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.