Mainframe Utility: CNVTUPCS

by | Oct 26, 2016 | 0 comments

Return to Mainframe Utilities Page

Module


/******************************************************************/
/* CLIST : CNVTUPCS - THIS CLIST WILL PROMPT THE USER FOR AN ISPF */
/*                    TABLE NAME AND LIBRARY, AND CONVERT THE     */
/*                    TABLE FIELD VALUES TO UPPER CASE.           */
/* AUTHOR : DAVE LEIGH   DATE : 5-17-89                           */
/******************************************************************/

PROC 0 HELP TNAME() TDSN()

/**** SET MESSAGE DISPLAY ON/OFF BASED ON THE DEBUG SWITCH ***/
ISPEXEC VGET (DBGSWTCH) PROFILE
IF &DBGSWTCH = &STR(ON) THEN +
CONTROL MSG LIST CONLIST SYMLIST NOFLUSH ASIS
ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS

IF &HELP = STR(&HELP) THEN GOTO HELPSEC

SET DIALOG = OFF

/*****************************************************/
/* GET THE TABLE NAME AND TABLE LIBRARY IF NECESSARY */
/*****************************************************/
IF &TDSN =    OR &TNAME =    THEN +
    DO
        SET DIALOG = ON
        ISPEXEC VPUT (TDSN TNAME) SHARED
LOOP: +
        ISPEXEC DISPLAY PANEL(UTILUPCS)
        IF &LASTCC > 0 THEN +
            DO
                IF &TNAME >     THEN +
                    DO
                        ISPEXEC TBSTATS &TNAME STATUS2(TBS2)
                        IF &TBS2 > 1 THEN ISPEXEC TBEND &TNAME
                    END
                SET ZEDLMSG = &STR(EXITED "CNVTUPCS" UTILITY WITHOUT)+
                              &STR( PROCESSING)
                ISPEXEC SETMSG MSG(UTLZ000)
                ISPEXEC LIBDEF ISPTABL
                EXIT
            END
        ISPEXEC VGET (TDSN TNAME) SHARED
    END

/*****************************************/
/* SET UP THE OUTPUT TABLE = INPUT TABLE */
/*****************************************/
ISPEXEC LIBDEF ISPTABL
ISPEXEC LIBDEF ISPTABL DATASET ID('&TDSN')

SET SAVECC = &LASTCC
IF &SAVECC > 0 THEN +
    DO
        IF &SAVECC = 4 THEN +
            DO
                SET ZEDLMSG = &STR(APPLICATION LIBRARY DOES NOT EXIST)+
                              &STR( FOR THIS TYPE)
                ISPEXEC SETMSG MSG(UTLZ001)
                IF &DIALOG = ON THEN GOTO LOOP
                ISPEXEC LIBDEF ISPTABL
                EXIT
            END
        IF &SAVECC = 8 THEN +
            DO
                SET ZEDLMSG = &STR(APPLICATION LIBRARY ALREADY EXISTS)+
                              &STR( FOR THIS TYPE)
                ISPEXEC SETMSG MSG(UTLZ001)
                IF &DIALOG = ON THEN GOTO LOOP
                ISPEXEC LIBDEF ISPTABL
                EXIT
            END
        IF &SAVECC = 12 THEN +
            DO
                SET ZEDLMSG = &STR('ISPPROF' SPECIFIED AS LIB-TYPE;)+
                              &STR( INVALID LIB-TYPE SPECIFIED)
                ISPEXEC SETMSG MSG(UTLZ001)
                IF &DIALOG = ON THEN GOTO LOOP
                ISPEXEC LIBDEF ISPTABL
                EXIT
            END
        IF &SAVECC = 16 THEN +
            DO
                SET ZEDLMSG = &STR("&TDSN" INVALID MVS NAME OR NOT )+
                              &STR(ALLOCATED)
                ISPEXEC SETMSG MSG(UTLZ001)
                IF &DIALOG = ON THEN GOTO LOOP
                ISPEXEC LIBDEF ISPTABL
                EXIT
            END
        IF &SAVECC = 20 THEN +
            DO
                SET ZEDLMSG = &STR(A SEVERE ERROR HAS OCCURED WHILE )+
                              &STR(EXECUTING THE ISPF LIBDEF UTILITY)
                ISPEXEC SETMSG MSG(UTLZ001)
                IF &DIALOG = ON THEN GOTO LOOP
                ISPEXEC LIBDEF ISPTABL
                EXIT
            END
    END

/**************************************/
/* OPEN THE SELECTED TABLE FOR UPDATE */
/**************************************/
ISPEXEC TBOPEN &TNAME WRITE

IF &LASTCC = 8 THEN +
    DO
        SET ZEDLMSG = &STR(TABLE &TNAME DOES NOT EXIST ** )+
                      &STR(PROCESS WAS TERMINATED)
        ISPEXEC SETMSG MSG(UTLZ001)
        IF &DIALOG = ON THEN GOTO LOOP
        ISPEXEC LIBDEF ISPTABL
        EXIT
    END

/******************************************************/
/* SET THE KEYS, NAMES AND INITIAL LASTSORT VARIABLES */
/******************************************************/
ISPEXEC TBQUERY &TNAME KEYS(TBKEYS) +
                       NAMES(TBNAMES) +
                       KEYNUM(TBKEYNUM) +
                       NAMENUM(TBNAMNUM) +
                       ROWNUM(TBROWS)

SET A = &EVAL(&LENGTH(&STR(&TBKEYS)) - 1)
SET B = &EVAL(&LENGTH(&STR(&TBNAMES)) - 1)

IF &A > 1 THEN +
    SET TBKEYS = &SUBSTR(2:&A,&STR(&TBKEYS))

IF &B > 1 THEN +
    SET TBNAMES = &SUBSTR(2:&B,&STR(&TBNAMES))

SET TBFIELDS = &STR(&TBKEYS &TBNAMES)

ISPEXEC VPUT (TNAME TDSN TBFIELDS) SHARED

ISPEXEC SELECT CMD(%CNVTUPC2)

IF &LASTCC > 0 THEN GOTO LOOP
ELSE +
    DO
        ISPEXEC VGET (TBFIELDS) SHARED
        IF &TBFIELDS =   THEN +
            DO
                SET ZEDLMSG = &STR(NO FIELDS SELECTED FROM "&TNAME")
                ISPEXEC SETMSG MSG(UTLZ001)
                GOTO LOOP
            END
    END

SET ZEDLMSG = &STR(*** CONVERTING "&TNAME" TO UPPER CASE ***)
IF &DIALOG = ON THEN +
    DO
        ISPEXEC SETMSG MSG(UTLZ000)
        ISPEXEC CONTROL DISPLAY LOCK
        ISPEXEC DISPLAY PANEL(UTILUPCS)
    END
ELSE WRITE &ZEDLMSG

FREE ATTRLIST(ATTRIB1)
ATTRIB ATTRIB1 +
       RECFM(F B) +
       LRECL(80) +
       BLKSIZE(23440) +
       OUTPUT

FREE DDNAME(SYSUT2)
DELETE SYSUT2
ALLOC DD(SYSUT2) DSN(SYSUT2) +
      NEW CATALOG +
      UNIT(SYSDA) +
      SPACE(1,1) TRACKS RELEASE +
      USING(ATTRIB1)

OPENFILE SYSUT2 OUTPUT

SET SYSUT2 = &STR(PROC 0 FIELDS())
PUTFILE SYSUT2
SET SYSUT2 = &STR(ISPEXEC VGET (DBGSWTCH) PROFILE)
PUTFILE SYSUT2
SET SYSUT2 = &STR(IF &&DBGSWTCH = &STR(ON) THEN +)
PUTFILE SYSUT2
SET SYSUT2 = &STR(CONTROL MSG LIST CONLIST SYMLIST NOFLUSH ASIS)
PUTFILE SYSUT2
SET SYSUT2 = &STR(ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS)
PUTFILE SYSUT2
SET SYSUT2 = &STR(ISPEXEC VGET (&&FIELDS))
PUTFILE SYSUT2

SET X = &TBFIELDS
DO WHILE &X >
    SET A = &SYSINDEX(&STR( ),&STR(&X))
    SET A = &A - 1
    IF &A > 0 THEN +
        DO
            SET SYSUT2 = &SUBSTR(1:&A,&STR(&X))
            SET SYSUT2 = &STR(SET &SYSUT2 = )+
                         &STR(&&SYSCAPS(&&NRSTR(&STR(&&)&SYSUT2)))
            PUTFILE SYSUT2
            SET A = &A + 2
            SET SLEN = &LENGTH(&STR(&X))
            SET &X = &SUBSTR(&A:&SLEN,&STR(&X))
        END
    ELSE +
        DO
            SET SYSUT2 = &STR(SET &X = )+
                         &STR(&&SYSCAPS(&&NRSTR(&STR(&&)&X)))
            PUTFILE SYSUT2
            SET X =
        END
END

SET SYSUT2 = &STR(ISPEXEC VPUT (&&FIELDS))
PUTFILE SYSUT2
SET SYSUT2 = &STR(EXIT)
PUTFILE SYSUT2

CLOSFILE SYSUT2
FREE DDNAME(SYSUT2)

SET SAVECC = 0
ISPEXEC TBTOP &TNAME
ISPEXEC TBVCLEAR &TNAME
ISPEXEC TBSKIP &TNAME NUMBER(1)
SET SAVECC = &LASTCC

DO WHILE &SAVECC = 0
    SET X = 0
    ISPEXEC VPUT (&TBFIELDS)
    EXEC '&SYSUID..SYSUT2' 'FIELDS(''&TBFIELDS'')'
    ISPEXEC VGET (&TBFIELDS)
    ISPEXEC TBMOD &TNAME
    ISPEXEC TBVCLEAR &TNAME
    ISPEXEC TBSKIP &TNAME NUMBER(1) POSITION(POSROW)
    SET SAVECC = &LASTCC
END

ISPEXEC TBCLOSE &TNAME
ISPEXEC LIBDEF ISPTABL

FREE ATTRLIST(ATTRIB1)

SET ZEDLMSG = &STR(FIELDS IN "&TNAME" TABLE CONVERTED TO UPPER CASE)
ISPEXEC SETMSG MSG(UTLZ000)

EXIT

HELPSEC: +
CLEAR
WRITE *** HELP FOR CLIST CNVTUPCS ***
WRITE
WRITE THIS CLIST CONVERTS EVERY FIELD IN A TABLE TO UPPER CASE WHEREEVER
WRITE THERE ARE LOWER-CASE ALPHABETIC CHARACTERS.  IT NEEDS TO KNOW THE
WRITE OUTPUT TABLE LIBRARY NAME AND THE TABLE NAME.  THE INPUT TABLE
WRITE WILL BE THE FIRST ONE IN THE ISPTLIB CONCATENATION WITH THAT NAME.
WRITE
WRITE BASIC SYNTAX :
WRITE
WRITE COMMAND ===> TSO CNVTUPCS TNAME(OUTPUT.ISPTLIB) TDSN(TBLNAME)
WRITE
WRITE IF YOU DO NOT SPECIFY THE OUTPUT TABLE LIBRARY NAME, OR THE INPUT
WRITE TABLE NAME, YOU WILL BE TAKEN TO AN ISPF PANEL TO ENTER THESE
WRITE PARAMETERS.
WRITE
WRITE *** END OF HELP *** NO PROCESSING PERFORMED ***
EXIT
            


Documentation


 This utility allows you to convert 1, some, or all of the fields in a given
 ISPF table from lower or mixed case to upper case.
            


0 Comments

Leave a Reply

This site uses Akismet to reduce spam. Learn how your comment data is processed.

Archives

Categories

Important links

leighweb.com – our family web site
surleslinteaux.leighweb.com – my wife’s French Sunday School blog
eglisejosue.fr – our church in France
tdr-guebwiller.eu – our house of prayer (HOP) in France
informatique.leighweb.com – My web development freelance business
My CV/Resume in English (PDF)