./ ADD NAME=$COMPAR1 PROC 1 DSN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /********************************************************************** /* UTILITY : $COMPAR1 * /* AUTHOR : DAVE LEIGH * /* FUNCTION : THIS UTILITY IS USED IN CONJUNCTION WITH $COMPAR2. IT * /* SAVES THE NAME OF THE "OLD" DATASET TO BE USED IN THE * /* COMPARE WITH THE "NEW" DATASET WHICH $COMPAR2 WILL * /* INVOKE. * /********************************************************************** SET SCEODFL = &NRSTR(&DSN) ISPEXEC VPUT (SCEODFL) PROFILE EXIT ./ ADD NAME=$COMPAR2 /********************************************************************** /* UTILITY : $COMPAR2 * /* AUTHOR : DAVE LEIGH * /* FUNCTION : THIS UTILITY IS USED IN CONJUNCTION WITH $COMPAR1. IT * /* TAKES INPUT OF A DATASET NAME WHICH IS THE "NEW" DATASET* /* AND SAVES IT AND THEN INVOKES THE ISPF 3;13 COMPARE * /* UTILITY. * /********************************************************************** PROC 1 DSN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /********************************************************************** /* DISPLAY HELP IF REQUESTED * /********************************************************************** IF &STR(&DSN) = HELP THEN GOTO HELPSEC SET SCENWFL = &NRSTR(&DSN) ISPEXEC VPUT (SCENWFL) PROFILE ISPEXEC SELECT PGM(ISRSEPRM) NOCHECK EXIT /********************************************************************** /* DISPLAY ANY "HELP" WHICH IS AVAILABLE FOR THIS UTILITY * /********************************************************************** HELPSEC: + ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR $COMPAR2 UTILITY + *** NO PROCESSING PERFORMED ***) ISPEXEC SETMSG MSG(UTLZ000) EXIT ./ ADD NAME=$COUNT /******************************************************************/ /* CLIST $COUNT - COUNT THE RECORDS IN A DATASET. */ /* AUTHOR : DAVID LEIGH. */ /******************************************************************/ PROC 1 DSN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT IF &DSN = HELP THEN GOTO HELPSEC ISPEXEC VGET ZDLDSORG IF &ZDLDSORG = &STR(PO) THEN + DO SET COLON = &STR(:) SET I = 4 END ELSE + DO SET COLON = SET I = 3 END SET SYSOUTTRAP = 100 PDS &DSN XISPMODE VERIFY &STR(&COLON) SET SYSOUTTRAP = 0 SET COUNT = &SUBSTR(1:10,&STR(&SYSNSUB(2,&&SYSOUTLINE&I)))&STR( RECS) SET COUNT = &COUNT SET ZDLMSG = &STR(&COUNT) ISPEXEC VPUT ZDLMSG SHARED EXIT HELPSEC: + 02480000 ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) 02490000 SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR $COUNT UTILITY + 02490000 *** NO PROCESSING PERFORMED ***) 02490000 ISPEXEC SETMSG MSG(UTLZ000) 02490000 EXIT ./ ADD NAME=$COUNTKY PROC 1 DSN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /********************************************************************** /* UTILITY : $COUNTKY * /* AUTHOR : DAVE LEIGH * /* FUNCTION : CALL THE "COUNTKEY" UTILITY PASSING THE NAMED DATASET * /* AS THE INPUT DATASET. * /********************************************************************** SET LEN = &LENGTH(&STR(&DSN)) SET DSN = &SUBSTR(2:&EVAL(&LEN - 1),&STR(&DSN)) ISPEXEC SELECT CMD(%COUNTKEY DSN(&DSN)) EXIT ./ ADD NAME=$F PROC 1 DMPDSN OPT() -------- /*** CHECK THE DEBUG SWITCH ***/ ISPEXEC VGET DBGSWTCH PROFILE IF &DBGSWTCH = ON THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS IF &SYSINDEX(&STR('),&STR(&DMPDSN)) = 0 THEN + IF &STR(&SYSUID) > THEN + SET DMPDSN = &STR('&SYSUID..&DMPDSN') ELSE + SET DMPDSN = &STR('&DMPDSN') %PROFUPDT FAXE VARIABLE(DMPDSN) VALUE(''&DMPDSN'') IF &DATATYPE(&STR(&OPT)) = NUM THEN SET OPT = &STR(OPT(&OPT)) ISPEXEC SELECT CMD(%FILEAID) EXIT ./ ADD NAME=$FB PROC 1 DATA_SET_NAME_OR_GO /*********************************************************************/ /* COMPUWARE CORPORATION FARMINGTON HILLS, MICHIGAN */ /* F1 - INVOKE FILE-AID BROWSE (F.1) DIRECTLY */ /*********************************************************************/ CONTROL MSG SET &FUNCVAR = &STR(1) SET &DSNVAR = &STR(&DATA_SET_NAME_OR_GO) IF &SUBSTR(1:1,&DSNVAR) = &STR(') - THEN SET "E = &STR(QUOTE) ELSE SET "E = &STR() /*********************************************************************/ /* PASS PARMS TO FADYNALC TO SET LIBS AND INVOKE FILE-AID */ /*********************************************************************/ ISPEXEC SELECT - CMD(%FADYNALC &FUNCVAR DSN(&DSNVAR) "E) NEWAPPL(FAXX) END ./ ADD NAME=$FE PROC 1 DATA_SET_NAME_OR_GO /*********************************************************************/ /* COMPUWARE CORPORATION FARMINGTON HILLS, MICHIGAN */ /* F2 - INVOKE FILE-AID EDIT (F.2) DIRECTLY */ /*********************************************************************/ CONTROL MSG SET &FUNCVAR = &STR(2) SET &DSNVAR = &STR(&DATA_SET_NAME_OR_GO) IF &SUBSTR(1:1,&DSNVAR) = &STR(') - THEN SET "E = &STR(QUOTE) ELSE SET "E = &STR() /*********************************************************************/ /* PASS PARMS TO FADYNALC TO SET LIBS AND INVOKE FILE-AID */ /*********************************************************************/ ISPEXEC SELECT - CMD(%FADYNALC &FUNCVAR DSN(&DSNVAR) "E) NEWAPPL(FAXX) END ./ ADD NAME=$JCLSRCH PROC 1 DSN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT SET DSNLEN = &EVAL(&LENGTH(&STR(&DSN)) - 1) SET DSN = &SUBSTR(2:&DSNLEN,&STR(&DSN)) SET GOO = &SYSINDEX(&STR(.G),&STR(&DSN)) SET VOO = &SYSINDEX(&STR(V),&STR(&DSN)) IF &GOO > 0 AND &VOO > &GOO THEN + DO SET GOO = &GOO - 1 SET DSN = &SUBSTR(1:&GOO,&STR(&DSN)) END %DXREF STG(&DSN) EDIT EXIT ./ ADD NAME=$LIBCLN1 PROC 1 DSN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /********************************************************************** /* UTILITY : $LIBCLN1 * /* AUTHOR : DAVE LEIGH * /* FUNCTION : THIS UTILITY IS USED IN CONJUNCTION WITH $LIBCLN2. IT * /* SAVES THE NAME OF THE "OLD" DATASET TO BE USED IN THE * /* EXECUTION OF THE LIBCLEAN UTILITY WITH THE "NEW" DATASET* /* WHICH $COMPAR2 WILL INVOKE. * /********************************************************************** SET OLDDSN = &NRSTR(&DSN) ISPEXEC VPUT (OLDDSN) PROFILE EXIT ./ ADD NAME=$LIBCLN2 PROC 1 DSN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /********************************************************************** /* UTILITY : $LIBCLN2 * /* AUTHOR : DAVE LEIGH * /* FUNCTION : THIS UTILITY IS USED IN CONJUNCTION WITH $LIBCLN1. IT * /* SAVES THE NAME OF THE "NEW" DATASET TO BE USED IN THE * /* EXECUTION OF THE LIBCLEAN UTILITY AND THEN INVOKES THE * /* LIBCLEAN UTILITY. * /********************************************************************** SET NEWDSN = &NRSTR(&DSN) ISPEXEC VPUT (NEWDSN) PROFILE %LIBCLEAN EXIT ./ ADD NAME=$LISTCAT PROC 1 DATASET_TO_LIST -------- /*** CHECK THE DEBUG SWITCH ***/ ISPEXEC VGET DBGSWTCH PROFILE IF &DBGSWTCH = ON THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS IF &STR(&DATASET_TO_LIST) = HELP THEN GOTO HELPSEC /********************************************************************** /* UTILITY: $LISTCAT * /* AUTHOR: DAVID LEIGH * /* FUNCTION: INVOKE THE "LISTCAT" COMMAND AND DUMP THE OUTPUT TO A * /* DATASET. * /********************************************************************** /********************************************************************** /* PARSE THE DATASET NAME * /********************************************************************** IF &SYSINDEX(&STR('),&STR(&DATASET_TO_LIST)) = 1 THEN + SET DATASET_TO_LIST = &SUBSTR(2:+ &LENGTH(&STR(&DATASET_TO_LIST))-1,+ &STR(&DATASET_TO_LIST)) ELSE + SET DATASET_TO_LIST = &STR(&SYSUID..&DATASET_TO_LIST) /********************************************************************** /* SET UP THE OUTPUT DATASET * /********************************************************************** SET OUTDSN = &STR(&SYSUID..TEMP.LISTCAT) DELETE '&OUTDSN' FREE DDNAME(OUTDD) ALLOC DD(OUTDD) DSN('&OUTDSN') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK$$$) + SPACE(5,5) TRACKS RELEASE + DSORG(PS) RECFM(V B A) LRECL(125) BLKSIZE(23375) /********************************************************************** /* INVOKE THE LISTCAT AND DUMP THE RESULTS TO THE FILE * /********************************************************************** LISTCAT LEVEL('&DATASET_TO_LIST') ALL OUTFILE(OUTDD) /********************************************************************** /* EDIT THE OUTPUT * /********************************************************************** FREE DDNAME(OUTDD) ISPEXEC EDIT DATASET('&OUTDSN') EXIT HELPSEC: + 02480000 ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) 02490000 SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR $LISTCAT UTILITY + 02490000 *** NO PROCESSING PERFORMED ***) 02490000 ISPEXEC SETMSG MSG(UTLZ000) 02490000 EXIT ./ ADD NAME=$PRINT PROC 1 DSN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /********************************************************************** /* CLIST : $PRINT * /* AUTHOR : DAVE LEIGH * /* FUNCTION : CALL THE PRINT UTILITY PASSING THE DATASET NAMED. * /********************************************************************** IF &SUBSTR(1:1,&NRSTR(&DSN)) = &STR(') THEN + DO SET LEN = &LENGTH(&STR(&DSN)) SET DSN = &SUBSTR(2:&EVAL(&LEN - 1),&STR(&DSN)) END ISPEXEC VPUT (DSN) PROFILE %UTILPRNT EXIT ./ ADD NAME=$PRINTIT PROC 1 DATASET_NAME_TO_PRINT DEBUG HELP BATCH B /********************************************************************** /* CLIST: $PRINTIT * /* AUTHOR: DAVID LEIGH * /* FUNCTION: THIS CLIST IS DESIGNED SPECIFICALLY TO BE USED WITH A * /* "DSLIST" (ISPF 3.4-TYPE) SCREEN. IT MAY BE USED * /* OTHERWISE AS WELL THOUGH. IT PASSES THE DATASET NAME TO * /* THE "PRINTIT" CLIST FOR PROCESSING. * /********************************************************************** /********************************************************************** /* STRIP OFF SINGLE QUOTES IF PRESENT. * /********************************************************************** SET X = &LENGTH(&STR(&DATASET_NAME_TO_PRINT)) IF &SYSINDEX(&STR('),&STR(&DATASET_NAME_TO_PRINT)) = 1 AND + &SUBSTR(&X:&X,&STR(&DATASET_NAME_TO_PRINT)) = &STR(') THEN + SET DATASET_NAME_TO_PRINT = &SUBSTR(2:&X-1,+ &STR(&DATASET_NAME_TO_PRINT) /********************************************************************** /* CALL THE PRINTIT CLIST. * /********************************************************************** IF &B = B THEN SET BATCH = BATCH %PRINTIT PDSN(&DATASET_NAME_TO_PRINT) &DEBUG &HELP &BATCH EXIT ./ ADD NAME=$PVBROWS ROC 1 PNSL **** SET MESSAGE DISPLAY ON/OFF BASED ON THE DEBUG SWITCH ***/ SPEXEC VGET (DBGSWTCH) PROFILE F &DBGSWTCH = &STR(ON) THEN CONTROL MSG LIST CONLIST SYMLIST NOFLUSH LSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT F &HELP = &STR(HELP) THEN GOTO HELPSEC ********************************************************************** * UTILITY: $PVBROWS * * AUTHOR: DAVID LEIGH * * FUNCTION: GO INTO PANVALET BROWSE FROM A DSLIST SCREEN OR A PASSED * * PANVALET DATASET NAME. * ********************************************************************** F &SUBSTR(1:1,&STR(&PNSL)) ¬= &STR(') AND + &SUBSTR(&LENGTH(&STR(&PNSL)),&STR(&PNSL)) ¬= &STR(') THEN + SET PNSL = &STR('&PNSL') ET ZTRAIL = 1 ET PFLG = 1 ET EMSG = SPEXEC VPUT (ZTRAIL PFLG EMSG) SHARED SPEXEC VPUT (PNSL) PROFILE SPEXEC SELECT PGM(PSPILINI) ET ACCESSCC = &LASTCC F &ACCESSCC > 8 THEN + DO SET ZEDLMSG = &STR(*** COULD NOT BROWSE "&PNSL" ***) ISPEXEC SETMSG MSG(UTLZ001) END XIT ELPSEC: + 02480000 SPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) 02490000 ET ZEDLMSG = &STR(*** HELP DISPLAYED FOR $PVBROWS UTILITY + 02490000 *** NO PROCESSING PERFORMED ***) 02490000 SPEXEC SETMSG MSG(UTLZ000) 02490000 XIT ./ ADD NAME=$PVEDIT ROC 1 PNSL **** SET MESSAGE DISPLAY ON/OFF BASED ON THE DEBUG SWITCH ***/ SPEXEC VGET (DBGSWTCH) PROFILE F &DBGSWTCH = &STR(ON) THEN CONTROL MSG LIST CONLIST SYMLIST NOFLUSH LSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT F &HELP = &STR(HELP) THEN GOTO HELPSEC ********************************************************************** * UTILITY: $PVEDIT * * AUTHOR: DAVID LEIGH * * FUNCTION: GO INTO PANVALET EDIT FROM A DSLIST SCREEN OR A PASSED * * PANVALET DATASET NAME. * ********************************************************************** F &SUBSTR(1:1,&STR(&PNSL)) ¬= &STR(') AND + &SUBSTR(&LENGTH(&STR(&PNSL)),&STR(&PNSL)) ¬= &STR(') THEN + SET PNSL = &STR('&PNSL') ET ZTRAIL = 2 ET PFLG = 1 ET EMSG = SPEXEC VPUT (ZTRAIL PFLG EMSG) SHARED SPEXEC VPUT (PNSL) PROFILE SPEXEC SELECT PGM(PSPILINI) ET ACCESSCC = &LASTCC F &ACCESSCC > 8 THEN + DO SET ZEDLMSG = &STR(*** COULD NOT EDIT "&PNSL" ***) ISPEXEC SETMSG MSG(UTLZ001) END XIT ELPSEC: + 02480000 SPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) 02490000 ET ZEDLMSG = &STR(*** HELP DISPLAYED FOR $PVEDIT UTILITY + 02490000 *** NO PROCESSING PERFORMED ***) 02490000 SPEXEC SETMSG MSG(UTLZ000) 02490000 XIT ./ ADD NAME=$RECALL /********************************************************************** /* UTILITY: $RECALL * /* AUTHOR: DAVID LEIGH * /* FUNCTION: RESTORE A DATASET FROM DMS ARCHIVE IN A BATCH JOB * /********************************************************************** PROC 1 RDSN -------- /*** CHECK THE DEBUG SWITCH ***/ ISPEXEC VGET DBGSWTCH PROFILE IF &DBGSWTCH = ON THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS IF &STR(&RDSN) = HELP THEN GOTO HELPSEC /********************************************************************** /* DEAL WITH THE SINGLE QUOTES * /********************************************************************** IF &SYSINDEX(&STR('),&STR(&RDSN)) = 0 THEN + IF &STR(&SYSUID) > THEN + SET RDSN = &STR(&SYSUID..&RDSN) ELSE ELSE + SET RDSN = &SUBSTR(2:&LENGTH(&STR(&RDSN))-1,&STR(&RDSN)) /********************************************************************** /* CREATE THE JCL AND SUBMIT IT * /********************************************************************** SET TEMPDSN = &STR(&SYSUID..TEMP.RECALL.JCL) DELETE '&TEMPDSN' FREE DDNAME(ISPFILE) ALLOCATE DDNAME(ISPFILE) DSN('&TEMPDSN') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK005) + SPACE(1,1) TRACKS RELEASE + RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS) ISPEXEC FTOPEN ISPEXEC FTINCL $RECALL ISPEXEC FTCLOSE FREE DD(ISPFILE) SUBMIT '&TEMPDSN' SET ZDLMSG = &STR(RECALL SUBMITTED) ISPEXEC VPUT ZDLMSG EXIT HELPSEC: + ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR $RECALL UTILITY + *** NO PROCESSING PERFORMED ***) ISPEXEC SETMSG MSG(UTLZ000) EXIT ./ ADD NAME=$RELGEN /* REXX ***************************************************************/ /* Utility: $RELGEN */ /* Author: David Leigh */ /* Function: Using GDGGEN (in reverse) return the relative GDG gen */ /* of a dataset when it's passed the full dataset name */ /* with the G0000V00 as the last node. */ /**********************************************************************/ parse upper arg INDSN /**********************************************************************/ /* get the g0000v00 and the base that was passed in */ /**********************************************************************/ indsn = strip(indsn,b,"'") gv = substr(INDSN,length(INDSN)-7) xcmd = parse var 'indsn' 'indsn' "'."gv"'" . interpret xcmd /**********************************************************************/ /* call gdggen to get the "minus" information */ /**********************************************************************/ address tso '%gdggen dsn('indsn')' address ispexec 'vget gen shared' /**********************************************************************/ /* loop through the results until you find the one you're looking for */ /**********************************************************************/ if gen > 0 then do i = 0 to gen - 1 'vget minus'i 'shared' xcmd = 'xv = substr(minus'i',length(minus'i')-7)' interpret xcmd if xv = gv then do if i = 0 then zdlmsg = i else zdlmsg = '-'i leave end end /**********************************************************************/ /* put the results in the dslist short message variable. */ /**********************************************************************/ address ispexec 'vput zdlmsg' EXIT ./ ADD NAME=$SCAN /* REXX ***************************************************************/ /* UTILITY: $SCAN */ /* AUTHOR: DAVID LEIGH */ /* FUNCTION: THIS EXEC IS DESIGNED FOR ISPF OPTION 3.4 SUCH THAT YOU */ /* TYPE $SCAN/$S NEXT TO A DATASET NAME AND PRESS ENTER. */ /* YOU WILL BE THEN TAKEN TO THE SUPERC EXTENDED SEARCH FOR */ /* UTILITY PANEL WITH THE DATASET NAME ALREADY POPULATED. */ /**********************************************************************/ ARG SF4FILE ZTRAIL = 'S' /* SELECT EXTENDED SEARCH FOR FACILITY */ SF4S1 = '' SF4S2 = '' SF4S3 = '' SF4S4 = '' SF4S5 = '' SF4ML = '' ADDRESS ISPEXEC "VPUT (SF4FILE ZTRAIL SF4S1 SF4S2 SF4S3 SF4S4 SF4S5 SF4ML)" "CONTROL NONDISPL ENTER" "SELECT PGM(ISRSEPRM) NOCHECK" ./ ADD NAME=$SEND PROC 1 DSN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /********************************************************************** /* CLIST : $SEND * /* AUTHOR : DAVE LEIGH * /* FUNCTION : CALL THE "SENDDATA" UTILITY PASSING THE NAMED DATASET * /* AS THE INPUT DATASET. * /********************************************************************** SET LEN = &LENGTH(&STR(&DSN)) SET DSN = &SUBSTR(2:&EVAL(&LEN - 1),&STR(&DSN)) ISPEXEC SELECT CMD(%SENDDATA THISDSN(&DSN)) EXIT ./ ADD NAME=$TDATE PROC 1 TDSN -------- /*** CHECK THE DEBUG SWITCH ***/ ISPEXEC VGET DBGSWTCH PROFILE IF &DBGSWTCH = ON THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS IF &STR(&TDSN) = HELP THEN GOTO HELPSEC /********************************************************************** /* UTILITY: $TDATE * /* AUTHOR: DAVID LEIGH * /* FUNCTION: CALL "TMSBINQ" TO FIND OUT THE CREATE DATE ON A TAPE * /* DATASET AND PLACE IT INTO TMS. * /********************************************************************** IF &SYSINDEX(&STR('),&STR(&TDSN)) = 1 THEN + SET TDSN = &SUBSTR(2:&LENGTH(&STR(&TDSN))-1,&STR(&TDSN)) ELSE + SET TDSN = &STR(&SYSUID..&TDSN) SET ZEDLMSG = &STR(*** GETTING CREATE DATE FOR "&TDSN" ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) SET SYSRPTDSN = &STR(&SYSUID..TEMP.TMS.REPORT) DELETE '&SYSRPTDSN' FREE DDNAME(TMSRPT SYSIN) ALLOC DD(TMSRPT) DSN('&SYSRPTDSN') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK$$$) + SPACE(5,5) TRACKS RELEASE + DSORG(PS) RECFM(F B) LRECL(133) BLKSIZE(23408) ALLOC DD(SYSIN) + NEW + UNIT(SYSDA) VOLUME(WRK$$$) + SPACE(1,1) TRACKS RELEASE + RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS) OPENFILE SYSIN OUTPUT SET SYSIN = &STR(DSN=&TDSN,LONG) PUTFILE SYSIN CLOSFILE SYSIN ISPEXEC SELECT PGM(TMSBINQ) FREE DDNAME(SYSIN SYSPRINT) /********************************************************************** /* PARSE THE OUTPUT FILE FOR THE DATA WE'RE LOOKING FOR * /********************************************************************** ERROR DO SET ERRCC = &LASTCC SELECT (&ERRCC) WHEN (400) DO SET EOF = YES RETURN END OTHERWISE DO ERROR OFF WRITE *** ERROR CC: &ERRCC OCCURRED READING A FILE *** CLOSFILE TMSRPT FREE DD(TMSRPT) EXIT END END END SET SWITCH = OFF SET EOF = NO OPENFILE TMSRPT GETFILE TMSRPT DO WHILE &EOF = NO IF &SYSINDEX(&STR( DSN=&TDSN),&STR(&SYSNSUB(1,&TMSRPT))) > 0 AND + &SYSINDEX(&STR( DSN=&TDSN),&STR(&SYSNSUB(1,&TMSRPT))) < 30 THEN + DO GETLOOP: GETFILE TMSRPT IF &SYSINDEX(&STR(CDATE=),&STR(&SYSNSUB(1,&TMSRPT))) > 0 + THEN DO SET A = + &SYSINDEX(&STR(CDATE=),&STR(&SYSNSUB(1,&TMSRPT))) SET A = &A + 6 SET Y = &A + 9 SET DATE = &SUBSTR(&A:&Y,&STR(&SYSNSUB(1,&TMSRPT))) SET DATE = &SUBSTR(9:10,&STR(&DATE))+ &SUBSTR(1:2,&STR(&DATE))+ &SUBSTR(4:5,&STR(&DATE)) SET B = + &SYSINDEX(&STR(CTIME=),&STR(&SYSNSUB(1,&TMSRPT))) SET B = &B + 6 SET X = &B + 4 SET TIME = &SUBSTR(&B:&X,&STR(&SYSNSUB(1,&TMSRPT))) SET ZDLMSG = &STR(D=&DATE T=&TIME) ISPEXEC VPUT ZDLMSG GOTO FINISH END ELSE GOTO GETLOOP END GETFILE TMSRPT END FINISH: + ERROR OFF CLOSFILE TMSRPT FREE DD(TMSRPT) EXIT HELPSEC: + 02480000 ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) 02490000 SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR $TDATE UTILITY + 02490000 *** NO PROCESSING PERFORMED ***) 02490000 ISPEXEC SETMSG MSG(UTLZ000) 02490000 EXIT ./ ADD NAME=$TINFO PROC 1 TDSN BATCH -------- /*** CHECK THE DEBUG SWITCH ***/ ISPEXEC VGET DBGSWTCH PROFILE IF &DBGSWTCH = ON THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS IF &STR(&TDSN) = HELP THEN GOTO HELPSEC /********************************************************************** /* UTILITY: $TINFO * /* AUTHOR: DAVID LEIGH * /* FUNCTION: CALL "TMSBINQ" TO FIND OUT TMS INFO ON A TAPE DATASET * /* WITHOUT HAVING TO GO INTO TMS. * /********************************************************************** IF &SYSINDEX(&STR('),&STR(&TDSN)) = 1 THEN + SET TDSN = &SUBSTR(2:&LENGTH(&STR(&TDSN))-1,&STR(&TDSN)) ELSE + SET TDSN = &STR(&SYSUID..&TDSN) SET ZEDLMSG = &STR(*** GATHERING TMS INFORMATION ON "&TDSN" ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) SET SYSRPTDSN = &STR(&SYSUID..TEMP.TMS.REPORT) DELETE '&SYSRPTDSN' FREE DDNAME(TMSRPT SYSIN) ALLOC DD(TMSRPT) DSN('&SYSRPTDSN') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK$$$) + SPACE(5,5) TRACKS RELEASE + DSORG(PS) RECFM(F B) LRECL(133) BLKSIZE(23408) ALLOC DD(SYSIN) + NEW + UNIT(SYSDA) VOLUME(WRK$$$) + SPACE(1,1) TRACKS RELEASE + RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS) OPENFILE SYSIN OUTPUT SET SYSIN = &STR(DSN=&TDSN,LONG) PUTFILE SYSIN CLOSFILE SYSIN ISPEXEC SELECT PGM(TMSBINQ) SET ZEDLMSG = &STR(*** FORMATTING TMS INFORMATION FOR "&TDSN" ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) FREE DDNAME(SYSIN SYSPRINT) /********************************************************************** /* SHOW THE OUTPUT IN AN EDITED FILE. * /********************************************************************** FREE DDNAME(TMSRPT) ISPEXEC VPUT (TDSN BATCH) SHARED ISPEXEC EDIT DATASET('&SYSRPTDSN') MACRO(TINFOMAC) EXIT /********************************************************************** /* DON'T REMOVE THE NEXT CODE SINCE IT WAS SO TIME-CONSUMING TO CREATE* /********************************************************************** ERROR DO SET ERRCC = &LASTCC SELECT (&ERRCC) WHEN (400) DO SET EOF = YES RETURN END OTHERWISE DO ERROR OFF WRITE *** ERROR CC: &ERRCC OCCURRED READING A FILE *** CLOSFILE TMSRPT FREE DD(TMSRPT) EXIT CODE(&ERRCC) END END END SET SWITCH = OFF SET EOF = NO OPENFILE TMSRPT GETFILE TMSRPT DO WHILE &EOF = NO IF &SYSINDEX(&STR(VOLSEQ=001),&STR(&TMSRPT)) = 9 THEN + DO SET VOLSEQ = &SUBSTR(016:018,&STR(&TMSRPT)) SET ACCT = &SUBSTR(088:128,&STR(&TMSRPT)) GETFILE TMSRPT SET CUNIT = &SUBSTR(073:075,&STR(&TMSRPT)) SET LJOB = &SUBSTR(083:090,&STR(&TMSRPT)) SET LDATE = &SUBSTR(099:103,&STR(&TMSRPT)) SET LUNIT = &SUBSTR(112:114,&STR(&TMSRPT)) GETFILE TMSRPT SET FIRSTVOL = &SUBSTR(016:021,&STR(&TMSRPT)) SET NEXTVOL = &SUBSTR(032:037,&STR(&TMSRPT)) SET PREVVOL = &SUBSTR(048:053,&STR(&TMSRPT)) SET NUMDSNB = &SUBSTR(074:077,&STR(&TMSRPT)) SET FRSTDSNB = &SUBSTR(088:092,&STR(&TMSRPT)) SET FLAG2 = &SUBSTR(101:102,&STR(&TMSRPT)) SET BATCHID = &SUBSTR(113:115,&STR(&TMSRPT)) GETFILE TMSRPT SET LABEL = &SUBSTR(015:016,&STR(&TMSRPT)) SET DEN = &SUBSTR(023:024,&STR(&TMSRPT)) SET TRTCH = &SUBSTR(033:034,&STR(&TMSRPT)) GETFILE TMSRPT SET OUTCODE = &SUBSTR(017:020,&STR(&TMSRPT)) SET OUTDATE = &SUBSTR(031:035,&STR(&TMSRPT)) SET SLOT = &SUBSTR(043:048,&STR(&TMSRPT)) SET CLNCNT = &SUBSTR(057:059,&STR(&TMSRPT)) SET DATECLN = &SUBSTR(070:074,&STR(&TMSRPT)) SET USECLN = &SUBSTR(084:088,&STR(&TMSRPT)) SET BTHDATE = &SUBSTR(099:103,&STR(&TMSRPT)) SET COUNT = &SUBSTR(112:116,&STR(&TMSRPT)) GETFILE TMSRPT SET FLAG3 = &SUBSTR(015:016,&STR(&TMSRPT)) END IF &SYSINDEX(&STR(DSN=&TDSN),&STR(&TMSRPT)) = 50 THEN + DO SET VOLSER = &SUBSTR(016:021,&STR(&TMSRPT)) SET FILESEQ = &SUBSTR(032:034,&STR(&TMSRPT)) SET EXPDT = &SUBSTR(043:047,&STR(&TMSRPT)) SET NEXTDSNB = &SUBSTR(109:114,&STR(&TMSRPT)) GETFILE TMSRPT SET CJOB = &SUBSTR(014:020,&STR(&TMSRPT)) SET STPNAME = &SUBSTR(032:039,&STR(&TMSRPT)) SET CRTDT = &SUBSTR(048:052,&STR(&TMSRPT)) SET CTIME = &SUBSTR(061:064,&STR(&TMSRPT)) SET FLAG1 = &SUBSTR(073:074,&STR(&TMSRPT)) SET F1STVOL = &SUBSTR(085:090,&STR(&TMSRPT)) GETFILE TMSRPT SET RECFM = &SUBSTR(015:016,&STR(&TMSRPT)) SET LRECL = &SUBSTR(025:029,&STR(&TMSRPT)) SET BLKSIZE = &SUBSTR(040:044,&STR(&TMSRPT)) SET BLKCNT = &SUBSTR(054:059,&STR(&TMSRPT)) SET READERR = &SUBSTR(070:072,&STR(&TMSRPT)) SET WRITERR = &SUBSTR(083:085,&STR(&TMSRPT)) SET EOF = YES END GETFILE TMSRPT END ERROR OFF CLOSFILE TMSRPT FREE DD(TMSRPT) WRITE VOLSEQ &VOLSEQ WRITE ACCT &ACCT WRITE CUNIT &CUNIT WRITE LJOB &LJOB WRITE LDATE &LDATE WRITE LUNIT &LUNIT WRITE FIRSTVOL &FIRSTVOL WRITE NEXTVOL &NEXTVOL WRITE PREVVOL &PREVVOL WRITE NUMDSNB &NUMDSNB WRITE FRSTDSNB &FRSTDSNB WRITE FLAG2 &FLAG2 WRITE BATCHID &BATCHID WRITE LABEL &LABEL WRITE DEN &DEN WRITE TRTCH &TRTCH WRITE OUTCODE &OUTCODE WRITE OUTDATE &OUTDATE WRITE SLOT &SLOT WRITE CLNCNT &CLNCNT WRITE DATECLN &DATECLN WRITE USECLN &USECLN WRITE BTHDATE &BTHDATE WRITE COUNT &COUNT WRITE FLAG3 &FLAG3 WRITE VOLSER &VOLSER WRITE FILESEQ &FILESEQ WRITE EXPDT &EXPDT WRITE NEXTDSNB &NEXTDSNB WRITE CJOB &CJOB WRITE STPNAME &STPNAME WRITE CRTDT &CRTDT WRITE CTIME &CTIME WRITE FLAG1 &FLAG1 WRITE F1STVOL &F1STVOL WRITE RECFM &RECFM WRITE LRECL &LRECL WRITE BLKSIZE &BLKSIZE WRITE BLKCNT &BLKCNT WRITE READERR &READERR WRITE WRITERR &WRITERR EXIT HELPSEC: + 02480000 ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) 02490000 SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR $TINFO UTILITY + 02490000 *** NO PROCESSING PERFORMED ***) 02490000 ISPEXEC SETMSG MSG(UTLZ000) 02490000 EXIT ./ ADD NAME=$TMS PROC 1 TDSN -------- /*** CHECK THE DEBUG SWITCH ***/ ISPEXEC VGET DBGSWTCH PROFILE IF &DBGSWTCH = ON THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS IF &STR(&TDSN) = HELP THEN GOTO HELPSEC /********************************************************************** /* UTILITY: $TOUT * /* AUTHOR: DAVID LEIGH * /* FUNCTION: CALL "TMSBINQ" TO FIND OUT THE OUTCODE ON A TAPE AND * /* DISPLAY THE RESULTS ON DSLIST. * /********************************************************************** IF &SYSINDEX(&STR('),&STR(&TDSN)) = 1 THEN + SET TDSN = &SUBSTR(2:&LENGTH(&STR(&TDSN))-1,&STR(&TDSN)) ELSE + SET TDSN = &STR(&SYSUID..&TDSN) SET ZEDLMSG = &STR(*** GETTING "OUTCODE" FOR "&TDSN" ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) SET SYSRPTDSN = &STR(&SYSUID..TEMP.TMS.REPORT) DELETE '&SYSRPTDSN' FREE DDNAME(TMSRPT SYSIN) ALLOC DD(TMSRPT) DSN('&SYSRPTDSN') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK005) + SPACE(5,5) TRACKS RELEASE + DSORG(PS) RECFM(F B) LRECL(133) BLKSIZE(23408) ALLOC DD(SYSIN) + NEW + UNIT(SYSDA) VOLUME(WRK005) + SPACE(1,1) TRACKS RELEASE + RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS) OPENFILE SYSIN OUTPUT SET SYSIN = &STR(DSN=&TDSN,LONG) PUTFILE SYSIN CLOSFILE SYSIN ISPEXEC SELECT PGM(TMSBINQ) FREE DDNAME(TMSRPT SYSIN SYSPRINT) ISPEXEC EDIT DATASET('&SYSRPTDSN') EXIT ./ ADD NAME=$TOUT PROC 1 TDSN -------- /*** CHECK THE DEBUG SWITCH ***/ ISPEXEC VGET DBGSWTCH PROFILE IF &DBGSWTCH = ON THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS IF &STR(&TDSN) = HELP THEN GOTO HELPSEC /********************************************************************** /* UTILITY: $TOUT * /* AUTHOR: DAVID LEIGH * /* FUNCTION: CALL "TMSBINQ" TO FIND OUT THE OUTCODE ON A TAPE AND * /* DISPLAY THE RESULTS ON DSLIST. * /********************************************************************** IF &SYSINDEX(&STR('),&STR(&TDSN)) = 1 THEN + SET TDSN = &SUBSTR(2:&LENGTH(&STR(&TDSN))-1,&STR(&TDSN)) ELSE + SET TDSN = &STR(&SYSUID..&TDSN) SET ZEDLMSG = &STR(*** GETTING "OUTCODE" FOR "&TDSN" ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) SET SYSRPTDSN = &STR(&SYSUID..TEMP.TMS.REPORT) DELETE '&SYSRPTDSN' FREE DDNAME(TMSRPT SYSIN) ALLOC DD(TMSRPT) DSN('&SYSRPTDSN') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK$$$) + SPACE(5,5) TRACKS RELEASE + DSORG(PS) RECFM(F B) LRECL(133) BLKSIZE(23408) ALLOC DD(SYSIN) + NEW + UNIT(SYSDA) VOLUME(WRK$$$) + SPACE(1,1) TRACKS RELEASE + RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS) OPENFILE SYSIN OUTPUT SET SYSIN = &STR(DSN=&TDSN,LONG) PUTFILE SYSIN CLOSFILE SYSIN ISPEXEC SELECT PGM(TMSBINQ) FREE DDNAME(SYSIN SYSPRINT) /********************************************************************** /* PARSE THE OUTPUT FILE FOR THE DATA WE'RE LOOKING FOR * /********************************************************************** ERROR DO SET ERRCC = &LASTCC SELECT (&ERRCC) WHEN (400) DO SET EOF = YES RETURN END OTHERWISE DO ERROR OFF WRITE *** ERROR CC: &ERRCC OCCURRED READING A FILE *** CLOSFILE TMSRPT FREE DD(TMSRPT) EXIT END END END SET SWITCH = OFF SET EOF = NO OPENFILE TMSRPT GETFILE TMSRPT DO WHILE &EOF = NO IF &SYSINDEX(&STR(OUTCODE=),&STR(&SYSNSUB(1,&TMSRPT))) > 0 THEN + DO SET A = &SYSINDEX(&STR(OUTCODE=),+ &STR(&SYSNSUB(1,&TMSRPT))) SET A = &A + 8 SET Y = &A + 3 SET OUTCODE = &SUBSTR(&A:&Y,+ &STR(&SYSNSUB(1,&TMSRPT))) SET ZDLMSG = &STR(OUTCODE="&OUTCODE") ISPEXEC VPUT ZDLMSG GOTO FINISH END GETFILE TMSRPT END FINISH: + ERROR OFF CLOSFILE TMSRPT FREE DD(TMSRPT) EXIT HELPSEC: + 02480000 ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) 02490000 SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR $TOUT UTILITY + 02490000 *** NO PROCESSING PERFORMED ***) 02490000 ISPEXEC SETMSG MSG(UTLZ000) 02490000 EXIT ./ ADD NAME=$XMIT PROC 1 DSN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /********************************************************************** /* CLIST : $XMIT * /* AUTHOR : DAVE LEIGH * /* FUNCTION : THIS CLIST USES THE INPUT DATASET IN A TSO "TRANSMIT" * /* COMMAND. IT PROMPTS THE USER FOR DESTINATION IPC AND * /* USER AND WHETHER THEY WANT TO SEND AN ACCOMPANYING * /* MESSAGE. * /********************************************************************** IF &SYSDSN(&DSN) ¬= OK THEN + DO SET ZEDSMSG = &STR(PROBLEM WITH DATASET) SET ZEDLMSG = &STR(&DSN PROBLEM : &SYSDSN(&DSN)) ISPEXEC SETMSG MSG(UTLZ001) EXIT END WRITENR IPC DESTINATION (JUST TO QUIT) ? READ IPC IF &IPC = THEN + DO SET ZEDLMSG = &STR(&DSN NOT TRANSMITTED *** PROCESS TERMINATED) ISPEXEC SETMSG MSG(UTLZ000) EXIT END WRITENR USER ID (JUST TO QUIT) ? READ USERID IF &USERID = THEN + DO SET ZEDLMSG = &STR(&DSN NOT TRANSMITTED *** PROCESS TERMINATED) ISPEXEC SETMSG MSG(UTLZ000) EXIT END WRITENR TYPE "MESSAGE"-SEND A MSG "QUIT"-QUIT OR PRESS -NO MSG READ MESSAGE IF &MESSAGE = QUIT THEN + DO SET ZEDLMSG = &STR(&DSN NOT TRANSMITTED *** PROCESS TERMINATED) ISPEXEC SETMSG MSG(UTLZ000) EXIT END IF &MESSAGE = MESSAGE OR &MESSGE = THEN ELSE + DO SET ZEDLMSG = &STR(NO MESSAGE SENT "&MESSAGE" IS INVALID) ISPEXEC SETMSG MSG(UTLZ000) END LOOP: + WRITE YOUR TRANSMIT COMMAND WILL BE : WRITE TRANSMIT &IPC..&USERID DA(&DSN) &MESSAGE WRITENR TYPE "QUIT" TO QUIT NOW OR PRESS TO CONTINUE ==> READ ANS IF &ANS = QUIT THEN EXIT IF &ANS > AND &ANS ¬= QUIT THEN GOTO LOOP TRANSMIT &IPC..&USERID DA(&DSN) &MESSAGE EXIT ./ ADD NAME=$XREF PROC 1 DSN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /********************************************************************** /* CLIST : $XREF * /* AUTHOR : DAVE LEIGH * /* FUNCTION : CALL THE "DXREF" UTILITY TO CREATE A CROSS REFERENCE OF * /* THE PASSED DATASET IN PRODUCTION JCL. * /********************************************************************** SET DSNLEN = &EVAL(&LENGTH(&STR(&DSN)) - 1) SET DSN = &SUBSTR(2:&DSNLEN,&STR(&DSN)) SET GOO = &SYSINDEX(&STR(.G),&STR(&DSN)) SET VOO = &SYSINDEX(&STR(V),&STR(&DSN)) IF &GOO > 0 AND &VOO > &GOO THEN + DO SET GOO = &GOO - 1 SET DSN = &SUBSTR(1:&GOO,&STR(&DSN)) END %DXREF DSN(&DSN) EDIT EXIT ./ ADD NAME=A ISREDIT MACRO NOPROCESS (STG1,STG2,OPT1,OPT2,OPT3,OPT4,OPT5,OPT6,OPT7) ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /**********************************************************************/ /* UTILITY NAME : A */ /* DATE WRITTEN : 9-29-88 */ /* AUTHOR : DAVE LEIGH */ /* DESCRIPTION : INSERT 'STRING 2' AFTER LINE WITH (AN) OCCURANCE(S) */ /* : OF 'STRING 1' */ /*========================== MODIFICATIONS ===========================*/ /* WHO |WHEN |WHY */ /* --- |---- |--- */ /* DAVE LEIGH |8-11-89 |TOOK OFF THE 'CODE(&MAXCC)' PORTION OF THE */ /* | |EXIT STATEMENT SINCE A CODE OF > 0 WOULD */ /* | |CAUSE THE INVOCATION COMMAND ON THE COMMAND */ /* | |TO REMAIN AFTER IT WAS COMPLETE, AND HITTING*/ /* | |THE LAST LINE OF THE FILE WOULD ALWAYS CAUSE*/ /* | |THE RETURN CODE TO BE > 0. */ /* DAVE LEIGH |8-17-89 |CHANGED &STRING_ TO &NRSTR(&STRING_) TO TAKE*/ /* | |CARE OF STRINGS WITH '&' IN THEM. */ /**********************************************************************/ IF &NRSTR(&STG2) = THEN + IF &NRSTR(&STG1) = &STR(HELP) THEN GOTO HELPSEC ELSE + DO SET ZEDSMSG = &STR(2ND STRING MISSING) ISPEXEC SETMSG MSG(UTLZ001) EXIT CODE(8) END IF &SYSNSUB(1,&STG2) = ZLINE OR + &SYSNSUB(1,&STG2) = &SYSNSUB(0,&ZLINE) THEN + DO ISREDIT PROCESS RANGE Z IF &LASTCC ¬= 0 THEN + DO SET ZEDLMSG = &STR(*** NO LINE MARKED "Z" TO INSERT ***) ISPEXEC SETMSG MSG(UTLZ001) EXIT END ELSE + DO SET I = 0 ISREDIT FIND FIRST P'=' 1 .ZFRANGE .ZLRANGE DO WHILE &LASTCC = 0 SET I = &I + 1 ISREDIT (ZLINE&I) = LINE .ZCSR ISREDIT FIND NEXT P'=' 1 .ZFRANGE .ZLRANGE END SET NUMZ = &I END END ELSE + IF &SUBSTR(1:1,&STR(&SYSNSUB(1,&STG2))) = &STR(') OR + &SUBSTR(1:1,&STR(&SYSNSUB(1,&STG2))) = &STR(") THEN + DO SET X = &LENGTH(&SYSNSUB(1,&STG2)) SET STG2 = &SUBSTR(2:&X-1,&SYSNSUB(1,&STG2)) END SET OPTIONS = &SYSCAPS(&OPT1 &OPT2 &OPT3 &OPT4 &OPT5 &OPT6 &OPT7) ISREDIT (SLINE,SCOL) = CURSOR SET XCOUNT = 0 ISREDIT FIND FIRST &NRSTR(&STG1) &OPTIONS DO WHILE &LASTCC = 0 SET XCOUNT = &XCOUNT + 1 IF &SYSNSUB(1,&STG2) = ZLINE OR + &SYSNSUB(1,&STG2) = &SYSNSUB(0,&ZLINE) THEN + DO ISREDIT LABEL .ZCSR = .CURR DO &I = &NUMZ TO 1 BY -1 ISREDIT LINE_AFTER .CURR = (ZLINE&I) ISREDIT FIND NEXT P'=' 1 ISREDIT CHANGE 'XCOUNT' + '&XCOUNT' .ZCSR .ZCSR ALL IF &I = &NUMZ THEN ISREDIT LABEL .ZCSR = .NEXT ISREDIT SEEK FIRST P'=' .CURR .CURR END ISREDIT FIND FIRST P'=' .NEXT .NEXT END ELSE + DO ISREDIT LINE_AFTER .ZCSR = (STG2) ISREDIT FIND NEXT P'=' 1 ISREDIT CHANGE 'XCOUNT' '&XCOUNT' .ZCSR .ZCSR ALL END ISREDIT SEEK LAST P'=' .ZCSR .ZCSR ISREDIT FIND NEXT &NRSTR(&STG1) &OPTIONS END ISREDIT CURSOR = &SLINE &SCOL IF &STR(&NUMZ) > 1 THEN SET XCOUNT = &XCOUNT * &NUMZ SET ZEDSMSG = &STR(&XCOUNT LINES INSERTED) ISPEXEC SETMSG MSG(UTLZ000) EXIT HELPSEC: + ISPEXEC SELECT PGM(ISPTUTOR) PARM(UTILH010) SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR "A" EDIT MACRO + *** NO PROCESSING PERFORMED ***) ISPEXEC SETMSG MSG(UTLZ000) EXIT ./ ADD NAME=ABENDLOG /********************************************************************** /* CLIST : ABENDLOG * /* AUTHOR : DAVE LEIGH * /* FUNCTION : THIS UTILITY MAINTAINS A PRODUCTION ABEND LOG TABLE. * /********************************************************************** PROC 0 ISPFPFX(D@UDAL.STR) + HELP /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT IF &HELP = HELP THEN GOTO HELPSEC /*****************************************/ /* SET UP THE OUTPUT TABLE = INPUT TABLE */ /*****************************************/ ISPEXEC LIBDEF ISPTABL ISPEXEC LIBDEF ISPTABL DATASET ID('&ISPFPFX..ISPTLIB') /**************************************/ /* OPEN THE ABENDLOG TABLE FOR UPDATE */ /**************************************/ ISPEXEC CONTROL ERRORS RETURN ISPEXEC TBOPEN ABENDLOG WRITE SET OPENCC = &LASTCC IF &OPENCC > 8 THEN + DO SET ZEDLMSG = &STR(*** ABEND LOG TABLE CURRENTLY IN USE ***) ISPEXEC SETMSG MSG(UTLZ001) EXIT END /**************************************************/ /* CREATE THE ABENDLOG TABLE IF IT DOES NOT EXIST */ /**************************************************/ IF &OPENCC = 8 THEN + DO ISPEXEC TBCREATE ABENDLOG WRITE SHARE + KEYS() + NAMES(PROGRAM ABNDCODE JOBNAME SUFLAG CYCDATE + SEID IACODE DSC01 DSC02 DSC03 DSC04 DSC05 + DSC06 DSC07 DSC08 DSC09 DSC10 + DSC11 DSC12 DSC13 DSC14 DSC15 + DSC16 DSC17 DSC18 DSC19 DSC20) END /**********************************/ /* PRE-SORT THE TABLE FOR DISPLAY */ /**********************************/ SET LASTSORT = &STR(JOBNAME,C,A,PROGRAM,C,A,SUFLAG,C,A,ABNDCODE,C,A) ISPEXEC TBSORT ABENDLOG FIELDS(&LASTSORT) SET LASTSORT = JOBNAME /************************/ /* MAIN PROCESSING LOOP */ /************************/ /*****************************************************/ /* DISPLAY THE MEMBER LIST AND SAVE THE RETURN CODE */ /*****************************************************/ REDISP1: + ISPEXEC TBDISPL ABENDLOG PANEL(ABENDLOG) SET SAVECC = &LASTCC /*************************************************/ /* DO PROCESSING FOR PENDING SELECTED ROWS FIRST */ /*************************************************/ IF &ZTDSELS ¬= &STR(0000) THEN + DO ISPEXEC CONTROL DISPLAY SAVE DO WHILE &ZTDSELS ¬= &STR(0000) IF &STR(&SEL) = &STR(D) THEN + ISPEXEC TBDELETE ABENDLOG IF &STR(&SEL) = &STR(I) THEN + DO ISPEXEC TBVCLEAR ABENDLOG SET SEID = &SYSUID SET YY = SET MM = SET DD = SET ZEDLMSG = &STR(*** TYPE IN THE ABEND + INFORMATION AND PRESS + TO SAVE ***) ISPEXEC SETMSG MSG(UTLZ000) INSLOOP1: + ISPEXEC DISPLAY PANEL(ABENDLG2) IF &LASTCC > 7 THEN + DO SET ZEDLMSG = + &STR(*** "END" COMMAND ENTERED ***) ISPEXEC SETMSG MSG(UTLZ000) END ELSE + DO SET CYCDATE = &STR(&YY&MM&DD) ISPEXEC TBADD ABENDLOG GOTO INSLOOP1 END END IF &STR(&SEL) = &STR(S) THEN + DO SET &YY = &SUBSTR(1:2,&STR(&CYCDATE)) SET &MM = &SUBSTR(3:4,&STR(&CYCDATE)) SET &DD = &SUBSTR(5:6,&STR(&CYCDATE)) SELLOOP1: + ISPEXEC DISPLAY PANEL(ABENDLG2) IF &LASTCC = 8 THEN ISPEXEC SETMSG MSG(UTLZ000) ELSE + DO SET CYCDATE = &STR(&YY&MM&DD) ISPEXEC TBPUT ABENDLOG GOTO SELLOOP1 END END IF &ZTDSELS > &STR(0001) THEN + DO ISPEXEC CONTROL DISPLAY RESTORE ISPEXEC TBDISPL ABENDLOG ISPEXEC CONTROL DISPLAY SAVE END ELSE + DO SET ZTDSELS = &STR(0000) ISPEXEC CONTROL DISPLAY RESTORE END END END /***************************************/ /* PROCESS USERS PENDING 'END' COMMAND */ /***************************************/ IF &SAVECC > 7 THEN GOTO FINISH /***********************************/ /* PROCESS INSERT OF NEW TABLE ROW */ /***********************************/ IF &LENGTH(&STR(&ZCMD)) > 0 THEN + IF &STR(&ZCMD) = &STR(I) THEN + DO ISPEXEC CONTROL DISPLAY SAVE ISPEXEC TBVCLEAR ABENDLOG SET ZEDLMSG = &STR(*** TYPE IN THE ABEND + INFORMATION AND PRESS + TO SAVE ***) ISPEXEC SETMSG MSG(UTLZ000) SET SEID = &SYSUID SET YY = SET MM = SET DD = SET ZEDLMSG = &STR(*** TYPE IN THE ABEND + INFORMATION AND PRESS + TO SAVE ***) ISPEXEC SETMSG MSG(UTLZ000) ISPEXEC DISPLAY PANEL(ABENDLG2) SET ZEDLMSG = &STR(*** "END" COMMAND ENTERED ***) IF &LASTCC = 8 THEN + ISPEXEC SETMSG MSG(UTLZ000) ELSE + DO SET CYCDATE = &STR(&YY&MM&DD) ISPEXEC TBADD ABENDLOG GOTO REDISP2 END ISPEXEC CONTROL DISPLAY RESTORE END /**************************/ /* PROCESS LOCATE COMMAND */ /**************************/ IF &LENGTH(&STR(&ZCMD)) > 2 THEN + IF &SUBSTR(1:2,&STR(&ZCMD)) = &STR(L ) THEN + DO ISPEXEC TBTOP ABENDLOG SET VALUE = &SUBSTR(3:&LENGTH(&STR(&ZCMD)),&STR(&ZCMD)) IF &STR(&LASTSORT) = PROGRAM + THEN SET PROGRAM = &STR(&VALUE) IF &STR(&LASTSORT) = ABNDCODE + THEN SET ABNDCODE = &STR(&VALUE) IF &STR(&LASTSORT) = JOBNAME + THEN SET JOBNAME = &STR(&VALUE) IF &STR(&LASTSORT) = CYCDATE + THEN SET CYCDATE = &STR(&VALUE) IF &STR(&LASTSORT) = SEID + THEN SET SEID = &STR(&VALUE) IF &STR(&LASTSORT) = IACODE + THEN SET IACODE = &STR(&VALUE) IF &STR(&LASTSORT) = SUFLAG + THEN SET SUFLAG = &STR(&VALUE) SET VALUE = &STR(&VALUE)&STR(*) SET VALUE = &SUBSTR(1:&LENGTH(&STR(&VALUE)),&STR(&VALUE)) ISPEXEC TBSCAN ABENDLOG ARGLIST(&LASTSORT) + CONDLIST(GE) + NOREAD END /************************/ /* PROCESS SORT COMMAND */ /************************/ IF &LENGTH(&STR(&ZCMD)) > 5 THEN + IF &SUBSTR(1:5,&STR(&ZCMD)) = &STR(SORT ) THEN + DO SET FLD1 = SET FLD2 = SET FLD3 = SET FLD4 = SET FLD5 = SET FLD6 = SET FLD7 = SET FLDS = SET X = &EVAL(&SYSINDEX(&STR( ),&STR(&ZCMD)) + 1) SET Y = &LENGTH(&STR(&ZCMD)) SET SYSDVAL = &SUBSTR(&X:&Y,&STR(&ZCMD)) READDVAL FLD1 FLD2 FLD3 FLD4 FLD5 FLD6 FLD7 SET ZEDLMSG = &STR(VALID FLDS: PROGRAM ABEND JOB + SYS/USER IDMS/CODE DATE SE) IF &STR(&FLD1) > THEN + IF (&STR(&FLD1) ¬= PROGRAM AND + &STR(&FLD1) ¬= ABEND AND + &STR(&FLD1) ¬= JOB AND + &STR(&FLD1) ¬= &STR(SYS/USER) AND + &STR(&FLD1) ¬= &STR(IDMS/CODE) AND + &STR(&FLD1) ¬= DATE AND + &STR(&FLD1) ¬= SE) THEN + ISPEXEC SETMSG MSG(UTLZ001) ELSE + DO IF &STR(&FLD1) = PROGRAM THEN + SET FLDS = &STR(PROGRAM,C,A) IF &STR(&FLD1) = ABEND THEN + SET FLDS = &STR(ABNDCODE,C,A) IF &STR(&FLD1) = JOB THEN + SET FLDS = &STR(JOBNAME,C,A) IF &STR(&FLD1) = &STR(SYS/USER) THEN + SET FLDS = &STR(SUFLAG,C,A) IF &STR(&FLD1) = &STR(IDMS/CODE) THEN + SET FLDS = &STR(IACODE,C,A) IF &STR(&FLD1) = DATE THEN + SET FLDS = &STR(CYCDATE,C,A) IF &STR(&FLD1) = SE THEN + SET FLDS = &STR(SEID,C,A) END IF &STR(&FLD2) > THEN + IF (&STR(&FLD2) ¬= PROGRAM AND + &STR(&FLD2) ¬= ABEND AND + &STR(&FLD2) ¬= JOB AND + &STR(&FLD2) ¬= &STR(SYS/USER) AND + &STR(&FLD2) ¬= &STR(IDMS/CODE) AND + &STR(&FLD2) ¬= DATE AND + &STR(&FLD2) ¬= SE) THEN + ISPEXEC SETMSG MSG(UTLZ001) ELSE + DO IF &STR(&FLD2) = PROGRAM THEN + SET FLDS = &STR(PROGRAM,C,A) IF &STR(&FLD2) = ABEND THEN + SET FLDS = &STR(ABNDCODE,C,A) IF &STR(&FLD2) = JOB THEN + SET FLDS = &STR(JOBNAME,C,A) IF &STR(&FLD2) = &STR(SYS/USER) THEN + SET FLDS = &STR(SUFLAG,C,A) IF &STR(&FLD2) = &STR(IDMS/CODE) THEN + SET FLDS = &STR(IACODE,C,A) IF &STR(&FLD2) = DATE THEN + SET FLDS = &STR(CYCDATE,C,A) IF &STR(&FLD2) = SE THEN + SET FLDS = &STR(SEID,C,A) END IF &STR(&FLD3) > THEN + IF (&STR(&FLD3) ¬= PROGRAM AND + &STR(&FLD3) ¬= ABEND AND + &STR(&FLD3) ¬= JOB AND + &STR(&FLD3) ¬= &STR(SYS/USER) AND + &STR(&FLD3) ¬= &STR(IDMS/CODE) AND + &STR(&FLD3) ¬= DATE AND + &STR(&FLD3) ¬= SE) THEN + ISPEXEC SETMSG MSG(UTLZ001) ELSE + DO IF &STR(&FLD3) = PROGRAM THEN + SET FLDS = &STR(PROGRAM,C,A) IF &STR(&FLD3) = ABEND THEN + SET FLDS = &STR(ABNDCODE,C,A) IF &STR(&FLD3) = JOB THEN + SET FLDS = &STR(JOBNAME,C,A) IF &STR(&FLD3) = &STR(SYS/USER) THEN + SET FLDS = &STR(SUFLAG,C,A) IF &STR(&FLD3) = &STR(IDMS/CODE) THEN + SET FLDS = &STR(IACODE,C,A) IF &STR(&FLD3) = DATE THEN + SET FLDS = &STR(CYCDATE,C,A) IF &STR(&FLD3) = SE THEN + SET FLDS = &STR(SEID,C,A) END IF &STR(&FLD4) > THEN + IF (&STR(&FLD4) ¬= PROGRAM AND + &STR(&FLD4) ¬= ABEND AND + &STR(&FLD4) ¬= JOB AND + &STR(&FLD4) ¬= &STR(SYS/USER) AND + &STR(&FLD4) ¬= &STR(IDMS/CODE) AND + &STR(&FLD4) ¬= DATE AND + &STR(&FLD4) ¬= SE) THEN + ISPEXEC SETMSG MSG(UTLZ001) ELSE + DO IF &STR(&FLD4) = PROGRAM THEN + SET FLDS = &STR(PROGRAM,C,A) IF &STR(&FLD4) = ABEND THEN + SET FLDS = &STR(ABNDCODE,C,A) IF &STR(&FLD4) = JOB THEN + SET FLDS = &STR(JOBNAME,C,A) IF &STR(&FLD4) = &STR(SYS/USER) THEN + SET FLDS = &STR(SUFLAG,C,A) IF &STR(&FLD4) = &STR(IDMS/CODE) THEN + SET FLDS = &STR(IACODE,C,A) IF &STR(&FLD4) = DATE THEN + SET FLDS = &STR(CYCDATE,C,A) IF &STR(&FLD4) = SE THEN + SET FLDS = &STR(SEID,C,A) END IF &STR(&FLD5) > THEN + IF (&STR(&FLD5) ¬= PROGRAM AND + &STR(&FLD5) ¬= ABEND AND + &STR(&FLD5) ¬= JOB AND + &STR(&FLD5) ¬= &STR(SYS/USER) AND + &STR(&FLD5) ¬= &STR(IDMS/CODE) AND + &STR(&FLD5) ¬= DATE AND + &STR(&FLD5) ¬= SE) THEN + ISPEXEC SETMSG MSG(UTLZ001) ELSE + DO IF &STR(&FLD5) = PROGRAM THEN + SET FLDS = &STR(PROGRAM,C,A) IF &STR(&FLD5) = ABEND THEN + SET FLDS = &STR(ABNDCODE,C,A) IF &STR(&FLD5) = JOB THEN + SET FLDS = &STR(JOBNAME,C,A) IF &STR(&FLD5) = &STR(SYS/USER) THEN + SET FLDS = &STR(SUFLAG,C,A) IF &STR(&FLD5) = &STR(IDMS/CODE) THEN + SET FLDS = &STR(IACODE,C,A) IF &STR(&FLD5) = DATE THEN + SET FLDS = &STR(CYCDATE,C,A) IF &STR(&FLD5) = SE THEN + SET FLDS = &STR(SEID,C,A) END IF &STR(&FLD6) > THEN + IF (&STR(&FLD6) ¬= PROGRAM AND + &STR(&FLD6) ¬= ABEND AND + &STR(&FLD6) ¬= JOB AND + &STR(&FLD6) ¬= &STR(SYS/USER) AND + &STR(&FLD6) ¬= &STR(IDMS/CODE) AND + &STR(&FLD6) ¬= DATE AND + &STR(&FLD6) ¬= SE) THEN + ISPEXEC SETMSG MSG(UTLZ001) ELSE + DO IF &STR(&FLD6) = PROGRAM THEN + SET FLDS = &STR(PROGRAM,C,A) IF &STR(&FLD6) = ABEND THEN + SET FLDS = &STR(ABNDCODE,C,A) IF &STR(&FLD6) = JOB THEN + SET FLDS = &STR(JOBNAME,C,A) IF &STR(&FLD6) = &STR(SYS/USER) THEN + SET FLDS = &STR(SUFLAG,C,A) IF &STR(&FLD6) = &STR(IDMS/CODE) THEN + SET FLDS = &STR(IACODE,C,A) IF &STR(&FLD6) = DATE THEN + SET FLDS = &STR(CYCDATE,C,A) IF &STR(&FLD6) = SE THEN + SET FLDS = &STR(SEID,C,A) END IF &STR(&FLD7) > THEN + IF (&STR(&FLD7) ¬= PROGRAM AND + &STR(&FLD7) ¬= ABEND AND + &STR(&FLD7) ¬= JOB AND + &STR(&FLD7) ¬= &STR(SYS/USER) AND + &STR(&FLD7) ¬= &STR(IDMS/CODE) AND + &STR(&FLD7) ¬= DATE AND + &STR(&FLD7) ¬= SE) THEN + ISPEXEC SETMSG MSG(UTLZ001) ELSE + DO IF &STR(&FLD7) = PROGRAM THEN + SET FLDS = &STR(PROGRAM,C,A) IF &STR(&FLD7) = ABEND THEN + SET FLDS = &STR(ABNDCODE,C,A) IF &STR(&FLD7) = JOB THEN + SET FLDS = &STR(JOBNAME,C,A) IF &STR(&FLD7) = &STR(SYS/USER) THEN + SET FLDS = &STR(SUFLAG,C,A) IF &STR(&FLD7) = &STR(IDMS/CODE) THEN + SET FLDS = &STR(IACODE,C,A) IF &STR(&FLD7) = DATE THEN + SET FLDS = &STR(CYCDATE,C,A) IF &STR(&FLD7) = SE THEN + SET FLDS = &STR(SEID,C,A) END IF &LENGTH(&STR(&FLDS)) > 0 THEN + DO ISPEXEC TBSORT ABENDLOG FIELDS(&STR(&FLDS) SET A = &EVAL(&SYSINDEX(&STR(,C,A),&STR(&STR(&FLDS)) - 1) SET A = &A - 1 SET LASTSORT = &SUBSTR(1:&A,&STR(&STR(&FLDS)) END END /*****************************/ /* MAINTAIN THE TOP OF TABLE */ /*****************************/ IF &LENGTH(&STR(&ZCMD)) = 0 THEN + DO ISPEXEC TBTOP ABENDLOG ISPEXEC TBSKIP ABENDLOG NUMBER(&ZTDTOP) ISPEXEC VGET (ZVERB ZSCROLLN) IF &STR(&ZVERB) = &STR(UP) THEN + ISPEXEC TBSKIP ABENDLOG NUMBER(-&ZSCROLLN) IF &STR(&ZVERB) = &STR(DOWN) THEN + ISPEXEC TBSKIP ABENDLOG NUMBER(&ZSCROLLN) END GOTO REDISP1 /******************************/ /* RE-DISPLAY THE NEW ELEMENT */ /******************************/ REDISP2: + ISPEXEC DISPLAY PANEL(ABENDLG2) IF &LASTCC = 8 THEN + DO ISPEXEC CONTROL DISPLAY RESTORE GOTO REDISP1 END ELSE + DO SET CYCDATE = &STR(&YY&MM&DD) ISPEXEC TBPUT ABENDLOG GOTO REDISP2 END IF &SAVECC > 7 THEN GOTO FINISH GOTO REDISP1 /*************************************************/ /* CLOSE THE ABENDLOG TABLE (SAVING THE CHANGES) */ /*************************************************/ FINISH: + ISPEXEC TBCLOSE ABENDLOG ISPEXEC LIBDEF ISPTABL EXIT HELPSEC: + 02480000 ISPEXEC SELECT PGM(ISPTUTOR) PARM(UTILH033) 02490000 SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR ABENDLOG UTILITY + 02490000 *** NO PROCESSING PERFORMED ***) 02490000 ISPEXEC SETMSG MSG(UTLZ000) 02490000 EXIT ./ ADD NAME=ABLINE PROC 0 /*** CHECK THE DEBUG SWITCH ***/ ISPEXEC VGET DBGSWTCH PROFILE IF &DBGSWTCH = ON THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS ISPEXEC CONTROL ERRORS RETURN /********************************************************************** /* UTILITY: ABLINE * /* AUTHOR: DAVID LEIGH * /* UTILITY: POINT TO THE LINE IN THE COBOL COMPILE LISTING WHICH * /* CONTAINED THE ABEND OR NEXT INSTRUCTION BASED ON THE * /* COBOL2 FORMATTED DUMP. * /********************************************************************** /********************************************************************** /* INITIAL CALL SIMPLY DEFINES A DATASET FOR THE SDSF PRINT COMMAND * /********************************************************************** IF &SYSDSN('&SYSUID..TEMP.ABEND') ¬= OK THEN + DO FREE DD(TEMPDD) ALLOC DD(TEMPDD) DSN('&SYSUID..TEMP.ABEND') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK005) + SPACE(1,1) TRACKS RELEASE + RECFM(F B) LRECL(255) BLKSIZE(23460) DSORG(PS) FREE DD(TEMPDD) EXIT END /********************************************************************** /* FIND THE INSTRUCTION OFFSET OR REAL LINE TO USE IN THE LISTING. * /********************************************************************** SET ZEDLMSG = &STR(*** PARSING THE CURRENT SDSF SCREEN ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) ISPEXEC EDIT DATASET('&SYSUID..TEMP.ABEND') MACRO(ABLINEM1) DELETE '&SYSUID..TEMP.ABEND' /********************************************************************** /* CHECK FOR ERROR MESSAGE AND GET OUT IF FOUND. * /********************************************************************** ISPEXEC VGET (ERRMSG PGMNAME) SHARED IF &STR(&ERRMSG) > THEN + DO SET ZEDLMSG = &STR(&ERRMSG) ISPEXEC SETMSG MSG(UTLZ001) EXIT END /********************************************************************** /* EDIT THE LISTING AND POINT TO THE PROPER LINE. * /********************************************************************** ISPEXEC EDIT DATASET('&SYSUID..COMPILE.LISTING.&PGMNAME') + MACRO(ABLINEM2) IF &LASTCC > 8 THEN + DO SET ZEDLMSG = &STR(UNABLE TO EDIT: + "&SYSUID..COMPILE.LISTING.&PGMNAME") ISPEXEC SETMSG MSG(UTLZ001) END EXIT ./ ADD NAME=ABLINEM1 ISREDIT MACRO ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /********************************************************************** /* UTILITY: ABLINEM1 * /* AUTHOR: DAVID LEIGH * /* FUNCTION: CALLED BY 'ABLINE' CLIST WHEN EDITING THE ABEND DATA * /* FROM SDSF TO FIND AN INSTRUCTION OFFSET OR A PROGRAM * /* LINE NUMBER. * /********************************************************************** /********************************************************************** /* PROCESS IF THIS IS THE $JES2LOG DATASET * /********************************************************************** ISREDIT FIND ' J E S 2 J O B L O G -- ' FIRST IF &LASTCC ¬= 0 THEN GOTO SYSDBOUT ISREDIT FIND ' SYMPTOM DUMP OUTPUT ' ISREDIT FIND PREV ' +' 20 ISREDIT LABEL .ZCSR = .B ISREDIT FIND PREV ' +IGZ' 20 ISREDIT LABEL .ZCSR = .A ISREDIT FIND FIRST ' IN ' .A .B SET CC1 = &LASTCC ISREDIT FIND NEXT ' PROGRAM ' .A .B SET CC2 = &LASTCC IF &CC1 = 0 AND &CC2 = 0 THEN + DO ISREDIT FIND NEXT "'" .A .B ISREDIT (LN1,CL1) = CURSOR SET CL1 = &CL1 + 1 ISREDIT CURSOR = &LN1 &CL1 ISREDIT FIND NEXT "'" .A .B ISREDIT (LN2,CL2) = CURSOR SET CL2 = &CL2 - 1 ISREDIT (LINE) = LINE .ZCSR SET PGMNAME = &SUBSTR(&CL1:&CL2,&STR(&SYSNSUB(1,&LINE))) END ISREDIT FIND FIRST ' RELATIVE ' .A .B SET CC1 = &LASTCC ISREDIT FIND NEXT ' LOCATION ' .A .B SET CC2 = &LASTCC IF &CC1 = 0 AND &CC2 = 0 THEN + DO ISREDIT FIND NEXT " X'" .A .B ISREDIT (LN1,CL1) = CURSOR SET CL1 = &CL1 + 3 ISREDIT CURSOR = &LN1 &CL1 ISREDIT FIND NEXT "'" .A .B ISREDIT (LN2,CL2) = CURSOR SET CL2 = &CL2 - 1 ISREDIT (LINE) = LINE .ZCSR SET RELLOC = &SUBSTR(&CL1:&CL2,&STR(&SYSNSUB(1,&LINE))) SET RELLOC = &SUBSTR(&LENGTH(&STR(000000&RELLOC))-5:+ &LENGTH(&STR(000000&RELLOC)),+ &STR(000000&RELLOC)) SET NEXTINS = SET LINENUM = SET ERRMSG = GOTO FINISH END ISREDIT FIND FIRST ' ON ' .A .B SET CC1 = &LASTCC ISREDIT FIND NEXT ' LINE ' .A .B SET CC2 = &LASTCC IF &CC1 = 0 AND &CC2 = 0 THEN + DO ISREDIT FIND NEXT "'" .A .B ISREDIT (LN1,CL1) = CURSOR SET CL1 = &CL1 + 1 ISREDIT CURSOR = &LN1 &CL1 ISREDIT FIND NEXT "'" .A .B ISREDIT (LN2,CL2) = CURSOR SET CL2 = &CL2 - 1 ISREDIT (LINE) = LINE .ZCSR SET RELLOC = SET NEXTINS = SET LINENUM = &SUBSTR(&CL1:&CL2,&STR(&SYSNSUB(1,&LINE))) SET ERRMSG = GOTO FINISH END SET RELLOC = SET NEXTINS = SET LINENUM = SET ERRMSG = &STR(NO ABEND INFO FOUND IN THE JESLOG. TRY SYSDBOUT.) GOTO FINISH /********************************************************************** /* PROCESS IF THIS IS THE SYSDBOUT DATASET * /********************************************************************** SYSDBOUT: + ISREDIT FIND ' VS COBOL II FORMATTED DUMP AT ABEND ' FIRST IF &LASTCC ¬= 0 THEN GOTO ERROR_SECTION ISREDIT FIND FIRST '0THE ABEND ADDRESS WAS OUTSIDE OF MAINLINE COBOL' IF &LASTCC = 0 THEN + DO SET RELLOC = SET NEXTINS = SET LINENUM = SET ERRMSG = &STR(NO ABEND INFO FOUND IN THE SYSDBOUT. + TRY $JES2LOG.) GOTO FINISH END ISREDIT FIND FIRST '0THE GP REGISTERS AT ENTRY TO ABEND WERE' ISREDIT FIND PREV P'=' 1 ISREDIT LABEL .ZCSR = .B ISREDIT FIND PREV '1PROGRAM = ' ISREDIT LABEL .ZCSR = .A ISREDIT FIND NEXT "'" .A .A ISREDIT (LN,PCL1) = CURSOR SET PCL1 = &PCL1 + 1 ISREDIT FIND NEXT "'" .A .A ISREDIT (LN,PCL2) = CURSOR SET PCL2 = &PCL2 - 1 ISREDIT (LINE) = LINE .ZCSR SET PGMNAME = &SUBSTR(&PCL1:&PCL2,&STR(&SYSNSUB(1,&LINE))) ISREDIT FIND '0THE RELATIVE ADDRESS OF THE NEXT INSTRUCTION' .A .B SET CC1 = &LASTCC ISREDIT FIND ':' .A .B SET CC2 = &LASTCC IF &CC1 = 0 AND &CC2 = 0 THEN + DO ISREDIT FIND NEXT "'" .A .B ISREDIT (LN1,CL1) = CURSOR SET CL1 = &CL1 + 3 ISREDIT CURSOR = &LN1 &CL1 ISREDIT FIND NEXT "'" .A .B ISREDIT (LN2,CL2) = CURSOR SET CL2 = &CL2 - 1 ISREDIT (LINE) = LINE .ZCSR SET RELLOC = SET NEXTINS = &SUBSTR(&CL1:&CL2,&STR(&SYSNSUB(1,&LINE))) SET LINENUM = SET ERRMSG = GOTO FINISH END SET RELLOC = SET NEXTINS = SET LINENUM = SET ERRMSG = &STR(NO ABEND INFO FOUND IN THE SYSDBOUT. TRY $JES2LOG.) SET PGMNAME = GOTO FINISH /********************************************************************** /* SET UP FOR AN ERROR WITH A MESSAGE * /********************************************************************** ERROR_SECTION: + ISREDIT FIND ' VS COBOL II FORMATTED DUMP AT ABEND ' FIRST IF &LASTCC ¬= 0 THEN GOTO ERROR_SECTION SET RELLOC = SET NEXTINS = SET LINENUM = SET ERRMSG = &STR(NO ABEND INFO FOUND. TRY THE JESLOG OR SYSDBOUT.) SET PGMNAME = GOTO FINISH /********************************************************************** /* STORE DATA IN THE SHARED POOL AND GET OUT * /********************************************************************** FINISH: + IF &STR(&PGMNAME) = AND + &STR(&ERRMSG) = THEN + DO WRITE WRITE UNABLE TO PARSE THE PROGRAM NAME FROM THIS PARTICULAR WRITE SDSF SCREEN. WRITE WRITENR PLEASE ENTER THE PROGRAM NAME HERE ==> READ PGMNAME END ISPEXEC VPUT (RELLOC NEXTINS LINENUM ERRMSG PGMNAME) SHARED ISREDIT END ./ ADD NAME=ABLINEM2 ISREDIT MACRO ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /********************************************************************** /* UTILITY: ABLINEM2 * /* AUTHOR: DAVID LEIGH * /* FUNCTION: CALLED BY 'ABLINE' CLIST WHEN EDITING THE COMPILE * /* LISTING FILE TO FIND THE APPROPRIATE DATA LINE OR AREA * /* IN WHICH AN ABEND OCCURRED. * /********************************************************************** /********************************************************************** /* PROCESSING MESSAGE * /********************************************************************** ISREDIT (DSN) = DATASET SET ZEDLMSG = &STR(*** FINDING THE INSTRUCTION IN "&DSN" ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) /********************************************************************** /* FIRST, FIND THE HEX XREF OF ALL THE VERBS OR THE PMAP * /********************************************************************** ISREDIT FIND FIRST ' LINE # HEXLOC VERB LINE' IF &LASTCC = 0 THEN ISREDIT (LN1,CL1) = CURSOR ISREDIT FIND FIRST ' START EQU * ' IF &LASTCC = 0 THEN ISREDIT (LN2,CL2) = CURSOR /********************************************************************** /* DETERMINE THE MODE OF PROCESSING * /********************************************************************** ISPEXEC VGET (RELLOC NEXTINS LINENUM) SHARED IF &STR(&RELLOC) > THEN GOTO RELATIVE_LOCATION IF &STR(&NEXTINS) > THEN GOTO NEXT_INSTRUCTION IF &STR(&LINENUM) > THEN GOTO LINE_NUMBER SET ZEDLMSG = &STR(MACRO ABLINEM2 CALLED WITHOUT PARAMETERS) ISPEXEC SETMSG MSG(UTLZ001) ISREDIT CANCEL /********************************************************************** /* NOW GET THE CODE HEX ADDRESS AND EQUATE IT TO A LINE ADDRESS. * /********************************************************************** LINE_NUMBER: + ISPEXEC VGET LINENUM SHARED SET COBLINE = &STR(&LINENUM) GOTO FINDLINE /********************************************************************** /* NOW GET THE CODE HEX ADDRESS AND EQUATE IT TO A LINE ADDRESS. * /********************************************************************** NEXT_INSTRUCTION: + ISPEXEC VGET NEXTINS SHARED IF &LN2 > 1 THEN + DO ISREDIT CURSOR = &LN2 &CL2 ISREDIT LABEL .ZCSR = .TOP ISREDIT FIND '&STR(&NEXTINS)' IF &LASTCC ¬= 0 THEN + DO SET ZEDLMSG = &STR(*** COULD NOT FIND LINE ADDRESS + "&NEXTINS" IN THE PMAP ***) ISPEXEC SETMSG MSG(UTLZ001) EXIT END ISREDIT (LN,CL) = CURSOR ISREDIT FIND FIRST P'=' 1 .ZCSR .ZCSR ISREDIT FIND PREV P' ...... ' &EVAL(&CL-1) ISREDIT (ALCLINE) = LINE .ZCSR SET ALCLINE = &SUBSTR(38:65,&STR(&SYSNSUB(1,&ALCLINE))) ISREDIT FIND PREV P' ###### .' 1 .TOP .ZCSR ISREDIT (COBLINE) = LINE .ZCSR SET COBLINE = &SUBSTR(2:7,&STR(&SYSNSUB(1,&COBLINE))) END ELSE + DO ISPEXEC SELECT PGM(HEX2DECP) PARM(&NEXTINS) ISPEXEC VGET DECNUM SHARED SET RELNUM = &DECNUM ISREDIT CURSOR = &LN1 &CL1 ISREDIT LABEL .ZCSR = .TA ISREDIT FIND LAST P' ###### ...... @' ISREDIT LABEL .ZCSR = .TB ISREDIT FIND FIRST P'###### ...... @' .TA .TB DO WHILE &LASTCC = 0 SET SS = &SS + 1 ISREDIT (LN&SS,CL&SS) = CURSOR ISREDIT FIND NEXT P'###### ...... @' .TA .TB END SET TLINEA = 1 SET TLINEB = &SS SET PREVSS = 0 SET PREVNUM = 0 SET PREVCOB = 0 NEXT_LOOP: + SET MIDSS = &EVAL(&TLINEA + ((&TLINEB - &TLINEA) / 2)) SET LN = &STR(&SYSNSUB(2,&&LN&MIDSS)) SET CL = &STR(&SYSNSUB(2,&&CL&MIDSS)) ISREDIT CURSOR = &LN &CL ISREDIT (LINE) = LINE .ZCSR SET CLINE = &SUBSTR(&CL:&CL+5,&STR(&LINE)) SET HLINE = &SUBSTR(&CL+7:&CL+12,&STR(&LINE)) ISPEXEC SELECT PGM(HEX2DECP) PARM(&STR(&HLINE)) ISPEXEC VGET DECNUM SHARED SELECT WHEN (&DECNUM = &RELNUM) DO ISREDIT FIND LAST '&STR(&HLINE)' .TA .TB ISREDIT (LN,CL) = CURSOR SET COBLINE = &SUBSTR(&CL-7:&CL-2,&STR(&LINE)) END WHEN (&PREVNUM < &RELNUM AND &EVAL(&MIDSS - &PREVSS) < 2) DO ISREDIT FIND LAST '&STR(&PREVHEX)' .TA .TB ISREDIT (LN,CL) = CURSOR SET COBLINE = &SUBSTR(&CL-7:&CL-2,&STR(&LINE)) END WHEN (&DECNUM < &RELNUM) DO SET PREVSS = &MIDSS SET PREVNUM = &DECNUM SET PREVHEX = &STR(&HLINE) SET TLINEA = &MIDSS GOTO NEXT_LOOP END WHEN (&DECNUM > &RELNUM) DO SET TLINEB = &MIDSS GOTO NEXT_LOOP END END END GOTO FINDLINE /********************************************************************** /* NOW GET THE CODE HEX ADDRESS AND EQUATE IT TO A LINE ADDRESS. * /********************************************************************** RELATIVE_LOCATION: + ISPEXEC VGET RELLOC SHARED IF &LN2 > 1 THEN + DO ISREDIT CURSOR = &LN2 &CL2 ISREDIT LABEL .ZCSR = .TOP ISREDIT FIND '&STR(&RELLOC)' IF &LASTCC ¬= 0 THEN + DO SET ZEDLMSG = &STR(*** COULD NOT FIND LINE ADDRESS + "&RELLOC" IN THE PMAP ***) ISPEXEC SETMSG MSG(UTLZ001) EXIT END ISREDIT (ALCLINE) = LINE .ZCSR SET ALCLINE = &SUBSTR(38:65,&STR(&SYSNSUB(1,&ALCLINE))) ISREDIT FIND PREV P' ###### .' 1 .TOP .ZCSR ISREDIT (COBLINE) = LINE .ZCSR SET COBLINE = &SUBSTR(2:7,&STR(&SYSNSUB(1,&COBLINE))) END ELSE + DO ISPEXEC SELECT PGM(HEX2DECP) PARM(&RELLOC) ISPEXEC VGET DECNUM SHARED SET RELNUM = &DECNUM ISREDIT CURSOR = &LN1 &CL1 ISREDIT LABEL .ZCSR = .TA ISREDIT FIND LAST P' ###### ...... @' ISREDIT LABEL .ZCSR = .TB ISREDIT FIND FIRST P'###### ...... @' .TA .TB DO WHILE &LASTCC = 0 SET SS = &SS + 1 ISREDIT (LN&SS,CL&SS) = CURSOR ISREDIT FIND NEXT P'###### ...... @' .TA .TB END SET TLINEA = 1 SET TLINEB = &SS SET PREVSS = 0 SET PREVNUM = 0 SET PREVCOB = 0 RELATIVE_LOOP: + SET MIDSS = &EVAL(&TLINEA + ((&TLINEB - &TLINEA) / 2)) SET LN = &STR(&SYSNSUB(2,&&LN&MIDSS)) SET CL = &STR(&SYSNSUB(2,&&CL&MIDSS)) ISREDIT CURSOR = &LN &CL ISREDIT (LINE) = LINE .ZCSR SET CLINE = &SUBSTR(&CL:&CL+5,&STR(&LINE)) SET HLINE = &SUBSTR(&CL+7:&CL+12,&STR(&LINE)) ISPEXEC SELECT PGM(HEX2DECP) PARM(&STR(&HLINE)) ISPEXEC VGET DECNUM SHARED SELECT WHEN (&DECNUM = &RELNUM) DO ISREDIT FIND LAST '&STR(&HLINE)' .TA .TB ISREDIT (LN,CL) = CURSOR SET COBLINE = &SUBSTR(&CL-7:&CL-2,&STR(&LINE)) END WHEN (&PREVNUM < &RELNUM AND &EVAL(&MIDSS - &PREVSS) < 2) DO ISREDIT FIND LAST '&STR(&PREVHEX)' .TA .TB ISREDIT (LN,CL) = CURSOR SET COBLINE = &SUBSTR(&CL-7:&CL-2,&STR(&LINE)) END WHEN (&DECNUM < &RELNUM) DO SET PREVSS = &MIDSS SET PREVNUM = &DECNUM SET PREVHEX = &STR(&HLINE) SET TLINEA = &MIDSS GOTO RELATIVE_LOOP END WHEN (&DECNUM > &RELNUM) DO SET TLINEB = &MIDSS GOTO RELATIVE_LOOP END END END /********************************************************************** /* POSITION THE USER ON THE CORRECT LINE AND GET OUT. * /********************************************************************** FINDLINE: + ISREDIT FIND FIRST ' &COBLINE ' 3 ISREDIT LINE_BEFORE .ZCSR = MSGLINE + '***************************************************+ *****************************' ISREDIT LINE_BEFORE .ZCSR = MSGLINE + '* THE FOLLOWING LINE CAUSED THE ABEND.' IF &STR(&ALCLINE) > THEN + ISREDIT LINE_BEFORE .ZCSR = MSGLINE + '* THE ASSEMBLER INSTRUCTION EXECUTED WAS: &STR(&ALCLINE)' ISREDIT LINE_BEFORE .ZCSR = MSGLINE + '***************************************************+ *****************************' ISREDIT UP 12 EXIT ./ ADD NAME=ACCUM PROC 0 AMT(10000) PER(12) PCT(1) REI(50) ISPEXEC VGET (DBGSWTCH) PROFILE /********************/ IF &DBGSWTCH = &STR(ON) THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH /********************/ ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /* 4. JUST DISPLAY */ FREE ATTRLIST(ATTRIB1) ATTRIB ATTRIB1 + RECFM(F B) + LRECL(80) + BLKSIZE(23440) + OUTPUT DELETE TEMP.ACCUM FREE DDNAME(OUTFILE) ALLOC DDNAME(OUTFILE) + DSN(TEMP.ACCUM) + NEW CATALOG + UNIT(SYSDA) + SPACE(5,5) TRACKS RELEASE + USING(ATTRIB1) OPENFILE OUTFILE OUTPUT SET X = 0 DO WHILE &X < &PER SET X = &X + 1 WRITE WORKING ON PERIOD &X SET DIV = (&AMT * &PCT) / 100 SET RINV = (&DIV * &REI) / 100 SET CASH = &DIV - &RINV SET RAMT = &AMT + &RINV SET OUTFILE = &STR(PERIOD=&X + ACCNT VALUE=&AMT + NEW ACCNT VALUE=&RAMT + CASH=&CASH) PUTFILE OUTFILE SET AMT = &RAMT END CLOSFILE OUTFILE FREE DDNAME(OUTFILE) FREE ATTRLIST(ATTRIB1) ISPEXEC EDIT DATASET(TEMP.ACCUM) EXIT ./ ADD NAME=ACFINFO /*** CHECK THE DEBUG SWITCH ***/ ISPEXEC VGET DBGSWTCH PROFILE IF &DBGSWTCH = ON THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS /********************************************************************** /* UTILITY: ACFINFO * /* AUTHOR: DAVID LEIGH * /* FUNCTION: PARSE THE INFORMATION MAINTATINED BY ACF2 USING THE ACF * /* TSO COMMAND PROCESSOR. ACFINFO RETURNS VARIABLES IN A * /* FEW DIFFERENT WAYS DEPENDING UPON IF ISPF IS ACTIVE AND * /* IF ACFINFO IS CALLED USING THE "BATCH" KEYWORD. * /* ISPF BATCH * /* ACTIVE KEYWORD * /* ------ ------- * /* YES YES SHARED POOL ISPF VARIABLES * /* NO YES CLIST "WRITE" LINES IN VAR = VALUE FORMAT* /* YES NO CLIST "WRITE" LINES AND ISPF VARIABLES * /* NO NO CLIST "WRITE" LINES * /* * /* * /* * /* * /* * /* * /********************************************************************** SET SYSOUTTRAP = 1000 ACF LIST * END SET SYSOUTTRAP = 0 CLEAR DO &I = 1 TO 14 SET LINE = &&SYSOUTLINE&I SET NPFX = &SUBSTR(01:22,&STR(&SYSNSUB(2,&LINE))) SET NPFX = &NPFX IF &STR(&NPFX) = THEN SET NPFX = &STR(&PFX) ELSE SET PFX = &STR(&NPFX) SET LEN = &LENGTH( &STR(&SYSNSUB(2,&LINE))) SET SFX = &SUBSTR(23:&LEN,&STR(&SYSNSUB(2,&LINE))) WRITE &SUBSTR(1:22,&STR(&NPFX ))+ &STR(&SFX) END EXIT SELECT (&STR(&PFX)) WHEN (&SYSUID) DO WRITE &SUBSTR(1:22,&STR(&PFX ))+ &STR(&SFX) END WHEN (PRIVILEGES) DO WRITE &SUBSTR(1:22,&STR(&PFX ))+ &STR(&SFX) END WHEN (ACCESS) DO WRITE &SUBSTR(1:22,&STR(&PFX ))+ &STR(&SFX) END WHEN (PASSWORD) DO WRITE &SUBSTR(1:22,&STR(&PFX ))+ &STR(&SFX) END WHEN (TSO) DO WRITE &SUBSTR(1:22,&STR(&PFX ))+ &STR(&SFX) END WHEN (STATISTICS) DO WRITE &SUBSTR(1:22,&STR(&PFX ))+ &STR(&SFX) END WHEN (CICS) DO WRITE &SUBSTR(1:22,&STR(&PFX ))+ &STR(&SFX) END WHEN (RESTRICTIONS) DO WRITE &SUBSTR(1:22,&STR(&PFX ))+ &STR(&SFX) END OTHERWISE DO WRITE &STR( )+ &STR(&SFX) END END END EXIT /* SET X = &SYSINDEX(&STR(D@UDAL),&STR(&LINE)) /* SET Y = &SYSINDEX(&STR( TSOACCT),&STR(&LINE)) /* IF &X = 2 THEN SET NAME = + /* &SUBSTR(33:&LENGTH(&STR(&LINE)),&STR(&LINE)) /* ELSE + /* IF &Y > 0 THEN + /* DO /* SET TSOACCT = &SUBSTR(&Y+9:&Y+17,&STR(&LINE)) /* SET X = &SYSINDEX(&STR(,),&STR(&TSOACCT)) /* SET COSTCTR = &SUBSTR(1:&X-1,&STR(&TSOACCT)) /* SET SYSOBOX = &SUBSTR(&X+1:&LENGTH(&STR(&TSOACCT)),+ /* &STR(&TSOACCT)) /* SET I = 2000 /* END /*D ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8 D@UDAL USCDENDPPND@UDAL DAVID A. LEIGH AGENCY(USC) DEPT(DP) LOC(DEN) SECT(PN) ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8 PRIVILEGES DUMPAUTH JOB TSO ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8 ACCESS ACC-CNT(863) ACC-DATE(01/06/92) ACC-SRCE(SW2D) ACC-TIME(10:57) ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8 PASSWORD MAXDAYS(30) MINDAYS(15) PSWD-DAT(01/02/92) PSWD-INV(0) PSWD-SRC(SW0P) PSWD-TIM(14:59) PSWD-TOD(12/30/91-08:18) PSWD-VIO(1) ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8 TSO DFT-PFX(D@UDAL) INTERCOM JCL LGN-RCVR MAIL NOTICES PAUSE PROMPT TSOACCT(1TMP,USTR) TSOPROC(@TSOPG) TSORGN(3,000) TSOSIZE(4,096) WTP ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8 STATISTICS UPD-TOD(01/06/92-10:57) ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8 CICS CICSID(DP) ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8 RESTRICTIONS PFX(D@UDAL) ....+....1....+....2....+....3....+....4....+....5....+....6....+....7....+....8 ./ ADD NAME=ADDCOL ISREDIT MACRO (COLUMN1,COLUMN2,COLUMN3) ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /**********************************************************************/ /* UTILITY NAME : ADDCOL */ /* DATE WRITTEN : 4-19-89 */ /* AUTHOR : DAVE LEIGH */ /* DESCRIPTION : ADD UP THE NUMBERS IN A COLUMN OF NUMBERS WITHIN A */ /* : FILE BEING EDITED IN ISPF */ /*========================== MODIFICATIONS ===========================*/ /* WHO ³WHEN ³WHY */ /* --- ³---- ³--- */ /* DAVE LEIGH ³3-26-90 ³ADDED CODE TO DETERMINE THE NUMBERING MODE */ /* ³ ³TO SEE IF IT'S COBOL OR NOT BECAUSE THIS */ /* ³ ³AFFECTS THE COLUMNS THAT ARE RETURNED TO */ /* ³ ³THE MACRO FOR COMPUTATION. */ /**********************************************************************/ IF &LENGTH(&STR(&COLUMN2)) = 0 THEN + IF &STR(&COLUMN1) = &STR(HELP) THEN GOTO HELPSEC ELSE + DO SET ZEDSMSG = &STR(2ND COLUMN MISSING) SET ZEDLMSG = &STR(YOU MUST PASS A BEGINNING AND ENDING + COLUMN # TO THE ADDCOL MACRO (E.G. " + ADDCOL 35 40")) ISPEXEC SETMSG MSG(UTLZ001) EXIT END IF &LENGTH(&STR(&COLUMN3)) > 0 AND + &COLUMN1 > &COLUMN3 AND + &COLUMN3 > &COLUMN2 THEN + DO SET ZEDLMSG = &STR(THE DECIMAL POINT COLUMN MUST BE > THE 1ST + COLUMN AND < THE 2ND COLUMN) ISPEXEC SETMSG MSG(UTLZ001) EXIT END ISREDIT (NUMVAR1,NUMVAR2) = NUMBER IF &NUMVAR2 = &STR(NOSTD COBOL NODISPL) THEN + DO SET COLUMN1 = &COLUMN1 - 6 SET COLUMN2 = &COLUMN2 - 6 IF &STR(&COLUMN3) > THEN SET COLUMN3 = &COLUMN3 - 6 END ISREDIT (SLINE,SCOL) = CURSOR SET COUNT = 0 SET NUMCOUNT = 0 SET CHARCOUNT = 0 SET AMOUNT = 0 ISREDIT CURSOR = 1 0 SET SAVECC = 0 ISREDIT FIND NEXT P'=' 1 X SET SAVECC = &LASTCC SET XCOLUMN1 = 1 SET XCOLUMN2 = &COLUMN2 - &COLUMN1 + 1 SET XCOLUMN3 = &COLUMN3 - &COLUMN1 + 1 SET LENDATA = &COLUMN2 - &COLUMN1 + 1 DO WHILE &SAVECC = 0 ISREDIT (DATA) = LINE .ZCSR SET XDATA = &SUBSTR(&COLUMN1:&COLUMN2,&STR(&SYSNSUB(1,&DATA))) SET NDX = 1 DO WHILE &NDX <= &LENDATA IF &SYSINDEX(&STR( ),&STR(&SYSNSUB(1,&XDATA))) = &NDX THEN + DO SET A = &NDX - 1 SET B = &NDX + 1 SET XDATA1 = SET XDATA2 = IF &A > 0 THEN + SET XDATA1 = &SUBSTR(1:&A,&STR(&SYSNSUB(1,&XDATA))) IF &B <= &LENDATA THEN + SET XDATA2 = &SUBSTR(&B:&LENDATA,+ &STR(&SYSNSUB(1,&XDATA))) SET XDATA = &STR(&SYSNSUB(1,&XDATA1))+ &STR(0)+ &STR(&SYSNSUB(1,&XDATA2)) END SET NDX = &NDX + 1 END IF &LENGTH(&STR(&COLUMN3)) > 0 THEN + DO SET A = &XCOLUMN3 - 1 SET B = &XCOLUMN3 + 1 SET XDATA1 = &SUBSTR(&XCOLUMN1:&A,&STR(&XDATA)) SET XDATA2 = &SUBSTR(&B:&XCOLUMN2,&STR(&XDATA)) SET XDATA = &STR(&XDATA1)&STR(&XDATA2) END ELSE SET XDATA = &SUBSTR(&XCOLUMN1:&XCOLUMN2,&STR(&XDATA)) IF &DATATYPE(&STR(&XDATA)) = CHAR THEN + SET CHARCOUNT = &CHARCOUNT + 1 ELSE + DO SET NUMCOUNT = &NUMCOUNT + 1 SET AMOUNT = &AMOUNT + &XDATA END SET COUNT = &COUNT + 1 ISREDIT FIND NEXT P'=' 1 X SET SAVECC = &LASTCC END ISREDIT CURSOR = &SLINE &SCOL IF &COUNT = 0 THEN + DO SET ZEDLMSG = &STR(LINES TO BE ACCUMULATED MUST BE "EXCLUDED" + WITH AN "X" IN THE LINE NUMBER) ISPEXEC SETMSG MSG(UTLZ001) END ELSE + DO IF &LENGTH(&STR(&COLUMN3)) > 0 THEN + DO SET POINT = &COLUMN2 - &COLUMN3 SET LENAMT = &LENGTH(&STR(&AMOUNT)) SET POINT = &LENAMT - &POINT SET AMT1 = &SUBSTR(1:&POINT,&STR(&AMOUNT)) SET POINT = &POINT + 1 SET AMT2 = &SUBSTR(&POINT:&LENAMT,&STR(&AMOUNT)) SET AMOUNT = &STR(&AMT1).&STR(&AMT2) END SET ZEDSMSG = &STR(TOTAL AMT = &AMOUNT) SET ZEDLMSG = &STR(TOTAL LINES READ = &COUNT NON-NUMERIC + = &CHARCOUNT NUMERIC = &NUMCOUNT + TOTAL AMOUNT = &AMOUNT) ISPEXEC SETMSG MSG(UTLZ000) ISPEXEC VGET ADDCOL SHARED IF &STR(&ADDCOL) = BATCH THEN + DO SET ADDCOL = &STR(&AMOUNT) ISPEXEC VPUT ADDCOL SHARED END END EXIT CODE(&MAXCC) HELPSEC: + WRITE *** HELP FOR EDIT MACRO 'ADDCOL' *** WRITE WRITE THE 'ADDCOL' EDIT MACRO WILL AUTOMATICALLY ADD UP A COLUMN OF WRITE NUMBERS IN A BLOCK OF LINES IN A COLUMN THAT YOU ARE EDITING. WRITE THE EDIT MACRO WILL TAKE INTO ACCOUNT ZERO-FILLING WHERE NECESSARY WRITE AND ANY NON-NUMERIC LINES THAT MAY FALL INTO THE SELECTED BLOCK OF WRITE LINES. IF THERE ARE DECIMAL POINTS, AN ADDITIONAL PARAMETER MAY WRITE BE PASSED TO THE MACRO TO TAKE THEM INTO ACCOUNT. POSSIBLE USES WRITE FOR THIS MACRO INCLUDE ADDING UP A COLUMN OF NUMBERS IN A REPORT WRITE OR EXTRACT FILE, OR ADDING UP FILE OR PRINT LINE LAYOUTS IN A WRITE PROGRAM. THE BASIC METHOD OF USING IT IS TO DETERMIN THE COLUMNS WRITE IN THE FILE THAT BEGIN AND END THE NUMERIC AREA TO ACCUMULATE WRITE (THIS CAN BE ACCOMPLISED VIA THE "COLS" EDIT LINE COMMAND). THEN WRITE "EXCLUDE" THE BLOCK OF LINES TO BE ACCUMULATED. (THIS CAN BE WRITE ACCOMPLISHED VIA THE "X" OR "XX" EDIT LINE COMMANDS). THEN INVOKE WRITE THE MACRO AS FOLLOWS: (THE OUTPUT IS AN ISPF MESSAGE LINE). WRITE WRITE BASIC SYNTAX : WRITE WRITE COMMAND ===> ADDCOL 1 3 2 WRITE (WHERE "1" = BEGINNING COLUMN OF NUMERIC AREA TO ACCUMULATE) WRITE (WHERE "3" = ENDING COLUMN OF NUMERIC AREA TO ACCUMULATE) WRITE (WHERE "2" IS AN OPTIONAL PARAMETER INDICATING THE COLUMN POSITION WRITE OF THE DECIMAL POINT IN THIS NUMERIC AREA...IF THERE IS ONE) WRITE WRITE EXAMPLE #1 WRITE WRITE COMMAND ===> ADDCOL 10 12 WRITE ****** ***************************** TOP OF DATA ***************** WRITE =COLS> ....+....1....+....2....+....3....+....4....+....5....+.... WRITE XX0100 111 WRITE 000200 111 WRITE 000300 111 WRITE 000400 111 WRITE XX0500 111 WRITE ****** **************************** BOTTOM OF DATA *************** WRITE WRITE MESSAGE AFTER COMMAND EXECUTION : WRITE WRITE COMMAND ===> WRITE TOTAL LINES READ = 5 NON-NUM = 0 NUM = 5 TOTAL AMOUNT = 555 WRITE =COLS> ....+....1....+....2....+....3....+....4....+....5....+.... WRITE 000100 111 WRITE 000200 111 WRITE 000300 111 WRITE 000400 111 WRITE 000500 111 WRITE ****** **************************** BOTTOM OF DATA *************** WRITE WRITE EXAMPLE #2 - NUMBERS WITH DECIMAL POINTS WRITE WRITE COMMAND ===> ADDCOL 10 15 13 WRITE ****** ***************************** TOP OF DATA ***************** WRITE =COLS> ....+....1....+....2....+....3....+....4....+....5....+.... WRITE XX0100 111.11 WRITE 000200 111.11 WRITE 000300 111.11 WRITE 000400 111.11 WRITE XX0500 111.11 WRITE ****** **************************** BOTTOM OF DATA *************** WRITE WRITE MESSAGE AFTER COMMAND EXECUTION : WRITE WRITE COMMAND ===> WRITE TOTAL LINES READ = 5 NON-NUM = 0 NUM = 5 TOTAL AMOUNT = 555.55 WRITE =COLS> ....+....1....+....2....+....3....+....4....+....5....+.... WRITE 000100 111.11 WRITE 000200 111.11 WRITE 000300 111.11 WRITE 000400 111.11 WRITE 000500 111.11 WRITE ****** **************************** BOTTOM OF DATA *************** WRITE WRITE EXAMPLE #3 - NUMBERS WITH DECIMAL POINTS AND LETTING THE "ADDCOL" WRITE MACRO "ZERO FILL" SPACES WHERE NECESSARY. WRITE WRITE COMMAND ===> ADDCOL 10 15 13 WRITE ****** ***************************** TOP OF DATA ***************** WRITE =COLS> ....+....1....+....2....+....3....+....4....+....5....+.... WRITE XX0100 111.1 WRITE 000200 111. WRITE 000300 111 WRITE 000400 11.11 WRITE XX0500 1 WRITE ****** **************************** BOTTOM OF DATA *************** WRITE WRITE MESSAGE AFTER COMMAND EXECUTION : WRITE WRITE COMMAND ===> WRITE TOTAL LINES READ = 5 NON-NUM = 0 NUM = 5 TOTAL AMOUNT = 345.21 WRITE =COLS> ....+....1....+....2....+....3....+....4....+....5....+.... WRITE 000100 111.1 WRITE 000200 111. WRITE 000300 111 WRITE 000400 11.11 WRITE 000500 1 WRITE ****** **************************** BOTTOM OF DATA *************** WRITE WRITE EXAMPLE #4 - NUMBERS WITH DECIMAL POINTS AND LETTING THE "ADDCOL" WRITE MACRO "ZERO FILL" SPACES WHERE NECESSARY AND INTER- WRITE SPERSING NON-NUMERIC DATA LINES WITHIN THE BLOCK OF WRITE NUMERIC DATA LINES. WRITE WRITE COMMAND ===> ADDCOL 10 15 13 WRITE ****** ***************************** TOP OF DATA ***************** WRITE =COLS> ....+....1....+....2....+....3....+....4....+....5....+.... WRITE XX0100 111.11 WRITE 000200 XXXXXXXXXX WRITE 000300 111 WRITE 000400 XXXXXXXXXXX WRITE XX0500 1 WRITE ****** **************************** BOTTOM OF DATA *************** WRITE WRITE MESSAGE AFTER COMMAND EXECUTION : (NOTICE DIFFERENCE IN COUNTS OF WRITE NUMERIC AND NON-NUMERIC LINES.) WRITE WRITE COMMAND ===> WRITE TOTAL LINES READ = 5 NON-NUM = 2 NUM = 3 TOTAL AMOUNT = 223.11 WRITE =COLS> ....+....1....+....2....+....3....+....4....+....5....+.... WRITE 000100 111.11 WRITE 000200 XXXXXXXXXX WRITE 000300 111 WRITE 000400 XXXXXXXXXXX WRITE 000500 1 WRITE ****** **************************** BOTTOM OF DATA *************** WRITE WRITE EXAMPLE #5 - PRACTICAL USE FOR ADDING UP RECORD LAYOUTS. WRITE WRITE COMMAND ===> ADDCOL 44 45 WRITE ****** ***************************** TOP OF DATA ***************** WRITE =COLS> ....+....1....+....2....+....3....+....4....+....5....+.... WRITE 000100 01 PRINT-LINE-1. WRITE XX0200 05 PRINT-DATE PIC 9(06) WRITE 000300 VALUE ZEROS. WRITE 000200 05 FILLER PIC X(20) WRITE 000300 VALUE SPACES. WRITE 000200 05 FILLER PIC X(29) WRITE 000300 VALUE 'THIS IS THE LONG REPORT TITLE'. WRITE 000200 05 FILLER PIC X(21) WRITE 000300 VALUE ' PAGE '. WRITE XX0200 05 PRINT-PAGE PIC 9(04) WRITE 000300 VALUE ZEROS. WRITE ****** **************************** BOTTOM OF DATA *************** WRITE WRITE MESSAGE AFTER COMMAND EXECUTION : (NOTICE THAT ONLY THE REPORT WRITE TITLE IS CONSIDERED NON-NUMERIC WRITE IN THIS GROUP OF LINES. THAT WRITE IS BECAUSE THE LINES IN WHICH WRITE COLUMNS 44 AND 45 BOTH CONTAIN WRITE SPACES ARE "ZERO-FILLED" AND WRITE AND THUS BECOME THE NUMERIC WRITE VALUE '00'. WRITE WRITE COMMAND ===> WRITE TOTAL LINES READ = 9 NON-NUM = 1 NUM = 8 TOTAL AMOUNT = 80 WRITE =COLS> ....+....1....+....2....+....3....+....4....+....5....+.... WRITE 000100 01 PRINT-LINE-1. WRITE XX0200 05 PRINT-DATE PIC 9(06) WRITE 000300 VALUE ZEROS. WRITE 000400 05 FILLER PIC X(20) WRITE 000500 VALUE SPACES. WRITE 000600 05 FILLER PIC X(29) WRITE 000700 VALUE 'THIS IS THE LONG REPORT TITLE'. WRITE 000800 05 FILLER PIC X(21) WRITE 000900 VALUE ' PAGE '. WRITE XX1000 05 PRINT-PAGE PIC 9(04) WRITE 001100 VALUE ZEROS. WRITE ****** **************************** BOTTOM OF DATA *************** WRITE WRITE SPECIAL NOTES : MORE INFORMATION ON "EXCLUDING" LINES CAN BE FOUND WRITE BY TYPING "HELP" FROM ANY ISPF "EDIT" SESSION AND WRITE CHOOSING OPTION "11 EDIT LINE COMMANDS". WRITE WRITE ADDCOL WILL ONLY ZERO-FILL "SPACES" IN THE WRITE SPECIFIED COLUMNS. THEREFORE, THE FOLLOWING WRITE NUMBERS WOULD NOT BE ADDED CORRECTLY : WRITE WRITE COMMAND ===> ADDCOL 10 15 13 WRITE ****** ***************************** TOP OF DATA ***************** WRITE =COLS> ....+....1....+....2....+....3....+....4....+....5....+.... WRITE XX0100 $111.11 WRITE 000200 $11.11 WRITE 000300 $1.11 WRITE 000400 111.1X WRITE XX0500 1 WRITE ****** **************************** BOTTOM OF DATA *************** WRITE WRITE ONLY LINES 000100, AND 000500 ABOVE WOULD BE CONSIDERED WRITE NUMERIC AND WOULD BE ADDED. WRITE WRITE *** END OF HELP *** NO PROCESSING PERFORMED *** EXIT ./ ADD NAME=ADDNOTE PROC 0 HELP /**********************************************************************/ /* UTILITY NAME : ADDNOTE */ /* AUTHOR : DAVID LEIGH */ /* FUNCTION : ADD TECHNOTE TABLE ENTRIES FOR MEMBERS WHICH ALREADY*/ /* EXIST IN A GIVEN GROUP'S TECHNOTE LIBRARY. */ /**********************************************************************/ /**** 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 /********************************************************************** /* (RE)INITIALIZE THE VARIABLES. * /********************************************************************** ISPEXEC SELECT CMD(%TECHLIST GETGROUP) ISPEXEC VGET GROUPS SHARED REMAP: + SET BAMBR = SET BAGROUP = SET BADESC = /********************************************************************** /* DISPLAY THE PANEL AND GET USER INPUT. * /********************************************************************** DISPLAY: + ISPEXEC DISPLAY PANEL(ADDNOTE) IF &LASTCC > 7 THEN EXIT ISPEXEC VPUT (BAMBR BAGROUP BADESC) SHARED ISPEXEC SELECT CMD(%TECHLIST BATCH) SET TECHCC = &LASTCC SELECT (&TECHCC) WHEN (12) DO SET ZEDLMSG = &STR(COULD NOT OPEN THE TECHNOTE TABLE. + PLEASE TRY LATER.) ISPEXEC SETMSG MSG(UTLZ001) GOTO DISPLAY END WHEN (16) DO SET ZEDLMSG = &STR(SEVERE ERROR TRYING TO ACCESS THE TECHNOTE + TABLE. PLEASE NOTIFY TECH SERVICES.) ISPEXEC SETMSG MSG(UTLZ001) GOTO DISPLAY END OTHERWISE DO SET ZEDLMSG = &STR(ADD TO TECHNOTE LIST SUCCESSFUL) ISPEXEC SETMSG MSG(UTLZ000) GOTO PREMAP END END ./ ADD NAME=ADDRESS /********************************************************************** /* UTILITY: ADDRESS * /* AUTHOR: DAVID LEIGH * /* FUNCTION: THIS CLIST CONTROLS A TABLE DISPLAY OF ADDRESSES. * /********************************************************************** PROC 0 SKELLIB(&SYSPREF..ADDRESS.ISPSLIB) + ISPFPFX(&SYSPREF..STR) /*** CHECK THE DEBUG SWITCH ***/ ISPEXEC VGET DBGSWTCH PROFILE IF &DBGSWTCH = ON THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS ISPEXEC CONTROL ERRORS RETURN /*********************************************************************** /* OPEN ADDRESS TABLE * /*********************************************************************** ISPEXEC TBOPEN ADDRESS NOWRITE SELECT (&LASTCC) WHEN (8) DO ISPEXEC TBCREATE ADDRESS WRITE SHARE KEYS() + NAMES(ID1 ID2 FNAME1 FNAME2 LNAME1 LNAME2 MAIDEN1 + MAIDEN2 ADDRESS1 ADDRESS2 CITY STATPROV ZIPPOST + COUNTRY PHONE1 PHONE2 CATEGORY LETTER INCAREOF + ICOADDR1 ICOADDR2 ICOCITY ICOSTATE ICOZIP + ICOCNTRY ICOPHONE NOTE1 NOTE10 NOTE2 NOTE3 NOTE4 + NOTE5 NOTE6 NOTE7 NOTE8 NOTE9 LUID LUDATE LUTIME) ISPEXEC TBCLOSE ADDRESS REPLCOPY ISPEXEC TBOPEN ADDRESS NOWRITE END WHEN (12) DO ISPEXEC TBSTATS ADDRESS STATUS2(TABSTAT) IF &STR(&TABSTAT) = 1 THEN GOTO OPEN_CONTINUE SET ZEDLMSG = &STR(ATTEMPTING TO ACCESS THE ADDRESS ISPF + TABLE) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ001W) ISPEXEC TBOPEN ADDRESS NOWRITE SET OPENCC = &LASTCC DO &I = 1 TO 30 WHILE &OPENCC ¬= 0 ISPEXEC TBOPEN ADDRESS NOWRITE SET OPENCC = &LASTCC END IF &OPENCC ¬= 0 THEN + DO SET ZEDLMSG = &STR(UNABLE TO ACCESS ADDRESS ISPF + TABLE. PLEASE TRY LATER) ISPEXEC SETMSG MSG(UTLZ001) EXIT CODE(12) END END WHEN (16 | 20) DO SET ZELDMSG = &STR(SEVERE ERROR ATTEMPTING TO ACCESS + ADDRESS ISPF TABLE. NOTIFY TECH SUPPORT) ISPEXEC SETMSG MSG(UTLZ001) EXIT CODE(16) END END /******************************************************/ /* SET THE KEYS, NAMES AND INITIAL LASTSORT VARIABLES */ /******************************************************/ OPEN_CONTINUE: + ISPEXEC TBQUERY ADDRESS KEYS(TBKEYS) NAMES(TBNAMES) IF &STR(&TBKEYS) > THEN + SET TBKEYS = &SUBSTR(2:&EVAL(&LENGTH(&STR(&TBKEYS)) - 1),+ &STR(&TBKEYS)) SET TBNAMES = &SUBSTR(2:&EVAL(&LENGTH(&STR(&TBNAMES)) - 1),+ &STR(&TBNAMES)) SET ALLNAMES = &STR(&TBKEYS &TBNAMES) SET LASTSORT = LNAME1 SET SPACE = &STR( ) /************************/ /* MAIN PROCESSING LOOP */ /************************/ /*****************************************************/ /* DISPLAY THE MEMBER LIST AND SAVE THE RETURN CODE */ /*****************************************************/ REDISPLAY: + ISPEXEC TBDISPL ADDRESS PANEL(ADDRESS) SET SAVECC = &LASTCC IF &SAVECC > 8 THEN + DO SET ZEDLMSG = &STR(PROBABLE MAIN PANEL ERROR. TBDISPL + RC = &SAVECC) ISPEXEC SETMSG MSG(UTLZ001) GOTO FINISH END /*************************************************/ /* DO PROCESSING FOR PENDING SELECTED ROWS FIRST */ /*************************************************/ IF &ZTDSELS ¬= &STR(0000) THEN + DO ISPEXEC CONTROL DISPLAY SAVE SELDIS: DO WHILE &ZTDSELS ¬= &STR(0000) IF &STR(&ZSEL) = THEN SET ZSEL = C SELECT (&ZSEL) WHEN (D) DO DELETE_LINE_SEC: ISPEXEC SELECT CMD(%YOUSURE COLUMN(26) ROW(1)) IF &LASTCC > 0 THEN GOTO LINE_LOOP ISPEXEC TBSKIP ADDRESS NUMBER(0) POSITION(CRP) ISPEXEC TBEND ADDRESS IF &ZTDSELS > 0001 THEN + DO SET ZEDLMSG = &STR(AN "UPDATE-TYPE" LINE + COMMAND PRECLUDED THE + PROCESSING OF YOUR + SUBSEQUENT LINE + COMMANDS) ISPEXEC SETMSG MSG(UTLZ001) END SET ZTDSELS = &STR(0000) ISPEXEC LIBDEF ISPTABL + DATASET ID('&ISPFPFX..ISPTLIB') ISPEXEC TBOPEN ADDRESS WRITE SET OPENCC = &LASTCC DO &I = 1 TO 30 WHILE &OPENCC ¬= 0 ISPEXEC TBOPEN ADDRESS WRITE SET OPENCC = &LASTCC END IF &OPENCC = 0 THEN + DO ISPEXEC TBSKIP ADDRESS NUMBER(&CRP) ISPEXEC TBDELETE ADDRESS ISPEXEC TBCLOSE ADDRESS ISPEXEC TBOPEN ADDRESS NOWRITE END ELSE + DO SET ZEDLMSG = &STR(UNABLE TO OPEN THE + ADDRESS ISPF TABLE FOR + UPDATE. PLEASE TRY + LATER.) ISPEXEC SETMSG MSG(UTLZ001W) ISPEXEC TBOPEN ADDRESS NOWRITE END ISPEXEC CONTROL DISPLAY RESTORE GOTO SCROLL END WHEN (C) DO CHANGE_LINE_SEC: ISPEXEC VPUT (&STR(&ALLNAMES)) SHARED ISPEXEC TBGET ADDRESS POSITION(CRP) ISPEXEC TBEND ADDRESS IF &ZTDSELS > 0001 THEN + DO SET ZEDLMSG = &STR(AN "UPDATE-TYPE" LINE + COMMAND PRECLUDED THE + PROCESSING OF YOUR + SUBSEQUENT LINE + COMMANDS) ISPEXEC SETMSG MSG(UTLZ001) END SET ZTDSELS = &STR(0000) ISPEXEC LIBDEF ISPTABL + DATASET ID('&ISPFPFX..ISPTLIB') ISPEXEC TBOPEN ADDRESS WRITE SET OPENCC = &LASTCC DO &I = 1 TO 30 WHILE &OPENCC ¬= 0 ISPEXEC TBOPEN ADDRESS WRITE SET OPENCC = &LASTCC END IF &OPENCC = 0 THEN + DO ISPEXEC TBSKIP ADDRESS NUMBER(&CRP) ISPEXEC VGET (&STR(&ALLNAMES)) SHARED SET LUID = &STR(&SYSUID) SET LUDATE = &STR(&SYSSDATE) SET LUTIME = &STR(&SYSTIME) ISPEXEC TBPUT ADDRESS ISPEXEC TBCLOSE ADDRESS ISPEXEC TBOPEN ADDRESS NOWRITE END ELSE + DO SET ZEDLMSG = &STR(UNABLE TO OPEN THE + ADDRESS ISPF TABLE + FOR UPDATE. PLEASE + TRY LATER.) ISPEXEC SETMSG MSG(UTLZ001W) ISPEXEC TBOPEN ADDRESS NOWRITE END ISPEXEC CONTROL DISPLAY RESTORE GOTO SCROLL END OTHERWISE DO LINE_COMMANDS: ISPEXEC TBEND ADDRCMDS ISPEXEC TBCREATE ADDRCMDS NOWRITE REPLACE KEYS() + NAMES(ADCMD ADCMDDES) SET ADCMD = &STR(C ) /******************/ SET ADCMDDES = + &STR(CHANGE THE INFORMATION ASSOCIATED WITH A GIVEN ADDRESS ) ISPEXEC TBADD ADDRCMDS SET ADCMD = &STR(D ) /******************/ SET ADCMDDES = + &STR(DELETE AN ADDRESS. ) ISPEXEC TBADD ADDRCMDS ISPEXEC TBTOP ADDRCMDS SET ZWINTTL = &STR(VALID LINE COMMANDS...PF3 TO RETURN...+ PF7/8 TO SCROLL) SET ZTDMARK = &STR(*** END OF VALID LINE COMMANDS ***) /* ISPEXEC ADDPOP ROW(3) COLUMN(8) ISPEXEC CONTROL DISPLAY SAVE /* FIXPOP */ LINE_CMDLOOP: ISPEXEC TBDISPL ADDRCMDS PANEL(ADDRCMDS) IF &LASTCC = 0 THEN GOTO LINE_CMDLOOP /* ISPEXEC REMPOP ISPEXEC CONTROL DISPLAY RESTORE /* FIXPOP */ END END LINE_LOOP: IF &ZTDSELS > &STR(0001) THEN + DO ISPEXEC CONTROL DISPLAY RESTORE ISPEXEC TBDISPL ADDRESS ISPEXEC CONTROL DISPLAY SAVE END ELSE + DO SET ZTDSELS = &STR(0000) ISPEXEC CONTROL DISPLAY RESTORE END END END /***************************************/ /* PROCESS USERS PENDING 'END' COMMAND */ /***************************************/ IF &SAVECC = 8 THEN GOTO FINISH /************************************************/ /* GOTO THE PROPER SECTION BASED ON THE COMMAND */ /************************************************/ IF &STR(&ZCMD) = THEN GOTO SCROLL SET SYSDVAL = &STR(&ZCMD) READDVAL ZCMD OPT1 OPT2 OPT3 OPT4 OPT5 OPT6 OPT7 OPT8 OPT9 OPT10 SELECT (&SYSCAPS(&STR(&ZCMD))) WHEN (E | ED | EDI | EDIT) GOTO EDIT_SECTION WHEN (I | INS | INSERT | A | AD | ADD) GOTO INSERT_SECTION WHEN (L | LO | LOC | LOCA | LOCAT | LOCATE) GOTO LOCATE_SECTION WHEN (O | OR | ORD | ORDE | ORDER | SORT) GOTO SORT_SECTION WHEN (R | REP | REPORT | DUMP | PRINT) GOTO REPORT_SECTION OTHERWISE DO PRIM_COMMANDS: + ISPEXEC TBEND ADDRCMDS ISPEXEC TBCREATE ADDRCMDS NOWRITE REPLACE KEYS() + NAMES(ADCMD ADCMDDES) SET ADCMD = &STR(EDIT ) /***********************************/ SET ADCMDDES = + &STR(ALIASES: "E" "ED" "EDI" ) ISPEXEC TBADD ADDRCMDS SET ADCMD = SET ADCMDDES = + &STR(PARAMETERS: A ADDRESS SKELETON MEMBER NAME OR BLANK FOR A ) ISPEXEC TBADD ADDRCMDS SET ADCMDDES = + &STR( MEMBER SELECTION LIST. ) ISPEXEC TBADD ADDRCMDS SET ADCMDDES = + &STR(FUNCTIONS: EDIT AN ISPF SKELETON WHICH IS STORED IN DSN: ) ISPEXEC TBADD ADDRCMDS SET ADCMDDES = + &STR( "&SKELLIB") ISPEXEC TBADD ADDRCMDS SET ADCMD = &STR(INSERT ) /***********************************/ SET ADCMDDES = + &STR(ALIASES: "I" "INS" "A" "AD" "ADD" ) ISPEXEC TBADD ADDRCMDS SET ADCMD = SET ADCMDDES = + &STR(PARAMETERS: NONE) ISPEXEC TBADD ADDRCMDS SET ADCMDDES = + &STR(FUNCTIONS: INSERT A NEW ADDRESS TABLE ROW ) ISPEXEC TBADD ADDRCMDS SET ADCMD = &STR(LOCATE ) /***********************************/ SET ADCMDDES = + &STR(ALIASES: "L" "LO" "LOC" "LOCA" "LOCAT" ) ISPEXEC TBADD ADDRCMDS SET ADCMD = SET ADCMDDES = + &STR(PARAMETERS: A STRING TO LOCATE ) ISPEXEC TBADD ADDRCMDS SET ADCMDDES = + &STR(FUNCTIONS: LOCATE (AND POSITION THE TABLE DISPLAY) ON THE ) ISPEXEC TBADD ADDRCMDS SET ADCMDDES = + &STR( THE FIRST TABLE ROW IN WHICH THE PRIMARY SORT ) ISPEXEC TBADD ADDRCMDS SET ADCMDDES = + &STR( KEY OF THAT ROW IS EQUAL TO OR GREATER THAN THE) ISPEXEC TBADD ADDRCMDS SET ADCMDDES = + &STR( STRING WHICH WAS PASSED WITH THE COMMAND. THIS) ISPEXEC TBADD ADDRCMDS SET ADCMDDES = + &STR( WORKS ESSENTIALLY LIKE THE "L" COMMAND ON A PDS) ISPEXEC TBADD ADDRCMDS SET ADCMDDES = + &STR( MEMBER LIST. ) ISPEXEC TBADD ADDRCMDS SET ADCMD = &STR(SORT ) /***********************************/ SET ADCMDDES = + &STR(ALIASES: "O" "OR" "ORD" "ORDE" "SORT" ) ISPEXEC TBADD ADDRCMDS SET ADCMD = SET ADCMDDES = + &STR(PARAMETERS: VALID ADDRESS TABLE DISPLAY COLUMN NAME(S) ) ISPEXEC TBADD ADDRCMDS SET ADCMDDES = + &STR( VALID COLUMN NAMES ARE: ID1 ID2 FNAME1 FNAME2 ) ISPEXEC TBADD ADDRCMDS SET ADCMDDES = + &STR( LNAME1 LNAME2 MAIDEN1 MAIDEN2 ADDRESS1 ) ISPEXEC TBADD ADDRCMDS SET ADCMDDES = + &STR( ADDRESS2 CITY STATPROV ZIPPOST COUNTRY PHONE1 ) ISPEXEC TBADD ADDRCMDS SET ADCMDDES = + &STR( PHONE2 CATEGORY LETTER INCAREOF ICOADDR1 ) ISPEXEC TBADD ADDRCMDS SET ADCMDDES = + &STR( ICOADDR2 ICOCITY ICOCITY ICOSTATE ICOZIP ) ISPEXEC TBADD ADDRCMDS SET ADCMDDES = + &STR( ICOCNTRY ICOPHONE NOTE1 NOTE2 NOTE3 NOTE4 ) ISPEXEC TBADD ADDRCMDS SET ADCMDDES = + &STR( NOTE5 NOTE6 NOTE7 NOTE8 NOTE9 NOTE10 LUID ) ISPEXEC TBADD ADDRCMDS SET ADCMDDES = + &STR( LUDATE LUTIME ) ISPEXEC TBADD ADDRCMDS SET ADCMDDES = + &STR(FUNCTIONS: SORT THE TABLE DISPLAY IN A SPECIFIC ORDER, AND) ISPEXEC TBADD ADDRCMDS SET ADCMDDES = + &STR( SET THE "PRIMARY SORT KEY" VARIABLE WHICH IS ) ISPEXEC TBADD ADDRCMDS SET ADCMDDES = + &STR( USED BY THE "LOCATE" COMMAND. ) ISPEXEC TBADD ADDRCMDS SET ADCMD = &STR(REPORT ) /***********************************/ SET ADCMDDES = + &STR(ALIASES: "R" "REP" "DUMP" "PRINT" ) ISPEXEC TBADD ADDRCMDS SET ADCMD = SET ADCMDDES = + &STR(PARAMETERS: A SKELETON NAME TO FILE TAILOR ) ISPEXEC TBADD ADDRCMDS SET ADCMDDES = + &STR(FUNCTIONS: CREATE A REPORT FILE OF THE CONTENTS OF THE ) ISPEXEC TBADD ADDRCMDS SET ADCMDDES = + &STR( ADDRESS TABLE. ) ISPEXEC TBADD ADDRCMDS ISPEXEC TBTOP ADDRCMDS SET ZWINTTL = &STR(VALID PRIMARY COMMANDS...PF3 TO RETURN...+ PF7/8 TO SCROLL) SET ZTDMARK = &STR(*** END OF VALID PRIMARY COMMANDS ***) /* ISPEXEC ADDPOP ROW(3) COLUMN(8) ISPEXEC CONTROL DISPLAY SAVE /* FIXPOP */ PRIM_CMDLOOP: + ISPEXEC TBDISPL ADDRCMDS PANEL(ADDRCMDS) IF &LASTCC = 0 THEN GOTO PRIM_CMDLOOP /* ISPEXEC REMPOP ISPEXEC CONTROL DISPLAY RESTORE /* FIXPOP */ END END /*****************************/ /* MAINTAIN THE TOP OF TABLE */ /*****************************/ SCROLL: + IF &LENGTH(&STR(&ZCMD)) = 0 THEN + DO ISPEXEC TBTOP ADDRESS ISPEXEC TBSKIP ADDRESS NUMBER(&ZTDTOP) ISPEXEC VGET (ZVERB ZSCROLLN) IF &ZVERB = &STR(UP) THEN + ISPEXEC TBSKIP ADDRESS NUMBER(-&ZSCROLLN) IF &ZVERB = &STR(DOWN) THEN + ISPEXEC TBSKIP ADDRESS NUMBER(&ZSCROLLN) END GOTO REDISPLAY /*************************************************/ /* CLOSE THE ADDRESS TABLE (SAVING THE CHANGES) */ /*************************************************/ FINISH: + ISPEXEC TBCLOSE ADDRESS ISPEXEC LIBDEF ISPTABL EXIT /***********************************/ /* PROCESS INSERT OF NEW TABLE ROW */ /***********************************/ INSERT_SECTION: + ISPEXEC TBSKIP ADDRESS NUMBER(0) POSITION(CRP) ISPEXEC TBEND ADDRESS ISPEXEC LIBDEF ISPTABL DATASET ID('&ISPFPFX..ISPTLIB') ISPEXEC TBOPEN ADDRESS WRITE SET OPENCC = &LASTCC DO &I = 1 TO 30 WHILE &OPENCC ¬= 0 ISPEXEC TBOPEN ADDRESS WRITE SET OPENCC = &LASTCC END IF &OPENCC = 0 THEN + DO ISPEXEC TBTOP ADDRESS ISPEXEC TBSKIP ADDRESS NUMBER(&CRP) ISPEXEC TBVCLEAR ADDRESS ISPEXEC TBADD ADDRESS ISPEXEC TBCLOSE ADDRESS ISPEXEC TBOPEN ADDRESS NOWRITE ISPEXEC TBTOP ADDRESS ISPEXEC TBSKIP ADDRESS NUMBER(&CRP) END ELSE + DO SET ZEDLMSG = &STR(UNABLE TO OPEN THE + ADDRESS ISPF TABLE FOR + UPDATE. PLEASE TRY + LATER.) ISPEXEC SETMSG MSG(UTLZ001W) ISPEXEC TBOPEN ADDRESS NOWRITE ISPEXEC TBTOP ADDRESS ISPEXEC TBSKIP ADDRESS NUMBER(&CRP) END GOTO SCROLL /**************************/ /* PROCESS LOCATE COMMAND */ /**************************/ LOCATE_SECTION: + ISPEXEC TBTOP ADDRESS SET OPT1 = &STR(&OPT1.*) SELECT (&LASTSORT) WHEN (ID1) SET ID1 = &STR(&OPT1) WHEN (ID2) SET ID2 = &STR(&OPT1) WHEN (FNAME1) SET FNAME1 = &STR(&OPT1) WHEN (FNAME2) SET FNAME2 = &STR(&OPT1) WHEN (LNAME1) SET LNAME1 = &STR(&OPT1) WHEN (LNAME2) SET LNAME2 = &STR(&OPT1) WHEN (MAIDEN1) SET MAIDEN1 = &STR(&OPT1) WHEN (MAIDEN2) SET MAIDEN2 = &STR(&OPT1) WHEN (ADDRESS1) SET ADDRESS1 = &STR(&OPT1) WHEN (ADDRESS2) SET ADDRESS2 = &STR(&OPT1) WHEN (CITY) SET CITY = &STR(&OPT1) WHEN (STATPROV) SET STATPROV = &STR(&OPT1) WHEN (ZIPPOST) SET ZIPPOST = &STR(&OPT1) WHEN (COUNTRY) SET COUNTRY = &STR(&OPT1) WHEN (PHONE1) SET PHONE1 = &STR(&OPT1) WHEN (PHONE2) SET PHONE2 = &STR(&OPT1) WHEN (CATEGORY) SET CATEGORY = &STR(&OPT1) WHEN (LETTER) SET LETTER = &STR(&OPT1) WHEN (INCAREOF) SET INCAREOF = &STR(&OPT1) WHEN (ICOADDR1) SET ICOADDR1 = &STR(&OPT1) WHEN (ICOADDR2) SET ICOADDR2 = &STR(&OPT1) WHEN (ICOCITY) SET ICOCITY = &STR(&OPT1) WHEN (ICOSTATE) SET ICOSTATE = &STR(&OPT1) WHEN (ICOZIP) SET ICOZIP = &STR(&OPT1) WHEN (ICOCNTRY) SET ICOCNTRY = &STR(&OPT1) WHEN (ICOPHONE) SET ICOPHONE = &STR(&OPT1) WHEN (NOTE1) SET NOTE1 = &STR(&OPT1) WHEN (NOTE10) SET NOTE10 = &STR(&OPT1) WHEN (NOTE2) SET NOTE2 = &STR(&OPT1) WHEN (NOTE3) SET NOTE3 = &STR(&OPT1) WHEN (NOTE4) SET NOTE4 = &STR(&OPT1) WHEN (NOTE5) SET NOTE5 = &STR(&OPT1) WHEN (NOTE6) SET NOTE6 = &STR(&OPT1) WHEN (NOTE7) SET NOTE7 = &STR(&OPT1) WHEN (NOTE8) SET NOTE8 = &STR(&OPT1) WHEN (NOTE9) SET NOTE9 = &STR(&OPT1) WHEN (LUID) SET LUID = &STR(&OPT1) WHEN (LUDATE) SET LUDATE = &STR(&OPT1) WHEN (LUTIME) SET LUTIME = &STR(&OPT1) OTHERWISE DO CLEAR WRITE ******************************************************** WRITE * THE FOLLOWING FIELDS ARE VALID FOR THE "LOCATE" * WRITE * COMMAND. * WRITE * ID1 ID2 FNAME1 FNAME2 LNAME1 LNAME2 MAIDEN1 MAIDEN2 * WRITE * ADDRESS1 ADDRESS2 CITY STATPROV ZIPPOST COUNTRY * WRITE * PHONE1 PHONE2 CATEGORY LETTER INCAREOF ICOADDR1 * WRITE * ICOADDR2 ICOCITY ICOSTATE ICOZIP ICOCNTRY ICOPHONE * WRITE * NOTE1 NOTE10 NOTE2 NOTE3 NOTE4 NOTE5 NOTE6 NOTE7 * WRITE * NOTE8 NOTE9 LUID LUDATE LUTIME * WRITE ******************************************************** GOTO SCROLL END END ISPEXEC TBSCAN ADDRESS ARGLIST(&LASTSORT) CONDLIST(GE) NOREAD GOTO SCROLL /******************************/ /* PROCESS DUMP TABLE COMMAND */ /******************************/ REPORT_SECTION: + SET OPT1 = &STR(&SYSCAPS(&OPT1)) IF &STR(&OPT1) = THEN + DO SET ZEDLMSG = &STR(AN ISPSLIB SKELETON MEMBER TO FILE TAILOR + MUST BE SPECIFIED) ISPEXEC SETMSG MSG(UTLZ001) GOTO SCROLL END IF &SYSDSN('&SKELLIB(&OPT1)') ¬= OK THEN + DO SET ZEDLMSG = &STR("&SKELLIB(&OPT1)" PROBLEM: + &SYSDSN('&SKELLIB(&OPT1)') ISPEXEC SETMSG MSG(UTLZ001) GOTO SCROLL END %GDGGEN DSN(D@UDAL.OUTPUT) ISPEXEC VGET NEXTGEN SET ZEDLMSG = &STR(*** CREATING TABLE REPORT IN DATASET + &NEXTGEN ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) FREE DDNAME(ISPFILE QUICK) ALLOCATE DDNAME(QUICK) DSN('&NEXTGEN') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK005) + SPACE(1,1) CYLINDERS RELEASE + RECFM(F B) LRECL(255) BLKSIZE(23460) DSORG(PS) FREE DDNAME(QUICK) ALLOCATE DDNAME(ISPFILE) DSN('&NEXTGEN') + OLD ISPEXEC LIBDEF ISPSLIB ISPEXEC LIBDEF ISPSLIB DATASET ID('&SKELLIB') ISPEXEC CONTROL ERRORS CANCEL ISPEXEC FTOPEN ISPEXEC FTINCL &OPT1 SET SAVECC = &LASTCC ISPEXEC FTCLOSE ISPEXEC CONTROL ERRORS RETURN FREE DDNAME(ISPFILE) ISPEXEC LIBDEF ISPSLIB IF &SAVECC > 0 THEN + DO SET ZEDLMSG = &STR(REPORT CREATION FAILED WITH RC = &SAVECC) ISPEXEC SETMSG MSG(UTLZ001) ISPEXEC EDIT DATASET('&NEXTGEN') END ELSE + DO SET ZEDLMSG = &STR(REPORT OF ADDRESS TABLE SUCCESSFULLY + LOADED IN &NEXTGEN) ISPEXEC SETMSG MSG(UTLZ000) ISPEXEC EDIT DATASET('&NEXTGEN') END GOTO SCROLL /************************/ /* PROCESS EDIT COMMAND */ /************************/ EDIT_SECTION: + IF &STR(&OPT1) = THEN + PDS '&STR(&SKELLIB)' MEMLIST : ELSE + DO SET X = &STR(&SKELLIB(&SYSCAPS(&OPT1))) ISPEXEC EDIT DATASET('&X') END GOTO SCROLL /************************/ /* PROCESS SORT COMMAND */ /************************/ SORT_SECTION: + SET SFIELD = IF &STR(&OPT1) = THEN + DO SET ZEDLMSG = &STR(TABLE SORTED IN DEFAULT ORDER: + BY LNAME1,FNAME1 (1ST LAST NAME + 1ST FIRST NAME)) ISPEXEC SETMSG MSG(UTLZ000) SET SFIELD = &STR(,LNAME1,C,A,FNAME1,C,A) SET LASTSORT = UTNAME END ELSE + DO &I = 1 TO 10 SET X = &&OPT&I IF &X = THEN GOTO SORT_CONTINUE SELECT (&SYSCAPS(&X)) WHEN (ID1) SET SFIELD = &STR(&SFIELD,ID1,C,A) WHEN (ID2) SET SFIELD = &STR(&SFIELD,ID2,C,A) WHEN (FNAME1) SET SFIELD = &STR(&SFIELD,FNAME1,C,A) WHEN (FNAME2) SET SFIELD = &STR(&SFIELD,FNAME2,C,A) WHEN (LNAME1) SET SFIELD = &STR(&SFIELD,LNAME1,C,A) WHEN (LNAME2) SET SFIELD = &STR(&SFIELD,LNAME2,C,A) WHEN (MAIDEN1) SET SFIELD = &STR(&SFIELD,MAIDEN1,C,A) WHEN (MAIDEN2) SET SFIELD = &STR(&SFIELD,MAIDEN2,C,A) WHEN (ADDRESS1) SET SFIELD = &STR(&SFIELD,ADDRESS1,C,A) WHEN (ADDRESS2) SET SFIELD = &STR(&SFIELD,ADDRESS2,C,A) WHEN (CITY) SET SFIELD = &STR(&SFIELD,CITY,C,A) WHEN (STATPROV) SET SFIELD = &STR(&SFIELD,STATPROV,C,A) WHEN (ZIPPOST) SET SFIELD = &STR(&SFIELD,ZIPPOST,C,A) WHEN (COUNTRY) SET SFIELD = &STR(&SFIELD,COUNTRY,C,A) WHEN (PHONE1) SET SFIELD = &STR(&SFIELD,PHONE1,C,A) WHEN (PHONE2) SET SFIELD = &STR(&SFIELD,PHONE2,C,A) WHEN (CATEGORY) SET SFIELD = &STR(&SFIELD,CATEGORY,C,A) WHEN (LETTER) SET SFIELD = &STR(&SFIELD,LETTER,C,A) WHEN (INCAREOF) SET SFIELD = &STR(&SFIELD,INCAREOF,C,A) WHEN (ICOADDR1) SET SFIELD = &STR(&SFIELD,ICOADDR1,C,A) WHEN (ICOADDR2) SET SFIELD = &STR(&SFIELD,ICOADDR2,C,A) WHEN (ICOCITY) SET SFIELD = &STR(&SFIELD,ICOCITY,C,A) WHEN (ICOSTATE) SET SFIELD = &STR(&SFIELD,ICOSTATE,C,A) WHEN (ICOZIP) SET SFIELD = &STR(&SFIELD,ICOZIP,C,A) WHEN (ICOCNTRY) SET SFIELD = &STR(&SFIELD,ICOCNTRY,C,A) WHEN (ICOPHONE) SET SFIELD = &STR(&SFIELD,ICOPHONE,C,A) WHEN (NOTE1) SET SFIELD = &STR(&SFIELD,NOTE1,C,A) WHEN (NOTE10) SET SFIELD = &STR(&SFIELD,NOTE10,C,A) WHEN (NOTE2) SET SFIELD = &STR(&SFIELD,NOTE2,C,A) WHEN (NOTE3) SET SFIELD = &STR(&SFIELD,NOTE3,C,A) WHEN (NOTE4) SET SFIELD = &STR(&SFIELD,NOTE4,C,A) WHEN (NOTE5) SET SFIELD = &STR(&SFIELD,NOTE5,C,A) WHEN (NOTE6) SET SFIELD = &STR(&SFIELD,NOTE6,C,A) WHEN (NOTE7) SET SFIELD = &STR(&SFIELD,NOTE7,C,A) WHEN (NOTE8) SET SFIELD = &STR(&SFIELD,NOTE8,C,A) WHEN (NOTE9) SET SFIELD = &STR(&SFIELD,NOTE9,C,A) WHEN (LUID) SET SFIELD = &STR(&SFIELD,LUID,C,A) WHEN (LUDATE) SET SFIELD = &STR(&SFIELD,LUDATE,C,A) WHEN (LUTIME) SET SFIELD = &STR(&SFIELD,LUTIME,C,A) OTHERWISE DO WRITE **************************************************** WRITE * THE FOLLOWING FIELDS ARE VALID FOR THE "SORT" * WRITE * COMMAND. * WRITE * ID1 ID2 FNAME1 FNAME2 LNAME1 LNAME2 MAIDEN1 * WRITE * MAIDEN2 ADDRESS1 ADDRESS2 CITY STATPROV * WRITE * ZIPPOST COUNTRY PHONE1 PHONE2 CATEGORY * WRITE * LETTER INCAREOF ICOADDR1 ICOADDR2 ICOCITY * WRITE * ICOSTATE ICOZIP ICOCNTRY ICOPHONE NOTE1 * WRITE * NOTE10 NOTE2 NOTE3 NOTE4 NOTE5 NOTE6 NOTE7 * WRITE * NOTE8 NOTE9 LUID LUDATE LUTIME * WRITE **************************************************** WRITENR PRESS TO CONTINUE READ ANSWER GOTO SCROLL END END END SORT_CONTINUE: + SET A = &LENGTH(&STR(&SFIELD)) SET SFIELD = &SUBSTR(2:&A,&STR(&SFIELD)) ISPEXEC TBEND ADDRESS ISPEXEC LIBDEF ISPTABL DATASET ID('&ISPFPFX..ISPTLIB') ISPEXEC TBOPEN ADDRESS WRITE SET OPENCC = &LASTCC DO &I = 1 TO 30 WHILE &OPENCC ¬= 0 ISPEXEC TBOPEN ADDRESS WRITE SET OPENCC = &LASTCC END IF &OPENCC = 0 THEN + DO ISPEXEC TBSORT ADDRESS FIELDS(&STR(&SFIELD)) SET A = &EVAL(&SYSINDEX(&STR(,C,A),&STR(&STR(&SFIELD)) - 1) SET A = &A - 1 SET LASTSORT = &SUBSTR(1:&A,&STR(&STR(&SFIELD)) ISPEXEC TBCLOSE ADDRESS ISPEXEC TBOPEN ADDRESS NOWRITE END ELSE + DO SET ZEDLMSG = &STR(UNABLE TO OPEN THE + ADDRESS ISPF TABLE + FOR UPDATE. PLEASE + TRY LATER.) ISPEXEC SETMSG MSG(UTLZ001W) ISPEXEC TBOPEN ADDRESS NOWRITE END GOTO SCROLL ./ ADD NAME=ADJUSTPL ISREDIT MACRO ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ISREDIT (SYSDVAL) = LINE .ZCSR READDVAL X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 IF &DATATYPE(&STR(&X1)) = NUM THEN SET NEXTP = &X1 + &X2 IF &NEXTP > THEN GOTO FINISH IF &DATATYPE(&STR(&X2)) = NUM THEN SET NEXTP = &X2 + &X3 IF &NEXTP > THEN GOTO FINISH IF &DATATYPE(&STR(&X3)) = NUM THEN SET NEXTP = &X3 + &X4 IF &NEXTP > THEN GOTO FINISH IF &DATATYPE(&STR(&X4)) = NUM THEN SET NEXTP = &X4 + &X5 IF &NEXTP > THEN GOTO FINISH IF &DATATYPE(&STR(&X5)) = NUM THEN SET NEXTP = &X5 + &X6 IF &NEXTP > THEN GOTO FINISH IF &DATATYPE(&STR(&X6)) = NUM THEN SET NEXTP = &X6 + &X7 IF &NEXTP > THEN GOTO FINISH IF &DATATYPE(&STR(&X7)) = NUM THEN SET NEXTP = &X7 + &X8 IF &NEXTP > THEN GOTO FINISH IF &DATATYPE(&STR(&X8)) = NUM THEN SET NEXTP = &X8 + &X9 IF &NEXTP > THEN GOTO FINISH IF &DATATYPE(&STR(&X9)) = NUM THEN SET NEXTP = &X9 + &X10 FINISH: + ISREDIT FIND NEXT P'=' .ZCSR .ZCSR ISREDIT FIND NEXT P'=' .ZCSR .ZCSR ISREDIT FIND NEXT P'=' 1 ISREDIT FIND NEXT P'#' .ZCSR .ZCSR ISREDIT (LN1,CL1) = CURSOR ISREDIT FIND NEXT P'-' .ZCSR .ZCSR ISREDIT (LN2,CL2) = CURSOR SET CL2 = &CL2 - 1 SET WIDTH = &CL2 - &CL1 + 1 DO &I = 1 TO &WIDTH SET EQUALS = &STR(=&EQUALS) END DO &I = &LENGTH(&NEXTP) TO &WIDTH - 1 SET NEXTP = &STR(0&NEXTP) END ISREDIT CHANGE P'&STR(&EQUALS)' '&STR(&NEXTP)' FIRST &CL1 .ZCSR .ZCSR ./ ADD NAME=ADSOBGEN PROC 0 DIALOG() TPWRD() REPEAT HELP /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ISPEXEC CONTROL ERRORS RETURN IF &HELP = HELP THEN GOTO HELPSEC /********************************************************************** /* UTILITY : ADSOBGEN * /* AUTHOR : DAVE LEIGH * /* FUNCTION : THIS UTILITY SUBMITS ADSOBGENS FOR THE DIALOG NAMES * /* ENTERED IN THE PANEL OR PASSED TO THE UTILITY. * /********************************************************************** ISPEXEC TBOPEN PROJECT NOWRITE ISPEXEC TBVCLEAR PROJECT SET TESTPROD = T SET PRJELEM = &STR(IPC/CPU) ISPEXEC TBSCAN PROJECT ARGLIST(TESTPROD,PRJELEM) + CONDLIST(EQ,EQ) SET SYSAFF = &STR(SYSAFF=&PRJPARM) ISPEXEC TBEND PROJECT ISPEXEC VGET (ZTEMPF) SHARED SET JCLREVEW = N ISPEXEC VPUT (JCLREVEW TPWRD) SHARED REDISP: + ISPEXEC DISPLAY PANEL(ADSOBGEN) IF &LASTCC = 8 THEN + DO IF &REPEAT = &STR(REPEAT) THEN ELSE ISPEXEC SETMSG MSG(UTLM002H) GOTO FINISH END CONTINUE: + ISPEXEC VGET (JCLREVEW TPWRD) SHARED SET SPACE7 = &STR( ) ISPEXEC CONTROL ERRORS CANCEL ISPEXEC TBOPEN PROJECT NOWRITE ISPEXEC TBSORT PROJECT FIELDS(PRJQUAL,C,A) IF &JCLREVEW = &STR(Y) THEN + DO DELETE TEMP.JCL FREE DDNAME(ISPFILE QUICK) ALLOCATE DDNAME(QUICK) DSN(TEMP.JCL) + NEW CATALOG + UNIT(SYSDA) + SPACE(1,1) AVBLOCK(10796) RELEASE + RECFM(F B) LRECL(80) DSORG(PS) FREE DDNAME(QUICK) ALLOCATE DDNAME(ISPFILE) + DSN(TEMP.JCL) + OLD ISPEXEC FTOPEN ISPEXEC FTINCL ADSOBGEN SET SAVECC = &LASTCC ISPEXEC FTCLOSE FREE DDNAME(ISPFILE) IF &SAVECC > 0 THEN ISPEXEC SETMSG MSG(UTLM002F) ELSE + DO ISPEXEC SETMSG MSG(UTILM030) ISPEXEC EDIT DATASET(TEMP.JCL) END END ELSE + DO ISPEXEC FTOPEN TEMP ISPEXEC FTINCL ADSOBGEN SET SAVECC = &LASTCC ISPEXEC FTCLOSE IF &SAVECC > 0 THEN ISPEXEC SETMSG MSG(UTLM002F) ELSE + DO ISPEXEC SETMSG MSG(UTLM002G) SUBMIT '&ZTEMPF' END END ISPEXEC TBEND PROJECT IF &REPEAT = &STR(REPEAT) THEN GOTO REDISP FINISH: + EXIT HELPSEC: + ISPEXEC SELECT PGM(ISPTUTOR) PARM(UTILH008) SET ZEDLMSG = &STR(*** HELP FOR ADSOBGEN ENDED *** NO PROCESSING + PERFORMED ***) ISPEXEC SETMSG MSG(UTLZ000) EXIT ./ ADD NAME=ADSORPTS PROC 0 DIALOG() DSN() REPEAT HELP /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ISPEXEC CONTROL ERRORS CANCEL IF &HELP = HELP THEN GOTO HELPSEC /********************************************************************** /* UTILITY : ADSORPTS * /* AUTHOR : DAVE LEIGH * /* FUNCTION : SUBMIT A BACKROUND JOB TO PRODUCE ADSORPTS WITH THE * /* SELECTED KIND OF ENHANCEMENTS FOR THE ENTERED DIALOGS. * /********************************************************************** WTSPXSET * NAMES(PRGNAME) ISPEXEC TBOPEN PROJECT NOWRITE ISPEXEC TBTOP PROJECT ISPEXEC TBVCLEAR PROJECT SET TESTPROD = T SET PRJELEM = BATCH SET PRJPARM = &STR(ACCESS CODE) ISPEXEC TBSCAN PROJECT ARGLIST(TESTPROD,PRJELEM,PRJPARM) + CONDLIST(EQ,EQ,EQ) SET ACODE = &PRJQUAL ISPEXEC TBTOP PROJECT ISPEXEC TBVCLEAR PROJECT SET PRJELEM = DIALOG SET PRJQUAL = LIBRARY ISPEXEC TBSCAN PROJECT ARGLIST(TESTPROD,PRJELEM,PRJQUAL) + CONDLIST(EQ,EQ,EQ) SET DDSN = &PRJPARM ISPEXEC TBTOP PROJECT ISPEXEC TBVCLEAR PROJECT SET PRJELEM = TABLE SET PRJQUAL = LIBRARY ISPEXEC TBSCAN PROJECT ARGLIST(TESTPROD,PRJELEM,PRJQUAL) + CONDLIST(EQ,EQ,EQ) SET PTLIB = &PRJPARM ISPEXEC TBTOP PROJECT ISPEXEC TBVCLEAR PROJECT SET TESTPROD = T SET PRJELEM = &STR(IPC/CPU) ISPEXEC TBSCAN PROJECT ARGLIST(TESTPROD,PRJELEM) + CONDLIST(EQ,EQ) SET SYSAFF = &PRJPARM ISPEXEC TBEND PROJECT ISPEXEC VGET (YMPRMNO XMPRMNO YMPACTC) PROFILE IF &YMPRMNO = THEN SET YMPRMNO = &XMPRMNO IF &YMPACTC = THEN SET YMPACTC = &ACODE IF &XMPRMNO = THEN SET XMPRMNO = &YMPRMNO ISPEXEC VPUT (YMPRMNO XMPRMNO YMPACTC) PROFILE ISPEXEC VGET (ZTEMPF) SHARED SET MSUB = X SET XREL = X SET LSUM = X SET LDET = X SET RSUM = X SET RDET = X SET PLIST = Y 00290011 SET UDSN = Y 00290011 SET PWL = X 00591011 SET PGBL = 00591011 SET PGLL = 00591011 SET PGBI = 00591011 SET PEMER = 00591011 SET COP = 1 SET DSN = SET JCLREVEW = N ISPEXEC VPUT (PLIST UDSN PWL PGBL PGLL PGBI PEMER COP JCLREVEW + MSUB XREL LSUM LDET RSUM RDET DDSN DSN) SHARED REDISP: + ISPEXEC DISPLAY PANEL(ADSORPTS) IF &LASTCC = 8 THEN + DO IF &REPEAT = &STR(REPEAT) THEN ELSE ISPEXEC SETMSG MSG(UTLM001V) GOTO FINISH END ISPEXEC VGET (PLIST UDSN PWL PGBL PGLL PGBI PEMER COP JCLREVEW + MSUB XREL LSUM LDET RSUM RDET DDSN DSN) SHARED ISPEXEC VGET (YMPRMNO XMPRMNO) PROFILE IF &YMPRMNO = THEN SET YMPRMNO = &XMPRMNO IF &XMPRMNO = THEN SET XMPRMNO = &YMPRMNO ISPEXEC VPUT (YMPRMNO XMPRMNO) PROFILE SET SPACE7 = &STR( ) SET FORMS = SET FCB = &STR(,FCB=SS8) SET PC = H SET DEST = DEDNN1 IF &PEMER > THEN + DO SET DEST = DENVERCA SET PC = A SET FCB = END ELSE + IF &PGBI > THEN + DO SET FCB = &STR(,FCB=STD3) SET PC = T END ELSE + DO SET PDEST = DEDNN1 SET PC = H IF &PWL > THEN SET FORMS = &STR(,FORMS=TR17) IF &PGBL > THEN SET FORMS = &STR(,FORMS=TR12) IF &PGLL > THEN SET FORMS = &STR(,FORMS=TR11) END SET OUTCARD = &STR(DEST=&DEST&FCB&FORMS,COPIES=&COP) ISPEXEC TBCREATE $&SYSUID NOWRITE REPLACE KEYS(DIALOG) IF &DIALOG > THEN GOTO RESUME1 SET LPAREN = &STR(( SET RPAREN = &STR()) SET A = &SYSINDEX(&STR(&LPAREN),&STR(&DSN)) SET C = &A - 1 SET A = &A + 1 SET D = &A + 1 SET B = &LENGTH(&STR(&DSN)) SET B = &B - 1 IF &B < 1 THEN GOTO RESUME1 IF &A > 1 AND + &B > 0 AND + (&SUBSTR(&A:&A,&STR(&DSN)) = &STR(+) OR + &SUBSTR(&A:&A,&STR(&DSN)) = &STR(-) OR + &SUBSTR(&A:&A,&STR(&DSN)) = &STR(0) OR + &SUBSTR(&A:&A,&STR(&DSN)) = &STR(1) OR + &SUBSTR(&A:&A,&STR(&DSN)) = &STR(2) OR + &SUBSTR(&A:&A,&STR(&DSN)) = &STR(3) OR + &SUBSTR(&A:&A,&STR(&DSN)) = &STR(4) OR + &SUBSTR(&A:&A,&STR(&DSN)) = &STR(5) OR + &SUBSTR(&A:&A,&STR(&DSN)) = &STR(6) OR + &SUBSTR(&A:&A,&STR(&DSN)) = &STR(7) OR + &SUBSTR(&A:&A,&STR(&DSN)) = &STR(8) OR + &SUBSTR(&A:&A,&STR(&DSN)) = &STR(9)) THEN + DO SET GM = &SUBSTR(&A:&B,&STR(&DSN)) IF &SUBSTR(1:1,&STR(&GM)) = &STR(-) THEN + SET GM = &SUBSTR(2,&STR(&GM)) IF &LENGTH(&STR(&GM)) > 1 THEN + DO IF &SUBSTR(1:1,&STR(&GM)) = &STR(+) THEN + DO SET ZEDLMSG = &STR(NON-EXISTANT GENERATIONS )+ &STR(ARE NOT ALLOWED) ISPEXEC SETMSG MSG(UTLZ001) EXIT END IF &SUBSTR(1:2,&STR(&GM)) = &STR(+1) THEN + SET GM = NEXTGEN IF &SUBSTR(1:2,&STR(&GM)) = &STR(+0) THEN + SET GM = &STR(0) END SET XDSN = &SUBSTR(1:&C,&STR(&DSN)) SET ZEDLMSG = &STR(* RESOLVING DATASET)+ &STR( RELATIVE GDG GENERATION )+ &STR(NUMBER *) ISPEXEC SETMSG MSG(UTLZ000) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY PANEL(ADSORPTS) %GDGGEN DSN(&XDSN) SET GM = MINUS&GM ISPEXEC VGET (&GM GEN LIMIT) SHARED IF &STR(&&GM) > THEN + SET GEN = &&&GM ELSE + IF &LIMIT > 0 THEN + SET GEN = G0001V00 ELSE + DO SET ZEDLMSG = &STR("&DSN" IS NOT A GDG DATASET) ISPEXEC SETMSG MSG(UTLZ001) GOTO REDISP END SET DSN = &STR(&XDSN..&GEN) END LISTDSI '&DSN' SET SAVECC = &LASTCC IF &SAVECC > 4 THEN + DO SET ZEDLMSG = &STR(DIALOG DSN PROBLEM : &SYDSN('&DSN')) ISPEXEC SETMSG MSG(UTLZ001) GOTO REDISP END ELSE + IF &SYSINDEX(&STR(PO),&STR(&SYSDSORG)) > 0 AND + &SYSINDEX(&STR(&LPAREN),&STR(&DSN)) = 0 THEN + DO SET ZEDLMSG = &STR("&DSN" MUST CONTAIN A MEMBER NAME) ISPEXEC SETMSG MSG(UTLZ001) GOTO REDISP END FREE DDNAME(DIALOG) ALLOC DDNAME(DIALOG) DSN('&DSN') + SHR KEEP OPENFILE DIALOG ERROR DO 02260000 IF &LASTCC = 400 THEN + 02270000 DO 02280000 SET EOF = YES 02290000 RETURN 02300000 END 02310000 ELSE + 02320000 DO 02330000 CLEARSCR 02350000 WRITE 02350000 WRITE *** UNEXPECTED ERROR IN CLIST ADSORPTS ** 02340000 WRITE 02350000 WRITE *** RETURN CODE WAS : &LASTCC *** 02340000 WRITE 02350000 WRITE *** OCCURED WHILE LOADING &DSN INTO A TABLE 02350000 CLOSFILE DIALOG 02470000 FREE DDNAME(DIALOG) 02470000 GOTO REDISP 02380000 END 02390000 END 02400000 SET EOF = NO GETFILE DIALOG DO WHILE &EOF = NO SET DIALOG = &SUBSTR(1:8,&STR(&DIALOG)) ISPEXEC TBADD $&SYSUID ORDER GETFILE DIALOG END ERROR OFF CLOSFILE DIALOG FREE DDNAME(DIALOG) GOTO RESUME2 RESUME1: + SET PRGNAME = &DIALOG ISPEXEC TBADD $&SYSUID ORDER RESUME2: + ISPEXEC TBTOP $&SYSUID ISPEXEC TBOPEN PROJECT NOWRITE ISPEXEC TBSORT PROJECT FIELDS(PRJQUAL,C,A) IF &JCLREVEW = &STR(Y) THEN + DO DELETE TEMP.JCL FREE DDNAME(ISPFILE) FREE DDNAME(QUICK) FREE ATTRLIST(ATTRIB1) ATTRIB ATTRIB1 + RECFM(F B) + LRECL(80) + DSORG(PS) + BLKSIZE(23440) + OUTPUT ALLOCATE DDNAME(QUICK) + DSN(TEMP.JCL) + NEW CATALOG + UNIT(SYSDA) + SPACE(1,1) TRACKS RELEASE + USING(ATTRIB1) FREE DDNAME(QUICK) ALLOCATE DDNAME(ISPFILE) + DSN(TEMP.JCL) + OLD ISPEXEC FTOPEN ISPEXEC FTINCL ADSORPTS SET SAVECC = &LASTCC ISPEXEC FTCLOSE FREE DDNAME(ISPFILE) IF &SAVECC > 0 THEN ISPEXEC SETMSG MSG(UTLM001X) ELSE + DO ISPEXEC SETMSG MSG(UTILM030) ISPEXEC EDIT DATASET(TEMP.JCL) END END ELSE + DO ISPEXEC FTOPEN TEMP ISPEXEC FTINCL ADSORPTS SET SAVECC = &LASTCC ISPEXEC FTCLOSE IF &SAVECC > 0 THEN ISPEXEC SETMSG MSG(UTLM001X) ELSE + DO ISPEXEC SETMSG MSG(UTLM001W) SUBMIT '&ZTEMPF' END END ISPEXEC TBEND PROJECT ISPEXEC TBEND $&SYSUID IF &REPEAT = &STR(REPEAT) THEN GOTO REDISP FINISH: + EXIT HELPSEC: + 02480000 ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) 02490000 SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR ADSORPTS UTILITY + 02490000 *** NO PROCESSING PERFORMED ***) 02490000 ISPEXEC SETMSG MSG(UTLZ000) 02490000 EXIT ./ ADD NAME=ADSOXREF 000100 /*BLOCK TOP DO NOT DELETE */ 000200 /**********************************************************************/ 000300 /*C L I S T / M A C R O U T I L I T Y D O C U M E N T A T I O N */ 000400 /* */ 000500 /* UTILITY NAME: ADSOXREF */ 000600 /* ALIAS NAME: */ 000700 /* DATASET NAME: **************** LEAVE BLANK **************** */ 000800 /* */ 000900 /* PURPOSE: THIS CLIST GENERATES AN ADS/O DIALOG CROSS */ 001000 /* REFERENCE LISTING EITHER TO THE HOLD QUEUE OR */ 001100 /* TO PAPER. IT INCORPORATES ALL RESPONSES FOR THE */ 001200 /* DIALOG AND INCLUDE MODULES. */ 001300 /* */ 001400 /* SPECIAL USE INSTRUCTIONS: */ 001500 /* NONE */ 001600 /* */ 001700 /* USAGE CATEGORY: */ 001800 /* DATASET MANIPULATION: LANGUAGE SPECIFIC: */ 001900 /* _ SEQUENTIAL _ ALC / ASSEMBLER */ 002000 /* _ GDG BASED _ ADS/O */ 002100 /* _ COMPLETE PDS _ COBOL / COBOL II */ 002200 /* X SINGLE PDS MEMBER _ PL/I */ 002300 /* _ COMPLETE PANVALET LIB. _ JCL */ 002400 /* _ PANVALET MEMBER _ OTHER: __________________ */ 002500 /* _ VSAM */ 002600 /* */ 002700 /* DATABASE SPECIFIC: TP MONITOR SPECIFIC: */ 002800 /* _ DB2 _ CICS */ 002900 /* _ IDMS _ IMS/DC */ 003000 /* _ IMS */ 003100 /* */ 003200 /* _ DATA MANIPULATION _ OTHER: __________________ */ 003300 /* */ 003400 /* ARE ISPF FACILITIES USED: X YES _ NO (E.G. ISPEXEC CALLS) */ 003500 /* PANEL(S) - ADSOXREF */ 003600 /* SKELETON(S) - ADSOXREF */ 003700 /* TABLE(S) - NONE */ 003800 /* MESSAGE(S) - IDMS001 */ 003900 /* PROGRAM(S) - */ 004000 /* DATASETS:****| ________.________.________ ( ) */ 004100 /* ************ | ________.________.________ ( ) */ 004200 /* * LEAVE --> | ________.________.________ ( ) */ 004300 /* * BLANK | ________.________.________ ( ) */ 004400 /* ***************| ________.________.________ ( ) */ 004500 /* */ 004600 /* MACRO: _ YES X NO */ 004700 /* */ 004800 /* INVOKED VIA: */ 004900 /* X ISPF OPTION 6 X MENU */ 005000 /* X TSO (CLISTNAME) _ COMMAND LINE (MACRO) */ 005100 /* _ ISPEXEC _ ISPSTART */ 005200 /* */ 005300 /* PARAMETERS: REQUIRES DIALOG NAME, ACCESS CODE, JOB ID CHARACTER, */ 005400 /* AND EXECUTION CLASS. ALL BUT DIALOG NAME HAVE */ 005500 /* DEFAULT VALUES. */ 005600 /* */ 005700 /* PROJECT NAME: CHEVROLET MARKETING CENTER (CMC) */ 005800 /* */ 005900 /* IS THE UTILITY PROJECT SPECIFIC? X YES _ NO */ 006000 /* WILL STANDARDIZATION/REDESIGN OF THE UTILITY PROVIDE OTHER */ 006100 /* PROJECTS WITH A PRACTICAL TOOL? X YES _ NO */ 006200 /* */ 006300 /* WAS THIS UTILITY ACQUIRED FROM ANOTHER PROJECT? _ YES _ NO X ? */ 006400 /* HAVE YOU MADE ENHANCEMENTS TO THIS UTILITY AFTER ACQUIRING */ 006500 /* IT FROM ANOTHER PROJECT? _ YES _ NO X ? */ 006600 /* */ 006700 /**********************************************************************/ 006800 /* M O D I F I C A T I O N L O G */ 006900 /**********************************************************************/ 007000 /* DATE SE DESCRIPTION */ 007100 /* ??/??/?? ? CREATED/UPDATED */ 007200 /* */ 007300 /**********************************************************************/ 007400 /* */ 007500 /*BLOCK BOTTOM DO NOT DELETE */ 007600 PROC 0 007700 CONTROL NOFLUSH END(ENDO) NOMSG 007800 /*IF &USERID ¬= THEN GOTO SKIPIT 007900 FREE DDNAME(DEFAULT) 008000 ALLOC F(DEFAULT) DA('TCWMK.CTC.DEFAULTS(&SYSUID)') SHR 008100 IF &LASTCC = 0 THEN DO 008200 OPENFILE DEFAULT 008300 GETFILE DEFAULT 008400 SET USERID = &SUBSTR(1:8,&DEFAULT) 008500 SET DICTNME = &SUBSTR(9:15,&DEFAULT) 008600 SET DSN = &SUBSTR(16:37,&DEFAULT) 008700 SET D = &SUBSTR(38:38,&DEFAULT) 008800 SET ACC = &SUBSTR(39:44,&DEFAULT) 008900 SET ROOM = &SUBSTR(45:48,&DEFAULT) 009000 SET X = &SUBSTR(49:49,&DEFAULT) 009100 CLOSFILE DEFAULT 009200 FREE F(DEFAULT) 009300 ENDO 009400 /* 009500 ISPEXEC DISPLAY PANEL(ADSOXREF) 009600 IF &LASTCC > 7 THEN EXIT 009700 /* 009800 KEEPON: - 009900 SET CV = CV22 010000 FREE DDNAME(ISPFILE) ATTR(ISPATTR) 010100 ATTR ISPATTR RECFM(F B) LRECL(80) BLKSIZE(6160) 010200 DELETE '&SYSUID..CTC.ISPFILE' 010300 ALLOC F(ISPFILE) DA('&SYSUID..CTC.ISPFILE') NEW + 010400 SPACE(1 5) CYLINDER USING(ISPATTR) 010500 FREE ATTR(ISPATTR) 010600 ISPEXEC FTOPEN 010700 IF &CV = CV22 THEN DO 010800 SET SYSTEM = P310 010900 ENDO 011000 IF &CV = CV62 THEN DO 011100 SET SYSTEM = P310 011200 ENDO 011300 SET JOBNAME = &STR(&SYSUID.&D) 011400 ISPEXEC FTINCL ADSOXREF 011500 ISPEXEC FTCLOSE 011600 /* ADDED NEXT LINE TO FIX CHAMP ISPFILE ALLOCATION - D. LEIGH 9-10-90 011700 FREE DDNAME(ISPFILE) 011800 SUBMIT '&SYSUID..CTC.ISPFILE' 011900 /*DELETE '&SYSUID..CTC.ISPFILE' 012000 ISPEXEC VPUT (USERID DICTNME DSN D ACC ROOM X) PROFILE 012100 ISPEXEC VPUT (BOX PREFIX MEMBER LOADLIB) PROFILE 012200 ISPEXEC DISPLAY MSG(IDMS001) 012300 IF &LASTCC > 7 THEN EXIT 012400 GOTO KEEPON ./ ADD NAME=ADWCNVT ISREDIT MACRO (OPT) ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ISREDIT CHANGE ALL 'ENTITY ACCT CNTL NBR' + 'TABLE UTL40T_ACCTCNTLNBR' ISREDIT CHANGE ALL 'ENTITY ACTIVITY LOG COMMENT' + 'TABLE ACT02T_ACTLOGCMNT' ISREDIT CHANGE ALL 'ENTITY ACTIVITY LOG HEADER' + 'TABLE ACT01T_ACTLOGHDR' ISREDIT CHANGE ALL 'ENTITY ACTIVITY LOG JUNCTION' + 'TABLE ACT03T_ACTLOGJNCTN' ISREDIT CHANGE ALL 'ENTITY ACTLOGCMT' + 'TABLE LOG03T_ACTLOGCMT' ISREDIT CHANGE ALL 'ENTITY ACTLOGDTL' + 'TABLE LOG02T_ACTLOGDTL' ISREDIT CHANGE ALL 'ENTITY ACTLOGHDR' + 'TABLE LOG01T_ACTLOGHDR' ISREDIT CHANGE ALL 'ENTITY ADDRESS' + 'TABLE PRT03T_PARTIADDR' ISREDIT CHANGE ALL 'ENTITY APPL RUN HISTORY' + 'TABLE UTL16T_APPLRUNHST' ISREDIT CHANGE ALL 'ENTITY BILLING ACCOUNT' + 'TABLE MNT10T_BILLACCT' ISREDIT CHANGE ALL 'ENTITY BLNKT GNTE TRACKNG' + 'TABLE HLD13T_BLNKTGNTE' ISREDIT CHANGE ALL 'ENTITY BULLTN' + 'TABLE ADM63T_BULLTN' ISREDIT CHANGE ALL 'ENTITY CALENDAR' + 'TABLE UTL20T_CALENDAR' ISREDIT CHANGE ALL 'ENTITY CAPITALIZATION FREQUENCY' + 'TABLE GVA50T_CAPFREQ' ISREDIT CHANGE ALL 'ENTITY CHKPNT' + 'TABLE UTL15T_CHKPNT' ISREDIT CHANGE ALL 'ENTITY CLM CNTL NBR' + 'TABLE UTL45T_CLMCNTLNBR' ISREDIT CHANGE ALL 'ENTITY CODE' + 'TABLE UTL02T_CODE' ISREDIT CHANGE ALL 'ENTITY CODE DEFN' + 'TABLE UTL01T_CODEDEFN' ISREDIT CHANGE ALL 'ENTITY COLLECTION DEFN' + 'TABLE ADM60T_COLLDEFN' ISREDIT CHANGE ALL 'ENTITY COLLECTIONS QUEUE' + 'TABLE COL01T_COLLQUEUE' ISREDIT CHANGE ALL 'ENTITY COLLECTIONS QUEUE USER' + 'TABLE COL02T_COLLQUEUSER' ISREDIT CHANGE ALL 'ENTITY COLLECTOR PARTICIPANT' + 'TABLE COL03T_COLLPARTI' ISREDIT CHANGE ALL 'ENTITY COLLECTOR RANGE' + 'TABLE COL04T_COLLRANGE' ISREDIT CHANGE ALL 'ENTITY DATE EXPANDED' + 'TABLE UTL21T_DTEEXPAND' ISREDIT CHANGE ALL 'ENTITY DEFERMENT GROUP' + 'TABLE GVA10T_DEFERGRP' ISREDIT CHANGE ALL 'ENTITY DEPT DEFN' + 'TABLE ADM44T_DEPTDEFN' ISREDIT CHANGE ALL 'ENTITY DOCUMENT DEFN' + 'TABLE DOC03T_DOCUDEFN' ISREDIT CHANGE ALL 'ENTITY DOCUMENT LINK' + 'TABLE DOC01T_DOCULINK' ISREDIT CHANGE ALL 'ENTITY DOCUMENT PRINT QUEUE' + 'TABLE DOC50T_DOCPRNTQUE' ISREDIT CHANGE ALL 'ENTITY DOCUMENT TOC' + 'TABLE DOC04T_DOCUTOC' ISREDIT CHANGE ALL 'ENTITY DOCUMENT TXT' + 'TABLE DOC02T_DOCUTXT' ISREDIT CHANGE ALL 'ENTITY ERROR LOG' + 'TABLE UTL10T_ERRORLOG' ISREDIT CHANGE ALL 'ENTITY FINAL DEMAND RESPONSE' + 'TABLE GVA04T_FDMRESP' ISREDIT CHANGE ALL 'ENTITY FLD CODE XREF' + 'TABLE UTL03T_FLDCDEXREF' ISREDIT CHANGE ALL 'ENTITY FNDSRCE ACCT NBR' + 'TABLE HLD52T_FSACCTNBR' ISREDIT CHANGE ALL 'ENTITY FNDSRCE FORB OPT' + 'TABLE HLD53T_FSFORBOPT' ISREDIT CHANGE ALL 'ENTITY FNDSRCE GNTR' + 'TABLE HLD54T_FNDSRCEGNTR' ISREDIT CHANGE ALL 'ENTITY FNDSRCE LOAN TYPE' + 'TABLE HLD51T_FSLOANTYPE' ISREDIT CHANGE ALL 'ENTITY FNDSRCE SCHL' + 'TABLE HLD55T_FNDSRCESCHL' ISREDIT CHANGE ALL 'ENTITY FORBEARANCE TYPE' + 'TABLE GVA28T_FORBTYPE' ISREDIT CHANGE ALL 'ENTITY FUNDING SOURCE' + 'TABLE HLD50T_FNDSRCE' ISREDIT CHANGE ALL 'ENTITY GNTE CNTL NBR' + 'TABLE UTL44T_GNTECNTLNBR' ISREDIT CHANGE ALL 'ENTITY GNTR ADDRESS' + 'TABLE GNT02T_GNTRADDR' ISREDIT CHANGE ALL 'ENTITY GNTR CNTCT PERSON' + 'TABLE GNT03T_GNTRCNTCT' ISREDIT CHANGE ALL 'ENTITY GNTR CODE' + 'TABLE GNT04T_GNTRCODE' ISREDIT CHANGE ALL 'ENTITY GNTR COMMENT' + 'TABLE GNT90T_GNTRCOMMENT' ISREDIT CHANGE ALL 'ENTITY GOVAG ADDRESS' + 'TABLE GVA02T_GVAGADDR' ISREDIT CHANGE ALL 'ENTITY GOVAG CNTCT PERSN' + 'TABLE GVA03T_GVAGCNTCT' ISREDIT CHANGE ALL 'ENTITY GOVAG FEE' + 'TABLE GVA05T_GVAGFEE' ISREDIT CHANGE ALL 'ENTITY GOVERNING AGENCY' + 'TABLE GVA01T_GOVAGENCY' ISREDIT CHANGE ALL 'ENTITY GOVERNING AGENCY COMMENT' + 'TABLE GVA90T_GVAGCOMMENT' ISREDIT CHANGE ALL 'ENTITY GRAD PMT PARMS' + 'TABLE GVA27T_GRADPMTPARM' ISREDIT CHANGE ALL 'ENTITY GROUP PROFILE' + 'TABLE ADM40T_GRPPROF' ISREDIT CHANGE ALL 'ENTITY GRP SUBSYS' + 'TABLE ADM46T_GRPSUBSYS' ISREDIT CHANGE ALL 'ENTITY GUARANTOR' + 'TABLE GNT01T_GUARANTOR' ISREDIT CHANGE ALL 'ENTITY HLDR ADDRESS' + 'TABLE HLD02T_HLDRADDR' ISREDIT CHANGE ALL 'ENTITY HLDR CNTCT PERSN' + 'TABLE HLD03T_HLDRCNTCT' ISREDIT CHANGE ALL 'ENTITY HLDR COMM OPT' + 'TABLE HLD11T_HLDRCOMMOPT' ISREDIT CHANGE ALL 'ENTITY HLDR COMMENT' + 'TABLE HLD90T_HLDRCOMMENT' ISREDIT CHANGE ALL 'ENTITY HLDR DISB OPT' + 'TABLE HLD06T_HLDRDISBOPT' ISREDIT CHANGE ALL 'ENTITY HLDR DUEDIL RQMT' + 'TABLE HLD09T_HLDRDDLRQMT' ISREDIT CHANGE ALL 'ENTITY HLDR EFT SCHL' + 'TABLE HLD14T_HLDREFTSCHL' ISREDIT CHANGE ALL 'ENTITY HLDR ESCROW AGENT' + 'TABLE HLD10T_HLDRESCROAG' ISREDIT CHANGE ALL 'ENTITY HLDR FEE' + 'TABLE HLD04T_HLDRFEE' ISREDIT CHANGE ALL 'ENTITY HLDR FND XFER OPT' + 'TABLE HLD07T_HLDRFNDXFER' ISREDIT CHANGE ALL 'ENTITY HLDR SKPTRC OPT' + 'TABLE HLD08T_HLDRSKPOPT' ISREDIT CHANGE ALL 'ENTITY HOLDER' + 'TABLE HLD01T_HOLDER' ISREDIT CHANGE ALL 'ENTITY JOB DEFN' + 'TABLE ADM45T_JOBDEFN' ISREDIT CHANGE ALL 'ENTITY KEYWORD' + 'TABLE DOC05T_KEYWORD' ISREDIT CHANGE ALL 'ENTITY KEYWORD LINK' + 'TABLE DOC06T_KEYWRDLNK' ISREDIT CHANGE ALL 'ENTITY LATE DISB RQMT' + 'TABLE GNT11T_LTDISBRQMT' ISREDIT CHANGE ALL 'ENTITY LOAN AMT LMT' + 'TABLE GVA21T_LOANAMTLMT' ISREDIT CHANGE ALL 'ENTITY LOAN DEFERMENT TYPE' + 'TABLE GVA11T_LOANDEFER' ISREDIT CHANGE ALL 'ENTITY LOAN TYPE' + 'TABLE GVA20T_LOANTYPE' ISREDIT CHANGE ALL 'ENTITY MENU ITEM' + 'TABLE ADM24T_MENUITEM' ISREDIT CHANGE ALL 'ENTITY MISC PORTFOLIO' + 'TABLE HLD12T_MISCPORT' ISREDIT CHANGE ALL 'ENTITY MNE SUBSYS' + 'TABLE ADM23T_MNESUBSYS' ISREDIT CHANGE ALL 'ENTITY MNEMONIC' + 'TABLE ADM22T_MNEMONIC' ISREDIT CHANGE ALL 'ENTITY MODEL JCL' + 'TABLE UTL50T_MODELJCL' ISREDIT CHANGE ALL 'ENTITY NOTE' + 'TABLE NTE01T_NOTE' ISREDIT CHANGE ALL 'ENTITY NOTE $ SUMMARY' + 'TABLE MNT01T_NTE$SUMMRY' ISREDIT CHANGE ALL 'ENTITY NOTE BILLING ACCOUNT' + 'TABLE MNT11T_NTEBILLACCT' ISREDIT CHANGE ALL 'ENTITY NOTE CNTL NBR' + 'TABLE UTL41T_NTECNTLNBR' ISREDIT CHANGE ALL 'ENTITY NOTE COND HST' + 'TABLE NTE02T_NOTECONDHST' ISREDIT CHANGE ALL 'ENTITY NOTE CONSOLIDATION' + 'TABLE NTE11T_NOTECONSOL' ISREDIT CHANGE ALL 'ENTITY NOTE DUEDIL MARKER' + 'TABLE NTE06T_NOTEDUDLMRK' ISREDIT CHANGE ALL 'ENTITY NOTE GNTR POLICY' + 'TABLE NTE07T_NOTEGNTPLCY' ISREDIT CHANGE ALL 'ENTITY NOTE MISC PORTFOLIO' + 'TABLE NTE05T_NOTEMSCPORT' ISREDIT CHANGE ALL 'ENTITY NOTE PARTICIPANT' + 'TABLE NTE09T_NOTEPARTI' ISREDIT CHANGE ALL 'ENTITY NOTE PARTICIPANT BANKRUPTCY' + 'TABLE NTE13T_NTEPARTIBNK' ISREDIT CHANGE ALL 'ENTITY NOTE PAYMENT' + 'TABLE MNT21T_NTEPAYMENT' ISREDIT CHANGE ALL 'ENTITY NOTE PAYMENT SCHEDULE' + 'TABLE NTE08T_NOTEPAYSCHD' ISREDIT CHANGE ALL 'ENTITY NOTE PORTFOLIO' + 'TABLE NTE03T_NOTEPORT' ISREDIT CHANGE ALL 'ENTITY NOTE POSTPONEMENT' + 'TABLE PST03T_NOTEPOST' ISREDIT CHANGE ALL 'ENTITY NOTE RATE' + 'TABLE NTE04T_NOTERATE' ISREDIT CHANGE ALL 'ENTITY NOTE SLSS' + 'TABLE NTE10T_NOTESLSS' ISREDIT CHANGE ALL 'ENTITY NOTE SNAPSHOT' + 'TABLE NTE12T_NOTESNPSHOT' ISREDIT CHANGE ALL 'ENTITY NOTE TRANSACTION' + 'TABLE MNT02T_NTE$TRANDTL' ISREDIT CHANGE ALL 'ENTITY PARTI CNTL NBR' + 'TABLE UTL42T_PRTICNTLNBR' ISREDIT CHANGE ALL 'ENTITY PARTICIPANT' + 'TABLE PRT01T_PARTICIPANT' ISREDIT CHANGE ALL 'ENTITY PARTICIPANT COND' + 'TABLE PRT02T_PARTICOND' ISREDIT CHANGE ALL 'ENTITY PARTICIPANT POSTPONEMENT' + 'TABLE PST02T_PARTIP0ST' ISREDIT CHANGE ALL 'ENTITY PARTICIPANT TO PARTICIPANT' + 'TABLE PRT05T_PARTIPARTI' ISREDIT CHANGE ALL 'ENTITY PAYINST CNTL NBR' + 'TABLE UTL43T_PINSCNTLNBR' ISREDIT CHANGE ALL 'ENTITY PAYMENT' + 'TABLE MNT20T_PAYMENT' ISREDIT CHANGE ALL 'ENTITY PAYMENT DUE DAYS' + 'TABLE GVA24T_PMTDUEDAYS' ISREDIT CHANGE ALL 'ENTITY PAYMENT INSTRUMENT' + 'TABLE MNT23T_PMTINSTRMNT' ISREDIT CHANGE ALL 'ENTITY PAYMENT STUB' + 'TABLE MNT22T_PAYMENTSTUB' ISREDIT CHANGE ALL 'ENTITY PHONE' + 'TABLE PRT04T_PARTIPHONE' ISREDIT CHANGE ALL 'ENTITY PLCY CLM DOC RQMT' + 'TABLE GNT52T_CLMDOCRQMT' ISREDIT CHANGE ALL 'ENTITY PLCY CLM OPT' + 'TABLE GNT50T_PLCYCLMOPT' ISREDIT CHANGE ALL 'ENTITY PLCY CLM TYPE OPT' + 'TABLE GNT51T_CLMTYPEOPT' ISREDIT CHANGE ALL 'ENTITY PLCY CONSOL DOC RQMT' + 'TABLE GNT21T_CONSOLDOCRQ' ISREDIT CHANGE ALL 'ENTITY PLCY CONSOL OPT' + 'TABLE GNT20T_CONSOLOPT' ISREDIT CHANGE ALL 'ENTITY PLCY DELIQ OPT' + 'TABLE GNT40T_PLCYDELQOPT' ISREDIT CHANGE ALL 'ENTITY PLCY DELIQ RQMT' + 'TABLE GNT41T_PLCYDELQRQM' ISREDIT CHANGE ALL 'ENTITY PLCY DISB METH' + 'TABLE GNT31T_DISBMETH' ISREDIT CHANGE ALL 'ENTITY PLCY DISB OPT' + 'TABLE GNT30T_PLCYDISBOPT' ISREDIT CHANGE ALL 'ENTITY PLCY FEE' + 'TABLE GNT72T_PLCYFEE' ISREDIT CHANGE ALL 'ENTITY PLCY GRACE' + 'TABLE GNT71T_PLCYGRACE' ISREDIT CHANGE ALL 'ENTITY PLCY INT OPT' + 'TABLE GNT73T_PLCYINTOPT' ISREDIT CHANGE ALL 'ENTITY PLCY LOAN TYPE OPT' + 'TABLE GNT70T_LOANTYPEOPT' ISREDIT CHANGE ALL 'ENTITY PLCY POST OPT' + 'TABLE GNT12T_PLCYPOSTOPT' ISREDIT CHANGE ALL 'ENTITY PLCY SKP RQMT' + 'TABLE GNT13T_PLCYSKPRQMT' ISREDIT CHANGE ALL 'ENTITY POLICY' + 'TABLE GNT10T_POLICY' ISREDIT CHANGE ALL 'ENTITY POSTPONEMENT' + 'TABLE PST01T_POSTPONEMNT' ISREDIT CHANGE ALL 'ENTITY POSTPONEMENT TYPES' + 'TABLE GVA51T_POSTTYPE' ISREDIT CHANGE ALL 'ENTITY RATE BY LOAN TYPE' + 'TABLE GVA40T_LOANRATE' ISREDIT CHANGE ALL 'ENTITY REPAY CONVERT' + 'TABLE GVA22T_REPAYCONV' ISREDIT CHANGE ALL 'ENTITY REPAY PERIOD OPT' + 'TABLE GVA23T_REPAYPRDOPT' ISREDIT CHANGE ALL 'ENTITY SAP CATEGORIES' + 'TABLE GVA06T_SAPCAT' ISREDIT CHANGE ALL 'ENTITY SAP ELIGIBILITY' + 'TABLE GVA26T_SAPELIG' ISREDIT CHANGE ALL 'ENTITY SCHL CNTCT PERSON' + 'TABLE SCH03T_SCHLCNTCT' ISREDIT CHANGE ALL 'ENTITY SCHOOL' + 'TABLE SCH01T_SCHOOL' ISREDIT CHANGE ALL 'ENTITY SCHOOL ADDRESS' + 'TABLE SCH02T_SCHLADDR' ISREDIT CHANGE ALL 'ENTITY SCHOOL COMMENT' + 'TABLE SCH90T_SCHLCOMMENT' ISREDIT CHANGE ALL 'ENTITY SCHOOL EFT OPT' + 'TABLE SCH09T_SCHLEFTOPT' ISREDIT CHANGE ALL 'ENTITY SCHOOL ELIG' + 'TABLE SCH07T_SCHLELIG' ISREDIT CHANGE ALL 'ENTITY SCHOOL OPEN' + 'TABLE SCH06T_SCHLOPEN' ISREDIT CHANGE ALL 'ENTITY SCHOOL RELSHP' + 'TABLE SCH08T_SCHLRELSHP' ISREDIT CHANGE ALL 'ENTITY SECURITY' + 'TABLE ADM21T_SECURITY' ISREDIT CHANGE ALL 'ENTITY SERVICER' + 'TABLE SVC01T_SERVICER' ISREDIT CHANGE ALL 'ENTITY SERVICER ACH' + 'TABLE SVC14T_SVCRACH' ISREDIT CHANGE ALL 'ENTITY SUBSYS DEFN' + 'TABLE ADM20T_SUBSYSDEFN' ISREDIT CHANGE ALL 'ENTITY SUSPENSE COMMENT' + 'TABLE SSP02T_SUSPCMT' ISREDIT CHANGE ALL 'ENTITY SUSPENSE TRANSACTION' + 'TABLE SSP01T_SUSPTRAN' ISREDIT CHANGE ALL 'ENTITY SVCR ADDRESS' + 'TABLE SVC02T_SVCRADDR' ISREDIT CHANGE ALL 'ENTITY SVCR BILL OPT' + 'TABLE SVC10T_SVCRBILLOPT' ISREDIT CHANGE ALL 'ENTITY SVCR CALENDAR' + 'TABLE SVC09T_SVCRCALENDR' ISREDIT CHANGE ALL 'ENTITY SVCR CHKUP OPT' + 'TABLE SVC07T_SVCRCHKPOPT' ISREDIT CHANGE ALL 'ENTITY SVCR CNTCT PERSN' + 'TABLE SVC03T_SVCRCNTCT' ISREDIT CHANGE ALL 'ENTITY SVCR COMM OPT' + 'TABLE SVC13T_COMMOPT' ISREDIT CHANGE ALL 'ENTITY SVCR COMMENT' + 'TABLE SVC90T_SVCRCOMMENT' ISREDIT CHANGE ALL 'ENTITY SVCR DISB OPT' + 'TABLE SVC11T_SVCRDISBOPT' ISREDIT CHANGE ALL 'ENTITY SVCR DUEDIL RQMT' + 'TABLE SVC06T_SVCRDDLRQMT' ISREDIT CHANGE ALL 'ENTITY SVCR FEE' + 'TABLE SVC04T_SVCRFEE' ISREDIT CHANGE ALL 'ENTITY SVCR HOURS' + 'TABLE SVC08T_SVCRHOURS' ISREDIT CHANGE ALL 'ENTITY SVCR PMNT DD OPT' + 'TABLE SVC05T_SVCRPMNTDD' ISREDIT CHANGE ALL 'ENTITY SVCR SKPTRC OPT' + 'TABLE SVC12T_SVCRSKPOPT' ISREDIT CHANGE ALL 'ENTITY TIME ZONE' + 'TABLE UTL30T_TIMEZONE' ISREDIT CHANGE ALL 'ENTITY USER JOB GRP' + 'TABLE ADM04T_USERJOBGRP' ISREDIT CHANGE ALL 'ENTITY USER JOBCRD LNE' + 'TABLE ADM03T_USERJOBCRD' ISREDIT CHANGE ALL 'ENTITY USER LANGUAGE' + 'TABLE ADM02T_USERLANG' ISREDIT CHANGE ALL 'ENTITY USER PROFILE' + 'TABLE ADM01T_USERPROF' ISREDIT CHANGE ALL 'ENTITY VAR INT TRACKING' + 'TABLE GVA41T_VARINTTRAC' ISREDIT CHANGE ALL 'ENTITY WINDFALL REBATE' + 'TABLE GVA25T_WNDFLLRBT' ISREDIT CHANGE ALL 'ENTITY WRITOFF LIMIT' + 'TABLE HLD05T_WRITOFFLMT' ./ ADD NAME=ADWNORM /* REXX ***************************************************************/ /* UTILITY: ADWNORM */ /* AUTHOR: DAVID LEIGH */ /* FUNCTION: CONVERT A COBOL COPYBOOK INTO AN ADW ENTITY(S) DOING */ /* NORMALIZATION FOR OCCURS CLAUSES. */ /**********************************************************************/ /**********************************************************************/ /* NOTIFY THE USER OF WHAT'S HAPPENING */ /**********************************************************************/ ADDRESS ISPEXEC "control errors return" ZEDLMSG = '*** CREATING A PROGRAM OF THIS COPYBOOK ***' 'CONTROL DISPLAY LOCK' 'DISPLAY MSG(UTLZ000W)' /**********************************************************************/ /* ESTABLISH THIS AS AN EDIT MACRO */ /**********************************************************************/ ADDRESS ISREDIT 'MACRO (PAUSE)' /**********************************************************************/ /* INITIAL PROCESSING */ /* - CREATE A TIMESTAMP STRING */ /* - CREATE A MEMBER NAME */ /**********************************************************************/ UPDATED = SUBSTR(DATE('S'),1,4) || '/' || , SUBSTR(DATE('S'),5,2) || '/' || , SUBSTR(DATE('S'),7,2) || ' ' || , TIME('N') || '-000 ' || , SYSVAR(SYSUID) "(MBR) = MEMBER" "(DSN) = DATASET" IF MBR = '' THEN DO PARSE VAR DSN N.1 '.', N.2 '.', N.3 '.', N.4 '.', N.5 '.', N.6 '.', N.7 '.', N.8 '.' DO I = 8 TO 1 BY -1 IF N.I > '' THEN DO MBR = N.I LEAVE END END END /**********************************************************************/ /* ALLOCATE THE NECESSARY DD'S FOR THE FOREGROUND COMPILE */ /**********************************************************************/ ADDRESS TSO DUMMY = OUTTRAP(NULL) "FREE DD(SYSIN SYSLIB SYSPRINT SYSLIN ", "SYSUT1 SYSUT2 SYSUT3 SYSUT4 SYSUT5 SYSUT6 SYSUT7)" "ALLOC DD(SYSLIB) DUMMY" "ALLOC DD(SYSLIN) DUMMY" "ALLOC DD(SYSUT1) UNIT(SYSDA) SPACE(1,1) CYLINDERS" "ALLOC DD(SYSUT2) UNIT(SYSDA) SPACE(1,1) CYLINDERS" "ALLOC DD(SYSUT3) UNIT(SYSDA) SPACE(1,1) CYLINDERS" "ALLOC DD(SYSUT4) UNIT(SYSDA) SPACE(1,1) CYLINDERS" "ALLOC DD(SYSUT5) UNIT(SYSDA) SPACE(1,1) CYLINDERS" "ALLOC DD(SYSUT6) UNIT(SYSDA) SPACE(1,1) CYLINDERS" "ALLOC DD(SYSUT7) UNIT(SYSDA) SPACE(1,1) CYLINDERS" "ALLOC DD(SYSPRINT) ", "NEW ", "UNIT(SYSDA) ", "SPACE(1,1) CYLINDERS RELEASE ", "RECFM(F B A) LRECL(133) BLKSIZE(23408) DSORG(PS)" "ALLOC DD(SYSIN) ", "NEW ", "UNIT(SYSDA) ", "SPACE(1,1) TRACKS RELEASE ", "RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS)" DROP NULL. /**********************************************************************/ /* MAKE A "PROGRAM" OUT OF THIS COPYBOOK */ /**********************************************************************/ "NEWSTACK" QUEUE ' IDENTIFICATION DIVISION.' QUEUE ' PROGRAM-ID. TESTPGM.' QUEUE ' DATE-COMPILED.' QUEUE ' ENVIRONMENT DIVISION.' QUEUE ' INPUT-OUTPUT SECTION.' QUEUE ' FILE-CONTROL.' QUEUE ' DATA DIVISION.' QUEUE ' FILE SECTION.' QUEUE ' WORKING-STORAGE SECTION.' NUMRECS = QUEUED() "EXECIO" NUMRECS "DISKW SYSIN" "DELSTACK" /**********************************************************************/ /* LOOP THROUGH THE COPYBOOK TO GET NON-COMMENT LINES AND FIND "01" */ /**********************************************************************/ "NEWSTACK" ADDRESS ISREDIT "(X,Y) = NUMBER" IF X = 'ON' & POS(' COBOL',Y) > 0 THEN DO COL1 = 1 COL2 = 66 COL3 = 4 PREFIX = ' ' END ELSE DO COL1 = 7 COL2 = 72 COL3 = 10 PREFIX = '' END /**********************************************************************/ /* LOOK FOR AN "01" LEVEL TO BEGIN THE DATA ELEMENT */ /* - INSERT A DUMMY ONE IF NEEDED */ /**********************************************************************/ "CURSOR = 1 1" "EXCLUDE ALL P'.' "COL1 COL1 NBR = 99 "FIND FIRST P' #' "COL1" "COL2" NX" IF RC = 0 THEN DO "(LN1,CL1) = CURSOR" "FIND NEXT ' ' .ZCSR .ZCSR" "(LN2,CL2) = CURSOR" "(NBR) = LINE .ZCSR" NBR = SUBSTR(NBR,CL1,(CL2-CL1+1)) END IF NBR > 1 THEN QUEUE ' 01 TEMP-LAYOUT-AREA.' "FIND FIRST P'=' "COL1" "COL1" NX" DO WHILE RC = 0 "(SYSIN) = LINE .ZCSR" QUEUE PREFIX || SYSIN "FIND NEXT P'=' "COL1" "COL1" NX" END ADDRESS TSO NUMRECS = QUEUED() "EXECIO" NUMRECS "DISKW SYSIN" "DELSTACK" /**********************************************************************/ /* PUT THE TAIL END ON THE PROGRAM */ /**********************************************************************/ "NEWSTACK" QUEUE ' PROCEDURE DIVISION.' QUEUE ' GOBACK.' NUMRECS = QUEUED() "EXECIO" NUMRECS "DISKW SYSIN (FINIS" "DELSTACK" /**********************************************************************/ /* NOTIFY THE USER OF WHAT'S HAPPENING */ /**********************************************************************/ ADDRESS ISPEXEC ZEDLMSG = '*** COMPILING THE PROGRAM ***' 'CONTROL DISPLAY LOCK' 'DISPLAY MSG(UTLZ000W)' /**********************************************************************/ /* COMPILE THE SUCKER ! */ /**********************************************************************/ ADDRESS ISPEXEC "SELECT PGM(IGYCRCTL)" SAVECC = RC ADDRESS TSO "FREE DD(SYSIN SYSLIB SYSLIN ", "SYSUT1 SYSUT2 SYSUT3 SYSUT4 SYSUT5 SYSUT6 SYSUT7)" IF SAVECC > 4 THEN DO ZEDLMSG = '*** COMPILE UNSUCCESSFUL! RC='SAVECC' ***' ADDRESS ISPEXEC "SETMSG MSG(UTLZ001W)" ADDRESS ISPEXEC "LMINIT DATAID(DID) DDNAME(SYSPRINT)" ADDRESS ISPEXEC "EDIT DATAID("DID")" ADDRESS ISPEXEC "LMFREE DATAID("DID")" EXIT 12 END IF PAUSE = PAUSE THEN DO ADDRESS ISPEXEC "LMINIT DATAID(DID) DDNAME(SYSPRINT)" ADDRESS ISPEXEC "EDIT DATAID("DID")" ADDRESS ISPEXEC "LMFREE DATAID("DID")" END /**********************************************************************/ /* NOTIFY THE USER OF WHAT'S HAPPENING */ /**********************************************************************/ ADDRESS ISPEXEC ZEDLMSG = '*** POSITION THE COMPILE LISTING TO THE LAYOUT ***' 'CONTROL DISPLAY LOCK' 'DISPLAY MSG(UTLZ000W)' /**********************************************************************/ /* LOAD THE COMPILE LISTING INTO A STEM VARIABLE ARRAY AND LOOP */ /* THROUGH IT UNTIL WE GET TO THE PART THAT WE WANT TO PROCESS. */ /**********************************************************************/ ADDRESS TSO "EXECIO * DISKR SYSPRINT (STEM LAYOUT." DO I = 1 TO LAYOUT.0 IF POS('0SOURCE HIERARCHY AND',LAYOUT.I) = 1 THEN LEAVE END /**********************************************************************/ /* NOTIFY THE USER OF WHAT'S HAPPENING */ /**********************************************************************/ ADDRESS ISPEXEC ZEDLMSG = '*** LOAD THE LAYOUT INTO STEM VARIABLE ARRAYS ***' 'CONTROL DISPLAY LOCK' 'DISPLAY MSG(UTLZ000W)' /**********************************************************************/ /* NOW GO THROUGH THE LAYOUT AND PARSE ONLY THE REAL LAYOUT LINES AND */ /* STORE DATA INTO A SET OF STEM ARRAYS: */ /* - LEVEL */ /* - FIELD NAME */ /* - HEX DISPLACEMENT */ /* - FIELD LENGTH */ /* - FIELD TYPE */ /* - OCCURS FLAG */ /**********************************************************************/ X = 0 DO I = I TO LAYOUT.0 IF POS('BLW=0000',LAYOUT.I) > 0 THEN DO X = X + 1 PARSE VAR LAYOUT.I NULL1 LEVEL.X FIELD.X NULL2 FIELD.X = TRANSLATE(STRIP(FIELD.X,T,'.'),'-','_') PARSE VAR LAYOUT.I 83 HEXDISP.X NULL LNGTH.X TYPE.X OFLAG.X IF FIELD.X = 'FILLER' THEN X = X - 1 END END NUMFIELDS = X /**********************************************************************/ /* PUT IN THE STANDARD CONSOLIDATION FILE HEADER */ /**********************************************************************/ ADDRESS TSO "NEWSTACK" QUEUE 'hdr($ADW_CONSOLIDATION_FILE_V2.7$).' /**********************************************************************/ /* NOTIFY THE USER OF WHAT'S HAPPENING */ /**********************************************************************/ ADDRESS ISPEXEC ZEDLMSG = '*** CREATE OBJECT INSTANCES IN THE STACK ***' 'CONTROL DISPLAY LOCK' 'DISPLAY MSG(UTLZ000W)' /**********************************************************************/ /* PUT THE OBJECT INSTANCES INTO THE CONSOLIDATION FILE AND DETERMINE */ /* THE ENTITIES. */ /**********************************************************************/ DO I = 1 TO NUMFIELDS /******************************************************************/ /* THE "01" LEVEL BECOMES THE "ROOT" OR "TOP" LEVEL PARENT ENTITY.*/ /******************************************************************/ IF LEVEL.I = 1 THEN DO NTT = 1 ENTNBR.NTT = I || '0,0,1' QUEUE 'cns_oi(t('I'0,0,1),10007,$'FIELD.I'$).' END /******************************************************************/ /* "CHILD" ENTITIES ARE ANY ELEMENTS WHICH HAVE AN OCCURS CLAUSE */ /* THAT CREATES A 1:M RELATIONSHIP. OCCURS WITHIN OCCURS WILL */ /* CREATE "GENERATIONS" OF PARENT-CHILD RELATIONSHIPS. */ /******************************************************************/ IF OFLAG.I = 'O' THEN DO PARNTT = NTT NTT = NTT + 1 ENTNBR.NTT = I || '0,0,1' J = I - 1 DO J = J TO 1 BY -1 IF TYPE.J ¬= 'GROUP' THEN LEAVE END J = J + 1 ENTLVL.NTT = LEVEL.J PARNBR.I = ENTNBR.PARNTT QUEUE 'cns_oi(t('I'0,0,1),10007,$'FIELD.I'$).' END /******************************************************************/ /* CREATE THE OBJECT INSTANCES FOR ATTRIBUTES AND INFORMATION */ /* TYPES AND INFORMATION TYPE VALUE SETS. */ /******************************************************************/ IF TYPE.I ¬= 'GROUP' & LEVEL.I > 1 THEN DO IF LEVEL.I <= ENTLVL.NTT THEN NTT = NTT - 1 ENT.I = ENTNBR.NTT QUEUE 'cns_oi(t('I'1,0,1),10003,$$).' QUEUE 'cns_oi(t('I'2,0,1),10094,$'FIELD.I'$).' QUEUE 'cns_oi(t('I'3,0,1),10095,$$).' END END /**********************************************************************/ /* NOTIFY THE USER OF WHAT'S HAPPENING */ /**********************************************************************/ ADDRESS ISPEXEC ZEDLMSG = '*** CREATE ASSOCIATION INSTANCES IN THE STACK ***' 'CONTROL DISPLAY LOCK' 'DISPLAY MSG(UTLZ000W)' /**********************************************************************/ /* PUT THE ASSOCIATION INSTANCES INTO THE CONSOLIDATION FILE. */ /**********************************************************************/ DO I = 1 TO NUMFIELDS /*** INFO-TYPE/VALUE SET, ATTRIBUTE/ENTITY, ENTITY/ENTITY ***/ IF TYPE.I ¬= 'GROUP' & LEVEL.I > 1 THEN DO QUEUE 'cns_ai(t('I'4,0,2),t('I'2,0,1),20211,t('I'3,0,1)).' QUEUE 'cns_ai(t('I'5,0,2),t('I'1,0,1),20450,t('I'2,0,1)).' QUEUE 'cns_ai(t('I'6,0,2),t('I'1,0,1),20007,t('ENT.I')).' END /*** CHILD TO PARENT ***/ IF OFLAG.I = 'O' THEN DO QUEUE 'cns_ai(t('I'7,0,2),t('PARNBR.I'),20044,t('I'0,0,1)).' END END /**********************************************************************/ /* PUT THE PROPERTY INSTANCES INTO THE CONSOLIDATION FILE. */ /**********************************************************************/ DO I = 1 TO NUMFIELDS /*** "ROOT" ENTITY ***/ IF LEVEL.I = 1 THEN DO NTT = 1 ATT = 0 ENTNBR.NTT = ENTNBR.1 QUEUE 'cns_pi(t(0,0,3),t('ENTNBR.1'),30025,0,$FUNDAMENTAL$).' QUEUE 'cns_pi(t(0,0,3),t('ENTNBR.1'),30028,0,.0,0,0,0,0,0.).' QUEUE 'cns_pi(t(0,0,3),t('ENTNBR.1'),30075,0,$'UPDATED'$).' QUEUE 'cns_pi(t(0,0,3),t('ENTNBR.1'),30110,0,$'UPDATED'$).' END /*** "CHILD" ENTITIES ***/ IF OFLAG.I = 'O' THEN DO NTT = NTT + 1 ATT = 0 ENTNBR.NTT = I || '0,0,1' QUEUE 'cns_pi(t(0,0,3),t('ENTNBR.NTT'),30025,0,$ATTRIBUTIVE$).' QUEUE 'cns_pi(t(0,0,3),t('ENTNBR.NTT'),30028,0,', '.'NTT',0,'NTT',0,0,0.).' QUEUE 'cns_pi(t(0,0,3),t('ENTNBR.NTT'),30075,0,$'UPDATED'$).' QUEUE 'cns_pi(t(0,0,3),t('ENTNBR.NTT'),30110,0,$'UPDATED'$).' QUEUE 'cns_pi(t(0,0,3),t('I'7,0,2),30034,0,$has$).' QUEUE 'cns_pi(t(0,0,3),t('I'7,0,2),30037,0,$is_for$).' QUEUE 'cns_pi(t(0,0,3),t('I'7,0,2),30068,0,' ||, '$1 M 1 1$).' QUEUE 'cns_pi(t(0,0,3),t('I'7,0,2),30075,0,$'UPDATED'$).' QUEUE 'cns_pi(t(0,0,3),t('I'7,0,2),30110,0,$'UPDATED'$).' END /*** ATTRIBUTE, INFO-TYPE, VALUE SET ***/ IF TYPE.I ¬= 'GROUP' & LEVEL.I > 1 THEN DO LNGTH.I = STRIP(LNGTH.I,T,'C') LNGTH.I = STRIP(LNGTH.I,T,'P') ATT = ATT + 1 ENT.I = ENTNBR.NTT SELECT WHEN TYPE.I = 'DISPLAY' THEN DO SETTYPE = 'ALPHANUM' VALUTYPE = 'CHARACTER' END WHEN TYPE.I = 'DISP-NUM' THEN DO SETTYPE = 'NUMBER' VALUTYPE = 'NUMERIC' END WHEN TYPE.I = 'BINARY' THEN DO SETTYPE = 'INTEGER' VALUTYPE = 'NUMERIC' END WHEN TYPE.I = 'PACKED-DEC' THEN DO SETTYPE = 'FORMATTED' VALUTYPE = 'NUMERIC' LNGTH.I = LNGTH.I * 2 - 1 END OTHERWISE NOP END QUEUE 'cns_pi(t(0,0,3),t('I'2,0,1),30075,0,$'UPDATED'$).' QUEUE 'cns_pi(t(0,0,3),t('I'2,0,1),30110,0,$'UPDATED'$).' QUEUE 'cns_pi(t(0,0,3),t('I'3,0,1),30075,0,$'UPDATED'$).' QUEUE 'cns_pi(t(0,0,3),t('I'3,0,1),30110,0,$'UPDATED'$).' queue 'cns_pi(t(0,0,3),t('i'3,0,1),30116,0,$'FIELD.I'$).' IF TYPE.I = 'PACKED-DEC' THEN DO QUEUE 'cns_pi(t(0,0,3),t('I'3,0,1),30458,0,$0$).' QUEUE 'cns_pi(t(0,0,3),t('I'3,0,1),30459,0,$'LNGTH.I'$).' END QUEUE 'cns_pi(t(0,0,3),t('I'3,0,1),30460,0,$'SETTYPE'$).' QUEUE 'cns_pi(t(0,0,3),t('I'3,0,1),30463,0,$'VALUTYPE'$).' IF TYPE.I ¬= 'PACKED-DEC' THEN DO QUEUE 'cns_pi(t(0,0,3),t('I'3,0,1),30464,0,$'LNGTH.I'$).' END QUEUE 'cns_pi(t(0,0,3),t('I'1,0,1),30011,0,$'FIELD.I'$).' QUEUE 'cns_pi(t(0,0,3),t('I'1,0,1),30054,0,.'ATT',0.).' QUEUE 'cns_pi(t(0,0,3),t('I'1,0,1),30067,0,$1 1$).' QUEUE 'cns_pi(t(0,0,3),t('I'1,0,1),30075,0,$'UPDATED'$).' QUEUE 'cns_pi(t(0,0,3),t('I'1,0,1),30110,0,$'UPDATED'$).' END END /**********************************************************************/ /* NOTIFY THE USER OF WHAT'S HAPPENING */ /**********************************************************************/ ADDRESS ISPEXEC ZEDLMSG = '*** CREATE THE CONSOLIDATION FILE FROM THE STACK ***' 'CONTROL DISPLAY LOCK' 'DISPLAY MSG(UTLZ000W)' /**********************************************************************/ /* UNLOAD THE STUFF INTO THE CONSOLIDATION FILE AND EDIT IT. */ /**********************************************************************/ TEMPFILE = SYSVAR(SYSUID) || '.TEMP.ADW.LAYOUT.' || MBR ADDRESS TSO DUMMY = OUTTRAP(NULL) "FREE DD(TEMPOUT)" "DELETE '"TEMPFILE"'" "ALLOCATE DD(TEMPOUT) DSN('"TEMPFILE"')" , "NEW CATALOG" , "UNIT(SYSDA) VOLUME(WRK$$$)" , "SPACE(1,1) CYLINDERS RELEASE" , "RECFM(F B) LRECL(255) BLKSIZE(23460) DSORG(PS)" DROP NULL. NUMRECS = QUEUED() "EXECIO" NUMRECS "DISKW TEMPOUT (FINIS" "FREE DD(TEMPOUT)" ADDRESS ISPEXEC "EDIT DATASET('"TEMPFILE"')" ./ ADD NAME=ADWNUMBR ISREDIT MACRO (OPT) ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /********************************************************************** /* SET UP ADW TYPES IN VARIABLES * /********************************************************************** SET TABLESPACE = 10147 SET PARTITION = 10148 SET STOGROUP_CONTAINS_PARTITION = 20480 SET SUBSYSTEM_CONTAINS_TABLESPACE = 20483 SET COMPONENT_CONTAINS = 20487 SET LAST_UPDATED = 30075 SET CREATED = 30110 SET PHYSICAL_NAME = 30336 SET TABLESPACE_TYPE = 30558 SET BUFFER_POOL = 30562 SET CLOSE_RULE = 31089 SET PRIMARY_QUANTITY = 31093 SET SECONDARY_QUANTITY = 31094 SET FREEPAGE = 31096 SET PERCENT_FREE_SPACE = 31097 SET LOCKSIZE = 31104 SET SEGMENT_SIZE = 31105 /********************************************************************** /* SORT THE DATA TO PROCESS IT CORRECTLY * /********************************************************************** ISREDIT SORT .ZFIRST .ZLAST 1 8 /********************************************************************** /* LOOP THROUGH THE DATA AND INCREMENT MASK NUMBERS * /********************************************************************** ISREDIT FIND FIRST P'@' 1 NX DO WHILE &LASTCC = 0 ISREDIT LABEL .ZCSR = .BEGIN SET INCR = &INCR + 1 ISREDIT (LINE) = LINE .ZCSR SET TSNAME = &SUBSTR(1:8,&STR(&SYSNSUB(1,&LINE))) SET ZEDSMSG = &STR(WORKING ON &TSNAME) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000) SET NUMBER = &SUBSTR(15:19,&STR(&SYSNSUB(1,&LINE))) SET NEWNUM = &NUMBER + &INCR SET NEWNUM = &SUBSTR(&LENGTH(&STR(00000&NEWNUM))-4:+ &LENGTH(&STR(00000&NEWNUM)),+ &STR(00000&NEWNUM)) ISREDIT FIND LAST '&STR(&TSNAME)' 1 ISREDIT LABEL .ZCSR = .END ISREDIT CHANGE '&NUMBER' '&NEWNUM' 15 ALL .BEGIN .END ISREDIT CHANGE '&NUMBER' '&NEWNUM' 33 ALL .BEGIN .END ISREDIT CHANGE '&NUMBER' '&NEWNUM' 45 ALL .BEGIN .END ISREDIT FIND FIRST P'=' 1 .BEGIN .END /********************************************************************** /* PROCESS SPECIFIC LINE TYPES SEPARATELY AND REMOVE TS NAME PREFIX * /********************************************************************** DO WHILE &LASTCC = 0 ISREDIT (LINE) = LINE .ZCSR SET LINETYPE = &SUBSTR(21:25,&STR(&SYSNSUB(1,&LINE))) SELECT (&STR(&LINETYPE)) WHEN (&STR(&TABLESPACE)) DO END WHEN (&STR(&PARTITION)) DO END WHEN (&STR(&STOGROUP_CONTAINS_PARTITION)) DO END WHEN (&STR(&SUBSYSTEM_CONTAINS_TABLESPACE)) DO END WHEN (&STR(&COMPONENT_CONTAINS)) DO END WHEN (&STR(&LAST_UPDATED)) DO END WHEN (&STR(&CREATED)) DO END WHEN (&STR(&PHYSICAL_NAME)) DO END WHEN (&STR(&TABLESPACE_TYPE)) DO END WHEN (&STR(&BUFFER_POOL)) DO END WHEN (&STR(&CLOSE_RULE)) DO END WHEN (&STR(&PRIMARY_QUANTITY)) DO SET VAL = &SUBSTR(34:43,&STR(&SYSNSUB(1,&LINE))) SET VAX = &VAL ISREDIT CHANGE FIRST '&STR(&VAL)' '&VAX' 34 .ZCSR .ZCSR END WHEN (&STR(&SECONDARY_QUANTITY)) DO SET VAL = &SUBSTR(34:38,&STR(&SYSNSUB(1,&LINE))) SET VAX = &VAL ISREDIT CHANGE FIRST '&STR(&VAL)' '&VAX' 34 .ZCSR .ZCSR END WHEN (&STR(&FREEPAGE)) DO SET VAL = &SUBSTR(34:38,&STR(&SYSNSUB(1,&LINE))) SET VAX = &VAL ISREDIT CHANGE FIRST '&STR(&VAL)' '&VAX' 34 .ZCSR .ZCSR END WHEN (&STR(&PERCENT_FREE_SPACE)) DO SET VAL = &SUBSTR(34:38,&STR(&SYSNSUB(1,&LINE))) SET VAX = &VAL ISREDIT CHANGE FIRST '&STR(&VAL)' '&VAX' 34 .ZCSR .ZCSR END WHEN (&STR(&LOCKSIZE)) DO END WHEN (&STR(&SEGMENT_SIZE)) DO SET VAL = &SUBSTR(34:38,&STR(&SYSNSUB(1,&LINE))) SET VAX = &VAL ISREDIT CHANGE FIRST '&STR(&VAL)' '&VAX' 34 .ZCSR .ZCSR END OTHERWISE DO ISREDIT (LNUM) = LINENUM .ZCSR WRITE &STR(UNKNOWN TYPE: &LINETYPE ON LINE: &LNUM) END END ISREDIT SHIFT ( .ZCSR 8 ISREDIT FIND NEXT P'=' 1 .BEGIN .END END ISREDIT FIND NEXT P'@' 1 NX END /********************************************************************** /* RESORT THE DATA FOR DIVIDING INTO OI, PI, AND AI TYPE FILES * /********************************************************************** ISREDIT SORT .ZFIRST .ZLAST 13 17 ./ ADD NAME=ADW2WORD /********************************************************************** /* UTILITY: ADW2WORD * /* AUTHOR: DAVID LEIGH * /* FUNCTION: THIS EDIT MACRO TAKES INPUT OF AN ADW ATTRIBUTE LIST AND * /* CONVERTS IT INTO THE FORMAT NECESSARY FOR THE * /* DOCUMENTATION SPECIALISTS TO MAINTAIN THE FIELD * /* DOCUMENTATION AND THEN LOAD IT INTO UNISTAR USING * /* JEFF WOKENFUSS'S PROGRAM. * /* CURRENTLY, OTHER THAN THE "DEFINITION" THIS MACRO CAN * /* CAN HANDLE THE PRESENCE OF "PROPERTY" AND "COMMENTS" IN * /* THE INPUT FILE. "COMMENTS" ARE FOLDED INTO THE * /* DEFINITION. "PROPERTIES" ARE DELETED. * /* * /* THE OUTPUT INCLUDES A LINE WHICH INDICATES WHICH ENTITY * /* THIS PARTICULAR ATTRIBUTE DEFINITION IS FOR. IT SHOULD * /* BE DETERMINED WHETHER THE DOCUMENTATION SPECIALISTS NEED * /* THIS INFORMATION. IF NOT, ALL OCCURANCES OF IT SHOULD * /* BE DELETED BEFORE GIVING THEM THE FILE. * /* * /* IF AN ATTRIBUTE IS LISTED FOR MORE THAN ONE ENTITY, THEN * /* THIS ENTITY MARKER LINE IS WHAT DELIMITS THE DEFINITION * /* FOR ONE ENTITY FROM THE DEFINITION FOR ANOTHER ENTITY. IT* /* IS UP TO THE DOCUMENTATION SPECIALISTS TO RECONCILE THE * /* DIFFERENCES IN THE DEFINITION TO COME UP WITH A COMMON * /* DEFINITION. * /********************************************************************** ISREDIT MACRO ISPEXEC CONTROL ERRORS RETURN CONTROL NOMSG NOLIST /********************************************************************** /* INFORM THE USER * /********************************************************************** SET ZEDSMSG = &STR(DELETING BLANKS) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000) /********************************************************************** /* GET RID OF BLANKS AND THEN SET THE DEBUG SWITCH AFTERWARDS * /********************************************************************** ISREDIT %NOBLANK /**** 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 /********************************************************************** /* SET SOME INITIAL VARIABLES * /********************************************************************** SET ACTION = &STR(?) SET TYPE = &STR(F) SET DATEMASK = &STR(??/??/????) SET ZEDSMSG = /********************************************************************** /* MAIN PROCESSING LOOP * /********************************************************************** ISREDIT FIND FIRST 'ATTRIBUTE TYPE: ' 1 SET SAVECC = &LASTCC DO WHILE &SAVECC = 0 /*** GET RID OF KEYWORDS ***/ ISREDIT LABEL .ZCSR = .A ISREDIT FIND NEXT ' COMMENTS ' 1 IF &LASTCC = 0 THEN ISREDIT DELETE .ZCSR ISREDIT FIND NEXT ' DEFINITION ' 1 IF &LASTCC = 0 THEN ISREDIT DELETE .ZCSR /********************************************************************** /* ADW 1.6 FORMAT CODE? * /********************************************************************** /* ISREDIT FIND FIRST ':' .A .A /* ISREDIT FIND NEXT P'¬' .A .A /* ISREDIT (LN1,CL1) = CURSOR /* ISREDIT FIND FIRST '.' .A .A /* ISREDIT (LN2,CL2) = CURSOR /* ISREDIT FIND LAST P'¬' .A .A /* ISREDIT (LN3,CL3) = CURSOR /* ISREDIT CHANGE ' ' '_' ALL &CL2 &CL3 .A .A /* ISREDIT (LINE) = LINE .A /* SET ENTITY = &SUBSTR(&CL1:&CL2-1,&STR(&SYSNSUB(1,&LINE))) /* SET ATTRIB = &SUBSTR(&CL2+1:&CL3,&STR(&SYSNSUB(1,&LINE))) /********************************************************************** /* ADW 2.7 FORMAT CODE? * /********************************************************************** /*** MASSAGE AND CAPTURE ATTRIBUTE AND ENTITY NAMES ***/ ISREDIT FIND FIRST ':' .A .A ISREDIT FIND NEXT P'¬' .A .A ISREDIT (LN1,CL1) = CURSOR ISREDIT FIND NEXT '(' .A .A ISREDIT (LN2,CL2) = CURSOR ISREDIT FIND NEXT ')' .A .A ISREDIT (LN2,CL3) = CURSOR ISREDIT CHANGE ' ' '_' ALL &CL2 &CL3 .A .A ISREDIT (LINE) = LINE .A SET ENTITY = &SUBSTR(&CL2+1:&CL3-1,&STR(&SYSNSUB(1,&LINE))) SET ATTRIB = &SUBSTR(&CL1:&CL2-2,&STR(&SYSNSUB(1,&LINE))) /*** CONTROL BREAK FOR EACH NEW ATTRIBUTE ***/ IF &STR(&ATTRIB) ¬= &STR(&SAVEATTRIB) THEN + DO SET SAVEATTRIB = &STR(&ATTRIB) SET INCR = 0 ISREDIT LINE .A = <1,(ACTION) + 8,(TYPE) + 10,(ATTRIB) + 110,(DATEMASK)> SET ZEDLMSG = &STR(WORKING ON &ATTRIB) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000) END SET INCR = &INCR + 1 /*** INDICATE WHICH ENTITY THIS ATTRIBUTE BELONGS TO ***/ IF &INCR = 1 THEN + DO ISREDIT LINE_AFTER .A = + '&STR(<*** THIS IS FOR ENTITY &ENTITY ***>)' END ELSE + DO ISREDIT LINE .A = + '&STR(<*** THIS IS FOR ENTITY &ENTITY ***>)' END /*** DEAL WITH "PROPERTY" LINES (DELETE THEM) ***/ ISREDIT FIND NEXT ' PROPERTY VALUE ' 1 IF &LASTCC = 0 THEN + DO ISREDIT LABEL .ZCSR = .DELP ISREDIT (DELNUM) = LINENUM .DELP END ELSE + SET DELNUM = ISREDIT FIND NEXT 'ATTRIBUTE TYPE: ' 1 SET SAVECC = &LASTCC IF &SAVECC = 0 AND &DELNUM > 0 THEN + DO ISREDIT (LINENUM) = LINENUM .ZCSR IF &DELNUM < &LINENUM THEN + DO ISREDIT LABEL .ZCSR = .SAVE ISREDIT FIND PREV P'=' 1 ISREDIT DELETE .DELP .ZCSR ISREDIT FIND FIRST P'=' .SAVE .SAVE END END ELSE + IF &DELNUM > 0 THEN + ISREDIT DELETE .DELP .ZLAST END /*** GET RID OF THE HEADER STUFF ***/ ISREDIT FIND FIRST '?' 1 ISREDIT FIND PREV P'=' 1 IF &LASTCC = 0 THEN ISREDIT DELETE .ZFIRST .ZCSR ./ ADD NAME=ALLKEYS PROC 0 HELP /*** CHECK THE DEBUG SWITCH ***/ ISPEXEC VGET DBGSWTCH PROFILE IF &DBGSWTCH = ON THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS IF &HELP = HELP THEN GOTO HELPSEC /********************************************************************** /* UTILITY: ALLKEYS * /* AUTHOR: DAVID LEIGH * /* FUNCTION: YOU CALL ALLKEYS WHEN YOU WANT THE PFKEY CHANGE YOU ARE * /* MAKING TO AFFECT OTHER PROFILE PFKEYS AS WELL. * /********************************************************************** ++++++++++++++++++++++++ FIRST SAVE THE KEY VALUES AS THEY ARE NOW NEXT CALL THE "KEYS" OPTION THEN CHECK TO SEE WHICH ARE CHANGED FOR EACH ONE THAT IS CHANGED, SAVE THE VALUE THAT WAS CHANGED, CREATE A NEW TEMP TABLE ADD A ROW FOR EACH PROFILE TABLE WHICH SHOWS THE VALUE OF THAT PF KEY IN THE OTHER PROFILES ALLOW THE USER TO SELECT WHICH PROFILES TO UPDATE UPDATE THE PROFILES GO ONTO THE NEXT PFKEY VALUE WHICH WAS CHANGED. ++++++++++++++++++++++++ IF &VARIABLE = THEN + DO WRITENR ENTER VARIABLE NAME TO UPDATE: READ VARIABLE SET VARIABLE = &SYSCAPS(&VARIABLE) IF &VARIABLE = THEN + DO SET ZEDLMSG = &STR(*** NO VARIABLE ENTERED *** + NO PROCESSING PERFORMED ***) ISPEXEC SETMSG MSG(UTLZ001) EXIT END END IF &VALUE = THEN + DO WRITENR ENTER VALUE FOR "&VARIABLE": READ VALUE IF &VALUE = THEN + DO SET ZEDLMSG = &STR(*** NO VALUE ENTERED *** + NO PROCESSING PERFORMED ***) ISPEXEC SETMSG MSG(UTLZ001) EXIT END END ISPEXEC LIBDEF ISPTLIB LIBRARY ID(ISPPROF) ISPEXEC LIBDEF ISPTABL LIBRARY ID(ISPPROF) ISPEXEC TBOPEN &PROFILE.PROF WRITE SHARE ISPEXEC TBTOP &PROFILE.PROF ISPEXEC TBSKIP &PROFILE.PROF SAVENAME(SAVEVARS) IF &SYSINDEX(&STR(&VARIABLE),&STR(&SAVEVARS)) = 0 THEN + SET SAVEVARS = &SUBSTR(1:&LENGTH(&STR(&SAVEVARS))-1,+ &STR(&SAVEVARS)) + &STR(&VARIABLE)+ &SUBSTR(&LENGTH(&STR(&SAVEVARS)),&STR(&SAVEVARS)) SET &&VARIABLE = &STR(&VALUE) ISPEXEC TBPUT &PROFILE.PROF SAVE&SAVEVARS ISPEXEC TBCLOSE &PROFILE.PROF ISPEXEC LIBDEF ISPTLIB ISPEXEC LIBDEF ISPTABL EXIT 3,'PGM(ISPOPT) PARM(ISPOPT3 )' ./ ADD NAME=ALLOCLST /* REXX ***************************************************************/ /* UTILITY: ALLOCLST */ /* AUTHOR: DAVID LEIGH */ /* FUNCTION: THIS UTILITY TAKES AN ARGUMENT OF A "DATASET LEVEL" AND */ /* A DD NAME AND THEN ALLOCATES ALL THE DATASETS IT FINDS */ /* WITH THAT "LEVEL" TO THAT DDNAME AS "SHR". THIS MUST BE */ /* RUN IN TSO, NOT IRXJCL. */ /**********************************************************************/ ARG LEVEL DD FILES = '' DUMMY = OUTTRAP(LISTC.) "LISTC LEVEL('"LEVEL"')" DO I = 1 TO LISTC.0 PARSE VAR LISTC.I TYPE NULL DSN IF TYPE = 'NONVSAM' THEN FILES = FILES ", '"DSN"'" END FILES = STRIP(FILES) FILES = STRIP(FILES,'L',',') "FREE DD("DD")" "ALLOCATE DD("DD") DSN("FILES") SHR" SAY '*** TSO "ECHO" MESSAGES FOLLOW ***' DO I = 1 TO LISTC.0 SAY LISTC.I END EXIT ./ ADD NAME=ALLOCMOD TEMPFILE = SYSVAR(SYSUID) ³³ '.TEMP.ADW.LAYOUT.' ³³ MBR ADDRESS TSO DUMMY = OUTTRAP('NULL.') "FREE DD(TEMPOUT)" "DELETE '"TEMPFILE"'" "ALLOCATE DD(TEMPOUT) DSN('"TEMPFILE"')" , "NEW CATALOG" , "UNIT(SYSDA) VOLUME(WRK$$$)" , "SPACE(1,1) CYLINDERS RELEASE" , "RECFM(F B) LRECL(255) DSORG(PS)" DROP NULL. ./ ADD NAME=AND ISREDIT MACRO (OPT) ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ISREDIT CANCEL ./ ADD NAME=APPLCHKM /********************************************************************** /* UTILITY: APPLCHKM * /* AUTHOR: DAVID LEIGH * /* FUNCTION: THIS EDIT MACRO WORKS WITH THE APPLCMPR UTILITY. IT IS * /* AN INITIAL MACRO WHICH SIMPLY CANCELS OUT OF AN EDIT ON * /* THE ENDEVOR PROFILE MEMBER. THIS IS A CHECK TO SEE IF * /* THE USER IS ALREADY IN ENDEVOR. * /********************************************************************** ISREDIT MACRO ISREDIT CANCEL ./ ADD NAME=APPLCMPR /********************************************************************** /* UTILITY: APPLCMPR * /* AUTHOR: DAVID LEIGH * /* FUNCTION: THIS UTILITY COMPARES ALL THE ELEMENTS OF AN APPLICATION * /* USING THE LISTAD ELEMENT AND CREATING PRINTS OF EACH OF * /* THESE COMPONENT ELEMENTS BEGINNING AT DEVL AND BEGINNING * /* AT QUAL (WITH THE SEARCH OPTION). THIS OUTPUT IS THEN * /* WRITTEN TO TWO PDS'S AND THEY ARE COMPARED. * /********************************************************************** PROC 1 CSP_APPLICATION + ROMSL1('QDEVL.STRMSV.MSL') + ROMSL2('QQUAL.STRMSV.MSL') + ROMSL3('MMODO.STRMSV.MSL') + ROMSL4('PEMER.STRMSV.MSL') + ROMSL5('PPROD.STRMSV.MSL') + ACCESS(DIRECT) + ENVIRON(QUAL) + STAGE1(D) + STAGE2(Q) + TYPE(LISTAD) + SYSTEM(STR) + SUBSYS(UNIPAC) + CCID(UTILITY) + CLASS('1,TIME=(1,00)') + BATCH + USERID() + UTILITY(APPLCMPR) + EDIT + HELP /********************************************************************** /* MISCELLANEOUS INITIALIZATION * /********************************************************************** ISPEXEC CONTROL ERRORS RETURN ISPEXEC VGET DBGSWTCH PROFILE 02 IF &DBGSWTCH = ON THEN + 02 CONTROL MSG LIST CONLIST SYMLIST NOFLUSH PROMPT ASIS 00000702 ELSE + 02 CONTROL NOMSG NOLIST NOFLUSH PROMPT ASIS 00000902 IF &HELP = HELP THEN GOTO HELPSEC 02 /********************************************************************** /* CHECK TO SEE IF THE USER IS IN ENDEVOR FIRST * /********************************************************************** IF &BATCH ¬= BATCH THEN + DO ISPEXEC EDIT DATASET('&SYSUID..ISPF.ISPPROF(CTLIPROF)') + MACRO(APPLCHKM) IF &LASTCC = 14 THEN + DO SET ZEDSMSG = SET ZEDLMSG = &STR(*** PLEASE EXIT ENDEVOR BEFORE + EXECUTING "APPLCMPR" ***) ISPEXEC SETMSG MSG(UTLZ001) EXIT END END 02 /********************************************************************** /* GET THE USER'S FULL NAME * /********************************************************************** IF &STR(&USER) > THEN GOTO SETVAR SET USERID = &STR(&SYSUID) SET SYSOUTTRAP = 1000 ACF LIST * END SET SYSOUTTRAP = 0 SET SYSDVAL = &STR(&SYSNSUB(1,&SYSOUTLINE1)) READDVAL A B NAME1 NAME2 NAME3 NAME4 NAME5 SET FULLNAME = &STR(&NAME1 &NAME2 &NAME3 &NAME4 &NAME5) 02 /********************************************************************** /* LOAD THE MSL CONCATENATION TABLE * /********************************************************************** SET OLDMSLS = SET NEWMSLS = ISPEXEC TBCREATE TEMPMSL NOWRITE REPLACE KEYS(MSLNAME) DO &I = 1 TO 20 SET MSLNAME = &STR(&SYSNSUB(2,&&ROMSL&I)) IF &STR(&MSLNAME) > THEN + DO IF &I > 1 THEN + SET OLDMSLS = &STR(&OLDMSLS,ROMSL&I) SET NEWMSLS = &STR(&NEWMSLS,ROMSL&I) ISPEXEC TBADD TEMPMSL END ELSE + SET I = 21 END SET NEWMSLS = &SUBSTR(2:&LENGTH(&STR(&NEWMSLS)),&STR(&NEWMSLS)) SET OLDMSLS = &SUBSTR(2:&LENGTH(&STR(&OLDMSLS)),&STR(&OLDMSLS)) 02 /********************************************************************** /* ESTABLISH SOME PROCESSING VARIABLES * /********************************************************************** SETVAR: + CALL 'SYS2.USC1.LINKLIB(USERINFO)' '&USERID ' SET APPL = &STR(&CSP_APPLICATION) SET COMMENTS = &STR(&APPL COMPARE³&USERID³&SYSSDATE³&SYSSTIME) SET TMESTAMP = &STR(D)+ &SUBSTR(1:2,&STR(&SYSSDATE))+ &SUBSTR(4:5,&STR(&SYSSDATE))+ &SUBSTR(7:8,&STR(&SYSSDATE))+ &STR(.T)+ &SUBSTR(1:2,&STR(&SYSTIME))+ &SUBSTR(4:5,&STR(&SYSTIME))+ &SUBSTR(7:8,&STR(&SYSTIME)) SET TEMPJCL = &STR(&USERID..TEMP.APPLCMPR.&TMESTAMP..JCL) SET TEMPFILE = &STR(&USERID..TEMP.APPLCMPR.&TMESTAMP..ENDEVOR) SET EXITCC = 0 SET LP = &STR(( SET RP = &STR() /********************************************************************** /* INFORM THE USER * /********************************************************************** SET ZEDLMSG = &STR(*** PREPARING TO CALL ENDEVOR TO EXTRACT THE + "LISTAD" FOR "&APPL" ***) IF &BATCH = BATCH THEN WRITE &STR(&ZEDLMSG) ELSE + DO ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY PANEL(MSGPANEL) END /********************************************************************** /* PREPARE FOR A CALL TO ENDEVOR * /********************************************************************** FREE DDNAME(SYSPRINT C1MSGS1 C1PRINT PRINTDD BSTIPT01) ALLOC DD(SYSPRINT) DUMMY IF &DBGSWTCH = ON THEN + ALLOC DD(C1MSGS1) DA(*) ELSE + ALLOC DD(C1MSGS1) DUMMY ALLOC DD(C1PRINT) DUMMY DELETE '&TEMPFILE' ALLOC DD(PRINTDD) + DSN('&TEMPFILE') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK$$$) + SPACE(1,1) CYLINDERS RELEASE + RECFM(F B) LRECL(133) BLKSIZE(23408) DSORG(PS) ALLOC DD(BSTIPT01) + NEW CATALOG + UNIT(SYSDA) + SPACE(1,1) TRACKS RELEASE + RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS) OPENFILE BSTIPT01 OUTPUT SET BSTIPT01 = &STR(PRINT ELEMENTS '&APPL') PUTFILE BSTIPT01 SET BSTIPT01 = &STR(FROM ENVIRONMENT '&ENVIRON' ) PUTFILE BSTIPT01 SET BSTIPT01 = &STR( STAGE '&STAGE1' ) PUTFILE BSTIPT01 SET BSTIPT01 = &STR( SYSTEM '&SYSTEM' ) PUTFILE BSTIPT01 SET BSTIPT01 = &STR( SUBSYSTEM '&SUBSYS' ) PUTFILE BSTIPT01 SET BSTIPT01 = &STR( TYPE '&TYPE') PUTFILE BSTIPT01 SET BSTIPT01 = &STR( TO FILE 'PRINTDD' ) PUTFILE BSTIPT01 SET BSTIPT01 = &STR(OPTIONS NOSEARCH ) PUTFILE BSTIPT01 SET BSTIPT01 = &STR(. ) PUTFILE BSTIPT01 CLOSFILE BSTIPT01 SET ZEDLMSG = &STR(*** EXTRACTING THE "LISTAD" FOR "&APPL" FROM + ENDEVOR ***) IF &BATCH = BATCH THEN WRITE &STR(&ZEDLMSG) ELSE + DO ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY PANEL(MSGPANEL) END ISPEXEC SELECT PGM(NDVRC1) PARM(C1BM3000) SET NDVRCC = &LASTCC FREE DDNAME(SYSPRINT C1MSGS1 C1PRINT PRINTDD BSTIPT01) ISPEXEC EDIT DATASET('&TEMPFILE') MACRO(APPLMACR) /********************************************************************** /* GET OUT IF THERE IS NO LISTAD TYPE * /********************************************************************** ISPEXEC TBQUERY TEMPGET ROWNUM(ROWS) IF &ROWS = 0 THEN + DO SET EXITCC = &NDVRCC IF NDVRCC < 8 THEN + DO SET ZEDLMSG = &STR(*** NO LISTAD ELEMENT FOUND FOR + APPLICATION "&APPL" ***) ISPEXEC SETMSG MSG(UTLZ000) END ELSE + DO SET ZEDLMSG = &STR(*** ENDEVOR CC: &NDVRCC TRYING TO + LIST "&TYPE" ELEMENTS ***) ISPEXEC SETMSG MSG(UTLZ000) END EXIT CODE(&NDVRCC) END /********************************************************************** /* INFORM THE USER * /********************************************************************** SET ZEDLMSG = &STR(*** GENERATING JCL TO COMPARE "&APPL" ***) IF &BATCH = BATCH THEN WRITE &STR(&ZEDLMSG) ELSE + DO ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY PANEL(MSGPANEL) END /********************************************************************** /* GENERATE JCL TO DO THE COMPARE * /********************************************************************** DELETE '&TEMPJCL' FREE DDNAME(ISPFILE) ALLOCATE DDNAME(ISPFILE) DSN('&TEMPJCL') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK$$$) + SPACE(1,1) TRACKS RELEASE + RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS) ISPEXEC FTOPEN ISPEXEC FTINCL APPLCMPR SET SAVECC = &LASTCC ISPEXEC FTCLOSE FREE DDNAME(ISPFILE) IF &EDIT = EDIT THEN + DO IF &SAVECC > 0 THEN + DO ISPEXEC VGET ZERRLM SET ZEDSMSG = &STR(JCL CREATION ERROR) SET ZEDLMSG = &STR(&ZERRLM) ISPEXEC SETMSG MSG(UTLZ001) ISPEXEC EDIT DATASET('&TEMPJCL') END ELSE + DO SET ZEDLMSG = &STR(*** NOTE: YOU MUST SUBMIT THIS + JCL YOURSELF ***) ISPEXEC SETMSG MSG(UTLZ000W) ISPEXEC EDIT DATASET('&TEMPJCL') END END ELSE + DO IF &SAVECC > 0 THEN + DO ISPEXEC VGET ZERRLM SET ZEDSMSG = &STR(JCL CREATION ERROR) SET ZEDLMSG = &STR(&ZERRLM) ISPEXEC SETMSG MSG(UTLZ001) ISPEXEC EDIT DATASET('&TEMPJCL') END ELSE + DO SUBMIT '&TEMPJCL' SET ZEDSMSG = &STR(JOB SUBMITTED) SET ZEDLMSG = &STR(*** THE CREATED JCL WAS SUBMITTED + ***) ISPEXEC SETMSG MSG(UTLZ000) END END /********************************************************************** /* CLEANUP AND GET OUT * /********************************************************************** FINISH: + EXIT /********************************************************************** /* DISPLAY ANY "HELP" WHICH IS AVAILABLE FOR THIS UTILITY * /********************************************************************** HELPSEC: + ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR APPLCMPR UTILITY + *** NO PROCESSING PERFORMED ***) ISPEXEC SETMSG MSG(UTLZ000) EXIT ./ ADD NAME=APPLMACR /********************************************************************** /* UTILITY: APPLMACR * /* AUTHOR: DAVID LEIGH * /* FUNCTION: THIS EDIT MACRO WORKS WITH THE APPLCMPR UTILITY. IT IS * /* AN INITIAL MACRO WHICH PARSES AN ENDEVOR "LISTAD" ELEMENT* /* AND POPULATES A TABLE WITH IT. * /********************************************************************** ISREDIT MACRO ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /********************************************************************** /* PARE DOWN THE OUTPUT TO JUST WHAT IS REQUIRED * /********************************************************************** ISREDIT NUMBER OFF ISREDIT BOUNDS 1 133 ISREDIT EXCLUDE ALL P'=' 1 ISREDIT FIND ALL ' SGRPENVSTAGE' 41 ISREDIT FIND ALL ' PROCENVSTAGE' 41 ISREDIT FIND ALL ' RECDENVSTAGE' 41 ISREDIT FIND ALL ' MAP ENVSTAGE' 41 ISREDIT FIND ALL ' APPLENVSTAGE' 41 ISREDIT FIND ALL ' TBLEENVSTAGE' 41 ISREDIT DELETE ALL X ISREDIT CHANGE ALL P'=' ' ' 1 9 ISREDIT CHANGE ALL P'=' ' ' 46 133 /********************************************************************** /* CREATE MIRROR TEMPORARY TABLES TO HOLD THE ELEMENT NAMES * /* THE DUAL TABLES ARE NECESSARY DURING THE FILE TAILORING TO DO * /* MATCHING, NESTED )DOT FUNCTIONS WITHIN A SINGLE JOBSTEP. * /********************************************************************** ISPEXEC TBCREATE TEMPGET NOWRITE REPLACE KEYS() + NAMES(MAPG NAME TYPE) ISPEXEC TBVCLEAR TEMPGET /********************************************************************** /* FIND WHERE THE BIND PLAN CARDS START AND EXTRACT THE PLAN NAME * /********************************************************************** ISREDIT FIND FIRST P'=' 1 DO WHILE &LASTCC = 0 ISREDIT (SYSDVAL) = LINE .ZCSR READDVAL MAPG NAME TYPE IF &STR(&TYPE) = THEN + DO SET TYPE = &STR(&NAME) SET NAME = &STR(&MAPG) SET MAPG = END ELSE SET TYPE = MAPG ISPEXEC TBADD TEMPGET ISREDIT FIND NEXT P'=' 1 END ISPEXEC TBSORT TEMPGET FIELDS(TYPE,C,A,NAME,C,A) ISPEXEC TBTOP TEMPGET ISREDIT CANCEL ./ ADD NAME=APPLPMAC /********************************************************************** /* UTILITY: APPLPMAC * /* AUTHOR: DAVID LEIGH * /* FUNCTION: THIS EDIT MACRO RUNS AGAINST A FILE OF "APPL" TYPE ESF. * /* IT REDUCES THE ESF TO JUST THE PROLOGUE FOR EACH * /* APPLICATION. IT IS CALLED BY CLIST APPLPROL. * /********************************************************************** ISREDIT MACRO ISPEXEC CONTROL ERRORS RETURN /**** 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 /********************************************************************** /* EXCLUDE EVERYTHING * /********************************************************************** ISREDIT EXCLUDE ALL P'=' 1 /********************************************************************** /* FIND ALL THE BEGINNING LINES OF EACH "APPLICATION" AND MODIFY THEM * /********************************************************************** ISREDIT FIND ALL ':APPL ' 1 ISREDIT CHANGE 32 80 P'=' '' ALL NX ISREDIT CHANGE ':APPL NAME =' + '*** APPLICATION PROLOGUE FOR: ' 1 ALL NX ISREDIT %A 'APPLICATION PROLOGUE FOR:' + '***************************************' NX ISREDIT %B 'APPLICATION PROLOGUE FOR:' + '***************************************' NX /********************************************************************** /* LOOP THROUGH AND FIND ALL THE CONTENTS OF EACH PROLOGUE * /********************************************************************** ISREDIT FIND FIRST ':PROL. ' 1 DO WHILE &LASTCC = 0 ISREDIT (LN,CL) = CURSOR SET X = &X + 1 IF &EVAL(&X//20) = 0 THEN + WRITE &STR(PROLOGUE PROCESSING. ON LINE: &LN) ISREDIT LABEL .ZCSR = .PROL ISREDIT FIND NEXT ':EPROL. ' 1 ISREDIT LABEL .ZCSR = .EPROL ISREDIT FIND ALL P'=' 1 .PROL .EPROL ISREDIT DELETE .PROL .PROL ISREDIT DELETE .EPROL .EPROL ISREDIT FIND NEXT ':PROL. ' 1 END /********************************************************************** /* GET RID OF EVERYTHING THAT WAS NOT FOUND * /********************************************************************** ISREDIT DELETE ALL EXCLUDED /********************************************************************** /* GET RID OF THE UNIPAC COPYRIGHT FLOWER BOX * /********************************************************************** ISREDIT EXCLUDE ALL '* DO NOT COPY!!' 1 ISREDIT EXCLUDE ALL '* THIS DOCUMENT CONTAINS TRADE SE' 1 ISREDIT EXCLUDE ALL '* EXPRESSION OF WHICH IS AN UNPUB' 1 ISREDIT EXCLUDE ALL '* PROTECTED BY THE UNITED STATES ' 1 ISREDIT EXCLUDE ALL '* CONSIDERED A TRADE SECRET OWNED' 1 ISREDIT EXCLUDE ALL '* CORPORATION. ' 1 ISREDIT EXCLUDE ALL '* ' 1 ISREDIT EXCLUDE ALL '* ALL RIGHTS, TITLE, INTEREST, AN' 1 ISREDIT EXCLUDE ALL '* BY UNIPAC SERVICE CORPORATION. ' 1 ISREDIT EXCLUDE ALL '* ACQUIRED, COPIED, MODIFIED, OR ' 1 ISREDIT EXCLUDE ALL '* WHATSOEVER WITHOUT THE EXPRESS ' 1 ISREDIT EXCLUDE ALL '* SERVICE CORPORATION. ' 1 ISREDIT SEEK FIRST P'=' 1 X DO WHILE &LASTCC = 0 ISREDIT (LN,CL) = CURSOR SET X = &X + 1 IF &EVAL(&X//20) = 0 THEN + WRITE &STR(COPYRIGHT PROCESSING. ON LINE: &LN) ISREDIT FIND PREV '***' 1 NX ISREDIT EXCLUDE P'=' .ZCSR .ZCSR FIRST ISREDIT FIND NEXT '***' 1 NX ISREDIT EXCLUDE P'=' .ZCSR .ZCSR FIRST ISREDIT SEEK NEXT P'=' 1 NX ISREDIT SEEK NEXT P'=' 1 X END ISREDIT DELETE ALL EXCLUDED ISREDIT END ./ ADD NAME=APPLPROL /********************************************************************** /* UTILITY: APPLPROL * /* AUTHOR: DAVID LEIGH * /* FUNCTION: THIS CLIST POINTS TO THE ESFOUT DD IN A BATCH JOB AND * /* INVOKES A REFORMATTING EDIT ON THAT DATASET. * /********************************************************************** PROC 0 DEBUG /*** CHECK THE DEBUG SWITCH ***/ IF &DEBUG = DEBUG THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS ISPEXEC LMINIT DATAID(DID) DDNAME(ESFOUT) ENQ(SHRW) ISPEXEC EDIT DATAID(&DID) MACRO(APPLPMAC) SET ZISPFRC = &LASTCC WRITE &STR(RETURN CODE = &ZISPFRC) ISPEXEC VPUT ZISPFRC SHARED EXIT CODE(&ZISPFRC) ./ ADD NAME=ARCHGAP /* rexx ***************************************************************/ /* show the gap between db2 archive logs */ /**********************************************************************/ ADDRESS ISPEXEC 'CONTROL ERRORS RETURN' ADDRESS ISREDIT "MACRO" "change 40 132 p'=' '' all" saveday = '' savehours = '' savemins = '' savesecs = '' savetens = '' "FIND last p'=' 1 nx" do while rc = 0 "(line) = line .zcsr" parse var line n1 "." n2 "." n3 "." n4 "." n5 . day = substr(n3,2,5) hours = substr(n4,2,2) mins = substr(n4,4,2) secs = substr(n4,6,2) tens = substr(n4,8,1) if saveday > '' then do if saveday > day then savehours = savehours + 24 diffhours = savehours - hours if (savemins - mins) < 0 then do diffhours = diffhours - 1 diffmins = mins - savemins end else diffmins = savemins - mins if (savesecs - secs) < 0 then do diffmins = diffmins - 1 diffsecs = secs - savesecs end else diffsecs = savesecs - secs if (savetens - tens) < 0 then do diffsecs = diffsecs - 1 difftens = tens - savetens end else difftens = savetens - tens if difftens < 0 then do diffsecs = diffsecs - 1 difftens = difftens + 10 end if diffsecs < 0 then do diffmins = diffmins - 1 diffsecs = diffsecs + 60 end if diffmins < 0 then do diffhours = diffhours - 1 diffmins = diffmins + 60 end endmark = '' if diffhours = 0 &, diffmins < 10 then endmark = " ****" diffhours = "0"diffhours diffhours = substr(diffhours,length(diffhours)-1,2) diffmins = "0"diffmins diffmins = substr(diffmins,length(diffmins)-1,2) diffsecs = "0"diffsecs diffsecs = substr(diffsecs,length(diffsecs)-1,2) difftime = diffhours":"diffmins":"diffsecs":"difftens"0"endmark diffmsg = "gap til next:" difftime /* say difftime diffmsg*/ "change p'=' '"diffmsg"' 40 .zcsr .zcsr" "find first p'=' .zcsr .zcsr" end saveday = day savehours = hours savemins = mins savesecs = secs savetens = tens "FIND prev p'=' 1 nx" end ./ ADD NAME=ATEND ISREDIT MACRO (STRING,VAR1,VAR2,VAR3,VAR4,VAR5,VAR6,VAR7,VAR8,VAR9) ISPEXEC CONTROL ERRORS RETURN ISPEXEC VGET (DBGSWTCH) PROFILE IF &DBGSWTCH = &STR(ON) THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH ASIS ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS IF &STR(&STRING) = HELP THEN GOTO HELPSEC /********************************************************************** /* EDIT MACRO : ATEND * /* AUTHOR : DAVID LEIGH * /* FUNCTION : PLACE A STRING IN THE FIRST BLANK POSITION AFTER THE * /* LAST NON-BLANK POSITION ON EACH LINE MEETING THE * /* PASSED EDIT CRITERIA. * /********************************************************************** DO &X = 1 TO 9 SET VARIABLES = &SYSCAPS(&STR(&VARIABLES &&VAR&X)) END IF &STR(&VARIABLES) = THEN + DO %YOUSURE COLUMN(10) ROW(5) ZWINTTL('PROCESS ALL LINES?!') IF &LASTCC > 0 THEN + DO SET ZEDLMSG = &STR(*** NO "ATEND" PROCESSING + PERFORMED ***) ISPEXEC SETMSG MSG(UTLZ001) EXIT END END IF (&SUBSTR(1:1,&STR(&STRING)) = &STR(') AND + &SUBSTR(&LENGTH(&STR(&STRING)):+ &LENGTH(&STR(&STRING)),+ &STR(&STRING)) = &STR(')) OR + (&SUBSTR(1:1,&STR(&STRING)) = &STR(") AND + &SUBSTR(&LENGTH(&STR(&STRING)):+ &LENGTH(&STR(&STRING)),+ &STR(&STRING)) = &STR(")) THEN + SET STRING = + &SUBSTR(2:&EVAL(&LENGTH(&STR(&STRING)) - 1),&STR(&STRING)) IF &SYSINDEX(&STR('),&NRSTR(&STRING)) > 0 AND + &SYSINDEX(&STR("),&NRSTR(&STRING)) > 0 THEN + DO SET ZEDLMSG = &STR(*** "ATEND" CANNOT PROCESS + STRINGS WITH BOTH SINGLE AND + DOUBLE QOUTES ***) ISPEXEC SETMSG MSG(UTLZ001) EXIT CODE(8) END SET ZEDLMSG = &STR(PLACING "&STRING" AT END OF LINES W/CRITERIA + "&VARIABLES") ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) SET QT = &STR(') IF &SYSINDEX(&STR('),&NRSTR(&STRING)) > 0 THEN SET QT = &STR(") ISREDIT (SLN,SCL) = CURSOR SET BAD = 0 SET GOOD = 0 ISREDIT (LBOUND,RBOUND) = BOUNDS ISREDIT FIND FIRST P'=' &VARIABLES DO WHILE &LASTCC = 0 ISREDIT FIND LAST P'¬' .ZCSR .ZCSR IF &LASTCC = 0 THEN SET X = 1 ELSE SET X = 0 ISREDIT (LN,CL) = CURSOR SET CL = &CL + &X IF &CL > &RBOUND THEN SET BAD = &BAD + 1 ELSE + DO ISREDIT CHANGE P'=' &QT&NRSTR(&STRING)&QT &CL .ZCSR .ZCSR SET GOOD = &GOOD + 1 END ISREDIT FIND NEXT P'=' 1 &VARIABLES END SET TOTAL = &GOOD + &BAD SET ZEDLMSG = &STR(*** PROCESSED &GOOD OF &TOTAL LINES ***) ISPEXEC SETMSG MSG(UTLZ000) ISREDIT CURSOR = &SLN &SCL EXIT HELPSEC: + 02480000 ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) 02490000 SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR ATEND UTILITY + 02490000 *** NO PROCESSING PERFORMED ***) 02490000 ISPEXEC SETMSG MSG(UTLZ000) 02490000 EXIT ./ ADD NAME=ATFORMAT /* REXX */ /*===================================================================*/ /* */ /* UTILITY: ATFORMAT */ /* */ /* AUTHOR: SYSTEMS ENGINEERING SERVICES, CORP */ /* */ /* FUNCTION: REFORMATS FILES FROM THE OUTPUT DIRECTORY AND PLACES */ /* THEN IN THE DOWNLOAD DIRECTORY TO BE SENT TO THE LAN. */ /* */ /* TO INVOKE: EXECUTED IN BATCH */ /* */ /* INPUT DATASETS: P@UREX.TEST.CNTL(COPYCNTL) */ /* P@UREX.TEST.OUTPUT(XXXXXXXX) */ /* P@UREX.TEST.REXX.CRUD */ /* */ /* OUTPUT DATASETS: P@UREX.TEST.DOWNLOAD(XXXXXXXX) */ /* */ /* OTHER REQUIREMENTS: NONE */ /* */ /* CALLED BY: USRX0001 */ /* */ /* CHANGE LOG: */ /* 06/01/1996 SES ORIGINAL CODE AND TEST. */ /* */ /* 01/08/1999 MRB UPDATED TO UNIPAC STANDARDS. */ /* */ /* 01/14/1999 MRB CORRECTED FORMAT OF PROCFILE */ /* */ /*===================================================================*/ CNTL_LIB = 'P@UREX.TEST.CNTL' OUT_LIB = 'P@UREX.TEST.OUTPUT' DOWN_LIB = 'P@UREX.TEST.DOWNLOAD' CRUD_LIB = 'P@UREX.REXX.CRUD' /*================================================================ == MOVE THE COPYBOOKS FROM THE OUTPUT FILE TO THE DOWNLOAD FILE = ================================================================*/ "ALLOCATE F(CNTLIN) DA('"CNTL_LIB"(COPYCNTL)') SHR REUSE" "EXECIO * DISKR CNTLIN (STEM CNTLIN. FINIS" "FREE F(CNTLIN)" DO X = 1 TO CNTLIN.0 PARSE VAR CNTLIN.X PDS_MEM . "ALLOCATE F(FILEIN) DA('"OUT_LIB"("PDS_MEM")') SHR REUSE" "EXECIO * DISKR FILEIN (STEM FILEIN. FINIS" "FREE F(FILEIN)" "ALLOCATE F(FILEOT) DA('"DOWN_LIB"("PDS_MEM")') SHR REUSE" "EXECIO * DISKW FILEOT (STEM FILEIN. FINIS" "FREE F(FILEOT)" DROP FILEIN. END /*================================================================ == CREATE THE PROGRAMS FILE IN THE DOWNLOAD DIRECTORY = ================================================================*/ "ALLOCATE F(FILEIN) DA('"OUT_LIB"(PROGRAMS)') SHR REUSE" "EXECIO * DISKR FILEIN (STEM FILEIN. FINIS" "FREE F(FILEIN)" DO Y = 1 TO FILEIN.0 PARSE VAR FILEIN.Y PGM_NAME MODE_IND LNG_IND DB2_IND DB2_IND = STRIP(DB2_IND) IF DB2_IND = 'Y' THEN DB2_IND = '1' ELSE DB2_IND = '0' FILEOT.Y = PGM_NAME ³³ ',' ³³ MODE_IND ³³ ',', ³³ LNG_IND ³³ ',' ³³ DB2_IND END "ALLOCATE F(FILEOT) DA('"DOWN_LIB"(PROGRAMS)') SHR REUSE" "EXECIO * DISKW FILEOT (STEM FILEOT. FINIS" "FREE F(FILEOT)" DROP FILEIN. DROP FILEOT. /*================================================================ == REFORMAT THE PRGM2PRC FILE FOR THE XREF DATABASE ======= ================================================================*/ "ALLOCATE F(FILEIN) DA('"OUT_LIB"(PGM2PRC)') SHR REUSE" "EXECIO * DISKR FILEIN (STEM FILEIN. FINIS" "FREE F(FILEIN)" DO Y = 1 TO FILEIN.0 PARSE VAR FILEIN.Y PGM_NAME PROC_NAME STEP_NAME LNG_IND . FILEOT.Y = PGM_NAME ³³ ',' ³³ PROC_NAME ³³ ',', ³³ STEP_NAME ³³ ',' ³³ LNG_IND ³³ ',' END "ALLOCATE F(FILEOT) DA('"DOWN_LIB"(PGM2PRC)') SHR REUSE" "EXECIO * DISKW FILEOT (STEM FILEOT. FINIS" "FREE F(FILEOT)" DROP FILEIN. DROP FILEOT. /*================================================================ == REFORMAT THE PGMFILE FILE AND PUT IN THE DOWNLOAD DIRECTORY == ================================================================*/ "ALLOCATE F(FILEIN) DA('"OUT_LIB"(PGMFILE)') SHR REUSE" "EXECIO * DISKR FILEIN (STEM FILEIN. FINIS" "FREE F(FILEIN)" DO Y = 1 TO FILEIN.0 PARSE VAR FILEIN.Y PGM_NAME FILE_NAME COPY_IND COPY_IND = STRIP(COPY_IND,B) IF COPY_IND = 'Y' THEN COPY_IND = '1' ELSE COPY_IND = '0' FILEOT.Y = PGM_NAME ³³ ',' ³³ FILE_NAME ³³ ',' ³³ COPY_IND END "ALLOCATE F(FILEOT) DA('"DOWN_LIB"(PGMFILE)') SHR REUSE" "EXECIO * DISKW FILEOT (STEM FILEOT. FINIS" "FREE F(FILEOT)" DROP FILEIN. DROP FILEOT. /*================================================================ * REFORMAT THE PROCFILE FILE AND PUT IN THE DOWNLOAD DIRECTORY * ================================================================*/ "ALLOCATE F(FILEIN) DA('"OUT_LIB"(PROCFILE)') SHR REUSE" "EXECIO * DISKR FILEIN (STEM FILEIN. FINIS" "FREE F(FILEIN)" DO Z = 1 TO FILEIN.0 PARSE VAR FILEIN.Z PGM_NAME LIB_NAME FILE_NAME PROC_NAME , STEP_NAME LIB_IND LIB_IND = STRIP(LIB_IND,B) FILEOT.Z = PGM_NAME ³³ ',' ³³ LIB_NAME ³³ ',' ³³ FILE_NAME ³³ ',', ³³ PROC_NAME ³³ ',' ³³ STEP_NAME ³³ ',' ³³ LIB_IND ³³ ',' END "ALLOCATE F(FILEOT) DA('"DOWN_LIB"(PROCFILE)') SHR REUSE" "EXECIO * DISKW FILEOT (STEM FILEOT. FINIS" "FREE F(FILEOT)" DROP FILEOT. /*=============================================================== = REFORMAT THE CRUD MATRIX OUTPUT FROM THE UPDATES EXEC ======== ===============================================================*/ REC_CNT = 0 "ALLOCATE F(GETCRUD) DA('"OUT_LIB"(DDSCAN)') SHR REUSE" "EXECIO * DISKR GETCRUD (STEM RECIN. FINIS" "FREE F(GETCRUD)" DO X = 1 TO RECIN.0 PARSE VAR RECIN.X PGM FNAME FILE RNAME AM RN CRUD /* INITIALIZE VARIABLES */ READ_IND = '0' READ_INTO = '0' REW_IND = '0' WRITE_IND = '0' DELETE_IND = '0' CREAD = '0' CWRITE = '0' CREW = '0' CDELETE = '0' IO_IND = '0' I_IND = '0' O_IND = '0' IF RN = 'Y' THEN RN = '1' IF INDEX(CRUD,'IT') > 0 THEN READ_INTO = '1' IF INDEX(CRUD,'RD') > 0 THEN READ_IND = '1' IF INDEX(CRUD,'RW') > 0 THEN REW_IND = '1' IF INDEX(CRUD,'WR') > 0 THEN WRITE_IND = '1' IF INDEX(CRUD,'DL') > 0 THEN DELETE_IND = '1' IF INDEX(CRUD,'CR ') > 0 THEN CREAD = '1' IF INDEX(CRUD,'CW') > 0 THEN CWRITE = '1' IF INDEX(CRUD,'CRW') > 0 THEN CREW = '1' IF INDEX(CRUD,'CD') > 0 THEN CDELETE = '1' IF INDEX(CRUD,'I-O') > 0 THEN IO_IND = '1' IF INDEX(CRUD,'IP') > 0 THEN I_IND = '1' IF INDEX(CRUD,'OT') > 0 THEN O_IND = '1' REC_CNT = REC_CNT + 1 FILEOT.REC_CNT = PGM ³³ ',' ³³ FNAME ³³ ',' ³³ FILE ³³ ',' ³³ RNAME, ³³ ',' ³³ AM ³³ ',' ³³ RN, ³³ ',' ³³ READ_INTO ³³ ',' ³³ READ_IND, ³³ ',' ³³ REW_IND ³³ ',' ³³ WRITE_IND, ³³ ',' ³³ DELETE_IND ³³ ',' ³³ CREAD, ³³ ',' ³³ CWRITE ³³ ',' ³³ CREW, ³³ ',' ³³ CDELETE ³³ ',' ³³ IO_IND, ³³ ',' ³³ I_IND ³³ ',' ³³ O_IND END "ALLOCATE F(FILEOT) DA('"CRUD_LIB"') SHR REUSE" "EXECIO * DISKW FILEOT (STEM FILEOT. FINIS" "FREE F(FILEOT)" SAY 'FINISHED AT' TIME() EXIT ./ ADD NAME=AUDITMAC /********************************************************************** /* DIVIDE ADPB TOTAL FIGURES BY THE NBR OF DAYS IN THE PERIOD. * /* THAT NBR IS PASSED TO THE PROGRAM. * /********************************************************************** ISREDIT MACRO (DAYS) ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /********************************************************************** /* EDIT FOR NBR OF DAYS PASSED * /********************************************************************** IF &DATATYPE(&DAYS) = CHAR OR &STR(&DAYS) < 1 THEN SET DAYS = 92 /* /* DO /* SET ZEDSMSG = &STR(# DAYS NEEDED) /* SET ZEDLMSG = &STR(PLEASE INVOKE LIKE: "AUDITMAC 92") /* ISPEXEC SETMSG MST(UTLZ001) /* EXIT CODE(12) /* END /********************************************************************** /* PROCESS "BC" FOR PART III * /********************************************************************** WRITE &STR(*** PART III *** BC ***) ISREDIT FIND FIRST ' BC ' 45 DO WHILE &LASTCC = 0 ISREDIT (LINE) = LINE .ZCSR SET SYSDVAL = &SUBSTR(75:89,&STR(&SYSNSUB(1,&LINE))) READDVAL X1 X2 X3 X4 X5 SET NBR = &STR(&X1&X2&X3&X4&X5) SET NBR = &NBR IF &STR(&NBR) > AND + &SYSINDEX(&STR(NUMBER OF ACCTS),&STR(&LINE)) = 0 THEN + ISREDIT CHANGE FIRST P'=' '&STR((&EVAL(&NBR/&DAYS)))' 90 .ZCSR .ZCSR ISREDIT FIND NEXT ' BC ' 45 END /********************************************************************** /* PROCESS "BC" FOR PART IV * /********************************************************************** WRITE &STR(*** PART IV *** BC ***) ISREDIT FIND FIRST ' BC ' 69 DO WHILE &LASTCC = 0 ISREDIT (LINE) = LINE .ZCSR SET SYSDVAL = &SUBSTR(95:107,&STR(&SYSNSUB(1,&LINE))) READDVAL X1 X2 X3 X4 X5 SET NBR = &STR(&X1&X2&X3&X4&X5) SET NBR = &NBR IF &STR(&NBR) > AND + &SYSINDEX(&STR(NUMBER OF ACCTS),&STR(&LINE)) = 0 THEN + ISREDIT CHANGE FIRST P'=' '&STR((&EVAL(&NBR/&DAYS)))' + 110 .ZCSR .ZCSR ISREDIT FIND NEXT ' BC ' 69 END /********************************************************************** /* PROCESS "BI" FOR PART IV * /********************************************************************** WRITE &STR(*** PART IV *** BI ***) ISREDIT FIND FIRST ' BI ' 69 DO WHILE &LASTCC = 0 ISREDIT (LINE) = LINE .ZCSR SET SYSDVAL = &SUBSTR(115:126,&STR(&SYSNSUB(1,&LINE))) READDVAL X1 X2 X3 X4 X5 SET NBR = &STR(&X1&X2&X3&X4&X5) SET NBR = &NBR IF &STR(&NBR) > AND + &SYSINDEX(&STR(NUMBER OF ACCTS),&STR(&LINE)) = 0 THEN + ISREDIT CHANGE FIRST P'=' '&STR((&EVAL(&NBR/&DAYS)))' + 105 .ZCSR .ZCSR ISREDIT FIND NEXT ' BI ' 69 END /********************************************************************** /* PROCESS "BD" FOR PART IV * /********************************************************************** WRITE &STR(*** PART IV *** BD ***) ISREDIT FIND FIRST ' BD ' 69 DO WHILE &LASTCC = 0 ISREDIT (LINE) = LINE .ZCSR SET SYSDVAL = &SUBSTR(115:126,&STR(&SYSNSUB(1,&LINE))) READDVAL X1 X2 X3 X4 X5 SET NBR = &STR(&X1&X2&X3&X4&X5) SET NBR = &NBR IF &STR(&NBR) > AND + &SYSINDEX(&STR(NUMBER OF ACCTS),&STR(&LINE)) = 0 THEN + ISREDIT CHANGE FIRST P'=' '&STR((&EVAL(&NBR/&DAYS)))' + 105 .ZCSR .ZCSR ISREDIT FIND NEXT ' BD ' 69 END ISREDIT END ./ ADD NAME=AUTOPAGE ISREDIT MACRO ISPEXEC CONTROL ERRORS RETURN /**** 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 ISREDIT CHANGE P'=' ' ' 1 ALL SET X = 1 SET LN = 61 ISREDIT CURSOR = &LN 1 DO WHILE &LASTCC = 0 SET X = &X + 1 SET ZEDLMSG = &STR(WORKING ON PAGE: &X) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) ISREDIT FIND FIRST ' ' 1 .ZCSR .ZCSR DO WHILE &LASTCC > 0 SET LN = &LN - 1 ISREDIT CURSOR = &LN 1 ISREDIT FIND FIRST ' ' 1 .ZCSR .ZCSR END ISREDIT CHANGE ' ' '1' 1 .ZCSR .ZCSR SET LN = &LN + 60 ISREDIT CURSOR = &LN 1 END SET ZEDLMSG = &STR(&X PAGES CREATED) ISPEXEC SETMSG MSG(UTLZ000W) ISREDIT CURSOR = 1 1 ./ ADD NAME=B ISREDIT MACRO NOPROCESS (STG1,STG2,OPT1,OPT2,OPT3,OPT4,OPT5,OPT6,OPT7) ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /**********************************************************************/ /* UTILITY NAME : B */ /* DATE WRITTEN : 9-29-88 */ /* AUTHOR : DAVE LEIGH */ /* DESCRIPTION : INSERT 'STRING 2' BEFORE LINE WITH (AN) OCCURANCE(S)*/ /* : OF 'STRING 1' */ /*========================== MODIFICATIONS ===========================*/ /* WHO |WHEN |WHY */ /* --- |---- |--- */ /* DAVE LEIGH |8-11-89 |TOOK OFF THE 'CODE(&MAXCC)' PORTION OF THE */ /* | |EXIT STATEMENT SINCE A CODE OF > 0 WOULD */ /* | |CAUSE THE INVOCATION COMMAND ON THE COMMAND */ /* | |TO REMAIN AFTER IT WAS COMPLETE, AND HITTING*/ /* | |THE LAST LINE OF THE FILE WOULD ALWAYS CAUSE*/ /* | |THE RETURN CODE TO BE > 0. */ /* DAVE LEIGH |8-17-89 |CHANGED &STRING_ TO &NRSTR(&STRING_) TO TAKE*/ /* | |CARE OF STRINGS WITH '&' IN THEM. */ /**********************************************************************/ IF &NRSTR(&STG2) = THEN + IF &NRSTR(&STG1) = &STR(HELP) THEN GOTO HELPSEC ELSE + DO SET ZEDSMSG = &STR(2ND STRING MISSING) ISPEXEC SETMSG MSG(UTLZ001) EXIT CODE(8) END IF &SYSNSUB(1,&STG2) = ZLINE OR + &SYSNSUB(1,&STG2) = &SYSNSUB(0,&ZLINE) THEN + DO ISREDIT PROCESS RANGE Z IF &LASTCC ¬= 0 THEN + DO SET ZEDLMSG = &STR(*** NO LINE MARKED "Z" TO INSERT ***) ISPEXEC SETMSG MSG(UTLZ001) EXIT END ELSE + DO SET I = 0 ISREDIT FIND FIRST P'=' 1 .ZFRANGE .ZLRANGE DO WHILE &LASTCC = 0 SET I = &I + 1 ISREDIT (ZLINE&I) = LINE .ZCSR ISREDIT FIND NEXT P'=' 1 .ZFRANGE .ZLRANGE END SET NUMZ = &I END END ELSE + IF &SUBSTR(1:1,&STR(&SYSNSUB(1,&STG2))) = &STR(') OR + &SUBSTR(1:1,&STR(&SYSNSUB(1,&STG2))) = &STR(") THEN + DO SET X = &LENGTH(&SYSNSUB(1,&STG2)) SET STG2 = &SUBSTR(2:&X-1,&SYSNSUB(1,&STG2)) END SET OPTIONS = &SYSCAPS(&OPT1 &OPT2 &OPT3 &OPT4 &OPT5 &OPT6 &OPT7) ISREDIT (SLINE,SCOL) = CURSOR SET XCOUNT = 0 ISREDIT FIND FIRST &NRSTR(&STG1) &OPTIONS DO WHILE &LASTCC = 0 SET XCOUNT = &XCOUNT + 1 IF &SYSNSUB(1,&STG2) = ZLINE OR + &SYSNSUB(1,&STG2) = &SYSNSUB(0,&ZLINE) THEN + DO ISREDIT LABEL .ZCSR = .CURR DO &I = 1 TO &NUMZ ISREDIT LINE_BEFORE .CURR = (ZLINE&I) ISREDIT FIND PREV P'=' 1 .ZCSR .ZCSR ISREDIT FIND PREV P'=' 1 ISREDIT CHANGE 'XCOUNT' '&XCOUNT' .ZCSR .ZCSR ALL ISREDIT SEEK FIRST P'=' .CURR .CURR END END ELSE + DO ISREDIT LINE_BEFORE .ZCSR = (STG2) ISREDIT FIND PREV P'=' 1 .ZCSR .ZCSR ISREDIT FIND PREV P'=' 1 ISREDIT CHANGE 'XCOUNT' '&XCOUNT' .ZCSR .ZCSR ALL ISREDIT FIND NEXT P'=' 1 END ISREDIT SEEK LAST P'=' .ZCSR .ZCSR ISREDIT FIND NEXT &NRSTR(&STG1) &OPTIONS END ISREDIT CURSOR = &SLINE &SCOL IF &STR(&NUMZ) > 1 THEN SET XCOUNT = &XCOUNT * &NUMZ SET ZEDSMSG = &STR(&XCOUNT LINES INSERTED) ISPEXEC SETMSG MSG(UTLZ000) EXIT HELPSEC: + CLEAR. WRITE *** HELP FOR EDIT MACRO 'B' *** WRITE WRITE THE 'B' EDIT MACRO ALLOWS YOU TO INSERT A LINE OF BEFORE WRITE EVERY LINE IN WHICH OCCURS AT LEAST ONCE. WRITE WRITE BASIC SYNTAX : WRITE WRITE COMMAND ===> B XXXX $$$$ WRITE WRITE FILE VIEW BEFORE COMMAND EXECUTION : WRITE WRITE 000100 AAAA WRITE 000200 BBBB WRITE 000300 XXXX WRITE 000400 CCCC WRITE 000500 XXXX WRITE WRITE FILE VIEW AFTER COMMAND EXECUTION : WRITE WRITE 000100 AAAA WRITE 000200 BBBB WRITE 000201 $$$$ WRITE 000300 XXXX WRITE 000400 CCCC WRITE 000401 $$$$ WRITE 000500 XXXX WRITE WRITE TO PROCESS ONLY EXCLUDED LINES : WRITE WRITE COMMAND ===> B XXXX $$$$ X WRITE WRITE FILE VIEW BEFORE COMMAND EXECUTION : WRITE WRITE 000100 AAAA WRITE 000200 BBBB WRITE X XXXX WRITE 000400 CCCC WRITE 000500 XXXX WRITE WRITE FILE VIEW AFTER COMMAND EXECUTION : WRITE WRITE 000100 AAAA WRITE 000200 BBBB WRITE 000201 $$$$ WRITE 000300 XXXX WRITE 000400 CCCC WRITE 000500 XXXX WRITE WRITE TO PROCESS ONLY INCLUDED LINES : WRITE WRITE COMMAND ===> B XXXX $$$$ NX WRITE WRITE FILE VIEW BEFORE COMMAND EXECUTION : WRITE WRITE 000100 AAAA WRITE 000200 BBBB WRITE X XXXX WRITE 000400 CCCC WRITE 000500 XXXX WRITE WRITE FILE VIEW AFTER COMMAND EXECUTION : WRITE WRITE 000100 AAAA WRITE 000200 BBBB WRITE X XXXX WRITE 000400 CCCC WRITE 000401 $$$$ WRITE 000500 XXXX WRITE WRITE SPECIAL NOTES : IF NEITHER 'X' NOR 'NX' ARE SPECIFIED TO DEAL WITH WRITE EXCLUDED OR INCLUDED LINES, ALL LINES WILL BE WRITE SEARCHED REGARDLESS OF INCLUSION/EXCLUSION STATUS. WRITE WRITE SINGLE/DOUBLE QUOTE USAGE AROUND THE 2 STRINGS IS WRITE IDENTICAL TO THAT OF THE EDIT 'CHANGE' (OR 'C') WRITE COMMAND. WRITE WRITE THE NUMBER OF LINES INSERTED WILL BE PLACED IN THE WRITE SHORT MESSAGE FIELD AT THE UPPER RIGHT HAND CORNER WRITE OF YOUR SCREEN. WRITE WRITE IF YOU SPECIFY 'X' FOR PROCESSING EXCLUDED LINES, WRITE ALL LINES WILL BE RESET AT THE END OF MACRO WRITE EXECUTION. WRITE WRITE IF YOU DO NOT SPECIFY 'X' OR 'NX', AND EXCLUDED WRITE LINES ARE FOUND WHICH CONTAIN THEY WILL WRITE BE RESET. EXIT ./ ADD NAME=BATEDIT0 PROC 2 DATE1 ITER DEBUG /*** CHECK THE DEBUG SWITCH ***/ IF &DEBUG = DEBUG THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS /********************************************************************** /* GET A DATA ID FOR THE CONTENTS DD AND THEN EDIT WITH IT * /********************************************************************** ISPEXEC LMINIT DATAID(DID) DDNAME(CALENDAR) ENQ(SHRW) WRITE &STR(&DATE1 &ITER) ISPEXEC VPUT (DATE1 ITER) SHARED ISPEXEC EDIT DATAID(&DID) MACRO(DATEMACR) EXIT ./ ADD NAME=BBOARD PROC 0 B(NO) CONTROL NOFLUSH NOMSG END(ENDO) ASIS GLOBAL ANS CLEAR /**********************************************************************/ /* */ /* CHEVY CAS BULLETIN BOARD CLIST */ /* */ /* DATE SE DESCRIPTION */ /* 06/14/88 GORTER CREATED */ /* 09/19/88 MONTGOMERY STOLE FROM PDS & MODIFIED */ /* 06/14/89 GOSNELL STOLE FROM CANADA,STOLE FROM PDS & MODIFIED*/ /* */ /**********************************************************************/ ERROR GOTO EXIT3 SET NEW = YES SET DSPLY = &B SET MONTH = &SUBSTR(1:2,&SYSDATE) SET DAY = &SUBSTR(4:5,&SYSDATE) SET YEAR = &SUBSTR(7:8,&SYSDATE) SET JYEAR = &SUBSTR(1:2,&SYSJDATE) SET JDAY = &SUBSTR(4:6,&SYSJDATE) IF &JYEAR > 88 THEN - SET CENTURY = 19 ELSE - SET CENTURY = 20 SET TODAY = &STR(&CENTURY&JYEAR/&JDAY) LISTDSI 'TCWCA.TWB.BULLETIN' IF &LASTCC < 5 THEN - IF &STR(&SYSREFDATE) = &STR(&TODAY) THEN - SET NEW = NO WRITE - *************************************************************** WRITE - * * WRITE - * C H E V Y C A S B U L L E T I N B O A R D * WRITE - * * WRITE - *************************************************************** WRITE ALLOC F(DD2) DA('TCWCA.TWB.BULLETIN') SHR OPENFILE DD2 INPUT IF &NEW = YES THEN - DO ALLOC F(DD3) DA('TCWCA.TWB.BULLETHS') MOD ALLOC F(DD4) DA('TCWCA.TWB.BULLETTM') SHR ALLOC F(RR) DA('TCWCA.TWBAT.RULES') SHR OPENFILE DD3 OUTPUT OPENFILE DD4 OUTPUT OPENFILE RR INPUT GOTO BLDQDJ ENDO CONTINUE: - ERROR GOTO EXIT2 SET &COUNT = 0 PROCESS2: + GETFILE DD2 SET &TDATE = &SUBSTR(73:80,&DD2) SET &TMONTH = &SUBSTR(73:74,&DD2) SET &TDAY = &SUBSTR(76:77,&DD2) SET &TYEAR = &SUBSTR(79:80,&DD2) IF &STR(&TDATE) = &STR( ) AND &NEW ¬= YES THEN GOTO DISPLAY /*YEAR*/ IF &YEAR GT &TYEAR THEN GOTO PURGE2 /*MONTH*/ IF &YEAR EQ &TYEAR AND - &MONTH GT &TMONTH THEN GOTO PURGE2 /* DAY */ IF &YEAR EQ &TYEAR AND - &MONTH EQ &TMONTH AND - &DAY GT &TDAY THEN GOTO PURGE2 DISPLAY: - IF &STR(&TDATE) > &STR( ) OR &B = YES THEN - WRITE &SUBSTR(1:72,&DD2) IF &NEW = YES THEN - DO SET &DD4 = &DD2 PUTFILE DD4 ENDO IF &STR(&TDATE) = &STR(99/99/99) OR - &STR(&TDATE) = &STR( ) THEN /* CONTINUE ELSE + SET &COUNT = &COUNT + 1 GOTO PROCESS2 PURGE2: + IF &NEW = YES AND &STR(&TDATE) > &STR( ) THEN - DO SET &DD3 = &DD2 PUTFILE DD3 ENDO GOTO PROCESS2 EXIT2: + ERROR OFF CLOSFILE DD2 FREE F(DD2) IF &NEW = YES THEN - DO CLOSFILE DD3 FREE F(DD3) CLOSFILE DD4 FREE F(DD4) CLOSFILE RR FREE f(RR) ENDO EXIT3: + ERROR EXIT CODE(4) IF &NEW = YES THEN - DO RENAME 'TCWCA.TWB.BULLETIN' 'TCWCA.TWB.BULL' RENAME 'TCWCA.TWB.BULLETTM' 'TCWCA.TWB.BULLETIN' RENAME 'TCWCA.TWB.BULL' 'TCWCA.TWB.BULLETTM' ENDO IF &COUNT > 0 THEN ELSE WRITE - * NO MESSAGES TODAY * WRITE - * * WRITE - *************************************************************** WRITE EXIT4: + SET ANS = WRITENR &STR(PRESS TO CONTINUE ) READ &ANS EXIT CODE(0) /********************************************************************** BLDQDJ: - IF (&DAY - ((&DAY / 2) * 2)) = 0 THEN SET NT = 366 - &JDAY ELSE SET NT = &JDAY DO WHILE &NT > 100 SET NT = &NT - 100 ENDO /*SET T = &SYSTIME /*SET S1 = &SUBSTR(5,&T) /*SET S3 = &SUBSTR(8,&T) /*SET NT = &STR(&S2)&STR(&S1) SET RULENO = &NT SET N = 1 ERROR - DO SET RC = &LASTCC ERROR OFF IF &RC > 0 THEN - IF &RC = 400 THEN GOTO MAINLINE ELSE GOTO CONTINUE ENDO GETFILE RR DO WHILE &N < &RULENO GETFILE RR SET N = &N + 1 ENDO MAINLINE: - SET TEXT = &RR SET L = &LENGTH(&STR(&TEXT)) IF &L = 0 THEN GOTO CONTINUE SET QDJ = &STR( - Quote du Jour -) SET DD4 = &STR(&QDJ) PUTFILE DD4 SET DD4 = &STR( ) PUTFILE DD4 IF &DSPLY = YES THEN - DO WRITE &STR(&QDJ) WRITE ENDO SET H = &SYSINDEX(&STR(:),&STR(&TEXT)) IF &H > 0 THEN - DO SET HEADING = &SUBSTR(1:&H,&STR(&TEXT)) SET TEXT = &SUBSTR(&H+1:&L,&STR(&TEXT)) ENDO SET L = &LENGTH(&STR(&TEXT)) SET S = &SYSINDEX(&STR(›),&STR(&TEXT)) IF &S > 0 THEN - DO SET SIGNATR = &SUBSTR(&S+1:&L,&STR(&TEXT)) SET TEXT = &SUBSTR(1:&S-1,&STR(&TEXT)) ENDO SET &WBODY = &STR(&TEXT) IF &STR(&HEADING) > &STR( ) THEN - DO SET DD4 = &STR( &HEADING) PUTFILE DD4 IF &DSPLY = YES THEN - WRITE &STR( &HEADING) ENDO SET &LL = &LENGTH(&STR(&WBODY)) IF &LL > 60 THEN GOTO SPLTBODY ELSE SET &DBODY = &STR(&WBODY) NEXT: - SET DD4 = &STR( &DBODY) PUTFILE DD4 IF &DSPLY = YES THEN - WRITE &STR( &DBODY) IF &SIGNATR > &STR( ) THEN - DO SET DD4 = &STR( -- &SIGNATR) PUTFILE DD4 IF &DSPLY = YES THEN - WRITE &STR( -- &SIGNATR) ENDO SET DD4 = &STR( ) PUTFILE DD4 IF &DSPLY = YES THEN - WRITE GOTO CONTINUE SPLTBODY: - DO WHILE &LL > 60 SET &C = 60 SET &CH = &SUBSTR(&C,&STR(&WBODY)) DO WHILE &STR(&CH) ¬= &STR( ) SET &C = &C - 1 SET &CH = &SUBSTR(&C,&STR(&WBODY)) ENDO SET &DBODY = &SUBSTR(1:&C,&STR(&WBODY)) SET DD4 = &STR( &DBODY) PUTFILE DD4 IF &DSPLY = YES THEN - WRITE &STR( &DBODY) SET &C = &C + 1 SET &TL = &LENGTH(&STR(&WBODY)) IF &C <= &TL THEN - SET &WBODY = &SUBSTR(&C:&LL,&STR(&WBODY)) ELSE - SET &WBODY = SET &LL = &LENGTH(&STR(&WBODY)) ENDO IF &LL > 0 THEN - SET &DBODY = &STR(&WBODY) GOTO NEXT ./ ADD NAME=BBOARDXX PROC 0 B(NO) CONTROL NOFLUSH NOMSG END(ENDO) GLOBAL ANS CLEAR /**********************************************************************/ /* */ /* CHEVY CAS BULLETIN BOARD CLIST */ /* */ /* DATE SE DESCRIPTION */ /* 06/14/88 GORTER CREATED */ /* 09/19/88 MONTGOMERY STOLE FROM PDS & MODIFIED */ /* 06/14/89 GOSNELL STOLE FROM CANADA,STOLE FROM PDS & MODIFIED*/ /* */ /**********************************************************************/ ERROR GOTO EXIT3 SET NEW = YES SET MONTH = &SUBSTR(1:2,&SYSDATE) SET DAY = &SUBSTR(4:5,&SYSDATE) SET YEAR = &SUBSTR(7:8,&SYSDATE) SET JYEAR = &SUBSTR(1:2,&SYSJDATE) SET JDAY = &SUBSTR(4:6,&SYSJDATE) IF &JYEAR > 88 THEN - SET CENTURY = 19 ELSE - SET CENTURY = 20 SET TODAY = &STR(&CENTURY&JYEAR/&JDAY) LISTDSI 'TCWCA.TWB.BULLETIN' IF &LASTCC < 5 THEN - IF &STR(&SYSREFDATE) = &STR(&TODAY) THEN - SET NEW = NO WRITE - *************************************************************** WRITE - * * WRITE - * C H E V Y C A S B U L L E T I N B O A R D * WRITE - * * WRITE - *************************************************************** WRITE IF &B = YES THEN %BONMOT WRITE ALLOC F(DD2) DA('TCWCA.TWB.BULLETIN') SHR OPENFILE DD2 INPUT IF &NEW = YES THEN - DO ALLOC F(DD3) DA('TCWCA.TWB.BULLETHS') MOD ALLOC F(DD4) DA('TCWCA.TWB.BULLETTM') SHR OPENFILE DD3 OUTPUT OPENFILE DD4 OUTPUT ENDO ERROR GOTO EXIT2 SET &COUNT = 0 PROCESS2: + GETFILE DD2 SET &TMONTH = &SUBSTR(73:74,&DD2) SET &TDAY = &SUBSTR(76:77,&DD2) SET &TYEAR = &SUBSTR(79:80,&DD2) /*YEAR*/ IF &YEAR GT &TYEAR THEN GOTO PURGE2 /*MONTH*/ IF &YEAR EQ &TYEAR AND - &MONTH GT &TMONTH THEN GOTO PURGE2 /* DAY */ IF &YEAR EQ &TYEAR AND - &MONTH EQ &TMONTH AND - &DAY GT &TDAY THEN GOTO PURGE2 WRITE &SUBSTR(1:72,&DD2) IF &NEW = YES THEN - DO SET &DD4 = &DD2 PUTFILE DD4 ENDO IF &TYEAR EQ 99 AND &TMONTH EQ 99 AND &TDAY EQ 99 THEN ELSE + SET &COUNT = &COUNT + 1 GOTO PROCESS2 PURGE2: + IF &NEW = YES THEN - DO SET &DD3 = &DD2 PUTFILE DD3 ENDO GOTO PROCESS2 EXIT2: + ERROR OFF CLOSFILE DD2 FREE F(DD2) IF &NEW = YES THEN - DO CLOSFILE DD3 FREE F(DD3) CLOSFILE DD4 FREE F(DD4) ENDO EXIT3: + ERROR EXIT CODE(4) IF &NEW = YES THEN - DO RENAME 'TCWCA.TWB.BULLETIN' 'TCWCA.TWB.BULL' RENAME 'TCWCA.TWB.BULLETTM' 'TCWCA.TWB.BULLETIN' RENAME 'TCWCA.TWB.BULL' 'TCWCA.TWB.BULLETTM' ENDO IF &COUNT > 0 THEN ELSE WRITE - * NO MESSAGES TODAY * WRITE - * * WRITE - *************************************************************** WRITE EXIT4: + WRITENR &STR(PRESS TO CONTINUE ) READ &ANS EXIT CODE(0) ./ ADD NAME=BC ISREDIT MACRO ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /********************************************************************** /* UTILITY : BC * /* AUTHOR : DAVE LEIGH * /* FUNCTION : EDIT A COMPILE LISTING. * /********************************************************************** ISREDIT (MEMBER) = MEMBER ISPEXEC BROWSE DATASET('&SYSUID..COMPILE.LISTING.&MEMBER') EXIT ./ ADD NAME=BIMONTH PROC 0 /********************************************************************/ /* BIMONTH - THIS CLIST IS USED TO DETERMINE THE PASSWORD OF THE */ /* SO-CALLED "SUPERID'S" WHICH ARE RESET AUTOMATICALLY */ /* BIMONTHLY. IT IS CALLED BY A MULTITUDE OF CLISTS THAT */ /* SIMPLY CALL IT AND VGET "ACF2PW" SHARED. AFTER THEY */ /* USE IT, THEY SHOULD CLEAR THE VARIABLE AND VPUT IT */ /* AGAIN. DUE TO THE SENSETIVE NATURE OF THE PROCESSING */ /* THE DEBUG SWITCH DOES NOT OPERATE AGAINST THIS CLIST. */ /* AUTHOR - DAVE LEIGH */ /* DATE - 12-28-89 */ /********************************************************************/ CONTROL NOMSG NOLIST NOFLUSH NOPROMPT SET WDINDATE = &STR(&SYSDATE) SET WDINFMT = &STR(11) SET WDINMOD = &STR(11) ISPEXEC VPUT (WDINDATE WDINFMT WDINMOD) SHARED ISPEXEC SELECT PGM(WADATPGM) ISPEXEC VGET (WDFMT32I WDFMT00I) SHARED SET ACF2PW = &SUBSTR(1:3,&STR(&WDFMT32I)) IF &SUBSTR(4:5,&STR(&WDFMT32I)) < 15 THEN + SET ACF2PW = &STR(&ACF2PW.01) ELSE + SET ACF2PW = &STR(&ACF2PW.02) ISPEXEC VPUT (ACF2PW) SHARED EXIT ./ ADD NAME=BINDCARD /********************************************************************** /* UTILITY: BINDCARD * /* AUTHOR: DAVID LEIGH * /* FUNCTION: THIS UTILITY GENERATES BIND PLAN CARDS AND ENDEVOR SCL * /* FROM REQUESTS ENTERED ON A PANEL BY PROGRAMMERS. THESE * /* BIND CARDS ARE THEN ENTERED INTO ENDEVOR BY THE DBA'S * /* USING THE ENDEVOR SCL WHICH IS ALSO GENERATED. * /********************************************************************** PROC 0 TEMPJCL('&SYSUID..TEMP.BINDCARD.JCL') + TEMPFILE(&SYSUID..TEMP.ENDEVOR) + ENVIRON(QUAL) + STAGE(D) + TYPE(BINDBTCH) + SYSTEM(STR) + SUBSYS(UNIPAC) + OWNER(BINDADM) + VALIDATE(BIND) + RETAIN(RETAIN) + NUMAPPL(15) + SENDDEST('D@UDAL D@UJEF D@ULJS') + HELP /********************************************************************** /* MISCELLANEOUS INITIALIZATION * /********************************************************************** ISPEXEC CONTROL ERRORS RETURN ISPEXEC VGET DBGSWTCH PROFILE 02 IF &DBGSWTCH = ON THEN + 02 CONTROL MSG LIST CONLIST SYMLIST NOFLUSH PROMPT ASIS 00000702 ELSE + 02 CONTROL NOMSG NOLIST NOFLUSH PROMPT ASIS 00000902 IF &HELP = HELP THEN GOTO HELPSEC 02 /********************************************************************** /* GET THE USER'S FULL NAME * /********************************************************************** SET SYSOUTTRAP = 1000 ACF LIST * END SET SYSOUTTRAP = 0 SET SYSDVAL = &STR(&SYSNSUB(1,&SYSOUTLINE1)) READDVAL A B NAME1 NAME2 NAME3 NAME4 NAME5 SET FULLNAME = &STR(&NAME1 &NAME2 &NAME3 &NAME4 &NAME5) 02 /********************************************************************** /* ESTABLISH SOME PROCESSING VARIABLES * /********************************************************************** CALL 'SYS2.USC1.LINKLIB(USERINFO)' '&SYSUID ' ISPEXEC VPUT NUMAPPL SHARED SET EXITCC = 0 SET LP = &STR(( SET RP = &STR() /********************************************************************** /* DISPLAY THE PANEL * /********************************************************************** REDISPLAY: + SET GENERATE = ISPEXEC DISPLAY PANEL(BINDCARD) IF &LASTCC > 7 THEN + DO IF &STR(&GENERATE) = Y THEN + DO SET ZEDSMSG = SET ZEDLMSG = &STR(*** SET GENERATE TO "N" BEFORE + QUITTING OR PRESS TO + GENERATE ***) ISPEXEC SETMSG MSG(UTLZ001) GOTO REDISPLAY END GOTO FINISH END ELSE + SELECT /**********************************************************************/ /* PRESENT A LIST OF ELEMENTS OF THIS TYPE TO CHOOSE FROM */ /**********************************************************************/ WHEN (&STR(&APP0) = &STR(?)) DO ISPEXEC EDIT DATASET('&SYSUID..ISPF.ISPPROF(CTLIPROF)') + MACRO(APPLCHKM) IF &LASTCC = 14 THEN + DO SET ZEDSMSG = SET ZEDLMSG = &STR(*** CANNOT CONTINUE UNTIL YOU + ARE OUT OF ENDEVOR ***) ISPEXEC SETMSG MSG(UTLZ001) END ELSE + DO ISPEXEC SELECT CMD(%BINDGET + &STR(&ENVIRON) + &STR(&STAGE) + &STR(&TYPE) + &STR(&SYSTEM) + &STR(&SUBSYS)) ISPEXEC VGET APP0 SHARED END GOTO REDISPLAY END /**********************************************************************/ /* NOTHING TO DO NOW */ /**********************************************************************/ WHEN (&GENERATE = N AND &ACTION = ADD) GOTO REDISPLAY /**********************************************************************/ /* GET A LIST OF CALLED APPLICATIONS FOR THIS APPLICATION */ /**********************************************************************/ WHEN (&GENERATE = N AND &ACTION ¬= ADD) DO /*GOTO FIX_NDVRC1 ISPEXEC EDIT DATASET('&SYSUID..ISPF.ISPPROF(CTLIPROF)') + MACRO(APPLCHKM) IF &LASTCC = 14 THEN + DO SET ZEDSMSG = SET ZEDLMSG = &STR(*** CANNOT CONTINUE UNTIL YOU + ARE OUT OF ENDEVOR ***) ISPEXEC SETMSG MSG(UTLZ001) GOTO REDISPLAY END SET ZEDSMSG = SET ZEDLMSG = &STR(*** PREPARING TO CALL + ENDEVOR TO FIND "&APP0" ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000) FREE DDNAME(SYSPRINT C1MSGS1 C1PRINT PRINTDD BSTIPT01) ALLOC DD(SYSPRINT) DUMMY IF &DBGSWTCH = ON THEN + 02 ALLOC DD(C1MSGS1) DA(*) ELSE + ALLOC DD(C1MSGS1) DUMMY ALLOC DD(C1PRINT) DUMMY DELETE '&TEMPFILE' ALLOC DD(PRINTDD) + DSN('&TEMPFILE') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK$$$) + SPACE(1,1) CYLINDERS RELEASE + RECFM(F B) LRECL(133) BLKSIZE(23408) DSORG(PS) ALLOC DD(BSTIPT01) + NEW CATALOG + UNIT(SYSDA) + SPACE(1,1) TRACKS RELEASE + RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS) OPENFILE BSTIPT01 OUTPUT SET BSTIPT01 = &STR(PRINT ELEMENT '&APP0' ) PUTFILE BSTIPT01 SET BSTIPT01 = &STR(FROM ENVIRONMENT '&ENVIRON' ) PUTFILE BSTIPT01 SET BSTIPT01 = &STR( STAGE '&STAGE' ) PUTFILE BSTIPT01 SET BSTIPT01 = &STR( SYSTEM '&SYSTEM' ) PUTFILE BSTIPT01 SET BSTIPT01 = &STR( SUBSYSTEM '&SUBSYS' ) PUTFILE BSTIPT01 SET BSTIPT01 = &STR( TYPE '&TYPE') PUTFILE BSTIPT01 SET BSTIPT01 = &STR( TO FILE 'PRINTDD' ) PUTFILE BSTIPT01 SET BSTIPT01 = &STR(OPTIONS SEARCH ) PUTFILE BSTIPT01 SET BSTIPT01 = &STR(. ) PUTFILE BSTIPT01 CLOSFILE BSTIPT01 SET ZEDSMSG = SET ZEDLMSG = &STR(*** EXTRACTING "&APP0" + FROM ENDEVOR ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000) ISPEXEC SELECT PGM(NDVRC1) PARM(C1BM3000) SET NDVRCC = &LASTCC FREE DDNAME(SYSPRINT C1MSGS1 C1PRINT PRINTDD BSTIPT01) ISPEXEC EDIT DATASET('&TEMPFILE') MACRO(BINDCRDM) ISPEXEC VGET VARS SHARED ISPEXEC VGET (&STR(&VARS)) SHARED IF &EDITCC < 8 THEN + DO SET ZEDSMSG = SET ZEDLMSG = &STR(*** VALUES FOR "&APP0" + WERE SUCCESSFULLY EXTRACTED + FROM ENDEVOR ***) ISPEXEC SETMSG MSG(UTLZ000) END ELSE + DO SET ZEDSMSG = SET ZEDLMSG = &STR(*** NO BIND CARDS FOR "&APP0" + FOUND IN ENDEVOR ***) ISPEXEC SETMSG MSG(UTLZ001) END GOTO REDISPLAY END END /********************************************************************** /* LOAD A TEMPORARY TABLE WITH ALL THE APPLICATIONS * /********************************************************************** SET ZEDSMSG = SET ZEDLMSG = &STR(*** GENERATING JCL TO UPDATE ENDEVOR ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000) ISPEXEC TBCREATE TEMPTABL NOWRITE REPLACE KEYS(APPLICAT) IF &STR(&DB2) = Y THEN + DO SET APPLICAT = &STR(&APP0) ISPEXEC TBADD TEMPTABL END /**********************************************************************/ /* LOAD UP THE TABLE WITH THE PACKAGE LIST. */ /* */ /* 12/8/97 - GET RID OF OLD REFERENCES TO EP02A, EP03A AND SC50A */ /**********************************************************************/ DO &I = 1 TO &NUMAPPL SET APPLICAT = &STR(&SYSNSUB(2,&&APP&I)) IF &STR(&APPLICAT) > AND + &STR(&APPLICAT) ¬= &STR(EP02A) AND + &STR(&APPLICAT) ¬= &STR(EP03A) AND + &STR(&APPLICAT) ¬= &STR(SC50A) THEN ISPEXEC TBADD TEMPTABL END /********************************************************************** /* THE FOLLOWING SECTION ADDS STANDARD APPLICATIONS WHICH MUST BE * /* PRESENT IN EVERY PLAN. SINCE THE TABLE IS KEYED, IF THEY EXIST, * /* THEY WON'T BE ADDED TWICE, BUT IF THEY DON'T EXIST ALREADY, THEY * /* WILL BE ADDED. * /********************************************************************** SET APPLICAT = &STR(EPB0002) /* ERROR PROCESSING APPLICATION */ ISPEXEC TBADD TEMPTABL ISPEXEC TBTOP TEMPTABL ISPEXEC TBQUERY TEMPTABL ROWNUM(ENDROW) /********************************************************************** /* USE FILE TAILORING TO CREATE THE JOB * /********************************************************************** DELETE '&TEMPJCL' FREE DDNAME(ISPFILE) ALLOCATE DDNAME(ISPFILE) DSN('&TEMPJCL') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK$$$) + SPACE(1,1) TRACKS RELEASE + RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS) ISPEXEC FTOPEN ISPEXEC FTINCL BINDCARD SET SAVECC = &LASTCC ISPEXEC FTCLOSE FREE DDNAME(ISPFILE) IF &SAVECC > 0 THEN + DO SET ZEDSMSG = &STR(JCL CREATION ERROR) SET ZEDLMSG = &STR(ENDEVOR UPDATE JCL CREATION FAILED + WITH RC: &SAVECC) ISPEXEC SETMSG MSG(UTLZ001) IF &JCLREVEW = Y THEN ISPEXEC EDIT DATASET('&TEMPJCL') END ELSE + DO IF &STR(&DEFAULTS) = N THEN + DO SEND '&STR("&FULLNAME" CREATED BATCH BIND PLAN + REQUEST "&APP0" ON &SYSSDATE AT &SYSTIME)' + USER(&SENDDEST) LOGON SEND '&STR(!!!!! NON-DEFAULT VALUE(S) USED !!!!!)' + USER(&SENDDEST) LOGON END IF &JCLREVEW = Y THEN + DO SET ZEDSMSG = SET ZEDLMSG = &STR(*** YOU MUST SUBMIT THIS JOB + YOURSELF ***) ISPEXEC SETMSG MSG(UTLZ001) ISPEXEC EDIT DATASET('&TEMPJCL') END ELSE + DO SUBMIT '&TEMPJCL' SET ZEDSMSG = &STR(ENDEVOR JOB SUBMITTED) SET ZEDLMSG = &STR(ENDEVOR UPDATE JOB WAS CREATED + AND SUBMITTED) ISPEXEC SETMSG MSG(UTLZ000) END END GOTO REDISPLAY /********************************************************************** /* CLEANUP AND GET OUT * /********************************************************************** FINISH: + EXIT /********************************************************************** /* DISPLAY ANY "HELP" WHICH IS AVAILABLE FOR THIS UTILITY * /********************************************************************** HELPSEC: + ISPEXEC SELECT PGM(ISPTUTOR) PARM(BINDCRDA) SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR BINDCARD UTILITY + *** NO PROCESSING PERFORMED ***) ISPEXEC SETMSG MSG(UTLZ000) EXIT ./ ADD NAME=BINDCOPY /* REXX ***************************************************************/ /* UTILITY: BINDCOPY */ /* AUTHOR: DAVID LEIGH/JANET FREDERICK */ /* FUNCTION: THIS UTILITY CONTROLS FILE TAILORING OF A JOB WHICH WILL */ /* CREATE BIND COPY STATEMENTS FROM THE LATEST VERSION OF */ /* SELECTED PACKAGES. */ /* THIS VERSION TO BE USED TO CREATE BIND COPY STATEMENTS */ /* TO COPY PACKAGES FROM A CURRENTLY EXISTING PRODUCTION */ /* COLLECTION TO A NEW PRODUCTION COLLECTION - SAY FOR A */ /* NEW REMOTE DATABASE */ /**********************************************************************/ ADDRESS ISPEXEC "CONTROL ERRORS RETURN" /**********************************************************************/ /* READ THE PARM FILE TO SET TARGET VALUES */ /**********************************************************************/ ADDRESS TSO "EXECIO * DISKR PARMFILE (STEM PARM. FINIS)" DO I = 1 TO PARM.0 PARSE UPPER VAR PARM.I VARNAME VARVALUE NULL SELECT WHEN VARNAME = 'COLLID' THEN COLLID = VARVALUE WHEN VARNAME = 'OWNER' THEN OWNER = VARVALUE WHEN VARNAME = 'QUALIFIER' THEN QUAL = VARVALUE END END /**********************************************************************/ /* READ THE INPUT FILE TO PARSE AND LOAD THE TEMP TABLE */ /**********************************************************************/ "TBCREATE BINDTABL NOWRITE REPLACE NAMES(INCOLL PGMNAME VERSION)" ADDRESS TSO "EXECIO * DISKR INFILE (STEM INREC. FINIS)" DO I = 1 TO INREC.0 INREC.I = TRANSLATE(INREC.I,' ','00'X) PARSE UPPER VAR INREC.I INCOLL 19 PGMNAME 27 29 VERSION NULL INCOLL = STRIP(INCOLL) PGMNAME = STRIP(PGMNAME) VERSION = STRIP(VERSION) "TBADD BINDTABL" END "TBTOP BINDTABL" /**********************************************************************/ /* FILE TAILOR TO CREATE THE BIND CARDS */ /**********************************************************************/ "FTOPEN" "FTINCL BINDCOPY" SAY 'BINDCOPY FILE TAILOR RC =' RC "FTCLOSE" EXIT ./ ADD NAME=BINDCPY /* REXX ***************************************************************/ /* MACRO: BINDCPY */ /* AUTHOR: DAVID LEIGH */ /* FUNCTION: THIS EDIT MACRO TAKES A PACKAGE REBIND */ /* AND CONVERTS THE REBIND CARDS TO */ /* A BIND COPY. */ /* IT'S EXPECTING THE INPUT TO HAVE BEEN */ /* GENERATED BY AN "LREBIND" COMMAND IN PLATINUM. */ /**********************************************************************/ ADDRESS ISPEXEC 'CONTROL ERRORS RETURN' ADDRESS ISREDIT "MACRO" "FIND FIRST 'REBIND PACKAGE('" "(LINE) = LINE .ZCSR" PARSE UPPER VAR LINE 'REBIND PACKAGE(' INPKG '.(' PKGVER '))' NULL "LINE_BEFORE .ZCSR = 'BIND PACKAGE(DSNTDDF.P@UXXX_COLLECTION) -'" "LINE_BEFORE .ZCSR = 'COPY("INPKG") -'" "LINE_BEFORE .ZCSR = 'COPYVER("PKGVER") -'" "DELETE .ZCSR .ZCSR" "CHANGE 'BINDADM' 'P@UXXX' ALL" "CHANGE 'EXPLAIN(YES)' 'EXPLAIN(NO)' FIRST" "FIND FIRST 'QUALIFIER('" "(LINE) = LINE .ZCSR" PARSE UPPER VAR LINE 'QUALIFIER(' QUAL ')' NULL "CHANGE '"QUAL"' 'P@UXXX'" ./ ADD NAME=BINDCRDM /********************************************************************** /* UTILITY: BINDCRDM * /* AUTHOR: DAVID LEIGH * /* FUNCTION: THIS EDIT MACRO WORKS WITH THE BINDCARD UTILITY. IT IS * /* AN INITIAL MACRO WHICH PARSES AN ENDEVOR "PRINT" OF SOME * /* BIND PLAN CARDS AND PUTS THE INFORMATION INTO VARIABLES * /* TO DISPLAY ON THE BINDCARD MAIN PANEL. * /********************************************************************** ISREDIT MACRO ISPEXEC CONTROL ERRORS CANCEL /**** 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 ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /********************************************************************** /* PRESET SOME VARIABLES * /********************************************************************** SET VARS = &STR(DB2 ISOLATE ACQUIRE RELEASE EDITCC) SET EDITCC = 0 ISPEXEC VGET NUMAPPL SHARED /********************************************************************** /* FIND WHERE THE BIND PLAN CARDS START AND EXTRACT THE PLAN NAME * /********************************************************************** ISREDIT FIND FIRST ' PLAN(' IF &LASTCC ¬= 0 THEN + DO SET EDITCC = 12 GOTO FINISH END ISREDIT FIND NEXT '(' .ZCSR .ZCSR ISREDIT FIND NEXT P'=' .ZCSR .ZCSR ISREDIT (LN1,CL1) = CURSOR ISREDIT FIND NEXT ')' .ZCSR .ZCSR ISREDIT FIND PREV P'=' .ZCSR .ZCSR ISREDIT (LN2,CL2) = CURSOR ISREDIT (LINE) = LINE .ZCSR SET PLAN = &SUBSTR(&CL1:&CL2,&STR(&SYSNSUB(1,&LINE))) /********************************************************************** /* THE FOLLOWING "IF" TAKES INTO ACCOUNT A MODIFICATION TO THE BIND- * /* CARD SKELETON WHICH ADDED A "?" AFTER THE MAIN APPLICATION NAME * /* FOR JCLPREP PURPOSES. THIS "IF" REMOVES THAT "?". * /********************************************************************** IF &SYSINDEX(&STR(?),&STR(&PLAN)) = &LENGTH(&STR(&PLAN)) THEN + SET PLAN = &SUBSTR(&CL1:&CL2-1,&STR(&SYSNSUB(1,&LINE))) SET APP0 = &STR(&PLAN) SET I = 1 SET DB2 = N /********************************************************************** /* EXTRACT THE PACKAGE LIST * /********************************************************************** ISREDIT FIND NEXT ' *.' DO WHILE &LASTCC = 0 ISREDIT FIND NEXT '.' .ZCSR .ZCSR ISREDIT FIND NEXT P'=' .ZCSR .ZCSR ISREDIT (LN1,CL1) = CURSOR ISREDIT FIND NEXT ' ' .ZCSR .ZCSR ISREDIT FIND PREV P'=' .ZCSR .ZCSR ISREDIT (LN2,CL2) = CURSOR ISREDIT (LINE) = LINE .ZCSR SET PKG = &SUBSTR(&CL1:&CL2,&STR(&SYSNSUB(1,&LINE))) SELECT WHEN (&STR(&PKG) = &STR(&PLAN)) SET DB2 = Y WHEN (&STR(&PKG) = &STR(EP03A)) NOP WHEN (&STR(&PKG) = &STR(SC50A)) NOP WHEN (&STR(&PKG) = &STR(EP02A)) DO SET APP&I = &STR(EPB0002) SET I = &I + 1 END OTHERWISE DO SET APP&I = &STR(&PKG) SET I = &I + 1 END END ISREDIT FIND NEXT ' *.' END SET I = &I - 1 /********************************************************************** /* EXTRACT THE ISOLATION VALUE * /********************************************************************** ISREDIT FIND LAST ' ISOLATION(' ISREDIT FIND NEXT '(' .ZCSR .ZCSR ISREDIT FIND NEXT P'=' .ZCSR .ZCSR ISREDIT (LN1,CL1) = CURSOR ISREDIT FIND NEXT ')' .ZCSR .ZCSR ISREDIT FIND PREV P'=' .ZCSR .ZCSR ISREDIT (LN2,CL2) = CURSOR ISREDIT (LINE) = LINE .ZCSR SET ISOLATE = &SUBSTR(&CL1:&CL2,&STR(&SYSNSUB(1,&LINE))) /********************************************************************** /* EXTRACT THE ACQUIRE VALUE * /********************************************************************** ISREDIT FIND LAST ' ACQUIRE(' ISREDIT FIND NEXT '(' .ZCSR .ZCSR ISREDIT FIND NEXT P'=' .ZCSR .ZCSR ISREDIT (LN1,CL1) = CURSOR ISREDIT FIND NEXT ')' .ZCSR .ZCSR ISREDIT FIND PREV P'=' .ZCSR .ZCSR ISREDIT (LN2,CL2) = CURSOR ISREDIT (LINE) = LINE .ZCSR SET ACQUIRE = &SUBSTR(&CL1:&CL2,&STR(&SYSNSUB(1,&LINE))) /********************************************************************** /* EXTRACT THE RELEASE VALUE * /********************************************************************** ISREDIT FIND LAST ' RELEASE(' ISREDIT FIND NEXT '(' .ZCSR .ZCSR ISREDIT FIND NEXT P'=' .ZCSR .ZCSR ISREDIT (LN1,CL1) = CURSOR ISREDIT FIND NEXT ')' .ZCSR .ZCSR ISREDIT FIND PREV P'=' .ZCSR .ZCSR ISREDIT (LN2,CL2) = CURSOR ISREDIT (LINE) = LINE .ZCSR SET RELEASE = &SUBSTR(&CL1:&CL2,&STR(&SYSNSUB(1,&LINE))) /********************************************************************** /* SEND THESE EXTRACTED VALUES TO THE SHARED POOL * /********************************************************************** DO &A = 0 TO &I SET APP = &STR(&SYSNSUB(2,&&APP&A)) SET VARS = &STR(&VARS APP&A) END DO &A = &A TO &NUMAPPL SET APP&A = SET VARS = &STR(&VARS APP&A) END FINISH: + ISPEXEC VPUT VARS SHARED ISPEXEC VPUT (&STR(&VARS)) SHARED ISREDIT CANCEL ./ ADD NAME=BINDDFLT /* REXX ***************************************************************/ /* */ /**********************************************************************/ ADDRESS ISPEXEC 'CONTROL ERRORS RETURN' ADDRESS ISREDIT "MACRO" "FIND FIRST 'VALIDATE('" DO WHILE RC = 0 "LINE_BEFORE .ZCSR = 'DYNAMICRULES(RUN) -'" "LINE_BEFORE .ZCSR = 'CURRENTDATA(NO) -'" "FIND NEXT 'VALIDATE('" END "END" ./ ADD NAME=BINDFREE /* REXX ***************************************************************/ /* */ /**********************************************************************/ PARSE UPPER ARG OPT1 '(' OPT1VAL ')', OPT2 '(' OPT2VAL ')', OPT3 '(' OPT3VAL ')', OPT4 '(' OPT4VAL ')', OPT5 '(' OPT5VAL ')' SIGNAL ON SYNTAX DO I = 1 TO 5 STR1 = "STR = STRIP(OPT"I")" INTERPRET STR1 STR = STR '= STRIP('OPT||I||VAL')' INTERPRET STR END SYNTAX: IF DB2SSID = '' THEN DB2SSID = 'DSNT' IF FREE = '' THEN FREE = 'NO' /**********************************************************************/ /* LIBDEF TO MY BATCH LOAD LIBRARY - D. LEIGH */ /**********************************************************************/ /* SPECIFY QUERY */ "EXECIO * DISKR PACKSQL (STEM SQL. FINIS)" SQLQUERY = '' DO I = 1 TO SQL.0 SQLQUERY = SQLQUERY STRIP(SQL.I) END ADDRESS LINK "REXXSQL"; SQLRC = RC SAY SQLRC /* TEST RETURN CONDITION */ IF _NROWS = 0 | SQLRC <> 0 /* ERROR RETURN, TERMINATE */ THEN EXIT 8; SAY "NROWS" _NROWS; /* NO. OF ROWS */ SAY "NCOLS" _VN.0; /* NO. OF COLUMNS */ /* DISPLAY COLUMN NAMES */ SAY 'COLUMN NAMES ARE:' DO J = 1 TO _VN.0; SAY 'VN.'J _VN.J; END; SAY ' ' SAY 'THE DATA IS:' /* DISPLAY ROW DATA */ DO I = 1 TO _NROWS; DO J = 1 TO _VN.0; COLNAME = _VN.J; STMT = "SAY " I J COLNAME"."I; INTERPRET STMT; END; END; EXIT REBIND = "REBIND PACKAGE(DUSC1_ELM_BTCH_000.ACH." REBIND = REBIND"(DEVL)) " REBIND = REBIND"CURRENTDATA(NO) DEGREE(1) FLAG(I);" QUEUE REBIND "DSN SYSTEM(DSNT)" SAY 'DSN BIND RC' RC ./ ADD NAME=BINDGET /********************************************************************** /* UTILITY: BINDGET * /* AUTHOR: DAVID LEIGH * /* FUNCTION: THIS UTILITY WORKS WITH THE BIND CARD CLIST AND QUERIES * /* ENDEVOR FOR ALL THE ELEMENTS OF THE TYPE SPECIFIED AND * /* PRESENTS A LIST TO PICK FROM. * /********************************************************************** PROC 5 ENVIRON STAGE TYPE SYSTEM SUBSYS + TEMPFILE(&SYSUID..TEMP.ENDEVOR.GET) /********************************************************************** /* MISCELLANEOUS INITIALIZATION * /********************************************************************** ISPEXEC CONTROL ERRORS RETURN ISPEXEC VGET DBGSWTCH PROFILE 02 IF &DBGSWTCH = ON THEN + 02 CONTROL MSG LIST CONLIST SYMLIST NOFLUSH PROMPT ASIS 00000702 ELSE + 02 CONTROL NOMSG NOLIST NOFLUSH PROMPT ASIS 00000902 /*GOTO REDISPLAY /********************************************************************** /* ESTABLISH SOME PROCESSING VARIABLES * /********************************************************************** SET APP0 = SET GOTO = REDISPLAY SET LP = &STR(( SET RP = &STR() /********************************************************************** /* POPULATE A TEMP TABLE * /********************************************************************** SET ZEDSMSG = SET ZEDLMSG = &STR(*** PREPARING TO CALL ENDEVOR TO LIST AVAILABLE + "&TYPE" ELEMENTS ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000) FREE DDNAME(SYSPRINT C1MSGS1 C1PRINT PRINTDD BSTIPT01) ALLOC DD(SYSPRINT) DUMMY IF &DBGSWTCH = ON THEN + ALLOC DD(C1MSGS1) DA(*) ELSE + ALLOC DD(C1MSGS1) DUMMY ALLOC DD(C1PRINT) DUMMY DELETE '&TEMPFILE' ALLOC DD(PRINTDD) + DSN('&TEMPFILE') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK$$$) + SPACE(1,1) CYLINDERS RELEASE + RECFM(F B) LRECL(133) BLKSIZE(23408) DSORG(PS) ALLOC DD(BSTIPT01) + NEW CATALOG + UNIT(SYSDA) + SPACE(1,1) TRACKS RELEASE + RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS) OPENFILE BSTIPT01 OUTPUT SET BSTIPT01 = &STR(LIST ELEMENTS A THROUGH Z9999999 ) PUTFILE BSTIPT01 SET BSTIPT01 = &STR(FROM ENVIRONMENT '&ENVIRON' ) PUTFILE BSTIPT01 SET BSTIPT01 = &STR( STAGE '&STAGE' ) PUTFILE BSTIPT01 SET BSTIPT01 = &STR( SYSTEM '&SYSTEM' ) PUTFILE BSTIPT01 SET BSTIPT01 = &STR( SUBSYSTEM '&SUBSYS' ) PUTFILE BSTIPT01 SET BSTIPT01 = &STR( TYPE '&TYPE') PUTFILE BSTIPT01 SET BSTIPT01 = &STR( TO FILE 'PRINTDD' ) PUTFILE BSTIPT01 SET BSTIPT01 = &STR(OPTIONS SEARCH ) PUTFILE BSTIPT01 SET BSTIPT01 = &STR(. ) PUTFILE BSTIPT01 CLOSFILE BSTIPT01 SET ZEDSMSG = SET ZEDLMSG = &STR(*** EXTRACTING LIST OF "&TYPE" ELEMENTS FROM + ENDEVOR ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000) ISPEXEC SELECT PGM(NDVRC1) PARM(C1BM3000) SET NDVRCC = &LASTCC FREE DDNAME(SYSPRINT C1MSGS1 C1PRINT PRINTDD BSTIPT01) ISPEXEC EDIT DATASET('&TEMPFILE') MACRO(BINDGETM) ISPEXEC TBQUERY TEMPGET ROWNUM(ROWS) SELECT (&ROWS) WHEN (0) DO IF NDVRCC < 8 THEN + DO SET ZEDSMSG = SET ZEDLMSG = &STR(*** NO ELEMENTS OF TYPE "&TYPE" + FOUND ***) ISPEXEC SETMSG MSG(UTLZ000) END ELSE + DO SET ZEDSMSG = SET ZEDLMSG = &STR(*** ENDEVOR CC: &NDVRCC TRYINT TO + LIST "&TYPE" ELEMENTS ***) ISPEXEC SETMSG MSG(UTLZ000) END EXIT END WHEN (1) GOTO FINISH END REDISPLAY: ISPEXEC TBDISPL TEMPGET PANEL(BINDGET) IF &LASTCC < 8 THEN + IF &ZTDSELS ¬= &STR(0000) THEN + DO PROC_LOOP: ISPEXEC CONTROL DISPLAY SAVE DO WHILE &ZTDSELS ¬= &STR(0000) SELECT (&SELCHAR) WHEN (S) DO SET MESSAGE = SELECTED ISPEXEC TBMOD TEMPGET END /********** DISPLAY TABLE CONTENTS **********/ WHEN ( ) DO SET MESSAGE = ISPEXEC TBMOD TEMPGET END OTHERWISE DO SET ZEDSMSG = &STR(MUST USE "S") SET ZEDLMSG = &STR("S" IS THE ONLY VALID + CHARACTER TO SELECT AN + ENDEVOR PLAN ELEMENT WITH) ISPEXEC SETMSG MSG(UTLZ001W) SET ZTDSELS = 0 END END IF &ZTDSELS > &STR(0001) THEN + DO ISPEXEC CONTROL DISPLAY RESTORE ISPEXEC TBDISPL TEMPGET ISPEXEC CONTROL DISPLAY SAVE END ELSE + DO SET ZTDSELS = &STR(0000) ISPEXEC CONTROL DISPLAY RESTORE SET SELECTED = 0 ISPEXEC TBTOP TEMPGET ISPEXEC TBSKIP TEMPGET DO WHILE &LASTCC = 0 IF &STR(&SELCHAR) = S THEN + DO SET SELECTED = &SELECTED + 1 IF &SELECTED > 1 THEN + DO SET MESSAGE = SET SELCHAR = ISPEXEC TBMOD TEMPGET END END ISPEXEC TBSKIP TEMPGET END IF &SELECTED > 1 THEN + DO SET ZTDSELS = 0 SET ZEDSMSG = SET ZEDLMSG = &STR(*** YOU MAY ONLY + SELECT 1 ELEMENT + TO "DRAG" BACK ***) ISPEXEC SETMSG MSG(UTLZ001W) GOTO REDISPLAY END GOTO &GOTO END END END ELSE GOTO REDISPLAY ELSE + IF &LASTCC > 8 THEN + DO SET ZEDSMSG = SET ZEDLMSG = &STR(*** PROBABLE ISPF PANEL ERROR IN + PANEL "BINDGET" ***) ISPEXEC SETMSG MSG(UTLZ001W) EXIT END ELSE + IF &ZTDSELS > 0 THEN + DO SET GOTO = FINISH GOTO PROC_LOOP END FINISH: + ISPEXEC TBTOP TEMPGET ISPEXEC TBVCLEAR TEMPGET SET SELCHAR = S ISPEXEC TBSCAN TEMPGET ARGLIST(SELCHAR) CONDLIST(EQ) SET APP0 = &STR(&ELEMENT) ISPEXEC VPUT APP0 SHARED EXIT ./ ADD NAME=BINDGETM /********************************************************************** /* UTILITY: BINDGETM * /* AUTHOR: DAVID LEIGH * /* FUNCTION: THIS EDIT MACRO WORKS WITH THE BINDCARD UTILITY. IT IS * /* AN INITIAL MACRO WHICH PARSES AN ENDEVOR "LIST" OF * /* BINDBTCH ELEMENTS AND POPULATES A TABLE WITH THEM. * /********************************************************************** ISREDIT MACRO ISPEXEC CONTROL ERRORS CANCEL /**** 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 ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT SET ZEDSMSG = SET ZEDLMSG = &STR(*** POPULATING A TEMPORARY TABLE WITH THE + ELEMENTS ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000) /********************************************************************** /* CREATE A TEMPORARY TABLE TO HOLD THE ELEMENT NAMES * /********************************************************************** ISPEXEC TBCREATE TEMPGET NOWRITE REPLACE KEYS(ELEMENT) + NAMES(SELCHAR MESSAGE) ISPEXEC TBVCLEAR TEMPGET /********************************************************************** /* FIND WHERE THE BIND PLAN CARDS START AND EXTRACT THE PLAN NAME * /********************************************************************** ISREDIT FIND FIRST 'ACTION ELEMENT' DO WHILE &LASTCC = 0 ISREDIT FIND NEXT "'" .ZCSR .ZCSR ISREDIT FIND NEXT P'¬' .ZCSR .ZCSR ISREDIT (LN1,CL1) = CURSOR ISREDIT FIND NEXT "'" .ZCSR .ZCSR ISREDIT FIND PREV P'¬' .ZCSR .ZCSR ISREDIT (LN2,CL2) = CURSOR ISREDIT (LINE) = LINE .ZCSR SET ELEMENT = &SUBSTR(&CL1:&CL2,&STR(&SYSNSUB(1,&LINE))) ISPEXEC TBADD TEMPGET ISREDIT FIND NEXT 'ACTION ELEMENT' END ISPEXEC TBTOP TEMPGET ISREDIT CANCEL ./ ADD NAME=BINDTHIN /* REXX ***************************************************************/ /* THIS ONE PARSES THROUGH A BIND COPY MEMBER CREATED BY DB/EXPLAIN */ /* AND EXCLUDES ALL BIND COPY STATEMENTS THAT ARE AGAINST ANOTHER */ /* COPY OF A PACKAGE IT ALREADY ENCOUNTERED. YOU SHOULD ONLY HAVE 1 */ /* COLLECTION IN THIS FILE. */ /**********************************************************************/ ADDRESS ISPEXEC 'CONTROL ERRORS RETURN' ADDRESS ISREDIT "MACRO" PACKAGES = '' "FIND FIRST ' COPY('" DO WHILE RC = 0 "(LINE) = LINE .ZCSR" PARSE UPPER VAR LINE NULL1 '.' PKGNAME ')' NULL2 ZEDSMSG = PKGNAME ADDRESS ISPEXEC "CONTROL DISPLAY LOCK" ADDRESS ISPEXEC "DISPLAY MSG(UTLZ000W)" IF POS(' 'PKGNAME' ',PACKAGES) = 0 THEN PACKAGES = PACKAGES ³³ ' ' ³³ PKGNAME ³³ ' ' ELSE DO "FIND PREV ' BIND PACKAGE('" "LABEL .ZCSR = .A" "FIND NEXT ' ACTION(ADD'" "LABEL .ZCSR = .B" "EXCLUDE ALL P'=' 1 .A .B" END "FIND NEXT ' COPY(' NX" END EXIT ./ ADD NAME=BLDG /**********************************************************************/ /* UTILITY NAME : BLDG */ /* DATE WRITTEN : ? */ /* AUTHOR : DAVE LEIGH (ENHANCED VERSION OF PLANO WRITTEN CLIST */ /* DESCRIPTION : LIST, BUILD, AND DELETE GDG INDEXES. */ /**********************************************************************/ PROC 0 FUNC(B) DSN() ENT(3) SYSPRINT SILENT HELP /*** CHECK THE DEBUG SWITCH ***/ CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS ISPEXEC CONTROL ERRORS RETURN /********************************************************************** /* CONTROL CLIST/EDIT MODE PROCESSING * /********************************************************************** ERROR DO SET MODE = CLIST RETURN END ISREDIT MACRO ERROR OFF /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT IF &HELP = &STR(HELP) THEN + GOTO HELPSEC IF &MODE ¬= CLIST THEN GOTO PARSE_DSN IF &DSN = THEN + GOTO PREMAP ELSE + DO SET PARM = YES IF &SYSPRINT = THEN SET SYSPRINT = N IF &FUNC = B THEN GOTO BREAD IF &FUNC = L THEN GOTO LREAD IF &FUNC = D THEN GOTO DREAD END PREMAP: + ISPEXEC VGET DSN SHARED SET BUILD = X SET ENT = 3 SET LIST = SET DELETE = SET SYSPRINT = N ISPEXEC VPUT (DSN BUILD ENT DELETE LIST SYSPRINT) SHARED START: + ISPEXEC DISPLAY PANEL(UTILBLDG) IF &LASTCC = 8 THEN + DO IF &MODE ¬= CLIST THEN ISREDIT CURSOR = &LN &CL EXIT END ELSE + DO ISPEXEC VGET (DSN BUILD ENT DELETE LIST SYSPRINT) SHARED IF &SYSPRINT = Y THEN SET SYSPRINT = SYSPRINT IF &BUILD > THEN GOTO BREAD IF &DELETE > THEN GOTO DREAD IF &LIST > THEN GOTO LREAD END LREAD: + LISTCAT ENTRY('&DSN') GDG ALL IF &LASTCC = 0 THEN + DO SET ZEDLMSG = LISTCAT ON "&DSN" SUCCESSFUL GOTO EXITEND END ELSE SET ZEDLMSG = LISTCAT ON "&DSN" UNSUCCESSFUL GOTO EXITEND BREAD: + SET DSNTEXT = &STR(&SYSDSN('&DSN')) LISTDSI '&DSN' SET CCLISTDSI = &LASTCC SET SYSOUTTRAP = 1000 LISTCAT ENTRY('&DSN') GDG ALL SET CCLISTCAT = &LASTCC SET SYSOUTTRAP = 0 SELECT WHEN (&CCLISTDSI = 16 AND + &CCLISTCAT = 0) DO SET ZEDLMSG = "&DSN" IS ALREADY A GDG IF &SILENT = SILENT THEN SET EXITCODE = 4 GOTO EXITEND END WHEN (&STR(&DSNTEXT) = OK AND + &CCLISTDSI = 0 AND + &CCLISTCAT = 4) DO SET ZEDLMSG = "&DSN" IS ALREADY ALLOCATED AND IS NOT A GDG IF &SILENT = SILENT THEN SET EXITCODE = 8 GOTO EXITEND END OTHERWISE DO IF &LENGTH(&ENT) = 0 THEN + DO WRITENR ENTER NUMBER OF GDG ENTRIES REQUIRED ==> READ &ENT END DEFINE GDG(NAME('&DSN') NOEMPTY SCRATCH LIMIT(&ENT)) SET CCDEFINE = &LASTCC IF &CCDEFINE ¬= 0 THEN + DO SET ZEDLMSG = &STR(*** GDG DEFINITION OF "&DSN" + FAILED WITH RETURN CODE OF + "&CCDEFINE" ***) IF &SILENT = SILENT THEN SET EXITCODE = 12 GOTO EXITEND END SET ZEDLMSG = GDG INDEX FOR "&DSN" CREATED WITH "&ENT" ENTRIES IF &SILENT = SILENT THEN SET EXITCODE = 0 GOTO EXITEND END END DREAD: + DELETE '&DSN' GDG IF &LASTCC > 0 OR &LASTCC < 0 THEN + DO WRITE WRITE GDG INDEX FOR "&DSN" WAS NOT DELETED WRITE WRITE 1) A GDG INDEX CANNOT BE DELETED UNLESS IT IS EMPTY. WRITE WRITE 2) A NON GDG DATA SET CANNOT BE DELETED HERE. WRITE WRITE 3) THERE IS NO GDG INDEX FOR THIS DSN. WRITE WRITE 4) YOU DO NOT HAVE AUTHORITY TO DELETE THIS ENTRY. WRITE WRITE FUNCTION TERMINATED SET ZEDLMSG = COULD NOT DELETE "&DSN" GDG INDEX GOTO EXITEND END SET ZEDLMSG = GDG INDEX FOR "&DSN" HAS BEEN DELETED GOTO EXITEND EXITEND: + IF &PARM = YES THEN + DO IF &SILENT = SILENT THEN EXIT CODE(&EXITCODE) WRITE &ZEDLMSG EXIT END ISPEXEC SETMSG MSG(UTLZ000) GOTO START /********************************************************************** /* PARSE THE DATASET NAME * /********************************************************************** PARSE_DSN: + SET BUILD = X SET DELETE = SET LIST = SET SYSPRINT = N SET LP = &STR(( SET RP = &STR()) ISREDIT (LN,CL) = CURSOR ISREDIT (DSN) = LINE .ZCSR SET SYSDVAL = &SUBSTR(&CL:&LENGTH(&NRSTR(&DSN)),&NRSTR(&DSN)) READDVAL DSN SET Y = &SYSINDEX(&STR(&LP),&STR(&DSN)) IF &Y > 0 THEN + SET DSN = &SUBSTR(1:&Y-1,&STR(&DSN)) SET X = &LENGTH(&STR(&DSN)) DO WHILE + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(.) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(?) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(") OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(') OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(:) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(;) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(&&) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(~) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(`) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(|) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(%) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(¬) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(*) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(_) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(-) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(=) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(+) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(!) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(?) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(?) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(\) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR({) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(}) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(/) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(>) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(<) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(&LP) OR + &SUBSTR(&X-1:&X,&STR(&DSN)) = &STR(&RP&RP) OR + &SUBSTR(&X-1:&X,&STR(&DSN)) = &STR(&LP&RP) OR + &SUBSTR(&X-1:&X,&STR(&DSN)) = &STR('&RP) OR + &SUBSTR(&X-1:&X,&STR(&DSN)) = &STR(&RP&LP) OR + (&SUBSTR(&X:&X,&STR(&DSN)) = &STR(&RP) AND + (&SYSINDEX(&STR(&LP),&STR(&DSN)) = 0) SET X = &X - 1 END SET DSN = &SUBSTR(1:&X,&STR(&DSN)) GOTO START HELPSEC: + WRITE *** HELP FOR CLIST BLDG *** WRITE WRITE THE 'BLDG' CLIST ALLOWS THE USER TO CREATE GDG INDEXES IN WRITE FOREGROUND. IT ALSO ALLOWS YOU TO DO THE FUNCTION INTERACTIVELY WRITE OR AS A CALLED FUNCTION FROM ANOTHER CLIST. YOU CAN DO THE WRITE FOLLOWING FUNCTIONS : WRITE WRITE BUILD AN INDEX WITH A SPECIFIED NUMBER OF ENTRIES WRITE DELETE AN EXISTING INDEX WRITE LIST INFORMATION ABOUT AN EXISTING INDEX WRITE WRITE YOU CAN ALSO SPECIFY TO DISPLAY THE IDCAMS MESSAGES ASSOCIATED WRITE WITH ANY OF THE 3 ABOVE FUNCTIONS. WRITE WRITE BASIC SYNTAX : WRITE WRITE COMMAND ===> TSO BLDG WRITE WRITE THIS INVOCATION WILL BRING UP A PANEL WHERE YOU CAN ENTER WRITE THE VALUES THAT CORRESPOND TO THE FUNCTION YOU WANT TO PERFORM. WRITE WRITE SYNTAX TO SPECIFY YOUR FUNCTION AND DATASET AT EXECUTION TIME : WRITE WRITE COMMAND ===> TSO BLDG DSN('') FUNC(L) WRITE WRITE THIS INVOCATION WILL LIST THE GDG INDEX INFORMATION FOR THE WRITE DATASET SPECIFIED AND THEN RETURN CONTROL BACK TO THE SCREEN WHERE WRITE BLDG WAS CALLED. WRITE WRITE THERE ARE DEFAULT PROCESSES IF YOU SPECIFY A DATASET NAME AT WRITE EXECUTION TIME. THE FOLLOWING IS AN EXAMPLE : WRITE WRITE COMMAND ===> TSO BLDG DSN('') WRITE WRITE THIS INVOCATION WILL BUILD A GDG INDEX WITH 3 ENTRIES FOR THE WRITE DATASET NAMED. WRITE WRITE TO SEE THE IDCAMS MESSAGES REGARDING THE FUNCTION THE USER IS WRITE PERFORMING, THE 'SYSPRINT' KEYWORD WOULD BE USED....I.E. : WRITE WRITE COMMAND ===> TSO BLDG DSN('') FUNC(D) SYSPRINT WRITE WRITE THIS INVOCATION WILL DELETE THE GDG INDEX FOR THE NAMED DATASET WRITE AND SHOW YOU THE ASSOCIATED IDCAMS MESSAGES. IF SYSPRINT IS NOT WRITE SPECIFIED, THE BLDG UTILITY WILL DISPLAY MESSAGES OF ITS OWN. WRITE WRITE *** END OF HELP *** NO PROCESSING PERFORMED EXIT ./ ADD NAME=BLKCALC PROC 0 LRECL() KEY() RECS() HELP /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT IF &STR(&HELP) = HELP THEN GOTO HELPSEC SET LRECLX = &LRECL SET KEYX = &KEY SET RECSX = &REC ISPEXEC VPUT (LRECLX KEYX RECSX) SHARED IF &LRECL > OR &KEY > OR &REC > THEN + DO SET ZEDLMSG = &STR(*** PRESS "ENTER" TO OBTAIN RESULTS ***) ISPEXEC SETMSG MSG(UTLZ001) END ISPEXEC SELECT PGM(RTIPCALC) EXIT HELPSEC: + 02480000 ISPEXEC SELECT PGM(ISPTUTOR) PARM(RTIUBLKC) 02490000 SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR BLKCALC UTILITY + 02490000 *** NO PROCESSING PERFORMED ***) 02490000 ISPEXEC SETMSG MSG(UTLZ000) 02490000 EXIT ./ ADD NAME=BLKSIZE /********************************************************************** /* UTILITY: BLKSIZE * /* AUTHOR: DAVE LEIGH * /* FUNCTION: CALCULATE BLKSIZE AND SPACE REQUIREMENTS BASED ON LRECL * /* AND NUMBER OF RECORDS. CALCULATE FOR MULTIPLE DEVICE * /* TYPES IF NECESSARY. RETURN INFORMATION TO CALLING * /* FUNCTIONS OR DISPLAY ON THE SCREEN. * /* UPDATE 05/22/95 * WALT ECKHARDT * /* ADDED ABILITY TO CALCULATE BLKSIZE FOR 3390 DEVICE TYPES * /* USING HALF TRACKS BLOCKING WITH OPTIMUM SIZE OF 27998 * /********************************************************************** PROC 2 LRECL /* LOGICAL RECORD LENGTH */ + NUMRECS /* EXPECTED NUMBER OF RECORDS */ + DEVICES('3390 TAPE') /* ALL CURRENTLY AVAILABLE DEVICES */ + /********************************************************************/ + /* SET UP OPTIMUM BLOCKING FACTOR, BLOCKS PER TRACK, AND TRACKS PER */ + /* CYLINDER FOR EACH DEVICE TYPE. THE VARIABLE NAME IS PREFIXED BY */ + /* "OPT", "BPT", OR "TPC" AND SUFFIXED WITH THE DEVICE TYPE NAME AS */ + /* LISTED IN THE "DEVICES" PARAMETER ABOVE. THERE SHOULD BE A SET */ + /* OF 3 VARIABLES FOR EACH DEVICE TYPE. NON-APPLICABLE VARIABLES */ + /* SHOULD BE SPECIFIED, BUT WITH NULL VALUES. */ + /********************************************************************/ + OPT3380(23476) /* OPTIMUM BLOCK SIZE FOR 3380 DASD */ + BPT3380(2) /* BLOCKS PER TRACK FOR 3380 DASD */ + TPC3380(15) /* TRACKS PER CYLINDER FOR 3380 DASD */ + OPT3390(27998) /* OPTIMUM BLOCK SIZE FOR 3390 DASD */ + BPT3390(2) /* BLOCKS PER TRACK FOR 3390 DASD */ + TPC3390(15) /* TRACKS PER CYLINDER FOR 3390 DASD */ + OPTTAPE(32760) /* OPTIMUM BLOCK SIZE FOR TAPE */ + BPTTAPE() /* BYTES PER TRACK FOR TAPE */ + TPCTAPE() /* TRACKS PER CYLINDER FOR TAPE */ + SELECT(ALL) /* WHICH DEVICE TYPE TO RETURN INFORMATION ON */ + BATCH /* RETURN INFORMATION TO A CALLING CLIST-NOT THE SCREEN*/ + DEBUG /* DISPLAY DEBUGGING MESSAGES */ /********************************************************************** /* ESTABLISH GLOBAL REFERBACKS IF NOT IN ISPF * /********************************************************************** /* IF &SYSISPF ¬= ACTIVE THEN + /* GLOBAL BLKSIZE RECSPBLK PCTUTIL CYLSREQ TRKSREQ /********************************************************************** /* CHECK THE DEBUG SWITCH * /********************************************************************** IF &SYSNEST = NO AND + &BATCH ¬= BATCH THEN + IF &DEBUG = DEBUG THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS /********************************************************************** /* SEE IF THE DEVICE SELECTED WAS VALID AND DETERMINE HOW MANY TO DO * /********************************************************************** IF &STR(&SELECT) = ALL THEN SET SYSDVAL = &STR(&DEVICES) ELSE SET SYSDVAL = &STR(&SELECT) READDVAL D1 D2 D3 D4 D5 D6 D7 D8 D9 D10 SET NUMDEV = 0 DO &X = 1 TO 10 SET DEV = &&D&X IF &SYSINDEX(&STR(&DEV),&STR(&DEVICES)) > 0 THEN + SET NUMDEV = &NUMDEV + 1 END IF &NUMDEV = 0 THEN + DO IF &BATCH = BATCH THEN EXIT CODE(12) SET MSG = &STR(*** NO DEVICE(S) SPECIFIED EXIST CURRENTLY ***) IF &SYSISPF = ACTIVE THEN + DO SET ZEDLMSG = &STR(&MSG) ISPEXEC SETMSG MSG(UTLZ001) END ELSE WRITE &STR(&MSG) EXIT CODE(12) END /********************************************************************** /* DISPLAY THE HEADER INFORMATION IF NOT IN BATCH. * /********************************************************************** IF &BATCH ¬= BATCH THEN + DO CLEAR WRITE WRITE FIXED VARIABLE RECS/ % BLK + CYLINDERS TRACKS WRITE DEVICE LRECL BLKSIZE BLKSIZE BLOCK UTIL. + REQUIRED REQUIRED END /********************************************************************** /* DO THE CALCULATIONS AND OUTPUT THE RESULTS. * /********************************************************************** DO &I = 1 TO &NUMDEV SET DEVICE = &&D&I SET BLKSIZE = &&OPT&DEVICE SET BLKSIZE = &BLKSIZE SET BLKSPTRK = &&BPT&DEVICE SET BLKSPTRK = &BLKSPTRK SET TRKSPCYL = &&TPC&DEVICE SET TRKSPCYL = &TRKSPCYL IF &STR(&TRKSPCYL) = THEN SET TRKSPCYL = 0 SET VBLKSIZE = &BLKSIZE SET BLKSIZE = &EVAL(&BLKSIZE / &LRECL) * &LRECL IF &STR(&BLKSPTRK) = OR + &STR(&TRKSPCYL) = THEN + DO SET RECSPBLK = SET CYLSREQ = SET TRKSREQ = IF &STR(&DEVICE) = TAPE THEN + SET RECSPBLK = &EVAL(&BLKSIZE / &LRECL) END ELSE + DO SET RECSPBLK = &EVAL(&BLKSIZE / &LRECL) SET RECSPTRK = &EVAL(&RECSPBLK * &BLKSPTRK) SET TRKSREQ = &EVAL(&NUMRECS / &RECSPTRK) IF &EVAL(&NUMRECS // &RECSPTRK) > 0 THEN + SET TRKSREQ = &TRKSREQ + 1 SET CYLSREQ = &EVAL(&TRKSREQ / &TRKSPCYL) IF &EVAL(&TRKSREQ // &TRKSPCYL) > 0 THEN + SET CYLSREQ = &CYLSREQ + 1 IF &TRKSREQ < &TRKSPCYL THEN SET CYLSREQ = &STR(<1) END SET X = &&OPT&DEVICE SET X = &X SET PCTUTIL = &EVAL((&BLKSIZE *100) / &X) IF &BATCH ¬= BATCH THEN + DO SET X = &LENGTH(&STR(&DEVICE)) DO WHILE &X < 6 SET DEVICE = &STR( &DEVICE) SET X = &LENGTH(&STR(&DEVICE)) IF &X < 6 THEN SET DEVICE = &STR(&DEVICE ) SET X = &LENGTH(&STR(&DEVICE)) END SET X = &LENGTH(&STR(&LRECL)) DO WHILE &X < 5 SET LRECL = &STR( &LRECL) SET X = &LENGTH(&STR(&LRECL)) IF &X < 5 THEN SET LRECL = &STR(&LRECL ) SET X = &LENGTH(&STR(&LRECL)) END SET X = &LENGTH(&STR(&BLKSIZE)) DO WHILE &X < 7 SET BLKSIZE = &STR( &BLKSIZE) SET X = &LENGTH(&STR(&BLKSIZE)) IF &X < 7 THEN SET BLKSIZE = &STR(&BLKSIZE ) SET X = &LENGTH(&STR(&BLKSIZE)) END SET X = &LENGTH(&STR(&VBLKSIZE)) DO WHILE &X < 7 SET VBLKSIZE = &STR( &VBLKSIZE) SET X = &LENGTH(&STR(&VBLKSIZE)) IF &X < 7 THEN SET VBLKSIZE = &STR(&VBLKSIZE ) SET X = &LENGTH(&STR(&VBLKSIZE)) END SET X = &LENGTH(&STR(&RECSPBLK)) DO WHILE &X < 5 SET RECSPBLK = &STR( &RECSPBLK) SET X = &LENGTH(&STR(&RECSPBLK)) IF &X < 5 THEN SET RECSPBLK = &STR(&RECSPBLK ) SET X = &LENGTH(&STR(&RECSPBLK)) END SET X = &LENGTH(&STR(&PCTUTIL)) DO WHILE &X < 5 SET PCTUTIL = &STR( &PCTUTIL) SET X = &LENGTH(&STR(&PCTUTIL)) IF &X < 5 THEN SET PCTUTIL = &STR(&PCTUTIL ) SET X = &LENGTH(&STR(&PCTUTIL)) END SET X = &LENGTH(&STR(&CYLSREQ)) DO WHILE &X < 9 SET CYLSREQ = &STR( &CYLSREQ) SET X = &LENGTH(&STR(&CYLSREQ)) IF &X < 9 THEN SET CYLSREQ = &STR(&CYLSREQ ) SET X = &LENGTH(&STR(&CYLSREQ)) END SET X = &LENGTH(&STR(&TRKSREQ)) DO WHILE &X < 8 SET TRKSREQ = &STR( &TRKSREQ) SET X = &LENGTH(&STR(&TRKSREQ)) IF &X < 8 THEN SET TRKSREQ = &STR(&TRKSREQ ) SET X = &LENGTH(&STR(&TRKSREQ)) END WRITE &DEVICE &LRECL &BLKSIZE &VBLKSIZE + &RECSPBLK &PCTUTIL &CYLSREQ &TRKSREQ END ELSE + IF &SYSISPF = ACTIVE THEN + ISPEXEC VPUT (DEVICE LRECL BLKSIZE RECSPBLK PCTUTIL + VBLKSIZE CYLSREQ TRKSREQ) SHARED END ./ ADD NAME=BMSISPF /********************************************************************** /* UTILITY: BMSISPF * /* AUTHOR: DAVID LEIGH * /* FUNCTION: CONVERT A BMS MAP TO AN ISPF PANEL. * /********************************************************************** ISREDIT MACRO ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /********************************************************************** /* CREATE ATTRIBUTE ISPF TABLE * /********************************************************************** ISPEXEC TBCREATE TEMPATTR NOWRITE REPLACE + KEYS(MAPSET MAP TYPE INTENS CAPS JUST PAD SKIP ATTN COLOR HILITE) + NAMES(ATTRCHAR) /********************************************************************** /* CREATE FIELDS ISPF TABLE * /********************************************************************** ISPEXEC TBCREATE TEMPFLDS NOWRITE REPLACE + KEYS(MAPSET MAP ROW COLUMN NAMES(NAME LITERAL STOPCOL + TYPE INTENS CAPS JUST PAD SKIP ATTN COLOR HILITE) /********************************************************************** /* GO FROM FIELD TO FIELD AND GATHER INFORMATION * /********************************************************************** SET LOGICAL = 1 ISREDIT EXCLUDE ALL '*' 1 ISREDIT EXCLUDE ALL ' NOGEN ' 15 ISREDIT FIND FIRST P'=' 1 NX DO WHILE &LASTCC = 0 SET CLF = 1 SET CLL = 1 ISREDIT FIND FIRST P'.' 1 72 .ZCSR .ZCSR IF &LASTCC = 0 THEN + DO ISREDIT (LNF,CLF) = CURSOR IF &CLF < 16 THEN + DO ISREDIT (LINE) = LINE .ZCSR SET SYSDVAL = &SUBSTR(1:15,&STR(&SYSNSUB(1,&LINE))) READDVAL NAME TYPE IF &TYPE = THEN + DO SET TYPE = &NAME SET NAME = END SET TYPE&LOGICAL = &TYPE SET NAME&LOGICAL = &NAME ISREDIT FIND FIRST P'.' 16 72 .ZCSR .ZCSR ISREDIT (LNF,CLF) = CURSOR END ISREDIT FIND LAST P'.' 1 72 .ZCSR .ZCSR ISREDIT (LNL,CLL) = CURSOR IF &CLL = 72 THEN + DO SET CONCAT = YES ISREDIT FIND PREV P'.' .ZCSR .ZCSR ISREDIT (LNL,CLL) = CURSOR END ELSE SET CONCAT = LAST ISREDIT (LINE) = LINE .ZCSR SET LINE = &SUBSTR(&CLF:&CLL,&STR(&SYSNSUB(1,&LINE))) IF &CONCAT = YES OR &CONCAT = LAST THEN + SET LINE&LOGICAL = &STR(&SYSNSUB(2,&&LINE&LOGICAL))+ &STR(&SYSNSUB(1,&LINE)) IF &CONCAT = LAST THEN DO SYSCALL PARSE NAME&LOGICAL TYPE&LOGICAL LINE&LOGICAL SET LOGICAL = &LOGICAL + 1 END END ISREDIT FIND NEXT P'=' 1 NX END EXIT /********************************************************************** /* LINE PARSING LOGIC * /********************************************************************** PARSE: PROC 5 &&NAME&LOGICAL &&TYPE&LOGICAL &&LINE&LOGICAL &MAP &MAPSET SYSREF &&NAME&LOGICAL &&TYPE&LOGICAL &&LINE&LOGICAL &MAP &MAPSET SET TYPE = &STR(&SYSNSUB(2,&&TYPE&LOGICAL)) IF &TYPE = DFHMSD THEN + DO SET MAPSET = &STR(&SYSNSUB(2,&&NAME&LOGICAL)) RETURN END IF &TYPE = DFHMDI THEN + DO SET MAP = &STR(&SYSNSUB(2,&&NAME&LOGICAL)) RETURN END /********************************************************************** /* INITIALIZE DEFAULT ATTRIBUTE SETTINGS * /********************************************************************** SET LP = &STR(( SET RP = &STR()) SET TYPE = TEXT SET INTENS = LOW SET CAPS = SET JUST = SET PAD = SET SKIP = ON SET ATTN = SET COLOR = SET HILITE = /********************************************************************** /* PARSE TO GET THE ATTRIBUTE SETTINGS (IF ANY) * /********************************************************************** PARSE_ATTRB: + SET A = &SYSINDEX(&STR(ATTRB=),&STR(&SYSNSUB(1,&LINE)) IF &A = 0 THEN GOTO PARSE_JUSTIFY SET ATTRIBUTES = &SUBSTR(&A:&LENGTH(&STR(&SYSNSUB(1,&LINE))),+ &STR(&SYSNSUB(1,&LINE))) SET LEFTP = &SYSINDEX(&STR(&LP),&STR(&SYSNSUB(1,&ATTRIBUTES))) IF &LEFTP > 0 THEN + SET RIGHTP = &SYSINDEX(&STR(&RP),&STR(&SYSNSUB(1,&ATTRIBUTES))) ELSE + DO SET LEFTP = &SYSINDEX(&STR(=),&STR(&SYSNSUB(1,&ATTRIBUTES))) SET RIGHTP = &SYSINDEX(&STR(,),&STR(&SYSNSUB(1,&ATTRIBUTES))) IF &RIGHTP = 0 THEN + SET RIGHTP = &LENGTH(&STR(&SYSNSUB(1,&ATTRIBUTES)))+1 END SET ATTRIBUTES = &SUBSTR(&LEFTP+1:&RIGHTP-1,+ &STR(&SYSNSUB(1,&ATTRIBUTES))) SET ASKIP = &SYSINDEX(&STR(ASKIP),&STR(&ATTRIBUTES)) SET NUM = &SYSINDEX(&STR(NUM),&STR(&ATTRIBUTES)) SET BRT = &SYSINDEX(&STR(BRT),&STR(&ATTRIBUTES)) SET DRK = &SYSINDEX(&STR(DRK),&STR(&ATTRIBUTES)) SET NORM = &SYSINDEX(&STR(NORM),&STR(&ATTRIBUTES)) SET PROT = &SYSINDEX(&STR(PROT),&STR(&ATTRIBUTES)) SET UNPROT = &SYSINDEX(&STR(UNPROT),&STR(&ATTRIBUTES)) SET DET = &SYSINDEX(&STR(DET),&STR(&ATTRIBUTES)) SET IC = &SYSINDEX(&STR(IC),&STR(&ATTRIBUTES)) SET FSET = &SYSINDEX(&STR(FSET),&STR(&ATTRIBUTES)) IF &ASKIP > 0 THEN + DO SET TYPE = TEXT SET SKIP = ON END IF &NUM > 0 THEN + DO SET VER = &VER + 1 SET VER&VER = &STR(VER (&NAME NUM)) SET SAVENAME = &STR(&SAVENAME VER&VER) END IF &BRT > 0 THEN + DO SET INTENS(HIGH) END IF &DRK > 0 THEN + DO SET INTENS(NON) END IF &NORM > 0 THEN + DO SET INTENS(LOW) END IF &PROT > 0 THEN + DO IF &NAME = THEN + SET TYPE = TEXT ELSE + SET TYPE = OUTPUT END IF &UNPROT > 0 THEN + DO IF &NAME = THEN + SET TYPE = TEXT ELSE + SET TYPE = INPUT END IF &DET > 0 THEN + DO SET ATTN = ON END IF &IC > 0 THEN + DO SET CURSOR = &CURSOR + 1 SET CURSOR&CURSOR = &STR(.CURSOR = &NAME) SET SAVENAME = &STR(&SAVENAME CURSOR&CURSOR) END IF &FSET > 0 THEN + DO SET VPUT = &VPUT + 1 SET VPUT&VPUT = &STR(VPUT &NAME SHARED) SET SAVENAME = &STR(&SAVENAME VPUT&VPUT) END /********************************************************************** /* PARSE TO GET THE JUSTIFICATION SETTING (IF ANY) * /********************************************************************** PARSE_JUSTIFY: + SET J = &SYSINDEX(&STR(JUSTIFY=),&STR(&SYSNSUB(1,&LINE)) IF &J = 0 THEN GOTO PARSE_PICIN SET JUSTIFY = &SUBSTR(&A:&LENGTH(&STR(&SYSNSUB(1,&LINE))),+ &STR(&SYSNSUB(1,&LINE))) SET LEFTP = &SYSINDEX(&STR(&LP),&STR(&SYSNSUB(1,&JUSTIFY))) IF &LEFTP > 0 THEN + SET RIGHTP = &SYSINDEX(&STR(&RP),&STR(&SYSNSUB(1,&JUSTIFY))) ELSE + DO SET LEFTP = &SYSINDEX(&STR(=),&STR(&SYSNSUB(1,&JUSTIFY))) SET RIGHTP = &SYSINDEX(&STR(,),&STR(&SYSNSUB(1,&JUSTIFY))) IF &RIGHTP = 0 THEN + SET RIGHTP = &LENGTH(&STR(&SYSNSUB(1,&JUSTIFY)))+1 END SET JUSTIFY = &SUBSTR(&LEFTP+1:&RIGHTP-1,&STR(&SYSNSUB(1,&JUSTIFY))) SET LEFT = &SYSINDEX(&STR(LEFT),&STR(&ATTRIBUTES)) SET RIGHT = &SYSINDEX(&STR(RIGHT),&STR(&ATTRIBUTES)) SET BLANK = &SYSINDEX(&STR(BLANK),&STR(&ATTRIBUTES)) SET ZERO = &SYSINDEX(&STR(ZERO),&STR(&ATTRIBUTES)) IF &BLANK > 0 THEN + DO SET PAD = &STR( ) SET JUSTIFY = LEFT END IF &LEFT > 0 THEN + DO SET JUSTIFY = LEFT END IF &ZERO > 0 THEN + DO SET JUSTIFY = RIGHT SET PAD = &STR(0) END IF &RIGHT > 0 THEN + DO SET JUSTIFY = RIGHT END /********************************************************************** /* PARSE TO GET THE INPUT PICTURE (IF ANY) * /********************************************************************** PARSE_PICIN: + ++++++++++++++++++++++++ VER (&VARNAME,PICT,STRING) MAY ONLY BE ABLE TO DETERMINE IF THE INPUT MUST BE NUMERIC OR NOT. "VIRTUAL" DECIMALS MIGHT BE IMPLEMENTABLE VIA A TRANS(TRUNC COMMAND. KEEPING THE INFORMATION SO THAT YOU CAN GO BACK TO BMS COULD BE DIFFICULT. SET P = &SYSINDEX(&STR(PICIN=),&STR(&SYSNSUB(1,&LINE)) IF &P = 0 THEN GOTO PARSE_PICOUT SET JUSTIFY = &SUBSTR(&A:&LENGTH(&STR(&SYSNSUB(1,&LINE))),+ &STR(&SYSNSUB(1,&LINE))) SET LEFTP = &SYSINDEX(&STR(&LP),&STR(&SYSNSUB(1,&JUSTIFY))) IF &LEFTP > 0 THEN + SET RIGHTP = &SYSINDEX(&STR(&RP),&STR(&SYSNSUB(1,&JUSTIFY))) ELSE + DO SET LEFTP = &SYSINDEX(&STR(=),&STR(&SYSNSUB(1,&JUSTIFY))) SET RIGHTP = &SYSINDEX(&STR(,),&STR(&SYSNSUB(1,&JUSTIFY))) IF &RIGHTP = 0 THEN + SET RIGHTP = &LENGTH(&STR(&SYSNSUB(1,&JUSTIFY)))+1 END SET JUSTIFY = &SUBSTR(&LEFTP+1:&RIGHTP-1,&STR(&SYSNSUB(1,&JUSTIFY))) SET LEFT = &SYSINDEX(&STR(LEFT),&STR(&ATTRIBUTES)) SET RIGHT = &SYSINDEX(&STR(RIGHT),&STR(&ATTRIBUTES)) SET BLANK = &SYSINDEX(&STR(BLANK),&STR(&ATTRIBUTES)) SET ZERO = &SYSINDEX(&STR(ZERO),&STR(&ATTRIBUTES)) IF &BLANK > 0 THEN + DO SET PAD = &STR( ) SET JUSTIFY = LEFT END IF &LEFT > 0 THEN + DO SET JUSTIFY = LEFT END IF &ZERO > 0 THEN + DO SET JUSTIFY = RIGHT SET PAD = &STR(0) END IF &RIGHT > 0 THEN + DO SET JUSTIFY = RIGHT END /********************************************************************** /* CREATE FIELDS ISPF TABLE * /********************************************************************** PARSE_LITERAL: + ISPEXEC TBCREATE TEMPFLDS NOWRITE REPLACE + KEYS(MAPSET MAP ROW COLUMN NAMES(NAME LITERAL + TYPE INTENS CAPS JUST PAD SKIP ATTN COLOR HILITE) RETURN END ./ ADD NAME=BRANCH ISREDIT MACRO (HELP) ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT IF &HELP = &STR(HELP) THEN GOTO HELPSEC /********************************************************************** /* UTILITY: BRANCH * /* AUTHOR: DAVE LEIGH * /* FUNCTION: BRANCH TO PARAGRAPHS/SECTIONS BASED ON PERFORM AND GOTO * /* STATEMENTS. THIS EDIT MACRO WORKS IN CONJUNCTION WITH * /* EDIT MACRO BRANCHBK WHICH TAKES YOU BACK TO WHERE YOU * /* WERE. * /********************************************************************** /********************************************************************** /* WHAT EDIT PROFILE NUMBERING SCHEME IS BEING USED? * /********************************************************************** ISREDIT (X,Y) = NUMBER IF &X = ON AND &SYSINDEX(&STR( COBOL),&STR(&Y)) > 0 THEN + DO SET COL1 = 1 SET COL2 = 66 END ELSE + DO SET COL1 = 7 SET COL2 = 72 END /********************************************************************** /* IF WE'RE BEFORE THE PROCEDURE DIVISION, JUST GO THERE AND RESET * /* THE BRANCH LEVEL TO 0. * /********************************************************************** ISREDIT FIND ' PROCEDURE ' &COL1 &EVAL(&COL1 + 10 + 3) IF &LASTCC > 0 THEN GOTO FIND_VERB /*** LET'S ONLY LOG THE INITIAL BRANCH! ***/ ISREDIT (LINE,CL) = CURSOR ISREDIT (X,Y) = DISPLAY_LINES ISREDIT LABEL &X = .X ISREDIT LABEL &Y = .Y ISREDIT FIND FIRST ' GO ' &COL1 &COL2 .X .Y ISREDIT (GOTO,NULL) = CURSOR ISREDIT FIND FIRST ' PERFORM ' &COL1 &COL2 .X .Y ISREDIT (PERFORM,NULL) = CURSOR ISREDIT FIND FIRST ' EXIT. ' &COL1 &COL2 .X .Y IF &LASTCC > 0 THEN SET EXIT = &Y ELSE ISREDIT (EXIT,NULL) = CURSOR SET X = &LINE IF &PERFORM > &LINE AND + &PERFORM < &EXIT THEN + SET X = &PERFORM IF (&GOTO > &LINE AND + &GOTO < &EXIT) AND + ((&PERFORM > &LINE AND + &GOTO < &PERFORM) OR + (&PERFORM = &LINE)) THEN + SET X = &GOTO ISREDIT LOCATE .X ISREDIT CURSOR = &X 1 SET BCHLVL = &STR(0) ISPEXEC VPUT BCHLVL SHARED EXIT /********************************************************************** /* LOOK FOR THE PERFORM OR GO TO AND PARSE THE LINE. * /********************************************************************** FIND_VERB: + SET TYPE = PERFORM ISREDIT FIND FIRST ' PERFORM ' &COL1 &COL2 .ZCSR .ZCSR IF &LASTCC > 0 THEN + DO SET TYPE = GOTO ISREDIT FIND FIRST ' GO ' &COL1 &COL2 .ZCSR .ZCSR IF &LASTCC = 0 THEN + DO ISREDIT FIND NEXT ' TO ' &COL1 &COL2 .ZCSR .ZCSR IF &LASTCC = 0 THEN GOTO PARSE_FOR_NAME END SET ZEDSMSG = &STR("PERFORM"³"GO TO" MISSING) ISPEXEC SETMSG MSG(UTLZ001) GOTO FINISH END /********************************************************************** /* FIND THE NAME OF THE SECTION OR PARAGRAPH TO BRANCH TO. * /********************************************************************** PARSE_FOR_NAME: + SET ZEDLMSG = ISREDIT FIND NEXT P'¬' &COL1 &COL2 .ZCSR .ZCSR IF &LASTCC > 0 THEN SET ZEDLMSG = &STR(PARAGRAPH/SECTION NAME NEEDS TO + BE ON THE SAME LINE AS THE + "&TYPE") ISREDIT FIND NEXT P' ' &COL1 &COL2 .ZCSR .ZCSR IF &LASTCC > 0 THEN SET ZEDLMSG = &STR(PARAGRAPH/SECTION NAME NEEDS TO + BE ON THE SAME LINE AS THE + "&TYPE") ISREDIT FIND NEXT P'¬' &COL1 &COL2 .ZCSR .ZCSR IF &LASTCC > 0 THEN SET ZEDLMSG = &STR(PARAGRAPH/SECTION NAME NEEDS TO + BE ON THE SAME LINE AS THE + "&TYPE") ISREDIT (NULL,COLBEGIN) = CURSOR ISREDIT FIND NEXT P' ' &COL1 &COL2 .ZCSR .ZCSR IF &LASTCC > 0 THEN SET COLEND = &COL2 ELSE ISREDIT (NULL,COLEND) = CURSOR SET COLEND = &COLEND - 1 ISREDIT FIND FIRST '.' &COLEND &COLEND .ZCSR .ZCSR IF &LASTCC = 0 THEN SET COLEND = &COLEND - 1 ISREDIT (VERBLINE) = LINE .ZCSR SET SECPARA = &SUBSTR(&COLBEGIN:&COLEND,&STR(&VERBLINE)) SET VERBLINE = &SUBSTR(1:&COL2,&STR(&SYSNSUB(1,&VERBLINE))) /********************************************************************** /* SAVE THE "VERB" LINE AND THE FIRST "DISPLAYED" LINE * /********************************************************************** ISREDIT (DISPLINE,NULL) = DISPLAY_LINES ISREDIT (CURRLINE) = LINENUM .ZCSR SET DISPLINE = &CURRLINE - &DISPLINE - 1 SET TEMPLINE = 0 SET X = 1 ISREDIT FIND FIRST '&STR(&VERBLINE)' ISREDIT (TEMPLINE) = LINENUM .ZCSR DO WHILE &TEMPLINE ¬= &CURRLINE ISREDIT FIND NEXT '&STR(&VERBLINE)' ISREDIT (TEMPLINE) = LINENUM .ZCSR SET X = &X + 1 END SET OCCURANCE = &X /********************************************************************** /* IF THE SECTION/PARAGRAPH TO GO TO EXISTS, GO THERE AND SAVE THE * /* "RETURN" INFORMATION. * /********************************************************************** SET LENSTR = &LENGTH(&STR( &SECPARA)) ISREDIT EXCLUDE ALL P'¬' &COL1 ISREDIT FIND FIRST ' &STR(&SECPARA)' &COL1 &EVAL(&COL1 + &LENSTR + 3) NX IF &LASTCC = 0 THEN + DO ISPEXEC VGET BCHLVL SHARED SET BCHLVL = &BCHLVL + 1 SET BCHT&BCHLVL = &DISPLINE SET BCHV&BCHLVL = &STR(&VERBLINE) SET BCHI&BCHLVL = &OCCURANCE ISREDIT (X,Y) = BOUNDS ISREDIT (LRECL) = LRECL SET BCHB&BCHLVL = &STR(&X &Y &LRECL) ISPEXEC VPUT (BCHLVL BCHT&BCHLVL BCHB&BCHLVL + BCHV&BCHLVL BCHI&BCHLVL) SHARED ISREDIT (LINE,CL) = CURSOR ISREDIT (X,Y) = DISPLAY_LINES IF &LINE > &X THEN + DO ISREDIT LOCATE &LINE ISREDIT (X,Y) = DISPLAY_LINES END ISREDIT LABEL &X = .X ISREDIT LABEL &Y = .Y ISREDIT FIND FIRST ' GO ' &COL1 &COL2 .X .Y ISREDIT (GOTO,NULL) = CURSOR ISREDIT FIND FIRST ' PERFORM ' &COL1 &COL2 .X .Y ISREDIT (PERFORM,NULL) = CURSOR ISREDIT FIND FIRST ' EXIT. ' &COL1 &COL2 .X .Y IF &LASTCC > 0 THEN SET EXIT = &Y ELSE ISREDIT (EXIT,NULL) = CURSOR SET X = &LINE IF &PERFORM > &LINE AND + &PERFORM < &EXIT THEN + SET X = &PERFORM IF (&GOTO > &LINE AND + &GOTO < &EXIT) AND + ((&PERFORM > &LINE AND + &GOTO < &PERFORM) OR + (&PERFORM = &LINE)) THEN + SET X = &GOTO ISREDIT RESET EXCLUDED ISREDIT LOCATE .X ISREDIT CURSOR = &X 1 END ELSE + DO ISREDIT RESET EXCLUDED ISREDIT CURSOR = &CURRLINE 1 ISREDIT LABEL .CURR = .ZCSR ISREDIT LOCATE &EVAL(&CURRLINE - &DISPLINE - 1) ISREDIT FIND FIRST P'=' .CURR .CURR SET ZEDLMSG = &STR(&SECPARA NOT FOUND ³ SPELLING ? ³ COPY + MEMBER ?) ISPEXEC SETMSG MSG(UTLZ001) END EXIT HELPSEC: + WRITE WRITE *** HELP FOR EDIT MACRO 'BRANCH' *** WRITE WRITE THE BRANCH MACRO IS AN EDIT MACRO WHICH IS EXECUTABLE FROM AN EDIT WRITE SESSION OF A COBOL OR COBOL2 PROGRAM. WRITE WRITE THE BRANCH MACRO WILL ENABLE A USER WHO IS EDITING A COBOL PROGRAM WRITE TO PLACE THE CURSOR ANYWHERE ON A LINE IN THE SOURCE CODE WHICH WRITE CONTAINS A 'PERFORM ' OR 'GO TO' STATEMENT. BY DEFINING SINGLE PF WRITE KEY WITH THE WORD 'BRANCH' THE KEY CAN BE PRESSED AND THE SCREEN WRITE WILL BRANCH DIRECTLY TO THE PARAGRAPH NAMED IN THE "PERFORM" OR WRITE "GO TO" STATEMENT. WRITE WRITE UPON ENTERING A COBOL PROGRAM FOR THE FIRST TIME, THE BRANCH PF WRITE KEY MAY BE PRESSED AND THE CURSOR WILL JUMP DIRECTLY TO THE WRITE PROCEDURE DIVISION. WRITE WRITE ONCE IN THE PROCDEURE DIVISION THE CURSOR SHOULD BE PLACED ON A WRITE LINE WHICH CONTAINS A PERFORM OR "GO TO" STATEMENT. IF THERE IS WRITE NO PERFORM OR "GO TO" STATEMENT, A MESSAGE STATING THAT WILL BE WRITE DISPLAYED ON THE TOP RIGHT CORNER OF THE SCREEN. WRITE WRITE MULTIPLE BRANCHES MAY BE STACKED UP TO A MAXIMUM OF 9999 BRANCHES. WRITE THIS MEANS THAT A PERSON MAY BRANCH TO SECTION A, SEE A PERFORM WRITE AND BRANCH TO SECTION B. ONCE FINISHED WITH B, A BRANCHBK MAY BE WRITE EXECUTED TO RETURN TO THE PERFORM STATEMENT IN SECTION A. IF WRITE DESIRED ANOTHER BRANCHBK MAY BE EXECUTED TO RETURN TO THE WRITE STATEMENT WHICH PERFORMED SECTION A. WRITE WRITE NOTE, EVERYTIME A BRANCH IS MADE TO THE PROCEDURE DIVISION FROM WRITE SOMEWHERE EARLIER IN THE PROGRAM THE BRANCH COUNTER IS ZEROED OUT WRITE AND THE COUNTING OF BRANCHES UP TO THE 9999 MAXIMUM BEGINS AGAIN. WRITE WRITE IF THERE HAS BEEN NO INITIAL BRANCH EXECUTED, AND BRANCHBK IS WRITE EXECUTED A MESSAGE STATING 'NO BRANCH BACK POINT' IS DISPLAYED. WRITE WRITE *** END OF HELP *** NO PROCESSING PERFORMED *** FINISH: + EXIT ./ ADD NAME=BRANCHBK ISREDIT MACRO (HELP) ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT IF &HELP = &STR(HELP) THEN GOTO HELPSEC /********************************************************************** /* UTILITY: BRANCHBK * /* AUTHOR: DAVE LEIGH * /* FUNCTION: USED IN CONJUNCTION TO BRANCH "BACK" TO WHERE YOU WERE * /* BEFORE ISSUING THE "BRANCH" COMMAND. * /********************************************************************** /********************************************************************** /* WHAT EDIT PROFILE NUMBERING SCHEME IS BEING USED? * /********************************************************************** ISREDIT (X,Y) = NUMBER IF &X = ON AND &SYSINDEX(&STR( COBOL),&STR(&Y)) > 0 THEN + DO SET COL1 = 1 SET COL2 = 66 END ELSE + DO SET COL1 = 7 SET COL2 = 72 END /********************************************************************** /* WHAT BRANCH LEVEL ARE WE CURRENTLY AT? * /********************************************************************** ISPEXEC VGET BCHLVL SHARED IF &BCHLVL < 1 THEN + DO SET ZEDSMSG = &STR(NO BRANCH BACK POINT) ISPEXEC SETMSG MSG(UTLZ001) EXIT END ISPEXEC VGET (BCHT&BCHLVL BCHV&BCHLVL + BCHB&BCHLVL BCHI&BCHLVL) SHARED SET DISPLINE = &&BCHT&BCHLVL SET VERBLINE = &&BCHV&BCHLVL SET OCCURANCE = &&BCHI&BCHLVL SET SYSDVAL = &&BCHB&BCHLVL SET SYSDVAL = &SYSDVAL READDVAL LEFT RIGHT LRECL IF &COL2 < &RIGHT THEN SET VERBLINE = &SUBSTR(1:&COL2,&STR(&VERBLINE)) ELSE + IF &RIGHT < &LRECL THEN SET VERBLINE = &SUBSTR(1:&RIGHT,&STR(&VERBLINE)) /********************************************************************** /* SEE IF WE CAN FIND THE PLACE TO BRANCH BACK TO. * /********************************************************************** SET QT = &STR(') IF &SYSINDEX(&STR('),&STR(&VERBLINE)) > 0 THEN + IF &SYSINDEX(&STR("),&STR(&VERBLINE)) > 0 THEN ELSE SET QT = &STR(") SET X = 1 ISREDIT FIND FIRST &STR(&QT&VERBLINE&QT) DO WHILE &X ¬= &OCCURANCE AND &LASTCC = 0 SET X = &X + 1 ISREDIT FIND NEXT &STR(&QT&VERBLINE&QT) END ISREDIT LABEL .ZCSR = .CURR ISREDIT UP &DISPLINE /********************************************************************** /* FIND THE NEXT "GO TO" OR "PERFORM" ON THIS SCREEN IF POSSIBLE. * /********************************************************************** ISREDIT (LINE,CL) = CURSOR ISREDIT (X,Y) = DISPLAY_LINES ISREDIT LABEL &X = .X ISREDIT LABEL &Y = .Y ISREDIT FIND LAST P'=' &COL1 &COL2 .CURR .CURR ISREDIT FIND NEXT ' GO ' &COL1 &COL2 .X .Y ISREDIT (GOTO,NULL) = CURSOR ISREDIT FIND LAST P'=' &COL1 &COL2 .CURR .CURR ISREDIT FIND NEXT ' PERFORM ' &COL1 &COL2 .X .Y ISREDIT (PERFORM,NULL) = CURSOR ISREDIT FIND LAST P'=' &COL1 &COL2 .CURR .CURR ISREDIT FIND NEXT ' EXIT. ' &COL1 &COL2 .X .Y IF &LASTCC > 0 THEN SET EXIT = &Y ELSE ISREDIT (EXIT,NULL) = CURSOR SET X = &LINE IF &PERFORM > &LINE AND + &PERFORM <= &EXIT THEN + SET X = &PERFORM IF (&GOTO > &LINE AND + &GOTO <= &EXIT) AND + ((&PERFORM > &LINE AND + &GOTO < &PERFORM) OR + (&PERFORM = &LINE)) THEN + SET X = &GOTO ISREDIT LOCATE .X ISREDIT CURSOR = &X 1 SET BCHLVL = &BCHLVL - 1 ISPEXEC VPUT BCHLVL SHARED EXIT ./ ADD NAME=BROWSEME ISREDIT MACRO (HELP) ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /******************************************************************/ /* 'BROWSEME' EDIT MACRO. BROWSE THE FILE BEING EDITED. */ /* AUTHOR : DAVID LEIGH DATE : 02-20-89 */ /******************************************************************/ IF &HELP = &STR(HELP) THEN GOTO HELPSEC ISREDIT (DSN) = DATASET ISREDIT (MBR) = MEMBER IF &HELP ¬= NOSAVE THEN ISREDIT SAVE IF &STR(&MBR) > THEN ISPEXEC BROWSE DATASET('&DSN(&MBR)') ELSE ISPEXEC BROWSE DATASET('&DSN') EXIT 01000000 HELPSEC: + 02480000 ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) 02490000 SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR BROWSEME UTILITY + 02490000 *** NO PROCESSING PERFORMED ***) 02490000 ISPEXEC SETMSG MSG(UTLZ000) 02490000 EXIT ./ ADD NAME=BTCHEDIT /**********************************************************************/ /* UTILITY: BTCHEDIT */ /* AUTHOR: DAVID LEIGH */ /* FUCTION: THIS CLIST IS INTENDED TO BE CALLED FROM A BATCH TSO STEP */ /* THAT HAS DONE A FULL ISPF GDA CALL FIRST. IT MUST BE */ /* CALLED WITH AN ISPSTART COMMAND. IT HAS POSITIONAL PARMS */ /* OF THE DATASET TO BE EDITED AND THE NAME OF THE INITIAL */ /* MACRO. OPTIONALLY YOU CAN SPECIFY THE KEYWORD PARAMETER */ /* "DEBUG" TO TURN ON THE CLIST CONTROL MESSAGES AND THE */ /* "RXTRC" KEYWORD TO INVOKE EXECUTIL TS BEFORE EDITING */ /* THE DATASET. */ /**********************************************************************/ PROC 2 EDITDSN INITMAC DD() PARMS() DEBUG RXTRC /**********************************************************************/ /* CLIST DEBUGGING */ /**********************************************************************/ IF &DEBUG = DEBUG THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS /**********************************************************************/ /* REXX TRACING */ /**********************************************************************/ IF &RXTRC = RXTRC THEN EXECUTIL TS /**********************************************************************/ /* EDIT THE DATASET */ /**********************************************************************/ IF &STR(PARMS) > &STR() THEN ISPEXEC VPUT PARMS SHARED IF &STR(&DD) = &STR() THEN + ISPEXEC EDIT + DATASET('&STR(&EDITDSN)') + MACRO(&STR(&INITMAC)) ELSE + DO ISPEXEC LMINIT DATAID(DID) DDNAME(&DD) ISPEXEC EDIT + DATAID(&DID) + MACRO(&STR(&INITMAC)) END EXIT ./ ADD NAME=BTCHMACR ISREDIT MACRO ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ISREDIT %DASDUSED ISREDIT END ./ ADD NAME=BULLETIN ISREDIT MACRO (PARM) WRITE THIS UTILITY NOT SET UP YET END ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT IF &PARM = HELP THEN GOTO HELPSEC /********************************************************************** /* EDIT MACRO : BULLETIN * /* AUTHOR : DAVE LEIGH * /* FUNCTION : SEND THE FILE BEING EDITED AS A SERIES OF TSO "SEND" * /* STATEMENTS TO ALL PROJECT TEAM MEMBERS. * /********************************************************************** ISREDIT (LRECL) = LRECL ISREDIT FIND FIRST "'" IF &LASTCC = 0 THEN + DO SET ZEDLMSG = &STR(YOUR MESSAGE CANNOT HAVE SINGLE QUOTES IN + IT, PLEASE USE DOUBLE QUOTES) ISPEXEC SETMSG MSG(UTLZ001) EXIT END ISREDIT FIND FIRST P'.' 69 &LRECL IF &LASTCC = 0 THEN + DO SET ZEDLMSG = &STR(YOUR MESSAGE CANNOT BE LONGER THAN 68 + CHARACTERS ON ANY GIVEN LINE) ISPEXEC SETMSG MSG(UTLZ001) EXIT END ISREDIT SAVE SET DSNLEN = &LENGTH(&STR(&SYSUID..TEMP.BULLETIN)) ISPEXEC TBOPEN PROJECT NOWRITE ISPEXEC TBVCLEAR PROJECT ISPEXEC TBTOP PROJECT SET PRJELEM = LOGONIDS SET PRJQUAL = DATASET ISPEXEC TBSCAN PROJECT ARGLIST(PRJELEM,PRJQUAL) + CONDLIST(EQ,EQ) SET LOGONS = &PRJPARM ISPEXEC TBEND PROJECT TSOPXSET * ACCNT(TSO) IF &PARM = JCL THEN SET MSGCLASS = &STR(,MSGCLASS=Y) ISREDIT (DSN) = DATASET ISREDIT (MBR) = MEMBER IF &MBR > THEN SET DSN = &STR(&DSN(&MBR)) IF &PARM = JCL THEN + DO FREE DDNAME(ISPFILE QUICK) FREE ATTRLIST(FB80) DELETE TEMP.JCL ATTRIB FB80 OUTPUT RECFM(F B) LRECL(80) DSORG(PS) ALLOCATE DDNAME(QUICK) DSN(TEMP.JCL) + NEW CATALOG + UNIT(SYSDA) + SPACE(1,1) AVBLOCK(10796) RELEASE + USING(FB80) FREE DDNAME(QUICK) ALLOCATE DDNAME(ISPFILE) DSN(TEMP.JCL) + OLD ISPEXEC FTOPEN ISPEXEC FTINCL BULLETIN SET SAVECC = &LASTCC ISPEXEC FTCLOSE FREE DDNAME(ISPFILE) IF &SAVECC > 0 THEN + DO SET ZEDLMSG = &STR(*** UNABLE TO CREATE JCL TO SEND + YOUR MESSAGE *** RC = &SAVECC ***) ISPEXEC SETMSG MSG(UTLZ001) END ELSE + DO ISPEXEC SETMSG MSG(UTILM030) ISPEXEC EDIT DATASET(TEMP.JCL) END END ELSE + DO ISPEXEC VGET (ZTEMPF) ISPEXEC FTOPEN TEMP ISPEXEC FTINCL BULLETIN SET SAVECC = &LASTCC ISPEXEC FTCLOSE IF &SAVECC > 0 THEN + DO SET ZEDLMSG = &STR(*** UNABLE TO CREATE JCL TO SEND + YOUR MESSAGE *** RC = &SAVECC ***) ISPEXEC SETMSG MSG(UTLZ001) END ELSE + DO SET ZEDLMSG = &STR(*** MESSAGE SENT TO ALL CMC + USERS ***) ISPEXEC SETMSG MSG(UTLZ000) SUBMIT '&ZTEMPF' END END EXIT HELPSEC: + 02480000 ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) 02490000 SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR BULLETIN UTILITY + 02490000 *** NO PROCESSING PERFORMED ***) 02490000 ISPEXEC SETMSG MSG(UTLZ000) 02490000 EXIT ./ ADD NAME=CALADD PROC 3 APPLIB MEMBER CALLIB DEBUG /*** CHECK THE DEBUG SWITCH ***/ IF &DEBUG = DEBUG THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS IF &STR(&MEMBER) = 0 THEN + DO SET SYSOUTTRAP = 1000 PDS '&APPLIB' MEMBERS #* SET SYSOUTTRAP = 0 SET X = &SYSOUTLINE SET LINE = &&SYSOUTLINE&X SET LINE = &LINE IF &LINE = &STR(NO MEMBER NAMES MATCH THIS COMBINATION NAME) + THEN SET MEMBER = #0000001 ELSE + DO SET X = &X - 2 SET LINE = &&SYSOUTLINE&X SET LINE = &LINE SET LEN = &LENGTH(&LINE) SET MEMBER = DO I = &LEN TO 1 BY -1 IF &SUBSTR(&I:&I,&LINE) = &STR(#) THEN + SET I = -1 ELSE + SET NUMBER = &SUBSTR(&I:&I,&LINE)&STR(&NUMBER) END SET NUMBER = &NUMBER + 1 SET NUMBER = &SUBSTR(&LENGTH(&STR(000000&NUMBER))-6:+ &LENGTH(&STR(000000&NUMBER)),+ &STR(000000&NUMBER)) SET MEMBER = &STR(#&NUMBER) END END IF &SYSDSN('&APPLIB(&MEMBER)') = OK THEN + DO WRITE Appointment Key &MEMBER already exists. WRITENR Press ENTER to continue. . . READ EXIT END REDOIT: + SET MM= SET DATESET = NO SET FTSET = NO SET TTSET = NO SET FROMTIMEKEY = SET TOTIMEKEY = SET DESC = SET DATEKEY = SET TIMEKEY = SET THEDATE = THETOP: CLEAR WRITE ****************************************************************+ *************** WRITE &STR(TASK ===> Make Appointment TODAYS DATE ===> &SYSDATE + &STR( KEY ===> &MEMBER)) WRITE ****************************************************************+ *************** WRITE IF &DATESET = NO THEN + DO SET XMM = &SUBSTR(1:2,&STR(&SYSDATE)) SET XDD = &SUBSTR(4:5,&STR(&SYSDATE)) SET XYY = &SUBSTR(7:8,&STR(&SYSDATE)) WRITE Enter Appointment Date in MM DD YY format or WRITENR press to use today's date: READ MM,DD,YY IF &STR(&MM) = THEN SET MM = &STR(&XMM) IF &STR(&DD) = THEN SET DD = &STR(&XDD) IF &STR(&YY) = THEN SET YY = &STR(&XYY) SYSCALL VERDATE MM DD YY DATEKEY IF &LASTCC ¬= 0 THEN GOTO THETOP SET THEDATE = &STR(&MM/&DD/&YY) SET DATESET = YES END ELSE + DO WRITE Enter Appointment Date (MM DD YY): &THEDATE END WRITE IF &FTSET = NO THEN + DO WRITE Enter the precise time you want to make the appointment for, WRITE or just press if you're just looking for a reminder WRITE for that day. WRITENR Make an appointment on &THEDATE at (time=HH MM Am/Pm): READ FROMHH,FROMMM,FROMZONE IF &FROMHH ¬= THEN + DO IF &FROMMM = THEN SET FROMMM = 99 IF &FROMZONE = THEN SET FROMZONE = x SET FROMZONE = &SYSCAPS(&FROMZONE) SYSCALL VERTIME FROMHH FROMMM FROMZONE TIMEKEY IF &LASTCC ¬= 0 THEN GOTO THETOP SET FROMTIMEKEY = &STR(&TIMEKEY) SET FTSET = YES END ELSE + DO SET FROMTIMEKEY = &STR(9999) SET TOTIMEKEY = &STR(9999) SET FTSET = YES SET TTSET = YES END END ELSE + DO WRITE Make an appointment on &THEDATE at (time=HH MM Am/Pm): + &STR(&FROMHH:&FROMMM &FROMZONE) END IF &TTSET = NO THEN + DO WRITENR &STR( and ending at (time=HH MM Am/Pm):) READ TOHH,TOMM,TOZONE IF &TOHH ¬= THEN + DO IF &TOMM = THEN SET TOMM = 99 IF &TOZONE = THEN SET TOZONE = x SET TOZONE = &SYSCAPS(&TOZONE) SYSCALL VERTIME TOHH TOMM TOZONE TIMEKEY IF &LASTCC ¬= 0 THEN GOTO THETOP SET TOTIMEKEY = &STR(&TIMEKEY) SET TTSET = YES END END ELSE + DO IF &STR(&TOTIMEKEY) ¬= &STR(9999) THEN + WRITE &STR( and ending at (time=HH MM Am/Pm): + &STR(&TOHH:&TOMM &TOZONE) END WRITE WRITE Enter a 1-64 character appointment description below. WRITENR &STR(=============>) IF &STR(&SYSNSUB(1,&DESC)) = THEN + DO READ SET DESC = &STR(&SYSNSUB(1,&SYSDVAL)) IF &STR(&SYSNSUB(1,&DESC)) ¬= THEN + DO IF &LENGTH(&STR(&SYSNSUB(1,&DESC))) > 64 THEN + DO WRITE WRITE ***ERROR - Appointment description is greater than + 64 characters. WRITE WRITENR Press ENTER to continue. . . READ SET DESC = GOTO THETOP END END END ELSE + DO WRITE &STR(&SYSNSUB(1,&DESC)) END WRITE WRITE Appointment: &STR(&SYSNSUB(1,&DESC)) WRITE &STR( on: &THEDATE) IF &FROMTIMEKEY = &STR(9999) THEN + DO WRITE &STR( *** All Day Reminder ***) END ELSE + DO WRITE &STR( from: &STR(&FROMHH:&FROMMM) &FROMZONE) WRITE &STR( to: &STR(&TOHH:&TOMM) &TOZONE) END WRITE WRITENR Enter Option ((S)ave (R)edo X to exit function): READ CHOICE SET CHOICE = &SYSCAPS(&CHOICE) SELECT &CHOICE WHEN (S) DO IF &DATESET = YES AND &FTSET = YES AND &TTSET = YES AND + &STR(&SYSNSUB(1,&DESC)) ¬= THEN GOTO SAVEIT ELSE + DO WRITE Appointment data is incomplete. WRITENR Press ENTER to continue. . . READ GOTO THETOP END END WHEN (R) GOTO REDOIT WHEN (X) EXIT WHEN () GOTO THETOP OTHERWISE DO WRITE Option &CHOICE not available. WRITENR Press ENTER to continue. . . READ GOTO THETOP END END SAVEIT: + SET FREQSET = NO SAVECLR: CLEAR WRITE ****************************************************************+ *************** WRITE &STR(TASK ===> Make Appointment TODAYS DATE ===> &SYSDATE + &STR( KEY ===> &MEMBER)) WRITE ****************************************************************+ *************** WRITE &STR(Appointment: &SYSNSUB(1,&DESC)) WRITE &STR( on: &THEDATE) IF &STR(&FROMTIMEKEY) = &STR(9999) THEN + DO WRITE &STR( *** All Day Reminder ***) END ELSE + DO WRITE &STR( from: &STR(&FROMHH:&FROMMM) &FROMZONE) WRITE &STR( to: &STR(&TOHH:&TOMM) &TOZONE) END WRITE *---------------------------------------------------------------+ --------------* WRITE WRITE Enter Appointment frequency below: WRITE WRITE &STR( 1 - One Day Only 5 - Monthly (Same date-day each + month) WRITE &STR( 2 - Daily 6 - On Additional Specific Day(s)) WRITE &STR( 3 - Weekly P - Previous function) WRITE &STR( 4 - Biweekly X - Exit MAKE APPOINTMENT function + (no update)) WRITE SET SPAN = 0 IF &FREQSET = NO THEN + DO WRITENR Enter Selection: READ FREQ SET FREQ = &SYSCAPS(&FREQ) SET FREQSET = YES END ELSE WRITE Enter Selection: &FREQ IF &FREQ = 2 OR &FREQ = 3 OR &FREQ = 4 OR &FREQ = 5 THEN + DO WRITE WRITENR Enter Number of Appointments to Log (0 = Reset): READ SPAN SET DTSPAN = &DATATYPE(&SPAN) IF &DTSPAN ¬= NUM THEN + DO WRITE WRITE ***ERROR - Parameter must be numeric. WRITENR Press ENTER to continue. . . READ GOTO SAVECLR END IF &SPAN = 0 THEN GOTO SAVEIT IF &SPAN > 30 THEN + DO WRITE WRITENR &SPAN appointments!!! SET ANSR = N DO UNTIL &ANSR = Y WRITENR Are you sure?!(Y/N): READ ANSR SET ANSR = &SYSCAPS(&ANSR) IF &ANSR = N THEN GOTO SAVECLR END CLEAR WRITE ********************************************************+ *********************** WRITE ************************* W A R N I N G **+ *********************** WRITE ********************************************************+ *********************** WRITE WRITE Up to &SPAN new members may be created in your Calendar + library! WRITE WRITE Has the library been allocated to accommodate this kind + of expansion? WRITE SET ANSR = N DO UNTIL &ANSR = Y WRITENR Do you want to continue?(Y/N): READ ANSR SET ANSR = &SYSCAPS(&ANSR) IF &ANSR = N THEN GOTO THETOP END END CLEAR SET CONFIRM = N DO UNTIL &CONFIRM = Y OR &CONFIRM = N WRITENR Do you want to confirm each appointment log entry?(Y/N): READ CONFIRM SET CONFIRM = &SYSCAPS(&CONFIRM) END END SELECT &FREQ WHEN (1) SET FREQ = 0 WHEN (2) SET FREQ = 1 WHEN (3) SET FREQ = 7 WHEN (4) SET FREQ = 14 WHEN (5) SET FREQ = M WHEN (6) SET FREQ = S WHEN (P) GOTO THETOP WHEN (X) EXIT OTHERWISE DO WRITE WRITE Option &FREQ not available. WRITENR Press ENTER to continue. . . READ GOTO SAVEIT END END CLEAR SET GREGDATE = X SYSCALL CONVDATE &DATEKEY GREGDATE SET ERRCC = &LASTCC IF &ERRCC ¬= 0 THEN + DO WRITE *** ERROR &ERRCC OCCURRED DURING PROC CALL *** WRITE PROCESSING TERMINATED. . . READ GOTO WRAPUP END WRITE Logging Appointment Entry &GREGDATE . . . FREE DD(APPKEYDD) ALLOC DD(APPKEYDD) DSN('&APPLIB(&MEMBER)') SHR FREE DD(CALDATDD) ALLOC DD(CALDATDD) DSN('&CALLIB(&DATEKEY)') SHR SET OPENTYPE = OUTPUT IF &SYSDSN('&CALLIB(&DATEKEY)') = OK THEN + DO SET OPENTYPE = INPUT FREE DD(TEMPDD) ALLOC DD(TEMPDD) DSN('&CALLIB($TEMP)') SHR END SET NOSPACE = APP ERROR DO SET ERRCC = &LASTCC SELECT (&ERRCC) WHEN (400) DO SET EOF = YES RETURN END WHEN (SB14) DO FREE DD(APPKEYDD) WRITE WRITENR Press ENTER for abend recovery. . . READ IF &DEBUG = DEBUG THEN + %CALRCVRY &APPLIB &MEMBER &CALLIB &NOSPACE DEBUG ELSE + %CALRCVRY &APPLIB &MEMBER &CALLIB &NOSPACE EXIT END OTHERWISE DO ERROR OFF WRITE *** ERROR CC: &ERRCC OCCURRED PROCESSING FILE *** READ CLOSFILE APPKEYDD FREE DD(APPKEYDD) EXIT END END END SET EOF = NO OPENFILE APPKEYDD OUTPUT OPENFILE CALDATDD &OPENTYPE IF &LENGTH(&MEMBER) ¬= 8 THEN + SET RECKEY = &STR(&MEMBER&SUBSTR(1:8 - &LENGTH(&MEMBER),&STR( + ))) ELSE SET RECKEY = &MEMBER SET THEAPPMT = &STR(&RECKEY&FROMTIMEKEY&TOTIMEKEY)+ &STR(&SYSNSUB(1,&DESC)) SET APPKEYDD = &STR(&SYSNSUB(1,&THEAPPMT)) PUTFILE APPKEYDD SET APPKEYDD = &DATEKEY PUTFILE APPKEYDD SET NOSPACE = CAL IF &OPENTYPE = INPUT THEN + DO OPENFILE TEMPDD OUTPUT DO UNTIL &EOF = YES GETFILE CALDATDD IF &EOF = NO THEN + DO SET TEMPDD = &CALDATDD PUTFILE TEMPDD END END SET EOF = NO CLOSFILE TEMPDD CLOSFILE CALDATDD OPENFILE TEMPDD INPUT OPENFILE CALDATDD OUTPUT SET INSERT = NO DO UNTIL &EOF = YES GETFILE TEMPDD IF &EOF = NO THEN + DO IF (&SUBSTR(9:12,&STR(&SYSNSUB(1,&THEAPPMT))) = + &SUBSTR(9:12,&TEMPDD) + AND &STR(&FROMTIMEKEY) ¬= &STR(9999)) + OR (&SUBSTR(9:12,&STR(&SYSNSUB(1,&THEAPPMT))) > + &SUBSTR(9:12,&TEMPDD) + AND &STR(&FROMTIMEKEY) ¬= &STR(9999) + AND &SUBSTR(9:12,&STR(&SYSNSUB(1,&THEAPPMT))) < + &SUBSTR(13:16,&TEMPDD)) THEN + DO WRITE WRITE ***WARNING - Conflicting appointment times within + calendar dated &GREGDATE WRITE WRITENR Press ENTER to continue. . . READ END IF &INSERT = NO THEN + DO IF &SUBSTR(9:12,&STR(&SYSNSUB(1,&THEAPPMT))) < + &SUBSTR(9:12,&TEMPDD) THEN + DO SET CALDATDD = &STR(&SYSNSUB(1,&THEAPPMT)) PUTFILE CALDATDD SET INSERT = YES END END IF (&SUBSTR(13:16,&STR(&SYSNSUB(1,&THEAPPMT))) > + &SUBSTR(9:12,&TEMPDD)) AND + &STR(&FROMTIMEKEY) ¬= &STR(9999) AND + &INSERT = YES THEN + DO WRITE WRITE ***WARNING - Conflicting appointment times + within calendar dated &GREGDATE WRITE WRITENR Press ENTER to continue. . . READ END SET CALDATDD = &TEMPDD PUTFILE CALDATDD END END SET EOF = NO CLOSFILE TEMPDD IF &INSERT = NO THEN + DO SET CALDATDD = &STR(&SYSNSUB(1,&THEAPPMT)) PUTFILE CALDATDD END END ELSE + DO SET CALDATDD = &STR(&SYSNSUB(1,&THEAPPMT)) PUTFILE CALDATDD END CLOSFILE CALDATDD FREE DD(CALDATDD) IF &OPENTYPE = INPUT THEN + DO OPENFILE TEMPDD OUTPUT CLOSFILE TEMPDD FREE DD(TEMPDD) END IF &FREQ = 0 THEN GOTO WRAPUP IF &FREQ = S THEN SET SPAN = 2 SET SPAN = &SPAN - 1 DO WHILE &SPAN > 0 SET CURRDATE = &DATEKEY SELECT &FREQ WHEN (S) DO SET SPECSET = NO DO UNTIL &SPECSET = YES CLEAR WRITE **** Completing Rest of Schedule **** WRITE WRITE Note: Date entered must be greater than &GREGDATE WRITE SET MM = DO UNTIL &MM ¬= WRITENR Enter next appointment date (0 = Done) (MM DD YY): READ MM,DD,YY END IF &MM = 0 THEN GOTO WRAPUP ELSE + DO IF &DD = THEN SET DD = 0 IF &YY = THEN SET YY = 0 SYSCALL VERDATE MM DD YY DATEKEY SET ERRCODE = &LASTCC IF &ERRCODE = 0 THEN + DO IF &DATEKEY .> &CURRDATE THEN + DO WRITE WRITE ***ERROR - New appointment date must be + greater than &GREGDATE READ SET ERRCODE = 8 SET DATEKEY = &CURRDATE END END IF &ERRCODE = 0 THEN + DO SET &GREGDATE = &STR(&MM/&DD/&YY) SET SPECSET = YES SET SPAN = 2 WRITE END END END END WHEN (M) DO SET MM = &SUBSTR(1:2,&GREGDATE) SET DD = &SUBSTR(4:5,&GREGDATE) SET YY = &SUBSTR(7:8,&GREGDATE) SET MM = &MM + 1 IF &MM > 12 THEN + DO SET MM = 1 SET YY = &YY + 1 END SYSCALL VERDATE MM DD YY DATEKEY SET ERRCC = &LASTCC IF &ERRCC ¬= 0 THEN + DO WRITE *** ERROR &ERRCC OCCURRED DURING VERDATE CALL *** WRITE PROCESSING TERMINATED. . . READ GOTO WRAPUP END SET GREGDATE = &STR(&MM/&DD/&YY) END OTHERWISE DO SET YY = &SUBSTR(2:3,&CURRDATE) SET &LEAPYY = &YY//4 SET JDAYS = &STR(&SUBSTR(4:6,&CURRDATE)) SET NEWJDAYS = &JDAYS + &FREQ IF (&LEAPYY = 0 AND &NEWJDAYS > 366) OR + (&LEAPYY ¬= 0 AND &NEWJDAYS > 365) THEN + DO SET YY = &YY + 1 SET NEWJDAYS = 1 SET CURRDATE = #&STR(&YY) END SELECT &LENGTH(&NEWJDAYS) WHEN (1) SET NEWJDAYS = &STR(00)&NEWJDAYS WHEN (2) SET NEWJDAYS = &STR(0)&NEWJDAYS END SET DATEKEY = &STR(&SUBSTR(1:3,&CURRDATE))&STR(&NEWJDAYS) SYSCALL CONVDATE &DATEKEY GREGDATE SET ERRCC = &LASTCC IF &ERRCC ¬= 0 THEN + DO WRITE *** ERROR &ERRCC OCCURRED DURING CONVDATE CALL *** WRITE PROCESSING TERMINATED. . . READ GOTO WRAPUP END END END SET ANSR = Y IF &CONFIRM = Y THEN + DO CLEAR WRITE **** Completing Rest of Schedule **** WRITE WRITE Logging Appointment Entry &GREGDATE . . . WRITE SET &ANSR = DO UNTIL &ANSR = Y OR &ANSR = N WRITENR Want to save this log entry?(Y/N): READ ANSR SET ANSR = &SYSCAPS(&ANSR) END END ELSE WRITE Logging Appointment Entry &GREGDATE . . . IF &ANSR = Y THEN + DO ERROR OFF FREE DD(CALDATDD) ALLOC DD(CALDATDD) DSN('&CALLIB(&DATEKEY)') SHR SET OPENTYPE = OUTPUT IF &SYSDSN('&CALLIB(&DATEKEY)') = OK THEN + DO SET OPENTYPE = INPUT FREE DD(TEMPDD) ALLOC DD(TEMPDD) DSN('&CALLIB($TEMP)') SHR END ERROR DO SET ERRCC = &LASTCC SELECT (&ERRCC) WHEN (400) DO SET EOF = YES RETURN END WHEN (SB14) DO CLOSFILE APPKEYDD FREE DD(CALDATDD) FREE DD(APPKEYDD) WRITE WRITENR Press ENTER for abend recovery. . . READ IF &DEBUG = DEBUG THEN + %CALRCVRY &APPLIB &MEMBER &CALLIB &NOSPACE DEBUG ELSE + %CALRCVRY &APPLIB &MEMBER &CALLIB &NOSPACE EXIT END OTHERWISE DO ERROR OFF WRITE *** ERROR CC: &ERRCC OCCURRED PROCESSING FILE *** READ FREE DD(CALDATDD) FREE DD(APPKEYDD) EXIT END END END OPENFILE CALDATDD &OPENTYPE IF &OPENTYPE = INPUT THEN + DO OPENFILE TEMPDD OUTPUT DO UNTIL &EOF = YES GETFILE CALDATDD IF &EOF = NO THEN + DO SET TEMPDD = &CALDATDD PUTFILE TEMPDD END END SET EOF = NO CLOSFILE TEMPDD CLOSFILE CALDATDD OPENFILE TEMPDD INPUT OPENFILE CALDATDD OUTPUT SET INSERT = NO DO UNTIL &EOF = YES GETFILE TEMPDD IF &EOF = NO THEN + DO IF (&SUBSTR(9:12,&STR(&SYSNSUB(1,&THEAPPMT))) = + &SUBSTR(9:12,&TEMPDD) + AND &STR(&FROMTIMEKEY) ¬= &STR(9999)) + OR (&SUBSTR(9:12,&STR(&SYSNSUB(1,&THEAPPMT))) > + &SUBSTR(9:12,&TEMPDD) + AND &STR(&FROMTIMEKEY) ¬= &STR(9999) + AND &SUBSTR(9:12,&STR(&SYSNSUB(1,&THEAPPMT))) < + &SUBSTR(13:16,&TEMPDD)) + THEN + DO WRITE WRITE ***WARNING - Conflicting appointment times + within calendar dated &GREGDATE WRITE WRITENR Press ENTER to continue. . . READ END IF &INSERT = NO THEN + DO IF &SUBSTR(9:12,&STR(&SYSNSUB(1,&THEAPPMT))) < + &SUBSTR(9:12,+ &TEMPDD) THEN + DO SET CALDATDD = &STR(&SYSNSUB(1,&THEAPPMT)) PUTFILE CALDATDD SET INSERT = YES END END IF (&SUBSTR(13:16,&STR(&SYSNSUB(1,&THEAPPMT))) > + &SUBSTR(9:12,&TEMPDD)) + &STR(&FROMTIMEKEY) ¬= &STR(9999) AND + AND &INSERT = YES THEN + DO WRITE WRITE ***WARNING - Conflicting appointment times + within calendar dated &GREGDATE WRITE WRITENR Press ENTER to continue. . . READ END SET CALDATDD = &TEMPDD PUTFILE CALDATDD END END SET EOF = NO CLOSFILE TEMPDD IF &INSERT = NO THEN + DO SET CALDATDD = &STR(&SYSNSUB(1,&THEAPPMT)) PUTFILE CALDATDD END END ELSE + DO SET CALDATDD = &STR(&SYSNSUB(1,&THEAPPMT)) PUTFILE CALDATDD END CLOSFILE CALDATDD FREE DD(CALDATDD) IF &OPENTYPE = INPUT THEN + DO OPENFILE TEMPDD OUTPUT CLOSFILE TEMPDD FREE DD(TEMPDD) END SET APPKEYDD = &DATEKEY PUTFILE APPKEYDD IF &FREQ = S THEN + DO WRITE WRITE Appointment &GREGDATE logged. WRITENR Press ENTER to continue. . . READ END END ELSE + DO WRITE WRITE Appointment log entry &GREGDATE skipped. WRITE WRITENR Press ENTER to continue. . . READ END SET SPAN = &SPAN - 1 END WRAPUP: + SET NOSPACE = APP CLOSFILE APPKEYDD FREE DD(APPKEYDD) WRITE WRITE Calendar updating concluded. WRITENR Press ENTER to continue. . . READ EXIT /***************************/ /*** CONVERT JUL TO GREG ***/ /***************************/ CONVDATE: PROC 2 &DATEKEY &GREGDATE SYSREF GREGDATE SET JDAYS = &SUBSTR(4:6,&DATEKEY) SET YY = &SUBSTR(2:3,&DATEKEY) SET &LEAPYY = &YY//4 SET LYDAY = IF &LEAPYY = 0 THEN + DO IF &JDAYS = 60 THEN SET LYDAY = 29 IF &JDAYS > 59 THEN SET &JDAYS = &JDAYS - 1 END SET &MM = 0 SELECT WHEN (&JDAYS > 334) DO SET MM = 12 SET DD = &JDAYS - 334 END WHEN (&JDAYS > 304) DO SET MM = 11 SET DD = &JDAYS - 304 END WHEN (&JDAYS > 273) DO SET MM = 10 SET DD = &JDAYS - 273 END WHEN (&JDAYS > 243) DO SET MM = &STR(09) SET DD = &JDAYS - 243 END WHEN (&JDAYS > 212) DO SET MM = &STR(08) SET DD = &JDAYS - 212 END WHEN (&JDAYS > 181) DO SET MM = &STR(07) SET DD = &JDAYS - 181 END WHEN (&JDAYS > 151) DO SET MM = &STR(06) SET DD = &JDAYS - 151 END WHEN (&JDAYS > 120) DO SET MM = &STR(05) SET DD = &JDAYS - 120 END WHEN (&JDAYS > 90) DO SET MM = &STR(04) SET DD = &JDAYS - 90 END WHEN (&JDAYS > 59) DO SET MM = &STR(03) SET DD = &JDAYS - 59 END WHEN (&JDAYS > 31) DO SET MM = &STR(02) IF &LYDAY ¬= AND &JDAYS = 59 THEN SET DD = &LYDAY ELSE SET DD = &JDAYS - 31 END OTHERWISE DO SET MM = &STR(01) SET DD = &JDAYS END END IF &LENGTH(&DD) = 1 THEN SET DD = &STR(0&DD) SET GREGDATE = &STR(&MM/&DD/&YY) END /***********************/ /*** VERIFY DATE KEY ***/ /***********************/ VERDATE: PROC 4 &MM &DD &YY &DATEKEY SYSREF MM SYSREF DD SYSREF YY SYSREF DATEKEY SET &BADDAY = NO IF &LENGTH(&STR(&MM)) = 1 THEN SET MM = &STR(0&MM) IF &LENGTH(&STR(&DD)) = 1 THEN SET DD = &STR(0&DD) IF &MM < 01 OR &MM > 12 THEN + DO WRITE WRITE ***ERROR - Invalid month value >&MM READ RETURN CODE(8) END IF &YY = 0 THEN SET &YY = &STR(&SUBSTR(1:2,&SYSJDATE)) ELSE + IF &YY < 91 OR &YY > 99 THEN + DO WRITE WRITE ***ERROR - Invalid year value >&YY READ RETURN CODE(8) END SET &LEAPYY = &YY//4 IF &DD > 0 THEN + IF &MM = 01 OR &MM = 03 OR &MM = 05 OR + &MM = 07 OR &MM = 08 OR &MM = 10 OR &MM = 12 THEN + DO IF &DD > 31 THEN SET &BADDAY = YES END ELSE IF &MM = 04 OR &MM = 06 OR &MM = 09 OR &MM = 11 THEN + DO IF &DD > 30 THEN SET &BADDAY = YES END ELSE + DO IF &MM = 02 THEN + DO IF &LEAPYY = 0 THEN + DO IF &DD > 29 THEN SET &BADDAY = YES END ELSE IF &DD > 28 THEN SET &BADDAY = YES END END ELSE SET &BADDAY = YES IF &BADDAY = YES THEN + DO WRITE WRITE ***ERROR - Invalid day value >&DD READ RETURN CODE(8) END /*** CONVERT DATE TO JULIAN ***/ SET &JDAYS = 0 SELECT &MM WHEN (2) SET &JDAYS = 31 WHEN (3) SET &JDAYS = 59 WHEN (4) SET &JDAYS = 90 WHEN (5) SET &JDAYS = 120 WHEN (6) SET &JDAYS = 151 WHEN (7) SET &JDAYS = 181 WHEN (8) SET &JDAYS = 212 WHEN (9) SET &JDAYS = 243 WHEN (10) SET &JDAYS = 273 WHEN (11) SET &JDAYS = 304 WHEN (12) SET &JDAYS = 334 END SET &JDAYS = &JDAYS + &DD IF &LEAPYY = 0 AND &MM > 02 THEN SET &JDAYS = &JDAYS + 1 SELECT &LENGTH(&JDAYS) WHEN (1) SET DATEKEY = &YY&STR(00)&JDAYS WHEN (2) SET DATEKEY = &YY&STR(0)&JDAYS OTHERWISE SET DATEKEY = &YY&JDAYS END SET COMPDATE = &SUBSTR(1:2,&SYSJDATE)&SUBSTR(4:6,&SYSJDATE) IF &DATEKEY < &COMPDATE THEN + DO WRITE WRITE ***ERROR - Appointment date cannot be less than current date. READ RETURN CODE(8) END ELSE SET DATEKEY = #&DATEKEY END /*******************/ /*** VERIFY TIME ***/ /*******************/ VERTIME: PROC 4 &CHH &CMM &CZONE &TIMEKEY SYSREF TIMEKEY SYSREF CHH SYSREF CMM SYSREF CZONE SET DTHH = &DATATYPE(&CHH) SET DTMM = &DATATYPE(&CMM) IF &DTHH ¬= NUM OR &DTMM ¬= NUM THEN + DO WRITE ***ERROR - Time parameter(s) not numeric. READ RETURN CODE(8) END IF &LENGTH(&STR(&CHH)) > 2 THEN + DO WRITE ***ERROR - HOURS parameter too large. READ RETURN CODE(8) END IF &LENGTH(&STR(&CMM)) > 2 THEN + DO WRITE ***ERROR - MINUTES parameter too large. READ RETURN CODE(8) END IF &CHH < 0 OR &CHH > 12 THEN + DO WRITE ***ERROR - Time hours value is invalid. READ RETURN CODE(8) END IF &CMM < 0 OR &CMM > 59 THEN + DO WRITE ***ERROR - Time minutes value is invalid. READ RETURN CODE(8) END SET CZONE = &SUBSTR(1:1,&CZONE) IF &CZONE ¬= A AND &CZONE ¬= P THEN + DO WRITE ***ERROR - Invalid time zone specified > &CZONE READ RETURN CODE(8) END SELECT &LENGTH(&STR(&CHH)) WHEN (1) DO IF &LENGTH(&STR(&CMM)) = 1 THEN SET CMM = &STR(0&CMM) SET CHH = &STR(0&CHH) END OTHERWISE DO IF &LENGTH(&STR(&CMM)) = 1 THEN SET CMM = &STR(0&CMM) END END SET MHH = &STR(&CHH) IF &CZONE = P AND &CHH ¬= 12 THEN SET MHH = &CHH + 12 IF &CZONE = A AND &CHH = 12 THEN SET MHH = &STR(00) SET TIMEKEY = &STR(&MHH&CMM) SET CZONE = &CZONE.m END ./ ADD NAME=CALCIX /*CALCULATE INDEX SIZE */ PROC 0 SET &COLS = ? SET &NULCOL = 0 SET &KEYLEN = ? SET &SUBPAG = 4 SET &RECORDS= ? SET &DUP = 0 SET &PCTFREE= 5 SET &FREEPAG= 0 NXTP: + ISPEXEC DISPLAY PANEL(DB2CALI) IF &LASTCC=8 THEN EXIT SET &MSG001= SET &IXINPG= SET &ROOT= SET &HIGIX= SET &MIDIX= SET &LOWIX= SET &NLEAF= SET &TRK80P= SET &TRK80S= SET &TRK90P= SET &TRK90S= SET &T1= SET &T2= IF &COLS > 64 + THEN DO SET &MSG001 = &STR(MAX. INDEX COLUMNS IS 64 FOR DB2 V2.3) GOTO NXTP END IF (&SUBPAG ¬= 1 AND &SUBPAG ¬= 2 AND &SUBPAG ¬= 4 AND - &SUBPAG ¬= 8 AND &SUBPAG ¬= 16) - THEN SET &SUBPAG=4 IF &SUBPAG < 8 AND (&KEYLEN > (254-&DUP)) + THEN GOTO ERRLN IF &SUBPAG = 8 AND &DUP>0 AND (&KEYLEN > (251-&NULCOL)) + THEN GOTO ERRLN IF &SUBPAG = 8 AND &DUP=0 AND (&KEYLEN > (238-&NULCOL)) + THEN GOTO ERRLN IF &SUBPAG = 16 AND &DUP>0 AND (&KEYLEN > (114-&NULCOL)) + THEN GOTO ERRLN IF &SUBPAG = 16 AND &DUP=0 AND (&KEYLEN > (111-&NULCOL)) + THEN GOTO ERRLN IF &DUP=0 THEN SET &DUP=1 /*IF &PARTION = Y AND (&KEYLEN > (40-&NULCOL)) + THEN GOTO ERRLN */ SET &SN=(100-&PCTFREE)*&DUP IF &SUBPAG=1 - THEN SET - &IXINPG=&SN*(4050/(&KEYLEN+(4*&DUP)))/100 ELSE SET - &IXINPG=&SN*(4067-&SUBPAG/(&KEYLEN+21))/(&KEYLEN+(4*&DUP))/100 SET &FRSTLVL=(&RECORDS/&IXINPG)+1 IF &FREEPAG > 0 THEN SET &FRSTLVL=&FRSTLVL+(&FRSTLVL/&FREEPAG)+1 IF &FRSTLVL < 10 THEN SET &FRSTLVL=10 IF &FRSTLVL > 10 THEN SET &SECLVL=(&FRSTLVL/&IXINPG)+1 ELSE SET &SECLVL=0 IF &SECLVL > 1 THEN SET &TRDLVL=(&SECLVL/&IXINPG)+1 ELSE SET &TRDLVL=0 IF &TRDLVL > 1 THEN SET &FORLVL=(&TRDLVL/&IXINPG)+1 ELSE SET &FORLVL=0 IF &FORLVL > 1 THEN SET &FIVLVL=(&FORLVL/&IXINPG)+1 ELSE SET &FIVLVL=0 IF &FIVLVL > 1 - THEN DO SET &MSG001 = &STR( + TOO MANY INDEX LEVELS (6+). CALL DB2 DBA-TEAM. TEL: 7904 ) GOTO NXTP END SET &ROOT=1 SET &NLEAF=&FRSTLVL IF &FORLVL > 1 THEN SET &HIGIX = &FORLVL IF &TRDLVL > 1 THEN SET &MIDIX = &TRDLVL IF &SECLVL > 1 THEN SET &LOWIX = &SECLVL SET &IXPG=&FRSTLVL+&SECLVL+&TRDLVL+&FORLVL+&FIVLVL SET &T1=(((&IXPG*4)/40)+1)*40 SET &T2=(((&T1/10)/40)+1)*40 IF &T1 < 12 THEN SET &T1=12 IF &T2 < 12 THEN SET &T2=12 SET &TRK80P = &T1/40 SET &TRK80S = &T2/40 SET &TRK90P = &T1/48 SET &TRK90S = &T2/48 IF &TRK80P=0 THEN SET &TRK80P=1 IF &TRK80S=0 THEN SET &TRK80S=1 IF &TRK90P=0 THEN SET &TRK90P=1 IF &TRK90S=0 THEN SET &TRK90S=1 GOTO NXTP ERRLN: + SET &MSG001 = &STR(KEY LENGTH IS TOO HIGH. CHECK SQL REFERENCE BOOK) GOTO NXTP ./ ADD NAME=CALCLIB /*CONTROL LIST SYMLIST CONLIST MSG*/ PROC 0 SET &RECLEN = ? SET &AVGREC = ? SET &MEMNO = ? NXTP: + ISPEXEC DISPLAY PANEL(SPACE02) IF &LASTCC=8 THEN EXIT SET &MSG001 = SET &BLKSIZE= SET &BLOCKP = SET &BLOCKS = SET &TRKP = SET &TRKS = SET &DIRBLK = IF &RECLEN = 0 OR &AVGREC = 0 OR &MEMNO = 0 + THEN DO SET &MSG001 = &STR(BE SERIOUS ... ) GOTO NXTP END A3380: + SET &DIRBLK = (&MEMNO/6)+1 SET &DIRBLK = ((&DIRBLK*4)/3)+3 /* GET SOME RESERVE */ SET &MEMLEN = &AVGREC*&RECLEN SET &TOTLEN = &MEMNO*&MEMLEN SET &J = 1 /* (FIRST &N) - 1 */ SET &I = 25 /* (LAST &N) + 1 */ SET &N2 = 23476 SET &N3 = 15476 SET &N4 = 11476 SET &N5 = 9076 SET &N6 = 7476 SET &N7 = 6356 SET &N8 = 5492 SET &N9 = 4826 SET &N10= 4276 SET &N11= 3860 SET &N12= 3476 SET &N13= 3188 SET &N14= 2932 IF &MEMLEN <= 23476 + THEN DO WHILE (&I > 2 ) SET &I = &I - 1 SET &J = &I SET &A = &&N&I IF &A > &MEMLEN + THEN DO SET &BLKSIZE = (&A/&RECLEN)*&RECLEN GOTO DISPLAY END END SET &FR = 9999999 SET &I = 1 LOOP: + DO WHILE (&I < 10) SET &I = &I + 1 SET &A = &&N&I /* WHICH TOP BLKSIZE WE ARE USING */ SET &A = (&A/&RECLEN)*&RECLEN /* ACTUAL MAX. BLKSIZE POSSIBLE */ IF &A = 0 THEN GOTO DISPLAY SET &FREE = (((&MEMLEN/&A)+1)*&A)-&MEMLEN /* FREE SPACE IN LAST */ IF &FREE = &MEMLEN THEN SET &FREE = 0 /* BLOCK OF MEMBER */ SET &FREE=&FREE+((&TOTLEN/&A)+1)*524 /* + FREE SPACE IN IBG */ IF &FREE < &FR + THEN DO SET &FR = &FREE SET &BLKSIZE = (&A/&RECLEN)*&RECLEN SET &J = &I END END /* DO WHILE (I < 10) */ DISPLAY: + SET &TOTBYTE = &TOTLEN +(&DIRBLK*264) SET &TOTBLKS = (&TOTBYTE/&BLKSIZE)+1 SET &BLOCKP = (&TOTBLKS*5)/4 /* RESERVE */ SET &BLOCKS = (&BLOCKP/4)+1 SET &TRKP = &BLOCKP/&J IF &TRKP*&J < &BLOCKP THEN SET &TRKP = &TRKP+1 SET &TRKS = &BLOCKS/&J IF &TRKS*&J < &BLOCKS THEN SET &TRKS = &TRKS+1 IF &RECLEN > 255 - THEN SET &MSG001 = &STR((*) MAX. RECORD LENGTH FOR EDITING IS 255) GOTO NXTP ./ ADD NAME=CALCSPB /* CALCULATE FILES SIZE */ PROC 0 /* CONTROL LIST SYMLIST CONLIST MSG */ SET &RECLEN = ? SET &RECNO = ? NXTP: + ISPEXEC DISPLAY PANEL(SPACE01) IF &LASTCC=8 THEN EXIT SET &MSG001= SET &BLKZ85 = SET &BLK85 = SET &TRK85 = SET &BLKZ82 = SET &BLK82 = SET &TRK82 = SET &BLKZ81 = SET &BLK81 = SET &TRK81 = SET &BLKZ95 = SET &BLK95 = SET &TRK95 = SET &BLKZ92 = SET &BLK92 = SET &TRK92 = SET &BLKZ91 = SET &BLK91 = SET &TRK91 = SET &BLK32 = SET &BLKN32 = SET &TAPENO = SET &TAPEN4 = IF &RECLEN > 32760 - THEN DO SET &MSG001 = &STR(MAX. RECORD LENGTH IS 32760 ) GOTO NXTP END IF &RECLEN = 0 OR &RECNO = 0 + THEN DO SET &MSG001 = &STR(BE SERIOUS ... ) GOTO NXTP END A3380: + IF &RECLEN > 9070 THEN GOTO A382 SET &RECINB5 = 9070/&RECLEN SET &BLKLEN5 = &RECINB5*&RECLEN SET &BLKNO5 = (&RECNO/&RECINB5)+1 IF &BLKNO5*&RECINB5 < &RECNO THEN SET &BLKNO5=&BLKNO5+1 SET &TRKNO5 = &BLKNO5/5 IF &TRKNO5*5 < &BLKNO5 THEN SET &TRKNO5=&TRKNO5+1 SET &BLKZ85 = &BLKLEN5 SET &BLK85 = &BLKNO5 SET &TRK85 = &TRKNO5 A382: + IF &RECLEN > 23470 THEN GOTO A381 SET &RECINB2 = 23470/&RECLEN SET &BLKLEN2 = &RECINB2*&RECLEN SET &BLKNO2 = (&RECNO/&RECINB2)+1 IF &BLKNO2*&RECINB2 < &RECNO THEN SET &BLKNO2=&BLKNO2+1 SET &TRKNO2 = &BLKNO2/2 IF &TRKNO2*2 < &BLKNO2 THEN SET &TRKNO2=&TRKNO2+1 SET &BLKZ82 = &BLKLEN2 SET &BLK82 = &BLKNO2 SET &TRK82 = &TRKNO2 GOTO A3390 A381: + SET &BLKZ81 = &RECLEN SET &BLK81 = &RECNO SET &TRK81 = &RECNO A3390: + IF &RECLEN > 10796 THEN GOTO A392 SET &RECINB5 = 10796/&RECLEN SET &BLKLEN5 = &RECINB5*&RECLEN SET &BLKNO5 = (&RECNO/&RECINB5)+1 IF &BLKNO5*&RECINB5 < &RECNO THEN SET &BLKNO5=&BLKNO5+1 SET &TRKNO5 = &BLKNO5/5 IF &TRKNO5*5 < &BLKNO5 THEN SET &TRKNO5=&TRKNO5+1 SET &BLKZ95 = &BLKLEN5 SET &BLK95 = &BLKNO5 SET &TRK95 = &TRKNO5 A392: + IF &RECLEN > 27998 THEN GOTO A391 SET &RECINB2 = 27998/&RECLEN SET &BLKLEN2 = &RECINB2*&RECLEN SET &BLKNO2 = &RECNO/&RECINB2 IF &BLKNO2*&RECINB2 < &RECNO THEN SET &BLKNO2=&BLKNO2+1 SET &TRKNO2 = &BLKNO2/2 IF &TRKNO2*2 < &BLKNO2 THEN SET &TRKNO2=&TRKNO2+1 SET &BLKZ92 = &BLKLEN2 SET &BLK92 = &BLKNO2 SET &TRK92 = &TRKNO2 GOTO ACART A391: + SET &BLKZ91 = &RECLEN SET &BLK91 = &RECNO SET &TRK91 = &RECNO ACART: + SET &RECINBT = 32760/&RECLEN SET &BLKLENT = &RECINBT*&RECLEN SET &BLKNOT = (&RECNO/&RECINBT)+1 SET &TAPENO = ((((&BLKLENT/1024)*&BLKNOT)+1)/200000)+1 SET &TAPEN4 = ((((&BLKLENT/1024)*&BLKNOT)+1)/800000)+1 SET &BLK32 = &BLKLENT SET &BLKN32 = &BLKNOT GOTO NXTP ./ ADD NAME=CALCTS /* CALCULATE TABLESPACE SIZE */ PROC 0 /*CONTROL LIST SYMLIST CONLIST MSG */ SET &RECLEN = 0 SET &VARFLD = 0 SET &NULFLD = 0 SET &RECORDS= ? SET &ADDREC = 0 SET &DELREC = 0 SET &PCTFREE= 10 SET &FREEPAG= 0 NXTP: + ISPEXEC DISPLAY PANEL(DB2CALT) IF &LASTCC=8 THEN EXIT SET &MSG001= SET &MSG002= SET &SEGSZ = SET &T2 = SET &T3 = SET &T5 = SET &TRK80P= SET &TRK80S= SET &TRK90P= SET &TRK90S= SET &PG = SET &SUGPCF= IF &RECLEN > 3900 - THEN DO SET &MSG001 = &STR(YOU MAY NEED BP32. CONTACT DBA - TEAM TEL: 7904) END IF &RECLEN > 32500 - THEN DO SET &MSG001 = &STR(FOR THIS RECORDSIZE CONTACT DBA - TEAM ! TEL: 7904) GOTO NXTP END IF &PCTFREE > 90 - THEN DO SET &MSG001 = &STR(MAX. PCTFREE ALLOWED IS 90) SET &PCTFREE = 90 END SET &BLK=4096 SET &DIFREC=&ADDREC-&DELREC IF &DIFREC < 0 THEN SET &DIFREC=0 IF &DIFREC > 0 - THEN SET &SUGPCF = ((&DIFREC*100)/&RECORDS)+1 IF &SUGPCF > 50 THEN SET &SUGPCF = 50 ELSE IF &SUGPCF < 0 THEN SET &SUGPCF = 0 IF &FREEPAG > 64 THEN SET &FREEPAG = 64 SET &T1=&RECLEN+8 SET &T1=&T1+(&VARFLD*2)+&NULFLD PAGE: - SET &T2=(((&BLK-22)/&T1)*(100-&PCTFREE))/100 IF &T2 > 127 THEN SET &T2=127 IF &T2 <= 0 - THEN DO SET &MSG001 =&STR(USING BP32 - PLEASE CONTACT DBA-TEAM.TEL: ) IF &BLK = 4096 - THEN DO SET &BLK=32768 GOTO PAGE END ELSE DO SET &MSG002 =&STR(PCTFREE &PCTFREE TOO HIGH) GOTO NXTP END END SET &T3=((&RECORDS/&T2)+3) IF &FREEPAG=0 THEN SET &T4=0 ELSE SET &T4=(&T3/&FREEPAG)+1 SET &T3=(&T3+&T4) IF &T3 < 10 THEN SET &T3=10 IF &DIFREC > 0 THEN SET &T5=(&DIFREC/&T2)+1 ELSE SET &T5=&T3/4 IF &BLK=4096 THEN DO SET &T3=&T3*4 SET &T5=&T5*4 END ELSE DO SET &T3=&T3*32 SET &T5=&T5*32 END SET &T3=(((&T3/40)+1)*40) SET &T5=(((&T5/40)+1)*40) IF &T3 < 40 THEN SET &T3 = 40 IF &T5 < 40 THEN SET &T5 = 40 SET &TRK80P = &T3/40 SET &TRK80S = &T5/40 SET &TRK90P = &T3/48 SET &TRK90S = &T5/48 IF &TRK80P=0 THEN SET &TRK80P=1 IF &TRK80S=0 THEN SET &TRK80S=1 IF &TRK90P=0 THEN SET &TRK90P=1 IF &TRK90S=0 THEN SET &TRK90S=1 IF &BLK=4096 THEN SET &PG=4 ELSE SET &PG=32 SELECT WHEN (&T3 > 320) SET &SEGSZ = 64 WHEN (&T3 > 160) SET &SEGSZ = 32 WHEN (&T3 > 120) SET &SEGSZ = 12 WHEN (&T3 > 80) SET &SEGSZ = 8 OTHERWISE SET &SEGSZ = 4 END IF &FREEPAG > &SEGSZ THEN SET &FREEPAG = &SEGSZ - 1 GOTO NXTP ./ ADD NAME=CALCULAT PROC 1 EQUATION /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT IF &STR(&EQUATION) = HELP THEN GOTO HELPSEC /********************************************************************** /* UTILITY : CALCULAT * /* AUTHOR : DAVID LEIGH * /* DATE : 10-20-90 * /* FUNCTION : THIS CLIST PROCESSES ARITHMATIC CALCULATIONS AND * /* DISPLAYS A MESSAGE WITH THE RESULT. * /********************************************************************** SET ZEDLMSG = &STR(&EQUATION = &EVAL(&EQUATION)) ISPEXEC SETMSG MSG(UTLZ000) EXIT HELPSEC: + 02480000 ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) 02490000 SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR CALCULAT UTILITY + 02490000 *** NO PROCESSING PERFORMED ***) 02490000 ISPEXEC SETMSG MSG(UTLZ000) 02490000 EXIT ./ ADD NAME=CALEDIT PROC 3 APPLIB MEMBER CALLIB DEBUG /*** CHECK THE DEBUG SWITCH ***/ IF &DEBUG = DEBUG THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS SET NEWDESC = IF &SYSDSN('&APPLIB(&MEMBER)') ¬= OK THEN + DO WRITE Appointment Key &MEMBER not found. WRITENR Press ENTER to continue. . . READ EXIT END FREE DD(APPKEYDD) ALLOC DD(APPKEYDD) DSN('&APPLIB(&MEMBER)') SHR ERROR DO SET ERRCC = &LASTCC SELECT (&ERRCC) WHEN (400) DO SET EOF = YES RETURN END OTHERWISE DO ERROR OFF WRITE *** ERROR CC: &ERRCC OCCURRED PROCESSING FILE *** READ CLOSFILE APPKEYDD FREE DD(APPKEYDD) EXIT END END END SET NEWDESC = SET EOF = NO OPENFILE APPKEYDD UPDATE GETFILE APPKEYDD SET CHKKEY = &STR(&SUBSTR(1:8,&APPKEYDD)) SET CHKKEY = &CHKKEY IF &CHKKEY ¬= &MEMBER THEN + DO WRITE WRITE **ERROR - Invalid member type for member &MEMBER.. WRITE Processing terminated. WRITE WRITENR Press ENTER to continue. . . READ GOTO WRAPUP END IF &EOF = NO THEN + DO SET THEAPPMT = &STR(&SUBSTR(1:16,&APPKEYDD)) SET THEDESC = &STR(&SUBSTR(17:80,&APPKEYDD)) SET STIME = &SUBSTR(9:10,&APPKEYDD) SET SZONE= X SYSCALL CONVTIME STIME SZONE SET FROMTIME = &STR(&STIME:&SUBSTR(11:12,&APPKEYDD) &SZONE) SET STIME = &SUBSTR(13:14,&APPKEYDD) SET SZONE= X SYSCALL CONVTIME STIME SZONE SET TOTIME = &STR(&STIME:&SUBSTR(15:16,&APPKEYDD) &SZONE) END ELSE + DO WRITE WRITE **ERROR - Appointment member &MEMBER is empty. WRITE Processing terminated. WRITE WRITENR Press ENTER to continue. . . READ GOTO WRAPUP END REDOIT: + SET NDSET = NO THETOP: CLEAR WRITE ****************************************************************+ *************** WRITE &STR(TASK ===> Edit Appointment TODAYS DATE ===> &SYSDATE + &STR( KEY ===> &MEMBER)) WRITE ****************************************************************+ *************** WRITE WRITE WRITE Enter New Appointment Description below: WRITE Maximum of 64 characters allowed (64 to end of line). WRITE WRITE WRITE &STR( &MEMBER===> &FROMTIME - &TOTIME) WRITE WRITE WRITE &STR(OLD==========> &THEDESC) WRITE IF &NDSET = NO THEN + DO WRITENR &STR(NEW==========>) READ SET NEWDESC = &SYSDVAL IF &NEWDESC ¬= THEN + DO IF &LENGTH(&STR(&NEWDESC)) > 64 THEN + DO WRITE WRITE ***ERROR - New appointment description is greater + than 64 characters. WRITE WRITENR Press ENTER to continue. . . READ SET NEWDESC = GOTO THETOP END SET NDSET = YES END END ELSE WRITE &STR(NEW==========> &NEWDESC) WRITE WRITE WRITENR Enter Option ((S)ave (R)edo X to exit function): READ CHOICE SET CHOICE = &SYSCAPS(&CHOICE) SELECT &CHOICE WHEN (S) DO IF &NDSET = NO THEN + DO WRITE ***ERROR - New appointment description is blank. WRITENR Press ENTER to continue. . . READ GOTO THETOP END END WHEN (R) GOTO REDOIT WHEN (X) DO WRITE WRITE EDIT function cancelled. WRITENR Press ENTER to continue. . . READ GOTO WRAPUP END WHEN () GOTO THETOP OTHERWISE DO WRITE Option &CHOICE not available. WRITENR Press ENTER to continue. . . READ GOTO THETOP END END SET APPKEYDD = &STR(&THEAPPMT)&STR(&NEWDESC) PUTFILE APPKEYDD GETFILE APPKEYDD IF &EOF = YES THEN + DO WRITE WRITE **ERROR - Appointment member &MEMBER has missing registered + calendar dates! WRITE Processing terminated. WRITE WRITENR Press ENTER to continue. . . READ GOTO WRAPUP END CLEAR DO WHILE &EOF = NO SET GREGDATE = X SET DATEKEY = &SUBSTR(1:8,&APPKEYDD) SET DATEKEY = &DATEKEY SYSCALL CONVDATE &DATEKEY GREGDATE SET ERRCC = &LASTCC IF &ERRCC ¬= 0 THEN + DO WRITE *** ERROR &ERRCC OCCURRED DURING PROC CALL *** WRITE PROCESSING TERMINATED. . . READ GOTO WRAPUP END WRITE Updating Appointment Entry &GREGDATE . . . ERROR OFF FREE DD(CALDATDD) ALLOC DD(CALDATDD) DSN('&CALLIB(&DATEKEY)') SHR ERROR DO SET ERRCC = &LASTCC SELECT (&ERRCC) WHEN (400) DO SET EOF = YES RETURN END OTHERWISE DO ERROR OFF WRITE *** ERROR CC: &ERRCC OCCURRED PROCESSING FILE *** READ CLOSFILE CALDATDD FREE DD(CALDATDD) GOTO WRAPUP END END END IF &SYSDSN('&CALLIB(&DATEKEY)') ¬= OK THEN + DO WRITE WRITE **WARNING - Calendar date &GREGDATE was registered but + not found. WRITE WRITENR Press ENTER to continue. . . READ END ELSE + DO OPENFILE CALDATDD UPDATE GETFILE CALDATDD SET APPFND = NO DO WHILE &EOF = NO IF &STR(&THEAPPMT) = &STR(&SUBSTR(1:16,&CALDATDD)) THEN + DO SET CALDATDD = &STR(&THEAPPMT)&STR(&NEWDESC) PUTFILE CALDATDD SET APPFND = YES END GETFILE CALDATDD END SET EOF = NO CLOSFILE CALDATDD FREE DD(CALDATDD) IF &APPFND = NO THEN + DO WRITE WRITE **WARNING - Appointment dated &GREGDATE was + registered but not found. WRITE WRITENR Press ENTER to continue. . . READ END END GETFILE APPKEYDD END SET EOF = NO WRITE WRITE WRITE Edit request completed. WRITE WRITENR Press ENTER to continue. . . READ WRAPUP: + CLOSFILE APPKEYDD FREE DD(APPKEYDD) ERROR OFF EXIT /***************************/ /*** CONVERT JUL TO GREG ***/ /***************************/ CONVDATE: PROC 2 &DATEKEY &GREGDATE SYSREF GREGDATE SET JDAYS = &SUBSTR(4:6,&DATEKEY) SET YY = &SUBSTR(2:3,&DATEKEY) SET &LEAPYY = &YY//4 SET LYDAY = IF &LEAPYY = 0 THEN + DO IF &JDAYS = 60 THEN SET LYDAY = 29 IF &JDAYS > 59 THEN SET &JDAYS = &JDAYS - 1 END SET &MM = 0 SELECT WHEN (&JDAYS > 334) DO SET MM = 12 SET DD = &JDAYS - 334 END WHEN (&JDAYS > 304) DO SET MM = 11 SET DD = &JDAYS - 304 END WHEN (&JDAYS > 273) DO SET MM = 10 SET DD = &JDAYS - 273 END WHEN (&JDAYS > 243) DO SET MM = &STR(09) SET DD = &JDAYS - 243 END WHEN (&JDAYS > 212) DO SET MM = &STR(08) SET DD = &JDAYS - 212 END WHEN (&JDAYS > 181) DO SET MM = &STR(07) SET DD = &JDAYS - 181 END WHEN (&JDAYS > 151) DO SET MM = &STR(06) SET DD = &JDAYS - 151 END WHEN (&JDAYS > 120) DO SET MM = &STR(05) SET DD = &JDAYS - 120 END WHEN (&JDAYS > 90) DO SET MM = &STR(04) SET DD = &JDAYS - 90 END WHEN (&JDAYS > 59) DO SET MM = &STR(03) SET DD = &JDAYS - 59 END WHEN (&JDAYS > 31) DO SET MM = &STR(02) IF &LYDAY ¬= AND &JDAYS = 59 THEN SET DD = &LYDAY ELSE SET DD = &JDAYS - 31 END OTHERWISE DO SET MM = &STR(01) SET DD = &JDAYS END END IF &LENGTH(&DD) = 1 THEN SET DD = &STR(0&DD) SET GREGDATE = &STR(&MM/&DD/&YY) END /**********************************************/ /*** CONVERT FROM MILITARY TO STANDARD TIME ***/ /**********************************************/ CONVTIME: PROC 2 STIME SZONE SYSREF STIME SYSREF SZONE SET SZONE = Am IF &STIME = &STR(00) THEN SET STIME = 12 ELSE + DO IF &STIME > 11 THEN + DO SET SZONE = Pm IF &STIME > 12 THEN SET STIME = &STIME - 12 IF &LENGTH(&STIME) = 1 THEN SET STIME = &STR(0&STIME) END END END ./ ADD NAME=CALENDAR PROC 0 LOGON DEBUG /*** CHECK THE DEBUG SWITCH ***/ IF &DEBUG = DEBUG THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS SET CALLIB = &STR(&SYSUID..SLSS.CALENDAR) SET &MEMBER = #&SUBSTR(1:2,&SYSJDATE)&SUBSTR(4:6,&SYSJDATE) THETOP: CLEAR IF &SYSDSN('&CALLIB') ¬= OK THEN + DO WRITE WRITE ***ERROR - Attempt to access Calendar Scheduling system + failed! WRITE &STR( Library &CALLIB is not allocated. WRITE WRITENR Press ENTER to continue. . . READ EXIT END WRITE ****************************************************************+ *************** WRITE **************************** SCHEDULE FOR &SYSDATE *************+ *************** WRITE ****************************************************************+ *************** WRITE WRITE &STR(Time Activity/Message) WRITE &STR(------------------- ---------------------------------------+ -------------------) IF &SYSDSN('&CALLIB(&MEMBER)') = OK THEN + DO FREE DD(CALDATDD) ALLOC DD(CALDATDD) DSN('&CALLIB(&MEMBER)') SHR END ELSE + DO WRITE WRITE WRITE No appointments today! WRITE GOTO THEEND END ERROR DO SET ERRCC = &LASTCC SELECT (&ERRCC) WHEN (400) DO SET EOF = YES RETURN END OTHERWISE DO ERROR OFF WRITE *** ERROR CC: &ERRCC OCCURRED PROCESSING FILE *** CLOSFILE CALDATDD FREE DD(CALDATDD) EXIT END END END SET EOF = NO OPENFILE CALDATDD GETFILE CALDATDD IF &EOF = YES THEN + DO WRITE **ERROR - Calendar date &SYSDATE is empty. WRITENR Press ENTER to continue. . . READ GOTO WRAPUP END ELSE + DO UNTIL &EOF = YES SET STIME = &SUBSTR(9:10,&CALDATDD) SET SZONE= X SYSCALL CONVTIME STIME SZONE SET FROMTIME = &STR(&STIME:&SUBSTR(11:12,+ &CALDATDD) &SZONE) SET STIME = &SUBSTR(13:14,&CALDATDD) SET SZONE= X SYSCALL CONVTIME STIME SZONE SET TOTIME = &STR(&STIME:&SUBSTR(15:16,+ &CALDATDD) &SZONE) SET THEAPPMT = &SUBSTR(17:80,&CALDATDD) WRITE &STR(&FROMTIME - &TOTIME &SUBSTR(1:59,&THEAPPMT)) IF &LENGTH(&THEAPPMT) > 59 THEN + WRITE &STR( &SUBSTR(60:64,&THEAPPMT)) GETFILE CALDATDD END WRAPUP: + ERROR OFF CLOSFILE CALDATDD FREE DD(CALDATDD) THEEND: + WRITE IF &LOGON = LOGON AND &SYSNEST = YES THEN + WRITENR Press ENTER to begin ISPF (or R to redisplay). . . ELSE + WRITENR Press ENTER to continue (or R to redisplay). . . READ CHOICE SET CHOICE = &SYSCAPS(&CHOICE) IF &CHOICE = R THEN GOTO THETOP EXIT /**********************************************/ /*** CONVERT FROM MILITARY TO STANDARD TIME ***/ /**********************************************/ CONVTIME: PROC 2 STIME SZONE SYSREF STIME SYSREF SZONE SET SZONE = Am IF &STIME = &STR(00) THEN SET STIME = 12 ELSE + DO IF &STIME > 11 THEN + DO SET SZONE = Pm IF &STIME > 12 THEN SET STIME = &STIME - 12 IF &LENGTH(&STIME) = 1 THEN SET STIME = &STR(0&STIME) END END END ./ ADD NAME=CALHELP PROC 0 DEBUG /*** CHECK THE DEBUG SWITCH ***/ IF &DEBUG = DEBUG THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS SET ENDIT = NO SET EOF = NO SET CNTR = 1 SET CNTRLMT = 3 SET PREF = SCHH DO UNTIL &ENDIT = YES CLEAR FREE DD(TEMPDD) ALLOC DD(TEMPDD) DSN('P@CWB.CALSCH.HELP(&PREF&CNTR)') SHR ERROR DO SET ERRCC = &LASTCC SELECT (&ERRCC) WHEN (400) DO SET EOF = YES RETURN END OTHERWISE DO ERROR OFF WRITE *** ERROR CC: &ERRCC OCCURRED PROCESSING FILE *** READ CLOSFILE TEMPDD FREE DD(TEMPDD) EXIT END END END OPENFILE TEMPDD INPUT GETFILE TEMPDD DO WHILE &EOF = NO WRITE &STR(&TEMPDD) GETFILE TEMPDD END CLOSFILE TEMPDD FREE DD(TEMPDD) ERROR OFF IF &LENGTH(&PREF) = 4 THEN + DO IF &CNTR = 1 THEN + WRITENR Enter option ((N)ext page, (X) to Exit Help): ELSE + DO IF &CNTR = &CNTRLMT THEN + DO WRITENR Enter option ((P)rev page, (X) to Exit Help, or + specific topic): END ELSE + DO WRITENR Enter option ((N)ext page, (P)rev page, + or (X) to Exit Help): END END END ELSE + DO IF &CNTR = 1 THEN + WRITENR Enter option ((N)ext page, (X) to return): ELSE + DO IF &CNTR = &CNTRLMT THEN + WRITENR Enter option ((P)rev page or (X) to return): ELSE + DO WRITENR Enter option ((N)ext page, (P)rev page, + or (X) to return): END END END READ CHOICE SET CHOICE = &SYSCAPS(&CHOICE) SELECT &CHOICE WHEN (N| ) DO IF &EVAL(&CNTR+1) .> &CNTRLMT THEN SET CNTR = &CNTR + 1 END WHEN (P) DO IF &EVAL(&CNTR-1) .< 1 THEN SET CNTR = &CNTR - 1 END WHEN (X) DO IF &LENGTH(&PREF) = 4 THEN + SET ENDIT = YES ELSE + DO SET CNTR = 3 SET CNTRLMT = 3 SET PREF = SCHH END END OTHERWISE DO IF &CNTR = &CNTRLMT THEN + DO SELECT &CHOICE WHEN (M) DO SET CNTR = 1 SET CNTRLMT = 2 SET PREF = SCHHM END WHEN (L) DO SET CNTR = 1 SET CNTRLMT = 2 SET PREF = SCHHL END WHEN (E) DO SET CNTR = 1 SET CNTRLMT = 2 SET PREF = SCHHE END WHEN (D) DO SET CNTR = 1 SET CNTRLMT = 2 SET PREF = SCHHD END WHEN (V) DO SET CNTR = 1 SET CNTRLMT = 2 SET PREF = SCHHV END END END END END SET EOF = NO END EXIT ./ ADD NAME=CALLBLKZ /* REXX */ PARSE ARG LRECL NUMRECS ADDRESS ISPEXEC "SELECT CMD(%BLKSIZE" LRECL NUMRECS "BATCH DEVICE(3390))" "VGET (CYLSREQ TRKSREQ) SHARED" SAY 'LRECL =' LRECL SAY 'NUMRECS =' NUMRECS SAY 'CYLSREQ =' CYLSREQ SAY 'TRKSREQ =' TRKSREQ ./ ADD NAME=CALLISPF /********************************************************************** /* UTILITY: CALLISPF * /* AUTHOR: DAVID LEIGH * /* FUNCTION: INVOKE "ISPSTART" WITH THE PARAMETERS PASSED BY THE USER.* /* ALSO ALLOCATE ISPLOG AND ISPLST BEFORE GOING INTO ISPF * /* SO THE USER IS NOT PRESENTED WITH THE ISPF "EXIT" * /* SCREENS WHEN THEY ARE DONE. * /********************************************************************** PROC 0 ISPSTART() DEBUG /*** CHECK THE DEBUG SWITCH ***/ IF &DEBUG = DEBUG THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /********************************************************************** /* PROMPT THE USER FOR THE ISPSTART PARAMETERS IF NOT GIVEN * /********************************************************************** IF &STR(&SYSNSUB(1,&ISPSTART)) = THEN + DO WRITE ENTER THE ISPF "ISPSTART" PARAMETERS BELOW, WRITE OR JUST PRESS TO QUIT. WRITE WRITE NOTE: USE SINGLE QUOTES (') AROUND THE ENTIRE WRITE PARAMETER STRING IF THERE ARE IMBEDDED WRITE SPACES. WRITE WRITENR ISPSTART ==> READ ISPSTART IF &STR(&SYSNSUB(1,&ISPSTART)) = THEN EXIT END /********************************************************************** /* ALLOCATE THE ISPLOG AND ISPLST DATASETS * /********************************************************************** SET LOGDSN = &STR(&SYSUID..TEMP.ISPF.LOG) SET LISTDSN = &STR(&SYSUID..TEMP.ISPF.LIST) FREE DD(ISPLOG ISPLST) DELETE '&LOGDSN' ALLOC DD(ISPLOG) DSN('&LOGDSN') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK005) + SPACE(1,1) CYLINDERS RELEASE + RECFM(F B) LRECL(255) BLKSIZE(23460) DSORG(PS) DELETE '&LISTDSN' ALLOC DD(ISPLST) DSN('&LISTDSN') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK005) + SPACE(1,1) CYLINDERS RELEASE + RECFM(F B) LRECL(255) BLKSIZE(23460) DSORG(PS) /********************************************************************** /* GO DO THE STUFF. * /********************************************************************** ISPSTART &STR(&SYSNSUB(1,&ISPSTART)) /********************************************************************** /* CLEAN UP. * /********************************************************************** FREE DD(ISPLOG ISPLST) EXIT ./ ADD NAME=CALLIST PROC 2 APPLIB AMEMBER DEBUG /*** CHECK THE DEBUG SWITCH ***/ IF &DEBUG = DEBUG THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS SET ORIGAMBR = &AMEMBER TT1: CLEAR SET AMEMBER = &ORIGAMBR WRITE WRITE WRITE WRITE WRITE WRITE WRITE ****** Request to LIST Appointments ****** WRITE WRITE Enter option below: WRITE WRITE &STR( 1 - List by "Keys Only") WRITE &STR( 2 - List with all appointment info) WRITE &STR( 3 - List all scheduled dates) WRITE &STR( X - Exit function) WRITE WRITE WRITENR What would you like to do?: READ CHOICE SET CHOICE = &SYSCAPS(&CHOICE) SELECT &CHOICE WHEN (1|2) DO SET KEYSONLY = SET LEVEL = &CHOICE IF &CHOICE = 1 THEN SET KEYSONLY = YES GOTO OPT1 END WHEN (3) DO GOTO OPT3 END WHEN (X) EXIT WHEN () GOTO TT1 OTHERWISE DO WRITE WRITE Option &CHOICE is not available. WRITENR Press ENTER to continue. . . READ GOTO TT1 END END OPT1: + SET SYSOUTTRAP = 1000 LISTD '&APPLIB' MEMBERS SET NBRMBRS = &SYSOUTLINE SET SYSOUTTRAP = 0 SET CHOICE = SET MBRFND = NO DO UNTIL &CHOICE = X CLEAR WRITE **************************************************************+ ***************** WRITE &STR(TASK ===> List Appointments TODAYS DATE ===> + &STR(&SYSDATE LEVEL ===> &LEVEL)) WRITE **************************************************************+ ***************** WRITE IF &KEYSONLY = YES THEN WRITE &STR( DISPLAY = "Keys Only") ELSE WRITE &STR( DISPLAY = Full) WRITE SET LINECNT = 0 SET STOPLOOP = NO IF &AMEMBER .> &NBRMBRS THEN + DO UNTIL &STOPLOOP = YES SET DIRMBR = &&SYSOUTLINE&AMEMBER SET DIRMBR = &DIRMBR IF &KEYSONLY = YES THEN + DO WRITE &DIRMBR WRITE END ELSE + DO FREE DD(APPKEYDD) ALLOC DD(APPKEYDD) DSN('&APPLIB(&DIRMBR)') SHR ERROR DO SET ERRCC = &LASTCC SELECT (&ERRCC) WHEN (400) DO SET EOF = YES RETURN END OTHERWISE DO WRITE *** ERROR CC: &ERRCC OCCURRED PROCESSING FILE *** READ CLOSFILE APPKEYDD FREE DD(APPKEYDD) GOTO WRAPUP1 END END END SET EOF = NO OPENFILE APPKEYDD INPUT GETFILE APPKEYDD IF &EOF = NO THEN + DO SET CHKKEY = &STR(&SUBSTR(1:8,&APPKEYDD)) SET CHKKEY = &CHKKEY IF &CHKKEY ¬= &DIRMBR THEN + DO WRITE WRITE **ERROR - Invalid member type for member + &DIRMBR.. WRITE Processing terminated. WRITE WRITENR Press ENTER to continue. . . READ CLOSFILE APPKEYDD FREE DD(APPKEYDD) GOTO WRAPUP1 END SET STIME = &SUBSTR(9:10,&APPKEYDD) SET SZONE= X SYSCALL CONVTIME STIME SZONE SET FROMTIME = &STR(&STIME:&SUBSTR(11:12,+ &APPKEYDD) &SZONE) SET STIME = &SUBSTR(13:14,&APPKEYDD) SET SZONE= X SYSCALL CONVTIME STIME SZONE SET TOTIME = &STR(&STIME:&SUBSTR(15:16,+ &APPKEYDD) &SZONE) SET THEAPPMT = &SUBSTR(17:80,&APPKEYDD) WRITE &STR(&DIRMBR===> &FROMTIME - &TOTIME) WRITE &STR( <&THEAPPMT>) END ELSE + DO WRITE **ERROR - Appointment member &DIRMBR is empty. WRITE END CLOSFILE APPKEYDD FREE DD(APPKEYDD) ERROR OFF END SET MBRFND = YES SET LINECNT = &LINECNT + 2 SET AMEMBER = &AMEMBER + 1 IF &LINECNT > 9 THEN SET STOPLOOP = YES IF &AMEMBER > &NBRMBRS THEN + DO SET STOPLOOP = YES WRITE &STR( ** END OF LISTING **) END END WRITE IF &MBRFND = NO THEN + DO WRITE &STR( No Appointment Keys found.) WRITE WRITENR Press ENTER to continue . . . READ SET &CHOICE = X END ELSE + DO WRITENR Enter Option ((N)ext Page, (B)ack to page 1, or + X to exit function): READ CHOICE END SET &CHOICE = &SYSCAPS(&CHOICE) IF &CHOICE = THEN SET &CHOICE = N IF &CHOICE ¬= B AND &CHOICE ¬= N AND &CHOICE ¬= X THEN + DO WRITE WRITE ***ERROR - Invalid Option. WRITE WRITENR Press ENTER to continue . . . READ SET &CHOICE = B END IF &CHOICE = B OR &CHOICE = N THEN + DO WRITE IF &CHOICE = B THEN SET AMEMBER = &ORIGAMBR IF &CHOICE = N AND &AMEMBER > &NBRMBRS THEN + DO IF &AMEMBER < &ORIGAMBR + 6 THEN SET AMEMBER = &ORIGAMBR ELSE SET AMEMBER = &AMEMBER - (&LINECNT / 2) END END END WRAPUP1: + ERROR OFF GOTO TT1 OPT3: + SET SYSOUTTRAP = 1000 LISTD '&APPLIB' MEMBERS SET NBRMBRS = &SYSOUTLINE SET SYSOUTTRAP = 0 SET CHOICE = IF &AMEMBER > &NBRMBRS THEN + DO WRITE WRITE &STR( No Appointment Keys found.) WRITE WRITENR Press ENTER to continue . . . READ EXIT END ELSE + DO UNTIL &CHOICE = X CLEAR WRITE ************************************************************+ ******************* WRITE &STR(TASK ===> List Appointments TODAYS DATE ===> + &STR(&SYSDATE LEVEL ===> 3)) WRITE ************************************************************+ ******************* WRITE SET DIRMBR = &&SYSOUTLINE&AMEMBER SET DIRMBR = &DIRMBR SET AMEMBER = &AMEMBER + 1 FREE DD(APPKEYDD) ALLOC DD(APPKEYDD) DSN('&APPLIB(&DIRMBR)') SHR ERROR DO SET ERRCC = &LASTCC SELECT (&ERRCC) WHEN (400) DO SET EOF = YES RETURN END OTHERWISE DO WRITE *** ERROR CC: &ERRCC OCCURRED PROCESSING FILE *** READ CLOSFILE APPKEYDD FREE DD(APPKEYDD) GOTO WRAPUP2 END END END SET EOF = NO OPENFILE APPKEYDD INPUT GETFILE APPKEYDD IF &EOF = YES THEN + DO WRITE **ERROR - Appointment member &DIRMBR is empty. WRITE END ELSE + DO SET CHKKEY = &STR(&SUBSTR(1:8,&APPKEYDD)) SET CHKKEY = &CHKKEY IF &CHKKEY ¬= &DIRMBR THEN + DO WRITE WRITE **ERROR - Invalid member type for member + &DIRMBR.. WRITE Processing terminated. WRITE WRITENR Press ENTER to continue. . . READ CLOSFILE APPKEYDD FREE DD(APPKEYDD) GOTO WRAPUP2 END WRITE &STR(Listing for &DIRMBR:) WRITE GETFILE APPKEYDD IF &EOF = YES THEN + DO WRITE **ERROR - Appointment member &DIRMBR is missing regis+ tered calendar dates. WRITE END ELSE + DO DO WHILE &EOF = NO SET DATEKEY = &SUBSTR(1:8,&APPKEYDD) SET DATEKEY = &DATEKEY SET GREGDATE = X SYSCALL CONVDATE &DATEKEY GREGDATE SET ERRCC = &LASTCC IF &ERRCC ¬= 0 THEN + DO WRITE *** ERROR &ERRCC OCCURRED + DURING PROC CALL *** WRITE PROCESSING TERMINATED. . . READ GOTO WRAPUP2 END WRITE &STR( Appointment entry on &GREGDATE) GETFILE APPKEYDD END WRITE WRITE &STR( ** END OF LISTING FOR &DIRMBR **) END END CLOSFILE APPKEYDD FREE DD(APPKEYDD) ERROR OFF IF &AMEMBER > &NBRMBRS THEN + DO WRITE WRITE ****** LAST APPOINTMENT DISPLAYED ****** WRITE END WRITE WRITENR Enter Option ((N)ext Page, (B)ack to page 1, or + X to exit function): READ CHOICE SET &CHOICE = &SYSCAPS(&CHOICE) IF &CHOICE = THEN SET &CHOICE = N IF &CHOICE ¬= B AND &CHOICE ¬= N AND &CHOICE ¬= X THEN + DO WRITE WRITE ***ERROR - Invalid Option. WRITE WRITENR Press ENTER to continue . . . READ SET &CHOICE = B END IF &CHOICE = B OR &CHOICE = N THEN + DO WRITE IF &CHOICE = B THEN SET AMEMBER = &ORIGAMBR IF &CHOICE = N AND &AMEMBER > &NBRMBRS THEN + SET AMEMBER = &NBRMBRS END END WRAPUP2: + ERROR OFF GOTO TT1 /**********************************************/ /*** CONVERT FROM MILITARY TO STANDARD TIME ***/ /**********************************************/ CONVTIME: PROC 2 STIME SZONE SYSREF STIME SYSREF SZONE SET SZONE = Am IF &STIME = &STR(00) THEN SET STIME = 12 ELSE + DO IF &STIME > 11 THEN + DO SET SZONE = Pm IF &STIME > 12 THEN SET STIME = &STIME - 12 IF &LENGTH(&STIME) = 1 THEN SET STIME = &STR(0&STIME) END END END /***************************/ /*** CONVERT JUL TO GREG ***/ /***************************/ CONVDATE: PROC 2 &DATEKEY &GREGDATE SYSREF GREGDATE SET JDAYS = &SUBSTR(4:6,&DATEKEY) SET YY = &SUBSTR(2:3,&DATEKEY) SET &LEAPYY = &YY//4 SET LYDAY = IF &LEAPYY = 0 THEN + DO IF &JDAYS = 60 THEN SET LYDAY = 29 IF &JDAYS > 59 THEN SET &JDAYS = &JDAYS - 1 END SET &MM = 0 SELECT WHEN (&JDAYS > 334) DO SET MM = 12 SET DD = &JDAYS - 334 END WHEN (&JDAYS > 304) DO SET MM = 11 SET DD = &JDAYS - 304 END WHEN (&JDAYS > 273) DO SET MM = 10 SET DD = &JDAYS - 273 END WHEN (&JDAYS > 243) DO SET MM = &STR(09) SET DD = &JDAYS - 243 END WHEN (&JDAYS > 212) DO SET MM = &STR(08) SET DD = &JDAYS - 212 END WHEN (&JDAYS > 181) DO SET MM = &STR(07) SET DD = &JDAYS - 181 END WHEN (&JDAYS > 151) DO SET MM = &STR(06) SET DD = &JDAYS - 151 END WHEN (&JDAYS > 120) DO SET MM = &STR(05) SET DD = &JDAYS - 120 END WHEN (&JDAYS > 90) DO SET MM = &STR(04) SET DD = &JDAYS - 90 END WHEN (&JDAYS > 59) DO SET MM = &STR(03) SET DD = &JDAYS - 59 END WHEN (&JDAYS > 31) DO SET MM = &STR(02) IF &LYDAY ¬= AND &JDAYS = 59 THEN SET DD = &LYDAY ELSE SET DD = &JDAYS - 31 END OTHERWISE DO SET MM = &STR(01) SET DD = &JDAYS END END IF &LENGTH(&DD) = 1 THEN SET DD = &STR(0&DD) SET GREGDATE = &STR(&MM/&DD/&YY) END ./ ADD NAME=CALSETUP PROC 4 INIMBR APPLIB CALLIB AMEMBER DEBUG /*** CHECK THE DEBUG SWITCH ***/ IF &DEBUG = DEBUG THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS SET AUTOTYPE = ALL SET ALCAPP = YES SET ALCCAL = YES SET SETINI = YES CLEAR WRITE *****************************************************************+ ************** WRITE ** C A L E N D A R S C H E D U L I N + &STR( G **) WRITE ** A U T O - S E T U P + &STR( **) WRITE **---------------------------------------------------------------+ &STR(------------**) IF &SYSDSN('&INIMBR') ¬= OK THEN GOTO FULLSU SET ALCAPP = NO SET ALCCAL = NO SET SETINI = NO IF &SYSDSN('&CALLIB') ¬= OK OR &SYSDSN('&APPLIB') ¬= OK THEN + DO SET AUTOTYPE = INC GOTO NOFILE END FULLSU: + WRITE ** Your configuration indicates you've never used the Calender Sc+ &STR(heduling **) WRITE ** system. To store the information needed to function properly, + &STR(the system **) WRITE ** will need two PDS libraries allocated. These libraries are cal+ &STR(led: **) WRITE ** + &STR( **) WRITE &STR(** &APPLIB )+ &STR( **) WRITE &STR(** &CALLIB )+ &STR( **) WRITE ** + &STR( **) WRITE ** If you choose the Auto-Setup option below, these libraries wil+ &STR(l be **) WRITE ** automatically allocated and your environment will be set for c+ &STR(ontinual **) WRITE ** successful execution of the Calendar Scheduling system. + &STR( **) WRITE ** + &STR( **) WRITE ** Note: The Scheduling session you just initiated will begin aut+ &STR(omatically **) WRITE ** once Auto-Setup has successfully completed. + &STR( **) WRITE *****************************************************************+ ************** GOTO ASK NOFILE: + WRITE ** Your configuration shows that you are NOT a first time user, b+ &STR(ut one or **) WRITE ** more of the files necessary to run the Calendar Scheduling sys+ &STR(tem is **) WRITE ** missing. Initiating Auto-Setup will result in the re-allocatio+ &STR(n of the **) WRITE ** library(ies) and general housekeeping to determine if any inco+ &STR(nsistencies **) WRITE ** exist within the resulting calendar system. + &STR( **) WRITE *****************************************************************+ ************** WRITE WRITE WRITE Target(s) for re-allocation: WRITE IF &SYSDSN('&CALLIB') ¬= OK THEN + DO WRITE &STR(===> &CALLIB) WRITE SET ALCCAL = YES END IF &SYSDSN('&APPLIB') ¬= OK THEN + DO WRITE &STR(===> &APPLIB) SET ALCAPP = YES END WRITE ASK: + WRITE SET CHOICE = DO UNTIL &CHOICE = Y OR &CHOICE = N WRITENR Do you want to initiate Auto-Setup?(Y/N): READ CHOICE SET CHOICE = &SYSCAPS(&CHOICE) END IF &CHOICE = N THEN + DO WRITE WRITE Auto-Setup cancelled. WRITENR Press ENTER to terminate session. . . READ EXIT CODE(8) END IF &AUTOTYPE = ALL THEN + DO IF &SYSDSN('&APPLIB') = OK THEN + DO CLEAR WRITE ***ERROR - It has been detected that the library &APPLIB WRITE &STR( already exists!) WRITE &STR( You must reconcile this discrepancy before proce+ ding.) WRITE &STR( Auto-Setup has been cancelled.) READ END IF &SYSDSN('&CALLIB') = OK THEN + DO CLEAR WRITE WRITE ***ERROR - It has been detected that the library &CALLIB WRITE &STR( already exists!) WRITE &STR( You must reconcile this discrepancy before proce+ ding.) WRITE &STR( Auto-Setup has been cancelled.) READ END IF &SYSDSN('&APPLIB') = OK OR &SYSDSN('&CALLIB') = OK THEN + EXIT CODE(8) END CLEAR IF &ALCAPP = YES THEN + DO WRITE WRITE Allocating &APPLIB at this time. . . WRITE FREE DD(APPKEYDD) ALLOC DD(APPKEYDD) DSN('&APPLIB') NEW CATALOG - TRACKS DSORG(PO) DIR(10) SPACE(15,1) - BLKSIZE(23440) LRECL(80) RECFM(F B) UNIT(3380) IF &LASTCC ¬= 0 THEN + DO WRITE Allocation of &APPLIB was unsuccessful! WRITE Process terminated. READ EXIT CODE(8) END FREE DD(APPKEYDD) WRITE &APPLIB successfully allocated. END IF &ALCCAL = YES THEN + DO WRITE WRITE Allocating &CALLIB at this time. . . WRITE FREE DD(CALDATDD) ALLOC DD(CALDATDD) DSN('&CALLIB') NEW CATALOG - TRACKS DSORG(PO) DIR(10) SPACE(15,1) - BLKSIZE(23440) LRECL(80) RECFM(F B) UNIT(3380) IF &LASTCC ¬= 0 THEN + DO WRITE Allocation of &CALLIB was unsuccessful! WRITE Process terminated. READ EXIT CODE(8) END FREE DD(CALDATDD) WRITE &CALLIB successfully allocated. WRITE WRITE Installing &CALLIB scratch member at this time. . . WRITE FREE DD(TEMPDD) ALLOC DD(TEMPDD) DSN('&CALLIB($TEMP)') SHR SET ERRCC = &LASTCC IF &ERRCC ¬= 0 THEN GOTO ABEND OPENFILE TEMPDD OUTPUT SET ERRCC = &LASTCC IF &ERRCC ¬= 0 THEN GOTO ABEND CLOSFILE TEMPDD SET ERRCC = &LASTCC IF &ERRCC ¬= 0 THEN GOTO ABEND FREE DD(TEMPDD) WRITE &CALLIB scratch member successfully installed. END IF &SETINI = YES THEN + DO WRITE WRITE Installing Calendar Scheduling ISPF Profile Flag at this + time. . . WRITE FREE DD(TEMPDD) ALLOC DD(TEMPDD) DSN('&INIMBR') SHR SET ERRCC = &LASTCC IF &ERRCC ¬= 0 THEN GOTO ABEND OPENFILE TEMPDD OUTPUT SET ERRCC = &LASTCC IF &ERRCC ¬= 0 THEN GOTO ABEND SET TEMPDD = &STR(*** THIS MEMBER MUST REMAIN ALLOCATED FOR THE CL+ IST CALENDAR SYSTEM ***) PUTFILE TEMPDD SET ERRCC = &LASTCC IF &ERRCC ¬= 0 THEN GOTO ABEND CLOSFILE TEMPDD SET ERRCC = &LASTCC IF &ERRCC ¬= 0 THEN GOTO ABEND FREE DD(TEMPDD) WRITE Calendar Scheduling ISPF Profile Flag was successfully + installed. END WRITE WRITENR *** READ IF &AUTOTYPE = ALL THEN GOTO SIGNOFF CLEAR WRITENR Press ENTER to begin Calendar Scheduling system review. . . READ WRITE CLEAR WRITE *****************************************************************+ ************** WRITE ** C A L E N D A R S C H E D U L I N + &STR( G **) WRITE ** R E V I E W + &STR( **) WRITE **---------------------------------------------------------------+ &STR(------------**) IF &ALCAPP = YES AND &ALCCAL = NO THEN GOTO NOAPP IF &ALCAPP = NO AND &ALCCAL = YES THEN GOTO NOCAL IF &ALCAPP = YES AND &ALCCAL = YES THEN GOTO SRTOVER GOTO SIGNOFF /* Have CALLIB, but no APPLIB */ NOAPP: + SET SYSOUTTRAP = 1000 LISTD '&CALLIB' MEMBERS SET NBRMBRS = &SYSOUTLINE SET SYSOUTTRAP = 0 SET GOTNO = NO IF &AMEMBER > &NBRMBRS THEN GOTO GOTNOCAL ELSE + DO SET DIRMBR = &&SYSOUTLINE&AMEMBER SET DIRMBR = &DIRMBR IF &DIRMBR = &STR($TEMP) THEN + DO IF &AMEMBER + 1 > &NBRMBRS THEN GOTO GOTNOCAL END END WRITE ** Unless you're able to recover your SLSS.APPKEYS library, the c+ &STR(ontents **) WRITE ** or your SLSS.CALENDAR library is pretty much useless. Although+ &STR( any **) WRITE ** remaining calendar appointments will still display when loggin+ &STR(g on to **) WRITE ** TSO, the only option available to you during a Scheduling sess+ &STR(ion would **) WRITE ** be V. All other options require the appointment key members to+ &STR( exist. It **) WRITE ** may be best to rename your current SLSS.CALENDAR library, re-a+ &STR(llocate it, **) WRITE ** and then re-MAKE your current appointments using the renamed l+ &STR(ibrary as **) WRITE ** a reference. (re, re, re!) + &STR( **) WRITE ** + &STR( **) WRITE ** Have fun!!! + &STR( **) GOTO NOAPPEND GOTNOCAL: + WRITE ** The review indicates that your SLSS.CALENDAR library didn't ha+ &STR(ve anything **) WRITE ** in it. So, you're basically starting with a new environment. H+ &STR(ave fun! **) NOAPPEND: + WRITE *****************************************************************+ ************** WRITE WRITENR Press ENTER to continue. . . READ GOTO SIGNOFF /* Have APPLIB, but no CALLIB */ NOCAL: + SET SYSOUTTRAP = 1000 LISTD '&APPLIB' MEMBERS SET NBRMBRS = &SYSOUTLINE SET SYSOUTTRAP = 0 SET GOTNO = NO IF &AMEMBER > &NBRMBRS THEN GOTO GOTNOAPP WRITE ** Unless you're able to recover your SLSS.CALENDAR library, the + &STR(contents **) WRITE ** or your SLSS.APPKEYS library is totally useless. The SLSS.APPK+ &STR(EYS library **) WRITE ** members carry the names of the members in your SLSS.CALENDAR l+ &STR(ibrary and **) WRITE ** these names are used as pointers to each associated calendar d+ &STR(ate. Since **) WRITE ** your SLSS.CALENDAR library is empty, the appointment key point+ &STR(ers are now **) WRITE ** invalid. Plus, your TSO logon process will not show any curren+ &STR(t calendar **) WRITE ** appointments because your SLSS.CALENDAR library is empty! It m+ &STR(ay be best **) WRITE ** to rename your current SLSS.APPKEYS library, re-allocate it, a+ &STR(nd then **) WRITE ** re-MAKE your current appointments using the renamed library as+ &STR( a **) WRITE ** reference. (re, re, re!) + &STR( **) WRITE ** + &STR( **) WRITE ** Have fun!!! + &STR( **) GOTO NOCALEND GOTNOAPP: + WRITE ** The review indicates that your SLSS.APPKEYS library didn't hav+ &STR(e anything **) WRITE ** in it. So, you're basically starting with a new environment. H+ &STR(ave fun! **) NOCALEND: + WRITE *****************************************************************+ ************** WRITE WRITENR Press ENTER to continue. . . READ GOTO SIGNOFF /* Don't have APPLIB or CALLIB */ SRTOVER: + WRITE ** Since both of the libraries needed to run this system have bee+ &STR(n **) WRITE ** re-allocated, you're starting with a new environment. Any prev+ &STR(iously **) WRITE ** relevant appointments logged have been wiped out. To reestabli+ &STR(sh the lost **) WRITE ** appointments, you will need to choose the MAKE APPOINTMENT opt+ &STR(ion and **) WRITE ** separately add each appointment entry (Oh Boy!). + &STR( **) WRITE ** + &STR( **) WRITE ** Good luck and... have a nice day. + &STR( **) WRITE *****************************************************************+ ************** WRITE WRITENR Press ENTER to continue. . . READ SIGNOFF: CLEAR IF &AUTOTYPE = ALL THEN + WRITE Installation of your Calendar Scheduling system is complete. ELSE + WRITE Recovery of your Calendar Scheduling system is complete. WRITE WRITENR Press ENTER to begin Scheduling session. . . READ EXIT ABEND: + WRITE WRITE ***ERROR - The allocation process received error code (&ERRCC) WRITE WRITE Process terminated. READ EXIT CODE(8) ./ ADD NAME=CALUPDAT PROC 0 DEBUG /*** CHECK THE DEBUG SWITCH ***/ /*SET &MEMBER = D&SUBSTR(1:2,&SYSJDATE)&SUBSTR(4:6,&SYSJDATE)*/ IF &DEBUG = DEBUG THEN + DO CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS SET AMEMBER = 8 END ELSE + DO CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS SET AMEMBER = 7 END SET ORIGAMBR = &AMEMBER SET CALLIB = &STR(&SYSUID..SLSS.CALENDAR) SET APPLIB = &STR(&SYSUID..SLSS.APPKEYS) SET INIMBR = &STR(&SYSUID..ISPF.ISPPROF(#CSFLG)) SET MBRFND = NO SET MEMBER = IF &SYSDSN('&INIMBR') ¬= OK + OR &SYSDSN('&CALLIB') ¬= OK OR &SYSDSN('&APPLIB') ¬= OK THEN + DO IF &DEBUG = DEBUG THEN + %CALSETUP &INIMBR &APPLIB &CALLIB &AMEMBER DEBUG ELSE + %CALSETUP &INIMBR &APPLIB &CALLIB &AMEMBER IF &LASTCC ¬= 0 THEN EXIT END /***********************/ /*** GET MAIN OPTION ***/ /***********************/ THETOP: CLEAR WRITE ****** CALENDAR SCHEDULING ****** WRITE WRITE Enter Option Below: WRITE WRITE &STR( M - Make an Appointment) WRITE &STR( L - List Appointments) WRITE &STR( E - Edit Appointment Description) WRITE &STR( D - Delete an Appointment) WRITE &STR( V - View Calendar Day) WRITE &STR( H - Get General Help) WRITE &STR( X - Exit Calendar Scheduling) WRITE WRITE WRITENR What would you like to do?: READ CHOICE SET &CHOICE = &SYSCAPS(&CHOICE) /**************************/ /*** VERIFY MAIN OPTION ***/ /**************************/ WRITE SELECT &CHOICE WHEN (M) DO WRITE ** Request to MAKE an Appointment ** WRITE WRITE Enter New Appointment Key below, or leave blank to receive WRITE a System Assigned Key. Maximum of 8 characters WRITE allowed. First character must be alphabetic. SET MEMBER = X SET ERRMSG = X SYSCALL AQUERY MEMBER ERRMSG SET ERRCC = &LASTCC SELECT (&ERRCC) WHEN (0 | 4) %CALADD &APPLIB &MEMBER &CALLIB &DEBUG WHEN (8) GOTO STANDERR END GOTO THETOP END WHEN (D) DO WRITE ** Request to DELETE an Appointment ** WRITE WRITE Enter Appointment Key below. SET MEMBER = X SET ERRMSG = X SYSCALL AQUERY MEMBER ERRMSG SET ERRCC = &LASTCC IF &ERRCC ¬= 0 THEN + DO IF &ERRCC = 4 THEN GOTO THETOP IF &ERRCC = 8 THEN GOTO STANDERR GOTO THETOP END IF &DEBUG = DEBUG THEN + %CALDEL &APPLIB &MEMBER &CALLIB DEBUG ELSE + %CALDEL &APPLIB &MEMBER &CALLIB GOTO THETOP END WHEN (E) DO WRITE ** Request to EDIT an Appointment ** WRITE WRITE Enter Appointment Key below. SET MEMBER = X SET ERRMSG = X SYSCALL AQUERY MEMBER ERRMSG SET ERRCC = &LASTCC IF &ERRCC ¬= 0 THEN + DO IF &ERRCC = 4 THEN GOTO THETOP IF &ERRCC = 8 THEN GOTO STANDERR GOTO THETOP END IF &DEBUG = DEBUG THEN + %CALEDIT &APPLIB &MEMBER &CALLIB DEBUG ELSE + %CALEDIT &APPLIB &MEMBER &CALLIB GOTO THETOP END WHEN (V) DO WRITE ** Request to VIEW Calendar Day ** WRITE WRITENR &STR( Enter Calendar Date (MM DD YY):) READ MM,DD,YY IF &MM = THEN GOTO THETOP IF &DD = THEN SET DD = 0 IF &YY = THEN SET YY = 0 SYSCALL VERDATE &MM &DD &YY MEMBER IF &LASTCC ¬= 0 THEN GOTO THETOP IF &DEBUG = DEBUG THEN + %CALVIEW &CALLIB &MEMBER DEBUG ELSE + %CALVIEW &CALLIB &MEMBER GOTO THETOP END WHEN (L) DO IF &DEBUG = DEBUG THEN + %CALLIST &APPLIB &AMEMBER DEBUG ELSE + %CALLIST &APPLIB &AMEMBER GOTO THETOP END WHEN (H) DO IF &DEBUG = DEBUG THEN + %CALHELP DEBUG ELSE + %CALHELP GOTO THETOP END WHEN (X) DO WRITE Session terminated. EXIT END WHEN () GOTO THETOP OTHERWISE DO SET ERRMSG = &STR(Option &CHOICE is not available.) GOTO STANDERR END END EXIT /*********************************************************************/ /************ S U B P R O C E D U R E S *****************/ /*********************************************************************/ /**************************************/ /*** DISPLAY STANDARD ERROR MESSAGE ***/ /**************************************/ STANDERR: + WRITE &ERRMSG WRITE WRITENR Press ENTER to continue . . . READ GOTO THETOP /***********************/ /*** ENTER APP QUERY ***/ /***********************/ AQUERY: PROC 2 &MEMBER &ERRMSG SYSREF MEMBER SYSREF ERRMSG WRITE WRITENR > READ MEMBER IF &MEMBER = THEN + DO SET MEMBER = 0 RETURN CODE(4) END SET MEMBER = &MEMBER SET MEMBER = &SYSCAPS(&MEMBER) IF &LENGTH(&MEMBER) > 8 THEN + DO SET ERRMSG = &STR(***ERROR - Key length is greater than 8 + characters.) RETURN CODE(8) END SET M1 = &SUBSTR(1:1,&MEMBER) IF &M1 < A OR &M1 > Z THEN + DO SET ERRMSG = &STR(***ERROR - First character of key must be + alphabetic) RETURN CODE(8) END END /***********************/ /*** VERIFY DATE KEY ***/ /***********************/ VERDATE: PROC 4 &MM &DD &YY &MEMBER SYSREF MEMBER WRITE SET &BADDAY = NO IF &MM < 01 OR &MM > 12 THEN + DO WRITE ***ERROR - Invalid month value >&MM READ RETURN CODE(8) END IF &YY = OR &YY = 0 THEN SET &YY = &STR(&SUBSTR(1:2,&SYSJDATE)) ELSE + IF &YY < 91 OR &YY > 99 THEN + DO WRITE ***ERROR - Invalid year value >&YY READ RETURN CODE(8) END SET &LEAPYY = &YY//4 IF &DD > 0 THEN + IF &MM = 01 OR &MM = 03 OR &MM = 05 OR + &MM = 07 OR &MM = 08 OR &MM = 10 OR &MM = 12 THEN + DO IF &DD > 31 THEN SET &BADDAY = YES END ELSE IF &MM = 04 OR &MM = 06 OR &MM = 09 OR &MM = 11 THEN + DO IF &DD > 30 THEN SET &BADDAY = YES END ELSE + DO IF &MM = 02 THEN + DO IF &LEAPYY = 0 THEN + DO IF &DD > 29 THEN SET &BADDAY = YES END ELSE IF &DD > 28 THEN SET &BADDAY = YES END END ELSE SET &BADDAY = YES IF &BADDAY = YES THEN + DO WRITE ***ERROR - Invalid day value >&DD READ RETURN CODE(8) END /*** CONVERT DATE TO JULIAN ***/ SET &JDAYS = 0 SELECT &MM WHEN (2) SET &JDAYS = 31 WHEN (3) SET &JDAYS = 59 WHEN (4) SET &JDAYS = 90 WHEN (5) SET &JDAYS = 120 WHEN (6) SET &JDAYS = 151 WHEN (7) SET &JDAYS = 181 WHEN (8) SET &JDAYS = 212 WHEN (9) SET &JDAYS = 243 WHEN (10) SET &JDAYS = 273 WHEN (11) SET &JDAYS = 304 WHEN (12) SET &JDAYS = 334 END SET &JDAYS = &JDAYS + &DD IF &LEAPYY = 0 AND &MM > 02 THEN SET &JDAYS = &JDAYS + 1 SELECT &LENGTH(&JDAYS) WHEN (1) SET MEMBER = #&YY&STR(00)&JDAYS WHEN (2) SET MEMBER = #&YY&STR(0)&JDAYS OTHERWISE SET MEMBER = #&YY&JDAYS END END /**********************************************/ /*** CONVERT FROM MILITARY TO STANDARD TIME ***/ /**********************************************/ CONVTIME: PROC 2 STIME SZONE SYSREF STIME SYSREF SZONE SET SZONE = Am IF &STIME = &STR(00) THEN SET STIME = 12 ELSE + DO IF &STIME > 11 THEN + DO SET SZONE = Pm IF &STIME > 12 THEN SET STIME = &STIME - 12 IF &LENGTH(&STIME) = 1 THEN SET STIME = &STR(0&STIME) END END END ./ ADD NAME=CALVIEW PROC 2 CALLIB MEMBER DEBUG /*** CHECK THE DEBUG SWITCH ***/ IF &DEBUG = DEBUG THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS SET GREGDATE = X SYSCALL CONVDATE &MEMBER GREGDATE IF &SYSDSN('&CALLIB(&MEMBER)') ¬= OK THEN + DO WRITE Calendar date &GREGDATE not found. WRITENR Press ENTER to continue. . . READ EXIT END FREE DD(CALDATDD) ALLOC DD(CALDATDD) DSN('&CALLIB(&MEMBER)') SHR ERROR DO SET ERRCC = &LASTCC SELECT (&ERRCC) WHEN (400) DO SET EOF = YES RETURN END OTHERWISE DO ERROR OFF WRITE *** ERROR CC: &ERRCC OCCURRED PROCESSING FILE *** READ CLOSFILE CALDATDD FREE DD(CALDATDD) EXIT END END END THETOP: CLEAR WRITE ****************************************************************+ *************** WRITE &STR(TASK ===> View Calendar Day TODAYS DATE ===> &SYSDATE + &STR( KEY ===> &MEMBER)) WRITE ****************************************************************+ *************** WRITE WRITE Calendar Date &GREGDATE: WRITE WRITE &STR(FROM TO DESCRIPTION) WRITE &STR(-------- -------- ----------------------------------------+ -------------------) OPENFILE CALDATDD SET EOF = NO GETFILE CALDATDD IF &EOF = YES THEN + DO WRITE **ERROR - Calendar date &GREGDATE is empty. WRITENR Press ENTER to continue. . . READ GOTO WRAPUP END ELSE + DO UNTIL &EOF = YES SET STIME = &SUBSTR(9:10,&CALDATDD) SET SZONE= X SYSCALL CONVTIME STIME SZONE SET FROMTIME = &STR(&STIME:&SUBSTR(11:12,+ &CALDATDD) &SZONE) SET STIME = &SUBSTR(13:14,&CALDATDD) SET SZONE= X SYSCALL CONVTIME STIME SZONE SET TOTIME = &STR(&STIME:&SUBSTR(15:16,+ &CALDATDD) &SZONE) SET THEAPPMT = &SUBSTR(17:80,&CALDATDD) WRITE &STR(&FROMTIME &TOTIME &SUBSTR(1:59,&THEAPPMT)) IF &LENGTH(&THEAPPMT) > 59 THEN + WRITE &STR( &SUBSTR(60:64,&THEAPPMT)) GETFILE CALDATDD END WRITE WRITE &STR( *** END OF CALENDAR DAY ***) WRITE WRITENR Enter X to exit function: READ ANSR SET ANSR = &SYSCAPS(&ANSR) IF &ANSR = X THEN GOTO WRAPUP CLOSFILE CALDATDD GOTO THETOP WRAPUP: + CLOSFILE CALDATDD FREE DD(CALDATDD) ERROR OFF EXIT /**********************************************/ /*** CONVERT FROM MILITARY TO STANDARD TIME ***/ /**********************************************/ CONVTIME: PROC 2 STIME SZONE SYSREF STIME SYSREF SZONE SET SZONE = Am IF &STIME = &STR(00) THEN SET STIME = 12 ELSE + DO IF &STIME > 11 THEN + DO SET SZONE = Pm IF &STIME > 12 THEN SET STIME = &STIME - 12 IF &LENGTH(&STIME) = 1 THEN SET STIME = &STR(0&STIME) END END END /***************************/ /*** CONVERT JUL TO GREG ***/ /***************************/ CONVDATE: PROC 2 &DATEKEY &GREGDATE SYSREF GREGDATE SET JDAYS = &SUBSTR(4:6,&DATEKEY) SET YY = &SUBSTR(2:3,&DATEKEY) SET &LEAPYY = &YY//4 SET LYDAY = IF &LEAPYY = 0 THEN + DO IF &JDAYS = 60 THEN SET LYDAY = 29 IF &JDAYS > 59 THEN SET &JDAYS = &JDAYS - 1 END SET &MM = 0 SELECT WHEN (&JDAYS > 334) DO SET MM = 12 SET DD = &JDAYS - 334 END WHEN (&JDAYS > 304) DO SET MM = 11 SET DD = &JDAYS - 304 END WHEN (&JDAYS > 273) DO SET MM = 10 SET DD = &JDAYS - 273 END WHEN (&JDAYS > 243) DO SET MM = &STR(09) SET DD = &JDAYS - 243 END WHEN (&JDAYS > 212) DO SET MM = &STR(08) SET DD = &JDAYS - 212 END WHEN (&JDAYS > 181) DO SET MM = &STR(07) SET DD = &JDAYS - 181 END WHEN (&JDAYS > 151) DO SET MM = &STR(06) SET DD = &JDAYS - 151 END WHEN (&JDAYS > 120) DO SET MM = &STR(05) SET DD = &JDAYS - 120 END WHEN (&JDAYS > 90) DO SET MM = &STR(04) SET DD = &JDAYS - 90 END WHEN (&JDAYS > 59) DO SET MM = &STR(03) SET DD = &JDAYS - 59 END WHEN (&JDAYS > 31) DO SET MM = &STR(02) IF &LYDAY ¬= AND &JDAYS = 59 THEN SET DD = &LYDAY ELSE SET DD = &JDAYS - 31 END OTHERWISE DO SET MM = &STR(01) SET DD = &JDAYS END END IF &LENGTH(&DD) = 1 THEN SET DD = &STR(0&DD) SET GREGDATE = &STR(&MM/&DD/&YY) END ./ ADD NAME=CASELCUC /* REXX ***************************************************************/ /* */ /* */ /* */ /* */ /* */ /* */ /**********************************************************************/ LC = 'abcdefghijklmnopqrstuvwxyz' UC = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' STRING = TRANSLATE(STRING,LC,UC) ./ ADD NAME=CA11TABL /********************************************************************** /* UTILITY: CA11TABL * /* AUTHOR: DAVID LEIGH * /* FUNCTION: WHEN LOOKING AT A CA11 OUTPUT SCREEN IN ISPF, IF YOU * /* INVOKE THIS UTILITY, IT WILL COPY TABLE CA11ITBL TO A * /* FLAT FILE WITH A TIME/DATE STAMP. * /********************************************************************** PROC 0 HELP /*** CHECK THE DEBUG SWITCH ***/ ISPEXEC VGET DBGSWTCH PROFILE IF &DBGSWTCH = ON THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS IF &HELP = HELP THEN GOTO HELPSEC /********************************************************************** /* SET UP THE OUTPUT DATASET WITH A TIME DATE STAMP * /********************************************************************** SET D = &STR(D)+ &SUBSTR(1:2,&STR(&SYSSDATE))+ &SUBSTR(4:5,&STR(&SYSSDATE))+ &SUBSTR(7:8,&STR(&SYSSDATE)) SET T = &STR(T)+ &SUBSTR(1:2,&STR(&SYSTIME))+ &SUBSTR(4:5,&STR(&SYSTIME))+ &SUBSTR(7:8,&STR(&SYSTIME)) SET TEMPTABL = &STR(&SYSUID..TEMP.CA11TABL.&D..&T) DELETE '&TEMPTABL' FREE DDNAME(ISPFILE) ALLOCATE DDNAME(ISPFILE) DSN('&TEMPTABL') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK$$$) + SPACE(1,1) TRACKS RELEASE + RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS) /********************************************************************** /* UNLOAD THE ISPF TABLE * /********************************************************************** ISPEXEC FTOPEN ISPEXEC FTINCL CA11TABL SET SAVECC = &LASTCC ISPEXEC FTCLOSE FREE DDNAME(ISPFILE) IF &SAVECC > 0 THEN + DO ISPEXEC VGET ZERRLM SET ZEDSMSG = &STR(TABLE CC: &SAVECC) SET ZEDLMSG = &STR(&ZERRLM) ISPEXEC SETMSG MSG(UTLZ001) END ELSE + ISPEXEC EDIT DATASET('&TEMPTABL') EXIT /********************************************************************** /* DISPLAY ANY "HELP" WHICH IS AVAILABLE FOR THIS UTILITY * /********************************************************************** HELPSEC: + ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR CA11TABL UTILITY + *** NO PROCESSING PERFORMED ***) ISPEXEC SETMSG MSG(UTLZ000) EXIT ./ ADD NAME=CA7CMD /* REXX ***************************************************************/ /* Utility: CA7CMD */ /* Author: David Leigh */ /* Function: This utility takes command line input to pass to CA7 */ /* and return results to the user without having to go */ /* into CA7. If it's in an edit session, it does this */ /* with note lines. Otherwise it puts it into an output */ /* file and takes the user into edit on it. */ /* */ /* If it's not in an edit session, the whole command must */ /* be entered. If it's in an edit session, the whole */ /* command can be entered but doesn't need to be. If */ /* nothing is entered or partial commands, certain defaults */ /* are used to construct an appropriate command for CA7. */ /* */ /* To see the valid inputs available for the edit session */ /* method of invocation, type CA7CMD HELP or CA7CMD ? on */ /* the command line to get help information in note lines. */ /**********************************************************************/ address ispexec "control errors return" address isredit "macro (passcmd)" if rc = 0 then do ismacro = 'yes' if passcmd = "?" then do funcrc = cmd_help(ismacro) exit end if pos(',JOB=',passcmd) = 0 then do "(mbr) = member" if passcmd = '' then passcmd = 'LJCL' passcmd = passcmd ³³ ',JOB=' ³³ mbr end end else do parse upper arg passcmd ismacro = 'no' if passcmd = "?" then do funcrc = cmd_help(ismacro) exit end end if passcmd = '' then do address ispexec zedlmsg = 'please pass a valid ca7 command such that your ', 'command looks like (for example): ', 'TSO CA7CMD LJOB,JOB=UFBL5305,LIST=ALL' "setmsg msg(utlz001w)" exit end address tso dummy = outtrap('null.') "FREE DD(SYSIN, SYSPRINT, UCC7CMDS TEMPCA7)" "ALLOC DD(SYSIN) NEW" "ALLOC DD(SYSPRINT) NEW SPACE(1,1) CYLINDERS RELEASE" "ALLOC DD(UCC7CMDS) DSN('SYS3.CA7.PROD.COMMDS') SHR REUSE" upper passcmd /* CA-7 demands upper case commands */ passcmd = strip(passcmd,L,",") /* in case the user put in an extra ,*/ /**********************************************************************/ /* don't let an "frjob" go by without a "schid" or it will be too big!*/ /**********************************************************************/ if pos("FRJOB",passcmd) > 0 &, pos("SCHID=",passcmd) = 0 then do address ispexec zedlmsg = 'When using the FRJOB command, you must supply ', 'a SCHID=nnn parameter or the command will be ', 'too resource intensive.' "setmsg msg(utlz001w)" exit end zedlmsg = 'Calling CA7 with command:' passcmd address ispexec "control display lock" address ispexec "display panel(msgpanel)" queue '/LOGON' queue '/PROFS,ID=' ³³ sysvar(sysuid) ³³ ',R=CA70255' queue PASSCMD queue '/LOGOFF' "execio" queued() "diskw sysin (finis)" ADDRESS ISPEXEC "SELECT PGM(SASSBSTR) PARM(0,POOL=(1-8))" "execio * diskr sysprint (stem result. finis)" "FREE DD(SYSIN, SYSPRINT, UCC7CMDS TEMPCA7)" drop null. if ismacro = 'yes' then do j = result.0 - 5 /* this gets rid of trailer lines*/ address isredit do i = 14 to j line = substr(result.i,2) /* this gets rid of carriage control */ "line_before .zfirst = msgline <1,(line)>" end end else do tempdsn = sysvar(sysuid) ³³ '.tempca7.d' ³³ date(j) ³³ '.t' ³³ time(s) address tso "ALLOC DD(TEMPCA7) DSN('"TEMPDSN"')", "NEW", "VOLUME(WRK$$$)", "SPACE(1,1) TRACKS RELEASE", "RECFM(F B A) LRECL(133)" "execio * diskw tempca7 (stem result. finis)" "FREE DD(TEMPCA7)" address ispexec "edit dataset('"tempdsn"')" end exit /**********************************************************************/ /* The following procedure gives a few handy CA7 commands that can */ /* be executed via CA7CMD. This list is, by no means, exhaustive */ /* but can be expanded as people think of good example commands. */ /**********************************************************************/ cmd_help: procedure arg ismacro if ismacro = "NO" then do jobstr = ",JOB=xxxxxxxx" address tso "clear" end else do jobstr = "" address ispexec "control display lock" end say "CA7CMD - Example CA7 commands" say "" say "Here are some example CA7 commands that you may find helpful. To have this" say "list updated, see someone on the Tools team." say "" say "LJOB"jobstr",LIST=TRIG" say " This command shows all the jobs which trigger this job and which this" say " job triggers" say "LJOB"jobstr",LIST=RQJOB" say " This command shows all the requirements that this job has. This is" say " where you find job dependencies and negative dependencies." say "LJCL"jobstr say " This command shows you in which library this job resides as far as" say " CA7 is concerned. It also shows you the JCL that CA7 has for that" say " job right now. *** if you don't enter a command, this is the default" say "LJOB"jobstr",LIST=DEPJ" say " This command shows a list of all jobs that are dependent on the job" say " being displayed, including negative dependencies" say "LJOB"jobstr",LIST=RQUSR" say " This command lists any user requirements on the job" say "LJOB"jobstr",LIST=NODD" say " This command shows everything except STEPDD information" say "LJOB"jobstr",LIST=SCHD" say " This command displays schedule information (works on base" say " calendar jobs only)" say "LJOB"jobstr",LIST=RQVRM" say " This command displays Virtual Resource Manager requirements for" say " a job" say "LDSN,DSN=USC10.SLSS.MASTER,LIST=USERS" say " This command lets you find out which jobs use a specific dataset" say "LRLOG"jobstr",DATE=*" say " This command shows the last 5 day's runlog for this job" say "LPRRN"jobstr say " This command shows detail about the last run for this job" say "FSTRUC"jobstr",SCHID=nnn" say " This command shows the subsequent job triggering path starting at" say " this job" say "FRJOB"jobstr",SCHID=nnn" say " This command shows which base calendar job will eventually trigger" say " this job. Note: it requires a SCHID!" say "*** Press twice to return ***" pull stuff return 0 ./ ADD NAME=CA7TOERD /* REXX ***************************************************************/ /* UTILITY: CA7TOERD */ /* AUTHOR: DAVID LEIGH */ /* FUNCTION: THIS UTILITY EXTRACTS CA7 JOB SCHEDULE INFORMATION FROM */ /* A DB2 DATABASE FOR A SPECIFIC JOB. THAT INFORMATION IS */ /* MASSAGED A BIT AND LOADED INTO AN ISPF TABLE. THIS */ /* TABLE IS FED THROUGH AN ISPF FILE TAILORING SKELETON OF */ /* THE SAME NAME AND THE RESULTS ARE DISPLAYED TO THE USER */ /* IN AN EDIT SESSION. */ /**********************************************************************/ /**********************************************************************/ /* READ IN THE LIST OF JOB PREFIXES TO WORK ON INTO A STEM ARRAY */ /**********************************************************************/ "EXECIO * DISKR INPREFIX (STEM JOBPFX. FINIS)" IF JOBPFX.0 = 0 THEN DO SAY '*** NO INPUT RECORDS TO PROCESS ***' SAY '*** EXITING ***' EXIT END /**********************************************************************/ /* CREATE AN ISPF TABLE TO HOLD THE JOB INFO FROM DB2 TO TAILOR */ /**********************************************************************/ ADDRESS ISPEXEC /**********************************************************************/ /* GET THE JOB INFO FROM DB2 */ /**********************************************************************/ DO I = 1 TO JOBPFX.0 "TBCREATE TEMPTABL NOWRITE REPLACE", "NAMES(JOBNAME RELJOB RELTYPE SCHID SCHID2", "QTM LEADTM SUBTM LIBCODE P2 P4)" PARSE UPPER VAR JOBPFX.I PRED PREDVAL . PARSE UPPER VAR PREDVAL "'" DSNODE "'" . DSNODE = TRANSLATE(DSNODE,'#@','_%') SELECT WHEN PRED = '=' THEN PRED = 'EQ' WHEN PRED = '>' THEN PRED = 'GT' WHEN PRED = '<' THEN PRED = 'LT' WHEN PRED = '>=' THEN PRED = 'GE' WHEN PRED = '<=' THEN PRED = 'LE' WHEN PRED = 'LIKE' THEN NOP WHEN PRED = 'EQ' THEN NOP WHEN PRED = 'GT' THEN NOP WHEN PRED = 'LT' THEN NOP WHEN PRED = 'GE' THEN NOP WHEN PRED = 'LE' THEN NOP OTHERWISE DO SAY 'PREDICATE PASSED IN =' PRED SAY '*** INVALID PREDICATE ***' SAY '*** VALID PREDICATES INCLUDE:' SAY '*** = > < >= <= LIKE EQ GT LT GE LE' EXIT 20 END END SAY '*** WORKING ON: "'PRED PREDVAL'" ***' SQLQUERY = "SELECT JOB_NAME,", " RELATED_JOB,", " DIGITS(RELATIONSHIP_TYPE) AS REL_TYPE,", " SCHID AS SCH_ID,", " SCHID2 AS SCH_ID2,", " QUEUE_TIME,", " LEAD_TIME,", " SUBMIT_TIME,", " LIBRARY_CODE", "FROM DBAUTIL.CA7_JOBS", "WHERE (JOB_NAME" PRED PREDVAL, " AND RELATED_JOB NOT" PRED PREDVAL")", " OR (JOB_NAME" PRED PREDVAL, " AND RELATED_JOB" PRED PREDVAL, " AND RELATIONSHIP_TYPE ¬= 2)", "UNION", "SELECT JOB_NAME,", " RELATED_JOB,", " DIGITS(RELATIONSHIP_TYPE) AS REL_TYPE,", " SCHID AS SCH_ID,", " SCHID2 AS SCH_ID2,", " QUEUE_TIME,", " LEAD_TIME,", " SUBMIT_TIME,", " LIBRARY_CODE", "FROM DBAUTIL.CA7_JOBS", "WHERE JOB_NAME IN (", "SELECT RELATED_JOB", "FROM DBAUTIL.CA7_JOBS", "WHERE (JOB_NAME" PRED PREDVAL, " AND RELATED_JOB NOT" PRED PREDVAL")", " OR (JOB_NAME" PRED PREDVAL, " AND RELATED_JOB" PRED PREDVAL, " AND RELATIONSHIP_TYPE ¬= 2))", " AND RELATIONSHIP_TYPE = 3;" DB2SSID = "DSNT" ADDRESS LINK "REXXSQL" SQLRC = RC SELECT WHEN SQLRC = 100 THEN SET ZEDLMSG = 'SQLCODE 100 - NO ROWS FOR: "'PRED PREDVAL'"' WHEN SQLRC ¬= 0 THEN DO SET ZEDLMSG = 'SQLCODE' SQLRC '- UNEXPECTED ERROR - TERMINATING' SAY '*** SQL STATEMENT WAS: ***' SAY 'SQLQUERY' EXIT 8 END OTHERWISE NOP END SAY '***' STRIP(_NROWS) 'ROWS FOUND FOR: "'PRED PREDVAL'" ***' /**********************************************************************/ /* LOOP THROUGH THE JOB INFO AND POPULATE THE ISPF TABLE */ /**********************************************************************/ DO J = 1 TO _NROWS JOBNAME = STRIP(JOB_NAME.J) RELJOB = STRIP(RELATED_JOB.J) RELTYPE = STRIP(REL_TYPE.J) SCHID = STRIP(SCH_ID.J) SCHID2 = STRIP(SCH_ID.J) QTM = STRIP(QUEUE_TIME.J) LEADTM = STRIP(LEAD_TIME.J) SUBTM = STRIP(SUBMIT_TIME.J) LIBCODE = STRIP(LIBRARY_CODE.J) P2 = SUBSTR(JOBNAME,1,2) P4 = SUBSTR(JOBNAME,1,4) "TBADD TEMPTABL" END "TBSORT TEMPTABL FIELDS(JOBNAME,C,A,RELJOB,C,A,RELTYPE,C,A)" /********************************************************************/ /* INVOKE FILE TAILORING TO CREATE THE RESULTS IN A TEMPORARY FILE */ /********************************************************************/ ERDFILE = 'DDBA.ERDFLOW.FOR.'DSNODE'.JOBS' SAY '*** RESULTS WILL BE STORED IN:' ERDFILE '***' ADDRESS TSO DUMMY = OUTTRAP('NULL.') "DELETE '"ERDFILE"'" "FREE DD(ISPFILE)" "ALLOCATE DD(ISPFILE) DSN('"ERDFILE"')" , "NEW CATALOG" , "UNIT(SYSDA)" , "SPACE(1,1) CYLINDERS RELEASE" , "RECFM(F B) LRECL(255) DSORG(PS)" DROP NULL. ADDRESS ISPEXEC "FTOPEN" "FTINCL CA7TOERD" FTRC = RC "FTCLOSE" IF RC ¬= 0 THEN DO SAY '*** CA7TOERD FILE TAILORING ENDED WITH RC:' FTRC '***' END ELSE SAY '*** RESULTS STORED IN:' ERDFILE '***' END ./ ADD NAME=CDACLOSE /* REXX ***************************************************************/ /* UTILITY: CDACLOSE */ /* AUTHOR: DAVID LEIGH */ /* FUNCTION: THIS REXX PROGRAM IS USED TO INTERROGATE FOR CDA/ELM */ /* DISTRIBUTED THREADS THAT ARE STILL ACTIVE WHEN THE */ /* DB2 MAINTENANCE IS ABOUT TO START. IF IT FINDS ANY, IT */ /* CANCELS THEM. */ /**********************************************************************/ /**********************************************************************/ /* PARSE THE INPUT PARAMETER */ /**********************************************************************/ PARSE UPPER ARG INPARM PARSE UPPER VAR INPARM 'SIMULATE=' SIMULATE . PARSE UPPER VAR INPARM 'SUBSYS=' SUBSYS . IF SIMULATE = '' THEN SIMULATE = 'YES' IF SUBSYS = '' THEN SUBSYS = 'DSNT' /**********************************************************************/ /* INITIAL VARIABLES AND DISPLAYS */ /**********************************************************************/ CANCELCT = 0 DUMMY = TIME(E) PARSE SOURCE EXECINFO SAY '*** REXX EXECUTION ***' SAY '***' EXECINFO SAY '*** BEGUN AT:' TIME(L) SAY '*** ON:' SUBSTR(DATE(S),1,4)³³-, SUBSTR(DATE(S),5,2)³³-, SUBSTR(DATE(S),7,2) SAY '*********************************************************' SAY '*** THIS REXX PROGRAM CAPTURES A DB2 "DISPLAY THREAD" ***' SAY '*** COMMAND AND PARSES THE OUTPUT LOOKING FOR THREADS ***' SAY '*** THAT ARE DISTRIBUTED THREADS AND ARE SPECIFIC TO ***' SAY '*** THE "CDA/ELM" SYSTEM. IT CANCELS THESE THREADS ***' SAY '*** SO THAT THE DB2 BATCH MAINTENANCE PROCESS CAN ***' SAY '*** START. ***' SAY '*********************************************************' /**********************************************************************/ /* GATHER THE OUTPUT OF THE DISPLAY THREAD COMMAND */ /**********************************************************************/ ADDRESS TSO DUMMY = OUTTRAP('THREAD.') QUEUE '-DISPLAY THREAD(*)' QUEUE 'END' 'DSN SYSTEM('SUBSYS')' /**********************************************************************/ /* LOOP THROUGH THE OUTPUT OF THE DISPLAY THREAD COMMAND AND CREATE */ /* CANCEL THREAD COMMANDS FOR THREADS THAT MEET THE CRITERIA. */ /**********************************************************************/ DO I = 1 TO THREAD.0 PARSE UPPER VAR THREAD.I NAME ST A REQ ID AUTHID PLAN ASID TOKEN . /*********************************/ /* THREAD SELECTION CRITERIA: */ IF NAME = 'SERVER' &, /* CONNECTION NAME = 'SERVER' */ AUTHID = 'CDALOGON' &, /* AUTH ID = 'CDALOGON' */ PLAN = 'DISTSERV' THEN /* PLAN NAME = 'DISTSERV' */ DO /*********************************/ SAY '*** CANCELLING THIS THREAD ***' SAY '* NAME:' NAME SAY '* ST:' ST SAY '* A:' A SAY '* REQ:' REQ SAY '* ID:' ID SAY '* AUTHID:' AUTHID SAY '* PLAN:' PLAN SAY '* ASID:' ASID SAY '* TOKEN:' TOKEN SAY '******************************' QUEUE '-CANCEL THREAD('TOKEN')' CANCELCT = CANCELCT + 1 END END IF CANCELCT = 0 THEN DO SAY ' ' SAY '****************************' SAY '*** NO THREADS TO CANCEL ***' SAY '****************************' SAY ' ' END DUMMY = OUTTRAP('OFF') DROP(THREAD.) /**********************************************************************/ /* NOW ACTUALLY ISSUE THE CANCEL THREAD COMMANDS TO DB2. */ /**********************************************************************/ IF SIMULATE = 'NO' THEN DO QUEUE 'END' 'DSN SYSTEM('SUBSYS')' END ELSE DO I = 0 TO QUEUED() PARSE UPPER PULL TERMCMD SAY TERMCMD END SAY '*** REXX EXECUTION ***' SAY '***' EXECINFO SAY '*** ENDED AT:' TIME(L) SAY '*** ON:' SUBSTR(DATE(S),1,4)³³-, SUBSTR(DATE(S),5,2)³³-, SUBSTR(DATE(S),7,2) SAY '*** ELAPSED TIME:' TIME(E) ./ ADD NAME=CDASETUP /* REXX ***************************************************************/ /* UTILITY: CDASETUP */ /* AUTHOR: DAVID LEIGH */ /* FUNCTION: THIS UTILITY CONTROLS FILE TAILORING OF A JOB WHICH WILL */ /* CREATE A PROGRAMMER'S TEST DB2 ENVIRONMENT IN THIER */ /* DATABASE BASED ON SOME CRITERIA PASSED TO THIS EXEC. IF */ /* THIS EXEC DOES NOT GET EVERYTHING IT NEEDS, IT WILL POP */ /* UP A PANEL TO PROMPT FOR IT. CONSEQUENTLY IT CAN BE */ /* CALLED BY OTHER PROCESSES THAT PASS THE REQUISITE */ /* INFORMATION VIA THE ISPF SHARED PROFILE POOL. */ /* */ /* NOTE: THIS UTILITY WAS "CLONED" FROM THE DBSETUP UTILITY */ /* TO DEAL WITH CDA OBJECTS SPECIFICALLY INSTEAD OF */ /* UNISTAR. IT DOES SHARE SOME ISPF DIALOG ELEMENTS */ /* WITH DBSETUP. */ /**********************************************************************/ ADDRESS ISPEXEC "CONTROL ERRORS RETURN" USERDB = SYSVAR(SYSUID) ³³ 'DB' "SELECT PGM(USERINFO) PARM("SYSVAR(SYSUID)")" "VGET (JOBPFX DATABASE CREATOR APPLNAME", "JCLREVEW SIZEPCT TBLSDROP DBSETUP DEBUG) SHARED" IF DBSETUP = AUTO THEN DO IF JOBPFX = '' THEN JOBPFX = 'EL' IF DATABASE = '' THEN DATABASE = USERDB IF CREATOR = '' THEN CREATOR = SYSVAR(SYSUID) IF JCLREVEW = '' THEN JCLREVEW = 'Y' IF SIZEPCT = '' THEN SIZEPCT = 1 IF TBLSDROP = '' THEN TBLSDROP = 'N' "VPUT (JOBPFX DATABASE CREATOR APPLNAME", "JCLREVEW SIZEPCT TBLSDROP DBSETUP DEBUG) SHARED" END ELSE DO WHILE GENJCL ¬= 'Y' "DISPLAY PANEL(CDASETUP)" IF RC = 8 THEN EXIT END TEMPFILE = SYSVAR(SYSUID) ³³ '.TEMP.CDASETUP.JCL' ADDRESS TSO DUMMY = OUTTRAP('NULL.') "FREE DD(ISPFILE)" "DELETE '"TEMPFILE"'" "ALLOCATE DD(ISPFILE) DSN('"TEMPFILE"')" , "NEW CATALOG" , "UNIT(SYSDA) VOLUME(WRK$$$)" , "SPACE(1,1) TRACKS RELEASE" , "RECFM(F B) LRECL(80) DSORG(PS)" DROP NULL. ADDRESS ISPEXEC "FTOPEN" "FTINCL CDASETUP" SAVERC = RC "FTCLOSE" ADDRESS TSO "FREE DD(ISPFILE)" IF SAVERC > 0 THEN DO ZEDLMSG = 'FILE TAILORING OF THE "CDASETUP" SKELETON FAILED', 'WITH RC =' SAVERC "SETMSG MSG(UTLZ001W)" "EDIT DATASET('"TEMPFILE"')" END ELSE IF JCLREVEW = 'Y' THEN DO ZEDLMSG = 'YOU MUST SUBMIT THIS JCL YOURSELF' "SETMSG MSG(UTLZ000W)" "EDIT DATASET('"TEMPFILE"')" END ELSE DO ADDRESS TSO "SUBMIT '"TEMPFILE"'" ZEDLMSG = 'CDASETUP JOB SUBMITTED' "SETMSG MSG(UTLZ000W)" END EXIT SAVERC ./ ADD NAME=CEDA PROC 0 /**** 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 ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT FREE DD(SYSLST BATCNTL SYSIPT) ALLOC DD(SYSLST) DSN(*) ALLOC DD(BATCNTL) DSN('CEMT.TST.BATCH.CONTROL') SHR ALLOC DD(SYSIPT) DSN('D@UDAL.STR.CNTLLIB(CEDA)') SHR CALL 'CEMT.V4R7M0.LOADLIB(MTPBATCH)' FREE DD(SYSLST BATCNTL SYSIPT SYSPRINT SYSOUT INFILE OUTFILE SYSIN) ./ ADD NAME=CEMT PROC 0 /**** 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 ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT FREE DD(SYSLST BATCNTL SYSIPT) ALLOC DD(SYSLST) DSN(*) ALLOC DD(BATCNTL) DSN('CEMT.COMMON.DSNT.BATCH.CONTROL') SHR ALLOC DD(SYSIPT) DSN('D@UDAL.STR.CNTLLIB(CEMT)') SHR CALL 'CEMT.V4R7M0.LOADLIB(MTPBATCH)' FREE DD(SYSLST BATCNTL SYSIPT) ./ ADD NAME=CENTER ISREDIT MACRO (HELP) ISPEXEC CONTROL ERRORS RETURN /**** 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 /******************************************************************/ /* 'CENTER' EDIT MACRO. CENTER THE STRING ON THE CURSOR LINE */ /* AUTHOR : DAVID LEIGH DATE : 11-15-89 */ /******************************************************************/ IF &STR(&HELP) = &STR(HELP) THEN GOTO HELPSEC ISREDIT (DSN) = DATASET LISTDSI '&DSN' ISREDIT (LN,CL) = CURSOR ISREDIT CURSOR = &LN 1 ISREDIT FIND FIRST P'¬' .ZCSR .ZCSR ISREDIT (LN,FIRST) = CURSOR ISREDIT FIND LAST P'¬' .ZCSR .ZCSR ISREDIT (LN,LAST) = CURSOR ISREDIT (DLINE) = LINE .ZCSR SET DLINE = &SUBSTR(&FIRST:&LAST,&STR(&DLINE)) SET DLEN = &LENGTH(&STR(&DLINE)) SET POS = (&SYSLRECL - &DLEN) / 2 SET REM = (&SYSLRECL - &DLEN) / 2 IF &REM > 1 THEN SET POS = &POS + 1 ISREDIT LINE .ZCSR = < &POS '&STR(&DLINE)' > EXIT HELPSEC: + 02480000 ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) 02490000 SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR CENTER UTILITY + 02490000 *** NO PROCESSING PERFORMED ***) 02490000 ISPEXEC SETMSG MSG(UTLZ000) 02490000 EXIT ./ ADD NAME=CHAMPSET PROC 0 NAME() TYPE() HELP /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT IF &HELP = &STR(HELP) THEN GOTO HELPSEC ISPEXEC VGET (SMEMBER SDSTYPE) IF &STR(&TYPE) = &STR(&SDSTYPE) THEN ELSE + DO SET SDSTYPE = &TYPE ISPEXEC VPUT (SDSTYPE) END IF &STR(&NAME) = &STR(&SMEMBER) THEN ELSE + DO SET SMEMBER = &NAME ISPEXEC VPUT (SMEMBER) END EXIT HELPSEC: + CLEARSCR WRITE *** HELP FOR CLIST 'CHAMPSET' *** WRITE WRITE THE 'CHAMPSET' CLIST ALLOWS THE USER TO SET THE CHAMP 'DS TYPE' WRITE AND 'MEMBER' VARIABLES PRIOR TO GOING TO THE MEMBER DISPLAY LIST, WRITE WITHOUT HAVING TO STOP AT THE 'SELECTION' SCREEN. THE SELECTION WRITE SCREEN IS WHERE THE USER TYPICALLY TYPES IN WHAT DSTYPE IS DESIRED WRITE ON THE SUBSEQUENT MEMBER LIST SCREEN. WRITE WRITE THERE ARE TIMES WHEN THIS COULD BE QUITE USEFUL. FOR EXAMPLE, A WRITE USER MIGHT ENTER '=E.C;2;;;E PWBPCR22' AT AN ISPF COMMAND LINE. WRITE THIS WOULD INDICATE THAT THE USER WANTED TO GO TO CHAMP, THEN TO WRITE STATUS 2, AND THEN INTO 'EDIT' MODE ON PROGRAM PWPBCR22. THIS WRITE WOULD WORK JUST FINE IF THE CHAMP DSTYPE WAS SET TO 'COBIDMS' AND WRITE THE MEMBER NAME WAS BLANK OR CONTAINED PART OF A PREFIX OF WRITE PWBPCR22 OR THE ENTIRE NAME PWBPCR22. IF, HOWEVER, THE DSTYPE HAS WRITE 'JCL' IN IT, THIS COMMAND WILL NOT WORK BECAUSE THE USER IS TRYING WRITE TO ACCESS A COBIDMS TYPE MEMBER IN A JCL TYPE LIST. WRITE WRITE IN THIS SITUATION, THE COMMAND LINE THAT THE USER ENTERED COULD BE WRITE CHANGED TO '=E.C;TSO CHAMPSET TYPE(COBIDMS);2;;;E PWBPCR22'. THIS WRITE WOULD DEFINATELY WORK BECAUSE THE DSTYPE WOULD BE SET TO 'COBIDMS' WRITE PRIOR TO FORMING THE MEMBER LIST. WRITE WRITE SYNTAX : WRITE WRITE COMMAND ==> TSO CHAMPSET TYPE(AAAAAAAA) NAME(BBBBBBBB) WRITE WRITE OR WRITE WRITE COMMAND ==> TSO CHAMPSET TYPE(AAAAAAAA) WRITE WRITE OR WRITE WRITE COMMAND ==> TSO CHAMPSET NAME(BBBBBBBB) WRITE WRITE OR WRITE WRITE COMMAND ==> TSO CHAMPSET WRITE WRITE OR WRITE WRITE WHERE 'AAAAAAAA' IS A VALID CHAMP DSTYPE AND WRITE WHERE 'BBBBBBBB' IS A VALID MEMBER NAME OR MEMBER NAME PREFIX. WRITE WRITE WHEN NAME IS NOT SPECIFIED, THE MEMBER PARAMETER WOULD BE SET TO WRITE BLANKS. WHEN TYPE IS NOT SPECIFIED, THE DSTYPE WOULD BE SET TO WRITE BLANKS. WHEN NEITHER ARE SPECIFIED, THEY WOULD BOTH BE SET TO WRITE BLANKS. WRITE WRITE THE CALL TO 'CHAMPSET' MUST BE MADE AFTER GOING INTO CHAMP, BUT WRITE BEFORE SELECTING YOUR FIRST CHAMP SUB-OPTION (E.G. '1', '2', ETC.) WRITE WRITE *** END OF HELP *** NO PROCESSING PERFORMED *** EXIT ./ ADD NAME=CHAMPVAR PROC 0 /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT FREE ATTRLIST(ATTRIB1) ATTRIB ATTRIB1 + BLKSIZE(23440) + LRECL(80) + RECFM(F B) + OUTPUT FREE DDNAME(VARNAMES) ALLOCATE DDNAME(VARNAMES) + DSNAME('TCWCA.TWB.WORKFILE(DALCVARS)') + SHR KEEP FREE DDNAME(VAROUT) DELETE TEMP.CHAMP.VAR ALLOCATE DDNAME(VAROUT) + DSNAME(TEMP.CHAMP.VAR) + NEW CATALOG + UNIT(SYSDA) + SPACE(5,2) TRACKS RELEASE + USING(ATTRIB1) ERROR + DO SET SAVECC = &LASTCC IF &SAVECC = 400 THEN + DO SET EOF = YES RETURN END ELSE + IF &ZZZ = ISPEXEC THEN RETURN ELSE + DO WRITE *** PROBLEM WITH CLIST CHAMPVAR *** WRITE *** RETURN CODE = &SAVECC *** CLOSFILE VAROUT FREE DDNAME(VAROUT) CLOSFILE VARNAMES FREE DDNAME(VARNAMES) FREE ATTRLIST(ATTRIB1) EXIT END END SET EOF = NO OPENFILE VAROUT OUTPUT OPENFILE VARNAMES INPUT GETFILE VARNAMES DO WHILE &EOF = NO SET CVAR = &SUBSTR(1:8,&STR(&VARNAMES)) SET ZZZ = ISPEXEC ISPEXEC VGET (&CVAR) SET ZZZ = SET A = &STR(&&)&STR(&CVAR) SET VAROUT = &STR("&CVAR" = &A) PUTFILE VAROUT GETFILE VARNAMES END ERROR OFF CLOSFILE VAROUT CLOSFILE VARNAMES FREE DDNAME(VARNAMES) ISPEXEC EDIT DATASET(TEMP.CHAMP.VAR) FREE DDNAME VAROUT ) EXIT ./ ADD NAME=CHANGE88 ISREDIT MACRO ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ISREDIT (SYSDVAL) = LINE .ZCSR READDVAL A B C D E F G WRITE A &A WRITE B &B WRITE C &C WRITE D &D WRITE E &E WRITE F &F WRITE G &G EXIT ISREDIT FIND FIRST P'=' 1 NX DO WHILE &LASTCC = 0 ISREDIT (NBR) = LINENUM .ZCSR WRITE WORKING ON &NBR ISREDIT LABEL .ZCSR = .CURR ISREDIT FIND NEXT P'=' 1 NX ISREDIT LABEL .ZCSR = .NEXT ISREDIT FIND PREV P'=' 1 .CURR ISREDIT TFLOW .ZCSR 80 ISREDIT FIND NEXT P'=' 1 NX .NEXT ISREDIT FIND PREV P'=' 255 ISREDIT FIND NEXT P'=' 1 NX END ./ ADD NAME=CHCKMAIL /* REXX ***************************************************************/ /* UTILITY: CHCKMAIL */ /* AUTHOR: DAVID LEIGH */ /* FUNCTION: THIS REXX EXEC TAKES INPUT THAT WAS EXTRACTED FROM THE */ /* PRD1AOR5 SDSF OUTPUT TO DETERMINE THE LAST TIME THAT THE */ /* MHS MAIL GATEWAY WAS RUN. IT CREATES A MESSAGE BASED ON */ /* THAT OUTPUT THAT THE NEXT STEP SENDS. */ /**********************************************************************/ ARG TSOSEND TSOUSER MINUTES ADDRESS TSO "NEWSTACK" /**********************************************************************/ /* CALCULATE THE SECONDS THRESHOLD */ /**********************************************************************/ IF MINUTES = '' THEN MINUTES = 30 SECONDS = MINUTES * 60 SAY '************** MAIL GATEWAY CHECK ****************' SAY '* TSOSEND:' TSOSEND SAY '* TSOUSER:' TSOUSER SAY '* MINUTES:' MINUTES SAY '* SECONDS:' SECONDS SAY '**************************************************' /**********************************************************************/ /* SET THE DEFAULT MESSAGE */ /**********************************************************************/ MSG = 'CKML0001-NO MAIL GATEWAY MSGS FOUND - CHECK SERVER AND/OR CICS' /**********************************************************************/ /* READ THE SDSF OUTPUT INTO A STEM ARRAY FOR PROCESSING */ /**********************************************************************/ "EXECIO * DISKR SDSFFILE (STEM SDSFLINE. FINIS)" SWITCH = 'OFF' /**********************************************************************/ /* MAIN PROCESSING LOOP. FIND THE RIGHT MESSAGE LINE AND THEN DO */ /* DATE/TIME CALCULATIONS TO DETERMINE THE SPAN OF TIME SINCE THE */ /* LAST SUCCESSFUL GATEWAY EXECUTION. */ /**********************************************************************/ DO I = 1 TO SDSFLINE.0 IF SWITCH = 'ON' THEN IF SUBSTR(SDSFLINE.I,44,5) = 'TIME:' THEN DO PARSE UPPER VAR SDSFLINE.I ': ' MO '-' DD '-' YY, ', TIME: ' HH '-' MI '-' SS NULL IF DATE(U) ¬= MO'/'DD'/'YY THEN HH = HH - 24 LASTSEC = SS + (MI * 60) + ((HH * 60) * 60) IF TIME(S) - LASTSEC > SECONDS THEN DO SAY '**************************************************' SAY '* LAST MAIL GATEWAY EXECUTION TIME' SAY '* DATE: ' MO'/'DD'/'YY SAY '* TIME: ' HH':'MI':'SS SAY '* MINUTES AGO:' (TIME(S)-LASTSEC)/60 SAY '**************************************************' MSG = 'CKML0002-LAST MAIL GATEWAY MESSAGE', 'TOO LONG AGO - CHECK SERVER' END ELSE DO SAY '**************************************************' SAY '* LAST MAIL GATEWAY EXECUTION TIME' SAY '* DATE: ' MO'/'DD'/'YY SAY '* TIME: ' HH':'MI':'SS SAY '* MINUTES AGO:' (TIME(S)-LASTSEC)/60 SAY '**************************************************' MSG = 'MAIL GATEWAY "OK" - LAST EXECUTION AT:', HH':'MI':'SS 'ON' MO'/'DD'/'YY, (TIME(S)-LASTSEC)/60 'MINUTES AGO' /* MSG = '' */ END /*ELSE MSG = ''*/ LEAVE END ELSE ITERATE IF SUBSTR(SDSFLINE.I,32,19) = 'PC2/LAN2 CONNECTION' THEN SWITCH = 'ON' END /**********************************************************************/ /* OUTPUT THE MESSAGE TO THE OUTPUT FILE */ /**********************************************************************/ IF MSG > '' THEN QUEUE MSG "EXECIO" QUEUED() "DISKW OUTMSG (FINIS)" /**********************************************************************/ /* SEND THE MESSAGE VIA TSO IF THE PARM WAS PASSED TO DO SO */ /**********************************************************************/ IF MSG > '' &, TSOSEND = 'YES' &, TSOUSER > '' THEN IF TSOUSER = 'CONSOLE' THEN DO "SEND '"MSG"' CN(MSTRUSC1)" "SEND '"MSG"' U(D@UDAL) LOGON" END ELSE "SEND '"MSG"' U("TSOUSER") LOGON" ./ ADD NAME=CHCKPRFM /* REXX ***************************************************************/ /* */ /**********************************************************************/ ADDRESS ISPEXEC 'CONTROL ERRORS RETURN' ADDRESS ISREDIT "MACRO" "(ONOFF,WHICH) = NUMBER" ADDRESS ISPEXEC "VPUT (ONOFF WHICH) SHARED" "CANCEL" ./ ADD NAME=CHCKPROF /* REXX ***************************************************************/ /* */ /**********************************************************************/ ADDRESS ISPEXEC 'CONTROL ERRORS RETURN' "LMINIT DATAID(DID) DATASET('PPROD.STR.COBOL') ENQ(SHR)" "LMOPEN DATAID("DID") OPTION(INPUT)" "LMMLIST DATAID("DID") OPTION(LIST) MEMBER(MBRNAME)" X = 0 DO WHILE RC = 0 X = X + 1 ZEDLMSG = MBRNAME "CONTROL DISPLAY LOCK" "DISPLAY MSG(UTLZ000W)" "EDIT DATAID("DID") MEMBER("MBRNAME") MACRO(CHCKPRFM)" EDITRC = RC "VGET (ONOFF WHICH) SHARED" IF EDITRC < 10 THEN EDITRC = '0'EDITRC ONOFF = SUBSTR(ONOFF' ',1,3) MBRNAME = SUBSTR(MBRNAME' ',1,8) STRNG.X = MBRNAME EDITRC ONOFF WHICH "LMMLIST DATAID("DID") OPTION(LIST) MEMBER(MBRNAME)" END "LMMLIST DATAID("DID") OPTION(FREE) MEMBER(MBRNAME)" "LMCLOSE DATAID("DID")" "LMFREE DATAID("DID")" ADDRESS TSO DUMMY = OUTTRAP('NULL.') "FREE DD(TEMPOUT)" "ALLOCATE DD(TEMPOUT) DSN('D@UDAL.STR.WRKLIB(ZNUMBER)') SHR" DROP NULL. "EXECIO" X "DISKW TEMPOUT (STEM STRNG. FINIS" "FREE DD(TEMPOUT)" EXIT ./ ADD NAME=CHCKSTAT /* REXX */ TEMPIN = SYSVAR(SYSUID) || '.TEMP.SDSF.INPUT' TEMPOUT = SYSVAR(SYSUID) || '.TEMP.SDSF.OUTPUT' ADDRESS TSO DUMMY = OUTTRAP('NULL.') "FREE DD(ISFIN ISFOUT)" "DELETE '"TEMPIN"'" "DELETE '"TEMPOUT"'" "ALLOCATE DD(ISFIN) DSN('"TEMPIN"')" , "NEW CATALOG" , "UNIT(SYSDA) VOLUME(WRK$$$)" , "SPACE(1,1) TRACKS RELEASE" , "RECFM(F B) LRECL(80) DSORG(PS)" "ALLOCATE DD(ISFOUT) DSN('"TEMPOUT"')" , "NEW CATALOG" , "UNIT(SYSDA) VOLUME(WRK$$$)" , "SPACE(1,1) CYLINDERS RELEASE" , "RECFM(F B) LRECL(255) DSORG(PS)" DROP NULL. QUEUE "PREFIX P2STATF1" QUEUE "DA" QUEUE "F P2STATF1" QUEUE "++?" QUEUE "F SYSTSPRT" QUEUE "F" QUEUE "++S" QUEUE "F 'DSN RC=' LAST" QUEUE "END" QUEUE "END" QUEUE "PREFIX P2STATF2" QUEUE "F P2STATF2" QUEUE "++?" QUEUE "F SYSTSPRT" QUEUE "F" QUEUE "++S" QUEUE "F 'DSN RC=' LAST" QUEUE "END" QUEUE "END" QUEUE "PREFIX P2STATF3" QUEUE "F P2STATF3" QUEUE "++?" QUEUE "F SYSTSPRT" QUEUE "F" QUEUE "++S" QUEUE "F 'DSN RC=' LAST" QUEUE "END" QUEUE "END" QUEUE "PREFIX P2STATF4" QUEUE "F P2STATF4" QUEUE "++?" QUEUE "F SYSTSPRT" QUEUE "F" QUEUE "++S" QUEUE "F 'DSN RC=' LAST" "EXECIO" QUEUED() "DISKW ISFIN (FINIS)" ADDRESS LINKMVS "SDSF" ./ ADD NAME=CHECKDSN PROC 0 CONTROL NOMSG NOFLUSH NOPROMPT END(ENDO) /*CONTROL MSG NOFLUSH NOPROMPT END(ENDO) CONLIST LIST GLOBAL FILENAME MEMBER /* INITIALIZE: - SET RC = 0 SET DSN = &STR(&FILENAME) SET LPAREN = &STR(( SET RPAREN = &STR()) SET DSNL = &LENGTH(&STR(&FILENAME)) /* IF &SUBSTR(1:1,&STR(&FILENAME)) = &STR(') THEN - DO SET FILENAME = &SUBSTR(2:&DSNL,&STR(&FILENAME)) SET DSNL = &DSNL - 1 ENDO /* IF &SUBSTR(&DSNL:&DSNL,&STR(&FILENAME)) = &STR(') THEN - DO SET DSNL = &DSNL - 1 SET FILENAME = &SUBSTR(1:&DSNL,&STR(&FILENAME)) ENDO /* SET LP = &SYSINDEX(&STR(&LPAREN),&STR(&FILENAME)) IF &LP > 0 THEN - DO SET RP = &SYSINDEX(&RPAREN,&STR(&FILENAME)) - 1 IF &RP < 1 OR &RP <= &LP+1 THEN GOTO CHKDSN SET MEMBER = &SUBSTR(&LP+1:&RP,&STR(&FILENAME)) SET FILENAME = &SUBSTR(1:&LP-1,&STR(&FILENAME)) SET DSNL = &LENGTH(&STR(&FILENAME)) ENDO /* IF &STR(&MEMBER) = THEN GOTO CHKDSN IF &DATATYPE(&MEMBER) = NUM THEN - DO SET ML = &LENGTH(&STR(&MEMBER)) SET MS = &SUBSTR(1:1,&STR(&MEMBER)) IF &STR(&MS) = &STR(-) THEN - DO SET MX = &SUBSTR(2:&ML,&STR(&MEMBER)) SET G = &MX + 0 ENDO ELSE - IF &STR(&MS) ¬= 0 THEN - DO SET RC = 16 WRITE *** WRITE *** INVALID REQUEST - GDG &STR(&FILENAME(&MEMBER)) GOTO EXIT ENDO ELSE - SET G = &MEMBER + 0 /* GOTO GETGDG CONTINUE: - IF &G < &N THEN - DO SET TEMPSTR = &STR(&&MINUS&G) SET FILENAME = &STR(&TEMPSTR) ENDO ELSE - DO SET RC = 16 WRITE *** WRITE *** GDG &FILENAME(&STR(-)&G) NO LONGER AVAILABLE GOTO EXIT ENDO ENDO /* CHKDSN: - SET RESULT = &SYSDSN('&FILENAME') /* IF &RESULT ¬= OK THEN - DO SET RESULT = &SYSDSN(&FILENAME) IF &RESULT ¬= OK THEN - DO SET RC = 16 WRITE *** IF &SYSINDEX(&STR(&FILENAME),&STR(&RESULT)) > 0 THEN - WRITE *** &RESULT ELSE WRITE *** &FILENAME &RESULT GOTO EXIT ENDO ELSE - DO SET FILENAME = &STR(&SYSUID..&FILENAME) SET DSNL = &DSNL + &LENGTH(&SYSUID) + 1 ENDO ENDO EXIT: - EXIT CODE(&RC) /* GETGDG: - SET MEMBER = SET NONVSAM = &STR(NONVSAM--) SET SYSOUTTRAP = 300 LISTCAT ENTRY(&FILENAME) GDG ALL SET RC = &LASTCC IF &RC ¬= 0 THEN - DO LISTCAT ENTRY('&FILENAME') GDG ALL SET RC = &LASTCC IF &RC ¬= 0 THEN - DO SET I = 1 WRITE *** DO WHILE &I <= &SYSOUTLINE SET LINE = &&SYSOUTLINE&I WRITE &LINE SET I = &I + 1 ENDO GOTO EXIT ENDO ENDO ELSE - DO SET DSNL = &DSNL + &LENGTH(&SYSUID) + 1 ENDO /* SET N = 0 SET I = 1 DO WHILE &I <= &SYSOUTLINE SET LINE = &&SYSOUTLINE&I SET X = &SYSINDEX(&STR(&NONVSAM),&LINE) IF &X > 0 THEN - DO SET N = &N + 1 SET F = &X + 9 SET L = &F + &DSNL + 8 SET GDG&N = &SUBSTR(&F:&L,&STR(&LINE)) ENDO SET I = &I + 1 ENDO /* SET I = 1 DO WHILE &I <= &N SET V = &N - &I SET MINUS&V = &STR(&&GDG&I) SET I = &I + 1 ENDO GOTO CONTINUE ./ ADD NAME=CHECKGDA PROC 0 GDASTATS() CONTROL NOMSG NOLIST NOPROMPT NOFLUSH SET SYSOUTTRAP = 100 PDS83 'SYS2.GDA.CNTL' HISTORY GDATA SET SYSOUTTRAP = 0 IF &STR(&GDASTATS) ¬= &SUBSTR(14:&LENGTH(&STR(&SYSOUTLINE2)),+ &STR(&SYSOUTLINE2)) THEN + DO CLEAR WRITE ******************************************************* WRITE STATS ON "SYS2.GDA.CNTL(GDATA)" DO NOT MATCH THOSE FROM WRITE THE TIME YOU CREATED YOUR PERSONAL GDA LOGON PROCESS. WRITE YOU MAY WANT TO DO AN ISPF 3.13 COMPARE OF YOUR COPY WRITE AGAINST THE CURRENT "SYS2.GDA.CNTL(GDATA)" TO DETERMINE WRITE SUBSTATIAL CHANGES. THEN RESET YOUR GDA LOGON PROCESS WRITE DATASET WITH THE NEW "GDATA" ISPF MEMBER STATISTICS WRITE WHEN YOU CALL "CHECKGDA". WRITE ******************************************************* WRITE WRITE *******************************************************+ ******************** WRITE OLD &SYSOUTLINE1 WRITE GDATA &GDASTATS WRITE WRITE NEW &SYSOUTLINE1 WRITE &SYSOUTLINE2 WRITE *******************************************************+ ******************** WRITE WRITENR PRESS TO CONTINUE READ ANS END EXIT ./ ADD NAME=CHECKJCL ISREDIT MACRO (HELP) ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /******************************************************************/ /* CHECKJCL - EDIT MACRO. VERIFY JCL PRIOR TO MIGRATING IT TO */ /* PRODUCTION (STATUS 1). */ /* */ /* AUTHOR: DAVID MONTGOMERY DATE: 06-07-90 */ /******************************************************************/ IF &HELP = HELP THEN GOTO HELPSEC ISREDIT RESET SET ASTRSK = &STR(*) SET TCOUNT = 0 SET SCOUNT = 0 SET CCOUNT = 0 SET XCOUNT = 0 SET TNODE = &STR(TCWMK.) SET TMSG = &STR(TEST DATASET) SET AMSG = &STR(-*-*-*- NO /*JOBPARM SYSAFF= FOUND) SET WMSG = &STR(-*-*-*- NO REFERENCE TO JESWTR OUTPUT FOUND) SET FMSG = &STR(>>> /*JOBPARM SYSAFF DOES NOT EQUAL P310) SET TNOTE = &STR(>>> REFERENCE TO A TEST DATASET) SET SMSG = &STR(UNIT=SYSDA) SET SNOTE = &STR(>>> REFERENCE UNIT=SYSDA) SET CMSG = &STR(TEST CV22) SET CNOTE = &STR(>>> REFERENCE TO CV22) SET DD = &STR( DD ) SET SYSTEM = &STR(SYSAFF=) SET WRITER = &STR(//JESWTR) SET OKMSG = &STR(NO REFERENCES TO TEST DATA OR CV22 FOUND) SET SFX = ISREDIT SEEK '&WRITER' FIRST SET RC = &LASTCC IF &RC > 0 THEN + DO ISREDIT LINE_BEFORE .ZFIRST = MSGLINE '&WMSG' SET XCOUNT = &XCOUNT + 1 END ISREDIT SEEK '&SYSTEM' FIRST SET RC = &LASTCC IF &RC > 0 THEN + DO ISREDIT LINE_BEFORE .ZFIRST = MSGLINE '&AMSG' SET XCOUNT = &XCOUNT + 1 END ELSE + DO ISREDIT (WLINE) = LINE .ZCSR IF &SYSINDEX(&STR(=P310),&STR(&WLINE)) = 0 THEN + DO ISREDIT LINE_BEFORE .ZCSR = MSGLINE '&FMSG' SET XCOUNT = &XCOUNT + 1 END END ISREDIT SEEK 'CV22' FIRST SET RC = &LASTCC DO WHILE &RC = 0 SET CCOUNT = &CCOUNT + 1 ISREDIT LINE_BEFORE .ZCSR = MSGLINE '&CNOTE' ISREDIT SEEK 'CV22' NEXT SET RC = &LASTCC END SET SFX = IF &CCOUNT > 0 THEN + DO IF &CCOUNT > 1 THEN SET SFX = S ISREDIT LINE_BEFORE .ZFIRST = MSGLINE + '-*-*-*- &CCOUNT &CMSG REFERENCE&SFX FOUND' END ISREDIT SEEK '&TNODE' FIRST SET RC = &LASTCC DO WHILE &RC = 0 SET TCOUNT = &TCOUNT + 1 ISREDIT LINE_BEFORE .ZCSR = MSGLINE '&TNOTE' ISREDIT SEEK '&TNODE' NEXT SET RC = &LASTCC END SET SFX = IF &TCOUNT > 0 THEN + DO IF &TCOUNT > 1 THEN SET SFX = S ISREDIT LINE_BEFORE .ZFIRST = MSGLINE + '-*-*-*- &TCOUNT &TMSG REFERENCE&SFX FOUND' END ISREDIT SEEK 'SYSDA' FIRST SET RC = &LASTCC DO WHILE &RC = 0 ISREDIT SEEK '&DD' PREV IF &LASTCC = 0 THEN + DO ISREDIT (WLINE) = LINE .ZCSR SET DDNAME = &SUBSTR(1:8,&STR(&WLINE)) IF &STR(&DDNAME) = &STR(//SORTWK) OR + &SUBSTR(3,&STR(&DDNAME)) = &STR(&ASTRSK) THEN /* CONTINUE ELSE + DO SET SCOUNT = &SCOUNT + 1 ISREDIT LINE_BEFORE .ZCSR = MSGLINE '&SNOTE' END ISREDIT SEEK 'SYSDA' NEXT END ISREDIT SEEK 'SYSDA' NEXT SET RC = &LASTCC END SET SFX = IF &SCOUNT > 0 THEN + DO IF &SCOUNT > 1 THEN SET SFX = S ISREDIT LINE_BEFORE .ZFIRST = MSGLINE + '-*-*-*- &SCOUNT &SMSG REFERENCE&SFX FOUND' END IF &CCOUNT + &SCOUNT + &TCOUNT + &XCOUNT = 0 THEN + ISREDIT LINE_BEFORE .ZFIRST = MSGLINE '&OKMSG' ISREDIT CURSOR = 1 1 ISREDIT UP MAX GOTO EXIT HELPSEC: - CLEARSCR WRITE *** HELP FOR EDIT MACRO 'CHECKJCL' *** WRITE WRITE THE CHECKJCL EDIT MACRO IS USED TO VERIFY JCL PRIOR TO MIGRATING WRITE IT TO PRODUCTION (STATUS 1). THE MACRO 'PARSES' THE JCL BEING WRITE EDITED, HIGHLIGHTING ALL REFERENCES TO THE TEST ENVIRONMENT, WRITE SUCH AS 'TCWMK' OR 'CV22'. IT ALSO FLAGS ALL UNIT=SYSDA WRITE STATEMENTS THAT ARE NOT ASSOCIATED WITH SORTWK0N DDNAMES. EACH WRITE HIGHLIGHTED LINE OF JCL CAN BE FOUND BY USING THE 'L SPECIAL' WRITE COMMAND WRITE WRITE *** END OF HELP - NO PROCESSING PERFORMED *** EXIT: - EXIT ./ ADD NAME=CHEKPROD ISREDIT MACRO ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /******************************************************************/ /* */ /******************************************************************/ ISREDIT RESET SET ICOUNT = 0 SET COPY = &STR( COPY ) SET INCLUDE = &STR(++INCLUDE) SET DICT02 = &STR(CAT0) SET DICT03 = &STR(CAM0) SET PRODSCHM = &STR(CAS0) SET IMSG = &STR(CHANGED TO ++INCLUDE) SET CMSG = &STR(======> COPY STATEMENT CHANGED TO ++INCLUDE) SET NPMSG = &STR(-*-*-*- NO PROCEDURE DIVISION FOUND, PLEASE VERIFY) SET PMSG1 = &STR(-*-*-*- COMMENTED OUT ACCEPT SUBSCHEMA PROCESSING) SET PMSG2 = &STR(======> COMMENTED OUT ACCEPT SUBSCHEMA STATEMENTS) SET NSMSG = &STR(-*-*-*- NO SUBSCHEMA STATEMENT FOUND, PLEASE VERIFY) SET SMSG1 = &STR(-*-*-*- SUBSCHEMA CHANGED TO PRODUCTION SUBSCHEMA) SET SMSG2 = &STR(======> SUBSCHEMA CHANGED FROM) SET FLAG = X SET SCHEMA = N ISREDIT CURSOR = 1 1 ISREDIT SEEK 'SCHEMA SECTION.' IF &LASTCC = 0 THEN + DO SET SCHEMA = Y ISREDIT (LN) = LINENUM .ZCSR SET LN = &LN + 1 ISREDIT CURSOR = &LN 1 ISREDIT SEEK P'.' ISREDIT (WL) = LINE .ZCSR IF &SYSINDEX(&STR( DB ),&STR(&WL)) > 0 THEN + DO SET S = &SYSINDEX(&DICT02,&STR(&WL)) IF &S > 0 THEN + DO SET SFX = &SUBSTR(&S+4:&S+7,&STR(&WL)) ISREDIT CHANGE &DICT02 &PRODSCHM .ZCSR .ZCSR SET SMSG2 = &STR(&SMSG2 &DICT02&SFX TO &PRODSCHM&SFX) SET FLAG = Y END ELSE + DO SET S = &SYSINDEX(&DICT03,&STR(&WL)) IF &S > 0 THEN + DO SET SFX = &SUBSTR(&S+4:&S+7,&STR(&WL)) ISREDIT CHANGE &DICT03 &PRODSCHM .ZCSR .ZCSR SET SMSG2 = + &STR(&SMSG2 &DICT03&SFX TO &PRODSCHM&SFX) SET FLAG = Y END END END ELSE + ISREDIT LINE_BEFORE .ZFIRST = MSGLINE '&NSMSG' END IF &FLAG = Y THEN + DO ISREDIT LINE_BEFORE .ZFIRST = MSGLINE '&SMSG1' ISREDIT LINE_BEFORE .ZCSR = MSGLINE '&SMSG2' END ISREDIT CURSOR = 1 1 ISREDIT SEEK ' PROCEDURE' 6 SET RC = &LASTCC IF &SCHEMA = N THEN SET RC = 99 IF &RC = 0 THEN + DO ISREDIT (LN) = LINENUM .ZCSR SET PN = &LN SET FLAG = X DO WHILE &FLAG = X SET LN = &LN + 1 ISREDIT (WL) = LINE &LN IF &SYSINDEX(SECTION,&STR(&WL)) > 0 THEN SET FLAG = N ELSE + IF &SYSINDEX(TWBYACPT,&STR(&WL)) > 0 THEN + DO IF &SUBSTR(7,&STR(&WL)) = &STR(*) THEN + SET FLAG = N ELSE + DO SET LPFX = &SUBSTR(1:6,&STR(&WL)) ISREDIT LINE &LN = '&LPFX***INCLUDE TWBYACPT' SET FLAG = Y END END ELSE + IF &SYSINDEX(ACCEPT,&STR(&WL)) > 0 THEN + IF &SUBSTR(7,&STR(&WL)) = &STR(*) THEN + SET FLAG = N ELSE + DO SET Q = &STR(') IF &SYSINDEX(&STR('),&STR(&WL)) > 0 THEN + SET Q = &STR(") SET LPFX = &SUBSTR(1:6,&STR(&WL)) SET LSFX = &SUBSTR(8:72,&STR(&WL)) ISREDIT LINE &LN = &Q&LPFX*&LSFX&Q SET FLAG = Y SET LN = &LN + 1 ISREDIT (WL) = LINE &LN IF &SYSINDEX(EXHIBIT,&STR(&WL)) > 0 THEN + DO SET Q = &STR(') IF &SYSINDEX(&STR('),&STR(&WL)) > 0 THEN + SET Q = &STR(") SET LPFX = &SUBSTR(1:6,&STR(&WL)) SET LSFX = &SUBSTR(8:72,&STR(&WL)) ISREDIT LINE &LN = &Q&LPFX*&LSFX&Q END END END END ELSE + IF &RC ¬= 99 THEN + ISREDIT LINE_BEFORE .ZFIRST = MSGLINE '&NPMSG' IF &FLAG = Y THEN + DO ISREDIT LINE_BEFORE .ZFIRST = MSGLINE '&PMSG1' ISREDIT CURSOR = &PN 1 ISREDIT LINE_BEFORE .ZCSR = MSGLINE '&PMSG2' END ISREDIT CURSOR = 1 1 ISREDIT SEEK '©' SET &RC = &LASTCC DO WHILE &RC = 0 ISREDIT (WL) = LINE .ZCSR ISREDIT (LN,CN) = CURSOR SET CN = &CN + 5 IF &SYSINDEX(&STR( IDMS ),&STR(&WL),&CN) > 0 OR + &SUBSTR(7,&STR(&WL)) = &STR(*) THEN /* CONTINUE ELSE + DO SET Q = &STR(') IF &SYSINDEX(&STR('),&STR(&WL)) > 0 THEN + SET Q = &STR(") SET PFX = &SUBSTR(1:7,&STR(&WL)) SET PT = &SYSINDEX(&STR(.),&STR(&WL)) IF &PT > 0 THEN SET PT = &PT - 1 ELSE SET PT = &LENGTH(&STR(&WL)) - 8 SET WL = &STR(&PFX++INCLUDE&SUBSTR(&CN:&PT,&STR(&WL))) ISREDIT LINE .ZCSR = &Q&WL&Q ISREDIT LINE_BEFORE .ZCSR = MSGLINE '&CMSG' SET ICOUNT = &ICOUNT + 1 END ISREDIT SEEK '©' SET &RC = &LASTCC END IF &ICOUNT > 0 THEN + DO SET SFX = IF &ICOUNT > 1 THEN SET SFX = S SET IMSG = &STR(-*-*-*- &ICOUNT COPY STATEMENT&SFX &IMSG) ISREDIT LINE_BEFORE .ZFIRST = MSGLINE '&IMSG' END ISREDIT CURSOR = 1 1 ISREDIT SEEK '&INCLUDE' SET &RC = &LASTCC DO WHILE &RC = 0 ISREDIT (WL) = LINE .ZCSR ISREDIT (LN,CN) = CURSOR IF &CN ¬= 8 THEN + DO SET Q = &STR(') IF &SYSINDEX(&STR('),&STR(&WL)) > 0 THEN + SET Q = &STR(") SET L = &LENGTH(&STR(&WL)) SET PFX = &SUBSTR(1:7,&STR(&WL)) SET WL = &STR(&PFX++INCLUDE&SUBSTR(&CN+9:&L,&STR(&WL))) ISREDIT LINE .ZCSR = &Q&WL&Q END ISREDIT SEEK '&INCLUDE' SET &RC = &LASTCC END ISREDIT CURSOR = 1 1 ISREDIT UP MAX EXIT ./ ADD NAME=CHGCASE /* REXX ***************************************************************/ /* */ /* */ /* */ /* */ /* */ /* */ /**********************************************************************/ ADDRESS ISPEXEC 'CONTROL ERRORS RETURN' ADDRESS ISREDIT 'MACRO (OPT)' LC = 'abcdefghijklmnopqrstuvwxyz' UC = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' "(LRECL) = LRECL" "(LN,CL) = CURSOR" "FIND PREV ' ' .ZCSR .ZCSR" IF RC > 0 THEN A = 1 ELSE "(NULL,A) = CURSOR" "CURSOR = " LN CL "FIND NEXT ' ' .ZCSR .ZCSR" IF RC > 0 THEN B = LRECL ELSE "(NULL,B) = CURSOR" "(LINE) = LINE .ZCSR" STRING = STRIP(SUBSTR(LINE,A,B-A+1)) SELECT WHEN OPT = 'LC' THEN STRING = TRANSLATE(STRING,UC,LC) WHEN OPT = 'LOWER' THEN STRING = TRANSLATE(STRING,UC,LC) WHEN OPT = 'LOW' THEN STRING = TRANSLATE(STRING,UC,LC) WHEN OPT = 'UC' THEN STRING = TRANSLATE(STRING,LC,UC) WHEN OPT = 'UPPER' THEN STRING = TRANSLATE(STRING,LC,UC) WHEN OPT = 'UP' THEN STRING = TRANSLATE(STRING,LC,UC) OTHERWISE STRING = TRANSLATE(STRING,UC,LC) END "CHANGE '"STRING"' '"STRING"' "A B" FIRST .ZCSR .ZCSR" "CURSOR = " LN CL ./ ADD NAME=CHNGCNTL /********************************************************************** /* UTILITY: CHNGCNTL * /* AUTHOR: DAVID LEIGH * /* FUNCTION: THIS CLIST READS A CONTROL FILE NAMED: * /* USERID.DATASET.CHANGE.CONTROL * /* AND NOTIFIES THE USER OF CHANGES TO DATASETS AND MEMBERS * /* WHICH HE HAS AN INTEREST IN. * /********************************************************************** PROC 1 USER_TO_NOTIFY DEBUG IF &DEBUG = DEBUG THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS /********************************************************************** /* CHECK FOR A VALID CONTROL DATASET * /********************************************************************** SET CNTLFILE = &STR(&USER_TO_NOTIFY..DATASET.CHANGE.CONTROL) LISTDSI '&CNTLFILE' IF &LASTCC > 0 THEN + DO WRITE **************** CHNGCNTL CLIST ERROR ******************* WRITE * THE NECESSARY CONTROL DATASET MUST EXISTS TO EXECUTE * WRITE * THIS CLIST. THE NAME OF THE DATASET IS BASED ON THE * WRITE * USERID PASSED AT INVOCATION TIME. IT'S FORMAT IS: * WRITE ********************************************************* WRITE >>>>>&USER_TO_NOTIFY..DATASET.CHANGE.CONTROL<<<<< WRITE ********************************************************* WRITE * NO PROCESSING WAS PERFORMED. * WRITE ********************************************************* EXIT CODE(12) END IF &SYSDSORG ¬= PS THEN + DO WRITE **************** CHNGCNTL CLIST ERROR ******************* WRITE * THE DATASET ORGANIZATION (DSORG) OF THE CONTROL * WRITE * DATASET USED BY THIS CLIST MUST BE "PS" (PHYSICAL * WRITE * SEQUENTIAL). * WRITE * NO PROCESSING WAS PERFORMED. * WRITE ********************************************************* EXIT CODE(12) END IF &SYSLRECL ¬= 255 THEN + DO WRITE **************** CHNGCNTL CLIST ERROR ******************* WRITE * THE DATASET LOGICAL RECORD LENGTH (LRECL) FOR THE * WRITE * CONTROL DATASET USED BY THIS CLIST MUST BE "255". * WRITE * NO PROCESSING WAS PERFORMED. * WRITE ********************************************************* EXIT CODE(12) END /********************************************************************** /* INITIAL VARIABLE SET UP * /********************************************************************** SET DATASET = SET DSN = SET GROUPS = SET LISTCC = SET MBR = SET MESSAGE = SET STATS = SET EOF = NO SET COM = 0 SET RCD = 0 SET BAD = 0 SET GOOD = 0 SET SPACE100 = &STR( )+ &STR( ) /********************************************************************** /* ALLOCATIONS. * /********************************************************************** DELETE '&CNTLFILE..NEW' FREE DD(CNTLFILE CNTLNEW) ALLOCATE DD(CNTLFILE) DSN('&CNTLFILE') SHR KEEP ALLOCATE DD(CNTLNEW) DSN('&CNTLFILE..NEW') + NEW CATALOG + UNIT(SYSDA) + LIKE('&CNTLFILE') /********************************************************************** /* PROCESSING LOOP * /********************************************************************** OPENFILE CNTLFILE OPENFILE CNTLNEW OUTPUT SYSCALL GET_ANOTHER_RECORD RCD CNTLFILE DATASET GROUPS STATS + MESSAGE EOF DSN MBR DO WHILE &EOF = NO IF &SUBSTR(1:1,&STR(&SYSNSUB(1,&CNTLFILE))) = &STR(*) THEN + DO SYSCALL COMMENT_LINE COM CNTLFILE SYSCALL GET_ANOTHER_RECORD RCD CNTLFILE DATASET GROUPS + STATS MESSAGE EOF DSN MBR END ELSE + DO LISTDSI '&DATASET' SET LISTCC = &LASTCC IF &LISTCC ¬= 0 OR + &STR(&SYSDSORG) ¬= PO THEN + DO SYSCALL BAD_DATASET LISTCC BAD RCD CNTLFILE SYSDSORG SYSCALL GET_ANOTHER_RECORD RCD CNTLFILE DATASET + GROUPS STATS MESSAGE EOF DSN MBR END ELSE + IF &STR(&SYSDSORG) = PO THEN + SYSCALL PARTITIONED GOOD CNTLFILE DATASET + GROUPS STATS MESSAGE + USER_TO_NOTIFY RCD EOF + DSN MBR ELSE + DO SYSCALL BAD_DATASET + LISTCC BAD RCD CNTLFILE SYSCALL GET_ANOTHER_RECORD + RCD CNTLFILE DATASET + GROUPS STATS + MESSAGE EOF DSN MBR END END END END CLOSFILE CNTLFILE CLOSFILE CNTLNEW FREE DD(CNTLFILE CNTLNEW) EXIT /********************************************************************** /* PROCESS A COMMENT LINE * /********************************************************************** COMMENT_LINE: PROC 2 &COM &CNTLFILE SYSREF &COM &CNTLFILE CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS SET COM = &COM + 1 SET CNTLNEW = &STR(&SYSNSUB(1,&CNTLFILE)) PUTFILE CNTLNEW RETURN END /********************************************************************** /* GET ANOTHER CONTROL FILE RECORD * /********************************************************************** GET_ANOTHER_RECORD: PROC 7 &RCD &CNTLFILE &DATASET &GROUPS &STATS + &MESSAGE &EOF &DSN &MBR SYSREF &RCD &CNTLFILE &DATASET &GROUPS &STATS &MESSAGE &EOF + &DSN &MBR SET LP = &STR(( SET RP = &STR()) ERROR DO SET ERRCC = &LASTCC SELECT (&ERRCC) WHEN (400) DO SET EOF = YES SET RCD = &RCD - 1 RETURN END OTHERWISE DO /* ERROR OFF WRITE *** ERROR CC: &ERRCC OCCURRED READING A FILE *** CLOSFILE CNTLFILE FREE DD(CNTLFILE) EXIT END END END SET RCD = &RCD + 1 GETFILE CNTLFILE WRITE &STR(&SYSNSUB(1,&CNTLFILE)) IF &STR(&EOF) = NO THEN + DO SET DATASET = &SUBSTR(001:050,&STR(&SYSNSUB(1,&CNTLFILE))) SET X = &SYSINDEX(&STR(&LP),&STR(&DATASET)) SET Y = &SYSINDEX(&STR(&RP),&STR(&DATASET)) IF &X > 0 AND &Y > &X THEN + DO SET DSN = &SUBSTR(1:&X-1,&STR(&DATASET)) SET MBR = &SUBSTR(&X+1:&Y-1,&STR(&DATASET)) END ELSE + DO SET DSN = SET MBR = END SET GROUPS = &SUBSTR(051:100,&STR(&SYSNSUB(1,&CNTLFILE))) SET STATS = &SUBSTR(101:180,&STR(&SYSNSUB(1,&CNTLFILE))) SET MESSAGE = &SUBSTR(181:255,&STR(&SYSNSUB(1,&CNTLFILE))) END SET X = &LENGTH(&STR(&SYSNSUB(1,&DATASET))) IF &X > 0 THEN + DO WHILE &SUBSTR(&X:&X,&STR(&SYSNSUB(1,&DATASET))) = &STR( ) AND + &X > 1 SET X = &X - 1 END IF &X > 0 THEN SET DATASET = &SUBSTR(1:&X,&STR(&SYSNSUB(1,&DATASET))) SET X = &LENGTH(&STR(&SYSNSUB(1,&DSN))) IF &X > 0 THEN + DO WHILE &SUBSTR(&X:&X,&STR(&SYSNSUB(1,&DSN))) = &STR( ) AND + &X > 1 SET X = &X - 1 END IF &X > 0 THEN SET DSN = &SUBSTR(1:&X,&STR(&SYSNSUB(1,&DSN))) SET X = &LENGTH(&STR(&SYSNSUB(1,&MBR))) IF &X > 0 THEN + DO WHILE &SUBSTR(&X:&X,&STR(&SYSNSUB(1,&MBR))) = &STR( ) AND + &X > 1 SET X = &X - 1 END IF &X > 0 THEN SET MBR = &SUBSTR(1:&X,&STR(&SYSNSUB(1,&MBR))) SET X = &LENGTH(&STR(&SYSNSUB(1,&GROUPS))) IF &X > 0 THEN + DO WHILE &SUBSTR(&X:&X,&STR(&SYSNSUB(1,&GROUPS))) = &STR( ) AND + &X > 1 SET X = &X - 1 END IF &X > 0 THEN SET GROUPS = &SUBSTR(1:&X,&STR(&SYSNSUB(1,&GROUPS))) SET X = &LENGTH(&STR(&SYSNSUB(1,&STATS))) IF &X > 0 THEN + DO WHILE &SUBSTR(&X:&X,&STR(&SYSNSUB(1,&STATS))) = &STR( ) AND + &X > 1 SET X = &X - 1 END IF &X > 0 THEN SET STATS = &SUBSTR(1:&X,&STR(&SYSNSUB(1,&STATS))) SET X = &LENGTH(&STR(&SYSNSUB(1,&MESSAGE))) IF &X > 0 THEN + DO WHILE &SUBSTR(&X:&X,&STR(&SYSNSUB(1,&MESSAGE))) = &STR( ) AND + &X > 1 SET X = &X - 1 END IF &X > 0 THEN SET MESSAGE = &SUBSTR(1:&X,&STR(&SYSNSUB(1,&MESSAGE))) RETURN END /********************************************************************** /* PROCESS A "BAD" DATASET RCDORD * /********************************************************************** BAD_DATASET: PROC 5 &LISTCC &BAD &RCD &CNTLFILE &SYSDSORG SYSREF &LISTCC &BAD &RCD &CNTLFILE &SYSDSORG CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS SET CNTLNEW = &STR(&SYSNSUB(1,&CNTLFILE)) PUTFILE CNTLNEW SET BAD = &BAD + 1 WRITE *** BAD CONTROL CARD RECORD *** WRITE *** RECORD #&RCD WRITE *** LISTDSI RETURN CODE: &LISTCC WRITE *** DATASET ORGANIZATION: &SYSDSORG WRITE *** RECORD DISPLAY FOLLOWS COLUMNS DISPLAY WRITE &STR(....+....1....+....2....+....3....+)+ &STR(....4....+....5....+....6....+....7)+ &STR(....+....8....+....9....+....0....+)+ &STR(....1....+....2....+....3....+....4)+ &STR(....+....5....+....6....+....7....+)+ &STR(....8....+....9....+....0....+....1)+ &STR(....+....2....+....3....+....4....+)+ &STR(....5....+) WRITE &STR(&SYSNSUB(1,&CNTLFILE)) RETURN END /********************************************************************** /* PROCESS A SEQUENTIAL FILE RECORD * /********************************************************************** SEQUENTIAL: PROC 12 &GOOD &CNTLFILE &DATASET &GROUPS &STATS + &MESSAGE &USER_TO_NOTIFY &RCD &EOF &DSN &MBR SYSREF &GOOD &CNTLFILE &DATASET &GROUPS &STATS &MESSAGE + &USER_TO_NOTIFY &RCD &EOF &DSN &MBR CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS SET GOOD = &GOOD + 1 SET SYSOUTTRAP = 100 PDS '&DATASET' USAGE SET SYSOUTTRAP = 0 IF &STR(&SYSOUTLINE7) ¬= &STR(&STATS) THEN + DO SEND '*** SEQUENTIAL DATASET: + "&DATASET" HAS CHANGED FROM + "&STATS"' U(&USER_TO_NOTIFY) LOGON SEND 'TO "&SYSOUTLINE7"' + U(&USER_TO_NOTIFY) LOGON SET CNTLNEW = &SUBSTR(001:100,&STR(&SYSNSUB(1,&CNTLFILE)))+ &SUBSTR(001:050,&STR(&SYSNSUB(1,&SYSOUTLINE7)&SPACE100))+ &SUBSTR(161:255,&STR(&SYSNSUB(1,&CNTLFILE))) PUTFILE CNTLNEW END CONTROL NOMSG NOLIST NOCONLIST NOSYMLIST SYSCALL GET_ANOTHER_RECORD RCD CNTLFILE DATASET GROUPS STATS + MESSAGE EOF DSN MBR CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS RETURN END /********************************************************************** /* PROCESS A PARTIONED DATASET FILE RECORD * /********************************************************************** PARTITIONED: PROC 14 &GOOD &CNTLFILE &DATASET &GROUPS &STATS + &MESSAGE &USER_TO_NOTIFY &RCD &EOF &DSN &MBR SYSREF &GOOD &CNTLFILE &DATASET &GROUPS &STATS &MESSAGE + &USER_TO_NOTIFY &RCD &EOF &DSN &MBR CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS SET GOOD = &GOOD + 1 SET OLDDATASET = &STR(&DATASET) SET SYSOUTTRAP = 10000 IF &STR(&SYSNSUB(1,&GROUPS)) = THEN + SET GROUPS = &STR(:) PDS '&DATASET' ATTRIB &STR(&SYSNSUB(1,&GROUPS)) SET SYSOUTTRAP = 0 SET X = &SYSOUTLINE DO &I = 2 TO &X SET STATISTICS = &&SYSOUTLINE&I SET STAT&I = &STR(STATISTICS) END CONTROL NOMSG NOLIST NOCONLIST NOSYMLIST SYSCALL GET_ANOTHER_RECORD RCD CNTLFILE DATASET GROUPS STATS + MESSAGE EOF DSN MBR CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS DO &I = 2 TO &X SET SYSDVAL = &&STAT&I READDVAL MEMBER STATISTICS IF &EOF = NO THEN + SELECT (&STR(&MBR)) WHEN (&STR(&MEMBER)) DO IF &STR(&STATISTICS) = &STR(&STATS) THEN + DO SET CNTLNEW = &STR(&SYSNSUB(1,&CNTLFILE)) PUTFILE CNTLNEW END ELSE + DO SEND '*** PDS MEMBER: "&MBR" IN DATASET: + "&DSN" HAS CHANGED FROM + "&STATS"' U(&USER_TO_NOTIFY) LOGON SEND 'TO "&STATISTICS"' + U(&USER_TO_NOTIFY) LOGON SET CNTLNEW = &SUBSTR(001:100,+ &STR(&SYSNSUB(1,&CNTLFILE)))+ &SUBSTR(001:060,+ &STR(&SYSNSUB(1,&STATISTICS)+ &SPACE100))+ &SUBSTR(161:255,+ &STR(&SYSNSUB(1,&CNTLFILE))) PUTFILE CNTLNEW END CONTROL NOMSG NOLIST NOCONLIST NOSYMLIST SYSCALL GET_ANOTHER_RECORD RCD CNTLFILE + DATASET GROUPS STATS + MESSAGE EOF DSN MBR CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS END OTHERWISE DO IF &STR(&MEMBER) < &STR(&MBR) THEN + DO SEND '*** PDS MEMBER: "&MEMBER" IN DATASET: + "&DSN" HAS BEEN ADDED TO THE CONTROL FILE' U(&USER_TO_NOTIFY) LOGON SET CNTLNEW = &SUBSTR(001:050,+ &STR(&SYSNSUB(1,&OLDDATASET)+ &SPACE100))+ &SUBSTR(001:050,&STR(&SPACE100))+ &SUBSTR(001:080,+ &STR(&SYSNSUB(1,&STATISTICS)+ &SPACE100))+ PUTFILE CNTLNEW END IF &STR(&MEMBER) > &STR(&MBR) THEN + DO SEND '*** PDS MEMBER: "&MBR" IN DATASET: + "&DSN" HAS BEEN DELETED FROM THE PDS + ' AND THE CONTROL FILE.' + U(&USER_TO_NOTIFY) LOGON CONTROL NOMSG NOLIST NOCONLIST NOSYMLIST SYSCALL GET_ANOTHER_RECORD RCD CNTLFILE + DATASET GROUPS STATS + MESSAGE EOF DSN MBR CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS END END END ELSE + DO SEND '*** PDS MEMBER: "&MEMBER" IN DATASET: + "&OLDDATASET" HAS BEEN ADDED TO THE CONTROL FILE' U(&USER_TO_NOTIFY) LOGON SET CNTLNEW = &SUBSTR(001:050,+ &STR(&SYSNSUB(1,&OLDDATASET)+ &SPACE100))+ &SUBSTR(001:050,&STR(&SPACE100))+ &SUBSTR(001:080,+ &STR(&SYSNSUB(1,&STATISTICS)+ &SPACE100))+ PUTFILE CNTLNEW END END RETURN END ./ ADD NAME=CICSDSN /********************************************************************** /* UTILITY: CICSDSN * /* AUTHOR: DAVID LEIGH * /* FUNCTION: RETURN THE DATASET NAME ASSOCIATED WITH A CICS FILE NAME * /* OR ALL THE DATASETS ASSOCIATED WITH A PARTIAL CICS FILE * /* NAME. * /********************************************************************** PROC 1 CICS_FILE_NAME_TO_SCAN_FOR /* CICS FILE NAME OR PARTIAL NAME */ + LIBRARY(SYS4.CICS.V330.TABLES) /* LIBRARY CONTAINING FCT'S */ + AUDIT /* INDICATE THAT WE WANT TO AUDIT THE ACTUAL OUTPUT */ + BATCH /* INDICATE THAT WE ARE IN A BATCH ENVIRONMENT */ /*** CHECK THE DEBUG SWITCH ***/ ISPEXEC VGET DBGSWTCH PROFILE IF &DBGSWTCH = ON THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS SET FILE = &STR(&CICS_FILE_NAME_TO_SCAN_FOR) IF &STR(&FILE) = HELP THEN GOTO HELPSEC IF &STR(&FILE) = &STR(*ALL) THEN SET FILE = ISPEXEC VPUT FILE SHARED /********************************************************************** /* TELL THE USER YOU'RE PREPARING TO SCAN * /********************************************************************** IF &BATCH ¬= BATCH THEN + DO SET ZEDLMSG = &STR(*** PREPARING TO SCAN THE FCT ALC MACROS ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) END /********************************************************************** /* PREPARE FOR THE SCAN * /********************************************************************** FREE DD(NEWDD OUTDD SYSIN) ALLOC DD(NEWDD) DSN('&LIBRARY') SHR DELETE '&SYSUID..TEMP.CICSDSN.OUTDD' ALLOC DD(OUTDD) DSN('&SYSUID..TEMP.CICSDSN.OUTDD') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK$$$) + SPACE(1,1) CYLINDERS RELEASE + RECFM(F B) LRECL(132) BLKSIZE(23364) DSORG(PS) DELETE '&SYSUID..TEMP.CICSDSN.SYSIN' ALLOC DD(SYSIN) DSN('&SYSUID..TEMP.CICSDSN.SYSIN') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK$$$) + SPACE(1,1) TRACKS RELEASE + RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS) OPENFILE SYSIN OUTPUT SET SYSIN = &STR(SLIST OFF) PUTFILE SYSIN SET SYSOUTTRAP = 1000 PDS '&LIBRARY' FIND *FCT0 ' TITLE ' SET LINES = &SYSOUTLINE SET SYSOUTTRAP = 0 DO &I = 1 TO &LINES SET SYSDVAL = &STR(&SYSNSUB(2,&&SYSOUTLINE&I)) IF &SYSINDEX(&STR(** FIND ),&STR(&SYSDVAL)) > 0 THEN + DO SET MEMS = &MEMS + 1 READDVAL NULL1 NULL2 MEMBER SET MEMBER&MEMS = &STR(&MEMBER) SET SYSIN = &STR(SELECT &SYSNSUB(2,&&MEMBER&MEMS)) PUTFILE SYSIN SET I = &I + 1 SET SYSDVAL = &STR(&SYSNSUB(2,&&SYSOUTLINE&I)) READDVAL NULL1 NULL2 REGION SET REGION&MEMS = &STR(®ION) ISPEXEC VPUT (REGION&MEMS MEMBER&MEMS) END END ISPEXEC VPUT MEMS SHARED SET SYSIN = &STR(CMPCOLM 1:31) PUTFILE SYSIN SET SYSIN = &STR(LSTCOLM 16:71) PUTFILE SYSIN SET SYSIN = &STR(SRCHFOR ' DATASET=') PUTFILE SYSIN SET SYSIN = &STR(SRCHFOR ' DSNAME=') PUTFILE SYSIN CLOSFILE SYSIN /********************************************************************** /* TELL THE USER YOU'RE SCANNING * /********************************************************************** IF &BATCH ¬= BATCH THEN + DO SET ZEDLMSG = &STR(*** SCANNING THE FCT ALC MACROS ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) END /********************************************************************** /* SCAN AWAY! * /********************************************************************** ISPEXEC SELECT PGM(ISRSUPC) PARM(SRCHCMP IDPFX NOPRTCC) ISPEXEC LMINIT DATAID(DID) DDNAME(OUTDD) ISPEXEC EDIT DATAID(&DID) MACRO(CICSDSNM) FREE DD(NEWDD OUTDD SYSIN) EXIT HELPSEC: + ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR CICSDSN UTILITY + *** NO PROCESSING PERFORMED ***) ISPEXEC SETMSG MSG(UTLZ000) EXIT ./ ADD NAME=CICSDSNM ISREDIT MACRO ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT SET ZEDLMSG = &STR(*** FORMATTING THE REPORT FILE *** + THIS TAKES ABOUT 2 MINUTES ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) ISPEXEC VGET (FILE MEMS) SHARED ISREDIT EXCLUDE ALL P'#' 16 16 ISREDIT DELETE ALL NX ISREDIT RESET EXCLUDED ISREDIT EXCLUDE ALL ' DATASET=' ISREDIT CHANGE ALL P'=' ' ' 1 16 NX ISREDIT CHANGE ALL P'=' ' ' 9 16 ISREDIT CHANGE ALL 'DATASET=' '' ISREDIT CHANGE ALL 'DSNAME=' '' ISREDIT CHANGE ALL ',' '' ISREDIT EXCLUDE ALL P'¬' 1 ISREDIT CHANGE ' ' '³' 30 ALL X ISREDIT %B '³' ' ' 30 ISREDIT FIND FIRST '³' DO WHILE &LASTCC = 0 ISREDIT TFLOW .ZCSR 132 ISREDIT CHANGE FIRST '³' ' ' .ZCSR .ZCSR ISREDIT FIND NEXT '³' END IF &STR(&FILE) > THEN + DO SET ZEDLMSG = &STR(*** EXCLUDING NON-REQUESTED FILES ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) ISREDIT EXCLUDE ALL '&STR(&FILE)' 18 26 ISREDIT DELETE ALL NX END SET ZEDLMSG = &STR(*** INSERTING REGION NAMES ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) DO &I = 1 TO &MEMS ISPEXEC VGET (MEMBER&I REGION&I) SHARED SET MEMBER = &STR(&SYSNSUB(2,&&MEMBER&I) ) SET SYSDVAL = &STR(&SYSNSUB(2,&®ION&I) ) READDVAL REGION NULL SET REGION = &SUBSTR(1:10,&STR(®ION )) ISREDIT CHANGE ALL '&STR(&MEMBER)' '&STR(®ION)' 1 END ISREDIT LINE_BEFORE .ZFIRST = <1,'------' 19,'--------' 32,'-------'> ISREDIT LINE_BEFORE .ZFIRST = <1,'REGION' 19,'FILENAME' 32,'DATASET'> ISREDIT CURSOR = 1 1 EXIT ./ ADD NAME=CICSNEW ISREDIT MACRO ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ISREDIT (MEMBER) = MEMBER PDS 'D@UDAL.STR.LOADLIB' COPY &MEMBER 'SLSS.TST.LOAD' SHR REPLACE FREE DD(SYSLST BATCNTL SYSIPT) ALLOC DD(SYSLST) DSN(*) ALLOC DD(BATCNTL) DSN('CEMT.TST.BATCH.CONTROL') SHR ISPEXEC FTOPEN TEMP ISPEXEC FTINCL CICSNEW SET SAVECC = &LASTCC ISPEXEC FTCLOSE IF &SAVECC > 0 THEN + DO ISPEXEC VGET ZERRLM SET ZEDSMSG = &STR(SYSIN CREATION ERROR) SET ZEDLMSG = &STR(&ZERRLM) ISPEXEC SETMSG MSG(UTLZ001) GOTO FINISH END ELSE + DO ISPEXEC VGET ZTEMPF ALLOC DD(SYSIPT) DSN('&ZTEMPF') SHR END CALL 'CEMT.V4R7M0.LOADLIB(MTPBATCH)' FINISH: + FREE DD(SYSLST BATCNTL SYSIPT SYSPRINT SYSOUT INFILE OUTFILE SYSIN) ./ ADD NAME=CICSSEND SEND '*** BEGINNING OF CICSSEND PROCESSING ***' USER(D@UDAL) LOGON SEND '*** END OF CICSSEND PROCESSING ***' USER(D@UDAL) LOGON ./ ADD NAME=CLEANUP /* REXX */ /*===================================================================*/ /* */ /* UTILITY: CLEANUP */ /* */ /* AUTHOR: SYSTEMS ENGINEERING SERVICES, CORP */ /* */ /* FUNCTION: REXX EXEC TO CLEANUP SOME THE THE WORK FILES THAT */ /* WERE GENERATED. */ /* */ /* TO INVOKE: EXECUTED BY USRX0001 */ /* */ /* INPUT DATASETS: NONE */ /* */ /* OUTPUT DATASETS: NONE */ /* */ /* OTHER REQUIREMENTS: NONE */ /* */ /* CALLED BY: USRX0001 */ /* */ /* CHANGE LOG: */ /* 06/01/1996 SES ORIGINAL CODE AND TEST. */ /* */ /* 01/08/1999 MRB UPDATE TO UNIPAC STANDARDS. */ /* */ /*===================================================================*/ OUTPUT_LIB = 'P@UREX.TEST.OUTPUT' "DELETE '"OUTPUT_LIB"(PROGRAM2)'" "DELETE '"OUTPUT_LIB"(PGMFILE2)'" RETURN ./ ADD NAME=CLEARGDG PROC 0 DSN(&DSN) DELETE /*** CHECK THE DEBUG SWITCH ***/ ISPEXEC VGET DBGSWTCH PROFILE IF &DBGSWTCH = ON THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS %GDGGEN DSN(&DSN) ISPEXEC VGET (GEN LIMIT) SHARED IF &GEN = 0 THEN + IF &DELETE = DELETE THEN + DELETE '&DSN' GDG ELSE ELSE + DO DO &I = 1 TO &LIMIT ISPEXEC VGET NEXTGEN SHARED FREE DD(TEMPDD) ALLOC DD(TEMPDD) DSN('&NEXTGEN') NEW CATALOG + UNIT(SYSDA) SPACE(1,1) TRACKS + RECFM(F) LRECL(10) %GDGGEN DSN(&DSN) END ISPEXEC VGET GEN SHARED SET GEN = &GEN - 1 DO &I = 0 TO &GEN ISPEXEC VGET MINUS&I SHARED DELETE '&STR(&SYSNSUB(2,&&MINUS&I))' END IF &DELETE = DELETE THEN + DELETE '&DSN' GDG ELSE END EXIT ./ ADD NAME=CLIENTDB /* REXX ***************************************************************/ /* */ /**********************************************************************/ ADDRESS ISPEXEC 'CONTROL ERRORS RETURN' ADDRESS ISREDIT "MACRO" "(MEMBER) = MEMBER" MBRSFX = SUBSTR(MEMBER,6,2) "C ALL ' . ' '.'" "C ALL ' .' '.'" "C ALL '. ' '.'" "EXCLUDE ALL P'=' 1" SELECT WHEN MBRSFX = 'AE' THEN DO "CHANGE 'AESTRP00.CST15T' 'USSTRP00.CST15T' ALL" "CHANGE 'AESTRP00.LND01T' 'USSTRP00.LND01T' ALL" "CHANGE 'AESTRP00.GNT01T' 'USSTRP00.GNT01T' ALL" "CHANGE 'AESTRP00.SCH01T' 'USSTRP00.SCH01T' ALL" END WHEN MBRSFX = 'AH' THEN DO "CHANGE 'AESTRP00.CST15T' 'USSTRP00.CST15T' ALL" "CHANGE 'AESTRP00.LND01T' 'USSTRP00.LND01T' ALL" "CHANGE 'AESTRP00.GNT01T' 'USSTRP00.GNT01T' ALL" "CHANGE 'AESTRP00.SCH01T' 'USSTRP00.SCH01T' ALL" END WHEN MBRSFX = 'CS' THEN DO "CHANGE 'AESTRP00.CST15T' 'USSTRP00.CST15T' ALL" "CHANGE 'AESTRP00.LND01T' 'USSTRP00.LND01T' ALL" "CHANGE 'AESTRP00.GNT01T' 'USSTRP00.GNT01T' ALL" "CHANGE 'AESTRP00.SCH01T' 'USSTRP00.SCH01T' ALL" END WHEN MBRSFX = 'FA' THEN DO "CHANGE 'AESTRP00.CST15T' 'USSTRP00.CST15T' ALL" "CHANGE 'AESTRP00.LND01T' 'USSTRP00.LND01T' ALL" "CHANGE 'AESTRP00.GNT01T' 'USSTRP00.GNT01T' ALL" "CHANGE 'AESTRP00.SCH01T' 'USSTRP00.SCH01T' ALL" END WHEN MBRSFX = 'GE' THEN DO "CHANGE 'AESTRP00.CST15T' 'USSTRP00.CST15T' ALL" "CHANGE 'AESTRP00.LND01T' 'USSTRP00.LND01T' ALL" "CHANGE 'AESTRP00.GNT01T' 'USSTRP00.GNT01T' ALL" "CHANGE 'AESTRP00.SCH01T' 'USSTRP00.SCH01T' ALL" END WHEN MBRSFX = 'KC' THEN DO "CHANGE 'AESTRP00.CST15T' 'USSTRP00.CST15T' ALL" "CHANGE 'AESTRP00.LND01T' 'USSTRP00.LND01T' ALL" "CHANGE 'AESTRP00.GNT01T' 'USSTRP00.GNT01T' ALL" "CHANGE 'AESTRP00.SCH01T' 'USSTRP00.SCH01T' ALL" END WHEN MBRSFX = 'LI' THEN DO "CHANGE 'AESTRP00.CST15T' 'USSTRP00.CST15T' ALL" "CHANGE 'AESTRP00.LND01T' 'USSTRP00.LND01T' ALL" "CHANGE 'AESTRP00.GNT01T' 'USSTRP00.GNT01T' ALL" "CHANGE 'AESTRP00.SCH01T' 'USSTRP00.SCH01T' ALL" END WHEN MBRSFX = 'NH' THEN DO "CHANGE 'AESTRP00.CST15T' 'USSTRP00.CST15T' ALL" "CHANGE 'AESTRP00.LND01T' 'USSTRP00.LND01T' ALL" "CHANGE 'AESTRP00.GNT01T' 'USSTRP00.GNT01T' ALL" "CHANGE 'AESTRP00.SCH01T' 'USSTRP00.SCH01T' ALL" END WHEN MBRSFX = 'NT' THEN DO "CHANGE 'AESTRP00.CST15T' 'USSTRP00.CST15T' ALL" "CHANGE 'AESTRP00.LND01T' 'USSTRP00.LND01T' ALL" "CHANGE 'AESTRP00.GNT01T' 'USSTRP00.GNT01T' ALL" "CHANGE 'AESTRP00.SCH01T' 'USSTRP00.SCH01T' ALL" END WHEN MBRSFX = 'OK' THEN DO "CHANGE 'AESTRP00.CST15T' 'USSTRP00.CST15T' ALL" "CHANGE 'AESTRP00.LND01T' 'USSTRP00.LND01T' ALL" "CHANGE 'AESTRP00.GNT01T' 'USSTRP00.GNT01T' ALL" "CHANGE 'AESTRP00.SCH01T' 'USSTRP00.SCH01T' ALL" END WHEN MBRSFX = 'SP' THEN DO "CHANGE 'AESTRP00.CST15T' 'USSTRP00.CST15T' ALL" "CHANGE 'AESTRP00.LND01T' 'USSTRP00.LND01T' ALL" "CHANGE 'AESTRP00.GNT01T' 'USSTRP00.GNT01T' ALL" "CHANGE 'AESTRP00.SCH01T' 'USSTRP00.SCH01T' ALL" END WHEN MBRSFX = 'RI' THEN DO "CHANGE 'AESTRP00.CST15T' 'USSTRP00.CST15T' ALL" "CHANGE 'AESTRP00.LND01T' 'USSTRP00.LND01T' ALL" "CHANGE 'AESTRP00.GNT01T' 'USSTRP00.GNT01T' ALL" "CHANGE 'AESTRP00.SCH01T' 'USSTRP00.SCH01T' ALL" END WHEN MBRSFX = 'UF' THEN DO "CHANGE 'AESTRP00.CST15T' 'USSTRP00.CST15T' ALL" "CHANGE 'AESTRP00.LND01T' 'USSTRP00.LND01T' ALL" "CHANGE 'AESTRP00.GNT01T' 'USSTRP00.GNT01T' ALL" "CHANGE 'AESTRP00.SCH01T' 'USSTRP00.SCH01T' ALL" END WHEN MBRSFX = 'US' THEN DO "CHANGE 'AESTRP00.CST15T' 'USSTRP00.CST15T' ALL" "CHANGE 'AESTRP00.LND01T' 'USSTRP00.LND01T' ALL" "CHANGE 'AESTRP00.GNT01T' 'USSTRP00.GNT01T' ALL" "CHANGE 'AESTRP00.SCH01T' 'USSTRP00.SCH01T' ALL" END WHEN MBRSFX = 'VS' THEN DO "CHANGE 'AESTRP00.CST15T' 'USSTRP00.CST15T' ALL" "CHANGE 'AESTRP00.LND01T' 'USSTRP00.LND01T' ALL" "CHANGE 'AESTRP00.GNT01T' 'USSTRP00.GNT01T' ALL" "CHANGE 'AESTRP00.SCH01T' 'USSTRP00.SCH01T' ALL" END WHEN MBRSFX = 'WS' THEN DO "CHANGE 'AESTRP00.CST15T' 'USSTRP00.CST15T' ALL" "CHANGE 'AESTRP00.LND01T' 'USSTRP00.LND01T' ALL" "CHANGE 'AESTRP00.GNT01T' 'USSTRP00.GNT01T' ALL" "CHANGE 'AESTRP00.SCH01T' 'USSTRP00.SCH01T' ALL" END OTHERWISE NOP END "UP MAX" EXIT ./ ADD NAME=CLIGUIDE ISREDIT MACRO ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ISREDIT FIND FIRST P'=' 1 DO WHILE &LASTCC = 0 ISREDIT SHIFT ) .ZCSR 1 ISREDIT FIND NEXT P'=' 1 END ISREDIT FIND LAST ' REVISED ' 1 ISREDIT RFIND DO WHILE &LASTCC = 0 ISREDIT LINE_AFTER .ZCSR = '1' ISREDIT RFIND END ISREDIT LINE_BEFORE .ZFIRST = '1' ./ ADD NAME=CLISTDAT CLEAR WRITE &STR(SYSDATE: &SYSDATE) WRITE &STR(SYSSDATE: &SYSSDATE) WRITE &STR(SYSJDATE: &SYSJDATE) WRITE &STR(SYS4DATE: &SYS4DATE) WRITE &STR(SYS4SDATE: &SYS4SDATE) WRITE &STR(SYS4JDATE: &SYS4JDATE) WRITE &STR(SYSTIME: &SYSTIME) WRITE &STR(SYSSTIME: &SYSSTIME) ./ ADD NAME=CMAPPEND PROC 1 UTILITY CMPDSN(D@UDAL.STR.WRKLIB(CHISOFT)) /*** CHECK THE DEBUG SWITCH ***/ ISPEXEC VGET DBGSWTCH PROFILE IF &DBGSWTCH = ON THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS /*********************************************************************/ /** FIRST, GET THE USER'S ACCOUNTING INFORMATION AND NAME AND THEN **/ /** MAKE SURE THE UTILITY NAME IS 8 BYTES LONG. **/ /*********************************************************************/ CALL 'SYS2.LINKLIB(USERINFO)' '&SYSUID ' ISPEXEC VGET (BINNM CCNTR) PROFILE SET UTILITY = &STR(&SYSPREF..TEMP.COMPONEN.&UTILITY) /*********************************************************************/ /** SUBMIT THE JOB TO DO THE UPDATE. **/ /*********************************************************************/ SUBMIT * END (@@) //&SYSUID.C JOB (&CCNTR,&BINNM,A00000,O),'&SYSUID LOG',MSGCLASS=X, // CLASS=V,TIME=(0,05) //****************************************************************** //* APPEND THE MEMBER * //****************************************************************** //LOG EXEC PGM=IEBGENER //SYSUT1 DD DSN=&CMPDSN, // DISP=(SHR,KEEP,KEEP) // DD DSN=&UTILITY, // DISP=(SHR,KEEP,KEEP) //SYSUT2 DD DSN=&CMPDSN, // DISP=(SHR,KEEP,KEEP) //SYSPRINT DD SYSOUT=* //SYSIN DD DUMMY // @@ EXIT ./ ADD NAME=CMMKCOB ISREDIT MACRO ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /********************************************************************** /* UTILITY: CMMKCOB * /* AUTHOR: DAVID LEIGH * /* FUNCTION: CALLED BY THE COMPMARK EDIT MACRO AS AN INITIAL EDIT * /* MACRO TO PROCESS A COBOL COMPILE LISTING FOR MESSAGES. * /********************************************************************** WRITE **************************************************************** WRITE * COMPMARK NOT SET UP FOR VS COBOL AT UNIPAC YET * WRITE **************************************************************** ISREDIT CANCEL EXIT ISREDIT (LRECL) = LRECL SET CMNUMINF = 0 SET CMNUMWAR = 0 SET CMNUMERR = 0 SET CMNUMSEV = 0 /******************************************************************/ /* GATHER ERRORS AT THE BOTTOM OF THE LISTING SECTION. */ /******************************************************************/ NEXTSEC: + ISREDIT FIND FIRST 'LINEID MESSAGE CODE MESSAGE TEXT ' 2 ISREDIT EXCLUDE ALL .ZCSR .ZLAST ISREDIT CHANGE ''' '"' ALL X ISREDIT FIND FIRST 'LINEID MESSAGE CODE MESSAGE TEXT ' 2 ISREDIT EXCLUDE ALL .ZCSR .ZLAST ISREDIT CHANGE '""' '"' ALL X ISREDIT FIND FIRST 'LINEID MESSAGE CODE MESSAGE TEXT ' 2 ISREDIT LABEL .ZCSR = .MSGA ISREDIT FIND NEXT 'TOTAL MESSAGES INFORMATIONAL WARNING' 2 ISREDIT LABEL .ZCSR = .MSGB ISREDIT FIND FIRST P'# ' 7 .MSGA .MSGB DO WHILE &LASTCC = 0 ISREDIT CHANGE ' ' '0' 2 6 ALL .ZCSR .ZCSR ISREDIT FIND LAST P'¬' .ZCSR .ZCSR ISREDIT (LN,CL) = CURSOR ISREDIT (DLINE) = LINE .ZCSR SET X = &SUBSTR(20:20,&STR(&SYSNSUB(1,&DLINE))) SELECT (&X) WHEN (I) DO SET TYPE = I SET CMNUMINF = &CMNUMINF + 1 SET Y = &CMNUMINF END WHEN (W) DO SET TYPE = W SET CMNUMWAR = &CMNUMWAR + 1 SET Y = &CMNUMWAR END WHEN (E) DO SET TYPE = E SET CMNUMERR = &CMNUMERR + 1 SET Y = &CMNUMERR END WHEN (S) DO SET TYPE = S SET CMNUMSEV = &CMNUMSEV + 1 SET Y = &CMNUMSEV END END SET Y = &SUBSTR(&LENGTH(&STR(000&Y))-3:&LENGTH(&STR(000&Y)),+ &STR(000&Y)) SET CM&TYPE&Y.M = &SUBSTR(24:&CL,&STR(&SYSNSUB(1,&DLINE))) SET LINENUM = &SUBSTR(2:7,&STR(&SYSNSUB(1,&DLINE))) ISREDIT FIND NEXT P'=' 1 ISREDIT FIND NEXT P' ¬' 20 .ZCSR .ZCSR DO WHILE &LASTCC = 0 ISREDIT FIND LAST P'¬' .ZCSR .ZCSR ISREDIT (LN1,CL1) = CURSOR ISREDIT (DLINE) = LINE .ZCSR SET A = &STR(&&CM&TYPE&Y.M) SET CM&TYPE&Y.M = &STR(&A)+ &SUBSTR(23:&CL1,&STR(&SYSNSUB(1,&DLINE))) ISREDIT FIND NEXT P'=' 1 ISREDIT FIND NEXT P' ¬' 20 .ZCSR .ZCSR END SET XTEMP = &&CM&TYPE&Y.M SET LASTMSG = &STR(&XTEMP) ISREDIT (SLN,SCL) = CURSOR SET PGMLINE = SET OCCURANCE = SYSCALL FIND_LINE LINENUM PGMLINE OCCURANCE SET CM&TYPE&Y.L = &STR(&SYSNSUB(1,&PGMLINE)) SET CM&TYPE&Y.O = &STR(&SYSNSUB(1,&OCCURANCE)) ISPEXEC VPUT (CM&TYPE&Y.M CM&TYPE&Y.L CM&TYPE&Y.O) SHARED ISREDIT CURSOR = &SLN &SCL ISREDIT FIND NEXT P'=' 1 ISREDIT FIND NEXT ' SAME MESSAGE ON LINE: ' 20 .ZCSR .ZCSR DO WHILE &LASTCC = 0 ISREDIT FIND NEXT P'# ' .ZCSR .ZCSR 51 130 DO WHILE &LASTCC = 0 ISREDIT (LN3,CL3) = CURSOR ISREDIT CHANGE ' ' '0' + &EVAL(&CL3-5) &CL3 ALL .ZCSR .ZCSR ISREDIT (DLINE) = LINE .ZCSR SET LINENUM = &SUBSTR(&EVAL(&CL3-5):&CL3,+ &STR(&SYSNSUB(1,&DLINE))) SELECT (&X) WHEN (I) DO SET TYPE = I SET CMNUMINF = &CMNUMINF + 1 SET Y = &CMNUMINF END WHEN (W) DO SET TYPE = W SET CMNUMWAR = &CMNUMWAR + 1 SET Y = &CMNUMWAR END WHEN (E) DO SET TYPE = E SET CMNUMERR = &CMNUMERR + 1 SET Y = &CMNUMERR END WHEN (S) DO SET TYPE = S SET CMNUMSEV = &CMNUMSEV + 1 SET Y = &CMNUMSEV END END SET Y = &SUBSTR(&LENGTH(&STR(000&Y))-3:+ &LENGTH(&STR(000&Y)),+ &STR(000&Y)) SET CM&TYPE&Y.M = &STR(&SYSNSUB(1,&LASTMSG)) ISREDIT (SLN,SCL) = CURSOR SET PGMLINE = SET OCCURANCE = SYSCALL FIND_LINE LINENUM PGMLINE OCCURANCE SET CM&TYPE&Y.L = &STR(&SYSNSUB(1,&PGMLINE)) SET CM&TYPE&Y.O = &STR(&SYSNSUB(1,&OCCURANCE)) ISPEXEC VPUT (CM&TYPE&Y.M CM&TYPE&Y.L CM&TYPE&Y.O) SHARED ISREDIT CURSOR = &SLN &SCL ISREDIT FIND NEXT P'# ' .ZCSR .ZCSR 51 130 ISREDIT FIND NEXT P'# ' .ZCSR .ZCSR 51 130 END ISREDIT FIND NEXT P'=' 1 ISREDIT FIND NEXT P' ' + 2 .ZCSR .ZCSR END ISREDIT CURSOR = &LN &CL ISREDIT FIND NEXT P'# ' 7 .MSGA .MSGB END IF &CMNUMINF = 0 AND + &CMNUMWAR = 0 AND + &CMNUMERR = 0 AND + &CMNUMSEV = 0 THEN + DO ISPEXEC VPUT (CMNUMINF CMNUMWAR CMNUMERR CMNUMSEV) SHARED GOTO FINAL END SET ZWINTTL = &STR(UNIPAC UTILITIES - COMPMARK FUNCTION) ISPEXEC ADDPOP ROW(10) COLUMN(12) /*PEXEC CONTROL DISPLAY SAVE /* FIXPOP */ ISPEXEC DISPLAY PANEL(COMPMARK) ISPEXEC REMPOP /*PEXEC CONTROL DISPLAY RESTORE /* FIXPOP */ FINAL: + ISREDIT CANCEL EXIT /********************************************************************** /* ACTUALLY FIND THE LINE IN THE CODE SECTION OF THE LISTING * /********************************************************************** FIND_LINE: PROC 3 LINENUM PGMLINE OCCURANCE SYSREF LINENUM PGMLINE OCCURANCE ISREDIT FIND FIRST ' &LINENUM ' 3 ISREDIT (PGMLINE) = LINE .ZCSR ISREDIT (SAVENUM) = LINENUM .ZCSR SET PGMLINE = &SUBSTR(19:84,&STR(&SYSNSUB(1,&PGMLINE))) IF &SYSINDEX(&STR('),&SYSNSUB(1,&DLINE)) > 0 THEN + IF &SYSINDEX(&STR("),&SYSNSUB(1,&DLINE)) > 0 THEN + SET PGMLINE = &STR(LISTING SOURCE SEQUENCE NUMBER: )+ &SUBSTR(12:17,&STR(&SYSNSUB(1,&PGMLINE))) ELSE + SET QT = &STR(") ELSE + SET QT = &STR(') SET OCCURANCE = 0 ISREDIT FIND FIRST &QT&SYSNSUB(1,&PGMLINE)&QT 18 SET FINDCC = &LASTCC ISREDIT (X) = LINENUM .ZCSR DO WHILE &FINDCC = 0 SET OCCURANCE = &OCCURANCE + 1 ISREDIT FIND NEXT &QT&SYSNSUB(1,&PGMLINE)&QT 18 SET FINDCC = &LASTCC IF &X > &SAVENUM THEN + DO SET FINDCC = 8 SET OCCURANCE = &OCCURANCE - 1 END ISREDIT (X) = LINENUM .ZCSR END RETURN END ./ ADD NAME=CMMKCOB2 ISREDIT MACRO ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /********************************************************************** /* UTILITY: CMMKCOB2 * /* AUTHOR: DAVID LEIGH * /* FUNCTION: CALLED BY THE COMPMARK EDIT MACRO AS AN INITIAL EDIT * /* MACRO TO PROCESS A COBOL2 COMPILE LISTING FOR MESSAGES. * /********************************************************************** ISREDIT (LRECL) = LRECL SET CMNUMINF = 0 SET CMNUMWAR = 0 SET CMNUMERR = 0 SET CMNUMSEV = 0 SET CMNUMUNA = 0 /******************************************************************/ /* GATHER ERRORS AT THE BOTTOM OF THE LISTING SECTION. */ /******************************************************************/ NEXTSEC: + ISREDIT FIND FIRST 'LINEID MESSAGE CODE MESSAGE TEXT ' 2 ISREDIT EXCLUDE ALL .ZCSR .ZLAST ISREDIT CHANGE ''' '"' ALL X ISREDIT FIND FIRST 'LINEID MESSAGE CODE MESSAGE TEXT ' 2 ISREDIT EXCLUDE ALL .ZCSR .ZLAST ISREDIT CHANGE '""' '"' ALL X ISREDIT FIND FIRST 'LINEID MESSAGE CODE MESSAGE TEXT ' 2 ISREDIT LABEL .ZCSR = .MSGA ISREDIT FIND NEXT 'MESSAGES TOTAL INFORMATIONAL WARNING ' 2 ISREDIT LABEL .ZCSR = .MSGB ISREDIT FIND FIRST P'# ' 7 .MSGA .MSGB DO WHILE &LASTCC = 0 ISREDIT CHANGE ' ' '0' 2 6 ALL .ZCSR .ZCSR ISREDIT FIND LAST P'¬' .ZCSR .ZCSR ISREDIT (LN,CL) = CURSOR ISREDIT (DLINE) = LINE .ZCSR SET X = &SUBSTR(20:20,&STR(&SYSNSUB(1,&DLINE))) SELECT (&X) WHEN (I) DO SET TYPE = I SET CMNUMINF = &CMNUMINF + 1 SET Y = &CMNUMINF END WHEN (W) DO SET TYPE = W SET CMNUMWAR = &CMNUMWAR + 1 SET Y = &CMNUMWAR END WHEN (E) DO SET TYPE = E SET CMNUMERR = &CMNUMERR + 1 SET Y = &CMNUMERR END WHEN (S) DO SET TYPE = S SET CMNUMSEV = &CMNUMSEV + 1 SET Y = &CMNUMSEV END WHEN (U) DO SET TYPE = U SET CMNUMUNA = &CMNUMUNA + 1 SET Y = &CMNUMUNA END END SET Y = &SUBSTR(&LENGTH(&STR(000&Y))-3:&LENGTH(&STR(000&Y)),+ &STR(000&Y)) SET CM&TYPE&Y.M = &SUBSTR(24:&CL,&STR(&SYSNSUB(1,&DLINE))) SET LINENUM = &SUBSTR(2:7,&STR(&SYSNSUB(1,&DLINE))) ISREDIT FIND NEXT P'=' 1 ISREDIT FIND NEXT P' ¬' 20 .ZCSR .ZCSR DO WHILE &LASTCC = 0 ISREDIT FIND LAST P'¬' .ZCSR .ZCSR ISREDIT (LN1,CL1) = CURSOR ISREDIT (DLINE) = LINE .ZCSR SET A = &STR(&&CM&TYPE&Y.M) SET CM&TYPE&Y.M = &STR(&A)+ &SUBSTR(23:&CL1,&STR(&SYSNSUB(1,&DLINE))) ISREDIT FIND NEXT P'=' 1 ISREDIT FIND NEXT P' ¬' 20 .ZCSR .ZCSR END SET XTEMP = &&CM&TYPE&Y.M SET LASTMSG = &STR(&XTEMP) ISREDIT (SLN,SCL) = CURSOR SET PGMLINE = SET OCCURANCE = SYSCALL FIND_LINE LINENUM PGMLINE OCCURANCE SET CM&TYPE&Y.L = &STR(&SYSNSUB(1,&PGMLINE)) SET CM&TYPE&Y.O = &STR(&SYSNSUB(1,&OCCURANCE)) ISPEXEC VPUT (CM&TYPE&Y.M CM&TYPE&Y.L CM&TYPE&Y.O) SHARED ISREDIT CURSOR = &SLN &SCL ISREDIT FIND NEXT P'=' 1 ISREDIT FIND NEXT ' SAME MESSAGE ON LINE: ' 20 .ZCSR .ZCSR DO WHILE &LASTCC = 0 ISREDIT FIND NEXT P'# ' .ZCSR .ZCSR 51 130 DO WHILE &LASTCC = 0 ISREDIT (LN3,CL3) = CURSOR ISREDIT CHANGE ' ' '0' + &EVAL(&CL3-5) &CL3 ALL .ZCSR .ZCSR ISREDIT (DLINE) = LINE .ZCSR SET LINENUM = &SUBSTR(&EVAL(&CL3-5):&CL3,+ &STR(&SYSNSUB(1,&DLINE))) SELECT (&X) WHEN (I) DO SET TYPE = I SET CMNUMINF = &CMNUMINF + 1 SET Y = &CMNUMINF END WHEN (W) DO SET TYPE = W SET CMNUMWAR = &CMNUMWAR + 1 SET Y = &CMNUMWAR END WHEN (E) DO SET TYPE = E SET CMNUMERR = &CMNUMERR + 1 SET Y = &CMNUMERR END WHEN (S) DO SET TYPE = S SET CMNUMSEV = &CMNUMSEV + 1 SET Y = &CMNUMSEV END WHEN (U) DO SET TYPE = U SET CMNUMUNA = &CMNUMUNA + 1 SET Y = &CMNUMUNA END END SET Y = &SUBSTR(&LENGTH(&STR(000&Y))-3:+ &LENGTH(&STR(000&Y)),+ &STR(000&Y)) SET CM&TYPE&Y.M = &STR(&SYSNSUB(1,&LASTMSG)) ISREDIT (SLN,SCL) = CURSOR SET PGMLINE = SET OCCURANCE = SYSCALL FIND_LINE LINENUM PGMLINE OCCURANCE SET CM&TYPE&Y.L = &STR(&SYSNSUB(1,&PGMLINE)) SET CM&TYPE&Y.O = &STR(&SYSNSUB(1,&OCCURANCE)) ISPEXEC VPUT (CM&TYPE&Y.M CM&TYPE&Y.L CM&TYPE&Y.O) SHARED ISREDIT CURSOR = &SLN &SCL ISREDIT FIND NEXT P'# ' .ZCSR .ZCSR 51 130 ISREDIT FIND NEXT P'# ' .ZCSR .ZCSR 51 130 END ISREDIT FIND NEXT P'=' 1 ISREDIT FIND NEXT P' ' + 2 .ZCSR .ZCSR END ISREDIT CURSOR = &LN &CL ISREDIT FIND NEXT P'# ' 7 .MSGA .MSGB END IF &CMNUMINF = 0 AND + &CMNUMWAR = 0 AND + &CMNUMERR = 0 AND + &CMNUMSEV = 0 AND + &CMNUMUNA = 0 THEN + DO ISPEXEC VPUT (CMNUMINF CMNUMWAR CMNUMERR CMNUMSEV + CMNUMUNA) SHARED GOTO FINAL END SET ZWINTTL = &STR(UNIPAC UTILITIES - COMPMARK FUNCTION) ISPEXEC ADDPOP ROW(07) COLUMN(12) /*PEXEC CONTROL DISPLAY SAVE /* FIXPOP */ ISPEXEC DISPLAY PANEL(COMPMARK) ISPEXEC REMPOP /*PEXEC CONTROL DISPLAY RESTORE /* FIXPOP */ FINAL: + ISREDIT CANCEL EXIT /********************************************************************** /* ACTUALLY FIND THE LINE IN THE CODE SECTION OF THE LISTING * /********************************************************************** FIND_LINE: PROC 3 LINENUM PGMLINE OCCURANCE SYSREF LINENUM PGMLINE OCCURANCE ISREDIT FIND FIRST ' &LINENUM ' 3 ISREDIT (PGMLINE) = LINE .ZCSR ISREDIT (SAVENUM) = LINENUM .ZCSR SET PGMLINE = &SUBSTR(19:89,&STR(&SYSNSUB(1,&PGMLINE))) IF &SYSINDEX(&STR('),&SYSNSUB(1,&DLINE)) > 0 THEN + IF &SYSINDEX(&STR("),&SYSNSUB(1,&DLINE)) > 0 THEN + SET PGMLINE = &STR(LISTING SOURCE SEQUENCE NUMBER: )+ &SUBSTR(12:17,&STR(&SYSNSUB(1,&PGMLINE))) ELSE + SET QT = &STR(") ELSE + SET QT = &STR(') SET OCCURANCE = 0 ISREDIT FIND FIRST &QT&SYSNSUB(1,&PGMLINE)&QT 19 SET FINDCC = &LASTCC ISREDIT (X) = LINENUM .ZCSR DO WHILE &FINDCC = 0 SET OCCURANCE = &OCCURANCE + 1 ISREDIT FIND NEXT &QT&SYSNSUB(1,&PGMLINE)&QT 19 SET FINDCC = &LASTCC IF &X > &SAVENUM THEN + DO SET FINDCC = 8 SET OCCURANCE = &OCCURANCE - 1 END ISREDIT (X) = LINENUM .ZCSR END RETURN END ./ ADD NAME=CMP PROC 0 HELP /**************************************************** 00010000 /* FUNCTION: CMP * 00020000 /* * 00030000 /* DESCRIPTION: COMPARE TWO CHANGED AGAINST BASE * 00040000 /* * 00050000 /* INPUTS: NONE * 00060001 /* * 00070001 /* OUTPUTS: NONE * 00080001 /* * 00090001 /* NOTES: NONE * 00100001 /******************* Modifications ****************** 00110001 /* 08/31/92 By: David Leigh * 00090001 /* I added a call to UTILLOG at the * 00090001 /* beginning and I added code to allow * 00090001 /* people with no TSO PROFILE PREFIX to * 00090001 /* use CMP. I looked into changing each * 00090001 /* dataset reference to use an explicit * 00090001 /* SYSUID prefix, but that looked more * 00090001 /* complex at first glance than I wanted to* 00090001 /* get. The problem with this method is * 00090001 /* that if CMP bombs and the prefix had * 00090001 /* been changed just for CMP, it would * 00090001 /* remain changed and the person would be * 00090001 /* screwed up! * 00090001 /* 06/19/95 By: David Leigh * 00090001 /* In the event of an IEBUPDTE bad return * 00090001 /* code CMP will now edit the SYSPRINT * 00090001 /* dataset and then exit the CLIST. This * 00090001 /* was added to both IEBUPDTE calls. * 00090001 /**************************************************** 00110001 ISPEXEC CONTROL ERRORS RETURN ISPEXEC VGET (DBGSWTCH) PROFILE IF &DBGSWTCH = &STR(ON) THEN CONTROL MSG LIST CONLIST SYMLIST NOFLUSH ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /********************************************************************** /* DISPLAY HELP IF REQUESTED * /********************************************************************** IF &HELP = HELP THEN GOTO HELPSEC /********************************************************************** /* Adjust for users who have PROFILE NOPREFIX in their logon * /********************************************************************** SET CMPPREF = &SYSPREF IF &STR(&CMPPREF) = THEN PROFILE PREFIX(&SYSUID) SET &CRSR = MEMBER SET &INIT = NO SET &RC = OK TOP: + ISPEXEC DISPLAY PANEL(cmp) CURSOR(&CRSR) 00130001 IF &LASTCC>7 THEN + GOTO EXIT SET &USER1DS=&STR('&USER1(&MEMBER)') SET &USER2DS=&STR('&USER2(&MEMBER)') SET &BASEDS=&STR('&BASE(&MEMBER)') IF &INIT = NO THEN GOTO INITIAL /******************************************************* /* COMPARE USERDS1 WITH BASE * /******************************************************* POSTINI: + ISPEXEC CONTROL DISPLAY LOCK SET CMPLMSG=&STR( *** Comparing &user1ds to &baseds ***) ISPEXEC DISPLAY MSG(CMPC000M) FREE DD(SYSUT1 SYSUT2 SYSUT3 SYSIN SYSPRINT SYSOUT) SET &cRSR=BASE SYSCALL OPEN &SYSODS &sysout_dd &DISPMOD RC IF &STR(&RC) NE OK THEN GOTO ALLOCER OPENFILE &SYSOUT_DD OUTPUT SET &SYSOUT = &STR( ***) PUTFILE SYSOUT SET &SYSOUT = &STR( *** &CMPLMSG) PUTFILE SYSOUT SET &SYSOUT = &STR( ***) PUTFILE SYSOUT CLOSFILE SYSOUT SYSCALL OPEN &SYSPRT &sysprint_dd &DISPMOD RC IF &STR(&RC) NE OK THEN GOTO ALLOCER OPENFILE &SYSPRINT_DD OUTPUT SET &SYSPRINT = &STR( ***) PUTFILE SYSPRINT SET &SYSPRINT = &STR( *** &CMPLMSG) PUTFILE SYSPRINT SET &SYSPRINT = &STR( ***) PUTFILE SYSPRINT CLOSFILE SYSPRINT ALLOC DSN(&DELTA1) DD(&SYSUT3) SHR IF &LASTCC > 7 THEN + DO SET &RC = &STR(*** Unable to allocate &DELTA1 ***) GOTO ALLOCER END SYSCALL OPEN &BASEDS &SYSUT1 &DISPSHR RC IF &STR(&RC) NE OK THEN GOTO ALLOCER SYSCALL OPEN &CARDFILE &SYSIN &DISPSHR RC IF &STR(&RC) NE OK THEN GOTO ALLOCER SET &CRSR=USER1 SYSCALL OPEN &USER1DS &SYSUT2 &DISPSHR RC IF &STR(&RC) NE OK THEN GOTO ALLOCER CALL 'SYS3.COMPAREX.PROD.LOADLIB(COMPAREX)' /******** COMPARE **/ FREE DD(SYSUT1 SYSUT2 SYSUT3 SYSIN SYSPRINT SYSOUT) /******************************************************* /* COMPARE USERDS2 WITH BASE * /******************************************************* ISPEXEC CONTROL DISPLAY LOCK SET CMPLMSG=&STR( *** Comparing &user2ds to &baseds ***) ISPEXEC DISPLAY MSG(CMPC000M) FREE DD(SYSUT1 SYSUT2 SYSUT3 SYSIN SYSPRINT SYSOUT) SET &cRSR=BASE SYSCALL OPEN &SYSODS &sysout_dd &DISPMOD RC IF &STR(&RC) NE OK THEN GOTO ALLOCER OPENFILE &SYSOUT_DD OUTPUT SET &SYSOUT = &STR( ***) PUTFILE SYSOUT SET &SYSOUT = &STR(&CMPLMSG) PUTFILE SYSOUT SET &SYSOUT = &STR( ***) PUTFILE SYSOUT CLOSFILE SYSOUT SYSCALL OPEN &SYSPRT &sysprint_dd &DISPMOD RC IF &STR(&RC) NE OK THEN GOTO ALLOCER OPENFILE &SYSPRINT_DD OUTPUT SET &SYSPRINT = &STR( ***) PUTFILE SYSPRINT SET &SYSPRINT = &STR(&CMPLMSG) PUTFILE SYSPRINT SET &SYSPRINT = &STR( ***) PUTFILE SYSPRINT CLOSFILE SYSPRINT ALLOC DSN(&DELTA2) DD(&SYSUT3) SHR IF &LASTCC > 7 THEN + DO SET &RC = &STR(*** Unable to allocate &DELTA2 ***) GOTO ALLOCER END SYSCALL OPEN &BASEDS &SYSUT1 &DISPSHR RC IF &STR(&RC) NE OK THEN GOTO ALLOCER SYSCALL OPEN &CARDFILE &SYSIN &DISPSHR RC IF &STR(&RC) NE OK THEN GOTO ALLOCER SET &CRSR=USER2 SYSCALL OPEN &USER2DS &SYSUT2 &DISPSHR RC IF &STR(&RC) NE OK THEN GOTO ALLOCER CALL 'SYS3.COMPAREX.PROD.LOADLIB(COMPAREX)' /******** COMPARE **/ FREE DD(SYSUT1 SYSUT2 SYSUT3 SYSIN SYSPRINT SYSOUT) /******************************************************* /* APPLY first set of changes * /******************************************************* ISPEXEC CONTROL DISPLAY LOCK SET CMPLMSG=&STR( *** Applying &user1ds updates to temp file ***) ISPEXEC DISPLAY MSG(CMPC000M) FREE DD(SYSUT1 SYSUT2 SYSUT3 SYSIN SYSPRINT SYSOUT) SET &CRSR=BASE SYSCALL OPEN &SYSODS &sysout_dd &DISPMOD RC IF &STR(&RC) NE OK THEN GOTO ALLOCER OPENFILE &SYSOUT_DD OUTPUT SET &SYSOUT = &STR( ***) PUTFILE SYSOUT SET &SYSOUT = &STR(&CMPLMSG) PUTFILE SYSOUT SET &SYSOUT = &STR( ***) PUTFILE SYSOUT CLOSFILE SYSOUT SYSCALL OPEN &SYSPRT_UP &SYSPRINT_DD &DISPMOD RC IF &STR(&RC) NE OK THEN GOTO ALLOCER SYSCALL OPEN &DELTA1 &SYSIN &DISPSHR RC IF &STR(&RC) NE OK THEN GOTO ALLOCER SYSCALL OPEN &BASEDS &SYSUT1 &DISPSHR RC IF &STR(&RC) NE OK THEN GOTO ALLOCER SYSCALL OPEN &UPDATEDS &SYSUT2 &DISPSHR RC IF &STR(&RC) NE OK THEN GOTO ALLOCER ISPEXEC SELECT PGM(IEBUPDTE) PARM(MOD) SET &LASTC = &LASTCC IF &LASTC > 0 THEN + DO SET &CMPLMSG = &STR(Bad Return from IEBUPDTE (RC=&LASTC) #1) ISPEXEC SETMSG MSG(CMPC000M) ISPEXEC EDIT DATASET(&SYSPRT_UP) EXIT END FREE DD(SYSUT1 SYSUT2 SYSUT3 SYSIN SYSPRINT SYSOUT) /******************************************************* /* APPLY second set of changes * /******************************************************* ISPEXEC CONTROL DISPLAY LOCK SET CMPLMSG=&STR( *** Applying &user2ds updates to temp file ***) ISPEXEC DISPLAY MSG(CMPC000M) FREE DD(SYSUT1 SYSUT2 SYSUT3 SYSIN SYSPRINT SYSOUT) SET &CRSR=BASE SYSCALL OPEN &SYSODS &sysout_dd &DISPMOD RC IF &STR(&RC) NE OK THEN GOTO ALLOCER OPENFILE &SYSOUT_DD OUTPUT SET &SYSOUT = &STR( ***) PUTFILE SYSOUT SET &SYSOUT = &STR(&CMPLMSG) PUTFILE SYSOUT SET &SYSOUT = &STR( ***) PUTFILE SYSOUT CLOSFILE SYSOUT SYSCALL OPEN &SYSPRT_UP &SYSPRINT_DD &DISPMOD RC IF &STR(&RC) NE OK THEN GOTO ALLOCER SYSCALL OPEN &DELTA2 &SYSIN &DISPSHR RC IF &STR(&RC) NE OK THEN GOTO ALLOCER SYSCALL OPEN &UPDATEDS &SYSUT1 &DISPSHR RC IF &STR(&RC) NE OK THEN GOTO ALLOCER SYSCALL OPEN &UPDATEDS &SYSUT2 &DISPSHR RC IF &STR(&RC) NE OK THEN GOTO ALLOCER ISPEXEC SELECT PGM(IEBUPDTE) PARM(MOD) SET &LASTC = &LASTCC IF &LASTC > 0 THEN + DO SET &CMPLMSG = &STR(Bad Return from IEBUPDTE (RC=&LASTC) #2) ISPEXEC SETMSG MSG(CMPC000M) ISPEXEC EDIT DATASET(&SYSPRT_UP) EXIT END FREE DD(SYSUT1 SYSUT2 SYSUT3 SYSIN SYSPRINT SYSOUT) ISPEXEC EDIT DATASET(&UPDATEDS(&MEMBER)) MACRO(CMPUPDT) SET &LASTC=&LASTCC IF &LASTC > 0 THEN + SET &CMPLMSG = &STR(*** Unable to view &UPDATEDS ***) ELSE SET &CMPLMSG = &STR(*** Completed Processing ***) ISPEXEC SETMSG MSG(CMPC000M) SET &CRSR = MEMBER GOTO TOP /******************************* /* PROCESS AN ALLOCATION ERROR * /******************************* ALLOCER: + IF &STR(&RC)=OK THEN + ISPEXEC SETMSG MSG(CMPC000A) ELSE + DO SET &CMPLMSG=&STR(&RC) ISPEXEC SETMSG MSG(CMPC000B) END GOTO TOP /************************* /* SINGLE POINT OF EXIT * /************************* EXIT: + IF &STR(&CMPPREF) = THEN PROFILE NOPREFIX DELETE cmp1.* EXIT /******************************************************** /* SUBROUTINES * /******************************************************** /************************* /* OPEN A DATASET * /************************* OPEN: PROC 3 DSN DD DISP RC SYSREF &RC SET RC=&SYSDSN(&DSN) IF &STR(&RC)=OK THEN + DO ALLOC DA(&DSN) FI(&DD) &DISP SET &LASTC=&LASTCC IF &LASTCC >7 THEN + SET RC=&STR(ERROR: Allocating &DSN DISP=&DISP (RC: &LASTC)) END ELSE + SET &RC = &STR(&RC: &DSN DISP=&DISP) END /************************* /* create card file * /************************* BLDCARD: PROC 1 DSN ALLOC DD(CARDS) DSN(&DSN) + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK$$$) + SPACE(5 1) CYLINDERS RELEASE + RECFM(F B) LRECL(80) BLKSIZE(23440) IF &LASTCC>7 THEN + DO SET RC='Unable to open ' &DSN ' for output rc:' &lastcc GOTO ALLOCER END ELSE + DO OPENFILE CARDS OUTPUT SET &CARDS=&STR(TEXT=$COBOL) PUTFILE CARDS SET &CARDS=&STR(COPYDIFF=(IEBUPDTE,SEQFLD=016)) PUTFILE CARDS SET &CARDS=&STR(MASK=(1,8)) PUTFILE CARDS SET &CARDS=&STR(MAXDIFF=1000) PUTFILE CARDS SET &CARDS=CONTINUE PUTFILE CARDS CLOSFILE CARDS FREE DD(CARDS) END END /************************* /* OPEN NEW DATASET * /************************* OPENNEW: PROC 4 DSN DD DISP DCB RC SYSREF &DISP &DCB &RC ALLOC DD(&DD) DSN(&DSN) + &DISP + UNIT(SYSDA) VOLUME(WRK$$$) + SPACE(5 1) CYLINDERS RELEASE + &DCB SET &LASTC = &LASTCC IF &LASTC>7 THEN + SET RC=&STR(ERROR: Allocating &dsn DISP=&DISP (RC: &LASTC)) END /************************* /* INITIALIZE ENVIRONMENT* /************************* INITIAL: + ISPEXEC CONTROL DISPLAY LOCK SET CMPLMSG=&STR( *** Allocating Temporary Datasets ***) ISPEXEC DISPLAY MSG(CMPC000M) SET &SYSIN = SYSIN SET &SYSUT1 = SYSUT1 SET &SYSUT2 = SYSUT2 SET &SYSUT3 = SYSUT3 SET &SYSOUT = SYSOUT SET &SYSPRINT = SYSPRINT SET &sysout_dd = SYSOUT SET &sysprint_dd = SYSPRINT SET &SYSODS = cmp1.SYSOUT SET &SYSPRT = cmp1.SYSPRT SET &SYSPRT_UP= cmp1.IEBUPPRT SET &CARDFILE = cmp1.SYSIN SET &DCBFBA = RECFM(F B A) LRECL(121) BLKSIZE(12100) SET &DCBVB = RECFM(V B ) LRECL(240) BLKSIZE(23440) SET &DCBF80 = RECFM(F B) LRECL(80) BLKSIZE(23440) SET &DISPMOD = MOD SET &DISPNEW = NEW CATALOG SET &DISPSHR = SHR SET &UPDATEDS = cmp.UPDATED SET &DELTA1 = &UPDATEDS(DELTA1) SET &DELTA2 = &UPDATEDS(DELTA2) SET &INIT = YES 00120 FREE DD(SYSUT1 SYSUT2 SYSUT3 SYSIN SYSPRINT SYSOUT) DELETE cmp1.* SYSCALL BLDCARD &CARDFILE SYSCALL OPENNEW &SYSODS &SYSOUT_DD DISPNEW DCBFBA RC OPENFILE SYSOUT OUTPUT SET &SYSOUT=&STR(cmp &ZTIME &ZDATE) PUTFILE SYSOUT CLOSFILE SYSOUT SYSCALL OPENNEW &SYSPRT &sysprint_dd DISPNEW DCBVB RC OPENFILE SYSPRINT OUTPUT SET &SYSPRINT=&STR(cmp &ZTIME &ZDATE) PUTFILE SYSPRINT CLOSFILE SYSPRINT FREE DD(&SYSPRINT_DD) SYSCALL OPENNEW &SYSPRT_UP &SYSPRINT_DD DISPNEW DCBFBA RC OPENFILE SYSPRINT OUTPUT SET &SYSPRINT=&STR(cmp &ZTIME &ZDATE) PUTFILE SYSPRINT CLOSFILE SYSPRINT IF &SYSDSN(&UPDATEDS) NE OK THEN + ALLOC DD(TMP) DSN(&UPDATEDS) + NEW CATALOG + DSORG(PO) + UNIT(SYSDA) VOLUME(WRK$$$) + SPACE(5 1) CYLINDERS RELEASE + DIR(5) + RECFM(F B) LRECL(80) BLKSIZE(23440) FREE DD(TMP) GOTO POSTINI /* return to top of code */ /********************************************************************** /* DISPLAY ANY "HELP" WHICH IS AVAILABLE FOR THIS UTILITY * /********************************************************************** HELPSEC: + ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR CMP UTILITY + *** NO PROCESSING PERFORMED ***) ISPEXEC SETMSG MSG(UTLZ000) EXIT ./ ADD NAME=CMPRACQ PROC 1 TDSN -------- /*** CHECK THE DEBUG SWITCH ***/ ISPEXEC VGET DBGSWTCH PROFILE IF &DBGSWTCH = ON THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS IF &STR(&TDSN) = HELP THEN GOTO HELPSEC /********************************************************************** /* UTILITY: $TINFO * /* AUTHOR: DAVID LEIGH * /* FUNCTION: CALL "TMSBINQ" TO FIND OUT TMS INFO ON A TAPE DATASET * /* WITHOUT HAVING TO GO INTO TMS. * /********************************************************************** IF &SYSINDEX(&STR('),&STR(&TDSN)) = 1 THEN + SET TDSN = &SUBSTR(2:&LENGTH(&STR(&TDSN))-1,&STR(&TDSN)) ELSE + SET TDSN = &STR(&SYSPREF..&TDSN) SET ZEDLMSG = &STR(*** GATHERING TMS INFORMATION ON "&TDSN" ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) SET SYSRPTDSN = &STR(&SYSPREF..TEMP.TMS.REPORT) DELETE '&SYSRPTDSN' FREE DDNAME(SYSPRINT TMSRPT SYSIN) ALLOC DD(SYSPRINT) DUMMY ALLOC DD(TMSRPT) DSN('&SYSRPTDSN') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK005) + SPACE(5,5) TRACKS RELEASE + DSORG(PS) RECFM(F B) LRECL(133) BLKSIZE(23408) ALLOC DD(SYSIN) + NEW + UNIT(SYSDA) VOLUME(WRK005) + SPACE(1,1) TRACKS RELEASE + RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS) OPENFILE SYSIN OUTPUT SET SYSIN = &STR(DSN=&TDSN,LONG) PUTFILE SYSIN CLOSFILE SYSIN TMSBINQ SET ZEDLMSG = &STR(*** FORMATTING TMS INFORMATION FOR "&TDSN" ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) FREE DDNAME(SYSIN SYSPRINT) /********************************************************************** /* SHOW THE OUTPUT IN AN EDITED FILE. * /********************************************************************** FREE DDNAME(TMSRPT) ISPEXEC VPUT TDSN SHARED ISPEXEC EDIT DATASET('&SYSRPTDSN') EXIT /********************************************************************** /* DON'T REMOVE THE NEXT CODE SINCE IT WAS SO TIME-CONSUMING TO CREATE* /********************************************************************** ERROR DO SET ERRCC = &LASTCC SELECT (&ERRCC) WHEN (400) DO SET EOF = YES RETURN END OTHERWISE DO ERROR OFF WRITE *** ERROR CC: &ERRCC OCCURRED READING A FILE *** CLOSFILE TMSRPT FREE DD(TMSRPT) EXIT CODE(&ERRCC) END END END SET SWITCH = OFF SET EOF = NO OPENFILE TMSRPT GETFILE TMSRPT DO WHILE &EOF = NO IF &SYSINDEX(&STR(VOLSEQ=001),&STR(&TMSRPT)) = 9 THEN + DO SET VOLSEQ = &SUBSTR(016:018,&STR(&TMSRPT)) SET ACCT = &SUBSTR(088:128,&STR(&TMSRPT)) GETFILE TMSRPT SET CUNIT = &SUBSTR(073:075,&STR(&TMSRPT)) SET LJOB = &SUBSTR(083:090,&STR(&TMSRPT)) SET LDATE = &SUBSTR(099:103,&STR(&TMSRPT)) SET LUNIT = &SUBSTR(112:114,&STR(&TMSRPT)) GETFILE TMSRPT SET FIRSTVOL = &SUBSTR(016:021,&STR(&TMSRPT)) SET NEXTVOL = &SUBSTR(032:037,&STR(&TMSRPT)) SET PREVVOL = &SUBSTR(048:053,&STR(&TMSRPT)) SET NUMDSNB = &SUBSTR(074:077,&STR(&TMSRPT)) SET FRSTDSNB = &SUBSTR(088:092,&STR(&TMSRPT)) SET FLAG2 = &SUBSTR(101:102,&STR(&TMSRPT)) SET BATCHID = &SUBSTR(113:115,&STR(&TMSRPT)) GETFILE TMSRPT SET LABEL = &SUBSTR(015:016,&STR(&TMSRPT)) SET DEN = &SUBSTR(023:024,&STR(&TMSRPT)) SET TRTCH = &SUBSTR(033:034,&STR(&TMSRPT)) GETFILE TMSRPT SET OUTCODE = &SUBSTR(017:020,&STR(&TMSRPT)) SET OUTDATE = &SUBSTR(031:035,&STR(&TMSRPT)) SET SLOT = &SUBSTR(043:048,&STR(&TMSRPT)) SET CLNCNT = &SUBSTR(057:059,&STR(&TMSRPT)) SET DATECLN = &SUBSTR(070:074,&STR(&TMSRPT)) SET USECLN = &SUBSTR(084:088,&STR(&TMSRPT)) SET BTHDATE = &SUBSTR(099:103,&STR(&TMSRPT)) SET COUNT = &SUBSTR(112:116,&STR(&TMSRPT)) GETFILE TMSRPT SET FLAG3 = &SUBSTR(015:016,&STR(&TMSRPT)) END IF &SYSINDEX(&STR(DSN=&TDSN),&STR(&TMSRPT)) = 50 THEN + DO SET VOLSER = &SUBSTR(016:021,&STR(&TMSRPT)) SET FILESEQ = &SUBSTR(032:034,&STR(&TMSRPT)) SET EXPDT = &SUBSTR(043:047,&STR(&TMSRPT)) SET NEXTDSNB = &SUBSTR(109:114,&STR(&TMSRPT)) GETFILE TMSRPT SET CJOB = &SUBSTR(014:020,&STR(&TMSRPT)) SET STPNAME = &SUBSTR(032:039,&STR(&TMSRPT)) SET CRTDT = &SUBSTR(048:052,&STR(&TMSRPT)) SET CTIME = &SUBSTR(061:064,&STR(&TMSRPT)) SET FLAG1 = &SUBSTR(073:074,&STR(&TMSRPT)) SET F1STVOL = &SUBSTR(085:090,&STR(&TMSRPT)) GETFILE TMSRPT SET RECFM = &SUBSTR(015:016,&STR(&TMSRPT)) SET LRECL = &SUBSTR(025:029,&STR(&TMSRPT)) SET BLKSIZE = &SUBSTR(040:044,&STR(&TMSRPT)) SET BLKCNT = &SUBSTR(054:059,&STR(&TMSRPT)) SET READERR = &SUBSTR(070:072,&STR(&TMSRPT)) SET WRITERR = &SUBSTR(083:085,&STR(&TMSRPT)) SET EOF = YES END GETFILE TMSRPT END ERROR OFF CLOSFILE TMSRPT FREE DD(TMSRPT) WRITE VOLSEQ &VOLSEQ WRITE ACCT &ACCT WRITE CUNIT &CUNIT WRITE LJOB &LJOB WRITE LDATE &LDATE WRITE LUNIT &LUNIT WRITE FIRSTVOL &FIRSTVOL WRITE NEXTVOL &NEXTVOL WRITE PREVVOL &PREVVOL WRITE NUMDSNB &NUMDSNB WRITE FRSTDSNB &FRSTDSNB WRITE FLAG2 &FLAG2 WRITE BATCHID &BATCHID WRITE LABEL &LABEL WRITE DEN &DEN WRITE TRTCH &TRTCH WRITE OUTCODE &OUTCODE WRITE OUTDATE &OUTDATE WRITE SLOT &SLOT WRITE CLNCNT &CLNCNT WRITE DATECLN &DATECLN WRITE USECLN &USECLN WRITE BTHDATE &BTHDATE WRITE COUNT &COUNT WRITE FLAG3 &FLAG3 WRITE VOLSER &VOLSER WRITE FILESEQ &FILESEQ WRITE EXPDT &EXPDT WRITE NEXTDSNB &NEXTDSNB WRITE CJOB &CJOB WRITE STPNAME &STPNAME WRITE CRTDT &CRTDT WRITE CTIME &CTIME WRITE FLAG1 &FLAG1 WRITE F1STVOL &F1STVOL WRITE RECFM &RECFM WRITE LRECL &LRECL WRITE BLKSIZE &BLKSIZE WRITE BLKCNT &BLKCNT WRITE READERR &READERR WRITE WRITERR &WRITERR EXIT HELPSEC: + 02480000 ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) 02490000 SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR $TINFO UTILITY + 02490000 *** NO PROCESSING PERFORMED ***) 02490000 ISPEXEC SETMSG MSG(UTLZ000) 02490000 EXIT ./ ADD NAME=CMPUPDT ISREDIT MACRO (OPT1,OPT2) /****************************************************** /* Insert Update comments based on delta decks * /* found in same dataset * /****************************************************** ISPEXEC CONTROL ERRORS RETURN ISPEXEC VGET (DBGSWTCH) PROFILE ISREDIT NUMBER OFF IF &DBGSWTCH = &STR(ON) THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH ASIS ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT GOTO INITIAL POSTINI: + ISREDIT CURSOR = 1 1 ISREDIT LINE_BEFORE .ZCSR = MSGLINE + 'COMP: The following source file contains the merged versions' ISREDIT LINE_BEFORE .ZCSR = MSGLINE + ' of &USER1_DSN and &USER2_DSN' ISREDIT LINE_BEFORE .ZCSR = MSGLINE + ' 1) All Lines that were deleted as a result of either file' ISREDIT LINE_BEFORE .ZCSR = MSGLINE + ' are kept as comment lines in this particular edit session' ISREDIT LINE_BEFORE .ZCSR = MSGLINE + ' 2) Use the LOCATE SPECIAL command to find each comment ' ISREDIT LINE_BEFORE .ZCSR = MSGLINE + ' 3) Comment lines will disappear when this edit session is' ISREDIT LINE_BEFORE .ZCSR = MSGLINE + ' ENDed.' /*********************************************** /* Read Delta Deck #1 * /*********************************************** ISPEXEC CONTROL DISPLAY LOCK SET &cmpLMSG = &STR(*** Reading &DELTA1_DSN ***) ISPEXEC DISPLAY MSG(cmpC000M) ISPEXEC EDIT DATASET(&DELTA1_DSN) MACRO(CMPDEL) ISPEXEC CONTROL DISPLAY LOCK SET &cmpLMSG = &STR(*** Extracting from &BASE_DSN ***) ISPEXEC DISPLAY MSG(cmpC000M) ISPEXEC EDIT DATASET(&BASE_DSN) MACRO(CMPINS) SYSCALL MAKLNS &USER1_DSN SYSCALL SHOWINS &USER1_DSN ISPEXEC CONTROL DISPLAY LOCK SET &cmpLMSG = &STR(*** Reading &DELTA2_DSN ***) ISPEXEC DISPLAY MSG(cmpC000M) ISPEXEC EDIT DATASET(&DELTA2_DSN) MACRO(CMPDEL) ISPEXEC CONTROL DISPLAY LOCK SET &cmpLMSG = &STR(*** Extracting from &BASE_DSN ***) ISPEXEC DISPLAY MSG(cmpC000M) ISPEXEC EDIT DATASET(&BASE_DSN) MACRO(CMPINS) SYSCALL MAKLNS &USER2_DSN SYSCALL SHOWINS &USER2_DSN ISREDIT CURSOR = 1 1 GOTO EXIT /* GET OUT OF HERE */ /************************* /* SINGLE POINT OF EXIT * /************************* EXIT: + EXIT /******************************************************** /* SUBROUTINES * /******************************************************** MAKLNS: PROC 1 &DSN ISPEXEC VGET (NUMLINE) SHARED DO I=1 TO 99999 WHILE &I<=&NUMLINE ISPEXEC VGET (DLN&I) SHARED SET X=&&DLN&I IF &SUBSTR(1:9,&STR(&X)) = &STR(SEQAFTER=) THEN + DO SET &SEQ = &SUBSTR(10:&LENGTH(&STR(&X)),&STR(&X)) ISREDIT FIND &STR('&SEQ') FIRST 1 6 ISREDIT (LN,CL) = CURSOR SET LN=&LN+1 ISREDIT CURSOR = &LN &CL ISREDIT LINE_BEFORE .ZCSR = MSGLINE + 'The following lines were deleted (see &DSN)' END ELSE + DO ISREDIT LINE_BEFORE .ZCSR = MSGLINE &STR('&X') END END END /*****************************/ /* Show new or changed lines */ /*****************************/ SHOWINS: PROC 1 &DSN /* CONTROL MSG LIST CONLIST SYMLIST NOFLUSH ASIS ISPEXEC VGET (INSMAX) SHARED SET PREV = &STR(' ') DO I=1 TO 99999 WHILE &I<=&INSMAX ISPEXEC VGET (IST&I) SHARED SET X=&&IST&I ISREDIT FIND &STR('&X') FIRST 1 6 ISREDIT (LN,CL) = CURSOR /* Set cursor prev line*/ SET LN=&LN-1 ISREDIT CURSOR = &LN &CL ISREDIT (CURRLINE) = LINE .ZCSR SET CURRP = &SUBSTR(1:6,&STR(&CURRLINE)) SET LN=&LN+1 ISREDIT CURSOR = &LN &CL /********************************************************************** /* 08/31/92 By: David Leigh * /* Added the "&STR" function to the following "IF" statement * /* to handle "CHARACTER DATA IN NUMERIC EXPRESSION" problem. * /********************************************************************** IF &STR(&CURRP) NE &STR(&PREV) THEN + DO ISREDIT LINE_BEFORE .ZCSR = MSGLINE + 'Following lines were Added or Changed (see &DSN)' IF &STR(&PREV)¬=&STR(' ') THEN + DO ISREDIT LINE_AFTER &PREVLINE = MSGLINE + 'Previous lines were Added or Changed (see &DSN)' END END SET PREV = &str(&X) ISREDIT (PREVLINE) = LINENUM .ZCSR END IF &STR(&PREV)¬=&STR(' ') THEN + DO ISREDIT LINE_AFTER &PREVLINE = MSGLINE + 'Previous lines were Added or Changed (see &DSN)' END END /************************* /* INITIALIZE ENVIRONMENT* /************************* INITIAL: + SET &DEL_INDX = 0 ISREDIT (DSN) = DATASET ISREDIT (MBR) = MEMBER ISREDIT RESET ISPEXEC VGET (BASE USER1 USER2 ) PROFILE SET &BASE_DSN = &STR('&BASE(&MBR)') SET &USER1_DSN = &STR('&USER1(&MBR)') SET &USER2_DSN = &STR('&USER2(&MBR)') SET &DELTA1_DSN = &STR('&DSN(DELTA1)') SET &DELTA2_DSN = &STR('&DSN(DELTA2)') SET &INIT=YES GOTO POSTINI ./ ADD NAME=CNTCOMMA ISREDIT MACRO (OPT) ISPEXEC CONTROL ERRORS RETURN /*** CHECK THE DEBUG SWITCH ***/ ISPEXEC VGET DBGSWTCH PROFILE IF &DBGSWTCH = ON THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS ISREDIT FIND FIRST P'=' 1 DO WHILE &LASTCC = 0 ISREDIT FIND ALL ',' .ZCSR .ZCSR ISREDIT (X,Y) = FIND_COUNTS ISREDIT CHANGE P'=' '&X &Y' 200 .ZCSR .ZCSR ISREDIT FIND NEXT P'=' 1 END ./ ADD NAME=CNTLBRW /********************************************************************** /* CLIST: CNTLBRW * /* AUTHOR: MICHELE DELUHERY * /* FUNCTION: THIS CLIST BROWSE DATA SETS WITH LIST OF EXISTING JCL * /* MEMBER NAMES. * /********************************************************************** /* SET UP SOME DEFAULT VARIABLES WHICH COULD BE CHANGED WHEN THE * /* CLIST IS INVOKED. * /********************************************************************** PROC 0 /********************************************************************** /* CONTROL DEBUG PROCESSING * /********************************************************************** /* BASED ON THE VARIABLE "DEBUG", DISPLAY OR DON'T DISPLAY LINES AS * /* THEY EXECUTE. * /********************************************************************** ISPEXEC CONTROL ERRORS RETURN IF &DEBUG = DEBUG OR &OPT1 = DEBUG OR &OPT2 = DEBUG THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ISPEXEC DISPLAY PANEL(CNTLPN3) /********************************************************************** /* CHECK FOR PF03 KEY TO EXIT CLIST * /********************************************************************** IF &PANELCC = 8 THEN EXIT EXIT ./ ADD NAME=CNTLCHG /********************************************************************** /* CLIST: CNTLNAM * /* AUTHOR: MICHELE DELUHERY * /* FUNCTION: THIS CLIST DETERMINES A VALID NEW PARMLIB MEMBER NAME * /********************************************************************** /* SET UP SOME DEFAULT VARIABLES WHICH COULD BE CHANGED WHEN THE * /* CLIST IS INVOKED. * /********************************************************************** PROC 0 /********************************************************************** /* CONTROL DEBUG PROCESSING * /********************************************************************** /* BASED ON THE VARIABLE "DEBUG", DISPLAY OR DON'T DISPLAY LINES AS * /* THEY EXECUTE. * /********************************************************************** ISPEXEC CONTROL ERRORS RETURN IF &DEBUG = DEBUG OR &OPT1 = DEBUG OR &OPT2 = DEBUG THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ISPEXEC DISPLAY PANEL(CNTLPN2) /********************************************************************** /* CHECK FOR PF03 KEY TO EXIT CLIST * /********************************************************************** IF &PANELCC = 8 THEN EXIT EXIT ./ ADD NAME=CNTLINES /* REXX ***************************************************************/ /* */ /**********************************************************************/ ADDRESS ISPEXEC 'CONTROL ERRORS RETURN' ADDRESS ISREDIT "MACRO" "FIND 'J E S 2 J O B' FIRST" "FIND P'=' 1 .ZCSR .ZCSR" "FIND PREV P'=' 1" "LABEL .ZCSR = .SAVE" "EXCLUDE ALL P'=' 1" "FIND ALL 'PRINT ELEMENT:' 2" "FIND ALL P'##$##' 3" "FIND ALL P'=' 1 .ZFIRST .SAVE" "DELETE ALL EXCLUDED" "C ALL 'JAN' '001' 25" "C ALL 'FEB' '002' 25" "C ALL 'MAR' '003' 25" "C ALL 'APR' '004' 25" "C ALL 'MAY' '005' 25" "C ALL 'JUN' '006' 25" "C ALL 'JUL' '007' 25" "C ALL 'AUG' '008' 25" "C ALL 'SEP' '009' 25" "C ALL 'OCT' '010' 25" "C ALL 'NOV' '011' 25" "C ALL 'DEC' '012' 25" "FIND FIRST 'PRINT ELEMENT:'" DO WHILE RC = 0 "LABEL .ZCSR = .A" "(LINE) = LINE .ZCSR" PARSE UPPER VAR LINE NULL1 NULL2 ELEMENT NULL3 ELEMENT = SUBSTR(ELEMENT || ' ',1,8) ZEDLMSG = ELEMENT ADDRESS ISPEXEC "CONTROL DISPLAY LOCK" ADDRESS ISPEXEC "DISPLAY MSG(UTLZ000W)" "FIND NEXT 'PRINT ELEMENT:'" IF RC > 0 THEN B = '.ZLAST' ELSE DO B = '.B' "LABEL .ZCSR = .B" "FIND PREV 'PRINT ELEMENT:'" END "FIND NEXT '.' 5 .A" B DO WHILE RC = 0 "CHANGE FIRST P'========' '"ELEMENT"' 3 .ZCSR .ZCSR" "FIND NEXT '.' 5 .A" B END "FIND NEXT 'PRINT ELEMENT:'" END ./ ADD NAME=CNTLNAM /********************************************************************** /* CLIST: CNTLNAM * /* AUTHOR: MICHELE DELUHERY * /* FUNCTION: THIS CLIST DETERMINES A VALID NEW PARMLIB MEMBER NAME * /********************************************************************** /* SET UP SOME DEFAULT VARIABLES WHICH COULD BE CHANGED WHEN THE * /* CLIST IS INVOKED. * /********************************************************************** PROC 0 /********************************************************************** /* CONTROL DEBUG PROCESSING * /********************************************************************** /* BASED ON THE VARIABLE "DEBUG", DISPLAY OR DON'T DISPLAY LINES AS * /* THEY EXECUTE. * /********************************************************************** ISPEXEC CONTROL ERRORS RETURN IF &DEBUG = DEBUG OR &OPT1 = DEBUG OR &OPT2 = DEBUG THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ISPEXEC DISPLAY PANEL(CNTLPN1) /********************************************************************** /* CHECK FOR PF03 KEY TO EXIT CLIST * /********************************************************************** IF &PANELCC = 8 THEN EXIT EXIT ./ ADD NAME=CNVTPANL /* REXX ***************************************************************/ /* UTILITY: CNVTPANL */ /* AUTHOR: DAVID LEIGH */ /* FUNCTION: THIS REXX EXEC TAKES THE VALUES OF THE EXTENDED EDIT AND */ /* BROWSE PANELS THAT USE VARIABLES BRN1-39 AND QRN1-39 AND */ /* CONVERTS THEM TO VARIABLES QBRN1-39, AND QERN1-39 */ /**********************************************************************/ ADDRESS ISPEXEC "VGET (BRN1 BRN2 BRN3 BRN4 BRN5 BRN6 BRN7 BRN8 BRN9 BRN10", "BRN11 BRN12 BRN13 BRN14 BRN15 BRN16 BRN17 BRN18 BRN19 BRN20", "BRN21 BRN22 BRN23 BRN24 BRN25 BRN26 BRN27 BRN28 BRN29 BRN30", "BRN31 BRN32 BRN33 BRN34 BRN35 BRN36 BRN37 BRN38 BRN39 BRN40", "BRN41 QRN1 QRN2 QRN3 QRN4 QRN5 QRN6 QRN7 QRN8 QRN9 QRN10", "QRN11 QRN12 QRN13 QRN14 QRN15 QRN16 QRN17 QRN18 QRN19 QRN20", "QRN21 QRN22 QRN23 QRN24 QRN25 QRN26 QRN27 QRN28 QRN29 QRN30", "QRN31 QRN32 QRN33 QRN34 QRN35 QRN36 QRN37 QRN38 QRN39 QRN40", "QRN41) PROFILE" QBRN1 = BRN1 QBRN2 = BRN2 QBRN3 = BRN3 QBRN4 = BRN4 QBRN5 = BRN5 QBRN6 = BRN6 QBRN7 = BRN7 QBRN8 = BRN8 QBRN9 = BRN9 QBRN10 = BRN10 QBRN11 = BRN11 QBRN12 = BRN12 QBRN13 = BRN13 QBRN14 = BRN14 QBRN15 = BRN15 QBRN16 = BRN16 QBRN17 = BRN17 QBRN18 = BRN18 QBRN19 = BRN19 QBRN20 = BRN20 QBRN21 = BRN21 QBRN22 = BRN22 QBRN23 = BRN23 QBRN24 = BRN24 QBRN25 = BRN25 QBRN26 = BRN26 QBRN27 = BRN27 QBRN28 = BRN28 QBRN29 = BRN29 QBRN30 = BRN30 QBRN31 = BRN31 QBRN32 = BRN32 QBRN33 = BRN33 QBRN34 = BRN34 QBRN35 = BRN35 QBRN36 = BRN36 QBRN37 = BRN37 QBRN38 = BRN38 QBRN39 = BRN39 QERN1 = QRN1 QERN2 = QRN2 QERN3 = QRN3 QERN4 = QRN4 QERN5 = QRN5 QERN6 = QRN6 QERN7 = QRN7 QERN8 = QRN8 QERN9 = QRN9 QERN10 = QRN10 QERN11 = QRN11 QERN12 = QRN12 QERN13 = QRN13 QERN14 = QRN14 QERN15 = QRN15 QERN16 = QRN16 QERN17 = QRN17 QERN18 = QRN18 QERN19 = QRN19 QERN20 = QRN20 QERN21 = QRN21 QERN22 = QRN22 QERN23 = QRN23 QERN24 = QRN24 QERN25 = QRN25 QERN26 = QRN26 QERN27 = QRN27 QERN28 = QRN28 QERN29 = QRN29 QERN30 = QRN30 QERN31 = QRN31 QERN32 = QRN32 QERN33 = QRN33 QERN34 = QRN34 QERN35 = QRN35 QERN36 = QRN36 QERN37 = QRN37 QERN38 = QRN38 QERN39 = QRN39 "VPUT (QBRN1 QBRN2 QBRN3 QBRN4 QBRN5 QBRN6 QBRN7 QBRN8 QBRN9 QBRN10", "QBRN11 QBRN12 QBRN13 QBRN14 QBRN15 QBRN16 QBRN17 QBRN18 QBRN19 QBRN20", "QBRN21 QBRN22 QBRN23 QBRN24 QBRN25 QBRN26 QBRN27 QBRN28 QBRN29 QBRN30", "QBRN31 QBRN32 QBRN33 QBRN34 QBRN35 QBRN36 QBRN37 QBRN38 QBRN39 QBRN40", "QBRN41 QERN1 QERN2 QERN3 QERN4 QERN5 QERN6 QERN7 QERN8 QERN9 QERN10", "QERN11 QERN12 QERN13 QERN14 QERN15 QERN16 QERN17 QERN18 QERN19 QERN20", "QERN21 QERN22 QERN23 QERN24 QERN25 QERN26 QERN27 QERN28 QERN29 QERN30", "QERN31 QERN32 QERN33 QERN34 QERN35 QERN36 QERN37 QERN38 QERN39 QERN40", "QERN41) PROFILE" ZEDLMSG = 'BRN* CONVERTED TO QBRN* AND QRN* CONVERTED TO QERN*' "SETMSG MSG(UTLZ000W)" EXIT ./ ADD NAME=CNVTUPCS /******************************************************************/ /* 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 ./ ADD NAME=CNVTUPC2 PROC 0 /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /*******************************************************************/ /* CLIST : CNVTUPC2 */ /* CREATED BY : DAVID LEIGH */ /* DATE : 6-9-89 */ /* DESCRIPTION : THIS CLIST IS CALLED BY CNVTUPCS TO ENABLE THE */ /* SELECTION AND OMISSION OF SPECIFIC FIELDS TO */ /* CONVERT TO UPPER CASE IN AN ISPF TABLE. */ /*******************************************************************/ SET XITCODE = 9999 SET Y = ISPEXEC VGET (TBFIELDS TDSN) SHARED ISPEXEC TBCREATE $$$$UPCS WRITE SHARE KEYS(FIELD) NAMES(SELECT) IF &LASTCC > 0 THEN + DO SET ZEDLMSG = &STR(COULD NOT CREATE TEMP TABLE "$$$$UPCS") + &STR(IN "&TDSN") ISPEXEC SETMSG MSG(UTLZ001) GOTO QUIT END SET X = &TBFIELDS DO WHILE &X > SET A = &SYSINDEX(&STR( ),&STR(&X)) SET A = &A - 1 IF &A > 0 THEN + DO SET FIELD = &SUBSTR(1:&A,&STR(&X)) ISPEXEC TBADD $$$$UPCS ORDER SET A = &A + 2 SET SLEN = &LENGTH(&STR(&X)) SET &X = &SUBSTR(&A:&SLEN,&STR(&X)) END ELSE SET X = END ISPEXEC TBTOP $$$$UPCS REDISP1: + ISPEXEC TBDISPL $$$$UPCS PANEL(UTILUPC2) SET SAVECC = &LASTCC IF &ZTDSELS ¬= &STR(0000) THEN + DO ISPEXEC CONTROL DISPLAY SAVE DO WHILE &ZTDSELS ¬= &STR(0000) IF &SEL = &STR(S) THEN + DO SET Y = &STR(&Y &FIELD) SET SELECT = SELECTED ISPEXEC TBMOD $$$$UPCS END IF &ZTDSELS > &STR(0001) THEN + DO ISPEXEC CONTROL DISPLAY RESTORE ISPEXEC TBDISPL $$$$UPCS ISPEXEC CONTROL DISPLAY SAVE END ELSE + DO SET ZTDSELS = &STR(0000) ISPEXEC CONTROL DISPLAY RESTORE END END END IF &SAVECC = 8 THEN GOTO FINISH IF &LENGTH(&STR(&ZCMD)) > 0 THEN + DO IF &ZCMD = ALL THEN + DO ISPEXEC TBTOP $$$$UPCS SET SETCC = 0 DO WHILE &SETCC = 0 SET Y = &STR(&Y &FIELD) ISPEXEC TBSKIP $$$$UPCS NUMBER(1) SET SETCC = &LASTCC END GOTO FINISH END IF &ZCMD = CANCEL THEN + DO SET Y = GOTO FINISH END SET ZEDLMSG = &STR(INVALID COMMAND : "&ZCMD") ISPEXEC SETMSG MSG(UTLZ001) END IF &LENGTH(&STR(&ZCMD)) = 0 THEN + DO ISPEXEC TBTOP $$$$UPCS ISPEXEC TBSKIP $$$$UPCS NUMBER(&ZTDTOP) ISPEXEC VGET (ZVERB ZSCROLLN) IF &ZVERB = &STR(UP) THEN + ISPEXEC TBSKIP $$$$UPCS NUMBER(-&ZSCROLLN) IF &ZVERB = &STR(DOWN) THEN + ISPEXEC TBSKIP $$$$UPCS NUMBER(&ZSCROLLN) END GOTO REDISP1 FINISH: + ISPEXEC TBEND $$$$UPCS DELETE '&TDSN($$$$UPCS)' SET TBFIELDS = &STR(&Y) ISPEXEC VPUT (TBFIELDS) SHARED SET XITCODE = 0 QUIT: + EXIT CODE(&XITCODE) ./ ADD NAME=CODEMIG /**********************************************************************/ /* UTILITY: CODEMIG */ /* AUTHOR: DAVID LEIGH */ /* FUNCTION: THIS UTILITY "CHECKS OUT" A CODE TYPE FOR MODIFICATION */ /* OF ITS UTL01,2, AND/OR 3 TABLE ROW COMPONENTS. CHECKOUT */ /* OCCURS FROM ENDEVOR IF THE CODE TYPE IS IN ENDEVOR, OR */ /* FROM DB2 IF THE CODE TYPE IS ONLY IN DB2. */ /**********************************************************************/ PROC 0 CODETYPE() + DB2STAGE() + GETFROM(ENDEVOR) + ENVIRON(QUAL) + STAGE(D) + TYPE(CODETYPE) + SYSTEM(STR) + SUBSYS(UNIPAC) + TEMPJCL('&SYSUID..TEMP.CODEMIG.JCL') + JCLREVEW(N) + HELP + DEBUG /*** CHECK THE DEBUG SWITCH ***/ IF &DEBUG = DEBUG THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS IF &HELP = HELP THEN GOTO HELPSEC 02 /**********************************************************************/ /* MAKE SURE THE USER'S NOT CURRENTLY IN ENDEVOR BY ATTEMPTING TO EDIT*/ /* THE ENDEVOR ISPF PROFILE MEMBER IN THE ISPF PROFILE PDS. IF WE */ /* CAN'T EDIT IT, WE KNOW THAT THAT ENDEVOR IS USING IT (MOST LIKELY).*/ /**********************************************************************/ ISPEXEC CONTROL ERRORS RETURN ISPEXEC EDIT DATASET('&SYSUID..ISPF.ISPPROF(CTLIPROF)') MACRO(APPLCHKM) 02 IF &LASTCC = 14 THEN + DO SET ZEDSMSG = SET ZEDLMSG = &STR(*** CANNOT CONTINUE UNTIL YOU + ARE OUT OF ENDEVOR ***) ISPEXEC SETMSG MSG(UTLZ001W) END 02 /**********************************************************************/ /* ESTABLISH SOME PROCESSING VARIABLES */ /**********************************************************************/ CALL 'SYS2.USC1.LINKLIB(USERINFO)' '&SYSUID ' SET TEMPJCL = &STR(&TEMPJCL) SET LP = &STR(( SET RP = &STR() /**********************************************************************/ /* DISPLAY THE PRIMARY DATA ENTRY PANEL */ /**********************************************************************/ REDISPLAY: + SET GENERATE = ISPEXEC DISPLAY PANEL(CODEMIG) IF &LASTCC > 7 THEN EXIT /**************************************************************/ /* PERMIT DYNAMIC DEBUG TOGGLEING */ /**************************************************************/ IF &ZCMD = &STR(DEBUG) THEN + IF &DEBUG = OFF THEN + DO SET DEBUG = DEBUG SET ZEDSMSG = &STR(DEBUG ON) SET ZEDLMSG = &STR(THE DEBUG SWITCH HAS BEEN SET ON) ISPEXEC SETMSG MSG(UTLZ000) CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS GOTO REDISPLAY END ELSE + DO SET DEBUG = OFF SET ZEDSMSG = &STR(DEBUG OFF) SET ZEDLMSG = &STR(THE DEBUG SWITCH HAS BEEN SET OFF) ISPEXEC SETMSG MSG(UTLZ000) CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS GOTO REDISPLAY END IF &ZCMD = &STR(DEBUG ON) THEN + DO SET DEBUG = DEBUG SET ZEDSMSG = &STR(DEBUG ON) SET ZEDLMSG = &STR(THE DEBUG SWITCH HAS BEEN SET ON) ISPEXEC SETMSG MSG(UTLZ000) CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS GOTO REDISPLAY END IF &ZCMD = &STR(DEBUG OFF) THEN + DO SET DEBUG = OFF SET ZEDSMSG = &STR(DEBUG OFF) SET ZEDLMSG = &STR(THE DEBUG SWITCH HAS BEEN SET OFF) ISPEXEC SETMSG MSG(UTLZ000) CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS GOTO REDISPLAY END /**********************************************************************/ /* THIS NEXT SECTOIN USES SOME OF THE CAPABILITIES TO "EXTEND" THE */ /* PLATINUM PRODUCT SUITE. IN THIS PARTICULAR CASE, THE USER IS */ /* TAKEN DIRECTLY INTO RC/UPDATE TO EDIT THEIR "UTL02" TABLE. */ /**********************************************************************/ IF &STR(&GETFROM) = DB2 OR + &STR(&ACTION) = A THEN GOTO CONTINUE IF &STR(&ACTION) = E THEN + DO SET HIGHLVL = &STR(SYS3.PLATINUM.PROD) ALLOC FI(CTRANS) DA('&HIGHLVL..LOADLIB') SHR ALLOC FI(PTILIB) DA('&HIGHLVL..LOADLIB') SHR ALLOC FI(PTIXMSG) DA('&HIGHLVL..XMESSAGE') SHR ALLOC FI(PTIPARM) DA('&HIGHLVL..PARMLIB') SHR ISPEXEC LIBDEF ISPLLIB DATASET ID ('&HIGHLVL..LOADLIB') ISPEXEC LIBDEF ISPMLIB DATASET ID ('&HIGHLVL..SPFMLIB') ISPEXEC LIBDEF ISPPLIB DATASET ID ('&HIGHLVL..SPFPLIB') ISPEXEC LIBDEF ISPSLIB DATASET ID ('&HIGHLVL..SPFSLIB') ISPEXEC LIBDEF ISPTLIB DATASET ID ('&HIGHLVL..SPFTLIB') EXEC 'SYS2.ISPF.ISPCLIB(RSPINIT)' ISPEXEC SELECT PGM(PTLDRIVM) + PARM(CI=PTLGLBL/RCU T E &SYSUID MIGRATE_UTL02) + NEWAPPL(RC) PASSLIB ISPEXEC LIBDEF ISPLLIB ISPEXEC LIBDEF ISPMLIB ISPEXEC LIBDEF ISPPLIB ISPEXEC LIBDEF ISPSLIB ISPEXEC LIBDEF ISPTLIB ISPEXEC LIBDEF ISPTABL FREE FI(CTRANS PTILIB PTIPARM PTIXMSG) GOTO REDISPLAY END /**********************************************************************/ /* CHECK TO SEE IF THIS CODE TYPE EXISTS IN ENDEVOR ALREADY */ /**********************************************************************/ SET ZEDSMSG = SET ZEDLMSG = &STR(*** DETERMINING IF "&CODETYPE" EXISTS IN ENDEVOR + CURRENTLY ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) FREE DDNAME(SYSPRINT C1MSGS1 C1PRINT BSTIPT01) ALLOC DD(SYSPRINT) DUMMY IF &DEBUG = DEBUG THEN + ALLOC DD(C1MSGS1) DA(*) ELSE + ALLOC DD(C1MSGS1) DUMMY ALLOC DD(C1PRINT) DUMMY ALLOC DD(BSTIPT01) + NEW CATALOG + UNIT(SYSDA) + SPACE(1,1) TRACKS RELEASE + RECFM(F B) LRECL(80) BLKSIZE(27920) DSORG(PS) OPENFILE BSTIPT01 OUTPUT SET BSTIPT01 = &STR(LIST ELEMENTS &CODETYPE ) PUTFILE BSTIPT01 SET BSTIPT01 = &STR(FROM ENVIRONMENT '&ENVIRON' ) PUTFILE BSTIPT01 SET BSTIPT01 = &STR( STAGE '&STAGE' ) PUTFILE BSTIPT01 SET BSTIPT01 = &STR( SYSTEM '&SYSTEM' ) PUTFILE BSTIPT01 SET BSTIPT01 = &STR( SUBSYSTEM '&SUBSYS' ) PUTFILE BSTIPT01 SET BSTIPT01 = &STR( TYPE '&TYPE') PUTFILE BSTIPT01 SET BSTIPT01 = &STR(OPTIONS SEARCH ) PUTFILE BSTIPT01 SET BSTIPT01 = &STR(. ) PUTFILE BSTIPT01 CLOSFILE BSTIPT01 ISPEXEC SELECT PGM(NDVRC1) PARM(C1BM3000) SET NDVRCC = &LASTCC SELECT (&STR(&NDVRCC)) WHEN (12) SET GETFROM = DB2 WHEN (4) SET GETFROM = DB2 WHEN (0) SET GETFROM = ENDEVOR OTHERWISE DO SET ZEDSMSG = SET ZEDLMSG = &STR(PROBLEM LISTING "&CODETYPE" ELEMENT IN + ENDEVOR. CC = &NDVRCC) ISPEXEC SETMSG MSG(UTLZ001W) GOTO REDISPLAY END END CONTINUE: + IF &STR(&GETFROM) = DB2 AND &STR(&DB2STAGE) = THEN + DO SET ZEDSMSG = SET ZEDLMSG = &STR("&CODETYPE" NOT IN ENDEVOR. PLEASE + SPECIFY WHICH DB2 STAGE TO RETRIEVE FROM) ISPEXEC SETMSG MSG(UTLZ001W) GOTO REDISPLAY END IF &STR(&GENERATE) ¬= Y THEN GOTO REDISPLAY /**********************************************************************/ /* CREATE THE JOB TO DO THE ACTUAL CHECKOUT WORK NOW */ /**********************************************************************/ SET ZEDSMSG = SET ZEDLMSG = &STR(*** CREATING THE JCL ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) DELETE '&TEMPJCL' FREE DDNAME(ISPFILE) ALLOCATE DDNAME(ISPFILE) DSN('&TEMPJCL') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK005) + SPACE(1,1) TRACKS RELEASE + RECFM(F B) LRECL(80) BLKSIZE(27920) DSORG(PS) ISPEXEC FTOPEN ISPEXEC FTINCL CODEMIG SET SAVECC = &LASTCC ISPEXEC FTCLOSE FREE DDNAME(ISPFILE) IF &SAVECC > 0 THEN + DO ISPEXEC VGET ZERRLM SET ZEDSMSG = &STR(JCL CREATION ERROR) SET ZEDLMSG = &STR(&ZERRLM) ISPEXEC SETMSG MSG(UTLZ001) END ELSE + IF &JCLREVEW = &STR(Y) THEN + DO SET ZEDLMSG = &STR(*** NOTE: YOU MUST SUBMIT THIS + JCL YOURSELF ***) ISPEXEC SETMSG MSG(UTLZ000W) ISPEXEC EDIT DATASET('&TEMPJCL') END ELSE + DO SUBMIT '&TEMPJCL' SET ZEDSMSG = &STR(JOB SUBMITTED) SET ZEDLMSG = &STR(*** THE CREATED JCL WAS SUBMITTED ***) ISPEXEC SETMSG MSG(UTLZ000) END SET GETFROM = ENDEVOR GOTO REDISPLAY ./ ADD NAME=CODEMIG1 /********************************************************************** /* UTILITY: CODEMIG1 * /* AUTHOR: DAVID LEIGH * /* FUNCTION: THIS UTILITY CREATES SQL DML INSERT, UPDATE, AND DELETE * /* STATEMENTS THAT RESULT FROM COMPARING THE CODE, CODEDEFN,* /* AND FLDCDEXREF TABLES BETWEEN DEVL AND QUAL. THIS DML IS* /* THEN FORMATTED (CURRENTLY WITH SYNCSORT AND A CLIST-BASED* /* EDIT MACRO) AND PRESENTED TO THE USER IN AN EDIT SESSION.* /* * /* THE FOLLOWING VIEWS CREATE THE COMPARE DML * /* SYSADM2.UTL01_MIG_DELETES * /* SYSADM2.UTL01_MIG_INSERTS * /* SYSADM2.UTL01_MIG_UPDATES * /* SYSADM2.UTL02_MIG_DELETES * /* SYSADM2.UTL02_MIG_INSERTS * /* SYSADM2.UTL02_MIG_UPDATES * /* SYSADM2.UTL03_MIG_DELETES * /* SYSADM2.UTL03_MIG_INSERTS * /* SYSADM2.UTL03_MIG_UPDATES * /* * /* IF THE FORMAT OF THESE TABLES CHANGES, THESE VIEWS AND * /* THE SYNCSORT FORMATTING PORTIONS OF THIS UTILITY MUST BE * /* CHANGED TO MATCH IT. * /* * /* COMPANION UTILITY "CODEMIG2" IS THEN USED TO HELP SPLIT * /* THE DML INTO SEPARATE PLATINUM BATCH PROCESSOR MEMBERS * /* FOR USE IN ENDEVOR. * /********************************************************************** PROC 0 DEBUG /*** CHECK THE DEBUG SWITCH ***/ IF &DEBUG = DEBUG THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS 02 /********************************************************************** /* SET UP SOME VARIABLES * /********************************************************************** SET LP = &STR(( SET RP = &STR()) /********************************************************************** /* QUERY DB2 TO GET A LIST OF TABLE NAMES * /********************************************************************** CONTROL END(END@) SET ZEDSMSG = SET ZEDLMSG = &STR(*** PREPARING TO CREATE THE COMPARE SQL DML ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) FREE DD(SYSREC00 SYSIN SYSPRINT SYSPUNCH) IF &DEBUG = DEBUG THEN + DO ALLOC DD(SYSPRINT) DA(*) ALLOC DD(SYSPUNCH) DA(*) END@ ELSE + DO ALLOC DD(SYSPRINT) DUMMY ALLOC DD(SYSPUNCH) DUMMY END@ SET DB2DSN00 = &STR(&SYSUID..TEMP.CODEMIG1.DML00) DELETE '&DB2DSN00' ALLOC DD(SYSREC00) DSN('&DB2DSN00') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK005) + SPACE(1,1) CYLINDERS RELEASE SET DB2DSN01 = &STR(&SYSUID..TEMP.CODEMIG1.DML01) DELETE '&DB2DSN01' ALLOC DD(SYSREC01) DSN('&DB2DSN01') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK005) + SPACE(1,1) CYLINDERS RELEASE SET DB2DSN02 = &STR(&SYSUID..TEMP.CODEMIG1.DML02) DELETE '&DB2DSN02' ALLOC DD(SYSREC02) DSN('&DB2DSN02') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK005) + SPACE(1,1) CYLINDERS RELEASE SET DB2DSN03 = &STR(&SYSUID..TEMP.CODEMIG1.DML03) DELETE '&DB2DSN03' ALLOC DD(SYSREC03) DSN('&DB2DSN03') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK005) + SPACE(1,1) CYLINDERS RELEASE SET DB2DSN04 = &STR(&SYSUID..TEMP.CODEMIG1.DML04) DELETE '&DB2DSN04' ALLOC DD(SYSREC04) DSN('&DB2DSN04') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK005) + SPACE(1,1) CYLINDERS RELEASE SET DB2DSN05 = &STR(&SYSUID..TEMP.CODEMIG1.DML05) DELETE '&DB2DSN05' ALLOC DD(SYSREC05) DSN('&DB2DSN05') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK005) + SPACE(1,1) CYLINDERS RELEASE SET DB2DSN06 = &STR(&SYSUID..TEMP.CODEMIG1.DML06) DELETE '&DB2DSN06' ALLOC DD(SYSREC06) DSN('&DB2DSN06') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK005) + SPACE(1,1) CYLINDERS RELEASE SET DB2DSN07 = &STR(&SYSUID..TEMP.CODEMIG1.DML07) DELETE '&DB2DSN07' ALLOC DD(SYSREC07) DSN('&DB2DSN07') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK005) + SPACE(1,1) CYLINDERS RELEASE SET DB2DSN08 = &STR(&SYSUID..TEMP.CODEMIG1.DML08) DELETE '&DB2DSN08' ALLOC DD(SYSREC08) DSN('&DB2DSN08') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK005) + SPACE(1,1) CYLINDERS RELEASE ALLOC DD(SYSIN) + NEW + UNIT(SYSDA) VOLUME(WRK005) + SPACE(1,1) TRACKS RELEASE + RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS) OPENFILE SYSIN OUTPUT SET SYSIN = &STR(SYSADM2.UTL01_MIG_DELETES ORDER BY 2 ) PUTFILE SYSIN SET SYSIN = &STR(SYSADM2.UTL01_MIG_INSERTS ORDER BY 2 ) PUTFILE SYSIN SET SYSIN = &STR(SYSADM2.UTL01_MIG_UPDATES ORDER BY 2 ) PUTFILE SYSIN SET SYSIN = &STR(SYSADM2.UTL02_MIG_DELETES ORDER BY 2, 3 ) PUTFILE SYSIN SET SYSIN = &STR(SYSADM2.UTL02_MIG_INSERTS ORDER BY 2, 3 ) PUTFILE SYSIN SET SYSIN = &STR(SYSADM2.UTL02_MIG_UPDATES ORDER BY 2, 3 ) PUTFILE SYSIN SET SYSIN = &STR(SYSADM2.UTL03_MIG_DELETES ORDER BY 2, 3 ) PUTFILE SYSIN SET SYSIN = &STR(SYSADM2.UTL03_MIG_INSERTS ORDER BY 2, 3 ) PUTFILE SYSIN SET SYSIN = &STR(SYSADM2.UTL03_MIG_UPDATES ORDER BY 2, 3 ) PUTFILE SYSIN CLOSFILE SYSIN /********************************************************************** /* INVOKE DSNTIAUL TO EXTRACT THE DATA FROM DB2 * /********************************************************************** SET ZEDSMSG = SET ZEDLMSG = &STR(*** CREATING THE CODE MIGRATION COMPARE SQL DML ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) DSN SYSTEM(DSNT) RUN PROGRAM(DSNTIAUL) PLAN(DSNTIB23) - LIB('SYS4.DSN.DSNT.RUNLIB.LOAD') END FREE DD(SYSREC00 SYSREC01 SYSREC02 SYSREC03 SYSREC04 SYSREC05 SYSREC06 + SYSREC07 SYSREC08 SYSIN SYSPRINT SYSPUNCH) CONTROL END(END@) /********************************************************************** /* INVOKE SYNCSORTS TO PUT THE DML INTO 80 BYTE LINES * /********************************************************************** SET ZEDSMSG = SET ZEDLMSG = &STR(*** FORMATTING THE SQL DML INTO 80 BYTE LINES ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) FREE DD(SORTIN SORTOUT SYSOUT SYSIN) IF &DEBUG = DEBUG THEN + ALLOC DD(SYSOUT) DSN(*) ELSE ALLOC DD(SYSOUT) DUMMY ALLOC DD(SORTIN) DSN('&DB2DSN00') SHR SET SORT00 = &STR(&SYSUID..TEMP.CODEMIG1.SORT00) DELETE '&SORT00' ALLOC DD(SORTOUT) DSN('&SORT00') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK005) + SPACE(1,1) CYLINDERS RELEASE + RECFM(F B A) LRECL(80) BLKSIZE(23440) DSORG(PS) ALLOC DD(SYSIN) + NEW + UNIT(SYSDA) VOLUME(WRK005) + SPACE(1,1) TRACKS RELEASE + RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS) OPENFILE SYSIN OUTPUT SET SYSIN = &STR( SORT FIELDS=COPY) PUTFILE SYSIN SET SYSIN = &STR( OUTREC FIELDS=(1,66,14X)) PUTFILE SYSIN CLOSFILE SYSIN ISPEXEC SELECT PGM(SORT) PARM(CORE=MAX) FREE DD(SORTIN SORTOUT SYSOUT SYSIN) IF &DEBUG = DEBUG THEN + ALLOC DD(SYSOUT) DSN(*) ELSE ALLOC DD(SYSOUT) DUMMY ALLOC DD(SORTIN) DSN('&DB2DSN01') SHR SET SORT01 = &STR(&SYSUID..TEMP.CODEMIG1.SORT01) DELETE '&SORT01' ALLOC DD(SORTOUT) DSN('&SORT01') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK005) + SPACE(1,1) CYLINDERS RELEASE + RECFM(F B A) LRECL(80) BLKSIZE(23440) DSORG(PS) ALLOC DD(SYSIN) + NEW + UNIT(SYSDA) VOLUME(WRK005) + SPACE(1,1) TRACKS RELEASE + RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS) OPENFILE SYSIN OUTPUT SET SYSIN = &STR( SORT FIELDS=COPY) PUTFILE SYSIN SET SYSIN = &STR( OUTFIL FILES=OUT,) PUTFILE SYSIN SET SYSIN = &STR( OUTREC=(79X),) PUTFILE SYSIN SET SYSIN = &STR( NODETAIL,) PUTFILE SYSIN SET SYSIN = &STR( SECTIONS=&LP.1,256,) PUTFILE SYSIN SET SYSIN = + &STR( TRAILER3=(1,79,/,80,79,/,159,79,/,238,79,/,317,3,76X)&RP) PUTFILE SYSIN CLOSFILE SYSIN ISPEXEC SELECT PGM(SORT) PARM(CORE=MAX) FREE DD(SORTIN SORTOUT SYSOUT SYSIN) IF &DEBUG = DEBUG THEN + ALLOC DD(SYSOUT) DSN(*) ELSE ALLOC DD(SYSOUT) DUMMY ALLOC DD(SORTIN) DSN('&DB2DSN02') SHR SET SORT02 = &STR(&SYSUID..TEMP.CODEMIG1.SORT02) DELETE '&SORT02' ALLOC DD(SORTOUT) DSN('&SORT02') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK005) + SPACE(1,1) CYLINDERS RELEASE + RECFM(F B A) LRECL(80) BLKSIZE(23440) DSORG(PS) ALLOC DD(SYSIN) + NEW + UNIT(SYSDA) VOLUME(WRK005) + SPACE(1,1) TRACKS RELEASE + RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS) OPENFILE SYSIN OUTPUT SET SYSIN = &STR( SORT FIELDS=COPY) PUTFILE SYSIN SET SYSIN = &STR( OUTFIL FILES=OUT,) PUTFILE SYSIN SET SYSIN = &STR( OUTREC=(79X),) PUTFILE SYSIN SET SYSIN = &STR( NODETAIL,) PUTFILE SYSIN SET SYSIN = &STR( SECTIONS=&LP.1,256,) PUTFILE SYSIN SET SYSIN = + &STR( TRAILER3=(1,79,/,80,79,/,159,79,/,238,79,/,317,22,57X)&RP) PUTFILE SYSIN CLOSFILE SYSIN ISPEXEC SELECT PGM(SORT) PARM(CORE=MAX) FREE DD(SORTIN SORTOUT SYSOUT SYSIN) IF &DEBUG = DEBUG THEN + ALLOC DD(SYSOUT) DSN(*) ELSE ALLOC DD(SYSOUT) DUMMY ALLOC DD(SORTIN) DSN('&DB2DSN03') SHR SET SORT03 = &STR(&SYSUID..TEMP.CODEMIG1.SORT03) DELETE '&SORT03' ALLOC DD(SORTOUT) DSN('&SORT03') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK005) + SPACE(1,1) CYLINDERS RELEASE + RECFM(F B A) LRECL(80) BLKSIZE(23440) DSORG(PS) ALLOC DD(SYSIN) + NEW + UNIT(SYSDA) VOLUME(WRK005) + SPACE(1,1) TRACKS RELEASE + RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS) OPENFILE SYSIN OUTPUT SET SYSIN = &STR( SORT FIELDS=COPY ) PUTFILE SYSIN SET SYSIN = &STR( OUTFIL FILES=OUT, ) PUTFILE SYSIN SET SYSIN = &STR( OUTREC=(79X), ) PUTFILE SYSIN SET SYSIN = &STR( NODETAIL, ) PUTFILE SYSIN SET SYSIN = &STR( SECTIONS=&LP.1,89, ) PUTFILE SYSIN SET SYSIN = &STR( TRAILER3=(1,79,/,80,10,69X)&RP) PUTFILE SYSIN CLOSFILE SYSIN ISPEXEC SELECT PGM(SORT) PARM(CORE=MAX) FREE DD(SORTIN SORTOUT SYSOUT SYSIN) IF &DEBUG = DEBUG THEN + ALLOC DD(SYSOUT) DSN(*) ELSE ALLOC DD(SYSOUT) DUMMY ALLOC DD(SORTIN) DSN('&DB2DSN04') SHR SET SORT04 = &STR(&SYSUID..TEMP.CODEMIG1.SORT04) DELETE '&SORT04' ALLOC DD(SORTOUT) DSN('&SORT04') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK005) + SPACE(1,1) CYLINDERS RELEASE + RECFM(F B A) LRECL(80) BLKSIZE(23440) DSORG(PS) ALLOC DD(SYSIN) + NEW + UNIT(SYSDA) VOLUME(WRK005) + SPACE(1,1) TRACKS RELEASE + RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS) OPENFILE SYSIN OUTPUT SET SYSIN = &STR( SORT FIELDS=COPY ) PUTFILE SYSIN SET SYSIN = &STR( OUTFIL FILES=OUT, ) PUTFILE SYSIN SET SYSIN = &STR( OUTREC=(79X), ) PUTFILE SYSIN SET SYSIN = &STR( NODETAIL, ) PUTFILE SYSIN SET SYSIN = &STR( SECTIONS=&LP.1,256, ) PUTFILE SYSIN SET SYSIN = + &STR( TRAILER3=(1,79,/,80,79,/,159,79,/,238,79,/,317,32,47X)&RP) PUTFILE SYSIN CLOSFILE SYSIN ISPEXEC SELECT PGM(SORT) PARM(CORE=MAX) FREE DD(SORTIN SORTOUT SYSOUT SYSIN) IF &DEBUG = DEBUG THEN + ALLOC DD(SYSOUT) DSN(*) ELSE ALLOC DD(SYSOUT) DUMMY ALLOC DD(SORTIN) DSN('&DB2DSN05') SHR SET SORT05 = &STR(&SYSUID..TEMP.CODEMIG1.SORT05) DELETE '&SORT05' ALLOC DD(SORTOUT) DSN('&SORT05') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK005) + SPACE(1,1) CYLINDERS RELEASE + RECFM(F B A) LRECL(80) BLKSIZE(23440) DSORG(PS) ALLOC DD(SYSIN) + NEW + UNIT(SYSDA) VOLUME(WRK005) + SPACE(1,1) TRACKS RELEASE + RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS) OPENFILE SYSIN OUTPUT SET SYSIN = &STR( SORT FIELDS=COPY ) PUTFILE SYSIN SET SYSIN = &STR( OUTFIL FILES=OUT, ) PUTFILE SYSIN SET SYSIN = &STR( OUTREC=(79X), ) PUTFILE SYSIN SET SYSIN = &STR( NODETAIL, ) PUTFILE SYSIN SET SYSIN = &STR( SECTIONS=&LP.1,256, ) PUTFILE SYSIN SET SYSIN = + &STR( TRAILER3=(1,79,/,80,79,/,159,79,/,238,79,/,317,55,24X)&RP) PUTFILE SYSIN CLOSFILE SYSIN ISPEXEC SELECT PGM(SORT) PARM(CORE=MAX) FREE DD(SORTIN SORTOUT SYSOUT SYSIN) IF &DEBUG = DEBUG THEN + ALLOC DD(SYSOUT) DSN(*) ELSE ALLOC DD(SYSOUT) DUMMY ALLOC DD(SORTIN) DSN('&DB2DSN06') SHR SET SORT06 = &STR(&SYSUID..TEMP.CODEMIG1.SORT06) DELETE '&SORT06' ALLOC DD(SORTOUT) DSN('&SORT06') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK005) + SPACE(1,1) CYLINDERS RELEASE + RECFM(F B A) LRECL(80) BLKSIZE(23440) DSORG(PS) ALLOC DD(SYSIN) + NEW + UNIT(SYSDA) VOLUME(WRK005) + SPACE(1,1) TRACKS RELEASE + RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS) OPENFILE SYSIN OUTPUT SET SYSIN = &STR( SORT FIELDS=COPY ) PUTFILE SYSIN SET SYSIN = &STR( OUTFIL FILES=OUT, ) PUTFILE SYSIN SET SYSIN = &STR( OUTREC=(79X), ) PUTFILE SYSIN SET SYSIN = &STR( NODETAIL, ) PUTFILE SYSIN SET SYSIN = &STR( SECTIONS=&LP.1,152, ) PUTFILE SYSIN SET SYSIN = &STR( TRAILER3=(1,79,/,80,73,6X)&RP) PUTFILE SYSIN CLOSFILE SYSIN ISPEXEC SELECT PGM(SORT) PARM(CORE=MAX) FREE DD(SORTIN SORTOUT SYSOUT SYSIN) IF &DEBUG = DEBUG THEN + ALLOC DD(SYSOUT) DSN(*) ELSE ALLOC DD(SYSOUT) DUMMY ALLOC DD(SORTIN) DSN('&DB2DSN07') SHR SET SORT07 = &STR(&SYSUID..TEMP.CODEMIG1.SORT07) DELETE '&SORT07' ALLOC DD(SORTOUT) DSN('&SORT07') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK005) + SPACE(1,1) CYLINDERS RELEASE + RECFM(F B A) LRECL(80) BLKSIZE(23440) DSORG(PS) ALLOC DD(SYSIN) + NEW + UNIT(SYSDA) VOLUME(WRK005) + SPACE(1,1) TRACKS RELEASE + RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS) OPENFILE SYSIN OUTPUT SET SYSIN = &STR( SORT FIELDS=COPY ) PUTFILE SYSIN SET SYSIN = &STR( OUTFIL FILES=OUT, ) PUTFILE SYSIN SET SYSIN = &STR( OUTREC=(79X), ) PUTFILE SYSIN SET SYSIN = &STR( NODETAIL, ) PUTFILE SYSIN SET SYSIN = &STR( SECTIONS=&LP.1,231, ) PUTFILE SYSIN SET SYSIN = &STR( TRAILER3=(1,79,/,80,79,/,159,73,6X)&RP ) PUTFILE SYSIN CLOSFILE SYSIN ISPEXEC SELECT PGM(SORT) PARM(CORE=MAX) FREE DD(SORTIN SORTOUT SYSOUT SYSIN) IF &DEBUG = DEBUG THEN + ALLOC DD(SYSOUT) DSN(*) ELSE ALLOC DD(SYSOUT) DUMMY ALLOC DD(SORTIN) DSN('&DB2DSN08') SHR SET SORT08 = &STR(&SYSUID..TEMP.CODEMIG1.SORT08) DELETE '&SORT08' ALLOC DD(SORTOUT) DSN('&SORT08') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK005) + SPACE(1,1) CYLINDERS RELEASE + RECFM(F B A) LRECL(80) BLKSIZE(23440) DSORG(PS) ALLOC DD(SYSIN) + NEW + UNIT(SYSDA) VOLUME(WRK005) + SPACE(1,1) TRACKS RELEASE + RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS) OPENFILE SYSIN OUTPUT SET SYSIN = &STR( SORT FIELDS=COPY ) PUTFILE SYSIN SET SYSIN = &STR( OUTFIL FILES=OUT, ) PUTFILE SYSIN SET SYSIN = &STR( OUTREC=(79X), ) PUTFILE SYSIN SET SYSIN = &STR( NODETAIL, ) PUTFILE SYSIN SET SYSIN = &STR( SECTIONS=&LP.1,245, ) PUTFILE SYSIN SET SYSIN = &STR( TRAILER3=(1,79,/,80,79,/,159,79,/,238,8,71X)&RP ) PUTFILE SYSIN CLOSFILE SYSIN ISPEXEC SELECT PGM(SORT) PARM(CORE=MAX) SET ZEDSMSG = SET ZEDLMSG = &STR(*** COMBINING THE SQL DML INTO ONE FILE ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) FREE DD(SYSUT1 SYSUT2 SYSPRINT SYSIN) IF &DEBUG = DEBUG THEN + ALLOC DD(SYSPRINT) DSN(*) ELSE ALLOC DD(SYSPRINT) DUMMY ALLOC DD(SYSUT1) DSN('&SORT00' + '&SORT01' + '&SORT02' + '&SORT03' + '&SORT04' + '&SORT05' + '&SORT06' + '&SORT07' + '&SORT08') SHR SET COMBINE = &STR(&SYSUID..TEMP.CODEMIG1.COMBINE) DELETE '&COMBINE' ALLOC DD(SYSUT2) DSN('&COMBINE') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK005) + SPACE(1,1) CYLINDERS RELEASE + RECFM(F B A) LRECL(80) BLKSIZE(23440) DSORG(PS) ALLOC DD(SYSIN) DUMMY ISPEXEC SELECT PGM(IEBGENER) FREE DD(SYSUT1 SYSUT2 SYSPRINT SYSIN) /********************************************************************** /* NOW REFINE THE FORMATTING AND PRESENT THE RESULTS TO THE USER * /********************************************************************** SET ZEDSMSG = SET ZEDLMSG = &STR(*** REFORMATTING THE SQL DML FOR READABILITY ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) ISPEXEC EDIT DATASET('&COMBINE') MACRO(CODEMMAC) EXIT ./ ADD NAME=CODEMIG2 /********************************************************************** /* MACRO: CODEMIG2 * /* AUTHOR: DAVID LEIGH * /* FUNCTION: THIS MACRO WORKS IN CONJUNCTION WITH THE OUTPUT FROM THE * /* CODEMIG1 UTILITY. THE USER EXCLUDES LINES OF SQL WHICH * /* NEED TO MIGRATE TOGETHER AND THEN TYPES CODEMIG2 ON THE * /* ON THE COMMAND LINE. THEY ARE PRESENTED WITH A PANEL * /* WHERE THEY ENTER THE APPROPRIATE INFORMATION NECESSARY * /* TO LOAD THE SELECTED SQL INTO ENDEVOR AS A DATABASE * /* CHANGE ELEMENT (A PLATINUM BATCH PROCESSOR CONTROL CARD * /* MEMBER). A BATCH JOB IS THEN CREATED AND (OPTIONALLY) * /* SUBMITTED TO LOAD THE SQL INTO ENDEVOR AND SIGN IT INTO * /* A PARTICULAR PROGRAMMER SO THAT THEY CAN PROMOTE THEIR * /* CODE CHANGES ALONG WITH THE REST OF THEIR CHANGE PACKAGE.* /********************************************************************** ISREDIT MACRO (DEBUG) ISPEXEC CONTROL ERRORS RETURN /**** SET MESSAGE DISPLAY ON/OFF BASED ON THE DEBUG SWITCH ***/ IF &DEBUG = DEBUG THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS /********************************************************************** /* CHECK TO SEE IF LINES ARE EXCLUDED FIRST * /********************************************************************** ISREDIT (COUNT,NULL) = EXCLUDE_COUNTS IF &COUNT = 0 THEN + DO SET ZEDSMSG = SET ZEDLMSG = &STR(*** YOU MUST EXCLUDE LINES PRIOR TO + INVOKING CODEMIG2 ***) ISPEXEC SETMSG MSG(UTLZ001W) EXIT CODE(8) END /********************************************************************** /* INITIALIZE SOME VARIABLES * /********************************************************************** SET ENVIRON = &STR(QUAL) SET STAGE = &STR(D) SET TYPE = &STR(DBCHANGE) SET SYSTEM = &STR(STR) SET SUBSYS = &STR(UNIPAC) /********************************************************************** /* GET THE USER'S FULL NAME * /********************************************************************** SET SYSOUTTRAP = 1000 ACF LIST * END SET SYSOUTTRAP = 0 SET SYSDVAL = &STR(&SYSNSUB(1,&SYSOUTLINE1)) READDVAL A B NAME1 NAME2 NAME3 NAME4 NAME5 SET FULLNAME = &STR(&NAME1 &NAME2 &NAME3 &NAME4 &NAME5) /********************************************************************** /* DISPLAY THE PANEL TO COLLECT THE INPUT DATA FROM THE USER * /********************************************************************** REDISPLAY: ISPEXEC DISPLAY PANEL(CODEMIG2) SET SAVECC = &LASTCC IF &SAVECC > 8 THEN + DO SET ZEDSMSG = SET ZEDLMSG = &STR(PROBABLE "CODEMIG2" PANEL ERROR. + CC = &SAVECC) ISPEXEC SETMSG MSG(UTLZ001W) EXIT CODE(8) END IF &SAVECC = 8 THEN + DO SET ZEDSMSG = SET ZEDLMSG = &STR(*** EXITED "CODEMIG2" WITHOUT ANY + PROCESSING ***) ISPEXEC SETMSG MSG(UTLZ000W) EXIT CODE(4) END /********************************************************************** /* INFORM THE USER * /********************************************************************** SET ZEDSMSG = SET ZEDLMSG = &STR(*** CREATING JOB TO LOAD SQL INTO ENDEVOR ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) /********************************************************************** /* CREATE A TEMPORARY ISPF TABLE TO HOUSE THE EXCLUDED LINES * /********************************************************************** ISPEXEC TBCREATE TEMPSQL NOWRITE REPLACE KEYS() NAMES(SQLLINE) /********************************************************************** /* LOOP THROUGH THE EXCLUDED LINES AND LOAD THEM INTO THE TABLE * /********************************************************************** ISREDIT SEEK FIRST P'=' 1 X DO WHILE &LASTCC = 0 ISREDIT (SQLLINE) = LINE .ZCSR ISPEXEC TBADD TEMPSQL ISREDIT SEEK NEXT P'=' 1 X END /********************************************************************** /* CREATE THE JCL USING ISPF FILE TAILORING * /********************************************************************** SET TEMPJCL = &STR(&SYSUID..TEMP.CODEMIG2.D)+ &SUBSTR(1:2,&STR(&SYSSDATE))+ &SUBSTR(4:5,&STR(&SYSSDATE))+ &SUBSTR(7:8,&STR(&SYSSDATE))+ &STR(.T)+ &SUBSTR(1:2,&STR(&SYSTIME))+ &SUBSTR(4:5,&STR(&SYSTIME))+ &SUBSTR(7:8,&STR(&SYSTIME))+ &STR(.JCL) DELETE '&TEMPJCL' FREE DD(ISPFILE) ALLOC DD(ISPFILE) DSN('&TEMPJCL') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK005) + SPACE(1,1) CYLINDERS RELEASE + RECFM(F B) LRECL(80) BLKSIZE(23440) ISPEXEC FTOPEN ISPEXEC FTINCL CODEMIG2 SET SAVECC = &LASTCC ISPEXEC FTCLOSE FREE DDNAME(ISPFILE) IF &JCLREVEW = &STR(Y) THEN + DO IF &SAVECC > 0 THEN + DO ISPEXEC VGET ZERRLM SET ZEDSMSG = &STR(JCL CREATION ERROR) SET ZEDLMSG = &STR(&ZERRLM) ISPEXEC SETMSG MSG(UTLZ001W) GOTO REDISPLAY END ELSE + DO SET ZEDLMSG = &STR(*** NOTE: YOU MUST SUBMIT THIS + JCL YOURSELF ***) ISPEXEC SETMSG MSG(UTLZ000W) ISPEXEC EDIT DATASET('&TEMPJCL') END END ELSE + DO IF &SAVECC > 0 THEN + DO ISPEXEC VGET ZERRLM SET ZEDSMSG = &STR(JCL CREATION ERROR) SET ZEDLMSG = &STR(&ZERRLM) ISPEXEC SETMSG MSG(UTLZ001W) GOTO REDISPLAY END ELSE + DO ISPEXEC VGET ZTEMPF SUBMIT '&ZTEMPF' SET ZEDSMSG = &STR(JOB SUBMITTED) SET ZEDLMSG = &STR(*** THE CREATED JCL WAS SUBMITTED + ***) ISPEXEC SETMSG MSG(UTLZ000W) END END /********************************************************************** /* CLEAN UP, SEND A MESSAGE AND GET OUT * /********************************************************************** ISREDIT DELETE ALL EXCLUDED ISREDIT CURSOR = 1 1 SET ZEDSMSG = SET ZEDLMSG = &STR(EXCLUDE SQL FOR A GIVEN PR AND TYPE "CODEMIG2" TO + PROCESS) ISPEXEC SETMSG MSG(UTLZ000W) EXIT ./ ADD NAME=CODEMMAC /********************************************************************** /* MACRO: CODEMMAC * /* AUTHOR: DAVID LEIGH * /* FUNCTION: THIS MACRO WORKS IN CONJUNCTION WITH THE CODEMIG1 UTILITY* /* AS AN INITIAL EDIT MACRO TO REFORMAT SOME SQL DML FOR * /* INSERTS UPDATES AND DELETES OF CODES. * /********************************************************************** ISREDIT MACRO ISPEXEC CONTROL ERRORS RETURN /**** 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 /********************************************************************** /* SET UP SOME INITIAL VARIABLES * /********************************************************************** SET LP = &STR(( SET RP = &STR()) /********************************************************************** /* GET RID OF A FEW UNPRINTABLE HEX CHARACTERS * /********************************************************************** ISREDIT (LRECL) = LRECL ISREDIT EXCLUDE ALL P'=' 1 ISREDIT FIND ALL 'INSERT' 4 ISREDIT FIND ALL 'DELETE' 4 ISREDIT FIND ALL 'UPDATE' 4 ISREDIT CHANGE ALL P'=' ' ' 1 3 NX /********************************************************************** /* GET RID OF BOGUS LEFT OVER LINES FROM SYNCSORT * /********************************************************************** ISREDIT FIND FIRST P'=' 1 NX DO WHILE &LASTCC = 0 ISREDIT LABEL .ZCSR = .CURR ISREDIT FIND NEXT ';' ISREDIT (LN,CL) = CURSOR SET CL = &CL + 1 IF &CL <= &LRECL THEN + ISREDIT CHANGE P'=' ' ' ALL &CL &LRECL .ZCSR .ZCSR ISREDIT FIND ALL P'=' 1 .CURR .ZCSR ISREDIT CURSOR = &LN &CL ISREDIT FIND NEXT P'=' 1 NX END ISREDIT DELETE ALL EXCLUDED /********************************************************************** /* REFORMAT ALL THE "INSERT" STATEMENTS * /********************************************************************** ISREDIT FIND FIRST 'INSERT' 4 DO WHILE &LASTCC = 0 ISREDIT LINE_BEFORE .ZCSR = '--*** INSERT *** INSERT *** INSERT ***' ISREDIT LABEL .ZCSR = .SQLA ISREDIT (LN1,CL1) = CURSOR ISREDIT FIND NEXT ';' ISREDIT (LN2,CL2) = CURSOR IF &LN1 = &LN2 THEN + SET SQLB = &STR(.SQLA) ELSE + DO SET SQLB = &STR(.SQLB) ISREDIT LABEL .ZCSR = .SQLB END SET SQLSTMT = ISREDIT FIND FIRST P'=' 1 .SQLA &STR(&SQLB) ISREDIT (LINE) = LINE .ZCSR SET SQLSTMT = &STR(&SQLSTMT&SUBSTR(3:&LRECL,&SYSNSUB(1,&LINE))) ISREDIT FIND NEXT P'=' 1 .SQLA &STR(&SQLB) DO WHILE &LASTCC = 0 ISREDIT (LINE) = LINE .ZCSR SET SQLSTMT = &STR(&SQLSTMT&SUBSTR(2:&LRECL,&SYSNSUB(1,&LINE))) ISREDIT FIND NEXT P'=' 1 .SQLA &STR(&SQLB) END SET SQLLEN = &LENGTH(&STR(&SQLSTMT)) SET X = &SYSINDEX(&STR(&LP),&STR(&SQLSTMT)) SET LINE = &SUBSTR(1:&X-1,&STR(&SQLSTMT)) ISREDIT LINE_BEFORE .SQLA = (LINE) SET SQLSTMT = &SUBSTR(&X:&SQLLEN,&STR(&SQLSTMT)) SET SQLLEN = &LENGTH(&STR(&SQLSTMT)) SET X = &SYSINDEX(&STR( VALUES ),&STR(&SQLSTMT)) SET VALUES = &SUBSTR(1:&X-1,&STR(&SQLSTMT)) SET SQLSTMT = &SUBSTR(&X:&SQLLEN,&STR(&SQLSTMT)) SET SQLLEN = &LENGTH(&STR(&SQLSTMT)) SET X = &X - 1 SET START = 1 DO &I = 1 TO &X IF &SUBSTR(&I:&I,&STR(&VALUES)) = &STR(,) THEN + DO SET COMMA = &I SET LINE = &SUBSTR(&START:&I,&STR(&VALUES)) ISREDIT LINE_BEFORE .SQLA = (LINE) SET START = &I + 1 END END SET LINE = &SUBSTR(&COMMA+1:&X,&STR(&VALUES)) ISREDIT LINE_BEFORE .SQLA = (LINE) SET X = &SYSINDEX(&STR(&LP),&STR(&SQLSTMT)) SET LINE = &SUBSTR(1:&X-1,&STR(&SQLSTMT)) ISREDIT LINE_BEFORE .SQLA = (LINE) SET SQLSTMT = &SUBSTR(&X:&SQLLEN,&STR(&SQLSTMT)) SET SQLLEN = &LENGTH(&STR(&SQLSTMT)) SET START = 1 DO &I = 1 TO &SQLLEN IF &SUBSTR(&I:&I,&STR(&SQLSTMT)) = &STR(,) THEN + DO SET COMMA = &I SET LINE = &SUBSTR(&START:&I,&STR(&SQLSTMT)) ISREDIT LINE_BEFORE .SQLA = (LINE) SET START = &I + 1 END END SET LINE = &SUBSTR(&COMMA+1:&SQLLEN,&STR(&SQLSTMT)) ISREDIT LINE_BEFORE .SQLA = (LINE) ISREDIT DELETE .SQLA &STR(&SQLB) ISREDIT FIND NEXT 'INSERT' 4 END /********************************************************************** /* INFORM THE USER OF THE NEXT STEP AND GO TO THE TOP * /********************************************************************** SET ZEDSMSG = SET ZEDLMSG = &STR(EXCLUDE SQL FOR A GIVEN PR AND TYPE "CODEMIG2" TO + PROCESS) ISPEXEC SETMSG MSG(UTLZ000W) ISREDIT RESET ISREDIT CURSOR = 1 1 ./ ADD NAME=COLS /********************************************************************** /* EDIT MACRO : COLS * /* AUTHOR : DAVE LEIGH * /* FUNCTION : UNTIL WE GO TO THE APPROPRIATE RELEASE OF ISPF * /* CREATE COMMENT BOXES IN VARIOUS FORMATS. * /********************************************************************** ISREDIT MACRO NOPROCESS (HELP) ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT IF &HELP = HELP THEN GOTO HELPSEC /********************************************************************** /* DETERMINE WHETHER TO USE AN "A³B" LINE COMMAND OR THE CURSOR POS. * /********************************************************************** ISREDIT (SLN,SCL) = CURSOR ISREDIT PROCESS DEST SET DESTCC = &LASTCC SELECT (&DESTCC) WHEN (0) DO ISREDIT (LINENUM) = LINENUM .ZDEST END WHEN (8) DO SET ZEDSMSG = &STR(A³B LINE REQUIRED) SET ZEDLMSG = &STR("COLS" AS A PRIMARY COMMAND REQUIRES AN + "A" OR "B" LINE COMMAND TO OPERATE) ISPEXEC SETMSG MSG(UTLZ001) EXIT CODE(12) END WHEN (16) DO SET ZEDSMSG = &STR(INVALID LINE COMMAND) SET ZEDLMSG = &STR(LINE CMDS CAN'T CONFLICT OR SPECIFY + "BEFORE" THE 1ST OR "AFTER" THE LAST + LINE) ISPEXEC SETMSG MSG(UTLZ001) EXIT CODE(12) END WHEN (20) DO SET ZEDSMSG = &STR(SEVERE ERROR) SET ZEDLMSG = &STR(PROCESSING THE LINE COMMAND PRODUCED A + SEVERE EDIT MACRO ERROR) ISPEXEC SETMSG MSG(UTLZ001) EXIT CODE(12) END OTHERWISE END /********************************************************************** /* CREATE A "COLUMNS" LINE THE SIZE OF THE LRECL * /********************************************************************** SET COLS = ISREDIT (LRECL) = LRECL DO &I = 1 TO &LRECL IF &I > 9 THEN + SET A = &SUBSTR(&LENGTH(&I)-1:&LENGTH(&I)-1,&I) SET B = &SUBSTR(&LENGTH(&I):&LENGTH(&I),&I) SET MARK = &STR(-) IF &B = 5 THEN SET MARK = &STR(+) IF &B = 0 THEN SET MARK = &STR(&A) SET COLS = &STR(&COLS&MARK) END /********************************************************************** /* PLACE THE COLUMNS LINE WHERE IT BELONGS * /********************************************************************** ISREDIT CURSOR = &LINENUM 1 ISREDIT LINE_AFTER .ZCSR = (COLS) /********************************************************************** /* RESTORE THE USER'S CURSOR POSITION * /********************************************************************** ISREDIT CURSOR = &SCL &SLN EXIT /********************************************************************** /* HELP PROCESSING * /********************************************************************** HELPSEC: + 02480000 ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) 02490000 SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR COLS UTILITY + 02490000 *** NO PROCESSING PERFORMED ***) 02490000 ISPEXEC SETMSG MSG(UTLZ000) 02490000 EXIT ./ ADD NAME=COMBOX ISREDIT MACRO NOPROCESS (TYPE,POSITION) ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT IF &TYPE = HELP THEN GOTO HELPSEC /********************************************************************** /* EDIT MACRO : COMBOX * /* AUTHOR : DAVE LEIGH * /* FUNCTION : CREATE COMMENT BOXES IN VARIOUS FORMATS. * /********************************************************************** ISREDIT PROCESS DEST SET DESTCC = &LASTCC SELECT (&DESTCC) WHEN (8) DO SET ZEDSMSG = &STR("A" OR "B" REQUIRED) SET ZEDLMSG = &STR(AN "A" OR "B" LINE COMMAND IS REQUIRED + FOR THE COMBOX UTILITY) ISPEXEC SETMSG MSG(UTLZ001) EXIT CODE(12) END WHEN (16) DO SET ZEDSMSG = &STR(INVALID LINE COMMAND) SET ZEDLMSG = &STR(LINE CMDS CAN'T CONFLICT OR SPECIFY + "BEFORE" THE 1ST OR "AFTER" THE LAST + LINE) ISPEXEC SETMSG MSG(UTLZ001) EXIT CODE(12) END WHEN (20) DO SET ZEDSMSG = &STR(SEVERE ERROR) SET ZEDLMSG = &STR(PROCESSING THE LINE COMMAND PRODUCED A + SEVERE EDIT MACRO ERROR) ISPEXEC SETMSG MSG(UTLZ001) EXIT CODE(12) END OTHERWISE END ISREDIT (SLN,SCL) = CURSOR ISREDIT (LINENUM) = LINENUM .ZDEST SET LINECC = &LASTCC ISREDIT LINE_AFTER .ZDEST = ' ' ISREDIT LINE_AFTER .ZDEST = ' ' ISREDIT LINE_AFTER .ZDEST = ' ' ISREDIT FIND FIRST P'=' .ZDEST .ZDEST ISREDIT (LN,CL) = CURSOR IF &LN > 1 OR &LINECC = 0 THEN ISREDIT FIND NEXT P'=' 1 ISREDIT LABEL .ZCSR = .BEGIN ISREDIT FIND NEXT P'=' 1 ISREDIT FIND NEXT P'=' 1 ISREDIT LABEL .ZCSR = .END IF &STR(&TYPE) = POSITION OR + &STR(&TYPE) = POS THEN + DO SET POSITION = POSITION SET TYPE = IF &SCL = 0 THEN SET SCL = 1 END IF &STR(&TYPE) = THEN ISREDIT (TYPE,NULL) = PROFILE SELECT &STR(&TYPE) WHEN (COBOL ³ COBOL2 ³ COB ³ COBOLII ³ SRCLIB) GOTO COBSEC WHEN (CLIST ³ PANEL ³ ISPPLIB ³ PANELS ³ ISPCLIB) GOTO CLISEC WHEN (REXX) GOTO CLISEC WHEN (IDCAMS ³ AMS) GOTO AMSSEC WHEN (JCL ³ CNTL ³ JCLLIB ³ PROCLIB) GOTO JCLSEC WHEN (ADS ³ ADSO) GOTO ADSSEC WHEN (SKEL ³ SKELETON ³ ISPSLIB ³ SKELS) GOTO SKLSEC WHEN (ALC ³ SORT ³ SYNCSORT ³ BAL ³ ASSEMBLER) GOTO ALCSEC WHEN (DYL ³ ANSWER ³ ASM ³ MAPS ³ DATA) GOTO ALCSEC WHEN (SPUFI ³ SQL ³ SPUFILIB ³ SQLLIB ³ MIGRLIB) GOTO SQLSEC OTHERWISE DO SET ZEDLMSG = &STR(*** VALID TYPES : + ADS + ADSO + ALC + AMS + ANSWER + ASM + ASSEMBLER + BAL + CLIST + CNTL + COB + COBOL + COBOLII + COBOL2 + DATA + DYL + IDCAMS + ISPCLIB + ISPPLIB + ISPSLIB + JCL + JCLLIB + MAPS + MIGRLIB + PANEL + PANELS + PROCLIB + REXX + SKEL + SKELETON + SKELS + SORT + SPUFI + SPUFILIB + SQL + SQLLIB + SRCLIB + SYNCSORT + ***) ISPEXEC SETMSG MSG(UTLZ001W ISREDIT DELETE .BEGIN .END EXIT CODE(12) END END ALCSEC: + ISREDIT CHANGE ALL P'=' '*' 1 .BEGIN .END ISREDIT CHANGE ALL P'=' '*' 71 .BEGIN .END ISREDIT CHANGE ALL P'=' '*' 1 71 .BEGIN .BEGIN ISREDIT CHANGE ALL P'=' '*' 1 71 .END .END GOTO FINAL COBSEC: + ISREDIT (USERSTAT) = USER_STATE ISREDIT UNNUM ISREDIT CHANGE ALL P'=' '*' 7 8 .BEGIN .END ISREDIT CHANGE ALL P'=' '*' 71 72 .BEGIN .END ISREDIT CHANGE ALL P'=' '*' 7 72 .BEGIN .BEGIN ISREDIT CHANGE ALL P'=' '*' 7 72 .END .END ISREDIT USER_STATE = (USERSTAT) ISREDIT RIGHT DATA ISREDIT LEFT DATA GOTO FINAL AMSSEC: + SET SLASHTERISK = &STR(/*) ISREDIT CHANGE ALL P'=' '&SLASHTERISK' 2 .BEGIN .END ISREDIT CHANGE ALL P'==' '*/' 71 .BEGIN .END ISREDIT CHANGE ALL P'=' '*' 3 71 .BEGIN .BEGIN ISREDIT CHANGE ALL P'=' '*' 3 71 .END .END GOTO FINAL CLISEC: + IF &STR(&POSITION) ¬= POSITION THEN SET SCL = 1 SET SLASHTERISK = &STR(/*) ISREDIT CHANGE ALL P'=' '&SLASHTERISK' &SCL .BEGIN .END ISREDIT CHANGE ALL P'==' '*/' 71 .BEGIN .END ISREDIT CHANGE ALL P'=' '*' &EVAL(&SCL + 1) 71 .BEGIN .BEGIN ISREDIT CHANGE ALL P'=' '*' &EVAL(&SCL + 1) 71 .END .END GOTO FINAL SKLSEC: + SET RP = &STR()) SET COMASTERISK = &STR(&RP.CM *) ISREDIT CHANGE ALL P'=' '&COMASTERISK' 1 .BEGIN .END ISREDIT CHANGE ALL P'=' '*' 71 .BEGIN .END ISREDIT CHANGE ALL P'=' '*' 5 71 .BEGIN .BEGIN ISREDIT CHANGE ALL P'=' '*' 5 71 .END .END GOTO FINAL ADSSEC: + SET EXCASTERISK = &STR(!*) ISREDIT CHANGE ALL P'=' '&EXCASTERISK' 1 .BEGIN .END ISREDIT CHANGE ALL P'=' '*' 71 .BEGIN .END ISREDIT CHANGE ALL P'=' '*' 2 71 .BEGIN .BEGIN ISREDIT CHANGE ALL P'=' '*' 2 71 .END .END GOTO FINAL JCLSEC: + SET SLASHTERISK = &STR(//*) ISREDIT CHANGE ALL P'=' '&SLASHTERISK' 1 .BEGIN .END ISREDIT CHANGE ALL P'=' '*' 71 .BEGIN .END ISREDIT CHANGE ALL P'=' '*' 3 71 .BEGIN .BEGIN ISREDIT CHANGE ALL P'=' '*' 3 71 .END .END GOTO FINAL SQLSEC: + SET DASHTERISK = &STR(--*) ISREDIT CHANGE ALL P'=' '&DASHTERISK' 1 .BEGIN .END ISREDIT CHANGE ALL P'=' '*' 71 .BEGIN .END ISREDIT CHANGE ALL P'=' '*' 3 71 .BEGIN .BEGIN ISREDIT CHANGE ALL P'=' '*' 3 71 .END .END FINAL: + ISREDIT (LN,CL) = CURSOR SET LN = &LN - 1 ISREDIT CURSOR = &LN 0 ISREDIT RESET LABEL .BEGIN .END EXIT HELPSEC: + 02480000 ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) 02490000 SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR COMBOX UTILITY + 02490000 *** NO PROCESSING PERFORMED ***) 02490000 ISPEXEC SETMSG MSG(UTLZ000) 02490000 EXIT ./ ADD NAME=COMMADEL ISREDIT MACRO (OPT1) ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /********************************************************************** /* INFORM THE USER * /********************************************************************** SET ZEDSMSG = SET ZEDLMSG = &STR(EXTRACTING TABLE ATTRIBUTES FROM THE MIXED DDL) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) /********************************************************************** /* GET RID OF COMMENTS * /********************************************************************** ISREDIT EXCLUDE ALL '--' 1 ISREDIT DELETE ALL EXCLUDED ISREDIT EXCLUDE ALL P'=' 1 /********************************************************************** /* FIND ALL CREATE TABLE STATEMENTS AND GET RID OF THE REST * /********************************************************************** ISREDIT FIND FIRST 'CREATE TABLE ' DO WHILE &LASTCC = 0 ISREDIT LABEL .ZCSR = .A ISREDIT FIND NEXT ';' ISREDIT LABEL .ZCSR = .B ISREDIT FIND ALL P'=' 1 .A .B ISREDIT FIND FIRST P'=' .B .B ISREDIT FIND NEXT 'CREATE TABLE ' END ISREDIT DELETE ALL EXCLUDED /********************************************************************** /* CLEAN UP THE CREATE TABLE SQL TO PARSE IT EASIER * /********************************************************************** ISREDIT CHANGE ALL ' NOT NULL WITH DEFAULT ' '' ISREDIT CHANGE ALL ' NOT NULL ' '' ISREDIT CHANGE ALL 'PRIMARY KEY' 'QQQPRIMARYKEYQQQ' ISREDIT FIND FIRST 'CHAR(' DO WHILE &LASTCC = 0 ISREDIT FIND NEXT '(' ISREDIT (LN1,CL1) = CURSOR ISREDIT FIND NEXT ')' ISREDIT (LN2,CL2) = CURSOR ISREDIT CHANGE P'=' '' ALL &CL1 &CL2 .ZCSR .ZCSR ISREDIT FIND NEXT 'CHAR(' END ISREDIT FIND FIRST 'DECIMAL(' DO WHILE &LASTCC = 0 ISREDIT FIND NEXT '(' ISREDIT (LN1,CL1) = CURSOR ISREDIT FIND NEXT ')' ISREDIT (LN2,CL2) = CURSOR ISREDIT CHANGE P'=' '' ALL &CL1 &CL2 .ZCSR .ZCSR ISREDIT FIND NEXT 'DECIMAL(' END ISREDIT CHANGE ALL ',' '' ISREDIT CHANGE ALL '(' '' ISREDIT CHANGE ALL ')' '' /********************************************************************** /* INFORM THE USER * /********************************************************************** SET ZEDLMSG = &STR(CONVERT CREATE TABLE STATMENTS TO "CREATE VIEW") ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) /********************************************************************** /* CONVERT THE CREATE TABLE STATEMENTS TO CREATE VIEWS * /********************************************************************** ISREDIT FIND FIRST 'CREATE TABLE' DO WHILE &LASTCC = 0 SET COMMA = ISREDIT LABEL .ZCSR = .FIRST ISREDIT FIND NEXT ';' ISREDIT LABEL .ZCSR = .LAST LOOP: ISREDIT FIND FIRST 'QQQPRIMARYKEYQQQ' .FIRST .LAST IF &LASTCC = 0 THEN + ISREDIT LABEL .ZCSR = .PRIM ELSE + DO ISREDIT FIND FIRST P'=' .LAST .LAST ISREDIT FIND PREV ' IN ' ISREDIT FIND PREV P'.' ISREDIT LINE_AFTER .ZCSR = 'QQQPRIMARYKEYQQQ' GOTO LOOP END ISREDIT (SYSDVAL) = LINE .FIRST READDVAL WORD1 WORD2 TABLE SET TABLE = &STR(&TABLE A) SET X = &SYSINDEX(&STR(.),&STR(&TABLE)) SET VIEW = &STR(TEMP_)+ &STR(&SYSUID._)+ &SUBSTR(&X+1:&X+5,&STR(&TABLE)) IF &STR(&OPT1) = DROP THEN + ISREDIT LINE_BEFORE .FIRST = + 'DROP VIEW &VIEW;' ISREDIT LINE_BEFORE .FIRST = 'CREATE VIEW &VIEW (STRING) AS SELECT' ISREDIT FIND LAST P'=' .FIRST .FIRST ISREDIT FIND NEXT P'=' 1 .FIRST .PRIM DO WHILE &LASTCC = 0 ISREDIT (SYSDVAL) = LINE .ZCSR READDVAL COLUMN TYPE NULL IF &STR(&COLUMN) ¬= &STR(QQQPRIMARYKEYQQQ) THEN + DO ISREDIT LABEL .ZCSR = .CURR SELECT (&STR(&TYPE)) WHEN (CHAR | VARCHAR) + SET STRING = &STR(&COMMA)+ &STR('''' || A.&COLUMN || '''' ||) WHEN (TIME | TIMESTAMP |DATE) + SET STRING = &STR(&COMMA)+ &STR(CHAR(A.&COLUMN) ||) WHEN (INTEGER | SMALLINT | DECIMAL) + SET STRING = &STR(&COMMA)+ &STR(DIGITS(A.&COLUMN) ||) END ISREDIT LINE_BEFORE .FIRST = (STRING) SET COMMA = &STR(',' || ) END ISREDIT FIND NEXT P'=' 1 .FIRST .PRIM END ISREDIT LINE_BEFORE .FIRST = 'FROM &STR(&TABLE);' ISREDIT LINE_BEFORE .FIRST = '--*********************************' ISREDIT CHANGE PREV '||' '' ISREDIT DELETE .FIRST .LAST ISREDIT FIND FIRST 'CREATE TABLE' END ISREDIT CURSOR = 1 1 EXIT ./ ADD NAME=COMMFLOW /********************************************************************** /* UTILITY: COMMFLOW * /* AUTHOR: DAVID LEIGH * /* FUNCTION: THIS EDIT MACRO ASSUMES AN INPUT FILE OF A SERIES OF DB2 * /* COMMENT ON TABLE DDL STATEMENTS. IT FLOWS THE STATEMENTS* /* FROM COLUMNS 1 TO 72 AND BREAKS ONLY ON THE COLUMN, NOT * /* NECESSARILY THE WORD. THIS KEEPS FROM STORING END OF * /* LINE BLANKS IN DB2'S REMARKS COLUMN. * /********************************************************************** ISREDIT MACRO ISPEXEC CONTROL ERRORS RETURN /**** 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 /********************************************************************** /* MAIN LOOP TO FIND "COMMENT ON TABLE" STATEMENTS * /********************************************************************** ISREDIT FIND FIRST 'COMMENT ON TABLE' 1 DO WHILE &LASTCC = 0 ISREDIT LABEL .ZCSR = .A ISREDIT FIND NEXT '; ' ISREDIT LABEL .ZCSR = .B SET STATMENT = /****************************************************************** /* INNER LOOP TO CREATE A CONTIGUOUS STATEMENT FROM THE COMMENTS * /****************************************************************** ISREDIT FIND FIRST P'=' 1 .A .B DO WHILE &LASTCC = 0 ISREDIT FIND LAST P'.' .ZCSR .ZCSR ISREDIT (ZEDSMSG,CL) = CURSOR IF &EVAL(&ZEDSMSG//10) = 0 THEN + DO ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000) END ISREDIT (LINE) = LINE .ZCSR IF &SYSINDEX(&STR(COMMENT ON TABLE),+ &STR(&SYSNSUB(1,&LINE))) = 0 THEN + SET STATEMENT = &STR(&SYSNSUB(1,&STATEMENT) )+ &SUBSTR(1:&CL,&STR(&SYSNSUB(1,&LINE))) ELSE + SET STATEMENT = &SUBSTR(1:&CL,&STR(&SYSNSUB(1,&LINE))) ISREDIT FIND NEXT P'=' 1 .A .B END /****************************************************************** /* NOW PUT THE STATEMENT BACK IN THE FILE IN 72 BYTE CHUNKS. * /****************************************************************** SET STATEMENT_LENGTH = &LENGTH(&STR(&SYSNSUB(1,&STATEMENT))) SET SIZE = &STATEMENT_LENGTH/72 SET REM = &STATEMENT_LENGTH//72 IF &REM > 0 THEN SET SIZE = &SIZE + 1 SET START = 1 DO &I = 1 TO &SIZE SET FINISH = &START + 72 - 1 IF &FINISH > &STATEMENT_LENGTH THEN + SET FINISH = &STATEMENT_LENGTH SET NEWLINE = &SUBSTR(&START:&FINISH,+ &STR(&SYSNSUB(1,&STATEMENT))) ISREDIT LINE_BEFORE .A = (NEWLINE) SET START = &FINISH + 1 END ISREDIT FIND LAST P'=' .B .B ISREDIT FIND NEXT P'=' ISREDIT LABEL .ZCSR = .C ISREDIT DELETE .A .B ISREDIT FIND FIRST P'=' .C .C ISREDIT FIND PREV P'=' ISREDIT FIND NEXT 'COMMENT ON TABLE' 1 END ISREDIT CURSOR = 1 1 ./ ADD NAME=COMPARE PROC 0 HELP /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT IF &HELP = &STR(HELP) THEN GOTO HELPSEC ISPEXEC SELECT PGM(ISRSEPRM) NOCHECK EXIT HELPSEC: + 02480000 ISPEXEC SELECT PGM(ISPTUTOR) PARM(UTILH009) 02490000 SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR COMPARE UTILITY + 02490000 *** NO PROCESSING PERFORMED ***) 02490000 ISPEXEC SETMSG MSG(UTLZ000) 02490000 EXIT ./ ADD NAME=COMPILE /********************************************************************** /* CLIST: COMPILE * /* AUTHOR: DAVID LEIGH * /* FUNCTION: THIS CLIST CONTROLS A CLIST/ISPF DIALOG TO FACILITATE * /* COMPILING OF COBOL, COBOL2, AND ASSEMBLER PROGRAMS AND * /* MAPS IN BATCH AND CICS ENVIRONMENTS. * /********************************************************************** PROC 0 JCLREVEW(N) /* INITIALIZE THE JCL REVIEW VALUE TO "NO" */ + ISPF /* SEND RESULTS TO AN ISPLLIB LOAD LIB */ + HELP /* DISPLAY HELP INSTEAD OF PROCESSING */ + DEBUG /* SHOW DEBUGGING MESSAGES DURING EXECUTION */ CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /********************************************************************** /* CONTROL CLIST/EDIT MODE PROCESSING * /********************************************************************** ERROR DO SET MODE = CLIST RETURN END ISREDIT MACRO (OPT1 OPT2 OPT3) ERROR OFF /********************************************************************** /* LOG THE USE * /********************************************************************** /********************************************************************** /* IF AN EDIT MACRO, PROCESS THE OPTIONS * /********************************************************************** IF &STR(&MODE) ¬= CLIST THEN + DO SET ZEDLMSG = &STR(*** PARSING THIS SOURCE TO SET COMPILE + DEFAULTS ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) SELECT (&OPT1) WHEN (ISPF) SET ISPF = ISPF WHEN (HELP) SET HELP = HELP WHEN (DEBUG) SET DEBUG = DEBUG END SELECT (&OPT2) WHEN (ISPF) SET ISPF = ISPF WHEN (HELP) SET HELP = HELP WHEN (DEBUG) SET DEBUG = DEBUG END SELECT (&OPT3) WHEN (ISPF) SET ISPF = ISPF WHEN (HELP) SET HELP = HELP WHEN (DEBUG) SET DEBUG = DEBUG END END /********************************************************************** /* CONTROL DEBUG PROCESSING * /********************************************************************** ISPEXEC CONTROL ERRORS RETURN IF &DEBUG = DEBUG THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /********************************************************************** /* CONTROL HELP PROCESSING * /********************************************************************** IF &HELP = HELP THEN GOTO HELPSEC /********************************************************************** /* ESTABLISH SOME VARIABLES AND GET SOME PROFILE VARIABLE VALUES * /********************************************************************** CALL 'SYS2.USC1.LINKLIB(USERINFO)' '&SYSUID ' SET LP = &STR(( SET RP = &STR()) SET AMPER = &STR(&&) SET LANG = SET CMPCICS = ISPEXEC VGET (CMPPCONF CMPTYPE CMPTYPFX CMPAPPL CMPJSUFF + CMPALIST CMPPTRN CMPDTRN CMPPLKED CMPDLKED CMPJCLR + CMPCLASS CMPPR CMPLDASD) PROFILE IF &STR(&CMPTYPE) = THEN SET CMPTYPE = &STR(COB2) IF &STR(&CMPTYPFX) = THEN SET CMPTYPFX = &STR(T) IF &STR(&CMPAPPL) = THEN + IF &SUBSTR(2:2,&STR(&SYSUID)) = &STR(#) THEN + SET CMPAPPL = GSS ELSE + SET CMPAPPL = SLSS IF &STR(&CMPJSUFF) = THEN SET CMPJSUFF = &STR(CMP) IF &STR(&CMPCLASS) = THEN SET CMPCLASS = &STR(1) IF &STR(&CMPPR) = THEN SET CMPPR = &STR(Z00000) IF &STR(&CMPPTRN) = THEN SET CMPPTRN = &STR(N) IF &STR(&CMPPLKED) = THEN SET CMPPLKED = &STR(N) IF &STR(&CMPDTRN) = THEN SET CMPDTRN = &STR(N) IF &STR(&CMPDLKED) = THEN SET CMPDLKED = &STR(N) IF &STR(&CMPALIST) = THEN SET CMPALIST = &STR(Y) IF &STR(&CMPJCLR) = THEN SET CMPJCLR = &STR(N) IF &STR(&CMPLDASD) = THEN SET CMPLDASD = &STR(T) ISPEXEC VPUT (CMPPCONF CMPTYPE CMPTYPFX CMPAPPL CMPJSUFF + CMPALIST CMPPTRN CMPDTRN CMPPLKED CMPDLKED CMPJCLR + CMPCLASS CMPPR CMPLDASD) PROFILE SET JCLREVEW = &STR(&CMPJCLR) /*********************************************************************** /* PARSE FOR DATASET INFORMATION AND LANGUAGE TYPE IF THIS IS A MACRO * /*********************************************************************** IF &MODE ¬= CLIST THEN + DO ISREDIT (PACK) = PACK IF &PACK = ON THEN + DO SET ZEDSMSG = &STR(DATA IS PACKED) SET ZEDLMSG = &STR(UNPACK THE DATA AND SAVE + THE DATASET FIRST) ISPEXEC SETMSG MSG(UTLZ001) GOTO FINISH END ISREDIT (LN,CL) = CURSOR ISREDIT (CMPDSN) = DATASET IF &STR(&LANG) = THEN + DO ISREDIT EXCLUDE ALL '*' 1 7 ISREDIT FIND FIRST ' IDENTIFICATION DIVISION. ' NX IF &LASTCC = 0 THEN SET LANG = COB2 END IF &STR(&LANG) = THEN + DO ISREDIT EXCLUDE ALL '*' 1 7 ISREDIT FIND FIRST ' ENVIRONMENT DIVISION. ' NX IF &LASTCC = 0 THEN SET LANG = COB2 END IF &STR(&LANG) = THEN + DO ISREDIT EXCLUDE ALL '*' 1 7 ISREDIT FIND FIRST ' DATA DIVISION ' NX IF &LASTCC = 0 THEN SET LANG = COB2 END IF &STR(&LANG) = THEN + DO ISREDIT EXCLUDE ALL '*' 1 7 ISREDIT FIND FIRST ' WORKING-STORAGE SECTION. ' NX IF &LASTCC = 0 THEN SET LANG = COB2 END IF &STR(&LANG) = THEN + DO ISREDIT EXCLUDE ALL '*' 1 7 ISREDIT FIND FIRST ' PROCEDURE DIVISION. ' NX IF &LASTCC = 0 THEN SET LANG = COB2 END IF &STR(&LANG) = THEN + DO ISREDIT EXCLUDE ALL '*' 1 ISREDIT FIND FIRST ' DFHMDI ' 8 NX IF &LASTCC = 0 THEN SET LANG = MAP END IF &STR(&LANG) = THEN + DO ISREDIT EXCLUDE ALL '*' 1 ISREDIT FIND FIRST ' DFHMSD ' 8 NX IF &LASTCC = 0 THEN SET LANG = MAP END IF &STR(&LANG) = THEN + DO ISREDIT EXCLUDE ALL '*' 1 ISREDIT FIND FIRST ' DFHMDF ' 8 NX IF &LASTCC = 0 THEN SET LANG = MAP END IF &STR(&LANG) = THEN + DO ISREDIT EXCLUDE ALL '*' 1 ISREDIT FIND FIRST ' CSECT ' 3 15 NX IF &LASTCC = 0 THEN SET LANG = ASM END IF &STR(&LANG) = THEN + DO ISREDIT EXCLUDE ALL '*' 1 ISREDIT FIND FIRST ' DSECT ' 3 15 NX IF &LASTCC = 0 THEN SET LANG = ASM END IF &STR(&LANG) = THEN + DO ISREDIT EXCLUDE ALL '*' 1 ISREDIT FIND FIRST ' MACRO ' 3 15 NX IF &LASTCC = 0 THEN SET LANG = ASM END IF &STR(&LANG) = THEN + DO ISREDIT EXCLUDE ALL '*' 1 ISREDIT FIND FIRST ' TITLE ' 3 15 NX IF &LASTCC = 0 THEN SET LANG = ASM END IF &STR(&CMPCICS) = THEN + DO ISREDIT FIND FIRST ' EXEC CICS ' NX IF &LASTCC = 0 THEN SET CMPCICS = Y END IF &STR(&CMPCICS) = THEN + DO ISREDIT FIND FIRST ' EXEC CICS ' NX IF &LASTCC = 0 THEN SET CMPCICS = Y END ISREDIT RESET EXCLUDED IF &STR(&LANG) > THEN + IF &STR(&CMPCICS) = &STR(Y) THEN + SET CMPTYPE = &STR(C&LANG) ELSE + SET CMPTYPE = &STR(&LANG) ELSE + SET CMPTYPE = ISREDIT (MEMBER) = MEMBER IF &STR(&MEMBER) > THEN + DO SET MEMBER8 = &SUBSTR(1:8,&STR(&MEMBER )) SET CMPDSN = &STR(&CMPDSN(&MEMBER)) IF &STR(&CMPALIST) = &STR(N) THEN + SET CMPLDSN = ELSE + SET CMPLDSN = &STR(&SYSUID..COMPILE.)+ &STR(LISTING.&MEMBER) END ELSE + DO SET MEMBER8 = &STR(SEQ. DSN) SET DATE = &STR(D)+ &SUBSTR(1:2,&STR(&SYSSDATE))+ &SUBSTR(4:5,&STR(&SYSSDATE))+ &SUBSTR(7:8,&STR(&SYSSDATE)) SET TIME = &STR(T)+ &SUBSTR(1:2,&STR(&SYSTIME))+ &SUBSTR(4:5,&STR(&SYSTIME))+ &SUBSTR(7:8,&STR(&SYSTIME)) IF &STR(&CMPALIST) = &STR(N) THEN + SET CMPLDSN = ELSE + SET CMPLDSN = &STR(&SYSUID..COMPILE.)+ &STR(LISTING.&DATE..&TIME) END IF &ISPF = ISPF THEN + SET CMPALOAD = &STR(&SYSUID..&CMPAPPL..ISPLLIB) ISREDIT CURSOR = &LN &CL END /********************************************************************** /* FIND OUT THE CURRENT VALID PRINT CONFIGURATIONS * /********************************************************************** SET ALLCONF = &STR( ) ISPEXEC TBOPEN PRINTIT NOWRITE IF &LASTCC = 0 THEN + DO ISPEXEC TBSKIP PRINTIT DO WHILE &LASTCC = 0 SET ALLCONF = &STR(&ALLCONF&PTCONNAM ) ISPEXEC TBSKIP PRINTIT END ISPEXEC TBEND PRINTIT END /*********************************************************************** /* DISPLAY THE PROCESSING PANEL * /*********************************************************************** REDISPLAY: + ISPEXEC DISPLAY PANEL(COMPILE) IF &LASTCC > 7 THEN + DO FINISH: EXIT END /********************************************************************** /* PROCESS THE USER'S PRIMARY COMMANDS IF ANY * /********************************************************************** IF &STR(&ZCMD) = THEN GOTO BUILD SET SYSDVAL = &STR(&ZCMD) READDVAL ZCMD OPT1 OPT2 OPT3 OPT4 OPT5 OPT6 OPT7 OPT8 OPT9 OPT10 SELECT (&SYSCAPS(&STR(&ZCMD))) WHEN (OPT ³ OPTION ³ OPTIONS) DO ISPEXEC DISPLAY PANEL(COMPILE3) SET ZEDLMSG = &STR(*** COMPILE UTILITY OPTIONS UPDATED ***) ISPEXEC SETMSG MSG(UTLZ000) END WHEN (SHOW) DO IF &STR(&SYSCAPS(&OPT1)) = &STR(ERRORS) THEN + DO ISPEXEC CONTROL ERRORS CANCEL GOTO BUILD END ELSE GOTO OTHER END OTHERWISE DO OTHER: SET ZEDSMSG = &STR(INVALID COMMAND) SET ZEDLMSG = &STR(VALID COMMANDS: + "OPTIONS") ISPEXEC SETMSG MSG(UTLZ001W) END END GOTO REDISPLAY /********************************************************************** /* FURTHER INPUT EDITS * /********************************************************************** BUILD: + LISTDSI '&CMPDSN' IF &SYSDSORG ¬= &STR(PO) THEN + IF &STR(&CMPALOAD) = THEN + DO SET ZEDLMSG = &STR(ALTERNATE LOAD LIB MUST BE ENTERED IF + SOURCE IS NOT A PDS MEMBER) ISPEXEC SETMSG MSG(UTLZ001W) GOTO REDISPLAY END ELSE ELSE + DO SET X = &SYSINDEX(&STR(&LP),&STR(&CMPDSN)) SET Y = &SYSINDEX(&STR(&RP),&STR(&CMPDSN)) SET X = &X + 1 SET Y = &Y - 1 IF &Y < &X OR &X = 1 OR &Y = 0 THEN + DO SET ZEDLMSG = &STR(A MEMBER NAME MUST BE PART OF THE + SOURCE DSN IF IT IS A PDS) ISPEXEC SETMSG MSG(UTLZ001W) GOTO REDISPLAY END ELSE + DO SET MEMBER = &SUBSTR(&X:&Y,&STR(&CMPDSN)) SET MEMBER8 = &SUBSTR(1:8,&STR(&MEMBER )) END END /********************************************************************** /* DETERMINE LANGUAGE IF NOT FOUND BY NOW * /********************************************************************** IF &LANG = OR + &SYSINDEX(&STR(&LANG),&STR(&CMPTYPE)) = 0 THEN + DO IF &SYSINDEX(&STR(COB2),&STR(&CMPTYPE)) > 0 THEN + DO SET LANG = COB2 IF &STR(&LANG) ¬= &STR(&CMPTYPE) AND + &SUBSTR(1:1,&STR(&CMPTYPE)) = C THEN + SET CMPCICS = Y ELSE + SET CMPCICS = END ELSE + IF &SYSINDEX(&STR(ASM),&STR(&CMPTYPE)) > 0 THEN + DO SET LANG = ASM IF &STR(&LANG) ¬= &STR(&CMPTYPE) AND + &SUBSTR(1:1,&STR(&CMPTYPE)) = C THEN + SET CMPCICS = Y ELSE + SET CMPCICS = END ELSE SET LANG = MAP END /********************************************************************** /* DEAL WITH PRINT CONFIGURATIONS * /********************************************************************** IF &STR(&CMPPCONF) > AND + &SYSINDEX(&STR( &CMPPCONF ),&STR(&ALLCONF)) = 0 THEN + DO IF &STR(&CMPPCONF) ¬= &STR(?) THEN + DO SET ZEDLMSG = &STR(*** "&CMPPCONF" IS NOT A VALID + PRINT CONFIGURATION ***) ISPEXEC SETMSG MSG(UTLZ001) END SET CMPPCONF = ISPEXEC TBOPEN PRINTIT NOWRITE ISPEXEC TBDISPL PRINTIT PANEL(COMPILE2) IF &LASTCC < 8 THEN + IF &ZTDSELS ¬= &STR(0000) THEN + SET CMPPCONF = &STR(&PTCONNAM) SET CMPSEL = ISPEXEC TBEND PRINTIT GOTO REDISPLAY END /********************************************************************** /* BUILD THE JCL * /********************************************************************** SELECT (&STR(&CMPLDASD)) WHEN (T) SET VOLUME = &STR(VOL=SER=WRK$$$,) WHEN (P) SET VOLUME = END IF &JCLREVEW = &STR(Y) THEN + DO SET TEMPJCL = &STR(&SYSUID..TEMP.COMPILE.JCL) DELETE '&TEMPJCL' FREE DDNAME(ISPFILE) ALLOCATE DDNAME(ISPFILE) DSN('&TEMPJCL') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK$$$) + SPACE(1,1) TRACKS RELEASE + RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS) ISPEXEC FTOPEN ISPEXEC FTINCL COMPILE SET SAVECC = &LASTCC ISPEXEC FTCLOSE FREE DDNAME(ISPFILE) IF &SAVECC > 0 THEN + DO SET ZEDSMSG = &STR(JCL CREATION ERROR) SET ZEDLMSG = &STR(FILE TAILORING OF SKELETON MEMBER + "COMPILE" FAILED WITH AN RC OF + "&SAVECC") ISPEXEC SETMSG MSG(UTLZ001) END ELSE + DO SET ZEDSMSG = SET ZEDLMSG = &STR(*** NOTE: YOU MUST SUBMIT THIS + JCL YOURSELF ***) ISPEXEC SETMSG MSG(UTLZ000W) ISPEXEC EDIT DATASET('&TEMPJCL') END END ELSE + DO ISPEXEC FTOPEN TEMP ISPEXEC FTINCL COMPILE SET SAVECC = &LASTCC ISPEXEC FTCLOSE IF &SAVECC > 0 THEN + DO SET ZEDSMSG = &STR(JCL CREATION ERROR) SET ZEDLMSG = &STR(FILE TAILORING OF SKELETON MEMBER + "COMPILE" FAILED WITH AN RC OF + "&SAVECC") ISPEXEC SETMSG MSG(UTLZ001) END ELSE + DO ISPEXEC VGET ZTEMPF SUBMIT '&ZTEMPF' SET ZEDSMSG = &STR(JOB SUBMITTED) SET ZEDLMSG = &STR(*** THE CREATED JCL WAS SUBMITTED + ***) ISPEXEC SETMSG MSG(UTLZ000) END END ISPEXEC VGET TYPEHOLD SHARED IF &STR(&TYPEHOLD) > THEN + DO SET CMPTYPFX = &STR(&TYPEHOLD) ISPEXEC VPUT CMPTYPFX PROFILE END IF &STR(&ZCMD) = &STR(SHOW ERRORS) THEN + ISPEXEC CONTROL ERRORS RETURN IF &STR(&MODE) = CLIST THEN + DO SET CMPCICS = SET LANG = END IF &STR(&JCLREVEW) = Y THEN + GOTO REDISPLAY ELSE + GOTO FINISH /********************************************************************** /* DISPLAY THE HELP TUTORIAL * /********************************************************************** HELPSEC: + ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR COMPILE UTILITY + *** NO PROCESSING PERFORMED ***) ISPEXEC SETMSG MSG(UTLZ000) EXIT ./ ADD NAME=COMPILEX /********************************************************************** /* CLIST: COMPILE * /* AUTHOR: DAVID LEIGH * /* FUNCTION: THIS CLIST CONTROLS A CLIST/ISPF DIALOG TO FACILITATE * /* COMPILING OF COBOL, COBOL2, AND ASSEMBLER PROGRAMS AND * /* MAPS IN BATCH AND CICS ENVIRONMENTS. * /********************************************************************** PROC 0 HELP /* DISPLAY HELP INSTEAD OF PROCESSING */ + DEBUG /* SHOW DEBUGGING MESSAGES DURING EXECUTION */ CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /********************************************************************** /* CONTROL CLIST/EDIT MODE PROCESSING * /********************************************************************** ERROR DO SET MODE = CLIST RETURN END ISREDIT MACRO (OPT1 OPT2 OPT3) ERROR OFF /********************************************************************** /* LOG THE USE * /********************************************************************** /********************************************************************** /* IF AN EDIT MACRO, PROCESS THE OPTIONS * /********************************************************************** IF &STR(&MODE) ¬= CLIST THEN + DO SET ZEDLMSG = &STR(*** PARSING THIS SOURCE TO SET COMPILE + DEFAULTS ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) SELECT (&OPT1) WHEN (HELP) SET HELP = HELP WHEN (DEBUG) SET DEBUG = DEBUG END SELECT (&OPT2) WHEN (HELP) SET HELP = HELP WHEN (DEBUG) SET DEBUG = DEBUG END SELECT (&OPT3) WHEN (HELP) SET HELP = HELP WHEN (DEBUG) SET DEBUG = DEBUG END END /********************************************************************** /* CONTROL DEBUG PROCESSING * /********************************************************************** ISPEXEC CONTROL ERRORS RETURN IF &DEBUG = DEBUG THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /********************************************************************** /* CONTROL HELP PROCESSING * /********************************************************************** IF &HELP = HELP THEN GOTO HELPSEC /********************************************************************** /* ESTABLISH SOME INITIAL VARIABLE VALUES * /********************************************************************** CALL 'SYS2.LINKLIB(USERINFO)' '&SYSUID ' SET LP = &STR(( SET RP = &STR()) SET AMPER = &STR(&&) /*********************************************************************** /* PARSE FOR DATASET INFORMATION AND LANGUAGE TYPE IF THIS IS A MACRO * /*********************************************************************** IF &MODE ¬= CLIST THEN + DO ISREDIT (PACK) = PACK IF &PACK = ON THEN + DO SET ZEDSMSG = &STR(DATA IS PACKED) SET ZEDLMSG = &STR(UNPACK THE DATA AND SAVE + THE DATASET FIRST) ISPEXEC SETMSG MSG(UTLZ001) GOTO FINISH END ISREDIT (LN,CL) = CURSOR ISREDIT (CMPDSN) = DATASET ISPEXEC VGET CMPAPPL PROFILE IF &STR(&CMPAPPL) = THEN + DO SET X1 = &SYSINDEX(&STR(.),&STR(&CMPDSN)) SET N2 = &SUBSTR(&X1+1:&LENGTH(&STR(&CMPDSN)),+ &STR(&CMPDSN)) SET X1 = &SYSINDEX(&STR(.),&STR(&N2)) SET CMPAPPL = &SUBSTR(1:&X1-1,&STR(&N2)) END /**************************************************************/ /* LOOK FOR "SIGNS" OF COBOL */ /**************************************************************/ IF &STR(&CMPLANG) = THEN + DO ISREDIT EXCLUDE ALL '*' 1 7 ISREDIT FIND FIRST ' IDENTIFICATION DIVISION. ' NX IF &LASTCC = 0 THEN SET CMPLANG = C END IF &STR(&CMPLANG) = THEN + DO ISREDIT EXCLUDE ALL '*' 1 7 ISREDIT FIND FIRST ' ENVIRONMENT DIVISION. ' NX IF &LASTCC = 0 THEN SET CMPLANG = C END IF &STR(&CMPLANG) = THEN + DO ISREDIT EXCLUDE ALL '*' 1 7 ISREDIT FIND FIRST ' DATA DIVISION ' NX IF &LASTCC = 0 THEN SET CMPLANG = C END IF &STR(&CMPLANG) = THEN + DO ISREDIT EXCLUDE ALL '*' 1 7 ISREDIT FIND FIRST ' WORKING-STORAGE SECTION. ' NX IF &LASTCC = 0 THEN SET CMPLANG = C END IF &STR(&CMPLANG) = THEN + DO ISREDIT EXCLUDE ALL '*' 1 7 ISREDIT FIND FIRST ' PROCEDURE DIVISION. ' NX IF &LASTCC = 0 THEN SET CMPLANG = C END /**************************************************************/ /* LOOK FOR "SIGNS" OF CICS BMS MAPS */ /**************************************************************/ IF &STR(&CMPLANG) = THEN + DO ISREDIT EXCLUDE ALL '*' 1 ISREDIT FIND FIRST ' DFHMDI ' 8 NX IF &LASTCC = 0 THEN SET CMPLANG = B END IF &STR(&CMPLANG) = THEN + DO ISREDIT EXCLUDE ALL '*' 1 ISREDIT FIND FIRST ' DFHMSD ' 8 NX IF &LASTCC = 0 THEN SET CMPLANG = B END IF &STR(&CMPLANG) = THEN + DO ISREDIT EXCLUDE ALL '*' 1 ISREDIT FIND FIRST ' DFHMDF ' 8 NX IF &LASTCC = 0 THEN SET CMPLANG = B END /**************************************************************/ /* LOOK FOR "SIGNS" OF ASSEMBLER PROGRAMS */ /**************************************************************/ IF &STR(&CMPLANG) = THEN + DO ISREDIT EXCLUDE ALL '*' 1 ISREDIT FIND FIRST ' CSECT ' 3 15 NX IF &LASTCC = 0 THEN SET CMPLANG = A END IF &STR(&CMPLANG) = THEN + DO ISREDIT EXCLUDE ALL '*' 1 ISREDIT FIND FIRST ' DSECT ' 3 15 NX IF &LASTCC = 0 THEN SET CMPLANG = A END IF &STR(&CMPLANG) = THEN + DO ISREDIT EXCLUDE ALL '*' 1 ISREDIT FIND FIRST ' MACRO ' 3 15 NX IF &LASTCC = 0 THEN SET CMPLANG = A END IF &STR(&CMPLANG) = THEN + DO ISREDIT EXCLUDE ALL '*' 1 ISREDIT FIND FIRST ' TITLE ' 3 15 NX IF &LASTCC = 0 THEN SET CMPLANG = A END /**************************************************************/ /* LOOK FOR "SIGNS" OF CICS */ /**************************************************************/ IF &STR(&CMPENVIR) = THEN DO ISREDIT FIND FIRST ' EXEC CICS ' NX IF &LASTCC = 0 THEN SET CMPENVIR = O END IF &STR(&CMPENVIR) = THEN + DO ISREDIT FIND FIRST ' EXEC CICS ' NX IF &LASTCC = 0 THEN SET CMPENVIR = O END /**************************************************************/ /* LOOK FOR "SIGNS" OF DB2 */ /**************************************************************/ IF &STR(&CMPDB2) = THEN DO ISREDIT FIND FIRST ' EXEC SQL ' NX IF &LASTCC = 0 THEN SET CMPDB2 = Y END IF &STR(&CMPDB2) = THEN + DO ISREDIT FIND FIRST ' EXEC SQL ' NX IF &LASTCC = 0 THEN SET CMPDB2 = Y END /**************************************************************/ /* LOOK FOR "SIGNS" OF FINALIST */ /**************************************************************/ IF &STR(&CMPFINAL) = THEN DO ISREDIT FIND FIRST 'LPFN' NX IF &LASTCC = 0 THEN SET CMPFINAL = Y END ISREDIT RESET EXCLUDED ISREDIT (MEMBER) = MEMBER IF &STR(&MEMBER) > THEN + DO SET MEMBER8 = &SUBSTR(1:8,&STR(&MEMBER )) SET CMPDSN = &STR(&CMPDSN(&MEMBER)) IF &STR(&CMPALIST) = &STR(N) THEN + SET CMPLDSN = ELSE + SET CMPLDSN = &STR(&SYSUID..COMPILE.)+ &STR(LISTING.&MEMBER) END ELSE + DO SET MEMBER8 = &STR(SEQ. DSN) SET DATE = &STR(D)+ &SUBSTR(1:2,&STR(&SYSSDATE))+ &SUBSTR(4:5,&STR(&SYSSDATE))+ &SUBSTR(7:8,&STR(&SYSSDATE)) SET TIME = &STR(T)+ &SUBSTR(1:2,&STR(&SYSTIME))+ &SUBSTR(4:5,&STR(&SYSTIME))+ &SUBSTR(7:8,&STR(&SYSTIME)) IF &STR(&CMPALIST) = &STR(N) THEN + SET CMPLDSN = ELSE + SET CMPLDSN = &STR(&SYSUID..COMPILE.)+ &STR(LISTING.&DATE..&TIME) END ISREDIT CURSOR = &LN &CL END /********************************************************************** /* FIND OUT THE CURRENT VALID PRINT CONFIGURATIONS * /********************************************************************** SET ALLCONF = &STR( ) ISPEXEC TBOPEN PRINTIT NOWRITE IF &LASTCC = 0 THEN + DO ISPEXEC TBSKIP PRINTIT DO WHILE &LASTCC = 0 SET ALLCONF = &STR(&ALLCONF&PTCONNAM ) ISPEXEC TBSKIP PRINTIT END ISPEXEC TBEND PRINTIT END /*********************************************************************** /* DISPLAY THE PROCESSING PANEL * /*********************************************************************** REDISPLAY: + ISPEXEC DISPLAY PANEL(COMPILEX) IF &LASTCC > 7 THEN + DO FINISH: EXIT END /********************************************************************** /* PROCESS THE USER'S PRIMARY COMMANDS IF ANY * /********************************************************************** IF &STR(&ZCMD) = THEN GOTO BUILD SET SYSDVAL = &STR(&ZCMD) READDVAL ZCMD OPT1 OPT2 OPT3 OPT4 OPT5 OPT6 OPT7 OPT8 OPT9 OPT10 SELECT (&SYSCAPS(&STR(&ZCMD))) WHEN (OPT | OPTION | OPTIONS) DO ISPEXEC DISPLAY PANEL(COMPILX3) SET ZEDLMSG = &STR(*** COMPILE UTILITY OPTIONS UPDATED ***) ISPEXEC SETMSG MSG(UTLZ000) END WHEN (SHOW) DO IF &STR(&SYSCAPS(&OPT1)) = &STR(ERRORS) THEN + DO ISPEXEC CONTROL ERRORS CANCEL GOTO BUILD END ELSE GOTO OTHER END OTHERWISE DO OTHER: SET ZEDSMSG = &STR(INVALID COMMAND) SET ZEDLMSG = &STR(VALID COMMANDS: + "OPTIONS") ISPEXEC SETMSG MSG(UTLZ001W) END END GOTO REDISPLAY /********************************************************************** /* FURTHER INPUT EDITS * /********************************************************************** BUILD: + IF &STR(&CMPAPPL) = THEN + DO SET X1 = &SYSINDEX(&STR(.),&STR(&CMPDSN)) SET N2 = &SUBSTR(&X1+1:&LENGTH(&STR(&CMPDSN)),&STR(&CMPDSN)) SET X1 = &SYSINDEX(&STR(.),&STR(&N2)) SET CMPAPPL = &SUBSTR(1:&X1-1,&STR(&N2)) END LISTDSI '&CMPDSN' IF &SYSDSORG ¬= &STR(PO) THEN + IF &STR(&CMPAPPL) = THEN + DO SET ZEDLMSG = &STR(AN APPLICATION NAME MUST BE ENTERED IF + THE SOURCE IS NOT A PDS MEMBER) ISPEXEC SETMSG MSG(UTLZ001W) GOTO REDISPLAY END ELSE ELSE + DO SET X = &SYSINDEX(&STR(&LP),&STR(&CMPDSN)) SET Y = &SYSINDEX(&STR(&RP),&STR(&CMPDSN)) SET X = &X + 1 SET Y = &Y - 1 IF &Y < &X OR &X = 1 OR &Y = 0 THEN + DO SET ZEDLMSG = &STR(A MEMBER NAME MUST BE PART OF THE + SOURCE DSN IF IT IS A PDS) ISPEXEC SETMSG MSG(UTLZ001W) GOTO REDISPLAY END ELSE + DO SET MEMBER = &SUBSTR(&X:&Y,&STR(&CMPDSN)) SET MEMBER8 = &SUBSTR(1:8,&STR(&MEMBER )) END END /********************************************************************** /* DEAL WITH PRINT CONFIGURATIONS * /********************************************************************** IF &STR(&CMPPCONF) > AND + &SYSINDEX(&STR( &CMPPCONF ),&STR(&ALLCONF)) = 0 THEN + DO IF &STR(&CMPPCONF) ¬= &STR(?) THEN + DO SET ZEDLMSG = &STR(*** "&CMPPCONF" IS NOT A VALID + PRINT CONFIGURATION ***) ISPEXEC SETMSG MSG(UTLZ001) END SET CMPPCONF = ISPEXEC TBOPEN PRINTIT NOWRITE ISPEXEC TBDISPL PRINTIT PANEL(COMPILE2) IF &LASTCC < 8 THEN + IF &ZTDSELS ¬= &STR(0000) THEN + SET CMPPCONF = &STR(&PTCONNAM) SET CMPSEL = ISPEXEC TBEND PRINTIT GOTO REDISPLAY END /********************************************************************** /* BUILD THE JCL * /********************************************************************** SELECT (&STR(&CMPLDASD)) WHEN (T) SET VOLUME = &STR(VOL=SER=WRK$$$,) WHEN (P) SET VOLUME = END IF &JCLREVEW = &STR(Y) THEN + DO SET TEMPJCL = &STR(&SYSUID..TEMP.COMPILE.JCL) DELETE '&TEMPJCL' FREE DDNAME(ISPFILE) ALLOCATE DDNAME(ISPFILE) DSN('&TEMPJCL') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK$$$) + SPACE(1,1) TRACKS RELEASE + RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS) ISPEXEC FTOPEN ISPEXEC FTINCL COMPILEX SET SAVECC = &LASTCC ISPEXEC FTCLOSE FREE DDNAME(ISPFILE) IF &SAVECC > 0 THEN + DO SET ZEDSMSG = &STR(JCL CREATION ERROR) SET ZEDLMSG = &STR(FILE TAILORING OF SKELETON MEMBER + "COMPILE" FAILED WITH AN RC OF + "&SAVECC") ISPEXEC SETMSG MSG(UTLZ001) END ELSE + DO SET ZEDSMSG = SET ZEDLMSG = &STR(*** NOTE: YOU MUST SUBMIT THIS + JCL YOURSELF ***) ISPEXEC SETMSG MSG(UTLZ000W) ISPEXEC EDIT DATASET('&TEMPJCL') END END ELSE + DO ISPEXEC FTOPEN TEMP ISPEXEC FTINCL COMPILEX SET SAVECC = &LASTCC ISPEXEC FTCLOSE IF &SAVECC > 0 THEN + DO SET ZEDSMSG = &STR(JCL CREATION ERROR) SET ZEDLMSG = &STR(FILE TAILORING OF SKELETON MEMBER + "COMPILE" FAILED WITH AN RC OF + "&SAVECC") ISPEXEC SETMSG MSG(UTLZ001) END ELSE + DO ISPEXEC VGET ZTEMPF SUBMIT '&ZTEMPF' SET ZEDSMSG = &STR(JOB SUBMITTED) SET ZEDLMSG = &STR(*** THE CREATED JCL WAS SUBMITTED + ***) ISPEXEC SETMSG MSG(UTLZ000) END END IF &STR(&ZCMD) = &STR(SHOW ERRORS) THEN + ISPEXEC CONTROL ERRORS RETURN IF &STR(&MODE) = CLIST THEN + DO SET CMPENVIR = SET LANG = END IF &STR(&JCLREVEW) = Y THEN + GOTO REDISPLAY ELSE + GOTO FINISH /********************************************************************** /* DISPLAY THE HELP TUTORIAL * /********************************************************************** HELPSEC: + ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR COMPILE UTILITY + *** NO PROCESSING PERFORMED ***) ISPEXEC SETMSG MSG(UTLZ000) EXIT ./ ADD NAME=COMPMARK ISREDIT MACRO (OPT1,OPT2) ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT IF &OPT1 = HELP THEN GOTO HELPSEC /********************************************************************** /* UTILITY: COMPMARK * /* AUTHOR: DAVID LEIGH * /* UTILITY: MARK THE COMPILER MESSAGES IN THE COBOL PROGRAM YOU ARE * /* EDITING BY INTERROGATING A COMPILE LISTING DATASET. * /********************************************************************** SET CMBAD = NO ISPEXEC VPUT CMBAD SHARED ISREDIT RESET IF &OPT1 = SPECIFY OR &OPT2 = SPECIFY THEN GOTO SPECSEC /********************************************************************** /* IN THIS NEXT SECTION, PROJECT SPECIFIC CODE SHOULD BE INSERTED TO * /* SPECIFY THE FORMAT OF THE DATASET NAME WHICH CONTAINS THE COMPILE * /* LISTING. CODE ALSO EXISTS TO ALLOW THE USER TO SPECIFY A DATASET * /* NAME IF THEIR LISTING IS IN A NON-STANDARD NAME. * /********************************************************************** ISREDIT (MBR) = MEMBER SET DSN = &STR(&SYSUID..COMPILE.LISTING.&MBR) GOTO GETERROR /********************************************************************** /* THE FOLLOWING SECTION OF CODE PERMITS A USER TO SPECIFY THAT THE * /* DATASET CONTAINING THE COMPILED LISTING IS NOT A STANDARD DATASET * /* (I.E. NOT FOLLOWING PROJECT CONVENTIONS) AND TO SPECIFY WHICH * /* DATASET CONTAINS THE COMPILED LISTING. * /********************************************************************** SPECSEC: + WRITENR ENTER FULLY QUALIFIED COMPILE LISTING DATASET NAME ==> READ DSN IF &STR(&DSN) = THEN + DO SET ZEDLMSG = &STR(*** NO LISTING DATASET NAME ENTERED *** + PROCESSING TERMINATED ***) ISPEXEC SETMSG MSG(UTLZ000) EXIT END /********************************************************************** /* THE FOLLOWING SECTION OF CODE PERMITS A PROJECT TO SPECIFY THAT * /* COBOL OR COBOL II IS THE DEFAULT LANGUAGE. IF THE USER PASSES * /* "COBOL" OR "COBOLII" THEN THEY MAY OVERRIDE THE DEFAULT. * /********************************************************************** GETERROR: + SET TYPE = COBOL2 /*** ENTER PROJECT DEFAULT HERE ***/ IF &OPT1 = COBOL OR &OPT1 = COBOLII OR &OPT1 = COBOL2 THEN + SET TYPE = &OPT1 IF &OPT2 = COBOL OR &OPT2 = COBOLII OR &OPT2 = COBOL2 THEN + SET TYPE = &OPT2 IF &TYPE = COBOL2 OR &TYPE = COBOLII THEN SET TYPE = COB2 IF &TYPE = COBOL THEN SET TYPE = COB SET ZEDLMSG = &STR(*** EXTRACTING COMPILER MESSAGES FROM "&DSN" ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) ISPEXEC EDIT DATASET('&DSN') MACRO(CMMK&TYPE) PROFILE(SYSPRINT) /********************************************************************** /* PROCESS INFORMATIONAL MESSAGES * /********************************************************************** ISPEXEC VGET CMNUMINF SHARED IF &CMNUMINF > 0 THEN + DO SET ZEDLMSG = &STR(*** MARKING INFORMATIONAL + MESSAGES IN THE CODE ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) SET TYPE = I SYSCALL PROCESS_MESSAGES TYPE CMNUMINF END /********************************************************************** /* PROCESS WARNING MESSAGES * /********************************************************************** ISPEXEC VGET CMNUMWAR SHARED IF &CMNUMWAR > 0 THEN + DO SET ZEDLMSG = &STR(*** MARKING WARNING + MESSAGES IN THE CODE ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) SET TYPE = W SYSCALL PROCESS_MESSAGES TYPE CMNUMWAR END /********************************************************************** /* PROCESS ERROR MESSAGES * /********************************************************************** ISPEXEC VGET CMNUMERR SHARED IF &CMNUMERR > 0 THEN + DO SET ZEDLMSG = &STR(*** MARKING ERROR + MESSAGES IN THE CODE ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) SET TYPE = E SYSCALL PROCESS_MESSAGES TYPE CMNUMERR END /********************************************************************** /* PROCESS SEVERE MESSAGES * /********************************************************************** ISPEXEC VGET CMNUMSEV SHARED IF &CMNUMSEV > 0 THEN + DO SET ZEDLMSG = &STR(*** MARKING SEVERE + MESSAGES IN THE CODE ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) SET TYPE = S SYSCALL PROCESS_MESSAGES TYPE CMNUMSEV END /********************************************************************** /* PROCESS "UNABLE TO CONTINUE" MESSAGES * /********************************************************************** ISPEXEC VGET CMNUMUNA SHARED IF &CMNUMUNA > 0 THEN + DO SET ZEDLMSG = &STR(*** MARKING "UNABLE TO CONTINUE" + MESSAGES IN THE CODE ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) SET TYPE = U SYSCALL PROCESS_MESSAGES TYPE CMNUMUNA END /********************************************************************** /* POSITION THE USER AT THE TOP WITH SOME MESSAGES * /********************************************************************** SET KEY = SELECT (&STR(&OPT1)) WHEN (1 ³ 01 ³ F1 ³ F01 ³ PF1 ³ PF01) SET KEY = ZPF01 WHEN (2 ³ 02 ³ F2 ³ F02 ³ PF2 ³ PF02) SET KEY = ZPF02 WHEN (3 ³ 03 ³ F3 ³ F03 ³ PF3 ³ PF03) SET KEY = ZPF03 WHEN (4 ³ 04 ³ F4 ³ F04 ³ PF4 ³ PF04) SET KEY = ZPF04 WHEN (5 ³ 05 ³ F5 ³ F05 ³ PF5 ³ PF05) SET KEY = ZPF05 WHEN (6 ³ 06 ³ F6 ³ F06 ³ PF6 ³ PF06) SET KEY = ZPF06 WHEN (7 ³ 07 ³ F7 ³ F07 ³ PF7 ³ PF07) SET KEY = ZPF07 WHEN (8 ³ 08 ³ F8 ³ F08 ³ PF8 ³ PF08) SET KEY = ZPF08 WHEN (9 ³ 09 ³ F9 ³ F09 ³ PF9 ³ PF09) SET KEY = ZPF09 WHEN (10 ³ 10 ³ F10 ³ PF10) SET KEY = ZPF10 WHEN (11 ³ 11 ³ F11 ³ PF11) SET KEY = ZPF11 WHEN (12 ³ 12 ³ F12 ³ PF12) SET KEY = ZPF12 WHEN (13 ³ 13 ³ F13 ³ PF13) SET KEY = ZPF13 WHEN (14 ³ 14 ³ F14 ³ PF14) SET KEY = ZPF14 WHEN (15 ³ 15 ³ F15 ³ PF15) SET KEY = ZPF15 WHEN (16 ³ 16 ³ F16 ³ PF16) SET KEY = ZPF16 WHEN (17 ³ 17 ³ F17 ³ PF17) SET KEY = ZPF17 WHEN (18 ³ 18 ³ F18 ³ PF18) SET KEY = ZPF18 WHEN (19 ³ 19 ³ F19 ³ PF19) SET KEY = ZPF19 WHEN (20 ³ 20 ³ F20 ³ PF20) SET KEY = ZPF20 WHEN (21 ³ 21 ³ F21 ³ PF21) SET KEY = ZPF21 WHEN (22 ³ 22 ³ F22 ³ PF22) SET KEY = ZPF22 WHEN (23 ³ 23 ³ F23 ³ PF23) SET KEY = ZPF23 WHEN (24 ³ 24 ³ F24 ³ PF24) SET KEY = ZPF24 END SELECT (&STR(&OPT2)) WHEN (1 ³ 01 ³ F1 ³ F01 ³ PF1 ³ PF01) SET KEY = ZPF01 WHEN (2 ³ 02 ³ F2 ³ F02 ³ PF2 ³ PF02) SET KEY = ZPF02 WHEN (3 ³ 03 ³ F3 ³ F03 ³ PF3 ³ PF03) SET KEY = ZPF03 WHEN (4 ³ 04 ³ F4 ³ F04 ³ PF4 ³ PF04) SET KEY = ZPF04 WHEN (5 ³ 05 ³ F5 ³ F05 ³ PF5 ³ PF05) SET KEY = ZPF05 WHEN (6 ³ 06 ³ F6 ³ F06 ³ PF6 ³ PF06) SET KEY = ZPF06 WHEN (7 ³ 07 ³ F7 ³ F07 ³ PF7 ³ PF07) SET KEY = ZPF07 WHEN (8 ³ 08 ³ F8 ³ F08 ³ PF8 ³ PF08) SET KEY = ZPF08 WHEN (9 ³ 09 ³ F9 ³ F09 ³ PF9 ³ PF09) SET KEY = ZPF09 WHEN (10 ³ 10 ³ F10 ³ PF10) SET KEY = ZPF10 WHEN (11 ³ 11 ³ F11 ³ PF11) SET KEY = ZPF11 WHEN (12 ³ 12 ³ F12 ³ PF12) SET KEY = ZPF12 WHEN (13 ³ 13 ³ F13 ³ PF13) SET KEY = ZPF13 WHEN (14 ³ 14 ³ F14 ³ PF14) SET KEY = ZPF14 WHEN (15 ³ 15 ³ F15 ³ PF15) SET KEY = ZPF15 WHEN (16 ³ 16 ³ F16 ³ PF16) SET KEY = ZPF16 WHEN (17 ³ 17 ³ F17 ³ PF17) SET KEY = ZPF17 WHEN (18 ³ 18 ³ F18 ³ PF18) SET KEY = ZPF18 WHEN (19 ³ 19 ³ F19 ³ PF19) SET KEY = ZPF19 WHEN (20 ³ 20 ³ F20 ³ PF20) SET KEY = ZPF20 WHEN (21 ³ 21 ³ F21 ³ PF21) SET KEY = ZPF21 WHEN (22 ³ 22 ³ F22 ³ PF22) SET KEY = ZPF22 WHEN (23 ³ 23 ³ F23 ³ PF23) SET KEY = ZPF23 WHEN (24 ³ 24 ³ F24 ³ PF24) SET KEY = ZPF24 END IF &STR(&KEY) > THEN + DO SET ZEDLMSG = &STR(*** PRESS &SUBSTR(2:5,&STR(&KEY)) TO SEE + THE MARKED LINES ***) SET &&KEY = &STR(LOCATE NEXT SPECIAL) ISPEXEC VPUT &KEY PROFILE END ELSE + SET ZEDLMSG = &STR(*** TYPE "L SPE" TO SEE THE MARKED LINES ***) IF &CMNUMINF = 0 AND &CMNUMWAR = 0 AND &CMNUMERR = 0 AND + &CMNUMSEV = 0 AND &CMNUMUNA = 0 THEN + SET ZEDLMSG = &STR(*** NO COMPILER MESSAGES TO MARK OR NONE + SELECTED TO MARK ***) ISREDIT LOCATE .ZLAST ISREDIT UP MAX ISREDIT (NUM1,NUM2) = NUMBER IF &STR(&NUM1) = ON AND &SYSINDEX(&STR(COBOL),&STR(&NUM2)) > 0 AND + (&CMNUMINF > 0 OR &CMNUMWAR = 0 OR &CMNUMERR = 0 OR + &CMNUMSEV = 0 OR &CMNUMUNA = 0) THEN + ISREDIT RIGHT 6 ISPEXEC SETMSG MSG(UTLZ000W) EXIT /********************************************************************** /* PROCESS THE MESSAGES OF A GIVEN TYPE * /********************************************************************** PROCESS_MESSAGES: PROC 2 TYPE NUMBER SYSREF TYPE NUMBER DO &I = 1 TO &NUMBER SET X = &SUBSTR(&LENGTH(&STR(000&I))-3:&LENGTH(&STR(000&I)),+ &STR(000&I) ISPEXEC VGET (CM&TYPE&X.M CM&TYPE&X.L CM&TYPE&X.O) SHARED SYSCALL INSERT_MESSAGE TYPE CM&TYPE&X.M CM&TYPE&X.L CM&TYPE&X.O IF &EVAL(&I//10) = 0 THEN + DO SET ZEDLMSG = &STR(*** PROCESSED &I OF + &NUMBER TYPE "&TYPE" MESSAGES ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) END END RETURN END /********************************************************************** /* INSERT A SPECIFIC MESSAGE * /********************************************************************** INSERT_MESSAGE: PROC 4 TYPE MESSAGE LINE OCCURANCE SYSREF TYPE MESSAGE LINE OCCURANCE SET PREFIX = &STR(** &TYPE **) IF &SYSINDEX(&STR('),&SYSNSUB(1,&LINE)) > 0 THEN + IF &SYSINDEX(&STR("),&SYSNSUB(1,&LINE)) > 0 THEN + SET NOMARK = YES ELSE + SET QT = &STR(") ELSE + SET QT = &STR(') ISREDIT (NUM1,NUM2) = NUMBER IF &SYSINDEX(&STR(COBOL),&STR(&NUM1)) > 0 OR + &SYSINDEX(&STR(COBOL),&STR(&NUM2)) > 0 THEN + SET COL1 = 1 ELSE SET COL1 = 7 ISREDIT (VAR1,VAR2) = BOUNDS ISREDIT NUMBER OFF ISREDIT (LRECL) = LRECL ISREDIT BOUNDS = 1 &LRECL ISREDIT FIND &QT&STR(&LINE)&QT FIRST &COL1 SET FINDCC = &LASTCC DO &I = 2 TO &OCCURANCE WHILE &LASTCC = 0 AND &FINDCC = 0 ISREDIT FIND &QT&STR(&LINE)&QT NEXT &COL1 END IF &NOMARK = YES OR &FINDCC > 0 THEN + DO ISPEXEC VGET CMBAD SHARED IF &CMBAD = NO THEN + DO SET CMBAD = YES ISPEXEC VPUT CMBAD SHARED SET INSERT = &STR(******* UNABLE TO MARK THE + FOLLOWING MESSAGES AT THE PROPER + PROGRAM LINE *******) ISREDIT LINE_BEFORE .ZFIRST = MSGLINE (INSERT) END ISREDIT FIND FIRST P'=' END DO WHILE &STR(&SYSNSUB(1,&MESSAGE)) > SET LEN = &LENGTH(&STR(&SYSNSUB(1,&MESSAGE))) SET X = 63 IF &LEN < &X THEN + SET X = &LEN ELSE + DO WHILE &SYSINDEX(&STR( ),&STR(&SYSNSUB(1,&MESSAGE))) > 0 AND + &SUBSTR(&X:&X,&STR(&SYSNSUB(1,&MESSAGE))) > &STR( ) SET X = &X - 1 END SET INSERT = &STR(&PREFIX &SUBSTR(1:&X,&SYSNSUB(1,&MESSAGE))) ISREDIT LINE_BEFORE .ZCSR = MSGLINE (INSERT) IF &X = &LEN THEN SET MESSAGE = ELSE + DO SET X = &X + 1 IF &X ¬> &LEN THEN + SET MESSAGE = &SUBSTR(&X:&LEN,+ &STR(&SYSNSUB(1,&MESSAGE))) END END IF &NOMARK = YES OR &FINDCC > 0 THEN + DO SET INSERT = &STR(&PREFIX &LINE) ISPEXEC LINE_BEFORE .ZFIRST = MSGLINE (INSERT) END ISREDIT NUMBER = &NUM1 &NUM2 ISREDIT BOUNDS = &VAR1 &VAR2 RETURN END HELPSEC: + ISPEXEC SELECT PGM(ISPTUTOR) PARM(UTILH031) SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR COMPMARK UTILITY + *** NO PROCESSING PERFORMED ***) ISPEXEC SETMSG MSG(UTLZ000) EXIT ./ ADD NAME=COMPME ISREDIT MACRO (OPT1,OPT2,OPT3) ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT IF &OPT1 = &STR(HELP) OR + &OPT2 = &STR(HELP) OR + &OPT3 = &STR(HELP) THEN + GOTO HELPSEC /********************************************************************** /* UTILITY: COMPME * /* AUTHOR: DAVE LEIGH * /* FUNCTION: BRANCH TO PARAGRAPHS/SECTIONS BASED ON PERFORM AND GOTO * /* STATEMENTS. THIS EDIT MACRO WORKS IN CONJUNCTION WITH * /* EDIT MACRO BRANCHBK WHICH TAKES YOU BACK TO WHERE YOU * /* WERE. * /********************************************************************** /********************************************************************** /* DO THE SUBMIT EDIT IF THAT'S WHAT WE'RE DOING. * /********************************************************************** ISPEXEC VGET (COMPTYPE COMPMBR COMPLIBR) SHARED IF &STR(&COMPTYPE) > THEN + DO IF &SYSINDEX(&STR($CC),&STR(&COMPTYPE)) = 0 THEN + DO ISREDIT FIND FIRST '//*CICS SECTION BEGIN' ISREDIT LABEL .ZCSR = .A ISREDIT FIND FIRST '//*CICS SECTION END' ISREDIT LABEL .ZCSR = .B ISREDIT DELETE .A .B END IF &SYSINDEX(&STR(X$),&STR(&COMPTYPE)) = 1 THEN + DO ISREDIT CHANGE FIRST + 'MEMBER=%%%%%%%%' 'MEMBER=&COMPMBR,' ISREDIT CHANGE FIRST '//*XPEDITERSIR' '// ' END IF &STR(&COMPLIBR) ¬= &STR(ISPLLIB) THEN + DO ISREDIT FIND FIRST '//*ISPLLIB SECTION BEGIN' ISREDIT LABEL .ZCSR = .A ISREDIT FIND FIRST '//*ISPLLIB SECTION END' ISREDIT LABEL .ZCSR = .B ISREDIT DELETE .A .B END IF &STR(&COMPLIBR) ¬= &STR(SLSSTST) THEN + DO ISREDIT FIND FIRST '//*SLSSTST SECTION BEGIN' ISREDIT LABEL .ZCSR = .A ISREDIT FIND FIRST '//*SLSSTST SECTION END' ISREDIT LABEL .ZCSR = .B ISREDIT DELETE .A .B END ISREDIT CHANGE '$$$$$$$$' '&COMPTYPE' ALL ISREDIT CHANGE '%%%%%%%%' '&COMPMBR' ALL SET COMPTYPE = SET COMPMBR = ISPEXEC VPUT (COMPTYPE COMPMBR) SHARED ISREDIT SUBMIT .ZFIRST .ZLAST ISREDIT REPLACE ##ZSUB .ZFIRST .ZLAST ISREDIT CANCEL EXIT END /********************************************************************** /* SAVE OUR LOCATION SAVE THE DATASET AND SET SOME VARIABLES. * /********************************************************************** SET COMPLIBR = IF &STR(&OPT1) = &STR(ISPLLIB) OR + &STR(&OPT2) = &STR(ISPLLIB) OR + &STR(&OPT3) = &STR(ISPLLIB) THEN + SET COMPLIBR = ISPLLIB IF &STR(&OPT1) = &STR(SLSSTST) OR + &STR(&OPT2) = &STR(SLSSTST) OR + &STR(&OPT3) = &STR(SLSSTST) THEN + SET COMPLIBR = SLSSTST ISREDIT (LN,CL) = CURSOR ISREDIT (COMPMBR) = MEMBER IF &STR(&OPT1) = SAVE OR + &STR(&OPT2) = SAVE OR + &STR(&OPT3) = SAVE THEN + ISREDIT SAVE /********************************************************************** /* WHAT EDIT PROFILE NUMBERING SCHEME IS BEING USED? * /********************************************************************** ISREDIT (X,Y) = NUMBER IF &X = ON AND &SYSINDEX(&STR( COBOL),&STR(&Y)) > 0 THEN + DO SET COL1 = 1 SET COL2 = 66 END ELSE + DO SET COL1 = 7 SET COL2 = 72 END /********************************************************************** /* IF WE'RE BEFORE THE PROCEDURE DIVISION, GO THERE. * /********************************************************************** ISREDIT FIND ' PROCEDURE ' &COL1 &EVAL(&COL1 + 10 + 3) ISREDIT FIND FIRST ' EXEC CICS ' IF &LASTCC = 0 THEN SET COMPTYPE = &STR($CCOB2) ELSE SET COMPTYPE = &STR($COB2) SET COMPTYPE = &STR(X&COMPTYPE) /* IF &OPT1 = X THEN SET COMPTYPE = &STR(X&COMPTYPE) /* ELSE SET COMPTYPE = &STR(T&COMPTYPE) /********************************************************************** /* GO EDIT THE COMPME JCL AND SUBMIT IT. * /********************************************************************** ISPEXEC VPUT (COMPTYPE COMPMBR COMPLIBR) SHARED ISPEXEC EDIT DATASET('&SYSPREF..STR.JCLLIB(COMPILE)') MACRO(COMPME) ISREDIT CURSOR = &LN &CL SET ZEDSMSG = &STR(COMPILE SUBMITTED) ISPEXEC SETMSG MSG(UTLZ000) EXIT HELPSEC: + 02480000 ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) 02490000 SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR COMPME UTILITY + 02490000 *** NO PROCESSING PERFORMED ***) 02490000 ISPEXEC SETMSG MSG(UTLZ000) 02490000 EXIT ./ ADD NAME=COMPONEN PROC 0 HELP DSN() EDIT CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /* STANDARD INITIAL */ ERROR DO /* PROCESSING : */ SET MODE = CLIST /* 1. INVOCATION */ RETURN /* MODE ? */ END /* */ ISREDIT MACRO (HELP) /* */ ERROR OFF /* */ ISPEXEC CONTROL ERRORS RETURN /* LOGGING */ ISPEXEC VGET (DBGSWTCH) PROFILE /* 3. DEBUG MESSAGES*/ IF &DBGSWTCH = &STR(ON) THEN /* BASED ON */ + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH /* "DBGSWTCH" */ ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /* VARIABLE. */ IF &HELP = HELP THEN GOTO HELPSEC /* 4. DISPLAY HELP */ /**********************************************************************/ /* UTILITY NAME : COMPONEN */ /* AUTHOR : DAVE LEIGH */ /* DESCRIPTION : EXTRACT WHAT COMPONENTS ARE A PART OF A GIVEN CLIST */ /* AND PLACE THE RESULTS IN A FILE. */ /**********************************************************************/ /********************************************************************** /* IF CALLED AS A CLIST, THEN START THE EDITING PROCESS. * /********************************************************************** IF &MODE = CLIST THEN + IF &STR(&DSN) = THEN + DO SET ZEDLMSG = &STR(NO CLIST DATASET NAME SPECIFIED. + NO PROCESSING PERFORMED) ISPEXEC SETMSG MSG(UTLZ001) EXIT END ELSE + DO SET CMPLVL = 0 IF &EDIT = EDIT THEN SET CMPEDIT = YES ISPEXEC VPUT (CMPLVL CMPEDIT) SHARED ISPEXEC EDIT DATASET('&DSN') MACRO(COMPONEN) EXIT END ELSE + DO IF &HELP = EDIT THEN + SET CMPEDIT = YES ELSE SET CMPEDIT = NO ISPEXEC VGET CMPTYPE SHARED IF &CMPTYPE = THEN + SET CMPTYPE = CLIST ISPEXEC VPUT (CMPEDIT CMPTYPE) SHARED ISREDIT (MBR) = MEMBER ISREDIT (DSN) = DATASET IF &MBR > THEN SET DSN = &STR(&DSN(&MBR)) SET ZEDLMSG = &STR(GATHERING COMPONENTS IN "&DSN") ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000) END /********************************************************************** /* IF THE NESTING LEVEL IS 0 THEN DO SOME INITIALIZATION * /********************************************************************** ISPEXEC VGET (CMPEDIT CMPLVL CMPDSN CMPTYPE) SHARED IF &STR(&CMPLVL) < 1 THEN SET &CMPLVL = 0 IF &STR(&CMPLVL) = 0 THEN + DO SET CMPTYPE = CLIST IF &STR(&MBR) > THEN + SET CMPDSN = &STR(&SYSPREF..TEMP.COMPONEN.&MBR) ELSE + DO &I = &LENGTH(&STR(&DSN)) TO 1 BY -1 IF &SUBSTR(&I:&I,&STR(&DSN)) = &STR(.) THEN + DO SET I = &I + 1 SET CMPDSN = &STR(&SYSPREF..TEMP.+ COMPONEN.+ &SUBSTR(&I,&LENGTH(&STR(&DSN)),+ &STR(&DSN)) SET I = 0 END END DO &I = &LENGTH(&STR(&CMPDSN)) TO 1 BY -1 IF &SUBSTR(&I:&I,&STR(&CMPDSN)) = &STR(.) THEN + DO SET I = &I + 1 SET CMPMBR = &SUBSTR(&I:&LENGTH(&STR(&CMPDSN)),+ &STR(&CMPDSN)) SET I = 0 END END SET ISPPLIB = SET ISPMLIB = SET ISPTLIB = SET ISPSLIB = SET ISPLLIB = SET ISPCLIB = ISPEXEC VPUT (CMPLVL ISPPLIB ISPMLIB ISPTLIB ISPSLIB + ISPLLIB ISPCLIB CMPDSN TYPE CMPMBR) SHARED DELETE '&CMPDSN' FREE DD(CMPDD) ALLOC DD(CMPDD) DSN('&CMPDSN') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK$$$) + SPACE(5,5) TRACKS RELEASE + RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS) OPENFILE CMPDD OUTPUT SET CMPDD = &STR(<&SUBSTR(1:8,&STR(&CMPMBR ))> + ISPCLIB: &CMPMBR) PUTFILE CMPDD CLOSFILE CMPDD END /********************************************************************** /* VGET SOME VARIABLE AND SET SOME VARIABLES. * /********************************************************************** SET VARVALUE = &STR(***VARIABLE***) ISPEXEC VGET (CMPLVL ISPPLIB ISPMLIB ISPTLIB ISPSLIB + ISPLLIB ISPCLIB CMPDSN TYPE CMPMBR) SHARED DO &I = 1 TO &CMPLVL BY 1 SET PFX = &STR(&PFX ) END SET PFX = &STR(<&SUBSTR(1:8,&STR(&CMPMBR ))> &PFX) SET CMPLVL = &CMPLVL + 1 ISPEXEC VPUT CMPLVL SHARED FREE DD(CMPDD) ALLOC DD(CMPDD) DSN('&CMPDSN') MOD OPENFILE CMPDD OUTPUT SET LP = &STR(( SET RP = &STR()) /********************************************************************** /* PROCESS DIFFERENTLY IF A CLIST, PANEL, OR SKELETON * /********************************************************************** SELECT (&CMPTYPE) WHEN (CLIST) GOTO CLIST_SECTION WHEN (PANEL) GOTO PANEL_SECTION WHEN (SKELETON) GOTO SKELETON_SECTION OTHERWISE EXIT CODE(20) END /********************************************************************** /* ACTUALLY PARSE THE CLIST NOW AND PUT THE INFO TO THE OUTPUT DATASET* /********************************************************************** CLIST_SECTION: + ISREDIT (LRECL) = LRECL ISREDIT BOUNDS = 1 &LRECL ISREDIT EXCLUDE ALL ISREDIT FIND ALL 'EXEC ' ISREDIT FIND ALL '%' ISREDIT FIND ALL ' MACRO(' ISREDIT EXCLUDE ALL "/" 1 ISREDIT EXCLUDE ALL 'REXX EXEC' ISREDIT EXCLUDE ALL 'EXEC PGM=' ISREDIT EXCLUDE ALL 'ISPEXEC CONTROL ' ISREDIT EXCLUDE ALL 'ISPEXEC LIBDEF ' ISREDIT EXCLUDE ALL 'ISPEXEC BROWSE ' ISREDIT EXCLUDE ALL 'ISPEXEC LM' ISREDIT EXCLUDE ALL 'ISPEXEC VPUT ' ISREDIT EXCLUDE ALL 'ISPEXEC VGET ' ISREDIT EXCLUDE ALL 'WRITE ' 1 ISREDIT EXCLUDE ALL '(%)' ISREDIT FIND FIRST P'=' 1 NX DO WHILE &LASTCC = 0 SET PANELTOO = NO ISREDIT FIND FIRST 'ISPEXEC ' .ZCSR .ZCSR IF &LASTCC = 0 THEN DO ISREDIT FIND NEXT ' SELECT ' .ZCSR .ZCSR IF &LASTCC = 0 THEN DO ISREDIT LABEL .ZCSR = .CURR ISREDIT FIND NEXT P'¬' .ZCSR .ZCSR ISREDIT FIND NEXT ' ' .ZCSR .ZCSR ISREDIT FIND NEXT P'¬' .ZCSR .ZCSR ISREDIT (NULL,COL1) = CURSOR ISREDIT FIND NEXT '(' .ZCSR .ZCSR ISREDIT (NULL,COL2) = CURSOR SET COL2 = &COL2 - 1 ISREDIT (TYPE) = LINE .ZCSR ISREDIT LINE_BEFORE .ZCSR = (TYPE) ISREDIT FIND FIRST P'=' 1 .ZCSR .ZCSR ISREDIT FIND PREV P'=' 1 ISREDIT CHANGE P'=' ' ' 1 &EVAL(&COL1-1) + ALL .ZCSR .ZCSR ISREDIT CHANGE P'=' ' ' &EVAL(&COL2+1) &LRECL + ALL .ZCSR .ZCSR ISREDIT (TYPE) = LINE .ZCSR ISREDIT DELETE .ZCSR SET TYPE = &TYPE SELECT (&TYPE) WHEN (PANEL) DO PANEL_TOO: SET COL1 = &COL2 + 2 ISREDIT FIND FIRST P'=' &COL1 .CURR .CURR ISREDIT FIND NEXT ')' .ZCSR .ZCSR ISREDIT (NULL,COL2) = CURSOR SET COL2 = &COL2 - 1 ISREDIT (XPANEL) = LINE .ZCSR ISREDIT LINE_BEFORE .ZCSR = (XPANEL) ISREDIT FIND FIRST P'=' 1 .ZCSR .ZCSR ISREDIT FIND PREV P'=' 1 ISREDIT CHANGE P'=' ' ' 1 &EVAL(&COL1-1) + ALL .ZCSR .ZCSR ISREDIT CHANGE P'=' ' ' &EVAL(&COL2+1) &LRECL + ALL .ZCSR .ZCSR ISREDIT FIND FIRST '&&' .ZCSR .ZCSR IF &LASTCC = 0 THEN + SET XPANEL = &STR(&VARVALUE) ELSE + DO ISREDIT (XPANEL) = LINE .ZCSR SET XPANEL = &XPANEL IF &LENGTH(&STR(&XPANEL)) = 0 THEN + SET XPANEL = &STR(&VARVALUE) END ISREDIT DELETE .ZCSR ISPEXEC VGET ISPPLIB SHARED IF &SYSINDEX(&STR( &XPANEL ),+ &STR(&ISPPLIB)) = 0 AND + &STR(&XPANEL) ¬= &STR(&VARVALUE) THEN + DO SET ISPPLIB = &STR(&ISPPLIB &XPANEL ) SET CMPDD = &STR(&PFX.ISPPLIB: &XPANEL) PUTFILE CMPDD ISPEXEC VPUT ISPPLIB SHARED ISPEXEC SELECT + CMD(%FINDMOD &XPANEL ISPPLIB BATCH) IF &LASTCC = 0 THEN + DO ISPEXEC VGET DSN SHARED CLOSFILE CMPDD SET CMPTYPE = PANEL ISPEXEC VPUT CMPTYPE SHARED ISPEXEC EDIT DATASET('&DSN') + MACRO(COMPONEN) SET CMPTYPE = CLIST ISPEXEC VPUT CMPTYPE SHARED FREE DD(CMPDD) ALLOC DD(CMPDD) DSN('&CMPDSN') MOD OPENFILE CMPDD OUTPUT END END IF &PANELTOO = YES THEN GOTO PANEL_TOO_GOBACK END WHEN (PGM) DO SET COL1 = &COL2 + 2 ISREDIT FIND FIRST P'=' &COL1 .CURR .CURR ISREDIT FIND NEXT ')' .ZCSR .ZCSR ISREDIT (NULL,COL2) = CURSOR SET COL2 = &COL2 - 1 ISREDIT (XPGM) = LINE .ZCSR ISREDIT LINE_BEFORE .ZCSR = (XPGM) ISREDIT FIND FIRST P'=' 1 .ZCSR .ZCSR ISREDIT FIND PREV P'=' 1 ISREDIT CHANGE P'=' ' ' 1 &EVAL(&COL1-1) + ALL .ZCSR .ZCSR ISREDIT CHANGE P'=' ' ' &EVAL(&COL2+1) &LRECL + ALL .ZCSR .ZCSR ISREDIT FIND FIRST '&&' .ZCSR .ZCSR IF &LASTCC = 0 THEN + SET XPGM = &STR(&VARVALUE) ELSE + DO ISREDIT (XPGM) = LINE .ZCSR SET XPGM = &XPGM IF &LENGTH(&STR(&XPGM)) = 0 THEN + SET XPGM = &STR(&VARVALUE) END ISREDIT DELETE .ZCSR ISPEXEC VGET ISPLLIB SHARED IF &SYSINDEX(&STR( &XPGM ),+ &STR(&ISPLLIB)) = 0 AND + &STR(&XPGM) ¬= &STR(&VARVALUE) THEN + DO SET ISPLLIB = &STR(&ISPLLIB &XPGM ) SET CMPDD = &STR(&PFX.ISPLLIB: &XPGM) PUTFILE CMPDD ISPEXEC VPUT ISPLLIB SHARED END END WHEN (CMD) DO SET COL1 = &COL2 + 2 ISREDIT FIND FIRST P'=' &COL1 .CURR .CURR ISREDIT FIND NEXT ')' .ZCSR .ZCSR ISREDIT (NULL,COL2) = CURSOR ISREDIT FIND FIRST P'=' &COL1 .CURR .CURR ISREDIT FIND NEXT ' ' .ZCSR .ZCSR ISREDIT (NULL,COL2X) = CURSOR IF &COL2X < &COL2 THEN SET COL2 = &COL2X SET COL2 = &COL2 - 1 ISREDIT (XCMD) = LINE .ZCSR ISREDIT LINE_BEFORE .ZCSR = (XCMD) ISREDIT FIND FIRST P'=' 1 .ZCSR .ZCSR ISREDIT FIND PREV P'=' 1 ISREDIT CHANGE P'=' ' ' 1 &EVAL(&COL1-1) + ALL .ZCSR .ZCSR ISREDIT CHANGE P'=' ' ' &EVAL(&COL2+1) &LRECL + ALL .ZCSR .ZCSR ISREDIT FIND FIRST '&&' .ZCSR .ZCSR IF &LASTCC = 0 THEN + SET XCMD = &STR(&VARVALUE) ELSE + DO ISREDIT (XCMD) = LINE .ZCSR SET XCMD = &XCMD IF &LENGTH(&STR(&XCMD)) = 0 THEN + SET XCMD = &STR(&VARVALUE) END ISREDIT DELETE .ZCSR IF &SUBSTR(1:1,&STR(&XCMD)) = &STR(%) THEN + SET XCMD = &SUBSTR(2:&LENGTH(&STR(&XCMD)),+ &STR(&XCMD)) ISPEXEC VGET ISPCLIB SHARED IF &SYSINDEX(&STR( &XCMD ),+ &STR(&ISPCLIB)) = 0 AND + &STR(&XCMD) ¬= &STR(&VARVALUE) THEN + DO SET ISPCLIB = &STR(&ISPCLIB &XCMD ) SET CMPDD = &STR(&PFX.ISPCLIB: &XCMD) PUTFILE CMPDD ISPEXEC VPUT ISPCLIB SHARED ISPEXEC SELECT + CMD(%FINDMOD &XCMD SYSPROC BATCH) IF &LASTCC = 0 THEN + DO ISPEXEC VGET DSN SHARED CLOSFILE CMPDD ISPEXEC EDIT DATASET('&DSN') + MACRO(COMPONEN) FREE DD(CMPDD) ALLOC DD(CMPDD) DSN('&CMPDSN') MOD OPENFILE CMPDD OUTPUT END END END OTHERWISE END END ELSE DO ISREDIT FIND NEXT ' DISPLAY ' .ZCSR .ZCSR IF &LASTCC = 0 THEN DO ISREDIT LABEL .ZCSR = .CURR ISREDIT FIND NEXT P'¬' .ZCSR .ZCSR ISREDIT FIND NEXT ' ' .ZCSR .ZCSR ISREDIT FIND NEXT P'¬' .ZCSR .ZCSR ISREDIT (NULL,COL1) = CURSOR ISREDIT FIND NEXT '(' .ZCSR .ZCSR ISREDIT (NULL,COL2) = CURSOR SET COL2 = &COL2 - 1 ISREDIT (TYPE) = LINE .ZCSR ISREDIT LINE_BEFORE .ZCSR = (TYPE) ISREDIT FIND FIRST P'=' 1 .ZCSR .ZCSR ISREDIT FIND PREV P'=' 1 ISREDIT CHANGE P'=' ' ' 1 &EVAL(&COL1-1) + ALL .ZCSR .ZCSR ISREDIT CHANGE P'=' ' ' &EVAL(&COL2+1) &LRECL + ALL .ZCSR .ZCSR ISREDIT (TYPE) = LINE .ZCSR ISREDIT DELETE .ZCSR SET TYPE = &TYPE SELECT (&TYPE) WHEN (PANEL) DO SET COL1 = &COL2 + 2 ISREDIT FIND FIRST P'=' &COL1 .CURR .CURR ISREDIT FIND NEXT ')' .ZCSR .ZCSR ISREDIT (NULL,COL2) = CURSOR SET COL2 = &COL2 - 1 ISREDIT (XPANEL) = LINE .ZCSR ISREDIT LINE_BEFORE .ZCSR = (XPANEL) ISREDIT FIND FIRST P'=' 1 .ZCSR .ZCSR ISREDIT FIND PREV P'=' 1 ISREDIT CHANGE P'=' ' ' 1 &EVAL(&COL1-1) + ALL .ZCSR .ZCSR ISREDIT CHANGE P'=' ' ' &EVAL(&COL2+1) &LRECL + ALL .ZCSR .ZCSR ISREDIT FIND FIRST '&&' .ZCSR .ZCSR IF &LASTCC = 0 THEN + SET XPANEL = &STR(&VARVALUE) ELSE + DO ISREDIT (XPANEL) = LINE .ZCSR SET XPANEL = &XPANEL IF &LENGTH(&STR(&XPANEL)) = 0 THEN + SET XPANEL = &STR(&VARVALUE) END ISREDIT DELETE .ZCSR ISPEXEC VGET ISPPLIB SHARED IF &SYSINDEX(&STR( &XPANEL ),+ &STR(&ISPPLIB)) = 0 AND + &STR(&XPANEL) ¬= &STR(&VARVALUE) THEN + DO SET ISPPLIB = &STR(&ISPPLIB &XPANEL ) SET CMPDD = &STR(&PFX.ISPPLIB: &XPANEL) PUTFILE CMPDD ISPEXEC VPUT ISPPLIB SHARED ISPEXEC SELECT + CMD(%FINDMOD &XPANEL ISPPLIB BATCH) IF &LASTCC = 0 THEN + DO ISPEXEC VGET DSN SHARED CLOSFILE CMPDD SET CMPTYPE = PANEL ISPEXEC VPUT CMPTYPE SHARED ISPEXEC EDIT DATASET('&DSN') + MACRO(COMPONEN) SET CMPTYPE = CLIST ISPEXEC VPUT CMPTYPE SHARED FREE DD(CMPDD) ALLOC DD(CMPDD) DSN('&CMPDSN') + MOD OPENFILE CMPDD OUTPUT END END END WHEN (MSG) DO SET COL1 = &COL2 + 2 ISREDIT FIND FIRST P'=' &COL1 .CURR .CURR ISREDIT FIND NEXT ')' .ZCSR .ZCSR ISREDIT (NULL,COL2) = CURSOR SET COL2 = &COL2 - 1 ISREDIT (XMSG) = LINE .ZCSR ISREDIT LINE_BEFORE .ZCSR = (XMSG) ISREDIT FIND FIRST P'=' 1 .ZCSR .ZCSR ISREDIT FIND PREV P'=' 1 ISREDIT CHANGE P'=' ' ' 1 &EVAL(&COL1-1) + ALL .ZCSR .ZCSR ISREDIT CHANGE P'=' ' ' &EVAL(&COL2+1) &LRECL + ALL .ZCSR .ZCSR ISREDIT FIND FIRST '&&' .ZCSR .ZCSR IF &LASTCC = 0 THEN + SET XMSG = &STR(&VARVALUE) ELSE + DO ISREDIT (XMSG) = LINE .ZCSR SET XMSG = &XMSG IF &LENGTH(&STR(&XMSG)) = 0 THEN + SET XMSG = &STR(&VARVALUE) END ISREDIT DELETE .ZCSR ISPEXEC VGET ISPMLIB SHARED IF &SYSINDEX(&STR( &XMSG ),+ &STR(&ISPMLIB)) = 0 AND + &STR(&XMSG) ¬= &STR(&VARVALUE) THEN + DO SET ISPMLIB = &STR(&ISPMLIB &XMSG ) SET CMPDD = &STR(&PFX.ISPMLIB: &XMSG) PUTFILE CMPDD ISPEXEC VPUT ISPMLIB SHARED END END OTHERWISE END END ELSE DO ISREDIT FIND NEXT ' SETMSG ' .ZCSR .ZCSR IF &LASTCC = 0 THEN DO ISREDIT LABEL .ZCSR = .CURR ISREDIT FIND NEXT '(' .ZCSR .ZCSR ISREDIT (NULL,COL1) = CURSOR SET COL1 = &COL1 + 1 ISREDIT FIND NEXT ')' .ZCSR .ZCSR ISREDIT (NULL,COL2) = CURSOR SET COL2 = &COL2 - 1 ISREDIT (XMSG) = LINE .ZCSR ISREDIT LINE_BEFORE .ZCSR = (XMSG) ISREDIT FIND FIRST P'=' 1 .ZCSR .ZCSR ISREDIT FIND PREV P'=' 1 ISREDIT CHANGE P'=' ' ' 1 &EVAL(&COL1-1) + ALL .ZCSR .ZCSR ISREDIT CHANGE P'=' ' ' &EVAL(&COL2+1) &LRECL + ALL .ZCSR .ZCSR ISREDIT FIND FIRST '&&' .ZCSR .ZCSR IF &LASTCC = 0 THEN + SET XMSG = &STR(&VARVALUE) ELSE + DO ISREDIT (XMSG) = LINE .ZCSR SET XMSG = &XMSG IF &LENGTH(&STR(&XMSG)) = 0 THEN + SET XMSG = &STR(&VARVALUE) END ISREDIT DELETE .ZCSR ISPEXEC VGET ISPMLIB SHARED IF &SYSINDEX(&STR( &XMSG ),+ &STR(&ISPMLIB)) = 0 AND + &STR(&XMSG) ¬= &STR(&VARVALUE) THEN + DO SET ISPMLIB = &STR(&ISPMLIB &XMSG ) SET CMPDD = &STR(&PFX.ISPMLIB: &XMSG) PUTFILE CMPDD ISPEXEC VPUT ISPMLIB SHARED END END ELSE DO ISREDIT FIND NEXT ' MACRO(' .ZCSR .ZCSR IF &LASTCC = 0 THEN DO ISREDIT LABEL .ZCSR = .CURR ISREDIT FIND NEXT '(' .ZCSR .ZCSR ISREDIT (NULL,COL1) = CURSOR SET COL1 = &COL1 + 1 ISREDIT FIND NEXT ')' .ZCSR .ZCSR ISREDIT (NULL,COL2) = CURSOR SET COL2 = &COL2 - 1 ISREDIT (XCMD) = LINE .ZCSR ISREDIT LINE_BEFORE .ZCSR = (XCMD) ISREDIT FIND FIRST P'=' 1 .ZCSR .ZCSR ISREDIT FIND PREV P'=' 1 ISREDIT CHANGE P'=' ' ' 1 &EVAL(&COL1-1) + ALL .ZCSR .ZCSR ISREDIT CHANGE P'=' ' ' &EVAL(&COL2+1) &LRECL + ALL .ZCSR .ZCSR ISREDIT FIND FIRST '&&' .ZCSR .ZCSR IF &LASTCC = 0 THEN + SET XCMD = &STR(&VARVALUE) ELSE + DO ISREDIT (XCMD) = LINE .ZCSR SET XCMD = &XCMD IF &LENGTH(&STR(&XCMD)) = 0 THEN + SET XCMD = &STR(&VARVALUE) END ISREDIT DELETE .ZCSR ISPEXEC VGET ISPCLIB SHARED IF &SYSINDEX(&STR( &XCMD ),+ &STR(&ISPCLIB)) = 0 AND + &STR(&XCMD) ¬= &STR(&VARVALUE) THEN + DO SET ISPCLIB = &STR(&ISPCLIB &XCMD ) SET CMPDD = &STR(&PFX.ISPCLIB: &XCMD) PUTFILE CMPDD ISPEXEC VPUT ISPCLIB SHARED ISPEXEC SELECT + CMD(%FINDMOD &XCMD SYSPROC BATCH) IF &LASTCC = 0 THEN + DO ISPEXEC VGET DSN SHARED CLOSFILE CMPDD ISPEXEC EDIT DATASET('&DSN') + MACRO(COMPONEN) FREE DD(CMPDD) ALLOC DD(CMPDD) DSN('&CMPDSN') MOD OPENFILE CMPDD OUTPUT END END END ELSE DO ISREDIT FIND NEXT ' FTINCL ' .ZCSR .ZCSR IF &LASTCC = 0 THEN DO ISREDIT LABEL .ZCSR = .CURR ISREDIT FIND NEXT P'¬' .ZCSR .ZCSR ISREDIT FIND NEXT ' ' .ZCSR .ZCSR ISREDIT FIND NEXT P'¬' .ZCSR .ZCSR ISREDIT (NULL,COL1) = CURSOR ISREDIT FIND NEXT ' ' .ZCSR .ZCSR ISREDIT (NULL,COL2) = CURSOR SET COL2 = &COL2 - 1 ISREDIT (SKELETON) = LINE .ZCSR ISREDIT LINE_BEFORE .ZCSR = (SKELETON) ISREDIT FIND FIRST P'=' 1 .ZCSR .ZCSR ISREDIT FIND PREV P'=' 1 ISREDIT CHANGE P'=' ' ' 1 &EVAL(&COL1-1) + ALL .ZCSR .ZCSR ISREDIT CHANGE P'=' ' ' &EVAL(&COL2+1) &LRECL + ALL .ZCSR .ZCSR ISREDIT FIND FIRST '&&' .ZCSR .ZCSR IF &LASTCC = 0 THEN + SET SKELETON = &STR(&VARVALUE) ELSE + DO ISREDIT (SKELETON) = LINE .ZCSR SET SKELETON = &SKELETON IF &LENGTH(&STR(&SKELETON)) = 0 THEN + SET SKELETON = &STR(&VARVALUE) END ISREDIT DELETE .ZCSR ISPEXEC VGET ISPSLIB SHARED IF &SYSINDEX(&STR( &SKELETON ),+ &STR(&ISPSLIB)) = 0 AND + &STR(&SKELETON) ¬= &STR(&VARVALUE) THEN + DO SET ISPSLIB = &STR(&ISPSLIB &SKELETON ) SET CMPDD = &STR(&PFX.ISPSLIB: &SKELETON) PUTFILE CMPDD ISPEXEC VPUT ISPSLIB SHARED ISPEXEC SELECT + CMD(%FINDMOD &SKELETON ISPSLIB BATCH) IF &LASTCC = 0 THEN + DO ISPEXEC VGET DSN SHARED CLOSFILE CMPDD SET CMPTYPE = SKELETON ISPEXEC VPUT CMPTYPE SHARED ISPEXEC EDIT DATASET('&DSN') + MACRO(COMPONEN) SET CMPTYPE = CLIST ISPEXEC VPUT CMPTYPE SHARED FREE DD(CMPDD) ALLOC DD(CMPDD) DSN('&CMPDSN') MOD OPENFILE CMPDD OUTPUT END END END ELSE DO ISREDIT FIND NEXT ' TB' .ZCSR .ZCSR IF &LASTCC = 0 THEN DO ISREDIT FIND ' PANEL(' .ZCSR .ZCSR IF &LASTCC = 0 THEN SET PANELTOO = YES ELSE SET PANELTOO = NO ISREDIT LABEL .ZCSR = .CURR ISREDIT FIND NEXT P'¬' .ZCSR .ZCSR ISREDIT FIND NEXT ' ' .ZCSR .ZCSR ISREDIT FIND NEXT P'¬' .ZCSR .ZCSR ISREDIT (NULL,COL1) = CURSOR ISREDIT FIND NEXT ' ' .ZCSR .ZCSR ISREDIT FIND PREV P'¬' .ZCSR .ZCSR ISREDIT (NULL,COL2) = CURSOR ISREDIT (XTABLE) = LINE .ZCSR ISREDIT LINE_BEFORE .ZCSR = (XTABLE) ISREDIT FIND FIRST P'=' 1 .ZCSR .ZCSR ISREDIT FIND PREV P'=' 1 ISREDIT CHANGE P'=' ' ' 1 &EVAL(&COL1-1) + ALL .ZCSR .ZCSR ISREDIT CHANGE P'=' ' ' &EVAL(&COL2+1) &LRECL + ALL .ZCSR .ZCSR ISREDIT FIND FIRST '&&' .ZCSR .ZCSR IF &LASTCC = 0 THEN + SET XTABLE = &STR(&VARVALUE) ELSE + DO ISREDIT (XTABLE) = LINE .ZCSR SET XTABLE = &XTABLE IF &LENGTH(&STR(&XTABLE)) = 0 THEN + SET XTABLE = &STR(&VARVALUE) END ISREDIT DELETE .ZCSR ISPEXEC VGET ISPTLIB SHARED IF &SYSINDEX(&STR( &XTABLE ),+ &STR(&ISPTLIB)) = 0 AND + &STR(&XTABLE) ¬= &STR(&VARVALUE) THEN + DO SET ISPTLIB = &STR(&ISPTLIB &XTABLE ) SET CMPDD = &STR(&PFX.ISPTLIB: &XTABLE) PUTFILE CMPDD ISPEXEC VPUT ISPTLIB SHARED END IF &PANELTOO = YES THEN + DO ISREDIT FIND FIRST ' PANEL(' .CURR .CURR ISREDIT FIND NEXT '(' .ZCSR .ZCSR ISREDIT (NULL,COL2) = CURSOR SET COL2 = &COL2 - 1 GOTO PANEL_TOO PANEL_TOO_GOBACK: SET PANELTOO = NO END END END END END END END END ELSE DO ISREDIT FIND FIRST 'EXEC ' .ZCSR .ZCSR IF &LASTCC = 0 THEN + DO ISREDIT LABEL .ZCSR = .CURR ISREDIT FIND NEXT ' ' .ZCSR .ZCSR ISREDIT FIND NEXT P'¬' .ZCSR .ZCSR ISREDIT (NULL,COL1) = CURSOR ISREDIT FIND NEXT ' ' .ZCSR .ZCSR ISREDIT (NULL,COL2) = CURSOR SET COL2 = &COL2 - 1 ISREDIT FIND FIRST "'" &COL1 &COL1 .ZCSR .ZCSR IF &LASTCC = 0 THEN + DO SET EVALUATE = NO SET COL1 = &COL1 + 1 SET COL2 = &COL2 - 1 END ELSE SET EVALUATE = YES ISREDIT (CMD) = LINE .ZCSR ISREDIT LINE_BEFORE .ZCSR = (CMD) ISREDIT FIND FIRST P'=' 1 .ZCSR .ZCSR ISREDIT FIND PREV P'=' 1 ISREDIT CHANGE P'=' ' ' 1 &EVAL(&COL1-1) + ALL .ZCSR .ZCSR ISREDIT CHANGE P'=' ' ' &EVAL(&COL2+1) &LRECL + ALL .ZCSR .ZCSR ISREDIT FIND FIRST '&&' .ZCSR .ZCSR IF &LASTCC = 0 THEN + SET CMD = &STR(&VARVALUE) ELSE + DO ISREDIT (CMD) = LINE .ZCSR SET CMD = &CMD IF &LENGTH(&STR(&CMD)) = 0 THEN + SET CMD = &STR(&VARVALUE) END ISREDIT DELETE .ZCSR IF &LENGTH(&STR(&CMD)) = 0 THEN + SET CMD = &STR(&VARVALUE) IF &EVALUATE = YES AND &STR(&CMD) ¬= &STR(&VARVALUE) THEN + DO SET A = &SYSINDEX(&STR(&LP),&STR(&CMD)) SET B = &SYSINDEX(&STR(CLIST),&STR(&CMD)) IF &B = 0 THEN + IF &A > 0 THEN + SET CMD = &STR(&SYSPREF..)+ &SUBSTR(1:&A-1,&STR(&CMD))+ &STR(.CLIST)+ &SUBSTR(&A:&LENGTH(&STR(&CMD))+ &STR(&CMD)) ELSE + SET CMD = &STR(&SYSPREF..&CMD..CLIST) ELSE SET CMD = &STR(&SYSPREF..&CMD) END ISPEXEC VGET ISPCLIB SHARED IF &SYSINDEX(&STR( &CMD ),+ &STR(&ISPCLIB)) = 0 AND + &STR(&CMD) ¬= &STR(&VARVALUE) THEN + DO SET ISPCLIB = &STR(&ISPCLIB &CMD ) SET CMPDD = &STR(&PFX.ISPCLIB: &CMD) PUTFILE CMPDD ISPEXEC VPUT ISPCLIB SHARED CLOSFILE CMPDD ISPEXEC EDIT DATASET('&CMD') + MACRO(COMPONEN) FREE DD(CMPDD) ALLOC DD(CMPDD) DSN('&CMPDSN') MOD OPENFILE CMPDD OUTPUT END END ELSE DO ISREDIT FIND FIRST 'EX ' .ZCSR .ZCSR IF &LASTCC = 0 THEN DO ISREDIT LABEL .ZCSR = .CURR ISREDIT FIND NEXT ' ' .ZCSR .ZCSR ISREDIT FIND NEXT P'¬' .ZCSR .ZCSR ISREDIT (NULL,COL1) = CURSOR ISREDIT FIND NEXT ' ' .ZCSR .ZCSR ISREDIT (NULL,COL2) = CURSOR SET COL2 = &COL2 - 1 ISREDIT FIND FIRST "'" &COL1 &COL1 .ZCSR .ZCSR IF &LASTCC = 0 THEN + DO SET EVALUATE = NO SET COL1 = &COL1 + 1 SET COL2 = &COL2 - 1 END ELSE SET EVALUATE = YES ISREDIT (CMD) = LINE .ZCSR ISREDIT LINE_BEFORE .ZCSR = (CMD) ISREDIT FIND FIRST P'=' 1 .ZCSR .ZCSR ISREDIT FIND PREV P'=' 1 ISREDIT CHANGE P'=' ' ' 1 &EVAL(&COL1-1) + ALL .ZCSR .ZCSR ISREDIT CHANGE P'=' ' ' &EVAL(&COL2+1) &LRECL + ALL .ZCSR .ZCSR ISREDIT FIND FIRST '&&' .ZCSR .ZCSR IF &LASTCC = 0 THEN + SET CMD = &STR(&VARVALUE) ELSE + DO ISREDIT (CMD) = LINE .ZCSR SET CMD = &CMD IF &LENGTH(&STR(&CMD)) = 0 THEN + SET CMD = &STR(&VARVALUE) END ISREDIT DELETE .ZCSR IF &LENGTH(&STR(&CMD)) = 0 THEN + SET CMD = &STR(&VARVALUE) IF &EVALUATE = YES AND &STR(&CMD) ¬= &STR(&VARVALUE) THEN + DO SET A = &SYSINDEX(&STR(&LP),&STR(&CMD)) SET B = &SYSINDEX(&STR(CLIST),&STR(&CMD)) IF &B = 0 THEN + IF &A > 0 THEN + SET CMD = &STR(&SYSPREF..)+ &SUBSTR(1:&A-1,&STR(&CMD))+ &STR(.CLIST)+ &SUBSTR(&A:&LENGTH(&STR(&CMD))+ &STR(&CMD)) ELSE + SET CMD = &STR(&SYSPREF..&CMD..CLIST) ELSE SET CMD = &STR(&SYSPREF..&CMD) END ISPEXEC VGET ISPCLIB SHARED IF &SYSINDEX(&STR( &CMD ),+ &STR(&ISPCLIB)) = 0 AND + &STR(&CMD) ¬= &STR(&VARVALUE) THEN + DO SET ISPCLIB = &STR(&ISPCLIB &CMD ) SET CMPDD = &STR(&PFX.ISPCLIB: &CMD) PUTFILE CMPDD ISPEXEC VPUT ISPCLIB SHARED CLOSFILE CMPDD ISPEXEC EDIT DATASET('&CMD') + MACRO(COMPONEN) FREE DD(CMPDD) ALLOC DD(CMPDD) DSN('&CMPDSN') MOD OPENFILE CMPDD OUTPUT END END ELSE DO ISREDIT FIND FIRST '%' .ZCSR .ZCSR IF &LASTCC = 0 THEN DO ISREDIT LABEL .ZCSR = .CURR ISREDIT FIND NEXT P'¬' .ZCSR .ZCSR ISREDIT (NULL,COL1) = CURSOR ISREDIT FIND NEXT ' ' .ZCSR .ZCSR ISREDIT (NULL,COL2) = CURSOR SET COL2 = &COL2 - 1 ISREDIT (CMD) = LINE .ZCSR ISREDIT LINE_BEFORE .ZCSR = (CMD) ISREDIT FIND FIRST P'=' 1 .ZCSR .ZCSR ISREDIT FIND PREV P'=' 1 ISREDIT CHANGE P'=' ' ' 1 &EVAL(&COL1-1) + ALL .ZCSR .ZCSR ISREDIT CHANGE P'=' ' ' &EVAL(&COL2+1) &LRECL + ALL .ZCSR .ZCSR ISREDIT FIND FIRST '&&' .ZCSR .ZCSR IF &LASTCC = 0 THEN + SET CMD = &STR(&VARVALUE) ELSE + DO ISREDIT (CMD) = LINE .ZCSR SET CMD = &CMD IF &LENGTH(&STR(&CMD)) = 0 THEN + SET CMD = &STR(&VARVALUE) END ISREDIT DELETE .ZCSR ISPEXEC VGET ISPCLIB SHARED IF &SYSINDEX(&STR( &CMD ),+ &STR(&ISPCLIB)) = 0 AND + &STR(&CMD) ¬= &STR(&VARVALUE) THEN + DO SET ISPCLIB = &STR(&ISPCLIB &CMD ) SET CMPDD = &STR(&PFX.ISPCLIB: &CMD) PUTFILE CMPDD ISPEXEC VPUT ISPCLIB SHARED ISPEXEC SELECT + CMD(%FINDMOD &CMD SYSPROC BATCH) IF &LASTCC = 0 THEN + DO ISPEXEC VGET DSN SHARED CLOSFILE CMPDD ISPEXEC EDIT DATASET('&DSN') + MACRO(COMPONEN) FREE DD(CMPDD) ALLOC DD(CMPDD) DSN('&CMPDSN') MOD OPENFILE CMPDD OUTPUT END END END END END END ISREDIT FIND NEXT P'=' 1 NX END GOTO FINISH /********************************************************************** /* PARSE A PANEL FOR MESSAGES * /********************************************************************** PANEL_SECTION: + ISREDIT (LRECL) = LRECL ISREDIT BOUNDS = 1 &LRECL ISREDIT EXCLUDE ALL ISREDIT FIND ALL ' MSG=' ISREDIT FIND ALL ',MSG=' ISREDIT EXCLUDE ALL '/' 1 ISREDIT EXCLUDE ALL ')' 1 ISREDIT FIND FIRST P'=' 1 NX DO WHILE &LASTCC = 0 ISREDIT FIND FIRST 'MSG=' .ZCSR .ZCSR IF &LASTCC = 0 THEN + DO ISREDIT LABEL .ZCSR = .CURR ISREDIT FIND NEXT '=' .ZCSR .ZCSR ISREDIT FIND NEXT P'¬' .ZCSR .ZCSR ISREDIT (NULL,COL1) = CURSOR ISREDIT FIND NEXT ')' .ZCSR .ZCSR ISREDIT (NULL,COL2) = CURSOR SET COL2 = &COL2 - 1 ISREDIT (MSG) = LINE .ZCSR ISREDIT LINE_BEFORE .ZCSR = (MSG) ISREDIT FIND FIRST P'=' 1 .ZCSR .ZCSR ISREDIT FIND PREV P'=' 1 ISREDIT CHANGE P'=' ' ' 1 &EVAL(&COL1-1) + ALL .ZCSR .ZCSR ISREDIT CHANGE P'=' ' ' &EVAL(&COL2+1) &LRECL + ALL .ZCSR .ZCSR ISREDIT FIND FIRST '&&' .ZCSR .ZCSR IF &LASTCC = 0 THEN + SET MSG = &STR(&VARVALUE) ELSE + DO ISREDIT (MSG) = LINE .ZCSR SET MSG = &MSG IF &LENGTH(&STR(&MSG)) = 0 THEN + SET MSG = &STR(&VARVALUE) END ISREDIT DELETE .ZCSR ISPEXEC VGET ISPMLIB SHARED IF &SYSINDEX(&STR(&MSG ),+ &STR(&ISPMLIB)) = 0 AND + &STR(&MSG) ¬= &STR(&VARVALUE) THEN + DO SET ISPMLIB = &STR(&ISPMLIB &MSG ) SET CMPDD = &STR(&PFX.ISPMLIB: &MSG) PUTFILE CMPDD ISPEXEC VPUT ISPMLIB SHARED END IF &STR(&MSG) = &STR(&VARVALUE) THEN + DO SET ISPMLIB = &STR(&ISPMLIB &MSG ) SET CMPDD = &STR(&PFX.ISPMLIB: &MSG) PUTFILE CMPDD END END ISREDIT FIND LAST P'=' .ZCSR .ZCSR ISREDIT FIND NEXT P'=' 1 NX END GOTO FINISH /********************************************************************** /* PARSE A SKELETON FOR IMBEDDED MEMBERS * /********************************************************************** SKELETON_SECTION: + ISREDIT (LRECL) = LRECL ISREDIT BOUNDS = 1 &LRECL ISREDIT EXCLUDE ALL ISREDIT FIND ALL ')IM ' 1 ISREDIT FIND FIRST P'=' 1 NX DO WHILE &LASTCC = 0 ISREDIT FIND FIRST P'¬' 5 &LRECL .ZCSR .ZCSR IF &LASTCC = 0 THEN + DO ISREDIT (NULL,COL1) = CURSOR ISREDIT FIND NEXT ' ' .ZCSR .ZCSR ISREDIT (NULL,COL2) = CURSOR SET COL2 = &COL2 - 1 ISREDIT (SKELETON) = LINE .ZCSR ISREDIT LINE_BEFORE .ZCSR = (SKELETON) ISREDIT FIND FIRST P'=' 1 .ZCSR .ZCSR ISREDIT FIND PREV P'=' 1 ISREDIT CHANGE P'=' ' ' 1 &EVAL(&COL1-1) + ALL .ZCSR .ZCSR ISREDIT CHANGE P'=' ' ' &EVAL(&COL2+1) &LRECL + ALL .ZCSR .ZCSR ISREDIT FIND FIRST '&&' .ZCSR .ZCSR IF &LASTCC = 0 THEN + SET SKELETON = &STR(&VARVALUE) ELSE + DO ISREDIT (SKELETON) = LINE .ZCSR SET SKELETON = &SKELETON IF &STR(&SKELETON) = THEN + SET SKELETON = &STR(&VARVALUE) END ISREDIT DELETE .ZCSR ISPEXEC VGET ISPSLIB SHARED IF &SYSINDEX(&STR( &SKELETON ),+ &STR(&ISPMLIB)) = 0 AND + &STR(&SKELETON) ¬= &STR(&VARVALUE) THEN + DO SET ISPMLIB = &STR(&ISPSLIB &SKELETON ) SET CMPDD = &STR(&PFX.ISPSLIB: &SKELETON) PUTFILE CMPDD ISPEXEC VPUT ISPSLIB SHARED ISPEXEC SELECT + CMD(%FINDMOD &SKELETON ISPSLIB BATCH) IF &LASTCC = 0 THEN + DO ISPEXEC VGET DSN SHARED CLOSFILE CMPDD ISPEXEC EDIT DATASET('&DSN') + MACRO(COMPONEN) FREE DD(CMPDD) ALLOC DD(CMPDD) DSN('&CMPDSN') MOD OPENFILE CMPDD OUTPUT END END IF &STR(&SKELETON) = &STR(&VARVALUE) THEN + DO SET ISPMLIB = &STR(&ISPSLIB &SKELETON ) SET CMPDD = &STR(&PFX.ISPSLIB: &SKELETON) PUTFILE CMPDD END END ISREDIT FIND LAST P'=' .ZCSR .ZCSR ISREDIT FIND NEXT P'=' 1 NX END GOTO FINISH /********************************************************************** /* RETURN TO THE PREVIOUS LEVEL OR GET OUT ALL TOGETHER. * /********************************************************************** FINISH: + IF &CMPLVL < 2 THEN + DO CLOSFILE CMPDD FREE DD(CMPDD) IF &CMPEDIT = YES THEN + ISPEXEC EDIT DATASET('&CMPDSN') SET CMPLVL = SET CMPDSN = SET CMPTYPE = SET DSN = ISPEXEC VPUT (CMPTYPE CMPLVL CMPDSN DSN) SHARED END SET CMPLVL = &CMPLVL - 1 ISPEXEC VPUT CMPLVL SHARED ISREDIT CANCEL EXIT HELPSEC: + 02480000 ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) 02490000 SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR XXXXXXXX UTILITY + 02490000 *** NO PROCESSING PERFORMED ***) 02490000 ISPEXEC SETMSG MSG(UTLZ000) 02490000 EXIT ./ ADD NAME=COMPRESS 000100 /*REXX*****************************************************************/ 000200 /* */ 000300 /* MODULE NAME = COMPRESS */ 000400 /* */ 000500 /* DESCRIPTIVE NAME = COMPRESS EDIT Macro for ISPF/PDF */ 000600 /* */ 000700 /* STATUS = R303 */ 000800 /* */ 000900 /* FUNCTION = The COMPRESS EDIT macro invokes the COMPRESS command */ 001000 /* for the current data set or for another data set, */ 001100 /* if a dsname is specified in the command. */ 001200 /* */ 001300 /* Author = Gilbert Saint-flour */ 001400 /* */ 001500 /* Dependencies = COMPRESS Command Processor R313 (COMPRCMD) */ 001600 /* STEMVIEW Program R105 (BATCH option only) */ 001700 /* */ 001800 /* Syntax = COMPRESS */ 001900 /* dsname|* data set name */ 002000 /* BATCH generate batch job */ 002100 /* */ 002200 /* Note: the default dsname is the name of the current data */ 002300 /* set. The * is only required when the BATCH option */ 002400 /* is specified for the current data set. */ 002500 /* */ 002600 /* Change Activity */ 002700 /* */ 002800 /* $300 New version, uses SETMSG option instead of OUTTRAP */ 002900 /* $301 Simplify dsname retrieval */ 003000 /* $302 Issue a long message instead of a short one */ 003100 /* $303 Add BATCH parm for background execution (requires STEMVIEW) */ 003200 /* */ 003300 /**********************************************************************/ 003400 ADDRESS 'ISPEXEC' 003500 "ISREDIT MACRO (DSN BATCH)" 003600 IF RC>0 THEN EXIT 20 003700 003800 dsn=TRANSLATE(dsn) /* convert to upper-case */ 003900 batch=TRANSLATE(batch) /* convert to upper-case */ 004000 004100 IF batch\='' & batch\='BATCH' THEN DO 004200 ZEDSMSG = 'Invalid parameter' 004300 ZEDLMSG = 'Second parameter must be BATCH' 004400 "SETMSG MSG(ISRZ001)" 004500 EXIT 20 004600 END 004700 004800 IF dsn='' | dsn='*' THEN DO /* Current Data Set */ 004900 "CONTROL ERRORS RETURN" /* trap ISPEXEC error */ 005000 "ISREDIT (DSN) = DATASET" /* retrieve dsname */ 005100 dsn="'" || dsn || "'" /* Enclose dsname in quotes */ 005200 "ISREDIT (ID1) = DATAID" 005300 IF rc>4 THEN SIGNAL SETMSG 005400 "LMQUERY DATAID("ID1") VOLUME(vol) DATASET(dsn2)" 005500 IF rc>4 THEN SIGNAL SETMSG 005600 IF dsn2 \= '' THEN /* non-null */ 005700 dsn=STRIP(dsn2) /* no trailing spaces */ 005800 IF vol <> '' THEN 005900 vol = 'VOLUME('vol')' 006000 END 006100 ELSE /* USER SPECIFIED A DSNAME */ 006200 vol='' 006300 006400 IF LEFT(dsn,1)\="'" THEN DO 006500 "VGET ZPREFIX" /* get dsname prefix */ 006600 dsn= "'" || zprefix || '.' || dsn || "'" 006700 END 006800 006900 IF batch='BATCH' THEN DO 007000 "VGET ZACCTNUM" /* Accounting info */ 007100 jobname=LEFT(USERID()||'CPR',8) /* JOB name */ 007200 acct=zacctnum /* Accounting info */ 007300 pgmr=USERID() /* Programmer's name */ 007400 QUEUE '//' || jobname 'JOB' acct || ",'" || pgmr || "'," 007500 QUEUE '// NOTIFY=&SYSUID,COND=(0,NE),' 007600 QUEUE '// CLASS=A,MSGCLASS=X' 007700 QUEUE '//COMPRESS EXEC PGM=IKJEFT01,REGION=2M' 007800 QUEUE '//SYSTSPRT DD SYSOUT=*' 007900 QUEUE '//SYSTSIN DD *' 008000 QUEUE 'COMPRESS' dsn 'SHR' vol 008100 CALL STEMVIEW 'VIEW',,,,'COMPRESS' dsn vol 008200 END 008300 ELSE DO /* BATCH was not spcified */ 008400 ZEDSMSG = '' 008500 ZEDLMSG = 'Data Set' dsn 'is being compressed.' 008600 IF vol\='' THEN 008700 ZEDLMSG = 'Data Set' dsn 'is being compressed on' vol 008800 "CONTROL DISPLAY LOCK" 008900 "DISPLAY MSG(ISRZ001)" 009000 "SELECT CMD(COMPRESS" dsn vol "SHR SETMSG) MODE(FSCR)" 009100 END 009200 EXIT 009300 009400 SETMSG: IF zerrmsg<>'' THEN 'SETMSG MSG('zerrmsg')' ; EXIT 20 ./ ADD NAME=COMPREXX 000100 /*REXX*****************************************************************/ 000200 /* */ 000300 /* MODULE NAME = COMPRESS */ 000400 /* */ 000500 /* DESCRIPTIVE NAME = COMPRESS EDIT MACRO FOR ISPF/PDF */ 000600 /* */ 000700 /* STATUS = R301 */ 000800 /* */ 000900 /* FUNCTION = The COMPRESS EDIT macro invokes the COMPRESS command */ 001000 /* for the current data set or for another data set, */ 001100 /* if one is specified in the command. */ 001200 /* */ 001300 /* AUTHOR = GILBERT SAINT-FLOUR */ 001400 /* */ 001500 /* DEPENDENCIES = COMPRESS COMMAND R313 */ 001600 /* */ 001700 /* CHANGE ACTIVITY */ 001800 /* */ 001900 /* $300 New version, uses SETMSG option instead of OUTTRAP */ 002000 /* $301 Simplify dsname retrieval */ 002100 /* */ 002200 /**********************************************************************/ 002300 ADDRESS 'ISPEXEC'; "ISREDIT MACRO (DSN)"; IF RC>0 THEN EXIT 20 002400 IF STRIP(dsn) = '' THEN DO 002500 "CONTROL ERRORS RETURN" /* trap ISPEXEC error */ 002600 "ISREDIT (DSN) = DATASET" /* retrieve dsname */ 002700 dsn="'"dsn"'" 002800 "ISREDIT (ID1) = DATAID" 002900 IF rc>4 THEN SIGNAL SETMSG 003000 "LMQUERY DATAID("ID1") VOLUME(VOL)" /* retrieve volser */ 003100 IF rc>4 THEN SIGNAL SETMSG 003200 IF vol <> '' THEN 003300 vol = 'VOLUME('vol')' 003400 END 003500 ELSE /* USER SPECIFIED A DSNAME */ 003600 vol='' 003700 003800 ZEDSMSG = 'Compress in progress' 003900 ZEDLMSG = dsn 'is being compressed' 004000 "CONTROL DISPLAY LOCK" 004100 "DISPLAY MSG(ISRZ001)" 004200 "SELECT CMD(COMPRESS" dsn vol "SHR SETMSG) MODE(FSCR)" 004300 EXIT 004400 004500 SETMSG: IF zerrmsg<>'' THEN 'SETMSG MSG('zerrmsg')' ; EXIT 20 ./ ADD NAME=COMPRSME ISREDIT MACRO (HELP) ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /********************************************************************/ /* COMPRSME */ /* */ /* PURPOSE: THIS EDIT MACRO WILL COMPRESS A PDS LIBRARY WHILE */ /* A MEMBER IS BEING EDITED. IF A 'SAVE' HAS BEEN */ /* ATTEMPTED AND A SPACE PROBLEM OCCURS, THE PDS CAN BE */ /* BE COMPRESSED BY ENTERING 'COMPRSME' ON THE COMMAND */ /* LINE. THE IEBCOPY MESSAGES WILL BE PLACED IN A */ /* SYSDA DATASET NAMED '&USERID.COMPRESS.LIST' AND MAY */ /* BE REVIEWED. */ /* */ /* CREATED BY JEFF JONES 12/6/89 - SEATTLE SE CENTER */ /* */ /* C H A N G E L O G */ /* PROJECT DATE ID COMMENTS */ /* */ /********************************************************************/ IF &HELP = &STR(HELP) THEN GOTO HELPSEC ISREDIT (EDITDSN) = DATASET SET &EDITDSN = &NRSTR('&EDITDSN') ERROR + DO ERROR OFF WRITE AN ERROR HAS OCCURRED PRIOR TO THE COMPRESS. FREE FILE(SYSIN,SYSPRINT,SYSUT3,SYSUT4,OUTPUT) GOTO ENDIT END ALLOCATE FILE(SYSIN) + UNIT(SYSDA) VOLUME(WRK$$$) + SPACE(1,1) TRACK + LRECL(80) RECFM(F) BLKSIZE(80) REUSE SET LISTDSN = &STR(&SYSUID..COMPRESS.LIST) IF &SYSDSN('&STR(&LISTDSN)') ¬= OK THEN + ALLOCATE FILE(SYSPRINT) DATASET('&STR(&LISTDSN)') RECFM(F,B,A) + UNIT(SYSDA) VOLUME(WRK$$$) + LRECL(121) BLKSIZE(12947) SPACE(1,1) TRACK REUSE ELSE + ALLOCATE FILE(SYSPRINT) DATASET('&STR(&LISTDSN)') SHR REUSE ALLOCATE FILE(SYSUT3) UNIT(SYSDA) SPACE(1,1) CYLINDERS REUSE ALLOCATE FILE(SYSUT4) UNIT(SYSDA) SPACE(1,1) CYLINDERS REUSE ALLOCATE FILE(OUTPUT) DATASET(&EDITDSN) SHR REUSE OPENFILE SYSIN OUTPUT SET SYSIN = &STR( COPY INDD=OUTPUT,OUTDD=OUTPUT) PUTFILE SYSIN CLOSFILE SYSIN ERROR + DO WRITE COMPRESS ERROR - DETAILS IN '&STR(&LISTDSN)' GOTO ENDIT END TSOEXEC CALL 'SYS1.LINKLIB(IEBCOPY)' 'SIZE=512K' WRITE &EDITDSN COMPRESSED AT &SYSTIME &SYSDATE GOTO ENDIT HELPSEC: + WRITE WRITE *** HELP FOR EDIT MACRO 'COMPRSME' *** WRITE WRITE THE COMPRSME MACRO WILL ENABLE A USER WHO IS EDITING A PDS LIBRARY WRITE TO COMPRESS THE DATASET WITHOUT EXITING THE MEMBER BEING EDITED. WRITE WRITE IF AN ATTEMPT HAS BEEN MADE TO SAVE A NEW PDS MAMBER AND A SPACE WRITE PROBLEM OCCURS THE DATASET CAN BE COMPRESSED BY TYPING 'COMPRSME' WRITE ON THE COMMAND LINE AND PRESSING 'ENTER'. A MESSAGE STATING THAT WRITE THE DATASET HAS BEEN COMPRESSED WILL BE DISPLAYED ON THE SCREEN WRITE UPON SUCCESSFUL COMPLETION OF THE COMPRESS. WRITE WRITE THE IEBCOPY MESSAGES MAY BE REVIEWED, IF DESIRED, AFTER THE WRITE COMPRESS IS COMPLETE BY EDITING A SYSDA DATASET NAMED WRITE '&STR(&LISTDSN)' WRITE WRITE WRITE WRITE WRITE *** END OF HELP *** NO PROCESSING PERFORMED *** EXIT ENDIT: + END ./ ADD NAME=CONCAT 000100 /*************************************************************** REXX */ 000200 /* */ 000300 /* MODULE NAME = CONCAT */ 000400 /* */ 000500 /* DESCRIPTIVE NAME = Concatenate a library to an existing DD */ 000600 /* */ 000700 /* STATUS = R301 */ 000800 /* */ 000900 /* FUNCTION = The CONCAT EXEC allows you to add a new PDS at the */ 001000 /* beginning or the end of a concatenation without */ 001100 /* having to know what libraries are currently */ 001200 /* allocated to the ddname you specify. */ 001300 /* */ 001400 /* AUTHOR = Gilbert Saint-flour */ 001500 /* */ 001600 /* DEPENDENCIES = TSO/E V2 */ 001700 /* */ 001800 /* SYNTAX = SEE BELOW */ 001900 /* */ 002000 /* CONCAT DDNAME(ddname) */ 002100 /* DSNAME(dsname) */ 002200 /* BEFORE|AFTER */ 002300 /* DEBUG */ 002400 /* */ 002500 /* Default: BEFORE */ 002600 /* DDNAME(SYSPROC) DSNAME('userid.EXEC') */ 002700 /* */ 002800 /* Example: */ 002900 /* */ 003000 /* Add the IBMUSER.EXEC library at the beginning of the */ 003100 /* SYSPROC concatenation: */ 003200 /* */ 003300 /* %CONCAT DD(SYSPROC) DS('IBMUSER.EXEC') */ 003400 /* */ 003500 /* OPERATION = see below */ 003600 /* */ 003700 /* CONCAT traps the output of the LISTALC command to */ 003800 /* retrieve the data set names currently allocated to the */ 003900 /* specified DD, then builds an ALLOCATE command with */ 004000 /* the new dsname and the old dsnames and executes it. */ 004100 /* */ 004200 /* CHANGES = see below */ 004300 /* */ 004400 /* $301 Issue ALLOCATE even if DDname not already allocated */ 004500 /* */ 004600 /**********************************************************************/ 004700 ARG parm 004800 PARSE SOURCE . . . . owndsn . /* retrieve my own dsname */ 004900 /*----------------------------------------------------------------*/ 005000 /* Provide defaults when invoked with no arguments */ 005100 /*----------------------------------------------------------------*/ 005200 IF parm='' THEN DO 005300 IF owndsn='?' THEN 005400 parm="DD(SYSEXEC) DS('"USERID()".EXEC') BEFORE" 005500 ELSE 005600 IF RIGHT(owndsn,5)='.EXEC' THEN 005700 parm="DD(SYSEXEC) DS('"owndsn"') BEFORE" 005800 ELSE 005900 parm="DD(SYSPROC) DS('"owndsn"') BEFORE" 006000 END 006100 /*----------------------------------------------------------------*/ 006200 /* Add closing parenthesis at end of string */ 006300 /*----------------------------------------------------------------*/ 006400 p=WORD(Parm,WORDS(Parm)) 006500 IF RIGHT(p,1)\=')' & POS('(',p)>1 THEN 006600 Parm=Parm||')' 006700 /*----------------------------------------------------------------*/ 006800 /* Process input parameters */ 006900 /*----------------------------------------------------------------*/ 007000 Ddname='';Dsname='';Place='';Debug='';olddsn='' 007100 DO i=1 to WORDS(parm) 007200 p=TRANSLATE(WORD(parm,i)) 007300 IF Debug='DEBUG' THEN SAY 'p='p 'parm='parm 007400 kwd='' 007500 IF RIGHT(p,1)=')' & POS('(',p)>1 THEN DO 007600 value=LEFT(p,LENGTH(p)-1) /* remove right paren */ 007700 PARSE VAR value kwd '(' value /* extract key-word */ 007800 END 007900 SELECT 008000 WHEN p='DEBUG' THEN Debug=p /* debugging */ 008100 WHEN ABBREV('DDNAME',kwd,2) THEN DO 008200 IF ddname\='' THEN SIGNAL Duplicate_keyword 008300 IF value='' | LENGTH(value)>8 THEN SIGNAL Invalid_value 008400 ddname=value 008500 END 008600 WHEN ABBREV('DSNAME',kwd,2) THEN DO 008700 IF dsname\='' THEN SIGNAL Duplicate_keyword 008800 IF value='' | LENGTH(value)>46 THEN SIGNAL Invalid_value 008900 dsname=value 009000 END 009100 WHEN ABBREV('BEFORE',p,1) | ABBREV('AFTER',p,1) THEN DO 009200 IF Place\='' THEN SIGNAL Duplicate_keyword 009300 Place=LEFT(p,1) /* B(efore) or A(fter) */ 009400 END 009500 OTHERWISE 009600 Say "Invalid argument:" kwd 009700 END 009800 END 009900 IF dsname='' THEN SIGNAL Missing_dsname 010000 IF ddname='' THEN SIGNAL Missing_ddname 010100 /*----------------------------------------------------------------*/ 010200 /* Check that specified DSname is cataloged */ 010300 /*----------------------------------------------------------------*/ 010400 rc=LISTDSI(dsname) 010500 IF rc>0 THEN SIGNAL Uncataloged_dsname 010600 dsname=sysdsname /* fully-qualified dsname */ 010700 /*----------------------------------------------------------------*/ 010800 /* Issue ALLOCATE if this is a new ddname */ 010900 /*----------------------------------------------------------------*/ 011000 rc=LISTDSI(ddname 'FILE') 011100 IF rc>0 THEN DO 011200 cmd="ALLOCATE DD("ddname") DS('"dsname"') SHR" 011300 SAY cmd 011400 cmd /* issue ALLOCATE command */ 011500 EXIT rc 011600 END 011700 /*----------------------------------------------------------------*/ 011800 /* Retrieve current allocations */ 011900 /*----------------------------------------------------------------*/ 012000 rc=OUTTRAP('LINE.') /* TRAP PUTLINE */ 012100 "LISTALC STATUS" 012200 rc=OUTTRAP('OFF') /* TRAP OFF */ 012300 /*----------------------------------------------------------------*/ 012400 /* Retrieve data sets currently allocated to &ddname */ 012500 /*----------------------------------------------------------------*/ 012600 DO I = 2 TO line.0 012700 dsn = LINE.I 012800 IF LEFT(dsn,9) = 'TERMFILE ' THEN ITERATE 012900 IF LEFT(dsn,9) = 'NULLFILE ' THEN ITERATE 013000 I = I+1 /* skip one line */ 013100 tdd=STRIP(SUBSTR(Line.I,3,8)) /* extract ddname */ 013200 IF tdd ¬= '' THEN 013300 ddn = tdd /* save DDNAME */ 013400 IF ddn = ddname THEN DO 013500 IF dsn ¬= dsname THEN /* eliminate duplicates */ 013600 olddsn = olddsn "'"dsn"'" 013700 IF debug¬='' THEN 013800 SAY ddn dsn '('dsname olddsn')' 013900 END 014000 END /* WHILE I <= line.0 */ 014100 /*----------------------------------------------------------------*/ 014200 /* Issue new ALLOCATE command */ 014300 /*----------------------------------------------------------------*/ 014400 "FREE DD("ddname")" /* Free current allocation */ 014500 IF rc=0 THEN DO 014600 IF place='A' then 014700 dsn=STRIP(olddsn) "'"dsname"'" /* place=AFTER */ 014800 ELSE 014900 dsn="'"dsname"'" STRIP(olddsn) /* place=BEFORE */ 015000 cmd="ALLOCATE DD("ddname") DS("dsn") SHR REUSE" 015100 SAY cmd 015200 cmd /* issue ALLOCATE command */ 015300 END 015400 ELSE 015500 SAY "DDname("ddname") could not be freed" 015600 IF debug\='' & rc>0 THEN SAY rc sysreason sysmsglvl1 sysmsglvl2 015700 EXIT rc 015800 015900 /*----------------------------------------------------------------*/ 016000 /* Error Routines */ 016100 /*----------------------------------------------------------------*/ 016200 Duplicate_keyword: 016300 IF kwd='' THEN kwd=p 016400 SAY 'Key-word' kwd 'has been specified more than once.' 016500 EXIT 8 016600 Invalid_value: 016700 IF Value='' THEN 016800 SAY 'A null value is invalid for key-word' kwd 016900 ELSE 017000 SAY 'Value' value 'is invalid for key-word' kwd 017100 EXIT 8 017200 Missing_dsname: 017300 SAY 'DSname missing or invalid.' 017400 EXIT 8 017500 Missing_ddname: 017600 SAY 'DDname missing or invalid.' 017700 EXIT 8 017800 Uncataloged_dsname: 017900 SAY 'DSname' dsname 'is not cataloged.' 018000 EXIT 8 ./ ADD NAME=CONTENTS ISREDIT MACRO (OPT) ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT IF &OPT = &STR(HELP) THEN GOTO HELPSEC /******************************************************************/ /* UTILITY: CONTENTS */ /* AUTHOR: DAVID LEIGH */ /* FUNCTION: INSERT MESSAGE OR DATA LINES OF THE CONTENTS OF A */ /* FILE WHICH YOU HAVE YOUR CURSOR PLACED ON AFTER THE */ /* LINE CONTAINING THE NAME OF THE FILE. */ /******************************************************************/ SET LP = &STR(( SET RP = &STR()) ISREDIT (LN,CL) = CURSOR ISREDIT (DSN) = LINE .ZCSR SET SYSDVAL = &SUBSTR(&CL:&LENGTH(&NRSTR(&DSN)),&NRSTR(&DSN)) READDVAL DSN SET X = &LENGTH(&STR(&DSN)) SET Y = &SYSINDEX(&STR(&LP&RP),&STR(&DSN)) DO WHILE + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(.) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(?) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(") OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(') OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(:) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(;) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(&&) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(~) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(`) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(|) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(%) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(¬) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(*) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(_) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(-) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(=) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(+) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(!) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(?) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(?) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(\) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR({) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(}) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(/) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(>) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(<) OR + &SUBSTR(&X:&X,&STR(&DSN)) = &STR(&LP) OR + &SUBSTR(&X-1:&X,&STR(&DSN)) = &STR(&RP&RP) OR + &SUBSTR(&X-1:&X,&STR(&DSN)) = &STR(&LP&RP) OR + &SUBSTR(&X-1:&X,&STR(&DSN)) = &STR('&RP) OR + &SUBSTR(&X-1:&X,&STR(&DSN)) = &STR(&RP&LP) OR + (&SUBSTR(&X:&X,&STR(&DSN)) = &STR(&RP) AND + (&SYSINDEX(&STR(&LP),&STR(&DSN)) = 0) SET X = &X - 1 END SET DSN = &SUBSTR(1:&X,&STR(&DSN)) IF &Y > 0 THEN SET DSN = &STR(&DSN&LP.0&RP) IF &SYSINDEX(&STR(+),&STR(&DSN)) > 1 THEN + DO SET A = &SYSINDEX(&STR(+),&STR(&DSN)) - 2 SET DSN = &SUBSTR(1:&A,&STR(&DSN)) %GDGGEN DSN(&DSN) IF &LASTCC = 0 THEN ISPEXEC VGET ZEROGEN SHARED SET DSN = &STR(&ZEROGEN) END IF &SYSINDEX(&STR(-),&STR(&DSN)) > 1 THEN + DO SET A = &SYSINDEX(&STR(-),&STR(&DSN)) - 2 SET DSN = &SUBSTR(1:&A,&STR(&DSN)) %GDGGEN DSN(&DSN) IF &LASTCC = 0 THEN ISPEXEC VGET ZEROGEN SHARED SET DSN = &STR(&ZEROGEN) END IF &SYSINDEX(&STR(&LP.0),&STR(&DSN)) > 1 THEN + DO SET A = &SYSINDEX(&STR(&LP.0),&STR(&DSN)) - 1 SET DSN = &SUBSTR(1:&A,&STR(&DSN)) %GDGGEN DSN(&DSN) IF &LASTCC = 0 THEN ISPEXEC VGET ZEROGEN SHARED SET DSN = &STR(&ZEROGEN) END LISTDSI '&DSN' IF &LASTCC = 4 AND &SYSREASON = 12 AND &SYSDSORG = VS THEN + DO SET ZEDSMSG = &STR(VSAM NOT SUPPORTED) SET ZEDLMSG = &STR("&DSN" IS A VSAM DATASET AND VSAM IS NOT + SUPPORTED BY THE "CONTENTS" UTILITY) SET XMSG = &STR(UTLZ001) GOTO FINAL END SET XMSG = &STR(UTLZ000) SET EDITCC = 0 FREE DD(TEMPDD) ALLOC DD(TEMPDD) DSN('&DSN') SHR KEEP ERROR DO SET ERRCC = &LASTCC SELECT (&ERRCC) WHEN (4) RETURN WHEN (400) DO SET EOF = YES RETURN END OTHERWISE DO ERROR OFF WRITE *** ERROR CC: &ERRCC OCCURRED READING A FILE *** CLOSFILE TEMPDD FREE DD(TEMPDD) EXIT END END END IF &STR(&OPT) = WRITE THEN SET LINE = ELSE SET LINE = MSGLINE ISREDIT LABEL .ZCSR = .CURR ISREDIT SEEK NEXT P'=' 1 IF &LASTCC > 0 THEN SET LABEL = &STR(.ZLAST) ELSE SET LABEL = &STR(.ZCSR) SET SWITCH = OFF SET EOF = NO OPENFILE TEMPDD GETFILE TEMPDD DO WHILE &EOF = NO ISREDIT LINE_BEFORE &LABEL = &LINE (TEMPDD) GETFILE TEMPDD END ERROR OFF CLOSFILE TEMPDD FREE DD(TEMPDD) FINAL: + ISREDIT CURSOR = &LN &CL ISPEXEC SETMSG MSG(&XMSG) EXIT HELPSEC: + CLEAR WRITE *** HELP FOR EDIT MACRO 'CONTENTS' *** WRITE WRITE THE CONTENTS EDIT MACRO ALLOWS THE USER TO TYPE CONTENTS ON THE COMMAND WRITE LINE DURING AN EDIT SESSION, PLACE THE CURSOR ON THE BEGINNING OF WRITE A DATASET NAME IN THE BODY OF THE FILE, PRESS , AND BE WRITE TAKEN INTO AN EDIT OR BROWSE OF THAT DATASET. ADDITIONALLY, A WRITE PF KEY CAN BE SET TO THE STRING 'CONTENTS', AND THE USER COULD PLACE WRITE THE CURSOR ON THE DATASET NAME, AND PRESS THE PF KEY, AND ACCOM- WRITE PLISH THE SAME THING. WRITE WRITE BASIC SYNTAX : WRITE WRITE COMMAND ===> CONTENTS WRITE 000108 //JS010 EXEC PGM=WAAPDSUT WRITE 000109 //SYSUT1 DD DSN=TCWCA.TWB.WORKFILE(INDATA), WRITE 000110 // DISP=(SHR,KEEP,KEEP) WRITE 000111 //SYSUT2 DD DSN=TCWCA.TWBAT.INDATA.COPY, WRITE 000112 // DISP=(NEW,CATLG,DELETE) WRITE 000113 // UNIT=TSTDA, WRITE 000114 // SPACE=(TRK,(1,1),RLSE), WRITE 000115 // DCB=(RECFM=FB,LRECL=80,BLKSIZE=23440) WRITE WRITE IN THE ABOVE EXAMPLE, THE CURSOR WOULD BE PLACED ON THE 'T' WRITE IMMEDIATELY FOLLOWING EITHER 'DSN=' STRING (SYSUT2 WOULD BE AVAIL- WRITE ABLE PROVIDING THAT THE JCL HAD ALREADY BEEN RUN), AND THE WRITE KEY WOULD BE PRESSED. PROVIDED THAT THE USER HAD AUTHORITY, AND WRITE THE DATASET WAS NOT IN USE, AND THE LRECL OF THE DATASET FELL WRITE WITHIN THE ALLOWABLE LIMITS OF AN ISPF EDIT SESSION, THE USER WRITE WOULD BE TAKEN INTO AN EDIT OF THE DATASET. WRITE WRITE IF THE RETURN CODE FROM THE ATTEMPT TO EDIT THE DATASET WAS UN- WRITE SATISFACTORY, THE MACRO WILL ATTEMPT TO BROWSE THE DATASET WRITE INSTEAD. ACF2 VIOLATIONS, AND EXCLUSIVE ENQUEUES OF THE DATASET WRITE WOULD BE THE ONLY FACTORS WHICH WOULD PROHIBIT A BROWSE OF THE WRITE DATASET. WRITE WRITE IN THE CASE OF GDG DATASETS WITH RELATIVE GENERATION NUMBERS OR WRITE PGENS SPECIFIED IN THE DATASET NAME, THE MOST RECENT GENERATION WRITE WILL BE EDITED. WRITE WRITE THE STANDARD EDIT/BROWSE CONVENTIONS AND COMMANDS ARE AVAILABLE IN WRITE THE RESULTING EDIT/BROWSE SESSION. WRITE WRITE *** END OF HELP *** NO PROCESSING PERFORMED *** EXIT ./ ADD NAME=COPYANY /* REXX ***************************************************************/ /* UTILITY: COPYANY */ /* AUTHOR: DAVID LEIGH */ /* FUNCTION: THIS UTILITY COPYS DATASETS INTO YOUR EDIT SESSION BY */ /* READING THEM WITH REXX EXECIO AND THEN INSERTING THE */ /* LINES. IT CAN COPY THINGS THAT ORDINARY COPY CAN'T */ /* HANDLE. */ /**********************************************************************/ ADDRESS ISPEXEC 'CONTROL ERRORS RETURN' ADDRESS ISREDIT "MACRO NOPROCESS" "PROCESS DEST" SELECT WHEN RC = 0 THEN DO "(LINENUM) = LINENUM .ZDEST" END WHEN RC = 8 THEN DO ZEDSMSG = 'A|B LINE REQUIRED' ZEDLMSG = '"COPYANY" REQUIRES AN', '"A" OR "B" LINE COMMAND TO OPERATE' ADDRESS ISPEXEC "SETMSG MSG(UTLZ001W)" EXIT 12 END WHEN RC = 16 THEN DO ZEDSMSG = 'INVALID LINE COMMAND' ZEDLMSG = "LINE CMDS CAN'T CONFLICT OR SPECIFY", '"BEFORE" THE 1ST OR "AFTER" THE LAST LINE' ADDRESS ISPEXEC "SETMSG MSG(UTLZ001W)" EXIT 12 END WHEN RC = 20 THEN DO ZEDSMSG = 'SEVERE ERROR' ZEDLMSG = 'PROCESSING THE LINE COMMAND PRODUCED A', 'SEVERE EDIT MACRO ERROR' ADDRESS ISPEXEC "SETMSG MSG(UTLZ001W)" EXIT 12 END OTHERWISE NOP END "(COPYDSN) = DATASET" "(COPYMBR) = MEMBER" ADDRESS ISPEXEC DO FOREVER "DISPLAY PANEL(COPYANY)" SELECT WHEN RC = 0 THEN DO IF COPYMBR > '' THEN XDSN = "'"COPYDSN"("COPYMBR")'" ELSE XDSN = "'"COPYDSN"'" IF SYSDSN(XDSN) = 'OK' THEN LEAVE ELSE DO ZEDSMSG = '' ZEDLMSG = '"'XDSN'" PROBLEM: 'SYSDSN(XDSN) ADDRESS ISPEXEC "SETMSG MSG(UTLZ001W)" END END WHEN RC < 9 THEN DO ZEDSMSG = 'PROCESS CANCELLED' ZEDLMSG = 'THE COPYANY PROCESS WAS CANCELLED AT THE', "USER'S REQUEST" ADDRESS ISPEXEC "SETMSG MSG(UTLZ001W)" EXIT 12 END OTHERWISE DO ZEDSMSG = 'SEVERE ERROR' ZEDLMSG = 'DISPLAYING THE COPYANY PANEL PRODUCED A', 'SEVERE ISPF ERROR' ADDRESS ISPEXEC "SETMSG MSG(UTLZ001W)" EXIT 12 END END END ADDRESS TSO DUMMY = OUTTRAP(NULL) "FREE DD(TMPCPYDD)" "ALLOCATE DD(TMPCPYDD) DSN("XDSN") SHR" DROP NULL. "NEWSTACK" "EXECIO * DISKR TMPCPYDD (FINIS" "FREE DD(TMPCPYDD)" X = QUEUED() ADDRESS ISREDIT "(LRECL) = LRECL" "CURSOR = "LINENUM" 1" DO I = X TO 1 BY -1 PARSE PULL CPYLINE IF LENGTH(CPYLINE) > LRECL & TRNKWRAP = 'W' THEN DO SAVELINE = CPYLINE J = LENGTH(SAVELINE) DO WHILE J > 0 K = K + 1 IF J > LRECL THEN LGTH = LRECL ELSE LGTH = J TMPLINE.K = SUBSTR(SAVELINE,1,LGTH) SAVELINE = SUBSTR(SAVELINE,LRECL+1) J = LENGTH(SAVELINE) END DO H = K TO 1 BY -1 XCPYLINE = TMPLINE.H "LINE_AFTER .ZCSR = (XCPYLINE)" END END ELSE "LINE_AFTER .ZCSR = (CPYLINE)" END ADDRESS TSO "DELSTACK" ./ ADD NAME=COPYBIND /* REXX ***************************************************************/ /* UTILITY: COPYBIND */ /* AUTHOR: DAVID LEIGH */ /* FUNCTION: THIS UTILITY CONTROLS FILE TAILORING OF A JOB WHICH WILL */ /* CREATE BIND COPY STATEMENTS FROM THE LATEST VERSION OF */ /* SELECTED PACKAGES. */ /**********************************************************************/ ADDRESS ISPEXEC "CONTROL ERRORS RETURN" /**********************************************************************/ /* READ THE PARM FILE TO SET TARGET VALUES */ /**********************************************************************/ ADDRESS TSO "EXECIO * DISKR PARMFILE (STEM PARM. FINIS)" DO I = 1 TO PARM.0 PARSE UPPER VAR PARM.I VARNAME VARVALUE NULL SELECT WHEN VARNAME = 'COLLID' THEN COLLID = VARVALUE WHEN VARNAME = 'OWNER' THEN OWNER = VARVALUE WHEN VARNAME = 'QUALIFIER' THEN QUAL = VARVALUE END END /**********************************************************************/ /* READ THE INPUT FILE TO PARSE AND LOAD THE TEMP TABLE */ /**********************************************************************/ "TBCREATE BINDTABL NOWRITE REPLACE NAMES(INCOLL PGMNAME VERSION)" ADDRESS TSO "EXECIO * DISKR INFILE (STEM INREC. FINIS)" DO I = 1 TO INREC.0 INREC.I = TRANSLATE(INREC.I,' ','00'X) PARSE UPPER VAR INREC.I INCOLL 19 PGMNAME 27 29 VERSION NULL INCOLL = STRIP(INCOLL) PGMNAME = STRIP(PGMNAME) VERSION = STRIP(VERSION) "TBADD BINDTABL" END "TBTOP BINDTABL" /**********************************************************************/ /* FILE TAILOR TO CREATE THE BIND CARDS */ /**********************************************************************/ "FTOPEN" "FTINCL COPYBIND" SAY 'COPYBIND FILE TAILOR RC =' RC "FTCLOSE" EXIT ./ ADD NAME=COPYBRW /********************************************************************** /* CLIST: COPYBRW * /* AUTHOR: MICHELE DELUHERY * /* FUNCTION: THIS CLIST DETERMINES A VALID NEW COPYBOOK MEMBER NAME * /********************************************************************** /* SET UP SOME DEFAULT VARIABLES WHICH COULD BE CHANGED WHEN THE * /* CLIST IS INVOKED. * /********************************************************************** PROC 0 /********************************************************************** /* CONTROL DEBUG PROCESSING * /********************************************************************** /* BASED ON THE VARIABLE "DEBUG", DISPLAY OR DON'T DISPLAY LINES AS * /* THEY EXECUTE. * /********************************************************************** ISPEXEC CONTROL ERRORS RETURN IF &DEBUG = DEBUG OR &OPT1 = DEBUG OR &OPT2 = DEBUG THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ISPEXEC DISPLAY PANEL(COPYPN3) /********************************************************************** /* CHECK FOR PF03 KEY TO EXIT CLIST * /********************************************************************** IF &PANELCC = 8 THEN EXIT EXIT ./ ADD NAME=COPYCHG /********************************************************************** /* CLIST: COPYNAM * /* AUTHOR: MICHELE DELUHERY * /* FUNCTION: THIS CLIST DETERMINES A VALID NEW COPYBOOK MEMBER NAME * /********************************************************************** /* SET UP SOME DEFAULT VARIABLES WHICH COULD BE CHANGED WHEN THE * /* CLIST IS INVOKED. * /********************************************************************** PROC 0 /********************************************************************** /* CONTROL DEBUG PROCESSING * /********************************************************************** /* BASED ON THE VARIABLE "DEBUG", DISPLAY OR DON'T DISPLAY LINES AS * /* THEY EXECUTE. * /********************************************************************** ISPEXEC CONTROL ERRORS RETURN IF &DEBUG = DEBUG OR &OPT1 = DEBUG OR &OPT2 = DEBUG THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ISPEXEC DISPLAY PANEL(COPYPN2) /********************************************************************** /* CHECK FOR PF03 KEY TO EXIT CLIST * /********************************************************************** IF &PANELCC = 8 THEN EXIT EXIT ./ ADD NAME=COPYCOL ISREDIT MACRO (COL1,COL2,COL3,OPT1,OPT2,OPT3,OPT4) ISPEXEC CONTROL ERRORS RETURN ISPEXEC VGET (DBGSWTCH) PROFILE IF &DBGSWTCH = &STR(ON) THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT IF &STR(&COL1) = HELP THEN GOTO HELPSEC /********************************************************************** /* EDIT MACRO : COPYCOL * /* AUTHOR : DAVID LEIGH * /* FUNCTION : COPY ONE COLUMN IN A FILE BEING EDITED TO ANOTHER. * /********************************************************************** /********************************************************************** /* EDIT THE USER INPUT * /********************************************************************** ISREDIT (LN,CL) = CURSOR ISREDIT (LRECL) = LRECL ISREDIT (X,Y) = DISPLAY_LINES IF &LASTCC = 8 THEN + DO SET ZEDLMSG = &STR(*** NO LINES EXIST TO PROCESS AGAINST ***) ISPEXEC SETMSG MSG(UTLZ001) EXIT END IF &DATATYPE(&COL1) ¬= NUM OR + &DATATYPE(&COL2) ¬= NUM OR + &DATATYPE(&COL3) ¬= NUM THEN + DO SET ZEDLMSG = &STR(*** 1ST 3 PARAMETERS MUST BE COLUMN NUMBERS + ***) ISPEXEC SETMSG MSG(UTLZ001) EXIT CODE(8) END IF (&COL1 > &LRECL OR &COL1 < 1) OR + (&COL2 > &LRECL OR &COL2 < 1) OR + (&COL3 > &LRECL OR &COL3 < 1) THEN + DO SET ZEDLMSG = &STR(*** ALL COLUMNS MUST BE BETWEEN 1 AND + &LRECL ***) ISPEXEC SETMSG MSG(UTLZ001) EXIT CODE(8) END IF &COL1 > &COL2 THEN + DO SET ZEDLMSG = &STR(*** COLUMN 1 MUST BE LESS THAN COLUMN 2 ***) ISPEXEC SETMSG MSG(UTLZ001) EXIT CODE(8) END IF &STR(&OPT4) = STRING AND + &STR(&OPT3) ¬= STRING THEN + DO SET ZEDLMSG = &STR(*** "STRING" CANNOT BE THE LAST OPTION ***) ISPEXEC SETMSG MSG(UTLZ001) EXIT CODE(8) END /********************************************************************** /* PROCESS THE INPUT * /********************************************************************** SELECT WHEN (&OPT1 = STRING) + DO SET STG = &STR(&OPT2) SET OPT = &STR(&OPT3 &OPT4) END WHEN (&OPT2 = STRING) + DO SET STG = &STR(&OPT3) SET OPT = &STR(&OPT1 &OPT4) END WHEN (&OPT3 = STRING) + DO SET STG = &STR(&OPT4) SET OPT = &STR(&OPT1 &OPT2) END OTHERWISE + DO SET STG = &STR(P'=') SET OPT = &STR(&OPT1 &OPT2 &OPT3 &OPT4) END END IF &STR(&OPT) = THEN + DO %YOUSURE COLUMN(10) ROW(5) ZWINTTL('PROCESS ALL LINES?!') IF &LASTCC > 0 THEN + DO SET ZEDLMSG = &STR(*** NO "COPYCOL" PROCESSING + PERFORMED ***) ISPEXEC SETMSG MSG(UTLZ001) EXIT END END ISREDIT (ONOFF,TYPE) = NUMBER IF &ONOFF = ON AND &SYSINDEX(&STR( COBOL ),&STR(&TYPE)) > 0 THEN + DO SET COL1 = &COL1 - 6 SET COL2 = &COL2 - 6 SET COL3 = &COL3 - 6 END SET COUNT = 0 SET LEN = &COL2 - &COL1 + 1 SET PIC = &STR(=) SET SPACE = &STR( ) DO &I = 2 TO &LEN SET PIC = &STR(&PIC=) SET SPACE = &STR(&SPACE ) END ISREDIT FIND FIRST &STR(&STG &OPT) DO WHILE &LASTCC = 0 SET COUNT = &COUNT + 1 ISREDIT CHANGE P'&PIC' '&SPACE' .ZCSR .ZCSR &COL3 ISREDIT (LINE) = LINE .ZCSR SET COL = &SUBSTR(&COL1:&COL2,&NRSTR(&LINE)) ISREDIT LINE .ZCSR = LINE + <(COL3) (COL)> ISREDIT FIND LAST P'=' .ZCSR .ZCSR ISREDIT FIND NEXT &STR(&STG &OPT) END SET ZEDLMSG = &STR(*** &COUNT LINE(S) PROCESSED ***) ISPEXEC SETMSG MSG(UTLZ000) ISREDIT CURSOR = &LN &CL EXIT HELPSEC: + 02480000 ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) 02490000 SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR COPYCOL UTILITY + 02490000 *** NO PROCESSING PERFORMED ***) 02490000 ISPEXEC SETMSG MSG(UTLZ000) 02490000 EXIT ./ ADD NAME=COPYDB /* REXX ***************************************************************/ /* UTILITY: COPYDB */ /* AUTHOR: DAVID LEIGH */ /* FUNCTION: THIS UTILITY ALLOWS THE USER TO SPECIFY SOURCE AND */ /* TARGET DATABASES (ACROSS SUBSYSTEMS) AND A TIMESTAMP */ /* RANGE. IT THEN USES THIS INFORMATION TO CONSTRUCT JCL */ /* WHICH WILL INVOKE DSN1COPY WITH SYSXLAT CARDS TO COPY */ /* IMAGE COPIES OF THE SOURCE DATABASES INTO THE TARGET */ /* DATABASE. */ /**********************************************************************/ ADDRESS ISPEXEC "CONTROL ERRORS RETURN" /**********************************************************************/ /* GET THE JOBCARD INFO */ /**********************************************************************/ "SELECT PGM(USERINFO) PARM("SYSVAR(SYSUID)")" IF POS('D@',SYSVAR(SYSUID)) = 1 THEN DO JCLASS = 'S' J2CLASS = 'S' END ELSE DO JCLASS = '1,TIME=(1,00)' J2CLASS = 'C,TIME=(5,00)' END /**********************************************************************/ /* MAIN PROCESSING AND DISPLAY LOOP */ /**********************************************************************/ DO WHILE CREATJCL ¬= 'Y' "DISPLAY PANEL(COPYDB)" IF RC = 8 THEN EXIT /********************************************************************/ /* VERIFY THE SOURCE DATABASE AND POP UP A SELECTION LIST IF */ /* NECESSARY. */ /********************************************************************/ "TBCREATE TEMPTABL NOWRITE REPLACE KEYS(POPFIELD)" DB2SSID = SSSID SQLQUERY = "SELECT A.NAME" SQLQUERY = SQLQUERY " FROM SYSIBM.SYSDATABASE A" IF POS('%',SDBNAME) > 0 THEN SQLQUERY = SQLQUERY " WHERE A.NAME LIKE '"SDBNAME"'" ELSE SQLQUERY = SQLQUERY " WHERE A.NAME = '"SDBNAME"'" SQLQUERY = SQLQUERY " ORDER BY A.NAME" ADDRESS LINK "REXXSQL" SQLRC = RC IF _NROWS = 0 THEN DO ZEDLMSG = 'NO SOURCE DATABASE FOUND IN 'SSSID' BY THAT NAME' "SETMSG MSG(UTLZ001W)" ITERATE END IF SQLRC <> 0 THEN DO ZEDLMSG = 'BAD SQLCODE VERIFYING SOURCE DATABASE:' SQLRC "SETMSG MSG(UTLZ001W)" ITERATE END DO I = 1 TO _NROWS POPFIELD = STRIP(NAME.I) "TBADD TEMPTABL" END IF _NROWS > 1 THEN DO "TBTOP TEMPTABL" ZTDSELS = '' "ADDPOP ROW(1) COLUMN(44)" DO WHILE ZTDSELS ¬= 1 & RC < 8 ZEDLMSG = 'SELECT 1 VALID SOURCE DATABASE' "TBDISPL TEMPTABL PANEL(CPYDBPOP)", "AUTOSEL(YES) MSG(UTLZ000)" END IF ZTDSELS = 0 THEN DO SDBNAME = '' CREATJCL = 'N' "REMPOP ALL" ZEDLMSG = 'YOU STILL NEED A SOURCE DATABASE' "SETMSG MSG(UTLZ001W)" ITERATE END "REMPOP ALL" END SDBNAME = POPFIELD /********************************************************************/ /* VERIFY THE TARGET DATABASE AND POP UP A SELECTION LIST IF */ /* NECESSARY. */ /********************************************************************/ "TBCREATE TEMPTABL NOWRITE REPLACE KEYS(POPFIELD)" DB2SSID = TSSID SQLQUERY = "SELECT A.NAME" SQLQUERY = SQLQUERY " FROM SYSIBM.SYSDATABASE A" IF POS('%',TDBNAME) > 0 THEN SQLQUERY = SQLQUERY " WHERE A.NAME LIKE '"TDBNAME"'" ELSE SQLQUERY = SQLQUERY " WHERE A.NAME = '"TDBNAME"'" SQLQUERY = SQLQUERY " ORDER BY A.NAME" ADDRESS LINK "REXXSQL" SQLRC = RC IF _NROWS = 0 THEN DO ZEDLMSG = 'NO TARGET DATABASE FOUND IN 'TSSID' BY THAT NAME' "SETMSG MSG(UTLZ001W)" ITERATE END IF SQLRC < 0 THEN DO ZEDLMSG = 'BAD SQLCODE VERIFYING TARGET DATABASE:' SQLRC "SETMSG MSG(UTLZ001W)" ITERATE END DO I = 1 TO _NROWS POPFIELD = STRIP(NAME.I) "TBADD TEMPTABL" END IF _NROWS > 1 THEN DO "TBTOP TEMPTABL" ZTDSELS = '' "ADDPOP ROW(1) COLUMN(44)" DO WHILE ZTDSELS ¬= 1 & RC < 8 ZEDLMSG = 'SELECT 1 VALID TARGET DATABASE' "TBDISPL TEMPTABL PANEL(CPYDBPOP)", "AUTOSEL(YES) MSG(UTLZ000)" END IF ZTDSELS = 0 THEN DO TDBNAME = '' CREATJCL = 'N' "REMPOP ALL" ZEDLMSG = 'YOU STILL NEED A TARGET DATABASE' "SETMSG MSG(UTLZ001W)" ITERATE END "REMPOP ALL" END TDBNAME = POPFIELD /********************************************************************/ /* POPUP A SELECTION LIST FOR "FROM" TIMESTAMP IF GIVEN A PARTIAL */ /********************************************************************/ SYSCRETR = STRIP(SYSCRETR) IF FTSYYYY = '' ³, FTSMM = '' ³, FTSDD = '' ³, FTSHH = '' ³, FTSMN = '' ³, FTSSS = '' ³, FTSMLSS = '' THEN DO IF FTSYYYY = '' THEN FTSYYYY = '0001' IF FTSMM = '' THEN FTSMM = '01' IF FTSDD = '' THEN FTSDD = '01' IF FTSHH = '' THEN FTSHH = '00' IF FTSMN = '' THEN FTSMN = '00' IF FTSSS = '' THEN FTSSS = '00' IF FTSMLSS = '' THEN FTSMLSS = '000000' FTMESTMP = FTSYYYY"-" ³³, FTSMM"-" ³³, FTSDD"-" ³³, FTSHH"." ³³, FTSMN"." ³³, FTSSS"." ³³, FTSMLSS "TBCREATE TEMPTABL NOWRITE REPLACE KEYS(POPFIELD)" DB2SSID = SSSID SQLQUERY = "SELECT TSNAME, CHAR(TIMESTAMP) AS TSTAMP" SQLQUERY = SQLQUERY " FROM "SYSCRETR".SYSCOPY" SQLQUERY = SQLQUERY " WHERE DBNAME = '"SDBNAME"'" SQLQUERY = SQLQUERY " AND TSNAME LIKE '"STSNAME"'" SQLQUERY = SQLQUERY " AND ICTYPE = 'F'" SQLQUERY = SQLQUERY " AND ICBACKUP = ' '" SQLQUERY = SQLQUERY " AND TIMESTAMP >= '"FTMESTMP"'" SQLQUERY = SQLQUERY " ORDER BY TSTAMP" ADDRESS LINK "REXXSQL" SQLRC = RC IF SQLRC = 100 THEN DO ZEDLMSG = 'NO TIMESTAMP >=' FTMESTMP 'IN 'SSSID' SYSCOPY' "SETMSG MSG(UTLZ001W)" ITERATE END IF SQLRC < 0 THEN DO ZEDLMSG = 'BAD SQLCODE VERIFYING "FROM" TIMESTAMP"' SQLRC "SETMSG MSG(UTLZ001W)" ITERATE END DO I = 1 TO _NROWS POPFIELD = SUBSTR(STRIP(TSNAME.I)" ",1,8), STRIP(TSTAMP.I) "TBADD TEMPTABL" END IF _NROWS > 1 THEN DO "TBTOP TEMPTABL" ZTDSELS = '' "ADDPOP ROW(1) COLUMN(34)" DO WHILE ZTDSELS ¬= 1 & RC < 8 ZEDLMSG = 'SELECT 1 "FROM" TIMESTAMP ROW' "TBDISPL TEMPTABL PANEL(CPYDBPO2)", "AUTOSEL(YES) MSG(UTLZ000)" END IF ZTDSELS = 0 THEN DO FTSYYYY = '' FTSMM = '' FTSDD = '' FTSHH = '' FTSMN = '' FTSSS = '' FTSMLSS = '' CREATJCL = 'N' "REMPOP ALL" ZEDLMSG = 'YOU STILL NEED A "FROM" TIMESTAMP' "SETMSG MSG(UTLZ001W)" ITERATE END "REMPOP ALL" END PARSE UPPER VAR POPFIELD TSNAME FTMESTMP PARSE UPPER VAR FTMESTMP FTSYYYY '-', FTSMM '-', FTSDD '-', FTSHH '.', FTSMN '.', FTSSS '.', FTSMLSS . END FTMESTMP = FTSYYYY"-" ³³, FTSMM"-" ³³, FTSDD"-" ³³, FTSHH"." ³³, FTSMN"." ³³, FTSSS"." ³³, FTSMLSS /********************************************************************/ /* POPUP A SELECTION LIST FOR "TO" TIMESTAMP IF GIVEN A PARTIAL ONE */ /********************************************************************/ IF TTSYYYY = '' ³, TTSMM = '' ³, TTSDD = '' ³, TTSHH = '' ³, TTSMN = '' ³, TTSSS = '' ³, TTSMLSS = '' THEN DO IF TTSYYYY = '' THEN TTSYYYY = '0001' IF TTSMM = '' THEN TTSMM = '01' IF TTSDD = '' THEN TTSDD = '01' IF TTSHH = '' THEN TTSHH = '00' IF TTSMN = '' THEN TTSMN = '00' IF TTSSS = '' THEN TTSSS = '00' IF TTSMLSS = '' THEN TTSMLSS = '000000' TTMESTMP = TTSYYYY"-" ³³, TTSMM"-" ³³, TTSDD"-" ³³, TTSHH"." ³³, TTSMN"." ³³, TTSSS"." ³³, TTSMLSS "TBCREATE TEMPTABL NOWRITE REPLACE KEYS(POPFIELD)" DB2SSID = SSSID SQLQUERY = "SELECT TSNAME, CHAR(TIMESTAMP) AS TSTAMP" SQLQUERY = SQLQUERY " FROM "SYSCRETR".SYSCOPY" SQLQUERY = SQLQUERY " WHERE DBNAME = '"SDBNAME"'" SQLQUERY = SQLQUERY " AND TSNAME LIKE '"STSNAME"'" SQLQUERY = SQLQUERY " AND ICTYPE = 'F'" SQLQUERY = SQLQUERY " AND ICBACKUP = ' '" SQLQUERY = SQLQUERY " AND TIMESTAMP >= '"TTMESTMP"'" SQLQUERY = SQLQUERY " ORDER BY TSTAMP" ADDRESS LINK "REXXSQL" SQLRC = RC IF SQLRC = 100 THEN DO ZEDLMSG = 'NO TIMESTAMP >=' TTMESTMP 'IN 'SSSID' SYSCOPY' "SETMSG MSG(UTLZ001W)" ITERATE END IF SQLRC < 0 THEN DO ZEDLMSG = 'BAD SQLCODE VERIFYING "TO" TIMESTAMP"' SQLRC "SETMSG MSG(UTLZ001W)" ITERATE END DO I = 1 TO _NROWS POPFIELD = SUBSTR(STRIP(TSNAME.I)" ",1,8), STRIP(TSTAMP.I) "TBADD TEMPTABL" END IF _NROWS > 1 THEN DO "TBTOP TEMPTABL" ZTDSELS = '' "ADDPOP ROW(1) COLUMN(34)" DO WHILE ZTDSELS ¬= 1 & RC < 8 ZEDLMSG = 'SELECT 1 "TO" TIMESTAMP ROW' "TBDISPL TEMPTABL PANEL(CPYDBPO2)", "AUTOSEL(YES) MSG(UTLZ000)" END IF ZTDSELS = 0 THEN DO TTSYYYY = '' TTSMM = '' TTSDD = '' TTSHH = '' TTSMN = '' TTSSS = '' TTSMLSS = '' CREATJCL = 'N' "REMPOP ALL" ZEDLMSG = 'YOU STILL NEED A "TO" TIMESTAMP' "SETMSG MSG(UTLZ001W)" ITERATE END "REMPOP ALL" END PARSE UPPER VAR POPFIELD TSNAME TTMESTMP PARSE UPPER VAR TTMESTMP TTSYYYY '-', TTSMM '-', TTSDD '-', TTSHH '.', TTSMN '.', TTSSS '.', TTSMLSS . END TTMESTMP = TTSYYYY"-" ³³, TTSMM"-" ³³, TTSDD"-" ³³, TTSHH"." ³³, TTSMN"." ³³, TTSSS"." ³³, TTSMLSS END /**********************************************************************/ /* OK, NOW WE'VE GOT THE APPROPRIATE PARAMETERS TO PASS TO THE NEXT */ /* STEP, WHICH IS RUN IN BATCH. THE FOLLOWING CODE CREATES A FILE TO */ /* HOLD THE JCL AND THEN CREATES THE JCL. IF THE USER REQUESTS TO */ /* "REVIEW" THE JCL, THEY ARE TAKEN INTO AN EDIT SESSION AND THE JOB */ /* IS *NOT* SUBMITTED. OTHERWISE THE JOB IS SUBMITTED AUTOMATICALLY. */ /**********************************************************************/ TEMPFILE = SYSVAR(SYSUID) ³³ '.TEMP.COPYDB.JCL' ADDRESS TSO DUMMY = OUTTRAP('NULL.') "FREE DD(ISPFILE)" "DELETE '"TEMPFILE"'" "ALLOCATE DD(ISPFILE) DSN('"TEMPFILE"')" , "NEW CATALOG" , "UNIT(SYSDA) VOLUME(WRK$$$)" , "SPACE(1,1) TRACKS RELEASE" , "RECFM(F B) LRECL(80) DSORG(PS)" DROP NULL. ADDRESS ISPEXEC "FTOPEN" "FTINCL COPYDB" SAVERC = RC "FTCLOSE" ADDRESS TSO "FREE DD(ISPFILE)" IF SAVERC > 0 THEN DO ZEDLMSG = 'FILE TAILORING OF THE "COPYDB" SKELETON FAILED', 'WITH RC =' SAVERC "SETMSG MSG(UTLZ001W)" "EDIT DATASET('"TEMPFILE"')" END ELSE IF JCLREVEW = 'Y' THEN DO ZEDLMSG = 'YOU MUST SUBMIT THIS JCL YOURSELF' "SETMSG MSG(UTLZ000W)" "EDIT DATASET('"TEMPFILE"')" END ELSE DO ADDRESS TSO "SUBMIT '"TEMPFILE"'" ZEDLMSG = 'COPYDB JOB SUBMITTED' "SETMSG MSG(UTLZ000W)" END EXIT SAVERC ./ ADD NAME=COPYDBJ /* REXX ***************************************************************/ /* UTILITY: COPYDBJ */ /* AUTHOR: DAVID LEIGH */ /* FUNCTION: THIS EXEC MATCHES UP SYSCOPY RECORDS FROM AN INPUT FILE */ /* (PREVIOUSLY "UNLOADED" WITH DSNTIAUL) BASED ON TABLE */ /* NAME WITH CATALOG INFORMATION IN A TARGET DATABASE AND */ /* CREATES DSN1COPY JCL TO COPY SOURCE DATABASE IMAGE */ /* COPIES TO A TARGET DATABASE WITH "SYSXLAT" CARDS. */ /**********************************************************************/ /**********************************************************************/ /* CAPTURE AND EVALUATE THE PASSED IN ARGUMENTS */ /**********************************************************************/ PARSE UPPER ARG DB2SSID DATABASE . /**********************************************************************/ /* CREATE WORK ISPF TABLES */ /**********************************************************************/ ADDRESS ISPEXEC "TBCREATE TEMPTABL NOWRITE REPLACE", "NAMES(TABLE DATABASE STSNAME PARTNUM TAPELAB ICNAME PART", "INDBID INPSID INOBID", "OUTDBID OUTPSID OUTOBID", "VOLSER VCAT TTSNAME LASTPART TIMESTMP)" "TBCREATE TEMPVOLS NOWRITE REPLACE", "KEYS(FIRSTVOL)", "NAMES(FIRSTLAB LASTLAB LASTVOL FULLVOL MODIFIED)" "TBCREATE TEMPNDXT NOWRITE REPLACE", "NAMES(TNAME TCREATOR DATABASE INDEX ICREATOR)" "TBCREATE TEMPJOBL NOWRITE REPLACE", "NAMES(JLINE)" /**********************************************************************/ /* LOAD THE JOBCARD INTO TABLE ROWS */ /**********************************************************************/ ADDRESS TSO "EXECIO * DISKR JOBLINES (STEM JOBREC. FINIS)" DO I = 1 TO JOBREC.0 JLINE = STRIP(JOBREC.I) "TBADD TEMPJOBL" END /**********************************************************************/ /* SET SOME WORK VARIABLES */ /**********************************************************************/ DNODE = 'D'SUBSTR(DATE(U),4,2)SUBSTR(DATE(U),7,2) TNODE = 'T'SUBSTR(TIME(L),1,2)SUBSTR(TIME(L),4,2) PREVVOL = '' V = 0 /**********************************************************************/ /* THIS IS THE MAIN PROCESSING LOOP. THE INPUT FILE IS READ INTO A */ /* STEM ARRAY AND THEN THE ARRAY IS PROCESSED ONE AT A TIME. FOR */ /* EACH INPUT RECORD, THE FIELDS ARE PARSED OUT AND CLEANED UP. THEN */ /* AN SQL STATEMENT IS ISSUED TO CAPTURE THE CORRESPONDING INTERNAL */ /* IDENTIFIERS FOR THE TARGET ENVIRONMENT AND THEY ARE PUT INTO THE */ /* ISPF TABLE. */ /**********************************************************************/ ADDRESS TSO "EXECIO * DISKR SRCOBJ (STEM SRCREC. FINIS)" DO I = 1 TO SRCREC.0 /********************************************************************/ /* PARSE THE INPUT RECORD AND CLEAN UP THE VALUES */ /********************************************************************/ PARSE UPPER VAR SRCREC.I SDBNAME 9, STSNAME 17 24, PARTNUM 27, TAPELAB 37, ICNAME 80 81, INDBID 86, INPSID 91, INOBID 96, FIRSTVOL 104, TABLE 122 124, TIMESTMP 148 150, VOLSER '00'X ICNAME = STRIP(ICNAME,B,' ') TABLE = STRIP(TABLE,T,'00'X) VOLSER = STRIP(VOLSER,T,',') FIRSTVOL = SUBSTR(FIRSTVOL,1,6) TAPELAB = '000'TAPELAB TAPELAB = SUBSTR(TAPELAB,LENGTH(TAPELAB)-2,LENGTH(TAPELAB)) TAPELAB = STRIP(TAPELAB,T,' ') INDBID = STRIP(INDBID,L,'0') INPSID = STRIP(INPSID,L,'0') INOBID = STRIP(INOBID,L,'0') /********************************************************************/ /* KEEP TRACK OF MULTI-VOLUME INFORMATION */ /********************************************************************/ "TBGET TEMPVOLS" IF RC = 8 THEN DO FIRSTLAB = TAPELAB LASTLAB = TAPELAB FULLVOL = VOLSER LASTVOL = SUBSTR(FULLVOL,LENGTH(FULLVOL)-5,6) MODIFIED = 'NO' "TBADD TEMPVOLS" END ELSE DO LASTLAB = TAPELAB FULLVOL = VOLSER LASTVOL = SUBSTR(FULLVOL,LENGTH(FULLVOL)-5,6) "TBPUT TEMPVOLS" END /********************************************************************/ /* SET FLAGS IF THIS IS A PARTITIONED TABLESPACE */ /********************************************************************/ IF PARTNUM = '00' THEN DO PART = 'NO' LASTPART = PARTNUM SAY ' ' SAY '*** PROCESSING TABLE:' TABLE END ELSE DO PART = 'YES' LASTPART = '' IF PARTNUM = 1 THEN SAY ' ' SAY '*** PROCESSING TABLE:' TABLE 'PARTITION('PARTNUM')' END /********************************************************************/ /* GET THE TARGET OBJECT INTERNAL IDENTIFIERS */ /********************************************************************/ SQLQUERY = "SELECT A.DBID AS DBID2," SQLQUERY = SQLQUERY " C.OBID AS OBID2," SQLQUERY = SQLQUERY " A.PSID AS PSID2," SQLQUERY = SQLQUERY " A.NAME AS TSNAME," SQLQUERY = SQLQUERY " C.CREATOR AS TCREATOR," SQLQUERY = SQLQUERY " B.VCATNAME" SQLQUERY = SQLQUERY "FROM SYSIBM.SYSTABLESPACE A ," SQLQUERY = SQLQUERY " SYSIBM.SYSTABLEPART B ," SQLQUERY = SQLQUERY " SYSIBM.SYSTABLES C" SQLQUERY = SQLQUERY "WHERE C.DBNAME = '"DATABASE"'" SQLQUERY = SQLQUERY "AND C.DBNAME = A.DBNAME" SQLQUERY = SQLQUERY "AND C.TSNAME = A.NAME" SQLQUERY = SQLQUERY "AND A.DBID = C.DBID" SQLQUERY = SQLQUERY "AND C.NAME = '"TABLE"'" SQLQUERY = SQLQUERY "AND B.DBNAME = A.DBNAME" SQLQUERY = SQLQUERY "AND B.TSNAME = A.NAME" SQLQUERY = SQLQUERY "AND B.PARTITION = "PARTNUM ADDRESS LINK "REXXSQL" SQLRC = RC IF SQLRC < 0 THEN DO SAY '*** BAD RC FROM REXXSQL ('DB2SSID') STMT #1:' SQLRC ADDRESS LINK "CANCEL" EXIT 20 END IF SQLRC = 0 THEN DO OUTDBID = STRIP(DBID2.1) OUTOBID = STRIP(OBID2.1) OUTPSID = STRIP(PSID2.1) VCAT = STRIP(VCATNAME.1) TTSNAME = STRIP(TSNAME.1) "TBADD TEMPTABL" END /********************************************************************/ /* GET THE INDEX NAMES FOR THE TARGET TABLE FOR RECOVERING THEM */ /********************************************************************/ IF (PART = 'YES' & PARTNUM = 1) ³ (PART = 'NO') THEN DO SQLQUERY = "SELECT NAME AS INAME," SQLQUERY = SQLQUERY " CREATOR" SQLQUERY = SQLQUERY "FROM SYSIBM.SYSINDEXES" SQLQUERY = SQLQUERY "WHERE DBNAME = '"DATABASE"'" SQLQUERY = SQLQUERY " AND TBNAME = '"TABLE"'" SQLQUERY = SQLQUERY " AND TBCREATOR = '"TCREATOR.1"'" ADDRESS LINK "REXXSQL" SQLRC = RC IF SQLRC < 0 THEN DO SAY '*** BAD RC FROM REXXSQL ('DB2SSID') STMT #2:' SQLRC ADDRESS LINK "CANCEL" EXIT 20 END IF SQLRC = 0 THEN DO J = 1 TO _NROWS INDEX = STRIP(INAME.J) TNAME = STRIP(TABLE) ICREATOR = STRIP(CREATOR.J) "TBADD TEMPNDXT" SAY ' INDEX:' INDEX END END END /**********************************************************************/ /* POST PROCESS THE MAIN TABLE TO ACCUMULATE VOLSER'S */ /**********************************************************************/ SAY ' ' SAY '*** POST-PROCESSING TO UPDATE MULTI-VOLUME VOLSERS ***' SAY ' ' DROP SAVEVOL. DROP SAVEFULL. V = 0 "TBSORT TEMPVOLS FIELDS(FIRSTLAB,C,A)" "TBTOP TEMPVOLS" "TBVCLEAR TEMPVOLS" MODIFIED = 'NO' "TBSARG TEMPVOLS NAMECOND(MODIFIED,EQ)" "TBSCAN TEMPVOLS" DO WHILE RC = 0 SAY '*** DETERMINING VOLUME SET BEGINNING:' FIRSTVOL V = V + 1 SAVEVOL.V = FIRSTVOL SAVEFULL.V = FULLVOL MODIFIED = 'YES' "TBPUT TEMPVOLS" FIRSTVOL = LASTVOL "TBGET TEMPVOLS" DO WHILE RC = 0 MODIFIED = 'YES' "TBPUT TEMPVOLS" SAVEFULL.V = SAVEFULL.V','SUBSTR(FULLVOL,8) IF FIRSTVOL = LASTVOL THEN LEAVE FIRSTVOL = LASTVOL "TBGET TEMPVOLS" END SAVEFULL.V = STRIP(SAVEFULL.V,T,',') SAY '****** VOLUME SET:' SAVEVOL.V '=' SAVEFULL.V "TBSORT TEMPVOLS FIELDS(FIRSTLAB,C,A)" "TBTOP TEMPVOLS" "TBVCLEAR TEMPVOLS" MODIFIED = 'NO' "TBSARG TEMPVOLS NAMECOND(MODIFIED,EQ)" "TBSCAN TEMPVOLS" END "TBTOP TEMPVOLS" "TBSKIP TEMPVOLS" DO WHILE RC = 0 DO I = 1 TO V IF POS(FIRSTVOL,SAVEFULL.I) > 0 THEN DO FULLVOL = SAVEFULL.I MODIFIED = 'YES' "TBPUT TEMPVOLS" LEAVE END END "TBSKIP TEMPVOLS" END SAY ' ' SAY '*** UPDATING THE MAIN TABLE WITH MULTI-VOLUME INFO ***' SAY ' ' "TBTOP TEMPTABL" "TBSKIP TEMPTABL" DO WHILE RC = 0 FIRSTVOL = SUBSTR(VOLSER,1,6) "TBGET TEMPVOLS" VOLSER = FULLVOL "TBPUT TEMPTABL" "TBSKIP TEMPTABL" END /**********************************************************************/ /* POST PROCESS THE MAIN TABLE TO TRACK THE LAST PARTITION NUMBER */ /**********************************************************************/ SAY ' ' SAY '*** POST-PROCESSING TO UPDATE LAST PARTITION NUMBER ***' "TBSORT TEMPTABL FIELDS(STSNAME,C,A,PARTNUM,N,D)" "TBTOP TEMPTABL" "TBSKIP TEMPTABL" PREVTS = '' DO WHILE RC = 0 IF STSNAME ¬= PREVTS THEN DO SAVEPART = PARTNUM PREVTS = STSNAME END LASTPART = SAVEPART "TBPUT TEMPTABL" "TBSKIP TEMPTABL" END /**********************************************************************/ /* THIS STEP ACTUALLY CREATES THE DSN1COPY JCL */ /**********************************************************************/ SAY ' ' SAY '*** CREATING DSN1COPY JCL ***' "TBSORT TEMPTABL FIELDS(VOLSER,C,A,TAPELAB,C,A)" "TBTOP TEMPTABL" "FTOPEN" "FTINCL DSN1COPY" "FTCLOSE" EXIT ./ ADD NAME=COPYDDL PROC 2 DDL_DSN TARGET_MEMBER + WRKLIB(DUSC1.STR.WRKLIB) DDLLIB(DUSC1.STR.DDLLIB) /*** CHECK THE DEBUG SWITCH ***/ ISPEXEC VGET DBGSWTCH PROFILE IF &DBGSWTCH = ON THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS ISPEXEC LMINIT DATAID(INDID) DATASET(&DDL_DSN) ISPEXEC LMINIT DATAID(WRKDID) DATASET('&WRKLIB') ISPEXEC LMINIT DATAID(DDLDID) DATASET('&DDLLIB') ISPEXEC LMOPEN DATAID(&INDID) ISPEXEC LMCOPY FROMID(&INDID) TODATAID(&WRKDID) TOMEM(&TARGET_MEMBER) + TRUNC REPLACE ISPEXEC LMCOPY FROMID(&INDID) TODATAID(&DDLDID) TOMEM(&TARGET_MEMBER) + TRUNC REPLACE ISPEXEC LMCLOSE DATAID(&INDID) ISPEXEC LMFREE DATAID(&INDID) ISPEXEC LMFREE DATAID(&WRKDID) ISPEXEC EDIT DATAID(&DDLDID) MEMBER(&TARGET_MEMBER) MACRO(%FIXDDLX) ISPEXEC LMFREE DATAID(&DDLDID) EXIT ./ ADD NAME=COPYDS ISREDIT MACRO (PARM) ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /******************************************************************/ /* 'COPYDS' EDIT MACRO. CALL THE DSCOPY CLIST TO COPY THE EDITED */ /* DATASET TO ANOTHER ONE. */ /* AUTHOR : DAVID LEIGH DATE : 6-1-89 */ /******************************************************************/ IF &PARM = &STR(HELP) THEN GOTO HELPSEC SET MBR = ISREDIT (MBR) = MEMBER ISREDIT (DSN) = DATASET IF &LENGTH(&STR(&MBR)) > 0 THEN SET DSN = &STR(&DSN.(&MBR)) SET ZEDSMSG = &STR(PROBLEM WITH DATASET) SET ZEDLMSG = &STR(&DSN PROBLEM : &SYSDSN('&DSN')) IF &SYSDSN('&DSN') = OK OR + &STR(&SWITCH) = ON THEN + DO SET INVOKE = COPYDS ISPEXEC VPUT (INVOKE) SHARED ISPEXEC SELECT CMD(%DSCOPY IN(&DSN) &PARM) END EXIT HELPSEC: + CLEAR WRITE *** HELP FOR EDIT MACRO 'COPYDS' *** WRITE WRITE THE COPYDS EDIT MACRO ALLOWS THE USER TO INVOKE THE DSCOPY CLIST WRITE USING THE CURRENT EDITED DATASET AS THE "IN" DATASET. WRITE WRITE BASIC SYNTAX : WRITE WRITE COMMAND ===> COPYDS WRITE WRITE THIS EXAMPLE WILL TAKE YOU INTO AN ISPF PANEL WHERE YOU MAY ENTER WRITE THE "OUT" DATASET AN CHANGE OR LEAVE THE DEFAULT VALUES FOR THE WRITE EXISTING "OUT" DATASET DISPOSITION AND THE SYSPRINT VIEWING WRITE OPTION. WRITE WRITE FOR HELP WITH THE PANEL, EXECUTE COPYDS IN SUCH A WAY AS TO WRITE ACCESS THE ISPF PANEL AND THEN TYPE "HELP" IN THE COMMAND WRITE LINE. WRITE WRITE YOU MAY ALSO EXECUTE THIS FUNCTION AS A CLIST NAMED "DSCOPY". WRITE "TSO DSCOPY HELP" ON ANY COMMAND LINE FOR HELP IN HOW TO USE IT. WRITE WRITE *** END OF HELP *** NO PROCESSING PERFORMED *** EXIT ./ ADD NAME=COPYNAM /********************************************************************** /* CLIST: COPYNAM * /* AUTHOR: MICHELE DELUHERY * /* FUNCTION: THIS CLIST DETERMINES A VALID NEW COPYBOOK MEMBER NAME * /********************************************************************** /* SET UP SOME DEFAULT VARIABLES WHICH COULD BE CHANGED WHEN THE * /* CLIST IS INVOKED. * /********************************************************************** PROC 0 /********************************************************************** /* CONTROL DEBUG PROCESSING * /********************************************************************** /* BASED ON THE VARIABLE "DEBUG", DISPLAY OR DON'T DISPLAY LINES AS * /* THEY EXECUTE. * /********************************************************************** ISPEXEC CONTROL ERRORS RETURN IF &DEBUG = DEBUG OR &OPT1 = DEBUG OR &OPT2 = DEBUG THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ISPEXEC DISPLAY PANEL(COPYPN1) /********************************************************************** /* CHECK FOR PF03 KEY TO EXIT CLIST * /********************************************************************** IF &PANELCC = 8 THEN EXIT EXIT ./ ADD NAME=COPYNX ISREDIT MACRO PROCESS (MEMBER) ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /******************************************************************/ /* 'COPYNX' EDIT MACRO. COPY 'NON-EXCLUDED' LINES AFTER OR BEFORE */ /* OTHER LINES, OR TO ANOTHER MEMBER IN THE PDS */ /* AUTHOR : DAVID LEIGH */ /******************************************************************/ IF &STR(&MEMBER) = &STR(HELP) THEN GOTO HELPSEC ISREDIT (CURRDSN) = DATASET LISTDSI '&CURRDSN' IF &SYSINDEX(&STR(PO),&STR(&SYSDSORG)) = 0 THEN + DO SET ZEDLMSG = &STR(THIS DATASET MUST BE A PDS TO + EXECUTE THIS UTILITY) ISPEXEC SETMSG MSG(UTLZ001) EXIT END IF &STR(&MEMBER) = THEN + DO ISREDIT PROCESS RANGE A B IF &LASTCC = 4 THEN + DO SET ZEDLMSG = &STR(LINE COMMAND 'A' OR 'B' + MUST BE SPECIFIED) ISPEXEC SETMSG MSG(UTLZ001) EXIT END ISREDIT (LINECMD) = RANGE_CMD END IF &STR(&MEMBER) = THEN + SET DSN = &STR(&CURRDSN($&SYSID)) ELSE + SET DSN = &STR(&CURRDSN(&MEMBER)) DELETE '&DSN' FREE DDNAME(TEMPFREE) ALLOC DDNAME(TEMPFREE) + DSN('&DSN') + SHR KEEP OPENFILE TEMPFREE OUTPUT ISREDIT (LN,CL) = CURSOR ISREDIT FIND FIRST P'=' 1 NX DO WHILE &LASTCC = 0 ISREDIT (TEMPFREE) = LINE .ZCSR PUTFILE TEMPFREE ISREDIT FIND NEXT P'=' 1 NX END CLOSFILE TEMPFREE FREE DDNAME(TEMPFREE) IF &STR(&MEMBER) = THEN + DO IF &LINECMD = A THEN ISREDIT COPY $&SYSUID AFTER .ZFRANGE ELSE ISREDIT COPY $&SYSUID BEFORE .ZLRANGE END ISREDIT CURSOR = &LN &CL EXIT HELPSEC: + 02480000 ISPEXEC SELECT PGM(ISPTUTOR) PARM(UTILH028) 02490000 SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR COPYNX UTILITY + 02490000 *** NO PROCESSING PERFORMED ***) 02490000 ISPEXEC SETMSG MSG(UTLZ000) 02490000 EXIT ./ ADD NAME=COPYVAR /********************************************************************** /* UTILITY: COPYVAR * /* AUTHOR: DAVID LEIGH * /* FUNCTION: THIS CLIST COPIES THE VALUE OF ONE ISPF VARIABLE INTO * /* ANOTHER AND THEN STORES IT INTO THE POOL DESIRED. * /********************************************************************** PROC 3 ISPF_FROM_VARIABLE ISPF_TO_VARIABLE ISPF_VARIABLE_POOL /*** CHECK THE DEBUG SWITCH ***/ ISPEXEC VGET DBGSWTCH PROFILE IF &DBGSWTCH = ON THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS ISPEXEC VGET &ISPF_FROM_VARIABLE SET &&ISPF_TO_VARIABLE = &STR(&SYSNSUB(3,&&&ISPF_FROM_VARIABLE)) ISPEXEC VPUT &ISPF_TO_VARIABLE &ISPF_VARIABLE_POOL EXIT ./ ADD NAME=COPYX ISREDIT MACRO NOPROCESS (HELP) ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /******************************************************************/ /* 'COPYX' EDIT MACRO. COPY 'EXCLUDED' LINES AFTER OR BEFORE OTHER*/ /* LINES. */ /* AUTHOR : DAVID LEIGH DATE : 11-7-89 */ /******************************************************************/ IF &STR(&HELP) = &STR(HELP) THEN GOTO HELPSEC ISREDIT (CURRDSN) = DATASET LISTDSI '&CURRDSN' IF &SYSINDEX(&STR(PO),&STR(&SYSDSORG)) = 0 THEN + DO SET ZEDLMSG = &STR(THIS DATASET MUST BE A PDS TO + EXECUTE THIS UTILITY) ISPEXEC SETMSG MSG(UTLZ001) EXIT END ISREDIT PROCESS RANGE A B IF &LASTCC = 4 THEN + DO SET ZEDLMSG = &STR(LINE COMMAND 'A' OR 'B' MUST BE SPECIFIED) ISPEXEC SETMSG MSG(UTLZ001) EXIT END ISREDIT (LINECMD) = RANGE_CMD DELETE '&CURRDSN($&SYSUID)' FREE DDNAME(TEMPFREE) ALLOC DDNAME(TEMPFREE) + DSN('&CURRDSN($&SYSUID)') + SHR KEEP OPENFILE TEMPFREE OUTPUT ISREDIT LABEL .ZCSR = .LABELA ISREDIT CURSOR = 1 1 SET SAVECC = 0 ISREDIT FIND FIRST P'=' 1 X SET SAVECC = &LASTCC DO WHILE &SAVECC = 0 ISREDIT (TEMPFREE) = LINE .ZCSR PUTFILE TEMPFREE ISREDIT FIND NEXT P'=' 1 X SET SAVECC = &LASTCC END CLOSFILE TEMPFREE FREE DDNAME(TEMPFREE) IF &LINECMD = A THEN ISREDIT COPY $&SYSUID AFTER .ZFRANGE ELSE ISREDIT COPY $&SYSUID BEFORE .ZLRANGE ISREDIT CURSOR = .LABELA ISREDIT RESET EXIT HELPSEC: + 02480000 ISPEXEC SELECT PGM(ISPTUTOR) PARM(UTILH028) 02490000 SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR COPYX UTILITY + 02490000 *** NO PROCESSING PERFORMED ***) 02490000 ISPEXEC SETMSG MSG(UTLZ000) 02490000 EXIT ./ ADD NAME=COUNTKEY /*********************************************************************/ /* CLIST COUNTKEY - COUNT THE KEY OCCURANCES WITHIN A FILE */ /* AUTHOR : DAVID LEIGH DATE : 5-31-89 */ /*********************************************************************/ PROC 0 HELP DSN() COL1() COL2() VIEW(E) BATCH /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT IF &HELP = &STR(HELP) THEN GOTO HELPSEC ISPEXEC VGET (INVOKE) SHARED IF &INVOKE = THEN SET INVOKE = COUNTKEY SET OUTDSN = &STR(&SYSUID..TEMP.&INVOKE..OUTPUT) SET CARDDSN = &STR(&SYSUID..TEMP.&INVOKE..SYSIN) SET OUTSYS = &STR(&SYSUID..TEMP.&INVOKE..SYSOUT) SET DIALOG = OFF IF &DSN = OR &COL1 = OR &COL2 = THEN + DO SET DIALOG = ON ISPEXEC VPUT (INVOKE VIEW DSN COL1 COL2 OUTDSN) SHARED ISPEXEC DISPLAY PANEL(UTILCTKY) IF &LASTCC > 0 THEN + DO SET ZEDLMSG = &STR(EXITED "&INVOKE" UTILITY WITHOUT)+ &STR( PROCESSING) ISPEXEC SETMSG MSG(UTLZ000) EXIT END ISPEXEC VGET (INVOKE VIEW DSN COL1 COL2 OUTDSN) SHARED END SET ZEDLMSG = &STR(*** PREPARING FOR CALL TO SYNCSORT ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) SET RP = &STR()) SET LP = &STR(( SET SLEN = &COL2 - &COL1 + 1 IF &SLEN > 9 THEN + DO SET LRECL = &SLEN + 12 SET EQL = &SLEN END ELSE + DO SET LRECL = 21 SET EQL = 9 END SET PAD = &LRECL - &SLEN IF &PAD < 1 THEN SET PAD = 1 SET SPCE = &SLEN - 9 IF &SPCE < 0 THEN SET SPCE = 0 SET SPCE = &SPCE + 1 SET SPCE1 = &SPCE + 9 - &SLEN + 2 SET SPCE2 = &SPCE + 3 LISTDSI '&DSN' IF &LASTCC = 16 THEN + DO SET ZEDLMSG = &STR("&DSN" PROBLEM: &SYSDSN('&DSN')) ISPEXEC SETMSG MSG(UTLZ001) EXIT END IF &SYSINDEX(&STR(V),&STR(&SYSRECFM)) = 1 THEN + SET RDW = 4 ELSE + SET RDW = 0 FREE DDNAME(SORTWK01 SYSIN SORTIN SORTOUT SYSOUT SYSPRINT SORTMSG + SORTWK02 SORTWK03 SORTWK04) DELETE '&CARDDSN' ALLOC DD(SYSIN) DSN('&CARDDSN') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK$$$) + SPACE(1,1) TRACKS RELEASE + RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS) OPENFILE SYSIN OUTPUT IF &RDW = 4 THEN + SET SYSIN = &STR( INREC FIELDS=&LP.1,4,&EVAL(&RDW+&COL1),)+ &STR(&SLEN,&PAD.X&RP) ELSE + SET SYSIN = &STR( INREC FIELDS=&LP&EVAL(&RDW+&COL1),)+ &STR(&SLEN,&PAD.X&RP) PUTFILE SYSIN SET SYSIN = &STR( SORT FIELDS=&LP.&EVAL(&RDW+1),)+ &STR(&SLEN,CH,A&RP) PUTFILE SYSIN SET SYSIN = &STR( OUTFIL FILES=OUT,) PUTFILE SYSIN SET SYSIN = &STR( HEADER1=&LP'KEY VALUE',&SPCE.X,'OCCURANCES',/,) PUTFILE SYSIN SET SYSIN = &STR( &EQL'=',X,'=========='&RP,) PUTFILE SYSIN SET SYSIN = &STR( NODETAIL,) PUTFILE SYSIN SET SYSIN = &STR( SECTIONS=&LP.&EVAL(&RDW+1),)+ &STR(&SLEN,) PUTFILE SYSIN SET SYSIN = &STR( TRAILER3=&LP.&EVAL(&RDW+1),)+ &STR(&SLEN,&SPCE1.X,COUNT&RP&RP,) PUTFILE SYSIN SET SYSIN = &STR( TRAILER1=&LP&EQL'=',X,'==========',/,) PUTFILE SYSIN SET SYSIN = &STR( 'TOTAL ',&SPCE2.X,COUNT&RP) PUTFILE SYSIN CLOSFILE SYSIN IF &RDW = 0 THEN + DO ISPEXEC SELECT CMD(%BLKSIZE &LRECL 0 DEVICE(3380) BATCH) ISPEXEC VGET BLKSIZE SHARED SET RECFM = (F B A) END ELSE + DO SET LRECL = &LRECL + 4 SET BLKSIZE = 23476 SET RECFM = (V B A) END DELETE '&OUTDSN' DELETE '&OUTSYS' SET SSCC = 0 IF &BATCH = BATCH THEN GOTO BATCH_SECTION ALLOC DD(SORTIN) DSN('&DSN') + SHR KEEP ALLOC DD(SORTWK01) UNIT(SYSDA) VOLUME(WRK$$$) + SPACE(1,1) CYLINDERS ALLOC DD(SORTWK02) UNIT(SYSDA) VOLUME(WRK$$$) + SPACE(1,1) CYLINDERS ALLOC DD(SORTWK03) UNIT(SYSDA) VOLUME(WRK$$$) + SPACE(1,1) CYLINDERS ALLOC DD(SORTWK04) UNIT(SYSDA) VOLUME(WRK$$$) + SPACE(1,1) CYLINDERS ALLOC DD(SORTOUT) DSN('&OUTDSN') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK$$$) + SPACE(5,5) TRACKS RELEASE + RECFM(&RECFM) LRECL(&LRECL) BLKSIZE(&BLKSIZE) DSORG(PS) ALLOC DD(SYSOUT) DSN('&OUTSYS') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK$$$) + SPACE(1,1) TRACKS RELEASE + RECFM(F B) LRECL(121) BLKSIZE(23474) DSORG(PS) SET ZEDLMSG = &STR(*** TALLYING UNIQUE VALUES BETWEEN + &COL1 AND &COL2 ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) ISPEXEC SELECT PGM(SYNCSORT) PARM('CORE=MAX') SET SSCC = &LASTCC IF &SSCC ¬= 0 THEN + DO SET ZEDLMSG = &STR(*** SYNCSORT UNSUCCESSFUL. RC = &SSCC ***) ISPEXEC SETMSG MSG(UTLZ001) ISPEXEC EDIT DATASET('&OUTSYS') GOTO FINAL END IF &VIEW = E THEN + ISPEXEC EDIT DATASET('&OUTDSN') IF &LASTCC > 8 THEN + ISPEXEC BROWSE DATASET('&OUTDSN') ELSE + IF &VIEW = B THEN + ISPEXEC BROWSE DATASET('&OUTDSN') GOTO FINAL BATCH_SECTION: + FREE DDNAME(SORTWK01 SYSIN SORTIN SORTOUT SYSOUT SYSPRINT SORTMSG + SORTWK02 SORTWK03 SORTWK04) SET TEMPJCL = &STR(&SYSUID..TEMP.&INVOKE..JCL) DELETE '&TEMPJCL' FREE DD(TEMPDD) ALLOC DD(TEMPDD) DSN('&TEMPJCL') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK$$$) + SPACE(1,1) TRACKS RELEASE + RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS) FREE DD(TEMPDD ISPFILE) ALLOC DD(ISPFILE) DSN('&TEMPJCL') OLD ISPEXEC FTOPEN ISPEXEC FTINCL COUNTKEY SET INCLCC = &LASTCC ISPEXEC FTCLOSE FREE DD(ISPFILE) IF &INCLCC = 0 THEN + DO SET ZEDSMSG = &STR(&INVOKE JOB SUBMITTED) SET ZEDLMSG = &STR(A BATCH JOB WAS SUBMITTED TO PROCESS YOUR + "&INVOKE" REQUEST) ISPEXEC SETMSG MSG(UTLZ000) SUBMIT '&TEMPJCL' END ELSE + DO SET ZEDSMSG = &STR(COULD NOT CREATE JCL) SET ZEDLMSG = &STR(CC "&INCLCC" RETURNED FROM JCL CREATION + PROCESS) ISPEXEC SETMSG MSG(UTLZ001) END FINAL: + FREE DDNAME(SORTWK01 SYSIN SORTIN SORTOUT SYSOUT SYSPRINT SORTMSG + SORTWK02 SORTWK03 SORTWK04) EXIT HELPSEC: + CLEAR WRITE *** HELP FOR CLIST 'COUNTKEY' *** WRITE WRITE THE COUNTKEY CLIST ALLOWS THE USER TO SEARCH THROUGH SPECIFIED WRITE COLUMNS WITHIN A DATASET AND COUNT THE NUMBER OF OCCURANCES OF WRITE EACH UNIQUE STRING FOUND WITHIN THE SPECIFIED COLUMNS. THE WRITE RESULTS ARE PLACED IN A FILE AND THE USER IS THEN TAKEN INTO THAT WRITE FILE. WRITE WRITE BASIC SYNTAX : WRITE WRITE COMMAND ===> TSO COUNTKEY WRITE WRITE THIS EXAMPLE WILL TAKE YOU INTO AN ISPF PANEL WHERE YOU MAY ENTER WRITE A DATASET NAME, TWO COLUMN NUMBERS AND CHANGE OR LEAVE THE DEFAULT WRITE VALUES FOR THE OUTPUT DATASET AND HOW OR IF YOU WANT TO WRITE AUTOMATICALLY VIEW THE OUTPUT FROM THE UTILITY. WRITE WRITE OTHER EXAMPLES : WRITE WRITE COMMAND ===> TSO COUNTKEY DSN(XXXXX.XXXXXX.XXXXX) WRITE WRITE THIS EXAMPLE WILL TAKE YOU INTO THE ISPF PANEL WHERE THE DATASET WRITE NAME WILL BE PREPOPULATED BUT YOU WILL HAVE TO ENTER THE COLUMN WRITE NUMBERS. WRITE WRITE COMMAND ===> TSO COUNTKEY DSN(XXXXX.XXXXXX.XXXXX) COL1(1) COL2(2) WRITE WRITE THIS EXAMPLE WILL INVOKE THE UTILITY WITHOUT THE ISPF PANEL. IN WRITE THIS MODE, YOU WILL HAVE NO CHOICE AS TO THE OUTPUT VIEWING MODE, WRITE OR THE OUTPUT DATASET. WRITE WRITE IF A DATASET CONTAINED THE FOLLOWING : WRITE WRITE =COLS> ----+----1----+ WRITE 000001 A9999BBBC888 WRITE 000002 A9999BBBC888 WRITE 000003 A9999BCBC888 WRITE 000004 A9999BDBC888 WRITE 000005 B9999BEBC888 WRITE 000006 B9999BFBC888 WRITE 000007 B9999BBBC888 WRITE 000008 B9999BABC888 WRITE 000009 C9999BSBC888 WRITE 000010 D9999BEBC888 WRITE 000011 D9999BSBC888 WRITE 000012 E9999BBBC888 WRITE WRITE YOU COULD RUN COUNT KEY ON COLUMNS 1 5 AND GET THE FOLLOWING : WRITE WRITE KEY VALUE NUMBER OF OCCURANCES WRITE --------- -------------------- WRITE A9999 0000000000000004 WRITE B9999 0000000000000004 WRITE C9999 0000000000000001 WRITE D9999 0000000000000002 WRITE E9999 0000000000000001 WRITE ---------------------------------------- WRITE TOTAL 0000000000000011 WRITE WRITE FOR HELP WITH THE PANEL, EXECUTE COUNTKEY IN SUCH A WAY AS TO WRITE ACCESS THE COUNTKEY PANEL AND THEN TYPE "HELP" IN THE COMMAND WRITE LINE. WRITE WRITE YOU MAY ALSO EXECUTE THIS FUNCTION AS AN EDIT MACRO NAMED WRITE "KEYCOUNT". WHILE IN AN EDIT SESSION, TYPE "KEYCOUNT HELP" ON THE WRITE COMMAND LINE FOR HELP IN HOW TO USE IT. WRITE WRITE *** END OF HELP *** NO PROCESSING PERFORMED *** EXIT ./ ADD NAME=COUNTLTR PROC 0 FREE DD(TEMPDD) ALLOC DD(TEMPDD) DSN('D@UDAL.TEMP.LETTERS') SHR ERROR DO SET ERRCC = &LASTCC SET LCMD = &SYSPCMD SET LSCMD &SYSSCMD SELECT (&ERRCC) WHEN (400) DO SET EOF = YES RETURN END OTHERWISE DO ERROR OFF WRITE *** ERROR CC: &ERRCC OCCURRED READING A FILE *** WRITE *** LAST COMMAND: &LCMD WRITE *** LAST SUBCOMMAND: &LSCMD CLOSFILE TEMPDD FREE DD(TEMPDD) EXIT CODE(&ERRCC) END END END SET TYPES = 0 SET EOF = NO OPENFILE TEMPDD GETFILE TEMPDD DO WHILE &EOF = NO SET X = &X + 1 IF &EVAL(&X//1000) = 0 THEN + DO WRITE PROCESSED: &X DO &Q = 1 TO &TYPES SET LTR = &&LETTER&Q SET LTR = <R SET CNT = &&COUNT&Q SET CNT = &CNT WRITE <R &CNT END END SET LEN = &LENGTH(&TEMPDD) DO &I = 1 TO &LEN SELECT (&I) WHEN (1 | 9 | 17 | 25 | 33 | 41) DO SET J = 0 IF &TYPES = 0 THEN + DO SET TYPES = 1 SET J = 1 SET LETTER&TYPES = &SUBSTR(&I:&I+1,+ &STR(&TEMPDD)) END ELSE + DO &K = 1 TO &TYPES SET TMP = &&LETTER&K SET TMP = &TMP IF &TMP = &SUBSTR(&I:&I+1,+ &STR(&TEMPDD)) THEN SET J = &K END IF &J = 0 THEN + DO SET TYPES = &TYPES + 1 SET J = &TYPES SET LETTER&TYPES = &SUBSTR(&I:&I+1,+ &STR(&TEMPDD)) END END WHEN (3 | 11 | 19 | 27 | 35 | 43) DO IF &SUBSTR(&I:&I+3,&STR(&TEMPDD)) = &STR(9110) THEN + DO SET C = &&COUNT&J SET C = &C + 1 SET COUNT&J = &C END END END END /* ----+----1----+----2----+----3----+----4----+----5/* /* AZ911112AZ911019B2910928C3900818C3890918C4890627 /* GETFILE TEMPDD END ERROR OFF CLOSFILE TEMPDD FREE DD(TEMPDD) WRITE TOTAL PROCESSED: &X DO &I = 1 TO &TYPES SET LTR = &&LETTER&I SET LTR = <R SET CNT = &&COUNT&I SET CNT = &CNT WRITE <R &CNT END ./ ADD NAME=CPY PROC 0 MEM(NUL) DSN() /* ALLOWS BROWSING OF A COPY BOOK WHILE EDITING AND OPTIONALLY */ /* ENTERING THE DATA SET TO LOOK FOR THE MEMBER IN */ /********************************************************************** /* MODIFICATION 4/12/91 - DAVE LEIGH * /* ADDED CAPABILITY TO DISTINQUISH BETWEEN GSS AND SLSS SEARCHES, * /* ADDED THE CICS COPY LIBRARY TO THE SEARCH, INPROVED THE PARSING * /* PROCESSING TO FIND THE MEMBER NAME, ADDED EDIT AS WELL AS BROWSE * /* CAPABILITY (MADE "EDIT" THE DEFAULT), ADDED A "HELP" SECTION, * /* ADDED DEBUG CAPABILITY, AND ADDED DOCUMENTATION. * /* MODIFICATION 10/23/92 - D SLEEMAN * /* CHANGED TO BE USED AS AN EDIT MACRO OR A TSO COMMAND * /* MODIFICATION 12/07/94 - D LEIGH * /* UPDATED SLSS COPYLIB CONCATENATION * /* ADDED UNISTAR LIBRARIES * /* ADDED EXEC SQL INCLUDE CAPABILITY * /********************************************************************** CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ERROR DO SET &MODE=CLIST RETURN END ISREDIT MACRO (TEMPDSN) ERROR OFF /*** CHECK THE DEBUG SWITCH ***/ ISPEXEC VGET DBGSWTCH PROFILE IF &DBGSWTCH = ON THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT IF &MODE = CLIST THEN + DO SET TEMPDSN = &DSN SET MEMBER = &MEM END ISPEXEC CONTROL ERRORS RETURN IF &STR(&TEMPDSN) = HELP THEN GOTO HELPSEC /********************************************************************** /* SAVE THE USER'S CURRENT LOCATION. * /********************************************************************** IF &MODE ¬= CLIST THEN + ISREDIT (SLN,SCL) = CURSOR /********************************************************************** /* ATTEMPT TO DETERMINE IF THIS IS A GSS OR SLSS SEARCH * /********************************************************************** IF &MODE ¬= CLIST THEN + DO ISREDIT (DATASET) = &TEMPDSN ISREDIT (MEMBER) = MEMBER END IF &SUBSTR(1:2,&STR(&SYSUID)) = &STR(P@) THEN SET SEARCH = SLSS IF &SUBSTR(1:2,&STR(&SYSUID)) = &STR(P#) THEN SET SEARCH = GSS IF &SYSINDEX(&STR(SLSS.),&STR(&DATASET)) > 0 THEN SET SEARCH = SLSS IF &SYSINDEX(&STR(GSS.),&STR(&DATASET)) > 0 THEN SET SEARCH = GSS IF &SYSINDEX(&STR(SLS),&STR(&DATASET)) = 1 THEN SET SEARCH = SLSS IF &SYSINDEX(&STR(GSS),&STR(&DATASET)) = 1 THEN SET SEARCH = GSS IF &SEARCH = THEN SET SEARCH = SLSS /********************************************************************** /* WHAT EDIT PROFILE NUMBERING SCHEME IS BEING USED? * /********************************************************************** IF &MODE = CLIST THEN + GOTO SKIPFIND ISREDIT (X,Y) = NUMBER IF &X = ON AND &SYSINDEX(&STR( COBOL),&STR(&Y)) > 0 THEN + DO SET COL1 = 1 SET COL2 = 66 END ELSE + DO SET COL1 = 7 SET COL2 = 72 END /********************************************************************** /* GET OUT IF THIS IS A COMMENT LINE. * /********************************************************************** ISREDIT FIND FIRST '*' &COL1 .ZCSR .ZCSR IF &LASTCC = 0 THEN + DO SET ZEDSMSG = &STR(COMMENT LINE) SET ZEDLMSG = &STR(*** THIS IS A COMMENT LINE *** + NO PROCESSING PERFORMED ***) ISPEXEC SETMSG MSG(UTLZ001) GOTO FINISH END /********************************************************************** /* FIND THE MEMBER NAME ON THE LINE. * /********************************************************************** SET MEMBER = ISREDIT FIND FIRST ' COPY ' &COL1 &EVAL(&COL1 + 55 + 3) .ZCSR .ZCSR IF &LASTCC ¬= 0 THEN + DO ISREDIT FIND FIRST ' CICSCOPY ' + &COL1 &EVAL(&COL1 + 51 + 3) .ZCSR .ZCSR IF &LASTCC ¬= 0 THEN + DO ISREDIT FIND FIRST ' INCLUDE ' + &COL1 &EVAL(&COL1 + 52 + 3) .ZCSR .ZCSR IF &LASTCC ¬= 0 THEN + DO SET ZEDSMSG = &STR(NO COPY VERB) SET ZEDLMSG = &STR(*** COULD NOT FIND + "COPY", "CICSCOPY", OR + "INCLUDE" + VERB ON THIS + LINE ***) ISPEXEC SETMSG MSG(UTLZ001) GOTO FINISH END END END ISREDIT FIND NEXT P'¬' .ZCSR .ZCSR ISREDIT FIND NEXT ' ' .ZCSR .ZCSR ISREDIT FIND NEXT P'¬' .ZCSR .ZCSR ISREDIT (LN,CL1) = CURSOR ISREDIT CURSOR = &LN &EVAL(&CL1 + 8) ISREDIT FIND PREV '.' .ZCSR .ZCSR ISREDIT FIND PREV P'¬' .ZCSR .ZCSR ISREDIT (NULL,CL2) = CURSOR ISREDIT (MEMBER) = LINE .ZCSR IF &CL2 < &CL1 OR &CL2 > &LENGTH(&STR(&MEMBER)) THEN + SET MEMBER = ELSE + SET MEMBER = &SUBSTR(&CL1:&CL2,&STR(&MEMBER)) IF &STR(&MEMBER) = THEN + DO SET ZEDSMSG = &STR(NO COPYBOOK) SET ZEDLMSG = &STR(*** COULD NOT FIND THE COPYBOOK NAME ON + THIS LINE ***) ISPEXEC SETMSG MSG(UTLZ001) GOTO FINISH END GOTO SKPCLIST SKIPFIND: + SET MEMBER = &MEM /********************************************************************** /* FIND FIRST OCCURANCE OF THE COPYBOOK MEMBER IN THE LIBRARIES * /********************************************************************** SKPCLIST: + SELECT WHEN (&SYSDSN('&TEMPDSN(&MEMBER)')=OK) + SET DSN = &STR(&TEMPDSN(&MEMBER)) WHEN (&SYSDSN('&SYSUID..&SEARCH..COPYLIB(&MEMBER)')=OK) + SET DSN = &STR(&SYSUID..&SEARCH..COPYLIB(&MEMBER)) WHEN (&SYSDSN('&SYSUID..STR.COPYLIB(&MEMBER)')=OK) + SET DSN = &STR(&SYSUID..STR.COPYLIB(&MEMBER)) WHEN (&SYSDSN('QDEVL.STR.COPYLIB(&MEMBER)')=OK) + SET DSN = &STR(QDEVL.STR.COPYLIB(&MEMBER)) WHEN (&SYSDSN('PDBA.USSTRD00.DCLGEN(&MEMBER)')=OK) + SET DSN = &STR(PDBA.USSTRD00.DCLGEN(&MEMBER)) WHEN (&SYSDSN('QQUAL.STR.COPYLIB(&MEMBER)')=OK) + SET DSN = &STR(QQUAL.STR.COPYLIB(&MEMBER)) WHEN (&SYSDSN('PDBA.USSTRQ00.DCLGEN(&MEMBER)')=OK) + SET DSN = &STR(PDBA.USSTRQ00.DCLGEN(&MEMBER)) WHEN (&SYSDSN('&SEARCH..RFP.COPYLIB(&MEMBER)')=OK) + SET DSN = &STR(&SEARCH..RFP.COPYLIB(&MEMBER)) WHEN (&SYSDSN('MMODO.STR.COPYLIB(&MEMBER)')=OK) + SET DSN = &STR(MMODO.STR.COPYLIB(&MEMBER)) WHEN (&SYSDSN('PDBA.USSTRM00.DCLGEN(&MEMBER)')=OK) + SET DSN = &STR(PDBA.USSTRM00.DCLGEN(&MEMBER)) WHEN (&SYSDSN('&SEARCH..PRD.COPYLIB(&MEMBER)')=OK) + SET DSN = &STR(&SEARCH..PRD.COPYLIB(&MEMBER)) WHEN (&SYSDSN('PEMER.STR.COPYLIB(&MEMBER)')=OK) + SET DSN = &STR(PEMER.STR.COPYLIB(&MEMBER)) WHEN (&SYSDSN('PPROD.STR.COPYLIB(&MEMBER)')=OK) + SET DSN = &STR(PPROD.STR.COPYLIB(&MEMBER)) WHEN (&SYSDSN('PDBA.USSTRP00.DCLGEN(&MEMBER)')=OK) + SET DSN = &STR(PDBA.USSTRP00.DCLGEN(&MEMBER)) WHEN (&SYSDSN('SYS4.CICS.COBLIB(&MEMBER)')=OK) + SET DSN = &STR(SYS4.CICS.COBLIB(&MEMBER)) WHEN (&SYSDSN('SYS3.CACOMMON.PROD.CAIMAC(&MEMBER)')=OK) + SET DSN = &STR(SYS3.CACOMMON.PROD.CAIMAC(&MEMBER)) WHEN (&SYSDSN('SYS3.ACF2CICS.PROD.ACFMAC(&MEMBER)')=OK) + SET DSN = &STR(SYS3.ACF2CICS.PROD.ACFMAC(&MEMBER)) WHEN (&SYSDSN('CRS.V2R1M0.SELACOPY(&MEMBER)')=OK) + SET DSN = &STR(CRS.V2R1M0.SELACOPY(&MEMBER)) OTHERWISE DO SET ZEDSMSG = &STR("&MEMBER" NOT FOUND) SET ZEDLMSG = &STR("&MEMBER" NOT FOUND IN ANY COPY LIBRARY) ISPEXEC SETMSG MSG(UTLZ001) GOTO FINISH END END /********************************************************************** /* PERFORM THE EDIT/BROWSE * /********************************************************************** ISPEXEC EDIT DATASET('&DSN') SELECT (&LASTCC) WHEN (0 ³ 4) DO SET ZEDSMSG = &STR("&MEMBER" EDITED) SET ZEDLMSG = &STR("&DSN" WAS EDITED) ISPEXEC SETMSG MSG(UTLZ000) SET BROWSE = NO END WHEN (14) DO SET ZEDSMSG = &STR("&MEMBER" IN USE) SET ZEDLMSG = &STR(UNABLE TO EDIT "&MEMBER" *** + IN USE BY ANOTHER USER/TASK) ISPEXEC SETMSG MSG(UTLZ000) SET BROWSE = YES END WHEN (16) DO SET ZEDSMSG = &STR("&MEMBER" NOT FOUND) SET ZEDLMSG = &STR("&MEMBER" DOES NOT EXIT) ISPEXEC SETMSG MSG(UTLZ001) SET BROWSE = NO END WHEN (20) DO SET ZEDSMSG = &STR("&MEMBER" EDIT ERROR) SET ZEDLMSG = &STR(SEVERE ERROR "20" TRYING TO EDIT + "&MEMBER") ISPEXEC SETMSG MSG(UTLZ001) SET BROWSE = YES END OTHERWISE DO SET ZEDSMSG = &STR("&MEMBER" EDIT ERROR) SET ZEDLMSG = &STR(ERROR CC "&LASTCC" TRYING TO EDIT + "&MEMBER") ISPEXEC SETMSG MSG(UTLZ001) SET BROWSE = YES END END IF &BROWSE = NO THEN GOTO FINISH ISPEXEC BROWSE DATASET('&DSN') SELECT (&LASTCC) WHEN (0) DO SET ZEDSMSG = &STR("&MEMBER" BROWSED) SET ZEDLMSG = &STR("&DSN" WAS BROWSED) ISPEXEC SETMSG MSG(UTLZ000) END WHEN (12) DO SET ZEDSMSG = &STR("&MEMBER" IS EMPTY) SET ZEDLMSG = &STR("&DSN" HAS NO LINES *** UNABLE TO BROWSE) ISPEXEC SETMSG MSG(UTLZ001) END WHEN (14 ³ 16) DO SET ZEDSMSG = &STR("&MEMBER" NOT FOUND) SET ZEDLMSG = &STR("&DSN" WAS NOT FOUND) ISPEXEC SETMSG MSG(UTLZ001) END WHEN (20) DO SET ZEDSMSG = &STR("&MEMBER" BROWSE ERROR) SET ZEDLMSG = &STR(SEVERE ERROR "20" TRYING TO BROWSE + "&MEMBER") ISPEXEC SETMSG MSG(UTLZ001) END OTHERWISE DO SET ZEDSMSG = &STR("&MEMBER" BROWSE ERROR) SET ZEDLMSG = &STR(ERROR CC "&LASTCC" TRYING TO BROWSE + "&MEMBER") ISPEXEC SETMSG MSG(UTLZ001) END END /********************************************************************** /* RETURN TO THE SAME CURSOR POSITION AND GET OUT * /********************************************************************** FINISH: + IF &MODE ¬= CLIST THEN + ISREDIT CURSOR = &SLN &SCL EXIT HELPSEC: + 02480000 ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) 02490000 SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR CPY UTILITY + 02490000 *** NO PROCESSING PERFORMED ***) 02490000 ISPEXEC SETMSG MSG(UTLZ000) 02490000 EXIT ./ ADD NAME=CPYOLD PROC 0 MEM(NUL) DSN() /* ALLOWS BROWSING OF A COPY BOOK WHILE EDITING AND OPTIONALLY */ /* ENTERING THE DATA SET TO LOOK FOR THE MEMBER IN */ /********************************************************************** /* MODIFICATION 4/12/91 - DAVE LEIGH * /* ADDED CAPABILITY TO DISTINQUISH BETWEEN GSS AND SLSS SEARCHES, * /* ADDED THE CICS COPY LIBRARY TO THE SEARCH, INPROVED THE PARSING * /* PROCESSING TO FIND THE MEMBER NAME, ADDED EDIT AS WELL AS BROWSE * /* CAPABILITY (MADE "EDIT" THE DEFAULT), ADDED A "HELP" SECTION, * /* ADDED DEBUG CAPABILITY, AND ADDED DOCUMENTATION. * /* MODIFICATION 10/23/92 - D SLEEMAN * /* CHANGED TO BE USED AS AN EDIT MACRO OR A TSO COMMAND * /********************************************************************** CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ERROR DO SET &MODE=CLIST RETURN END ISREDIT MACRO (TEMPDSN) ERROR OFF /*** CHECK THE DEBUG SWITCH ***/ ISPEXEC VGET DBGSWTCH PROFILE IF &DBGSWTCH = ON THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT IF &MODE = CLIST THEN + DO SET TEMPDSN = &DSN SET MEMBER = &MEM END ISPEXEC CONTROL ERRORS RETURN IF &STR(&TEMPDSN) = HELP THEN GOTO HELPSEC /********************************************************************** /* SAVE THE USER'S CURRENT LOCATION. * /********************************************************************** IF &MODE ¬= CLIST THEN + ISREDIT (SLN,SCL) = CURSOR /********************************************************************** /* ATTEMPT TO DETERMINE IF THIS IS A GSS OR SLSS SEARCH * /********************************************************************** IF &MODE ¬= CLIST THEN + ISREDIT (DATASET) = &TEMPDSN IF &MODE ¬= CLIST THEN + ISREDIT (MEMBER) = MEMBER IF &SUBSTR(1:2,&STR(&SYSUID)) = &STR(P@) THEN SET SEARCH = SLSS IF &SUBSTR(1:2,&STR(&SYSUID)) = &STR(P#) THEN SET SEARCH = GSS IF &SYSINDEX(&STR(SLSS.),&STR(&DATASET)) > 0 THEN SET SEARCH = SLSS IF &SYSINDEX(&STR(GSS.),&STR(&DATASET)) > 0 THEN SET SEARCH = GSS IF &SYSINDEX(&STR(SLS),&STR(&DATASET)) = 1 THEN SET SEARCH = SLSS IF &SYSINDEX(&STR(GSS),&STR(&DATASET)) = 1 THEN SET SEARCH = GSS IF &SEARCH = THEN SET SEARCH = SLSS /********************************************************************** /* WHAT EDIT PROFILE NUMBERING SCHEME IS BEING USED? * /********************************************************************** IF &MODE = CLIST THEN + GOTO SKIPFIND ISREDIT (X,Y) = NUMBER IF &X = ON AND &SYSINDEX(&STR( COBOL),&STR(&Y)) > 0 THEN + DO SET COL1 = 1 SET COL2 = 66 END ELSE + DO SET COL1 = 7 SET COL2 = 72 END /********************************************************************** /* GET OUT IF THIS IS A COMMENT LINE. * /********************************************************************** ISREDIT FIND FIRST '*' &COL1 .ZCSR .ZCSR IF &LASTCC = 0 THEN + DO SET ZEDSMSG = &STR(COMMENT LINE) SET ZEDLMSG = &STR(*** THIS IS A COMMENT LINE *** + NO PROCESSING PERFORMED ***) ISPEXEC SETMSG MSG(ISRZ001) GOTO FINISH END /********************************************************************** /* FIND THE MEMBER NAME ON THE LINE. * /********************************************************************** SET MEMBER = ISREDIT FIND FIRST ' COPY ' &COL1 &EVAL(&COL1 + 55 + 3) .ZCSR .ZCSR IF &LASTCC ¬= 0 THEN + DO ISREDIT FIND FIRST ' CICSCOPY ' + &COL1 &EVAL(&COL1 + 51 + 3) .ZCSR .ZCSR IF &LASTCC ¬= 0 THEN + DO SET ZEDSMSG = &STR(NO COPY VERB) SET ZEDLMSG = &STR(*** COULD NOT FIND THE + "COPY" VERB ON THIS + LINE ***) ISPEXEC SETMSG MSG(ISRZ001) GOTO FINISH END END ISREDIT FIND NEXT P'¬' .ZCSR .ZCSR ISREDIT FIND NEXT ' ' .ZCSR .ZCSR ISREDIT FIND NEXT P'¬' .ZCSR .ZCSR ISREDIT (LN,CL1) = CURSOR ISREDIT CURSOR = &LN &EVAL(&CL1 + 8) ISREDIT FIND PREV '.' .ZCSR .ZCSR ISREDIT FIND PREV P'¬' .ZCSR .ZCSR ISREDIT (NULL,CL2) = CURSOR ISREDIT (MEMBER) = LINE .ZCSR IF &CL2 < &CL1 OR &CL2 > &LENGTH(&STR(&MEMBER)) THEN + SET MEMBER = ELSE + SET MEMBER = &SUBSTR(&CL1:&CL2,&STR(&MEMBER)) IF &STR(&MEMBER) = THEN + DO SET ZEDSMSG = &STR(NO COPYBOOK) SET ZEDLMSG = &STR(*** COULD NOT FIND THE COPYBOOK NAME ON + THIS LINE ***) ISPEXEC SETMSG MSG(ISRZ001) GOTO FINISH END GOTO SKPCLIST SKIPFIND: + SET MEMBER = &MEM /********************************************************************** /* FIND FIRST OCCURANCE OF THE COPYBOOK MEMBER IN THE LIBRARIES * /********************************************************************** SKPCLIST: + SELECT WHEN (&SYSDSN('&TEMPDSN(&MEMBER)')=OK) + SET DSN = &STR(&TEMPDSN(&MEMBER)) WHEN (&SYSDSN('&SYSUID..&SEARCH..COPYLIB(&MEMBER)')=OK) + SET DSN = &STR(&SYSUID..&SEARCH..COPYLIB(&MEMBER)) WHEN (&SYSDSN('&SEARCH..RFP.COPYLIB(&MEMBER)')=OK) + SET DSN = &STR(&SEARCH..RFP.COPYLIB(&MEMBER)) WHEN (&SYSDSN('&SEARCH..PRD.COPYLIB(&MEMBER)')=OK) + SET DSN = &STR(&SEARCH..PRD.COPYLIB(&MEMBER)) WHEN (&SYSDSN('CICS21.COBLIB(&MEMBER)')=OK) + SET DSN = &STR(CICS21.COBLIB(&MEMBER)) OTHERWISE DO SET ZEDSMSG = &STR("&MEMBER" NOT FOUND) SET ZEDLMSG = &STR("&MEMBER" NOT FOUND IN ANY COPY LIBRARY) ISPEXEC SETMSG MSG(ISRZ001) GOTO FINISH END END /********************************************************************** /* PERFORM THE EDIT/BROWSE * /********************************************************************** ISPEXEC EDIT DATASET('&DSN') SELECT (&LASTCC) WHEN (0 ³ 4) DO SET ZEDSMSG = &STR("&MEMBER" EDITED) SET ZEDLMSG = &STR("&DSN" WAS EDITED) ISPEXEC SETMSG MSG(ISRZ000) SET BROWSE = NO END WHEN (14) DO SET ZEDSMSG = &STR("&MEMBER" IN USE) SET ZEDLMSG = &STR(UNABLE TO EDIT "&MEMBER" *** + IN USE BY ANOTHER USER/TASK) ISPEXEC SETMSG MSG(ISRZ000) SET BROWSE = YES END WHEN (16) DO SET ZEDSMSG = &STR("&MEMBER" NOT FOUND) SET ZEDLMSG = &STR("&MEMBER" DOES NOT EXIT) ISPEXEC SETMSG MSG(ISRZ001) SET BROWSE = NO END WHEN (20) DO SET ZEDSMSG = &STR("&MEMBER" EDIT ERROR) SET ZEDLMSG = &STR(SEVERE ERROR "20" TRYING TO EDIT + "&MEMBER") ISPEXEC SETMSG MSG(ISRZ001) SET BROWSE = YES END OTHERWISE DO SET ZEDSMSG = &STR("&MEMBER" EDIT ERROR) SET ZEDLMSG = &STR(ERROR CC "&LASTCC" TRYING TO EDIT + "&MEMBER") ISPEXEC SETMSG MSG(ISRZ001) SET BROWSE = YES END END IF &BROWSE = NO THEN GOTO FINISH ISPEXEC BROWSE DATASET('&DSN') SELECT (&LASTCC) WHEN (0) DO SET ZEDSMSG = &STR("&MEMBER" BROWSED) SET ZEDLMSG = &STR("&DSN" WAS BROWSED) ISPEXEC SETMSG MSG(ISRZ000) END WHEN (12) DO SET ZEDSMSG = &STR("&MEMBER" IS EMPTY) SET ZEDLMSG = &STR("&DSN" HAS NO LINES *** UNABLE TO BROWSE) ISPEXEC SETMSG MSG(ISRZ001) END WHEN (14 ³ 16) DO SET ZEDSMSG = &STR("&MEMBER" NOT FOUND) SET ZEDLMSG = &STR("&DSN" WAS NOT FOUND) ISPEXEC SETMSG MSG(ISRZ001) END WHEN (20) DO SET ZEDSMSG = &STR("&MEMBER" BROWSE ERROR) SET ZEDLMSG = &STR(SEVERE ERROR "20" TRYING TO BROWSE + "&MEMBER") ISPEXEC SETMSG MSG(ISRZ001) END OTHERWISE DO SET ZEDSMSG = &STR("&MEMBER" BROWSE ERROR) SET ZEDLMSG = &STR(ERROR CC "&LASTCC" TRYING TO BROWSE + "&MEMBER") ISPEXEC SETMSG MSG(ISRZ001) END END /********************************************************************** /* RETURN TO THE SAME CURSOR POSITION AND GET OUT * /********************************************************************** FINISH: + IF &MODE ¬= CLIST THEN + ISREDIT CURSOR = &SLN &SCL EXIT HELPSEC: + 02480000 ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) 02490000 SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR CPY UTILITY + 02490000 *** NO PROCESSING PERFORMED ***) 02490000 ISPEXEC SETMSG MSG(ISRZ000) 02490000 EXIT ./ ADD NAME=CRIS /* REXX ***************************************************************/ /* FIND ALL THE "CYL(" OR "CYLINDERS(" IDCAMS PARMS AND CHANGE THEM */ /* TO A PERCENTAGE OF THEIR CURRENT VALUE. */ /**********************************************************************/ ADDRESS ISPEXEC 'CONTROL ERRORS RETURN' CHGPCT = 10 ADDRESS ISREDIT "MACRO" "EXCLUDE ALL '*' 1" /* IGNORE IDCAMS COMMENT LINES */ "FIND FIRST ' CYL' NX" DO WHILE RC = 0 /* FIND THE TEXT BETWEEN THE PARENTHESES */ "FIND NEXT '(' .ZCSR .ZCSR" "(LN1,CL1) = CURSOR" "FIND NEXT ')' .ZCSR .ZCSR" "(LN2,CL2) = CURSOR" "(LINE) = LINE .ZCSR" /* TAKE INTO ACCOUNT IT COULD BE SEPARATED BY A SPACE OR COMMA */ CYLPARM = SUBSTR(LINE,CL1+1,CL2-CL1-1) PARSE UPPER VAR CYLPARM CYLPRIM ',' CYLSEC . CYLTEMP = CYLPRIM CYLSEC PARSE UPPER VAR CYLTEMP CYLPRIM CYLSEC . CYLNEWPRIM = CYLPRIM % CHGPCT /* USE INTEGER DIVISION */ CYLNEWSEC = CYLSEC % CHGPCT IF CYLNEWPRIM < 1 THEN CYLNEWPRIM = 1 IF CYLNEWSEC < 1 THEN CYLNEWSEC = 1 CYLNEW = CYLNEWPRIM CYLNEWSEC "CHANGE FIRST '"CYLPARM"' '"CYLNEW"' "CL1+1" .ZCSR .ZCSR" "FIND LAST P'=' .ZCSR .ZCSR" /* POSTITION TO THE END OF THIS LINE*/ "FIND NEXT 'CYL' NX" END /* "END" OBVIOUSLY YOUR LAST COMMAND */ ./ ADD NAME=CSPDB2MA /********************************************************************** /* UTILITY: CSPDB2MA * /* AUTHOR: DAVID LEIGH * /* FUNCTION: TAKES A SEQUENTIAL FILE OF EXPORT FORMAT RECORDS AND * /* CREATES A REPORT OF CSP NAME, DB2 NAME, AND PROLOGUE. * /* THIS EDIT MACRO IS INVOKED AS AN INITIAL MACRO AND IS A * /* SUBFUNCTION OF THE CSPDB2XR UTILITY. * /********************************************************************** ISREDIT MACRO ISPEXEC CONTROL ERRORS RETURN CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /*CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT SET DELIM = &STR(****************************************)+ &STR(****************************************) ISREDIT FIND FIRST ':RECORD' 1 DO WHILE &LASTCC = 0 ISREDIT LABEL .ZCSR = .A ISREDIT FIND NEXT '=' .ZCSR .ZCSR ISREDIT FIND NEXT P'¬' .ZCSR .ZCSR ISREDIT (LN1,CL1) = CURSOR ISREDIT FIND NEXT ' ' .ZCSR .ZCSR ISREDIT FIND PREV P'¬' .ZCSR .ZCSR ISREDIT (LN2,CL2) = CURSOR ISREDIT (LINE) = LINE .ZCSR SET CSPNAME = &SUBSTR(&CL1:&CL2,&STR(&SYSNSUB(1,&LINE))) ISREDIT FIND NEXT ':ERECORD' 1 ISREDIT LABEL .ZCSR = .B ISREDIT FIND FIRST ':SQLTABLE' 1 .A .B IF &LASTCC = 0 THEN + DO ISREDIT FIND NEXT "'" .ZCSR .ZCSR ISREDIT (LN1,CL1) = CURSOR ISREDIT FIND NEXT "'" .ZCSR .ZCSR ISREDIT (LN2,CL2) = CURSOR ISREDIT (LINE) = LINE .ZCSR SET DB2NAME = &SUBSTR(&CL1+1:&CL2-1,&STR(&SYSNSUB(1,&LINE))) END ELSE GOTO LOOP1 ISREDIT FIND FIRST ':PROL.' 1 .A .B IF &LASTCC = 0 THEN + DO ISREDIT LABEL .ZCSR = .PROL ISREDIT FIND NEXT ':EPROL.' 1 .A .B ISREDIT LABEL .ZCSR = .EPROL ISREDIT LINE_BEFORE .A = (DELIM) ISREDIT LINE_BEFORE .A = <1,(CSPNAME) + 10,(DB2NAME)> ISREDIT DELETE .A .PROL ISREDIT DELETE .EPROL .B GOTO LOOP2 END ELSE + DO ISREDIT FIND FIRST ':JOINCON' 1 .A .B IF &LASTCC = 0 THEN + DO ISREDIT LABEL .ZCSR = .PROL ISREDIT FIND NEXT ':EJOINCON' 1 .A .B ISREDIT LABEL .ZCSR = .EPROL ISREDIT LINE_BEFORE .A = (DELIM) ISREDIT LINE_BEFORE .A = <1,(CSPNAME) + 10,(DB2NAME)> ISREDIT DELETE .A .PROL ISREDIT DELETE .EPROL .B GOTO LOOP2 END ELSE + DO ISREDIT LINE_BEFORE .A = (DELIM) ISREDIT LINE_BEFORE .A = <1,(CSPNAME) + 10,(DB2NAME)> END END LOOP1: ISREDIT DELETE .A .B LOOP2: ISREDIT FIND NEXT ':RECORD' 1 END ISREDIT EXCLUDE ALL ':EZEE' 1 ISREDIT DELETE ALL EXCLUDED ISREDIT LINE_BEFORE .ZFIRST = '&STR(REPORT CREATED ON &SYSSDATE )+ &STR(AT &SYSTIME)' ISREDIT END ./ ADD NAME=CSPDB2XR /********************************************************************** /* UTILITY: CSPDB2XR * /* AUTHOR: DAVID LEIGH * /* FUNCTION: THIS UTILITY INVOKES A BATCH JOB WHICH EXTRACTS ALL CSP * /* RECORDS IN THE ENDEVOR-CONTROLLED MSLS INTO EXPORT * /* FORMAT. AN EDIT MACRO (CSPDB2MA) IS THEN INVOKED TO * /* FORMAT THE INFORMATION INTO A CROSS REFERENCE REPORT OF * /* CSP RECORD NAMES TO DB2 RECORD NAMES AND PUTS THE RESULTS* /* INTO THE DOCUMENT LIBRARY TO BE VIEWED ON-LINE. * /********************************************************************** PROC 0 DOCLIB('DUSC1.STR.DOCLIB') + PASSFIL1('&SYSUID..TEMP.CSPDB2XR.PASSFIL1') + PASSFIL2('&SYSUID..TEMP.CSPDB2XR.PASSFIL2') + GDAFILE('DUSC1.STR.CNTLLIB(GDA)') + MEMBER('CSPDB2XR') + ROMSL('TEDVDEVL TEDVQUAL MEDVMODO PEDVPROD') + EDIT + FORMAT + HELP /*** CHECK THE DEBUG SWITCH ***/ 02 ISPEXEC VGET DBGSWTCH PROFILE 02 IF &DBGSWTCH = ON THEN + 02 CONTROL MSG LIST CONLIST SYMLIST NOFLUSH PROMPT ASIS 00000702 ELSE + 02 CONTROL NOMSG NOLIST NOFLUSH PROMPT ASIS 00000902 ISPEXEC CONTROL ERRORS RETURN IF &HELP = HELP THEN GOTO HELPSEC /********************************************************************** /* IF BEING INVOKED WITH THE FORMAT PARAMETER, JUST EDIT THE DATASET * /********************************************************************** IF &FORMAT = FORMAT THEN + DO SET PASSFIL2 = &STR(&PASSFIL2) ISPEXEC EDIT DATASET('&PASSFIL2') MACRO(CSPDB2MA) EXIT END /********************************************************************** /* ESTABLISH SOME PROCESSING VARIABLES * /********************************************************************** /* INITIALIZE SEVERAL VARIABLES WHICH WILL BE USED LATER IN THE * /* PROCESSING. * /********************************************************************** OPEN_CONTINUE: + CALL 'SYS2.USC1.LINKLIB(USERINFO)' '&SYSUID ' SET JCLDSN = &STR(&SYSUID..TEMP.CSPDB2XR) SET EXITCC = 0 SET PASSFIL1 = &STR(&PASSFIL1) SET PASSFIL2 = &STR(&PASSFIL2) SET LP = &STR(( SET RP = &STR() /********************************************************************** /* CREATE THE JCL * /********************************************************************** SET ZEDLMSG = &STR(*** CREATING JCL TO GENERATE CSP/DB2 XREF REPORT ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ001) DELETE '&JCLDSN' FREE DDNAME(ISPFILE) ALLOCATE DDNAME(ISPFILE) DSN('&JCLDSN') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK$$$) + SPACE(2,2) TRACKS RELEASE + RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS) ISPEXEC FTOPEN ISPEXEC FTINCL CSPDB2XR ISPEXEC FTCLOSE FREE DD(ISPFILE) IF &EDIT = EDIT THEN + DO SET ZEDLMSG = &STR(NOTE: YOU MUST SUBMIT + THIS JCL YOURSELF. IT + WILL NOT RUN AUTOMATICALLY.) ISPEXEC SETMSG MSG(UTLZ001) ISPEXEC EDIT DATASET('&JCLDSN') SET EXITCC = 0 GOTO FINISH END SUBMIT '&JCLDSN' SET ZEDLMSG = &STR(*** CSPDB2XR JOB SUBMITTED ***) ISPEXEC SETMSG MSG(UTLZ000) /********************************************************************** /* CLOSE UP SHOP * /********************************************************************** FINISH: + EXIT CODE(&EXITCC) /********************************************************************** /* DISPLAY ANY "HELP" WHICH IS AVAILABLE FOR THIS UTILITY * /********************************************************************** HELPSEC: + ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR CSPDB2XR UTILITY + *** NO PROCESSING PERFORMED ***) ISPEXEC SETMSG MSG(UTLZ000) EXIT ./ ADD NAME=CUT /*********************************************************/ /* ISPF/PDF EDIT MACRO TO WRITE LINES FROM A FILE TO A */ /* ISPF TABLE IN MEMBER FOR LATTER INCLUSION BY THE */ /* PASTE MACRO. */ /* */ /* SUPPORT */ /* STEVEN SMITH SECURITY PACIFIC AUTOMATION CO OCT 88 */ /* */ /* FOR HELP ON RUNNING THIS MACRO, UNDER EDIT ENTER: */ /* CUT HELP */ /*********************************************************/ ISREDIT MACRO (PARM1 PARM2 PARM3) NOPROCESS /*** CHECK THE DEBUG SWITCH ***/ ISPEXEC VGET DBGSWTCH PROFILE IF &DBGSWTCH = ON THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS /* CONTROL LIST CONLIST SYMLIST ISPEXEC CONTROL ERRORS RETURN ISPEXEC VGET (CUTDEF PASTEDEF CUTLIMIT CUTNAME) PROFILE SET ACTN=&Z SET CT=&Z SET CUTCOUNT=&Z IF &STR(&PARM1)=&Z THEN GOTO VERIFY IF &LENGTH(&STR(&PARM1))=2 THEN SET CT=&PARM1 ELSE IF &DATATYPE(&PARM1) = NUM THEN SET CUTCOUNT=&PARM1 ELSE SET ACTN=&PARM1 IF &STR(&PARM2)=&Z THEN GOTO VERIFY IF &LENGTH(&STR(&PARM2))=2 THEN SET CT=&PARM2 ELSE IF &DATATYPE(&PARM2) = NUM THEN SET CUTCOUNT=&PARM2 ELSE SET ACTN=&PARM2 IF &STR(&PARM3)=&Z THEN GOTO VERIFY IF &LENGTH(&STR(&PARM3))=2 THEN SET CT=&PARM3 ELSE IF &DATATYPE(&PARM3) = NUM THEN SET CUTCOUNT=&PARM3 ELSE SET ACTN=&PARM3 VERIFY: - ISPEXEC CONTROL NONDISPL PROMPT: - ISPEXEC DISPLAY PANEL(CUTPROM) IF &LASTCC>7 THEN EXIT CODE(0) IF &ACTN = HELP THEN + DO /*ISPEXEC BROWSE DATASET('SYS6.DOC.DATA(CUT)') ISPEXEC SELECT PGM(ISPTUTOR) PARM(CUTHELP@) SET ACTN=&Z GOTO PROMPT END IF &ACTN=PROMPT THEN + DO SET ACTN=&Z GOTO PROMPT END /* GET DEFAULT MODE */ DEFAULT: - IF &ACTN=DEFAULTS THEN SET ACTN=&Z ELSE ISPEXEC CONTROL NONDISPL ISPEXEC DISPLAY PANEL(CUTDEF) IF &LASTCC>7 THEN EXIT CODE(0) IF &ACTN = &Z THEN SET ACTN=&CUTDEF GOTO PROCS /* PROCESS LINE COMMANDS, CHECK IF C OR M WAS SPECIFIED */ PROCS: - ISREDIT PROCESS RANGE C M IF &LASTCC >= 16 THEN DO EXIT CODE(12) END ELSE + IF &LASTCC >= 4 THEN + DO SET ZEDSMSG = ENTER "C" ³ "M" LINE CMD SET ZEDLMSG = CUT REQUIRES A "C" OR "M" LINE COMMAND ISPEXEC SETMSG MSG(ISRZ001) EXIT CODE(12) END ISREDIT (CMD) = RANGE_CMD /* GET THE COMMAND */ ISREDIT (LINE1) = LINENUM .ZFRANGE /* FIRST LINE IN RANGE */ ISREDIT (LINE2) = LINENUM .ZLRANGE /* LAST LINE IN RANGE */ SET LINESTOCUT = &LINE2 - &LINE1 + 1 /* GET THE NUM OF LINES THAT HAVE BEEN CUT BUT NOT PASTED, */ /* INITIALIZE TO ZERO IF FIRST TIME. */ SET CUTPST=CUTPST&CT ISPEXEC TBQUERY &CUTPST ROWNUM(CUTCNTMX) IF &LASTCC ¬= 0 THEN DO ISPEXEC TBCREATE &CUTPST NAMES(CTPT) NOWRITE SHARE IF &LASTCC ¬= 0 THEN DO ISPEXEC TBOPEN &CUTPST NOWRITE SHARE IF &LASTCC ¬= 0 THEN DO EXIT CODE(12) END END SET CUTCNTMX=0 END ISPEXEC TBBOTTOM &CUTPST IF &ACTN=REPLACE THEN + DO SET &LCC=0 DO WHILE &LCC=0 ISPEXEC TBDELETE &CUTPST SET LCC=&LASTCC END SET CUTCNTMX = 0 END SET CUTCNTMXSAVE = &CUTCNTMX /* CHECK TO SEE IF THE LIMIT WILL BE EXCEEDED BY STORING */ /* THE LINES */ SET COUNT = &CUTCNTMX + &LINESTOCUT IF &COUNT > &CUTCOUNT THEN DO SET ZEDSMSG = > &CUTCOUNT LINES TO CUT SET ZEDLMSG=REDUCE THE RANGE OR CHANGE LIMIT WITH "CUT &COUNT" ISPEXEC SETMSG MSG(ISRZ001) EXIT CODE(12) END /* CUT THE LINES TO THE TABLE */ SET CUTCNT = &CUTCNTMX SET I = &LINE1 DO WHILE &I <= &LINE2 SET CUTCNT = &CUTCNT + 1 ISREDIT (CTPT) = LINE &I ISPEXEC TBADD &CUTPST SET I = &I + 1 END /* IF THE NUMBER OF LINES CUT THIS TIME /* IS GREATER THAN THE MAXIMUM CUT, /* THEN SAVE THE NEW MAXIMUM. /* PASTE WILL SET THIS VARIABLE TO /* ZERO IF IT DELETES THE VARIABLES. IF &CMD = M THEN DO ISREDIT DELETE &LINE1 &LINE2 IF &CUTCNTMXSAVE = 0 THEN + DO SET ZEDSMSG = &LINESTOCUT LINES CUT AND DELETED SET ZEDLMSG = &LINESTOCUT LINES WERE CUT AND SET ZEDLMSG = &ZEDLMSG DELETED FROM THE CURRENT FILE END ELSE + DO SET ZEDSMSG = &LINESTOCUT LINES CUT AND DELETED' SET ZEDLMSG = A TOTAL OF &CUTCNTMX LINES HAVE BEEN CUT SET ZEDLMSG = &ZEDLMSG, THE LAST &LINESTOCUT WERE DELETED END ISPEXEC SETMSG MSG(ISRZ000) END ELSE + DO IF &CUTCNTMXSAVE = 0 THEN + DO SET ZEDSMSG = &LINESTOCUT LINES CUT SET ZEDLMSG = &LINESTOCUT LINES WERE CUT SET ZEDLMSG = &ZEDLMSG FROM THE CURRENT FILE END ELSE + DO SET ZEDSMSG = &LINESTOCUT LINES PLUS &CUTCNTMXSAVE LINES SET ZEDSMSG = &ZEDSMSG CUT SET ZEDLMSG = A TOTAL OF &CUTCNTMX LINES HAVE BEEN CUT END ISPEXEC SETMSG MSG(ISRZ000) END EXIT ./ ADD NAME=CUT390 /*********************************************************/ /* ISPF/PDF EDIT MACRO TO WRITE LINES FROM A FILE TO A */ /* ISPF TABLE IN MEMBER FOR LATTER INCLUSION BY THE */ /* PASTE MACRO. */ /* */ /* SUPPORT */ /* STEVEN SMITH SECURITY PACIFIC AUTOMATION CO OCT 88 */ /* */ /* FOR HELP ON RUNNING THIS MACRO, UNDER EDIT ENTER: */ /* CUT HELP */ /*********************************************************/ ISREDIT MACRO (PARM1 PARM2 PARM3) NOPROCESS /*** CHECK THE DEBUG SWITCH ***/ ISPEXEC VGET DBGSWTCH PROFILE IF &DBGSWTCH = ON THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS /* CONTROL LIST CONLIST SYMLIST ISPEXEC CONTROL ERRORS RETURN ISPEXEC VGET (CUTDEF PASTEDEF CUTLIMIT CUTNAME) PROFILE SET ACTN=&Z SET CT=&Z SET CUTCOUNT=&Z IF &STR(&PARM1)=&Z THEN GOTO VERIFY IF &LENGTH(&STR(&PARM1))=2 THEN SET CT=&PARM1 ELSE IF &DATATYPE(&PARM1) = NUM THEN SET CUTCOUNT=&PARM1 ELSE SET ACTN=&PARM1 IF &STR(&PARM2)=&Z THEN GOTO VERIFY IF &LENGTH(&STR(&PARM2))=2 THEN SET CT=&PARM2 ELSE IF &DATATYPE(&PARM2) = NUM THEN SET CUTCOUNT=&PARM2 ELSE SET ACTN=&PARM2 IF &STR(&PARM3)=&Z THEN GOTO VERIFY IF &LENGTH(&STR(&PARM3))=2 THEN SET CT=&PARM3 ELSE IF &DATATYPE(&PARM3) = NUM THEN SET CUTCOUNT=&PARM3 ELSE SET ACTN=&PARM3 VERIFY: - ISPEXEC CONTROL NONDISPL PROMPT: - ISPEXEC DISPLAY PANEL(CUTPROM) IF &LASTCC=8 THEN EXIT CODE(0) IF &ACTN = HELP THEN + DO /*ISPEXEC BROWSE DATASET('SYS6.DOC.DATA(CUT)') ISPEXEC SELECT PGM(ISPTUTOR) PARM(CUTHELP@) SET ACTN=&Z GOTO PROMPT END IF &ACTN=PROMPT THEN + DO SET ACTN=&Z GOTO PROMPT END /* GET DEFAULT MODE */ DEFAULT: - IF &ACTN=DEFAULTS THEN SET ACTN=&Z ELSE ISPEXEC CONTROL NONDISPL ISPEXEC DISPLAY PANEL(CUTDEF) IF &LASTCC=8 THEN EXIT CODE(0) IF &ACTN = &Z THEN SET ACTN=&CUTDEF GOTO PROCS /* PROCESS LINE COMMANDS, CHECK IF C OR M WAS SPECIFIED */ PROCS: - ISREDIT PROCESS RANGE C M IF &LASTCC >= 16 THEN DO EXIT CODE(12) END ELSE + IF &LASTCC >= 4 THEN + DO SET ZEDSMSG = ENTER "C" ³ "M" LINE CMD SET ZEDLMSG = CUT REQUIRES A "C" OR "M" LINE COMMAND ISPEXEC SETMSG MSG(ISRZ001) EXIT CODE(12) END ISREDIT (CMD) = RANGE_CMD /* GET THE COMMAND */ ISREDIT (LINE1) = LINENUM .ZFRANGE /* FIRST LINE IN RANGE */ ISREDIT (LINE2) = LINENUM .ZLRANGE /* LAST LINE IN RANGE */ SET LINESTOCUT = &LINE2 - &LINE1 + 1 /* GET THE NUM OF LINES THAT HAVE BEEN CUT BUT NOT PASTED, */ /* INITIALIZE TO ZERO IF FIRST TIME. */ SET CUTPST=CUTPST&CT ISPEXEC TBQUERY &CUTPST ROWNUM(CUTCNTMX) IF &LASTCC ¬= 0 THEN DO ISPEXEC TBCREATE &CUTPST NAMES(CTPT) NOWRITE SHARE IF &LASTCC ¬= 0 THEN DO ISPEXEC TBOPEN &CUTPST NOWRITE SHARE IF &LASTCC ¬= 0 THEN DO EXIT CODE(12) END END SET CUTCNTMX=0 END ISPEXEC TBBOTTOM &CUTPST IF &ACTN=REPLACE THEN + DO SET &LCC=0 DO WHILE &LCC=0 ISPEXEC TBDELETE &CUTPST SET LCC=&LASTCC END SET CUTCNTMX = 0 END SET CUTCNTMXSAVE = &CUTCNTMX /* CHECK TO SEE IF THE LIMIT WILL BE EXCEEDED BY STORING */ /* THE LINES */ SET COUNT = &CUTCNTMX + &LINESTOCUT IF &COUNT > &CUTCOUNT THEN DO SET ZEDSMSG = > &CUTCOUNT LINES TO CUT SET ZEDLMSG=REDUCE THE RANGE OR CHANGE LIMIT WITH "CUT &COUNT" ISPEXEC SETMSG MSG(ISRZ001) EXIT CODE(12) END /* CUT THE LINES TO THE TABLE */ SET CUTCNT = &CUTCNTMX SET I = &LINE1 DO WHILE &I <= &LINE2 SET CUTCNT = &CUTCNT + 1 ISREDIT (CTPT) = LINE &I ISPEXEC TBADD &CUTPST SET I = &I + 1 END /* IF THE NUMBER OF LINES CUT THIS TIME /* IS GREATER THAN THE MAXIMUM CUT, /* THEN SAVE THE NEW MAXIMUM. /* PASTE WILL SET THIS VARIABLE TO /* ZERO IF IT DELETES THE VARIABLES. IF &CMD = M THEN DO ISREDIT DELETE &LINE1 &LINE2 IF &CUTCNTMXSAVE = 0 THEN + DO SET ZEDSMSG = &LINESTOCUT LINES CUT AND DELETED SET ZEDLMSG = &LINESTOCUT LINES WERE CUT AND SET ZEDLMSG = &ZEDLMSG DELETED FROM THE CURRENT FILE END ELSE + DO SET ZEDSMSG = &LINESTOCUT LINES CUT AND DELETED' SET ZEDLMSG = A TOTAL OF &CUTCNTMX LINES HAVE BEEN CUT SET ZEDLMSG = &ZEDLMSG, THE LAST &LINESTOCUT WERE DELETED END ISPEXEC SETMSG MSG(ISRZ000) END ELSE + DO IF &CUTCNTMXSAVE = 0 THEN + DO SET ZEDSMSG = &LINESTOCUT LINES CUT SET ZEDLMSG = &LINESTOCUT LINES WERE CUT SET ZEDLMSG = &ZEDLMSG FROM THE CURRENT FILE END ELSE + DO SET ZEDSMSG = &LINESTOCUT LINES PLUS &CUTCNTMXSAVE LINES SET ZEDSMSG = &ZEDSMSG CUT SET ZEDLMSG = A TOTAL OF &CUTCNTMX LINES HAVE BEEN CUT END ISPEXEC SETMSG MSG(ISRZ000) END EXIT ./ ADD NAME=CVDEFINE ISREDIT MACRO (HELP) ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /******************************************************************/ /* 'CVDEFINE' EDIT MACRO. CREATE COBOL VDEFINE CALLS FROM "05" */ /* LEVEL W-FIELDNAME COBOL WORKING STORAGE STATEMENTS. */ /* AUTHOR : DAVID LEIGH DATE : 11-2-89 */ /******************************************************************/ IF &STR(&HELP) = &STR(HELP) THEN GOTO HELPSEC ISREDIT (SLN,SCL) = CURSOR ISREDIT (CURRDSN) = DATASET LISTDSI '&CURRDSN' DELETE '&CURRDSN($&SYSUID)' FREE DDNAME(TEMPFREE) ALLOC DDNAME(TEMPFREE) + DSN('&CURRDSN($&SYSUID)') + SHR KEEP OPENFILE TEMPFREE OUTPUT ISREDIT (SLINE,SCOL) = CURSOR SET PSWITCH = OFF ISREDIT CURSOR = 1 1 SET SAVECC = 0 ISREDIT FIND FIRST P'=' 1 X SET SAVECC = &LASTCC SET CNT = 0 IF &SAVECC = 0 THEN + DO ISREDIT (LN,CL) = CURSOR SET LN = &LN - 1 IF &LN = 0 THEN + DO ISREDIT LINE_BEFORE .ZCSR = ' ' SET LN = 1 END ISREDIT CURSOR = &LN &CL ISREDIT LABEL .ZCSR = .LABELA SET LN = &LN + 1 ISREDIT CURSOR = &LN &CL ISREDIT LABEL .ZCSR = .LABELB ISREDIT (DATA) = LINE .ZCSR END DO WHILE &SAVECC = 0 IF &SUBSTR(1:17,&STR(&DATA)) = &STR( 05 W-) THEN + DO SET CNT = &CNT + 1 SET DATA = &SUBSTR(18:80,&STR(&DATA)) SET A = &SYSINDEX(&STR( ),&STR(&DATA)) SET A = &A - 1 IF &SUBSTR(&A:&A,&STR(&DATA)) = &STR(.) THEN SET A = &A - 1 SET DATA = &SUBSTR(1:&A,&STR(&DATA) SET TEMPFREE = + &STR( ADD 1 TO A-ISPF-CALLS-MADE.) PUTFILE TEMPFREE SET TEMPFREE = + &STR( MOVE &CNT TO W-ISPF-CALL.) PUTFILE TEMPFREE SET TEMPFREE = + &STR( CALL 'ISPLINK' USING C-VDEFINE ) PUTFILE TEMPFREE SET TEMPFREE = + &STR( C-&DATA ) PUTFILE TEMPFREE SET TEMPFREE = + &STR( W-&DATA ) PUTFILE TEMPFREE SET TEMPFREE = + &STR( C-CHAR ) PUTFILE TEMPFREE SET TEMPFREE = + &STR( C-&DATA-LEN.) PUTFILE TEMPFREE SET TEMPFREE = + &STR( IF RETURN-CODE > C-NORMAL-RETURN-CODE ) PUTFILE TEMPFREE SET TEMPFREE = + &STR( PERFORM S3000-ISPF-RETURN-CODE-CHECK.) PUTFILE TEMPFREE SET TEMPFREE = PUTFILE TEMPFREE END ISREDIT FIND NEXT P'=' 1 X SET SAVECC = &LASTCC ISREDIT (DATA) = LINE .ZCSR END CLOSFILE TEMPFREE FREE DDNAME(TEMPFREE) ISREDIT COPY $&SYSUID BEFORE .LABELB ISREDIT LABEL .ZCSR = .LABELC ISREDIT DELETE .LABELB .LABELC ISREDIT RESET ISREDIT CURSOR = &SLN &SCL EXIT HELPSEC: + 02480000 ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) 02490000 SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR CVDEFINE UTILITY + 02490000 *** NO PROCESSING PERFORMED ***) 02490000 ISPEXEC SETMSG MSG(UTLZ000) 02490000 EXIT ./ ADD NAME=C7JOBTAG /* REXX ***************************************************************/ /* UTILITY: C7JOBTAG */ /* AUTHOR: DAVID LEIGH */ /* FUNCTION: THIS REXX PROGRAM CYCLES THROUGH THE "LJOB/RQJOB" AND */ /* "LJOB/TRIG" OUTPUT FROM CA7 FOR THE DBA JOBS. IT FINDS */ /* THE PRIMARY JOB BEING REPORTED ON AND TAGS AND NUMBERS */ /* ALL THE LINES ASSOCIATED WITH THAT JOB WITH THE JOB NAME */ /* OF THAT JOB. THIS DATA IS THEN PASSED TO A STEP THAT */ /* LOADS THE DATA INTO DB2 FOR QUERYING. */ /* */ /* NOTE THAT THE DATA HAS BEEN THROUGH A SYNCSORT PRIOR TO */ /* THIS STEP TO "EXLUDE" LINES THAT WE DON'T CARE ABOUT. */ /* THIS SIGNIFICANTLY CUTS DOWN ON THE AMOUNT OF DATA THAT */ /* MUST BE READ AND PROCESSED BY THIS PROGRAM. */ /**********************************************************************/ /**********************************************************************/ /* FIRST, WE READ IN THE CA7 DATA INTO A STEM ARRAY */ /**********************************************************************/ ADDRESS TSO "EXECIO * DISKR CA7IN (STEM CA7REC. FINIS)" /**********************************************************************/ /* NOW WE SET SOME INITIAL VARIABLE VALUES AND CREATE A NEW STACK */ /**********************************************************************/ "NEWSTACK" /**********************************************************************/ /* NOW THE MAIN PROCESSING LOOP */ /**********************************************************************/ DO I = 1 TO CA7REC.0 IF I//1000 = 0 THEN SAY 'PROCESSING #'I 'OF' CA7REC.0 TAGNBR = '00000'I TAGNBR = SUBSTR(TAGNBR,LENGTH(TAGNBR)-5) RELJOB = ' ' SCHID = '000' SCHID2 = '000' QTM = '0000' LEADTM = '0000' SUBMTM = '0000' SELECT /******************************************************************/ /* SET THE "RELATIONSHIP TYPE" TO "1" - A DEPENDENCY FOR THIS JOB */ /******************************************************************/ WHEN POS('REQUIREMENTS AND NETWORK CONNECTIONS',CA7REC.I) = 26 THEN DO RELTYPE = '1' END /******************************************************************/ /* SET THE "RELATIONSHIP TYPE" TO "2" - A TRIGGER FOR THIS JOB */ /******************************************************************/ WHEN POS('TRIGGERED BY JOBS/DATASETS/NETWORKS',CA7REC.I) = 27 THEN DO RELTYPE = '2' END /******************************************************************/ /* SET THE "RELATIONSHIP TYPE" TO "4" - JOBS THIS JOB TRIGGERS */ /******************************************************************/ WHEN POS('TRIGGERED JOBS',CA7REC.I) = 37 THEN DO RELTYPE = '4' END /******************************************************************/ /* PROCESS A JOB THAT IS A DEPENDENCY FOR THIS JOB */ /******************************************************************/ WHEN POS('JOB=',CA7REC.I) = 9 THEN DO IF POS('/',CA7REC.I) = 13 THEN DO RELTYPE = '5' /* NEGATIVE DEPENDENCY RELATIONSHIP TYPE */ PARSE UPPER VAR CA7REC.I 'JOB=/' RELJOB 'SCHID=' SCHID . END ELSE DO RELTYPE = '1' /* REGULAR DEPENDENCY RELATIONSHIP TYPE */ PARSE UPPER VAR CA7REC.I 'JOB=' RELJOB 'SCHID=' SCHID . PARSE UPPER VAR CA7REC.I 'LEADTM=' LEADTM . END IF LENGTH(LEADTM) < 2 THEN LEADTM = '0000' IF LENGTH(LEADTM) < 4 THEN LEADTM = LEADTM'00' IF POS('/',SCHID) = 4 THEN DO SCHID2 = SUBSTR(SCHID,5,3) SCHID = SUBSTR(SCHID,1,3) END ELSE DO SCHID2 = SCHID END RELJOB = RELJOB' ' RELJOB = SUBSTR(RELJOB,1,8) QUEUE JOBNAME TAGNBR RELTYPE RELJOB, SCHID SCHID2 QTM LEADTM SUBMTM LIB END /******************************************************************/ /* PROCESS A JOB THAT TRIGGERS OR IS TRIGGERED BY THIS JOB */ /******************************************************************/ WHEN POS('JOB=',CA7REC.I) = 12 THEN DO PARSE UPPER VAR CA7REC.I 'JOB=' RELJOB 'SCHID=' SCHID 'QTM=' QTM . PARSE UPPER VAR CA7REC.I 'LEADTM=' LEADTM 'SUBMTM=' SUBMTM . IF POS('DOTM=',SCHID) > 0 THEN DO PARSE UPPER VAR SCHID SCHID . QTM = '0000' END LEADTM = STRIP(LEADTM) IF LENGTH(LEADTM) < 2 THEN LEADTM = '0000' IF POS('/',SCHID) = 4 THEN DO SCHID2 = STRIP(SUBSTR(SCHID,5,3)) SCHID = STRIP(SUBSTR(SCHID,1,3)) END ELSE DO SCHID = STRIP(SCHID) SCHID2 = SCHID END RELJOB = RELJOB' ' RELJOB = SUBSTR(RELJOB,1,8) QUEUE JOBNAME TAGNBR RELTYPE RELJOB, SCHID SCHID2 QTM LEADTM SUBMTM LIB END /******************************************************************/ /* THIS IS THE JOB IN QUESTION...TO WHICH THE OTHER JOBS RELATE */ /******************************************************************/ OTHERWISE DO RELTYPE = '3' PARSE UPPER VAR CA7REC.I JOBNAME LIB . IF SUBSTR(CA7REC.I,15,8) = ' ' THEN LIB = '###' JOBNAME = JOBNAME' ' JOBNAME = SUBSTR(JOBNAME,1,8) RELJOB = JOBNAME QUEUE JOBNAME TAGNBR RELTYPE RELJOB, SCHID SCHID2 QTM LEADTM SUBMTM LIB END END END /**********************************************************************/ /* NOW WE WRITE OUT THE QUEUED RECORDS */ /**********************************************************************/ "EXECIO" QUEUED() "DISKW CA7OUT (FINIS)" EXIT ./ ADD NAME=DALLOGOF PROC 0 CONTROL NOMSG /********************************************************************** /* THIS LOGOFF MEMBER DOES NOTHING AT THIS MOMENT * /********************************************************************** EXIT ./ ADD NAME=DALLOGON PROC 0 CONTROL NOMSG /********************************************************************** /* DISPLAY YOUR GOALS DATASETS * /********************************************************************** /*CLEAR /*%SHOGOALS WRITE CALL 'D@UDAL.STR.LOADLIB(DAILY)' WRITE WRITENR PRESS ENTER TO CONTINUE OR "=X" TO DROP TO THE READY PROMPT READ X IF &STR(&X) = &STR(=X) THEN EXIT /********************************************************************** /* CHECK FOR NEW VERSIONS OF PRODUCTION COPY DATASETS * /********************************************************************** SUBMIT 'D@UDAL.STR.JCLLIB(CHANGES)' /********************************************************************** /* DISPLAY YOUR APPOINTMENTS * /********************************************************************** /*%CALENDAR LOGON /********************************************************************** /* DO DASD ANALYSIS * /********************************************************************** /*%DASDJOB /********************************************************************** /* COPY THE UTILITY LOG TO TAPE * /********************************************************************** /*%DUMPLOG /********************************************************************** /* PREPARE JOB TO PREVENT ARCHIVING OF CERTAIN DATASETS * /********************************************************************** %NOARC /********************************************************************** /* PREPARE JOB TO GATHER ADM60 TEST CASES * /********************************************************************** /*%ADM60TST /********************************************************************** /* PREPARE JOB TO COPY SYSCOPY TO DBAUTIL.SYSCOPY * /********************************************************************** /*%DSYSCOPY /********************************************************************** /* CHECK FOR NEED TO SEND FLOWERS * /********************************************************************** /*SUBMIT 'D@UDAL.STR.JCLLIB(FLOWERS)' /********************************************************************** /* RE ALLOCATE SYSPRINT * /********************************************************************** FREE DD(SYSPRINT) ALLOC DD(SYSPRINT) SYSOUT(X) /********************************************************************** /* TAKE THE USER INTO ISPF OPTION 2 (EDIT) * /********************************************************************** CLEAR ISPF /* ISPF 0.3 ./ ADD NAME=DALLOG2 /**********************************************************************/ /* THIS CLIST IS FOR INITIALIZATION OF ID P@UDAL */ /**********************************************************************/ PROC 0 CONTROL NOMSG /********************************************************************** /* PREPARE JOB TO PREVENT ARCHIVING OF CERTAIN DATASETS * /********************************************************************** /*%NOARC /********************************************************************** /* RE ALLOCATE SYSPRINT * /********************************************************************** FREE DD(SYSPRINT) ALLOC DD(SYSPRINT) SYSOUT(X) /********************************************************************** /* TAKE THE USER INTO ISPF OPTION 2 (EDIT) * /********************************************************************** CLEAR ISPF E.9 ./ ADD NAME=DASDANAL /********************************************************************** /* ISPSTART CLIST TO JUST EDIT THE RESULTS DATASET WITH A MACRO * /********************************************************************** PROC 0 CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ISPEXEC LMINIT DATAID(DID) DDNAME(DMSRPTS) ENQ(SHRW) WRITE LMINIT CC=&LASTCC ISPEXEC EDIT DATAID(&DID) MACRO(DASDMACR) WRITE EDIT CC=&LASTCC ISPEXEC LMFREE DATAID(&DID) WRITE LMFREE CC=&LASTCC EXIT ./ ADD NAME=DASDJOB PROC 0 DEBUG /*** CHECK THE DEBUG SWITCH ***/ IF &DEBUG = DEBUG THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS /********************************************************************** /* DETERMINE DAY OF THE WEEK * /********************************************************************** FREE DD(SYSPRINT) ALLOC DD(SYSPRINT) DSN(*) CALL 'D@UDAL.STR.LOADLIB(DAYRC)' SET DAY_OF_WEEK = &LASTCC FREE DD(SYSPRINT) SELECT (&DAY_OF_WEEK) WHEN (5 | 6 | 7) SET DEST = &STR(*.HELDQ,*.LOCLASER) OTHERWISE EXIT END /********************************************************************** /* FIND WHAT DSD JOBS EXIST CURRENTLY * /********************************************************************** SET LP = &STR(( SET RP = &STR()) SET SYSOUTTRAP = 1000 CONTROL MSG STATUS D@UDALDSD CONTROL NOMSG SET SYSOUTTRAP = 0 IF &SYSINDEX(&STR( WAITING FOR EXECUTION),+ &STR(&SYSNSUB(2,&&SYSOUTLINE&SYSOUTLINE))) > 0 THEN EXIT SUBMIT 'D@UDAL.STR.JCLLIB(DASDANAL)' EXIT ./ ADD NAME=DASDMACR /********************************************************************** /* DASD ANALYSIS DATA PREP EDIT MACRO * /********************************************************************** ISREDIT MACRO CONTROL NOMSG NOLIST NOCONLIST NOSYMLIST NOFLUSH ISPEXEC CONTROL ERRORS RETURN /********************************************************************** /* FIRST PARSE THE DATE/TIME STAMP INFO ON THE FIRST TWO LINES * /********************************************************************** ISREDIT FIND FIRST P'=' 1 ISREDIT (SYSDVAL) = LINE .ZCSR READDVAL VAL1 MONTH DAY YEAR REST ISREDIT FIND NEXT P'=' 1 ISREDIT (SYSDVAL) = LINE .ZCSR READDVAL DOW TIME1 TIME2 REST SET TIMESTAMP = &STR(&YEAR &MONTH &DAY &DOW &TIME1 &TIME2) /********************************************************************** /* GET RID OF REPORT HEADER/FOOTER LINES AND GDG INDEX ENTRIES * /********************************************************************** WRITE &STR(GET RID OF HEADERS/FOOTERS/GDG INDEXES) ISREDIT EXCLUDE ALL 'M U L T I P L E' 34 ISREDIT EXCLUDE ALL ' DMS/OS ' 120 ISREDIT EXCLUDE ALL ' C P ' 48 ISREDIT EXCLUDE ALL 'DEVICE UNIT A R' 37 ISREDIT EXCLUDE ALL 'DATA SET NAME' 2 ISREDIT EXCLUDE ALL '---------------------------' 2 ISREDIT EXCLUDE ALL 'TOTAL DATA SETS' 11 ISREDIT EXCLUDE ALL 'TOTAL IDLE' 64 ISREDIT EXCLUDE ALL ' ' 67 ISREDIT FIND ALL P' .' 2 ISREDIT DELETE ALL EXCLUDED /********************************************************************** /* PUT LEADING ZEROS INTO THE ALLOCATION NUMBERS * /********************************************************************** WRITE &STR(INSERT LEADING ZEROS) ISREDIT CHANGE ' ' '0' 91 95 ALL ISREDIT CHANGE ' ' '0' 97 101 ALL /********************************************************************** /* CLEAR SOME AREAS FOR LATER USE * /********************************************************************** WRITE &STR(PRE-CLEAR SOME COLUMNS) ISREDIT CHANGE P'=' ' ' 75 90 ALL ISREDIT CHANGE P'=' ' ' 102 133 ALL /********************************************************************** /* APPEND EACH LINE WITH THE TIMESTAMP * /********************************************************************** WRITE &STR(SUFFIX EACH LINE WITH "&TIMESTAMP") ISREDIT CHANGE P'=' '&STR(&TIMESTAMP)' 103 ALL /********************************************************************** /* MAKE ROOM FOR EXTENDING THE DATASET NAME BY GETTING RID OF STUFF * /********************************************************************** WRITE &STR(MOVE THE VOLUME NAME OVER FOR DATASET NAME EXTENSION) ISREDIT BOUNDS 30 52 ISREDIT FIND FIRST P'=' 30 DO WHILE &LASTCC = 0 ISREDIT SHIFT ) .ZCSR 16 ISREDIT FIND NEXT P'=' 30 END ISREDIT BOUNDS 1 133 /********************************************************************** /* GO THROUGH THE FILE BACKWARDS FOR 2-LINE DATASET NAMES AND FIX * /********************************************************************** WRITE &STR(MERGE TWO LINE DATASET NAMES INTO ONE) ISREDIT FIND LAST P' .' 2 DO WHILE &LASTCC = 0 ISREDIT LABEL .ZCSR = .B ISREDIT FIND PREV P'.' 2 ISREDIT LABEL .ZCSR = .A ISREDIT (SYSDVAL) = LINE .B READDVAL DSUFFIX NULL SET EQU = DO &I = 1 TO &LENGTH(&STR(&DSUFFIX)) SET EQU = &STR(&EQU=) END ISREDIT DELETE .B ISREDIT FIND FIRST '. ' .A .A ISREDIT FIND NEXT ' ' .A .A ISREDIT CHANGE P'&STR(&EQU)' '&STR(&DSUFFIX)' .A .A ISREDIT FIND PREV P' .' 2 END /********************************************************************** /* CREATE THE DSN HIGHLEVELS AS A FIELD ON EACH DATASET LINE * /********************************************************************** WRITE &STR(CREATE A HIGH-LEVEL QUALIFIER FIELD) ISREDIT FIND FIRST P'.' 2 DO WHILE &LASTCC = 0 ISREDIT CHANGE '.' ' ' 2 10 ALL .ZCSR .ZCSR ISREDIT (SYSDVAL) = LINE .ZCSR READDVAL QUAL1 QUAL2 REST IF &STR(&QUAL1) = &STR(T) THEN SET HQUAL = &STR(&QUAL2) ELSE SET HQUAL = &STR(&QUAL1) ISREDIT CHANGE ' ' '.' 2 10 ALL .ZCSR .ZCSR SET EQU = DO &I = 1 TO &LENGTH(&STR(&HQUAL)) SET EQU = &STR(&EQU=) END ISREDIT CHANGE FIRST P'&STR(&EQU)' '&STR(&HQUAL)' 75 .ZCSR .ZCSR ISREDIT FIND NEXT P'.' 2 END ISREDIT END ./ ADD NAME=DASDNED2 ISREDIT MACRO ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT SET X = 20 ISREDIT FIND FIRST '(' 54 DO WHILE &LASTCC = 0 ISREDIT (SYSDVAL) = LINE .ZCSR READDVAL DSN LRECL BLKSIZE EQUATION NULL SET EQUATION = &STR((&EQUATION)) %DYLCALC &STR(&EQUATION) PRECISION(0) ISPEXEC VGET DYRESULT SHARED %BLKSIZE &LRECL &DYRESULT DEVICES(3380) BATCH ISPEXEC VGET CYLSREQ SHARED IF &BLKSIZE > 23476 THEN SET CYLSREQ = &STR(N/A) SET DYRESULT = &SUBSTR(&LENGTH(&STR( &DYRESULT))-7:+ &LENGTH(&STR( &DYRESULT)),+ &STR( &DYRESULT)) SET CYLSREQ = &SUBSTR(&LENGTH(&STR( &CYLSREQ))-3:+ &LENGTH(&STR( &CYLSREQ)),+ &STR( &CYLSREQ)) WRITE &DSN &DYRESULT &CYLSREQ ISREDIT LINE .ZCSR = LINE + <102 (DYRESULT), 119 (CYLSREQ)> ISREDIT FIND NEXT '(' 54 END ISREDIT END ./ ADD NAME=DASDNEED ISREDIT MACRO ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /********************************************************************** /* GET THE JOB NUMBER FIRST * /********************************************************************** MAINLOOP: + ISREDIT FIND FIRST 'AAAAAAA' 1 DO WHILE &LASTCC = 0 ISREDIT LABEL .ZCSR = .A ISREDIT (LINENUM) = LINENUM .ZCSR WRITE &LINENUM ISREDIT FIND NEXT 'ZZZZZZZZ' 1 ISREDIT LABEL .ZCSR = .B ISREDIT FIND FIRST '/SLS' .A .B DO WHILE &LASTCC = 0 ISREDIT FIND NEXT '/' .ZCSR .ZCSR ISREDIT (LN,CL) = CURSOR SET CL = &CL - 1 ISREDIT (SYSDVAL) = LINE .ZCSR SET PGM = &SUBSTR(&CL:&CL,&STR(&SYSDVAL)) READDVAL NULL1 VARIABLE VALUE NULL2 SET VARIABLE = &STR(&PGM&VARIABLE) SELECT (&STR(&VARIABLE)) WHEN (&STR(AA-ACCOUNT-RECS-READ)) DO SET AAIN = &VALUE ISREDIT LABEL .ZCSR = .AAIN END WHEN (&STR(AA-DETAIL-RECS-WRITTEN)) DO SET DAOUT = &VALUE ISREDIT LABEL .ZCSR = .DAOUT END WHEN (&STR(AA-TRANSACTION-RECS-READ)) DO SET ATIN = &VALUE ISREDIT LABEL .ZCSR = .ATIN END WHEN (&STR(EA-EXCEPTION-RECORDS-READ)) DO SET EXIN = &VALUE ISREDIT LABEL .ZCSR = .EXIN END WHEN (&STR(EA-TOTAL-RECORDS-WRITTEN)) DO SET EROUT = &VALUE ISREDIT LABEL .ZCSR = .EROUT END WHEN (&STR(MA-ACCOUNT-RECORDS-WRITTEN)) DO SET ACOUT = &VALUE ISREDIT LABEL .ZCSR = .ACOUT END WHEN (&STR(MA-EXCEPTN-RECORDS-WRITTEN)) DO SET MEOUT = &VALUE ISREDIT LABEL .ZCSR = .MEOUT END WHEN (&STR(MA-MASTER-RECS-READ)) DO SET MAIN = &VALUE ISREDIT LABEL .ZCSR = .MAIN END WHEN (&STR(MA-TOTAL-MASTERS-BYPASSED)) DO SET MYOUT = &VALUE ISREDIT LABEL .ZCSR = .MYOUT END WHEN (&STR(RA-INPUT-RECORDS-READ)) DO SET DAIN = &VALUE ISREDIT LABEL .ZCSR = .DAIN END WHEN (&STR(RA-REPORT-RECORDS-WRITTEN)) DO SET REOUT = &VALUE ISREDIT LABEL .ZCSR = .REOUT END WHEN (&STR(TA-EXCEPTN-RECORDS-WRITTEN)) DO SET TEOUT = &VALUE ISREDIT LABEL .ZCSR = .TEOUT END WHEN (&STR(TA-TOTAL-TRANS-BYPASSED)) DO SET TYOUT = &VALUE ISREDIT LABEL .ZCSR = .TYOUT END WHEN (&STR(TA-TRAN-RECORDS-WRITTEN)) DO SET TAOUT = &VALUE ISREDIT LABEL .ZCSR = .TAOUT END WHEN (&STR(TA-TRAN-RECS-READ)) DO SET TAIN = &VALUE ISREDIT LABEL .ZCSR = .TAIN END END ISREDIT FIND NEXT '/SLS' .A .B END %DIVIDE &ACOUT &MAIN ISPEXEC VGET RESULT SHARED IF &SYSINDEX(&STR(.),&STR(&RESULT)) = 1 THEN + SET RESULT = &STR(0&RESULT) ISREDIT CHANGE FIRST 70 .ACOUT .ACOUT P'=' '&STR(&RESULT)' ISREDIT CHANGE FIRST 80 .ACOUT .ACOUT P'=' + '(ACCOUNT RECORDS WRITTEN/MASTER)' %DIVIDE &MEOUT &MAIN ISPEXEC VGET RESULT SHARED IF &SYSINDEX(&STR(.),&STR(&RESULT)) = 1 THEN + SET RESULT = &STR(0&RESULT) ISREDIT CHANGE FIRST 70 .MEOUT .MEOUT P'=' '&STR(&RESULT)' ISREDIT CHANGE FIRST 80 .MEOUT .MEOUT P'=' + '(EXCEPTION RECORDS WRITTEN/MASTER)' %DIVIDE &MYOUT &MAIN ISPEXEC VGET RESULT SHARED IF &SYSINDEX(&STR(.),&STR(&RESULT)) = 1 THEN + SET RESULT = &STR(0&RESULT) ISREDIT CHANGE FIRST 70 .MYOUT .MYOUT P'=' '&STR(&RESULT)' ISREDIT CHANGE FIRST 80 .MYOUT .MYOUT P'=' + '(BYPASS RECORDS WRITTEN/MASTER)' %DIVIDE &TAOUT &TAIN ISPEXEC VGET RESULT SHARED IF &SYSINDEX(&STR(.),&STR(&RESULT)) = 1 THEN + SET RESULT = &STR(0&RESULT) ISREDIT CHANGE FIRST 70 .TAOUT .TAOUT P'=' '&STR(&RESULT)' ISREDIT CHANGE FIRST 80 .TAOUT .TAOUT P'=' + '(GOOD TXN RECORDS WRITTEN/TXN)' %DIVIDE &TEOUT &TAIN ISPEXEC VGET RESULT SHARED IF &SYSINDEX(&STR(.),&STR(&RESULT)) = 1 THEN + SET RESULT = &STR(0&RESULT) ISREDIT CHANGE FIRST 70 .TEOUT .TEOUT P'=' '&STR(&RESULT)' ISREDIT CHANGE FIRST 80 .TEOUT .TEOUT P'=' + '(EXCEPTION RECORDS WRITTEN/TXN)' %DIVIDE &TYOUT &TAIN ISPEXEC VGET RESULT SHARED IF &SYSINDEX(&STR(.),&STR(&RESULT)) = 1 THEN + SET RESULT = &STR(0&RESULT) ISREDIT CHANGE FIRST 70 .TYOUT .TYOUT P'=' '&STR(&RESULT)' ISREDIT CHANGE FIRST 80 .TYOUT .TYOUT P'=' + '(BYPASS RECORDS WRITTEN/TXN)' SET XXIN = &AAIN + &ATIN %DIVIDE &DAOUT &XXIN ISPEXEC VGET RESULT SHARED IF &SYSINDEX(&STR(.),&STR(&RESULT)) = 1 THEN + SET RESULT = &STR(0&RESULT) ISREDIT CHANGE FIRST 70 .DAOUT .DAOUT P'=' '&STR(&RESULT)' ISREDIT CHANGE FIRST 80 .DAOUT .DAOUT P'=' + '(DETAIL RECORDS WRITTEN/EDITED TXN/ACCNT)' %DIVIDE &EROUT &EXIN ISPEXEC VGET RESULT SHARED IF &SYSINDEX(&STR(.),&STR(&RESULT)) = 1 THEN + SET RESULT = &STR(0&RESULT) ISREDIT CHANGE FIRST 70 .EROUT .EROUT P'=' '&STR(&RESULT)' ISREDIT CHANGE FIRST 80 .EROUT .EROUT P'=' + '(EX REPORT RECORDS WRITTEN/EXCEPTION REC)' %DIVIDE &REOUT &DAIN ISPEXEC VGET RESULT SHARED IF &SYSINDEX(&STR(.),&STR(&RESULT)) = 1 THEN + SET RESULT = &STR(0&RESULT) ISREDIT CHANGE FIRST 70 .REOUT .REOUT P'=' '&STR(&RESULT)' ISREDIT CHANGE FIRST 80 .REOUT .REOUT P'=' + '(799 REPORT RECORDS WRITTEN/DETAIL REC)' ISREDIT FIND NEXT 'AAAAAAA' 1 END /* ?????.SLSS.#799.MANUAL.ADJUST 3 /* ?????.SLSS.L799.ACCOUNT 1(DELETED) /* ?????.SLSS.L799.ACCOUNT.SORTED 1(DELETED) /* ?????.SLSS.L799.BYPASS.MASTER 1 /* ?????.SLSS.L799.BYPASS.TRAN 1 /* ?????.SLSS.L799.DETAIL 3(TAPE) /* ?????.SLSS.L799.DETAIL.FINAL 20(TAPE) /* ?????.SLSS.L799.DETAIL.PRELIM 3(TAPE) /* ?????.SLSS.L799.EXCPTION.REPORT 3 /* ?????.SLSS.L799.PREVBAL 20 /* ?????.SLSS.L799.PRORATE 3 /* ?????.SLSS.L799.REPORT.FINAL 20 /* ?????.SLSS.L799.REPORT.PRELIM 3 /* ?????.SLSS.L799.SLS799M.EXCPTION 1(DELETED) /* ?????.SLSS.L799.SLS799T.EXCPTION 1(DELETED) /* ?????.SLSS.L799.SORTOUT.EXCPTION 3 /* ?????.SLSS.L799.TRAN 1(TAPE) /* ?????.SLSS.L799.TRAN.SORTED 1(TAPE) /* ?????.SLSS.F799.ACCOUNT 1(DELETED) /* ?????.SLSS.F799.ACCOUNT.SORTED 1(DELETED) /* ?????.SLSS.F799.BYPASS.MASTER 1 /* ?????.SLSS.F799.BYPASS.TRAN 1 /* ?????.SLSS.F799.DETAIL 3(TAPE) /* ?????.SLSS.F799.DETAIL.FINAL 20(TAPE) /* ?????.SLSS.F799.DETAIL.PRELIM 3(TAPE) /* ?????.SLSS.F799.EXCPTION.REPORT 3 /* ?????.SLSS.F799.PREVBAL 20 /* ?????.SLSS.F799.PRORATE 3 /* ?????.SLSS.F799.REPORT.FINAL 20 /* ?????.SLSS.F799.REPORT.PRELIM 3 /* ?????.SLSS.F799.SLS799M.EXCPTION 1(DELETED) /* ?????.SLSS.F799.SLS799T.EXCPTION 1(DELETED) /* ?????.SLSS.F799.SORTOUT.EXCPTION 3 /* ?????.SLSS.F799.TRAN 1(TAPE) /* ?????.SLSS.F799.TRAN.SORTED 1(TAPE) /* ?????.SLSS.O799.EXCPTION.REPORT 3 /* ?????.SLSS.O799.SORTOUT.EXCPTION 3 ./ ADD NAME=DASDRPTS /********************************************************************** /* ISPSTART CLIST TO JUST EDIT THE RESULTS DATASET WITH A MACRO * /********************************************************************** PROC 0 CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ISPEXEC LMINIT DATAID(DID) DDNAME(DASDRPTS) ENQ(SHRW) WRITE LMINIT CC=&LASTCC ISPEXEC EDIT DATAID(&DID) MACRO(DASDRPT2) WRITE EDIT CC=&LASTCC ISPEXEC LMFREE DATAID(&DID) WRITE LMFREE CC=&LASTCC EXIT ./ ADD NAME=DASDRPT2 /********************************************************************** /* DASD ANALYSIS REPORT EDITING MACRO * /********************************************************************** ISREDIT MACRO CONTROL NOMSG NOLIST NOCONLIST NOSYMLIST NOFLUSH ISPEXEC CONTROL ERRORS RETURN /********************************************************************** /* GET RID OF CARRIAGE CONTROL ON TOTAL LINES * /********************************************************************** ISREDIT CHANGE '1TOTAL' '0TOTAL' 1 ALL /********************************************************************** /* MOVE THE PAGE BREAK UP A LINE * /********************************************************************** ISREDIT FIND FIRST '1' 1 DO WHILE &LASTCC = 0 ISREDIT LABEL .ZCSR = .A ISREDIT LINE_BEFORE .A = '1 ' ISREDIT CHANGE '1' ' ' FIRST 1 .A .A ISREDIT FIND NEXT '1' 1 END /********************************************************************** /* CALCULATE UNUSED CYLINDERS * /********************************************************************** ISREDIT FIND FIRST 'UNUSED=' DO WHILE &LASTCC = 0 ISREDIT FIND NEXT ' ' .ZCSR .ZCSR ISREDIT FIND NEXT P'#' .ZCSR .ZCSR ISREDIT (LN1,CL1) = CURSOR ISREDIT FIND NEXT ' ' .ZCSR .ZCSR ISREDIT FIND PREV P'#' .ZCSR .ZCSR ISREDIT (LN2,CL2) = CURSOR ISREDIT (LINE) = LINE .ZCSR SET SYSDVAL = &SUBSTR(&CL1:&CL2,&STR(&SYSNSUB(1,&LINE))) READDVAL NUM1 NUM2 NUM3 NUM4 SET TRACKS = &NUM1&NUM2&NUM3&NUM4 SET CYLINDERS = &EVAL(&TRACKS / 15) IF &CYLINDERS > 0 THEN + DO SET CYLINDERS = &SUBSTR(&LENGTH(&STR( &CYLINDERS))-4:+ &LENGTH(&STR( &CYLINDERS)),+ &STR( &CYLINDERS)) SET SUFFIX = &STR((APPROXIMATELY &CYLINDERS CYLINDERS)) END ELSE + SET SUFFIX = &STR( ) SET CL2 = &CL2 + 5 ISREDIT LINE .ZCSR = <1 (LINE) (CL2) (SUFFIX)> ISREDIT CURSOR = &LN2 &CL2 ISREDIT FIND NEXT 'UNUSED=' END /********************************************************************** /* ADD "....." FOR VISIBILITY * /********************************************************************** ISREDIT FIND FIRST '= ' DO WHILE &LASTCC = 0 ISREDIT FIND ' ' .ZCSR .ZCSR ISREDIT (LN1,CL1) = CURSOR ISREDIT FIND P'.' .ZCSR .ZCSR ISREDIT FIND PREV ' ' .ZCSR .ZCSR ISREDIT (LN2,CL2) = CURSOR IF &EVAL(&CL2 - &CL1) >= 0 THEN + ISREDIT CHANGE ALL ' ' '.' &CL1 &CL2 .ZCSR .ZCSR ISREDIT FIND NEXT '= ' END ISREDIT END ./ ADD NAME=DASDUSED ISREDIT MACRO ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /********************************************************************** /* TMS ALLOCATIONS * /********************************************************************** SET LP = &STR(( SET RP = &STR()) SET SPC = &STR( ) SET SYSRPTDSN = &STR(&SYSUID..TEMP.TMS.REPORT) DELETE '&SYSRPTDSN' FREE DDNAME(TMSRPT SYSIN) ALLOC DD(TMSRPT) DSN('&SYSRPTDSN') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK005) + SPACE(5,5) TRACKS RELEASE + DSORG(PS) RECFM(F B) LRECL(133) BLKSIZE(23408) /********************************************************************** /* GET RID OF GARBAGE * /********************************************************************** ISREDIT EXCLUDE ALL '??????' 46 ISREDIT DELETE ALL EXCLUDED ISREDIT CHANGE ALL P'=' '' 86 132 /********************************************************************** /* LOOP THROUGH THE DATASETS * /********************************************************************** ISREDIT FIND FIRST P'.' 1 DO WHILE &LASTCC = 0 ISREDIT (SYSDVAL) = LINE .ZCSR READDVAL DATASET VOLUME DSORG RECFM LRECL BLKSIZE TRACKS PCTUSED XX /* SET ZEDLMSG = &STR(*** WORKING ON "&DATASET" ***) /* ISPEXEC CONTROL DISPLAY LOCK /* ISPEXEC DISPLAY MSG(UTLZ000) IF &DATATYPE(&VOLUME) = NUM THEN + DO ALLOC DD(SYSIN) + NEW + UNIT(SYSDA) VOLUME(WRK005) + SPACE(1,1) TRACKS RELEASE + RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS) OPENFILE SYSIN OUTPUT SET SYSIN = &STR(DSN=&DATASET,LONG) PUTFILE SYSIN CLOSFILE SYSIN ISPEXEC SELECT PGM(TMSBINQ) /* ISPEXEC EDIT DATASET('&SYSRPTDSN') ERROR DO SET ERRCC = &LASTCC SELECT (&ERRCC) WHEN (400) DO SET EOF = YES RETURN END OTHERWISE DO ERROR OFF WRITE *** ERROR CC: &ERRCC OCCURRED READING A FILE *** CLOSFILE TMSRPT FREE DD(TMSRPT) EXIT END END END SET VOLS = 0 SET BLKCNT = 0 SET EOF = NO OPENFILE TMSRPT GETFILE TMSRPT DO WHILE &EOF = NO IF &DATATYPE(&SUBSTR(2:7,&STR(&SYSNSUB(1,&TMSRPT)))) = + NUM THEN SET VOLS = &VOLS + 1 IF &VOLS = 1 THEN + DO IF &SYSINDEX(&STR(LRECL=),+ &STR(&SYSNSUB(1,&TMSRPT))) > 0 THEN + DO SET A = &SYSINDEX(&STR(LRECL=),+ &STR(&SYSNSUB(1,&TMSRPT))) SET A = &A + 6 SET Y = &A + 5 SET LRECL = &SUBSTR(&A:&Y,+ &STR(&SYSNSUB(1,&TMSRPT))) SET LRECL = &LRECL END IF &SYSINDEX(&STR(BLKSIZE=),+ &STR(&SYSNSUB(1,&TMSRPT))) > 0 THEN + DO SET A = &SYSINDEX(&STR(BLKSIZE=),+ &STR(&SYSNSUB(1,&TMSRPT))) SET A = &A + 8 SET Y = &A + 5 SET BLKSIZE = &SUBSTR(&A:&Y,+ &STR(&SYSNSUB(1,&TMSRPT))) SET BLKSIZE = &BLKSIZE END END IF &SYSINDEX(&STR(BLKCNT=),+ &STR(&SYSNSUB(1,&TMSRPT))) > 0 THEN + DO SET A = &SYSINDEX(&STR(BLKCNT=),+ &STR(&SYSNSUB(1,&TMSRPT))) SET A = &A + 7 SET Y = &A + 6 SET X = &SUBSTR(&A:&Y,+ &STR(&SYSNSUB(1,&TMSRPT))) SET BLKCNT = &BLKCNT + &X END GETFILE TMSRPT END ERROR OFF CLOSFILE TMSRPT %DYLCALC &STR(&LP&BLKSIZE/&LRECL&RP*&BLKCNT) PRECISION(0) ISPEXEC VGET DYRESULT SHARED IF &DYRESULT = THEN SET DYRESULT = 0 SET RECORDS = &DYRESULT END ELSE + DO %DYLCALC &STR(&LP&LP&PCTUSED/100&RP*&TRACKS&RP*2) + PRECISION(0) ISPEXEC VGET DYRESULT SHARED IF &DYRESULT = THEN SET DYRESULT = 0 %DYLCALC &STR(&LP&BLKSIZE/&LRECL&RP*&DYRESULT) + PRECISION(0) ISPEXEC VGET DYRESULT SHARED IF &DYRESULT = THEN SET DYRESULT = 0 SET RECORDS = &DYRESULT %BLKSIZE &LRECL &RECORDS DEVICES(3380) BATCH ISPEXEC VGET CYLSREQ SHARED SET VOLS = &CYLSREQ END SET VOLUME = &SUBSTR(&LENGTH(&STR(&SPC&VOLUME))-5:+ &LENGTH(&STR(&SPC&VOLUME)),+ &STR(&SPC&VOLUME)) SET VOLS = &SUBSTR(&LENGTH(&STR(&SPC&VOLS))-5:+ &LENGTH(&STR(&SPC&VOLS)),+ &STR(&SPC&VOLS)) SET LRECL = &SUBSTR(&LENGTH(&STR(&SPC&LRECL))-5:+ &LENGTH(&STR(&SPC&LRECL)),+ &STR(&SPC&LRECL)) SET BLKSIZE = &SUBSTR(&LENGTH(&STR(&SPC&BLKSIZE))-5:+ &LENGTH(&STR(&SPC&BLKSIZE)),+ &STR(&SPC&BLKSIZE)) SET RECORDS = &SUBSTR(&LENGTH(&STR(&SPC&RECORDS))-10:+ &LENGTH(&STR(&SPC&RECORDS)),+ &STR(&SPC&RECORDS)) ISREDIT LINE .ZCSR = <2,(DATASET) + 50,(LRECL) + 60,(BLKSIZE) + 70,(RECORDS) + 85,(VOLUME) + 95,(VOLS)> WRITE &STR(&DATASET &LRECL &BLKSIZE &RECORDS &VOLUME &VOLS) ISREDIT FIND NEXT P'.' 1 END FREE DD(TMSRPT) SET DATASET = &STR(DATASETS (AS OF SEPTEMBER 92 MONTHEND)) SET VOLUME = &SUBSTR(&LENGTH(&STR(&SPC.VOLUME))-5:+ &LENGTH(&STR(&SPC.VOLUME)),+ &STR(&SPC.VOLUME)) SET VOLS = &SUBSTR(&LENGTH(&STR(&SPC.CARTS OR CYLS))-12:+ &LENGTH(&STR(&SPC.CARTS OR CYLS)),+ &STR(&SPC.CARTS OR CYLS)) SET LRECL = &SUBSTR(&LENGTH(&STR(&SPC.LRECL))-5:+ &LENGTH(&STR(&SPC.LRECL)),+ &STR(&SPC.LRECL)) SET BLKSIZE = &SUBSTR(&LENGTH(&STR(&SPC.BLKSIZE))-6:+ &LENGTH(&STR(&SPC.BLKSIZE)),+ &STR(&SPC.BLKSIZE)) SET RECORDS = &SUBSTR(&LENGTH(&STR(&SPC.RECORDS))-10:+ &LENGTH(&STR(&SPC.RECORDS)),+ &STR(&SPC.RECORDS)) ISREDIT LINE_BEFORE .ZFIRST = <02,(DATASET) + 50,(LRECL) + 59,(BLKSIZE) + 70,(RECORDS) + 85,(VOLUME) + 95,(VOLS)> SET DATASET = &STR(-----------------------------------------) SET VOLUME = &SUBSTR(&LENGTH(&STR(&SPC.------))-5:+ &LENGTH(&STR(&SPC.------)),+ &STR(&SPC.------)) SET VOLS = &SUBSTR(&LENGTH(&STR(&SPC.-------------))-12:+ &LENGTH(&STR(&SPC.-------------)),+ &STR(&SPC.-------------)) SET LRECL = &SUBSTR(&LENGTH(&STR(&SPC.-----))-5:+ &LENGTH(&STR(&SPC.-----)),+ &STR(&SPC.-----)) SET BLKSIZE = &SUBSTR(&LENGTH(&STR(&SPC.-------))-6:+ &LENGTH(&STR(&SPC.-------)),+ &STR(&SPC.-------)) SET RECORDS = &SUBSTR(&LENGTH(&STR(&SPC.-------))-10:+ &LENGTH(&STR(&SPC.-------)),+ &STR(&SPC.-------)) ISREDIT LINE_AFTER .ZFIRST = <02,(DATASET) + 50,(LRECL) + 59,(BLKSIZE) + 70,(RECORDS) + 85,(VOLUME) + 95,(VOLS)> ISREDIT CURSOR = 1 1 EXIT HELPSEC: + 02480000 ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) 02490000 SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR $TOUT UTILITY + 02490000 *** NO PROCESSING PERFORMED ***) 02490000 ISPEXEC SETMSG MSG(UTLZ000) 02490000 EXIT ./ ADD NAME=DATECHEK PROC 0 HELP CONTROL NOPROMPT NOMSG NOFLUSH GLOBAL FILENAME MEMBER CLEARSCR /* /******************************************************************/ /* 'CHEKDATE' CLIST. VERIFY ALL CAS DATE CARD FILES FOR CORRECT */ /* CREATION DATE & DATE VLAUES. */ /* AUTHOR : DAVID MONTGOMERY DATE 4-6-1990 */ /******************************************************************/ IF &HELP = &STR(HELP) THEN GOTO HELPSEC WRITE ********************************************************** WRITE *** WRITE *** VERIFY DATE CARD FILES FOR &STR(&SYSDATE) (&SYSJDATE) WRITE *** WRITE ********************************************************** /* INITIALIZE: - SET FILE1 = &STR(PCWCA.PWBUF.DAILYDTE.FILE(0)) SET FILE2 = &STR(PCWCA.PWBUF.WEKLYDTE.FILE(0)) SET FILE3 = &STR(PCWCA.PWBUF.MONTHDTE.FILE(0)) SET FILE4 = &STR(PCWCA.PWBUF.SPECLDTE.FILE(0)) SET FILE5 = &STR(PCWCA.PWBUF.VOIDATE.FILE(0)) SET TYPE1 = &STR(DAILY) SET TYPE2 = &STR(WEEKLY) SET TYPE3 = &STR(MONTHLY) SET TYPE4 = &STR(SPECIAL) SET TYPE5 = &STR(VOID) SET DAYS = &STR( 312831303130313130313031) /* SET TODAY = &STR(&SYSJDATE) SET YY = &SUBSTR(1:2,&STR(&TODAY)) SET DD = &SUBSTR(4:6,&STR(&TODAY)) SET YEAR = &YY + 1900 SET CREATED = &STR(&YEAR/&DD) SET OFFSET = &STR(1235601345) SET N = &SYSINDEX(&STR(&YY),&STR( 90919293949596979899)) / 2 SET DOF = &SUBSTR(&N,&STR(&OFFSET)) IF &N > 0 THEN - SET DAYOWK = &DD - ((&DD / 7) * 7) + &DOF ELSE - DO WRITE *** TIME TO UPDATE THE CLIST FOR CENTURY 2000 WRITE *** PROGRAM HALTED... GOTO EXIT END SET TODAY = &STR(&SYSDATE) SET MM = &SUBSTR(1:2,&STR(&TODAY)) SET DD = &SUBSTR(4:5,&STR(&TODAY)) SET YY = &SUBSTR(7:8,&STR(&TODAY)) SET DATE1 = &STR(&MM&DD&YY ) /* SET N = &MM * 2 SET MEND = &SUBSTR(&N:&N+1,&STR(&DAYS)) IF &MM = 02 THEN - IF &YEAR - ((&YEAR / 4) * 4) = 0 THEN - SET MEND = 29 SET DATE3 = &STR(&MM&MEND&YY ) /* SET WM = &STR(&MM) SET WY = &STR(&YY) SET WEND = &DD + (6 - &DAYOWK) IF &WEND > &MEND THEN - DO SET WEND = &WEND - &MEND SET WM = &WM + 1 IF &WM < 10 THEN SET WM = &STR(0&WM) ELSE IF &WM > 12 THEN - DO SET WM = &STR(01) SET WY = &YY + 1 END END IF &WEND < 10 THEN SET WEND = &STR(0&WEND) SET DATE2 = &STR(&WM&WEND&WY ) /* SET PS = &DD - &DAYOWK SET PM = &STR(&MM) SET PY = &STR(&YY) IF &PS < 1 THEN - DO SET PM = &MM - 1 IF &PM < 1 THEN - DO SET PM = 12 SET PY = &YY - 1 SET PYR = &PY + 1900 END SET N = &PM * 2 SET PEND = &SUBSTR(&N:&N+1,&STR(&DAYS)) IF &PM = 02 THEN - IF &PYR - ((&PYR / 4) * 4) = 0 THEN - SET PEND = 29 SET PD = &PEND + &PS IF &PM < 10 THEN SET PM = &STR(0&PM) END ELSE SET PD = &PS IF &PD < 10 THEN SET PD = &STR(0&PD) SET PRVSAT = &STR(&PM&PD&PY) IF &MM = &PM THEN SET FIRST = &STR(&PRVSAT) ELSE SET FIRST = &STR(&MM)&STR(01)&STR(&YY) IF &MM = &WM THEN SET SECOND = &STR(&DATE2) ELSE SET SECOND = &STR(&DATE3) SET DATE4 = &STR(&FIRST&SECOND) /* IF &DAYOWK = 7 THEN SET FIRST = &STR(&DATE1) ELSE SET FIRST = &STR(&PRVSAT) SET SECOND = &STR(&DATE2) SET DATE5 = &STR(&FIRST&SECOND) /* SET F = 1 FREE F(DATE) /* MAINLINE: - SET FILE = &STR(&&FILE&F) SET FILENAME = &STR(&FILE) SET FILETYPE = &STR(&&TYPE&F) %CHECKDSN SET RC = &LASTCC IF &RC > 4 THEN - DO WRITE *** WRITE *** ERROR VERIFYING &FILENAME WRITE *** RETURN CODE &RC FROM CHECKDSN GOTO NEXT1 END /* LISTDSI &STR('&FILENAME') SET RC = &LASTCC IF &RC > 4 THEN - DO WRITE *** WRITE *** LISTDSI ERROR &RC REASON &SYSREASON IF &SYSMSGLVL1 ¬= THEN WRITE &SYSMSGLVL1 IF &SYSMSGLVL2 ¬= THEN WRITE &SYSMSGLVL2 WRITE *** &DSN PRINT HALTED... GOTO NEXT1 END IF &STR(&SYSCREATE) ¬= &STR(&CREATED) THEN - DO WRITE *** WRITE *** &FILETYPE &FILENAME *** NOT VERIFIED *** WRITE *** LAST CREATED &SYSCREATE GOTO NEXT1 END /* ALLOC F(DATE) DA('&FILENAME') INPUT OPENFILE DATE GETFILE DATE SET DATESTR = &SUBSTR(1:12,&DATE) CLOSFILE DATE FREE F(DATE) /* SET TESTTYPE = &&TYPE&F SET TESTDATE = &&DATE&F IF &STR(&DATESTR) = &STR(&TESTDATE) THEN /* CONTINUE ELSE - DO SET ZEDLMSG = - &STR(&TESTTYPE DATES DO NOT MATCH : CALCULATED AS &TESTDATE) ISPEXEC SETMSG MSG(ISRZ000) ISPEXEC EDIT DATASET('&FILENAME') GOTO NEXT1 END /* NEXT: - WRITE *** WRITE *** &FILETYPE : &FILENAME VERIFIED NEXT1: - SET F = &F + 1 IF &F > 5 THEN GOTO EXIT GOTO MAINLINE /* HELPSEC: + WRITE *** HELP FOR CLIST 'CHEKDATE' *** WRITE WRITE THE CHEKDATE CLIST VERIFIES EACH OF THE CAS DATE CARD FILES. WRITE IF THE CREATION DATE OF A FILE IS NOT EQUAL TO TODAY'S DATE WRITE A MESSAGE IS DISPLAYED INDICATING POSSIBLE FURTHER ACTION ON WRITE THE PART OF THE SE. IF THE CONTENTS OF THE DATE FILE DO NOT WRITE EQUAL A CLIST CALCULATED VALUE, THE FILE IS ENTERED IN EDIT WRITE MODE FOR FURTHER INVESTIGATION. WRITE WRITE *** END OF HELP *** NO PROCESSING PERFORMED *** EXIT: - WRITE *** WRITE *** END OF DATE CARD FILE VERIFICATION WRITE *** WRITE ********************************************************** EXIT ./ ADD NAME=DATEFMTS PROC 0 HELP /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT IF &HELP = &STR(HELP) THEN GOTO HELPSEC SET WDFMT00I = SET WDFMT01I = SET WDFMT05I = SET WDFMT06I = SET WDFMT10I = SET WDFMT11I = SET WDFMT12I = SET WDFMT13I = SET WDFMT20I = SET WDFMT21I = SET WDFMT30I = SET WDFMT31I = SET WDFMT32I = SET WDFMT33I = SET WDFMT40I = SET WDFMT50I = SET WDFMT60I = SET WDFMT70I = SET WDDAYXXI = SET WDDAY99I = SET XXFMT00I = SET XXFMT10I = SET XXFMT20I = LOOP: + ISPEXEC DISPLAY PANEL(DATEFMTS) IF &LASTCC = 8 THEN EXIT ISPEXEC VGET (WDFMT00I WDFMT10I WDFMT20I) SHARED IF &WDFMT00I ¬= &XXFMT00I THEN + DO SET WDINDATE = &STR(&WDFMT00I) SET WDINFMT = &STR(00) SET WDINMOD = &STR(0) END IF &WDFMT10I ¬= &XXFMT10I THEN + DO SET WDINDATE = &STR(&WDFMT10I) SET WDINFMT = &STR(10) SET WDINMOD = &STR(0) END IF &WDFMT20I ¬= &XXFMT20I THEN + DO SET WDINDATE = &STR(&WDFMT20I) SET WDINFMT = &STR(20) SET WDINMOD = &STR(0) END ISPEXEC VPUT (WDINDATE WDINFMT WDINMOD) SHARED ISPEXEC SELECT PGM(WADATPGM) IF &LASTCC = 0 THEN + DO ISPEXEC VGET (WDFMT00I + WDFMT01I + WDFMT05I + WDFMT06I + WDFMT10I + WDFMT11I + WDFMT12I + WDFMT13I + WDFMT20I + WDFMT21I + WDFMT30I + WDFMT31I + WDFMT32I + WDFMT33I + WDFMT40I + WDFMT50I + WDFMT60I + WDFMT70I + WDDAYXXI + WDDAY99I) SHARED GOTO LOOP END ELSE + DO SET ZEDLMSG = &STR(DATE CONVERSION PROBLEM) ISPEXEC SETMSG MSG(UTLZ001) GOTO LOOP END HELPSEC: + CLEAR WRITE *** HELP FOR CLIST DATEFMTS *** WRITE WRITE HELP NOT WRITTEN AT THIS TIME WRITE WRITE *** END OF HELP *** NO PROCESSING PERFORMED EXIT ./ ADD NAME=DATELINE ISREDIT MACRO (OPT1,OPT2) ISPEXEC CONTROL ERRORS RETURN /**** 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 SET YEAR = 1600 SET DAY = 6 ISREDIT (LINE) = LINE .ZLAST SET XYEAR = &SUBSTR(1:4,&STR(&LINE)) SET XDAY = &SUBSTR(6:6,&STR(&LINE)) IF &XYEAR > 1599 THEN + DO SET YEAR = &XYEAR SET DAY = &XDAY END DO WHILE &YEAR < 2601 IF &EVAL(&YEAR//10) = 0 THEN + DO WRITE WORKING ON &YEAR ISREDIT SAVE END ISREDIT LINE_BEFORE .ZLAST = '&YEAR &DAY' IF &SUBSTR(3:4,&STR(&YEAR)) = &STR(00) THEN + SET LEAP = &EVAL(&YEAR//400) ELSE + SET LEAP = &EVAL(&YEAR//4) DO &DDD = 1 TO 365 SET DAY = &DAY + 1 IF &DAY > 7 THEN SET DAY = &DAY - 7 END IF &LEAP = 0 THEN + DO SET DAY = &DAY + 1 IF &DAY > 7 THEN SET DAY = &DAY - 7 END SET YEAR = &YEAR + 1 END ISREDIT SAVE ISREDIT END ./ ADD NAME=DATEMACR ISREDIT MACRO ISPEXEC CONTROL ERRORS RETURN /**** 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 ISPEXEC VGET (DATE1 ITER) SHARED WRITE &STR(&DATE1 &ITER) ISPEXEC LIBDEF ISPLLIB DATASET ID('SLSS.PRD.LOAD') SET DUFUNC = INCREMENT SET DUNUMBER = 1 SET DUDATE1 = &STR(&DATE1) SET DUDATE2 = &STR(&DATE1) SET DUDY1FMT = DD SET DUMO1FMT = MM SET DUYR1FMT = YYYY SET DUDT1FMT = &STR(Y-M-D) SET DUDY2FMT = DD SET DUMO2FMT = MM SET DUYR2FMT = YYYY SET DUDT2FMT = &STR(Y-M-D) ISREDIT LINE_AFTER .ZFIRST = '&STR(&DATE1)' DO &I = 1 TO &ITER IF &EVAL(&I // 100) = 0 THEN + DO WRITE &STR(ITERATION #&I --- LAST DATE: &DUDATE2) ISREDIT SAVE END SET DUDATE1 = &STR(&DUDATE2) ISPEXEC VPUT (DUFUNC DUDATE1 DUDY1FMT DUMO1FMT DUYR1FMT DUDT1FMT + DUNUMBER DUDY2FMT DUMO2FMT DUYR2FMT DUDT2FMT) SHARED ISPEXEC SELECT PGM(DATEUTIL) PARM(ISPF) IF &LASTCC = 0 THEN + DO ISPEXEC VGET (DUDATE2) SHARED ISREDIT LINE_AFTER .ZLAST = (DUDATE2) END ELSE + DO ISPEXEC VGET (DUMSG) SHARED WRITE &STR(ITERATION #&I PROBLEM = &DUMSG) END END END ISREDIT END ./ ADD NAME=DATETEST /* REXX ***************************************************************/ /* TEST THE USE OF DATEUTIL IN REXX */ /**********************************************************************/ ADDRESS ISPEXEC "LIBDEF ISPLLIB" "LIBDEF ISPLLIB DATASET ID('D@UDAL.STR.ISPLLIB')" DUFUNC = 'INCREMENT' DUNUMBER = 5 DUDT2FCD = 12 "VPUT (DUFUNC DUNUMBER DUDT2FCD) SHARED" "SELECT PGM(DATEUTIL) PARM(ISPF)" IF RC = 0 THEN DO "VGET (DUDATE2)" SAY DUDATE2 END ELSE DO SAVERC = RC "VGET (DUMSG) SHARED" SAY SAVERC DUMSG END EXIT ./ ADD NAME=DATEUTIL /********************************************************************** /* UTILITY: DATEUTIL * /* AUTHOR: DAVID LEIGH * /* FUNCTION: CALL THE DATEUTIL PROGRAM TO DO DATE MANIPULATION. * /* PRESENT THE USER WITH A SCREEN WHERE THEY CAN ENTER * /* THE NECESSARY DATE INFORMATION, AND THEN CALL THE * /* PROGRAM. * /********************************************************************** PROC 0 /*** CHECK THE DEBUG SWITCH ***/ ISPEXEC VGET DBGSWTCH PROFILE IF &DBGSWTCH = ON THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS /*PEXEC LIBDEF ISPLLIB /*PEXEC LIBDEF ISPLLIB DATASET ID('D@UDAL.STR.ISPLLIB') SET DUDATE1 = SET DUDY1FMT = SET DUMO1FMT = SET DUYR1FMT = SET DUYR1SWT = SET DUDT1FMT = SET DUDT1FCD = SET DUNUMBER = SET DUDATE2 = SET DUDY2FMT = SET DUMO2FMT = SET DUYR2FMT = SET DUYR1SWT = SET DUDT2FMT = SET DUDT2FCD = SET DUFUNC = SET DUMSG = REDISPLAY: + ISPEXEC VPUT (DUDATE1 DUDY1FMT DUMO1FMT DUYR1FMT DUDT1FMT DUNUMBER + DUDATE2 DUDY2FMT DUMO2FMT DUYR2FMT DUDT2FMT DUFUNC + DUYR1SWT DUYR2SWT DUDT1FCD DUDT2FCD DUMSG) SHARED ISPEXEC DISPLAY PANEL(DATEUTIL) SELECT (&LASTCC) WHEN (0) DO IF &STR(&DUDT1FCD) = &STR(?) THEN + DO SET ZWINTTL = &STR(VALID DATE 1 FORMAT CODES) ISPEXEC ADDPOP ROW(1) COLUMN(3) ISPEXEC DISPLAY PANEL(DATEUTLF) ISPEXEC REMPOP GOTO REDISPLAY END IF &STR(&DUDT2FCD) = &STR(?) THEN + DO SET ZWINTTL = &STR(VALID DATE 2 FORMAT CODES) ISPEXEC ADDPOP ROW(1) COLUMN(3) ISPEXEC DISPLAY PANEL(DATEUTLF) ISPEXEC REMPOP GOTO REDISPLAY END SET DUMSG = ISPEXEC VPUT (DUDATE1 DUDY1FMT DUMO1FMT DUYR1FMT DUDT1FMT DUNUMBER + DUDATE2 DUDY2FMT DUMO2FMT DUYR2FMT DUDT2FMT DUFUNC + DUYR1SWT DUYR2SWT DUDT1FCD DUDT2FCD DUMSG) SHARED ISPEXEC SELECT PGM(DATEUTIL) PARM(ISPF) IF &LASTCC = 0 THEN + DO SET SAVEDU2 = &STR(&DUDATE2) ISPEXEC VGET (DUDATE2 DUNUMBER) SHARED IF &STR(&DUDATE2) = AND + &STR(&SAVEDU2) > THEN + SET DUDATE2 = &STR(&SAVEDU2) END /* /* SELECT /* WHEN (&STR(&DUDATE1) = &STR() AND + /* &STR(&DUDATE2) > &STR() AND + /* &STR(&DUFUNC) = &STR()) + /* ISPEXEC VGET (DUNUMBER) SHARED /* WHEN (&STR(&DUFUNC) = &STR(BETWEEN)) + /* ISPEXEC VGET (DUNUMBER) SHARED /* OTHERWISE + /* ISPEXEC VGET (DUDATE2) SHARED /* END ELSE + ISPEXEC VGET (DUMSG) SHARED GOTO REDISPLAY END WHEN (8) EXIT OTHERWISE DO SET ZEDLMSG = &STR(DATEUTIL PANEL ERROR) ISPEXEC SETMSG MSG(UTLZ001W) EXIT END END ./ ADD NAME=DBCHANGE /********************************************************************** /* UTILITY: DBCHANGE * /* AUTHOR: DAVID LEIGH * /* FUNCTION: THIS CLIST MANAGES THE DISPLAY AND MAINTENANCE OF AN ISPF* /* TABLE, WHICH, ITSELF IS USED TO CONTROL WHICH PLATINUM * /* DATABASE CHANGE STRATEGIES ARE EXECUTED ON A GIVEN NIGHT.* /********************************************************************** PROC 0 DBCHPFX(DDBA.STR) /* POINT TO THE ISPF SET OF LIBRARIES */ ISPEXEC CONTROL ERRORS RETURN /*** CHECK THE DEBUG SWITCH ***/ ISPEXEC VGET DBGSWTCH PROFILE IF &DBGSWTCH = ON THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS /********************************************************************** /* ESTABLISH SOME OTHER VARIABLES * /********************************************************************** SET DB2FILE = &STR(&SYSUID..TEMP.DBCHANGE.DSNTIAUL) SET LASTSORT = LUDATE SET LP = &STR(( SET RP = &STR()) SET FIND = SET FIND_VAR = SET FIND_POS = /*********************************************************************** /* OPEN DBCHANGE TABLE * /*********************************************************************** ISPEXEC LIBDEF ISPTLIB DATASET ID('&DBCHPFX..ISPTLIB') ISPEXEC TBOPEN DBCHANGE NOWRITE SHARE SELECT (&LASTCC) WHEN (8) DO ISPEXEC LIBDEF ISPTABL DATASET ID('&DBCHPFX..ISPTLIB') ISPEXEC TBCREATE DBCHANGE KEYS(STRATEGY STRATDSN) + NAMES(STRATSEQ STRATDES IMPLDATE DB2SSID + LUDATE LUTIME LUID) ISPEXEC TBCLOSE DBCHANGE REPLCOPY ISPEXEC LIBDEF ISPTABL ISPEXEC TBOPEN DBCHANGE NOWRITE SHARE END WHEN (12) DO ISPEXEC TBSTATS DBCHANGE STATUS2(TABSTAT) IF &STR(&TABSTAT) = 1 THEN + DO ISPEXEC TBEND DBCHANGE ISPEXEC TBOPEN DBCHANGE NOWRITE SHARE GOTO OPEN_CONTINUE END SET ZEDSMSG = SET ZEDLMSG = &STR(ATTEMPTING TO ACCESS THE DBCHANGE ISPF + TABLE) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ001W) ISPEXEC TBOPEN DBCHANGE NOWRITE SHARE SET OPENCC = &LASTCC DO &I = 1 TO 30 WHILE &OPENCC ¬= 0 ISPEXEC TBSTATS DBCHANGE STATUS2(TABSTAT) IF &STR(&TABSTAT) = 1 THEN SET OPENCC = 0 ELSE + DO ISPEXEC TBOPEN DBCHANGE NOWRITE SHARE SET OPENCC = &LASTCC END END IF &OPENCC ¬= 0 THEN + DO SET ZEDSMSG = SET ZEDLMSG = &STR(UNABLE TO ACCESS DBCHANGE ISPF + TABLE. PLEASE TRY LATER) ISPEXEC SETMSG MSG(UTLZ001) EXIT CODE(12) END END WHEN (16 | 20) DO SET ZEDSMSG = SET ZEDLMSG = &STR(SEVERE ERROR ATTEMPTING TO ACCESS + DBCHANGE ISPF TABLE. NOTIFY TECH SUPPORT) ISPEXEC SETMSG MSG(UTLZ001) EXIT CODE(16) END END /*********************************************************************** /* REDISPLAY LIST SCREEN * /*********************************************************************** ISPEXEC TBSORT DBCHANGE FIELDS(LUDATE,C,D,LUTIME,C,D,STRATEGY,C,A) PROCLIST: + ISPEXEC TBDISPL DBCHANGE PANEL(DBCHANGE) SET PANELCC = &LASTCC IF &PANELCC > 8 THEN + DO SET ZEDSMSG = SET ZEDLMSG = &STR(PROBABLE ERROR IN MAIN PANEL. + TBDISPL RC = &PANELCC) ISPEXEC SETMSG MSG(UTLZ001W) GOTO FINISH END /********************************************************************** /* PROCESS LINE COMMANDS FIRST * /********************************************************************** IF &ZTDSELS ¬= &STR(0000) THEN + DO ISPEXEC CONTROL DISPLAY SAVE SELDIS: DO WHILE &ZTDSELS ¬= &STR(0000) SELECT (&ZSEL) /********** BROWSE A STRATEGY *********/ WHEN (B | S) DO ISPEXEC BROWSE DATASET('&STRATDSN') SELECT (&LASTCC) WHEN (0) DO SET ZEDSMSG = SET ZEDLMSG = &STR("&STRATDSN" BROWSED) ISPEXEC SETMSG MSG(UTLZ000) END WHEN (12) DO SET ZEDSMSG = SET ZEDLMSG = &STR("&STRATDSN" IS EMPTY. + IT CANNOT BE BROWSED.) ISPEXEC SETMSG MSG(UTLZ001) END WHEN (14 | 16) DO SET ZEDSMSG = SET ZEDLMSG = &STR("&STRATDSN" NOT FOUND) ISPEXEC SETMSG MSG(UTLZ001) END OTHERWISE DO SET ZEDSMSG = SET ZEDLMSG = &STR(UNABLE TO BROWSE + "&STRATDSN".) ISPEXEC SETMSG MSG(UTLZ001) END END END /******** CHANGE A ROW *********/ WHEN () DO ISPEXEC TBEND DBCHANGE IF &ZTDSELS > 0001 THEN + DO SET ZEDSMSG = SET ZEDLMSG = &STR(AN "UPDATE-TYPE" LINE + COMMAND PRECLUDED THE + PROCESSING OF YOUR + SUBSEQUENT LINE + COMMANDS) ISPEXEC SETMSG MSG(UTLZ001) END SET ZTDSELS = &STR(0000) SET DUFUNC = CONVERT SET DUNUMBER = SET DUDATE1 = &STR(&IMPLDATE) SET DUDY1FMT = DD SET DUMO1FMT = MM SET DUYR1FMT = YYYY SET DUDT1FMT = &STR(Y-M-D) SET DUDY2FMT = DD SET DUMO2FMT = MM SET DUYR2FMT = YYYY SET DUDT2FMT = &STR(Y-M-D) ISPEXEC VPUT (DUFUNC DUDATE1 DUDY1FMT + DUMO1FMT DUYR1FMT DUDT1FMT + DUNUMBER DUDY2FMT DUMO2FMT + DUYR2FMT DUDT2FMT) SHARED ISPEXEC SELECT PGM(DATEUTIL) PARM(ISPF) SET PGMCC = &LASTCC IF &PGMCC > 0 THEN + DO ISPEXEC VGET DUMSG SHARED SET ZEDSMSG = SET ZEDLMSG = &STR(&DUMSG) ISPEXEC SETMSG MSG(UTLZ001) GOTO LINE_LOOP END ISPEXEC LIBDEF ISPTABL + DATASET ID('&DBCHPFX..ISPTLIB') ISPEXEC TBOPEN DBCHANGE WRITE SET OPENCC = &LASTCC DO &I = 1 TO 30 WHILE &OPENCC ¬= 0 ISPEXEC TBSTATS DBCHANGE STATUS2(TABSTAT) IF &STR(&TABSTAT) = 1 THEN SET OPENCC = 0 ELSE + DO ISPEXEC TBOPEN DBCHANGE NOWRITE SHARE SET OPENCC = &LASTCC END END IF &OPENCC = 0 THEN + DO SET DUFUNC = CONVERT SET DUNUMBER = SET DUDATE1 = &STR(&SYSSDATE) SET DUDY1FMT = DD SET DUMO1FMT = MM SET DUYR1FMT = YY SET DUDT1FMT = &STR(Y/M/D) SET DUDY2FMT = DD SET DUMO2FMT = MM SET DUYR2FMT = YYYY SET DUDT2FMT = &STR(Y-M-D) ISPEXEC VPUT (DUFUNC DUDATE1 DUDY1FMT + DUMO1FMT DUYR1FMT DUDT1FMT + DUNUMBER DUDY2FMT DUMO2FMT + DUYR2FMT DUDT2FMT) SHARED ISPEXEC SELECT PGM(DATEUTIL) PARM(ISPF) SET PGMCC = &LASTCC IF &PGMCC = 0 THEN + DO ISPEXEC VGET DUDATE2 SHARED SET LUDATE = &STR(&DUDATE2) END ELSE + DO ISPEXEC VGET DUMSG SHARED SET ZEDSMSG = &STR(DATEUTIL ERROR) SET ZEDLMSG = &STR(&DUMSG) ISPEXEC SETMSG MSG(UTLZ001) ISPEXEC TBEND DBCHANGE ISPEXEC TBOPEN DBCHANGE + NOWRITE SHARE GOTO LINE_LOOP END SET LUID = &STR(&SYSUID) SET LUTIME = &STR(&SYSTIME) ISPEXEC TBMOD DBCHANGE ISPEXEC TBCLOSE DBCHANGE ISPEXEC TBOPEN DBCHANGE NOWRITE SHARE ISPEXEC TBSORT DBCHANGE + FIELDS(LUDATE,C,D,LUTIME,C,D,STRATEGY,C,A) END ELSE + DO SET ZEDSMSG = SET ZEDLMSG = &STR(UNABLE TO OPEN THE + DBCHANGE ISPF TABLE + FOR UPDATE. PLEASE + TRY LATER.) ISPEXEC SETMSG MSG(UTLZ001W) ISPEXEC TBOPEN DBCHANGE NOWRITE SHARE ISPEXEC TBSORT DBCHANGE + FIELDS(LUDATE,C,D,LUTIME,C,D,STRATEGY,C,A) END END /******** DELETE A ROW *********/ WHEN (D) DO ISPEXEC SELECT CMD(%YOUSURE COLUMN(26) ROW(1) + ZWINTTL('DELETE THIS TABLE ROW?')) IF &LASTCC > 0 THEN GOTO LINE_LOOP ISPEXEC TBEND DBCHANGE SET NAMECOND = ISPEXEC LIBDEF ISPTABL + DATASET ID('&DBCHPFX..ISPTLIB') ISPEXEC TBOPEN DBCHANGE WRITE SET OPENCC = &LASTCC DO &I = 1 TO 30 WHILE &OPENCC ¬= 0 ISPEXEC TBSTATS DBCHANGE STATUS2(TABSTAT) IF &STR(&TABSTAT) = 1 THEN SET OPENCC = 0 ELSE + DO ISPEXEC TBOPEN DBCHANGE NOWRITE SHARE SET OPENCC = &LASTCC END END IF &OPENCC = 0 THEN + DO ISPEXEC TBDELETE DBCHANGE ISPEXEC TBCLOSE DBCHANGE ISPEXEC TBOPEN DBCHANGE NOWRITE SHARE END ELSE + DO SET ZEDSMSG = SET ZEDLMSG = &STR(UNABLE TO OPEN THE + DBCHANGE ISPF TABLE + FOR UPDATE. PLEASE + TRY LATER.) ISPEXEC SETMSG MSG(UTLZ001W) ISPEXEC TBOPEN DBCHANGE NOWRITE SHARE END IF &ZTDSELS > 0001 THEN + DO SET ZEDSMSG = SET ZEDLMSG = &STR(AN "UPDATE-TYPE" LINE + COMMAND PRECLUDED THE + PROCESSING OF YOUR + SUBSEQUENT LINE + COMMANDS) ISPEXEC SETMSG MSG(UTLZ001) END SET ZTDSELS = &STR(0000) END /****** EDIT A DBCHANGE ******/ WHEN (E) DO ISPEXEC EDIT DATASET('&STRATDSN') SELECT (&LASTCC) WHEN (0 | 4) DO SET ZEDSMSG = SET ZEDLMSG = &STR("&STRATDSN" EDITED) ISPEXEC SETMSG MSG(UTLZ000) END WHEN (14) DO SET ZEDSMSG = SET ZEDLMSG = &STR("&STRATDSN" IS IN USE. + IT CANNOT BE EDITED.) ISPEXEC SETMSG MSG(UTLZ001) GOTO BROWSE END OTHERWISE DO SET ZEDSMSG = SET ZEDLMSG = &STR(UNABLE TO EDIT + "&STRATDSN".) ISPEXEC SETMSG MSG(UTLZ001) GOTO BROWSE END END END /****** SHOW DATASET INFORMATION ******/ WHEN (I) DO SET DSN = &STR(&STRATDSN) ISPEXEC VPUT DSN SHARED %INFODSN END /****** PRINT A DBCHANGE ******/ WHEN (P) DO SET PDSN = &STR(&STRATDSN) %PRINTIT PDSN(&PDSN(&STRATDSN)) END OTHERWISE DO LINE_COMMANDS: ISPEXEC TBEND DBCHCMDS ISPEXEC TBCREATE DBCHCMDS NOWRITE REPLACE + KEYS() NAMES(DCCMD DCCMDDES) SET DCCMD = &STR(B) /*** BROWSE COMMAND ***/ SET DCCMDDES = + &STR(BROWSE THE STRATEGY DATASET. NOTE: "S" IS AN ALIAS) ISPEXEC TBADD DBCHCMDS SET DCCMD = SET DCCMDDES = + &STR(FOR THIS COMMAND. ) ISPEXEC TBADD DBCHCMDS SET DCCMD = &STR(D) /*** DELETE COMMAND ***/ SET DCCMDDES = + &STR(DELETE A DBCHANGE TABLE ROW) ISPEXEC TBADD DBCHCMDS SET DCCMD = &STR(E) /*** EDIT COMMAND ***/ SET DCCMDDES = + &STR(EDIT THE STRATEGY DATASET) ISPEXEC TBADD DBCHCMDS SET DCCMD = &STR(I) /*** INFORMATION COMMAND ***/ SET DCCMDDES = + &STR(SHOW SYSTEM DATASET INFORMATION ABOUT THE DATASET AND ) ISPEXEC TBADD DBCHCMDS SET DCCMD = SET DCCMDDES = + &STR(MEMBER WHICH CONTAIN THE STRATEGY. ) ISPEXEC TBADD DBCHCMDS SET DCCMD = &STR(P) /*** PRINT COMMAND ***/ SET DCCMDDES = + &STR(PRINT THE STRATEGY. THIS CALLS THE "PRINTIT" UTILITY ) ISPEXEC TBADD DBCHCMDS SET DCCMD = SET DCCMDDES = + &STR(AND PASSES THE NAME OF THE DATASET CONTAINING THE ) ISPEXEC TBADD DBCHCMDS SET DCCMDDES = + &STR(STRATEGY. YOU MAY SELECT WHERE/HOW TO PRINT THE ) ISPEXEC TBADD DBCHCMDS SET DCCMDDES = + &STR(STRATEGY WITH THE "PRINTIT" UTILITY. ) ISPEXEC TBADD DBCHCMDS ISPEXEC TBTOP DBCHCMDS SET ZWINTTL = &STR(VALID LINE COMMANDS...PF3 TO + RETURN...PF7/8 TO SCROLL) SET ZTDMARK = &STR(*** END OF VALID LINE COMMANDS ***) /* ISPEXEC ADDPOP ROW(6) COLUMN(8) ISPEXEC CONTROL DISPLAY SAVE /* FIXPOP */ LINE_CMDLOOP: ISPEXEC TBDISPL DBCHCMDS PANEL(DBCHCMDS) IF &LASTCC = 0 THEN GOTO LINE_CMDLOOP /* ISPEXEC REMPOP ISPEXEC CONTROL DISPLAY RESTORE /* FIXPOP */ END END LINE_LOOP: IF &ZTDSELS > &STR(0001) THEN + DO ISPEXEC CONTROL DISPLAY RESTORE ISPEXEC TBDISPL DBCHANGE ISPEXEC CONTROL DISPLAY SAVE END ELSE + DO SET ZTDSELS = &STR(0000) ISPEXEC CONTROL DISPLAY RESTORE IF &STR(&ZCMD) > THEN GOTO SCROLL END END END /***************************************/ /* PROCESS USERS PENDING 'END' COMMAND */ /***************************************/ IF &PANELCC = 8 THEN GOTO FINISH /************************************************/ /* GOTO THE PROPER SECTION BASED ON THE COMMAND */ /************************************************/ IF &STR(&SYSNSUB(1,&ZCMD)) = THEN GOTO SCROLL SET SYSDVAL = &STR(&SYSNSUB(1,&ZCMD)) READDVAL ZCMD OPT1 OPT2 OPT3 OPT4 OPT5 OPT6 OPT7 OPT8 OPT9 OPT10 SELECT (&ZCMD) /********************************************************************** /* PROCESS DEBUG COMMAND * /********************************************************************** WHEN (DEBUG) DO ISPEXEC SELECT CMD(%SETDEBUG) ISPEXEC VGET DBGSWTCH PROFILE IF &DBGSWTCH = ON THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS END /********************************************************************** /* PROCESS FIND AND REPEAT FIND COMMANDS * /********************************************************************** WHEN (F | FI | FIN | FIND | RF | RFI | RFIN | RFIND) DO IF &STR(&OPT1) = AND &SUBSTR(1:1,&STR(&ZCMD)) = &STR(F) THEN + DO SET ZEDSMSG = SET ZEDLMSG = &STR(AN ARGUMENT STRING IS REQUIRED FOR + THE "FIND" COMMAND + (E.G. FIND XXXXXXXX)) ISPEXEC SETMSG MSG(UTLZ001) GOTO SCROLL END IF &STR(&OPT2) > AND &SUBSTR(1:1,&STR(&ZCMD)) = &STR(F) THEN + DO SET ZEDSMSG = SET ZEDLMSG = &STR(ONLY 1 ARGUMENT STRING IS ALLOWED + FOR THE "FIND" COMMAND + (E.G. FIND XXXXXXXX)) ISPEXEC SETMSG MSG(UTLZ001) GOTO SCROLL END IF &SUBSTR(1:1,&STR(&ZCMD)) = &STR(F) THEN + SET FIND = &STR(&SYSCAPS(&SYSNSUB(1,&OPT1))) ISPEXEC TBSKIP DBCHANGE SET SKIPCC = &LASTCC DO WHILE &SKIPCC = 0 IF &SYSINDEX(&STR(&SYSNSUB(1,&OPT1)),+ &STR(&SYSNSUB(1,&STRATEGY))) > 0 OR + &SYSINDEX(&STR(&SYSNSUB(1,&OPT1)),+ &STR(&SYSNSUB(1,&STRATDSN))) > 0 OR + &SYSINDEX(&STR(&SYSNSUB(1,&OPT1)),+ &STR(&SYSNSUB(1,&STRATDES))) > 0 OR + &SYSINDEX(&STR(&SYSNUSB(1,&OPT1)),+ &STR(&SYSNSUB(1,&STRATSEQ))) > 0 OR + &SYSINDEX(&STR(&SYSNUSB(1,&OPT1)),+ &STR(&SYSNSUB(1,&IMPLDATE))) > 0 OR + &SYSINDEX(&STR(&SYSNSUB(1,&OPT1)),+ &STR(&SYSNSUB(1,&DB2SSID))) > 0 OR + &SYSINDEX(&STR(&SYSNSUB(1,&OPT1)),+ &STR(&SYSNSUB(1,&LUDATE))) > 0 OR + &SYSINDEX(&STR(&SYSNSUB(1,&OPT1)),+ &STR(&SYSNSUB(1,&LUTIME))) > 0 OR + &SYSINDEX(&STR(&SYSNSUB(1,&OPT1)),+ &STR(&SYSNSUB(1,&LUID))) > 0 THEN + SET SKIPCC = 12 ELSE + DO ISPEXEC TBSKIP DBCHANGE SET SKIPCC = &LASTCC END END IF &SKIPCC = 12 THEN + DO SET ZEDSMSG = &STR(STRING FOUND) SET ZEDLMSG = &STR(STRING "&SYSNSUB(1,&OPT1)" WAS + FOUND ON 1ST DISPLAYED ROW) ISPEXEC SETMSG MSG(UTLZ000) END IF &SKIPCC = 8 THEN + DO SET ZEDSMSG = &STR(STRING NOT FOUND) SET ZEDLMSG = &STR(STRING "&SYSNSUB(1,&OPT1)" WAS + NOT FOUND ON ANY ROW) ISPEXEC SETMSG MSG(UTLZ001) END END /********************************************************************** /* PROCESS LOCATE COMMAND * /********************************************************************** WHEN (L | LO | LOC | LOCA | LOCAT | LOCATE) DO IF &STR(&OPT1) = THEN + DO SET ZEDSMSG = SET ZEDLMSG = &STR(AN ARGUMENT STRING IS REQUIRED FOR + THE "LOCATE" COMMAND + (E.G. LOCATE XXXXXXXX)) ISPEXEC SETMSG MSG(UTLZ001) GOTO SCROLL END IF &STR(&OPT2) > THEN + DO SET ZEDSMSG = SET ZEDLMSG = &STR(ONLY 1 ARGUMENT STRING IS ALLOWED + FOR THE "LOCATE" COMMAND + (E.G. LOCATE XXXXXXXX)) ISPEXEC SETMSG MSG(UTLZ001) GOTO SCROLL END ISPEXEC TBTOP DBCHANGE SET OPT1 = &STR(&OPT1.*) SELECT (&LASTSORT) WHEN (STRATEGY) DO SET STRATEGY = &STR(&OPT1) SET COND = GE END WHEN (STRATDSN) DO SET STRATDSN = &STR(&OPT1) SET COND = GE END WHEN (STRATDES) DO SET STRATDES = &STR(&OPT1) SET COND = GE END WHEN (IMPLDATE) DO SET IMPLDATE = &STR(&OPT1) SET COND = LE END WHEN (DB2SSID) DO SET DB2SSID = &STR(&OPT1) SET COND = GE END WHEN (STRATSEQ) DO SET STRATSEQ = &STR(&OPT1) SET COND = GE END WHEN (LUDATE) DO SET LUDATE = &STR(&OPT1) SET COND = LE END WHEN (LUTIME) DO SET LUTIME = &STR(&OPT1) SET COND = LE END WHEN (LUID) DO SET LUID = &STR(&OPT1) SET COND = GE END OTHERWISE DO SET ZEDSMSG = SET ZEDLMSG = &STR(INTERNAL ERROR IN DBCHANGE CLIST + PROCESSING LOCATE COMMAND) ISPEXEC SETMSG MSG(UTLZ001W) GOTO SCROLL END END ISPEXEC TBSCAN DBCHANGE ARGLIST(&LASTSORT) + CONDLIST(&COND) NOREAD GOTO SCROLL END /********************************************************************** /* PROCESS REFRESH COMMAND * /********************************************************************** WHEN (R | RE | REF | REFR | REFRE | REFRES | REFRESH) DO SET ZEDSMSG = SET ZEDLMSG = &STR(*** PREPARING TO EXTRACT FROM DB2 ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) FREE DD(SYSREC00 SYSIN SYSPRINT SYSPUNCH) IF &DBGSWTCH = ON THEN + DO ALLOC DD(SYSPRINT) DA(*) ALLOC DD(SYSPUNCH) DA(*) END ELSE + DO ALLOC DD(SYSPRINT) DUMMY ALLOC DD(SYSPUNCH) DUMMY END DELETE '&DB2FILE' ALLOC DD(SYSREC00) DSN('&DB2FILE') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK005) + SPACE(1,1) CYLINDER RELEASE DSORG(PS) ALLOC DD(SYSIN) + NEW + UNIT(SYSDA) VOLUME(WRK005) + SPACE(1,1) TRACKS RELEASE + RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS) OPENFILE SYSIN OUTPUT SET SYSIN = &STR(SYSADM2.PLAT_STRAT) PUTFILE SYSIN CLOSFILE SYSIN SET ZEDLMSG = &STR(*** EXTRACTING STRATEGIES FROM DB2 ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) CONTROL END(END@) DSN SYSTEM(DSNT) RUN PROGRAM(DSNTIAUL) PLAN(DSNTIB23) - LIB('SYS4.DSN.DSNT.RUNLIB.LOAD') END CONTROL END(END) SET ZEDLMSG = &STR(*** LOADING STRATEGIES INTO THE ISPF TABLE + ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) FREE DD(SYSIN SYSPRINT SYSPUNCH) ISPEXEC TBEND DBCHANGE ISPEXEC LIBDEF ISPTABL DATASET ID('&DBCHPFX..ISPTLIB') ISPEXEC TBOPEN DBCHANGE WRITE SET OPENCC = &LASTCC DO &I = 1 TO 30 WHILE &OPENCC ¬= 0 ISPEXEC TBSTATS DBCHANGE STATUS2(TABSTAT) IF &STR(&TABSTAT) = 1 THEN SET OPENCC = 0 ELSE + DO ISPEXEC TBOPEN DBCHANGE NOWRITE SHARE SET OPENCC = &LASTCC END END IF &OPENCC > 0 THEN + DO SET ZEDSMSG = &STR(OPEN FAILED) SET ZEDLMSG = &STR(ISPF TABLE OPEN FAILED WITH RC = + &OPENCC. PLEASE TRY AGAIN) ISPEXEC SETMSG MSG(UTLZ001W) GOTO SCROLL END ERROR DO SET ERRCC = &LASTCC SELECT (&ERRCC) WHEN (8) DO SET ADDED = &ADDED - 1 RETURN END WHEN (336) RETURN /* FILE ALREADY OPEN */ WHEN (400) DO SET EOF = YES RETURN END OTHERWISE DO ERROR OFF SET ZEDSMSG = SET ZEDLMSG = &STR(*** CLIST RETURN CODE: &ERRCC + WHILE PROCESSING RECORD #&REC + FROM THE EXTRACT FILE ***) ISPEXEC SETMSG MSG(UTLZ001W) CLOSFILE SYSREC00 FREE DD(SYSREC00) GOTO SCROLL END END END SET REC = 0 SET ADDED = 0 SET IMPLDATE = SET DB2SSID = SET STRATSEQ = SET SWITCH = OFF SET EOF = NO OPENFILE SYSREC00 GETFILE SYSREC00 DO WHILE &EOF = NO SET REC = &REC + 1 SET STRATEGY = + &SUBSTR(001:008,&STR(&SYSNSUB(1,&SYSREC00))) SET STRATDSN = + &SUBSTR(009:052,&STR(&SYSNSUB(1,&SYSREC00))) SET MEMBER = + &SUBSTR(053:060,&STR(&SYSNSUB(1,&SYSREC00))) SET MEMBER = &MEMBER SET X = &SYSINDEX(&STR( ),&STR(&STRATDSN)) IF &X > 1 THEN + SET STRATDSN = + &SUBSTR(1:&X-1,&STR(&STRATDSN))&STR((&MEMBER)) SET STRATDES = + &SUBSTR(061:085,&STR(&SYSNSUB(1,&SYSREC00))) SET LUID = + &SUBSTR(086:093,&STR(&SYSNSUB(1,&SYSREC00))) SET LUDATE = + &SUBSTR(096:105,&STR(&SYSNSUB(1,&SYSREC00))) SET LUTIME = + &SUBSTR(108:115,&STR(&SYSNSUB(1,&SYSREC00))) SET ADDED = &ADDED + 1 ISPEXEC TBADD DBCHANGE GETFILE SYSREC00 END ERROR OFF CLOSFILE SYSREC00 FREE DD(SYSREC00) ISPEXEC TBCLOSE DBCHANGE ISPEXEC TBOPEN DBCHANGE NOWRITE SHARE ISPEXEC TBSORT DBCHANGE + FIELDS(LUDATE,C,D,LUTIME,C,D,STRATEGY,C,A) SET ZEDSMSG = &STR(&ADDED ADDED) SET ZEDLMSG = &STR(*** &ADDED ROWS ADDED TO THE ISPF TABLE + FROM DB2 ***) ISPEXEC SETMSG MSG(UTLZ000) END /********************************************************************** /* PROCESS SORT COMMAND * /********************************************************************** WHEN (S | SO | SOR | SORT | O | OR | ORD | ORDE | ORDER) DO SET SFIELD = IF &STR(&SYSNSUB(1,&OPT1)) = THEN + DO SET ZEDSMSG = SET ZEDLMSG = &STR(TABLE SORTED IN DEFAULT ORDER: + BY LUDATE/D, LUTIME/D, STRATEGY/A) ISPEXEC SETMSG MSG(UTLZ000) SET SFIELD = &STR(,LUDATE,C,D,LUTIME,C,D,STRATEGY,C,A) SET LASTSORT = STRATDSN END ELSE + DO &I = 1 TO 6 SET X = &&OPT&I IF &X = THEN GOTO SORT_CONTINUE SELECT (&SYSCAPS(&X)) WHEN (STRATEGY) SET SFIELD = + &STR(&SFIELD,STRATEGY,C,A) WHEN (DATASET) SET SFIELD = + &STR(&SFIELD,STRATDSN,C,A) WHEN (DESC) SET SFIELD = + &STR(&SFIELD,STRATDES,C,A) WHEN (SEQ) SET SFIELD = + &STR(&SFIELD,STRATSEQ,C,A) WHEN (IMPLEMENT) SET SFIELD = + &STR(&SFIELD,IMPLDATE,C,D) WHEN (SSID) SET SFIELD = + &STR(&SFIELD,DB2SSID,C,A) WHEN (DATE) SET SFIELD = + &STR(&SFIELD,LUDATE,C,D) WHEN (TIME) SET SFIELD = + &STR(&SFIELD,LUTIME,C,D) WHEN (USER) SET SFIELD = + &STR(&SFIELD,LUID,C,A) OTHERWISE DO SET ZEDSMSG = SET ZEDLMSG = &STR(VALID FIELDS: + ******** STRATEGY, DATASET, DESC, IMPLEMENT + SSID, SEQ, USER, DATE, TIME) ISPEXEC SETMSG MSG(UTLZ001) GOTO SCROLL END END END SORT_CONTINUE: + SET A = &LENGTH(&STR(&SFIELD)) SET SFIELD = &SUBSTR(2:&A,&STR(&SFIELD)) ISPEXEC TBSORT DBCHANGE FIELDS(&STR(&SFIELD)) SET A = &SYSINDEX(&STR(,C,A),&STR(&SFIELD)) SET B = &SYSINDEX(&STR(,C,D),&STR(&SFIELD)) IF (&A < &B AND &A > 0) OR + (&B = 0) THEN + DO SET A = &A - 1 SET LASTSORT = &SUBSTR(1:&A,&STR(&SYSNSUB(1,&SFIELD))) END ELSE + DO SET B = &B - 1 SET LASTSORT = &SUBSTR(1:&B,&STR(&SYSNSUB(1,&SFIELD))) END END OTHERWISE DO PRIM_COMMANDS: + ISPEXEC TBEND DBCHCMDS ISPEXEC TBCREATE DBCHCMDS NOWRITE REPLACE KEYS() + NAMES(DCCMD DCCMDDES) SET DCCMD = &STR(DEBUG ) /**********************************/ SET DCCMDDES = + &STR(ALIASES: ) ISPEXEC TBADD DBCHCMDS SET DCCMD = SET DCCMDDES = + &STR(PARAMETERS: ) ISPEXEC TBADD DBCHCMDS SET DCCMDDES = + &STR(FUNCTION: THIS COMMAND "TOGGLES" CLIST DEBUGGING ON AND ) ISPEXEC TBADD DBCHCMDS SET DCCMDDES = + &STR( OFF FROM WITHIN THE EXECUTION OF THE DBCHANGE ) ISPEXEC TBADD DBCHCMDS SET DCCMDDES = + &STR( FACILITY. IF THE DEBUG SWITCH IS OFF, IT WILL ) ISPEXEC TBADD DBCHCMDS SET DCCMDDES = + &STR( TURN IT ON AND MESSAGES WILL BEGIN DISPLAYING. ) ISPEXEC TBADD DBCHCMDS SET DCCMDDES = + &STR( IF THE SWITCH IS ON, IT WILL TURN IT OFF, AND ) ISPEXEC TBADD DBCHCMDS SET DCCMDDES = + &STR( MESSAGES WILL STOP DISPLAYING. ) ISPEXEC TBADD DBCHCMDS SET DCCMD = &STR(FIND ) /***********************************/ SET DCCMDDES = + &STR(ALIASES: "F" "FI" "FIN" ) ISPEXEC TBADD DBCHCMDS SET DCCMD = SET DCCMDDES = + &STR(PARAMETERS: (REQUIRED) ) ISPEXEC TBADD DBCHCMDS SET DCCMDDES = + &STR( SEARCH STRINGS WITH EMBEDDED SPACES SHOULD BE ) ISPEXEC TBADD DBCHCMDS SET DCCMDDES = + &STR( ENCLOSED WITH SINGLE QUOTES. ) ISPEXEC TBADD DBCHCMDS SET DCCMDDES = + &STR(FUNCTION: THIS COMMAND POSITIONS THE DISPLAY AT THE NEXT ) ISPEXEC TBADD DBCHCMDS SET DCCMDDES = + &STR( ROW IN WHICH ANY TABLE FIELD CONTAINS THE ) ISPEXEC TBADD DBCHCMDS SET DCCMDDES = + &STR( STRING PASSED BY THE USER. THE STRING IS KEPT ) ISPEXEC TBADD DBCHCMDS SET DCCMDDES = + &STR( IN A VARIABLE FOR USE WITH THE RFIND COMMAND. ) ISPEXEC TBADD DBCHCMDS SET DCCMDDES = + &STR( SEARCHES ARE FORWARD ONLY, FROM THE TOP ROW IN ) ISPEXEC TBADD DBCHCMDS SET DCCMDDES = + &STR( THE CURRENT DISPLAY. YOU MUST POSITION THE ) ISPEXEC TBADD DBCHCMDS SET DCCMDDES = + &STR( DISPLAY TO THE BEGINNING TO SEARCH THE ENTIRE ) ISPEXEC TBADD DBCHCMDS SET DCCMDDES = + &STR( TABLE. ) ISPEXEC TBADD DBCHCMDS SET DCCMD = &STR(LOCATE ) /***********************************/ SET DCCMDDES = + &STR(ALIASES: "L" "LO" "LOC" "LOCA" "LOCAT" ) ISPEXEC TBADD DBCHCMDS SET DCCMD = SET DCCMDDES = + &STR(PARAMETERS: A STRING TO LOCATE ) ISPEXEC TBADD DBCHCMDS SET DCCMDDES = + &STR(FUNCTIONS: LOCATE (AND POSITION THE TABLE DISPLAY) ON THE ) ISPEXEC TBADD DBCHCMDS SET DCCMDDES = + &STR( THE FIRST TABLE ROW IN WHICH THE PRIMARY SORT ) ISPEXEC TBADD DBCHCMDS SET DCCMDDES = + &STR( KEY OF THAT ROW IS EQUAL TO OR GREATER THAN THE) ISPEXEC TBADD DBCHCMDS SET DCCMDDES = + &STR( STRING WHICH WAS PASSED WITH THE COMMAND. THIS) ISPEXEC TBADD DBCHCMDS SET DCCMDDES = + &STR( WORKS ESSENTIALLY LIKE THE "L" COMMAND ON A PDS) ISPEXEC TBADD DBCHCMDS SET DCCMDDES = + &STR( MEMBER LIST. ) ISPEXEC TBADD DBCHCMDS SET DCCMD = &STR(REFRESH ) /***********************************/ SET DCCMDDES = + &STR(ALIASES: "R" "RE" "REF" "REFR" "REFRE" "REFRES" ) ISPEXEC TBADD DBCHCMDS SET DCCMD = SET DCCMDDES = + &STR(PARAMETERS: ) ISPEXEC TBADD DBCHCMDS SET DCCMDDES = + &STR(FUNCTIONS: COPY ANY ROWS FROM THE PLATINUM DB2 STRATEGY ) ISPEXEC TBADD DBCHCMDS SET DCCMDDES = + &STR( TABLE "PTI.PTMG2_STRAT_0200" WHICH ARE NOT ) ISPEXEC TBADD DBCHCMDS SET DCCMDDES = + &STR( ALREADY IN THE ISPF TABLE INTO THE DBCHANGE ) ISPEXEC TBADD DBCHCMDS SET DCCMDDES = + &STR( ISPF TABLE. ) ISPEXEC TBADD DBCHCMDS SET DCCMD = &STR(SORT ) /***********************************/ SET DCCMDDES = + &STR(ALIASES: "S" "SO" "SOR" "O" "OR" "ORD" "ORDE" "ORDER" ) ISPEXEC TBADD DBCHCMDS SET DCCMD = SET DCCMDDES = + &STR(PARAMETERS: VALID DBCHANGE TABLE COLUMN NAME(S) ) ISPEXEC TBADD DBCHCMDS SET DCCMDDES = + &STR( THE VALID NAMES YOU MAY SPECIFY ARE: STRATEGY,) ISPEXEC TBADD DBCHCMDS SET DCCMDDES = + &STR( DATASET, DESC, IMPLEMENT, SSID, SEQ, USER, ) ISPEXEC TBADD DBCHCMDS SET DCCMDDES = + &STR( DATE AND TIME. IMPLEMENT &LP.THE ) ISPEXEC TBADD DBCHCMDS SET DCCMDDES = + &STR( IMPLEMENTATION DATE&RP, DATE AND TIME ARE ) ISPEXEC TBADD DBCHCMDS SET DCCMDDES = + &STR( SORTED IN DESCENDING SEQUENCE. ALL OTHER ) ISPEXEC TBADD DBCHCMDS SET DCCMDDES = + &STR( FIELDS ARE SORTED IN ASCENDING SEQUENCE. ) ISPEXEC TBADD DBCHCMDS SET DCCMDDES = + &STR(FUNCTIONS: SORT THE TABLE DISPLAY IN A SPECIFIC ORDER, AND) ISPEXEC TBADD DBCHCMDS SET DCCMDDES = + &STR( SET THE "PRIMARY SORT KEY" VARIABLE WHICH IS ) ISPEXEC TBADD DBCHCMDS SET DCCMDDES = + &STR( USED BY THE "LOCATE" COMMAND. ) ISPEXEC TBADD DBCHCMDS SET DCCMDDES = + &STR( YOU MAY SPECIFY MORE THAN 1 FIELD. IF YOU ) ISPEXEC TBADD DBCHCMDS SET DCCMDDES = + &STR( SPECIFY NO FIELDS, THE TABLE WILL BE SORTED IN ) ISPEXEC TBADD DBCHCMDS SET DCCMDDES = + &STR( DEFAULT ORDER (I.E. LUDATE, LUTIME, STRATEGY) ) ISPEXEC TBADD DBCHCMDS ISPEXEC TBTOP DBCHCMDS SET ZWINTTL = &STR(VALID PRIMARY COMMANDS...PF3 TO RETURN...+ PF7/8 TO SCROLL) SET ZTDMARK = &STR(*** END OF VALID PRIMARY COMMANDS ***) /* ISPEXEC ADDPOP ROW(3) COLUMN(8) ISPEXEC CONTROL DISPLAY SAVE /* FIXPOP */ PRIM_CMDLOOP: + ISPEXEC TBDISPL DBCHCMDS PANEL(DBCHCMDS) IF &LASTCC = 0 THEN GOTO PRIM_CMDLOOP /* ISPEXEC REMPOP ISPEXEC CONTROL DISPLAY RESTORE /* FIXPOP */ END END /*****************************/ /* MAINTAIN THE TOP OF TABLE */ /*****************************/ SCROLL: + IF &STR(&ZCMD) = THEN + DO ISPEXEC TBTOP DBCHANGE ISPEXEC TBSKIP DBCHANGE NUMBER(&ZTDTOP) ISPEXEC VGET (ZVERB ZSCROLLN) IF &ZVERB = &STR(UP) THEN + ISPEXEC TBSKIP DBCHANGE NUMBER(-&ZSCROLLN) IF &ZVERB = &STR(DOWN) THEN + ISPEXEC TBSKIP DBCHANGE NUMBER(&ZSCROLLN) END GOTO PROCLIST /********************************************************************** /* SORT THE TABLE IN "SEQ" # WITHIN DATE TO INSURE PROPER PROCESSING * /********************************************************************** FINISH: + ISPEXEC TBEND DBCHANGE ISPEXEC LIBDEF ISPTABL DATASET ID('&DBCHPFX..ISPTLIB') ISPEXEC TBOPEN DBCHANGE WRITE ISPEXEC TBSORT DBCHANGE FIELDS(IMPLDATE,C,A,STRATSEQ,C,A) ISPEXEC TBCLOSE DBCHANGE ISPEXEC LIBDEF ISPTABL ISPEXEC LIBDEF ISPTLIB EXIT ./ ADD NAME=DBECHCK1 PROC 0 DEBUG /*** CHECK THE DEBUG SWITCH ***/ IF &DEBUG = DEBUG THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS /********************************************************************** /* FIND WHAT DEC JOBS EXIST CURRENTLY * /********************************************************************** SET LP = &STR(( SET RP = &STR()) SET SYSOUTTRAP = 1000 CONTROL MSG STATUS D@UDALDE CONTROL NOMSG SET SYSOUTTRAP = 0 IF &SYSINDEX(&STR( WAITING FOR EXECUTION),+ &STR(&SYSNSUB(2,&&SYSOUTLINE&SYSOUTLINE))) > 0 THEN EXIT CONTROL NOMSG SUBMIT 'D@UDAL.STR.JCLLIB(DBECHECK)' EXIT ./ ADD NAME=DBECHECK /* REXX ***************************************************************/ /* UTILITY: DBECHECK */ /* AUTHOR: DAVID LEIGH */ /* FUNCTION: THIS REXX PROGRAM PARSES A DMS REPORT LOOKING FOR THE */ /* DB/EXPLAIN VSAM DATASETS. IF FOUND IT INTERROGATES THE */ /* LINE TO DETERMINE IF THE FILE IS IN EXTENTS. IF SO, IT */ /* SENDS A MESSAGE ON HOW TO RESIZE THE FILE. */ /**********************************************************************/ TRACE I "EXECIO * DISKR INPUTDD (FINIS STEM RECIN." "NEWSTACK" DO I = 1 TO RECIN.0 IF POS('KSDS',RECIN.I) = 47 THEN DO PARSE VAR RECIN.I DATASET TYPE VOLUME TRKALLOC PCTUSED MSGS IF PCTUSED > 95 | MSGS > '' THEN DO PARSE VAR TRKALLOC PART1 ',' PART2 ',' PART3 TRKALLOC = PART1 || PART2 || PART3 DATASET = STRIP(DATASET,L,' ') DATASET = STRIP(DATASET,L,'0') PRIMARY = TRKALLOC % 15 + 1 SECONDARY = PRIMARY % 2 QUEUE "SEND '*** MESSAGES FROM DBECHECK JOB ***'", "USER(D@UDAL) LOGON" QUEUE "SEND 'RESIZE" DATASET "WITH", PRIMARY || "," || SECONDARY "CYLS'", "U(D@UDAL) LOGON" QUEUE "SEND '*** MESSAGES FROM DBECHECK JOB ***'", "USER(D@UDAL) LOGON" END END END QUEUE 'END' "EXECIO" QUEUED() "DISKW OUTPUTDD (FINIS" ./ ADD NAME=DBSETED1 /* REXX ***************************************************************/ /* MACRO: DBSETED1 */ /* AUTHOR: DAVID LEIGH */ /* FUCNTION: THIS IS AN INITIAL EDIT MACRO THAT IS CALLED IN BATCH BY */ /* THE DB2 PERSONAL DATABASE SETUP PROCESS "DBSETUP". IT */ /* "MASSAGES" A DB2 DDL FILE TO CHANGE THINGS LIKE CREATOR */ /* IDS AND DATABASE NAMES, ETC. FROM A SOURCE TO A TARGET */ /* ENVIRONMENT. IT GETS THESE VALUES FROM AN INPUT FILE. */ /* IT ALSO READS A FILE THAT CONTAINS A NUMBER THAT IS USED */ /* TO CHANGE THE PRIMARY AND SECONDARY QUANTITY BY THAT */ /* PERCENTAGE SPECIFIED BY THE NUMBER. */ /* */ /* IT GETS RID OF ALL SYNONYM CREATION LINES AND GETS RID */ /* OF ALL VIEWS THAT HAVE CREATORS OTHER THAN "USSTRP00". */ /* THERE IS A COMPANION EDIT MACRO THAT GETS RID OF ALL THE */ /* VIEWS WITH CREATORS OTHER THAN "UFSTRP00". */ /**********************************************************************/ ADDRESS ISPEXEC 'CONTROL ERRORS RETURN' ADDRESS ISREDIT "MACRO" /**********************************************************************/ /* THIS SECTION LOOPS THROUGH THE VIEW SECTION OF THE IMPACT ANALYSIS */ /* REPORT TO GET RID OF VIEWS WITH CREATORS OTHER THAN USSTRP00. */ /**********************************************************************/ "FIND '-- OBJECT TYPE: VIEW' 1 FIRST" "FIND 'OBJECT NAME/CREATOR' NEXT" "FIND NEXT P'¬' 1" "LABEL .ZCSR = .VIEWS" "FIND NEXT 'OBJECT TYPE: ' 1" IF RC = 0 THEN "LABEL .ZCSR = .ENDVW" ELSE "LABEL .ZLAST = .ENDVW" "FIND FIRST P'¬' 9 .VIEWS .ENDVW" DO WHILE RC = 0 "LABEL .ZCSR = .CURR" "(LINE) = LINE .ZCSR" PARSE UPPER VAR LINE COMMENT VIEWNAME CREATOR NULL IF CREATOR ¬= 'USSTRP00' THEN DO VIEW = CREATOR ³³ '.' ³³ VIEWNAME "FIND FIRST '"VIEW" WILL BE CREATED'" "LABEL .ZCSR = .A" "FIND NEXT '.SYNC' 1" "LABEL .ZCSR = .B" "DELETE .A .B" END "FIND LAST P'=' .CURR .CURR" "FIND NEXT P'¬' 9 .VIEWS .ENDVW" END /**********************************************************************/ /* THIS SECTION GETS RID OF ALL "CREATE SYNONYM" CODE. */ /**********************************************************************/ "FIND FIRST ' CREATE SYNONYM'" DO WHILE RC = 0 "FIND PREV 'SET CURRENT SQLID'" "LABEL .ZCSR = .A" "FIND NEXT '.SYNC' 1" "LABEL .ZCSR = .B" "DELETE .A .B" "FIND NEXT ' CREATE SYNONYM'" END /**********************************************************************/ /* READ THE INPUT FILES TO DO THE CHANGES */ /**********************************************************************/ ADDRESS TSO "EXECIO * DISKR SWITCH (STEM SWITCH. FINIS)" ADDRESS TSO "EXECIO 1 DISKR PERCENT (STEM PERCENT. FINIS)" PCT = STRIP(PERCENT.1) / 100 SAY PCT DO I = 1 TO SWITCH.0 PARSE UPPER VAR SWITCH.I FROM TO NULL FROM = TRANSLATE(FROM,' ','\') TO = TRANSLATE(TO,' ','\') "CHANGE ALL '"FROM"' '"TO"'" END "FIND FIRST 'QTY '" DO WHILE RC = 0 "(LINE) = LINE .ZCSR" PARSE UPPER VAR LINE NULL1 AMOUNT NULL2 AMOUNT2 = AMOUNT * PCT X = POS('.',AMOUNT2) RND = SUBSTR(AMOUNT2,X+1,1) IF RND > 4 THEN RND = 1 ELSE RND = 0 IF X = 0 THEN X = LENGTH(AMOUNT2) + 1 AMOUNT2 = SUBSTR(AMOUNT2,1,X-1) AMOUNT2 = AMOUNT2 + RND IF AMOUNT2 < 12 THEN AMOUNT2 = 12 "CHANGE '"AMOUNT"' '"AMOUNT2"'" "FIND NEXT 'QTY '" END /**********************************************************************/ /* QUEUE UP ALL THE TABLESPACES, TABLES, VIEWS THAT ARE BEING CREATED */ /* AND THEN WRITE THEM OUT TO THE DROPOBJ DD. */ /**********************************************************************/ "FIND '-- OBJECT TYPE: TABLESPACE' 1 FIRST" IF RC = 0 THEN DO OBJTYPE = 3 "LABEL .ZCSR = .A" "FIND '-- OBJECT TYPE: ' 1 NEXT" IF RC = 0 THEN DO B = .B "LABEL .ZCSR = .B" END ELSE B = .ZLAST "EXCLUDE ALL P'=' 1" "FIND FIRST P'¬¬ ¬======= ¬======= ' 1 .A" B DO WHILE RC= 0 "(LINE) = LINE .ZCSR" PARSE UPPER VAR LINE NULL OBJNAME OBJQUAL OBJQUAL = STRIP(OBJQUAL) OBJNAME = SUBSTR(OBJNAME' ',1,18) OBJQUAL = SUBSTR(OBJQUAL' ',1,8) LINE = OBJTYPE ³³ OBJQUAL ³³ OBJNAME QUEUE LINE "FIND NEXT P'¬¬ ¬======= ¬======= ' 1 .A" B END END "FIND '-- OBJECT TYPE: TABLE ' 1 FIRST" IF RC = 0 THEN DO OBJTYPE = 2 "LABEL .ZCSR = .A" "FIND '-- OBJECT TYPE: ' 1 NEXT" IF RC = 0 THEN DO B = .B "LABEL .ZCSR = .B" END ELSE B = .ZLAST "EXCLUDE ALL P'=' 1" "FIND FIRST P'¬¬ ¬================= ¬======= ' 1 .A" B DO WHILE RC= 0 "(LINE) = LINE .ZCSR" PARSE UPPER VAR LINE NULL OBJNAME OBJQUAL OBJQUAL = STRIP(OBJQUAL) OBJNAME = SUBSTR(OBJNAME' ',1,18) OBJQUAL = SUBSTR(OBJQUAL' ',1,8) LINE = OBJTYPE ³³ OBJQUAL ³³ OBJNAME QUEUE LINE "FIND NEXT P'¬¬ ¬================= ¬======= ' 1 .A" B END END "FIND '-- OBJECT TYPE: VIEW ' 1 FIRST" IF RC = 0 THEN DO OBJTYPE = 1 "LABEL .ZCSR = .A" "FIND '-- OBJECT TYPE: ' 1 NEXT" IF RC = 0 THEN DO B = .B "LABEL .ZCSR = .B" END ELSE B = .ZLAST "EXCLUDE ALL P'=' 1" "FIND FIRST P'¬¬ ¬================= ¬======= ' 1 .A" B DO WHILE RC= 0 "(LINE) = LINE .ZCSR" PARSE UPPER VAR LINE NULL OBJNAME OBJQUAL OBJQUAL = STRIP(OBJQUAL) OBJNAME = SUBSTR(OBJNAME' ',1,18) OBJQUAL = SUBSTR(OBJQUAL' ',1,8) LINE = OBJTYPE ³³ OBJQUAL ³³ OBJNAME QUEUE LINE "FIND NEXT P'¬¬ ¬================= ¬======= ' 1 .A" B END END ADDRESS TSO "EXECIO" QUEUED() "DISKW DROPOBJ (FINIS)" "END" EXIT ./ ADD NAME=DBSETED2 /* REXX ***************************************************************/ /* MACRO: DBSETED2 */ /* AUTHOR: DAVID LEIGH */ /* FUCNTION: THIS IS AN INITIAL EDIT MACRO THAT IS CALLED IN BATCH BY */ /* THE DB2 PERSONAL DATABASE SETUP PROCESS "DBSETUP". IT */ /* "MASSAGES" A DB2 DDL FILE TO CHANGE THINGS LIKE CREATOR */ /* IDS AND DATABASE NAMES, ETC. FROM A SOURCE TO A TARGET */ /* ENVIRONMENT. IT GETS THESE VALUES FROM AN INPUT FILE. */ /* IT ALSO READS A FILE THAT CONTAINS A NUMBER THAT IS USED */ /* TO CHANGE THE PRIMARY AND SECONDARY QUANTITY BY THAT */ /* PERCENTAGE SPECIFIED BY THE NUMBER. */ /* */ /* IT GETS RID OF ALL SYNONYM CREATION LINES AND GETS RID */ /* OF ALL VIEWS THAT HAVE CREATORS OTHER THAN THE PARM FILE */ /* CREATOR. */ /**********************************************************************/ ADDRESS ISPEXEC 'CONTROL ERRORS RETURN' ADDRESS ISREDIT "MACRO" /**********************************************************************/ /* READ THE INPUT FILES TO GET PARAMETER DATA */ /**********************************************************************/ ADDRESS TSO "EXECIO * DISKR PARMFILE (STEM PARM. FINIS)" ADDRESS TSO "EXECIO * DISKR SWITCH (STEM SWITCH. FINIS)" ADDRESS TSO "EXECIO 1 DISKR PERCENT (STEM PERCENT. FINIS)" /**********************************************************************/ /* LOOP THROUGH THE PARM STEM ARRAY AND SET THE PARM VALUES */ /**********************************************************************/ DO I = 1 TO PARM.0 PARSE UPPER VAR PARM.I VARNAME VARVAL NULL SELECT WHEN VARNAME = 'DATABASE' THEN PARMDB = VARVAL WHEN VARNAME = 'CREATOR' THEN PARMCTR = VARVAL WHEN VARNAME = 'SOURCE' THEN PARMSCTR = VARVAL OTHERWISE END END /**********************************************************************/ /* THIS SECTION LOOPS THROUGH THE VIEW SECTION OF THE IMPACT ANALYSIS */ /* REPORT TO GET RID OF VIEWS WITH CREATORS OTHER THAN THE CREATOR */ /* PASSED IN THE PARM FILE. */ /**********************************************************************/ "FIND '-- OBJECT TYPE: VIEW ' 1 FIRST" "FIND 'OBJECT NAME/CREATOR' NEXT" "FIND NEXT P'¬' 1" "LABEL .ZCSR = .VIEWS" "FIND NEXT 'OBJECT TYPE: ' 1" IF RC = 0 THEN "LABEL .ZCSR = .ENDVW" ELSE "LABEL .ZLAST = .ENDVW" "FIND FIRST P'¬' 9 .VIEWS .ENDVW" DO WHILE RC = 0 "LABEL .ZCSR = .CURR" "(LINE) = LINE .ZCSR" PARSE UPPER VAR LINE COMMENT VIEWNAME CREATOR NULL IF CREATOR ¬= PARMSCTR THEN DO VIEW = CREATOR ³³ '.' ³³ VIEWNAME "FIND FIRST '"VIEW" WILL BE CREATED'" "LABEL .ZCSR = .A" "FIND NEXT '.SYNC' 1" "LABEL .ZCSR = .B" "DELETE .A .B" END "FIND LAST P'=' .CURR .CURR" "FIND NEXT P'¬' 9 .VIEWS .ENDVW" END /**********************************************************************/ /* THIS SECTION GETS RID OF ALL "CREATE SYNONYM" CODE. */ /**********************************************************************/ "FIND FIRST ' CREATE SYNONYM'" DO WHILE RC = 0 "FIND PREV 'SET CURRENT SQLID'" "LABEL .ZCSR = .A" "FIND NEXT '.SYNC' 1" "LABEL .ZCSR = .B" "DELETE .A .B" "FIND NEXT ' CREATE SYNONYM'" END /**********************************************************************/ /* THIS SECTION DOES THE GLOBAL CHANGES */ /**********************************************************************/ DO I = 1 TO SWITCH.0 PARSE UPPER VAR SWITCH.I FROM TO NULL FROM = TRANSLATE(FROM,' ','\') TO = TRANSLATE(TO,' ','\') "CHANGE ALL '"FROM"' '"TO"'" END /**********************************************************************/ /* THIS SECTION DOES THE RE-SIZES */ /**********************************************************************/ PCT = STRIP(PERCENT.1) / 100 SAY PCT "FIND FIRST 'QTY '" DO WHILE RC = 0 "(LINE) = LINE .ZCSR" PARSE UPPER VAR LINE NULL1 AMOUNT NULL2 AMOUNT2 = AMOUNT * PCT X = POS('.',AMOUNT2) RND = SUBSTR(AMOUNT2,X+1,1) IF RND > 4 THEN RND = 1 ELSE RND = 0 IF X = 0 THEN X = LENGTH(AMOUNT2) + 1 AMOUNT2 = SUBSTR(AMOUNT2,1,X-1) AMOUNT2 = AMOUNT2 + RND IF AMOUNT2 < 12 THEN AMOUNT2 = 12 "CHANGE '"AMOUNT"' '"AMOUNT2"'" "FIND NEXT 'QTY '" END /**********************************************************************/ /* QUEUE UP ALL THE TABLESPACES, TABLES, VIEWS THAT ARE BEING CREATED */ /* AND THEN WRITE THEM OUT TO THE DROPOBJ DD. */ /**********************************************************************/ "FIND '-- OBJECT TYPE: TABLESPACE' 1 FIRST" IF RC = 0 THEN DO OBJTYPE = 3 "LABEL .ZCSR = .A" "FIND '-- OBJECT TYPE: ' 1 NEXT" IF RC = 0 THEN DO B = .B "LABEL .ZCSR = .B" END ELSE B = .ZLAST "EXCLUDE ALL P'=' 1" "FIND FIRST P'¬¬ ¬======= ¬======= ' 1 .A" B DO WHILE RC= 0 "(LINE) = LINE .ZCSR" PARSE UPPER VAR LINE NULL OBJNAME OBJQUAL OBJQUAL = STRIP(OBJQUAL) OBJNAME = SUBSTR(OBJNAME' ',1,18) OBJQUAL = SUBSTR(OBJQUAL' ',1,8) LINE = OBJTYPE ³³ OBJQUAL ³³ OBJNAME QUEUE LINE "FIND NEXT P'¬¬ ¬======= ¬======= ' 1 .A" B END END "FIND '-- OBJECT TYPE: TABLE ' 1 FIRST" IF RC = 0 THEN DO OBJTYPE = 2 "LABEL .ZCSR = .A" "FIND '-- OBJECT TYPE: ' 1 NEXT" IF RC = 0 THEN DO B = .B "LABEL .ZCSR = .B" END ELSE B = .ZLAST "EXCLUDE ALL P'=' 1" "FIND FIRST P'¬¬ ¬================= ¬======= ' 1 .A" B DO WHILE RC= 0 "(LINE) = LINE .ZCSR" PARSE UPPER VAR LINE NULL OBJNAME OBJQUAL OBJQUAL = STRIP(OBJQUAL) OBJNAME = SUBSTR(OBJNAME' ',1,18) OBJQUAL = SUBSTR(OBJQUAL' ',1,8) LINE = OBJTYPE ³³ OBJQUAL ³³ OBJNAME QUEUE LINE "FIND NEXT P'¬¬ ¬================= ¬======= ' 1 .A" B END END "FIND '-- OBJECT TYPE: VIEW ' 1 FIRST" IF RC = 0 THEN DO OBJTYPE = 1 "LABEL .ZCSR = .A" "FIND '-- OBJECT TYPE: ' 1 NEXT" IF RC = 0 THEN DO B = .B "LABEL .ZCSR = .B" END ELSE B = .ZLAST "EXCLUDE ALL P'=' 1" "FIND FIRST P'¬¬ ¬================= ¬======= ' 1 .A" B DO WHILE RC= 0 "(LINE) = LINE .ZCSR" PARSE UPPER VAR LINE NULL OBJNAME OBJQUAL OBJQUAL = STRIP(OBJQUAL) OBJNAME = SUBSTR(OBJNAME' ',1,18) OBJQUAL = SUBSTR(OBJQUAL' ',1,8) LINE = OBJTYPE ³³ OBJQUAL ³³ OBJNAME QUEUE LINE "FIND NEXT P'¬¬ ¬================= ¬======= ' 1 .A" B END END ADDRESS TSO "EXECIO" QUEUED() "DISKW DROPOBJ (FINIS)" "END" EXIT ./ ADD NAME=DBSETSQL /* REXX ***************************************************************/ /* PROGRAM: DBSETSQL */ /* AUTHOR: DAVID LEIGH */ /* FUNCTION: THIS REXX PROGRAM WORKS WITH THE DBSETUP UTILITY AND IS */ /* CALLED IN THE BATCH JOB THAT DBSETUP CREATES. IT READS */ /* IN A FILE OF TABLE NAMES AND USES THOSE TABLE NAMES TO */ /* CREATE A DB2 SQL "WHERE" CLAUSE AGAINST THE DB2 CATALOG. */ /**********************************************************************/ "EXECIO * DISKR DROPTSQL (STEM INTABL. FINIS)" NEWSTACK DO I = 1 TO INTABL.0 IF I = 1 THEN DO CREATOR = "'"STRIP(SUBSTR(INTABL.I,2,8))"'" QUEUE "SELECT DISTINCT '3' CONCAT DBNAME CONCAT TSNAME" QUEUE " FROM SYSIBM.SYSTABLES" QUEUE " WHERE CREATOR =" CREATOR QUEUE " AND NAME IN" QUEUE "(" TABLNAME = "'"STRIP(SUBSTR(INTABL.I,10,18))"'" QUEUE TABLNAME END IF I > 1 & I < INTABL.0 THEN DO TABLNAME = ",'"STRIP(SUBSTR(INTABL.I,10,18))"'" QUEUE TABLNAME END IF I = INTABL.0 THEN DO QUEUE ");" END END "EXECIO" QUEUED() "DISKW DROPTSQL (FINIS)" ./ ADD NAME=DBSETUP9 /* REXX ***************************************************************/ /* UTILITY: DBSETUP */ /* AUTHOR: DAVID LEIGH */ /* FUNCTION: THIS UTILITY CONTROLS FILE TAILORING OF A JOB WHICH WILL */ /* CREATE A PROGRAMMER'S TEST DB2 ENVIRONMENT IN THIER */ /* DATABASE BASED ON SOME CRITERIA PASSED TO THIS EXEC. IF */ /* THIS EXEC DOES NOT GET EVERYTHING IT NEEDS, IT WILL POP */ /* UP A PANEL TO PROMPT FOR IT. CONSEQUENTLY IT CAN BE */ /* CALLED BY OTHER PROCESSES THAT PASS THE REQUISITE */ /* INFORMATION VIA THE ISPF SHARED PROFILE POOL. */ /**********************************************************************/ ADDRESS ISPEXEC "CONTROL ERRORS RETURN" USERDB = SYSVAR(SYSUID) ³³ 'DB' "SELECT PGM(USERINFO) PARM("SYSVAR(SYSUID)")" "VGET (JOBPFX DATABASE CREATOR APPLNAME", "JCLREVEW NUMACCTS TBLSDROP DBSETUP DEBUG) SHARED" IF DBSETUP = AUTO THEN DO IF JOBPFX = '' THEN JOBPFX = 'UF' IF DATABASE = '' THEN DATABASE = USERDB IF CREATOR = '' THEN CREATOR = SYSVAR(SYSUID) IF JCLREVEW = '' THEN JCLREVEW = 'Y' IF NUMACCTS = '' THEN NUMACCTS = 1000 IF TBLSDROP = '' THEN TBLSDROP = 'N' "VPUT (JOBPFX DATABASE CREATOR APPLNAME", "JCLREVEW NUMACCTS TBLSDROP DBSETUP DEBUG) SHARED" END ELSE DO WHILE GENJCL ¬= 'Y' "DISPLAY PANEL(DBSETUP)" IF RC = 8 THEN EXIT IF GRPID > '' THEN DO "TBCREATE TEMPDBST NOWRITE REPLACE KEYS(GRPID) NAMES(PRTROWS)" DB2SSID = "DSNP" SQLQUERY = "SELECT A.GRP_ID,", " B.CARD", " FROM USSTRP00.ADM40T_GRPPROF A,", " SYSIBM.SYSTABLES B", " WHERE A.GRP_TYPE = 'SVCR'", " AND A.DB2_QUALIFIER = B.CREATOR", " AND B.NAME = 'PRT01T_PARTICIPANT'", " ORDER BY B.CARD,", " A.GRP_ID" ADDRESS LINK "REXXSQL" SQLRC = RC IF SQLRC <> 0 THEN DO SAY "BAD SQLCODE VERIFYING GROUP ID:" SQLRC EXIT SQLRC END DO I = 1 TO _NROWS GRPID = STRIP(GRP_ID.I) PRTROWS = STRIP(CARD.I) "TBADD TEMPDBST" END "VGET GRPID SHARED" "TBGET TEMPDBST" IF RC > 0 THEN DO ZTDSELS = '' "ADDPOP ROW(1) COLUMN(44)" DO WHILE ZTDSELS ¬= 1 & RC < 8 ZEDLMSG = 'PLEASE SELECT 1 VALID GROUP ID' "TBDISPL TEMPDBST PANEL(DBSETPOP)", "AUTOSEL(YES) MSG(UTLZ000)" END IF ZTDSELS = 0 THEN DO GRPID = '' GENJCL = 'N' END "REMPOP ALL" END END END TEMPFILE = SYSVAR(SYSUID) ³³ '.TEMP.DBSETUP.JCL' ADDRESS TSO DUMMY = OUTTRAP('NULL.') "FREE DD(ISPFILE)" "DELETE '"TEMPFILE"'" "ALLOCATE DD(ISPFILE) DSN('"TEMPFILE"')" , "NEW CATALOG" , "UNIT(SYSDA) VOLUME(WRK$$$)" , "SPACE(1,1) TRACKS RELEASE" , "RECFM(F B) LRECL(80) DSORG(PS)" DROP NULL. ADDRESS ISPEXEC "FTOPEN" "FTINCL DBSETUP" SAVERC = RC "FTCLOSE" ADDRESS TSO "FREE DD(ISPFILE)" IF SAVERC > 0 THEN DO ZEDLMSG = 'FILE TAILORING OF THE "DBSETUP" SKELETON FAILED', 'WITH RC =' SAVERC "SETMSG MSG(UTLZ001W)" "EDIT DATASET('"TEMPFILE"')" END ELSE IF JCLREVEW = 'Y' THEN DO ZEDLMSG = 'YOU MUST SUBMIT THIS JCL YOURSELF' "SETMSG MSG(UTLZ000W)" "EDIT DATASET('"TEMPFILE"')" END ELSE DO ADDRESS TSO "SUBMIT '"TEMPFILE"'" ZEDLMSG = 'DBSETUP JOB SUBMITTED' "SETMSG MSG(UTLZ000W)" END EXIT SAVERC ./ ADD NAME=DBUGREXX /**********************************************************************/ /* CHECK THE DEBUG PROFILE SWITCH */ /**********************************************************************/ /* PARSE PULL DBGSWTCH ADDRESS ISPEXEC 'VGET DBGSWTCH PROFILE' IF DBGSWTCH = ON THEN TRACE ?R ELSE TRACE OFF ./ ADD NAME=DB2 PROC 0 HELP /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT IF &HELP = HELP THEN GOTO HELPSEC ISPEXEC SELECT CMD(%ZTSCPROD D2P1) NEWAPPL(D2P1) 00004800 EXIT HELPSEC: + 02480000 ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) 02490000 SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR DB2I UTILITY + 02490000 *** NO PROCESSING PERFORMED ***) 02490000 ISPEXEC SETMSG MSG(ISRZ000) 02490000 EXIT ./ ADD NAME=DB2BATCH PROC 0 CONTROL NOFLUSH END(ENDO) NOMSG ISPEXEC VGET (WSYS) PROFILE ISPEXEC DISPLAY PANEL(CB2PTD2) IF &LASTCC > 7 THEN EXIT KEEPON: - IF &LENGTH(&PGMNAME) > 7 THEN DO SET PGMSUFX = &SUBSTR(6:8,&PGMNAME) SET PGMPRFX = &SUBSTR(1:1,&PGMNAME) ENDO IF &WSYS = SYS THEN + SET PLANNME = &PGMPRFX.4301&PGMSUFX ELSE + SET PLANNME = &PGMNAME FREE DDNAME(ISPFILE) ATTR(ISPATTR) ATTR ISPATTR RECFM(F B) LRECL(80) BLKSIZE(6160) DELETE '&SYSUID..TEMP.ISPFFILE' ALLOC F(ISPFILE) DA('&SYSUID..TEMP.ISPFFILE') NEW + SPACE(1 1) TRACK USING(ISPATTR) FREE ATTR(ISPATTR) ISPEXEC FTOPEN ISPEXEC FTINCL CB2PTD2 ISPEXEC FTCLOSE ISPEXEC EDIT DATASET(TEMP.ISPFFILE) /*DELETE '&SYSUID..TEMP.ISPFFILE' ISPEXEC VPUT (WPRNT WCUST WSYS WSUBSYS WACCT WBOX WCLASS) PROFILE ISPEXEC VPUT (WTYPE WFORM) PROFILE IF &K = Y THEN DO ISPEXEC DISPLAY MSG(DNVR003) IF &LASTCC > 7 THEN EXIT GOTO KEEPON ENDO IF &K = N THEN DO ISPEXEC DISPLAY MSG(DNVR002) IF &LASTCC > 7 THEN EXIT GOTO KEEPON ENDO ./ ADD NAME=DB2DASD /* REXX ***************************************************************/ /* UTILITY: DB2DASD1 */ /* AUTHOR: DAVID LEIGH */ /* FUNCTION: THIS UTILITY READS IN A FILE OF DB2 DASD STATS DATA THAT */ /* CAME FROM THE PLATINUM STATS TABLE AND PARSES OUT EXTRA */ /* ROWS THAT WOULD BE TOO EXPENSIVE TO PARSE OUT IN SQL. */ /**********************************************************************/ "EXECIO * DISKR INPUTDD (STEM INREC. FINIS)" SAVEYYMM = '' SAVEQUAL = '' SAVEOBJ = '' SAVEQTY = 0 DO I = 1 TO INREC.0 PARSE UPPER VAR INREC.I YYMM 5 7 QUAL 15 OBJ 33 QTYA 43 44 QTYU 54 IF QUAL = SAVEQUAL &, OBJ = SAVEOBJ &, YYMM = SAVEYYMM THEN ITERATE ELSE DO IF I > 1 THEN DO QUEUE SAVEQUAL SAVEYYMM SAVEQTYA SAVEQTYU "EXECIO 1 DISKW OUTPUTDD" END SAVEQUAL = QUAL SAVEOBJ = OBJ SAVEYYMM = YYMM SAVEQTYA = QTYA SAVEQTYU = QTYU END END QUEUE SAVEQUAL SAVEYYMM SAVEQTYA SAVEQTYU "EXECIO 1 DISKW OUTPUTDD (FINIS)" ./ ADD NAME=DB2ESTIM /*REXX****************************************************************/ /* EXEC TO CALCULATE PRIMARY SPACE ALLOCATION FOR A DB2 */ /* TABLE. PANEL: TBSPALOC */ /* SEE DB2 V2.2 ADMINISTRATION GUIDE PG 2-26 */ /*********************************************************************/ ARG DEBUG /*********************************************************************/ /* DETERMINE IF WE ARE RUNNING IN DEBUG MODE */ /*********************************************************************/ IF DEBUG = "DEBUG" THEN TRACE I ELSE NOP /*********************************************************************/ /* CHANGE HOST COMMAND ENVIRONMENT FOR THIS EXEC TO ISPF */ /*********************************************************************/ ADDRESS "ISPEXEC" /*********************************************************************/ /* DECLARE SOME VARIABLES */ /*********************************************************************/ ARECSIZE = 0 PAGESIZE = 4 PCTFREE = 5 FREEPAGE = 0 MUL = 1.0 TOTPAGES = 0 TOTKB = 0 TOTKBM = 0 /*********************************************************************/ /* DISPLAY PANEL TBSPALOC */ /*********************************************************************/ "DISPLAY PANEL(TBSPALOC)" /*********************************************************************/ /* PROCESS PANEL INPUT AND REDISPLAY PANEL WHILE RC = 0 */ /*********************************************************************/ DO WHILE RC = 0 /*********************************************************************/ /* DETERMINE AVAILABLE BYTES PER PAGE -- BASED ON PAGESIZE */ /*********************************************************************/ IF PAGESIZE = 4 THEN ABYTESPP = 4074 ELSE ABYTESPP = 32746 /*********************************************************************/ /* CALCULATE ADJUSTED BYTES PER PAGE -- BASED ON PCTFREE */ /*********************************************************************/ ADBYTEPP = TRUNC(ABYTESPP*((100-PCTFREE)/100)) /*********************************************************************/ /* ADJUST RECORD SIZE TO INCLUDE 8 BYTE OVERHEAD */ /*********************************************************************/ ARECSIZE = RECSIZE + 8 IF ARECSIZE < 32 THEN ARECSIZE = 32 /*********************************************************************/ /* CALCULATE RECORDS PER PAGE -- BASED ON RECORD SIZE */ /*********************************************************************/ RECPP = TRUNC(ADBYTEPP/ARECSIZE) IF RECPP > 127 THEN RECPP = 127 /*********************************************************************/ /* CALCULATE UNUSED BYTES PER PAGE */ /*********************************************************************/ UNUSED = ADBYTEPP - TRUNC(RECPP*ARECSIZE) /*********************************************************************/ /* CALCULATE PAGES USED -- USE CEILING TO ROUND UP */ /*********************************************************************/ PGUSED = CEILING(RECORDS/RECPP) /*********************************************************************/ /* CALCULATE FREEPAGE ADJUSTMENT */ /* SET HPSMP = 3 (2 FOR HEADER PAGE + 1 FOR SPACE MAP) */ /*********************************************************************/ IF FREEPAGE = 0 THEN FPAGEAD = 0 ELSE FPAGEAD = TRUNC(PGUSED/FREEPAGE) HPSMP = 3 /*********************************************************************/ /* CALCULATE TOTAL PAGES */ /*********************************************************************/ IF FREEPAGE = 0 THEN TOTPAGES = PGUSED + HPSMP ELSE TOTPAGES = PGUSED + FPAGEAD + HPSMP /*********************************************************************/ /* CALCULATE TOTAL KILOBYTES */ /* CALCULATE TOTAL KILOBYTES WITH MULTIPLIER IF REQUESTED */ /*********************************************************************/ TOTKB = TRUNC(TOTPAGES * 4) IF TOTKB < 40 THEN TOTKB = 40 ELSE TOTKB = (CEILING(TOTKB/40) * 40) IF MUL <= 1.0 THEN TOTKBM = TOTKB ELSE DO TOTKBM = (TRUNC(TOTPAGES * 4) * MUL) IF TOTKBM < 40 THEN TOTKBM = 40 ELSE TOTKBM = (CEILING(TOTKBM/40) * 40) END /*********************************************************************/ /* CALCULATE TRACKS AND CYLINDERS FOR 3380 AND 3390 */ /*********************************************************************/ NUMERIC DIGITS 5 IF MUL <= 1.0 THEN T3380 = CEILING(TOTPAGES/10) ELSE T3380 = CEILING((TOTPAGES * MUL)/10) C3380 = T3380/15 P3380 = T3380*10 IF MUL <= 1.0 THEN T3390 = CEILING(TOTPAGES/12) ELSE T3390 = CEILING((TOTPAGES) * MUL/12) C3390 = T3390/15 P3390 = T3390*12 NUMERIC DIGITS 9 R3390 = P3390*RECPP "DISPLAY PANEL(TBSPALOC)" END /*** END DO WHILE LOOP ***/ EXIT /*** EXIT TBSPALOC EXEC ***/ CEILING: PROCEDURE /*********************************************************************/ /* FUNCTION TO ROUND UP A NUMBER */ /*********************************************************************/ ARG NUM1 NUM2 = TRUNC(NUM1) IF NUM1 > NUM2 THEN CEIL = NUM2 + 1 ELSE CEIL = NUM2 RETURN CEIL /***********************************************************************/ /* END OF REXX ROUTINE */ /***********************************************************************/ Here is the ISPF panel: )ATTR DEFAULT(%+_) x TYPE(INPUT) INTENS(HIGH) JUST(LEFT) COLOR(GREEN) ! TYPE(OUTPUT) INTENS(HIGH) COLOR(WHITE) , TYPE(TEXT) INTENS(HIGH) COLOR(YELLOW) @ TYPE(TEXT) INTENS(HIGH) COLOR(TURQUOISE) ~ TYPE(TEXT) INTENS(HIGH) COLOR(PINK) $ TYPE(TEXT) SKIP(ON) )BODY EXPAND(\\) %\-\ DB2 SPACE CALCULATION FOR A TABLE \-\ %COMMAND ===>xZCMD ,Please enter the following values and press the@ENTER,key: @ Number of records %===>xRECORDS $ @# Of 3390 Records %===>!R3390 @ Record size %===>xZ $@ (Add 1 for each NULL; Avg value for VARCHAR) @ Page size (K) %===>xZ $ @(4 or 32) @ PCTFREE %===>xZ $ @ FREEPAGE %===>xZ $ @ Multiplier %===>xMUL$ @(1.0,1.2,1.5,2.0) ~ \-\ Space Statistics \-\$ ~. @Available Bytes Per Page %===>!ABYTESPP . ~. @Adjusted Bytes Per Page %===>!ADBYTEPP @(Adjusted for Freespace) . ~. @Records Per Page %===>!RECPP @(Maximum of 127) . ~. @Unused Bytes Per Page %===>!UNUSED . ~. @Total Pages Required At Load %===>!PGUSED . ~. @Freepage Adjustment %===>!FPAGEAD . ~. @Header Page/Space Map Page Adjustment %===>!HPSMP . ~. . ~. @Adjusted Total Pages %===>!TOTPAGES . ~. @Est Total Kilobytes %===>!TOTKB @With Multiplier %===>!TOTKBM . ~. @3380 Tracks %===>!T3380 @Cyl %===>!C3380 @# of Pages %===>!P3380 . ~. @3390 Tracks %===>!T3390 @Cyl %===>!C3390 @# of Pages %===>!P3390 . ~ \-\,Enter@END,command to Exit~--$ )INIT .ZVARS = '(RECSIZE,PAGESIZE,PCTFREE,FREEPAGE)' .CURSOR = RECORDS )REINIT REFRESH (TOTPAGES,TOTKB,TOTKBM,T3380,C3380,T3390,C3390,P3380,P3390) )PROC VER(&RECORDS,NB,NUM,MSG=TBSPA001) VER(&RECSIZE,NB,NUM,MSG=TBSPA002) VER(&PAGESIZE,NB,LIST,4,32,NUM,MSG=TBSPA003) VER(&PCTFREE,NB,RANGE,0,99,MSG=TBSPA004) VER(&FREEPAGE,NB,RANGE,0,255,MSG=TBSPA005) VER(&MUL,PICT '9.9',MSG=TBSPA006) )END ***************************************************************** here are the ISPF messages ***************************************************************** TBSPA001 'ENTER NUMBER OF RECORDS' .ALARM=YES .HELP=* 'PLEASE ENTER THE TOTAL NUMBER OF RECORDS IN THE TABLE' TBSPA002 'ENTER LENGTH OF RECORD' .ALARM=YES .HELP=* 'PLEASE ENTER THE TOTAL LENGTH OF THE DB2 RECORD' TBSPA003 'INVALID DB2 PAGESIZE' .ALARM=YES .HELP=* 'PLEASE ENTER A VALID DB2 PAGESIZE: 4K OR 32K' TBSPA004 'PCTFREE OUT OF RANGE' .ALARM=YES .HELP=* 'VALID RANGE FOR PCTFREE ENTRY IS: 0 - 99' TBSPA005 'FREEPAGE OUT OF RANGE' .ALARM=YES .HELP=* 'VALID RANGE FOR FREEPAGE ENTRY IS: 0 - 255' TBSPA006 'INVALID MULTIPLIER VALUE' .ALARM=YES .HELP=* 'MULTIPLIER ENTRY MUST BE DECIMAL IN THE FORM: 9.9' ./ ADD NAME=DB2I PROC 0 HELP /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT IF &HELP = HELP THEN GOTO HELPSEC ISPEXEC SELECT PANEL(ZTSUMAIN) OPT(A) EXIT HELPSEC: + 02480000 ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) 02490000 SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR DB2I UTILITY + 02490000 *** NO PROCESSING PERFORMED ***) 02490000 ISPEXEC SETMSG MSG(ISRZ000) 02490000 EXIT ./ ADD NAME=DB2LOAD PROC 0 HELP /**** 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 = HELP THEN GOTO HELPSEC /*******************************************************************/ /* CLIST : DB2LOAD */ /* CREATED BY : DAVID LEIGH */ /* DATE : 5-2-90 */ /* DESCRIPTION : THIS CLIST ALLOWS THE USER TO LOAD DB2 TABLES */ /* FROM A SEQUENTIAL FILE. */ /*******************************************************************/ /********************************************************************/ /* HANDLE ALL ERRORS HERE */ /********************************************************************/ ISPEXEC CONTROL ERRORS CANCEL /********************************************************************/ /* SET INITIAL VARIABLES FOR USE IN THIS CLIST - MAKE CHANGES HERE! */ /********************************************************************/ ISPEXEC TBOPEN PROJECT NOWRITE ISPEXEC TBVCLEAR PROJECT SET TESTPROD = T SET PRJELEM = DB2 SET PRJPARM = SUBSYSTEM ISPEXEC TBSCAN PROJECT ARGLIST(TESTPROD,PRJELEM,PRJPARM) + CONDLIST(EQ,EQ,EQ) SET DB2S = &PRJQUAL ISPEXEC TBTOP PROJECT SET PRJPARM = DATABASE ISPEXEC TBSCAN PROJECT ARGLIST(TESTPROD,PRJELEM,PRJPARM) + CONDLIST(EQ,EQ,EQ) SET DB2DBASE = &PRJQUAL ISPEXEC TBTOP PROJECT SET PRJQUAL = LOADLIB ISPEXEC TBSCAN PROJECT ARGLIST(TESTPROD,PRJELEM,PRJQUAL) + CONDLIST(EQ,EQ,EQ) SET DB2LLIB = &PRJPARM ISPEXEC TBEND PROJECT SET TVNAME = SET SPACE7 = &STR( ) SET LOADTYPE = N SET JCLREVEW = N SET FCOMP = N SET LOADDSN = SET SAVEDSN = &STR(________.________.________.________) SET SORTDSN = SET LSCROLL = SET SCNUM = SET SCALE = SET IMAGE = SET FSTG = SET PREVNEXT = SET BREC = SET EREC = SET INCR = SET SAVETVNA = &STR(________) SET EDITYN = N SET LPAREN = &STR(( SET RPAREN = &STR()) SET ZTDSELS = &STR(0000) /********************************************************************/ /* CREATE THE TEMPORARY TABLE. */ /********************************************************************/ ISPEXEC TBCREATE $$$$D2TL WRITE + NAMES(FIELD COL1 COL2 FLEN TYPE KEY DEFAULT DB2SCALE NULLS) /********************************************************************/ /********************************************************************/ /* M A I N L I N E */ /********************************************************************/ /********************************************************************/ MAINLINE: + ISPEXEC VPUT (TVNAME LOADTYPE SORTDSN LOADDSN FCOMP LSCROLL SCNUM + SCALE IMAGE DB2S DB2DBASE FSTG BREC EREC INCR + LINENUM PREVNEXT EDITYN JCLREVEW) SHARED ISPEXEC TBDISPL $$$$D2TL PANEL(DB2LOAD) SET SAVECC = &LASTCC ISPEXEC VGET (TVNAME LOADTYPE SORTDSN LOADDSN FCOMP LSCROLL SCNUM + SCALE IMAGE DB2S DB2DBASE FSTG BREC EREC INCR + LINENUM PREVNEXT EDITYN JCLREVEW) SHARED SET SYSDVAL = &STR(&ZCMD) READDVAL XCMD OPT1 OPT2 OPT3 OPT4 OPT5 OPT6 OPT7 OPT8 OPT9 OPT10 OPT11 /********************************************************************/ /* BRANCH TO SECTIONS TO HANDLE ENTERED COMMAND */ /********************************************************************/ MAIN0001: + IF &ZTDSELS > &STR(0000) THEN GOTO ROWSEC MAIN0002: + IF &SAVECC > 7 THEN GOTO FINAL IF &TVNAME > AND &TVNAME ¬= &SAVETVNA THEN GOTO ISPFLOAD MAIN0003: + IF &LSCROLL > AND &NRSTR(&FSTG) > AND &STR(&LOADDSN) > THEN + DO SET ZEDLMSG = &STR(*** CANNOT BOTH "SCROLL" AND "FIND" ***) ISPEXEC SETMSG MSG(UTLZ001) GOTO MAINEXIT END IF &LSCROLL > AND &STR(&LOADDSN) = THEN + DO SET ZEDLMSG = &STR(*** NO LOAD DATASET, SCROLL IGNORED ***) ISPEXEC SETMSG MSG(UTLZ000) SET LSCROLL = SET SCNUM = END SELECT &STR(&LSCROLL) WHEN (U) GOTO UPSCRL WHEN (D) GOTO DOWNSCRL WHEN (L) GOTO LEFTSCRL WHEN (R) GOTO RGHTSCRL END IF &LOADTYPE = Y THEN GOTO PROCESS IF &STR(&LOADDSN) > AND &NRSTR(&LOADFILE) = OR + &STR(&LOADDSN) > AND &STR(&LOADDSN) ¬= &SAVEDSN THEN GOTO FILEALOC IF &NRSTR(&FSTG) > AND &STR(&LOADDSN) = THEN + DO SET ZEDLMSG = &STR(*** NO LOAD DATASET, FIND IGNORED ***) ISPEXEC SETMSG MSG(UTLZ000) SET FSTG = GOTO MAINEXIT END IF &NRSTR(&FSTG) > THEN GOTO FINDSEC IF &STR(&SORTDSN) > AND &EDITYN = Y THEN GOTO EDITSORT MAINEXIT: + IF &STR(&ZCMD) = THEN + DO ISPEXEC TBTOP $$$$D2TL ISPEXEC TBSKIP $$$$D2TL NUMBER(&ZTDTOP) ISPEXEC VGET (ZVERB ZSCROLLN) IF &ZVERB = &STR(UP) THEN + ISPEXEC TBSKIP $$$$D2TL NUMBER(-&ZSCROLLN) IF &ZVERB = &STR(DOWN) THEN + ISPEXEC TBSKIP $$$$D2TL NUMBER(&ZSCROLLN) END SET ZCMD = IF &SAVECC > 7 THEN GOTO FINAL GOTO MAINLINE /********************************************************************/ /********************************************************************/ /* F I N A L I Z A T I O N */ /********************************************************************/ /********************************************************************/ FINAL: + ERROR RETURN CLOSFILE LOADFILE ERROR OFF FREE DDNAME(LOADFILE) ISPEXEC TBEND $$$$D2TL EXIT /********************************************************************/ /********************************************************************/ /* S U B R O U T I N E S */ /********************************************************************/ /********************************************************************/ /********************************************************************/ /* PROCESS PENDING SELECTED ROWS */ /********************************************************************/ ROWSEC: + DO WHILE &ZTDSELS ¬= &STR(0000) SET ZEDLMSG = IF &COL2 = AND &COL1 = AND &NRSTR(&DEFAULT) = AND + &NRSTR(&NULLS) = &STR(NOT NULL) THEN + DO SET ZEDLMSG = &STR("NOT NULL" COLUMNS MUST HAVE A DEFAULT + OR A COLUMN NUMBER SPECIFICATION) ISPEXEC SETMSG MSG(UTLZ001) END IF &COL2 < &COL1 THEN + DO SET ZEDLMSG = &STR(COLUMN 2 MUST BE + GREATER THAN OR EQUAL TO COLUMN 1) ISPEXEC SETMSG MSG(UTLZ001) END IF &EVAL(&COL2 - &COL1 + 1) > &FLEN THEN + DO IF &TYPE ¬= DATE AND + &TYPE ¬= TIME AND + &TYPE ¬= TIMESTMP THEN + DO SET ZEDLMSG = &STR(FIELD LENGTH > THAN DEFINED + FIELD LENGTH FOR "&FIELD" : "&FLEN") ISPEXEC SETMSG MSG(UTLZ001) END IF &TYPE = DATE AND &EVAL(&COL2 - &COL1 + 1) > 10 THEN + DO SET ZEDLMSG = &STR(LENGTH FOR DATE FIELD "&FIELD" + > EXTERNAL FIELD LENGTH LIMIT : 10) ISPEXEC SETMSG MSG(UTLZ001) END IF &TYPE = TIME AND &EVAL(&COL2 - &COL1 + 1) > 15 THEN + DO SET ZEDLMSG = &STR(LENGTH FOR TIME FIELD "&FIELD" + > EXTERNAL FIELD LENGTH LIMIT : 15) ISPEXEC SETMSG MSG(UTLZ001) END IF &TYPE = TIMESTMP AND &EVAL(&COL2 - &COL1 + 1) > 26 THEN + DO SET ZEDLMSG = &STR(LENGTH FOR TIMESTAMP FIELD + "&FIELD" > EXTERNAL FIELD LENGTH LIMIT : 26) ISPEXEC SETMSG MSG(UTLZ001) END END IF &COL1 < 1 AND &COL2 < 1 AND + &NRSTR(&DEFAULT) > 0 THEN + DO SET DLEN = &LENGTH(&NRSTR(&DEFAULT)) SET X = &SYSINDEX(&STR('),&NRSTR(&DEFAULT)) SET X = &X + 1 SET XDEFAULT = &SUBSTR(&X:&DLEN,&NRSTR(&DEFAULT)) SET X = &SYSINDEX(&STR('),&NRSTR(&XDEFAULT)) SET X = &X - 1 IF &X < 1 THEN SET X = &LENGTH(&NRSTR(&XDEFAULT)) SET XDEFAULT = &SUBSTR(1:&X,&NRSTR(&XDEFAULT)) SET DLEN = &LENGTH(&NRSTR(&XDEFAULT)) IF &DLEN > &FLEN THEN + IF &TYPE ¬= DATE AND + &TYPE ¬= TIME AND + &TYPE ¬= TIMESTMP THEN + DO SET ZEDLMSG = &STR("DEFAULT" LENGTH > THAN + DEFINED FIELD LENGTH FOR + "&FIELD" : "&FLEN") ISPEXEC SETMSG MSG(UTLZ001) END ELSE + DO IF &TYPE = DATE AND &DLEN > 10 THEN + DO SET ZEDLMSG = &STR("DEFAULT" DATE + LENGTH > EXTERNAL + DATE FIELD LENGTH + LIMIT : 10) ISPEXEC SETMSG MSG(UTLZ001) END IF &TYPE = TIME AND &DLEN > 15 THEN + DO SET ZEDLMSG = &STR("DEFAULT" TIME + LENGTH > EXTERNAL + TIME FIELD LENGTH + LIMIT : 15) ISPEXEC SETMSG MSG(UTLZ001) END IF &TYPE = TIMESTMP AND &DLEN > 26 THEN + DO SET ZEDLMSG = &STR("DEFAULT" TIMESTAMP + LENGTH > EXTERNAL + TIMESTAMP FIELD + LENGTH LIMIT : 26) ISPEXEC SETMSG MSG(UTLZ001) END END END IF &STR(&ZEDLMSG) = THEN ISPEXEC TBPUT $$$$D2TL IF &ZTDSELS > &STR(0001) THEN ISPEXEC TBDISPL $$$$D2TL ELSE SET ZTDSELS = &STR(0000) END GOTO MAIN0002 /********************************************************************/ /* OPEN THE LOAD FILE, DEFINE THE SCALE AND GET THE FIRST ROW */ /********************************************************************/ FILEALOC: + SET SAVEDSN = &STR(&LOADDSN) ERROR RETURN CLOSFILE LOADFILE ERROR OFF TSOPDSNQ '&LOADDSN' IF &LASTCC = 0 THEN + DO SET X = &LENGTH(&STR(&SYSXDSNAME)) - 1 SET LOADDSN = &SUBSTR(2:&X,&STR(&SYSXDSNAME)) END LISTDSI '&LOADDSN' IF &LASTCC > 0 THEN + DO SET ZEDLMSG = &STR("&LOADDSN" PROBLEM : &SYSDSN('&LOADDSN')) ISPEXEC SETMSG MSG(UTLZ001) SET LOADDSN = GOTO MAINEXIT END SET X = 50 SET SC = &STR(----+----1----+----2----+----3----+----4----+----5) DO WHILE &X < &SYSLRECL SET SC = &STR(&SC----+----6----+----7----+----8----+----9----+----0) SET SC = &STR(&SC----+----1----+----2----+----3----+----4----+----5) SET X = &X + 100 END IF &SYSLRECL > 79 THEN SET ENDCOL = 79 ELSE SET ENDCOL = &SYSLRECL SET SCALE = &SUBSTR(1:&ENDCOL,&STR(&SC)) FREE DDNAME(LOADFILE) ALLOC DDNAME(LOADFILE) + DSN('&LOADDSN') + SHR KEEP ERROR + DO SET ERRCC = &LASTCC IF &ERRCC = 400 THEN + DO SET EOF = YES SET ZEDLMSG = &STR(*** "&LOADDSN" IS EMPTY ***) ISPEXEC SETMSG MSG(UTLZ001) SET LOADDSN = SET LOADFILE = GOTO MAINEXIT END ELSE + DO WRITE *** PROBLEM WITH CLIST DB2LOAD *** WRITE *** RETURN CODE = &ERRCC *** WRITE *** IN SECTION : FILEALOC *** GOTO FINAL END END SET EOF = NO OPENFILE LOADFILE INPUT GETFILE LOADFILE ERROR OFF SET DATALEN = &LENGTH(&NRSTR(&LOADFILE)) IF &DATATYPE(&STR(&DATALEN)) ¬= NUM THEN + DO SET X = &LENGTH(&STR(&DATALEN)) SET Y = 0 SET B = 0 DO WHILE &Y < &X SET Y = &Y + 1 SET A = &SUBSTR(&Y:&Y,&STR(&DATALEN)) SET A = &A IF &DATATYPE(&STR(&A)) = NUM THEN SET B = &STR(&B&A) END SET DATALEN = &B END IF &DATALEN > &ENDCOL THEN + SET IMAGE = &SUBSTR(1:&ENDCOL,&NRSTR(&LOADFILE)) ELSE + SET IMAGE = &SUBSTR(1:&DATALEN,&NRSTR(&LOADFILE)) SET BEGCOL = 1 SET LINENUM = 1 SET SAVEDSN = &LOADDSN SET PREVNEXT = N SET BREC = 1 SET EREC = 9999999 SET INCR = 1 GOTO MAINEXIT /********************************************************************/ /* SCROLL THE LOAD FILE UPWARDS */ /********************************************************************/ UPSCRL: + IF &LINENUM = 1 THEN + DO SET ZEDLMSG = &STR(*** TOP OF LOAD FILE ***) ISPEXEC SETMSG MSG(UTLZ000) GOTO MAINEXIT END IF &SCNUM < 1 THEN SET SCNUM = 1 SET LINENUM = &LINENUM - &SCNUM IF &LINENUM < 1 THEN SET LINENUM = 1 SET X = 0 CLOSFILE LOADFILE OPENFILE LOADFILE INPUT SET EOF = NO DO WHILE &X < &LINENUM GETFILE LOADFILE SET X = &X + 1 END SET DATALEN = &LENGTH(&NRSTR(&LOADFILE)) IF &DATATYPE(&STR(&DATALEN)) ¬= NUM THEN + DO SET X = &LENGTH(&STR(&DATALEN)) SET Y = 0 SET B = 0 DO WHILE &Y < &X SET Y = &Y + 1 SET A = &SUBSTR(&Y:&Y,&STR(&DATALEN)) SET A = &A IF &DATATYPE(&STR(&A)) = NUM THEN SET B = &STR(&B&A) END SET DATALEN = &B END IF &DATALEN > &ENDCOL THEN + SET IMAGE = &SUBSTR(&BEGCOL:&ENDCOL,&NRSTR(&LOADFILE)) ELSE + SET IMAGE = &SUBSTR(&BEGCOL:&DATALEN,&NRSTR(&LOADFILE)) SET LSCROLL = GOTO MAINEXIT /********************************************************************/ /* SCROLL THE LOAD FILE DOWNWARDS */ /********************************************************************/ DOWNSCRL: + ERROR + DO SET ERRCC = &LASTCC IF &ERRCC = 400 THEN + DO SET EOF = YES SET LINENUM = &LINENUM - 1 RETURN END ELSE + DO WRITE *** PROBLEM WITH CLIST DB2LOAD *** WRITE *** RETURN CODE = &ERRCC *** WRITE *** IN SECTION : DOWNSCRL *** GOTO FINAL END END IF &SCNUM < 1 THEN SET SCNUM = 1 SET X = 0 DO WHILE &X < &SCNUM AND &EOF = NO GETFILE LOADFILE SET LINENUM = &LINENUM + 1 SET X = &X + 1 END ERROR OFF IF &EOF = YES THEN + DO SET ZEDLMSG = &STR(*** BOTTOM OF LOAD FILE ***) ISPEXEC SETMSG MSG(UTLZ000) END SET DATALEN = &LENGTH(&NRSTR(&LOADFILE)) IF &DATATYPE(&STR(&DATALEN)) ¬= NUM THEN + DO SET X = &LENGTH(&STR(&DATALEN)) SET Y = 0 SET B = 0 DO WHILE &Y < &X SET Y = &Y + 1 SET A = &SUBSTR(&Y:&Y,&STR(&DATALEN)) SET A = &A IF &DATATYPE(&STR(&A)) = NUM THEN SET B = &STR(&B&A) END SET DATALEN = &B END IF &DATALEN > &ENDCOL THEN + SET IMAGE = &SUBSTR(&BEGCOL:&ENDCOL,&NRSTR(&LOADFILE)) ELSE + SET IMAGE = &SUBSTR(&BEGCOL:&DATALEN,&NRSTR(&LOADFILE)) SET LSCROLL = GOTO MAINEXIT /********************************************************************/ /* SCROLL THE LOAD FILE LEFT */ /********************************************************************/ LEFTSCRL: + IF &BEGCOL = 1 THEN + DO SET ZEDLMSG = &STR(*** ALREADY AT LOAD FILE LEFT BOUNDRY ***) ISPEXEC SETMSG MSG(UTLZ000) END ELSE + DO IF &SCNUM < 1 THEN SET SCNUM = 79 SET X = &BEGCOL - &SCNUM IF &X < 1 THEN + DO SET SCNUM = &X + &SCNUM - 1 SET &BEGCOL = &BEGCOL - &SCNUM END ELSE + SET &BEGCOL = &BEGCOL - &SCNUM SET &ENDCOL = &ENDCOL - &SCNUM END SET SCALE = &SUBSTR(&BEGCOL:&ENDCOL,&STR(&SC)) SET DATALEN = &LENGTH(&NRSTR(&LOADFILE)) IF &DATATYPE(&STR(&DATALEN)) ¬= NUM THEN + DO SET X = &LENGTH(&STR(&DATALEN)) SET Y = 0 SET B = 0 DO WHILE &Y < &X SET Y = &Y + 1 SET A = &SUBSTR(&Y:&Y,&STR(&DATALEN)) SET A = &A IF &DATATYPE(&STR(&A)) = NUM THEN SET B = &STR(&B&A) END SET DATALEN = &B END IF &DATALEN > &ENDCOL THEN + SET IMAGE = &SUBSTR(&BEGCOL:&ENDCOL,&NRSTR(&LOADFILE)) ELSE + SET IMAGE = &SUBSTR(&BEGCOL:&DATALEN,&NRSTR(&LOADFILE)) SET LSCROLL = GOTO MAINEXIT /********************************************************************/ /* SCROLL THE LOAD FILE RIGHT */ /********************************************************************/ RGHTSCRL: + IF &ENDCOL = &SYSLRECL THEN + DO SET ZEDLMSG = &STR(*** ALREADY AT LOAD FILE RIGHT BOUNDRY ***) ISPEXEC SETMSG MSG(UTLZ000) END ELSE + DO IF &SCNUM < 1 THEN SET SCNUM = 79 SET X = &ENDCOL + &SCNUM IF &X > &SYSLRECL THEN + DO SET SCNUM = &SYSLRECL - &ENDCOL SET ENDCOL = &ENDCOL + &SCNUM END ELSE + SET ENDCOL = &ENDCOL + &SCNUM SET BEGCOL = &BEGCOL + &SCNUM END SET SCALE = &SUBSTR(&BEGCOL:&ENDCOL,&STR(&SC)) SET DATALEN = &LENGTH(&NRSTR(&LOADFILE)) IF &DATATYPE(&STR(&DATALEN)) ¬= NUM THEN + DO SET X = &LENGTH(&STR(&DATALEN)) SET Y = 0 SET B = 0 DO WHILE &Y < &X SET Y = &Y + 1 SET A = &SUBSTR(&Y:&Y,&STR(&DATALEN)) SET A = &A IF &DATATYPE(&STR(&A)) = NUM THEN SET B = &STR(&B&A) END SET DATALEN = &B END IF &DATALEN > &ENDCOL THEN + SET IMAGE = &SUBSTR(&BEGCOL:&ENDCOL,&NRSTR(&LOADFILE)) ELSE + SET IMAGE = &SUBSTR(&BEGCOL:&DATALEN,&NRSTR(&LOADFILE)) SET LSCROLL = GOTO MAINEXIT /********************************************************************/ /* FIND A STRING IN THE FILE */ /********************************************************************/ FINDSEC: + IF &PREVNEXT ¬= N AND &PREVNEXT ¬= P THEN SET &PREVNEXT = N IF &PREVNEXT = P THEN + DO IF &LINENUM = 1 THEN + DO SET ZEDLMSG = &STR(*** TOP OF LOAD FILE ***) ISPEXEC SETMSG MSG(UTLZ001) GOTO MAINEXIT END CLOSFILE LOADFILE OPENFILE LOADFILE INPUT SET X = 0 SET Y = 0 SET LINENUM = &LINENUM - 1 SET ZEDLMSG = DO WHILE &X < &LINENUM SET X = &X + 1 GETFILE LOADFILE IF &SYSINDEX(&NRSTR(&FSTG),&NRSTR(&SYSCAPS(&LOADFILE)) > 0 THEN + DO SET ZEDLMSG = &STR(*** FOUND "&NRSTR(&FSTG)" ***) ISPEXEC SETMSG MSG(UTLZ000) SET Y = &X END END SET LINENUM = &LINENUM + 1 IF &Y > 0 THEN + DO CLOSFILE LOADFILE OPENFILE LOADFILE INPUT SET X = 0 DO WHILE &X < &Y SET X = &X + 1 GETFILE LOADFILE END SET LINENUM = &X END ELSE + DO SET ZEDLMSG = &STR(*** "&NRSTR(&FSTG)" NOT FOUND ***) ISPEXEC SETMSG MSG(UTLZ001) END END ELSE + DO ERROR DO SET ERRCC = &LASTCC IF &ERRCC = 400 THEN + DO SET EOF = YES SET ZEDLMSG = &STR(*** END OF FILE REACHED ***) ISPEXEC SETMSG MSG(UTLZ001) RETURN END ELSE + DO WRITE *** PROBLEM WITH CLIST DB2LOAD *** WRITE *** RETURN CODE = &ERRCC *** GOTO FINAL END END SET EOF = NO SET X = 0 SET Y = 0 SET ZEDLMSG = GETFILE LOADFILE DO WHILE &EOF = NO AND &STR(&ZEDLMSG) = SET X = &X + 1 IF &SYSINDEX(&NRSTR(&FSTG),&NRSTR(&SYSCAPS(&LOADFILE)) > 0 THEN + DO SET ZEDLMSG = &STR(*** FOUND "&NRSTR(&FSTG)" ***) ISPEXEC SETMSG MSG(UTLZ000) SET LINENUM = &X END IF &LINENUM < &X THEN GETFILE LOADFILE END ERROR OFF IF &STR(&ZEDLMSG) = THEN + DO CLOSFILE LOADFILE OPENFILE LOADFILE INPUT SET X = 0 DO WHILE &X < &LINENUM SET X = &X + 1 GETFILE LOADFILE END END END SET DATALEN = &LENGTH(&NRSTR(&LOADFILE)) IF &DATATYPE(&STR(&DATALEN)) ¬= NUM THEN + DO SET X = &LENGTH(&STR(&DATALEN)) SET Y = 0 SET B = 0 DO WHILE &Y < &X SET Y = &Y + 1 SET A = &SUBSTR(&Y:&Y,&STR(&DATALEN)) SET A = &A IF &DATATYPE(&STR(&A)) = NUM THEN SET B = &STR(&B&A) END SET DATALEN = &B END IF &DATALEN > &ENDCOL THEN + SET IMAGE = &SUBSTR(&BEGCOL:&ENDCOL,&NRSTR(&LOADFILE)) ELSE + SET IMAGE = &SUBSTR(&BEGCOL:&DATALEN,&NRSTR(&LOADFILE)) GOTO MAINEXIT /********************************************************************/ /* EDIT THE SORT CARDS DATASET */ /********************************************************************/ EDITSORT: + SET EDITYN = N SET X = &SYSINDEX(&STR(&LPAREN),&NRSTR(&SORTDSN)) IF &X > 0 THEN + DO SET X = &X + 1 SET Y = &SUBSTR(&X:&X,&NRSTR(&SORTDSN)) IF &STR(&X) = &STR(0) OR + &STR(&X) = &STR(1) OR + &STR(&X) = &STR(2) OR + &STR(&X) = &STR(3) OR + &STR(&X) = &STR(4) OR + &STR(&X) = &STR(5) OR + &STR(&X) = &STR(6) OR + &STR(&X) = &STR(7) OR + &STR(&X) = &STR(8) OR + &STR(&X) = &STR(9) OR + &STR(&X) = &STR(+) OR + &STR(&X) = &STR(-) THEN + DO TSOPDSNQ '&SORTDSN' IF &LASTCC = 0 THEN + DO SET X = &LENGTH(&STR(&SYSXDSNAME)) - 1 SET SORTDSN = &SUBSTR(2:&X,&STR(&SYSXDSNAME)) END END END ISPEXEC EDIT DATASET('&SORTDSN') IF &LASTCC > 8 THEN + DO SET ZEDLMSG = &STR("&SORTDSN" PROBLEM : &SYSDSN('&SORTDSN')) ISPEXEC SETMSG MSG(UTLZ001) END GOTO MAINEXIT /********************************************************************/ /* LOAD THE ISPF TABLE WITH THE DB2 TABLE INFORMATION */ /********************************************************************/ ISPFLOAD: + ISPEXEC CONTROL ERRORS RETURN ISPEXEC TBEND $$$$D2TL ISPEXEC TBCREATE $$$$D2TL WRITE + NAMES(FIELD COL1 COL2 FLEN TYPE KEY DEFAULT DB2SCALE NULLS) SET SAVETVNA = &TVNAME SET ZEDLMSG = &STR(*** LOADING THE TABLE DEFINITION FOR "&TVNAME" ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC SETMSG MSG(UTLZ000) ISPEXEC DISPLAY PANEL(DB2LOAD) FREE ATTRLIST(ATTRIB1) ATTRIB ATTRIB1 OUTPUT + RECFM(F B) + LRECL(80) + BLKSIZE(23440) FREE ATTRLIST(ATTRIB2) ATTRIB ATTRIB2 OUTPUT + RECFM(F B) + LRECL(255) + BLKSIZE(23460) DELETE SYSPRINT FREE DDNAME(SYSPRINT) ALLOC DD(SYSPRINT) + DSN(SYSPRINT) + NEW CATALOG + UNIT(SYSDA) + SPACE(1,1) TRACKS RELEASE + USING(ATTRIB2) FREE DDNAME(SYSIN) DELETE SYSIN ALLOC DD(SYSIN) + DSN(SYSIN) + NEW CATALOG + UNIT(SYSDA) + SPACE(1,1) TRACKS RELEASE + USING(ATTRIB1) OPENFILE SYSIN OUTPUT SET SYSIN = &STR(SELECT B.TBNAME,) PUTFILE SYSIN SET SYSIN = &STR( A.DNAME,) PUTFILE SYSIN SET SYSIN = &STR( B.NAME,) PUTFILE SYSIN SET SYSIN = &STR( B.COLTYPE,) PUTFILE SYSIN SET SYSIN = &STR( B.LENGTH,) PUTFILE SYSIN SET SYSIN = &STR( B.SCALE,) PUTFILE SYSIN SET SYSIN = &STR( B.NULLS,) PUTFILE SYSIN SET SYSIN = &STR( B.KEYSEQ,) PUTFILE SYSIN SET SYSIN = &STR( B.COLNO) PUTFILE SYSIN SET SYSIN = &STR( FROM SYSIBM.SYSVIEWDEP A,) PUTFILE SYSIN SET SYSIN = &STR( SYSIBM.SYSCOLUMNS B) PUTFILE SYSIN SET SYSIN = &STR( WHERE B.TBCREATOR = '&DB2DBASE') PUTFILE SYSIN SET SYSIN = &STR( AND A.BCREATOR = '&DB2DBASE') PUTFILE SYSIN SET SYSIN = &STR( AND A.DCREATOR = '&DB2DBASE') PUTFILE SYSIN SET SYSIN = &STR( AND A.BNAME = B.TBNAME) PUTFILE SYSIN SET SYSIN = &STR( AND (A.DNAME = '&TVNAME' OR A.BNAME = '&TVNAME')) PUTFILE SYSIN SET SYSIN = &STR( ORDER BY B.COLNO;) PUTFILE SYSIN CLOSFILE SYSIN FREE DDNAME(SYSIN) ALLOC DD(SYSIN) + DSN(SYSIN) + SHR KEEP DSN SYSTEM(&DB2S) RUN PROGRAM(DSNTEP2) PLAN(DSNTEP2) END FREE ATTRLIST(ATTRIB1) FREE ATTRLIST(ATTRIB2) FREE DDNAME(SYSPRINT) FREE DDNAME(SYSIN) ALLOC DD(SYSPRINT) + DSN(SYSPRINT) + SHR KEEP ERROR + DO SET ERRCC = &LASTCC IF &ERRCC = 400 THEN + DO SET EOF = YES RETURN END ELSE + DO WRITE *** PROBLEM WITH CLIST DB2LOAD *** WRITE *** RETURN CODE = &ERRCC *** WRITE *** IN SECTION : ISPFLOAD *** GOTO FINAL END END SET EOF = NO SET COL1 = SET COL2 = OPENFILE SYSPRINT INPUT GETFILE SYSPRINT DO WHILE &EOF = NO IF &SYSINDEX(&STR(_|),&STR(&SYSPRINT)) = 10 THEN + DO SET FIELD = &SUBSTR(55:72,&STR(&SYSPRINT)) SET FIELD = &FIELD SET FLEN = &SUBSTR(86:95,&STR(&SYSPRINT)) SET FLEN = &FLEN SET TYPE = &SUBSTR(76:83,&STR(&SYSPRINT)) SET TYPE = &TYPE SET DB2SCALE = &SUBSTR(99:107,&STR(&SYSPRINT)) SET DB2SCALE = &DB2SCALE SET NULLS = &SUBSTR(111:111,&STR(&SYSPRINT)) SET NULLS = &NULLS SET KEY = &SUBSTR(119:127,&STR(&SYSPRINT)) SET KEY = &KEY IF &KEY < 1 THEN SET KEY = IF &KEY > OR &NULLS = N THEN + SELECT &STR(&TYPE) WHEN (CHAR) SET DEFAULT = &STR(' ') WHEN (VARCHAR) SET DEFAULT = &STR(' ') WHEN (LONG VARCHAR) SET DEFAULT = &STR(' ') WHEN (INTEGER) SET DEFAULT = &STR(0) WHEN (SMALLINT) SET DEFAULT = &STR(0) WHEN (DECIMAL) SET DEFAULT = &STR(0) WHEN (FLOAT) SET DEFAULT = &STR(0) WHEN (DATE) SET DEFAULT = + &STR(CURRENT DATE) WHEN (TIME) SET DEFAULT = + &STR(CURRENT TIME) WHEN (TIMESTMP) SET DEFAULT = + &STR(CURRENT TIMESTAMP) END SELECT &STR(&FIELD) WHEN (ADD_USER) SET DEFAULT = &STR('&SYSUID') WHEN (UPDATE_USER) SET DEFAULT = &STR('&SYSUID') END IF &NULLS = N THEN SET NULLS = &STR(NOT NULL) ELSE + DO SET NULLS = SET DEFAULT = END ISPEXEC TBADD $$$$D2TL END GETFILE SYSPRINT END ERROR OFF CLOSFILE SYSPRINT FREE DDNAME(SYSPRINT) ISPEXEC TBTOP $$$$D2TL GOTO MAIN0003 /********************************************************************/ /* LOAD THE DB2 TABLE FROM THE FLAT FILE. */ /********************************************************************/ PROCESS: + ISPEXEC TBTOP $$$$D2TL SET ZEDLMSG = &STR(*** PREPARING JCL TO LOAD "&TVNAME" ***) ISPEXEC SETMSG MSG(UTLZ000) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY PANEL(DB2LOAD) TSOPXSET * ACCNT(TSO) SET LOADTYPE = N LISTDSI '&LOADDSN' SET LRECL = &SYSLRECL SET PRIMARY = &SYSPRIMARY SET SECOND = &SYSSECONDS IF &SECOND = THEN SET SECONDS = &SYSPRIMARY / 2 IF &SYSUNITS = CYLINDER THEN + DO SET SPCEUNIT = CYL IF &PRIMARY > 0 AND &PRIMARY < 41 THEN + DO SET SORTNUM = 3 SET SORTSPCE = 13 END IF &PRIMARY > 40 AND &PRIMARY < 141 THEN + DO SET SORTNUM = 4 SET SORTSPCE = 35 END IF &PRIMARY > 140 AND &PRIMARY < 361 THEN + DO SET SORTNUM = 6 SET SORTSPCE = 60 END IF &PRIMARY > 360 AND &PRIMARY < 601 THEN + DO SET SORTNUM = 6 SET SORTSPCE = 100 END IF &PRIMARY > 600 AND &PRIMARY < 901 THEN + DO SET SORTNUM = 6 SET SORTSPCE = 150 END END IF &SYSUNITS = BLOCK THEN + DO SET PRIMARY = &SYSBLKSIZE SET SECOND = &SYSBLKSIZE / 2 SET SPCEUNIT = BLK IF &PRIMARY > 0 AND &PRIMARY < 2401 THEN + DO SET SORTNUM = 3 SET SORTSPCE = 800 END IF &PRIMARY > 2400 AND &PRIMARY < 8401 THEN + DO SET SORTNUM = 4 SET SORTSPCE = 2100 END IF &PRIMARY > 8400 AND &PRIMARY < 21601 THEN + DO SET SORTNUM = 6 SET SORTSPCE = 3600 END IF &PRIMARY > 21600 AND &PRIMARY < 36001 THEN + DO SET SORTNUM = 6 SET SORTSPCE = 6000 END IF &PRIMARY > 36000 AND &PRIMARY < 54001 THEN + DO SET SORTNUM = 6 SET SORTSPCE = 9000 END END IF &SYSUNITS = TRACK THEN + DO SET SPCEUNIT = TRK IF &PRIMARY > 0 AND &PRIMARY < 615 THEN + DO SET SORTNUM = 3 SET SORTSPCE = 195 END IF &PRIMARY > 614 AND &PRIMARY < 2115 THEN + DO SET SORTNUM = 4 SET SORTSPCE = 525 END IF &PRIMARY > 2114 AND &PRIMARY < 5415 THEN + DO SET SORTNUM = 6 SET SORTSPCE = 900 END IF &PRIMARY > 5414 AND &PRIMARY < 9015 THEN + DO SET SORTNUM = 6 SET SORTSPCE = 1500 END IF &PRIMARY > 9154 AND &PRIMARY < 13515 THEN + DO SET SORTNUM = 6 SET SORTSPCE = 2250 END END IF &JCLREVEW = Y THEN + DO DELETE TEMP.JCL FREE DDNAME(ISPFILE) FREE DDNAME(QUICK) FREE ATTRLIST(ATTRIB1) ATTRIB ATTRIB1 + RECFM(F B) + LRECL(80) + DSORG(PS) + BLKSIZE(23440) + OUTPUT ALLOCATE DDNAME(QUICK) + DSN(TEMP.JCL) + NEW CATALOG + UNIT(SYSDA) + SPACE(1,1) TRACKS RELEASE + USING(ATTRIB1) FREE DDNAME(QUICK) ALLOCATE DDNAME(ISPFILE) + DSN(TEMP.JCL) + OLD ISPEXEC FTOPEN ISPEXEC FTINCL DB2LOAD SET SAVECC = &LASTCC ISPEXEC FTCLOSE FREE DDNAME(ISPFILE) IF &SAVECC > 0 THEN + DO SET ZEDLMSG = &STR(*** UNABLE TO CREATE JCL TO LOAD + THE TABLE *** RC = &SAVECC ***) ISPEXEC SETMSG MSG(UTLZ001) END ELSE + DO ISPEXEC SETMSG MSG(UTILM030) ISPEXEC EDIT DATASET(TEMP.JCL) END END ELSE + DO ISPEXEC VGET (ZTEMPF) ISPEXEC FTOPEN TEMP ISPEXEC FTINCL DB2LOAD SET SAVECC = &LASTCC ISPEXEC FTCLOSE IF &SAVECC > 0 THEN + DO SET ZEDLMSG = &STR(*** UNABLE TO CREATE JCL TO LOAD + THE TABLE *** RC = &SAVECC ***) ISPEXEC SETMSG MSG(UTLZ001) END ELSE + DO SET ZEDLMSG = &STR(*** "&SYSUID.L" SUBMITTED TO LOAD + "&TVNAME" ***) ISPEXEC SETMSG MSG(UTLZ000) SUBMIT '&ZTEMPF' END END SET JCLREVEW = N GOTO MAINEXIT HELPSEC: + 02480000 ISPEXEC SELECT PGM(ISPTUTOR) PARM(UTILH076) 02490000 SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR DB2LOAD UTILITY + 02490000 *** NO PROCESSING PERFORMED ***) 02490000 ISPEXEC SETMSG MSG(UTLZ000) 02490000 EXIT ./ ADD NAME=DB2SECTY /* REXX ***************************************************************/ /* UTILITY: DB2SECTY */ /* AUTHOR: DAVID LEIGH */ /* FUNCTION: THIS EDIT MACRO GOES THROUGH THE OUTPUT OF A PLATINUM */ /* RC/SECURE CONSISTANCY REPORT AND GENERATES GRANTS AND */ /* REVOKES TO MAKE RC/SECURE AGREE WITH DB2. */ /**********************************************************************/ ADDRESS ISPEXEC 'CONTROL ERRORS RETURN' ADDRESS ISREDIT "MACRO" SYNCOUNT = 0 "FIND FIRST P'=' 1" DO WHILE RC = 0 "(LINE) = LINE .ZCSR" PARSE UPPER VAR LINE X1 X2 X3 X4 X5 X6 X7 X8 . SELECT WHEN X1 = 'ON' THEN DO OBJNAME = X3 AUTHID = X5 END WHEN X2 = 'RCS-SRS:' THEN DO IF X4 = 'AUTHORITIES' THEN GNTREV = 'REVOKE' ELSE DO GNTREV = 'GRANT' IF X3 = 'G' THEN WGRANT = 'WITH GRANT' ELSE WGRANT = '' THEAUTH = X4 QUEUE GNTREV THEAUTH 'ON' OBJNAME 'TO' AUTHID WGRANT ';' SYNCOUNT = SYNCOUNT + 10 QUEUE '.SYNC' SYNCOUNT END END WHEN X2 = 'DB2:' THEN DO IF X4 = 'AUTHORITIES' THEN GNTREV = 'GRANT' ELSE DO GNTREV = 'REVOKE' THEAUTH = X4 QUEUE GNTREV THEAUTH 'ON' OBJNAME 'FROM' AUTHID ';' SYNCOUNT = SYNCOUNT + 10 QUEUE '.SYNC' SYNCOUNT END END WHEN X3 = '<======' THEN DO IF GNTREV = 'GRANT' THEN DO IF X1 = 'G' THEN WGRANT = 'WITH GRANT' ELSE WGRANT = '' THEAUTH = X2 QUEUE GNTREV THEAUTH 'ON' OBJNAME 'TO' AUTHID WGRANT ';' SYNCOUNT = SYNCOUNT + 10 QUEUE '.SYNC' SYNCOUNT END ELSE DO THEAUTH = X2 QUEUE GNTREV THEAUTH 'ON' OBJNAME 'FROM' AUTHID ';' SYNCOUNT = SYNCOUNT + 10 QUEUE '.SYNC' SYNCOUNT END END END "FIND NEXT P'=' 1" END IF QUEUED() > 1 THEN DO I = QUEUED() DO I = 1 TO QUEUED() PULL LINE "LINE_BEFORE .ZLAST = (LINE)" END END ./ ADD NAME=DB2TABL PROC 0 /**** 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 /*******************************************************************/ /* CLIST : DB2TABL */ /* CREATED BY : DAVID LEIGH */ /* DATE : 6-9-89 */ /* DESCRIPTION : THIS CLIST ALLOWS THE USER TO LOAD DB2 TABLES */ /* INTERACTIVELY OR IN BATCH FROM A DATASET. */ /*******************************************************************/ /********************************************************************/ /* HANDLE ALL ERRORS HERE */ /********************************************************************/ ISPEXEC CONTROL ERRORS CANCEL /********************************************************************/ /* SET INITIAL VARIABLES FOR USE IN THIS CLIST - MAKE CHANGES HERE! */ /********************************************************************/ ISPEXEC TBOPEN PROJECT NOWRITE ISPEXEC TBVCLEAR PROJECT SET TESTPROD = T SET PRJELEM = DB2 SET PRJPARM = SUBSYSTEM ISPEXEC TBSCAN PROJECT ARGLIST(TESTPROD,PRJELEM,PRJPARM) + CONDLIST(EQ,EQ,EQ) SET DB2S = &PRJQUAL ISPEXEC TBTOP PROJECT SET PRJPARM = DATABASE ISPEXEC TBSCAN PROJECT ARGLIST(TESTPROD,PRJELEM,PRJPARM) + CONDLIST(EQ,EQ,EQ) SET DB2DBASE = &PRJQUAL ISPEXEC TBTOP PROJECT SET PRJQUAL = LOADLIB ISPEXEC TBSCAN PROJECT ARGLIST(TESTPROD,PRJELEM,PRJQUAL) + CONDLIST(EQ,EQ,EQ) SET DB2LLIB = &PRJPARM ISPEXEC TBEND PROJECT ISPEXEC VGET ODSN PROFILE IF &ODSN > THEN SET DISCDSN = &STR(&ODSN(+1)) ELSE SET DISCDSN = SET TVNAME = SET LOADTYPE = SET FCOMP = N SET LOADDSN = SET SAVEDSN = &STR(________.________.________.________) SET SORTDSN = SET LSCROLL = SET SCNUM = SET SCALE = SET IMAGE = SET FSTG = SET PREVNEXT = SET BREC = SET EREC = SET INCR = SET SAVETVNA = &STR(________) SET EDITYN = N SET LPAREN = &STR(( SET RPAREN = &STR()) SET ZTDSELS = &STR(0000) /********************************************************************/ /* CREATE THE TEMPORARY TABLE. */ /********************************************************************/ ISPEXEC TBCREATE $$$$D2TL WRITE + NAMES(FIELD COL1 COL2 FLEN TYPE KEY DEFAULT DB2SCALE NULLS) /********************************************************************/ /********************************************************************/ /* M A I N L I N E */ /********************************************************************/ /********************************************************************/ MAINLINE: + ISPEXEC VPUT (TVNAME LOADTYPE SORTDSN LOADDSN FCOMP LSCROLL SCNUM + SCALE IMAGE DB2S DB2DBASE FSTG BREC EREC INCR + LINENUM PREVNEXT EDITYN) SHARED ISPEXEC TBDISPL $$$$D2TL PANEL(DB2TABL) SET SAVECC = &LASTCC ISPEXEC VGET (TVNAME LOADTYPE SORTDSN LOADDSN FCOMP LSCROLL SCNUM + SCALE IMAGE DB2S DB2DBASE FSTG BREC EREC INCR + LINENUM PREVNEXT EDITYN) SHARED SET SYSDVAL = &STR(&ZCMD) READDVAL XCMD OPT1 OPT2 OPT3 OPT4 OPT5 OPT6 OPT7 OPT8 OPT9 OPT10 OPT11 /********************************************************************/ /* BRANCH TO SECTIONS TO HANDLE ENTERED COMMAND */ /********************************************************************/ MAIN0001: + IF &ZTDSELS > &STR(0000) THEN GOTO ROWSEC MAIN0002: + IF &SAVECC > 7 THEN GOTO FINAL IF &TVNAME > AND &TVNAME ¬= &SAVETVNA THEN GOTO ISPFLOAD MAIN0003: + IF &LSCROLL > AND &FSTG > AND &LOADDSN > THEN + DO SET ZEDLMSG = &STR(*** CANNOT BOTH "SCROLL" AND "FIND" ***) ISPEXEC SETMSG MSG(UTLZ001) GOTO MAINEXIT END IF &LSCROLL > AND &LOADDSN = THEN + DO SET ZEDLMSG = &STR(*** NO LOAD DATASET, SCROLL IGNORED ***) ISPEXEC SETMSG MSG(UTLZ000) SET LSCROLL = SET SCNUM = END SELECT &STR(&LSCROLL) WHEN (U) GOTO UPSCRL WHEN (D) GOTO DOWNSCRL WHEN (L) GOTO LEFTSCRL WHEN (R) GOTO RGHTSCRL END IF &LOADTYPE > THEN GOTO PROCESS IF &LOADDSN > AND &LOADFILE = OR + &LOADDSN > AND &LOADDSN ¬= &SAVEDSN THEN GOTO FILEALOC IF &NRSTR(&FSTG) > AND &LOADDSN = THEN + DO SET ZEDLMSG = &STR(*** NO LOAD DATASET, FIND IGNORED ***) ISPEXEC SETMSG MSG(UTLZ000) SET FSTG = GOTO MAINEXIT END IF &NRSTR(&FSTG) > THEN GOTO FINDSEC IF &SORTDSN > AND &EDITYN = Y THEN GOTO EDITSORT MAINEXIT: + IF &STR(&ZCMD) = THEN + DO ISPEXEC TBTOP $$$$D2TL ISPEXEC TBSKIP $$$$D2TL NUMBER(&ZTDTOP) ISPEXEC VGET (ZVERB ZSCROLLN) IF &ZVERB = &STR(UP) THEN + ISPEXEC TBSKIP $$$$D2TL NUMBER(-&ZSCROLLN) IF &ZVERB = &STR(DOWN) THEN + ISPEXEC TBSKIP $$$$D2TL NUMBER(&ZSCROLLN) END SET ZCMD = IF &SAVECC > 7 THEN GOTO FINAL GOTO MAINLINE /********************************************************************/ /********************************************************************/ /* F I N A L I Z A T I O N */ /********************************************************************/ /********************************************************************/ FINAL: + ERROR RETURN CLOSFILE LOADFILE ERROR OFF ISPEXEC TBEND $$$$D2TL ISPEXEC LIBDEF ISPTABL EXIT /********************************************************************/ /********************************************************************/ /* S U B R O U T I N E S */ /********************************************************************/ /********************************************************************/ /********************************************************************/ /* PROCESS PENDING SELECTED ROWS */ /********************************************************************/ ROWSEC: + DO WHILE &ZTDSELS ¬= &STR(0000) SET ZEDLMSG = IF &COL2 = AND &COL1 = AND &NRSTR(&DEFAULT) = AND + &NRSTR(&NULLS) = &STR(NOT NULL) THEN + DO SET ZEDLMSG = &STR("NOT NULL" COLUMNS MUST HAVE A DEFAULT + OR A COLUMN NUMBER SPECIFICATION) ISPEXEC SETMSG MSG(UTLZ001) END IF &COL2 < &COL1 THEN + DO SET ZEDLMSG = &STR(COLUMN 2 MUST BE + GREATER THAN OR EQUAL TO COLUMN 1) ISPEXEC SETMSG MSG(UTLZ001) END IF &EVAL(&COL2 - &COL1 + 1) > &FLEN THEN + DO SET ZEDLMSG = &STR(LOAD FIELD LENGTH GREATER THAN + DEFINED FIELD LENGTH FOR "&FIELD") ISPEXEC SETMSG MSG(UTLZ001) END IF &STR(&ZEDLMSG) = THEN ISPEXEC TBPUT $$$$D2TL IF &ZTDSELS > &STR(0001) THEN ISPEXEC TBDISPL $$$$D2TL ELSE SET ZTDSELS = &STR(0000) END GOTO MAIN0002 /********************************************************************/ /* OPEN THE LOAD FILE, DEFINE THE SCALE AND GET THE FIRST ROW */ /********************************************************************/ FILEALOC: + SET SAVEDSN = &LOADDSN ERROR RETURN CLOSFILE LOADFILE ERROR OFF LISTDSI '&LOADDSN' IF &LASTCC > 0 THEN + DO SET ZEDLMSG = &STR("&LOADDSN" PROBLEM : &SYSDSN('&LOADDSN')) ISPEXEC SETMSG MSG(UTLZ001) SET LOADDSN = GOTO MAINEXIT END SET X = 50 SET SC = &STR(----+----1----+----2----+----3----+----4----+----5) DO WHILE &X < &SYSLRECL SET SC = &STR(&SC----+----6----+----7----+----8----+----9----+----0) SET SC = &STR(&SC----+----1----+----2----+----3----+----4----+----5) SET X = &X + 100 END IF &SYSLRECL > 79 THEN SET ENDCOL = 79 ELSE SET ENDCOL = &SYSLRECL SET SCALE = &SUBSTR(1:&ENDCOL,&STR(&SC)) FREE DDNAME(LOADFILE) ALLOC DDNAME(LOADFILE) + DSN('&LOADDSN') + SHR KEEP ERROR + DO SET ERRCC = &LASTCC IF &ERRCC = 400 THEN + DO SET EOF = YES SET ZEDLMSG = &STR(*** "&LOADDSN" IS EMPTY ***) ISPEXEC SETMSG MSG(UTLZ001) SET LOADDSN = SET LOADFILE = GOTO MAINEXIT END ELSE + DO WRITE *** PROBLEM WITH CLIST DB2TABL *** WRITE *** RETURN CODE = &ERRCC *** WRITE *** IN SECTION : FILEALOC *** GOTO FINAL END END SET EOF = NO OPENFILE LOADFILE INPUT GETFILE LOADFILE ERROR OFF SET DATALEN = &LENGTH(&NRSTR(&LOADFILE)) IF &DATALEN > &ENDCOL THEN + SET IMAGE = &SUBSTR(1:&ENDCOL,&NRSTR(&LOADFILE)) ELSE + SET IMAGE = &SUBSTR(1:&DATALEN,&NRSTR(&LOADFILE)) SET BEGCOL = 1 SET LINENUM = 1 SET SAVEDSN = &LOADDSN SET PREVNEXT = N SET BREC = 1 SET EREC = 9999999 SET INCR = 1 GOTO MAINEXIT /********************************************************************/ /* SCROLL THE LOAD FILE UPWARDS */ /********************************************************************/ UPSCRL: + IF &LINENUM = 1 THEN + DO SET ZEDLMSG = &STR(*** TOP OF LOAD FILE ***) ISPEXEC SETMSG MSG(UTLZ000) GOTO MAINEXIT END IF &SCNUM < 1 THEN SET SCNUM = 1 SET LINENUM = &LINENUM - &SCNUM IF &LINENUM < 1 THEN SET LINENUM = 1 SET X = 0 CLOSFILE LOADFILE OPENFILE LOADFILE INPUT DO WHILE &X < &LINENUM GETFILE LOADFILE SET X = &X + 1 END SET DATALEN = &LENGTH(&NRSTR(&LOADFILE)) IF &DATALEN > &ENDCOL THEN + SET IMAGE = &SUBSTR(&BEGCOL:&ENDCOL,&NRSTR(&LOADFILE)) ELSE + SET IMAGE = &SUBSTR(&BEGCOL:&DATALEN,&NRSTR(&LOADFILE)) SET LSCROLL = GOTO MAINEXIT /********************************************************************/ /* SCROLL THE LOAD FILE DOWNWARDS */ /********************************************************************/ DOWNSCRL: + ERROR + DO SET ERRCC = &LASTCC IF &ERRCC = 400 THEN + DO SET EOF = YES RETURN END ELSE + DO WRITE *** PROBLEM WITH CLIST DB2TABL *** WRITE *** RETURN CODE = &ERRCC *** WRITE *** IN SECTION : DOWNSCRL *** GOTO FINAL END END IF &SCNUM < 1 THEN SET SCNUM = 1 SET X = 0 DO WHILE &X < &SCNUM AND &EOF = NO GETFILE LOADFILE SET LINENUM = &LINENUM + 1 SET X = &X + 1 END ERROR OFF IF &EOF = YES THEN + DO SET LINENUM = &LINENUM - 1 SET ZEDLMSG = &STR(*** BOTTOM OF LOAD FILE ***) ISPEXEC SETMSG MSG(UTLZ000) END SET DATALEN = &LENGTH(&NRSTR(&LOADFILE)) IF &DATALEN > &ENDCOL THEN + SET IMAGE = &SUBSTR(&BEGCOL:&ENDCOL,&NRSTR(&LOADFILE)) ELSE + SET IMAGE = &SUBSTR(&BEGCOL:&DATALEN,&NRSTR(&LOADFILE)) SET LSCROLL = GOTO MAINEXIT /********************************************************************/ /* SCROLL THE LOAD FILE LEFT */ /********************************************************************/ LEFTSCRL: + IF &BEGCOL = 1 THEN + DO SET ZEDLMSG = &STR(*** ALREADY AT LOAD FILE LEFT BOUNDRY ***) ISPEXEC SETMSG MSG(UTLZ000) END ELSE + DO IF &SCNUM < 1 THEN SET SCNUM = 79 SET X = &BEGCOL - &SCNUM IF &X < 1 THEN + DO SET SCNUM = &X + &SCNUM - 1 SET &BEGCOL = &BEGCOL - &SCNUM END ELSE + SET &BEGCOL = &BEGCOL - &SCNUM SET &ENDCOL = &ENDCOL - &SCNUM END SET SCALE = &SUBSTR(&BEGCOL:&ENDCOL,&STR(&SC)) SET DATALEN = &LENGTH(&NRSTR(&LOADFILE)) IF &DATALEN > &ENDCOL THEN + SET IMAGE = &SUBSTR(&BEGCOL:&ENDCOL,&NRSTR(&LOADFILE)) ELSE + SET IMAGE = &SUBSTR(&BEGCOL:&DATALEN,&NRSTR(&LOADFILE)) SET LSCROLL = GOTO MAINEXIT /********************************************************************/ /* SCROLL THE LOAD FILE RIGHT */ /********************************************************************/ RGHTSCRL: + IF &ENDCOL = &SYSLRECL THEN + DO SET ZEDLMSG = &STR(*** ALREADY AT LOAD FILE RIGHT BOUNDRY ***) ISPEXEC SETMSG MSG(UTLZ000) END ELSE + DO IF &SCNUM < 1 THEN SET SCNUM = 79 SET X = &ENDCOL + &SCNUM IF &X > &SYSLRECL THEN + DO SET SCNUM = &SYSLRECL - &ENDCOL SET ENDCOL = &ENDCOL + &SCNUM END ELSE + SET ENDCOL = &ENDCOL + &SCNUM SET BEGCOL = &BEGCOL + &SCNUM END SET SCALE = &SUBSTR(&BEGCOL:&ENDCOL,&STR(&SC)) SET DATALEN = &LENGTH(&NRSTR(&LOADFILE)) IF &DATALEN > &ENDCOL THEN + SET IMAGE = &SUBSTR(&BEGCOL:&ENDCOL,&NRSTR(&LOADFILE)) ELSE + SET IMAGE = &SUBSTR(&BEGCOL:&DATALEN,&NRSTR(&LOADFILE)) SET LSCROLL = GOTO MAINEXIT /********************************************************************/ /* FIND A STRING IN THE FILE */ /********************************************************************/ FINDSEC: + IF &PREVNEXT ¬= N AND &PREVNEXT ¬= P THEN SET &PREVNEXT = N IF &PREVNEXT = P THEN + DO IF &LINENUM = 1 THEN + DO SET ZEDLMSG = &STR(*** TOP OF LOAD FILE ***) ISPEXEC SETMSG MSG(UTLZ001) GOTO MAINEXIT END CLOSFILE LOADFILE OPENFILE LOADFILE INPUT SET X = 0 SET Y = 0 SET LINENUM = &LINENUM - 1 SET ZEDLMSG = DO WHILE &X < &LINENUM SET X = &X + 1 GETFILE LOADFILE IF &SYSINDEX(&NRSTR(&FSTG),&NRSTR(&LOADFILE)) > 0 THEN + DO SET ZEDLMSG = &STR(*** FOUND "&NRSTR(&FSTG)" ***) ISPEXEC SETMSG MSG(UTLZ000) SET Y = &X END END SET LINENUM = &LINENUM + 1 IF &Y > 0 THEN + DO CLOSFILE LOADFILE OPENFILE LOADFILE INPUT SET X = 0 DO WHILE &X < &Y SET X = &X + 1 GETFILE LOADFILE END SET LINENUM = &X END ELSE + DO SET ZEDLMSG = &STR(*** "&NRSTR(&FSTG)" NOT FOUND ***) ISPEXEC SETMSG MSG(UTLZ001) END END ELSE + DO ERROR DO SET ERRCC = &LASTCC IF &ERRCC = 400 THEN + DO SET EOF = YES SET ZEDLMSG = &STR(*** END OF FILE REACHED ***) ISPEXEC SETMSG MSG(UTLZ001) RETURN END ELSE + DO WRITE *** PROBLEM WITH CLIST DB2TABL *** WRITE *** RETURN CODE = &ERRCC *** GOTO FINAL END END SET EOF = NO SET X = 0 SET Y = 0 SET ZEDLMSG = GETFILE LOADFILE DO WHILE &EOF = NO AND &STR(&ZEDLMSG) = SET X = &X + 1 IF &SYSINDEX(&NRSTR(&FSTG),&NRSTR(&LOADFILE)) > 0 THEN + DO SET ZEDLMSG = &STR(*** FOUND "&NRSTR(&FSTG)" ***) ISPEXEC SETMSG MSG(UTLZ000) SET LINENUM = &X END IF &LINENUM < &X THEN GETFILE LOADFILE END ERROR OFF IF &STR(&ZEDLMSG) = THEN + DO CLOSFILE LOADFILE OPENFILE LOADFILE INPUT SET X = 0 DO WHILE &X < &LINENUM SET X = &X + 1 GETFILE LOADFILE END END END SET DATALEN = &LENGTH(&NRSTR(&LOADFILE)) IF &DATALEN > &ENDCOL THEN + SET IMAGE = &SUBSTR(&BEGCOL:&ENDCOL,&NRSTR(&LOADFILE)) ELSE + SET IMAGE = &SUBSTR(&BEGCOL:&DATALEN,&NRSTR(&LOADFILE)) GOTO MAINEXIT /********************************************************************/ /* EDIT THE SORT CARDS DATASET */ /********************************************************************/ EDITSORT: + ISPEXEC EDIT DATASET('&SORTDSN') IF &LASTCC > 8 THEN + DO SET ZEDLMSG = &STR("&SORTDSN" PROBLEM : &SYSDSN('&SORTDSN')) ISPEXEC SETMSG MSG(UTLZ001) END GOTO MAINEXIT /********************************************************************/ /* LOAD THE ISPF TABLE WITH THE DB2 TABLE INFORMATION */ /********************************************************************/ ISPFLOAD: + ISPEXEC CONTROL ERRORS RETURN ISPEXEC TBEND $$$$D2TL ISPEXEC TBCREATE $$$$D2TL WRITE + NAMES(FIELD COL1 COL2 FLEN TYPE KEY DEFAULT DB2SCALE NULLS) SET SAVETVNA = &TVNAME SET ZEDLMSG = &STR(*** LOADING THE TABLE DEFINITION FOR "&TVNAME" ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC SETMSG MSG(UTLZ000) ISPEXEC DISPLAY PANEL(DB2TABL) FREE ATTRLIST(ATTRIB1) ATTRIB ATTRIB1 OUTPUT + RECFM(F B) + LRECL(80) + BLKSIZE(23440) FREE ATTRLIST(ATTRIB2) ATTRIB ATTRIB2 OUTPUT + RECFM(F B) + LRECL(255) + BLKSIZE(23460) DELETE SYSPRINT FREE DDNAME(SYSPRINT) ALLOC DD(SYSPRINT) + DSN(SYSPRINT) + NEW CATALOG + UNIT(SYSDA) + SPACE(1,1) TRACKS RELEASE + USING(ATTRIB2) FREE DDNAME(SYSIN) DELETE SYSIN ALLOC DD(SYSIN) + DSN(SYSIN) + NEW CATALOG + UNIT(SYSDA) + SPACE(1,1) TRACKS RELEASE + USING(ATTRIB1) OPENFILE SYSIN OUTPUT SET SYSIN = &STR(SELECT B.TBNAME,) PUTFILE SYSIN SET SYSIN = &STR( A.DNAME,) PUTFILE SYSIN SET SYSIN = &STR( B.NAME,) PUTFILE SYSIN SET SYSIN = &STR( B.COLTYPE,) PUTFILE SYSIN SET SYSIN = &STR( B.LENGTH,) PUTFILE SYSIN SET SYSIN = &STR( B.SCALE,) PUTFILE SYSIN SET SYSIN = &STR( B.NULLS,) PUTFILE SYSIN SET SYSIN = &STR( B.KEYSEQ,) PUTFILE SYSIN SET SYSIN = &STR( B.COLNO) PUTFILE SYSIN SET SYSIN = &STR( FROM SYSIBM.SYSVIEWDEP A,) PUTFILE SYSIN SET SYSIN = &STR( SYSIBM.SYSCOLUMNS B) PUTFILE SYSIN SET SYSIN = &STR( WHERE B.TBCREATOR = '&DB2DBASE') PUTFILE SYSIN SET SYSIN = &STR( AND A.BCREATOR = '&DB2DBASE') PUTFILE SYSIN SET SYSIN = &STR( AND A.DCREATOR = '&DB2DBASE') PUTFILE SYSIN SET SYSIN = &STR( AND A.BNAME = B.TBNAME) PUTFILE SYSIN SET SYSIN = &STR( AND (A.DNAME = '&TVNAME' OR A.BNAME = '&TVNAME')) PUTFILE SYSIN SET SYSIN = &STR( ORDER BY B.COLNO;) PUTFILE SYSIN CLOSFILE SYSIN FREE DDNAME(SYSIN) ALLOC DD(SYSIN) + DSN(SYSIN) + SHR KEEP DSN SYSTEM(&DB2S) RUN PROGRAM(DSNTEP2) PLAN(DSNTEP2) END FREE ATTRLIST(ATTRIB1) FREE ATTRLIST(ATTRIB2) FREE DDNAME(SYSPRINT) FREE DDNAME(SYSIN) ALLOC DD(SYSPRINT) + DSN(SYSPRINT) + SHR KEEP ERROR + DO SET ERRCC = &LASTCC IF &ERRCC = 400 THEN + DO SET EOF = YES RETURN END ELSE + DO WRITE *** PROBLEM WITH CLIST DB2TABL *** WRITE *** RETURN CODE = &ERRCC *** WRITE *** IN SECTION : ISPFLOAD *** GOTO FINAL END END SET EOF = NO SET COL1 = SET COL2 = OPENFILE SYSPRINT INPUT GETFILE SYSPRINT DO WHILE &EOF = NO IF &SYSINDEX(&STR(_|),&STR(&SYSPRINT)) = 10 THEN + DO SET FIELD = &SUBSTR(55:72,&STR(&SYSPRINT)) SET FIELD = &FIELD SET FLEN = &SUBSTR(86:95,&STR(&SYSPRINT)) SET FLEN = &FLEN SET TYPE = &SUBSTR(76:83,&STR(&SYSPRINT)) SET TYPE = &TYPE SET DB2SCALE = &SUBSTR(99:107,&STR(&SYSPRINT)) SET DB2SCALE = &DB2SCALE SET NULLS = &SUBSTR(111:111,&STR(&SYSPRINT)) SET NULLS = &NULLS SET KEY = &SUBSTR(119:127,&STR(&SYSPRINT)) SET KEY = &KEY IF &KEY < 1 THEN SET KEY = IF &KEY > OR &NULLS = N THEN + SELECT &STR(&TYPE) WHEN (CHAR) SET DEFAULT = &STR(' ') WHEN (VARCHAR) SET DEFAULT = &STR(' ') WHEN (LONG VARCHAR) SET DEFAULT = &STR(' ') WHEN (INTEGER) SET DEFAULT = &STR(0) WHEN (SMALLINT) SET DEFAULT = &STR(0) WHEN (DECIMAL) SET DEFAULT = &STR(0) WHEN (FLOAT) SET DEFAULT = &STR(0) WHEN (DATE) SET DEFAULT = + &STR(DATE(CURRENT TIMESTAMP)) WHEN (TIME) SET DEFAULT = + &STR(TIME(CURRENT TIMESTAMP)) WHEN (TIMESTMP) SET DEFAULT = + &STR(CURRENT TIMESTAMP) END SELECT &STR(&FIELD) WHEN (ADD_USER) SET DEFAULT = &STR('&SYSUID') WHEN (UPDATE_USER) SET DEFAULT = &STR('&SYSUID') END IF &NULLS = N THEN SET NULLS = &STR(NOT NULL) ELSE SET NULLS = ISPEXEC TBADD $$$$D2TL END GETFILE SYSPRINT END ERROR OFF CLOSFILE SYSPRINT FREE DDNAME(SYSPRINT) ISPEXEC TBTOP $$$$D2TL GOTO MAIN0003 /********************************************************************/ /* LOAD THE DB2 TABLE FROM THE FLAT FILE. */ /********************************************************************/ PROCESS: + IF &LOADTYPE = B THEN + DO SET LOADTYPE = GOTO MAINEXIT END SET ZEDLMSG = &STR(*** LOADING DATA FROM "&LOADDSN" INTO "&TVNAME" ***) ISPEXEC SETMSG MSG(UTLZ000) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY PANEL(DB2TABL) IF &LOADTYPE = I THEN + DO SET LOADTYPE = SET INDSN = &LOADDSN IF &SORTDSN > THEN + DO SET INDSN = &SYSUID..SORTOUT FREE ATTRLIST(ATTRIB2) ATTRIB ATTRIB2 OUTPUT + RECFM(&SYSRECFM) + LRECL(&SYSLRECL) + BLKSIZE(&SYSBLKSIZE) FREE DDNAME(SORTIN) ALLOC DDNAME(SORTIN) + DSN('&LOADDSN') + SHR KEEP IF &SYSUNITS = BLOCK THEN + SET SYSUNITS = &STR(&SYSUNITS(&SYSBLKSIZE)) DELETE SORTOUT FREE DDNAME(SORTOUT) ALLOC DDNAME(SORTOUT) + DSN(SORTOUT) + NEW CATALOG + UNIT(SYSDA) + SPACE(&SYSPRIMARY,&SYSSECONDS) &SYSUNITS RELEASE + USING(ATTRIB2) FREE DDNAME(SYSIN) ALLOC DDNAME(SYSIN) + DSN('&SORTDSN') + SHR KEEP FREE DDNAME(SORTMSG) ALLOC DDNAME(SORTMSG) DUMMY FREE DDNAME(SYSOUT) ALLOC DDNAME(SYSOUT) DUMMY CALL 'SYS2A.LINKLIB(SYNCSORT)' FREE ATTRLIST(ATTRIB2) FREE DDNAME(SORTIN) FREE DDNAME(SORTOUT) FREE DDNAME(SORTMSG) FREE DDNAME(SYSOUT) FREE DDNAME(SYSIN) END GOTO NEXT FREE ATTRLIST(ATTRIB3) ATTRIB ATTRIB3 OUTPUT + RECFM(V B A) + LRECL(125) + BLKSIZE(23375) DELETE SYSUDUMP FREE DDNAME(SYSUDUMP) ALLOC DD(SYSUDUMP) + DSN(SYSUDUMP) + NEW CATALOG + UNIT(SYSDA) + SPACE(5,2) CYLINDERS RELEASE + USING(ATTRIB3) NEXT: + FREE ATTRLIST(ATTRIB2) ATTRIB ATTRIB2 OUTPUT + RECFM(F B) + LRECL(121) + BLKSIZE(23474) DELETE SYSOUT FREE DDNAME(SYSOUT) ALLOC DD(SYSOUT) + DSN(SYSOUT) + NEW CATALOG + UNIT(SYSDA) + SPACE(2,2) CYLINDERS RELEASE + USING(ATTRIB2) FREE ATTRLIST(ATTRIB1) ATTRIB ATTRIB1 OUTPUT + RECFM(F B) + LRECL(80) + BLKSIZE(23440) DELETE OUTFILE FREE DDNAME(OUTFILE) ALLOC DD(OUTFILE) + DSN(OUTFILE) + NEW CATALOG + UNIT(SYSDA) + SPACE(5,5) CYLINDERS RELEASE + USING(ATTRIB1) FREE DDNAME(INFILE) ALLOC DD(INFILE) + DSN('&INDSN') + SHR KEEP FREE DDNAME(SYSPRINT) ALLOC DD(SYSPRINT) DSN(*) FREE DDNAME(SYSABOUT) ALLOC DD(SYSABOUT) DSN(*) FREE DDNAME(SYSOUT) ALLOC DD(SYSOUT) DSN(*) ISPEXEC LIBDEF ISPLLIB ISPEXEC LIBDEF ISPLLIB DATASET ID(PDS.ISPLLIB) STEPLIB SET DSNAME('TFDTDAL.PDS.ISPLLIB' 'SYS2.COB2LIB') SET LRECL = &SYSLRECL ISPEXEC VPUT (TVNAME LRECL DB2DBASE) SHARED WRITE PROGRAM BEGINNING ISPEXEC SELECT PGM(DB2TABL) WRITE PGM RC = &LASTCC ISPEXEC LIBDEF ISPLLIB STEPLIB RESET END GOTO MAINEXIT /********************************************************************/ /* RESOLVE RELATIVE GDG NUMBERS. */ /********************************************************************/ GDGSEC: PROC 1 DSN SYSREF &DSN SET GDGRC = 0 SET LPAREN = &STR(( SET RPAREN = &STR()) SET A = &SYSINDEX(&STR(&LPAREN),&STR(&DSN)) SET C = &A - 1 SET A = &A + 1 SET D = &A + 1 SET B = &LENGTH(&STR(&DSN)) SET B = &B - 1 IF &B < 1 OR &C < 1 THEN GOTO GOBACK IF &A > 1 AND + &B > 0 AND + (&SUBSTR(&A:&A,&STR(&DSN)) = &STR(+) OR + &SUBSTR(&A:&A,&STR(&DSN)) = &STR(-) OR + &SUBSTR(&A:&A,&STR(&DSN)) = &STR(0) OR + &SUBSTR(&A:&A,&STR(&DSN)) = &STR(1) OR + &SUBSTR(&A:&A,&STR(&DSN)) = &STR(2) OR + &SUBSTR(&A:&A,&STR(&DSN)) = &STR(3) OR + &SUBSTR(&A:&A,&STR(&DSN)) = &STR(4) OR + &SUBSTR(&A:&A,&STR(&DSN)) = &STR(5) OR + &SUBSTR(&A:&A,&STR(&DSN)) = &STR(6) OR + &SUBSTR(&A:&A,&STR(&DSN)) = &STR(7) OR + &SUBSTR(&A:&A,&STR(&DSN)) = &STR(8) OR + &SUBSTR(&A:&A,&STR(&DSN)) = &STR(9)) THEN + DO SET GM = &SUBSTR(&A:&B,&STR(&DSN)) IF &SUBSTR(1:1,&STR(&GM)) = &STR(-) THEN + DO SET GDGRC = 8 GOTO GOBACK END ELSE + SELECT &STR(&GM) WHEN (&STR(+0)) SET GM = ZEROGEN WHEN (&STR(+1)) SET GM = NEXTGEN WHEN (&STR(0)) SET GM = ZEROGEN OTHERWISE SET GDGRC = 8 END IF GDGRC > 4 THEN GOTO GOBACK SET XDSN = &SUBSTR(1:&C,&STR(&DSN)) %GDGGEN DSN(&XDSN) IF &LASTCC > 4 THEN + DO SET GDGRC = 4 SET ZEDLMSG = &STR("&DSN" IS NOT + A GDG DATASET) GOTO GOBACK END ISPEXEC VGET &GM SHARED SET DSN = &STR(&XDSN..&GM) END GOBACK: END ./ ADD NAME=DB2UNLD PROC 0 HELP /**** 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 = HELP THEN GOTO HELPSEC /*******************************************************************/ /* CLIST : DB2UNLD */ /* CREATED BY : DAVID LEIGH */ /* DATE : 5-1-90 */ /* DESCRIPTION : THIS CLIST ALLOWS THE USER TO UNLOAD DB2 TABLES */ /* VIA THE DSNTAUIL SAMPLE PROGRAM. */ /*******************************************************************/ /********************************************************************/ /* HANDLE ALL ERRORS HERE */ /********************************************************************/ ISPEXEC CONTROL ERRORS CANCEL /********************************************************************/ /* SET INITIAL VARIABLES FOR USE IN THIS CLIST - MAKE CHANGES HERE! */ /********************************************************************/ ISPEXEC TBOPEN PROJECT NOWRITE ISPEXEC TBVCLEAR PROJECT SET PRJELEM = SYSOUT SET PRJQUAL = BOX ISPEXEC TBSCAN PROJECT ARGLIST(PRJELEM,PRJQUAL) + CONDLIST(EQ,EQ) SET BOX = &PRJPARM ISPEXEC TBTOP PROJECT SET TESTPROD = T SET PRJELEM = DB2 SET PRJPARM = SUBSYSTEM ISPEXEC TBSCAN PROJECT ARGLIST(TESTPROD,PRJELEM,PRJPARM) + CONDLIST(EQ,EQ,EQ) SET DB2S = &PRJQUAL ISPEXEC TBTOP PROJECT SET PRJPARM = DATABASE ISPEXEC TBSCAN PROJECT ARGLIST(TESTPROD,PRJELEM,PRJPARM) + CONDLIST(EQ,EQ,EQ) SET DB2DBASE = &PRJQUAL ISPEXEC TBTOP PROJECT SET PRJQUAL = LOADLIB ISPEXEC TBSCAN PROJECT ARGLIST(TESTPROD,PRJELEM,PRJQUAL) + CONDLIST(EQ,EQ,EQ) SET DB2LLIB = &PRJPARM ISPEXEC TBEND PROJECT TSOPXSET * ACCNT(TSO) SET JCLREVEW = N SET OUTDSN = SET LOADDSN = SET IMBEDPOS = SET PRINTPOS = SET DISPOS = X ISPEXEC VGET YMPRMNO PROFILE IF &YMPRMNO > THEN SET BOX = &YMPRMNO /********************************************************************/ /********************************************************************/ /* M A I N L I N E */ /********************************************************************/ /********************************************************************/ MAINLINE: + ISPEXEC VPUT (DB2S DB2DBASE TVNAME JCLREVEW OUTDSN BOX + IMBEDPOS PRINTPOS DISPOS LOADDSN) SHARED ISPEXEC DISPLAY PANEL(DB2UNLD) IF &LASTCC > 7 THEN + DO SET ZEDLMSG = &STR(*** "DB2UNLD" EXITED WITHOUT PROCESSING ***) ISPEXEC SETMSG MSG(UTLZ000) EXIT END ISPEXEC VGET (DB2S DB2DBASE TVNAME JCLREVEW OUTDSN BOX + IMBEDPOS PRINTPOS DISPOS LOADDSN) SHARED IF &STR(&LOADDSN) > AND &STR(&OUTDSN) > AND + &STR(&LOADDSN) = &STR(&OUTDSN) THEN + DO SET ZEDLMSG = &STR(*** THE OUTPUT DATASET AND THE DB2 LOAD + UTILITY DATASET CANNOT BE THE SAME) ISPEXEC SETMSG MSG(UTLZ001) GOTO MAINLINE END SET SAVETVNA = &TVNAME SET ZEDLMSG = &STR(*** VALIDATING "&TVNAME" IN DB2 ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC SETMSG MSG(UTLZ000) ISPEXEC DISPLAY PANEL(DB2UNLD) FREE ATTRLIST(ATTRIB1) ATTRIB ATTRIB1 OUTPUT + RECFM(F B) + LRECL(80) + BLKSIZE(23440) FREE ATTRLIST(ATTRIB2) ATTRIB ATTRIB2 OUTPUT + RECFM(F B) + LRECL(255) + BLKSIZE(23460) DELETE SYSPRINT FREE DDNAME(SYSPRINT) ALLOC DD(SYSPRINT) + DSN(SYSPRINT) + NEW CATALOG + UNIT(SYSDA) + SPACE(1,1) TRACKS RELEASE + USING(ATTRIB2) FREE DDNAME(SYSIN) DELETE SYSIN ALLOC DD(SYSIN) + DSN(SYSIN) + NEW CATALOG + UNIT(SYSDA) + SPACE(1,1) TRACKS RELEASE + USING(ATTRIB1) OPENFILE SYSIN OUTPUT SET SYSIN = &STR(SELECT DNAME) PUTFILE SYSIN SET SYSIN = &STR( FROM SYSIBM.SYSVIEWDEP) PUTFILE SYSIN SET SYSIN = &STR( WHERE BCREATOR = '&DB2DBASE') PUTFILE SYSIN SET SYSIN = &STR( AND DCREATOR = '&DB2DBASE') PUTFILE SYSIN SET SYSIN = &STR( AND (DNAME = '&TVNAME' OR BNAME = '&TVNAME')) PUTFILE SYSIN CLOSFILE SYSIN FREE DDNAME(SYSIN) ALLOC DD(SYSIN) + DSN(SYSIN) + SHR KEEP DSN SYSTEM(&DB2S) RUN PROGRAM(DSNTEP2) PLAN(DSNTEP2) END FREE ATTRLIST(ATTRIB1) FREE ATTRLIST(ATTRIB2) FREE DDNAME(SYSPRINT) FREE DDNAME(SYSIN) ALLOC DD(SYSPRINT) + DSN(SYSPRINT) + SHR KEEP ERROR + DO SET ERRCC = &LASTCC IF &ERRCC = 400 THEN + DO SET EOF = YES RETURN END ELSE + DO WRITE *** PROBLEM WITH CLIST DB2UNLD *** WRITE *** RETURN CODE = &ERRCC *** EXIT END END SET EOF = NO OPENFILE SYSPRINT INPUT GETFILE SYSPRINT DO WHILE &EOF = NO IF &SYSINDEX(&STR( 1_| ),&STR(&SYSPRINT)) = 56 THEN + DO SET TVNAME = &SUBSTR(61:78,&STR(&SYSPRINT)) SET TVNAME = &TVNAME SET EOF = YES END GETFILE SYSPRINT END ERROR OFF CLOSFILE SYSPRINT FREE DDNAME(SYSPRINT) IF &TVNAME = THEN + DO SET TVNAME = &SAVETVNA SET ZEDLMSG = &STR(*** "&TVNAME" IS NOT FOUND IN DB2 ***) ISPEXEC SETMSG MSG(UTLZ001) GOTO MAINLINE END SET X = &LENGTH(&STR(&TVNAME)) IF &X > 8 THEN SET X = 8 SET TVSHORT = &SUBSTR(1:&X,&STR(&TVNAME)) SET A = &SUBSTR(1:2,&STR(&SYSSDATE)) SET B = &SUBSTR(4:5,&STR(&SYSSDATE)) SET C = &SUBSTR(7:8,&STR(&SYSSDATE)) SET DATE = &STR(D&A&B&C) SET A = &SUBSTR(1:2,&STR(&SYSTIME)) SET B = &SUBSTR(4:5,&STR(&SYSTIME)) SET C = &SUBSTR(7:8,&STR(&SYSTIME)) SET TIME = &STR(T&A&B&C) SET TCLIST = &STR(&SYSUID..&DATE..&TIME..CLIST) IF &STR(&OUTDSN) > THEN SET X = &STR('&OUTDSN') ELSE SET X = TSOPDSNQ &X IF &LASTCC > 0 OR + &STR(&OUTDSN) = THEN + SET XUTDSN = &STR(&SYSUID..LOAD.&TVSHORT) ELSE + IF &LASTCC = 0 THEN + DO SET L = &LENGTH(&STR(&SYSXDSNAME)) SET L = &L - 1 SET XUTDSN = &SUBSTR(2:&L,&STR(&SYSXDSNAME)) END ELSE + SET XUTDSN = &STR(&SYSUID..LOAD.&TVSHORT) SET DSNLEN = &LENGTH(&STR(&XUTDSN)) IF &STR(&LOADDSN) > THEN SET X = &STR('&LOADDSN') ELSE SET X = TSOPDSNQ &X IF &LASTCC > 0 OR + &STR(&LOADDSN) = THEN + SET XOADDSN = &STR(&SYSUID..LOAD.POSITION.&TVSHORT) ELSE + IF &LASTCC = 0 THEN + DO SET L = &LENGTH(&STR(&SYSXDSNAME)) SET L = &L - 1 SET XOADDSN = &SUBSTR(2:&L,&STR(&SYSXDSNAME)) END ELSE + SET XOADDSN = &STR(&SYSUID..LOAD.POSITION.&TVSHORT) IF &JCLREVEW = Y THEN + DO DELETE TEMP.JCL FREE DDNAME(ISPFILE) FREE DDNAME(QUICK) FREE ATTRLIST(ATTRIB1) ATTRIB ATTRIB1 + RECFM(F B) + LRECL(80) + DSORG(PS) + BLKSIZE(23440) + OUTPUT ALLOCATE DDNAME(QUICK) + DSN(TEMP.JCL) + NEW CATALOG + UNIT(SYSDA) + SPACE(1,1) TRACKS RELEASE + USING(ATTRIB1) FREE DDNAME(QUICK) ALLOCATE DDNAME(ISPFILE) + DSN(TEMP.JCL) + OLD ISPEXEC FTOPEN ISPEXEC FTINCL DB2UNLD SET SAVECC = &LASTCC ISPEXEC FTCLOSE FREE DDNAME(ISPFILE) IF &SAVECC > 0 THEN + DO SET ZEDLMSG = &STR(*** UNABLE TO CREATE JCL TO UNLOAD + THE TABLE *** RC = &SAVECC ***) ISPEXEC SETMSG MSG(UTLZ001) END ELSE + DO ISPEXEC SETMSG MSG(UTILM030) ISPEXEC EDIT DATASET(TEMP.JCL) END END ELSE + DO ISPEXEC VGET (ZTEMPF) ISPEXEC FTOPEN TEMP ISPEXEC FTINCL DB2UNLD SET SAVECC = &LASTCC ISPEXEC FTCLOSE IF &SAVECC > 0 THEN + DO SET ZEDLMSG = &STR(*** UNABLE TO CREATE JCL TO UNLOAD + THE TABLE *** RC = &SAVECC ***) ISPEXEC SETMSG MSG(UTLZ001) END ELSE + DO SET ZEDLMSG = &STR(*** "&SYSUID.U" SUBMITTED TO UNLOAD + "&TVNAME" ***) ISPEXEC SETMSG MSG(UTLZ000) SUBMIT '&ZTEMPF' END END EXIT HELPSEC: + 02480000 ISPEXEC SELECT PGM(ISPTUTOR) PARM(UTILH074) 02490000 SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR DB2UNLD UTILITY + 02490000 *** NO PROCESSING PERFORMED ***) 02490000 ISPEXEC SETMSG MSG(ISRZ000) 02490000 EXIT ./ ADD NAME=DB2UTIL /**********************************************************************/ /* UTILITY: DB2UTIL */ /* AUTHOR: DAVID LEIGH */ /* FUNCTION: THIS UTILITY INVOKES PLATINUM'S RC/QUERY FOR A SPECIFIC */ /* DB2 SUBSYSTEM AND THEN TAKES THE USER DIRECTLY TO THE */ /* "SY" "UT" SCREEN TO SEE WHAT UTILITIES THAT DB2 KNOWS */ /* ABOUT FOR THAT SUBSYSTEM. */ /**********************************************************************/ PROC 1 DB2_SUBSYSTEM_ID ISPEXEC SELECT CMD(%SETVAR SYS RC &STR(&DB2_SUBSYSTEM_ID)) SET HIGHLVL = &STR(SYS3.PLATINUM.PROD) ALLOC FI(CTRANS) DA('&HIGHLVL..LOADLIB') SHR ALLOC FI(PTILIB) DA('&HIGHLVL..LOADLIB') SHR ALLOC FI(PTIXMSG) DA('&HIGHLVL..XMESSAGE') SHR ALLOC FI(PTIPARM) DA('&HIGHLVL..PARMLIB') SHR ISPEXEC LIBDEF ISPLLIB DATASET ID ('&HIGHLVL..LOADLIB') ISPEXEC LIBDEF ISPMLIB DATASET ID ('&HIGHLVL..SPFMLIB') ISPEXEC LIBDEF ISPPLIB DATASET ID ('&HIGHLVL..SPFPLIB') ISPEXEC LIBDEF ISPSLIB DATASET ID ('&HIGHLVL..SPFSLIB') ISPEXEC LIBDEF ISPTLIB DATASET ID ('&HIGHLVL..SPFTLIB') EXEC 'SYS2.ISPF.ISPCLIB(RSPINIT)' ISPEXEC SELECT PGM(PTLDRIVM) + PARM(CI=PTLGLBL/RCQ SY UT) + NEWAPPL(RC) PASSLIB ISPEXEC LIBDEF ISPLLIB ISPEXEC LIBDEF ISPMLIB ISPEXEC LIBDEF ISPPLIB ISPEXEC LIBDEF ISPSLIB ISPEXEC LIBDEF ISPTLIB ISPEXEC LIBDEF ISPTABL FREE FI(CTRANS PTILIB PTIPARM PTIXMSG) ./ ADD NAME=DDCONCAT /********************************************************************** /* UTILITY: DDCONCAT * /* AUTHOR: DAVID LEIGH * /* DATE: 11-26-90 * /* FUNCTION: RE-ALLOCATE THE SYSPROC AND ISPF DD'S AT TSO LOGON TO * /* ADD TO THE CONCATENATION BEFORE OR AFTER THE CURRENT * /* ALLOCATIONS * /********************************************************************** PROC 0 BSYSPROC() ASYSPROC() + BSYSEXEC() ASYSEXEC() + BSYSHELP() ASYSHELP() + BISPPLIB() AISPPLIB() + BISPTLIB() AISPTLIB() + BISPSLIB() AISPSLIB() + BISPMLIB() AISPMLIB() + BISPLLIB() AISPLLIB() DEBUG HELP IF &DEBUG = DEBUG THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH ASIS IF &HELP = HELP THEN GOTO HELPSEC /********************************************************************** /* GATHER SYSTEM ALLOCATION INFORMATION FROM LISTALC STATUS * /********************************************************************** SET SYSOUTTRAP = 500 LISTA ST SET SYSOUTTRAP = 0 /********************************************************************** /* SAVE IN OTHER VARS SINCE SOME TSO COMMANDS WIPE OUT SYSOUTLINE INFO* /********************************************************************** SET X = &SYSOUTLINE DO &I = 1 TO &SYSOUTLINE SET LINE&I = &&SYSOUTLINE&I END /********************************************************************** /* LOOP THROUGH THE VARIABLES AND PROCESS EACH DD AS IT COMES UP. * /********************************************************************** SET I = &I - 1 DO &J = 1 TO &I SET LINE = &&LINE&J SET TEMPDD = &STR(&LINE) IF &SUBSTR(1:2,&STR(&TEMPDD)) > THEN + DO IF &STR(&ALLDSN) > THEN SET ALLDSN = &STR(&ALLDSN '&DSN') ELSE SET ALLDSN = &STR('&DSN') SET X = &SYSINDEX(&STR( ),&STR(&TEMPDD)) - 1 IF &X < 1 THEN SET X = &LENGTH(&STR(&TEMPDD)) IF &X > 0 THEN SET DSN = &SUBSTR(1:&X,&STR(&TEMPDD)) END IF &SUBSTR(1:2,&STR(&TEMPDD)) = AND + &SUBSTR(3:3,&STR(&TEMPDD)) > THEN + DO SELECT /********************************************************************** /* SYSPROC REALLOCATION * /********************************************************************** WHEN (&CURRDD = SYSPROC AND + (&STR(&BSYSPROC) > OR + &STR(&ASYSPROC) > )) DO FREE DDNAME(SYSPROC) ALLOC DD(SYSPROC) + DSN(&BSYSPROC + &ALLDSN + &ASYSPROC) SHR WRITE *** SYSPROC ALLOCATION CC = &LASTCC *** END /********************************************************************** /* SYSEXEC REALLOCATION * /********************************************************************** WHEN (&CURRDD = SYSEXEC AND + (&STR(&BSYSEXEC) > OR + &STR(&ASYSEXEC) > )) DO FREE DDNAME(SYSEXEC) ALLOC DD(SYSEXEC) + DSN(&BSYSEXEC + &ALLDSN + &ASYSEXEC) SHR WRITE *** SYSEXEC ALLOCATION CC = &LASTCC *** END /********************************************************************** /* SYSHELP REALLOCATION * /********************************************************************** WHEN (&CURRDD = SYSHELP AND + (&STR(&BSYSHELP) > OR + &STR(&ASYSHELP) > )) DO FREE DDNAME(SYSHELP) ALLOC DD(SYSHELP) + DSN(&BSYSHELP + &ALLDSN + &ASYSHELP) SHR WRITE *** SYSHELP ALLOCATION CC = &LASTCC *** END /********************************************************************** /* ISPPLIB REALLOCATION * /********************************************************************** WHEN (&CURRDD = ISPPLIB AND + (&STR(&BISPPLIB) > OR + &STR(&AISPPLIB) > )) DO FREE DDNAME(&CURRDD) ALLOC DD(&CURRDD) + DSN(&BISPPLIB + &ALLDSN + &AISPPLIB) SHR WRITE *** &CURRDD ALLOCATION CC = &LASTCC *** END /********************************************************************** /* ISPTLIB REALLOCATION * /********************************************************************** WHEN (&CURRDD = ISPTLIB AND + (&STR(&BISPTLIB) > OR + &STR(&AISPTLIB) > )) DO FREE DDNAME(&CURRDD) ALLOC DD(&CURRDD) + DSN(&BISPTLIB + &ALLDSN + &AISPTLIB) SHR WRITE *** &CURRDD ALLOCATION CC = &LASTCC *** END /********************************************************************** /* ISPMLIB REALLOCATION * /********************************************************************** WHEN (&CURRDD = ISPMLIB AND + (&STR(&BISPMLIB) > OR + &STR(&AISPMLIB) > )) DO FREE DDNAME(&CURRDD) ALLOC DD(&CURRDD) + DSN(&BISPMLIB + &ALLDSN + &AISPMLIB) SHR WRITE *** &CURRDD ALLOCATION CC = &LASTCC *** END /********************************************************************** /* ISPSLIB REALLOCATION * /********************************************************************** WHEN (&CURRDD = ISPSLIB AND + (&STR(&BISPSLIB) > OR + &STR(&AISPSLIB) > )) DO FREE DDNAME(&CURRDD) ALLOC DD(&CURRDD) + DSN(&BISPSLIB + &ALLDSN + &AISPSLIB) SHR WRITE *** &CURRDD ALLOCATION CC = &LASTCC *** END /********************************************************************** /* ISPLLIB REALLOCATION * /********************************************************************** WHEN (&CURRDD = ISPLLIB AND + (&STR(&BISPLLIB) > OR + &STR(&AISPLLIB) > )) DO FREE DDNAME(&CURRDD) ALLOC DD(&CURRDD) + DSN(&BISPLLIB + &ALLDSN + &AISPLLIB) SHR WRITE *** &CURRDD ALLOCATION CC = &LASTCC *** END END SET CURRDD = &SUBSTR(3:10,&STR(&TEMPDD) SET X = &SYSINDEX(&STR( ),&STR(&CURRDD)) - 1 IF &X < 1 THEN SET X = &LENGTH(&STR(&CURRDD)) IF &STR(&CURRDD) > THEN + DO SET CURRDD = &SUBSTR(1:&X,&STR(&CURRDD)) SET ALLDSN = END END END EXIT HELPSEC: + SET PLUS = &STR(+ ) CLRSCRN WRITE *** HELP FOR "DDCONCAT" UTILITY *** WRITE WRITE DDCONCAT is a CLIST which allows the user to dynamically change the WRITE concatenation sequence of any of the following DDs during logon or while WRITE out of ISPF. WRITE WRITE SYSHELP WRITE SYSEXEC WRITE SYSPROC WRITE ISPPLIB WRITE ISPMLIB WRITE ISPSLIB WRITE ISPTLIB WRITE ISPLLIB WRITE WRITE It allows you to put one or more libraries before and/or after WRITE each one of these standard dd's. WRITE WRITE Note: you are responsible for whether any specific library can, in WRITE fact, be successfully concatenated to a given dd based on MVS WRITE restrictions on dataset concatenations and installation-specific WRITE restrictions. For example, Fidelity CLIST files are all defined WRITE VB 255. An FB 80 library ahead of this concatenation will cause WRITE any CLISTs executed in concatenation after the FB 80 library to WRITE ABEND. Also, some installation-specific ISPF commands can only be WRITE implemented by placing them in the first ISPTLIB library. If you WRITE place a different ISPTLIB library first, you may, in fact, nullify WRITE your ability to use these commands. WRITE WRITE DDCONCAT has 2 keyword parameters for each ISPF ddname and for WRITE SYSPROC. The names of these keywords are the ddname prefixed by WRITE an "A" or a "B". For example, the CLIST dd "SYSPROC" has the WRITE keywords "ASYSPROC" and "BSYSPROC" associated with it; the panel WRITE dd "ISPPLIB" has "AISPPLIB" and "BISPPLIB", etc. The "A" means WRITE "after" and the "B" means "before". WRITE WRITE Consequently, you put the library names which you want to place WRITE before the current xxxxxxx concatenation in the Bxxxxxxx keyword. WRITE To place CLIST library "ABC.DEF.CLIST" ahead of the concatenation WRITE in SYSPROC, you would invoke DDCONCAT as follows: WRITE WRITE %DDCONCAT BSYSPROC('''ABC.DEF.CLIST''') WRITE WRITE You may specify any or all of the keywords which DDCONCAT has in a WRITE single call to DDCONCAT (indeed, you SHOULD do this for WRITE efficiency's sake). WRITE WRITE DDCONCAT uses standard TSO dataset name qualification. This means WRITE that if you specify a dataset name in single quotes, it will be WRITE used as specified. If you do not specify the single quotes, your WRITE user id will be prefixed in front of the dataset name. In the WRITE above example, if you had specified BSYSPROC(ABC.DEF.CLIST), the WRITE actual dataset to be used would have been &SYSUID..ABC.DEF.CLIST. WRITE If you want to specify more than one dataset in a given keyword WRITE parameter, the entire keyword value must be in single quotes as WRITE well. WRITE WRITE Note that the use of single quotes in CLIST processing of a WRITE KEYWORD parameter (such as BSYSPROC, or AISPPLIB in this example) WRITE is not intuitively obvious. CLISTs interpret single quotes a WRITE little strangely when passed as part of parameters. In the above WRITE example, to maintain the single quotes around ABC.DEF.CLIST, three WRITE single quotes on each side were needed. The outer-most single WRITE quote encompasses the entire parameter, and the next two are then WRITE interpreted as one single quote. Note how they are used in the WRITE next example. WRITE WRITE For instance, if you wanted to place &SYSUID..GHI.JKL.ISPPLIB and WRITE MNO.PQR.ISPPLIB after the ISPPLIB concatenation, you would specify WRITE the command as follows: WRITE WRITE %DDCONCAT AISPPLIB('GHI.JKL.ISPPLIB ''MNO.PQR.ISPPLIB''') WRITE WRITE So, if you wanted to place all of your personal CLIST and ISPF WRITE libraries in the proper concatenations while logging on, you could WRITE call DDCONCAT in the following manner: WRITE WRITE %DDCONCAT BSYSPROC(PDS.CLIST) BISPPLIB(PDS.ISPPLIB) &STR(&PLUS) WRITE BISPTLIB(PDS.ISPTLIB) BISPMLIB(PDS.ISPMLIB) &STR(&PLUS) WRITE BISPSLIB(PDS.ISPSLIB) BISPLLIB(PDS.ISPLLIB) WRITE WRITE *** END OF HELP *** NO PROCESSING PERFORMED *** EXIT ./ ADD NAME=DEBUG /*** CHECK THE DEBUG SWITCH ***/ ISPEXEC VGET DBGSWTCH PROFILE IF &DBGSWTCH = ON THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS ./ ADD NAME=DEC2HEX /* REXX ***************************************************************/ /* */ /**********************************************************************/ PARSE UPPER ARG INDEC OUTHEX = D2X(INDEC) SAY OUTHEX ./ ADD NAME=DELDUPS ISREDIT MACRO (CL1,CL2,CL3,CL4,CL5,CL6,CL7,CL8,CL9,CL10,CL11,CL12) ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /**********************************************************************/ /* UTILITY NAME : DELDUPS */ /* DATE WRITTEN : 3-13-90 */ /* AUTHOR : DAVE LEIGH */ /* DESCRIPTION : DELETE DUPLICATE RECORDS IN A FILE. */ /*========================== MODIFICATIONS ===========================*/ /* WHO ³WHEN ³WHY */ /* --- ³---- ³--- */ /* ³ ³ */ /**********************************************************************/ IF &NRSTR(&CL1) = &NRSTR(HELP) THEN GOTO HELPSEC IF &NRSTR(&CL1) = THEN + DO ISREDIT (LRECL) = LRECL SET CL1 = 1 SET CL2 = &LRECL END IF (&NRSTR(&CL1) > AND &NRSTR(&CL2) = ) OR + (&NRSTR(&CL3) > AND &NRSTR(&CL4) = ) OR + (&NRSTR(&CL5) > AND &NRSTR(&CL6) = ) OR + (&NRSTR(&CL7) > AND &NRSTR(&CL8) = ) OR + (&NRSTR(&CL9) > AND &NRSTR(&CL10) = ) OR + (&NRSTR(&CL11) > AND &NRSTR(&CL12) = ) THEN + DO SET ZEDLMSG = &NRSTR(COLUMNS MUST BE SPECIFIED IN PAIRS, + EVEN IF THE SAME COLUMN) ISPEXEC SETMSG MSG(UTLZ001) EXIT END IF (&DATATYPE(&NRSTR(&CL1)) ¬= NUM AND &NRSTR(&CL1) > ) OR + (&DATATYPE(&NRSTR(&CL2)) ¬= NUM AND &NRSTR(&CL2) > ) OR + (&DATATYPE(&NRSTR(&CL3)) ¬= NUM AND &NRSTR(&CL3) > ) OR + (&DATATYPE(&NRSTR(&CL4)) ¬= NUM AND &NRSTR(&CL4) > ) OR + (&DATATYPE(&NRSTR(&CL5)) ¬= NUM AND &NRSTR(&CL5) > ) OR + (&DATATYPE(&NRSTR(&CL6)) ¬= NUM AND &NRSTR(&CL6) > ) OR + (&DATATYPE(&NRSTR(&CL7)) ¬= NUM AND &NRSTR(&CL7) > ) OR + (&DATATYPE(&NRSTR(&CL8)) ¬= NUM AND &NRSTR(&CL8) > ) OR + (&DATATYPE(&NRSTR(&CL9)) ¬= NUM AND &NRSTR(&CL9) > ) OR + (&DATATYPE(&NRSTR(&CL10)) ¬= NUM AND &NRSTR(&CL10) > ) OR + (&DATATYPE(&NRSTR(&CL11)) ¬= NUM AND &NRSTR(&CL11) > ) OR + (&DATATYPE(&NRSTR(&CL12)) ¬= NUM AND &NRSTR(&CL12) > ) THEN + DO SET ZEDLMSG = &NRSTR("DELDUPS" ARGUMENTS MUST BE NUMERIC) ISPEXEC SETMSG MSG(UTLZ001) EXIT END IF &NRSTR(&CL1) = 0 OR + &NRSTR(&CL2) = 0 OR + &NRSTR(&CL3) = 0 OR + &NRSTR(&CL4) = 0 OR + &NRSTR(&CL5) = 0 OR + &NRSTR(&CL6) = 0 OR + &NRSTR(&CL7) = 0 OR + &NRSTR(&CL8) = 0 OR + &NRSTR(&CL9) = 0 OR + &NRSTR(&CL10) = 0 OR + &NRSTR(&CL11) = 0 OR + &NRSTR(&CL12) = 0 THEN + DO SET ZEDLMSG = &NRSTR(ZERO IS NOT A VALID COLUMN) ISPEXEC SETMSG MSG(UTLZ001) EXIT END IF &CL1 > &CL2 OR + &CL3 > &CL4 OR + &CL5 > &CL6 OR + &CL7 > &CL8 OR + &CL9 > &CL10 OR + &CL11 > &CL12 THEN + DO SET ZEDLMSG = &NRSTR(2ND COLUMN IN A PAIR MUST BE > OR = + TO THE 1ST COLUMN IN A PAIR) ISPEXEC SETMSG MSG(UTLZ001) EXIT END ISREDIT SORT + &CL1 &CL2 &CL3 &CL4 &CL5 &CL6 &CL7 &CL8 &CL9 &CL10 &CL11 &C12 IF &LASTCC > 4 THEN + DO SET ZEDLMSG = &NRSTR(PROBLEM WITH THE "DELDUPS" SORT STEP) ISPEXEC SETMSG MSG(UTLZ001) EXIT END ISREDIT FIND FIRST P'=' 1 ISREDIT LINE_BEFORE .ZCSR = ' ' ISREDIT FIND FIRST P'=' 1 ISREDIT CHANGE P'=' X'FF' ALL .ZCSR .ZCSR ISREDIT (FFFFLINE) = LINE .ZCSR ISREDIT FIND FIRST P'=' 1 IF &LASTCC = 0 THEN + DO ISREDIT (DLINE) = LINE .ZCSR IF &CL2 > THEN SET SAVE1 = &SUBSTR(&CL1:&CL2,&NRSTR(&DLINE)) IF &CL4 > THEN SET SAVE2 = &SUBSTR(&CL1:&CL2,&NRSTR(&DLINE)) IF &CL6 > THEN SET SAVE3 = &SUBSTR(&CL1:&CL2,&NRSTR(&DLINE)) IF &CL8 > THEN SET SAVE4 = &SUBSTR(&CL1:&CL2,&NRSTR(&DLINE)) IF &CL10 > THEN SET SAVE5 = &SUBSTR(&CL1:&CL2,&NRSTR(&DLINE)) IF &CL12 > THEN SET SAVE6 = &SUBSTR(&CL1:&CL2,&NRSTR(&DLINE)) END ISREDIT FIND NEXT P'=' 1 SET SAVECC = &LASTCC DO WHILE &SAVECC = 0 ISREDIT (DLINE) = LINE .ZCSR SET PART1 = SET PART2 = SET PART3 = SET PART4 = SET PART5 = SET PART6 = IF &CL2 > THEN SET PART1 = &SUBSTR(&CL1:&CL2,&NRSTR(&DLINE)) IF &CL4 > THEN SET PART2 = &SUBSTR(&CL1:&CL2,&NRSTR(&DLINE)) IF &CL6 > THEN SET PART3 = &SUBSTR(&CL1:&CL2,&NRSTR(&DLINE)) IF &CL8 > THEN SET PART4 = &SUBSTR(&CL1:&CL2,&NRSTR(&DLINE)) IF &CL10 > THEN SET PART5 = &SUBSTR(&CL1:&CL2,&NRSTR(&DLINE)) IF &CL12 > THEN SET PART6 = &SUBSTR(&CL1:&CL2,&NRSTR(&DLINE)) IF &NRSTR(&PART1) = &NRSTR(&SAVE1) AND + &NRSTR(&PART2) = &NRSTR(&SAVE2) AND + &NRSTR(&PART3) = &NRSTR(&SAVE3) AND + &NRSTR(&PART4) = &NRSTR(&SAVE4) AND + &NRSTR(&PART5) = &NRSTR(&SAVE5) AND + &NRSTR(&PART6) = &NRSTR(&SAVE6) THEN + ISREDIT LINE .ZCSR = '&FFFFLINE' SET SAVE1 = &NRSTR(&PART1) SET SAVE2 = &NRSTR(&PART2) SET SAVE3 = &NRSTR(&PART3) SET SAVE4 = &NRSTR(&PART4) SET SAVE5 = &NRSTR(&PART5) SET SAVE6 = &NRSTR(&PART6) ISREDIT FIND NEXT P'=' 1 SET SAVECC = &LASTCC END ISREDIT RESET ALL ISREDIT EXCLUDE ALL ISREDIT FIND ALL '&FFFFLINE' ISREDIT DELETE ALL NX ISREDIT RESET EXIT HELPSEC: + 02480000 ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) 02490000 SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR DELDUPS UTILITY + 02490000 *** NO PROCESSING PERFORMED ***) 02490000 ISPEXEC SETMSG MSG(UTLZ000) 02490000 EXIT ./ ADD NAME=DELETEME /********************************************************************/ /* DELETEME */ /* */ /* PURPOSE: THIS EDIT MACRO WILL ALLOW A MEMBER IN A PDS TO BE */ /* DELETED WHILE EDITING. ONCE THE DELETION TAKES */ /* PLACE, THE PDS MEMBER LIST IS DISPLAYED. */ /* */ /* CREATED BY JEFF JONES 10/31/89 - SEATTLE SE CENTER */ /* */ /* C H A N G E L O G */ /* PROJECT DATE ID COMMENTS */ /* */ /********************************************************************/ ISREDIT MACRO (NOW) /**** 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 ELSE CONTROL NOSYMLIST NOCONLIST NOMSG NOLIST NOFLUSH IF &NOW = &STR(HELP) THEN + GOTO HELPSEC ISREDIT (EDITDSN) = DATASET ISREDIT (EDITMBR) = MEMBER SET &EDITDSN = &NRSTR(&EDITDSN) SET &EDITMBR = &NRSTR(&EDITMBR) SET &WKFILE = &NRSTR(&EDITDSN(&EDITMBR)) IF &NOW = THEN + DO WRITENR TYPE "Y" TO DELETE &EDITMBR : READ ANS END IF &ANS = Y OR &NOW = NOW THEN + DO DELETE '&WKFILE' ISREDIT CANCEL END EXIT HELPSEC: + WRITE WRITE *** HELP FOR EDIT MACRO 'DELETEME' *** WRITE WRITE THE DELETEME MACRO WILL ENABLE A USER WHO IS EDITING A WRITE MEMBER IN A PDS LIBRARY TO ENTER A SINGLE COMMAND ON THE WRITE COMMAND LINE TO DELETE THE PDS MEMBER. FOR EXAMPLE: WRITE WRITE COMMAND ===> DELETEME WRITE WRITE CAUTION: DO NOT SET THIS MACRO UP AS A PF KEY. THERE IS NO WRITE QUESTION ASKED PRIOR TO THE DELETION OF THE PDS MEMBER. WRITE WRITE IF A MEMBER IS ACCIDENTLY DELETED, THE ISPMODE OPTION OF WRITE DATASET SERVICES (E.P) PROCEDURE CAN BE USED TO RESTORE THE WRITE MEMBER. WRITE WRITE *** END OF HELP *** NO PROCESSING PERFORMED *** EXIT ./ ADD NAME=DELEXPLN PROC 2 COLLECTION APPLICATION CREATOR(D@UDAL) DEBUG /*** CHECK THE DEBUG SWITCH ***/ IF &DEBUG = DEBUG THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS END(END@) ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS END(END@) FREE DD(SYSIN SYSPRINT) ALLOC DD(SYSIN) NEW + UNIT(SYSDA) + SPACE(1,1) TRACKS RELEASE + RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS) ALLOC DD(SYSPRINT) DSN(*) OPENFILE SYSIN OUTPUT SET SYSIN = &STR(DELETE FROM &CREATOR..PLAN_TABLE) PUTFILE SYSIN SET SYSIN = &STR(WHERE PROGNAME = '&APPLICATION') PUTFILE SYSIN IF &STR(&COLLECTION) ¬= &STR(*) THEN + DO SET SYSIN = &STR( AND COLLID LIKE '&COLLECTION') PUTFILE SYSIN END@ CLOSFILE SYSIN DSN SYSTEM(DSNT) RUN PROGRAM(DSNTIAD) PLAN(DSNTIA23) - LIB('SYS4.DSN.DSNT.RUNLIB.LOAD') SET DB2CC = &LASTCC END FREE DD(SYSIN SYSPRINT) EXIT CODE(&DB2CC) ./ ADD NAME=DELIM /* REXX ***************************************************************/ /* UTILITY: DELIM */ /* AUTHOR: DAVID LEIGH */ /* FUNCTION: THIS UTILITY TAKES IN A COMMA-DELIMITED FILE AND A LAYOUT*/ /* FILE AND OUTPUTS THE FILE IN FIXED FORMAT TO THE OUTFILE */ /* DD. */ /**********************************************************************/ /**********************************************************************/ /* READ THE LAYOUT FILE INTO THE STACK */ /* READ THE DATA FILE INTO THE "INREC" STEM ARRAY */ /**********************************************************************/ "EXECIO * DISKR LAYOUT (FINIS" "EXECIO * DISKR INFILE (STEM INREC. FINIS" DROP IFIELD. IINTYPE. IINFMT. IINPARM. IOUTTYPE. IOUTFMT. IOUTPARM. DROP OFIELD. OINTYPE. OINFMT. OINPARM. OOUTTYPE. OOUTFMT. OOUTPARM. LAYRECS = QUEUED() FIELDS = 0 OUTLRECL = 0 /**********************************************************************/ /* LOOP THROUGH THE STACK (WHICH NOW CONTAINS THE LAYOUT FILE) AND */ /* PARSE EACH NON-COMMENT RECORD. PLACE THE VALUES IN TWO STEM */ /* ARRAYS. ONE ARRAY WILL BE IN THE ORDER OF THE INPUT FILE AND ONE */ /* WILL BE IN THE ORDER OF THE OUTPUT FILE. INPUT FILE ORDER IS BASED*/ /* ON THE NUMBER AT THE BEGINNING OF EACH LAYOUT FILE LINE. OUTPUT */ /* ORDER IS DEFINED BY THE ORDER OF THE RECORDS IN THE LAYOUT FILE. */ /**********************************************************************/ DO I = 1 TO LAYRECS PULL RECORD /* FROM THE STACK */ IF INDEX(RECORD,'*') = 1 THEN ITERATE /* IGNORE COMMENT LINES */ PARSE VAR RECORD R RECORD /* FIND THE "IN" ORDER # */ IF DATATYPE(R,N) = 0 THEN /* VERIFY IT'S A NUMBER! */ DO SAY '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' SAY '! ERROR IN LAYOUT INPUT: NON-NUMERIC VALUE FOUND !' SAY '! FOR THE INPUT FILE POSITIONAL ORDER VALUE. !' SAY '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' EXIT 2001 END /**********************************************************************/ /* PARSE THE LAYOUT RECORD INTO THE "IN" ARRAY */ /**********************************************************************/ PARSE VAR RECORD FIELD.R , "IN(" IINTYPE.R IINFMT.R IINPARM.R ")" , "OUT(" IOUTTYPE.R IOUTFMT.R IOUTPARM.R ")" DISCARD /**********************************************************************/ /* ALLOW THE OUTPUT FORMATS TO DEFAULT TO THE INPUT FORMATS IF NOT */ /* SPECIFIED. */ /**********************************************************************/ IF IOUTTYPE.R = '' THEN IOUTTYPE.R = IINTYPE.R IF IOUTFMT.R = '' THEN IOUTFMT.R = IINFMT.R IF IOUTPARM.R = '' THEN IOUTPARM.R = IINPARM.R /**********************************************************************/ /* SET THE OUTPUT ORDER ARRAY = TO THE INPUT ORDER ARRAY */ /**********************************************************************/ FIELDS = FIELDS + 1 OFIELD.FIELDS = IFIELD.R OINTYPE.FIELDS = IINTYPE.R OINFMT.FIELDS = IINFMT.R OINPARM.FIELDS = IINPARM.R OOUTTYPE.FIELDS = IOUTTYPE.R OOUTFMT.FIELDS = IOUTFMT.R OOUTPARM.FIELDS = IOUTPARM.R /**********************************************************************/ /* EDIT THE FORMATS FOR VALIDITY AND CALCULATE THE OUTPUT LRECL FOR */ /* GOOD MEASURE. */ /**********************************************************************/ SELECT /**********************************************************************/ /* "CHAR" VALUES */ /**********************************************************************/ WHEN IOUTTYPE.R = 'CHAR' THEN DO IF DATATYPE(IOUTFMT.R,N) = 0 THEN DO SAY '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' SAY '! NON-NUMERIC "CHAR" LENGTH FOUND IN THE !' SAY '! "OUT" DEFINITION OF THE LAYOUT FILE ON !' SAY '! RECORD NUMBER: ' FIELDS SAY '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' EXIT 2002 END OUTLRECL = OUTLRECL + IOUTFMT.R END /**********************************************************************/ /* "NUM" VALUES */ /**********************************************************************/ WHEN IOUTTYPE.R = 'NUM' THEN DO NUM9S = COUNTSTR(IOUTFMT.R '9') NUMZS = COUNTSTR(IOUTFMT.R 'Z') NUMPDS = COUNTSTR(IOUTFMT.R '.') IF NUMZS > 0 THEN DO SAY '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' SAY '! THE OUTPUT FORMAT OF A RECORD ON THE !' SAY '! LAYOUT FILE WAS INVALID BECAUSE IT HAD !' SAY '! "Z"S IN IT. ONLY INPUT VALUES MAY BE !' SAY '! ZERO-SUPPRESSED. THIS OCCURRED ON !' SAY '! RECORD NUMBER: ' FIELDS SAY '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' EXIT 2003 END IF NUMPDS > 0 & IOUTPARM.R = 'PACKED' THEN DO SAY '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' SAY '! THE OUTPUT FORMAT OF A RECORD ON THE !' SAY '! LAYOUT FILE WAS INVALID BECAUSE IT HAD !' SAY '! "."S IN IT AND SPECIFIED A PACKED FORMAT.!' SAY '! THIS OCCURRED ON RECORD NUMBER: ' FIELDS SAY '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' EXIT 2004 END IF IOUTPARM.R = 'PACKED' THEN NUM9S = (NUM9S % 2) + 1 OUTLRECL = OUTLRECL + NUM9S + NUMPDS END /**********************************************************************/ /* "DATE" VALUES */ /**********************************************************************/ WHEN IOUTTYPE.R = 'DATE' THEN DO NUMMS = COUNTSTR(IOUTFMT.R 'M') NUMDS = COUNTSTR(IOUTFMT.R 'D') NUMYS = COUNTSTR(IOUTFMT.R 'Y') POS_MONTH = POS('MONTH',IOUTFMT.R) IF NUMMS = 1 & POS_MONTH > 0 THEN DO SAY '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' SAY '! THE OUTPUT FORMAT OF A RECORD ON THE !' SAY '! LAYOUT FILE WAS INVALID BECAUSE IT HAD !' SAY '! A MONTH PORTION OF A DATE FORMAT AS A !' SAY '! SINGLE "M". IT MUST BE "MM", "MMM" OR !' SAY '! "MONTH". THIS OCCURRED ON !' SAY '! RECORD NUMBER: ' FIELDS SAY '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' EXIT 2005 END IF POS_MONTH > 1 THEN NUMMS = 9 IF IOUTPARM.R = 'PACKED' THEN NUMDATE = , ((NUMMS + NUMDS + NUMYS) % 2) + 1 ELSE NUMDATE = (NUMMS + NUMDS + NUMYS) OUTLRECL = OUTLRECL + NUMDATE END OTHERWISE DO SAY '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' SAY '! INVALID "OUT" VALUES IN THE LAYOUT FILE !' SAY '! ON RECORD NUMBER: ' FIELDS SAY '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' EXIT 2006 END END END SAY 'NUMBER OF FIELDS: ' FIELDS SAY 'CALCULATED OUTPUT LRECL: ' OUTLRECL "DELSTACK" /**********************************************************************/ /* GET OUT IF THE INPUT ORDER NUMBERS ARE NOT IN CONTIGUOUS SEQUENCE. */ /**********************************************************************/ IF R ¬= LAYRECS THEN DO SAY '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' SAY '! ERROR IN LAYOUT INPUT: NO NUMBERS CAN BE SKIPPED !' SAY '! WHEN DEFINING THE POSITIONAL ORDER OF FIELDS IN !' SAY '! THE INPUT FILE. THEY MUST BE IN CONTIGUOUS !' SAY '! SEQUENCE. E.G. 1,2,3 IS VALID BUT 1,3,4 IS NOT. !' SAY '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' EXIT 2007 END COMMAS = FIELDS - 1 /**********************************************************************/ // PARM='DELIM' /* BASED ON THE LAYOUT FILE. NOW WE NEED TO PROCESS THE INPUT DATA */ /* FILE USING THE INFORMATION FROM THE LAYOUT FILE. WE CREATE A */ /* DEFAULT PARSE INSTRUCTION FOR THOSE RECORDS WITH THE SAME AMOUNT */ /* OF COMMAS AS DEFINED FIELDS. IF THERE ARE MORE COMMAS THAN */ //LAYOUT DD DSN=D@UDAL.STR.WRKLIB(KDLAYOUT), /* TEXT FIELDS OF THAT RECORD NEEDS A SPECIAL PARSE INSTRUCTION TO */ /* HANDLE IT. */ /**********************************************************************/ //OUTFILE DD DSN=D@UDAL.OUTPUT(+1), DO I = 1 TO INREC.0 // SPACE=(CYL,(1,1),RLSE), // DCB=(T.GDG.MODEL,RECFM=FB,LRECL=847,BLKSIZE=22869) SELECT WHEN INCOMMAS < COMMAS THEN DO SAY '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' SAY '! ERROR IN DATA INPUT: RECORD 'I' HAD LESS FIELDS !' SAY '! IN IT THAN THAT DEFINED IN THE LAYOUT. ABORTING. !' SAY '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' EXIT 2008 END WHEN INCOMMAS > COMMAS THEN DO PARSEX_INSTR = BUILD_PARSE(INCOMMAS+1 "INREC.I") INTERPRET PARSEX_INSTR END OTHERWISE INTERPRET PARSE_INSTR END "EXECIO" FIELDS "DISKW TEMPOUT (STEM VAL. FINIS" END EXIT /**********************************************************************/ /* THIS PROCEDURE BUILDS A REXX PARSE INSTRUCTION FOR THE DATA */ /**********************************************************************/ BUILD_PARSE:PROCEDURE PARSE ARG NUMBER VARIABLE PSTRING = "PARSE VAR" VARIABLE DO I = 1 TO NUMBER - 1 PSTRING = PSTRING "VAL." || I " ',' " END PSTRING = PSTRING "VAL." || NUMBER "DISCARD" SAY PSTRING RETURN(PSTRING) /**********************************************************************/ /* THIS PROCEDURE COUNTS THE NUMBER OF TIMES A STRING OCCURS IN A STR.*/ /**********************************************************************/ COUNTSTR:PROCEDURE ARG STRING VARIABLE IF STRING = 'PULL' THEN PARSE UPPER PULL STRING COUNT = 0 X = LENGTH(STRING) DO I = 1 TO X IF SUBSTR(STRING,I,1) = VARIABLE THEN COUNT = COUNT + 1 END RETURN(COUNT) ./ ADD NAME=DIAGSCAN 000000 ***************************************************************** 000000 * I D E N T I F I C A T I O N D I V I S I O N * 000001 * * 000000 *** NOTE: USED TO BE NAMED WAGLINK OR WAGFLINK. * 000000 ***************************************************************** 000000 IDENTIFICATION DIVISION. 000000 PROGRAM-ID. DIAGSCAN. 000000 AUTHOR. J. CURRY 000000 INSTALLATION. DSEC 000000 DATE-WRITTEN. AUGUST 5, 1988. 000001 DATE-COMPILED. 000001 REMARKS. 000001 ***************************************************************** 000001 * J A C F L I N K * 000001 * * 000001 * FUNCTION - THIS PROGRAM READS THE IDD DATABASE * 000001 * PROGRAM RECORDS TO GET THE MODULE SOURCE. * 000001 * THE SOURCE IS SEARCHED FOR LINK AND * 000001 * INCLUDE MODULES * 000005 ***************************************************************** 000005 EJECT 000006 ***************************************************************** 000006 * E N V I R O N M E N T D I V I S I O N * 000006 ***************************************************************** 000006 SKIP2 000006 ENVIRONMENT DIVISION. 000006 SKIP2 000006 INPUT-OUTPUT SECTION. 000006 SKIP1 000006 FILE-CONTROL. 000006 SKIP1 000007 SELECT OUTPUT-FILE ASSIGN TO UT-S-DB001N02. 000007 SKIP1 000007 SELECT INPUT-FILE ASSIGN TO UT-S-DB001N03. 000007 SKIP1 000007 IDMS-CONTROL SECTION. 000007 PROTOCOL. MODE IS BATCH-AUTOSTATUS DEBUG 000007 IDMS-RECORDS MANUAL. 000007 EJECT 000008 ***************************************************************** 000008 * D A T A D I V I S I O N * 000008 ***************************************************************** 000008 SKIP2 000008 DATA DIVISION. 000008 SKIP1 000008 FILE SECTION. 000008 SKIP2 FD OUTPUT-FILE LABEL RECORDS ARE STANDARD BLOCK CONTAINS 0 RECORDS. 01 PROGRAM-REC. 05 FILLER PIC X(01) VALUE SPACES. 05 O-LINK-NAME PIC X(08). 05 FILLER PIC X(01). 05 O-PROG-NAME PIC X(08). 05 FILLER PIC X(01). 05 O-MOD-NAME PIC X(32). * CHANGED FILLER 30 TO FILLER 70 FOR SINGLE LINE OUTPUT * 05 FILLER PIC X(30). 05 FILLER PIC X(82). 00001240 FD INPUT-FILE LABEL RECORDS ARE STANDARD BLOCK CONTAINS 0 RECORDS. 01 INPUT-REC PIC X(80). 00001240 EJECT 00001240 ***************************************************************** 00001250 * S C H E M A S E C T I O N * 00001260 ***************************************************************** 00001270 SCHEMA SECTION. 00001280 00001290 *NODMLIST 00001300 DB IDMSNWKA WITHIN IDMSNTWK VERSION 1. 00001310 SKIP3 00001320 ***************************************************************** 00001330 * W O R K I N G - S T O R A G E S E C T I O N * 00001340 ***************************************************************** 00001350 SKIP2 00001360 WORKING-STORAGE SECTION. 00001370 SKIP2 00001380 01 WS-BEGIN PIC X(40) 00001390 VALUE 'WAGFLINK - WORKING STORAGE BEGINS HERE'. 00001400 SKIP2 00001410 01 SWITCHES. 00001420 05 S-STRING-MATCH PIC X(01) VALUE 'N'. 88 STRINGS-MATCH VALUE 'Y'. 05 EOF-FLAG PIC X(01) VALUE 'N'. 88 END-OF-PROGRAMS VALUE 'Y'. 05 S-DIALOG-CHAR PIC X(01) VALUE 'D'. 88 IS-A-DIALOG VALUE 'D'. 05 MODULE-FLAG PIC X(01) VALUE 'N'. 88 END-OF-MODULES VALUE 'Y'. 05 TEXT-FLAG PIC X(01) VALUE 'N'. 88 END-OF-TEXT VALUE 'Y'. 05 LINK-FLAG PIC X(01) VALUE 'N'. 88 LINK-FOUND VALUE 'Y'. 05 MOD-TXT-FLAG PIC X(01) VALUE 'N'. 88 MODULE-FOUND VALUE 'Y'. 05 S-RECORD-WRITTEN-IND PIC X(01) VALUE 'N'. 00006790 88 NO-RECORD-WRITTEN VALUE 'N'. SKIP1 00001430 01 WORK-AREAS. 00001560 SKIP1 00001570 05 W-COUNT PIC 9(04) VALUE 0. 00001660 00001670 05 W-ABEND-CODE PIC S9(09) COMP SYNC 00001660 VALUE +0. 00001670 05 W-LANG-FLAG PIC S9(04) COMP SYNC 00001660 VALUE +128. 00001670 05 FILLER REDEFINES W-LANG-FLAG. 00001660 10 FILLER PIC X. 10 COBOL-IND PIC X. 00001670 05 W-SOURCE-LINE. 00001660 10 W-SOURCE OCCURS 80 00001660 INDEXED BY CHR-NDX 00001660 CHR-NDX2 00001660 CHR-NDX3.00001660 15 W-SOURCE-CHAR PIC X(01). 00001660 00001670 05 W-INPUT-LINE. 00001660 10 W-INPUT OCCURS 80 00001660 INDEXED BY INP-NDX 00001660 INP-NDX2.00001660 15 W-INPUT-CHAR PIC X(01). 00001660 00001670 05 W-COMPARE-LINE. 00001660 10 W-COMPARE OCCURS 80 00001660 INDEXED BY CMP-NDX 00001660 CMP-NDX2.00001660 15 W-COMPARE-CHAR PIC X(01). 00001660 00001670 05 W-OUT-LINE PIC X(120). 00001660 00001670 05 T-INCLUDE-TABLE. 00001660 10 T-SAVE-INCLUDE-MODULES 00001660 OCCURS 1000 TIMES 00001660 INDEXED BY INCL-NDX 00001660 INCL-NDX2. 00001660 15 T-DIALOG-NAME PIC X(08). 00001660 15 T-INCLUDE-NAME PIC X(32). 00001660 00001660 05 W-DIALOG-TYPE. 00001660 10 W-PRJ-TEST-CHR PIC X(01) OCCURS 08 00001660 INDEXED BY PRJ-NDX. 00001660 05 W-FIELD. 00001660 10 W-FIELD-CHAR PIC X(01) OCCURS 08 00001660 INDEXED BY FLD-NDX. 00001660 05 FILLER REDEFINES W-FIELD. 00001680 10 FIELD-1-7 PIC X(07). 00001690 10 FILLER PIC X(01). 00001700 00001660 05 FILLER REDEFINES W-FIELD. 00001680 10 FIELD-1-5 PIC X(05). 00001690 10 FILLER PIC X(03). 00001700 00001660 05 FILLER REDEFINES W-FIELD. 00001680 10 FIELD-1-4 PIC X(04). 00001690 10 FILLER PIC X(04). 00001700 00001660 05 FILLER REDEFINES W-FIELD. 00001680 10 FIELD-1-1 PIC X(01). 00001690 10 FILLER PIC X(07). 00001700 00001660 05 SAVE-PROG-NAME. 00001680 10 FIRST-CHAR PIC X(01) VALUE SPACES. 00001690 10 FILLER PIC X(02) VALUE SPACES. 00001690 10 FILLER PIC X(04) VALUE SPACES. 00001710 10 LAST-CHAR PIC X(01) VALUE SPACES. 00001700 00001720 05 SAVE-MOD-NAME PIC X(32) VALUE SPACES. 00001680 00001690 05 WS-DATE. 00001680 10 WS-YEAR PIC X(02) VALUE SPACES. 00001690 10 WS-MONTH PIC X(02) VALUE SPACES. 00001700 10 WS-DAY PIC X(02) VALUE SPACES. 00001710 00001720 05 WS-TIME. 00001730 10 WS-HOUR PIC X(02) VALUE SPACES. 00001740 10 WS-MIN PIC X(02) VALUE SPACES. 00001750 10 FILLER PIC X(04) VALUE SPACES. 00001760 00001770 EJECT 00001810 01 CONSTANTS. 00001820 SKIP1 00001830 05 C-MAX-LINES PIC S9(4) COMP SYNC 00001840 VALUE +60. 00001850 SKIP1 00001860 05 C-ZERO PIC S9(4) COMP SYNC 00001900 VALUE +0. 00001910 05 C-INVALID PIC X(21) VALUE 00001900 ' IS INVALID *'. 00001910 SKIP1 00001920 05 C-ABEND-CALL PIC X(08) VALUE 'ABEND'. 00001930 05 K-LINK PIC X(05) VALUE 'LINK '. 00001930 05 K-MODULE PIC X(07) VALUE 'MODULE '. 00001930 05 K-MODULES PIC X(07) VALUE 'MODULES'. 00001930 05 K-MOD PIC X(04) VALUE 'MOD '. 00001930 05 K-COMMENT PIC X(01) VALUE '!'. 00001930 05 K-INCLUDE PIC X(07) VALUE 'INCLUDE'. 00001930 SKIP2 00001970 01 ACCUMULATORS. 00001980 00001990 05 A-LINE-COUNTER PIC S9(04) COMP SYNC. 00002000 00002010 05 A-PAGE-COUNTER PIC S9(03) COMP-3. 00002020 00002030 05 A-COUNT PIC S9(04) COMP SYNC 00002040 VALUE ZERO. 00002050 SKIP3 00003300 01 WS-END PIC X(36) 00003310 VALUE 'WAGFLINK - WORKING STORAGE ENDS HERE'. 00003320 EJECT 00003330 SKIP3 00003340 01 COPY IDMS SUBSCHEMA-CTRL. 00003350 EJECT 00003360 01 SUBSCHEMA-SSNAME PIC X(08) VALUE 'IDMSNWKA'. 00003370 01 SUBSCHEMA-RECNAMES. 00003380 05 SR12 PIC X(16) 00003390 VALUE 'OOAK-012 '. 00003400 05 SR32 PIC X(16) 00003390 VALUE 'SSR-032 '. 00003400 05 SR47 PIC X(16) 00003390 VALUE 'USER-047 '. 00003400 05 SR49 PIC X(16) 00003390 VALUE 'PROGLST-049 '. 00003400 05 SR55 PIC X(16) 00003390 VALUE 'MODLST-055 '. 00003400 05 SR51 PIC X(16) 00003410 VALUE 'PROG-051 '. 00003420 05 SR59 PIC X(16) 00003410 VALUE 'RCDACT-059 '. 00003420 05 SR67 PIC X(16) 00003430 VALUE 'MODULE-067 '. 00003440 05 SR88 PIC X(16) 00003450 VALUE 'TEXT-088 '. 00003460 05 SR91 PIC X(16) 00003470 VALUE 'SSPROG-091 '. 00003480 05 SR92 PIC X(16) 00003490 VALUE 'CLASS-092 '. 00003500 05 SR93 PIC X(16) 00003510 VALUE 'ATTRIBUTE-093 '. 00003520 SKIP1 00003530 01 SUBSCHEMA-SETNAMES. 00003540 05 OOAK-PROG PIC X(16) 00003550 VALUE 'OOAK-PROG '. 00003560 05 PROG-RCDACT PIC X(16) 00003550 VALUE 'PROG-RCDACT '. 00003560 05 SSR-RCDACT PIC X(16) 00003550 VALUE 'SSR-RCDACT '. 00003560 05 PROG-MODLST PIC X(16) 00003550 VALUE 'PROG-MODLST '. 00003560 05 MODULE-MODLST PIC X(16) 00003570 VALUE 'MODULE-MODLST '. 00003580 05 MODULE-TEXT PIC X(16) 00003590 VALUE 'MODULE-TEXT '. 00003600 05 PROG-PROGATTR PIC X(16) 00003610 VALUE 'PROG-PROGATTR '. 00003620 05 PROG-SSPROG PIC X(16) 00003630 VALUE 'PROG-SSPROG '. 00003640 SKIP1 00003650 01 SUBSCHEMA-AREANAMES. 00003660 05 DDLDML PIC X(16) 00003670 VALUE 'DDLDML '. 00003680 EJECT 00003690 COPY IDMS PROG-051. 00003710 EJECT 00003690 COPY IDMS RCDACT-059. 00003710 EJECT 00003690 COPY IDMS SSR-032. 00003710 EJECT 00003690 COPY IDMS MODLST-055. 00003710 EJECT 00003690 COPY IDMS MODULE-067. 00003710 EJECT 00003690 COPY IDMS TEXT-088. 00003710 EJECT 00003690 COPY IDMS OOAK-012. 00003750 EJECT 00003690 ***************************************************************** 00001330 * L I N K A G E S E C T I O N * 00001340 ***************************************************************** 00001350 SKIP2 00001360 LINKAGE SECTION. 00001370 SKIP2 00001380 01 PARM-AREA. 05 PARM-LENGTH PIC S9(04) COMP. 05 PARM-DATA. 10 PROJECT-NAME PIC X(04). EJECT ***************************************************************** 00003770 * P R O C E D U R E D I V I S I O N * 00003780 ***************************************************************** 00003790 SKIP2 00003800 PROCEDURE DIVISION USING PARM-AREA. 00003810 SKIP2 00003820 ***************************************************************** 00006850 * M A I N L I N E * 00006870 * - MAIN DRIVER OF PROGRAM * 00006870 * * 00006870 ***************************************************************** 00006850 MAINLINE SECTION. 00003890 SKIP2 00003900 PERFORM INITIALIZATION. PERFORM PROCESS-INPUT UNTIL END-OF-PROGRAMS. PERFORM FINALIZATION. 00004000 GOBACK. EJECT ***************************************************************** 00006850 * I N I T I A L I Z A T I O N * 00006870 * - INTIALIZES FILEDS FOR PROGRAM * 00006870 * * 00006870 ***************************************************************** 00006850 INITIALIZATION SECTION. 00003830 SKIP1 00003840 IF PROJECT-NAME = 'CMC ' SET PRJ-NDX TO +4 ELSE IF PROJECT-NAME = 'CCRS' OR PROJECT-NAME = 'CAS ' OR PROJECT-NAME = 'CRRS' SET PRJ-NDX TO +8 ELSE DISPLAY '****************************************' DISPLAY '* *' DISPLAY '* PROJECT NAME ' PROJECT-NAME C-INVALID DISPLAY '* *' DISPLAY '* VALID PROJECT NAMES ARE : *' DISPLAY '* CMC FOR CHEVROLET MARKETING CENTER *' DISPLAY '* CAS FOR CUSTOMER ASSISTANCE SYSTEM *' DISPLAY '* CCRS FOR CADILLAC CONSUMER REL. SYS*' DISPLAY '* CRRS FOR CADILLAC ROADSIDE SYSTEM *' DISPLAY '* *' DISPLAY '****************************************' MOVE 9999 TO W-ABEND-CODE CALL 'ABEND' USING W-ABEND-CODE. 00003930 OPEN INPUT INPUT-FILE 00003930 OUTPUT OUTPUT-FILE. 00003930 00003840 READ INPUT-FILE 00003840 AT END 00003840 DISPLAY '****************************************' DISPLAY '* *' DISPLAY '* NULL SEARCH STRING IS INVALID *' DISPLAY '* *' DISPLAY '****************************************' MOVE 9999 TO W-ABEND-CODE CALL 'ABEND' USING W-ABEND-CODE. 00003930 MOVE SPACES TO W-COMPARE-LINE. 00001660 00001670 MOVE INPUT-REC TO W-INPUT-LINE. 00001660 00006790 PERFORM ADVANCE-TO-NAME VARYING INP-NDX FROM 1 BY 1 UNTIL 00001660 W-INPUT-CHAR (INP-NDX) = QUOTE. 00001660 00001670 SET INP-NDX UP BY +1. 00001670 PERFORM MOVE-INPUT-STR VARYING CMP-NDX FROM +1 BY +1 00001660 UNTIL INP-NDX > 80. 00001660 00001670 SET CMP-NDX2 TO CMP-NDX. 00001670 SET CMP-NDX2 DOWN BY +1. 00001670 DISPLAY 'SEARCH STRING ==> ' W-COMPARE-LINE. 00001670 MOVE SPACES TO T-INCLUDE-TABLE. 00003930 SKIP1 00003840 SET INCL-NDX TO +1. SUBTRACT +1 FROM A-COUNT. DISPLAY 'STRING LENGTH ==> ' A-COUNT. SKIP1 00003840 COPY IDMS SUBSCHEMA-BINDS. 00003850 SKIP2 00003860 READY USAGE-MODE IS RETRIEVAL. 00003870 SKIP1 00003840 DISPLAY 'PROJECT NAME ===> ' PROJECT-NAME. OBTAIN FIRST PROG-051 WITHIN DDLDML. 00005480 INIT-EXIT. EXIT. 00003830 EJECT 00003880 ***************************************************************** 00006850 * F I N A L I Z A T I O N * 00006870 * -CLOSES ALL FILES * 00006870 * * 00006870 ***************************************************************** 00006850 FINALIZATION SECTION. 00004080 SKIP2 00004090 FINISH. 00004120 SKIP1 00004130 CLOSE INPUT-FILE 00004150 OUTPUT-FILE. 00004150 SKIP1 00004160 SKIP1 00003840 FINAL-EXIT. EXIT. 00003830 EJECT 00003880 ***************************************************************** 00006850 * P R O C E S S - I N P U T * 00006870 * * 00006870 * - WHEN A DIALOG IS FOUND THIS WILL CALL SUBROUTINE TO GET * 00006870 * THE MODULES ASSOCIATED WITH IT * 00006870 * * 00006870 ***************************************************************** 00006850 PROCESS-INPUT SECTION. 00004690 SKIP1 00004700 SET INCL-NDX TO +1. MOVE 'N' TO S-RECORD-WRITTEN-IND. 00006790 MOVE PROG-NAME-051 TO W-DIALOG-TYPE. 00001660 IF W-PRJ-TEST-CHR (PRJ-NDX) = S-DIALOG-CHAR PERFORM READ-MODULES UNTIL END-OF-MODULES MOVE '0000' TO ERROR-STATUS MOVE 'N' TO MODULE-FLAG SET INCL-NDX2 TO +1 PERFORM UNLOAD-TABLE UNTIL END-OF-MODULES MOVE SPACES TO T-INCLUDE-TABLE 00003930 OBTAIN CALC PROG-051 00005480 MOVE 'N' TO MODULE-FLAG. OBTAIN NEXT PROG-051 WITHIN DDLDML 00005480 ON DB-END-OF-SET MOVE 'Y' TO EOF-FLAG. SKIP1 00003840 PROCESS-EXIT. EXIT. 00003830 EJECT 00006780 ***************************************************************** 00006850 * R E A D - M O D U L E S * 00006870 * * 00006870 * - GETS ALL THE MODULES ASSOCIATED WITH THE DIALOG * 00006870 * - CALLS SUBROUTINE TO READ ALL LINES OF THE MODULES CODE * 00006870 * AND SCAN FOR LINK MODULES. * 00006870 ***************************************************************** 00006850 READ-MODULES SECTION. 00006790 00006800 OBTAIN NEXT MODLST-055 WITHIN PROG-MODLST ON DB-END-OF-SET MOVE 'Y' TO MODULE-FLAG GO TO READ-MODULES-EXIT. OBTAIN OWNER WITHIN MODULE-MODLST. 00006800 MOVE MOD-NAME-067 TO O-MOD-NAME. 00006810 MOVE MOD-NAME-067 TO SAVE-MOD-NAME. 00006810 PERFORM READ-TEXT UNTIL END-OF-TEXT. MOVE 'N' TO TEXT-FLAG. 00006820 READ-MODULES-EXIT. EXIT. 00006830 EJECT 00006840 ***************************************************************** 00006850 * U N LO A D - T A B L E * 00006870 * - UNLOADS THE INCLUDE TABLE * 00006870 * * 00006870 ***************************************************************** 00006850 UNLOAD-TABLE SECTION. 00006790 SKIP2 00006800 MOVE T-INCLUDE-NAME (INCL-NDX2) TO MOD-NAME-067. IF T-INCLUDE-NAME (INCL-NDX2) GREATER THAN SPACES NEXT SENTENCE ELSE MOVE 'Y' TO MODULE-FLAG GO TO UNLOAD-TABLE-EXIT. OBTAIN CALC MODULE-067 ON ANY-ERROR-STATUS DISPLAY 'CANT FIND==> ' T-INCLUDE-NAME (INCL-NDX2) SET INCL-NDX2 UP BY +1 GO TO UNLOAD-TABLE-EXIT. SET INCL-NDX2 UP BY +1. 00005480 MOVE MOD-NAME-067 TO O-MOD-NAME. 00006810 MOVE MOD-NAME-067 TO SAVE-MOD-NAME. 00006810 MOVE 'N' TO TEXT-FLAG. 00006820 MOVE ZERO TO W-COUNT. PERFORM READ-TEXT UNTIL END-OF-TEXT. MOVE 'N' TO TEXT-FLAG. 00006820 SKIP2 00006820 UNLOAD-TABLE-EXIT. EXIT. EJECT 00006840 ***************************************************************** 00006850 * R E A D - T E X T * 00006870 * - GETS EACH LINE OF CODE FOR THAT MODULE * 00006870 * * 00006870 ***************************************************************** 00006850 READ-TEXT SECTION. 00006790 00006800 OBTAIN NEXT TEXT-088 WITHIN MODULE-TEXT ON DB-END-OF-SET MOVE 'Y' TO TEXT-FLAG GO TO READ-TEXT-EXIT. ADD 1 TO W-COUNT. MOVE SOURCE-088 TO W-SOURCE-LINE. SET CHR-NDX TO +1. SET CHR-NDX2 TO +1. SET CHR-NDX3 TO +1. PERFORM FIND-LINK-MODULE UNTIL CHR-NDX2 > 70 OR LINK-FOUND. MOVE 'N' TO LINK-FLAG. 00006820 READ-TEXT-EXIT. EXIT. 00006830 EJECT 00006840 ***************************************************************** 00006850 * F I N D - L I N K - M O D U L E * 00006870 * -CHECKS FOR COMMENTS * 00006870 * -CHECKS FOR 'LINK ' IF FOUND CALLS SUBROUTINE TO SET UP NAME * 00006870 * OF THE LINK MODULES * 00006870 * * 00006870 ***************************************************************** 00006850 FIND-LINK-MODULE SECTION. 00006790 00006800 PERFORM MOVE-CHARACTERS 00006810 VARYING FLD-NDX FROM 1 BY 1 UNTIL FLD-NDX > 8. IF FIELD-1-1 = K-COMMENT SET CHR-NDX2 TO +71 GO TO FIND-LINK-MODULE-EXIT. SET CHR-NDX3 TO CHR-NDX2. MOVE 'Y' TO S-STRING-MATCH. PERFORM COMPARE-STRINGS VARYING CMP-NDX FROM +1 BY +1 UNTIL S-STRING-MATCH = 'N' OR CMP-NDX > CMP-NDX2. IF CMP-NDX > CMP-NDX2 PERFORM SETUP-NAME. IF FIELD-1-7 = K-INCLUDE MOVE SPACES TO W-FIELD PERFORM ADVANCE-TO-NAME 00006810 VARYING CHR-NDX FROM CHR-NDX BY 1 UNTIL W-SOURCE-CHAR (CHR-NDX) NOT = SPACE PERFORM MOVE-CHARACTERS 00006810 VARYING FLD-NDX FROM 1 BY 1 UNTIL FLD-NDX > 8 IF W-FIELD = K-MODULES SET CHR-NDX2 TO +71 GO TO FIND-LINK-MODULE-EXIT ELSE IF FIELD-1-7 = K-MODULE SET CHR-NDX DOWN BY +1 PERFORM SETUP-INCLUDE-NAME ELSE IF FIELD-1-4 = K-MOD SET CHR-NDX DOWN BY +5 PERFORM SETUP-INCLUDE-NAME ELSE MOVE W-FIELD TO T-INCLUDE-NAME (INCL-NDX) MOVE SAVE-MOD-NAME TO T-DIALOG-NAME (INCL-NDX) SET INCL-NDX UP BY +1. SET CHR-NDX2 UP BY +1. SET CHR-NDX TO CHR-NDX2. FIND-LINK-MODULE-EXIT. EXIT. EJECT 00006840 ***************************************************************** 00006850 * S E T - U P - N A M E * 00006870 * - SETS UP THE POINTER TI POINT AT THE FIRST CHARACTER TO BE * 00006870 * MOVED * 00006870 ***************************************************************** 00006850 SETUP-NAME SECTION. 00006790 SKIP2 00006800 * CHANGED THIS CODE TO STRING OUTPUT ONTO 1 LINE. MOVE SPACES TO W-FIELD. * MOVE W-COUNT TO O-LINK-NAME. * MOVE SAVE-PROG-NAME TO O-PROG-NAME. * MOVE SAVE-PROG-NAME TO O-PROG-NAME. * MOVE PROG-NAME-051 TO O-PROG-NAME. 00001660 * MOVE SAVE-MOD-NAME TO O-MOD-NAME. MOVE 'Y' TO LINK-FLAG. MOVE 'Y' TO S-RECORD-WRITTEN-IND. 00006790 * WRITE PROGRAM-REC. 00005480 STRING W-COUNT DELIMITED BY ' ' ' ' PROG-NAME-051 DELIMITED BY ' ' ' ' SAVE-MOD-NAME DELIMITED BY ' ' ' LINE ==> ' SOURCE-088 DELIMITED BY SIZE INTO W-OUT-LINE. WRITE PROGRAM-REC FROM W-OUT-LINE. 00005480 * MOVE SPACES TO PROGRAM-REC. 00005480 * WRITE PROGRAM-REC. 00005480 SKIP2 00006820 SETUP-NAME-EXIT. EXIT. EJECT 00006840 ***************************************************************** 00006850 * S E T U P - I N C L U D E - N A M E * 00006870 * - SETS UP THE POINTER TI POINT AT THE FIRST CHARACTER TO BE * 00006870 * MOVED * 00006870 ***************************************************************** 00006850 SETUP-INCLUDE-NAME SECTION. 00006790 SKIP2 00006800 MOVE SPACES TO W-FIELD. PERFORM ADVANCE-TO-NAME 00006810 VARYING CHR-NDX FROM CHR-NDX BY 1 UNTIL ((W-SOURCE-CHAR (CHR-NDX) NOT = ' ') AND (W-SOURCE-CHAR (CHR-NDX) NOT = '.') AND (W-SOURCE-CHAR (CHR-NDX) NOT = '=') AND (W-SOURCE-CHAR (CHR-NDX) NOT = '"')) OR (CHR-NDX > 70). PERFORM MOVE-CHARACTERS 00006810 VARYING FLD-NDX FROM 1 BY 1 UNTIL FLD-NDX > 8. MOVE W-FIELD TO T-INCLUDE-NAME (INCL-NDX). MOVE SAVE-MOD-NAME TO T-DIALOG-NAME (INCL-NDX). MOVE 'Y' TO LINK-FLAG. 00005480 SET INCL-NDX UP BY +1. SKIP2 00006820 SETUP-INCLUDE-NAME-EXIT. EXIT. EJECT 00006840 ***************************************************************** 00006850 * M O V E I N P U T S T R * 00006870 * * 00006870 * - MOVES THE SEARCH STRING TO A WORKING STORAGE FIELD * 00006870 * * 00006870 ***************************************************************** 00006850 MOVE-INPUT-STR SECTION. 00006790 00006800 IF W-INPUT-CHAR (INP-NDX) NOT EQUAL QUOTE 00006810 MOVE W-INPUT-CHAR (INP-NDX) TO W-COMPARE-CHAR (CMP-NDX) 00006810 ELSE SET INP-NDX TO +80. ADD +1 TO A-COUNT. 00006810 SET INP-NDX UP BY +1. 00006810 00006810 SKIP2 00006820 MOVE-INPUT-EXIT. EXIT. EJECT 00006840 ***************************************************************** 00006850 * C O M P A R E S T R I N G S * 00006870 * * 00006870 * - COMPARES THE TWO STRINGS * 00006870 * * 00006870 ***************************************************************** 00006850 COMPARE-STRINGS SECTION. 00006790 00006800 IF W-SOURCE-CHAR (CHR-NDX3) NOT EQUAL 00006810 W-COMPARE-CHAR (CMP-NDX) 00006810 MOVE 'N' TO S-STRING-MATCH. 00006800 SET CHR-NDX3 UP BY +1. 00006810 00006810 COMPARE-STRINGS-EXIT. EXIT. EJECT 00006840 ***************************************************************** 00006850 * M O V E C H A R A C T E R S * 00006870 * * 00006870 * - MOVES THE MODULE NAME TO THE WORKING STORAGE FIELD * 00006870 * * 00006870 ***************************************************************** 00006850 MOVE-CHARACTERS SECTION. 00006790 00006800 IF W-SOURCE-CHAR (CHR-NDX) NOT EQUAL '.' 00006810 MOVE W-SOURCE-CHAR (CHR-NDX) TO W-FIELD-CHAR (FLD-NDX). 00006810 SET CHR-NDX UP BY +1. 00006810 00006820 MOVE-CHARACTERS-EXIT. EXIT. EJECT 00006840 ***************************************************************** 00006850 * A D V A N C E - T O - N A M E * 00006870 * - DUMMY SUBROUTINE * 00006870 * * 00006870 ***************************************************************** 00006850 ADVANCE-TO-NAME SECTION. 00006790 SKIP2 00006800 MOVE 999 TO W-ABEND-CODE. 00006810 SKIP2 00006820 ADVANCE-TO-NAME-EXIT. EXIT. EJECT 00006840 ***************************************************************** 00006850 * IDMS-STATUS * 00006860 * * 00006870 * - CHECKS COMPLETION STATUS OF LAST IDMS FUNCTION * 00006880 ***************************************************************** 00006850 SKIP2 00006900 COPY IDMS IDMS-STATUS. 00006910 IDMS-ABORT SECTION. 00006920 IDMS-ABORT-EXIT. 00006930 EXIT. 00006940 ./ ADD NAME=DIAGTEST /********************************************************************** /* UTILITY: DIAGTEST * /* AUTHOR: DAVID LEIGH * /* FUNCTION: THIS UTILITY SIMPLY INVOKES THE ISPF DIALOG TEST FACILITY* /********************************************************************** PROC 0 HELP /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT IF &HELP = &STR(HELP) THEN GOTO HELPSEC ISPEXEC SELECT PGM(ISPYXDR) PARM(ISP) NOCHECK EXIT HELPSEC: + 02480000 ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) 02490000 SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR DIAGTEST UTILITY + 02490000 *** NO PROCESSING PERFORMED ***) 02490000 ISPEXEC SETMSG MSG(UTLZ000) 02490000 EXIT ./ ADD NAME=DISTSNAM /* REXX ***************************************************************/ /* */ /**********************************************************************/ ADDRESS ISPEXEC 'CONTROL ERRORS RETURN' ADDRESS ISREDIT "MACRO" "EXCLUDE ALL ' ' 3" "EXCLUDE ALL 'NAME ' 3" "EXCLUDE ALL '--------' 3" "EXCLUDE ALL '*' 3" "EXCLUDE ALL 'I - ' 10" "EXCLUDE ALL P'¬' 1 2" "FIND ALL 'DATABASE = '" "DELETE ALL EXCLUDED" "EXCLUDE ALL 'DATABASE = '" "CHANGE ' ' 'XX' 1 ALL X" "FIND FIRST 'DATABASE = '" DO WHILE RC = 0 "(LINE) = LINE .ZCSR" "LABEL .ZCSR = .CURR" PARSE UPPER VAR LINE NULL1 NULL2 NULL3 NULL4 DBNAME NULL5 "FIND NEXT 'DATABASE = '" IF RC = 0 THEN DO LBL = '.B' "LABEL .ZCSR = .B" END ELSE DO LBL = '.ZLAST' END "FIND FIRST ' ' 1 .CURR" LBL DO WHILE RC = 0 "CHANGE ' ' '"DBNAME".' 1 .ZCSR .ZCSR" "FIND NEXT ' ' 1 .CURR" LBL END "FIND LAST P'=' .CURR .CURR" "FIND NEXT 'DATABASE = '" END "EXCLUDE ALL 'DATABASE = '" "DELETE ALL EXCLUDED" ./ ADD NAME=DISVAR /********************************************************************** /* UTILITY: DISVAR * /* AUTHOR: DAVID LEIGH * /* FUNCTION: DISPLAY A VARIABLE VALUE WHICH IS IN AN ISPF VARIABLE * /* POOL. THE PROFILE POOL CAN BE CHANGED BY SPECIFYING THE * /* PROFILE TO LOOK AT IN THE "PROFILE" KEYWORD VARIABLE. * /* YOU CAN CALL DISVAR FROM ANOTHER PROCESS AND HAVE THE * /* VALUE RETURED IN THE ISPF SHARED VARIABLE "DISVARVL" BY * /* SPECIFYING "BATCH". * /********************************************************************** PROC 1 VAR PROFILE() OLDAPPL() BATCH /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT IF &STR(&VAR) = &STR(HELP) THEN GOTO HELPSEC IF &STR(&PROFILE) > THEN + DO ISPEXEC VGET ZAPPLID SHARED ISPEXEC SELECT CMD(%DISVAR &VAR &BATCH OLDAPPL(&ZAPPLID)) + NEWAPPL(&PROFILE) ISPEXEC VGET DISVARVL PROFILE ISPEXEC VPUT DISVARVL SHARED SET DISVARVL = ISPEXEC VPUT DISVARVL PROFILE EXIT END ISPEXEC VGET (&VAR) SET VALUE = &STR(&&)&STR(&VAR) IF &BATCH = BATCH THEN + DO SET DISVARVL = &STR(&VALUE) IF &STR(&OLDAPPL) > THEN + ISPEXEC SELECT CMD(%PROFUPDT &OLDAPPL VARIABLE(DISVARVL) + VALUE(&DISVARVL)) ELSE + ISPEXEC VPUT DISVARVL SHARED EXIT END SET ZEDLMSG = &STR(&VAR = &VALUE) IF &LENGTH(&STR(&ZEDLMSG)) > 78 AND + &SYSINDEX(&STR(ISPF 2.3),&STR(&ZENVIR)) > 0 THEN + DO SET ZEDLMSG = &SUBSTR(1:78,&STR(&ZEDLMSG)) ISPEXEC SETMSG MSG(UTLZ000) END ELSE + ISPEXEC SETMSG MSG(UTLZ000W) EXIT HELPSEC: + 02480000 ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) 02490000 SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR DISVAR UTILITY + 02490000 *** NO PROCESSING PERFORMED ***) 02490000 ISPEXEC SETMSG MSG(UTLZ000) 02490000 EXIT ./ ADD NAME=DIVIDE PROC 2 X Y /*** CHECK THE DEBUG SWITCH ***/ ISPEXEC VGET DBGSWTCH PROFILE IF &DBGSWTCH = ON THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS SET L = 9 - &LENGTH(&X) DO &I = 1 TO &L SET ZERO = &STR(0&ZERO) END SET Q = &STR(&X&ZERO) SET ANSWER = &EVAL(&Q/&Y) SET M = &LENGTH(&ANSWER) SET L = &M - &L + 1 SET ZERO = SET J = 0 DO &I = &L TO 0 SET J = &J + 1 SET ZERO = &STR(0&ZERO) SET M = &M + 1 END SET L = &L + &J SET ANSWER = &STR(&ZERO&ANSWER) SET SUFFIX = &SUBSTR(&L:&M,&STR(&ANSWER)) SET L = &L - 1 IF &L > 0 THEN SET PREFIX = &SUBSTR(1:&L,&STR(&ANSWER)) ELSE SET PREFIX = SET EQUATION = &STR(&X / &Y = &PREFIX..&SUFFIX) SET RESULT = &STR(&PREFIX..&SUFFIX) ISPEXEC VPUT (EQUATION RESULT) SHARED ./ ADD NAME=DLMTOSET ISREDIT MACRO ISPEXEC CONTROL ERRORS RETURN /**** 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 /********************************************************************** /* UTILITY: DLMTOSET * /* AUTHOR: DAVID LEIGH * /* FUNCTION: CREATE A 2ND FILE CONTAINING CLIST "SET" FIELD STATEMENTS* /* FROM A FILE (THE CURRENT ONE BEING EDITED) WHICH CONTAINS* /* FIELDS DELIMITED BY ','. THE FIRST LINE MUST CONTAIN * /* THE FIELD NAMES ASSOCIATED WITH EACH "," DELIMITED FIELD.* /********************************************************************** /********************************************************************** /* FIRST EDIT FOR VALID DATA ON THE FIRST LINE. * /********************************************************************** ISREDIT FIND FIRST ',' .ZFIRST .ZFIRST SET SAVECC = &LASTCC ISREDIT (LN,CL2) = CURSOR IF &SAVECC > 0 THEN + DO SET ZEDLMSG = &STR(*** NO COMMAS FOUND ON THE FIRST LINE ***) ISPEXEC SETMSG MSG(UTLZ001W) EXIT CODE(12) END IF &CL2 = 1 THEN + DO SET ZEDLMSG = &STR(A "," CANNOT BE THE FIRST CHARACTER ON + THE FIRST LINE) ISPEXEC SETMSG MSG(UTLZ001W) EXIT CODE(12) END /********************************************************************** /* FIRST PARSE LINE NUMBER ONE TO CREATE THE LIST OF FIELD NAMES * /********************************************************************** ISREDIT (SYSDVAL) = LINE .ZFIRST READDVAL F1 F2 F3 F4 F5 F6 F7 F8 F9 F10 + F11 F12 F13 F14 F15 F16 F17 F18 F19 F20 + F21 F22 F23 F24 F25 F26 F27 F28 F29 F30 + F31 F32 F33 F34 F35 F36 F37 F38 F39 F40 + F41 F42 F43 F44 F45 F46 F47 F48 F49 F50 + F51 F52 F53 F54 F55 F56 F57 F58 F59 F60 + F61 F62 F63 F64 F65 F66 F67 F68 F69 F70 + F71 F72 F73 F74 F75 F76 F77 F78 F79 F80 + F81 F82 F83 F84 F85 F86 F87 F88 F89 F90 + F91 F92 F93 F94 F95 F96 F97 F98 F99 F100 DO &I = 1 TO 100 SET X = &&F&I IF &STR(&X) = THEN + DO SET NUMFIELDS = &I - 1 SET I = 9999 END END /********************************************************************** /* CREATE AN OUTPUT FILE IN WHICH TO STORE THE "SET" STATEMENTS * /********************************************************************** SET FILENAME = &STR(&SYSPREF..TEMP.DELIM.TO.SET) DELETE '&FILENAME' FREE DD(TEMPDD) ALLOC DD(TEMPDD) DSN('&FILENAME') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK005) + SPACE(1,1) CYLINDERS RELEASE + RECFM(F B) LRECL(255) BLKSIZE(23460) DSORG(PS) OPENFILE TEMPDD OUTPUT /********************************************************************** /* LOOP THROUGH THE LINES AND POPULATE THE OUTPUT FILE. * /********************************************************************** SET LP = &STR(( SET RP = &STR()) ISREDIT (LASTLINE) = LINENUM .ZLAST ISREDIT FIND FIRST P'=' 2 .ZFIRST .ZFIRST ISREDIT FIND NEXT P'=' 1 DO WHILE &LASTCC = 0 ISREDIT (LINE) = LINE .ZCSR SET CL1 = 1 ISREDIT FIND FIRST ',' .ZCSR .ZCSR DO &FIELDNUM = 1 TO &NUMFIELDS WHILE &LASTCC = 0 ISREDIT (NULL,CL2) = CURSOR SET X = &&F&FIELDNUM IF &EVAL(&CL2 - &CL1) < 2 THEN + SET TEMPDD = &STR(SET &X = ) ELSE + SET TEMPDD = &STR(SET &X = &&STR&LP&&SYSNSUB&LP.1,)+ &SUBSTR(&CL1:&CL2-1,&STR(&SYSNSUB(1,&LINE)))+ &STR(&RP) PUTFILE TEMPDD SET CL1 = &CL2 + 1 ISREDIT FIND NEXT ',' .ZCSR .ZCSR END ISREDIT (THISLINE) = LINENUM .ZCSR IF &EVAL(&THISLINE//10) = 0 THEN + DO SET ZEDLMSG = &STR(*** PROCESSED &THISLINE OF &LASTLINE + LINES) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) END ISREDIT FIND NEXT P'=' 1 END /********************************************************************** /* CLEAN UP AND EDIT THE OUTPUT FILE. * /********************************************************************** ISREDIT CURSOR = 1 1 CLOSFILE TEMPDD FREE DD(TEMPDD) ISPEXEC EDIT DATASET('&FILENAME') EXIT HELPSEC: + 02480000 ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) 02490000 SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR DLMTOSET UTILITY + 02490000 *** NO PROCESSING PERFORMED ***) 02490000 ISPEXEC SETMSG MSG(UTLZ000) 02490000 EXIT ./ ADD NAME=DOLOOP ISREDIT MACRO (OPT) ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /* ISREDIT (TYPE,NULL) = PROFILE IF &STR(&OPT) = THEN SET OPT = &STR(&TYPE) ISREDIT FIND FIRST 'FIND FIRST' .ZCSR .ZCSR ISREDIT (LINE) = LINE .ZCSR ISREDIT LABEL .ZCSR = .CURR ISREDIT LINE_AFTER .CURR = 'END' ISREDIT LINE_AFTER .CURR = <5 (LINE)> IF &STR(&OPT) = REXX THEN + DO ISREDIT LINE_AFTER .CURR = ' PARSE UPPER VAR LINE' ISREDIT LINE_AFTER .CURR = ' "(LINE) = LINE .ZCSR"' ISREDIT LINE_AFTER .CURR = 'DO WHILE RC = 0' END ELSE + ISREDIT LINE_AFTER .CURR = 'DO WHILE .LASTCC = 0' ISREDIT FIND FIRST P'=' .CURR .CURR ISREDIT FIND 'DO WHILE' IF &STR(&OPT) ¬= REXX THEN + ISREDIT CHANGE '.' '&&' ISREDIT CHANGE 'FIRST' 'NEXT' ISREDIT FIND PREV P'=' 1 .ZCSR .ZCSR ISREDIT FIND PREV P'=' 1 ISREDIT INSERT .ZCSR IF &STR(&OPT) = REXX THEN + DO ISREDIT FIND PREV 'VAR LINE' ISREDIT FIND 'LINE' ISREDIT FIND NEXT ' ' ISREDIT FIND NEXT ' ' END ./ ADD NAME=DOWNLOAD PROC 0 INDSN() DOWNDSN(D@UDAL.TEMP.DOWNLOAD) FIL() /********************************************************************** /* UTILITY: DOWNLOAD * /* AUTHOR: DAVID LEIGH * /* FUNCTION: CREATE A PDS WHICH CONTAINS DOWNLOAD BAT FILES TO PERFORM* /* DOWNLOADS TO A PC. * /* INDSN = PDS TO BE DOWNLOADED * /* DOWNDSN = PDS TO CONTAIN BAT FILES (CREATED IF NOT * /* EXISTING) * /* FIL = NAME OF THE PC FILECTORY FOR THIS PDS * /********************************************************************** /*** CHECK THE DEBUG SWITCH ***/ ISPEXEC VGET DBGSWTCH PROFILE IF &DBGSWTCH = ON THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS /********************************************************************** /* PARSE AND VALIDATE THE INPUT * /********************************************************************** SET X = &STR(&SYSDSN('&INDSN')) IF &STR(&X) ¬= &STR(OK) THEN + DO SET ZEDLMSG = &STR("&INDSN" PROBLEM: &X) ISPEXEC SETMSG MSG(UTLZ001W) EXIT END SET Y = &STR(&SYSDSN('&DOWNDSN')) IF &STR(&Y) ¬= &STR(OK) THEN + DO FREE DD(TEMPDD) ALLOC DD(TEMPDD) DSN('&DOWNDSN') + NEW CATALOG + UNIT(SYSDA) + SPACE(1,1) DIR(10) CYLINDERS RELEASE + RECFM(F B) LRECL(255) BLKSIZE(23460) DSORG(PO) SET CC = &LASTCC FREE DD(TEMPDD) IF &CC > 0 THEN + DO SET ZEDLMSG = &STR("&DOWNDSN" ALLOC CC: &CC; "&Y") ISPEXEC SETMSG MSG(UTLZ001W) EXIT END END IF &STR(&FIL) = OR + &LENGTH(&STR(&FIL)) > 8 THEN + DO SET ZEDLMSG = &STR(A VALID PC FILECTORY MUST BE SPECIFIED) ISPEXEC SETMSG MSG(UTLZ001W) EXIT END /********************************************************************** /* INITIALIZATION PROCESSING FOR THE PDS'S * /********************************************************************** SET ZEDLMSG = &STR(*** INITIALIZING DATASETS ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) ISPEXEC LMINIT DATAID(DSN1) DATASET('&INDSN') ISPEXEC LMOPEN DATAID(&DSN1) ISPEXEC LMINIT DATAID(DSN2) DATASET('&DOWNDSN') ENQ(SHRW) FREE DD(TEMPDD) SET DATE = &SUBSTR(1:2,&STR(&SYSSDATE))+ &SUBSTR(4:5,&STR(&SYSSDATE))+ &SUBSTR(7:8,&STR(&SYSSDATE)) SET TIME = &SUBSTR(1:2,&STR(&SYSTIME))+ &SUBSTR(4:5,&STR(&SYSTIME))+ &SUBSTR(7:8,&STR(&SYSTIME)) SET TEMPDSN = &STR(&SYSUID..TEMP.D&DATE..T&TIME) DELETE '&TEMPDSN' ALLOC DD(TEMPDD) DSN('&TEMPDSN') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK005) + SPACE(1,1) DIR(1) TRACKS RELEASE + RECFM(F B) LRECL(255) BLKSIZE(23460) DSORG(PO) ISPEXEC LMINIT DATAID(DSN3) DDNAME(TEMPDD) ENQ(EXCLU) ISPEXEC LMCOPY FROMID(&DSN2) TODATAID(&DSN3) + FROMMEM(##ALL##) TOMEM(##ALL##) REPLACE SET COPYCC = &LASTCC ISPEXEC LMFREE DATAID(&DSN3) ISPEXEC LMOPEN DATAID(&DSN2) OPTION(OUTPUT) /********************************************************************** /* UPDATE THE ##ALL## MEMBER * /********************************************************************** SET ZEDLMSG = &STR(*** UPDATING ##ALL##; CREATING &FIL IN &DOWNDSN ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) IF ©CC = 8 THEN GOTO ALL_CONTINUE FREE DD(TEMPDD) ALLOC DD(TEMPDD) DSN('&TEMPDSN(##ALL##)') SHR ERROR DO SET ERRCC = &LASTCC SELECT (&ERRCC) WHEN (400) DO SET EOF = YES RETURN END OTHERWISE DO ERROR OFF WRITE *** ERROR CC: &ERRCC OCCURRED READING A FILE *** GOTO FINAL END END END SET SWITCH = OFF SET EOF = NO OPENFILE TEMPDD GETFILE TEMPDD DO WHILE &EOF = NO ISPEXEC LMPUT DATAID(&DSN2) MODE(INVAR) DATALOC(TEMPDD) DATALEN(255) GETFILE TEMPDD END ERROR OFF CLOSFILE TEMPDD ALL_CONTINUE: + SET TEMPDD = &STR(CALL 3270RECV F:\&FIL..BAT + '&DOWNDSN(&FIL)' ASCII CRLF) ISPEXEC LMPUT DATAID(&DSN2) MODE(INVAR) DATALOC(TEMPDD) DATALEN(255) ISPEXEC LMMREP DATAID(&DSN2) MEMBER(##ALL##) /********************************************************************** /* CREATE THE NEW "FIL" MEMBER * /********************************************************************** SET TEMPDD = &STR(F:) ISPEXEC LMPUT DATAID(&DSN2) MODE(INVAR) DATALOC(TEMPDD) DATALEN(255) SET TEMPDD = &STR(CD \DOWNLOAD) ISPEXEC LMPUT DATAID(&DSN2) MODE(INVAR) DATALOC(TEMPDD) DATALEN(255) ISPEXEC LMMLIST DATAID(&DSN1) MEMBER(MEMNAME) DO WHILE &LASTCC = 0 SET MEMNAME = &MEMNAME SET TEMPDD = &STR(CALL 3270RECV &MEMNAME..FIL + '&INDSN(&MEMNAME)' ASCII CRLF) ISPEXEC LMPUT DATAID(&DSN2) MODE(INVAR) DATALOC(TEMPDD) DATALEN(255) ISPEXEC LMMLIST DATAID(&DSN1) MEMBER(MEMNAME) END ISPEXEC LMMLIST DATAID(&DSN1) OPTION(FREE) SET TEMPDD = &STR(F:\PKZ\PKZIP F:\&FIL *.*) ISPEXEC LMPUT DATAID(&DSN2) MODE(INVAR) DATALOC(TEMPDD) DATALEN(255) SET TEMPDD = &STR(ECHO Y . ERASE F:\DOWNLOAD\*.*) ISPEXEC LMPUT DATAID(&DSN2) MODE(INVAR) DATALOC(TEMPDD) DATALEN(255) SET TEMPDD = &STR(CD \) ISPEXEC LMPUT DATAID(&DSN2) MODE(INVAR) DATALOC(TEMPDD) DATALEN(255) SET TEMPDD = &STR(NDIR *.* FILESONLY) ISPEXEC LMPUT DATAID(&DSN2) MODE(INVAR) DATALOC(TEMPDD) DATALEN(255) SET TEMPDD = &STR(ECHO *** THE FILE JUST CREATED WAS &FIL ***) ISPEXEC LMPUT DATAID(&DSN2) MODE(INVAR) DATALOC(TEMPDD) DATALEN(255) ISPEXEC LMMREP DATAID(&DSN2) MEMBER(&FIL) /********************************************************************** /* CLOSE UP SHOP * /********************************************************************** FINAL: + SET ZEDLMSG = &STR(*** CLEANING UP ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) FREE DD(TEMPDD) DELETE '&TEMPDSN' ISPEXEC LMCLOSE DATAID(&DSN1) ISPEXEC LMFREE DATAID(&DSN1) ISPEXEC LMCLOSE DATAID(&DSN2) ISPEXEC LMFREE DATAID(&DSN2) EXIT ./ ADD NAME=DRAWBOX ISREDIT MACRO (LAB1,LAB2,COL1,COL2) ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT IF &LAB1 = HELP THEN GOTO HELPSEC /********************************************************************** /* EDIT MACRO : DRAWBOX * /* AUTHOR : DAVE LEIGH * /* FUNCTION : DRAW A BOX IN A FILE BEING EDITED BY SPECIFYING TWO * /* LABELS AND TWO COLUMNS AS THE BOX LIMITS. * /********************************************************************** IF &LAB1 = OR &LAB2 = OR &COL1 = OR &COL2 = OR + &SYSINDEX(&STR(.),&STR(&LAB1)) ¬= 1 OR + &SYSINDEX(&STR(.),&STR(&LAB2)) ¬= 1 THEN + DO SET ZEDLMSG = &STR(*** 2 LABELS AND 2 COLUMN NUMBERS MUST BE + SPECIFIED ***) ISPEXEC SETMSG MSG(UTLZ001) EXIT END ISREDIT CHANGE ALL P'=' '³' &COL1 &LAB1 &LAB2 ISREDIT CHANGE ALL P'=' '³' &COL2 &LAB1 &LAB2 ISREDIT CHANGE ALL P'=' '-' &COL1 &COL2 &LAB1 &LAB1 ISREDIT CHANGE ALL P'=' '-' &COL1 &COL2 &LAB2 &LAB2 ISREDIT CHANGE ALL P'=' '+' &COL1 &LAB1 &LAB1 ISREDIT CHANGE ALL P'=' '+' &COL2 &LAB1 &LAB1 ISREDIT CHANGE ALL P'=' '+' &COL1 &LAB2 &LAB2 ISREDIT CHANGE ALL P'=' '+' &COL2 &LAB2 &LAB2 EXIT HELPSEC: + 02480000 ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) 02490000 SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR DRAWBOX UTILITY + 02490000 *** NO PROCESSING PERFORMED ***) 02490000 ISPEXEC SETMSG MSG(UTLZ000) 02490000 EXIT ./ ADD NAME=DROPARC /* REXX ***************************************************************/ /* UTILITY: DROPARC */ /* AUTHOR: DAVID LEIGH */ /* FUNCTION: THIS REXX PROGRAM READS IN A REPORT CREATED BY DMS WHICH */ /* LISTS DB2 PHYSICAL OBJECT DATASETS. IF THESE DATASETS */ /* ARE CURRENTLY ARCHIVED AND THE ARCHIVE IS TO EXPIRE IN */ /* A SPECIFIC AMOUNT OF DAYS, THIS PROGRAM WILL CREATE THE */ /* APPROPRIATE DROP TABLESPACE STATEMENTS TO PASS ON TO A */ /* SUBSEQUENT STEP THAT ACTUALLY DOES THE DROPS. */ /**********************************************************************/ /**********************************************************************/ /* SET SOME INITIAL VARIABLES */ /**********************************************************************/ OUTNBR = 0 DBNAME = '' TSNAME = '' DUFUNC = 'INCREMENT' DUNUMBER = 3 /*** THE NUMBER OF DAYS IN THE FUTURE TO LOOK ***/ DUDT2FCD = 12 /*** DATEUTIL DATE FORMAT CODE ***/ /**********************************************************************/ /* DO THE DATE PROCESSING HERE */ /**********************************************************************/ SAY "GETTING DATE" DUNUMBER "DAYS IN THE FUTURE FOR COMPARISON" ADDRESS ISPEXEC "VPUT (DUFUNC DUNUMBER DUDT2FCD) SHARED" "SELECT PGM(DATEUTIL) PARM(ISPF)" IF RC = 0 THEN DO "VGET (DUDATE2)" SAY "COMPARISON DATE IS:" DUDATE2 END ELSE DO ZISPFRC = RC "VGET (DUMSG) SHARED" SAY "PROBLEM GETTING DATE!" SAY ZISPFRC "VPUT ZISPFRC" EXIT ZISPFRC END "LIBDEF ISPLLIB" /**********************************************************************/ /* READ THE DMS REPORT HERE */ /**********************************************************************/ ADDRESS TSO "EXECIO * DISKR INDMSRPT (STEM RPTLINE. FINIS)" ZISPFRC = RC SAY "DMS REPORT READ RETURN CODE:" RC IF SAVERC > 0 THEN DO SAY "PROBLEM READING DMS REPORT!" SAY ZISPFRC "VPUT ZISPFRC" EXIT ZISPFRC END SAY "DMS REPORT RECORDS READ:" RPTLINE.0 /**********************************************************************/ /* MAIN PROCESSING LOOP */ /**********************************************************************/ ADDRESS ISPEXEC "TBCREATE TEMPTABL NOWRITE REPLACE KEYS(DBNAME TSNAME EXPIRE)" DO I = 1 TO RPTLINE.0 /********************************************************************/ /* MAKE SURE WE'RE LOOKING AT A DATASET LINE IN THE REPORT FILE */ /********************************************************************/ IF DBNAME > '' & TSNAME = '' THEN DO PARSE UPPER VAR RPTLINE.I TSNAME '.' NULL TSNAME = STRIP(TSNAME) END /********************************************************************/ /* MAKE SURE IT'S AN "ARCHIVE" (NOT BACKUP) WITHIN THE DATE RANGE */ /********************************************************************/ IF POS('.DSNDBC.',RPTLINE.I) = 7 &, /* 1ST LINE OF DSN */ SUBSTR(RPTLINE.I,130,1) = 'A' &, /* "ARCHIVE" DESIGNATION */ (SUBSTR(RPTLINE.I,82,8) < DUDATE2 ³, /* WITHIN THE DATE RANGE */ SUBSTR(RPTLINE.I,82,8) = DUDATE2) THEN DO TSNAME = '' EXPIRE = SUBSTR(RPTLINE.I,82,8) PARSE UPPER VAR RPTLINE.I X1 '.' X2 '.' DBNAME '.' X4 '.' X5 '.' IF POS(' ',X4) = 1 THEN TSNAME = '' ELSE TSNAME = STRIP(X4) J = I + 1 PARSE UPPER VAR RPTLINE.I DSN NULL PARSE UPPER VAR RPTLINE.J DSN2 NULL DSN = STRIP(DSN) ³³ STRIP(DSN2) KEEP = 'YES' /****************************************************************/ /* MAKE SURE THE DATASET IS STILL ARCHIVED! */ /****************************************************************/ IF MIGRATED(DSN) = 'YES' THEN KEEP = 'NO' END /********************************************************************/ /* IF ALL THE PIECES ARE IN ORDER ADD TO THE TABLE */ /********************************************************************/ IF DBNAME > '' & , TSNAME > '' & , TSNAME ¬= 'PLANRTAB' & , KEEP = 'NO' THEN DO "TBADD TEMPTABL" IF RC = 0 THEN OUTNBR = OUTNBR + 1 DBNAME = '' TSNAME = '' END END /**********************************************************************/ /* CREATE THE OUTPUT WITH ISPF FILE TAILORING */ /**********************************************************************/ SAY "TABLE RECORDS CREATED:" OUTNBR "FTOPEN" "FTINCL DROPARC" SAVERC = RC "FTCLOSE" SAY "FILE TAILORING RETURN CODE:" SAVERC IF SAVERC > 4 THEN DO SAY "PROBLEM WITH FILE TAILORING!" ZISPFRC = SAVERC "VPUT ZISPFRC" EXIT SAVERC END EXIT /**********************************************************************/ /* THIS INTERNAL FUNCTION TELLS IF THE DATASET IS STILL MIGRATED */ /**********************************************************************/ MIGRATED: ARG DSN MIGRATED = 'NO' "LMDINIT LISTID(DSLID) LEVEL("DSN")" "LMDLIST LISTID("DSLID") OPTION(LIST) DATASET(DSN) STATS(YES)" IF ZDLVOL = 'MIGRAT' THEN MIGRATED = 'YES' "LMDLIST LISTID("DSLID") OPTION(FREE)" "LMDFREE LISTID("DSLID")" SAY "CANDIDATE ARCHIVE DATASET:" DSN SAY " CURRENT MIGRATION STATUS:" MIGRATED RETURN MIGRATED ./ ADD NAME=DSCOPY PROC 0 IN() OUT() SYSPRINT(N) DISP(MOD) UNIT() HELP REPEAT NOREPEAT /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /*********************************************************************/ /* DSCOPY CLIST - COPY INPUT DATASET TO OUTPUT DATASET WITH THE SAME */ /* UNIT, SPACE, AND DCB INFORMATION COPIED. */ /* AUTHOR : DAVID LEIGH DATE : 6-1-89 */ /*********************************************************************/ IF &HELP = &STR(HELP) THEN GOTO HELPSEC ISPEXEC VGET (INVOKE) SHARED IF &INVOKE = THEN SET INVOKE = DSCOPY SET DIALOG = OFF SET EXEC = NO IF &IN = OR &OUT = THEN + DO SET DIALOG = ON ISPEXEC VPUT (INVOKE IN OUT SYSPRINT DISP LRECL BLKSZ) SHARED LOOP:+ ISPEXEC DISPLAY PANEL(UTILDSCP) IF &LASTCC > 0 THEN + DO IF &EXEC = YES THEN + SET ZEDLMSG = &STR(EXITED "&INVOKE" UTILITY) ELSE + SET ZEDLMSG = &STR(EXITED "&INVOKE" UTILITY)+ &STR( WITHOUT PROCESSING) ISPEXEC SETMSG MSG(UTLZ000) SET INVOKE = DSCOPY ISPEXEC VPUT (DSCOPY) SHARED EXIT END ISPEXEC VGET (INVOKE IN OUT SYSPRINT DISP LRECL BLKSZ) SHARED END IF &BLKSZ > 0 THEN + IF &EVAL(&BLKSZ // &LRECL) > 0 THEN + DO SET ZEDLMSG = &STR(*** BLKSIZE NOT MULTIPLE OF LRECL ***) ISPEXEC SETMSG MSG(UTLZ001) GOTO LOOP END ELSE SET LPAREN = &STR(( SET RPAREN = &STR()) SET A = &SYSINDEX(&STR(&LPAREN),&STR(&OUT)) SET C = &A - 1 SET A = &A + 1 SET B = &LENGTH(&STR(&OUT)) SET B = &B - 1 IF &A > 1 AND + (&SUBSTR(&A:&A,&STR(&OUT)) = &STR(+) OR + &SUBSTR(&A:&A,&STR(&OUT)) = &STR(-) OR + &SUBSTR(&A:&A,&STR(&OUT)) = &STR(0) OR + &SUBSTR(&A:&A,&STR(&OUT)) = &STR(1) OR + &SUBSTR(&A:&A,&STR(&OUT)) = &STR(2) OR + &SUBSTR(&A:&A,&STR(&OUT)) = &STR(3) OR + &SUBSTR(&A:&A,&STR(&OUT)) = &STR(4) OR + &SUBSTR(&A:&A,&STR(&OUT)) = &STR(5) OR + &SUBSTR(&A:&A,&STR(&OUT)) = &STR(6) OR + &SUBSTR(&A:&A,&STR(&OUT)) = &STR(7) OR + &SUBSTR(&A:&A,&STR(&OUT)) = &STR(8) OR + &SUBSTR(&A:&A,&STR(&OUT)) = &STR(9)) THEN + DO SET GM = &SUBSTR(&A:&B,&STR(&OUT)) IF &SUBSTR(1:1,&STR(&GM)) = &STR(-) THEN + SET GM = &SUBSTR(2,&STR(&GM)) IF &LENGTH(&STR(&GM)) > 1 THEN + DO IF &SUBSTR(1:1,&STR(&GM)) = &STR(+) AND + &SUBSTR(2:2,&STR(&GM)) ¬= &STR(0) AND + &SUBSTR(2:2,&STR(&GM)) ¬= &STR(1) THEN + DO SET ZEDLMSG = &STR("PLUS 2" AND GREATER )+ &STR(GDG GENERATIONS ARE )+ &STR(NOT ALLOWED) ISPEXEC SETMSG MSG(UTLZ001) IF &DIALOG = ON THEN GOTO LOOP ELSE EXIT END IF &SUBSTR(1:2,&STR(&GM)) = &STR(+1) THEN + SET GM = NEXTGEN IF &SUBSTR(1:2,&STR(&GM)) = &STR(+0) THEN + SET GM = &STR(0) END SET DSN = &SUBSTR(1:&C,&STR(&OUT)) SET ZEDLMSG = &STR(* RESOLVING "TO" DATASET)+ &STR( RELATIVE GDG GENERATION )+ &STR(NUMBER *) IF &DIALOG = ON THEN + DO ISPEXEC SETMSG MSG(UTLZ000) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY PANEL(UTILDSCP) END ELSE + IF &INVOKE = CLIST THEN ELSE + WRITE &ZEDLMSG %GDGGEN DSN(&DSN) IF &STR(&GM) ¬= NEXTGEN THEN SET GM = MINUS&GM ISPEXEC VGET (&GM GEN LIMIT) SHARED IF &STR(&&GM) > THEN + SET GEN = &&&GM ELSE + IF &LIMIT > 0 THEN + SET GEN = G0001V00 ELSE + DO SET ZEDLMSG = &STR("&DSN" IS NOT A GDG DATASET) ISPEXEC SETMSG MSG(UTLZ001) IF &DIALOG = ON THEN GOTO LOOP ELSE EXIT END SET OUT = &STR(&DSN..&GEN) END IF &SYSDSN('&OUT') ¬= OK THEN + IF &LENGTH(&STR(&GM)) > 4 THEN + IF &SUBSTR(1:5,&STR(&GM)) = MINUS THEN + DO SET ZEDLMSG = &STR("&OUT" PROBLEM: &SYSDSN('&OUT')) ISPEXEC SETMSG MSG(UTLZ001) IF &DIALOG = ON THEN GOTO LOOP ELSE EXIT END SET A = &SYSINDEX(&STR(&LPAREN),&STR(&IN)) SET C = &A - 1 SET A = &A + 1 SET B = &LENGTH(&STR(&IN)) SET B = &B - 1 IF &A > 1 AND + (&SUBSTR(&A:&A,&STR(&IN)) = &STR(+) OR + &SUBSTR(&A:&A,&STR(&IN)) = &STR(-) OR + &SUBSTR(&A:&A,&STR(&IN)) = &STR(0) OR + &SUBSTR(&A:&A,&STR(&IN)) = &STR(1) OR + &SUBSTR(&A:&A,&STR(&IN)) = &STR(2) OR + &SUBSTR(&A:&A,&STR(&IN)) = &STR(3) OR + &SUBSTR(&A:&A,&STR(&IN)) = &STR(4) OR + &SUBSTR(&A:&A,&STR(&IN)) = &STR(5) OR + &SUBSTR(&A:&A,&STR(&IN)) = &STR(6) OR + &SUBSTR(&A:&A,&STR(&IN)) = &STR(7) OR + &SUBSTR(&A:&A,&STR(&IN)) = &STR(8) OR + &SUBSTR(&A:&A,&STR(&IN)) = &STR(9)) THEN + DO SET GM = &SUBSTR(&A:&B,&STR(&IN)) IF &SUBSTR(1:1,&STR(&GM)) = &STR(-) THEN + SET GM = &SUBSTR(2,&STR(&GM)) IF &LENGTH(&STR(&GM)) > 1 THEN + DO IF &SUBSTR(1:1,&STR(&GM)) = &STR(+) AND + &SUBSTR(2:2,&STR(&GM)) ¬= &STR(0) THEN + DO SET ZEDLMSG = &STR("PLUS 1" AND GREATER )+ &STR(GDG GENS ARE NOT ALLO)+ &STR(WED FOR THE "FROM" DATASET) ISPEXEC SETMSG MSG(UTLZ001) IF &DIALOG = ON THEN GOTO LOOP ELSE EXIT END IF &SUBSTR(1:2,&STR(&GM)) = &STR(+0) THEN + SET GM = &STR(0) END SET DSN = &SUBSTR(1:&C,&STR(&IN)) SET ZEDLMSG = &STR(* RESOLVING "FROM" DATASET)+ &STR( RELATIVE GDG GENERATION )+ &STR(NUMBER *) IF &DIALOG = ON THEN + DO ISPEXEC SETMSG MSG(UTLZ000) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY PANEL(UTILDSCP) END ELSE + IF &INVOKE = CLIST THEN ELSE + WRITE &ZEDLMSG %GDGGEN DSN(&DSN) SET GM = MINUS&GM ISPEXEC VGET (&GM GEN LIMIT) SHARED IF &STR(&&GM) > THEN + SET GEN = &&&GM ELSE + IF &LIMIT > 0 THEN + SET GEN = G0001V00 ELSE + DO SET ZEDLMSG = &STR("&DSN" IS NOT A GDG DATASET) ISPEXEC SETMSG MSG(UTLZ001) IF &DIALOG = ON THEN GOTO LOOP ELSE EXIT END SET IN = &STR(&DSN..&GEN) END IF &SYSDSN('&IN') ¬= OK THEN + DO SET ZEDLMSG = &STR("&IN" PROBLEM: &SYSDSN('&IN')) ISPEXEC SETMSG MSG(UTLZ001) IF &DIALOG = ON THEN GOTO LOOP ELSE EXIT END LISTDSI '&OUT' IF &LASTCC = 16 THEN + DO SET SWITCHOUT = OFF LISTDSI '&IN' END ELSE + DO SET SWITCHOUT = ON SET LRECL = &SYSLRECL LISTDSI '&IN' END SET ZEDLMSG = &STR(*** COPY IN PROGRESS ***) IF &DIALOG = ON THEN + DO ISPEXEC SETMSG MSG(UTLZ000) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY PANEL(UTILDSCP) END ELSE + IF &INVOKE = CLIST THEN ELSE + WRITE &ZEDLMSG FREE DDNAME(SYSUT1) ALLOC DD(SYSUT1) + DSN('&IN') + SHR KEEP IF &SWITCHOUT = ON THEN + DO FREE ATTRLIST(ATTRIB1) ATTRIB ATTRIB1 OUTPUT + RECFM(F B) + LRECL(80) + DSORG(PS) FREE DDNAME(SYSUT2) ALLOC DD(SYSUT2) + DSN('&OUT') + &DISP IF &LRECL > &SYSLRECL THEN + DO DELETE SYSIN FREE DDNAME(SYSIN) ALLOC DD(SYSIN) + DSN(SYSIN) + NEW CATALOG + UNIT(SYSDA) + SPACE(10,5) AVBLOCK(10796) RELEASE + RECFM(F B) LRECL(80) DSORG(PS) FREE DDNAME(SYSIN) ALLOC DD(SYSIN) + DSN(SYSIN) + SHR KEEP OPENFILE SYSIN OUTPUT SET SYSIN = &STR( MVC 0(1,RZ),=C' ') PUTFILE SYSIN SET SYSIN = &STR( MVC 1(250,RZ),0(RZ)) PUTFILE SYSIN SET SYSIN = &STR( MVC 251(250,RZ),0(RZ)) PUTFILE SYSIN SET SYSIN = &STR( MVC 501(250,RZ),0(RZ)) PUTFILE SYSIN SET SYSIN = &STR( MVC 751(250,RZ),0(RZ)) PUTFILE SYSIN SET SYSIN = &STR( MVC 1001(250,RZ),0(RZ)) PUTFILE SYSIN SET SYSIN = &STR( MVC 1251(250,RZ),0(RZ)) PUTFILE SYSIN SET SYSIN = &STR( MVC 1501(250,RZ),0(RZ)) PUTFILE SYSIN SET SYSIN = &STR( MVC 1751(250,RZ),0(RZ)) PUTFILE SYSIN SET SYSIN = &STR( MVC 2001(250,RZ),0(RZ)) PUTFILE SYSIN SET SYSIN = &STR( MVC 2251(250,RZ),0(RZ)) PUTFILE SYSIN SET SYSIN = &STR( MVC 2501(250,RZ),0(RZ)) PUTFILE SYSIN SET SYSIN = &STR( MVC 2751(250,RZ),0(RZ)) PUTFILE SYSIN SET SYSIN = &STR( MVC 3001(250,RZ),0(RZ)) PUTFILE SYSIN SET SYSIN = &STR( MVC 3251(250,RZ),0(RZ)) PUTFILE SYSIN SET SYSIN = &STR( MVC 3501(250,RZ),0(RZ)) PUTFILE SYSIN SET SYSIN = &STR( MVC 3751(250,RZ),0(RZ)) PUTFILE SYSIN IF &SYSLRECL > 256 THEN + DO SET X = 0 SET &LRECL = 256 DO WHILE &SYSLRECL > 0 SET SYSIN = &STR( MVC &X)+ &STR((&LRECL,RZ),&X(RX)) PUTFILE SYSIN SET &SYSLRECL = &SYSLRECL - 256 IF &SYSLRECL > 256 THEN SET LRECL = 256 ELSE SET LRECL = &SYSLRECL SET X = &X + &LRECL END END ELSE + DO SET SYSIN = &STR( MVC 0)+ &STR((&SYSLRECL,RZ),0(RX)) PUTFILE SYSIN END SET SYSIN = &STR( BAL SYSUT2(RZ)) PUTFILE SYSIN SET SYSIN = &STR( B DELETE(RX)) PUTFILE SYSIN SET SYSIN = &STR( END) PUTFILE SYSIN CLOSFILE SYSIN FREE DDNAME(SYSIN) ALLOC DD(SYSIN) + DSN(SYSIN) + SHR KEEP END ELSE IF &LRECL < &SYSLRECL AND &LRECL > 0 THEN + DO DELETE SYSIN FREE DDNAME(SYSIN) ALLOC DD(SYSIN) + DSN(SYSIN) + NEW CATALOG + UNIT(SYSDA) + SPACE(1,1) AVBLOCK(10796) RELEASE + RECFM(F B) LRECL(80) DSORG(PS) FREE DDNAME(SYSIN) ALLOC DD(SYSIN) + DSN(SYSIN) + SHR KEEP OPENFILE SYSIN OUTPUT SET SYSIN = &STR( MVC LENX,=H'&LRECL') PUTFILE SYSIN SET SYSIN = &STR( BAL SYSUT2(RX)) PUTFILE SYSIN SET SYSIN = &STR( B DELETE(RX)) PUTFILE SYSIN SET SYSIN = &STR( END) PUTFILE SYSIN CLOSFILE SYSIN FREE DDNAME(SYSIN) ALLOC DD(SYSIN) + DSN(SYSIN) + SHR KEEP END END ELSE + DO IF &UNIT = THEN SET UNIT = &SYSUNIT IF &LRECL = THEN SET LRECL = &SYSLRECL IF &LRECL ¬= &SYSLRECL THEN + DO ALLOC DD(SYSUT2) DSN('&OUT') + NEW CATALOG + UNIT(&UNIT) + SPACE(1000,1000) AVBLOCK(10796) RELEASE + RECFM(F B) LRECL(&LRECL) DSORG(PS) END ELSE + DO ALLOC DD(SYSUT2) + DSN('&OUT') + NEW CATALOG + VOLUME(&SYSVOLUME) + UNIT(&SYSUNIT) + LIKE('&IN') END IF &LRECL > &SYSLRECL THEN + DO DELETE SYSIN FREE DDNAME(SYSIN) ALLOC DD(SYSIN) + DSN(SYSIN) + NEW CATALOG + UNIT(SYSDA) + SPACE(5,1) TRACKS RELEASE + RECFM(F B) LRECL(80) DSORG(PS) FREE DDNAME(SYSIN) ALLOC DD(SYSIN) + DSN(SYSIN) + SHR KEEP OPENFILE SYSIN OUTPUT SET SYSIN = &STR( MVC 0(1,RZ),=C' ') PUTFILE SYSIN SET SYSIN = &STR( MVC 1(250,RZ),0(RZ)) PUTFILE SYSIN SET SYSIN = &STR( MVC 251(250,RZ),0(RZ)) PUTFILE SYSIN SET SYSIN = &STR( MVC 501(250,RZ),0(RZ)) PUTFILE SYSIN SET SYSIN = &STR( MVC 751(250,RZ),0(RZ)) PUTFILE SYSIN SET SYSIN = &STR( MVC 1001(250,RZ),0(RZ)) PUTFILE SYSIN SET SYSIN = &STR( MVC 1251(250,RZ),0(RZ)) PUTFILE SYSIN SET SYSIN = &STR( MVC 1501(250,RZ),0(RZ)) PUTFILE SYSIN SET SYSIN = &STR( MVC 1751(250,RZ),0(RZ)) PUTFILE SYSIN SET SYSIN = &STR( MVC 2001(250,RZ),0(RZ)) PUTFILE SYSIN SET SYSIN = &STR( MVC 2251(250,RZ),0(RZ)) PUTFILE SYSIN SET SYSIN = &STR( MVC 2501(250,RZ),0(RZ)) PUTFILE SYSIN SET SYSIN = &STR( MVC 2751(250,RZ),0(RZ)) PUTFILE SYSIN SET SYSIN = &STR( MVC 3001(250,RZ),0(RZ)) PUTFILE SYSIN SET SYSIN = &STR( MVC 3251(250,RZ),0(RZ)) PUTFILE SYSIN SET SYSIN = &STR( MVC 3501(250,RZ),0(RZ)) PUTFILE SYSIN SET SYSIN = &STR( MVC 3751(250,RZ),0(RZ)) PUTFILE SYSIN IF &SYSLRECL > 256 THEN + DO SET X = 0 SET &LRECL = 256 DO WHILE &SYSLRECL > 0 SET SYSIN = &STR( MVC &X)+ &STR((&LRECL,RZ),&X(RX)) PUTFILE SYSIN SET &SYSLRECL = &SYSLRECL - 256 IF &SYSLRECL > 256 THEN SET LRECL = 256 ELSE SET LRECL = &SYSLRECL SET X = &X + &LRECL END END ELSE + DO SET SYSIN = &STR( MVC 0)+ &STR((&SYSLRECL,RZ),0(RX)) PUTFILE SYSIN END SET SYSIN = &STR( BAL SYSUT2(RZ)) PUTFILE SYSIN SET SYSIN = &STR( B DELETE(RX)) PUTFILE SYSIN SET SYSIN = &STR( END) PUTFILE SYSIN CLOSFILE SYSIN FREE DDNAME(SYSIN) ALLOC DD(SYSIN) + DSN(SYSIN) + SHR KEEP END ELSE IF &LRECL < &SYSLRECL AND &LRECL > 0 THEN + DO DELETE SYSIN FREE DDNAME(SYSIN) ALLOC DD(SYSIN) + DSN(SYSIN) + NEW CATALOG + UNIT(SYSDA) + SPACE(1,1) AVBLOCK(10796) RELEASE + RECFM(F B) LRECL(80) DSORG(PS) FREE DDNAME(SYSIN) ALLOC DD(SYSIN) + DSN(SYSIN) + SHR KEEP OPENFILE SYSIN OUTPUT SET SYSIN = &STR( MVC LENX,=H'&LRECL') PUTFILE SYSIN SET SYSIN = &STR( BAL SYSUT2(RX)) PUTFILE SYSIN SET SYSIN = &STR( B DELETE(RX)) PUTFILE SYSIN SET SYSIN = &STR( END) PUTFILE SYSIN CLOSFILE SYSIN FREE DDNAME(SYSIN) ALLOC DD(SYSIN) + DSN(SYSIN) + SHR KEEP END END FREE DDNAME(SYSPRINT) IF &SYSPRINT = Y THEN + ALLOC DD(SYSPRINT) + DSN(*) ELSE + ALLOC DD(SYSPRINT) + DUMMY /* FREE ATTRLIST(ATTRDUMP) /* ATTRIB ATTRDUMP OUTPUT + /* RECFM(F B) + /* LRECL(255) + /* BLKSIZE(23460) /* DELETE SYSUDUMP /* FREE DDNAME(SYSUDUMP) /* ALLOC DD(SYSUDUMP) + /* DSN(SYSUDUMP) + /* NEW CATALOG + /* UNIT(SYSDA) + /* SPACE(5,1) CYLINDERS RELEASE + /* USING(ATTRDUMP) /* FREE DDNAME(SYSUDUMP) ALLOC DD(SYSUDUMP) + DUMMY CALL 'SYS2A.LINKLIB(WAAPDSUT)' SET SAVECC = &LASTCC IF &SAVECC = 0 THEN + IF &SWITCHOUT = ON THEN + IF &DISP = SHR OR &DISP = OLD THEN + SET ZEDLMSG = &STR(REPLACED "&OUT" WITH "&IN") ELSE SET ZEDLMSG = &STR(APPENDED "&OUT" WITH "&IN") ELSE SET ZEDLMSG = &STR(CREATED "&OUT" FROM "&IN") ELSE SET ZEDLMSG = &STR(&INVOKE UNSUCCESSFUL - WAAPDSUT RC = &SAVECC) ISPEXEC SETMSG MSG(UTLZ000) FREE ATTRLIST(ATTRIB1) FREE ATTRLIST(ATTRIB2) FREE DDNAME(SYSIN) FREE DDNAME(SYSUT1) FREE DDNAME(SYSUT2) FREE DDNAME(SYSPRINT) FREE DDNAME(SYSUDUMP) SET EXEC = YES IF (&INVOKE = DSCOPY OR &REPEAT = REPEAT) + AND &NOREPEAT ¬= NOREPEAT THEN GOTO LOOP SET INVOKE = DSCOPY ISPEXEC VPUT (DSCOPY) SHARED EXIT HELPSEC: + CLEAR WRITE *** HELP FOR CLIST 'DSCOPY' *** WRITE WRITE THE DSCOPY UTILITY ALLOWS THE USER TO COPY ONE DATASET TO ANOTHER WRITE IF THE "TO" DATASET DOES OR DOES NOT EXIST. IF THE "TO" DATASET WRITE DOES NOT EXIST, IT WILL BE ALLOCATED USING THE SPACE, UNIT AND WRITE DCB PARAMETERS FROM THE "FROM" DATASET. IF THE DATASET DOES EXIST WRITE IT CAN BE "APPENDED" ("MOD" IS THE DEFAULT FOR EXISTING DATASETS), WRITE OR OVERWRITTEN (DISP=SHR). IF THE DATASETS HAVE INCOMPATIBLE WRITE LRECL'S, AUTOMATIC TRUNCATION, OR PADDING WITH SPACES WILL OCCUR. WRITE THE CLIST MAY BE INVOKED WITH PASSED PARAMETERS FOR CALLING FROM WRITE OTHER CLISTS, OR CALLING FROM ISPF OPTION 6 (THE PASSED PARAMETERS WRITE MAY BE TOO LONG FOR NON-OPTION 6 COMMAND LINE INVOCATION). WRITE IF CALLED WITHOUT ALL THE NECESSARY PARAMETERS, THE USER WILL BE WRITE TAKEN INTO AN ISPF PANEL FOR ENTERING THE NECESSARY PARAMETERS. WRITE THIS CLIST MAY ALSO BE CALLED FROM EDIT MACRO "COPYDS". TYPE WRITE "COPYDS HELP" FOR SPECIFICS ON HOW TO USE THE EDIT MACRO VERSION. WRITE TO RECEIVE "HELP" ON HOW TO FILL OUT THE ISPF PANEL, INVOKE DSCOPY WRITE WITHOUT ALL THE NECESSARY PARAMETERS AND YOU WILL BE TAKEN INTO WRITE THE ISPF PANEL. FROM THERE, TYPE "HELP" AND PRESS . WRITE WRITE BASIC SYNTAX : WRITE WRITE COMMAND ==> DSCOPY WRITE WRITE AVAILABLE KEYWORD PARAMBERS : WRITE WRITE IN - FULLY QUALIFIED INPUT DATASET NAME WITHOUT QUOTES (NO GDG WRITE RELATIVE GENERATION NUMBERS ALLOWED) WRITE OUT - FULLY QUALIFIED OUTPUT DATASET NAME WITHOUT QUOTES (NO GDG WRITE RELATIVE GENERATION NUMBERS ALLOWED) WRITE DISP - PRIMARY DISPOSITION OF OUTPUT DATASET IF IT ALREADY EXISTS. WRITE THE DEFAULT IS "MOD". VALID VALUES ARE "OLD", "SHR", AND WRITE "MOD". WRITE SYSPRINT - VALUE OF "Y" WILL DISPLAY THE WAAPDSUT SYSPRINT WRITE ASSOCIATED WITH THE COPY OPERATION. THE VALUE OF "NO" WRITE WILL NOT DISPLAY THE SYSPRINT MESSAGES. "N" IS THE WRITE DEFAULT. WRITE WRITE THE VALUES OF "IN" AND "OUT" MUST BE PASSED WITH THE INVOCATION OF WRITE "DSCOPY" IF YOU WANT TO AVOID THE ISPF PANEL. "DISP" AND WRITE "SYSPRINT" WILL DEFAULT. WRITE WRITE *** END OF HELP *** NO PROCESSING PERFORMED *** EXIT ./ ADD NAME=DSLIST 000100 /*************************************************************** REXX */ 000200 /* */ 000300 /* Module Name: DSLIST */ 000400 /* */ 000500 /* Descriptive Name: Cursor-driven entry into PDF 3.4 panel */ 000600 /* */ 000700 /* Status: R213 */ 000800 /* */ 000900 /* Function: This REXX program allows you to invoke the data-set */ 001000 /* list function of ISPF/PDF (option 3.4) with the */ 001100 /* DSNAME LEVEL field set to the dsname under which */ 001200 /* the cursor is placed when you enter the command. */ 001300 /* When running in ISPF 4.2, the Work Place (opt 11) */ 001400 /* is invoked instead of the Data Set List Utility. */ 001500 /* */ 001600 /* Author: Gilbert Saint-flour */ 001700 /* */ 001800 /* Environment: TSO/E V2 */ 001900 /* ISPF/PDF V3 or V4 */ 002000 /* */ 002100 /* Operation: */ 002200 /* */ 002300 /* DSLIST may be invoked as a command or as an EDIT macro. */ 002400 /* */ 002500 /* o To invoke DSLIST as a command, enter TSO %DSLIST in the */ 002600 /* command field, move the cursor under a data set name */ 002700 /* currently appearing on your screen and press ENTER. */ 002800 /* DSLIST extracts the data set name from the screen, */ 002900 /* invokes the Data Set List utility (opt 3.4) and places */ 003000 /* the data set name in the DSNAME LEVEL field. In the */ 003100 /* ISPF 4.2 environment, DSLIST invokes the ISPF Workplace */ 003200 /* (opt 11) instead of the Data Set List utility. */ 003300 /* */ 003400 /* o To invoke DSLIST as an EDIT macro, type %DSLIST in the */ 003500 /* command field, move the cursor under a data set name */ 003600 /* currently appearing on your screen and press ENTER. */ 003700 /* */ 003800 /* Notes: */ 003900 /* */ 004000 /* o DSLIST extracts data set names in upper-case only. */ 004100 /* */ 004200 /* o A data set name in a message can not be extracted. */ 004300 /* */ 004400 /* o When invoked as a command, the data set name must be */ 004500 /* entirely visible on the screen. */ 004600 /* */ 004700 /* o When invoked as an EDIT macro, the data set name only */ 004800 /* needs to be partially visible but it must be on a */ 004900 /* DATA line. */ 005000 /* */ 005100 /* o When invoked as an EDIT macro, DSLIST uses standard ISREDIT */ 005200 /* functions to retrieve the text at the cursor position. */ 005300 /* */ 005400 /* o When invoked as a command, DSLIST accesses control */ 005500 /* blocks that are not part of the standard ISPF */ 005600 /* programming interface to retrieve the screen image and */ 005700 /* cursor position. This method works with ISPF/PDF V2R3 */ 005800 /* thru V4R5 but may not work in future releases. */ 005900 /* This technique is borrowed from ISPCDSN, a program written */ 006000 /* by Gordon J. Schillinger, to whom I'm for ever grateful. */ 006100 /* */ 006200 /* o Assign TSO %DSLIST to a PFK in those ISPF applications */ 006300 /* that allow you to view job output: SDSF, SAR, IOF, etc. */ 006400 /* In some applications (such as SYSVIEW), you MUST invoke */ 006500 /* DSLIST using a PFK. */ 006600 /* */ 006700 /* o When DSLIST is invoked outside of PDF (i.e ZAPPLID is NOT */ 006800 /* equal to ISR), DSLIST re-invokes itself with NEWAPPL(ISR) */ 006900 /* to ensure the same PFK setting as when option 3.4 is */ 007000 /* invoked from the PDF main menu. */ 007100 /* */ 007200 /* o To enable their cursor-driven capability, commercial */ 007300 /* products like MVS/QuickRef require you to modify the */ 007400 /* main panel of every application in which you intend to */ 007500 /* use it. DSLIST does not require any panel modification. */ 007600 /* */ 007700 /* Change Activity: */ 007800 /* */ 007900 /* @206 Fix DEBUG option, add "_" as dsname delimiter */ 008000 /* @207 Rewrite DSN extraction algorithm to support dynamic areas */ 008100 /* and windows; dsname must be in upper-case. */ 008200 /* @208 If the cursor is placed under a DSN= or DSNAME= string, */ 008300 /* extract the dsname to the right of the = sign. */ 008400 /* @209 Invoke ISPF Workplace in the ISPF 4.2 environment */ 008500 /* @210 Minor technical changes and documentation improvements */ 008600 /* @211 Prevent error when csrw=0 */ 008700 /* @212 Add PROFILE option on VPUT commands */ 008800 /* @213 Rewrite dsname extraction algorithm */ 008900 /**********************************************************************/ 009000 ADDRESS ISPEXEC 009100 "CONTROL ERRORS RETURN" 009200 Zerrmsg='' 009300 Dsname='' 009400 "ISREDIT MACRO (DEBUG)" 009500 If rc = 0 THEN DO /* if we've been invoked as */ 009600 UPPER debug /* an edit macro, use ISREDIT */ 009700 "ISREDIT (LINE,CSRP) = CURSOR" /* to retrieve the line and */ 009800 "ISREDIT (LINE) = LINE .ZCSR" /* cursor position */ 009900 IF csrp>0 THEN /* then */ 010000 CALL extract_dsname /* extract the dsname */ 010100 END 010200 ELSE DO /* DSLIST invoked as a command */ 010300 ARG debug 010400 "VGET ZAPPLID" /* Get current application ID */ 010500 IF zapplid <> 'ISR' THEN DO /* If ZAPPLID\=ISR, re-invoke */ 010600 "SELECT CMD(%"SYSVAR(SYSICMD) debug ") NEWAPPL(ISR)" 010700 EXIT rc /* DSLIST with NEWAPPL(ISR) */ 010800 END 010900 CALL find_cursor_position /* find the cursor position, */ 011000 CALL extract_dsname /* extract the dsname */ 011100 END 011200 "VGET ZENVIR" /* Retrieve ISPF Version */ 011300 /* Zenvir='ISPF 4.1' */ /* Force usage of DSLIST */ 011400 IF LEFT(Zenvir,8) < 'ISPF 4.2' THEN 011500 CALL Invoke_ISRUDL /* Data Set List Utility (3.4) */ 011600 ELSE 011700 CALL Invoke_Work_Place /* Work Place Utility (opt 11) */ 011800 IF zerrmsg<>'' THEN "SETMSG MSG("zerrmsg")" 011900 EXIT 012000 /*-------------------------------------------------------- sub-routine*/ 012100 /* */ 012200 /* RETRIEVE LINE ADDRESS AND CURSOR POSITION */ 012300 /* */ 012400 /*--------------------------------------------------------------------*/ 012500 find_cursor_position: 012600 tcb = PTR(540) /* TCB (EXEC command) PSATOLD */ 012700 tcb = PTR(tcb+132) /* TCB (ISPTASK) TCBOTC */ 012800 fsa = PTR(tcb+112) /* first save area TCBFSA */ 012900 r1 = PTR(fsa+24) /* ISPTASK's R1 */ 013000 tld = PTR(r1) /* TLD address */ 013100 tls = PTR(tld+096) /* screen buffer TLDTLSP */ 013200 csr = PTR(tld+164) /* relative cursor pos. TLDCSR */ 013300 scrw = PTR(tld+192) /* screen width TLDCLSWD */ 013400 IF scrw>0 then 013500 csrp = csr//scrw+1 /* cursor position in curr. line */ 013600 ELSE 013700 csrp = 1 /* ISPSTRT */ 013800 linead = D2X(tls+csr-csrp+1) /* address of current line */ 013900 line = STORAGE(linead,scrw) /* text of current line */ 014000 IF debug='DEBUG' THEN SAY 'tcb='D2X(tcb) 'fsa='D2X(fsa) 'r1='D2X(r1), 014100 'tld='D2X(tld) STORAGE(D2X(tld),4) 'tls='D2X(tls), 014200 'csr='csr 'scrw='scrw 'linead='linead 014300 RETURN 014400 PTR: RETURN C2D(BITAND(STORAGE(D2X(ARG(1)),4),'7FFFFFFF'X)) 014500 /*-------------------------------------------------------- sub-routine*/ 014600 /* */ 014700 /* Scan current line to extract the dsname */ 014800 /* */ 014900 /* line -> TEXT OF LINE AT CURSOR POSITION */ 015000 /* csrp -> CURSOR POSITION IN LINE */ 015100 /* */ 015200 /*--------------------------------------------------------------------*/ 015300 extract_dsname: 015400 valid=COPIES(' ',64)||XRANGE('40'x,'FF'x) 015500 IF debug='DEBUG' THEN /* debug */ 015600 DO /* debug */ 015700 PARSE SOURCE . . cmd ddn dsn . . . . . /* debug */ 015800 SAY 'cmd='cmd 'ddn='ddn 'dsn='dsn /* debug */ 015900 DO I=1 BY 16 TO LENGTH(Line) /* debug */ 016000 HEX=''; CHAR='*' /* debug */ 016100 DO J=I BY 4 UNTIL J>I+16 /* debug */ 016200 L=LENGTH(Line)-J+1 /* debug */ 016300 IF L<1 THEN LEAVE /* debug */ 016400 S=SUBSTR(Line,J,L) /* debug */ 016500 HEX=HEX || ' ' || LEFT(C2X(S),8) /* debug */ 016600 CHAR=CHAR||LEFT(S,4) /* debug */ 016700 END /* debug */ 016800 char=TRANSLATE(char,valid) /* debug */ 016900 SAY ' +'RIGHT(I-1,4,'0') ' ' LEFT(HEX,36) ' ' LEFT(CHAR,17)'*' 017000 END /* debug */ 017100 SAY 'CURSOR POSITION='csrp /* debug */ 017200 END /* debug */ 017300 If SUBSTR(line,csrp,1)=' ' THEN RETURN 017400 017500 /* If the cursor is positionned under a DSN= or DSNAME= string, */ 017600 /* move the cursor pointer to the right of the = sign. */ 017700 017800 p=SUBSTR(line,MAX(csrp-3,1),MIN(csrp+3,LENGTH(line))+1) 017900 IF POS('DSN=',p) > 0 THEN csrp=csrp+4 018000 018100 p=SUBSTR(line,MAX(csrp-6,1),MIN(csrp+6,LENGTH(line))+1) 018200 IF POS('DSNAME=',p) > 0 THEN csrp=csrp+7 018300 018400 /* Pad the line at both ends with spaces; convert to upper-case */ 018500 018600 line=COPIES(' ',10) || TRANSLATE(line,valid) || COPIES(' ',10) 018700 csrp=csrp+10 018800 line=TRANSLATE(line) /* convert to upper case */ 018900 019000 /* If the cursor is positionned under a parenthesis, ignore it */ 019100 019200 DO WHILE SUBSTR(line,csrp,1)='('; csrp=csrp+1; END 019300 DO WHILE SUBSTR(line,csrp,1)=')'; csrp=csrp-1; END 019400 019500 valid='ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789@#$-{.' 019600 ld=0;lp=0 019700 019800 /* Check that the cursor is under a valid dsname character. */ 019900 /* If it's under an apostrophe, determine if it's the start */ 020000 /* or the end of the dsname. */ 020100 020200 c=SUBSTR(line,csrp,1) 020300 IF VERIFY(c,valid)=1 THEN DO /* invalid dsname char */ 020400 IF c\="'" THEN RETURN /* invalid, not a quote */ 020500 IF VERIFY(SUBSTR(line,csrp+1,1),valid)=0 THEN 020600 ld=csrp /* left delimiter found */ 020700 ELSE DO /* apost marks start dsn */ 020800 p=csrp-1 /* move csr before apost */ 020900 IF SUBSTR(line,p,1)=')' | VERIFY(SUBSTR(line,p,1),valid)=0 THEN 021000 csrp=csrp-2 /* move csr before ) */ 021100 ELSE /* apost surounded by */ 021200 RETURN /* invalid characters */ 021300 END 021400 END 021500 IF debug='DEBUG' THEN SAY 'ld='ld 021600 021700 /* Find start of dsname */ 021800 021900 IF ld=0 THEN DO 022000 DO csrp=csrp to 1 by -1 022100 c=SUBSTR(line,csrp,1) 022200 IF VERIFY(c,valid)>0 THEN /* invalid dsname char */ 022300 IF c='(' THEN DO /* left paren */ 022400 IF lp>0 THEN LEAVE /* not first left paren */ 022500 DO I=1 to 9 /* search for a period */ 022600 IF SUBSTR(line,csrp+i,1) ='.' THEN LEAVE 022700 END 022800 IF i>8 THEN /* no period found after */ 022900 lp=csrp /* start of member */ 023000 ELSE 023100 LEAVE /* start of member */ 023200 END 023300 ELSE /* invalid char, not "(" */ 023400 LEAVE 023500 END 023600 ld=csrp /* left delimiter */ 023700 IF lp=ld+1 THEN DO 023800 lp=0 /* no member */ 023900 ld=ld+1 024000 END 024100 END 024200 IF debug='DEBUG' THEN SAY 'ld='ld 'lp='lp 'csrp='csrp 024300 024400 /* Find start of member name */ 024500 024600 IF lp=0 THEN DO /* "(" not seen yet */ 024700 csrp=ld+1 /* 1st byte of dsname */ 024800 p=VERIFY(line,valid,,csrp) /* Find delimiter */ 024900 IF debug='DEBUG' THEN SAY 'csrp='csrp 'p='p SUBSTR(line,p,1) 025000 IF SUBSTR(line,p,1)='(' THEN DO 025100 lp=p /* "(" found */ 025200 csrp=p+1 /* 1st byte of mbr name */ 025300 END 025400 END 025500 ELSE 025600 csrp=lp+1 /* 1st byte of member */ 025700 IF debug='DEBUG' THEN SAY 'ld='ld 'lp='lp 'csrp='csrp 025800 025900 /* Find end of dsname */ 026000 026100 rd=VERIFY(line,valid,,csrp) /* Find delimiter aft dsn */ 026200 IF debug='DEBUG' THEN SAY 'csrp='csrp 'rd='rd SUBSTR(line,rd,1) 026300 IF lp>0 & SUBSTR(line,rd,1)=')' THEN rd=rd+1 026400 026500 IF SUBSTR(line,ld,1)="'" & SUBSTR(line,rd,1)\="'" THEN RETURN 026600 026700 Dsname = SUBSTR(Line,ld+1,rd-ld-1) 026800 IF LEFT(Dsname,9) = 'CLUSTER--', /* IDCAMS LISTCAT */ 026900 | LEFT(Dsname,9) = 'DATA-----', /* IDCAMS LISTCAT */ 027000 | LEFT(Dsname,9) = 'INDEX----', /* IDCAMS LISTCAT */ 027100 | LEFT(Dsname,9) = 'NONVSAM--' THEN /* IDCAMS LISTCAT */ 027200 dsname=RIGHT(dsname,LENGTH(dsname)-9) /* IDCAMS LISTCAT */ 027300 IF debug='DEBUG' THEN SAY 'Dsname="'Dsname'"' 027400 IF LENGTH(Dsname) < 5 | LENGTH(Dsname) > 44 THEN Dsname='' 027500 RETURN 027600 /*-------------------------------------------------------- sub-routine*/ 027700 /* */ 027800 /* Invoke the Data Set List Utility (ISPF 2.3 through 4.1) */ 027900 /* */ 028000 /*--------------------------------------------------------------------*/ 028100 Invoke_ISRUDL: 028200 IF Dsname<>'' THEN DO 028300 i=INDEX(Dsname,'(') /* check for member name */ 028400 IF i>0 THEN /* If abcd.edfgh(ijkl) */ 028500 Zdldsnlv=LEFT(Dsname,i-1) /* remove (ijkl) */ 028600 ELSE 028700 Zdldsnlv=Dsname /* pass data set name */ 028800 zdlpvl='' /* blank out volume serial */ 028900 "VPUT (Zdldsnlv Zdlpvl) PROFILE" /* update ISRUDLP variables */ 029000 END 029100 "SELECT PGM(ISRUDL) PARM(ISRUDLP)" 029200 RETURN 029300 /*-------------------------------------------------------- sub-routine*/ 029400 /* */ 029500 /* Invoke the Work Place Utility (ISPF 4.2 and above) */ 029600 /* */ 029700 /*--------------------------------------------------------------------*/ 029800 Invoke_Work_Place: 029900 IF Dsname<>'' THEN DO 030000 Zwrkdsn="'"Dsname"'" /* enclose dsname in quotes */ 030100 Zwrkvol='' /* blank out volume serial */ 030200 Zreftype='D' /* Data set view */ 030300 "VPUT (Zwrkdsn Zwrkvol Zreftype) PROFILE" /* update ISRWORK vars */ 030400 END 030500 "SELECT PGM(ISRUDA) PARM(ISRWORK) SCRNAME(WORK)" 030600 RETURN ./ ADD NAME=DSNPATH /* REXX ***************************************************************/ /* Utility: DSNPATH */ /* Author: David Leigh */ /* Function: This utility traverses the ca11 dataset xref with a */ /* combination of input JOBNAME, JOBSTEP NAME, and */ /* PROCSTEP NAME. It finds each output dataset name in that */ /* step and attempts to find where that data ends up by */ /* following that dataset and seeing what jobs and steps it */ /* ends up in. */ /* */ /* This is an edit macro. Its output is "SAY" statements. */ /* To capture this output, it is best to run it in batch */ /* and save the job output to a dataset. */ /**********************************************************************/ ADDRESS ISPEXEC 'CONTROL ERRORS RETURN' ADDRESS ISREDIT "MACRO (sJobName sJobStep sPrcStep iLevel iSeqNbr sInDSN sDebug)" if sJobName = '' then do address ispexec 'vget (sJobName sJobStep sPrcStep iLevel iSeqNbr sInDSN) shared' 'vget (sDebug sDisplay) shared' address isredit end upper sDebug sDisplay if sDebug = 'DEBUG' then trace ?i if iSeqNbr = '' then iSeqNbr = 0 iSubLevel = 0 if iLevel < 1 then do iLevel = 0 tLevel = 0 SAY '*********************************' SAY '* DSNPATH Utility Input' SAY '* JobName:' sJobName SAY '* JobStep:' sJobStep SAY '* PrcStep:' sPrcStep SAY '* Display Output:' sDisplay SAY '*********************************' address ispexec "tbstats temptabl status2(tStat2)" if tStat2 = 1 then "tbcreate temptabl nowrite replace", "keys(tJobName, tJobStep, tPrcStep, tDSN)", "names(tLevel, tDisp, tDDName, tSeqNbr)" address isredit end /**********************************************************************/ /* "priming" find */ /**********************************************************************/ "find first '"substr(sJobName' ',1,8), substr(sJobStep' ',1,8) sPrcStep"' 93" /**********************************************************************/ /* main Prcessing loop through the datasets in this step */ /**********************************************************************/ do while rc = 0 "(line) = line .zcsr" /* store the line a variable */ "label .zcsr = .curr" /* maintain position to this line */ /********************************************************************/ /* parse out the line into its individual component fields & strip */ /********************************************************************/ parse upper var line sDSN sDisp1 ',' sDisp2 sDD sMedia sJob sJS sPS . sDSN = strip(sDSN) sDisp1 = strip(sDisp1) if sDisp1 = 'NEW' ³ sDisp1 = 'MOD' then do /* only output datasets */ if sDD ¬= 'STEPLIB' &, /* disregard certain dds */ sDD ¬= 'XPRINT' &, sDD ¬= 'PRINT' &, sDD ¬= 'SYSOUD' then do /****************************************************************/ /* begin the real traversing work using recursive calls */ /****************************************************************/ /* sOutput = sJob"/"sJS"/"sPS"/"sDD"/"sDSN "("sDisp1")" if iLevel > 0 then say insert(' ',sOutput,0,iLevel*2,' ') else say sOutput */ if sInDSN = '' then sInDSN = sDSN /****************************************************************/ /* set table column variable values and try to add the table */ /****************************************************************/ tJobName = sJob /* Job Name */ tJobStep = sJS /* Job Step Name */ tPrcStep = sPS /* Proc Step Name */ tDSN = sDSN /* Dataset Name */ tDisp = sDisp1 /* Dataset Disposition */ tDDName = sDD /* DD Name */ iSubLevel = iSubLevel + 1 /* Level within this iteration */ tLevel = iLevel"."iSubLevel /* Main Level */ iSeqNbr = iSeqNbr + 1 /* Order in which rows added */ tSeqNbr = substr("000"iSeqNbr,length("000"iSeqNbr)-3) tNumVar = 1 /* # of Extension Variables */ tXVar1 = sInDSN /* previous dataset */ address ispexec "tbadd temptabl save(tNumVar tXVar1)" if rc = 0 then do /**************************************************************/ /* OK, this is a new row so now we go to find what this DSN */ /* is input to. We do that by a "find loop". */ /**************************************************************/ "find first '"sDsn"' 2" /* now find where this is input to */ do while rc = 0 "(line) = line .zcsr" parse upper var line sInDSN sDisp1 ',', sDisp2 sDD sMedia sJob sJS sPS . if sDisp1 = 'SHR' ³ sDisp1 = 'OLD' then do iNewLevel = iLevel + 1 /* find next outputs by calling DSNPATH recursively */ "DSNPATH" sJob sJS sPS iNewLevel iSeqNbr sInDSN sDebug end "find next '"sDsn"' 2" end end else do /**************************************************************/ /* if the row exists, extract what has already been captured */ /* as input to this step and add this one to it. */ /**************************************************************/ address ispexec "tbget temptabl savename(tExtVars)" /* process extension vars */ sTemp = 'j =' tNumVar interpret sTemp sTemp = '' do i = 1 to j /* build the tbput "save" parameter */ sTemp = sTemp 'tXVar'i end tNumVar = tNumVar + 1 sTemp2 = 'tXVar'tNumVar '=' sInDSN interpret sTemp2 tExtVars = 'tNumVar' sTemp 'tXVar'tNumVar "tbput temptabl save("tExtVars")" address isredit end end end "find last p'=' .curr .curr" /* reposition and find the next one */ "find next '"substr(sJobName' ',1,8), substr(sJobStep' ',1,8) sPrcStep"' 93" end /**********************************************************************/ /* Last one out, turn out the lights... */ /* This section executes if you're leaving this utility to the calling*/ /* application and not another "layer" of DSNPATH. If you've called */ /* DSNPATH over and over with different job/step/step combos and you */ /* want a display just at the end, the sDisplay must be set to 'no' */ /* on the first executions and 'yes' on the last one. When it is YES */ /* this is where the display is processed. */ /**********************************************************************/ if iLevel = 0 then do address ispexec if sDisplay = 'YES' then do "tbsort temptabl fields(tSeqNbr,C,A)" "tbtop temptabl" "tbskip temptabl SAVENAME(tExtVars)" do while rc = 0 parse upper var tLevel iLevel '.' iSubLevel . say insert(' ',tJobName,0,iLevel*2,' '), tJobStep tPrcStep tDSN "("tDisp")" tSeqNbr sTemp = 'j =' tNumVar interpret sTemp sTemp = '' do i = 1 to j /* display input datasets for this one */ sTemp = 'sTempDSN = tXVar'i interpret sTemp sTemp = " Input Dataset: " say insert(' ',sTemp,0,iLevel*2,' ') sTempDSN end "tbskip temptabl SAVENAME(tExtVars)" end end "vput (iSeqNbr) shared" address isredit "cancel" end exit ./ ADD NAME=DSNPRINT ISREDIT MACRO (PARM) ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /******************************************************************/ /* 'DSNPRINT' EDIT MACRO. PRINT THE DATASET WHERE THE CURSOR IS */ /* OR THE DATASET BEING EDITED IF THE CURSOR IS AT THE TOP. */ /* AUTHOR : DAVID LEIGH DATE : 10-11-88 */ /******************************************************************/ IF &PARM = &STR(HELP) THEN GOTO HELPSEC ISREDIT (LN,CL) = CURSOR IF &STR(&CL) = &STR(000) THEN + DO SET MBR = ISREDIT (MBR) = MEMBER ISREDIT (DSN) = DATASET IF &LENGTH(&STR(&MBR)) > 0 THEN SET DSN = &STR(&DSN.(&MBR)) SET ZEDSMSG = &STR(PROBLEM WITH DATASET) SET ZEDLMSG = &STR(&DSN PROBLEM : &SYSDSN('&DSN')) IF &SYSDSN('&DSN') = OK OR + &STR(&SWITCH) = ON THEN + DO ISPEXEC VPUT (DSN) PROFILE ISPEXEC SELECT CMD(%UTILPRNT &PARM) END ELSE ISPEXEC SETMSG MSG(UTLZ001) END ELSE + DO ISREDIT (DSN) = LINE .ZCSR SET DSN = &SUBSTR(&CL:&LENGTH(&STR(&DSN)),&STR(&DSN)) IF &SYSINDEX(&STR( ),&STR(&DSN)) > 1 THEN + SET DSN = &SUBSTR(1:+ &EVAL(&SYSINDEX(&STR( ),&STR(&DSN)) -1),&STR(&DSN)) IF &SYSINDEX(&STR(. ),&STR(&DSN)) > 1 THEN + SET DSN = &SUBSTR(1:+ &EVAL(&SYSINDEX(&STR(. ),&STR(&DSN)) -1),&STR(&DSN)) IF &SYSINDEX(&STR(?),&STR(&DSN)) > 1 THEN + SET DSN = &SUBSTR(1:+ &EVAL(&SYSINDEX(&STR(?),&STR(&DSN)) -1),&STR(&DSN)) IF &SYSINDEX(&STR(:),&STR(&DSN)) > 1 THEN + SET DSN = &SUBSTR(1:+ &EVAL(&SYSINDEX(&STR(:),&STR(&DSN)) -1),&STR(&DSN)) IF &SYSINDEX(&STR(;),&STR(&DSN)) > 1 THEN + SET DSN = &SUBSTR(1:+ &EVAL(&SYSINDEX(&STR(;),&STR(&DSN)) -1),&STR(&DSN)) IF &SYSINDEX(&STR(,),&STR(&DSN)) > 1 THEN + SET DSN = &SUBSTR(1:+ &EVAL(&SYSINDEX(&STR(,),&STR(&DSN)) -1),&STR(&DSN)) IF &SYSINDEX(&STR(+),&STR(&DSN)) > 1 THEN + DO SET A = &SYSINDEX(&STR(+),&STR(&DSN)) - 2 SET DSN = &SUBSTR(1:&A,&STR(&DSN)) SET XDSN = &STR(&STR(&DSN)&STR((0))) END IF &SYSINDEX(&STR(()),&STR(&DSN)) > 1 THEN + DO SET A = &SYSINDEX(&STR(()),&STR(&DSN)) - 1 SET DSN = &SUBSTR(1:&A,&STR(&DSN)) SET XDSN = &STR(&STR(&DSN)&STR((0))) END IF &SYSINDEX(&STR(-),&STR(&DSN)) > 1 THEN + DO SET A = &SYSINDEX(&STR(-),&STR(&DSN)) - 1 SET DSN = &SUBSTR(1:&A,&STR(&DSN)) SET XDSN = &STR(&STR(&DSN)&STR((0))) END SET ZEDSMSG = &STR(PROBLEM WITH DATASET) SET ZEDLMSG = &STR(&DSN PROBLEM : &SYSDSN('&DSN')) IF &LENGTH(&STR(&XDSN)) = 0 THEN SET XDSN = &STR(&DSN) IF &SYSDSN('&DSN') = OK THEN + DO SET DSN = &STR(&XDSN) ISPEXEC VPUT (DSN) PROFILE ISPEXEC SELECT CMD(%UTILPRNT &PARM) END ELSE ISPEXEC SETMSG MSG(UTLZ001) ISREDIT CURSOR = &LN &CL END EXIT HELPSEC: + CLEAR WRITE *** HELP FOR EDIT MACRO 'DSNPRINT' *** WRITE WRITE THE DSNPRINT EDIT MACRO ALLOWS THE USER TO TYPE DSNPRINT ON THE WRITE COMMAND LINE DURING AN EDIT SESSION AND PRINT THE DATASET THAT IS WRITE BEING EDITED. IT ALSO ALLOWS THE USER TO TYPE DSNPRINT ONT THE WRITE COMMAND LINE, THEN PLACE THE CURSOR AT THE BEGINNING OF A VALID WRITE MVS DATASET NAME, AND PRINT THAT DATASET INSTEAD. SINCE PF KEYS WRITE CAN BE SET TO ANY COMMAND THAT CAN BE TYPED, A PF KEY COULD BE WRITE SET TO 'DSNPRINT', AND ACCOMPLISH THE SAME PROCESS. WRITE WRITE BASIC SYNTAX : WRITE WRITE COMMAND ===> DSNPRINT WRITE 000108 //JS010 EXEC PGM=WAAPDSUT WRITE 000109 //SYSUT1 DD DSN=TCWCA.TWB.WORKFILE(BACHBOOK), WRITE 000110 // DISP=(SHR,KEEP,KEEP) WRITE 000111 //SYSUT2 DD DSN=TCWCA.TWBAT.COPY, WRITE 000112 // DISP=(NEW,CATLG,DELETE) WRITE 000113 // UNIT=SYSDA, WRITE 000114 // SPACE=(TRK,(1,1),RLSE), WRITE 000115 // DCB=(RECFM=FB,LRECL=80,BLKSIZE=23440) WRITE WRITE IN THE ABOVE EXAMPLE, IF THE CURSOR WERE ON THE COMMAND LINE, WRITE THE 'TOP OF DATA' LINE, OR A LINE NUMBER, ONCE THE USER PRESSED WRITE , THE PROCESSING WOULD DETERMINE THE NAME OF THE DATASET WRITE BEING EDITED, AND WOULD TAKE THE USER INTO THE NEXT STEP OF THE WRITE PRINT PROCESS. WRITE WRITE ALTERNATIVELY, THE CURSOR COULD ALSO BE PLACED ON THE 'T' WRITE IMMEDIATELY FOLLOWING EITHER 'DSN=' STRING (SYSUT2 WOULD BE AVAIL- WRITE ABLE PROVIDING THAT THE JCL HAD ALREADY BEEN RUN), AND THE WRITE KEY WOULD BE PRESSED. PROVIDED THAT THE USER HAD AUTHORITY TO WRITE READ THE DATASET, THE USER WOULD BE TAKEN INTO THE NEXT STEP OF WRITE THE PRINT PROCESS. WRITE WRITE THE NEXT STEP OF THE PRINT PROCESS IS A SCREEN WHICH ACCEPTS WRITE PRINT VARIABLES TO BE INSERTED INTO JCL (E.G. DESTINATION, NUMBER WRITE OF COPIES, ETC.). THE JCL CAN THEN BE SUBMITTED AUTOMATICALLY, OR WRITE CAN BE EDITED BY THE USER FIRST FOR FURTHER MODIFICATION. AFTER WRITE THE PROCESS IS FINISHED, THE USER IS RETURNED TO THE EDIT SESSION WRITE THAT HE/SHE WAS IN. WRITE WRITE IN THE CASE OF GDG DATASETS WITH RELATIVE GENERATION NUMBERS OR WRITE PGENS SPECIFIED IN THE DATASET NAME, THE MOST RECENT GENERATION WRITE WILL BE PRINTED BY DEFAULT, BUT THIS CAN BE OVERRIDDEN. WRITE WRITE *** END OF HELP *** NO PROCESSING PERFORMED *** EXIT ./ ADD NAME=DSNSTAMP ISREDIT MACRO (OPT1) ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT IF &OPT1 = HELP THEN GOTO HELPSEC /********************************************************************** /* EDIT MACRO : DSNSTAMP * /* AUTHOR : DAVE LEIGH * /* FUNCTION : REPLACE TEXT AT THE CURSOR LOCATION WITH THE NAME OF * /* THE DATASET BEING EDITED. * /********************************************************************** ISREDIT (DSN) = DATASET ISREDIT (MBR) = MEMBER ISREDIT (LN,CL) = CURSOR IF &STR(&MBR) > THEN + SET DSN = &STR(&DSN(&MBR)) DO &I = 1 TO &LENGTH(&STR(&DSN)) SET EQUALS = &STR(&EQUALS=) END ISREDIT CHANGE P'&EQUALS' '&DSN' .ZCSR .ZCSR IF &LASTCC > 0 THEN + DO SET ZEDLMSG = &STR(*** NOT ENOUGH ROOM TO STAMP "&DSN" ***) ISPEXEC SETMSG MSG(UTLZ001) EXIT END ISREDIT CURSOR = &LN &CL EXIT HELPSEC: + ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR DSNSTAMP UTILITY + *** NO PROCESSING PERFORMED ***) ISPEXEC SETMSG MSG(UTLZ000) EXIT ./ ADD NAME=DSNUSAGE ISREDIT MACRO (HELP) ISPEXEC CONTROL ERRORS CANCEL /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ISREDIT (DSN) = DATASET CONTROL MSG SET SYSOUTTRAP = 9999 PDS '&DSN' USAGE END SET MAXOUT = &SYSOUTLINE IF &MAXOUT = 0 THEN EXIT FREE DDNAME(PDSLOG) DELETE PDS.LOG FREE ATTRLIST(ATTRIB1) ATTRIB ATTRIB1 + RECFM(F B) + LRECL(80) + BLKSIZE(23440) + OUTPUT ALLOC DDNAME(PDSLOG) DSN(PDS.LOG) + NEW CATALOG + UNIT(SYSDA) + SPACE(5,2) CYLINDERS RELEASE + USING(ATTRIB1) OPENFILE PDSLOG OUTPUT SET N = 1 DO WHILE &N <= &MAXOUT SET PDSLOG = &STR(&SYSNSUB(2,&&SYSOUTLINE&N)) PUTFILE PDSLOG SET N = &N + 1 END CLOSFILE PDSLOG FREE DDNAME(PDSLOG) ISPEXEC EDIT DATASET(PDS.LOG) EXIT ./ ADD NAME=DSYSCOPY PROC 0 DEBUG /*** CHECK THE DEBUG SWITCH ***/ IF &DEBUG = DEBUG THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS /********************************************************************** /* FIND WHAT EVF JOBS EXIST CURRENTLY * /********************************************************************** SET LP = &STR(( SET RP = &STR()) SET SYSOUTTRAP = 1000 CONTROL MSG STATUS D@UDALSC CONTROL NOMSG SET SYSOUTTRAP = 0 IF &SYSINDEX(&STR( WAITING FOR EXECUTION),+ &STR(&SYSNSUB(2,&&SYSOUTLINE&SYSOUTLINE))) > 0 THEN EXIT CONTROL NOMSG SUBMIT 'D@UDAL.STR.JCLLIB(SYSCOPY)' EXIT ./ ADD NAME=DUMPADDR PROC 0 /*** CHECK THE DEBUG SWITCH ***/ ISPEXEC VGET DBGSWTCH PROFILE IF &DBGSWTCH = ON THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS DELETE TEMP.ADDRRPT FREE DDNAME(ISPFILE QUICK) ALLOCATE DDNAME(QUICK) DSN(TEMP.ADDRRPT) + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK005) + SPACE(10,10) TRACKS RELEASE + RECFM(V B) LRECL(255) BLKSIZE(23460) DSORG(PS) FREE DDNAME(QUICK) ALLOCATE DDNAME(ISPFILE) DSN(TEMP.ADDRRPT) + OLD ISPEXEC LIBDEF ISPSLIB DATASET ID(ADDRESS.ISPSLIB) ISPEXEC FTOPEN ISPEXEC FTINCL DUMPADDR SET SAVECC = &LASTCC ISPEXEC FTCLOSE FREE DDNAME(ISPFILE) ISPEXEC LIBDEF ISPSLIB ISPEXEC EDIT DATASET(TEMP.ADDRRPT) ./ ADD NAME=DUMPLOG PROC 0 DEBUG NOW /*** CHECK THE DEBUG SWITCH ***/ IF &DEBUG = DEBUG THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS /********************************************************************** /* DETERMINE TIME OF DAY * /********************************************************************** SET HOURS = &SUBSTR(1:2,&STR(&SYSTIME)) IF (&HOURS > 16 OR &HOURS < 7) AND &NOW ¬= NOW THEN EXIT /********************************************************************** /* DETERMINE DAY OF THE WEEK * /********************************************************************** FREE DD(SYSPRINT) ALLOC DD(SYSPRINT) DSN(*) CALL 'D@UDAL.STR.LOADLIB(DAYRC)' SET DAY_OF_WEEK = &LASTCC FREE DD(SYSPRINT) SELECT (&DAY_OF_WEEK) WHEN (6 | 7) EXIT OTHERWISE SET DEST = &STR(*.HELDQ) END /* WHEN (5 | 6 | 7) SET DEST = &STR(*.HELDQ,*.LOCLASER) /********************************************************************** /* FIND WHAT ULG JOBS EXIST CURRENTLY * /********************************************************************** SET LP = &STR(( SET RP = &STR()) SET SYSOUTTRAP = 1000 CONTROL MSG STATUS D@UDALUL CONTROL NOMSG SET SYSOUTTRAP = 0 IF &SYSINDEX(&STR( WAITING FOR EXECUTION),+ &STR(&SYSNSUB(2,&&SYSOUTLINE&SYSOUTLINE))) > 0 THEN EXIT SET SYSOUTTRAP = 1000 ACF LIST * END SET SYSOUTTRAP = 0 DO &I = 1 TO 40 SET SYSDVAL = &STR(&SYSNSUB(2,&&SYSOUTLINE&I)) READDVAL PARM1 PARM2 PARM3 PARM4 IF &SYSINDEX(&STR(TSOACCT),&STR(&PARM2)) = 1 THEN + DO SET I = 50 SET LP = &STR(( SET X = &SYSINDEX(&STR(&LP),&STR(&PARM2)) + 1 SET Y = &LENGTH(&STR(&PARM2)) SET Z = &LENGTH(&STR(&PARM3)) SET JOBACCT = &SUBSTR(&X:&Y,&STR(&PARM2))+ &STR(,)+ &SUBSTR(1:&Z-1,&STR(&PARM3)) END END SUBMIT * END (@@) //D@UDALUL JOB (&JOBACCT,Z00000,O),'UTILITY LOG DUMP',MSGCLASS=X, // CLASS=D,NOTIFY=D@UDAL //HELDQ OUTPUT DEST=LOCAL,CLASS=X,COPIES=1 //LOCLASER OUTPUT DEST=LOCAL,CLASS=Q,FCB=NRW,FORMS=NRW,LINECT=66, // COPIES=1 //STRIP EXEC PGM=SYNCSORT //SORTIN DD DSN=SYST.ISPF.DOCLIB(#UTILLOG), // DISP=(SHR,KEEP,KEEP) //SORTOUT DD DSN=D@UDAL.OUTPUT(+1), // DISP=(NEW,CATLG,DELETE), // UNIT=SYSDA, // SPACE=(TRK,(1,1),RLSE), // DCB=(T.GDG.MODEL,RECFM=FB,LRECL=80,BLKSIZE=23440) //SYSOUT DD SYSOUT=* //SYSIN DD * &STR( OMIT COND=(1,1,CH,EQ,C'*')) &STR( SORT FIELDS=COPY) &STR(/*) //RESET EXEC PGM=SYNCSORT //SORTIN DD DSN=SYST.ISPF.DOCLIB(#UTILLOG), // DISP=(SHR,KEEP,KEEP) //SORTOUT DD DSN=SYST.ISPF.DOCLIB(#UTILLOG), // DISP=(SHR,KEEP,KEEP) //SYSOUT DD SYSOUT=* //SYSIN DD * &STR( INCLUDE COND=(1,1,CH,EQ,C'*')) &STR( SORT FIELDS=COPY) &STR(/*) //MOD EXEC PGM=SYNCSORT,REGION=4096K //SORTIN DD DSN=T.D@UDAL.UTILITY.LOG(0), // DISP=(SHR,KEEP,KEEP) // DD DSN=D@UDAL.OUTPUT(+1), // DISP=(SHR,KEEP,KEEP) //SORTOUT DD DSN=T.D@UDAL.UTILITY.LOG(+1), // DISP=(NEW,CATLG,DELETE), // UNIT=CART,LABEL=(1,SL,EXPDT=99000), // DCB=(T.GDG.MODEL,RECFM=FB,LRECL=80,BLKSIZE=32720) //SYSOUT DD SYSOUT=* //SYSIN DD * &STR( SORT FIELDS=COPY) &STR(/*) //UTILITY1 EXEC PGM=SYNCSORT, // REGION=4096K, // PARM='CORE=MAX' //SORTIN DD DSN=T.D@UDAL.UTILITY.LOG(+1), // DISP=(SHR,KEEP,KEEP), // VOL=(,RETAIN) // DD DSN=SYST.ISPF.DOCLIB(#UTILLOG), // DISP=(SHR,KEEP,KEEP) //SORTWK01 DD UNIT=SYSDA,SPACE=(CYL,(4,2)) //SORTWK02 DD UNIT=SYSDA,SPACE=(CYL,(4,2)) //SORTWK03 DD UNIT=SYSDA,SPACE=(CYL,(4,2)) //SORTWK04 DD UNIT=SYSDA,SPACE=(CYL,(4,2)) //SORTOUT DD DISP=(NEW,PASS), // UNIT=SYSDA, // SPACE=(CYL,(1,1),RLSE), // DCB=(RECFM=FBA,LRECL=18,BLKSIZE=23472) //SYSOUT DD SYSOUT=* //SYSIN DD * &STR( OMIT COND=&LP.1,1,CH,EQ,C'*',OR, ) &STR( 28,14,CH,EQ,C'DAVID A. LEIGH'&RP) &STR( SORT FIELDS=(19,8,CH,A) ) &STR( OUTFIL FILES=OUT, ) &STR( OUTREC=(19,8,9X), ) &STR( NODETAIL, ) &STR( SECTIONS=&LP.19,8, ) &STR( TRAILER3=&LP.19,8,' ',COUNT&RP&RP ) &STR(/*) //UTILITY2 EXEC PGM=SYNCSORT, // REGION=4096K, // PARM='CORE=MAX' //SORTIN DD DSN=*.UTILITY1.SORTOUT, // DISP=(OLD,PASS) //SORTIN DD * //SORTWK01 DD UNIT=SYSDA,SPACE=(CYL,(4,2)) //SORTWK02 DD UNIT=SYSDA,SPACE=(CYL,(4,2)) //SORTWK03 DD UNIT=SYSDA,SPACE=(CYL,(4,2)) //SORTWK04 DD UNIT=SYSDA,SPACE=(CYL,(4,2)) //SORTOUT DD SYSOUT=(,),OUTPUT=(&DEST), // DCB=RECFM=FB //SYSOUT DD SYSOUT=* //SYSIN DD * &STR( SORT FIELDS=(11,8,CH,D) ) &STR( OUTREC FIELDS=(2,17) ) &STR(/*) //USER1 EXEC PGM=SYNCSORT, // REGION=4096K, // PARM='CORE=MAX' //SORTIN DD DSN=T.D@UDAL.UTILITY.LOG(+1), // DISP=(SHR,KEEP,KEEP), // VOL=REF=*.UTILITY1.SORTIN // DD DSN=SYST.ISPF.DOCLIB(#UTILLOG), // DISP=(SHR,KEEP,KEEP) //SORTWK01 DD UNIT=SYSDA,SPACE=(CYL,(4,2)) //SORTWK02 DD UNIT=SYSDA,SPACE=(CYL,(4,2)) //SORTWK03 DD UNIT=SYSDA,SPACE=(CYL,(4,2)) //SORTWK04 DD UNIT=SYSDA,SPACE=(CYL,(4,2)) //SORTOUT DD DISP=(NEW,PASS), // UNIT=SYSDA, // SPACE=(CYL,(1,1),RLSE), // DCB=(RECFM=FBA,LRECL=40,BLKSIZE=23440) //SYSOUT DD SYSOUT=* //SYSIN DD * &STR( OMIT COND=&LP.1,1,CH,EQ,C'*',OR, ) &STR( 28,14,CH,EQ,C'DAVID A. LEIGH'&RP) &STR( SORT FIELDS=(28,30,CH,A) ) &STR( OUTFIL FILES=OUT, ) &STR( OUTREC=(28,30,9X), ) &STR( NODETAIL, ) &STR( SECTIONS=&LP.28,30, ) &STR( TRAILER3=&LP.28,30,' ',COUNT&RP&RP ) &STR(/*) //USER2 EXEC PGM=SYNCSORT, // REGION=4096K, // PARM='CORE=MAX' //SORTIN DD DSN=*.USER1.SORTOUT, // DISP=(OLD,PASS) //SORTWK01 DD UNIT=SYSDA,SPACE=(CYL,(4,2)) //SORTWK02 DD UNIT=SYSDA,SPACE=(CYL,(4,2)) //SORTWK03 DD UNIT=SYSDA,SPACE=(CYL,(4,2)) //SORTWK04 DD UNIT=SYSDA,SPACE=(CYL,(4,2)) //SORTOUT DD SYSOUT=(,),OUTPUT=(&DEST), // DCB=RECFM=FB //SYSOUT DD SYSOUT=* //SYSIN DD * &STR( SORT FIELDS=(33,8,CH,D) ) &STR( OUTREC FIELDS=(2,39) ) &STR(/*) //COMPRESS EXEC PGM=IKJEFT01 //SYSTSPRT DD SYSOUT=* //SYSTSIN DD * &STR(PDS 'SYST.ISPF.DOCLIB' COMPR ) &STR(/*) //RELEASE EXEC DMS &STR(FIND DSNAMES=SYST.ISPF.DOCLIB) &STR( RELEASE) //ADDSPACE EXEC PGM=IKJEFT01 //SYSTSPRT DD SYSOUT=* //SYSTSIN DD * &STR(PDS 'SYST.ISPF.DOCLIB' FIX ADDCYL(5)) &STR(/*) @@ EXIT ./ ADD NAME=DUMPTABL PROC 1 TABLE TLIB() DEBUG ISPEXEC CONTROL ERRORS RETURN IF &DEBUG = DEBUG THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS IF &TABLE = HELP THEN GOTO HELPSEC /********************************************************************** /* CLIST : DUMPTABL * /* AUTHOR : DAVE LEIGH * /* DATE : 7-6-90 * /* FUNCTION : THIS CLIST DUMPS THE CONTENTS OF ISPF TABLES INTO 2 * /* FILES. THE FIRST IS A FLAT FILE. THE SECOND IS AN * /* EXECUTABLE CLIST WHICH, WHEN EXECUTED, WILL "SELF-LOAD" * /* THE TABLE. * /********************************************************************** IF &STR(&TLIB) > THEN + DO ISPEXEC LIBDEF ISPTLIB DATASET ID('&TLIB') UNCOND SET LIBCC = &LASTCC IF &LIBCC > 0 THEN + DO SET ZEDLMSG = &STR(*** RC = &LIBCC FOR + LIBDEF OF &TLIB ***) ISPEXEC SETMSG MSG(UTLZ001) EXIT END END SET RP = &STR()) SET PLUS = &STR(+) /*** ATTEMPT TO OPEN THE TABLE THE USER PASSED AS INPUT ***/ ISPEXEC TBOPEN &TABLE NOWRITE SET SAVECC = &LASTCC IF &SAVECC > 0 THEN + DO SET ZEDLMSG = &STR(*** RC = &SAVECC TRYING TO OPEN &TABLE ***) IF &SAVECC = 12 THEN GOTO KEEPON /* DO /* ISPEXEC TBSTATS &TABLE STATUS1(S1) STATUS2(S2) /* IF &S1 = 1 AND &S2 = 4 THEN SET CLOSE = NO /* ELSE + /* DO /* ISPEXEC SETMSG MSG(UTLZ001) /* EXIT /* END /* END ELSE + DO ISPEXEC SETMSG MSG(UTLZ001) EXIT END END /*** GET THE # AND NAME OF THE FIELDS IN THE TABLE AND # OF ROWS ***/ KEEPON: + ISPEXEC TBQUERY &TABLE KEYS(TKEYS) NAMES(TNAMES) KEYNUM(X) NAMENUM(Y) + ROWNUM(NUMROWS) IF &STR(&TKEYS) > THEN + DO SET A = &LENGTH(&STR(&TKEYS)) SET A = &A - 1 SET SYSDVAL = &SUBSTR(2:&A,&STR(&TKEYS)) END IF &STR(&TNAMES) > THEN + DO SET A = &LENGTH(&STR(&TNAMES)) SET A = &A - 1 IF &STR(&SYSDVAL) > THEN + SET SYSDVAL = &STR(&SYSDVAL &SUBSTR(2:&A,&STR(&TNAMES))) ELSE + SET SYSDVAL = &SUBSTR(2:&A,&STR(&TNAMES)) END READDVAL F1 F2 F3 F4 F5 F6 F7 F8 F9 F10 + F11 F12 F13 F14 F15 F16 F17 F18 F19 F20 + F21 F22 F23 F24 F25 F26 F27 F28 F29 F30 + F31 F32 F33 F34 F35 F36 F37 F38 F39 F40 + F41 F42 F43 F44 F45 F46 F47 F48 F49 F50 + F51 F52 F53 F54 F55 F56 F57 F58 F59 F60 + F61 F62 F63 F64 F65 F66 F67 F68 F69 F70 + F71 F72 F73 F74 F75 F76 F77 F78 F79 F80 + F81 F82 F83 F84 F85 F86 F87 F88 F89 F90 + F91 F92 F93 F94 F95 F96 F97 F98 F99 F100 SET NUMFLDS = &X + &Y CLEAR WRITE WRITE *** DETERMINING LRECL OF LONGEST TABLE ROW FOR "&TABLE" *** ISPEXEC TBTOP &TABLE ISPEXEC TBSKIP &TABLE DO WHILE &LASTCC = 0 SET X = 0 DO WHILE &X < &NUMFLDS ERROR DO RETURN END SET X = &X + 1 SET Y = &SYSNSUB(2,&&F&X) SET Y = &LENGTH(&SYSNSUB(3,&&&Y)) SET Z = &STR(&SYSNSUB(2,&&L&X)) IF &Y > &Z THEN SET L&X = &Y ERROR OFF END ISPEXEC TBSKIP &TABLE END /*** CALC THE LRECL FROM THE INDIVIDUAL FIELD LENGTHS ***/ SET X = 0 SET LRECL = 0 DO WHILE &X < &NUMFLDS SET X = &X + 1 SET Y = &STR(&SYSNSUB(2,&&L&X)) IF &Y = 0 THEN SET Y = 1 SET LRECL = &LRECL + &Y END /*** DETERMINE PRIMARY, SECONDARY SPACE NEEDED TO HOLD THE FLAT FILE ***/ ISPEXEC SELECT CMD(%BLKSIZE &LRECL &NUMROWS DEVICE(3380) BATCH) ISPEXEC VGET (BLKSIZE TRKSREQ) SHARED SET X = &EVAL(&TRKSREQ / 10) IF &X < 1 THEN SET X = 1 /*** ALLOCATE THE OUTPUT FLAT FILE ***/ DELETE '&SYSUID..TEMP.&TABLE..FLAT' FREE DDNAME(FLATFILE) ALLOC DD(FLATFILE) DSN('&SYSUID..TEMP.&TABLE..FLAT') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK$$$) + SPACE(&TRKSREQ,&X) TRACKS RELEASE + RECFM(F B) LRECL(&LRECL) BLKSIZE(&BLKSIZE) DSORG(PS) /*** DETERMINE PRIMARY, SECONDARY SPACE NEEDED TO HOLD THE LOAD FILE ***/ ISPEXEC SELECT CMD(%BLKSIZE 255 &EVAL(&NUMROWS * &NUMFLDS + 500) + DEVICE(3380) BATCH) ISPEXEC VGET (BLKSIZE TRKSREQ) SHARED SET X = &EVAL(&TRKSREQ / 10) IF &X < 1 THEN SET X = 1 /*** ALLOCATE THE OUTPUT LOAD FILE ***/ DELETE '&SYSUID..TEMP.&TABLE..LOAD' FREE DDNAME(LOADFILE) ALLOC DD(LOADFILE) DSN('&SYSUID..TEMP.&TABLE..LOAD') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK$$$) + SPACE(&TRKSREQ,&X) TRACKS RELEASE + RECFM(F B) LRECL(255) BLKSIZE(&BLKSIZE) DSORG(PS) /*** CREATE A "SUFFIX" SPACE VARIABLE = TO THE LRECL LENGTH ***/ SET SPACE = &STR( ) SET X = 0 DO WHILE &X < &LRECL SET X = &X + 1 SET SPACE = &STR( &SPACE) END WRITE WRITE *** LOADING BOTH THE "FLAT" FILE AND THE "LOAD" FILE *** /*** PUT BEGINNING CLIST LINES IN THE LOAD FILE *** OPENFILE LOADFILE OUTPUT SET LOADFILE = + &NRSTR(PROC 0 TABLE(&TABLE) ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(ISPEXEC VGET (DBGSWTCH) PROFILE ) PUTFILE LOADFILE SET LOADFILE = + &STR(IF &&DBGSWTCH = &STR(ON) THEN + ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( CONTROL MSG LIST CONLIST SYMLIST NOFLUSH ASIS ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(ELSE + ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(WRITE *********************************************) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(WRITE * THIS CLIST LOADS A TABLE THAT WAS UNLOADED ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(WRITE * ON &SYSDATE AT &SYSTIME BY THE NAME OF ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(WRITE * "&TABLE". DEFAULT EXECUTION OF THIS ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(WRITE * CLIST WILL APPEND "&TABLE" WITH THE ROWS ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(WRITE * WHICH WERE PREVIOUSLY UNLOADED. YOU MUST ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(WRITE * SPECIFY FULLY QUALIFIED DATASET NAME ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(WRITE * WHICH IS THE ISPF TABLE LIBRARY INTO WHICH ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(WRITE * "&TABLE" IS TO BE STORED. YOU MAY ALSO ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(WRITE * RELOAD "&TABLE" INTO A DIFFERENT TABLE ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(WRITE * NAME. YOU MAY ALSO SPECIFY WHETHER YOU ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(WRITE * WOULD LIKE TO "CREATE", "REPLACE", OR ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(WRITE * "APPEND" A GIVEN TABLE. SUCCESSFUL ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(WRITE * APPENDING ASSUMES "LIKE-NAMED" FIELDS. ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(WRITE *********************************************) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(WRITE ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(WRITENR ENTER TABLE LIBRARY NAME HERE ==> ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(READ TLIB ) PUTFILE LOADFILE SET LOADFILE = + &STR(IF &&TLIB = THEN + ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( DO ) PUTFILE LOADFILE SET LOADFILE = + &STR( SET ZEDLMSG = &STR(&&)STR(*** NO TABLE LIBRARY &PLUS PUTFILE LOADFILE SET LOADFILE = + &NRSTR( ENTERED *** NO PROCESSING PERFORMED ***&RP) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( ISPEXEC SETMSG MSG(UTLZ001) ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( EXIT ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( END ) PUTFILE LOADFILE SET LOADFILE = + &STR(SET TLIB = &&STR(&&SYSCAPS(&&TLIB)) ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(ISPEXEC LIBDEF ISPTABL ) PUTFILE LOADFILE SET LOADFILE = + &STR(ISPEXEC LIBDEF ISPTABL DATASET ID('&&TLIB') ) PUTFILE LOADFILE SET LOADFILE = + &STR(SET SAVECC = &&LASTCC ) PUTFILE LOADFILE SET LOADFILE = + &STR(IF &&SAVECC > 0 THEN + ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( DO ) PUTFILE LOADFILE SET LOADFILE = + &STR( SET ZEDLMSG = &STR(&&)STR(*** "ISPTABL LIBDEF" &PLUS PUTFILE LOADFILE SET LOADFILE = + &STR( OF "&&TLIB" FAILED WITH RC = &&SAVECC ***&RP) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( ISPEXEC SETMSG MSG(UTLZ001) ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( EXIT ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( END ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(WRITENR ENTER NEW TABLE NAME HERE, OR PRESS + ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( TO USE "&TABLE" ==> ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(READ XTABLE ) PUTFILE LOADFILE SET LOADFILE = + &STR(IF &&XTABLE > THEN SET TABLE = &&XTABLE ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(SET ACTION = APPEND ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(WRITENR ENTER (C)REATE, OR (R)EPLACE. JUST PRESS +) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( TO (A)PPEND ==> ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(READ XACTION ) PUTFILE LOADFILE SET LOADFILE = + &STR(IF &&XACTION > THEN SET ACTION = &&SYSCAPS(&&XACTION)) PUTFILE LOADFILE SET LOADFILE = + &STR(SET ACTION = &&SUBSTR(1:1,&&ACTION) ) PUTFILE LOADFILE SET LOADFILE = + &STR(IF &&ACTION ¬= A AND + ) PUTFILE LOADFILE SET LOADFILE = + &STR( &&ACTION ¬= C AND + ) PUTFILE LOADFILE SET LOADFILE = + &STR( &&ACTION ¬= R THEN + ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( DO ) PUTFILE LOADFILE SET LOADFILE = + &STR( SET ZEDLMSG = &STR(&&)STR(*** ACTION MUST BE &PLUS PUTFILE LOADFILE SET LOADFILE = + &NRSTR( (A)PPEND, (C)REATE, OR (R)EPLACE ***&RP) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( ISPEXEC SETMSG MSG(UTLZ001) ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( EXIT ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( END ) PUTFILE LOADFILE SET LOADFILE = + &STR(IF &&ACTION = R THEN + ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( DO ) PUTFILE LOADFILE SET LOADFILE = + &STR( ISPEXEC TBERASE &&TABLE ) PUTFILE LOADFILE SET LOADFILE = + &STR( SET SAVECC = &&LASTCC ) PUTFILE LOADFILE SET LOADFILE = + &STR( IF &&SAVECC = 8 THEN + ) PUTFILE LOADFILE SET LOADFILE = + &STR( WRITE *** "&&TABLE" DOES NOT EXIST IN + ) PUTFILE LOADFILE SET LOADFILE = + &STR( "&&TLIB" *** CONTINUING *** ) PUTFILE LOADFILE SET LOADFILE = + &STR( IF &&SAVECC = 12 THEN + ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( DO ) PUTFILE LOADFILE SET LOADFILE = + &STR( SET ZEDLMSG = &STR(&&)STR(*** "&&TABLE" &PLUS PUTFILE LOADFILE SET LOADFILE = + &NRSTR( IN USE, CANNOT REPLACE IT ***&RP) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( ISPEXEC SETMSG MSG(UTLZ001) ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( ISPEXEC LIBDEF ISPTABL ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( EXIT ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( END ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( END ) PUTFILE LOADFILE SET LOADFILE = + &STR(IF &&ACTION = R OR &&ACTION = C THEN ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( DO ) PUTFILE LOADFILE SET LOADFILE = + &STR( ISPEXEC TBCREATE &&TABLE + ) PUTFILE LOADFILE SET X = 0 SET PLS = &STR(+) SET NME = &STR(NAMES) SET NLP = &STR(( SET NRP = SET KYS = &STR(KEYS) SET KLP = &STR(( SET KRP = DO WHILE &X < &NUMFLDS SET X = &X + 1 SET Y = &SYSNSUB(2,&&F&X) IF &SYSINDEX(&Y,&STR(&TNAMES)) > 0 THEN + DO SET NAMESWITCH = ON IF &X = 1 THEN + DO SET LOADFILE = + &NRSTR( KEYS() &PLS) PUTFILE LOADFILE END END IF &NAMESWITCH = ON THEN + DO IF &X = &NUMFLDS THEN SET NRP = &STR()) SET LOADFILE = + &NRSTR( &NME&NLP&Y&NRP &PLS) SET NME = &STR( ) SET NLP = &STR( ) END ELSE + DO SET Q = &X + 1 SET Q = &SYSNSUB(2,&&F&Q) IF &SYSINDEX(&Q,&STR(&TKEYS)) = 0 THEN SET KRP = &STR()) SET LOADFILE = + &NRSTR( &KYS&KLP&Y&KRP &PLS) SET KYS = &STR( ) SET KLP = &STR( ) END PUTFILE LOADFILE END SET LOADFILE = + &NRSTR( LIBRARY(ISPTABL) &PLS ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( WRITE ) PUTFILE LOADFILE SET LOADFILE = + &STR( SET SAVECC = &&LASTCC ) PUTFILE LOADFILE SET LOADFILE = + &STR( IF &&SAVECC > 4 THEN &PLS ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( DO ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( ISPEXEC LIBDEF ISPTABL ) PUTFILE LOADFILE SET LOADFILE = + &STR( SET ZEDLMSG = &STR(&&)STR(*** COULD NOT &PLS) PUTFILE LOADFILE SET LOADFILE = + &STR( CREATE A NEW "&&TABLE". &PLS ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( "TBCREATE" FAILED W/RC = &PLS ) PUTFILE LOADFILE SET LOADFILE = + &STR( &&SAVECC ***&RP) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( ISPEXEC SETMSG MSG(UTLZ001) ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( EXIT ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( END ) PUTFILE LOADFILE SET LOADFILE = + &STR( ISPEXEC TBCLOSE &&TABLE ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( END ) PUTFILE LOADFILE SET LOADFILE = + &STR(ISPEXEC TBOPEN &&TABLE WRITE) PUTFILE LOADFILE OPENFILE FLATFILE OUTPUT SET FLATFILE = &STR(&SPACE) ISPEXEC TBTOP &TABLE ISPEXEC TBVCLEAR &TABLE SET WRITESWITCH = ON ISPEXEC TBSKIP &TABLE WRITE WRITE *** THIS IS THE LAYOUT FOR "&SYSUID..TEMP.&TABLE..FLATFILE" *** WRITE *** !!! SCREEN PRINT THIS !!! *** SET RWS = 0 DO WHILE &LASTCC = 0 SET RWS = &RWS + 1 SET X = 0 SET A = 0 DO WHILE &X < &NUMFLDS SET X = &X + 1 SET Y = &STR(&SYSNSUB(2,&&L&X)) IF &Y = 0 THEN + DO SET Y = 1 SET FFLD = &STR( ) SET LFLD = &STR( ) IF &WRITESWITCH = ON THEN + WRITE NOTE : FIELD "&SYSNSUB(2,&&F&X)" HAD NO + NON-NULL VALUES...SUBSTITUTING 1 SPACE END ELSE + DO ERROR DO SET ERRCC = &LASTCC WRITE *** ERR001 ERROR CC: &ERRCC PROCESSING RECORD #&RWS *** WRITE &STR(*** FIELD 1 NAME = "&F1") WRITE &STR(*** FIELD 1 VALUE = "&SYSNSUB(3,&&&F1)") WRITE &STR(*** FIELD IN ERROR = "&SYSNSUB(2,&&F&X)" ***)+ &STR( IT WILL BE SET TO "?") SET ERRF = &STR(&SYSNSUB(2,&&F&X)) SET &&ERRF = &STR(?) RETURN END SET LFLD = &STR(&&)&STR(&SYSNSUB(2,&&F&X)) SET LFLD = &STR(&LFLD) IF &STR(&LFLD) = THEN SET LFLD = &STR( ) SET FFLD = &STR(&&)&STR(&SYSNSUB(2,&&F&X))&STR(&SPACE) SET FFLD = &SUBSTR(1:&Y,&STR(&FFLD)) ERROR OFF END ERROR DO SET ERRCC = &LASTCC WRITE *** ERR002 ERROR CC: &ERRCC PROCESSING RECORD #&RWS *** WRITE &STR(*** FIELD 1 NAME = "&F1") WRITE &STR(*** FIELD 1 VALUE = "&SYSNSUB(3,&&&F1)") WRITE &STR(*** FIELD IN ERROR = "&SYSNSUB(2,&&F&X)" ***)+ &STR( IT WILL BE SET TO "?") SET ERRF = &STR(&SYSNSUB(2,&&F&X)) SET &&ERRF = &STR(?) RETURN END SET B = &Y + 1 SET LOADFILE = + &STR(SET &SYSNSUB(2,&&F&X) = + &STR(&&STR(&&SYSNSUB(0,&STR(&SYSNSUB(1,&LFLD))))) PUTFILE LOADFILE IF &A = 0 THEN + SET FLATFILE = &STR(&FFLD)+ &SUBSTR(&B:&LRECL,&STR(&FLATFILE)) ELSE + SET FLATFILE = &SUBSTR(1:&A,&STR(&FLATFILE))+ &STR(&FFLD)+ &SUBSTR(&B:&LRECL,&STR(&FLATFILE)) ERROR OFF IF &WRITESWITCH = ON THEN + WRITE FIELD : "&SYSNSUB(2,&&F&X)" IS AT POSITION + &EVAL(&A + 1) FOR A LENGTH OF &Y SET A = &A + &Y END SET WRITESWITCH = OFF SET LOADFILE = &STR(ISPEXEC TBADD &&TABLE) PUTFILE LOADFILE PUTFILE FLATFILE IF &EVAL(&RWS//10) = 0 THEN + DO SET LOADFILE = &STR(WRITE &RWS ROWS LOADED INTO &&TABLE) PUTFILE LOADFILE WRITE &STR(&RWS ROWS DUMPED FOR TABLE &TABLE) END ISPEXEC TBSKIP &TABLE END SET LOADFILE = &STR(ISPEXEC TBCLOSE &&TABLE) PUTFILE LOADFILE /* SET LOADFILE = &STR(ISPEXEC LIBDEF ISPTABL) /* PUTFILE LOADFILE FINAL: + CLOSFILE LOADFILE FREE DDNAME(LOADFILE) CLOSFILE FLATFILE FREE DDNAME(FLATFILE) FREE ATTRLIST(ATTRIB1) IF &CLOSE ¬= NO THEN ISPEXEC TBEND &TABLE IF &STR(&TLIB) > THEN ISPEXEC LIBDEF ISPTLIB ISPEXEC BROWSE DATASET('&SYSUID..TEMP.&TABLE..FLAT') EXIT HELPSEC: + 02480000 ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) 02490000 SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR XXXXXXXX UTILITY + 02490000 *** NO PROCESSING PERFORMED ***) 02490000 ISPEXEC SETMSG MSG(UTLZ000) 02490000 EXIT ./ ADD NAME=DUMPTABX /* REXX ***************************************************************/ /* UTILITY: DUMPTABL */ /* AUTHOR: DAVID LEIGH */ /* FUNCTION: THIS PROGRAM DUMPS THE CONTENTS OF AN ISPF TABLE INTO 2 */ /* FILES. THE FIRST IS A FLAT FILE. THE SECOND IS AN */ /* EXECUTABLE CLIST WHICH, WHEN EXECUTED, WILL "SELF-LOAD" */ /* THE TABLE. */ /**********************************************************************/ PARSE UPPER ARG TABLE TLIB DEBUG IF (TABLE = HELP) THEN SIGNAL HELPSEC IF (TLIB > '') THEN DO ADDRESS "ISPEXEC LIBDEF ISPTLIB DATASET ID('"TLIB"') UNCOND" LIBCC = RC IF (LIBCC > 0) THEN DO ZEDLMSG = '*** RC = 'LIBCC' FOR LIBDEF OF 'TLIB' ***' ADDRESS "ISPEXEC SETMSG MSG(UTLZ001)" EXIT END END SET RP = &STR()) SET PLUS = &STR(+) /*** ATTEMPT TO OPEN THE TABLE THE USER PASSED AS INPUT ***/ ADDRESS "ISPEXEC TBOPEN &TABLE NOWRITE " SET SAVECC = &LASTCC IF &SAVECC > 0 THEN + DO SET ZEDLMSG = &STR(*** RC = &SAVECC TRYING TO OPEN &TABLE ***) IF &SAVECC = 12 THEN GOTO KEEPON /* DO /* ISPEXEC TBSTATS &TABLE STATUS1(S1) STATUS2(S2) /* IF &S1 = 1 AND &S2 = 4 THEN SET CLOSE = NO /* ELSE + /* DO /* ISPEXEC SETMSG MSG(UTLZ001) /* EXIT /* END /* END ELSE + DO ADDRESS "ISPEXEC SETMSG MSG(UTLZ001) " EXIT END END /*** GET THE # AND NAME OF THE FIELDS IN THE TABLE AND # OF ROWS ***/ KEEPON: + ADDRESS "ISPEXEC TBQUERY &TABLE KEYS(TKEYS) NAMES(TNAMES) " "KEYNUM(X) NAMENUM(Y) ROWNUM(NUMROWS) " IF &STR(&TKEYS) > THEN + DO SET A = &LENGTH(&STR(&TKEYS)) SET A = &A - 1 SET SYSDVAL = &SUBSTR(2:&A,&STR(&TKEYS)) END IF &STR(&TNAMES) > THEN + DO SET A = &LENGTH(&STR(&TNAMES)) SET A = &A - 1 IF &STR(&SYSDVAL) > THEN + SET SYSDVAL = &STR(&SYSDVAL &SUBSTR(2:&A,&STR(&TNAMES))) ELSE + SET SYSDVAL = &SUBSTR(2:&A,&STR(&TNAMES)) END READDVAL F1 F2 F3 F4 F5 F6 F7 F8 F9 F10 + F11 F12 F13 F14 F15 F16 F17 F18 F19 F20 + F21 F22 F23 F24 F25 F26 F27 F28 F29 F30 + F31 F32 F33 F34 F35 F36 F37 F38 F39 F40 + F41 F42 F43 F44 F45 F46 F47 F48 F49 F50 + F51 F52 F53 F54 F55 F56 F57 F58 F59 F60 + F61 F62 F63 F64 F65 F66 F67 F68 F69 F70 + F71 F72 F73 F74 F75 F76 F77 F78 F79 F80 + F81 F82 F83 F84 F85 F86 F87 F88 F89 F90 + F91 F92 F93 F94 F95 F96 F97 F98 F99 F100 SET NUMFLDS = &X + &Y CLEAR WRITE WRITE *** DETERMINING LRECL OF LONGEST TABLE ROW FOR "&TABLE" *** ISPEXEC TBTOP &TABLE ISPEXEC TBSKIP &TABLE DO WHILE &LASTCC = 0 SET X = 0 DO WHILE &X < &NUMFLDS ERROR DO RETURN END SET X = &X + 1 SET Y = &SYSNSUB(2,&&F&X) SET Y = &LENGTH(&SYSNSUB(3,&&&Y)) SET Z = &STR(&SYSNSUB(2,&&L&X)) IF &Y > &Z THEN SET L&X = &Y ERROR OFF END ISPEXEC TBSKIP &TABLE END /*** CALC THE LRECL FROM THE INDIVIDUAL FIELD LENGTHS ***/ SET X = 0 SET LRECL = 0 DO WHILE &X < &NUMFLDS SET X = &X + 1 SET Y = &STR(&SYSNSUB(2,&&L&X)) IF &Y = 0 THEN SET Y = 1 SET LRECL = &LRECL + &Y END /*** DETERMINE PRIMARY, SECONDARY SPACE NEEDED TO HOLD THE FLAT FILE ***/ ADDRESS "ISPEXEC SELECT CMD(%BLKSIZE &LRECL &NUMROWS " "DEVICE(3380) BATCH) " ADDRESS "ISPEXEC VGET (BLKSIZE TRKSREQ) SHARED " SET X = &EVAL(&TRKSREQ / 10) IF &X < 1 THEN SET X = 1 /*** ALLOCATE THE OUTPUT FLAT FILE ***/ DELETE '&SYSUID..TEMP.&TABLE..FLAT' FREE DDNAME(FLATFILE) ALLOC DD(FLATFILE) DSN('&SYSUID..TEMP.&TABLE..FLAT') + NEW CATALOG + UNIT(DISK) VOLUME(WRK006) + SPACE(&TRKSREQ,&X) TRACKS RELEASE + RECFM(F B) LRECL(&LRECL) BLKSIZE(&BLKSIZE) DSORG(PS) /*** DETERMINE PRIMARY, SECONDARY SPACE NEEDED TO HOLD THE LOAD FILE ***/ ADDRESS "ISPEXEC SELECT " "CMD(%BLKSIZE 255 &EVAL(&NUMROWS * &NUMFLDS + 500) " "DEVICE(3380) BATCH) " ADDRESS "ISPEXEC VGET (BLKSIZE TRKSREQ) SHARED " SET X = &EVAL(&TRKSREQ / 10) IF &X < 1 THEN SET X = 1 /*** ALLOCATE THE OUTPUT LOAD FILE ***/ DELETE '&SYSUID..TEMP.&TABLE..LOAD' FREE DDNAME(LOADFILE) ALLOC DD(LOADFILE) DSN('&SYSUID..TEMP.&TABLE..LOAD') + NEW CATALOG + UNIT(DISK) VOLUME(WRK006) + SPACE(&TRKSREQ,&X) TRACKS RELEASE + RECFM(F B) LRECL(255) BLKSIZE(&BLKSIZE) DSORG(PS) /*** CREATE A "SUFFIX" SPACE VARIABLE = TO THE LRECL LENGTH ***/ SET SPACE = &STR( ) SET X = 0 DO WHILE &X < &LRECL SET X = &X + 1 SET SPACE = &STR( &SPACE) END WRITE WRITE *** LOADING BOTH THE "FLAT" FILE AND THE "LOAD" FILE *** /*** PUT BEGINNING CLIST LINES IN THE LOAD FILE *** OPENFILE LOADFILE OUTPUT SET LOADFILE = + &NRSTR(PROC 0 TABLE(&TABLE) ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(ISPEXEC VGET (DBGSWTCH) PROFILE ) PUTFILE LOADFILE SET LOADFILE = + &STR(IF &&DBGSWTCH = &STR(ON) THEN + ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( CONTROL MSG LIST CONLIST SYMLIST NOFLUSH ASIS ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(ELSE + ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(WRITE *********************************************) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(WRITE * THIS CLIST LOADS A TABLE THAT WAS UNLOADED ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(WRITE * ON &SYSDATE AT &SYSTIME BY THE NAME OF ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(WRITE * "&TABLE". DEFAULT EXECUTION OF THIS ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(WRITE * CLIST WILL APPEND "&TABLE" WITH THE ROWS ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(WRITE * WHICH WERE PREVIOUSLY UNLOADED. YOU MUST ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(WRITE * SPECIFY FULLY QUALIFIED DATASET NAME ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(WRITE * WHICH IS THE ISPF TABLE LIBRARY INTO WHICH ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(WRITE * "&TABLE" IS TO BE STORED. YOU MAY ALSO ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(WRITE * RELOAD "&TABLE" INTO A DIFFERENT TABLE ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(WRITE * NAME. YOU MAY ALSO SPECIFY WHETHER YOU ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(WRITE * WOULD LIKE TO "CREATE", "REPLACE", OR ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(WRITE * "APPEND" A GIVEN TABLE. SUCCESSFUL ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(WRITE * APPENDING ASSUMES "LIKE-NAMED" FIELDS. ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(WRITE *********************************************) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(WRITE ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(WRITENR ENTER TABLE LIBRARY NAME HERE ==> ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(READ TLIB ) PUTFILE LOADFILE SET LOADFILE = + &STR(IF &&TLIB = THEN + ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( DO ) PUTFILE LOADFILE SET LOADFILE = + &STR( SET ZEDLMSG = &STR(&&)STR(*** NO TABLE LIBRARY &PLUS PUTFILE LOADFILE SET LOADFILE = + &NRSTR( ENTERED *** NO PROCESSING PERFORMED ***&RP) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( ISPEXEC SETMSG MSG(UTLZ001) ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( EXIT ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( END ) PUTFILE LOADFILE SET LOADFILE = + &STR(SET TLIB = &&STR(&&SYSCAPS(&&TLIB)) ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(ISPEXEC LIBDEF ISPTABL ) PUTFILE LOADFILE SET LOADFILE = + &STR(ISPEXEC LIBDEF ISPTABL DATASET ID('&&TLIB') ) PUTFILE LOADFILE SET LOADFILE = + &STR(SET SAVECC = &&LASTCC ) PUTFILE LOADFILE SET LOADFILE = + &STR(IF &&SAVECC > 0 THEN + ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( DO ) PUTFILE LOADFILE SET LOADFILE = + &STR( SET ZEDLMSG = &STR(&&)STR(*** "ISPTABL LIBDEF" &PLUS PUTFILE LOADFILE SET LOADFILE = + &STR( OF "&&TLIB" FAILED WITH RC = &&SAVECC ***&RP) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( ISPEXEC SETMSG MSG(UTLZ001) ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( EXIT ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( END ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(WRITENR ENTER NEW TABLE NAME HERE, OR PRESS + ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( TO USE "&TABLE" ==> ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(READ XTABLE ) PUTFILE LOADFILE SET LOADFILE = + &STR(IF &&XTABLE > THEN SET TABLE = &&XTABLE ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(SET ACTION = APPEND ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(WRITENR ENTER (C)REATE, OR (R)EPLACE. JUST PRESS +) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( TO (A)PPEND ==> ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR(READ XACTION ) PUTFILE LOADFILE SET LOADFILE = + &STR(IF &&XACTION > THEN SET ACTION = &&SYSCAPS(&&XACTION)) PUTFILE LOADFILE SET LOADFILE = + &STR(SET ACTION = &&SUBSTR(1:1,&&ACTION) ) PUTFILE LOADFILE SET LOADFILE = + &STR(IF &&ACTION ¬= A AND + ) PUTFILE LOADFILE SET LOADFILE = + &STR( &&ACTION ¬= C AND + ) PUTFILE LOADFILE SET LOADFILE = + &STR( &&ACTION ¬= R THEN + ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( DO ) PUTFILE LOADFILE SET LOADFILE = + &STR( SET ZEDLMSG = &STR(&&)STR(*** ACTION MUST BE &PLUS PUTFILE LOADFILE SET LOADFILE = + &NRSTR( (A)PPEND, (C)REATE, OR (R)EPLACE ***&RP) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( ISPEXEC SETMSG MSG(UTLZ001) ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( EXIT ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( END ) PUTFILE LOADFILE SET LOADFILE = + &STR(IF &&ACTION = R THEN + ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( DO ) PUTFILE LOADFILE SET LOADFILE = + &STR( ISPEXEC TBERASE &&TABLE ) PUTFILE LOADFILE SET LOADFILE = + &STR( SET SAVECC = &&LASTCC ) PUTFILE LOADFILE SET LOADFILE = + &STR( IF &&SAVECC = 8 THEN + ) PUTFILE LOADFILE SET LOADFILE = + &STR( WRITE *** "&&TABLE" DOES NOT EXIST IN + ) PUTFILE LOADFILE SET LOADFILE = + &STR( "&&TLIB" *** CONTINUING *** ) PUTFILE LOADFILE SET LOADFILE = + &STR( IF &&SAVECC = 12 THEN + ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( DO ) PUTFILE LOADFILE SET LOADFILE = + &STR( SET ZEDLMSG = &STR(&&)STR(*** "&&TABLE" &PLUS PUTFILE LOADFILE SET LOADFILE = + &NRSTR( IN USE, CANNOT REPLACE IT ***&RP) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( ISPEXEC SETMSG MSG(UTLZ001) ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( ISPEXEC LIBDEF ISPTABL ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( EXIT ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( END ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( END ) PUTFILE LOADFILE SET LOADFILE = + &STR(IF &&ACTION = R OR &&ACTION = C THEN ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( DO ) PUTFILE LOADFILE SET LOADFILE = + &STR( ISPEXEC TBCREATE &&TABLE + ) PUTFILE LOADFILE SET X = 0 SET PLS = &STR(+) SET NME = &STR(NAMES) SET NLP = &STR(( SET NRP = SET KYS = &STR(KEYS) SET KLP = &STR(( SET KRP = DO WHILE &X < &NUMFLDS SET X = &X + 1 SET Y = &SYSNSUB(2,&&F&X) IF &SYSINDEX(&Y,&STR(&TNAMES)) > 0 THEN + DO SET NAMESWITCH = ON IF &X = 1 THEN + DO SET LOADFILE = + &NRSTR( KEYS() &PLS) PUTFILE LOADFILE END END IF &NAMESWITCH = ON THEN + DO IF &X = &NUMFLDS THEN SET NRP = &STR()) SET LOADFILE = + &NRSTR( &NME&NLP&Y&NRP &PLS) SET NME = &STR( ) SET NLP = &STR( ) END ELSE + DO SET Q = &X + 1 SET Q = &SYSNSUB(2,&&F&Q) IF &SYSINDEX(&Q,&STR(&TKEYS)) = 0 THEN SET KRP = &STR()) SET LOADFILE = + &NRSTR( &KYS&KLP&Y&KRP &PLS) SET KYS = &STR( ) SET KLP = &STR( ) END PUTFILE LOADFILE END SET LOADFILE = + &NRSTR( LIBRARY(ISPTABL) &PLS ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( WRITE ) PUTFILE LOADFILE SET LOADFILE = + &STR( SET SAVECC = &&LASTCC ) PUTFILE LOADFILE SET LOADFILE = + &STR( IF &&SAVECC > 4 THEN &PLS ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( DO ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( ISPEXEC LIBDEF ISPTABL ) PUTFILE LOADFILE SET LOADFILE = + &STR( SET ZEDLMSG = &STR(&&)STR(*** COULD NOT &PLS) PUTFILE LOADFILE SET LOADFILE = + &STR( CREATE A NEW "&&TABLE". &PLS ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( "TBCREATE" FAILED W/RC = &PLS ) PUTFILE LOADFILE SET LOADFILE = + &STR( &&SAVECC ***&RP) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( ISPEXEC SETMSG MSG(UTLZ001) ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( EXIT ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( END ) PUTFILE LOADFILE SET LOADFILE = + &STR( ISPEXEC TBCLOSE &&TABLE ) PUTFILE LOADFILE SET LOADFILE = + &NRSTR( END ) PUTFILE LOADFILE SET LOADFILE = + &STR(ISPEXEC TBOPEN &&TABLE WRITE) PUTFILE LOADFILE OPENFILE FLATFILE OUTPUT SET FLATFILE = &STR(&SPACE) ISPEXEC TBTOP &TABLE ISPEXEC TBVCLEAR &TABLE SET WRITESWITCH = ON ISPEXEC TBSKIP &TABLE WRITE WRITE *** THIS IS THE LAYOUT FOR "&SYSUID..TEMP.&TABLE..FLATFILE" *** WRITE *** !!! SCREEN PRINT THIS !!! *** SET RWS = 0 DO WHILE &LASTCC = 0 SET RWS = &RWS + 1 SET X = 0 SET A = 0 DO WHILE &X < &NUMFLDS SET X = &X + 1 SET Y = &STR(&SYSNSUB(2,&&L&X)) IF &Y = 0 THEN + DO SET Y = 1 SET FFLD = &STR( ) SET LFLD = &STR( ) IF &WRITESWITCH = ON THEN + WRITE NOTE : FIELD "&SYSNSUB(2,&&F&X)" HAD NO + NON-NULL VALUES...SUBSTITUTING 1 SPACE END ELSE + DO ERROR DO SET ERRCC = &LASTCC WRITE *** ERR001 ERROR CC: &ERRCC PROCESSING RECORD #&RWS *** WRITE &STR(*** FIELD 1 NAME = "&F1") WRITE &STR(*** FIELD 1 VALUE = "&SYSNSUB(3,&&&F1)") WRITE &STR(*** FIELD IN ERROR = "&SYSNSUB(2,&&F&X)" ***)+ &STR( IT WILL BE SET TO "?") SET ERRF = &STR(&SYSNSUB(2,&&F&X)) SET &&ERRF = &STR(?) RETURN END SET LFLD = &STR(&&)&STR(&SYSNSUB(2,&&F&X)) SET LFLD = &STR(&LFLD) IF &STR(&LFLD) = THEN SET LFLD = &STR( ) SET FFLD = &STR(&&)&STR(&SYSNSUB(2,&&F&X))&STR(&SPACE) SET FFLD = &SUBSTR(1:&Y,&STR(&FFLD)) ERROR OFF END ERROR DO SET ERRCC = &LASTCC WRITE *** ERR002 ERROR CC: &ERRCC PROCESSING RECORD #&RWS *** WRITE &STR(*** FIELD 1 NAME = "&F1") WRITE &STR(*** FIELD 1 VALUE = "&SYSNSUB(3,&&&F1)") WRITE &STR(*** FIELD IN ERROR = "&SYSNSUB(2,&&F&X)" ***)+ &STR( IT WILL BE SET TO "?") SET ERRF = &STR(&SYSNSUB(2,&&F&X)) SET &&ERRF = &STR(?) RETURN END SET B = &Y + 1 SET LOADFILE = + &STR(SET &SYSNSUB(2,&&F&X) = + &STR(&&STR(&&SYSNSUB(0,&STR(&SYSNSUB(1,&LFLD))))) PUTFILE LOADFILE IF &A = 0 THEN + SET FLATFILE = &STR(&FFLD)+ &SUBSTR(&B:&LRECL,&STR(&FLATFILE)) ELSE + SET FLATFILE = &SUBSTR(1:&A,&STR(&FLATFILE))+ &STR(&FFLD)+ &SUBSTR(&B:&LRECL,&STR(&FLATFILE)) ERROR OFF IF &WRITESWITCH = ON THEN + WRITE FIELD : "&SYSNSUB(2,&&F&X)" IS AT POSITION + &EVAL(&A + 1) FOR A LENGTH OF &Y SET A = &A + &Y END SET WRITESWITCH = OFF SET LOADFILE = &STR(ISPEXEC TBADD &&TABLE) PUTFILE LOADFILE PUTFILE FLATFILE IF &EVAL(&RWS//10) = 0 THEN + DO SET LOADFILE = &STR(WRITE &RWS ROWS LOADED INTO &&TABLE) PUTFILE LOADFILE WRITE &STR(&RWS ROWS DUMPED FOR TABLE &TABLE) END ISPEXEC TBSKIP &TABLE END SET LOADFILE = &STR(ISPEXEC TBCLOSE &&TABLE) PUTFILE LOADFILE /* SET LOADFILE = &STR(ISPEXEC LIBDEF ISPTABL) /* PUTFILE LOADFILE FINAL: + CLOSFILE LOADFILE FREE DDNAME(LOADFILE) CLOSFILE FLATFILE FREE DDNAME(FLATFILE) FREE ATTRLIST(ATTRIB1) IF &CLOSE ¬= NO THEN ISPEXEC TBEND &TABLE IF &STR(&TLIB) > THEN ISPEXEC LIBDEF ISPTLIB ADDRESS "ISPEXEC BROWSE DATASET('&SYSUID..TEMP.&TABLE..FLAT') " EXIT HELPSEC: + 02480000 ADDRESS "ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL)" SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR XXXXXXXX UTILITY + 02490000 *** NO PROCESSING PERFORMED ***) 02490000 ADDRESS "ISPEXEC SETMSG MSG(UTLZ000)" EXIT ./ ADD NAME=DWH1VIEW /* REXX ***************************************************************/ /* */ /**********************************************************************/ ADDRESS ISPEXEC 'CONTROL ERRORS RETURN' ADDRESS ISREDIT "MACRO (VIEWNAME)" IF VIEWNAME = '' THEN DO ZEDLMSG = 'SYNTAX: DWH1VIEW SLSV_MULTBORRACCT' ADDRESS ISPEXEC 'SETMSG MSG(UTLZ000W)' EXIT END "X ALL P'=' 1" "F ALL '"VIEWNAME"'" "F ALL '.' 1" "SEEK FIRST 'SRSLOAD'" "LABEL .ZCSR = .SRS" FIRSTLIN = '.ZFIRST' "FIND FIRST '"VIEWNAME"' NX" DO WHILE RC = 0 "FIND PREV '.' 1 NX" "FIND NEXT P'=' 1 NX" "SEEK PREV P'=' 1 X" "(LINNUM) = LINENUM .ZCSR" "(SRSLINE) = LINENUM .SRS" IF LINNUM > SRSLINE THEN DO "SEEK FIRST P'=' .SRS .SRS" "SEEK PREV P'=' 1 X" END "DELETE "FIRSTLIN" .ZCSR" "FIND NEXT 'CREATE VIEW ' NX" IF RC ¬= 0 THEN LEAVE "FIND NEXT '.SYNC' NX" "SEEK NEXT P'=' 1 X" "LABEL .ZCSR = .CURR" FIRSTLIN = '.CURR' "FIND NEXT '"VIEWNAME"' NX" END "FIND ALL P'=' 1 .ZFIRST .ZCSR" "DELETE ALL EXCLUDED" EXIT ./ ADD NAME=DXREF PROC 0 DSN() JOB() PGM() STG() INVOKE(NOPARM) EDIT BROWSE HELP + JCLLIB(PCWMK.CTC.JCLPAN) LIBTYPE(PAN) PREFIX(CWMKT) REPEAT /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT IF &HELP = &STR(HELP) THEN GOTO HELPSEC SET XREFDSN = &STR(&SYSPREF..XREF.OUTPUT) SET JOBSFLD = &STR(94,8,CH,A) SET STEPSFLD = &STR(1,8,CH,A) SET PGMSFLD = &STR(12,9,CH,A) SET DSNSFLD = &STR(32,40,CH,A) SET JOBSORD = 2 SET STEPSORD = 4 SET PGMSORD = 3 SET DSNSORD = 1 SET LINES = 60 ISPEXEC TBOPEN PROJECT NOWRITE ISPEXEC TBVCLEAR PROJECT SET PRJELEM = SKELETON SET PRJQUAL = LIBRARY ISPEXEC TBSCAN PROJECT ARGLIST(PRJELEM,PRJQUAL) CONDLIST(EQ,EQ) SET SKELLIB = &PRJPARM ISPEXEC TBEND PROJECT ISPEXEC VGET ZTEMPF SHARED ISPEXEC FTOPEN TEMP ISPEXEC FTINCL XREFPAN1 ISPEXEC FTCLOSE SET MODE = E IF &BROWSE = BROWSE THEN SET MODE = B IF &DSN > THEN + DO SET SFIELDS = &STR(&DSNSFLD)&STR(,)+ &STR(&JOBSFLD)&STR(,)+ &STR(&PGMSFLD)&STR(,)+ &STR(&STEPSFLD) SET INVOKE = PARM GOTO XREF END IF &JOB > THEN + DO SET PREFIX = &JOB SET SFIELDS = &STR(&JOBSFLD)&STR(,)+ &STR(&STEPSFLD)&STR(,)+ &STR(&PGMSFLD)&STR(,)+ &STR(&DSNSFLD) SET INVOKE = PARM GOTO XREF END IF &PGM > THEN + DO SET SFIELDS = &STR(&PGMSFLD)&STR(,)+ &STR(&JOBSFLD)&STR(,)+ &STR(&STEPSFLD)&STR(,)+ &STR(&DSNSFLD) SET INVOKE = PARM GOTO XREF END IF &NRSTR(&STG) > THEN + DO SET INVOKE = PARM GOTO SCAN END /*********************************************************************/ /* PROMPT THE USER IF NO PARAMETERS WERE ENTERED */ /*********************************************************************/ PROMPT: + ISPEXEC VPUT (XREFDSN DSN JOB PGM STG MODE JOBSORD STEPSORD PGMSORD + DSNSORD LINES) SHARED ISPEXEC DISPLAY PANEL(DXREF) IF &LASTCC > 4 THEN EXIT ISPEXEC VGET (XREFDSN DSN JOB PGM STG MODE JOBSORD STEPSORD PGMSORD + DSNSORD LINES) SHARED IF &STR(&JOBSORD) = 1 THEN SET SFIELDS = &STR(&JOBSFLD) IF &STR(&STEPSORD) = 1 THEN SET SFIELDS = &STR(&STEPSFLD) IF &STR(&PGMSORD) = 1 THEN SET SFIELDS = &STR(&PGMSFLD) IF &STR(&DSNSORD) = 1 THEN SET SFIELDS = &STR(&DSNSFLD) IF &STR(&JOBSORD) = 2 THEN SET SFIELDS = &STR(&SFIELDS,&JOBSFLD) IF &STR(&STEPSORD) = 2 THEN SET SFIELDS = &STR(&SFIELDS,&STEPSFLD) IF &STR(&PGMSORD) = 2 THEN SET SFIELDS = &STR(&SFIELDS,&PGMSFLD) IF &STR(&DSNSORD) = 2 THEN SET SFIELDS = &STR(&SFIELDS,&DSNSFLD) IF &STR(&JOBSORD) = 3 THEN SET SFIELDS = &STR(&SFIELDS,&JOBSFLD) IF &STR(&STEPSORD) = 3 THEN SET SFIELDS = &STR(&SFIELDS,&STEPSFLD) IF &STR(&PGMSORD) = 3 THEN SET SFIELDS = &STR(&SFIELDS,&PGMSFLD) IF &STR(&DSNSORD) = 3 THEN SET SFIELDS = &STR(&SFIELDS,&DSNSFLD) IF &STR(&JOBSORD) = 4 THEN SET SFIELDS = &STR(&SFIELDS,&JOBSFLD) IF &STR(&STEPSORD) = 4 THEN SET SFIELDS = &STR(&SFIELDS,&STEPSFLD) IF &STR(&PGMSORD) = 4 THEN SET SFIELDS = &STR(&SFIELDS,&PGMSFLD) IF &STR(&DSNSORD) = 4 THEN SET SFIELDS = &STR(&SFIELDS,&DSNSFLD) IF &NRSTR(&STG) > THEN + DO GOTO SCAN END /*********************************************************************/ /* CALL PAN#1, WAAPDSUT, SORT, & WAAPDSUT TO SHOW A DATASET'S USAGE */ /*********************************************************************/ XREF: + IF &INVOKE = NOPARM THEN ELSE + DO CLEAR WRITE *** CROSS REFERENCE SEARCH ARGUMENTS WERE : WRITE *** DATASET = &DSN WRITE *** PROGRAM = &PGM WRITE *** JOB = &JOB WRITE END SET ZEDLMSG = &STR(*** EXTRACTING JCL FROM &JCLLIB ***) IF &INVOKE = NOPARM THEN + DO ISPEXEC CONTROL DISPLAY LOCK ISPEXEC SETMSG MSG(UTLZ000) ISPEXEC DISPLAY PANEL(DXREF) END ELSE + DO WRITE WRITE &STR(&ZEDLMSG) END IF &STR(&PREFIX) > THEN + SET ZEDLMSG = &STR(*** MEMBERS PREFIXED WITH "&PREFIX" + ARE INCLUDED ***) ELSE + SET ZEDLMSG = &STR(*** ALL JOBS WILL BE INCLUDED ***) IF &INVOKE = NOPARM THEN ELSE + DO WRITE WRITE &STR(&ZEDLMSG) END FREE ATTRLIST(ATTRIB1) ATTRIB ATTRIB1 + BLKSIZE(23440) + LRECL(80) + RECFM(F B) + OUTPUT FREE ATTRLIST(ATTRIB2) ATTRIB ATTRIB2 + BLKSIZE(23408) + LRECL(133) + RECFM(F B) + OUTPUT FREE ATTRLIST(ATTRIB3) ATTRIB ATTRIB3 + BLKSIZE(23409) + LRECL(81) + RECFM(F B) + OUTPUT IF &STR(&LIBTYPE) = PAN THEN + DO DELETE PANDD2 FREE DDNAME(SYSIN) FREE DDNAME(SYSPRINT) FREE DDNAME(PANDD1) FREE DDNAME(PANDD2) ALLOCATE DDNAME(SYSIN) + DSNAME('&ZTEMPF') + SHR KEEP ALLOCATE DDNAME(PANDD1) + DSNAME('&JCLLIB') + SHR KEEP ALLOCATE DDNAME(PANDD2) + DSNAME(PANDD2) + NEW CATALOG + UNIT(SYSDA) + SPACE(5,2) CYLINDERS RELEASE + USING(ATTRIB1) ALLOCATE DDNAME(SYSPRINT) DUMMY CALL 'SYS2A.LINKLIB(PAN#1)' 'OPEN=INP' END IF &STR(&LIBTYPE) = PDS THEN + DO DELETE SYSPUNCH DELETE SYSIN FREE DDNAME(SYSIN) FREE DDNAME(SYSPRINT) FREE DDNAME(SYSUT1) FREE DDNAME(SYSPUNCH) FREE DDNAME(SYSOUT) ALLOCATE DDNAME(SYSIN) + DSNAME(SYSIN) + NEW CATALOG + UNIT(SYSDA) + SPACE(1,1) TRACKS RELEASE + USING(ATTRIB1) FREE DDNAME(SYSIN) ALLOCATE DDNAME(SYSIN) + DSNAME(SYSIN) + SHR KEEP OPENFILE SYSIN OUTPUT IF &STR(&PREFIX) > THEN + SET SYSIN = &SUBSTR(1:8,&STR(&PREFIX*******)) ELSE + SET SYSIN = &STR(*ALL) PUTFILE SYSIN CLOSFILE SYSIN ALLOCATE DDNAME(SYSUT1) + DSNAME('&JCLLIB') + SHR KEEP ALLOCATE DDNAME(SYSPUNCH) + DSNAME(SYSPUNCH) + NEW CATALOG + UNIT(SYSDA) + SPACE(5,2) CYLINDERS RELEASE + USING(ATTRIB3) ALLOCATE DDNAME(SYSPRINT) DUMMY CALL 'SYS2A.LINKLIB(WAAPPDSP)' FREE DDNAME(SYSIN) FREE DDNAME(SYSPRINT) FREE DDNAME(SYSUT1) FREE DDNAME(SYSUT2) FREE DDNAME(SYSPUNCH) FREE DDNAME(SYSOUT) DELETE PANDD2 ALLOCATE DDNAME(SYSIN) + DSNAME('&SKELLIB(XREFWAP4)') + SHR KEEP ALLOCATE DDNAME(SYSUT1) + DSNAME(SYSPUNCH) + SHR KEEP ALLOCATE DDNAME(SYSUT2) + DSNAME(PANDD2) + NEW CATALOG + UNIT(SYSDA) + SPACE(5,2) CYLINDERS RELEASE + USING(ATTRIB1) ALLOCATE DDNAME(SYSPRINT) DUMMY CALL 'SYS2A.LINKLIB(WAAPDSUT)' END SET ZEDLMSG = &STR(*** FORMATTING JCL EXTRACT DATA ***) IF &INVOKE = NOPARM THEN + DO ISPEXEC CONTROL DISPLAY LOCK ISPEXEC SETMSG MSG(UTLZ000) ISPEXEC DISPLAY PANEL(DXREF) END ELSE + DO WRITE WRITE &STR(&ZEDLMSG) END FREE DDNAME(SYSIN) FREE DDNAME(PANDD1) FREE DDNAME(PANDD2) FREE DDNAME(SYSPRINT) DELETE SYSIN DELETE SYSUT3 FREE DDNAME(SYSUT1) FREE DDNAME(SYSUT2) FREE DDNAME(SYSUT3) ALLOCATE DDNAME(SYSIN) + DSNAME('&SKELLIB(XREFWAP1)') + SHR KEEP ALLOCATE DDNAME(SYSUT1) + DSNAME(PANDD2) + OLD DELETE ALLOCATE DDNAME(SYSUT2) DUMMY ALLOCATE DDNAME(SYSUT3) + DSNAME(SYSUT3) + NEW CATALOG + UNIT(SYSDA) + SPACE(2,1) CYLINDERS RELEASE + USING(ATTRIB2) ALLOCATE DD(SYSPRINT) DUMMY CALL 'SYS2A.LINKLIB(WAAPDSUT)' SET ZEDLMSG = &STR(*** SORTING JCL EXTRACT DATA ***) IF &INVOKE = NOPARM THEN + DO ISPEXEC CONTROL DISPLAY LOCK ISPEXEC SETMSG MSG(UTLZ000) ISPEXEC DISPLAY PANEL(DXREF) END ELSE + DO WRITE WRITE &STR(&ZEDLMSG) END FREE DDNAME(SYSIN) FREE DDNAME(SYSUT1) FREE DDNAME(SYSUT2) FREE DDNAME(SYSUT3) FREE DDNAME(SYSPRINT) DELETE SYSIN DELETE SORTOUT FREE DDNAME(SORTIN) FREE DDNAME(SORTOUT) FREE DDNAME(SORTMSG) FREE DDNAME(SYSOUT) ALLOCATE DDNAME(SYSIN) + DSNAME(SYSIN) + NEW CATALOG + UNIT(SYSDA) + SPACE(1,1) TRACKS RELEASE + USING(ATTRIB1) SET LENDSN = &LENGTH(&DSN) SET LENJOB = &LENGTH(&JOB) SET LENPGM = &LENGTH(&PGM) SET COMMA = OPENFILE SYSIN OUTPUT SET SYSIN = &STR( SORT FIELDS=(&SFIELDS)) PUTFILE SYSIN SET RPAREN = &STR()) SET LPAREN = &STR(( IF &NRSTR(&DSN) > OR + &NRSTR(&PGM) > OR + &NRSTR(&JOB) > THEN + DO SET SYSIN = &STR( INCLUDE COND=&LPAREN) IF &LENDSN > 0 THEN + DO SET SYSIN = &STR(&SYSIN&COMMA.32,&LENDSN,CH,EQ,C'&DSN',) SET COMMA = &STR(AND,) END IF &LENJOB > 0 THEN + DO IF &COMMA > THEN + DO PUTFILE SYSIN SET SYSIN = &STR( ) END SET SYSIN = &STR(&SYSIN&COMMA.94,&LENJOB,CH,EQ,C'&JOB',) SET COMMA = &STR(AND,) END IF &LENPGM > 0 THEN + DO IF &COMMA > THEN + DO PUTFILE SYSIN SET SYSIN = &STR( ) END SET SYSIN = &STR(&SYSIN&COMMA.12,&LENPGM,CH,EQ,C'&PGM',) END SET LENSYS = &LENGTH(&STR(&SYSIN)) - 1 SET SYSIN = &SUBSTR(1:&LENSYS,&STR(&SYSIN)) SET SYSIN = &STR(&SYSIN&RPAREN) PUTFILE SYSIN END CLOSFILE SYSIN ALLOCATE DDNAME(SORTIN) + DSNAME(SYSUT3) + OLD DELETE ALLOCATE DDNAME(SORTOUT) + DSNAME(SORTOUT) + NEW CATALOG + UNIT(SYSDA) + SPACE(2,1) CYLINDERS RELEASE + USING(ATTRIB2) ALLOCATE DD(SORTMSG) DUMMY ALLOCATE DD(SYSOUT) DUMMY ALLOCATE DD(SYSPRINT) DUMMY CALL 'SYS2A.LINKLIB(SYNCSORT)' SET ZEDLMSG = &STR(*** CREATING DATASET USAGE REPORT ***) IF &INVOKE = NOPARM THEN + DO ISPEXEC CONTROL DISPLAY LOCK ISPEXEC SETMSG MSG(UTLZ000) ISPEXEC DISPLAY PANEL(DXREF) END ELSE + DO WRITE WRITE &STR(&ZEDLMSG) END FREE DDNAME(SYSIN) FREE DDNAME(SORTIN) FREE DDNAME(SORTOUT) FREE DDNAME(SORTMSG) FREE DDNAME(SYSOUT) FREE DDNAME(SYSPRINT) IF &DSN = THEN SET XDSN = &STR(ANY DATASET) ELSE SET XDSN = &NRSTR(&DSN) IF &JOB = THEN SET XJOB = &STR(ANY JOB) ELSE SET XJOB = &NRSTR(&JOB) IF &PGM = THEN SET XPGM = &STR(ANY PROGRAM) ELSE SET XPGM = &NRSTR(&PGM) SET SPACE40 = &STR( ) SET XDSN = &STR(DATASET=&XDSN&SPACE40) SET XDSN = &SUBSTR(1:43,&NRSTR(&XDSN)) SET XJOB = &STR(JOB=&XJOB&SPACE40) SET XJOB = &SUBSTR(1:43,&NRSTR(&XJOB)) SET XPGM = &STR(PROGRAM=&XPGM&SPACE40) SET XPGM = &SUBSTR(1:43,&NRSTR(&XPGM)) SET SFLD1 = &STR(* 1 = %%%%%%%%%%&SPACE40) SET SFLD2 = &STR(* 2 = %%%%%%%%%%&SPACE40) SET SFLD3 = &STR(* 3 = %%%%%%%%%%&SPACE40) SET SFLD4 = &STR(* 4 = %%%%%%%%%%&SPACE40) SET SORDER = IF &STR(&JOBSORD) = 1 THEN SET SORDER = &STR(JOB) IF &STR(&STEPSORD) = 1 THEN SET SORDER = &STR(STEP IF &STR(&PGMSORD) = 1 THEN SET SORDER = &STR(PROGRAM) IF &STR(&DSNSORD) = 1 THEN SET SORDER = &STR(DATASET) IF &STR(&JOBSORD) = 2 THEN SET SORDER = &STR(&SORDER JOB) IF &STR(&STEPSORD) = 2 THEN SET SORDER = &STR(&SORDER STEP) IF &STR(&PGMSORD) = 2 THEN SET SORDER = &STR(&SORDER PROGRAM) IF &STR(&DSNSORD) = 2 THEN SET SORDER = &STR(&SORDER DATASET) IF &STR(&JOBSORD) = 3 THEN SET SORDER = &STR(&SORDER JOB) IF &STR(&STEPSORD) = 3 THEN SET SORDER = &STR(&SORDER STEP) IF &STR(&PGMSORD) = 3 THEN SET SORDER = &STR(&SORDER PROGRAM) IF &STR(&DSNSORD) = 3 THEN SET SORDER = &STR(&SORDER DATASET) IF &STR(&JOBSORD) = 4 THEN SET SORDER = &STR(&SORDER JOB&SPACE40) IF &STR(&STEPSORD) = 4 THEN SET SORDER = &STR(&SORDER STEP&SPACE40) IF &STR(&PGMSORD) = 4 THEN SET SORDER = &STR(&SORDER PROGRAM&SPACE40) IF &STR(&DSNSORD) = 4 THEN SET SORDER = &STR(&SORDER DATASET&SPACE40) SET SORDER = &STR(SORT ORDER = &SORDER&SPACE40) SET SORDER = &SUBSTR(1:43,&STR(&SORDER)) IF &STR(&DSN) = THEN + DO SET LLDSN = &STR(0+++ ANY +++&SPACE40) SET LLDSN = &SUBSTR(1:40,&STR(&LLDSN)) END ELSE + DO SET LLDSN = &STR(0&DSN.________________________________________) SET LLDSN = &SUBSTR(1:40,&STR(&LLDSN)) END IF &STR(&PGM) = THEN + SET LLPGM = &STR(++ ANY ++) ELSE + DO SET LLPGM = &STR(&PGM.__________) SET LLPGM = &SUBSTR(1:9,&STR(&LLPGM)) END IF &STR(&JOB) = THEN + SET LLJOB = &STR(+ ANY + ) ELSE + DO SET LLJOB = &STR(&JOB.__________) SET LLJOB = &SUBSTR(1:8,&STR(&LLJOB)) END SET SUBSTAMP = &STR(SUBMITTED ON : &SYSDATE AT : &SYSTIME&SPACE40) SET SUBSTAMP = &SUBSTR(1:43,&NRSTR(&SUBSTAMP)) IF &LINES = 45 THEN SET L = 42 IF &LINES = 60 THEN SET L = 57 IF &LINES = 80 THEN SET L = 77 DELETE SYSIN FREE DDNAME(ISPFILE) FREE DDNAME(QUICK) FREE ATTRLIST(ATTRIB1) ATTRIB ATTRIB1 + RECFM(F B) + LRECL(80) + DSORG(PS) + BLKSIZE(23440) + OUTPUT ALLOCATE DDNAME(QUICK) + DSN(SYSIN) + NEW CATALOG + UNIT(SYSDA) + SPACE(10,10) TRACKS RELEASE + USING(ATTRIB1) FREE DDNAME(QUICK) ALLOCATE DDNAME(ISPFILE) + DSN(SYSIN) + OLD ISPEXEC FTOPEN ISPEXEC FTINCL DXREF ISPEXEC FTCLOSE FREE DDNAME(ISPFILE) FREE DDNAME(SYSUT1) FREE DDNAME(SYSIN) FREE DDNAME(SYSUT2) ALLOCATE DDNAME(SYSIN) + DSNAME(SYSIN) + SHR KEEP ALLOCATE DDNAME(SYSUT1) + DSNAME(SORTOUT) + SHR KEEP FREE ATTRLIST(ATTRIB3) ATTRIB ATTRIB3 + BLKSIZE(23408) + LRECL(133) + RECFM(F B A) + OUTPUT DELETE '&XREFDSN' ALLOCATE DDNAME(SYSUT2) + DSNAME('&XREFDSN') + NEW CATALOG + UNIT(SYSDA) + SPACE(1,1) CYLINDERS RELEASE + USING(ATTRIB3) ALLOCATE DDNAME(SYSPRINT) DUMMY CALL 'SYS2A.LINKLIB(WAAPDSUT)' FREE DDNAME(ATTRIB1) FREE DDNAME(ATTRIB2) FREE DDNAME(ATTRIB3) FREE DDNAME(SYSIN) FREE DDNAME(SYSUT1) FREE DDNAME(SYSUT2) FREE DDNAME(SYSPRINT) GOTO RESULTS /*********************************************************************/ /* CALL PAN#1, & WAAPDSUT TO SHOW LINES IN JCL WITH A GIVEN STRING. */ /*********************************************************************/ SCAN: + IF &INVOKE = NOPARM THEN ELSE + DO CLEAR WRITE &STR(*** SEARCHING FOR STRING : &NRSTR(&STG) ***) END SET ZEDLMSG = &STR(*** EXTRACTING JCL FROM &JCLLIB ***) IF &INVOKE = NOPARM THEN + DO ISPEXEC CONTROL DISPLAY LOCK ISPEXEC SETMSG MSG(UTLZ000) ISPEXEC DISPLAY PANEL(DXREF) END ELSE + DO WRITE WRITE &STR(&ZEDLMSG) END IF &STR(&PREFIX) > THEN + SET ZEDLMSG = &STR(*** MEMBERS PREFIXED WITH "&PREFIX" + ARE INCLUDED ***) ELSE + SET ZEDLMSG = &STR(*** ALL JOBS WILL BE INCLUDED ***) IF &INVOKE = NOPARM THEN ELSE + DO WRITE WRITE &STR(&ZEDLMSG) END FREE ATTRLIST(ATTRIB1) ATTRIB ATTRIB1 + BLKSIZE(23440) + LRECL(80) + RECFM(F B) + OUTPUT FREE ATTRLIST(ATTRIB2) ATTRIB ATTRIB2 + BLKSIZE(23408) + LRECL(133) + RECFM(F B) + OUTPUT FREE ATTRLIST(ATTRIB3) ATTRIB ATTRIB3 + BLKSIZE(23409) + LRECL(81) + RECFM(F B) + OUTPUT SET LENSTG = &LENGTH(&NRSTR(&STG)) IF &STR(&LIBTYPE) = PAN THEN + DO DELETE PANDD2 FREE DDNAME(SYSIN) FREE DDNAME(SYSPRINT) FREE DDNAME(PANDD1) FREE DDNAME(PANDD2) ALLOCATE DDNAME(SYSIN) + DSNAME('&ZTEMPF') + SHR KEEP ALLOCATE DDNAME(PANDD1) + DSNAME('&JCLLIB') + SHR KEEP ALLOCATE DDNAME(PANDD2) + DSNAME(PANDD2) + NEW CATALOG + UNIT(SYSDA) + SPACE(5,2) CYLINDERS RELEASE + USING(ATTRIB1) ALLOCATE DDNAME(SYSPRINT) DUMMY CALL 'SYS2A.LINKLIB(PAN#1)' 'OPEN=INP' END IF &STR(&LIBTYPE) = PDS THEN + DO DELETE SYSPUNCH DELETE SYSIN FREE DDNAME(SYSIN) FREE DDNAME(SYSPRINT) FREE DDNAME(SYSUT1) FREE DDNAME(SYSPUNCH) FREE DDNAME(SYSOUT) ALLOCATE DDNAME(SYSIN) + DSNAME(SYSIN) + NEW CATALOG + UNIT(SYSDA) + SPACE(1,1) TRACKS RELEASE + USING(ATTRIB1) FREE DDNAME(SYSIN) ALLOCATE DDNAME(SYSIN) + DSNAME(SYSIN) + SHR KEEP OPENFILE SYSIN OUTPUT IF &STR(&PREFIX) > THEN + SET SYSIN = &SUBSTR(1:8,&STR(&PREFIX*******)) ELSE + SET SYSIN = &STR(*ALL) PUTFILE SYSIN CLOSFILE SYSIN ALLOCATE DDNAME(SYSUT1) + DSNAME('&JCLLIB') + SHR KEEP ALLOCATE DDNAME(SYSPUNCH) + DSNAME(SYSPUNCH) + NEW CATALOG + UNIT(SYSDA) + SPACE(5,2) CYLINDERS RELEASE + USING(ATTRIB3) ALLOCATE DDNAME(SYSPRINT) DUMMY CALL 'SYS2A.LINKLIB(WAAPPDSP)' FREE DDNAME(SYSIN) FREE DDNAME(SYSPRINT) FREE DDNAME(SYSUT1) FREE DDNAME(SYSUT2) FREE DDNAME(SYSPUNCH) FREE DDNAME(SYSOUT) DELETE PANDD2 ALLOCATE DDNAME(SYSIN) + DSNAME('&SKELLIB(XREFWAP5)') + SHR KEEP ALLOCATE DDNAME(SYSUT1) + DSNAME(SYSPUNCH) + SHR KEEP ALLOCATE DDNAME(SYSUT2) + DSNAME(PANDD2) + NEW CATALOG + UNIT(SYSDA) + SPACE(5,2) CYLINDERS RELEASE + USING(ATTRIB1) ALLOCATE DDNAME(SYSPRINT) DUMMY CALL 'SYS2A.LINKLIB(WAAPDSUT)' END SET ZEDLMSG = &STR(*** EXTRACTING MATCHING LINES FROM THE JCL ***) IF &INVOKE = NOPARM THEN + DO ISPEXEC CONTROL DISPLAY LOCK ISPEXEC SETMSG MSG(UTLZ000) ISPEXEC DISPLAY PANEL(DXREF) END ELSE + DO WRITE WRITE &STR(&ZEDLMSG) END DELETE SYSIN FREE DDNAME(PANDD1) FREE DDNAME(PANDD2) FREE DDNAME(SYSIN) FREE DDNAME(SYSUT1) FREE DDNAME(SYSUT2) FREE DDNAME(SYSPRINT) ALLOCATE DDNAME(SYSIN) + DSNAME(SYSIN) + NEW CATALOG + UNIT(SYSDA) + SPACE(1,1) TRACKS RELEASE + USING(ATTRIB1) OPENFILE SYSIN OUTPUT SET SYSIN = &STR(10 NULL) PUTFILE SYSIN SET SYSIN = &STR( LA RV,10(RX)) PUTFILE SYSIN SET SYSIN = &STR( ZAP TALLY1,=P'0') PUTFILE SYSIN SET SYSIN = &STR(11 NULL) PUTFILE SYSIN SET SYSIN = &STR( CLC 0(2,RX),=C'//') PUTFILE SYSIN SET SYSIN = &STR( BNE 20) PUTFILE SYSIN SET SYSIN = &STR( CLC 2(1,RX),=C'*') PUTFILE SYSIN SET SYSIN = &STR( BE 20) PUTFILE SYSIN SET SYSIN = &STR( CLC 0(5,RV),=C' JOB ') PUTFILE SYSIN SET SYSIN = &STR( BE 12) PUTFILE SYSIN SET SYSIN = &STR( LA RV,1(,RV)) PUTFILE SYSIN SET SYSIN = &STR( AP TALLY1,=P'1') PUTFILE SYSIN SET SYSIN = &STR( CP TALLY1,=P'5') PUTFILE SYSIN SET SYSIN = &STR( BNL 20) PUTFILE SYSIN SET SYSIN = &STR( B 11) PUTFILE SYSIN SET SYSIN = &STR(12 NULL) PUTFILE SYSIN SET SYSIN = &STR( MVC 0(8,RZ),2(RX)) PUTFILE SYSIN SET SYSIN = &STR( MVC 8(3,RZ),=C' - ') PUTFILE SYSIN SET SYSIN = &STR(20 NULL) PUTFILE SYSIN SET SYSIN = &STR( LA RV,0(RX)) PUTFILE SYSIN SET SYSIN = &STR( ZAP TALLY1,=P'0') PUTFILE SYSIN SET SYSIN = &STR(21 NULL) PUTFILE SYSIN SET SYSIN = &STR( CLC 0(&LENSTG,RV),=C'&NRSTR(&STG)') PUTFILE SYSIN SET SYSIN = &STR( BE 22) PUTFILE SYSIN SET SYSIN = &STR( LA RV,1(,RV)) PUTFILE SYSIN SET SYSIN = &STR( AP TALLY1,=P'1') PUTFILE SYSIN SET SYSIN = &STR( CP TALLY1,=P'75') PUTFILE SYSIN SET SYSIN = &STR( BNL DELETE(RX)) PUTFILE SYSIN SET SYSIN = &STR( B 21) PUTFILE SYSIN SET SYSIN = &STR(22 NULL) PUTFILE SYSIN SET SYSIN = &STR( MVC 11(1,RZ),=C' ') PUTFILE SYSIN SET SYSIN = &STR( MVC 12(200,RZ),11(RZ)) PUTFILE SYSIN SET SYSIN = &STR( MVC 11(80,RZ),0(RX)) PUTFILE SYSIN SET SYSIN = &STR( BAL SYSUT2(RZ)) PUTFILE SYSIN SET SYSIN = &STR( B DELETE(RX)) PUTFILE SYSIN SET SYSIN = &STR( END) PUTFILE SYSIN CLOSFILE SYSIN ALLOCATE DDNAME(SYSUT1) + DSNAME(PANDD2) + SHR KEEP DELETE '&XREFDSN' ALLOCATE DDNAME(SYSUT2) + DSNAME('&XREFDSN') + NEW CATALOG + UNIT(SYSDA) + SPACE(1,1) CYLINDERS RELEASE + USING(ATTRIB2) OPENFILE SYSUT2 OUTPUT SET SYSUT2 = &STR(JOB NAME JCL LINE) PUTFILE SYSUT2 SET SYSUT2 = &STR(======== ========) PUTFILE SYSUT2 CLOSFILE SYSUT2 FREE DDNAME(SYSUT2) ALLOCATE DDNAME(SYSUT2) + DSNAME('&XREFDSN') + MOD KEEP ALLOCATE DDNAME(SYSPRINT) DUMMY CALL 'SYS2A.LINKLIB(WAAPDSUT)' FREE DDNAME(ATTRIB1) FREE DDNAME(ATTRIB2) FREE DDNAME(SYSIN) FREE DDNAME(SYSUT1) FREE DDNAME(SYSUT2) FREE DDNAME(SYSPRINT) RESULTS: + IF &MODE = E THEN + %WAACEDIT '&XREFDSN' IF &MODE = B THEN + %WAACBROW '&XREFDSN' IF &MODE = P THEN + %CASPRINT DSN(&XREFDSN) IF &REPEAT = REPEAT THEN GOTO PROMPT EXIT HELPSEC: + CLEAR WRITE *** HELP FOR CLIST : DXREF *** WRITE WRITE THIS CLIST ALLOWS YOU TO SEE ONLINE THE OUTPUT OF THE CAS JCL WRITE DATASET CROSS REFERENCE REPORT AND TO SEARCH FOR A STRING IN THE WRITE CAS PRODUCTION JCL. THE OUTPUT CAN BE DISPLAYED ON THE SCREEN, WRITE OR THE OUTPUT CAN BE DIRECTED TO A DATASET. IF THE DATASET OPTION WRITE IS CHOSEN, THEN THE USER WILL BE TAKEN INTO AN ISPF EDIT SESSION WRITE OF THE OUTPUT DASASET. WRITE WRITE BASIC SYNTAX AND EXAMPLES : WRITE WRITE COMMAND ===> TSO DXREF WRITE WRITE IF YOU TYPE THIS IN, YOU WILL BE PROMPTED FOR ALL OTHER ENTRIES. WRITE IF YOU WANT TO PASS ALL THE DESIRED PARAMETERS AT EXECUTION TIME WRITE YOU MAY DO SO. WRITE WRITE IF YOU WANT TO SEE WHERE A GIVEN DATASET NAME IS USED : WRITE WRITE COMMAND ===> TSO DXREF DSN(PCWCA.PWBAT.CR22.WEEKLY) WRITE WRITE THIS WILL DISPLAY A REPORT OF WHERE 'PCWCA.PWBAT.CR22.WEEKLY' IS WRITE USED IN CAS PRODUCTION JCL. WRITE WRITE IF YOU WANT TO SEE WHERE A GIVEN PROGRAM NAME IS USED : WRITE WRITE COMMAND ===> TSO DXREF PGM(PWBPGRX1) WRITE WRITE THIS WILL DISPLAY A REPORT OF WHERE 'PWBPGRX1' IS USED IN CAS WRITE PRODUCTION JCL. WRITE WRITE IF YOU WANT TO SEE THE DATASET USAGE IN A GIVEN JOB : WRITE WRITE COMMAND ===> TSO DXREF JOB(CWCAWBD0) WRITE WRITE THIS WILL DISPLAY A REPORT OF DATASET USAGE IN THE CAS PRODUCTION WRITE JOB 'CWCAWBD0'. WRITE WRITE IF YOU WANT TO SEE THE ACTUAL JCL LINES WHICH CONTAIN A GIVEN WRITE STRING : WRITE WRITE COMMAND ===> TSO DXREF STG(//SYSCTL) WRITE WRITE THIS WILL DISPLAY ALL THE LINES IN CAS PRODUCTION JCL WHICH WRITE CONTAIN THE STRING '//SYSCTL' PREFIXED BY THE MEMBER NAME WHICH WRITE CONTAINS THEM. CAS DATASET MEMBER NAMES ARE SYNONOMOUS WITH THE WRITE JOB NAME. WRITE WRITE IF YOU WANT TO PUT THE OUTPUT OF ANY OF THE PREVIOUS COMMANDS WRITE TO A DATASET : WRITE WRITE COMMAND ===> TSO DXREF DSN(PCWCA.PWBAT.CR22.WEEKLY) EDIT WRITE COMMAND ===> TSO DXREF PGM(PWBPGRX1) EDIT WRITE COMMAND ===> TSO DXREF STG(//SYSCTL) EDIT WRITE COMMAND ===> TSO DXREF JOB(CWCAWBD0) EDIT WRITE WRITE IN EACH OF THESE SITUATIONS, THE OUTPUT WILL BE SENT TO AN OUTPUT WRITE DATASET (OVERLAYED AT EACH EXECUTION) AN THE USER WILL BE TAKEN IN WRITE TO AN ISPF EDIT OF THAT DATASET. WRITE WRITE IF YOU FIND YOUR SELF EXECUTING THIS CLIST OFTEN, YOU MAY WANT TO WRITE SET A PF KEY TO 'TSO DXREF'. THEN YOU WOULD ONLY HAVE TO TYPE IN WRITE THE DESIRED PARAMETERS. WRITE WRITE *** END OF HELP *** NO PROCESSING PERFORMED *** EXIT ./ ADD NAME=DYLCALC PROC 1 EQUATION PRECISION(4) DYLEDIT(B) /*** CHECK THE DEBUG SWITCH ***/ ISPEXEC VGET DBGSWTCH PROFILE IF &DBGSWTCH = ON THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS FREE DD(SYSOUT SYSPRINT SYS280R SYS004 AUDWORK AUDEPF AUDCBF + NOTHING SYSIN) ALLOC DD(SYSOUT) DUMMY ALLOC DD(SYSPRINT) DUMMY ALLOC DD(SYS280R) NEW UNIT(SYSDA) SPACE(1) TRACKS + RECFM(F B A) LRECL(133) DSORG(PS) BLKSIZE(23408) ALLOC DD(SYS004) UNIT(SYSDA) SPACE(5) TRACKS ALLOC DD(AUDWORK) UNIT(SYSDA) SPACE(10,5) TRACKS ALLOC DD(AUDEPF) UNIT(SYSDA) SPACE(10,5) TRACKS RECFM(F B) LRECL(80) ALLOC DD(AUDCBF) UNIT(SYSDA) SPACE(10,5) TRACKS BLKSIZE(1000) ALLOC DD(NOTHING) NEW UNIT(SYSDA) SPACE(1) TRACKS + RECFM(F B) LRECL(80) DSORG(PS) BLKSIZE(23440) OPENFILE NOTHING OUT SET NOTHING = NOTHING PUTFILE NOTHING CLOSFILE NOTHING ALLOC DD(SYSIN) NEW UNIT(SYSDA) SPACE(1) TRACKS + RECFM(F B) LRECL(80) DSORG(PS) BLKSIZE(23440) OPENFILE SYSIN OUT SET SYSIN = &STR(FILE NOTHING) PUTFILE SYSIN SET SYSIN = &STR(WORKAREA) PUTFILE SYSIN SET SYSIN = &STR( XRESULT 16 PD &PRECISION &DYLEDIT ROUNDED VALUE 0.) PUTFILE SYSIN SET SYSIN = &STR(READ NOTHING) PUTFILE SYSIN SET SYSIN = &STR(STOP) PUTFILE SYSIN SET SYSIN = &STR(ON FINAL) PUTFILE SYSIN SET SYSIN = &STR( XRESULT = &EQUATION) PUTFILE SYSIN SET SYSIN = &STR( LIST XRESULT) PUTFILE SYSIN CLOSFILE SYSIN CALL 'DYL280II.R25.LOADLIB(DYL280)' OPENFILE SYS280R GETFILE SYS280R GETFILE SYS280R GETFILE SYS280R SET SYSDVAL = &SYS280R READDVAL CC DYRESULT ISPEXEC VPUT DYRESULT SHARED CLOSFILE SYS280R FREE DD(SYSOUT SYSPRINT SYS280R SYS004 AUDWORK AUDEPF AUDCBF + NOTHING SYSIN) EXIT ./ ADD NAME=EBCDIC /* REXX ***************************************************************/ /* CREATE A LINE OF EACH CHAR IN THE EBCDIC CODING SEQUENCE */ /**********************************************************************/ ADDRESS ISPEXEC 'CONTROL ERRORS RETURN' /**** SET MESSAGE DISPLAY ON/OFF BASED ON THE DEBUG SWITCH ***/ 'VGET (DBGSWTCH) PROFILE' IF (DBGSWTCH = 'ON') THEN TRACE ?R ELSE TRACE OFF ADDRESS ISREDIT 'MACRO (OPT)' DO I = 0 TO 255 XSTRING = D2X(I) IF I < 16 THEN XSTRING = 0 || XSTRING XSTRING = X2C(XSTRING) 'LINE_BEFORE .ZLAST = (XSTRING)' END ./ ADD NAME=EC ISREDIT MACRO ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /********************************************************************** /* UTILITY : EC * /* AUTHOR : DAVE LEIGH * /* FUNCTION : EDIT A COMPILE LISTING. * /********************************************************************** ISREDIT (MEMBER) = MEMBER ISPEXEC EDIT DATASET('&SYSUID..COMPILE.LISTING.&MEMBER') EXIT ./ ADD NAME=ECHANGE /********************************************************************** /* UTILITY: ECHANGE * /* AUTHOR: DAVID LEIGH * /* FUNCTION: THIS UTILITY PROVIDES A WAY TO CHANGE EXTRA LONG STRINGS * /* WITHOUT HAVING TO WRITE A MACRO OR SET KEYS. IT ALSO * /* AUTOMATICALLY PARSES FOR A SPACE DELIMITED WORD IF YOUR * /* CURSOR IS IN THE DATA. THAT BECOMES THE "FROM" STRING. * /********************************************************************** ISREDIT MACRO (PARM1 PARM2) ISPEXEC CONTROL ERRORS RETURN /**** 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 &STR(&SYSNSUB(1,&PARM)) = HELP THEN GOTO HELPSEC /********************************************************************** /* EVALUATE ANY PASSED PARMS * /********************************************************************** SET QT = &STR(') SELECT (&SYSCAPS(&PARM1)) WHEN (PREFIX) SET PREFIX = &STR(&SYSNSUB(1,&PARM2)) WHEN (SUFFIX) SET SUFFIX = &STR(&SYSNSUB(1,&PARM2)) WHEN (TO) SET CTO = &STR(&QT&SYSNSUB(1,&PARM2)&QT) END /********************************************************************** /* SAVE THE CURSOR POSITION AND SEE IF WE'RE ON THE COMMAND LINE * /********************************************************************** ISREDIT (LN,CL) = CURSOR IF &CL = 0 THEN GOTO DISPLAY /********************************************************************** /* IF NOT ON THE COMMAND LINE FIND THE STRING OUR CURSOR IS ON * /********************************************************************** ISREDIT FIND PREV ' ' .ZCSR .ZCSR ISREDIT FIND NEXT P'¬' .ZCSR .ZCSR ISREDIT (LN1,CL1) = CURSOR ISREDIT FIND NEXT ' ' .ZCSR .ZCSR ISREDIT FIND PREV P'¬' .ZCSR .ZCSR ISREDIT (LN2,CL2) = CURSOR ISREDIT (CFROM) = LINE .ZCSR SET CFROM = &SUBSTR(&CL1:&CL2,&STR(&SYSNSUB(1,&CFROM))) IF &SYSINDEX(&STR('),&STR(&SYSNSUB(1,&CFROM))) > 0 AND + &SYSINDEX(&STR("),&STR(&SYSNSUB(1,&CFROM))) = 0 THEN + SET QT = &STR(") IF &STR(&SYSNSUB(1,&CTO)) = THEN + SET CTO = &STR(&QT&SYSNSUB(1,&PREFIX)+ &SYSNSUB(1,&CFROM)+ &SYSNSUB(1,&SUFFIX)&QT) SET CFROM = &STR(&QT&SYSNSUB(1,&CFROM)&QT) /********************************************************************** /* DISPLAY THE DATA ENTRY PANEL AND EXIT IF THE USER "END"S OUT * /********************************************************************** DISPLAY: + ISPEXEC DISPLAY PANEL(ECHANGE) IF &LASTCC > 7 THEN + DO SET ZEDSMSG = &STR(NO CHANGE PERFORMED) ISPEXEC SETMSG MSG(UTLZ000) EXIT END /********************************************************************** /* INFORM THE USER OF THE ACTIVITY * /********************************************************************** SET ZEDLMSG = &STR(CHANGING: &CFROM TO: &CTO + PARMS: &CPARM) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) /********************************************************************** /* LET'S FINALLY DO THE WORK! * /********************************************************************** ISPEXEC VGET (CFROM CTO CPARM) SHARED ISREDIT CHANGE &STR(&SYSNSUB(1,&CFROM)) + &STR(&SYSNSUB(1,&CTO)) + &STR(&SYSNSUB(1,&CPARM)) /********************************************************************** /* TELL THE USER THE RESULTS AND GO BACK TO THE LINE THEY WERE ON * /********************************************************************** SET CC = &LASTCC ISREDIT (X,Y) = CHANGE_COUNTS SET X = &X SET Y = &Y SELECT (&CC) WHEN (0) DO SET ZEDSMSG = &STR(CHANGE SUCCESSFUL) SET ZEDLMSG = &STR(CHANGED &X STRING OCCURANCES) ISPEXEC SETMSG MSG(UTLZ000) END WHEN (4) DO SET ZEDSMSG = &STR(STRING NOT FOUND) SET ZEDLMSG = &STR(COULD NOT FIND "&SYSNSUB(1,&CFROM)" + TO CHANGE) ISPEXEC SETMSG MSG(UTLZ001) END WHEN (8) DO SET ZEDSMSG = &STR(SOME DATA UNCHANGED) SET ZEDLMSG = &STR(&X OCCURANCES CHANGED AND &Y OCCURANCES + UNCHANGED) ISPEXEC SETMSG MSG(UTLZ001) END OTHERWISE DO SET ZEDSMSG = &STR(SEVERE ECHANGE ERROR) SET ZEDLMSG = &STR(THE CHANGE HAD A RETURN CODE OF: &CC) ISPEXEC SETMSG MSG(UTLZ001) END END ISREDIT CURSOR = &LN &CL EXIT /********************************************************************** /* DISPLAY ANY "HELP" WHICH IS AVAILABLE FOR THIS UTILITY * /********************************************************************** HELPSEC: + ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR ECHANGE UTILITY + *** NO PROCESSING PERFORMED ***) ISPEXEC SETMSG MSG(UTLZ000) EXIT ./ ADD NAME=EDITGRP /* REXX ***************************************************************/ /* LIBDEF TO MY BATCH LOAD LIBRARY - D. LEIGH */ /**********************************************************************/ ADDRESS ISPEXEC "LIBDEF ISPLLIB DATASET ID('D@UDAL.STR.BATCH.LOADLIB')" DB2SSID = "DSNP" SQLQUERY = "SELECT A.GRP_ID,", " B.CARD", " FROM USSTRP00.ADM40T_GRPPROF A,", " SYSIBM.SYSTABLES B", " WHERE A.GRP_TYPE = 'SVCR'", " AND A.DB2_QUALIFIER = B.CREATOR", " AND B.NAME = 'PRT01T_PARTICIPANT'", " ORDER BY B.CARD,", " A.GRP_ID" ADDRESS LINK "REXXSQL" SQLRC = RC IF SQLRC <> 0 THEN EXIT SQLRC DO I = 1 TO _NROWS SAY GRP_ID.I CARD.I END ADDRESS ISPEXEC "LIBDEF ISPLLIB" ./ ADD NAME=EDIT799 /********************************************************************** /* UTILITY: EDIT799 * /* AUTHOR: DAVID LEIGH * /* FUNCTION: PROVIDE THE CLIENT ACCOUNTING DEPARTMENT THE ABILITY TO * /* MODIFY THE 799 REPORTS ON-LINE AND RE-PRINT THEM BY * /* LENDER ID. * /********************************************************************** /* SET UP SOME DEFAULT VARIABLES WHICH COULD BE CHANGED WHEN THE * /* CLIST IS INVOKED. * /********************************************************************** PROC 0 VALIDDBS('USC10 LIN51 D@UDAL') /* DATABASES USING EDIT799 */ + USC10DSNS('DSN5245 DSN5251 TGSL5251 MSLP5251 TSAC5251 OSLC5251') + USC10ID('CA P@ LINNRS') /* USER ID PREFIXES VALID FOR USC10 */ + /* D@UDALDSNS('DSNLNEW DSNFNEW TGSLLNEW MSLPLNEW') /* D@UDAL DSNS*/ + /* D@UDALID('P@') /* TSO USER ID PREFIXES VALID FOR D@UDAL */ + LIN51DSNS('DSN5245 DSN5251') /* LIN51 DSNS*/ + LIN51ID('LIN P@') /* TSO USER ID PREFIXES VALID FOR LIN51 */ + DSN5245(SLSS.MONTHLY.SLS5245.PRINTA) /* 5245 GDG BASE SUFFIX*/ + DSN5251(SLSS.MONTHLY.SLS5251.PRINT1) /* 5251 GDG BASE SUFFIX*/ + TGSL5251(SLSS.MONTHLY.TGSL5251.PRINT1) /* TGSL5251 GDG SUFFX*/ + MSLP5251(SLSS.MONTHLY.MSLP5251.PRINT1) /* MSLP5251 GDG SUFFX*/ + TSAC5251(SLSS.MONTHLY.TSAC5251.PRINT1) /* TSAC5251 GDG SUFFX*/ + OSLC5251(SLSS.MONTHLY.OSLC5251.PRINT1) /* TSAC5251 GDG SUFFX*/ + /* DSNLNEW(SLSS.L799.REPORT) /* NEW LENDER 799 GDG BASE SUFFIX*/ + /* DSNFNEW(SLSS.F799.REPORT) /* NEW "BOND" 799 GDG BASE SUFFIX*/ + /* TGSLLNEW(SLSS.L799TGSL.REPORT) /* NEW "TGSL" GDG BASE SUFFIX*/ + /* MSLPLNEW(SLSS.L799MSLP.REPORT) /* NEW "MSLP" GDG BASE SUFFIX*/ + DEBUG /* TURN DEBUGGING ON OR OFF */ + HELP /* DISPLAY THE HELP SCREENS INSTEAD OF PROCESSING */ IF &HELP = HELP THEN GOTO HELPSEC ISPEXEC CONTROL ERRORS RETURN /********************************************************************** /* INVOKE DEBUGGING IF SELECTED BY THE USER * /********************************************************************** /*** CHECK THE DEBUG SWITCH ***/ IF &DEBUG = DEBUG THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /********************************************************************** /* CREATE THE TEMPORARY TABLE * /********************************************************************** ISPEXEC TBEND EDIT799A ISPEXEC TBCREATE EDIT799A NOWRITE REPLACE KEYS() + NAMES(DATASET CREATED) /********************************************************************** /* LOOP THROUGH THE VALID DATABASES TO LOAD THE EDIT799A TABLE * /********************************************************************** SET TABLE = EDIT799A SET SYSDVAL = &STR(&VALIDDBS) READDVAL V1 V2 V3 V4 V5 V6 V7 V8 V9 + V10 V11 V12 V13 V14 V15 V16 V17 V18 V19 + V20 V21 V22 V23 V24 V25 V26 V27 V28 V29 DO I = 1 TO 29 SET DB = &&V&I SET DB = &DB IF &STR(&DB) = THEN GOTO EXIT_LOOP_1 SET SYSDVAL = &STR(&SYSNSUB(3,&&&DB.ID)) SET SYSDVAL = &SYSDVAL READDVAL ID1 ID2 ID3 ID4 ID5 ID6 ID7 ID8 ID9 + ID10 ID11 ID12 ID13 ID14 ID15 ID16 ID17 ID18 ID19 DO &J = 1 TO 19 SET PFXID = &&ID&J SET PFXID = &PFXID IF &STR(&PFXID) = THEN GOTO EXIT_LOOP_2 IF &SYSINDEX(&STR(&PFXID),&STR(&SYSUID)) = 1 THEN + DO SET SYSDVAL = &STR(&SYSNSUB(3,&&&DB.DSNS)) SET SYSDVAL = &SYSDVAL READDVAL DSN1 DSN2 DSN3 DSN4 DSN5 DSN6 DSN7 DSN9 DSN9 DO &K = 1 TO 9 SET DSN = &&DSN&K SET DSN = &DSN IF &STR(&DSN) = THEN GOTO EXIT_LOOP_3 SET DSN = &STR(&SYSNSUB(3,&&&DSN)) SET DSN = &STR(&DB..&DSN) SET ZEDLMSG = &STR(*** GATHERING "&DSN" + FILE CREATION INFORMATION ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) ISPEXEC SELECT CMD(%EDIT799L + &STR(&TABLE) &STR(&DSN) &DEBUG) END EXIT_LOOP_3: + END END EXIT_LOOP_2: + END /********************************************************************** /* ESTABLISH PRINT PROFILE VALUES IF THEY DO NOT CURRENTLY EXIST * /********************************************************************** EXIT_LOOP_1:+ CALL 'SYS2.USC1.LINKLIB(USERINFO)' '&SYSUID ' ISPEXEC VGET (CCNTR BINNM) PROFILE ISPEXEC VGET (PJOBSUFF PACODE PSLOC PPRCDE PJOBTYPE PJOBCLAS + PPGMNAME) PROFILE IF &STR(&PJOBSUFF) = THEN SET PJOBSUFF = &STR(P) IF &STR(&PACODE) = THEN SET PACODE = &STR(&CCNTR) IF &STR(&PSLOC) = THEN SET PSLOC = &STR(&BINNM) IF &STR(&PPRCDE) = THEN SET PPRCDE = &STR(A00000) IF &STR(&PJOBTYPE) = THEN SET PJOBTYPE = &STR(O) IF &STR(&PJOBCLAS) = THEN SET PJOBCLAS = &STR(A) IF &STR(&PPGMNAME) = THEN SET PPGMNAME = &STR(799 REPORT REPRINT) ISPEXEC VPUT (PJOBSUFF PACODE PSLOC PPRCDE PJOBTYPE PJOBCLAS + PPGMNAME) PROFILE /********************************************************************** /* POSITION AT THE TOP OF THE TABLE * /********************************************************************** ISPEXEC TBTOP EDIT799A /********************************************************************** /* (RE)DISPLAY THE EDIT799A TABLE * /********************************************************************** REDISPLAY_EDIT799A: + SET ZTDMARK = &STR(*** END OF 799 "FULL-REPORT" FILES ***) ISPEXEC TBDISPL EDIT799A PANEL(EDIT799A) SELECT (&LASTCC) WHEN (0) GOTO EDIT799A_COMMANDS WHEN (4) GOTO EDIT799A_COMMANDS WHEN (8) DO ISPEXEC TBEND EDIT799A ISPEXEC TBEND EDIT799B ISPEXEC TBEND EDIT799C ISPEXEC TBEND EDIT799X EXIT CODE(0) END OTHERWISE DO SET ZEDLMSG = &STR(*** "EDIT799A" PANEL ERROR. + CONTACT PROGRAMMER ***) ISPEXEC SETMSG MSG(UTLZ001W) EXIT CODE(12) END END /********************************************************************** /* PROCESS EDIT799A COMMANDS * /********************************************************************** EDIT799A_COMMANDS: + IF &ZTDSELS ¬= &STR(0000) THEN + DO ISPEXEC CONTROL DISPLAY SAVE DO WHILE &ZTDSELS ¬= &STR(0000) SELECT (&ZSEL) /********************************************************************** /* SELECT A FULL REPORT FOR BROWSING * /********************************************************************** WHEN (B) DO ISPEXEC BROWSE DATASET('&DATASET') SET ZEDLMSG = &STR(*** "&DATASET" BROWSED ***) ISPEXEC SETMSG MSG(UTLZ000W) END /********************************************************************** /* SELECT A FULL REPORT FOR EDITING * /********************************************************************** WHEN (E) DO SET ZEDLMSG = &STR(*** NOTE: YOU ARE EDITING A + "FULL REPORT" FILE. CHANGES + CANNOT BE SAVED! ***) ISPEXEC SETMSG MSG(UTLZ001W) ISPEXEC EDIT DATASET('&DATASET') SET ZEDLMSG = &STR(*** "&DATASET" EDITED ***) ISPEXEC SETMSG MSG(UTLZ000W) END /********************************************************************** /* SELECT A ROW FOR PROCESSING * /********************************************************************** WHEN (S) DO SET ZEDLMSG = &STR(*** SCANNING FOR + EXTRACTS OF "&DATASET" ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) SET FULLDSN = &STR(&DATASET) SET FULLDATE = &STR(&CREATED) ISPEXEC TBEND EDIT799B ISPEXEC TBCREATE EDIT799B NOWRITE REPLACE KEYS() + NAMES(DATASET CREATED) SET SYSDVAL = DO &I = 1 TO &LENGTH(&DATASET) IF &SUBSTR(&I:&I,&STR(&DATASET)) = &STR(.) + THEN + SET SYSDVAL = &STR(&SYSDVAL ) ELSE + SET SYSDVAL = &STR(&SYSDVAL)+ &SUBSTR(&I:&I,&STR(&DATASET)) END READDVAL NODE1 NODE2 NODE3 NODE4 NODE5 NODE6 IF &SUBSTR(2:4,&STR(&NODE3)) = 799 THEN + DO SET PROGRAM = SLS799R SET PREFIX = &STR(&SYSUID..)+ &STR(&NODE3..)+ &STR(X&SUBSTR(2:8,+ &STR(&NODE5)).)+ &STR(LENDER) END ELSE + DO SET B = &LENGTH(&STR(&NODE4)) SET A = &LENGTH(&STR(&NODE4)) - 3 SET PROGRAM = &STR(SLS&SUBSTR(&A:&B,+ &STR(&NODE4))) SET GNTR = &SUBSTR(1:&A-1,&STR(&NODE4)) IF &STR(&GNTR) = SLS THEN SET GNTR = ELSE SET GNTR = &STR(&GNTR..) SET PREFIX = &STR(&SYSUID..)+ &STR(&GNTR)+ &STR(X&SUBSTR(&A:&B,+ &STR(&NODE4)).)+ &STR(X&SUBSTR(2:8,+ &STR(&NODE6)).)+ &STR(LENDER) END SET TABLE = EDIT799B ISPEXEC SELECT CMD(%EDIT799L + &STR(&TABLE) &STR(&PREFIX) &DEBUG) ISPEXEC CONTROL DISPLAY SAVE ISPEXEC VPUT (FULLDSN FULLDATE PREFIX + PROGRAM) SHARED ISPEXEC SELECT CMD(%EDIT799B &DEBUG) ISPEXEC CONTROL DISPLAY RESTORE END /********************************************************************** /* IF THE LINE COMMAND ENTERED WAS INVALID, SHOW THE USER THE VALID * /* LINE COMMANDS IN A DYNAMICALLY CREATED TABLE DISPLAY. * /********************************************************************** OTHERWISE DO LINE_799A_COMMANDS: ISPEXEC TBEND EDIT799X ISPEXEC TBCREATE EDIT799X NOWRITE REPLACE KEYS() + NAMES(CMD799 CMD799DS) SET CMD799 = &STR(B) SET CMD799DS = + &STR(BROWSE A 799 REPORT DATASET ) ISPEXEC TBADD EDIT799X SET CMD799 = &STR(E) SET CMD799DS = + &STR(EDIT A 799 REPORT DATASET. NOTE: THE ACF2 SECURITY ) ISPEXEC TBADD EDIT799X SET CMD799 = SET CMD799DS = + &STR(SYSTEM CONTROLS ANY "UPDATE" CAPABILITY TO THESE FILES.) ISPEXEC TBADD EDIT799X SET CMD799 = &STR(S) SET CMD799DS = + &STR(SELECT A 799 REPORT DATASET FOR PROCESSING ) ISPEXEC TBADD EDIT799X ISPEXEC TBTOP EDIT799X SET ZWINTTL = &STR(VALID LINE COMMANDS...PF3 TO + RETURN...PF7/8 TO SCROLL) SET ZTDMARK = &STR(*** END OF VALID LINE COMMANDS ***) ISPEXEC ADDPOP ROW(6) COLUMN(8) /*PEXEC CONTROL DISPLAY SAVE /* FIXPOP */ LINE_799A_CMDLOOP: ISPEXEC TBDISPL EDIT799X PANEL(EDIT799X) IF &LASTCC = 0 THEN GOTO LINE_799A_CMDLOOP ISPEXEC REMPOP /*PEXEC CONTROL DISPLAY RESTORE /* FIXPOP */ END END /********************************************************************** /* GET THE NEXT LINE COMMAND IF THERE IS ONE * /********************************************************************** NEXT_799A_LINE: IF &ZTDSELS > &STR(0001) THEN + DO ISPEXEC CONTROL DISPLAY RESTORE ISPEXEC TBDISPL EDIT799A ISPEXEC CONTROL DISPLAY SAVE END ELSE + DO ISPEXEC CONTROL DISPLAY RESTORE SET ZTDSELS = &STR(0000) IF &STR(&ZCMD) = THEN GOTO SCROLL_799A END END END /********************************************************************** /* THIS CODE MAINTAINS WHICH TABLE ROW IS THE TOP ONE DISPLAYED * /********************************************************************** SCROLL_799A: + IF &STR(&ZCMD) = THEN + DO ISPEXEC TBTOP EDIT799A ISPEXEC TBSKIP EDIT799A NUMBER(&ZTDTOP) ISPEXEC VGET (ZVERB ZSCROLLN) IF &ZVERB = &STR(UP) THEN + ISPEXEC TBSKIP EDIT799A NUMBER(-&ZSCROLLN) IF &ZVERB = &STR(DOWN) THEN + ISPEXEC TBSKIP EDIT799A NUMBER(&ZSCROLLN) END GOTO REDISPLAY_EDIT799A /********************************************************************** /* DISPLAY ANY "HELP" WHICH IS AVAILABLE FOR THIS UTILITY * /********************************************************************** HELPSEC: + ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPE700) SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR EDIT799 UTILITY + *** NO PROCESSING PERFORMED ***) ISPEXEC SETMSG MSG(UTLZ000) EXIT ./ ADD NAME=EDIT799B /********************************************************************** /* UTILITY: EDIT799B * /* AUTHOR: DAVID LEIGH * /* FUNCTION: THIS CLIST IS CALLED BY THE EDIT799 CLIST. IT HANDLES * /* THE EDIT799B TABLE DISPLAY PROCESSING. * /********************************************************************** PROC 0 DEBUG /********************************************************************** /* INVOKE DEBUG PROCESSING IF NECESSARY * /********************************************************************** IF &DEBUG = DEBUG THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /********************************************************************** /* INITIALIZATION * /********************************************************************** ISPEXEC CONTROL ERRORS RETURN ISPEXEC VGET (FULLDATE FULLDSN PREFIX PROGRAM) SHARED ISPEXEC TBTOP EDIT799B /********************************************************************** /* (RE)DISPLAY THE EDIT799B TABLE * /********************************************************************** REDISPLAY_EDIT799B: + SET ZTDMARK = &STR(** END OF EXTRACT DATASETS FOR "&FULLDSN" **) ISPEXEC TBDISPL EDIT799B PANEL(EDIT799B) SELECT (&LASTCC) WHEN (0) GOTO EDIT799B_COMMANDS WHEN (8) GOTO EDIT799B_FINISH OTHERWISE DO SET ZEDLMSG(*** "EDIT799B" PANEL ERROR. CONTACT PROGRAMMER ***) ISPEXEC SETMSG MSG(UTLZ001W) GOTO EDIT799B_FINISH END END /********************************************************************** /* PROCESS EDIT799B COMMANDS * /********************************************************************** EDIT799B_COMMANDS: + IF &ZTDSELS ¬= &STR(0000) THEN + DO ISPEXEC CONTROL DISPLAY SAVE DO WHILE &ZTDSELS ¬= &STR(0000) SELECT (&ZSEL) /********************************************************************** /* SELECT DATASET FOR EDITING * /********************************************************************** WHEN (E ³ S) DO ISPEXEC EDIT DATASET('&DATASET') SET ZEDLMSG = &STR(*** "&DATASET" EDITED ***) END /********************************************************************** /* SELECT DATASET FOR PRINTING * /********************************************************************** WHEN (P) DO ISPEXEC SELECT CMD(%PRINTIT PDSN(&DATASET)) END /********************************************************************** /* IF THE LINE COMMAND ENTERED WAS INVALID, SHOW THE USER THE VALID * /* LINE COMMANDS IN A DYNAMICALLY CREATED TABLE DISPLAY. * /********************************************************************** OTHERWISE DO LINE_799B_COMMANDS: ISPEXEC TBEND EDIT799X ISPEXEC TBCREATE EDIT799X NOWRITE REPLACE KEYS() + NAMES(CMD799 CMD799DS) SET CMD799 = &STR(E) SET CMD799DS = + &STR(EDIT A LENDER SPECIFIC 799 REPORT DATASET ) ISPEXEC TBADD EDIT799X SET CMD799 = &STR(P) SET CMD799DS = + &STR(PRINT A LENDER SPECIFIC 799 REPORT DATASET ) ISPEXEC TBADD EDIT799X SET CMD799 = &STR(S) SET CMD799DS = + &STR(ALIAS OF THE "E" COMMAND ) ISPEXEC TBADD EDIT799X ISPEXEC TBTOP EDIT799X SET ZWINTTL = &STR(VALID LINE COMMANDS...PF3 TO + RETURN...PF7/8 TO SCROLL) SET ZTDMARK = &STR(*** END OF VALID LINE COMMANDS ***) ISPEXEC ADDPOP ROW(6) COLUMN(8) /*PEXEC CONTROL DISPLAY SAVE /* FIXPOP */ LINE_799B_CMDLOOP: ISPEXEC TBDISPL EDIT799X PANEL(EDIT799X) IF &LASTCC = 0 THEN GOTO LINE_799B_CMDLOOP ISPEXEC REMPOP /*PEXEC CONTROL DISPLAY RESTORE /* FIXPOP */ END END /********************************************************************** /* GET THE NEXT LINE COMMAND IF THERE IS ONE * /********************************************************************** NEXT_799B_LINE: IF &ZTDSELS > &STR(0001) THEN + DO ISPEXEC CONTROL DISPLAY RESTORE ISPEXEC TBDISPL EDIT799B ISPEXEC CONTROL DISPLAY SAVE END ELSE + DO ISPEXEC CONTROL DISPLAY RESTORE SET ZTDSELS = &STR(0000) IF &STR(&ZCMD) = THEN GOTO SCROLL_799B END END END /********************************************************************** /* PROCESS 799B PRIMARY COMMANDS * /********************************************************************** /* PROCESS ANY COMMANDS THAT THE USER MAY HAVE TYPED ON THE COMMAND * /* LINE (I.E. "PRIMARY" COMMANDS). * /********************************************************************** IF &STR(&ZCMD) = THEN GOTO SCROLL_799B SET SYSDVAL = &STR(&ZCMD) READDVAL ZCMD OPT1 OPT2 OPT3 OPT4 OPT5 OPT6 OPT7 OPT8 OPT9 OPT10 SELECT (&SYSCAPS(&STR(&ZCMD))) WHEN (EX ³ EXT ³ EXTR ³ EXTRA ³ EXTRAC ³ EXTRACT ) + GOTO EXTRACT_SECTION /********************************************************************** /* DISPLAY A DYNAMICALLY CREATED TABLE LISTING THE VALID PRIMARY * /* COMMANDS IF THE USER DID NOT ENTER A VALID COMMAND. * /********************************************************************** OTHERWISE DO PRIM_COMMANDS: + ISPEXEC TBEND EDIT799X ISPEXEC TBCREATE EDIT799X NOWRITE REPLACE KEYS() + NAMES(CMD799 CMD799DS) SET CMD799 = &STR(HELP ) /***********************************/ SET CMD799DS = + &STR(ALIASES: ) ISPEXEC TBADD EDIT799X SET CMD799 = SET CMD799DS = + &STR(PARAMETERS: NONE) ISPEXEC TBADD EDIT799X SET CMD799DS = + &STR(FUNCTION: INVOKE A TUTORIAL ABOUT THE 799 REPORT EDITING ) ISPEXEC TBADD EDIT799X SET CMD799DS = + &STR( UTILITY. ) ISPEXEC TBADD EDIT799X SET CMD799 = &STR(EXTRACT) /***********************************/ SET CMD799DS = + &STR(ALIASES: "EX" "EXT" "EXTR" "EXTRA" "EXTRAC" ) ISPEXEC TBADD EDIT799X SET CMD799 = SET CMD799DS = + &STR(PARAMETERS: A VALID 6 CHARACTER LENDER ID) ISPEXEC TBADD EDIT799X SET CMD799DS = + &STR(FUNCTION: EXTRACT THE SECTION OF A 799 REPORT FOR A ) ISPEXEC TBADD EDIT799X SET CMD799DS = + &STR( SPECIFIC LENDER. THE DATASET WHICH WILL BE ) ISPEXEC TBADD EDIT799X SET CMD799DS = + &STR( EXTRACTED "FROM" IS THE ONE SPECIFIED IN THE ) ISPEXEC TBADD EDIT799X SET CMD799DS = + &STR( "CURRENT FULL REPORT DATASET" FIELD. ONCE THE ) ISPEXEC TBADD EDIT799X SET CMD799DS = + &STR( REPORT EXTRACT HAS BEEN CREATED, THE NEW DATASET) ISPEXEC TBADD EDIT799X SET CMD799DS = + &STR( WHICH CONTAINS IT WILL BE ADDED TO THE DISPLAY. ) ISPEXEC TBADD EDIT799X ISPEXEC TBTOP EDIT799X SET ZWINTTL = &STR(VALID PRIMARY COMMANDS...PF3 TO RETURN...+ PF7/8 TO SCROLL_799B) SET ZTDMARK = &STR(*** END OF VALID PRIMARY COMMANDS ***) ISPEXEC ADDPOP ROW(3) COLUMN(8) /*PEXEC CONTROL DISPLAY SAVE /* FIXPOP */ PRIM_CMDLOOP: + ISPEXEC TBDISPL EDIT799X PANEL(EDIT799X) IF &LASTCC = 0 THEN GOTO PRIM_CMDLOOP ISPEXEC REMPOP /*PEXEC CONTROL DISPLAY RESTORE /* FIXPOP */ END END /********************************************************************** /* THIS CODE MAINTAINS WHICH TABLE ROW IS THE TOP ONE DISPLAYED * /********************************************************************** SCROLL_799B: + IF &STR(&ZCMD) = THEN + DO ISPEXEC TBTOP EDIT799B ISPEXEC TBSKIP EDIT799B NUMBER(&ZTDTOP) ISPEXEC VGET (ZVERB ZSCROLLN) IF &ZVERB = &STR(UP) THEN + ISPEXEC TBSKIP EDIT799B NUMBER(-&ZSCROLLN) IF &ZVERB = &STR(DOWN) THEN + ISPEXEC TBSKIP EDIT799B NUMBER(&ZSCROLLN) END GOTO REDISPLAY_EDIT799B /********************************************************************** /* PROCESS THE EXTRACT OF REPORT DATA * /********************************************************************** EXTRACT_SECTION: + IF &STR(&OPT1) = THEN + DO SET ZEDLMSG = &STR(*** A LENDER ID MUST BE SPECIFIED. + E.G. "EXTRACT 826626" ***) ISPEXEC SETMSG MSG(UTLZ001W) GOTO SCROLL_799B END SET LENDERID = &STR(&OPT1) ISPEXEC TBVCLEAR EDIT799B SET DATASET = &STR(&PREFIX..#&LENDERID) ISPEXEC TBSCAN EDIT799B ARGLIST(DATASET) IF &LASTCC = 0 THEN + IF &OPT2 = REPLACE THEN + DO DELETE '&DATASET' ISPEXEC TBDELETE EDIT799B END ELSE + DO SET ZEDLMSG = &STR(** "&LENDERID" EXTRACT ALREADY EXISTS. + "EXTRACT &LENDERID REPLACE" TO REPLACE + IT. **) ISPEXEC SETMSG MSG(UTLZ001W) GOTO SCROLL_799B END SET ZEDLMSG = &STR(*** EDITING "&FULLDSN" ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) ISPEXEC VPUT (LENDERID PREFIX PROGRAM) SHARED ISPEXEC EDIT DATASET('&FULLDSN') MACRO(EDIT799M) ISPEXEC VGET (LINES799 TEMPDSN) SHARED IF &STR(&LINES799) > 0 THEN + DO ISPEXEC TBCREATE EDIT799B NOWRITE REPLACE KEYS() + NAMES(DATASET CREATED) SET TABLE = EDIT799B ISPEXEC SELECT CMD(%EDIT799L + &STR(&TABLE) &STR(&PREFIX) &DEBUG) ISPEXEC TBTOP EDIT799B SET ZEDLMSG = &STR(*** "&TEMPDSN" CONTAINS "&LENDERID" + EXTRACT ***) ISPEXEC SETMSG MSG(UTLZ000W) END ELSE + DO SET ZEDLMSG = &STR(*** REPORT SECTION FOR LENDER "&LENDERID" + NOT FOUND IN THIS REPORT DATASET ***) ISPEXEC SETMSG MSG(UTLZ001W) END SET LINES799 = 0 ISPEXEC VPUT LINES799 SHARED GOTO SCROLL_799B /********************************************************************** /* EXIT THIS CLIST AND RETURN * /********************************************************************** EDIT799B_FINISH: + EXIT ./ ADD NAME=EDIT799L /********************************************************************** /* UTILITY: EDIT799L * /* AUTHOR: DAVID LEIGH * /* FUNCTION: THIS SECTION IS CALLED FROM SEVERAL PLACES IN THE * /* EDIT799 UTILITY. IT TAKES A PASSED ISPF TABLE NAME, A * /* DATASET "LEVEL" FOR A LISTCAT, AND IT PERFORMS A * /* LISTCAT, PARSES THE LISTCAT, GETS A DATASET CREATE DATE * /* AND ADDS ROWS TO A TABLE. * /********************************************************************** PROC 2 &TABLE &PREFIX DEBUG /********************************************************************** /* DO DEBUG PROCESSING IF SO DESIRED * /********************************************************************** IF &DEBUG = DEBUG THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /********************************************************************** /* LISTCAT TO FIND OUT ALL THE DATASETS WITH THIS LEVEL * /********************************************************************** SET SYSOUTTRAP = 1000 LISTCAT LEVEL('&PREFIX') HISTORY SET SYSOUTTRAP = 0 SET LINES = &SYSOUTLINE /********************************************************************** /* PARSE THE LISTCAT AND LOAD THE ISPF TABLE * /********************************************************************** DO I = 1 TO &LINES SET LINE = &&SYSOUTLINE&I SET SYSDVAL = &STR(&LINE) READDVAL TOKEN1 TOKEN2 TOKEN3 IF &STR(&TOKEN1) = NONVSAM THEN + DO SET DATASET = &STR(&TOKEN3) LISTDSI &STR('&DATASET') SET DUDATE1 = &STR(&SYSCREATE) SET DUDY1FMT = &STR(DDD) SET DUYR1FMT = &STR(YYYY) SET DUDT1FMT = &STR(Y/D) SET DUFUNC = &STR(CONVERT) SET DUDY2FMT = &STR(DAY) SET DUDT2FMT = &STR(D) ISPEXEC VPUT (DUDATE1 DUDY1FMT DUYR1FMT DUDT1FMT + DUFUNC DUDY2FMT DUDT2FMT) SHARED ISPEXEC SELECT PGM(DATEUTIL) PARM(ISPF) IF &LASTCC = 0 THEN + DO ISPEXEC VGET (DUDATE2) SHARED SET DAY = &STR(&DUDATE2) END ELSE + DO ISPEXEC VGET (DUMSG) SHARED WRITE #1 &STR(&DUMSG) EXIT END SET DUDY2FMT = &STR(ZD) SET DUMO2FMT = &STR(MONTH) SET DUYR2FMT = &STR(YYYY) SET DUDT2FMT = &STR(M D, Y) ISPEXEC VPUT (DUDATE1 DUDY1FMT DUYR1FMT DUDT1FMT + DUFUNC DUDY2FMT DUMO2FMT DUYR2FMT + DUDT2FMT) SHARED ISPEXEC SELECT PGM(DATEUTIL) PARM(ISPF) IF &LASTCC = 0 THEN + DO ISPEXEC VGET (DUDATE2) SHARED SET CREATED = &STR(&DAY &DUDATE2) END ELSE + DO ISPEXEC VGET (DUMSG) SHARED WRITE #2 &STR(&DUMSG) EXIT END ISPEXEC TBADD &TABLE END END EXIT ./ ADD NAME=EDIT799M /********************************************************************** /* UTILITY: EDIT799M * /* AUTHOR: DAVID LEIGH * /* FUNCTION: WHILE IN EDIT ON A REPORT FILE OF THE 799 REPORTS, THIS * /* EDIT MACRO (EXECUTED AS AN INITIAL MACRO) WILL CREATE * /* AND LOAD AN "EXTRACT" FILE WITH THE REPORT LINES WHICH * /* PERTAIN TO A SPECIFIC LENDER. * /********************************************************************** ISREDIT MACRO ISPEXEC CONTROL ERRORS RETURN /**** 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 /********************************************************************** /* INITIALIZE VARIABLES * /********************************************************************** ISPEXEC VGET (LENDERID PREFIX PROGRAM) SHARED ISREDIT (DATASET) = DATASET ISREDIT (LRECL) = LRECL SET LINES799 = 0 SET TEMPDSN = &STR(&PREFIX..#&LENDERID) /********************************************************************** /* MARK THE BEGINNING AND ENDING OF THAT LENDER'S SECTION. * /********************************************************************** SET ZEDLMSG = &STR(*** IDENTIFYING DATA FOR LENDER: &LENDERID ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) IF &STR(&PROGRAM) = SLS799R THEN + SET STRING = &STR( LID: &STR(&LENDERID) ) ELSE + SET STRING = &STR( LID: &STR(&LENDERID) ) ISREDIT FIND FIRST '&STR(&STRING)' IF &LASTCC > 0 THEN GOTO FINISH ISREDIT FIND PREV '1UNIPAC/&PROGRAM/' 1 ISREDIT LABEL .ZCSR = .A ISREDIT (LNBEGIN) = LINENUM .ZCSR ISREDIT FIND LAST '&STR(&STRING)' ISREDIT FIND NEXT '1UNIPAC/&PROGRAM/' 1 IF &LASTCC > 0 THEN + DO ISREDIT LABEL .ZLAST = .B ISREDIT (LNEND) = LINENUM .ZLAST END ELSE + DO ISREDIT FIND PREV P'=' 1 ISREDIT LABEL .ZCSR = .B ISREDIT (LNEND) = LINENUM .ZCSR END /********************************************************************** /* ALLOCATE THE OUTPUT DATASET BASED ON THE NUMBER OF LINES * /********************************************************************** SET LINES799 = &EVAL(&LNEND - &LNBEGIN + 1) GLOBAL A B C D E F G H I J %BLKSIZE &LRECL &LINES799 SELECT(3380) BATCH ISPEXEC VGET (BLKSIZE TRKSREQ) SHARED FREE DD(TEMPDD) DELETE '&TEMPDSN' ALLOC DD(TEMPDD) DSN('&TEMPDSN') + NEW CATALOG + UNIT(SYSDA) + SPACE(&TRKSREQ,1) TRACKS RELEASE + BLKSIZE(&BLKSIZE) + LIKE('&DATASET') /********************************************************************** /* LOOP THROUGH FROM .A THROUGH .B AND VPUT ALL THE LINES * /********************************************************************** SET ZEDLMSG = &STR(*** CAPTURING REPORT LINES FOR LENDER: &LENDERID ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) OPENFILE TEMPDD OUTPUT ISREDIT FIND FIRST P'=' 1 .A .B DO WHILE &LASTCC = 0 ISREDIT (TEMPDD) = LINE .ZCSR PUTFILE TEMPDD ISREDIT FIND NEXT P'=' 1 .A .B END CLOSFILE TEMPDD FREE DD(TEMPDD) /********************************************************************** /* VPUT THE VARIABLE AND GET OUT * /********************************************************************** FINISH: + ISPEXEC VPUT (LINES799 TEMPDSN) SHARED ISREDIT CANCEL ./ ADD NAME=EDVCLIST PROC 1 PLANNAME TEMPFILE(&SYSUID..TEMP.ENDEVOR) /*** CHECK THE DEBUG SWITCH ***/ ISPEXEC VGET DBGSWTCH PROFILE IF &DBGSWTCH = ON THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS SET ZEDLMSG = &STR(*** PREPARING TO CALL ENDEVOR ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000) DELETE '&TEMPFILE' FREE DDNAME(SYSPRINT C1MSGS1 C1PRINT PRINTDD BSTIPT01) ALLOC DD(SYSPRINT) + DUMMY ALLOC DD(SYSUDUMP) + DUMMY ALLOC DD(C1MSGS1) + DUMMY FREE DDNAME(PRINTDD) ALLOC DD(PRINTDD) + DSN('&TEMPFILE') + NEW CATALOG + UNIT(SYSDA) + SPACE(1,1) CYLINDERS RELEASE + RECFM(F B) + LRECL(133) + BLKSIZE(23408) ALLOC DD(C1PRINT) + DUMMY DELETE BSTIPT01 ALLOC DD(BSTIPT01) + NEW CATALOG + UNIT(SYSDA) + SPACE(50,1) TRACKS RELEASE + RECFM(F B) + LRECL(80) + BLKSIZE(23440) OPENFILE BSTIPT01 OUTPUT SET BSTIPT01 = &STR(PRINT ELEMENT '&PLANNAME' ) PUTFILE BSTIPT01 SET BSTIPT01 = &STR( FROM ENVIRONMENT 'QUAL' ) PUTFILE BSTIPT01 SET BSTIPT01 = &STR( STAGE 'D' ) PUTFILE BSTIPT01 SET BSTIPT01 = &STR( SYSTEM 'STR' ) PUTFILE BSTIPT01 SET BSTIPT01 = &STR( SUBSYSTEM 'UNIPAC' ) PUTFILE BSTIPT01 SET BSTIPT01 = &STR( TYPE 'BINDOVRD' ) PUTFILE BSTIPT01 SET BSTIPT01 = &STR( TO FILE 'PRINTDD' ) PUTFILE BSTIPT01 SET BSTIPT01 = &STR(. ) PUTFILE BSTIPT01 CLOSFILE BSTIPT01 SET ZEDLMSG = &STR(*** CALLING ENDEVOR ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000) ISPEXEC SELECT PGM(NDVRC1) PARM(C1BM3000) ' SET ZEDSMSG = &STR(ENDEVOR &LASTCC) ISPEXEC SETMSG MSG(UTLZ000) FREE DDNAME(SYSPRINT C1MSGS1 C1PRINT PRINTDD BSTIPT01) ISPEXEC EDIT DATASET('&TEMPFILE') MACRO(EDVMACRO) ./ ADD NAME=EDVMACRO ISREDIT MACRO ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ISREDIT FIND LAST ' PLAN(' IF &LASTCC ¬= 0 THEN EXIT CODE(8) ISREDIT FIND NEXT '(' .ZCSR .ZCSR ISREDIT FIND NEXT P'=' .ZCSR .ZCSR ISREDIT (LN1,CL1) = CURSOR ISREDIT FIND NEXT ')' .ZCSR .ZCSR ISREDIT FIND PREV P'=' .ZCSR .ZCSR ISREDIT (LN2,CL2) = CURSOR ISREDIT (LINE) = LINE .ZCSR SET PLAN = &SUBSTR(&CL1:&CL2,&STR(&SYSNSUB(1,&LINE))) SET I = 0 SET DB2MAIN = N ISREDIT FIND NEXT ' *.' DO WHILE &LASTCC = 0 ISREDIT FIND NEXT '.' .ZCSR .ZCSR ISREDIT FIND NEXT P'=' .ZCSR .ZCSR ISREDIT (LN1,CL1) = CURSOR ISREDIT FIND NEXT ' ' .ZCSR .ZCSR ISREDIT FIND PREV P'=' .ZCSR .ZCSR ISREDIT (LN2,CL2) = CURSOR ISREDIT (LINE) = LINE .ZCSR SET PKG = &SUBSTR(&CL1:&CL2,&STR(&SYSNSUB(1,&LINE))) IF &I = 0 THEN + IF &STR(&PKG) = &STR(&PLAN) THEN SET DB2MAIN = Y ELSE SET I = &I + 1 SET APP&I = &STR(&PKG) SET I = &I + 1 ISREDIT FIND NEXT ' *.' END SET I = &I - 1 ISREDIT FIND LAST ' ISOLATION(' ISREDIT FIND NEXT '(' .ZCSR .ZCSR ISREDIT FIND NEXT P'=' .ZCSR .ZCSR ISREDIT (LN1,CL1) = CURSOR ISREDIT FIND NEXT ')' .ZCSR .ZCSR ISREDIT FIND PREV P'=' .ZCSR .ZCSR ISREDIT (LN2,CL2) = CURSOR ISREDIT (LINE) = LINE .ZCSR SET ISOLATE = &SUBSTR(&CL1:&CL2,&STR(&SYSNSUB(1,&LINE))) ISREDIT FIND LAST ' ACQUIRE(' ISREDIT FIND NEXT '(' .ZCSR .ZCSR ISREDIT FIND NEXT P'=' .ZCSR .ZCSR ISREDIT (LN1,CL1) = CURSOR ISREDIT FIND NEXT ')' .ZCSR .ZCSR ISREDIT FIND PREV P'=' .ZCSR .ZCSR ISREDIT (LN2,CL2) = CURSOR ISREDIT (LINE) = LINE .ZCSR SET ACQUIRE = &SUBSTR(&CL1:&CL2,&STR(&SYSNSUB(1,&LINE))) ISREDIT FIND LAST ' RELEASE(' ISREDIT FIND NEXT '(' .ZCSR .ZCSR ISREDIT FIND NEXT P'=' .ZCSR .ZCSR ISREDIT (LN1,CL1) = CURSOR ISREDIT FIND NEXT ')' .ZCSR .ZCSR ISREDIT FIND PREV P'=' .ZCSR .ZCSR ISREDIT (LN2,CL2) = CURSOR ISREDIT (LINE) = LINE .ZCSR SET RELEASE = &SUBSTR(&CL1:&CL2,&STR(&SYSNSUB(1,&LINE))) ISREDIT LINE_BEFORE .ZLAST = MSGLINE '&STR(PLAN = &PLAN)' DO &A = 0 TO &I SET APP = &STR(&SYSNSUB(2,&&APP&A)) IF &STR(&APP) > THEN + ISREDIT LINE_BEFORE .ZLAST = MSGLINE '&STR(APP&A = &APP)' END ISREDIT LINE_BEFORE .ZLAST = MSGLINE '&STR(ISOLATION = &ISOLATE)' ISREDIT LINE_BEFORE .ZLAST = MSGLINE '&STR(ACQUIRE = &ACQUIRE)' ISREDIT LINE_BEFORE .ZLAST = MSGLINE '&STR(RELEASE = &RELEASE)' ./ ADD NAME=EL PROC 0 HELP /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT IF &HELP = &STR(HELP) THEN GOTO HELPSEC /********************************************************************** /* UTILITY : EL * /* AUTHOR : DAVE LEIGH * /* FUNCTION : EDIT A LINK LISTING IN CHAMP. * /********************************************************************** ISPEXEC VGET (LINKLIST) SHARED %WAACEDIT '&LINKLIST' EXIT HELPSEC: + CLEAR WRITE *** HELP FOR CLIST EL *** WRITE WRITE HELP NOT WRITTEN AT THIS TIME WRITE WRITE *** END OF HELP *** NO PROCESSING PERFORMED EXIT ./ ADD NAME=ELA$CLST ********************************************************************** * * * LICENSED MATERIALS - PROPERTY OF IBM * * 5688-206 (C) COPYRIGHT IBM CORP. 1990, 1992 * * SEE COPYRIGHT INSTRUCTIONS * * * ********************************************************************** ./ ADD NAME=ELACUSR2 PROC 0 GLOBAL GENV GHLQ GVOL GUNIT GDB2 GLBLK /**********************************************************************/ /* MODULE NAME = ELACUSR2 */ /* */ /* DESCRIPTIVE NAME = CSP/370RS ALLOCATION OF USER DATASETS */ /* NECESSARY IN ALL ENVIRONMENTS */ /* */ /* LICENSED MATERIALS - PROPERTY OF IBM */ /* 5688-206 (C) COPYRIGHT IBM CORP. 1990, 1992 */ /* SEE COPYRIGHT INSTRUCTIONS */ /* */ /* STATUS = VERSION 2, RELEASE 1, LEVEL 0 */ /* */ /* FUNCTION = THIS CLIST IS USED TO ALLOCATE USER DATASETS FOR USE */ /* WITH CSP/370RS */ /* */ /* VARIABLES USED BY THIS CLIST INCLUDE: */ /* */ /* NAME DESCRIPTION DEFAULT */ /* */ /* GENV - ENVIRONMENT(S) FROM THE FOLLOWING NONE */ /* ENVIRONMENTS LISTED BELOW */ /* GHLQ - DATASET HIGH LEVEL QUALIFIER USERID */ /* GVOL - VOLUME SERIAL FOR DATASET ALLOCATION VVVVVV */ /* GUNIT - UNIT FOR DATASET ALLOCATION SYSDA */ /* GDB2 - Y/N WILL DB2 DATABASES BE USED? N */ /* GLBLK - LOAD LIBRARY BLOCKSIZE 6144 */ /* */ /* ENVIRONNMENTS: */ /* */ /* IMSVS - IS IMSVS A TARGET ENVIRONMENT? (Y/N) */ /* MVSCICS - IS MVSCICS A TARGET ENVIRONMENT? (Y/N) */ /* MVSBATCH - IS MVSBATCH A TARGET ENVIRONMENT? (Y/N) */ /* IMSBMP - IS IMSBMP A TARGET ENVIRONMENT? (Y/N) */ /* TSO - IS TSO A TARGET ENVIRONMENT? (Y/N) */ /* */ /**********************************************************************/ CONTROL MSG NOLIST /**********************************************************************/ /* ALLOCATE FILES USED IN ALL ENVIRONMENTS EXCEPT OS2CICS */ /**********************************************************************/ /* */ /* ALLOC EZEJCLP */ /* */ IF &SYSDSN('&GHLQ..&GENV..EZEJCLP') ¬= OK THEN + ALLOC DA('&GHLQ..&GENV..EZEJCLP') NEW DIR(08) + BLKSIZE(6160) LRECL(80) RECFM(F,B) DSORG(PO) + SPACE(01,01) CYLINDERS UNIT(&GUNIT) VOLUME(&GVOL) FREE DA('&GHLQ..&GENV..EZEJCLP') /* */ /* ALLOC EZELINK */ /* */ IF &SYSDSN('&GHLQ..&GENV..EZELINK') ¬= OK THEN + ALLOC DA('&GHLQ..&GENV..EZELINK') NEW DIR(08) + BLKSIZE(3200) LRECL(80) RECFM(F,B) DSORG(PO) + SPACE(10,02) CYLINDERS UNIT(&GUNIT) VOLUME(&GVOL) FREE DA('&GHLQ..&GENV..EZELINK') /* */ /* ALLOC EZEPCTL */ /* */ IF &SYSDSN('&GHLQ..&GENV..EZEPCTL') ¬= OK THEN + ALLOC DA('&GHLQ..&GENV..EZEPCTL') NEW DIR(20) + BLKSIZE(6160) LRECL(80) RECFM(F B) DSORG(PO) + SPACE(01,01) CYLINDERS UNIT(&GUNIT) VOLUME(&GVOL) FREE DA('&GHLQ..&GENV..EZEPCTL') /* */ /* ALLOC EZESRC */ /* */ IF &SYSDSN('&GHLQ..&GENV..EZESRC') ¬= OK THEN + ALLOC DA('&GHLQ..&GENV..EZESRC') NEW DIR(20) + BLKSIZE(6160) LRECL(80) RECFM(F B) DSORG(PO) + SPACE(02,01) CYLINDERS UNIT(&GUNIT) VOLUME(&GVOL) FREE DA('&GHLQ..&GENV..EZESRC') /* */ /* ALLOC LOAD */ /* */ IF &SYSDSN('&GHLQ..&GENV..LOAD') ¬= OK THEN + ALLOC DA('&GHLQ..&GENV..LOAD') NEW DIR(20) + BLKSIZE(&GLBLK) LRECL(00) RECFM(U) DSORG(PO) + SPACE(10,02) CYLINDERS UNIT(&GUNIT) VOLUME(&GVOL) FREE DA('&GHLQ..&GENV..LOAD') /* */ /* ALLOC OBJECT */ /* */ IF &SYSDSN('&GHLQ..&GENV..OBJECT') ¬= OK THEN + ALLOC DA('&GHLQ..&GENV..OBJECT') NEW DIR(20) + BLKSIZE(3200) LRECL(80) RECFM(F B) DSORG(PO) + SPACE(03,01) CYLINDERS UNIT(&GUNIT) VOLUME(&GVOL) FREE DA('&GHLQ..&GENV..OBJECT') /* */ /* ALLOC EZEWORK */ /* */ IF &SYSDSN('&GHLQ..EZEWORK') ¬= OK THEN + DO CONTROL NOMSG DEFINE CLUSTER (NAME('&GHLQ..EZEWORK') + VOL(&GVOL) + CYLINDERS(1 1) + KEYS(14 0) + RECORDSIZE(272 272) + SHR(3 3) + INDEXED) + DATA (NAME('&GHLQ..EZEWORK.DATA')) + INDEX(NAME('&GHLQ..EZEWORK.INDEX')) CONTROL MSG END /**********************************************************************/ /* ALLOCATE DB2 FILES */ /**********************************************************************/ IF &GDB2=Y THEN + DO /* */ /* ALLOC DBRMLIB */ /* */ IF &SYSDSN('&GHLQ..&GENV..DBRMLIB') ¬= OK THEN + ALLOC DA('&GHLQ..&GENV..DBRMLIB') NEW DIR(05) + BLKSIZE(6160) LRECL(80) RECFM(F,B) DSORG(PO) + SPACE(02,01) CYLINDERS UNIT(&GUNIT) VOLUME(&GVOL) FREE DA('&GHLQ..&GENV..DBRMLIB') /* */ /* ALLOC EZEBIND */ /* */ IF &SYSDSN('&GHLQ..&GENV..EZEBIND') ¬= OK THEN + ALLOC DA('&GHLQ..&GENV..EZEBIND') NEW DIR(05) + BLKSIZE(6160) LRECL(80) RECFM(F,B) DSORG(PO) + SPACE(01,01) CYLINDERS UNIT(&GUNIT) VOLUME(&GVOL) FREE DA('&GHLQ..&GENV..EZEBIND') END EXIT ./ ADD NAME=ELATALC /**********************************************************************/ /* ELATALC - ALLOCATE CLIST */ /* */ /* Input Parameter Description Parameter Name */ /* ----------------------------------------------- -------------- */ /* FULLY-QUALIFIED DATASET NAME--------------------> &FQDSN */ /* FILE NAME --------------------------------------> &FILE */ /* DEVICE TYPE ------------------------------------> &UNIT */ /* RECORD FORMAT ----------------------------------> &RECFM */ /* LOGICAL RECORD LENGTH --------------------------> &LRECL */ /* BLOCK SIZE -------------------------------------> &BLKSIZE */ /* UNIT OF ALLOCATION (CYLINDERS OR TRACKS) -------> &TYPE */ /* PRIMARY ALLOCATION -----------------------------> &PRIMEXT */ /* SECONDARY ALLOCATION ---------------------------> &SECEXT */ /* DISPOSITION OF ALLOCATED FILE (IF FILE EXISTS) -> &DISP */ /**********************************************************************/ PROC 10 &FQDSN &FILE &UNIT &RECFM + &LRECL &BLKSIZE &TYPE &PRIMEXT + &SECEXT &DISP CONTROL NOLIST NOFLUSH NOMSG /* CHECK FOR ALLOCATION OF FILE */ /* CONDITION CODE OF 16 IS RETURNED FOR SEVERE ERROR */ /* REASON CODE OF 2 IS RETURNED FOR DYNAMIC ALLOCATION PROCESSING */ /* ERROR (SVC 99 ERROR) */ LISTDSI &FILE FILE IF &LASTCC = 16 AND &SYSREASON = 2 THEN + DO /* CHECK FOR EXISTENCE OF DATASET */ /* CONDITION CODE OF 16 IS RETURNED FOR SEVERE ERROR */ /* REASON CODE OF 5 IS RETURNED FOR DATA SET NOT CATALOGED */ /* (LOCATE MACRO ERROR) */ LISTDSI '&FQDSN' IF &LASTCC = 16 AND &SYSREASON = 5 THEN + DO /* FORMAT RECFM WITH SPACES */ SET &LEN = &LENGTH(&RECFM) SET &RECFMT = &STR() DO WHILE &LEN > 0 SET &FCHAR = &SUBSTR(&LEN,&RECFM) SET &RECFMT = &STR(&FCHAR &RECFMT) SET &LEN = &LEN - 1 END SET &RECFM = &STR(&RECFMT) /* ALLOCATE DATASET */ SET &SYSMSG = ON /* SHOW ANY ALLOCATION ERROR MESSAGES */ ALLOC FILE(&FILE) + DATASET('&FQDSN') + UNIT(&UNIT) + RECFM(&RECFM) + LRECL(&LRECL) + BLKSIZE(&BLKSIZE) + SPACE(&PRIMEXT,&SECEXT) + &TYPE + NEW SET &SAVECC = &LASTCC SET &SYSMSG = OFF /* SUPPRESS TSO COMMAND MESSAGES */ /* IF ALLOCATION FAILS TERMINATE */ IF &SAVECC NE 0 THEN + EXIT CODE(&SAVECC) /* IF DISP = SHR OR MOD THEN REALLOCATE USING DISP */ IF &DISP = SHR OR &DISP = MOD THEN + DO /* ALLOCATE FILE */ SET &SYSMSG = ON /* SHOW ANY ALLOCATION ERROR MESSAGES */ ALLOC FILE(&FILE) + DATASET('&FQDSN') + &DISP + REUSE SET &SAVECC = &LASTCC SET &SYSMSG = OFF /* SUPPRESS TSO COMMAND MESSAGES */ /* IF ALLOCATION FAILS TERMINATE */ IF &SAVECC NE 0 THEN + EXIT CODE(&SAVECC) END END /* DATASET EXISTS BUT NOT ALLOCATED */ ELSE + DO /* ALLOCATE FILE */ SET &SYSMSG = ON /* SHOW ANY ALLOCATION ERROR MESSAGES*/ ALLOC FILE(&FILE) + DATASET('&FQDSN') + &DISP + REUSE SET &SAVECC = &LASTCC SET &SYSMSG = OFF /* SUPPRESS TSO COMMAND MESSAGES */ /* IF ALLOCATION FAILS TERMINATE */ IF &SAVECC NE 0 THEN + EXIT CODE(&SAVECC) END END END ./ ADD NAME=ELMSETUP /* REXX ***************************************************************/ /* UTILITY: ELMSETUP */ /* AUTHOR: DAVID LEIGH */ /* FUNCTION: THIS UTILITY CONTROLS FILE TAILORING OF A JOB WHICH WILL */ /* CREATE A PROGRAMMER'S TEST DB2 ENVIRONMENT IN THIER */ /* DATABASE BASED ON SOME CRITERIA PASSED TO THIS EXEC. IF */ /* THIS EXEC DOES NOT GET EVERYTHING IT NEEDS, IT WILL POP */ /* UP A PANEL TO PROMPT FOR IT. CONSEQUENTLY IT CAN BE */ /* CALLED BY OTHER PROCESSES THAT PASS THE REQUISITE */ /* INFORMATION VIA THE ISPF SHARED PROFILE POOL. */ /* */ /* NOTE: THIS UTILITY WAS "CLONED" FROM THE DBSETUP UTILITY */ /* TO DEAL WITH ELM OBJECTS SPECIFICALLY INSTEAD OF */ /* UNISTAR. IT DOES SHARE SOME ISPF DIALOG ELEMENTS */ /* WITH DBSETUP. */ /**********************************************************************/ ADDRESS ISPEXEC "CONTROL ERRORS RETURN" USERDB = SYSVAR(SYSUID) ³³ 'DB' "SELECT PGM(USERINFO) PARM("SYSVAR(SYSUID)")" "VGET (JOBPFX DATABASE CREATOR APPLNAME", "JCLREVEW SIZEPCT TBLSDROP DBSETUP DEBUG) SHARED" IF DBSETUP = AUTO THEN DO IF JOBPFX = '' THEN JOBPFX = 'EL' IF DATABASE = '' THEN DATABASE = USERDB IF CREATOR = '' THEN CREATOR = SYSVAR(SYSUID) IF JCLREVEW = '' THEN JCLREVEW = 'Y' IF SIZEPCT = '' THEN SIZEPCT = 1 IF TBLSDROP = '' THEN TBLSDROP = 'N' "VPUT (JOBPFX DATABASE CREATOR APPLNAME", "JCLREVEW SIZEPCT TBLSDROP DBSETUP DEBUG) SHARED" END ELSE DO WHILE GENJCL ¬= 'Y' "DISPLAY PANEL(ELMSETUP)" IF RC = 8 THEN EXIT END TEMPFILE = SYSVAR(SYSUID) ³³ '.TEMP.ELMSETUP.JCL' ADDRESS TSO DUMMY = OUTTRAP('NULL.') "FREE DD(ISPFILE)" "DELETE '"TEMPFILE"'" "ALLOCATE DD(ISPFILE) DSN('"TEMPFILE"')" , "NEW CATALOG" , "UNIT(SYSDA) VOLUME(WRK$$$)" , "SPACE(1,1) TRACKS RELEASE" , "RECFM(F B) LRECL(80) DSORG(PS)" DROP NULL. ADDRESS ISPEXEC "FTOPEN" "FTINCL ELMSETUP" SAVERC = RC "FTCLOSE" ADDRESS TSO "FREE DD(ISPFILE)" IF SAVERC > 0 THEN DO ZEDLMSG = 'FILE TAILORING OF THE "ELMSETUP" SKELETON FAILED', 'WITH RC =' SAVERC "SETMSG MSG(UTLZ001W)" "EDIT DATASET('"TEMPFILE"')" END ELSE IF JCLREVEW = 'Y' THEN DO ZEDLMSG = 'YOU MUST SUBMIT THIS JCL YOURSELF' "SETMSG MSG(UTLZ000W)" "EDIT DATASET('"TEMPFILE"')" END ELSE DO ADDRESS TSO "SUBMIT '"TEMPFILE"'" ZEDLMSG = 'ELMSETUP JOB SUBMITTED' "SETMSG MSG(UTLZ000W)" END EXIT SAVERC ./ ADD NAME=ERRORDO FREE DD(TEMPDD) ALLOC DD(TEMPDD) DSN('&GOALSDSN') SHR ERROR DO SET ERRCC = &LASTCC SELECT (&ERRCC) WHEN (400) DO SET EOF = YES RETURN END OTHERWISE DO ERROR OFF WRITE *** ERROR CC: &ERRCC OCCURRED READING A FILE *** CLOSFILE TEMPDD FREE DD(TEMPDD) EXIT END END END SET SWITCH = OFF SET EOF = NO OPENFILE TEMPDD GETFILE TEMPDD DO WHILE &EOF = NO WRITE &STR(&TEMPDD) GETFILE TEMPDD END ERROR OFF CLOSFILE TEMPDD FREE DD(TEMPDD) ./ ADD NAME=ESADSN /* REXX ***************************************************************/ /* */ /**********************************************************************/ /**********************************************************************/ /* CHECK THE DEBUG PROFILE SWITCH */ /**********************************************************************/ PARSE PULL DBGSWTCH IF DBGSWTCH = '' THEN TRACE OFF ELSE TRACE DBGSWTCH /**********************************************************************/ /* LOAD THE STRINGS TO BE USED TO DO THE CHANGES */ /**********************************************************************/ 'EXECIO * DISKR STRINGS (STEM CHNGSTGS. FINIS' STRINGS = CHNGSTGS.0 DO I = 1 TO CHNGSTGS.0 PARSE VAR CHNGSTGS.I STRG1.I STRG2.I STRG1.I = STRIP(STRG1.I) LSTRG1.I = LENGTH(STRG1.I) STRG2.I = STRIP(STRG2.I) END /**********************************************************************/ /* LOAD THE LIST OF PDS'S TO PROCESS INTO A STEM ARRAY */ /**********************************************************************/ 'EXECIO * DISKR PDSLIST (STEM PDS. FINIS' /**********************************************************************/ /* MAIN PROCESSING LOOP: */ /* - ALLOCATE THE PDS VIA "LM" SERVICES */ /* - LOOP THROUGH THE DIRECTORY AND FOR EACH MEMBER: */ /* - LOOP THROUGH EACH RECORD IN THE PDS DOING: */ /* - LOOP THROUGH THE STRING STEM ARRAY AND FOR EACH OCCURANCE: */ /* - REPLACE THE 1ST STRING (IF FOUND) WITH THE 2ND STRING */ /**********************************************************************/ /*** PDS NAME LOOP ***/ DO I = 1 TO PDS.0 PDS.I = STRIP(PDS.I) QUEUE 'PROCESSING LIBRARY 'PDS.I SAY 'PROCESSING LIBRARY 'PDS.I ADDRESS ISPEXEC "LMINIT DATAID(DIDI) DATASET('"PDS.I"') ENQ(SHR)" 'LMOPEN DATAID('DIDI') OPTION(INPUT)' "LMINIT DATAID(DIDO) DATASET('"PDS.I"') ENQ(SHRW)" 'LMOPEN DATAID('DIDO') OPTION(OUTPUT)' 'LMMLIST DATAID('DIDI') OPTION(LIST) MEMBER(MBR)' /*** MEMBER NAME LOOP ***/ DO WHILE RC = 0 QUEUE 'PROCESSING MEMBER 'MBR SAY 'PROCESSING MEMBER 'MBR FOUND = 0 'LMMFIND DATAID('DIDI') MEMBER('MBR')' 'LMGET DATAID('DIDI') MODE(INVAR) DATALOC(LINE) DATALEN(LINEL) MAXLEN(80)' /*** MEMBER RECORD LOOP ***/ DO WHILE RC = 0 /*** STRING LOOP ***/ DO X = 1 TO STRINGS A = INDEX(LINE,STRG1.X) IF A > 0 THEN DO LINE = DELSTR(LINE,A,LSTRG1.X) LINE = INSERT(STRG2.X,A-1) FOUND = FOUND + 1 END END 'LMPUT DATAID('DIDO') MODE(INVAR) DATALOC(LINE) DATALEN('LENGTH(LINE)')' 'LMGET DATAID('DIDI') MODE(INVAR) DATALOC(LINE) DATALEN(LINEL) MAXLEN(80)' END IF FOUND > 0 THEN DO QUEUE '**** CHANGES MADE TO 'MBR SAY '**** CHANGES MADE TO 'MBR END 'LMMREP DATAID('DIDO') MEMBER('MBR')' 'LMMLIST DATAID('DIDI') OPTION(LIST) MEMBER(MBR)' END 'LMMLIST DATAID('DIDI') OPTION(FREE)' 'LMCLOSE DATAID('DIDI')' 'LMFREE DATAID('DIDI')' 'LMCLOSE DATAID('DIDO')' 'LMFREE DATAID('DIDO')' END /**********************************************************************/ /* WRITE THE "RESULTS" FILE FROM THE STACK */ /**********************************************************************/ ADDRESS TSO NUM_QUEUED = QUEUED() 'EXECIO ' NUM_QUEUED ' DISKW RESULTS (FINIS' EXIT /*** PDS NAME LOOP ***/ DO I = 1 TO PDS.0 PDS.I = STRIP(PDS.I) QUEUE 'PROCESSING LIBRARY 'PDS.I SAY 'PROCESSING LIBRARY 'PDS.I MEMBERS = OFF DUMMY = OUTTRAP('MBR.') "LISTDS '"PDS.I"' MEMBERS" /*** MEMBER NAME LOOP ***/ DO J = 1 TO MBR.0 IF MEMBERS = ON THEN DO MBR.J = STRIP(MBR.J) QUEUE 'PROCESSING MEMBER 'MBR.J SAY 'PROCESSING MEMBER 'MBR.J ADDRESS ISPEXEC "EDIT DATASET('"PDS.I"("MBR.J")') MACRO(ESADSNM)" IF RC = 0 THEN DO QUEUE '**** CHANGES MADE TO 'MBR.J SAY '**** CHANGES MADE TO 'MBR.J END ADDRESS TSO END IF INDEX(MBR.J,'--MEMBERS--') > 0 THEN MEMBERS = ON END END ./ ADD NAME=ESADSNM /* REXX ***************************************************************/ /* */ /**********************************************************************/ ADDRESS ISPEXEC 'CONTROL ERRORS RETURN' /**** SET MESSAGE DISPLAY ON/OFF BASED ON THE DEBUG SWITCH ***/ 'VGET (DBGSWTCH) PROFILE' IF (DBGSWTCH = 'ON') THEN TRACE ?R ELSE TRACE OFF ADDRESS ISREDIT 'MACRO (OPT)' TRACE R "CHANGE 'PTRP.P310AA.PARMLIB' 'SYS3.PLATINUM.PARMLIB' ALL" "CHANGE 'ACF2.BTICICS.PARM1' 'SYS3.ACF2.BTI.PARM1' ALL" "CHANGE 'ACF2.CICS52.ACFAMAC' 'SYS3.ACF2CICS.PROD.ACFAMAC' ALL" "CHANGE 'ACF2.CICS52.ACFAMOD' 'SYS3.ACF2CICS.PROD.ACFAMOD' ALL" "CHANGE 'ACF2.CICS52.ACFJOBS' 'SYS3.ACF2.PROD.ACFJOBS' ALL" "CHANGE 'ACF2.CICS52.ACFLC210' 'SYS3.ACF2.PROD.ACFLC210' ALL" "CHANGE 'ACF2.CICS52.ACFLC310' 'SYS3.ACF2.PROD.ACFLC310' ALL" "CHANGE 'ACF2.CICS52.ACFLOAD' 'SYS3.ACF2CICS.PROD.ACF2LOAD' ALL" "CHANGE 'ACF2.CICS52.ACFMAC' 'SYS3.ACF2CICS.PROD.ACFMAC' ALL" "CHANGE 'ACF2.CICS52.ACFPTFS' 'SYS3.ACF2.PROD.ACFPTFS' ALL" "CHANGE 'ACF2.CICS52.ACF2LOAD' 'SYS3.ACF2CICS.PROD.ACF2LOAD' ALL" "CHANGE 'ACF2.CICS52.CICSBLDS' 'SYS3.ACF2CICS.PROD.CICSBLDS' ALL" "CHANGE 'ACF2.CICS52.DISTASMS' 'SYS3.ACF2.COMMON.PROD.DISTASM' ALL" "CHANGE 'ACF2.CICS52.DISTMACS' 'SYS3.ACF2.COMMON.PROD.DISTMACS' ALL" "CHANGE 'ACF2.COMMON.BKINFO' 'SYS3.ACF2.COMMON.BKINFO' ALL" "CHANGE 'ACF2.COMMON.BKLIDS' 'SYS3.ACF2.COMMON.BKLIDS' ALL" "CHANGE 'ACF2.COMMON.BKRULES' 'SYS3.ACF2.COMMON.BKRULES' ALL" "CHANGE 'ACF2.COMMON.INFOSTG' 'SYS3.ACF2.COMMON.INFOSTG' ALL" "CHANGE 'ACF2.COMMON.LOGONIDS' 'SYS3.ACF2.COMMON.LOGONIDS' ALL" "CHANGE 'ACF2.COMMON.RULES' 'SYS3.ACF2.COMMON.RULES' ALL" "CHANGE 'ACF2.MDL1AOR1.PARM1' 'SYS3.ACF2.M1A1.PARM1' ALL" "CHANGE 'ACF2.MDL1AOR1.PARM2' 'SYS3.ACF2.M1A1.PARM2' ALL" "CHANGE 'ACF2.MDL1AOR2.PARM1' 'SYS3.ACF2.M1A2.PARM1' ALL" "CHANGE 'ACF2.MDL1AOR2.PARM2' 'SYS3.ACF2.M1A2.PARM2' ALL" "CHANGE 'ACF2.MDL1TOR1.PARM1' 'SYS3.ACF2.M1T1.PARM1' ALL" "CHANGE 'ACF2.MDL1TOR1.PARM2' 'SYS3.ACF2.M1T1.PARM2' ALL" "CHANGE 'ACF2.PRD1AOR1.PARM1' 'SYS3.ACF2.P1A1.PARM1' ALL" "CHANGE 'ACF2.PRD1AOR1.PARM2' 'SYS3.ACF2.P1A1.PARM2' ALL" "CHANGE 'ACF2.PRD1AOR2.PARM1' 'SYS3.ACF2.P1A2.PARM1' ALL" "CHANGE 'ACF2.PRD1AOR2.PARM2' 'SYS3.ACF2.P1A2.PARM2' ALL" "CHANGE 'ACF2.PRD1AOR5.PARM1' 'SYS3.ACF2.P1A5.PARM1' ALL" "CHANGE 'ACF2.PRD1AOR5.PARM2' 'SYS3.ACF2.P1A5.PARM2' ALL" "CHANGE 'ACF2.PRD1TOR1.PARM1' 'SYS3.ACF2.P1T1.PARM1' ALL" "CHANGE 'ACF2.PRD1TOR1.PARM2' 'SYS3.ACF2.P1T1.PARM2' ALL" "CHANGE 'ACF2.REMCICS.PARM1' 'SYS3.ACF2.REM.PARM1' ALL" "CHANGE 'ACF2.REMCICS.PARM2' 'SYS3.ACF2.REM.PARM2' ALL" "CHANGE 'ACF2.REMTOR.PARM1' 'SYS3.ACF2.RTOR.PARM1' ALL" "CHANGE 'ACF2.REMTOR.PARM2' 'SYS3.ACF2.RTOR.PARM2' ALL" "CHANGE 'ACF2.R52.ACFCLIST' 'SYS3.ACF2.PROD.CAICLIB' ALL" "CHANGE 'ACF2.R52.ACFHELP' 'SYS3.ACF2.PROD.ACFHELP' ALL" "CHANGE 'ACF2.R52.ACFJOBS' 'SYS3.ACF2.PROD.ACFJOBS' ALL" "CHANGE 'ACF2.R52.ACFLOAD' 'SYS3.ACF2.PROD.CAILIB' ALL" "CHANGE 'ACF2.R52.ACFMLIB' 'SYS3.ACF2.PROD.CAISPM' ALL" "CHANGE 'ACF2.R52.ACFPLIB' 'SYS3.ACF2.PROD.CAISPM' ALL" "CHANGE 'ACF2.R52.ACFPROCS' 'SYS3.ACF2.PROD.CAIPROC' ALL" "CHANGE 'ACF2.R52.ACFPTFSS' 'SYS3.ACF2.PROD.ACFPTFS' ALL" "CHANGE 'ACF2.R52.DISTASM' 'SYS3.ACF2.PROD.DISTASM' ALL" "CHANGE 'ACF2.R52.DISTMACS' 'SYS3.ACF2.PROD.DISTMACS' ALL" "CHANGE 'ACF2.TSTALT.PARM1' 'SYS3.ACF2.TALT.PARM1' ALL" "CHANGE 'ACF2.TSTALT.PARM2' 'SYS3.ACF2.TALT.PARM2' ALL" "CHANGE 'ACF2.TSTCICS.PARM1' 'SYS3.ACF2.RFP.PARM1' ALL" "CHANGE 'ACF2.TSTCICS.PARM2' 'SYS3.ACF2.RFP.PARM2' ALL" "CHANGE 'ACF2.TSTREM.PARM1' 'SYS3.ACF2.TREM.PARM1' ALL" "CHANGE 'ACF2.TSTSLS.PARM1' 'SYS3.ACF2.TSLS.PARM1' ALL" "CHANGE 'ACF2.TSTSLS.PARM2' 'SYS3.ACF2.TSLS.PARM2' ALL" "CHANGE 'ACF2.TSTTOR.PARM1' 'SYS3.ACF2.TTOR.PARM1' ALL" "CHANGE 'ACF2.TSTTOR.PARM2' 'SYS3.ACF2.TTOR.PARM2' ALL" "CHANGE 'ACF2.TST1AOR1.PARM1' 'SYS3.ACF2.T1A1.PARM1' ALL" "CHANGE 'ACF2.TST1AOR1.PARM2' 'SYS3.ACF2.T1A1.PARM2' ALL" "CHANGE 'ACF2.TST1AOR2.PARM1' 'SYS3.ACF2.T1A2.PARM1' ALL" "CHANGE 'ACF2.TST1AOR2.PARM2' 'SYS3.ACF2.T1A2.PARM2' ALL" "CHANGE 'ACF2.TST1SYS1.PARM1' 'SYS3.ACF2.T1S1.PARM1' ALL" "CHANGE 'ACF2.TST1SYS2.PARM1' 'SYS3.ACF2.T1S2.PARM1' ALL" "CHANGE 'ACF2.TST1TOR1.PARM1' 'SYS3.ACF2.T1T1.PARM1' ALL" "CHANGE 'ACF2.TST1TOR1.PARM2' 'SYS3.ACF2.T1T1.PARM2' ALL" "CHANGE 'ACF2.TST2AOR1.PARM1' 'SYS3.ACF2.T2A1.PARM1' ALL" "CHANGE 'ACF2.TST2AOR1.PARM2' 'SYS3.ACF2.T2A1.PARM2' ALL" "CHANGE 'ACF2.TST2AOR2.PARM1' 'SYS3.ACF2.T2A2.PARM1' ALL" "CHANGE 'ACF2.TST2TOR1.PARM1' 'SYS3.ACF2.T2T1.PARM1' ALL" "CHANGE 'ACF2.TST2TOR1.PARM2' 'SYS3.ACF2.T2T1.PARM2' ALL" "CHANGE 'ACF2.TTFCICS.PARM1' 'SYS3.ACF2.TTF.PARM1' ALL" "CHANGE 'ACF2.TTFCICS.PARM2' 'SYS3.ACF2.TTF.PARM2' ALL" "CHANGE 'ACF2.T3A1.PARM1' 'SYS3.ACF2.T3A1.PARM1' ALL" "CHANGE 'ACF2.T3A1.PARM2' 'SYS3.ACF2.T3A1.PARM2' ALL" "CHANGE 'ACF2.T3A2.PARM1' 'SYS3.ACF2.T3A2.PARM1' ALL" "CHANGE 'ACF2.T3A2.PARM2' 'SYS3.ACF2.T3A2.PARM2' ALL" "CHANGE 'ACF2.USCCICS.PARM1' 'SYS3.ACF2.USC.PARM1' ALL" "CHANGE 'ACF2.USCCICS.PARM2' 'SYS3.ACF2.USC.PARM2' ALL" "CHANGE 'ACF2.USCTOR.PARM1' 'SYS3.ACF2.UTOR.PARM1' ALL" "CHANGE 'ACF2.USCTOR.PARM2' 'SYS3.ACF2.UTOR.PARM2' ALL" "CHANGE 'CAI.CA1.AUDIT' 'SYS3.CA1.PROD.AUDIT' ALL" "CHANGE 'CAI.CA1.R50.CL050DLD' 'SYS3.CA1.PROD.CL050DLD' ALL" "CHANGE 'CAI.CA1.R50.CL050IMD' 'SYS3.CA1.PROD.CL050IMD' ALL" "CHANGE 'CAI.CA1.R50.CL050IPD' 'SYS3.CA1.PROD.CL050IPD' ALL" "CHANGE 'CAI.CA1.R50.CL050ISD' 'SYS3.CA1.PROD.CL050ISD' ALL" "CHANGE 'CAI.CA1.R50.CL050ITD' 'SYS3.CA1.PROD.CL050ITD' ALL" "CHANGE 'CAI.CA1.R50.CL050LLD' 'SYS3.CA1.PROD.CL050LLD' ALL" "CHANGE 'CAI.CA1.R50.CL050MLD' 'SYS3.CA1.PROD.CL050MLD' ALL" "CHANGE 'CAI.CA1.R50.CL050SLD' 'SYS3.CA1.PROD.CL050SLD' ALL" "CHANGE 'CAI.CA1.R50.DELTAS' 'SYS3.CA1.PROD.DELTAS' ALL" "CHANGE 'CAI.CA1.R50.SAMPLIB' 'SYS3.CA1.PROD.SAMPLIB' ALL" "CHANGE 'CAI.CA1.R50.USERMOD' 'SYS3.CA1.PROD.USERMOD' ALL" "CHANGE 'CAI.CA1.TMC' 'SYS3.CA1.PROD.TMC' ALL" "CHANGE 'CAI.CA1.TMSCYCLE' 'SYS3.CA1.PROD.TMSCYCLE' ALL" "CHANGE 'CAI.CA1.VAULT' 'SYS3.CA1.PROD.VAULT' ALL" "CHANGE 'CAI.CA1.VPD' 'SYS3.CA1.PROD.VPD' ALL" "CHANGE 'CAI.CA1.VPD2' 'SYS3.CA1.PROD.VPD2' ALL" "CHANGE 'CAI.CA1.VPD2.BKUP' 'SYS3.CA1.PROD.VPD2.BKUP' ALL" "CHANGE 'CAI.CA1.VPD.BKUP' 'SYS3.CA1.PROD.VPD.BKUP' ALL" "CHANGE 'CAI.CA11.COMMON.CMT' 'SYS3.CA11.PROD.CMT' ALL" "CHANGE 'CAI.CA11.COMMON.LOG' 'SYS3.CA11.COMMON.LOG' ALL" "CHANGE 'CAI.CA11.COMMON.NEW.JEHF' 'SYS3.CA11.PROD.JEHF' ALL" "CHANGE 'CAI.CA11.REORG.JEHF' 'SYS3.CA11.REORG.JEHF' ALL" "CHANGE 'CAI.CA11.R20.CL720LLD' 'SYS3.CA11.PROD.CL720LLD' ALL" "CHANGE 'CAI.CA11.R20.CL720MLD' 'SYS3.CA11.PROD.CL720MLD' ALL" "CHANGE 'CAI.CA11.R20.CL720PLD' 'SYS3.CA11.PROD.CL720PLD' ALL" "CHANGE 'CAI.CA11.R20.CL720SLD' 'SYS3.CA11.PROD.CL720SLD' ALL" "CHANGE 'CAI.CA11.R20.CL720XLD' 'SYS3.CA11.PROD.CL720XLD' ALL" "CHANGE 'CAI.CA11.R20.SAMPLIB' 'SYS3.CA11.PROD.SAMPJCL' ALL" "CHANGE 'CAI.CA7.R30.ACTQUE' 'SYS3.CA7.PROD.ACTQUE' ALL" "CHANGE 'CAI.CA7.R30.BATCHI#1' 'SYS3.CA7.PROD.BATCHI#1' ALL" "CHANGE 'CAI.CA7.R30.BATCHI#2' 'SYS3.CA7.PROD.BATCHI#2' ALL" "CHANGE 'CAI.CA7.R30.BATCHI#3' 'SYS3.CA7.PROD.BATCHI#3' ALL" "CHANGE 'CAI.CA7.R30.BATCHI#4' 'SYS3.CA7.PROD.BATCHI#4' ALL" "CHANGE 'CAI.CA7.R30.BATCHO#1' 'SYS3.CA7.PROD.BATCHO#1' ALL" "CHANGE 'CAI.CA7.R30.BATCHO#2' 'SYS3.CA7.PROD.BATCHO#2' ALL" "CHANGE 'CAI.CA7.R30.BATCHO#3' 'SYS3.CA7.PROD.BATCHO#3' ALL" "CHANGE 'CAI.CA7.R30.BATCHO#4' 'SYS3.CA7.PROD.BATCHO#4' ALL" "CHANGE 'CAI.CA7.R30.BROWSE' 'SYS3.CA7.PROD.BROWSE' ALL" "CHANGE 'CAI.CA7.R30.CKPTDS' 'SYS3.CA7.PROD.CKPTDS' ALL" "CHANGE 'CAI.CA7.R30.COMMDS' 'SYS3.CA7.PROD.COMMDS' ALL" "CHANGE 'CAI.CA7.R30.DQTQUE' 'SYS3.CA7.PROD.DQTQUE' ALL" "CHANGE 'CAI.CA7.R30.HELP' 'SYS3.CA7.PROD.HELP' ALL" "CHANGE 'CAI.CA7.R30.IDS' 'SYS3.CA7.PROD.IDS' ALL" "CHANGE 'CAI.CA7.R30.JCLLIB' 'SYS3.CA7.PROD.JCLLIB' ALL" "CHANGE 'CAI.CA7.R30.LOADLIB' 'SYS2.CA7.PROD.LOADLIB' ALL" "CHANGE 'CAI.CA7.R30.LOGP' 'SYS3.CA7.PROD.LOGP' ALL" "CHANGE 'CAI.CA7.R30.LOGS' 'SYS3.CA7.PROD.LOGS' ALL" "CHANGE 'CAI.CA7.R30.MACLIB' 'SYS3.CA7.PROD.MACLIB' ALL" "CHANGE 'CAI.CA7.R30.PREQUE' 'SYS3.CA7.PROD.PREQUE' ALL" "CHANGE 'CAI.CA7.R30.PRNQUE' 'SYS3.CA7.PROD.PRNQUE' ALL" "CHANGE 'CAI.CA7.R30.PSTQUE' 'SYS3.CA7.PROD.PSTQUE' ALL" "CHANGE 'CAI.CA7.R30.RDYQUE' 'SYS3.CA7.PROD.RDYQUE' ALL" "CHANGE 'CAI.CA7.R30.REQQUE' 'SYS3.CA7.PROD.REQQUE' ALL" "CHANGE 'CAI.CA7.R30.SASDS' 'SYS3.CA7.PROD.SASDS' ALL" "CHANGE 'CAI.CA7.R30.SASJOB' 'SYS3.CA7.PROD.SASJOB' ALL" "CHANGE 'CAI.CA7.R30.SCRQUE' 'SYS3.CA7.PROD.SCRQUE' ALL" "CHANGE 'CAI.CA7.R30.SECURITY' 'SYS3.CA7.PROD.SECURITY' ALL" "CHANGE 'CAI.CA7.R30.SOURCE' 'SYS3.CA7.PROD.SOURCE' ALL" "CHANGE 'CAI.CA7.R30.STATFILE' 'SYS3.CA7.PROD.STATFILE' ALL" "CHANGE 'CAI.CA7.R30.TRLQUE' 'SYS3.CA7.PROD.TRLQUE' ALL" "CHANGE 'CAI.CA7.R9307.SAMPJCL' 'SYS3.CA7.PROD.SAMPJCL' ALL" "CHANGE 'CAI.CA90S.SAMPJCL' 'SYS3.CAS90.PROD.SAMPLIB' ALL" "CHANGE 'CAI.COMMON.CAICICS' 'SYS3.CACOMMON.PROD.CAICICS' ALL" "CHANGE 'CAI.COMMON.CAICLIB' 'SYS3.CACOMMON.PROD.CAICLIB' ALL" "CHANGE 'CAI.COMMON.CAIISPL' 'SYS3.CACOMMON.PROD.CAIISPL' ALL" "CHANGE 'CAI.COMMON.CAIISPM' 'SYS3.CACOMMON.PROD.CAIISPM' ALL" "CHANGE 'CAI.COMMON.CAIISPP' 'SYS3.CACOMMON.PROD.CAIISPP' ALL" "CHANGE 'CAI.COMMON.CAIISPS' 'SYS3.CACOMMON.PROD.CAIISPS' ALL" "CHANGE 'CAI.COMMON.CAIISPT' 'SYS3.CACOMMON.PROD.CAIISPT' ALL" "CHANGE 'CAI.COMMON.CAIMAC' 'SYS3.CACOMMON.PROD.CAIMAC' ALL" "CHANGE 'CAI.COMMON.CAIPROC' 'SYS3.CACOMMON.PROD.CAIPROC' ALL" "CHANGE 'CAI.COMMON.CAISRC' 'SYS3.CACOMMON.PROD.CAISRC' ALL" "CHANGE 'CAI.COMMON.PPOPTION' 'SYS3.CACOMMON.PROD.PPOPTION' ALL" "CHANGE 'CAI.COMN.CIF23LLD' 'SYS3.CAS90.PROD.COMN.CIF23LLD' ALL" "CHANGE 'CAI.COMN.CIF23MLD' 'SYS3.CAS90.PROD.COMN.CIF23MLD' ALL" "CHANGE 'CAI.DU10.CDU10LLD' 'SYS3.CAS90.PROD.DU10.CDU10LLD' ALL" "CHANGE 'CAI.DU10.CDU10MLD' 'SYS3.CAS90.PROD.DU10.CDU10MLD' ALL" "CHANGE 'CAI.DU10.CDU10SLD' 'SYS3.CAS90.PROD.DU10.CDU10SLD' ALL" "CHANGE 'CAI.EARL.CEO60LLD' 'SYS3.CAS90.PROD.EO60.CEO60LLD' ALL" "CHANGE 'CAI.EARL.CEO60MLD' 'SYS3.CAS90.PROD.EO60.CEO60MLD' ALL" "CHANGE 'CAI.EARL.CEO60SLD' 'SYS3.CAS90.PROD.EO60.CEO60SLD' ALL" "CHANGE 'CAI.F330.CF330LLD' 'SYS3.CAS90.PROD.F330.CF330LLD' ALL" "CHANGE 'CAI.F330.CF330MLD' 'SYS3.CAS90.PROD.F330.CF330MLD' ALL" "CHANGE 'CAI.F330.CF330SLD' 'SYS3.CAS90.PROD.F330.CF330SLD' ALL" "CHANGE 'CAI.NETMAN.K048DB.CD' 'SYS3.NETMAN.PROD.CD' ALL" "CHANGE 'CAI.NETMAN.K048DB.CD.BACKUP' 'SYS3.NETMAN.PROD.CD.BACKUP' ALL" "CHANGE 'CAI.NETMAN.K048DB.CHANGE' 'SYS3.NETMAN.PROD.CHANGE' ALL" "CHANGE 'CAI.NETMAN.K048DB.CHANGE.BACKUP' 'SYS3.NETMAN.PROD.CHANGE.BACKUP' ALL" "CHANGE 'CAI.NETMAN.K048DB.CONFIG' 'SYS3.NETMAN.PROD.CONFIG' ALL" "CHANGE 'CAI.NETMAN.K048DB.CONFIG.BACKUP' 'SYS3.NETMAN.PROD.CONFIG.BACKUP' ALL" "CHANGE 'CAI.NETMAN.K048DB.INDEX' 'SYS3.NETMAN.PROD.INDEX' ALL" "CHANGE 'CAI.NETMAN.K048DB.INDEX.BACKUP' 'SYS3.NETMAN.PROD.INDEX.BACKUP' ALL" "CHANGE 'CAI.NETMAN.K048DB.INVOICE' 'SYS3.NETMAN.PROD.INVOICE' ALL" "CHANGE 'CAI.NETMAN.K048DB.INVOICE.BACKUP' 'SYS3.NETMAN.PROD.INVOICE.BACKUP' ALL" "CHANGE 'CAI.NETMAN.K048DB.MP' 'SYS3.NETMAN.PROD.MP' ALL" "CHANGE 'CAI.NETMAN.K048DB.MP.BACKUP' 'SYS3.NETMAN.PROD.MP.BACKUP' ALL" "CHANGE 'CAI.NETMAN.K048DB.NATVSYS' 'SYS3.NETMAN.PROD.NATVSYS' ALL" "CHANGE 'CAI.NETMAN.K048DB.NTMMGCTL' 'SYS3.NETMAN.PROD.NTMMGCTL' ALL" "CHANGE 'CAI.NETMAN.K048DB.NTMMGCTL.BACKUP' 'SYS3.NETMAN.PROD.NTMMGCTL.BACKUP' ALL" "CHANGE 'CAI.NETMAN.K048DB.NTMPI' 'SYS3.NETMAN.PROD.NTMPI' ALL" "CHANGE 'CAI.NETMAN.K048DB.NTMPI.BACKUP' 'SYS3.NETMAN.PROD.NTMPI.BACKUP' ALL" "CHANGE 'CAI.NETMAN.K048DB.NTMPM' 'SYS3.NETMAN.PROD.NTMPM' ALL" "CHANGE 'CAI.NETMAN.K048DB.NTMPM.BACKUP' 'SYS3.NETMAN.PROD.NTMPM.BACKUP' ALL" "CHANGE 'CAI.NETMAN.K048DB.OPLOG' 'SYS3.NETMAN.PROD.OPLOG' ALL" "CHANGE 'CAI.NETMAN.K048DB.OPLOG.BACKUP' 'SYS3.NETMAN.PROD.OPLOG.BACKUP' ALL" "CHANGE 'CAI.NETMAN.K048DB.PROBLEM' 'SYS3.NETMAN.PROD.PROBLEM' ALL" "CHANGE 'CAI.NETMAN.K048DB.PROBLEM.BACKUP' 'SYS3.NETMAN.PROD.PROBLEM.BACKUP' ALL" "CHANGE 'CAI.NETMAN.K048DB.SYSTEM' 'SYS3.NETMAN.PROD.SYSTEM' ALL" "CHANGE 'CAI.NETMAN.K048DB.SYSTEM.BACKUP' 'SYS3.NETMAN.PROD.SYSTEM.BACKUP' ALL" "CHANGE 'CAI.NETMAN.L09212.CK048001' 'SYS3.NETMAN.PROD.CK048001' ALL" "CHANGE 'CAI.NETMAN.L09212.CK048002' 'SYS3.NETMAN.PROD.CK048002' ALL" "CHANGE 'CAI.NETMAN.L09212.CK048003' 'SYS3.NETMAN.PROD.CK048003' ALL" "CHANGE 'CAI.NETMAN.L09212.CK048004' 'SYS3.NETMAN.PROD.CK048004' ALL" "CHANGE 'CAI.NETMAN.L09212.CK148001' 'SYS3.NETMAN.PROD.CK148001' ALL" "CHANGE 'CAI.NETMAN.L09212.CK148002' 'SYS3.NETMAN.PROD.CK148002' ALL" "CHANGE 'CAI.NETMAN.L09212.CK248001' 'SYS3.NETMAN.PROD.CK248001' ALL" "CHANGE 'CAI.NETMAN.L09212.CK248002' 'SYS3.NETMAN.PROD.CK248002' ALL" "CHANGE 'CAI.NETMAN.L09212.PTF' 'SYS3.NETMAN.PROD.PTF' ALL" "CHANGE 'CAI.NETMAN.L09212.SAMPJCL' 'SYS3.NETMAN.PROD.SAMPJCL' ALL" "CHANGE 'CAI.NETMAN.L9212.PTF' 'SYS3.NETMAN.PRD.PTF' ALL" "CHANGE 'CAI.NETMAN.R48.CONTROL' 'SYS3.NETMAN.PROD.CONTROL' ALL" "CHANGE 'CAI.PROF.CPP10LLD' 'SYS3.CAS90.PROD.PROFILE.CPP10LLD' ALL" "CHANGE 'CAI.PROFILE.CPP10LLD' 'SYS3.CA11.PROD.PROFILE.CPP10LLD' ALL" "CHANGE 'CAI.SACX.CAG23LLD' 'SYS3.CAS90.PROD.SACX.CAG23LLD' ALL" "CHANGE 'CAI.SACX.CAG23PLD' 'SYS3.CAS90.PROD.SACX.CAG23PLD' ALL" "CHANGE 'CAI.SCAM.CF623LLD' 'SYS3.CAS90.PROD.SCAM.CF623LLD' ALL" "CHANGE 'CAI.SCAM.CF623MLD' 'SYS3.CAS90.PROD.SCAM.CF623MLD' ALL" "CHANGE 'CAI.SDBS.CSP23LLD' 'SYS3.CAS90.PROD.SDBS.CSP23LLD' ALL" "CHANGE 'CAI.SDBS.CSP23MLD' 'SYS3.CAS90.PROD.SDBS.CSP23MLD' ALL" "CHANGE 'CAI.SHLP.CBS23LLD' 'SYS3.CAS90.PROD.SHLP.CBS23LLD' ALL" "CHANGE 'CAI.SHLP.CBS23MLD' 'SYS3.CAS90.PROD.SHLP.CBS23MLD' ALL" "CHANGE 'CAI.SR66.CSR66LLD' 'SYS3.CAS90.PROD.SR66.CSR66LLD' ALL" "CHANGE 'CAI.STMP.CTB23LLD' 'SYS3.CAS90.PROD.STMP.CTB23LLD' ALL" "CHANGE 'CAI.STMP.CTB23MLD' 'SYS3.CAS90.PROD.STMP.CTB23MLD' ALL" "CHANGE 'CAI.S910.CS910LLD' 'SYS3.CAS90.PROD.S910.CS910LLD' ALL" "CHANGE 'CAI.S910.CS910SLD' 'SYS3.CAS90.PROD.S910.CS910SLD' ALL" "CHANGE 'CAI.VPNT.CWC12DLD' 'SYS3.CAS90.PROD.VPNT.CWC12DLD' ALL" "CHANGE 'CAI.VPNT.CWC12LLD' 'SYS3.CAS90.PROD.VPNT.CWC12LLD' ALL" "CHANGE 'CAI.VPNT.CWC12PLD' 'SYS3.CAS90.PROD.VPNT.CWC12PLD' ALL" "CHANGE 'CAI.VPNT.CWC12TLD' 'SYS3.CAS90.PROD.VPNT.CWC12TLD' ALL" "CHANGE 'CAI.VPOINT.CHOICES' 'SYS3.CAS90.PROD.VPOINT.CHOICES' ALL" "CHANGE 'CAI.VPOINT.DIALOG' 'SYS3.CAS90.PROD.VPOINT.DIALOG' ALL" "CHANGE 'CAI.VPOINT.HELP' 'SYS3.CAS90.PROD.VPOINT.HELP' ALL" "CHANGE 'CAI.VPOINT.MESSAGE' 'SYS3.CAS90.PROD.VPOINT.MESSAGE' ALL" "CHANGE 'CAI.VPOINT.PANEL' 'SYS3.CAS90.PROD.VPOINT.PANEL' ALL" "CHANGE 'CAI.VPOINT.SQL' 'SYS3.CAS90.PROD.VPOINT.SQL' ALL" "CHANGE 'CAI.VPOINT.TEMPLATE' 'SYS3.CAS90.PROD.VPOINT.TEMPLATE' ALL" "CHANGE 'CAI.WU40.CWU40LLD' 'SYS3.CAS90.PROD.WU40.CWU40LLD' ALL" "CHANGE 'CAI.WU40.CWU40MLD' 'SYS3.CAS90.PROD.WU40.CWU40MLD' ALL" "CHANGE 'CAI.WU40.CWU40SLD' 'SYS3.CAS90.PROD.WU40.CWU40SLD' ALL" "CHANGE 'CAI.W110.CW110LLD' 'SYS3.CAS90.PROD.W110.CW110LLD' ALL" "CHANGE 'CAI.W110.CW110SLD' 'SYS3.CAS90.PROD.W110.CW110SLD' ALL" "CHANGE 'CANDLE.COMMON.ASACOBM' 'SYS3.OMEGDB2.COMMON.ASACOBM' ALL" "CHANGE 'CANDLE.COMMON.ASACOMM' 'SYS3.OMEGDB2.COMMON.ASACOMM' ALL" "CHANGE 'CANDLE.COMMON.ASACOSM' 'SYS3.OMEGDB2.COMMON.ASACOSM' ALL" "CHANGE 'CANDLE.COMMON.ASACTRN' 'SYS3.OMEGDB2.COMMON.ASACTRN' ALL" "CHANGE 'CANDLE.COMMON.DCISRC' 'SYS3.OMEGDB2.COMMON.DCISRC' ALL" "CHANGE 'CANDLE.COMMON.DCNCUST' 'SYS3.OMEGDB2.COMMON.DCNCUST' ALL" "CHANGE 'CANDLE.COMMON.DCNLOAD' 'SYS3.OMEGDB2.COMMON.DCNLOAD' ALL" "CHANGE 'CANDLE.COMMON.DCNSAMP' 'SYS3.OMEGDB2.COMMON.DCNSAMP' ALL" "CHANGE 'CANDLE.COMMON.DEBIPNL' 'SYS3.OMEGDB2.COMMON.DEBIPNL' ALL" "CHANGE 'CANDLE.COMMON.DEBLOAD' 'SYS3.OMEGDB2.COMMON.DEBLOAD' ALL" "CHANGE 'CANDLE.COMMON.DETLOAD' 'SYS3.OMEGDB2.COMMON.DETLOAD' ALL" "CHANGE 'CANDLE.COMMON.DETSAMP' 'SYS3.OMEGDB2.COMMON.DETSAMP' ALL" "CHANGE 'CANDLE.COMMON.DGMACLIB' 'SYS3.OMEGDB2.COMMON.DGMACLIB' ALL" "CHANGE 'CANDLE.COMMON.DIALOAD' 'SYS3.OMEGDB2.COMMON.DIALOAD' ALL" "CHANGE 'CANDLE.COMMON.DJIDATA' 'SYS3.OMEGDB2.COMMON.DJIDATA' ALL" "CHANGE 'CANDLE.COMMON.DJILOAD' 'SYS3.OMEGDB2.COMMON.DJILOAD' ALL" "CHANGE 'CANDLE.COMMON.DLELOAD' 'SYS3.OMEGDB2.COMMON.DLELOAD' ALL" "CHANGE 'CANDLE.COMMON.DLULOAD' 'SYS3.OMEGDB2.COMMON.DLULOAD' ALL" "CHANGE 'CANDLE.COMMON.DLVCMDS' 'SYS3.OMEGDB2.COMMON.DLVCMDS' ALL" "CHANGE 'CANDLE.COMMON.DLVCUST' 'SYS3.OMEGDB2.COMMON.DLVCUST' ALL" "CHANGE 'CANDLE.COMMON.DLVGMAC' 'SYS3.OMEGDB2.COMMON.DLVGMAC' ALL" "CHANGE 'CANDLE.COMMON.DLVHPENU' 'SYS3.OMEGDB2.COMMON.DLVHPENU' ALL" "CHANGE 'CANDLE.COMMON.DLVLOAD' 'SYS3.OMEGDB2.COMMON.DLVLOAD' ALL" "CHANGE 'CANDLE.COMMON.DLVPARM' 'SYS3.OMEGDB2.COMMON.DLVPARM' ALL" "CHANGE 'CANDLE.COMMON.DLVPNENU' 'SYS3.OMEGDB2.COMMON.DLVPNENU' ALL" "CHANGE 'CANDLE.COMMON.DLVSPENU' 'SYS3.OMEGDB2.COMMON.DLVSPENU' ALL" "CHANGE 'CANDLE.COMMON.DOBHELP' 'SYS3.OMEGDB2.COMMON.DOBHELP' ALL" "CHANGE 'CANDLE.COMMON.DOBLOAD' 'SYS3.OMEGDB2.COMMON.DOBLOAD' ALL" "CHANGE 'CANDLE.COMMON.DOBSAMP' 'SYS3.OMEGDB2.COMMON.DOBSAMP' ALL" "CHANGE 'CANDLE.COMMON.DSDLOAD' 'SYS3.OMEGDB2.COMMON.DSDLOAD' ALL" "CHANGE 'CANDLE.COMMON.DSDPNENU' 'SYS3.OMEGDB2.COMMON.DSDPNENU' ALL" "CHANGE 'CANDLE.COMMON.RLVCMDS' 'SYS3.OMEGDB2.COMMON.RLVCMDS' ALL" "CHANGE 'CANDLE.COMMON.RLVPARM' 'SYS3.OMEGDB2.COMMON.RLVPARM' ALL" "CHANGE 'CANDLE.COMMON.RLVPNENU' 'SYS3.OMEGDB2.COMMON.RLVPNENU' ALL" "CHANGE 'CANDLE.COMMON.RLVSPENU' 'SYS3.OMEGDB2.COMMON.RLVSPENU' ALL" "CHANGE 'CANDLE.COMMON.TCISRC' 'SYS3.OMEGDB2.COMMON.TCISRC' ALL" "CHANGE 'CANDLE.COMMON.TCNCUST' 'SYS3.OMEGDB2.COMMON.TCNCUST' ALL" "CHANGE 'CANDLE.COMMON.TCNLOAD' 'SYS3.OMEGDB2.COMMON.TCNLOAD' ALL" "CHANGE 'CANDLE.COMMON.TCNSAMP' 'SYS3.OMEGDB2.COMMON.TCNSAMP' ALL" "CHANGE 'CANDLE.COMMON.TEBIPNL' 'SYS3.OMEGDB2.COMMON.TEBIPNL' ALL" "CHANGE 'CANDLE.COMMON.TETLOAD' 'SYS3.OMEGDB2.COMMON.TETLOAD' ALL" "CHANGE 'CANDLE.COMMON.TETSAMP' 'SYS3.OMEGDB2.COMMON.TETSAMP' ALL" "CHANGE 'CANDLE.COMMON.TGMACLIB' 'SYS3.OMEGDB2.COMMON.TGMACLIB' ALL" "CHANGE 'CANDLE.COMMON.TJIDATA' 'SYS3.OMEGDB2.COMMON.TJIDATA' ALL" "CHANGE 'CANDLE.COMMON.TLOADLIB' 'SYS3.OMEGDB2.COMMON.TLOADLIB' ALL" "CHANGE 'CANDLE.COMMON.TLVCMDS' 'SYS3.OMEGDB2.COMMON.TLVCMDS' ALL" "CHANGE 'CANDLE.COMMON.TLVHPENU' 'SYS3.OMEGDB2.COMMON.TLVHPENU' ALL" "CHANGE 'CANDLE.COMMON.TLVLOAD' 'SYS3.OMEGDB2.COMMON.TLVLOAD' ALL" "CHANGE 'CANDLE.COMMON.TLVPARM' 'SYS3.OMEGDB2.COMMON.TLVPARM' ALL" "CHANGE 'CANDLE.COMMON.TLVPNENU' 'SYS3.OMEGDB2.COMMON.TLVPNENU' ALL" "CHANGE 'CANDLE.COMMON.TLVSPENU' 'SYS3.OMEGDB2.COMMON.TLVSPENU' ALL" "CHANGE 'CANDLE.COMMON.TOBHELP' 'SYS3.OMEGDB2.COMMON.TOBHELP' ALL" "CHANGE 'CANDLE.COMMON.TOBSAMP' 'SYS3.OMEGDB2.COMMON.TOBSAMP' ALL" "CHANGE 'CANDLE.COMMON.TSDLOAD' 'SYS3.OMEGDB2.COMMON.TSDLOAD' ALL" "CHANGE 'CANDLE.COMMON.TSDPNENU' 'SYS3.OMEGDB2.COMMON.TSDPNENU' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.DD2HPENU' 'SYS3.OMEGDB2.DD2HPENU' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.DD2PNENU' 'SYS3.OMEGDB2.DD2PNENU' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.DOCFILE' 'SYS3.OMEGDB2.DOCFILE' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.DO2CHART' 'SYS3.OMEGDB2.DO2CHART' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.DO2CLIST' 'SYS3.OMEGDB2.DO2CLIST' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.DO2DBRM' 'SYS3.OMEGDB2.DO2DBRM' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.DO2DOC' 'SYS3.OMEGDB2.DO2DOC' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.DO2HELP' 'SYS3.OMEGDB2.DO2HELP' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.DO2IMSG' 'SYS3.OMEGDB2.DO2IMSG' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.DO2IPNL' 'SYS3.OMEGDB2.DO2IPNL' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.DO2ISKL' 'SYS3.OMEGDB2.DO2ISKL' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.DO2LOAD' 'SYS3.OMEGDB2.DO2LOAD' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.DO2MSGS' 'SYS3.OMEGDB2.DO2MSGS' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.DO2MSGS' 'SYS3.OMEGDB2.DO2MSGS' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.DO2PROC' 'SYS3.OMEGDB2.DO2PROC' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.DO2PROC' 'SYS3.OMEGDB2.DO2PROC' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.DO2SAMP' 'SYS3.OMEGDB2.DO2SAMP' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.DO2SAMP' 'SYS3.OMEGDB2.DO2SAMP' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.DO2SPCH1' 'SYS3.OMEGDB2.DO2SPCH1' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.DO2SPFR1' 'SYS3.OMEGDB2.DO2SPFR1' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.DO2SPPR1' 'SYS3.OMEGDB2.DO2SPPR1' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.DO2SPQR1' 'SYS3.OMEGDB2.DO2SPQR1' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.DO2SPSAS' 'SYS3.OMEGDB2.DO2SPSAS' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.DO2SPSPU' 'SYS3.OMEGDB2.DO2SPSPU' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.INSTLIB' 'SYS3.OMEGDB2.INSTLIB' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.PROCSAVE' 'SYS3.OMEGDB2.PROCSAVE' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.PROFSAVE' 'SYS3.OMEGDB2.PROFSAVE' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.RO2JCL' 'SYS3.OMEGDB2.RO2JCL' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.RO2PARM' 'SYS3.OMEGDB2.RO2PARM' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.SNAP' 'SYS3.OMEGDB2.SNAP' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.TD2HPENU' 'SYS3.OMEGDB2.TD2HPENU' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.TD2PNENU' 'SYS3.OMEGDB2.TD2PNENU' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.TLOADLIB' 'SYS3.OMEGDB2.TLOADLIB' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.TO2CHART' 'SYS3.OMEGDB2.TO2CHART' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.TO2CLIST' 'SYS3.OMEGDB2.TO2CLIST' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.TO2DBRM' 'SYS3.OMEGDB2.TO2DBRM' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.TO2DOC' 'SYS3.OMEGDB2.TO2DOC' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.TO2HELP' 'SYS3.OMEGDB2.TO2HELP' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.TO2IMSG' 'SYS3.OMEGDB2.TO2IMSG' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.TO2IPNL' 'SYS3.OMEGDB2.TO2IPNL' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.TO2ISKL' 'SYS3.OMEGDB2.TO2ISKL' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.TO2MSGS' 'SYS3.OMEGDB2.TO2MSGS' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.TO2PROC' 'SYS3.OMEGDB2.TO2PROC' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.TO2SAMP' 'SYS3.OMEGDB2.TO2SAMP' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.TO2SPCH1' 'SYS3.OMEGDB2.TO2SPCH1' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.TO2SPFR1' 'SYS3.OMEGDB2.TO2SPFR1' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.TO2SPPR1' 'SYS3.OMEGDB2.TO2SPPR1' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.TO2SPQR1' 'SYS3.OMEGDB2.TO2SPQR1' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.TO2SPSAS' 'SYS3.OMEGDB2.TO2SPSAS' ALL" "CHANGE 'CANDLE.OMEGDB2.V260.TO2SPSPU' 'SYS3.OMEGDB2.TO2SPSPU' ALL" "CHANGE 'CA7.COMMON.DMPQUE' 'SYS3.CA7.PROD.DMPQUE' ALL" "CHANGE 'CA7.COMMON.LOGON1' 'SYS3.CA7.PROD.LOGON1' ALL" "CHANGE 'CA7.COMMON.LOGON2' 'SYS3.CA7.PROD.LOGON2' ALL" "CHANGE 'CA7.COMMON.PASSWORD' 'SYS3.CA7.PROD.PASSWORD' ALL" "CHANGE 'CEMT.COMMON.BATCH.CONTROL' 'SYS3.CEMT.PROD.BATCH.CONTROL' ALL" "CHANGE 'CEMT.COMMON.DSNT.BATCH.CONTROL' 'SYS3.CEMT.PROD.DSNT.BATCH.CONTROL' ALL" "CHANGE 'CEMT.TST.BATCH.CONTROL' 'SYS3.CEMT.TST.BATCH.CONTROL' ALL" "CHANGE 'CEMT.V4R7M0.LOADLIB' 'SYS3.CEMT.PROD.LOADLIB' ALL" "CHANGE 'CEMT.V4R7M0.SOURCE' 'SYS3.CEMT.PROD.SOURCE' ALL" "CHANGE 'COMPAREX.V7R1M2.IFACE' 'SYS3.COMPAREX.PROD.IFACE' ALL" "CHANGE 'COMPAREX.V7R1M2.ISPCLIB' 'SYS3.COMPAREX.PROD.CLIST' ALL" "CHANGE 'COMPAREX.V7R1M2.ISPLLIB' 'SYS3.COMPAREX.PROD.LOADLIB' ALL" "CHANGE 'COMPAREX.V7R1M2.ISPMLIB' 'SYS3.COMPAREX.PROD.MSGS' ALL" "CHANGE 'COMPAREX.V7R1M2.ISPPLIB' 'SYS3.COMPAREX.PROD.PANELS' ALL" "CHANGE 'COMPAREX.V7R1M2.ISPTLIB' 'SYS3.COMPAREX.PROD.TABLES' ALL" "CHANGE 'COMPAREX.V7R1M2.LOADLIB' 'SYS3.COMPAREX.PROD.LOADLIB' ALL" "CHANGE 'COMPAREX.V7R1M2.SYSGEN' 'SYS3.COMPAREX.PROD.SYSGEN' ALL" "CHANGE 'DMS.R81.AHELP' 'SYS3.DMS.PROD.AHELP' ALL" "CHANGE 'DMS.R81.AISPMLIB' 'SYS3.DMS.PROD.AISPMLIB' ALL" "CHANGE 'DMS.R81.AISPPLIB' 'SYS3.DMS.PROD.AISPPLIB' ALL" "CHANGE 'DMS.R81.AISPSLIB' 'SYS3.DMS.PROD.AISPSLIB' ALL" "CHANGE 'DMS.R81.ALOADLIB' 'SYS3.DMS.PROD.ALOADLIB' ALL" "CHANGE 'DMS.R81.AMACLIB' 'SYS3.DMS.PROD.AMACLIB' ALL" "CHANGE 'DMS.R81.APARMLIB' 'SYS3.DMS.PROD.APARMLIB' ALL" "CHANGE 'DMS.R81.APROCLIB' 'SYS3.DMS.PROD.APROCLIB' ALL" "CHANGE 'DMS.R81.DOCLIB' 'SYS3.DMS.PROD.DOCLIB' ALL" "CHANGE 'DMS.R81.FILES' 'SYS3.DMS.PROD.FILES' ALL" "CHANGE 'DMS.R81.FILESU1' 'SYS3.DMS.MAINT.FILES' ALL" "CHANGE 'DMS.R81.INSTALL' 'SYS3.DMS.PROD.INSTALL' ALL" "CHANGE 'DMS.R81.ISPMLIB' 'SYS3.DMS.PROD.ISPMLIB' ALL" "CHANGE 'DMS.R81.ISPPLIB' 'SYS3.DMS.PROD.ISPPLIB' ALL" "CHANGE 'DMS.R81.ISPSLIB' 'SYS3.DMS.PROD.ISPSLIB' ALL" "CHANGE 'DMS.R81.LOADLIB' 'SYS3.DMS.PROD.LOADLIB' ALL" "CHANGE 'DMS.R81.MACLIB' 'SYS3.DMS.PROD.MACLIB' ALL" "CHANGE 'DMS.R81.PARMLIB' 'SYS3.DMS.PROD.PARMLIB' ALL" "CHANGE 'DMS.R81.PMRSUMRY' 'SYS3.DMS.PROD.PMRSUMRY' ALL" "CHANGE 'DMS.R81.PROCLIB' 'SYS3.DMS.PROD.PROCLIB' ALL" "CHANGE 'DMS.R81.USERMODS' 'SYS3.DMS.PROD.USERMODS' ALL" "CHANGE 'DMS.R810.INSTALL' 'SYS3.DMS.MAINT.INSTALL' ALL" "CHANGE 'DSN.V2R3M0.CNTL' 'SYS4.DSN.CNTL' ALL" "CHANGE 'DSN.V2R3M0.DBRMLIB.DATA' 'SYS4.DSN.DBRMLIB.DATA' ALL" "CHANGE 'DSN.V2R3M0.DOCLIB' 'SYS4.DSN.DOCLIB' ALL" "CHANGE 'DSN.V2R3M0.DSNALOAD' 'SYS4.DSN.DSNALOAD' ALL" "CHANGE 'DSN.V2R3M0.DSNAMACS' 'SYS4.DSN.DSNAMACS' ALL" "CHANGE 'DSN.V2R3M0.DSNCLIST' 'SYS4.DSN.DSNCLIST' ALL" "CHANGE 'DSN.V2R3M0.DSNEXIT' 'SYS2.DSN.DSNEXIT' ALL" "CHANGE 'DSN.V2R3M0.DSNLOAD' 'SYS4.DSN.DSNLOAD' ALL" "CHANGE 'DSN.V2R3M0.DSNMACS' 'SYS4.DSN.DSNMACS' ALL" "CHANGE 'DSN.V2R3M0.DSNP.DBRMLIB.DATA' 'SYS4.DSN.DSNS.DBRMLIB.DATA' ALL" "CHANGE 'DSN.V2R3M0.DSNP.DSNEXIT' 'SYS4.DSN.DSNP.DSNEXIT' ALL" "CHANGE 'DSN.V2R3M0.DSNP.DSNLOAD' 'SYS4.DSN.DSNP.DSNLOAD' ALL" "CHANGE 'DSN.V2R3M0.DSNP.DSNSAMP' 'SYS4.DSN.DSNP.DSNSAMP' ALL" "CHANGE 'DSN.V2R3M0.DSNP.DSNTEMP' 'SYS4.DSN.DSNP.DSNTEMP' ALL" "CHANGE 'DSN.V2R3M0.DSNP.DSN8UNLD.SYSPUNCH' 'SYS4.DSN.DSNP.DSN8UNLD.SYSPUNCH' ALL" "CHANGE 'DSN.V2R3M0.DSNP.DSN8UNLD.SYSREC00' 'SYS4.DSN.DSNP.DSN8UNLD.SYSREC00' ALL" "CHANGE 'DSN.V2R3M0.DSNP.DSN8UNLD.SYSREC01' 'SYS4.DSN.DSNP.DSN8UNLD.SYSREC01' ALL" "CHANGE 'DSN.V2R3M0.DSNP.RUNLIB.LOAD' 'SYS4.DSN.DSNP.RUNLIB.LOAD' ALL" "CHANGE 'DSN.V2R3M0.DSNP.SRCLIB.DATA' 'SYS4.DSN.DSNP.SRCLIB.DATA' ALL" "CHANGE 'DSN.V2R3M0.DSNS.DSNEXIT' 'SYS4.DSN.DSNS.DSNEXIT' ALL" "CHANGE 'DSN.V2R3M0.DSNS.DSNLOAD' 'SYS4.DSN.DSNS.DSNLOAD' ALL" "CHANGE 'DSN.V2R3M0.DSNS.DSNSAMP' 'SYS4.DSN.DSNS.DSNSAMP' ALL" "CHANGE 'DSN.V2R3M0.DSNS.DSNTEMP' 'SYS4.DSN.DSNS.DSNTEMP' ALL" "CHANGE 'DSN.V2R3M0.DSNS.RUNLIB.LOAD' 'SYS4.DSN.DSNS.RUNLIB.LOAD' ALL" "CHANGE 'DSN.V2R3M0.DSNS.SRCLIB.DATA' 'SYS4.DSN.DSNS.SRCLIB.DATA' ALL" "CHANGE 'DSN.V2R3M0.DSNSAMP' 'SYS4.DSN.DSNSAMP' ALL" "CHANGE 'DSN.V2R3M0.DSNSPFM' 'SYS4.DSN.DSNSPFM' ALL" "CHANGE 'DSN.V2R3M0.DSNSPFP' 'SYS4.DSN.DSNSPFP' ALL" "CHANGE 'DSN.V2R3M0.DSNT.DBRMLIB.DATA' 'SYS4.DSN.DSNT.DBRMLIB.DATA' ALL" "CHANGE 'DSN.V2R3M0.DSNT.DSNEXIT' 'SYS4.DSN.DSNT.DSNEXIT' ALL" "CHANGE 'DSN.V2R3M0.DSNT.DSNLOAD' 'SYS4.DSN.DSNT.DSNLOAD' ALL" "CHANGE 'DSN.V2R3M0.DSNT.DSNSAMP' 'SYS4.DSN.DSNT.DSNSAMP' ALL" "CHANGE 'DSN.V2R3M0.DSNT.DSNTEMP' 'SYS4.DSN.DSNT.DSNTEMP' ALL" "CHANGE 'DSN.V2R3M0.DSNT.DSN8UNLD.SYSPUNCH' 'SYS4.DSN.DSNT.DSN8UNLD.SYSPUNCH' ALL" "CHANGE 'DSN.V2R3M0.DSNT.DSN8UNLD.SYSREC00' 'SYS4.DSN.DSNT.DSN8UNLD.SYSREC00' ALL" "CHANGE 'DSN.V2R3M0.DSNT.DSN8UNLD.SYSREC01' 'SYS4.DSN.DSNT.DSN8UNLD.SYSREC01' ALL" "CHANGE 'DSN.V2R3M0.DSNT.RUNLIB.LOAD' 'SYS4.DSN.DSNT.RUNLIB.LOAD' ALL" "CHANGE 'DSN.V2R3M0.HLDS' 'SYS4.DSN.HLDS' ALL" "CHANGE 'DSN.V2R3M0.MTS' 'SYS4.DSN.MTS' ALL" "CHANGE 'DSN.V2R3M0.PGMDIR' 'SYS4.DSN.PGMDIR' ALL" "CHANGE 'DSN.V2R3M0.PTS' 'SYS4.DSN.PTS' ALL" "CHANGE 'DSN.V2R3M0.RIMLIB' 'SYS4.DSN.RIMLIB' ALL" "CHANGE 'DSN.V2R3M0.RUNLIB.LOAD' 'SYS4.DSN.RUNLIB.LOAD' ALL" "CHANGE 'DSN.V2R3M0.SCDS' 'SYS4.DSN.SCDS' ALL" "CHANGE 'DSN.V2R3M0.SRCLIB.DATA' 'SYS4.DSN.SRCLIB.DATA' ALL" "CHANGE 'DSN.V2R3M0.STS' 'SYS4.DSN.STS' ALL" "CHANGE 'EDC.V2R1M0.AEDCLIBO' 'SYS1.EDC.V2R1M0.AEDCLIBO' ALL" "CHANGE 'EDC.V2R1M0.AEDCSRC1' 'SYS1.EDC.V2R1M0.AEDCSRC1' ALL" "CHANGE 'EDC.V2R1M0.AEDCSRC4' 'SYS1.EDC.V2R1M0.AEDCSRC4' ALL" "CHANGE 'EDC.V2R1M0.AEDCSTBS' 'SYS1.EDC.V2R1M0.AEDCSTBS' ALL" "CHANGE 'EDC.V2R1M0.SEDCBASE' 'SYS1.EDC.V2R1M0.SEDCBASE' ALL" "CHANGE 'EDC.V2R1M0.SEDCCOBJ' 'SYS1.EDC.V2R1M0.SEDCCOBJ' ALL" "CHANGE 'EDC.V2R1M0.SEDCCOMP' 'SYS1.EDC.V2R1M0.SEDCCOMP' ALL" "CHANGE 'EDC.V2R1M0.SEDCLINK' 'SYS1.EDC.V2R1M0.SEDCLINK' ALL" "CHANGE 'EDC.V2R1M0.SEDCLIST' 'SYS1.EDC.V2R1M0.SEDCLIST' ALL" "CHANGE 'EDC.V2R1M0.SEDCLOCL' 'SYS1.EDC.V2R1M0.SEDCLOCL' ALL" "CHANGE 'EDC.V2R1M0.SEDCMCLB' 'SYS1.EDC.V2R1M0.SEDCMCLB' ALL" "CHANGE 'EDC.V2R1M0.SEDCMSGS' 'SYS1.EDC.V2R1M0.SEDCMSGS' ALL" "CHANGE 'EDC.V2R1M0.SEDCSPC' 'SYS1.EDC.V2R1M0.SEDCSPC' ALL" "CHANGE 'ENDMVS.CSP.CONLIB' 'SYS3.ENDMVS.PROD.CSP.CONLIB' ALL" "CHANGE 'ENDMVS.CSP.ISPMLIB' 'SYS3.ENDMVS.PROD.CSP.ISPMLIB' ALL" "CHANGE 'ENDMVS.CSP.ISPPLIB' 'SYS3.ENDMVS.PROD.CSP.ISPPLIB' ALL" "CHANGE 'ENDMVS.CSP.ISPSLIB' 'SYS3.ENDMVS.PROD.CSP.ISPSLIB' ALL" "CHANGE 'ENDMVS.CSP.ISRCLIB' 'SYS3.ENDMVS.PROD.CSP.ISRCLIB' ALL" "CHANGE 'ENDMVS.DEMOINST' 'SYS3.ENDMVS.PROD.DEMOINST' ALL" "CHANGE 'ENDMVS.DEMOPROD.CLISTLIB' 'SYS3.ENDMVS.PROD.DEMOPROD.CLISTLIB' ALL" "CHANGE 'ENDMVS.DEMOPROD.COPYLIB' 'SYS3.ENDMVS.PROD.DEMOPROD.COPYLIB' ALL" "CHANGE 'ENDMVS.DEMOPROD.DBRMLIB' 'SYS3.ENDMVS.PROD.DEMOPROD.DBRMLIB' ALL" "CHANGE 'ENDMVS.DEMOPROD.DELTA' 'SYS3.ENDMVS.PROD.DEMOPROD.DELTA' ALL" "CHANGE 'ENDMVS.DEMOPROD.IMPACT' 'SYS3.ENDMVS.PROD.DEMOPROD.IMPACT' ALL" "CHANGE 'ENDMVS.DEMOPROD.JCLLIB' 'SYS3.ENDMVS.PROD.DEMOPROD.JCLLIB' ALL" "CHANGE 'ENDMVS.DEMOPROD.LINKLIB' 'SYS3.ENDMVS.PROD.DEMOPROD.LINKLIB' ALL" "CHANGE 'ENDMVS.DEMOPROD.LISTLIB' 'SYS3.ENDMVS.PROD.DEMOPROD.LISTLIB' ALL" "CHANGE 'ENDMVS.DEMOPROD.LOADLIB' 'SYS3.ENDMVS.PROD.DEMOPROD.LOADLIB' ALL" "CHANGE 'ENDMVS.DEMOPROD.MCF' 'SYS3.ENDMVS.PROD.DEMOPROD.MCF' ALL" "CHANGE 'ENDMVS.DEMOPROD.MSL' 'SYS3.ENDMVS.PROD.DEMOPROD.MSL' ALL" "CHANGE 'ENDMVS.DEMOPROD.OBJLIB' 'SYS3.ENDMVS.PROD.DEMOPROD.OBJLIB' ALL" "CHANGE 'ENDMVS.DEMOPROD.PARMLIB' 'SYS3.ENDMVS.PROD.DEMOPROD.PARMLIB' ALL" "CHANGE 'ENDMVS.DEMOPROD.PRCSLOAD' 'SYS3.ENDMVS.PROD.DEMOPROD.PRCSLOAD' ALL" "CHANGE 'ENDMVS.DEMOPROD.PROCLIB' 'SYS3.ENDMVS.PROD.DEMOPROD.PROCLIB' ALL" "CHANGE 'ENDMVS.DEMOPROD.SRCLIB' 'SYS3.ENDMVS.PROD.DEMOPROD.SRCLIB' ALL" "CHANGE 'ENDMVS.DEMOQA.CLISTLIB' 'SYS3.ENDMVS.PROD.DEMOQA.CLISTLIB' ALL" "CHANGE 'ENDMVS.DEMOQA.COPYLIB' 'SYS3.ENDMVS.PROD.DEMOQA.COPYLIB' ALL" "CHANGE 'ENDMVS.DEMOQA.DBRMLIB' 'SYS3.ENDMVS.PROD.DEMOQA.DBRMLIB' ALL" "CHANGE 'ENDMVS.DEMOQA.DELTA' 'SYS3.ENDMVS.PROD.DEMOQA.DELTA' ALL" "CHANGE 'ENDMVS.DEMOQA.IMPACT' 'SYS3.ENDMVS.PROD.DEMOQA.IMPACT' ALL" "CHANGE 'ENDMVS.DEMOQA.JCLLIB' 'SYS3.ENDMVS.PROD.DEMOQA.JCLLIB' ALL" "CHANGE 'ENDMVS.DEMOQA.LINKLIB' 'SYS3.ENDMVS.PROD.DEMOQA.LINKLIB' ALL" "CHANGE 'ENDMVS.DEMOQA.LISTLIB' 'SYS3.ENDMVS.PROD.DEMOQA.LISTLIB' ALL" "CHANGE 'ENDMVS.DEMOQA.LOADLIB' 'SYS3.ENDMVS.PROD.DEMOQA.LOADLIB' ALL" "CHANGE 'ENDMVS.DEMOQA.MCF' 'SYS3.ENDMVS.PROD.DEMOQA.MCF' ALL" "CHANGE 'ENDMVS.DEMOQA.MSL' 'SYS3.ENDMVS.PROD.DEMOQA.MSL' ALL" "CHANGE 'ENDMVS.DEMOQA.OBJLIB' 'SYS3.ENDMVS.PROD.DEMOQA.OBJLIB' ALL" "CHANGE 'ENDMVS.DEMOQA.PARMLIB' 'SYS3.ENDMVS.PROD.DEMOQA.PARMLIB' ALL" "CHANGE 'ENDMVS.DEMOQA.PRCSLOAD' 'SYS3.ENDMVS.PROD.DEMOQA.PRCSLOAD' ALL" "CHANGE 'ENDMVS.DEMOQA.PROCLIB' 'SYS3.ENDMVS.PROD.DEMOQA.PROCLIB' ALL" "CHANGE 'ENDMVS.DEMOQA.SRCLIB' 'SYS3.ENDMVS.PROD.DEMOQA.SRCLIB' ALL" "CHANGE 'ENDMVS.DEMOQF.CLISTLIB' 'SYS3.ENDMVS.PROD.DEMOQF.CLISTLIB' ALL" "CHANGE 'ENDMVS.DEMOQF.COPYLIB' 'SYS3.ENDMVS.PROD.DEMOQF.COPYLIB' ALL" "CHANGE 'ENDMVS.DEMOQF.DBRMLIB' 'SYS3.ENDMVS.PROD.DEMOQF.DBRMLIB' ALL" "CHANGE 'ENDMVS.DEMOQF.DELTA' 'SYS3.ENDMVS.PROD.DEMOQF.DELTA' ALL" "CHANGE 'ENDMVS.DEMOQF.IMPACT' 'SYS3.ENDMVS.PROD.DEMOQF.IMPACT' ALL" "CHANGE 'ENDMVS.DEMOQF.JCLLIB' 'SYS3.ENDMVS.PROD.DEMOQF.JCLLIB' ALL" "CHANGE 'ENDMVS.DEMOQF.LINKLIB' 'SYS3.ENDMVS.PROD.DEMOQF.LINKLIB' ALL" "CHANGE 'ENDMVS.DEMOQF.LISTLIB' 'SYS3.ENDMVS.PROD.DEMOQF.LISTLIB' ALL" "CHANGE 'ENDMVS.DEMOQF.LOADLIB' 'SYS3.ENDMVS.PROD.DEMOQF.LOADLIB' ALL" "CHANGE 'ENDMVS.DEMOQF.MCF' 'SYS3.ENDMVS.PROD.DEMOQF.MCF' ALL" "CHANGE 'ENDMVS.DEMOQF.MSL' 'SYS3.ENDMVS.PROD.DEMOQF.MSL' ALL" "CHANGE 'ENDMVS.DEMOQF.OBJLIB' 'SYS3.ENDMVS.PROD.DEMOQF.OBJLIB' ALL" "CHANGE 'ENDMVS.DEMOQF.PARMLIB' 'SYS3.ENDMVS.PROD.DEMOQF.PARMLIB' ALL" "CHANGE 'ENDMVS.DEMOQF.PRCSLOAD' 'SYS3.ENDMVS.PROD.DEMOQF.PRCSLOAD' ALL" "CHANGE 'ENDMVS.DEMOQF.PROCLIB' 'SYS3.ENDMVS.PROD.DEMOQF.PROCLIB' ALL" "CHANGE 'ENDMVS.DEMOQF.SRCLIB' 'SYS3.ENDMVS.PROD.DEMOQF.SRCLIB' ALL" "CHANGE 'ENDMVS.DEMOUT.CLISTLIB' 'SYS3.ENDMVS.PROD.DEMOUT.CLISTLIB' ALL" "CHANGE 'ENDMVS.DEMOUT.COPYLIB' 'SYS3.ENDMVS.PROD.DEMOUT.COPYLIB' ALL" "CHANGE 'ENDMVS.DEMOUT.DBRMLIB' 'SYS3.ENDMVS.PROD.DEMOUT.DBRMLIB' ALL" "CHANGE 'ENDMVS.DEMOUT.DELTA' 'SYS3.ENDMVS.PROD.DEMOUT.DELTA' ALL" "CHANGE 'ENDMVS.DEMOUT.IMPACT' 'SYS3.ENDMVS.PROD.DEMOUT.IMPACT' ALL" "CHANGE 'ENDMVS.DEMOUT.JCLLIB' 'SYS3.ENDMVS.PROD.DEMOUT.JCLLIB' ALL" "CHANGE 'ENDMVS.DEMOUT.LINKLIB' 'SYS3.ENDMVS.PROD.DEMOUT.LINKLIB' ALL" "CHANGE 'ENDMVS.DEMOUT.LISTLIB' 'SYS3.ENDMVS.PROD.DEMOUT.LISTLIB' ALL" "CHANGE 'ENDMVS.DEMOUT.LOADLIB' 'SYS3.ENDMVS.PROD.DEMOUT.LOADLIB' ALL" "CHANGE 'ENDMVS.DEMOUT.MCF' 'SYS3.ENDMVS.PROD.DEMOUT.MCF' ALL" "CHANGE 'ENDMVS.DEMOUT.MSL' 'SYS3.ENDMVS.PROD.DEMOUT.MSL' ALL" "CHANGE 'ENDMVS.DEMOUT.OBJLIB' 'SYS3.ENDMVS.PROD.DEMOUT.OBJLIB' ALL" "CHANGE 'ENDMVS.DEMOUT.PARMLIB' 'SYS3.ENDMVS.PROD.DEMOUT.PARMLIB' ALL" "CHANGE 'ENDMVS.DEMOUT.PRCSLOAD' 'SYS3.ENDMVS.PROD.DEMOUT.PRCSLOAD' ALL" "CHANGE 'ENDMVS.DEMOUT.PROCLIB' 'SYS3.ENDMVS.PROD.DEMOUT.PROCLIB' ALL" "CHANGE 'ENDMVS.DEMOUT.SRCLIB' 'SYS3.ENDMVS.PROD.DEMOUT.SRCLIB' ALL" "CHANGE 'ENDMVS.INSTALL.ARCHSRC' 'SYS3.ENDMVS.PROD.INSTALL.ARCHSRC' ALL" "CHANGE 'ENDMVS.INSTALL.DEMOSRC' 'SYS3.ENDMVS.PROD.INSTALL.DEMOSRC' ALL" "CHANGE 'ENDMVS.INSTALL.DEMOVSM1' 'SYS3.ENDMVS.PROD.INSTALL.DEMOVSM1' ALL" "CHANGE 'ENDMVS.INSTALL.DEMOVSM2' 'SYS3.ENDMVS.PROD.INSTALL.DEMOVSM2' ALL" "CHANGE 'ENDMVS.INSTALL.DEMOVSM3' 'SYS3.ENDMVS.PROD.INSTALL.DEMOVSM3' ALL" "CHANGE 'ENDMVS.INSTALL.DEMOVSM4' 'SYS3.ENDMVS.PROD.INSTALL.DEMOVSM4' ALL" "CHANGE 'ENDMVS.R360.INSTALL' 'SYS3.ENDMVS.PROD.INSTALL' ALL" "CHANGE 'ENDMVS.R360.ISPMLIB' 'SYS3.ENDMVS.PROD.ISPMLIB' ALL" "CHANGE 'ENDMVS.R360.ISPPLIB' 'SYS3.ENDMVS.PROD.ISPPLIB' ALL" "CHANGE 'ENDMVS.R360.ISPSLIB' 'SYS3.ENDMVS.PROD.ISPSLIB' ALL" "CHANGE 'ENDMVS.R360.ISRCLIB' 'SYS3.ENDMVS.PROD.ISRCLIB' ALL" "CHANGE 'ENDMVS.R360.JCL' 'SYS3.ENDMVS.PROD.JCL' ALL" "CHANGE 'ENDMVS.R360.LOADLIB' 'SYS3.ENDMVS.PROD.LOADLIB' ALL" "CHANGE 'ENDMVS.R360.SOURCE' 'SYS3.ENDMVS.PROD.SOURCE' ALL" "CHANGE 'FILEAID.R641.INSTALL' 'SYS3.FILEAID.PROD.INSTALL' ALL" "CHANGE 'FILEAID.R641.ISPMLIB' 'SYS3.FILEAID.PROD.ISPMLIB' ALL" "CHANGE 'FILEAID.R641.ISPPLIB' 'SYS3.FILEAID.PROD.ISPPLIB' ALL" "CHANGE 'FILEAID.R641.ISPTLIB' 'SYS3.FILEAID.PROD.ISPTLIB' ALL" "CHANGE 'FILEAID.R641.LOADLIB' 'SYS3.FILEAID.PROD.LOADLIB' ALL" "CHANGE 'FILEAID.R641.LOADLIB.BACKUP' 'SYS3.FILEAID.PROD.LOADLIB.BACKUP' ALL" "CHANGE 'FILEAID.R641.OBJECT' 'SYS3.FILEAID.PROD.OBJECT' ALL" "CHANGE 'FINALIST.PRD.CITY.STATE' 'SYS3.FINALIST.PRD.CITY.STATE' ALL" "CHANGE 'FINALIST.PRD.DATAFILE' 'SYS3.FINALIST.PRD.DATAFILE' ALL" "CHANGE 'FINALIST.PRD.LOADLIB' 'SYS3.FINALIST.PRD.LOADLIB' ALL" "CHANGE 'FINALIST.PRD.SOURCE' 'SYS3.FINALIST.PRD.SOURCE' ALL" "CHANGE 'FINALOL.R64.LOADLIB.XA' 'SYS3.FINALOL.PROD.LOADLIB' ALL" "CHANGE 'FINALOL.R64.SOURCE.XA' 'SYS3.FINALOL.PROD.SOURCE' ALL" "CHANGE 'GIM.AGIMLMD0' 'SYS1.GIM.AGIMLMD0' ALL" "CHANGE 'GIM.AGIMMENU' 'SYS1.GIM.AGIMMENU' ALL" "CHANGE 'GIM.AGIMPENU' 'SYS1.GIM.AGIMPENU' ALL" "CHANGE 'GIM.AGIMSENU' 'SYS1.GIM.AGIMSENU' ALL" "CHANGE 'GIM.AGIMTENU' 'SYS1.GIM.AGIMTENU' ALL" "CHANGE 'GIM.SGIMCLS0' 'SYS1.GIM.SGIMCLS0' ALL" "CHANGE 'GIM.SGIMLMD0' 'SYS1.GIM.SGIMLMD0' ALL" "CHANGE 'GIM.SGIMMENU' 'SYS1.GIM.SGIMMENU' ALL" "CHANGE 'GIM.SGIMPENU' 'SYS1.GIM.SGIMPENU' ALL" "CHANGE 'GIM.SGIMSENU' 'SYS1.GIM.SGIMSENU' ALL" "CHANGE 'GIM.SGIMTENU' 'SYS1.GIM.SGIMTENU' ALL" "CHANGE 'ICQ.ICQAATAB' 'SYS1.ICQ.ICQAATAB' ALL" "CHANGE 'ICQ.ICQABTAB' 'SYS1.ICQ.ICQABTAB' ALL" "CHANGE 'ICQ.ICQABTXT' 'SYS1.ICQ.ICQABTXT' ALL" "CHANGE 'ICQ.ICQAMTAB' 'SYS1.ICQ.ICQAMTAB' ALL" "CHANGE 'ICQ.ICQANTAB' 'SYS1.ICQ.ICQANTAB' ALL" "CHANGE 'ICQ.ICQAPTAB' 'SYS1.ICQ.ICQAPTAB' ALL" "CHANGE 'ICQ.ICQCCLIB' 'SYS1.ICQ.ICQCCLIB' ALL" "CHANGE 'ICQ.ICQCMTAB' 'SYS1.ICQ.ICQCMTAB' ALL" "CHANGE 'ICQ.ICQGCTAB' 'SYS1.ICQ.ICQGCTAB' ALL" "CHANGE 'ICQ.ICQILIB' 'SYS1.ICQ.ICQILIB' ALL" "CHANGE 'ICQ.ICQMLIB' 'SYS1.ICQ.ICQMLIB' ALL" "CHANGE 'ICQ.ICQPLIB' 'SYS1.ICQ.ICQPLIB' ALL" "CHANGE 'ICQ.ICQSLIB' 'SYS1.ICQ.ICQSLIB' ALL" "CHANGE 'ICQ.ICQTABLS' 'SYS1.ICQ.ICQTABLS' ALL" "CHANGE 'ICQ.ICQTLIB' 'SYS1.ICQ.ICQTLIB' ALL" "CHANGE 'INNOVATE.IDP.PERM.DOCIAM61' 'SYS3.IAM.PROD.DOCIAM61' ALL" "CHANGE 'INNOVATE.IDP.PERM.ICLIAM61' 'SYS3.IAM.PROD.ICLIAM61' ALL" "CHANGE 'INNOVATE.ISPF.PERM.ISPMLIB' 'SYS3.IAM.PROD.ISPMLIB' ALL" "CHANGE 'INNOVATE.ISPF.PERM.ISPPLIB' 'SYS3.IAM.PROD.ISPPLIB' ALL" "CHANGE 'ISF.V1R3M1.AISFJCL' 'SYS1.ISF.V1R3M3.AISFJCL' ALL" "CHANGE 'ISF.V1R3M1.AISFLOAD' 'SYS1.ISF.V1R3M3.AISFLOAD' ALL" "CHANGE 'ISF.V1R3M1.AISFMLIB' 'SYS1.ISF.V1R3M3.AISFMLIB' ALL" "CHANGE 'ISF.V1R3M1.AISFPLIB' 'SYS1.ISF.V1R3M3.AISFPLIB' ALL" "CHANGE 'ISF.V1R3M1.AISFTLIB' 'SYS1.ISF.V1R3M3.AISFTLIB' ALL" "CHANGE 'ISF.V1R3M1.ISFJCL' 'SYS1.ISF.V1R3M3.ISFJCL' ALL" "CHANGE 'ISF.V1R3M1.ISFLOAD' 'SYS1.ISF.V1R3M3.ISFLOAD' ALL" "CHANGE 'ISF.V1R3M1.ISFLPA' 'SYS1.ISF.V1R3M3.ISFLPA' ALL" "CHANGE 'ISF.V1R3M1.ISFMLIB' 'SYS1.ISF.V1R3M3.ISFMLIB' ALL" "CHANGE 'ISF.V1R3M1.ISFPLIB' 'SYS1.ISF.V1R3M3.ISFPLIB' ALL" "CHANGE 'ISF.V1R3M1.ISFSRC' 'SYS1.ISF.V1R3M3.ISFSRC' ALL" "CHANGE 'ISF.V1R3M1.ISFTLIB' 'SYS1.ISF.V1R3M3.ISFTLIB' ALL" "CHANGE 'ISP.V2R3M0.ISPALIB' 'SYS1.ISP.V3R5M0.ISPALIB' ALL" "CHANGE 'ISP.V2R3M0.ISPEXEC' 'SYS1.ISP.V3R5M0.ISPEXEC' ALL" "CHANGE 'ISP.V2R3M0.ISPGENU' 'SYS1.ISP.V3R5M0.ISPGENU' ALL" "CHANGE 'ISP.V2R3M0.ISPLOAD' 'SYS1.ISP.V3R5M0.ISPLOAD' ALL" "CHANGE 'ISP.V2R3M0.ISPLPA' 'SYS1.ISP.V3R5M0.ISPLPA' ALL" "CHANGE 'ISP.V2R3M0.ISPMACS' 'SYS1.ISP.V3R5M0.ISPMACS' ALL" "CHANGE 'ISP.V2R3M0.ISPMLIB' 'SYS1.ISP.V3R5M0.ISPMENU' ALL" "CHANGE 'ISP.V2R3M0.ISPPLIB' 'SYS1.ISP.V3R5M0.ISPPENU' ALL" "CHANGE 'ISP.V2R3M0.ISPSLIB' 'SYS1.ISP.V3R5M0.ISPSLIB' ALL" "CHANGE 'ISP.V2R3M0.ISPTLIB' 'SYS1.ISP.V3R5M0.ISPTENU' ALL" "CHANGE 'ISR.V2R3M0.ISRCLIB' 'SYS1.ISR.V3R5M0.ISRCLIB' ALL" "CHANGE 'ISR.V2R3M0.ISRHELP' 'SYS1.ISR.V3R5M0.ISRHELP' ALL" "CHANGE 'ISR.V2R3M0.ISRLOAD' 'SYS1.ISR.V3R5M0.ISRLOAD' ALL" "CHANGE 'ISR.V2R3M0.ISRLPA' 'SYS1.ISR.V3R5M0.ISRLPA' ALL" "CHANGE 'ISR.V2R3M0.ISRMACS' 'SYS1.ISR.V3R5M0.ISRMACS' ALL" "CHANGE 'ISR.V2R3M0.ISRMLIB' 'SYS1.ISR.V3R5M0.ISRMENU' ALL" "CHANGE 'ISR.V2R3M0.ISRPLIB' 'SYS1.ISR.V3R5M0.ISRPENU' ALL" "CHANGE 'ISR.V2R3M0.ISRSAMP' 'SYS1.ISR.V3R5M0.ISRSAMP' ALL" "CHANGE 'ISR.V2R3M0.ISRSLIB' 'SYS1.ISR.V3R5M0.ISRSENU' ALL" "CHANGE 'ISR.V2R3M0.ISRTLIB' 'SYS1.ISR.V3R5M0.ISRTLIB' ALL" "CHANGE 'ISR.V2R3M0.SEHOBASE' 'SYS1.ISR.V3R5M0.SEHOBASE' ALL" "CHANGE 'ISR.V2R3M0.SEHOBENU' 'SYS1.ISR.V3R5M0.SEHOBENU' ALL" "CHANGE 'JCLPREP.V360.CLIST' 'SYS3.JCLPREP.PROD.CLIST' ALL" "CHANGE 'JCLPREP.V360.JCL' 'SYS3.JCLPREP.PROD.JCL' ALL" "CHANGE 'JCLPREP.V360.LOAD' 'SYS3.JCLPREP.PROD.LOAD' ALL" "CHANGE 'JCLPREP.V360.MLIB' 'SYS3.JCLPREP.PROD.MLIB' ALL" "CHANGE 'JCLPREP.V360.PLIB' 'SYS3.JCLPREP.PROD.PLIB' ALL" "CHANGE 'JCLPREP.V360.REPORT' 'SYS3.JCLPREP.REPORT' ALL" "CHANGE 'JCLPREP.V360.RULEG' 'SYS3.JCLPREP.PROD.RULEG' ALL" "CHANGE 'JCLPREP.V360.RULES' 'SYS3.JCLPREP.PROD.RULES' ALL" "CHANGE 'JCLPREP.V360.RULEY' 'SYS3.JCLPREP.PROD.RULEY' ALL" "CHANGE 'JCLPREP.V360.SLIB' 'SYS3.JCLPREP.PROD.SLIB' ALL" "CHANGE 'JCLPREP.V360.TLIB' 'SYS3.JCLPREP.PROD.TLIB' ALL" "CHANGE 'JCLPREP.V360.WRITE' 'SYS3.JCLPREP.WRITE' ALL" "CHANGE 'JCLPREP.V360.WRITEPDS' 'SYS3.JCLPREP.WRITEPDS' ALL" "CHANGE 'JCLPREP.WRITE' 'SYS3.JCLPREP.WRITE' ALL" "CHANGE 'JCLPREP.WRITEPDS' 'SYS3.JCLPREP.WRITEPDS' ALL" "CHANGE 'MTEXT.AHELP' 'SYS3.MTEXT.AHELP' ALL" "CHANGE 'MTEXT.BACKUP.MDL1AOR1.KLIB' 'SYS3.MTEXT.BACKUP.M1A1.KLIB' ALL" "CHANGE 'MTEXT.BACKUP.MDL1AOR2.KLIB' 'SYS3.MTEXT.BACKUP.M1A2.KLIB' ALL" "CHANGE 'MTEXT.BACKUP.PRD1AOR1.KLIB' 'SYS3.MTEXT.BACKUP.P1A1.KLIB' ALL" "CHANGE 'MTEXT.BACKUP.TST1AOR1.KLIB' 'SYS3.MTEXT.BACKUP.T1A1.KLIB' ALL" "CHANGE 'MTEXT.BACKUP.TST1AOR2.KLIB' 'SYS3.MTEXT.BACKUP.T1A2.KLIB' ALL" "CHANGE 'MTEXT.BACKUP.TST2AOR1.KLIB' 'SYS3.MTEXT.BACKUP.T2A1.KLIB' ALL" "CHANGE 'MTEXT.INSTALL' 'SYS3.MTEXT.INSTALL' ALL" "CHANGE 'MTEXT.MDL1AOR1.KLIB' 'SYS3.MTEXT.M1A1.KLIB' ALL" "CHANGE 'MTEXT.MDL1AOR1.LSTFIL1' 'SYS3.MTEXT.M1A1.LSTFIL1' ALL" "CHANGE 'MTEXT.MDL1AOR1.LSTFIL2' 'SYS3.MTEXT.M1A1.LSTFIL2' ALL" "CHANGE 'MTEXT.MDL1AOR1.MSPELL.DICT' 'SYS3.MTEXT.M1A1.MSPELL.DICT' ALL" "CHANGE 'MTEXT.MDL1AOR1.PHELPENG' 'SYS3.MTEXT.M1A1.PHELPENG' ALL" "CHANGE 'MTEXT.MDL1AOR2.KLIB' 'SYS3.MTEXT.M1A2.KLIB' ALL" "CHANGE 'MTEXT.MDL1AOR2.LSTFIL1' 'SYS3.MTEXT.M1A2.LSTFIL1' ALL" "CHANGE 'MTEXT.MDL1AOR2.LSTFIL2' 'SYS3.MTEXT.M1A2.LSTFIL2' ALL" "CHANGE 'MTEXT.MDL1AOR2.MSPELL.DICT' 'SYS3.MTEXT.M1A2.MSPELL.DICT' ALL" "CHANGE 'MTEXT.MDL1AOR2.PHELPENG' 'SYS3.MTEXT.M1A2.PHELPENG' ALL" "CHANGE 'MTEXT.PRD1AOR1.KLIB' 'SYS3.MTEXT.P1A1.KLIB' ALL" "CHANGE 'MTEXT.PRD1AOR1.LSTFIL1' 'SYS3.MTEXT.P1A1.LSTFIL1' ALL" "CHANGE 'MTEXT.PRD1AOR1.LSTFIL2' 'SYS3.MTEXT.P1A1.LSTFIL2' ALL" "CHANGE 'MTEXT.PRD1AOR1.MSPELL.DICT' 'SYS3.MTEXT.P1A1.MSPELL.DICT' ALL" "CHANGE 'MTEXT.PRD1AOR1.PHELPENG' 'SYS3.MTEXT.P1A1.PHELPENG' ALL" "CHANGE 'MTEXT.PRD1AOR2.KLIB' 'SYS3.MTEXT.P1A2.KLIB' ALL" "CHANGE 'MTEXT.PRD1AOR2.LSTFIL1' 'SYS3.MTEXT.P1A2.LSTFIL1' ALL" "CHANGE 'MTEXT.PRD1AOR2.LSTFIL2' 'SYS3.MTEXT.P1A2.LSTFIL2' ALL" "CHANGE 'MTEXT.PRD1AOR2.MSPELL.DICT' 'SYS3.MTEXT.P1A2.MSPELL.DICT' ALL" "CHANGE 'MTEXT.PRD1AOR2.PHELPENG' 'SYS3.MTEXT.P1A2.PHELPENG' ALL" "CHANGE 'MTEXT.TST1AOR1.KLIB' 'SYS3.MTEXT.T1A1.KLIB' ALL" "CHANGE 'MTEXT.TST1AOR1.LSTFIL1' 'SYS3.MTEXT.T1A1.LSTFIL1' ALL" "CHANGE 'MTEXT.TST1AOR1.LSTFIL2' 'SYS3.MTEXT.T1A1.LSTFIL2' ALL" "CHANGE 'MTEXT.TST1AOR1.MSPELL.DICT' 'SYS3.MTEXT.T1A1.MSPELL.DICT' ALL" "CHANGE 'MTEXT.TST1AOR1.PHELPENG' 'SYS3.MTEXT.T1A1.PHELPENG' ALL" "CHANGE 'MTEXT.TST1AOR2.KLIB' 'SYS3.MTEXT.T1A2.KLIB' ALL" "CHANGE 'MTEXT.TST1AOR2.LSTFIL1' 'SYS3.MTEXT.T1A2.LSTFIL1' ALL" "CHANGE 'MTEXT.TST1AOR2.LSTFIL2' 'SYS3.MTEXT.T1A2.LSTFIL2' ALL" "CHANGE 'MTEXT.TST1AOR2.MSPELL.DICT' 'SYS3.MTEXT.T1A2.MSPELL.DICT' ALL" "CHANGE 'MTEXT.TST1AOR2.PHELPENG' 'SYS3.MTEXT.T1A2.PHELPENG' ALL" "CHANGE 'MTEXT.TST2AOR1.KLIB' 'SYS3.MTEXT.T2A1.KLIB' ALL" "CHANGE 'MTEXT.TST2AOR1.LSTFIL1' 'SYS3.MTEXT.T2A1.LSTFIL1' ALL" "CHANGE 'MTEXT.TST2AOR1.LSTFIL2' 'SYS3.MTEXT.T2A1.LSTFIL2' ALL" "CHANGE 'MTEXT.TST2AOR1.MSPELL.DICT' 'SYS3.MTEXT.T2A1.MSPELL.DICT' ALL" "CHANGE 'MTEXT.TST2AOR1.PHELPENG' 'SYS3.MTEXT.T2A1.PHELPENG' ALL" "CHANGE 'MTEXT.V21.ACTHELP' 'SYS3.MTEXT.PROD.ACTHELP' ALL" "CHANGE 'MTEXT.V21.CICSTBLS' 'SYS3.MTEXT.PROD.CICSTBLS' ALL" "CHANGE 'MTEXT.V21.CICS212.LINKLIB' 'SYS3.MTEXT.PROD.CICS212.LINKLIB' ALL" "CHANGE 'MTEXT.V21.JCLLIB' 'SYS3.MTEXT.PROD.JCLLIB' ALL" "CHANGE 'MTEXT.V21.LINKLIB' 'SYS3.MTEXT.PROD.LINKLIB' ALL" "CHANGE 'MTEXT.V21.LOADLIB' 'SYS3.MTEXT.PROD.LOADLIB' ALL" "CHANGE 'MTEXT.V21.MACLIB' 'SYS3.MTEXT.PROD.MACLIB' ALL" "CHANGE 'MTEXT.V21.MSPELL.LINKLIB' 'SYS3.MTEXT.PROD.MSPELL.LINKLIB' ALL" "CHANGE 'MTEXT.V21.MSPELL.OBJLIB' 'SYS3.MTEXT.PROD.MSPELL.OBJLIB' ALL" "CHANGE 'MTEXT.V21.MSPELL.SOURCE' 'SYS3.MTEXT.PROD.MSPELL.SOURCE' ALL" "CHANGE 'MTEXT.V21.OBJLIB' 'SYS3.MTEXT.PROD.OBJLIB' ALL" "CHANGE 'MTEXT.V21.SAMPJCL' 'SYS3.MTEXT.PROD.SAMPJCL' ALL" "CHANGE 'MTEXT.V21.SOURCE' 'SYS3.MTEXT.PROD.SOURCE' ALL" "CHANGE 'MXG.PDB.SPIN' 'SYS3.MXG.PROD.PDB.SPIN' ALL" "CHANGE 'MXG.PRD.CICSTRAN' 'SYS3.MXG.PROD.CICSTRAN' ALL" "CHANGE 'MXG.PRD.MXG.FORMATS' 'SYS3.MXG.PROD.MXG.FORMATS' ALL" "CHANGE 'MXG.PRD.MXG.SOURCLIB' 'SYS3.MXG.PROD.MXG.SOURCLIB' ALL" "CHANGE 'MXG.PRD.USERID.SOURCLIB' 'SYS3.MXG.PROD.USERID.SOURCLIB' ALL" "CHANGE 'NOMAD.$QLIST.NOMAD.DATA' 'SYS3.NOMAD.$QLIST.NOMAD.DATA' ALL" "CHANGE 'NOMAD.$QLIST.NOMAD.DB.WRDBHELP' 'SYS3.NOMAD.$QLIST.NOMAD.DB.WRDBHELP' ALL" "CHANGE 'NOMAD.$QLIST.NOMAD.DB.WRDBXYZ' 'SYS3.NOMAD.$QLIST.NOMAD.DB.WRDBXYZ' ALL" "CHANGE 'NOMAD.COLL.NOMAD.DATA' 'SYS3.NOMAD.COLL.NOMAD.DATA' ALL" "CHANGE 'NOMAD.COLL.SCHEMA.DATA' 'SYS3.NOMAD.COLL.SCHEMA.DATA' ALL" "CHANGE 'NOMAD.COPYBOOK.NOMAD.DATA' 'SYS3.NOMAD.COPYBOOK.NOMAD.DATA' ALL" "CHANGE 'NOMAD.CS.INSTLIB' 'SYS3.NOMAD.CS.INSTLIB' ALL" "CHANGE 'NOMAD.D090893.NOMAD.DATA' 'SYS3.NOMAD.D090893.NOMAD.DATA' ALL" "CHANGE 'NOMAD.D090893.SCHEMA.DATA' 'SYS3.NOMAD.D090893.SCHEMA.DATA' ALL" "CHANGE 'NOMAD.N2EDUC.INPUT.DATA' 'SYS3.NOMAD.N2EDUC.INPUT.DATA' ALL" "CHANGE 'NOMAD.N2EDUC.NOMAD.DATA' 'SYS3.NOMAD.N2EDUC.NOMAD.DATA' ALL" "CHANGE 'NOMAD.N2EDUC.NOMAD.DB.ADDVIDEO' 'SYS3.NOMAD.N2EDUC.NOMAD.DB.ADDVIDEO' ALL" "CHANGE 'NOMAD.N2EDUC.NOMAD.DB.ARVIDEO' 'SYS3.NOMAD.N2EDUC.NOMAD.DB.ARVIDEO' ALL" "CHANGE 'NOMAD.N2EDUC.NOMAD.DB.BIGONE' 'SYS3.NOMAD.N2EDUC.NOMAD.DB.BIGONE' ALL" "CHANGE 'NOMAD.N2EDUC.NOMAD.DB.BIGTHREE' 'SYS3.NOMAD.N2EDUC.NOMAD.DB.BIGTHREE' ALL" "CHANGE 'NOMAD.N2EDUC.NOMAD.DB.CHECKING' 'SYS3.NOMAD.N2EDUC.NOMAD.DB.CHECKING' ALL" "CHANGE 'NOMAD.N2EDUC.NOMAD.DB.CLASSA' 'SYS3.NOMAD.N2EDUC.NOMAD.DB.CLASSA' ALL" "CHANGE 'NOMAD.N2EDUC.NOMAD.DB.CLASSB' 'SYS3.NOMAD.N2EDUC.NOMAD.DB.CLASSB' ALL" "CHANGE 'NOMAD.N2EDUC.NOMAD.DB.CLASSC' 'SYS3.NOMAD.N2EDUC.NOMAD.DB.CLASSC' ALL" "CHANGE 'NOMAD.N2EDUC.NOMAD.DB.COLLEGE' 'SYS3.NOMAD.N2EDUC.NOMAD.DB.COLLEGE' ALL" "CHANGE 'NOMAD.N2EDUC.NOMAD.DB.ED' 'SYS3.NOMAD.N2EDUC.NOMAD.DB.ED' ALL" "CHANGE 'NOMAD.N2EDUC.NOMAD.DB.FILMS' 'SYS3.NOMAD.N2EDUC.NOMAD.DB.FILMS' ALL" "CHANGE 'NOMAD.N2EDUC.NOMAD.DB.FORMAT' 'SYS3.NOMAD.N2EDUC.NOMAD.DB.FORMAT' ALL" "CHANGE 'NOMAD.N2EDUC.NOMAD.DB.HRVIDEO' 'SYS3.NOMAD.N2EDUC.NOMAD.DB.HRVIDEO' ALL" "CHANGE 'NOMAD.N2EDUC.NOMAD.DB.JONESTK1' 'SYS3.NOMAD.N2EDUC.NOMAD.DB.JONESTK1' ALL" "CHANGE 'NOMAD.N2EDUC.NOMAD.DB.JONESTK2' 'SYS3.NOMAD.N2EDUC.NOMAD.DB.JONESTK2' ALL" "CHANGE 'NOMAD.N2EDUC.NOMAD.DB.LABOR3' 'SYS3.NOMAD.N2EDUC.NOMAD.DB.LABOR3' ALL" "CHANGE 'NOMAD.N2EDUC.NOMAD.DB.LOOKUPS' 'SYS3.NOMAD.N2EDUC.NOMAD.DB.LOOKUPS' ALL" "CHANGE 'NOMAD.N2EDUC.NOMAD.DB.MCA' 'SYS3.NOMAD.N2EDUC.NOMAD.DB.MCA' ALL" "CHANGE 'NOMAD.N2EDUC.NOMAD.DB.MONITOR' 'SYS3.NOMAD.N2EDUC.NOMAD.DB.MONITOR' ALL" "CHANGE 'NOMAD.N2EDUC.NOMAD.DB.NADMAST' 'SYS3.NOMAD.N2EDUC.NOMAD.DB.NADMAST' ALL" "CHANGE 'NOMAD.N2EDUC.NOMAD.DB.NADVIDEO' 'SYS3.NOMAD.N2EDUC.NOMAD.DB.NADVIDEO' ALL" "CHANGE 'NOMAD.N2EDUC.NOMAD.DB.PROLABOR' 'SYS3.NOMAD.N2EDUC.NOMAD.DB.PROLABOR' ALL" "CHANGE 'NOMAD.N2EDUC.NOMAD.DB.RELATEX' 'SYS3.NOMAD.N2EDUC.NOMAD.DB.RELATEX' ALL" "CHANGE 'NOMAD.N2EDUC.NOMAD.DB.RTEX10' 'SYS3.NOMAD.N2EDUC.NOMAD.DB.RTEX10' ALL" "CHANGE 'NOMAD.N2EDUC.NOMAD.DB.SALES' 'SYS3.NOMAD.N2EDUC.NOMAD.DB.SALES' ALL" "CHANGE 'NOMAD.N2EDUC.NOMAD.DB.TIMES' 'SYS3.NOMAD.N2EDUC.NOMAD.DB.TIMES' ALL" "CHANGE 'NOMAD.N2EDUC.NOMAD.DB.TIMES2' 'SYS3.NOMAD.N2EDUC.NOMAD.DB.TIMES2' ALL" "CHANGE 'NOMAD.N2EDUC.NOMAD.DB.VENDOR' 'SYS3.NOMAD.N2EDUC.NOMAD.DB.VENDOR' ALL" "CHANGE 'NOMAD.N2EDUC.NOMAD.DB.WLABOR' 'SYS3.NOMAD.N2EDUC.NOMAD.DB.WLABOR' ALL" "CHANGE 'NOMAD.N2EDUC.SCHEMA.DATA' 'SYS3.NOMAD.N2EDUC.SCHEMA.DATA' ALL" "CHANGE 'NOMAD.N2SHARE.NOMAD.DATA' 'SYS3.NOMAD.N2SHARE.NOMAD.DATA' ALL" "CHANGE 'NOMAD.N2SHARE.NOMAD.DB.AMPLISTE' 'SYS3.NOMAD.N2SHARE.NOMAD.DB.AMPLISTE' ALL" "CHANGE 'NOMAD.N2SHARE.NOMAD.DB.ANYFILE' 'SYS3.NOMAD.N2SHARE.NOMAD.DB.ANYFILE' ALL" "CHANGE 'NOMAD.N2SHARE.NOMAD.DB.AUDREC' 'SYS3.NOMAD.N2SHARE.NOMAD.DB.AUDREC' ALL" "CHANGE 'NOMAD.N2SHARE.NOMAD.DB.IFACEDB2' 'SYS3.NOMAD.N2SHARE.NOMAD.DB.IFACEDB2' ALL" "CHANGE 'NOMAD.N2SHARE.NOMAD.DB.IFACETQL' 'SYS3.NOMAD.N2SHARE.NOMAD.DB.IFACETQL' ALL" "CHANGE 'NOMAD.N2SHARE.NOMAD.DB.LANIF' 'SYS3.NOMAD.N2SHARE.NOMAD.DB.LANIF' ALL" "CHANGE 'NOMAD.N2SHARE.NOMAD.DB.LANIFINT' 'SYS3.NOMAD.N2SHARE.NOMAD.DB.LANIFINT' ALL" "CHANGE 'NOMAD.N2SHARE.NOMAD.DB.NAPA1' 'SYS3.NOMAD.N2SHARE.NOMAD.DB.NAPA1' ALL" "CHANGE 'NOMAD.N2SHARE.NOMAD.DB.NAPA2' 'SYS3.NOMAD.N2SHARE.NOMAD.DB.NAPA2' ALL" "CHANGE 'NOMAD.N2SHARE.NOMAD.DB.NEWCMPNY' 'SYS3.NOMAD.N2SHARE.NOMAD.DB.NEWCMPNY' ALL" "CHANGE 'NOMAD.N2SHARE.NOMAD.DB.NH300' 'SYS3.NOMAD.N2SHARE.NOMAD.DB.NH300' ALL" "CHANGE 'NOMAD.N2SHARE.NOMAD.DB.PLANTBL' 'SYS3.NOMAD.N2SHARE.NOMAD.DB.PLANTBL' ALL" "CHANGE 'NOMAD.N2SHARE.NOMAD.DB.PROJECTS' 'SYS3.NOMAD.N2SHARE.NOMAD.DB.PROJECTS' ALL" "CHANGE 'NOMAD.N2SHARE.NOMAD.DB.PROJRM' 'SYS3.NOMAD.N2SHARE.NOMAD.DB.PROJRM' ALL" "CHANGE 'NOMAD.N2SHARE.NOMAD.DB.SCDB2130' 'SYS3.NOMAD.N2SHARE.NOMAD.DB.SCDB2130' ALL" "CHANGE 'NOMAD.N2SHARE.NOMAD.DB.SCDB2210' 'SYS3.NOMAD.N2SHARE.NOMAD.DB.SCDB2210' ALL" "CHANGE 'NOMAD.N2SHARE.NOMAD.DB.SCDB2230' 'SYS3.NOMAD.N2SHARE.NOMAD.DB.SCDB2230' ALL" "CHANGE 'NOMAD.N2SHARE.NOMAD.DB.SGMETAE' 'SYS3.NOMAD.N2SHARE.NOMAD.DB.SGMETAE' ALL" "CHANGE 'NOMAD.N2SHARE.NOMAD.DB.SORTWK01' 'SYS3.NOMAD.N2SHARE.NOMAD.DB.SORTWK01' ALL" "CHANGE 'NOMAD.N2SHARE.NOMAD.DB.SORTWK02' 'SYS3.NOMAD.N2SHARE.NOMAD.DB.SORTWK02' ALL" "CHANGE 'NOMAD.N2SHARE.NOMAD.DB.SORTWK03' 'SYS3.NOMAD.N2SHARE.NOMAD.DB.SORTWK03' ALL" "CHANGE 'NOMAD.N2SHARE.NOMAD.DB.TOOLMSGE' 'SYS3.NOMAD.N2SHARE.NOMAD.DB.TOOLMSGE' ALL" "CHANGE 'NOMAD.N2SHARE.NOMAD.DB.UERRE' 'SYS3.NOMAD.N2SHARE.NOMAD.DB.UERRE' ALL" "CHANGE 'NOMAD.N2SHARE.NOMAD.DB.USERJOB.BKUP' 'SYS3.NOMAD.N2SHARE.NOMAD.DB.USERJOB.BKUP' ALL" "CHANGE 'NOMAD.N2SHARE.NOMAD.DB.XREFJOB' 'SYS3.NOMAD.N2SHARE.NOMAD.DB.XREF' ALL" "CHANGE 'NOMAD.N2SHARE.NOMAD.DB.XXDBLOG' 'SYS3.NOMAD.N2SHARE.NOMAD.DB.XXDBLOG' ALL" "CHANGE 'NOMAD.N2SHARE.NOMAD.DB.XXEZHELP' 'SYS3.NOMAD.N2SHARE.NOMAD.DB.XXEZHELP' ALL" "CHANGE 'NOMAD.N2SHARE.NOMAD.DB.XXFORMS3' 'SYS3.NOMAD.N2SHARE.NOMAD.DB.XXFORMS3' ALL" "CHANGE 'NOMAD.N2SHARE.NOMAD.DB.XXFORMS4' 'SYS3.NOMAD.N2SHARE.NOMAD.DB.XXFORMS4' ALL" "CHANGE 'NOMAD.N2SHARE.NOMAD.DB.XXFORMS5' 'SYS3.NOMAD.N2SHARE.NOMAD.DB.XXWFORM5' ALL" "CHANGE 'NOMAD.N2SHARE.NOMAD.DB.XXWFORMS' 'SYS3.NOMAD.N2SHARE.NOMAD.DB.XXWFORMS' ALL" "CHANGE 'NOMAD.N2SHARE.SCHEMA.DATA' 'SYS3.NOMAD.N2SHARE.SCHEMA.DATA' ALL" "CHANGE 'NOMAD.N2SHARE.TOOLFUNC.ASM' 'SYS3.NOMAD.N2SHARE.TOOLFUNC.ASM' ALL" "CHANGE 'NOMAD.N2SHARE.TOOLFUNC.LOAD' 'SYS3.NOMAD.N2SHARE.TOOLFUNC.LOAD' ALL" "CHANGE 'NOMAD.N2SHARE.WPPRLIST' 'SYS3.NOMAD.N2SHARE.WPPRLIST' ALL" "CHANGE 'NOMAD.N2SUP.NOMAD.DATA' 'SYS3.NOMAD.N2SUP.NOMAD.DATA' ALL" "CHANGE 'NOMAD.N2SUP.NOMAD.DB.LICUR' 'SYS3.NOMAD.N2SUP.NOMAD.DB.LICUR' ALL" "CHANGE 'NOMAD.N2WINDOW.NOMAD.DATA' 'SYS3.NOMAD.N2WINDOW.NOMAD.DATA' ALL" "CHANGE 'NOMAD.N2WINDOW.NOMAD.DB.WP450' 'SYS3.NOMAD.N2WINDOW.NOMAD.DB.WP450' ALL" "CHANGE 'NOMAD.N2WINDOW.SCHEMA.DATA' 'SYS3.NOMAD.N2WINDOW.SCHEMA.DATA' ALL" "CHANGE 'NOMAD.TOOL.INSTALL' 'SYS3.NOMAD.TOOL.INSTALL' ALL" "CHANGE 'NOMAD.UT9303.CS.INSTLIB' 'SYS3.NOMAD.UT9303.CS.INSTLIB' ALL" "CHANGE 'NOMAD.UT9401.CS.INSTLIB' 'SYS3.NOMAD.UT9401.CS.INSTLIB' ALL" "CHANGE 'NOMAD.UT9401.CS.NOMAD.DB.SGMETAE' 'SYS3.NOMAD.UT9401.CS.NOMAD.DB.SGMETAE' ALL" "CHANGE 'NOMAD.UT9401.CS.NOMAD.DB.SURS9401' 'SYS3.NOMAD.UT9401.CS.NOMAD.DB.SURS9401' ALL" "CHANGE 'NOMAD.UT9401.CS.NOMAD.DB.WRDBFRE' 'SYS3.NOMAD.UT9401.CS.NOMAD.DB.WRDBFRE' ALL" "CHANGE 'NOMAD.V550.CS.ALINKLIB' 'SYS3.NOMAD.PROD.CS.ALINKLIB' ALL" "CHANGE 'NOMAD.V550.CS.AMACLIB' 'SYS3.NOMAD.PROD.CS.AMACLIB' ALL" "CHANGE 'NOMAD.V550.CS.AMMACLIB' 'SYS3.NOMAD.PROD.CS.AMMACLIB' ALL" "CHANGE 'NOMAD.V550.CS.ANOMAD.DATA' 'SYS3.NOMAD.PROD.CS.ANOMAD.DATA' ALL" "CHANGE 'NOMAD.V550.CS.AN2PROC.DATA' 'SYS3.NOMAD.PROD.CS.AN2PROC.DATA' ALL" "CHANGE 'NOMAD.V550.CS.ASAMPLIB' 'SYS3.NOMAD.PROD.CS.ASAMPLIB' ALL" "CHANGE 'NOMAD.V550.CS.ASCHEMA.DATA' 'SYS3.NOMAD.PROD.CS.ASCHEMA.DATA' ALL" "CHANGE 'NOMAD.V550.CS.ASOURCE' 'SYS3.NOMAD.PROD.CS.ASOURCE' ALL" "CHANGE 'NOMAD.V550.CS.INSTLIB' 'SYS3.NOMAD.PROD.CS.INSTLIB' ALL" "CHANGE 'NOMAD.V550.CS.MACLIB' 'SYS3.NOMAD.PROD.CS.MACLIB' ALL" "CHANGE 'NOMAD.V550.CS.MMACLIB' 'SYS3.NOMAD.PROD.CS.MMACLIB' ALL" "CHANGE 'NOMAD.V550.CS.NOMAD.DATA' 'SYS3.NOMAD.PROD.CS.NOMAD.DATA' ALL" "CHANGE 'NOMAD.V550.CS.NOMAD.DB.AMPLISTE' 'SYS3.NOMAD.PROD.CS.NOMAD.DB.AMPLISTE' ALL" "CHANGE 'NOMAD.V550.CS.NOMAD.DB.ANYFILEE' 'SYS3.NOMAD.PROD.CS.NOMAD.DB.ANYFILE' ALL" "CHANGE 'NOMAD.V550.CS.NOMAD.DB.AUDREC' 'SYS3.NOMAD.PROD.CS.NOMAD.DB.AUDREC' ALL" "CHANGE 'NOMAD.V550.CS.NOMAD.DB.LANIF' 'SYS3.NOMAD.PROD.CS.NOMAD.DB.LANIF' ALL" "CHANGE 'NOMAD.V550.CS.NOMAD.DB.LANIFINT' 'SYS3.NOMAD.PROD.CS.NOMAD.DB.LANIFINT' ALL" "CHANGE 'NOMAD.V550.CS.NOMAD.DB.NEWCMPNY' 'SYS3.NOMAD.PROD.CS.NOMAD.DB.NEWCMPNY' ALL" "CHANGE 'NOMAD.V550.CS.NOMAD.DB.NSMENV' 'SYS3.NOMAD.PROD.CS.NOMAD.DB.NSMENV' ALL" "CHANGE 'NOMAD.V550.CS.NOMAD.DB.PROJECTS' 'SYS3.NOMAD.PROD.CS.NOMAD.DB.PROJECTS' ALL" "CHANGE 'NOMAD.V550.CS.NOMAD.DB.SCDB2130' 'SYS3.NOMAD.PROD.CS.NOMAD.DB.SCDB2130' ALL" "CHANGE 'NOMAD.V550.CS.NOMAD.DB.SCDB2210' 'SYS3.NOMAD.PROD.CS.NOMAD.DB.SCDB2210' ALL" "CHANGE 'NOMAD.V550.CS.NOMAD.DB.SCDB2230' 'SYS3.NOMAD.PROD.CS.NOMAD.DB.SCDB2230' ALL" "CHANGE 'NOMAD.V550.CS.NOMAD.DB.SGMETAE' 'SYS3.NOMAD.PROD.CS.NOMAD.DB.SGMETAE' ALL" "CHANGE 'NOMAD.V550.CS.NOMAD.DB.SURS9209' 'SYS3.NOMAD.PROD.CS.NOMAD.DB.SURS9209' ALL" "CHANGE 'NOMAD.V550.CS.NOMAD.DB.SURS9303' 'SYS3.NOMAD.PROD.CS.NOMAD.DB.SURS9303' ALL" "CHANGE 'NOMAD.V550.CS.NOMAD.DB.TOOLMSGE' 'SYS3.NOMAD.PROD.CS.NOMAD.DB.TOOLMSGE' ALL" "CHANGE 'NOMAD.V550.CS.NOMAD.DB.UERRE' 'SYS3.NOMAD.PROD.CS.NOMAD.DB.UERRE' ALL" "CHANGE 'NOMAD.V550.CS.NOMAD.DB.WRDBHELP' 'SYS3.NOMAD.PROD.CS.NOMAD.DB.WRDBHELP' ALL" "CHANGE 'NOMAD.V550.CS.NOMAD.DB.WRDBHLPU' 'SYS3.NOMAD.PROD.CS.NOMAD.DB.WRDBHLPU' ALL" "CHANGE 'NOMAD.V550.CS.NOMAD.DB.WRDBXY30' 'SYS3.NOMAD.PROD.CS.NOMAD.DB.WRDBXY30' ALL" "CHANGE 'NOMAD.V550.CS.NOMAD.DB.WRDBZYXP' 'SYS3.NOMAD.PROD.CS.NOMAD.DB.WRDBZYX' ALL" "CHANGE 'NOMAD.V550.CS.NOMAD.DB.XREF' 'SYS3.NOMAD.PROD.CS.NOMAD.DB.XREF' ALL" "CHANGE 'NOMAD.V550.CS.NOMAD.DB.XXEZHELP' 'SYS3.NOMAD.PROD.CS.NOMAD.DB.XXEZHELP' ALL" "CHANGE 'NOMAD.V550.CS.NOMAD.DB.XXWFORMS' 'SYS3.NOMAD.PROD.CS.NOMAD.DB.XXWFORMS' ALL" "CHANGE 'NOMAD.V550.CS.NOMAD.ZZ.SGMETAE' 'SYS3.NOMAD.PROD.CS.NOMAD.ZZ.SGMETAE' ALL" "CHANGE 'NOMAD.V550.CS.PARMLIB' 'SYS3.NOMAD.PROD.CS.PARMLIB' ALL" "CHANGE 'NOMAD.V550.CS.SAMPLIB' 'SYS3.NOMAD.PROD.CS.SAMPLIB' ALL" "CHANGE 'NOMAD.V550.CS.SCHEMA.DATA' 'SYS3.NOMAD.PROD.CS.SCHEMA.DATA' ALL" "CHANGE 'NOMAD.V550.CS.SOURCE' 'SYS3.NOMAD.PROD.CS.SOURCE' ALL" "CHANGE 'NOMAD.V550.UPLOAD.NOMAD.DATA' 'SYS3.NOMAD.PROD.UPLOAD.NOMAD.DATA' ALL" "CHANGE 'NOMAD.V60.CS.INSTLIB' 'SYS3.NOMAD.V60.CS.INSTLIB' ALL" "CHANGE 'PLI.V2R3M0.AIBMMOD1' 'SYS4.PLI.V2R3M0.AIBMMOD1' ALL" "CHANGE 'PLI.V2R3M0.AIBMSRC1' 'SYS4.PLI.V2R3M0.AIBMSRC1' ALL" "CHANGE 'PLI.V2R3M0.PLIPROC' 'SYS4.PLI.V2R3M0.PLIPROC' ALL" "CHANGE 'PLI.V2R3M0.PLISAMP' 'SYS4.PLI.V2R3M0.PLISAMP' ALL" "CHANGE 'PLI.V2R3M0.SIBMBASE' 'SYS4.PLI.V2R3M0.SIBMBASE' ALL" "CHANGE 'PLI.V2R3M0.SIBMLINK' 'SYS2.PLI.V2R3M0.SIBMLINK' ALL" "CHANGE 'PTRP.P310AA.BPMODLIB' 'SYS3.PLATINUM.BPMODLIB' ALL" "CHANGE 'PTRP.P310AA.CLIST' 'SYS3.PLATINUM.CLIST' ALL" "CHANGE 'PTRP.P310AA.COBIN' 'SYS3.PLATINUM.COBIN' ALL" "CHANGE 'PTRP.P310AA.COMPLIB' 'SYS3.PLATINUM.COMPLIB' ALL" "CHANGE 'PTRP.P310AA.CONTROL' 'SYS3.PLATINUM.CONTROL' ALL" "CHANGE 'PTRP.P310AA.DBRMLIB' 'SYS3.PLATINUM.DBRMLIB' ALL" "CHANGE 'PTRP.P310AA.FIXLIB' 'SYS3.PLATINUM.FIXLIB' ALL" "CHANGE 'PTRP.P310AA.LOADCICS' 'SYS3.PLATINUM.LOADCICS' ALL" "CHANGE 'PTRP.P310AA.LOADLIB' 'SYS3.PLATINUM.LOADLIB' ALL" "CHANGE 'PTRP.P310AA.MAINT.SCREENS' 'SYS3.PLATINUM.MAINT.SCREENS' ALL" "CHANGE 'PTRP.P310AA.MODEL' 'SYS3.PLATINUM.MODEL' ALL" "CHANGE 'PTRP.P310AA.NEW.SCREENS' 'SYS3.PLATINUM.NEW.SCREENS' ALL" "CHANGE 'PTRP.P310AA.OBJCICS' 'SYS3.PLATINUM.OBJCICS' ALL" "CHANGE 'PTRP.P310AA.OBJIMS' 'SYS3.PLATINUM.OBJIMS' ALL" "CHANGE 'PTRP.P310AA.OBJTSO' 'SYS3.PLATINUM.OBJTSO' ALL" "CHANGE 'PTRP.P310AA.PRODDATA' 'SYS3.PLATINUM.PRODDATA' ALL" "CHANGE 'PTRP.P310AA.SCREENS' 'SYS3.PLATINUM.SCREENS' ALL" "CHANGE 'PTRP.P310AA.SPFMLIB' 'SYS3.PLATINUM.SPFMLIB' ALL" "CHANGE 'PTRP.P310AA.SPFPLIB' 'SYS3.PLATINUM.SPFPLIB' ALL" "CHANGE 'PTRP.P310AA.SPFSLIB' 'SYS3.PLATINUM.SPFSLIB' ALL" "CHANGE 'PTRP.P310AA.SPFTLIB' 'SYS3.PLATINUM.SPFTLIB' ALL" "CHANGE 'PTRP.P310AA.SRCLIB' 'SYS3.PLATINUM.SRCLIB' ALL" "CHANGE 'PTRP.P310AA.XMESSAGE' 'SYS3.PLATINUM.XMESSAGE' ALL" "CHANGE 'PTRP.P310AC.UNLOAD.CNTL' 'SYS3.PLATINUM.P310AC.UNLOAD.CNTL' ALL" "CHANGE 'PTRP.P310AD.SCREENS' 'SYS3.PLATINUM.P310AD.SCREENS' ALL" "CHANGE 'PTRP.P310AD.UNLOAD.CNTL' 'SYS3.PLATINUM.P310AD.UNLOAD.CNTL' ALL" "CHANGE 'PTRP.P310AD1.UMLOAD.CNTL' 'SYS3.PLATINUM.P310AD1.UNLOAD.CNTL' ALL" "CHANGE 'PTRP.TAPE' 'SYS3.PLATINUM.TAPE' ALL" "CHANGE 'PTRP.TEXTLIB' 'SYS3.PLATINUM.TEXTLIB' ALL" "CHANGE 'PTRP.UNLOAD.CNTL' 'SYS3.PLATINUM.UNLOAD.CNTL' ALL" "CHANGE 'PTRP.USER.LOAD' 'SYS3.PLATINUM.USER.LOAD' ALL" "CHANGE 'SAS.CPE.CAT' 'SYS3.SAS.PROD.CPE.CAT' ALL" "CHANGE 'SAS.CPE.MISC' 'SYS3.SAS.PROD.CPE.MISC' ALL" "CHANGE 'SAS.CPE.SAMPSIO' 'SYS3.SAS.PROD.CPE.SAMPSIO' ALL" "CHANGE 'SAS.R608.AUTOLIB' 'SYS3.SAS.PROD.AUTOLIB' ALL" "CHANGE 'SAS.R608.BAMISC' 'SYS3.SAS.PROD.BAMISC' ALL" "CHANGE 'SAS.R608.CLIST' 'SYS3.SAS.PROD.CLIST' ALL" "CHANGE 'SAS.R608.CNTL' 'SYS3.SAS.PROD.CNTL' ALL" "CHANGE 'SAS.R608.LIBRARY' 'SYS3.SAS.PROD.LIBRARY' ALL" "CHANGE 'SAS.R608.LIBRARYO' 'SYS3.SAS.PROD.LIBRARYO' ALL" "CHANGE 'SAS.R608.NEWS' 'SYS3.SAS.PROD.NEWS' ALL" "CHANGE 'SAS.R608.PROCLIB' 'SYS3.SAS.PROD.PROCLIB' ALL" "CHANGE 'SAS.R608.SAMPLE' 'SYS3.SAS.PROD.SAMPLE' ALL" "CHANGE 'SAS.R608.SAMPSIO' 'SYS3.SAS.PROD.SAMPSIO' ALL" "CHANGE 'SAS.R608.SASHELP' 'SYS3.SAS.PROD.SASHELP' ALL" "CHANGE 'SAS.R608.SASMSG' 'SYS3.SAS.PROD.SASMSG' ALL" "CHANGE 'SAS.R608.TESTS' 'SYS3.SAS.PROD.TESTS' ALL" "CHANGE 'SAS.R608.USAGE.NOTES' 'SYS3.SAS.PROD.USAGE.NOTES' ALL" "CHANGE 'SAS.R608.USAGE.PGMS' 'SYS3.SAS.PROD.USAGE.PGMS' ALL" "CHANGE 'SAS.R608.USAGE.ZAPS' 'SYS3.SAS.PROD.USAGE.ZAPS' ALL" "CHANGE 'SWITCH.V50.LOADLIB' 'SYS3.SWITCH.LOADLIB' ALL" "CHANGE 'SWITCH.V50.SOURCE' 'SYS3.SWITCH.SOURCE' ALL" "CHANGE 'SYSM.R641.LOADLIB' 'SYS3.SYSM.PROD.LOADLIB' ALL" "CHANGE 'SYSM.R641.LOADLIB.FIX' 'SYS3.SYSM.PROD.LOADLIB.FIX' ALL" "CHANGE 'SYSM.R641.MACLIB' 'SYS3.SYSM.PROD.MACLIB' ALL" "CHANGE 'SYSM.R641.OBJLIB' 'SYS3.SYSM.PROD.OBJLIB' ALL" "CHANGE 'SYSM.R641.SAMPLIB' 'SYS3.SYSM.PROD.SAMPLIB' ALL" "CHANGE 'SYSM.R641.SAMPLIB.NEW' 'SYS3.SYSM.PROD.SAMPLIB.NEW' ALL" "CHANGE 'SYSM.R641.SOURCE' 'SYS3.SYSM.PROD.SOURCE' ALL" "CHANGE 'SYSM.R641.SOURCE.NEW' 'SYS3.SYSM.PROD.SOURCE.NEW' ALL" "CHANGE 'SYSMV.R641.SYSMARC' 'SYS3.SYSMV.PROD.SYSMARC' ALL" "CHANGE 'SYSMV.R641.SYSMCSH' 'SYS3.SYSMV.PROD.SYSMCSH' ALL" "CHANGE 'SYSMV.R641.SYSMIO' 'SYS3.SYSMV.PROD.SYSMIO' ALL" "CHANGE 'SYSMV.R641.SYSMIOX' 'SYS3.SYSMV.PROD.SYSMIOX' ALL" "CHANGE 'SYSMV.R641.SYSMLET' 'SYS3.SYSMV.PROD.SYSMLET' ALL" "CHANGE 'SYSMV.R641.SYSMLIS' 'SYS3.SYSMV.PROD.SYSMLIS' ALL" "CHANGE 'SYSMV.R641.SYSMPRN' 'SYS3.SYSMV.PROD.SYSMPRN' ALL" "CHANGE 'SYSMV.R641.SYSMPRT' 'SYS3.SYSMV.PROD.SYSMPRT' ALL" "CHANGE 'SYSMV.R641.SYSMREC' 'SYS3.SYSMV.PROD.SYSMREC' ALL" "CHANGE 'SYSMV.R641.SYSMSEN' 'SYS3.SYSMV.PROD.SYSMSEN' ALL" "CHANGE 'SYSMV.R641.SYSMUSER' 'SYS3.SYSMV.PROD.SYSMUSER' ALL" "CHANGE 'SYSMV.R641.SYSMWRD' 'SYS3.SYSMV.PROD.SYSMWRD' ALL" "CHANGE 'SYSMV.R641.SYSMZIP' 'SYS3.SYSMV.PROD.SYSMZIP' ALL" "CHANGE 'SYS1.ACFMAC' 'SYS3.CACOMMON.PROD.CAIMAC' ALL" "CHANGE 'SYS2.CAI.CA7.R30.LOADLIB' 'SYS2.CA7.PROD.LOADLIB' ALL" "CHANGE 'SYS2.CAI.COMMON.CAILIB' 'SYS2.CACOMMON.PROD.CAILIB' ALL" "CHANGE 'SYS2.CAI.COMMON.CAILPA' 'SYS2.CACOMMON.PROD.CAILPA' ALL" "CHANGE 'SYS2.CICS.LPALIB' 'SYS2.CICS.LPALIB' ALL" "CHANGE 'SYS2.ENDMVS.R360.CONLIB' 'SYS2.ENDMVS.PROD.CONLIB' ALL" "CHANGE 'SYS2.NOMAD.V550.CS.LINKLIB' 'SYS2.NOMAD.PROD.CS.LINKLIB' ALL" "CHANGE 'SYS2.VPS.R60.LOAD' 'SYS2.VPS.PROD.LOAD' ALL" "CHANGE 'SYS3.PLATINUM.CRDBASE' 'SYS3.PLATINUM.EDUCAT.CRDBASE.SOURCE' ALL" "CHANGE 'SYS3.PLATINUM.C02PROG.SOURCE' 'SYS3.PLATINUM.EDUCAT.C02PROG.SOURCE' ALL" "CHANGE 'SYS3.PLATINUM.C03DSN.SOURCE' 'SYS3.PLATINUM.EDUCAT.C03DSN.SOURCE' ALL" "CHANGE 'SYS3.PLATINUM.C04DBA.SOURCE' 'SYS3.PLATINUM.EDUCAT.C04DBA.SOURCE' ALL" "CHANGE 'SYS3.PLATINUM.C04DBA.V21.SOURCE' 'SYS3.PLATINUM.EDUCAT.C04DBA.V21.SOURCE' ALL" "CHANGE 'SYS3.PLATINUM.C05CSP.SOURCE' 'SYS3.PLATINUM.EDUCAT.C05CSP.SOURCE' ALL" "CHANGE 'SYS3.PLATINUM.C10CICS.LOADLIB' 'SYS3.PLATINUM.EDUCAT.C10CICS.LOADLIB' ALL" "CHANGE 'SYS3.PLATINUM.C10CICS.SOURCE' 'SYS3.PLATINUM.EDUCAT.C11APT.SOURCE' ALL" "CHANGE 'SYS3.PLATINUM.C11APT.DATA' 'SYS3.PLATINUM.EDUCAT.C11APT.DATA' ALL" "CHANGE 'SYS3.PLATINUM.EDTEST.SOURCE' 'SYS3.PLATINUM.EDUCAT.EDTEST.SOURCE' ALL" "CHANGE 'SYS3.PLATINUM.P01PRF.SOURCE' 'SYS3.PLATINUM.EDUCAT.P01PRF.SOURCE' ALL" "CHANGE 'TMONCICS.COMMON.ALERTA' 'SYS3.TMONCICS.COMMON.ALERTA' ALL" "CHANGE 'TMONCICS.COMMON.ALERTB' 'SYS3.TMONCICS.COMMON.ALERTB' ALL" "CHANGE 'TMONCICS.COMMON.CNTL' 'SYS3.TMONCICS.COMMON.CNTL' ALL" "CHANGE 'TMONCICS.COMMON.HISTORYA' 'SYS3.TMONCICS.COMMON.HISTORYA' ALL" "CHANGE 'TMONCICS.COMMON.HISTORYB' 'SYS3.TMONCICS.COMMON.HISTORYB' ALL" "CHANGE 'TMONCICS.COMMON.STRACEA' 'SYS3.TMONCICS.COMMON.STRACEA' ALL" "CHANGE 'TMONCICS.COMMON.STRACEB' 'SYS3.TMONCICS.COMMON.STRACEB' ALL" "CHANGE 'TMONCICS.COMMON.TMON01A' 'SYS3.TMONCICS.COMMON.TMON01A' ALL" "CHANGE 'TMONCICS.COMMON.TMON01B' 'SYS3.TMONCICS.COMMON.TMON01B' ALL" "CHANGE 'TMONCICS.COMMON.TMON02A' 'SYS3.TMONCICS.COMMON.TMON02A' ALL" "CHANGE 'TMONCICS.COMMON.TMON02B' 'SYS3.TMONCICS.COMMON.TMON02B' ALL" "CHANGE 'TMONCICS.COMMON.TMON03A' 'SYS3.TMONCICS.COMMON.TMON03A' ALL" "CHANGE 'TMONCICS.COMMON.TMON03B' 'SYS3.TMONCICS.COMMON.TMON03B' ALL" "CHANGE 'TMONCICS.DSTAPF81.LOADLIB' 'SYS3.TMONCICS.PROD.LOADLIB' ALL" "CHANGE 'TMONCICS.V81.DSTCNTL' 'SYS3.TMONCICS.PROD.DSTCNTL' ALL" "CHANGE 'TMONCICS.V81.DSTPTF' 'SYS3.TMONCICS.PROD.DSTPTF' ALL" "CHANGE 'TMONCICS.V81.DSTSAMP' 'SYS3.TMONCICS.PROD.DSTSAMP' ALL" "CHANGE 'TMONCICS.V81.INSTLIB' 'SYS3.TMONCICS.PROD.INSTALL' ALL" "CHANGE 'TMONCICS.V81.RFSHCNTL' 'SYS3.TMONCICS.PROD.RFSHCNTL' ALL" "CHANGE 'TMONCICS.V81.SEQHIST' 'SYS3.TMONCICS.SEQHIST' ALL" "CHANGE 'TMONCICS.V81.TMON01.ARCHIVE' 'SYS3.TMONCICS.TMON01.ARCHIVE' ALL" "CHANGE 'TMONCICS.V81.TMON02.ARCHIVE' 'SYS3.TMONCICS.TMON02.ARCHIVE' ALL" "CHANGE 'TMONCICS.V81.TMON03.ARCHIVE' 'SYS3.TMONCICS.TMON03.ARCHIVE' ALL" "CHANGE 'TMONMVS.V11.GDC.LSCM01A' 'SYS3.TMONMVS.PROD.GDC.LSCM01A' ALL" "CHANGE 'TMONMVS.V11.GDC.LSCM01B' 'SYS3.TMONMVS.PROD.GDC.LSCM01B' ALL" "CHANGE 'TMONMVS.V11.GDC.LSCM02A' 'SYS3.TMONMVS.PROD.GDC.LSCM02A' ALL" "CHANGE 'TMONMVS.V11.GDC.LSCM02B' 'SYS3.TMONMVS.PROD.GDC.LSCM02B' ALL" "CHANGE 'TMONMVS.V11.GDC.LSCM03A' 'SYS3.TMONMVS.PROD.GDC.LSCM03A' ALL" "CHANGE 'TMONMVS.V11.GDC.LSCM03B' 'SYS3.TMONMVS.PROD.GDC.LSCM03B' ALL" "CHANGE 'TMONMVS.V11.GDC.LSCM04A' 'SYS3.TMONMVS.PROD.GDC.LSCM04A' ALL" "CHANGE 'TMONMVS.V11.GDC.LSCM04B' 'SYS3.TMONMVS.PROD.GDC.LSCM04B' ALL" "CHANGE 'TMONMVS.V11.ML913B.SAMPLIB' 'SYS3.TMONMVS.PROD.SAMPLIB' ALL" "CHANGE 'TMONMVS.V11.ML913D.CONTROL.FILE' 'SYS3.TMONMVS.PROD.CONTROL.FILE' ALL" "CHANGE 'TMONMVS.V11.ML913D.INSTLIB' 'SYS3.TMONMVS.PROD.INSTLIB' ALL" "CHANGE 'TMONMVS.V11.ML913D.LOADLIB' 'SYS3.TMONMVS.PROD.LOADLIB' ALL" "CHANGE 'TMONMVS.V11.ML913D.SAMPLIB' 'SYS3.TMONMVS.PROD.SAMPLIB' ALL" "CHANGE 'TRACS.COMMON.DOCLIB' 'SYS3.TRACS.PROD.DOCLIB' ALL" "CHANGE 'TRACS.COMMON.JCL' 'SYS3.TRACS.PROD.JCL' ALL" "CHANGE 'TRACS.COMMON.WEEKLOG' 'SYS3.TRACS.PROD.WEEKLOG' ALL" "CHANGE 'TRACS.V40.BACKUP.BATCH' 'SYS3.TRACS.BACKUP.BATCH' ALL" "CHANGE 'TRACS.V40.BACKUP.CONTROL' 'SYS3.TRACS.BACKUP.CONTROL' ALL" "CHANGE 'TRACS.V40.BACKUP.OFFLADD' 'SYS3.TRACS.BACKUP.OFFLADD' ALL" "CHANGE 'TRACS.V40.BATCH' 'SYS3.TRACS.PROD.BATCH' ALL" "CHANGE 'TRACS.V40.CONTROL' 'SYS3.TRACS.PROD.CONTROL' ALL" "CHANGE 'TRACS.V40.LOG' 'SYS3.TRACS.PROD.LOG' ALL" "CHANGE 'TRACS.V40.OFFLADD' 'SYS3.TRACS.PROD.OFFLADD' ALL" "CHANGE 'TRACS.V40.OFFLINE.LOG' 'SYS3.TRACS.PROD.OFFLINE.LOG' ALL" "CHANGE 'TRACS.V42.DUMP' 'SYS3.TRACS.PROD.DUMP' ALL" "CHANGE 'TRACS.V42.LOAD' 'SYS3.TRACS.PROD.LOAD' ALL" "CHANGE 'TRACS.V42.OBJECT' 'SYS3.TRACS.PROD.OBJECT' ALL" "CHANGE 'TRACS.V42.OPTFILE' 'SYS3.TRACS.PROD.OPTFILE' ALL" "CHANGE 'TRACS.V42.OUTFILE' 'SYS3.TRACS.PROD.OUTFILE' ALL" "CHANGE 'TRACS.V42.SNAPOUT' 'SYS3.TRACS.PROD.SNAPOUT' ALL" "CHANGE 'TRACS.V42.SOURCE' 'SYS3.TRACS.PROD.SOURCE' ALL" "CHANGE 'TSSO.V43.ASM' 'SYS3.TSSO.PROD.ASM' ALL" "CHANGE 'TSSO.V43.LOAD' 'SYS3.TSSO.PROD.LOAD' ALL" "CHANGE 'VDS.R31B.INSTALL' 'SYS3.SAMALLOC.INSTALL' ALL" "CHANGE 'VDS.R31B.ISPMLIB' 'SYS3.SAMALLOC.PROD.ISPMLIB' ALL" "CHANGE 'VDS.R31B.ISPPLIB' 'SYS3.SAMALLOC.PROD.ISPPLIB' ALL" "CHANGE 'VDS.R31B.LOADLIB' 'SYS3.SAMALLOC.PROD.LOADLIB' ALL" "CHANGE 'VDS.R31B.LOADLIB.BACKUP' 'SYS3.SAMALLOC.MAINT.LOADLIB' ALL" "CHANGE 'VPS.R60.ASM' 'SYS3.VPS.PROD.ASM' ALL" "CHANGE 'VPS.R60.CICS.ASM' 'SYS3.VPS.PROD.CICS.ASM' ALL" "CHANGE 'VPS.R60.CICS.CNTL' 'SYS3.VPS.PROD.CICS.CNTL' ALL" "CHANGE 'VPS.R60.CICS.LOAD' 'SYS3.VPS.PROD.CICS.LOAD' ALL" "CHANGE 'VPS.R60.CICS.MACLIB' 'SYS3.VPS.PROD.CICS.MACLIB' ALL" "CHANGE 'VPS.R60.CNTL' 'SYS3.VPS.PROD.CNTL' ALL" "CHANGE 'VPS.R60.LOAD' 'SYS3.VPS.PROD.LOAD' ALL" "CHANGE 'VPS.R60.MACLIB' 'SYS3.VPS.PROD.MACLIB' ALL" "CHANGE 'VPS.R60.PARMLIB' 'SYS3.VPS.PROD.PARMLIB' ALL" "CHANGE 'VPS.R60.PARMLIBO' 'SYS3.VPS.PROD.TSO.ASM' ALL" "CHANGE 'VPS.R60.TSO.ASM' 'SYS3.VPS.PROD.TSO.ASM' ALL" "CHANGE 'VPS.R60.TSO.CNTL' 'SYS3.VPS.PROD.TSO.CNTL' ALL" "CHANGE 'VPS.R60.TSO.LOAD' 'SYS3.VPS.PROD.TSO.LOAD' ALL" "CHANGE 'VPS.R60.TSO.MACLIB' 'SYS3.VPS.PROD.TSO.MACLIB' ALL" "CHANGE 'WINDOW.R20.LOADLIB' 'SYS3.WINDOW.PROD.LOADLIB' ALL" "CHANGE 'WINDOW.R20.SOURCE' 'SYS3.WINDOW.PROD.SOURCE' ALL" "CHANGE 'XPEDITER.CICSR620.EMPLOYEE.FILE' 'SYS3.XPEDITER.PROD.CICS.EMPLOYEE.FILE' ALL" "CHANGE 'XPEDITER.CICSR620.LISTING.FILE' 'SYS3.XPEDITER.PROD.CICS.LISTING.FILE' ALL" "CHANGE 'XPEDITER.CICSR620.LOADLIB' 'SYS3.XPEDITER.PROD.CICS.LOADLIB' ALL" "CHANGE 'XPEDITER.CICSR620.OBJECT' 'SYS3.XPEDITER.PROD.CICS.OBJECT' ALL" "CHANGE 'XPEDITER.CICSR620.PROFILE' 'SYS3.XPEDITER.PROD.CICS.PROFILE.FILE' ALL" "CHANGE 'XPEDITER.CICSR620.SORCMAC' 'SYS3.XPEDITER.PROD.CICS.SORCMAC' ALL" "CHANGE 'XPEDITER.CICSR620.SQL.XFER.FILE' 'SYS3.XPEDITER.PROD.CICS.SQL.XFER.FILE' ALL" "CHANGE 'XPEDITER.CICSR620.T3A1.LISTING.FILE' 'SYS3.XPEDITER.PROD.T3A1.LISTING.FILE' ALL" "CHANGE 'XPEDITER.CICSR620.T3A2.LISTING.FILE' 'SYS3.XPEDITER.PROD.T3A2.LISTING.FILE' ALL" "CHANGE 'XPEDITER.COMMON.INSTALL' 'SYS3.XPEDITER.PROD.INSTALL' ALL" "CHANGE 'XPEDITER.COMMON.LOADLIB' 'SYS3.XPEDITER.PROD.TSO.LOADLIB' ALL" "CHANGE 'XPEDITER.COMMON.SIR' 'SYS3.XPEDITER.PROD.TSO.SIR' ALL" "CHANGE 'XPEDITER.COMMON.XMESSAGE' 'SYS3.XPEDITER.PROD.TSO.XMESSAGE' ALL" "CHANGE 'XPEDITER.COMMON.XOPTIONS' 'SYS3.XPEDITER.PROD.TSO.XOPTIONS' ALL" "CHANGE 'XPEDITER.TSOR51.CLIST' 'SYS3.XPEDITER.PROD.TSO.CLIST' ALL" "CHANGE 'XPEDITER.TSOR51.HELP' 'SYS3.XPEDITER.PROD.TSO.HELP' ALL" "CHANGE 'XPEDITER.TSOR51.LOADLIB' 'SYS3.XPEDITER.PROD.TSO.LOADLIB' ALL" "CHANGE 'XPEDITER.TSOR51.MSGS' 'SYS3.XPEDITER.PROD.TSO.MSGS' ALL" "CHANGE 'XPEDITER.TSOR51.OBJECT' 'SYS3.XPEDITER.PROD.TSO.OBJECT' ALL" "CHANGE 'XPEDITER.TSOR51.PANELS' 'SYS3.XPEDITER.PROD.TSO.PANELS' ALL" "CHANGE 'XPEDITER.TSOR51.REBUILD' 'SYS3.XPEDITER.PROD.TSO.REBUILD' ALL" "CHANGE 'XPEDITER.TSOR51.SAMPLIB' 'SYS3.XPEDITER.PROD.TSO.SAMPLIB' ALL" "CHANGE 'XPEDITER.TSOR51.SKELS' 'SYS3.XPEDITER.PROD.TSO.SKELS' ALL" "CHANGE 'XPEDITER.TSOR51.SORCMAC' 'SYS3.XPEDITER.PROD.TSO.SORCMAC' ALL" "CHANGE 'XPEDITER.TSOR51.TABLES' 'SYS3.XPEDITER.PROD.TSO.TABLES' ALL" "CHANGE 'XPEDITER.TSOR53.CLIST' 'SYS3.XPEDITER.PROD.TSO.CLIST' ALL" "CHANGE 'XPEDITER.TSOR53.HELP' 'SYS3.XPEDITER.PROD.TSO.HELP' ALL" "CHANGE 'XPEDITER.TSOR53.INCLUDE' 'SYS3.XPEDITER.PROD.TSO.INCLUDE' ALL" "CHANGE 'XPEDITER.TSOR53.LOADLIB' 'SYS3.XPEDITER.PROD.TSO.LOADLIB' ALL" "CHANGE 'XPEDITER.TSOR53.MSGS' 'SYS3.XPEDITER.PROD.TSO.MSGS' ALL" "CHANGE 'XPEDITER.TSOR53.OBJECT' 'SYS3.XPEDITER.PROD.TSO.OBJECT' ALL" "CHANGE 'XPEDITER.TSOR53.PANELS' 'SYS3.XPEDITER.PROD.TSO.PANELS' ALL" "CHANGE 'XPEDITER.TSOR53.REBUILD' 'SYS3.XPEDITER.PROD.TSO.REBUILD' ALL" "CHANGE 'XPEDITER.TSOR53.SAMPLIB' 'SYS3.XPEDITER.PROD.TSO.SAMPLIB' ALL" "CHANGE 'XPEDITER.TSOR53.SIR' 'SYS3.XPEDITER.PROD.TSO.SIR' ALL" "CHANGE 'XPEDITER.TSOR53.SKELS' 'SYS3.XPEDITER.PROD.TSO.SKELS' ALL" "CHANGE 'XPEDITER.TSOR53.SORCMAC' 'SYS3.XPEDITER.PROD.TSO.SORCMAC' ALL" "CHANGE 'XPEDITER.TSOR53.TABLES' 'SYS3.XPEDITER.PROD.TSO.TABLES' ALL" "CHANGE 'XPEDITER.TSOR53.UNLOAD.XPIMSDB' 'SYS3.XPEDITER.PROD.TSO.UNLOAD.XPIMSDB' ALL" "CHANGE 'XPEDITER.TSOR53.UNLOAD.XPIMSDBT' 'SYS3.XPEDITER.PROD.TSO.UNLOAD.XPIMSDBT' ALL" "CHANGE 'XPEDITER.TSOR53.XMESSAGE' 'SYS3.XPEDITER.PROD.TSO.XMESSAGE' ALL" "CHANGE 'XPEDITER.TSOR53.XOPTIONS' 'SYS3.XPEDITER.PROD.TSO.XOPTIONS' ALL" "CHANGE 'XPEDITER.TTFCICS.SIR' 'SYS3.XPEDITER.PROD.TTFCICS.SIR' ALL" ./ ADD NAME=ESFRECD /********************************************************************** /* UTILITY: ESFRECD * /* AUTHOR: DAVID LEIGH * /* FUNCTION: THIS UTILITY PROMPTS FOR INPUT OF A DB2 TABLE NAME AND AN* /* ASSOCIATED CSP RECORD NAME, AN ENDEVOR CCID, AND AN * /* ENDEVOR COMMENT. IT THEN CREATES JCL WHICH: * /* 1. RETRIEVES A RECORD FROM ENDEVOR * /* 2. EXTRACTS THAT TABLE/VIEW'S INFORMATION FROM DB2 * /* 3. CREATES AN ESF FORMAT RECORD FROM THE DB2 INFO. * /* 4. ADDS THAT BACK INTO ENDEVOR * /********************************************************************** PROC 0 TABLE() + CREATOR(USSTRD00) + RECORD() + CCID() + COMMENT() + ENVIRON(QUAL) + STAGE(D) + TYPE(RECD) + SYSTEM(STR) + SUBSYS(UNIPAC) + XRFILE('DUSC1.STR.DOCLIB(CSPDB2XR)') + TEMPJCL('&SYSUID..TEMP.ESFRECD.JCL') + JCLREVEW(N) + HELP + DEBUG /*** CHECK THE DEBUG SWITCH ***/ IF &DEBUG = DEBUG THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS IF &HELP = HELP THEN GOTO HELPSEC 02 /********************************************************************** /* GET THE USER'S FULL NAME * /********************************************************************** SET SYSOUTTRAP = 1000 ACF LIST * END SET SYSOUTTRAP = 0 SET SYSDVAL = &STR(&SYSNSUB(1,&SYSOUTLINE1)) READDVAL A B NAME1 NAME2 NAME3 NAME4 NAME5 SET FULLNAME = &STR(&NAME1 &NAME2 &NAME3 &NAME4 &NAME5) 02 /********************************************************************** /* ESTABLISH SOME PROCESSING VARIABLES * /********************************************************************** CALL 'SYS2.USC1.LINKLIB(USERINFO)' '&SYSUID ' SET TEMPJCL = &STR(&TEMPJCL) SET LP = &STR(( SET RP = &STR() /********************************************************************** /* DISPLAY THE PANEL IF NO INPUT WAS PASSED * /********************************************************************** IF &STR(&TABLE) > AND + &STR(&RECORD) > AND + &STR(&CCID) > AND + &STR(&COMMENT) > THEN GOTO PROCESS ISPEXEC VGET (TABLE RECORD CCID COMMENT) SHARED REDISPLAY: + SET GENERATE = ISPEXEC DISPLAY PANEL(ESFRECD) IF &LASTCC > 7 THEN + DO IF &STR(&GENERATE) = Y THEN + DO SET ZEDSMSG = SET ZEDLMSG = &STR(*** SET GENERATE TO "N" BEFORE + QUITTING OR PRESS TO + GENERATE ***) ISPEXEC SETMSG MSG(UTLZ001W) GOTO REDISPLAY END GOTO FINISH END ELSE + DO /************************************************************** /* PERMIT DYNAMIC DEBUG TOGGLEING * /************************************************************** IF &ZCMD = &STR(DEBUG ON) THEN + DO SET DEBUG = DEBUG SET ZEDSMSG = &STR(DEBUG ON) SET ZEDLMSG = &STR(THE DEBUG SWITCH HAS BEEN SET ON) ISPEXEC SETMSG MSG(UTLZ000) GOTO REDISPLAY END IF &ZCMD = &STR(DEBUG OFF) THEN + DO SET DEBUG = DEBUG SET ZEDSMSG = &STR(DEBUG OFF) SET ZEDLMSG = &STR(THE DEBUG SWITCH HAS BEEN SET OFF) ISPEXEC SETMSG MSG(UTLZ000) GOTO REDISPLAY END /************************************************************** /* GET A TABLE/VIEW LIST FROM DB2 * /************************************************************** IF &SYSINDEX(&STR(%),&STR(&TABLE)) > 0 THEN + SYSCALL GET_TABLE TABLE CREATOR DEBUG /************************************************************** /* GET A CSP RECORD NAME FROM THE CROSS REFERENCE FILE * /************************************************************** IF &STR(&RECORD) = &STR(?) AND + &STR(&TABLE) > THEN + DO ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY PANEL(ESFRECD) ISPEXEC SELECT + CMD(%ESFRECD2 TABLE(&TABLE) XRFILE(&XRFILE)) IF &LASTCC = 2000 THEN + DO SET ZEDSMSG = SET ZEDLMSG = &STR(*** COULD NOT FIND A + CSP RECORD IN THE CROSS + REFERENCE FILE FOR THIS + TABLE ***) ISPEXEC SETMSG MSG(UTLZ001W) SET RECORD = GOTO REDISPLAY END ELSE ISPEXEC VGET RECORD SHARED END /************************************************************** /* PROCESS THE PROLOGUE OVERRIDE FLAG IF SET * /************************************************************** ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY PANEL(ESFRECD) SELECT (&STR(&PROLOVRD)) /********************************************************** /* REFRESH THE PROLOGUE OVERRIDE FROM THE CROSS REFERENCE * /********************************************************** WHEN (R) DO ISPEXEC SELECT CMD(%ESFRECD4 XRFILE(&XRFILE) + RECORD(&RECORD) + &DEBUG) IF &LASTCC = 2000 THEN + DO SET ZEDSMSG = SET ZEDLMSG = &STR(*** COULD NOT FIND A + CSP RECORD IN THE CROSS + REFERENCE FILE FOR THIS + TABLE ***) ISPEXEC SETMSG MSG(UTLZ001W) SET PROLOVRD = N ISPEXEC VGET PROVRDSN SHARED GOTO REDISPLAY END ELSE + SET PROLOVRD = Y ISPEXEC VGET PROVRDSN SHARED END /********************************************************** /* EDIT THE PROLOGUE OVERRIDE (BUILD FIRST IF NECESSARY) * /********************************************************** WHEN (E) DO LISTDSI '&PROVRDSN' IF &LASTCC ¬= 0 THEN + DO ISPEXEC SELECT CMD(%ESFRECD4 XRFILE(&XRFILE) + RECORD(&RECORD) + &DEBUG) ISPEXEC VGET PROVRDSN SHARED END ISPEXEC EDIT DATASET('&PROVRDSN') SET PROLOVRD = Y ISPEXEC VGET PROVRDSN SHARED END /********************************************************** /* SELECT THE PROLOGUE OVERRIDE (BUILD 1ST IF NECESSARY) * /********************************************************** WHEN (Y) DO ISPEXEC VGET PROVRDSN SHARED LISTDSI '&PROVRDSN' IF &LASTCC ¬= 0 THEN + DO ISPEXEC SELECT CMD(%ESFRECD4 XRFILE(&XRFILE) + RECORD(&RECORD) + &DEBUG) IF &LASTCC = 2000 THEN + DO SET ZEDSMSG = SET ZEDLMSG = &STR(*** COULD NOT FIND + A CSP RECORD IN THE + CROSS REFERENCE + FILE FOR THIS TABLE + ***) ISPEXEC SETMSG MSG(UTLZ001W) SET PROLOVRD = N GOTO REDISPLAY END END END END /************************************************************** /* GO BACK TO REDISPLAY IF THE USER'S NOT READY TO GENERATE * /************************************************************** IF &STR(&GENERATE) ¬= Y THEN GOTO REDISPLAY END /********************************************************************** /* PROCESS THE INPUT REQUEST * /********************************************************************** PROCESS: + SET ZEDSMSG = SET ZEDLMSG = &STR(*** CREATING THE JCL ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) DELETE '&TEMPJCL' FREE DDNAME(ISPFILE) ALLOCATE DDNAME(ISPFILE) DSN('&TEMPJCL') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK$$$) + SPACE(1,1) TRACKS RELEASE + RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS) ISPEXEC FTOPEN ISPEXEC FTINCL ESFRECD SET SAVECC = &LASTCC ISPEXEC FTCLOSE FREE DDNAME(ISPFILE) IF &SAVECC > 0 THEN + DO ISPEXEC VGET ZERRLM SET ZEDSMSG = &STR(JCL CREATION ERROR) SET ZEDLMSG = &STR(&ZERRLM) ISPEXEC SETMSG MSG(UTLZ001) END IF &JCLREVEW = &STR(Y) THEN + DO SET ZEDLMSG = &STR(*** NOTE: YOU MUST SUBMIT THIS + JCL YOURSELF ***) ISPEXEC SETMSG MSG(UTLZ000W) ISPEXEC EDIT DATASET('&TEMPJCL') END ELSE + DO SUBMIT '&TEMPJCL' SET ZEDSMSG = &STR(JOB SUBMITTED) SET ZEDLMSG = &STR(*** THE CREATED JCL WAS SUBMITTED ***) ISPEXEC SETMSG MSG(UTLZ000) END GOTO REDISPLAY /********************************************************************** /* GET OUT! * /********************************************************************** FINISH: EXIT /********************************************************************** /* QUERY DB2 TO GET A LIST OF TABLE NAMES * /********************************************************************** GET_TABLE: PROC 3 TABLE CREATOR DEBUG SYSREF &TABLE &CREATOR &DEBUG CONTROL END(END@) SET ZEDSMSG = SET ZEDLMSG = &STR(*** CREATING A DB2 TABLE LIST FROM THE CATALOG ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) FREE DD(SYSREC00 SYSIN SYSPRINT SYSPUNCH) IF &DEBUG = DEBUG THEN + DO ALLOC DD(SYSPRINT) DA(*) ALLOC DD(SYSPUNCH) DA(*) END@ ELSE + DO ALLOC DD(SYSPRINT) DUMMY ALLOC DD(SYSPUNCH) DUMMY END@ SET DB2DSN = &STR(&SYSUID..TEMP.ESFRECD.TABLES) DELETE '&DB2DSN' ALLOC DD(SYSREC00) DSN('&DB2DSN') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK$$$) + SPACE(1,1) TRACKS RELEASE ALLOC DD(SYSIN) + NEW + UNIT(SYSDA) VOLUME(WRK$$$) + SPACE(1,1) TRACKS RELEASE + RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS) OPENFILE SYSIN OUTPUT SET SYSIN = &STR(ESFRECD WHERE NAME LIKE '&TABLE' + AND CREATOR LIKE '&CREATOR') PUTFILE SYSIN CLOSFILE SYSIN DSN SYSTEM(DSNT) RUN PROGRAM(DSNTIAUL) PLAN(DSNTIAUL) - LIB('SYS4.DSN.DSNT.RUNLIB.LOAD') END FREE DD(SYSREC00 SYSIN SYSPRINT SYSPUNCH) ISPEXEC EDIT DATASET('&DB2DSN') MACRO(ESFRECDM) ISPEXEC VGET COUNT SHARED IF &COUNT = 1 THEN + DO SET ZTDSELS = 1 ISPEXEC VGET (CREATOR TABLE) SHARED GOTO SELECT_SECTION END@ /********************************************************************** /* SHOW THE LIST ON A SCREEN SO THE USER CAN CHOOSE ONE * /********************************************************************** DISPLAY_TABLES: + SET ZTDMARK = &STR(*** END OF DB2 TABLES/VIEWS LIKE "&TABLE" ***) ISPEXEC TBDISPL TEMPESFR PANEL(ESFRECD2) SET PANELCC = &LASTCC IF &PANELCC > 8 THEN + DO SET ZEDLMSG = &STR(PROBABLE ERROR IN ESFRECD2 PANEL. + TBDISPL RC = &PANELCC) ISPEXEC SETMSG MSG(UTLZ001W) GOTO FINISH_PROC END@ /********************************************************************** /* SEE HOW MANY THE USER SELECTED. THEY CAN ONLY DO ONE! * /********************************************************************** SELECT_SECTION: + SELECT (&ZTDSELS) WHEN (0) DO SET TABLE = SET CREATOR = IF &PANELCC > 7 THEN GOTO FINISH_PROC GOTO DISPLAY_TABLES END@ WHEN (1) GOTO FINISH_PROC OTHERWISE DO SET ZEDSMSG = &STR(SELECT ONLY 1) SET ZEDLMSG = &STR(YOU MAY SELECT ONLY 1 TABLE ON THIS SCREEN) ISPEXEC SETMSG MSG(UTLZ001) SET SEL = SET ZTDSELS = GOTO DISPLAY_TABLES END@ END@ FINISH_PROC: RETURN END@ ./ ADD NAME=ESFRECDM /********************************************************************** /* MACRO: ESFRECDM * /* AUTHOR: DAVID LEIGH * /* FUNCTION: THIS EDIT MACRO WORKS WITH THE ESFRECD UTILITY TO EDIT * /* THE OUTPUT OF DSNTIAUL AND LOAD IT INTO AN ISPF TABLE. * /* THIS MACRO CONTROLS THE CREATION OF THE TABLE AS WELL. * /********************************************************************** ISREDIT MACRO ISPEXEC CONTROL ERRORS RETURN /*** CHECK THE DEBUG SWITCH ***/ IF &DEBUG = DEBUG THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS /********************************************************************** /* CREATE THE TEMPORARY TABLE * /********************************************************************** ISPEXEC TBCREATE TEMPESFR KEYS(CREATOR TABLE) NOWRITE REPLACE /********************************************************************** /* GET RID OF THE NASTY HEX CHARACTERS * /********************************************************************** ISREDIT CHANGE ALL P'.' ' ' /********************************************************************** /* LOOP THROUGH AND LOAD THE TABLE * /********************************************************************** SET COUNT = 0 ISREDIT FIND FIRST P'=' 1 NX DO WHILE &LASTCC = 0 ISREDIT (LINE) = LINE .ZCSR SET TABLE = &SUBSTR(03:20,&STR(&SYSNSUB(1,&LINE))) SET CREATOR = &SUBSTR(21:28,&STR(&SYSNSUB(1,&LINE))) SET TABLE = &TABLE SET CREATOR = &CREATOR ISPEXEC TBADD TEMPESFR SET COUNT = &COUNT + 1 ISREDIT FIND NEXT P'=' 1 NX END /********************************************************************** /* SORT THE TABLE, RESET TO THE TOP AND GET OUT! * /********************************************************************** ISPEXEC TBSORT TEMPESFR FIELDS(CREATOR,C,A,TABLE,C,A) ISPEXEC TBTOP TEMPESFR ISPEXEC VPUT COUNT SHARED IF &COUNT = 1 THEN ISPEXEC VPUT (CREATOR TABLE) SHARED ISREDIT CANCEL ./ ADD NAME=ESFRECD2 /********************************************************************** /* UTILITY: ESFRECD2 * /* AUTHOR: DAVID LEIGH * /* FUNCTION: THIS CLIST WORKS WITH THE ESFRECD UTILITY. IT DOES THE * /* CROSS REFERENCING BETWEEN DB2 AND CSP BY INVOKING THE * /* CSP BATCH UTILITY TO FIND THE CSP RECORD NAME WHICH * /* CORRESPONDS WITH A DB2 TABLE/VIEW * /********************************************************************** PROC 0 XRFILE() TABLE() DEBUG /*** CHECK THE DEBUG SWITCH ***/ IF &DEBUG = DEBUG THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS /********************************************************************** /* INFORM THE USER * /********************************************************************** SET ZEDSMSG = SET ZEDLMSG = &STR(*** LOOKING FOR CSP RECORD FOR DB2 TABLE/VIEW + "&TABLE" ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) /********************************************************************** /* LOOP THROUGH THE CROSS REFERENCE FILE LOOKING FOR A DB2 TABLE * /* AND VPUT THE CSP RECORD NAME FOUND WITH IT. * /********************************************************************** /********************************************************************** /* ALLOCATION * /********************************************************************** FREE DD(TEMPDD) ALLOC DD(TEMPDD) DSN('&XRFILE') SHR /********************************************************************** /* ERROR/EOF PROCESSING SETUP * /********************************************************************** ERROR DO SET ERRCC = &LASTCC SELECT (&ERRCC) WHEN (400) DO SET EOF = YES RETURN END OTHERWISE DO ERROR OFF WRITE *** ERROR CC: &ERRCC OCCURRED READING "&XRFILE" *** CLOSFILE TEMPDD FREE DD(TEMPDD) EXIT END END END /********************************************************************** /* READ INITIALIZATION * /********************************************************************** SET FINALCC = 2000 SET SWITCH = OFF SET EOF = NO OPENFILE TEMPDD GETFILE TEMPDD /********************************************************************** /* READ LOOP * /********************************************************************** DO WHILE &EOF = NO IF &SYSINDEX(&STR(**********),&STR(&SYSNSUB(1,&TEMPDD))) = 1 THEN + DO SET SWITCH = ON GOTO GET_ANOTHER END IF &SWITCH = ON THEN + DO SET SYSDVAL = &STR(&SYSNSUB(1,&TEMPDD)) READDVAL RECORD XTABLE NULL IF &STR(&TABLE) = &STR(&XTABLE) THEN + DO SET FINALCC = 0 ISPEXEC VPUT RECORD SHARED GOTO FINISH END END SET SWITCH = OFF GET_ANOTHER: + GETFILE TEMPDD END /********************************************************************** /* CLEANUP AND GET OUT! * /********************************************************************** FINISH: + ERROR OFF CLOSFILE TEMPDD FREE DD(TEMPDD) EXIT CODE(&FINALCC) ./ ADD NAME=ESFRECD3 /********************************************************************** /* UTILITY: ESFRECD3 * /* AUTHOR: DAVID LEIGH * /* FUNCTION: THIS UTILITY WORKS WITH THE ESFRECD UTILITY TO CREATE * /* CSP RECORDS IN ESF FORMAT FOR LOADING INTO ENDEVOR. * /* IT IS INVOKED FROM BATCH. * /********************************************************************** PROC 1 RECORD DEBUG /*** CHECK THE DEBUG SWITCH ***/ IF &DEBUG = DEBUG THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS /********************************************************************** /* CREATE 2 TEMPORARY ISPF TABLES TO HOLD THE DB2 INFORMATION * /********************************************************************** ISPEXEC TBCREATE TEMPDB2 NOWRITE REPLACE KEYS() + NAMES(TABLE CREATOR COLUMN TYPE COLLEN SCALE DATACODE) ISPEXEC TBCREATE TEMPDB2R NOWRITE REPLACE KEYS() + NAMES(REMARKS) /********************************************************************** /* LOAD THE TABLE WITH INPUT FROM THE FILE * /********************************************************************** ERROR DO SET ERRCC = &LASTCC SELECT (&ERRCC) WHEN (400) DO SET EOF = YES RETURN END OTHERWISE DO ERROR OFF WRITE *** ERROR CC: &ERRCC OCCURRED READING INPUTDD *** CLOSFILE INPUTDD FREE DD(INPUTDD) EXIT CODE(&ERRCC) END END END SET SWITCH = OFF SET EOF = NO OPENFILE INPUTDD GETFILE INPUTDD DO WHILE &EOF = NO SET DATACODE = SET CREATOR = &SUBSTR(006:013,&STR(&SYSNSUB(1,&INPUTDD))) SET TABLE = &SUBSTR(014:031,&STR(&SYSNSUB(1,&INPUTDD))) SET COLUMN = &SUBSTR(032:049,&STR(&SYSNSUB(1,&INPUTDD))) SET COLLEN = &SUBSTR(058:062,&STR(&SYSNSUB(1,&INPUTDD))) SET TYPE = &SUBSTR(050:057,&STR(&SYSNSUB(1,&INPUTDD))) SELECT (&TYPE) WHEN (INTEGER ³ SMALLINT) SET TYPE = &STR(BIN) WHEN (DECIMAL) DO SET COLLEN = &EVAL((&COLLEN / 2) + 1) SET COLLEN = &SUBSTR(&LENGTH(&STR(00000&COLLEN))-4:+ &LENGTH(&STR(00000&COLLEN)),+ &STR(00000&COLLEN)) SET TYPE = &STR(PACK) END WHEN (DATE) DO SET COLLEN = &STR(00010) SET TYPE = &STR(CHA) END WHEN (TIMESTMP) DO SET COLLEN = &STR(00026) SET TYPE = &STR(CHA) END WHEN (CHAR) DO SET TYPE = &STR(CHA) SET DATACODE = &STR(DATACODE = 453) END WHEN (VARCHAR) DO SET TYPE = &STR(CHA) IF &COLLEN < 255 THEN SET DATACODE = &STR(DATACODE = 449) ELSE SET DATACODE = &STR(DATACODE = 457) END END SET SCALE = &SUBSTR(063:067,&STR(&SYSNSUB(1,&INPUTDD))) SET REMARKS = &SUBSTR(068:321,&STR(&SYSNSUB(1,&INPUTDD))) ISPEXEC TBADD TEMPDB2 GETFILE INPUTDD END ERROR OFF CLOSFILE INPUTDD ISPEXEC TBTOP TEMPDB2 /********************************************************************** /* PARSE OUT THE REMARKS TO FORMAT THE PROLOGUE * /* INITIALLY TRY FOR THE CONTENTS OF THE PROLOGUE DD. * /********************************************************************** ERROR DO SET ERRCC = &LASTCC SELECT (&ERRCC) WHEN (400) DO SET EOF = YES RETURN END OTHERWISE DO ERROR OFF WRITE *** ERROR CC: &ERRCC OCCURRED READING PROLOGUE *** CLOSFILE PROLOGUE FREE DD(PROLOGUE) EXIT END END END SET PRO_LINES = 0 SET SWITCH = OFF SET EOF = NO OPENFILE PROLOGUE GETFILE PROLOGUE DO WHILE &EOF = NO IF &SYSINDEX(&STR(:PROL.),+ &SYSCAPS(&STR(&SYSNSUB(1,&PROLOGUE)))) > 0 THEN + DO SET SWITCH = ON GOTO KEEP_GETTING END IF &SWITCH = ON THEN + DO IF &SYSINDEX(&STR(:EPROL.),+ &SYSCAPS(&STR(&SYSNSUB(1,&PROLOGUE)))) > 0 THEN + SET EOF = YES ELSE + DO SET PRO_LINES = &PRO_LINES + 1 SET REMARKS = &STR(&SYSNSUB(1,&PROLOGUE)) ISPEXEC TBADD TEMPDB2R END END KEEP_GETTING: + GETFILE PROLOGUE END ERROR OFF CLOSFILE PROLOGUE IF &PRO_LINES > 1 THEN GOTO TAILOR /********************************************************************** /* IF NOTHING IN THE PROLOGUE FILE CHECK THE DB2 "REMARKS". * /********************************************************************** SET REM_REMARKS = &STR(&SYSNSUB(1,&REMARKS)) DO WHILE &STR(&SYSNSUB(1,&REM_REMARKS)) > &STR( ) SET REM_LENGTH = &LENGTH(&SYSNSUB(1,&REM_REMARKS)) SET LIMIT = 60 IF &LIMIT >= &REM_LENGTH THEN + DO SET REMARKS = &STR(&SYSNSUB(1,&REM_REMARKS)) ISPEXEC TBADD TEMPDB2R SET REM_REMARKS = END ELSE + DO DO WHILE &SUBSTR(&LIMIT:&LIMIT,+ &STR(&SYSNSUB(1,&REM_REMARKS))) ¬= &STR( ) AND + &LIMIT > 1 SET &LIMIT = &LIMIT - 1 END SET REMARKS = &SUBSTR(1:&LIMIT,+ &STR(&SYSNSUB(1,&REM_REMARKS))) ISPEXEC TBADD TEMPDB2R SET LIMIT = &LIMIT + 1 DO WHILE &SUBSTR(&LIMIT:&LIMIT,+ &STR(&SYSNSUB(1,&REM_REMARKS))) = &STR( ) SET &LIMIT = &LIMIT + 1 IF &LIMIT > 254 THEN + DO SET LIMIT = 254 GOTO CONTINUE_1 END IF &LIMIT > &REM_LENGTH THEN + DO SET LIMIT = &REM_LENGTH GOTO CONTINUE_1 END END CONTINUE_1: + SET REM_REMARKS = &SUBSTR(&LIMIT:&REM_LENGTH,+ &STR(&SYSNSUB(1,&REM_REMARKS))) END END /********************************************************************** /* FILE TAILOR THE TABLE TO MAKE THE ESF RECORDS * /********************************************************************** TAILOR: + ISPEXEC FTOPEN ISPEXEC FTINCL ESFRECD2 SET FTCC = &LASTCC ISPEXEC FTCLOSE EXIT CODE(&FTCC) ./ ADD NAME=ESFRECD4 /********************************************************************** /* UTILITY: ESFRECD4 * /* AUTHOR: DAVID LEIGH * /* FUNCTION: THIS CLIST WORKS WITH THE ESFRECD UTILITY. IT USES THE * /* CROSS REFERENCE FILE TO BUILD AN ESF FORMAT PROLOGUE. * /********************************************************************** PROC 0 XRFILE() + RECORD() + DEBUG /*** CHECK THE DEBUG SWITCH ***/ IF &DEBUG = DEBUG THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS /********************************************************************** /* INFORM THE USER * /********************************************************************** SET ZEDSMSG = SET ZEDLMSG = &STR(*** FINDING PROLOGUE FOR CSP RECORD "&RECORD" ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) /********************************************************************** /* CREATE THE OVERRIDE DATASET NAME TO AVOID DUPLICATES * /********************************************************************** SET PROVRDSN = &STR(&SYSUID..TEMP.ESFRECD)+ &STR(.D)+ &SUBSTR(1:2,&STR(&SYSSDATE))+ &SUBSTR(4:5,&STR(&SYSSDATE))+ &SUBSTR(7:8,&STR(&SYSSDATE))+ &STR(.T)+ &SUBSTR(1:2,&STR(&SYSTIME))+ &SUBSTR(4:5,&STR(&SYSTIME))+ &SUBSTR(7:8,&STR(&SYSTIME)) ISPEXEC VPUT PROVRDSN SHARED /********************************************************************** /* LOOP THROUGH THE CROSS REFERENCE FILE LOOKING FOR A DB2 TABLE * /* AND VPUT THE CSP RECORD NAME FOUND WITH IT. * /********************************************************************** /********************************************************************** /* ALLOCATION * /********************************************************************** FREE DD(TEMPDD OUTDD) ALLOC DD(TEMPDD) DSN('&XRFILE') SHR DELETE '&PROVRDSN' ALLOCATE DDNAME(OUTDD) DSN('&PROVRDSN') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK$$$) + SPACE(1,1) TRACKS RELEASE + RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS) /********************************************************************** /* ERROR/EOF PROCESSING SETUP * /********************************************************************** ERROR DO SET ERRCC = &LASTCC SELECT (&ERRCC) WHEN (400) DO SET EOF = YES RETURN END OTHERWISE DO ERROR OFF WRITE *** ERROR CC: &ERRCC OCCURRED READING "&XRFILE" *** CLOSFILE TEMPDD FREE DD(TEMPDD) EXIT END END END /********************************************************************** /* READ INITIALIZATION * /********************************************************************** SET FINALCC = 2000 SET SWITCH1 = OFF SET SWITCH2 = OFF SET EOF = NO OPENFILE TEMPDD OPENFILE OUTDD OUTPUT SET OUTDD = &STR( :PROL.) PUTFILE OUTDD GETFILE TEMPDD /********************************************************************** /* READ LOOP * /********************************************************************** DO WHILE &EOF = NO IF &SWITCH1 = ON THEN + DO SET SYSDVAL = &STR(&SYSNSUB(1,&TEMPDD)) READDVAL XRECORD XTABLE NULL IF &STR(&RECORD) = &STR(&XRECORD) THEN + DO SET FINALCC = 0 SET SWITCH2 = ON SET SWITCH1 = OFF GOTO GET_ANOTHER END END IF &SWITCH2 = ON THEN + DO IF &SYSINDEX(&STR(*******************),+ &STR(&SYSNSUB(1,&TEMPDD))) = 1 THEN + DO SET SWITCH2 = OFF GOTO FINISH END SET OUTDD = &STR(&SYSNSUB(1,&TEMPDD)) PUTFILE OUTDD END SET SWITCH1 = OFF IF &SYSINDEX(&STR(**********),&STR(&SYSNSUB(1,&TEMPDD))) = 1 THEN + DO SET SWITCH1 = ON SET COUNT = 0 GOTO GET_ANOTHER END GET_ANOTHER: + GETFILE TEMPDD END /********************************************************************** /* CLEANUP AND GET OUT! * /********************************************************************** FINISH: + ERROR OFF CLOSFILE TEMPDD SET OUTDD = &STR( :EPROL.) PUTFILE OUTDD CLOSFILE OUTDD FREE DD(TEMPDD OUTDD) EXIT CODE(&FINALCC) ./ ADD NAME=EVFINFO /********************************************************************** /* UTILITY: EVFINFO * /* AUTHOR: DAVID LEIGH * /* FUNCTION: THIS CLIST MANAGES THE DISPLAY OF THE EVF TABLE CONTENTS * /* IN THE TSO/ISPF ENVIRONMENT. * /********************************************************************** PROC 0 EVFILE(USC00.SLSS.EVFILE) /* WHERE ARE THE TABLES! */ + EVFPGM(SLSI940) /* VSAM ACCESS PROGRAM */ + PGMLIB(PPROD.STR.BATCH.LOADLIB) /* PROGRAM LOAD LIBRARY */ /*** CHECK THE DEBUG SWITCH ***/ ISPEXEC VGET DBGSWTCH PROFILE IF &DBGSWTCH = ON THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS ISPEXEC CONTROL ERRORS RETURN /********************************************************************** /* INFORM THE USER * /********************************************************************** SET ZEDLMSG = &STR(*** INITIALIZING ISPF/EVF ENVIRONMENT ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY PANEL(EVFINFO) MSG(UTLZ000W) /*********************************************************************** /* ALLOCATE FILES FOR THE EVF EXTRACT PROGRAM * /*********************************************************************** IF &STR(&PGMLIB) > THEN ISPEXEC LIBDEF ISPLLIB DATASET ID('&PGMLIB') RELOAD: + SET HOLDEVFILE = &STR(&EVFILE) FREE DD(EVFILE) ALLOC DD(EVFILE) DSN('&EVFILE') SHR ISPEXEC SELECT PGM(&EVFPGM) PARM(TYPE=HEADER) /*********************************************************************** /* REDISPLAY LIST SCREEN * /*********************************************************************** REDISPLAY: + IF &STR(&HOLDEVFILE) ¬= &STR(&EVFILE) THEN GOTO RELOAD SET ZTDMARK = &STR(*** END OF CURRENT "EDIT + VERIFICATION FILE" TABLES ***) ISPEXEC TBDISPL TEMPHDRS PANEL(EVFINFO) SET PANELCC = &LASTCC SELECT WHEN (&PANELCC = 8) DO FREE DD(EVFILE) SET ZEDSMSG = &STR(*** EXITED ISPF/EFV ***) ISPEXEC SETMSG MSG(UTLZ000) ISPEXEC TBEND TEMPHDRS ISPEXEC TBEND TEMPROWS IF &STR(&PGMLIB) > THEN ISPEXEC LIBDEF ISPLLIB EXIT END WHEN (&PANELCC > 8) DO FREE DD(EVFILE) SET ZEDLMSG = &STR(PROBABLE ERROR IN MAIN PANEL. + TBDISPL RC = &PANELCC) ISPEXEC SETMSG MSG(UTLZ001W) ISPEXEC TBEND TEMPHDRS ISPEXEC TBEND TEMPROWS IF &STR(&PGMLIB) > THEN ISPEXEC LIBDEF ISPLLIB EXIT CODE(&PANELCC) END END /********************************************************************** /* PROCESS LINE COMMANDS FIRST * /********************************************************************** IF &ZTDSELS ¬= &STR(0000) THEN + DO ISPEXEC CONTROL DISPLAY SAVE SELDIS: DO WHILE &ZTDSELS ¬= &STR(0000) SELECT (&ZSEL) /********** DISPLAY TABLE INFO **********/ WHEN (I) DO INFO_LOOP: ISPEXEC DISPLAY PANEL(EVFINFO1) SET PANELCC = &LASTCC SELECT WHEN (&PANELCC = 0) GOTO INFO_LOOP WHEN (&PANELCC > 8) DO SET ZEDLMSG = &STR(*** PROBABLE ERROR + IN PANEL "EVFINFO1". + NOTIFY DEVELOPER ***) ISPEXEC SETMSG MSG(UTLZ001W) END END END /********** DISPLAY TABLE CONTENTS **********/ WHEN (S) DO SET ZEDLMSG = &STR(*** EXTRACTING TABLE: + &EVFTABLE COID: &EVFCOID ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) ISPEXEC SELECT PGM(&EVFPGM) + PARM(TYPE=DATA COID=&EVFCOID TABLE=&EVFTABLE) SYSCALL ROWS_SECTION + EVFILE EVFTABLE EVFCOID EVFDESC EVFKEYH + EVFDATAH EVFEDITF EVFEEXIT EVFDFLTF + EVFPKEYF EVFADDF EVFHEADD EVFHEADU + EVFMASKD EVFMASKU EVFCNTLD EVFCNTLU + EVFNAMED EVFNAMEU EVFCHGF EVFDELF + EVFMASK END OTHERWISE DO LINE_COMMANDS: ISPEXEC TBEND EVFCMDS ISPEXEC TBCREATE EVFCMDS NOWRITE REPLACE + KEYS() NAMES(EVCMD EVCMDDES) SET EVCMD = &STR(I) SET EVCMDDES = + &STR(VIEW THE PROFILE INFORMATION FOR A GIVEN EVF TABLE ) ISPEXEC TBADD EVFCMDS SET EVCMD = &STR(S) SET EVCMDDES = + &STR(VIEW THE CONTENTS OF A GIVEN EVF TABLE ) ISPEXEC TBADD EVFCMDS ISPEXEC TBTOP EVFCMDS SET ZWINTTL = &STR(VALID LINE COMMANDS...PF3 TO + RETURN...PF7/8 TO SCROLL) SET ZTDMARK = &STR(*** END OF VALID LINE COMMANDS ***) ISPEXEC ADDPOP ROW(6) COLUMN(8) /*PEXEC CONTROL DISPLAY SAVE /* FIXPOP */ LINE_CMDLOOP: ISPEXEC TBDISPL EVFCMDS PANEL(EVFCMDS) IF &LASTCC = 0 THEN GOTO LINE_CMDLOOP ISPEXEC REMPOP /*PEXEC CONTROL DISPLAY RESTORE /* FIXPOP */ END END LINE_LOOP: IF &ZTDSELS > &STR(0001) THEN + DO ISPEXEC CONTROL DISPLAY RESTORE ISPEXEC TBDISPL TEMPHDRS ISPEXEC CONTROL DISPLAY SAVE END ELSE + DO SET ZTDSELS = &STR(0000) ISPEXEC CONTROL DISPLAY RESTORE IF &STR(&ZCMD) > THEN GOTO SCROLL END END END /********************************************************************** /* NOW EXECUTE THE PRIMARY COMMANDS * /********************************************************************** IF &STR(&SYSNSUB(1,&ZCMD)) = THEN GOTO SCROLL SET SYSDVAL = &STR(&SYSNSUB(1,&ZCMD)) READDVAL ZCMD OPT1 OPT2 OPT3 OPT4 OPT5 OPT6 OPT7 OPT8 OPT9 OPT10 SELECT (&SYSCAPS(&STR(&ZCMD))) WHEN (R ³ RE ³ REP ³ REPO ³ REPOR ³ REPORT ³ RPT) DO IF &STR(&SYSCAPS(&OPT1)) = ALL THEN + DO SET ZEDLMSG = &STR(*** PREPARING TO REPORT ON ALL + EVF TABLES ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) SET RPTDSN = &STR(&SYSUID..TEMP.EVF.ALLTABLS.REPORT) DELETE '&RPTDSN' FREE DDNAME(ISPFILE) ALLOCATE DDNAME(ISPFILE) DSN('&RPTDSN') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK$$$) + SPACE(3,3) TRACKS RELEASE + RECFM(F B A) LRECL(80) BLKSIZE(23440) DSORG(PS) FREE DDNAME(ISPFILE) ALLOCATE DDNAME(ISPFILE) DSN('&RPTDSN') MOD KEEP ISPEXEC TBTOP TEMPHDRS ISPEXEC TBSKIP TEMPHDRS DO WHILE &LASTCC = 0 SET ZEDLMSG = &STR(*** REPORTING ON TABLE: + &EVFTABLE COID: &EVFCOID ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) ISPEXEC SELECT PGM(&EVFPGM) + PARM(TYPE=DATA COID=&EVFCOID TABLE=&EVFTABLE) ISPEXEC FTOPEN ISPEXEC FTINCL EVFINFO2 SET SAVECC = &LASTCC ISPEXEC FTCLOSE ISPEXEC TBSKIP TEMPHDRS END FREE DDNAME(ISPFILE) IF &SAVECC > 0 THEN + DO SET ZEDLMSG = &STR(*** 1 OR MORE TABLES DID + REPORT SUCCESSFULLY ***) ISPEXEC SETMSG MSG(UTLZ001) ISPEXEC EDIT DATASET('&RPTDSN') SET ZEDLMSG = &STR(*** "ALL TABLES" REPORT + EDITED ***) ISPEXEC SETMSG MSG(UTLZ000) END ELSE + DO SET ZEDLMSG = &STR(*** TYPE "PRINTIT" TO PRINT + THIS REPORT ***) ISPEXEC SETMSG MSG(UTLZ000W) ISPEXEC EDIT DATASET('&RPTDSN') SET ZEDLMSG = &STR(*** "ALL TABLES" REPORT + EDITED ***) ISPEXEC SETMSG MSG(UTLZ000) END END ELSE + DO SET ZEDLMSG = &STR(*** CREATING THE "TABLE NAMES" + REPORT ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) SET RPTDSN = &STR(&SYSUID..TEMP.EVF.TABLES.REPORT) DELETE '&RPTDSN' FREE DDNAME(ISPFILE) ALLOCATE DDNAME(ISPFILE) DSN('&RPTDSN') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK$$$) + SPACE(1,1) TRACKS RELEASE + RECFM(F B A) LRECL(80) BLKSIZE(23440) DSORG(PS) ISPEXEC FTOPEN ISPEXEC FTINCL EVFINFO1 SET SAVECC = &LASTCC ISPEXEC FTCLOSE FREE DDNAME(ISPFILE) IF &SAVECC > 0 THEN + DO ISPEXEC VGET ZERRLM SET ZEDSMSG = &STR(REPORT CREATION CC: &SAVECC) SET ZEDLMSG = &STR(&ZERRLM) ISPEXEC SETMSG MSG(UTLZ001) END ELSE + DO SET ZEDLMSG = &STR(*** TYPE "PRINTIT" TO PRINT + THIS REPORT ***) ISPEXEC SETMSG MSG(UTLZ000W) ISPEXEC EDIT DATASET('&RPTDSN') SET ZEDLMSG = &STR(*** "TABLE NAMES" REPORT + EDITED ***) ISPEXEC SETMSG MSG(UTLZ000) END END END OTHERWISE DO ISPEXEC TBEND EVFCMDS ISPEXEC TBCREATE EVFCMDS NOWRITE REPLACE KEYS() + NAMES(EVCMD EVCMDDES) SET EVCMD = &STR(REPORT ) SET EVCMDDES = + &STR(ALIASES: "R" "RE" "REP" "REPO" "REPOR" "RPT" ) ISPEXEC TBADD EVFCMDS SET EVCMD = SET EVCMDDES = + &STR(PARAMETERS: ALL (OPTIONAL) ) ISPEXEC TBADD EVFCMDS SET EVCMDDES = + &STR(FUNCTION: THIS COMMAND PRODUCES A REPORT FILE OF THE EVF ) ISPEXEC TBADD EVFCMDS SET EVCMDDES = + &STR( TABLES WHICH EXIST ON &EVFILE..) ISPEXEC TBADD EVFCMDS SET EVCMDDES = + &STR( IF THE OPTIONAL PARAMETER "ALL" IS NOT ) ISPEXEC TBADD EVFCMDS SET EVCMDDES = + &STR( SPECIFIED, THE REPORT WILL JUST CONSIST OF A ) ISPEXEC TBADD EVFCMDS SET EVCMDDES = + &STR( LIST OF THE CURRENT TABLES, THEIR COMPANY ID, ) ISPEXEC TBADD EVFCMDS SET EVCMDDES = + &STR( AND A DESCRIPTION. IF THE KEYWORD PARAMETER ) ISPEXEC TBADD EVFCMDS SET EVCMDDES = + &STR( "ALL" IS SPECIFIED, THE REPORT WILL CONSIST OF ) ISPEXEC TBADD EVFCMDS SET EVCMDDES = + &STR( ALL THE DETAIL INFORMATION AND CONTENTS OF ALL ) ISPEXEC TBADD EVFCMDS SET EVCMDDES = + &STR( OF THE EVF FILE TABLES. IT IS EQUIVILENT TO ) ISPEXEC TBADD EVFCMDS SET EVCMDDES = + &STR( GOING INTO EACH INDIVIDUAL TABLE AND TYPING ) ISPEXEC TBADD EVFCMDS SET EVCMDDES = + &STR( "REPORT" ON THE COMMAND LINE. NOTE: USING THE) ISPEXEC TBADD EVFCMDS SET EVCMDDES = + &STR( "ALL" PARAMETER CAUSES THIS PROCESS TO TAKE A ) ISPEXEC TBADD EVFCMDS SET EVCMDDES = + &STR( FEW MINUTES. ) ISPEXEC TBADD EVFCMDS SET EVCMDDES = + &STR( AFTER THE FILE IS CREATED, YOU ARE TAKEN INTO AN) ISPEXEC TBADD EVFCMDS SET EVCMDDES = + &STR( EDIT OF THE REPORT FILE. TO PRINT THE REPORT, ) ISPEXEC TBADD EVFCMDS SET EVCMDDES = + &STR( YOU CAN TYPE "PRINTIT" ON THE COMMAND LINE WHILE) ISPEXEC TBADD EVFCMDS SET EVCMDDES = + &STR( EDITING THE REPORT FILE AND PRESS . THIS) ISPEXEC TBADD EVFCMDS SET EVCMDDES = + &STR( WILL INVOKE THE PRINTIT UTILITY. YOU CAN USE ) ISPEXEC TBADD EVFCMDS SET EVCMDDES = + &STR( THE "HELP" COMMAND ON THE PRINIT UTILITY SCREEN ) ISPEXEC TBADD EVFCMDS SET EVCMDDES = + &STR( TO LEARN HOW IT FUNCTIONS. ) ISPEXEC TBADD EVFCMDS ISPEXEC TBTOP EVFCMDS SET ZWINTTL = &STR(VALID PRIMARY COMMANDS...PF3 TO RETURN...+ PF7/8 TO SCROLL) SET ZTDMARK = &STR(*** END OF VALID PRIMARY COMMANDS ***) ISPEXEC ADDPOP ROW(3) COLUMN(8) /*PEXEC CONTROL DISPLAY SAVE /* FIXPOP */ PRIM_CMDLOOP: + ISPEXEC TBDISPL EVFCMDS PANEL(EVFCMDS) IF &LASTCC = 0 THEN GOTO PRIM_CMDLOOP ISPEXEC REMPOP /*PEXEC CONTROL DISPLAY RESTORE /* FIXPOP */ END END /*****************************/ /* MAINTAIN THE TOP OF TABLE */ /*****************************/ SCROLL: + IF &STR(&ZCMD) = THEN + DO ISPEXEC TBTOP TEMPHDRS ISPEXEC TBSKIP TEMPHDRS NUMBER(&ZTDTOP) ISPEXEC VGET (ZVERB ZSCROLLN) IF &ZVERB = &STR(UP) THEN + ISPEXEC TBSKIP TEMPHDRS NUMBER(-&ZSCROLLN) IF &ZVERB = &STR(DOWN) THEN + ISPEXEC TBSKIP TEMPHDRS NUMBER(&ZSCROLLN) END GOTO REDISPLAY /********************************************************************** /* ROWS SECTION: THIS SECTION HANDLES THE DISPLAY AND PROCESSING OF * /* THE DATA ROWS FOR A SELECTED TABLE. * /********************************************************************** ROWS_SECTION: PROC 22 &EVFILE &EVFTABLE &EVFCOID &EVFDESC &EVFKEYH + &EVFDATAH &EVFEDITF &EVFEEXIT &EVFDFLTF &EVFPKEYF + &EVFADDF &EVFHEADD &EVFHEADU &EVFMASKD &EVFMASKU + &EVFCNTLD &EVFCNTLU &EVFNAMED &EVFNAMEU &EVFCHGF + &EVFDELF &EVFMASK SYSREF &EVFILE &EVFTABLE &EVFCOID &EVFDESC &EVFKEYH &EVFDATAH + &EVFEDITF &EVFEEXIT &EVFDFLTF &EVFPKEYF &EVFADDF &EVFHEADD + &EVFHEADU &EVFMASKD &EVFMASKU &EVFCNTLD &EVFCNTLU &EVFNAMED + &EVFNAMEU &EVFCHGF &EVFDELF &EVFMASK + ISPEXEC TBTOP TEMPROWS /*********************************************************************** /* REDISPLAY LIST SCREEN * /*********************************************************************** ROWDISPLAY: + SET ZTDMARK = &STR(*** END OF DATA ROWS FOR TABLE: + &EVFTABLE COID: &EVFCOID ***) ISPEXEC TBDISPL TEMPROWS PANEL(EVFINFO2) SET PANELCC = &LASTCC SELECT WHEN (&PANELCC = 8) DO SET ZEDLMSG = &STR(*** DATA ROWS DISPLAYED *** ISPEXEC SETMSG MSG(UTLZ000) RETURN END WHEN (&PANELCC > 8) DO SET ZEDLMSG = &STR(PROBABLE ERROR IN "EVFINFO2" PANEL. + TBDISPL RC = &PANELCC) ISPEXEC SETMSG MSG(UTLZ001W) RETURN END END IF &STR(&SYSNSUB(1,&ZCMD)) = THEN GOTO ROW_SCROLL SET SYSDVAL = &STR(&SYSNSUB(1,&ZCMD)) READDVAL ZCMD OPT1 OPT2 OPT3 OPT4 OPT5 OPT6 OPT7 OPT8 OPT9 OPT10 SELECT (&SYSCAPS(&STR(&ZCMD))) WHEN (R ³ RE ³ REP ³ REPO ³ REPOR ³ REPORT ³ RPT) DO SET ZEDLMSG = &STR(*** CREATING THE "TABLE CONTENTS" REPORT ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) SET RPTDSN = &STR(&SYSUID..TEMP.EVF.CONTENTS.REPORT) DELETE '&RPTDSN' FREE DDNAME(ISPFILE) ALLOCATE DDNAME(ISPFILE) DSN('&RPTDSN') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK$$$) + SPACE(1,1) TRACKS RELEASE + RECFM(F B A) LRECL(80) BLKSIZE(23440) DSORG(PS) ISPEXEC FTOPEN ISPEXEC FTINCL EVFINFO2 SET SAVECC = &LASTCC ISPEXEC FTCLOSE FREE DDNAME(ISPFILE) IF &SAVECC > 0 THEN + DO ISPEXEC VGET ZERRLM SET ZEDSMSG = &STR(REPORT CREATION CC: &SAVECC) SET ZEDLMSG = &STR(&ZERRLM) ISPEXEC SETMSG MSG(UTLZ001) END ELSE + DO SET ZEDLMSG = &STR(*** TYPE "PRINTIT" TO PRINT THIS + REPORT ***) ISPEXEC SETMSG MSG(UTLZ000W) ISPEXEC EDIT DATASET('&RPTDSN') SET ZEDLMSG = &STR(*** "TABLE NAMES" REPORT EDITED ***) ISPEXEC SETMSG MSG(UTLZ000) END END OTHERWISE DO ISPEXEC TBEND EVFCMDS ISPEXEC TBCREATE EVFCMDS NOWRITE REPLACE KEYS() + NAMES(EVCMD EVCMDDES) SET EVCMD = &STR(REPORT ) SET EVCMDDES = + &STR(ALIASES: "R" "RE" "REP" "REPO" "REPOR" "RPT" ) ISPEXEC TBADD EVFCMDS SET EVCMD = SET EVCMDDES = + &STR(PARAMETERS: NONE ) ISPEXEC TBADD EVFCMDS SET EVCMDDES = + &STR(FUNCTION: THIS COMMAND PRODUCES A REPORT FILE OF THE ) ISPEXEC TBADD EVFCMDS SET EVCMDDES = + &STR( CONTENTS OF THE CURRENTLY DISPLAYED TABLE. ) ISPEXEC TBADD EVFCMDS SET EVCMDDES = + &STR( AFTER THE FILE IS CREATED, YOU ARE TAKEN INTO AN) ISPEXEC TBADD EVFCMDS SET EVCMDDES = + &STR( EDIT OF THE REPORT FILE. TO PRINT THE REPORT, ) ISPEXEC TBADD EVFCMDS SET EVCMDDES = + &STR( YOU CAN TYPE "PRINTIT" ON THE COMMAND LINE WHILE) ISPEXEC TBADD EVFCMDS SET EVCMDDES = + &STR( EDITING THE REPORT FILE AND PRESS . THIS) ISPEXEC TBADD EVFCMDS SET EVCMDDES = + &STR( WILL INVOKE THE PRINTIT UTILITY. YOU CAN USE ) ISPEXEC TBADD EVFCMDS SET EVCMDDES = + &STR( THE "HELP" COMMAND ON THE PRINIT UTILITY SCREEN ) ISPEXEC TBADD EVFCMDS SET EVCMDDES = + &STR( TO LEARN HOW IT FUNCTIONS. ) ISPEXEC TBADD EVFCMDS ISPEXEC TBTOP EVFCMDS SET ZWINTTL = &STR(VALID PRIMARY COMMANDS...PF3 TO RETURN...+ PF7/8 TO SCROLL) SET ZTDMARK = &STR(*** END OF VALID PRIMARY COMMANDS ***) ISPEXEC ADDPOP ROW(3) COLUMN(8) /*PEXEC CONTROL DISPLAY SAVE /* FIXPOP */ PRIM_ROW_CMDLOOP: + ISPEXEC TBDISPL EVFCMDS PANEL(EVFCMDS) IF &LASTCC = 0 THEN GOTO PRIM_ROW_CMDLOOP ISPEXEC REMPOP /*PEXEC CONTROL DISPLAY RESTORE /* FIXPOP */ END END /*****************************/ /* MAINTAIN THE TOP OF TABLE */ /*****************************/ ROW_SCROLL: + IF &STR(&ZCMD) = THEN + DO ISPEXEC TBTOP TEMPROWS ISPEXEC TBSKIP TEMPROWS NUMBER(&ZTDTOP) ISPEXEC VGET (ZVERB ZROW_SCROLLN) IF &ZVERB = &STR(UP) THEN + ISPEXEC TBSKIP TEMPROWS NUMBER(-&ZROW_SCROLLN) IF &ZVERB = &STR(DOWN) THEN + ISPEXEC TBSKIP TEMPROWS NUMBER(&ZROW_SCROLLN) END GOTO ROWDISPLAY END ./ ADD NAME=EVFINFOZ IF &STR(&SYSNSUB(1,&ZCMD)) = THEN GOTO ROW_SCROLL SET SYSDVAL = &STR(&SYSNSUB(1,&ZCMD)) READDVAL ZCMD OPT1 OPT2 OPT3 OPT4 OPT5 OPT6 OPT7 OPT8 OPT9 OPT10 SELECT (&ZCMD) WHEN (R | RE | REP | REPO | REPOR | REPORT) DO END WHEN (F | FI | FIN | FIND) DO END WHEN (L | LOC | LOCATE) DO END WHEN (S | SO | SOR | SORT | O | OR | ORD | ORDE | ORDER) DO SET SFIELD = IF &STR(&SYSNSUB(1,&OPT1)) = THEN + DO SET ZEDLMSG = &STR(TABLE SORTED IN DEFAULT ORDER: + BY COMPANY ID, TABLE NAME) ISPEXEC SETMSG MSG(UTLZ000) SET SFIELD = &STR(,EVFCOID,C,A,EVFTABLE,C,A) SET LASTSORT = EVFCOID END ELSE + DO &I = 1 TO 2 SET X = &&OPT&I IF &X = THEN GOTO SORT_CONTINUE SELECT (&SYSCAPS(&X)) WHEN (NAME | TABLE) + SET SFIELD = &STR(&SFIELD,EVFTABLE,C,A) WHEN (COID | COMPANY | DSNQUAL) + SET SFIELD = &STR(&SFIELD,EVFCOID,C,A) OTHERWISE DO SET ZEDLMSG = &STR(VALID SORT FIELDS: + ******** COMPANY TABLE) SORT" ISPEXEC SETMSG MSG(UTLZ001) GOTO ROW_SCROLL END END END SORT_CONTINUE: + SET A = &LENGTH(&STR(&SFIELD)) SET SFIELD = &SUBSTR(2:&A,&STR(&SFIELD)) ISPEXEC TBSORT TEMPHDRS FIELDS(&STR(&SFIELD)) SET A = &SYSINDEX(&STR(,C,A),&STR(&SFIELD)) SET B = &SYSINDEX(&STR(,C,D),&STR(&SFIELD)) IF (&A < &B AND &A > 0) OR + (&B = 0) THEN + DO SET A = &A - 1 SET LASTSORT = &SUBSTR(1:&A,&STR(&SYSNSUB(1,&SFIELD))) END ELSE + DO SET B = &B - 1 SET LASTSORT = &SUBSTR(1:&B,&STR(&SYSNSUB(1,&SFIELD))) END END WHEN (REP | RPT | REPORT | PRN | PRT) DO END OTHERWISE DO PRIM_COMMANDS: + ISPEXEC TBEND EVFCMDS ISPEXEC TBCREATE EVFCMDS NOWRITE REPLACE KEYS() + NAMES(EVCMD EVCMDDES) SET EVCMD = &STR(FIND ) SET EVCMDDES = + &STR(ALIASES: "F" "FI" "FIN" ) ISPEXEC TBADD EVFCMDS SET EVCMD = SET EVCMDDES = + &STR(PARAMETERS: (OPTIONAL), TEXT (OPTIONAL). ) ISPEXEC TBADD EVFCMDS SET EVCMDDES = + &STR(FUNCTION: THIS COMMAND "QUALIFIES" THE LIST OF TECH DOCS ) ISPEXEC TBADD EVFCMDS SET EVCMD = &STR(SORT ) /***********************************/ SET EVCMDDES = + &STR(ALIASES: "S" "SO" "SOR" "O" "OR" "ORD" "ORDE" "ORDER" ) ISPEXEC TBADD EVFCMDS SET EVCMD = SET EVCMDDES = + &STR(PARAMETERS: VALID TEMPHDRS TABLE COLUMN NAME(S) ) ISPEXEC TBADD EVFCMDS SET EVCMDDES = + &STR( THE VALID NAMES YOU MAY SPECIFY ARE: NAME ) ISPEXEC TBADD EVFCMDS SET EVCMDDES = + &STR( TYPE DESC ID (I.E. THE LAST UPDATE ID) ) ISPEXEC TBADD EVFCMDS SET EVCMDDES = + &STR(FUNCTIONS: SORT THE TABLE DISPLAY IN A SPECIFIC ORDER, AND) ISPEXEC TBADD EVFCMDS SET EVCMDDES = + &STR( SET THE "PRIMARY SORT KEY" VARIABLE WHICH IS ) ISPEXEC TBADD EVFCMDS SET EVCMDDES = + &STR( USED BY THE "LOCATE" COMMAND. ) ISPEXEC TBADD EVFCMDS SET EVCMDDES = + &STR( YOU MAY SPECIFY MORE THAN 1 FIELD. IF YOU ) ISPEXEC TBADD EVFCMDS SET EVCMDDES = + &STR( SPECIFY NO FIELDS, THE TABLE WILL BE SORTED IN ) ISPEXEC TBADD EVFCMDS SET EVCMDDES = + &STR( DEFAULT ORDER (I.E. NAME) ) ISPEXEC TBADD EVFCMDS ISPEXEC TBTOP EVFCMDS SET ZWINTTL = &STR(VALID PRIMARY COMMANDS...PF3 TO RETURN...+ PF7/8 TO ROW_SCROLL) SET ZTDMARK = &STR(*** END OF VALID PRIMARY COMMANDS ***) /* ISPEXEC ADDPOP ROW(3) COLUMN(8) ISPEXEC CONTROL DISPLAY SAVE /* FIXPOP */ PRIM_CMDLOOP: + ISPEXEC TBDISPL EVFCMDS PANEL(EVFCMDS) IF &LASTCC = 0 THEN GOTO PRIM_CMDLOOP /* ISPEXEC REMPOP ISPEXEC CONTROL DISPLAY RESTORE /* FIXPOP */ END END ./ ADD NAME=EXAMPLES /*********************************************************************/ /* HOW TO SET THE VALUE OF VARIABLE 'D' IF ALL YOU HAVE IS THE 'NAME'*/ /* OF VARIABLE 'D' STORED IN ANOTHER VARIABLE...IN THIS CASE 'A1'. */ /*********************************************************************/ SET X = 1 /* VARIABLE 'X' NOW CONTAINS THE VALUE '1' SET D = CONTENTS /* VARIABLE 'D' CONTAINS THE VALUE 'CONTENTS' SET A&X = D /* VARIABLE 'A1' NOW CONTAINS THE VALUE 'D' SET B = A&X /* VARIABLE 'B' NOW CONTIANS THE VALUE 'A1' SET C = &&&B /* VARIABLE 'C' NOW CONTAINS THE VALUE 'D' SET &&C = NEW /* VARIABLE 'D' NOW CONTAINS THE VALUE 'NEW' ./ ADD NAME=EXECME ISREDIT MACRO /********************************************************************** /* UTILITY: EXECME * /* AUTHOR: DAVID LEIGH * /* FUNCTION: INVOKE THE DATASET BEING EDITED AS A CLIST. * /********************************************************************** ISREDIT (DSN) = DATASET ISREDIT (MBR) = MEMBER IF &STR(&MBR) > THEN SET DSN = &STR(&DSN(&MBR)) EXEC '&DSN' ./ ADD NAME=EXPERT /******************************************************************/ /* CLIST EXPERT - THIS CLIST SCANS THE CAS EXPERT LIST AND */ /* RETURNS THE LINE CONTAINING THE STRING SELECTED. */ /* THE GROUP EXPERT LIST IS IN SLSS.WORK.LIST */ /* IN MEMBER "EXPERT". */ /******************************************************************/ PROC 1 NAME_TO_SEARCH_FOR + COMMON('''SLSS.WORK.LIST(EXPERT)''') /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT IF &NAME_TO_SEARCH_FOR = &STR(HELP) THEN GOTO HELPSEC IF &NAME_TO_SEARCH_FOR = THEN + DO WRITE ENTER A STRING TO SEARCH FOR IN THE EXPERT LIST. WRITENR STRING ==> READ NAME_TO_SEARCH_FOR IF &NAME_TO_SEARCH_FOR = THEN + DO SET ZEDLMSG = &STR(NO STRING ENTERED *** )+ &STR(PROCESSING TERMINATED) ISPEXEC SETMSG MSG(UTLZ001) EXIT END END CLEAR WRITE *** SCANNING EXPERT LISTS FOR &NAME_TO_SEARCH_FOR *** IF &SYSINDEX(&STR('),&STR(&COMMON)) = 0 AND + &STR(&COMMON) > THEN + SET COMMON = &STR('&COMMON') IF &SYSDSN('&SYSUID..EXPERT') = OK THEN + SET EXPERTDSN = &STR(&COMMON '&SYSUID..EXPERT') ELSE + SET EXPERTDSN = &STR(&COMMON) IF &STR(&EXPERTDSN) = THEN + DO SET ZEDLMSG = &STR(*** NO EXPERT DATASETS TO SEARCH ***) ISPEXEC SETMSG MSG(UTLZ001) EXIT END FREE DDNAME(EXPERT) ALLOCATE DDNAME(EXPERT) + DSNAME(&EXPERTDSN) + SHR KEEP OPENFILE EXPERT INPUT SET EOF = NO ERROR DO IF &LASTCC = 400 THEN + DO SET EOF = YES RETURN END ELSE + DO CLEAR WRITE WRITE *** UNEXPECTED ERROR IN CLIST EXPERT *** WRITE WRITE *** RETURN CODE WAS : &LASTCC *** WRITE WRITE *** PROGRAM VARIABLES ARE : WRITE A = &A WRITE B = &B WRITE EOF = &EOF WRITE EXPERT = &EXPERT CLOSFILE EXPERT FREE DDNAME(EXPERT) EXIT END END GETFILE EXPERT SET A = 0 /********************************************************************** /* WRITE MATCHING LINES FROM THE EXPERT DATASET(S). * /********************************************************************** DO WHILE &EOF = NO IF &SYSINDEX(&STR(&NAME_TO_SEARCH_FOR),&STR(&EXPERT)) > 0 AND + &SUBSTR(1:1,&STR(&EXPERT)) ¬= &STR(*) THEN + DO WRITE &EXPERT SET A = &A + 1 END GETFILE EXPERT END ERROR OFF CLOSFILE EXPERT FREE DDNAME(EXPERT) /********************************************************************** /* WRITE MATCHING LINES FROM THE EXPERT LINES IN THE PROJECT * /* TABLE. * /********************************************************************** /* ISPEXEC CONTROL ERRORS RETURN /* ISPEXEC TBOPEN PROJECT NOWRITE /* IF &LASTCC > 4 THEN GOTO CONTINUE /* /* ISPEXEC TBTOP PROJECT /* ISPEXEC TBSKIP PROJECT NUMBER(1) /* SET SAVECC = &LASTCC /* /* DO WHILE &SAVECC = 0 /* IF (&SYSINDEX(&STR(&NAME),&STR(&PRJPARM)) > 0 OR + /* &SYSINDEX(&STR(&NAME),&STR(&PRJQUAL)) > 0) AND + /* &STR(&PRJELEM) = &STR(EXPERT #) THEN + /* DO /* SET A = &A + 1 /* IF &TESTPROD = T THEN + /* WRITE DSEC STAFF EXT : &PRJQUAL ===== &PRJPARM /* ELSE + /* WRITE ACCOUNT STAFF EXT : &PRJQUAL ===== &PRJPARM /* END /* ISPEXEC TBSKIP PROJECT NUMBER(1) /* SET SAVECC = &LASTCC /* END /* /* ISPEXEC TBEND PROJECT CONTINUE: + IF &A = 0 THEN + WRITE *** NO EXPERT INFO FOUND FOR &NAME_TO_SEARCH_FOR *** EXIT HELPSEC: + CLEAR WRITE *** HELP FOR THE EXPERT CLIST *** WRITE WRITE THIS CLIST ALLOWS THE USER TO LIST EXPERT INFORMATION BY WRITE PASSING A STRING TO THE CLIST AND THE CLIST WILL SEARCH THE WRITE PROJECT EXPERT LIST AND THE INDIVIDUALS PHONE LIST (IF ONE EXISTS). WRITE WRITE BASIC SYNTAX : WRITE WRITE COMMAND ===> TSO EXPERT WRITE WRITE WITH THIS SYNTAX, YOU WILL BE PROMPTED FOR A STRING TO SEARCH FOR. WRITE WRITE TO PASS THE INFORMATION AT EXECUTION TIME : WRITE WRITE COMMAND ===> TSO EXPERT SMITH WRITE WRITE THIS WILL DISPLAY ANY LINES CONTAINING THE STRING "SMITH". WRITE WRITE YOU COULD ALSO USE A STRING OF A NUMBER OR PARTIAL NAME, OR A WRITE DESCRIPTION THAT IS STORED IN THE EXPERT LIST (E.G. "SUPPORT") WRITE WRITE SPECIAL NOTES : THE PROJECT EXPERT LIST CONSISTS OF THE FOLLOWING WRITE DATASET(S): WRITE WRITE &STR(&COMMON) WRITE WRITE IF YOU WANT A PERSONAL LIST, YOU MUST CREATE A WRITE DATASET CALLED : WRITE '&SYSUID..EXPERT' WRITE THIS DATASET SHOULD BE AN 80 BYTE RECORD TO WRITE DISPLAY THE INFORMATION PROPERLY. WRITE WRITE IN YOUR PERSONAL EXPERT LIST DATASET, AN "* " WRITE IN THE FIRST COLUMN WILL INDICATE A "COMMENT" WRITE LINE. COMMENT LINES ARE NOT SCANNED FOR THE WRITE SEARCH STRING. THIS CAN HELP YOU IN THE WRITE MAINTENANCE OF YOUR PERSONAL EXPERT LIST BY WRITE ENABLING YOU TO "SECTION" YOUR EXPERT INTO WRITE DIFFERENT GROUPS. WRITE WRITE *** END OF HELP *** NO PROCESSING PERFORMED *** EXIT ./ ADD NAME=EXPEXIT /********************************************************************** /* CLIST: EXPEXIT * /* AUTHOR: DAVID LEIGH (2-28-92) * /* FUNCTION: THIS CLIST IS INVOKED FROM XPEDITER CLIST XPC1SJ AS A * /* SUBMIT EXIT BEFORE XPEDITER SUBMITS A "TYPRUN=SCAN" JOB * /* FOR PROC EXPANSION. THE NAME OF THIS MODULE IS STORED * /* IN XPEDITER ISPFTABL XPTDFLTS IN KEY ROW "XSF" IN AN * /* EXTENSION VARIABLE CALLED XSFJOBC. IF XSFJOBC CONTAINS * /* THE STRING "CMD(%EXPEXIT)", THIS CLIST WILL BE INVOKED. * /* * /* THIS SUBMIT EXIT IS INVOKED AFTER XPEDITER HAS PARSED * /* THE JOB CARDS WHICH THE USER UPDATES VIA THE 'SETUP' * /* COMMAND UNDER THE ALLOCATE FUNCTION AND HAS ADDED ITS * /* OWN INFORMATION. SINCE THE UNIPAC TSO JOB SUBMIT EXIT * /* (IKJEFF10) IS SO SPECIFIC, THIS CLIST BASICALLY REPLACES * /* ALL THAT XPEDITER HAS SET UP WITH IT'S OWN INFORMATION * /* TO MATCH THE NEEDS OF UNIPAC'S SUBMIT EXIT. * /* * /* THIS CLIST MAKES USE OF THE USERINFO TSO COMMAND * /* PROCESSOR AND STANDARD SYSTEM VARIABLES TO CONSTRUCT A * /* VALID JOB CARD. THE "CLASSTIME" PARAMETER BELOW SHOULD * /* CONTAIN A VALID COMBINATION FOR THIS ENVIRONMENT. * /********************************************************************** PROC 0 CLASSTIME('CLASS=V,TIME=(0,01)') /*** CHECK THE DEBUG SWITCH ***/ ISPEXEC VGET DBGSWTCH PROFILE IF &DBGSWTCH = ON THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS /********************************************************************** /* THE COST CENTER (ACCOUNTING CODE) AND BIN NUMBER * /********************************************************************** CALL 'SYS2.USC1.LINKLIB(USERINFO)' '&SYSUID ' ISPEXEC VGET (BINNM,CCNTR) PROFILE /********************************************************************** /* SET UP THE VARIABLES * /********************************************************************** ISPEXEC VGET XJ5 SHARED SET XJ1 = + &STR(//&SYSUID.X JOB (&CCNTR,&BINNM,Z00000,O),'XPEDITER EXPAND',) /********************************************************************** /* UNTIL SYSTEM DEFAULT VARIABLE "XSBHLD" IS CORRECTED, THE NEXT TWO * /* LINES ARE COMMENTED OUT AND REPLACED WITH THE FOLLOWING TWO. * /********************************************************************** /* SET XJ2 = + /* &STR(&XJ5.,) SET XJ2 = + &STR(// MSGCLASS=X,MSGLEVEL=1,TYPRUN=SCAN,) SET XJ3 = + &STR(// &CLASSTIME) SET XJ4 = SET XJ5 = ISPEXEC VPUT (XJ1 XJ2 XJ3 XJ4 XJ5) SHARED EXIT ./ ADD NAME=EXPLNRPT 000010******************************************************************01/12/89 000020 IDENTIFICATION DIVISION. EXPLNRPT 000030****************************************************************** LV030 000040 PROGRAM-ID. EXPLNRPT. CL*28 000050 INSTALLATION EDS - DSEC. CL*28 000060 AUTHOR. MIKE SKAFF. CL*28 000070 DATE-WRITTEN. NOV. 30, 1988. CL*28 000080 DATE-COMPILED. CL*28 000090 CL*28 000100 CL*28 000110*************************************************************** CL*28 000120* PROGRAM NAME: EXPLNRPT CL*28 000130* CL*28 000140* FUNCTION: THIS PROGRAM WILL PRODUCE A REPORT FOR THE DB2/SQL CL*28 000150* EXPLAIN RESULTS. CL*28 000160* CL*28 000170* OUTPUT FILE: EXPLAIN-REPORT FILE DDNAME=SYS010 CL*28 000180* CL*28 000190* CL*28 000200* ENTRY POINT: TOP-OF-PROGRAM - EXPLNRPT CL*28 000210* CL*28 000220* EXITS NORMAL: FINALIZATION SECTION CL*28 000230* CL*28 000240* EXITS ABNORMAL: ABORT SECTION CL*28 000250* CL*28 000260* RETURN CODES: NONE CL*28 000270* CL*28 000280* S-EOC-SWT CL*28 000290* S-END-OF-CURSOR 'Y' CL*28 000300* CL*28 000310* CL*28 000320* DATABASE ACCESS: CL*28 000330* CL*28 000340* TS27CLT2.PLAN_TABLE RETRIEVAL CL*28 000350* SYSIBM.SYSSTMT RETRIEVAL CL*28 000360* CL*28 000370* CL*28 000380* INCLUDE MODULES: CLTYDBWS - WORKING STORAGE FOR ABEND ROUTINE CL*28 000390* CLTYDBER - DB2 ABEND ROUTINE CL*28 000400* CL*28 000410* CL*28 000420* CL*28 000430*-------------------------------------------------------------- CL*28 000440* MODIFICATION LOG CL*28 000450*-------------------------------------------------------------- CL*28 000460* INIT ! DATE ! COMMENTS CL*28 000470*======!========!============================================== CL*28 000480*______!________!______________________________________________ CL*28 000490*______!________!______________________________________________ CL*28 000500*______!________!______________________________________________ CL*28 000510*______!________!______________________________________________ CL*28 000520* CL*28 000530*************************************************************** CL*28 000540/************************************************************** CL*28 000550 ENVIRONMENT DIVISION. CL*28 000560*************************************************************** CL*28 000570 CONFIGURATION SECTION. CL*28 000580 INPUT-OUTPUT SECTION. CL*28 000590 CL*28 000600 FILE-CONTROL. CL*28 000610 CL*28 000620 SELECT EXPLAIN-REPORT-FILE ASSIGN TO SYS010. CL*28 000630 CL*28 000640/************************************************************** CL*28 000650 DATA DIVISION. CL*28 000660*************************************************************** CL*28 000670 CL*28 000680 FILE SECTION. CL*28 000690 CL*28 000700*************************************************************** CL*28 000710* O U T P U T F I L E S CL*28 000720*************************************************************** CL*28 000730 CL*28 000740 CL*28 000750 FD EXPLAIN-REPORT-FILE CL*28 000760 RECORDING MODE IS F CL*28 000770 BLOCK CONTAINS 0 RECORDS CL*28 000780 LABEL RECORDS ARE STANDARD CL*28 000790 DATA RECORD IS REPORT-RECORD. CL*28 000800 CL*28 000810 01 REPORT-RECORD PIC X(133). CL*28 000820 CL*28 000830 CL*28 000840/***************************************************************** CL*28 000850 WORKING-STORAGE SECTION. CL*28 000860****************************************************************** CL*28 000870 CL*28 000880 01 FILLER PIC X(40) VALUE CL*28 000890 'EXPLNRPT WORKING STORAGE STARTS HERE'. CL*28 000900 CL*28 000910 CL*28 000920****************************************************************** CL*28 000930* A C C U M U L A T O R S * CL*28 000940****************************************************************** CL*28 000950 CL*28 000960 01 ACCUMULATORS. CL*28 000970 05 A-LINE-CNT PIC S9(04) COMP VALUE +66. CL*28 000980 05 A-PAGE-CNT PIC S9(04) COMP VALUE ZERO. CL*28 000990 CL*28 001000 CL*28 001010 CL*28 001020****************************************************************** CL*28 001030* C O N S T A N T S * CL*28 001040****************************************************************** CL*28 001050 CL*28 001060 01 CONSTANTS. CL*28 001070 05 C-PAGE-LIMIT PIC S9(04) COMP VALUE +60. CL*28 001080 CL*28 001090 CL*28 001100 CL*28 001110****************************************************************** CL*28 001120* S W I T C H E S * CL*28 001130****************************************************************** CL*28 001140 CL*28 001150 01 SWITCHES. CL*28 001160 CL*28 001170 05 S-EOC-SWT PIC X(01) VALUE 'N'. CL*28 001180 88 S-END-OF-CURSOR VALUE 'Y'. CL*28 001190 CL*28 001200 CL*28 001210****************************************************************** CL*28 001220* W O R K A R E A S * CL*28 001230****************************************************************** CL*28 001240 CL*28 001250 01 WORKAREAS. CL*28 001260 CL*28 001270 05 W-SAVE-STMTNO PIC S9(04) COMP VALUE ZEROS. CL*28 001280 CL*28 001290 05 W-SEQNO PIC 9(06) VALUE ZEROS. CL*28 001300 05 W-STMTNO PIC 9(06) VALUE ZEROS. CL*28 001310 05 W-SECTNO PIC 9(06) VALUE ZEROS. CL*28 001320 CL*28 001330 05 W-SAVE-TEXT. CL*28 001340 10 FILLER PIC X(06). CL*28 001350 10 W-TEXT PIC X(89). CL*28 001360 CL*28 001370 05 W-TIMESTAMP. CL*28 001380 10 W-DATE. CL*28 001390 15 W-DATE-YYYY PIC X(04). CL*28 001400 15 W-DATE-MM PIC X(02). CL*28 001410 15 W-DATE-DD PIC X(02). CL*28 001420 10 W-TIME PIC X(06). CL*28 001430 CL*28 001440 05 INPUT-PARM. CL*28 001450 10 FILLER PIC X(04). CL*28 001460 10 PGMNAME PIC X(08). CL*28 001470 10 FILLER PIC X(68). CL*28 001480 CL*28 001490 CL*28 001500/***************************************************************** CL*28 001510* P R I N T L I N E S * CL*28 001520****************************************************************** CL*28 001530 CL*28 001540 01 PRINTLINES. CL*28 001550 CL*28 001560 05 P-TITLE-1. CL*28 001570 10 FILLER PIC X(01) VALUE '1'. CL*28 001580 10 FILLER PIC X(53) VALUE SPACES. CL*28 001590 10 FILLER PIC X(21) VALUE CL*28 001600 'EXPLAIN RESULTS FOR: '. CL*28 001610 10 P-PGMNAME-HDR PIC X(08). CL*28 001620 10 FILLER PIC X(50) VALUE SPACES. CL*28 001630 CL*28 001640 05 P-TITLE-1A. CL*28 001650 10 FILLER PIC X(01) VALUE '1'. CL*28 001660 10 FILLER PIC X(49) VALUE SPACES. CL*28 001670 10 FILLER PIC X(25) VALUE CL*28 001680 'SQL STATEMENTS FOR PLAN: '. CL*28 001690 10 P-PGMNAME-HDR1A PIC X(08). CL*28 001700 10 FILLER PIC X(50) VALUE SPACES. CL*28 001710 CL*28 001720 05 P-TITLE-2. CL*28 001730 10 FILLER PIC X(01) VALUE ' '. CL*28 001740 10 FILLER PIC X(54) VALUE SPACES. CL*28 001750 10 FILLER PIC X(07) VALUE CL*28 001760 'DATE: '. CL*28 001770 10 P-DATE-YYYY PIC X(04). CL*28 001780 10 FILLER PIC X(01) VALUE '-'. CL*28 001790 10 P-DATE-MM PIC X(02). CL*28 001800 10 FILLER PIC X(01) VALUE '-'. CL*28 001810 10 P-DATE-DD PIC X(02). CL*28 001820 10 FILLER PIC X(02) VALUE SPACES. CL*28 001830 10 FILLER PIC X(07) VALUE CL*28 001840 'PAGE: '. CL*28 001850 10 P-PAGE-CNT PIC ZZZ9. CL*28 001860 10 FILLER PIC X(48) VALUE SPACES. CL*28 001870 CL*28 001880 05 P-HEADING-1. CL*28 001890 10 FILLER PIC X(01) VALUE '0'. CL*28 001900 10 FILLER PIC X(12) VALUE SPACES. CL*28 001910 10 FILLER PIC X(99) VALUE CL*28 001920 ' Q'. CL*28 001930 10 FILLER PIC X(21) VALUE CL*28 001940 ' EST. #'. CL*30 001950 CL*28 001960 05 P-HEADING-2. CL*28 001970 10 FILLER PIC X(01) VALUE ' '. CL*28 001980 10 FILLER PIC X(12) VALUE SPACES. CL*28 001990 10 FILLER PIC X(24) VALUE CL*28 002000 'QUERY BLOCK PLAN '. CL*28 002010 10 FILLER PIC X(40) VALUE CL*28 002020 ' TAB ACCESS MATCH MAX ACCESS '. CL*28 002030 10 FILLER PIC X(40) VALUE CL*28 002040 'INDX SORTN SORTC TSLOCK '. CL*28 002050 10 FILLER PIC X(16) VALUE CL*28 002060 'OF ROWS'. CL*28 002070 CL*28 002080 CL*28 002090 05 P-HEADING-3. CL*28 002100 10 FILLER PIC X(01) VALUE ' '. CL*28 002110 10 FILLER PIC X(03) VALUE SPACES. CL*28 002120 10 FILLER PIC X(09) VALUE CL*28 002130 'PROGNAME'. CL*28 002140 10 FILLER PIC X(24) VALUE CL*28 002150 ' NO NO NO METHOD'. CL*28 002160 10 FILLER PIC X(40) VALUE CL*28 002170 'TNAME NO TYPE COLS COLS NAME '. CL*28 002180 10 FILLER PIC X(40) VALUE CL*28 002190 'ONLY U J O G U J O G MODE '. CL*28 002200 10 FILLER PIC X(16) VALUE CL*28 002210 'AFFECTED'. CL*28 002220 CL*28 002230 05 P-HEADING-4. CL*28 002240 10 FILLER PIC X(01) VALUE ' '. CL*28 002250 10 FILLER PIC X(03) VALUE SPACES. CL*28 002260 10 FILLER PIC X(09) VALUE CL*28 002270 '--------'. CL*28 002280 10 FILLER PIC X(24) VALUE CL*28 002290 '----- ----- ---- ------'. CL*28 002300 10 FILLER PIC X(40) VALUE CL*28 002310 '-------- --- ------ ----- ---- --------'. CL*28 002320 10 FILLER PIC X(40) VALUE CL*28 002330 '---- --------- --------- ------ '. CL*28 002340 10 FILLER PIC X(16) VALUE CL*28 002350 '--------'. CL*28 002360 CL*28 002370 05 P-HEADING-1A. CL*28 002380 10 FILLER PIC X(01) VALUE '0'. CL*28 002390 10 FILLER PIC X(03) VALUE SPACES. CL*28 002400 10 FILLER PIC X(08) VALUE CL*28 002410 'PLANNAME'. CL*28 002420 10 FILLER PIC X(08) VALUE CL*28 002430 ' SEQNO '. CL*28 002440 10 FILLER PIC X(08) VALUE CL*28 002450 ' STMTNO'. CL*28 002460 10 FILLER PIC X(08) VALUE CL*28 002470 ' SECTNO'. CL*28 002480 10 FILLER PIC X(02) VALUE SPACES. CL*28 002490 10 FILLER PIC X(14) VALUE CL*28 002500 'STATEMENT TEXT'. CL*28 002510 10 FILLER PIC X(81) VALUE SPACES. CL*28 002520 CL*28 002530 05 P-HEADING-2A. CL*28 002540 10 FILLER PIC X(01) VALUE ' '. CL*28 002550 10 FILLER PIC X(03) VALUE SPACES. CL*28 002560 10 FILLER PIC X(08) VALUE CL*28 002570 '--------'. CL*28 002580 10 FILLER PIC X(08) VALUE CL*28 002590 ' ------'. CL*28 002600 10 FILLER PIC X(08) VALUE CL*28 002610 ' ------'. CL*28 002620 10 FILLER PIC X(08) VALUE CL*28 002630 ' ------'. CL*28 002640 10 FILLER PIC X(02) VALUE SPACES. CL*28 002650 10 FILLER PIC X(95) VALUE ALL '-'. CL*28 002660 CL*28 002670 CL*28 002680 05 P-DETAIL. CL*28 002690 10 FILLER PIC X(01) VALUE ' '. CL*28 002700 10 FILLER PIC X(03) VALUE SPACES. CL*28 002710 10 P-PGMNAME PIC X(08) VALUE SPACES. CL*28 002720 10 FILLER PIC X(01) VALUE SPACES. CL*28 002730 10 P-QUERYNO PIC ZZZZ9 VALUE ZEROS. CL*28 002740 10 FILLER PIC X(01) VALUE SPACES. CL*28 002750 10 P-QBLOCKNO PIC ZZZZ9 VALUE ZEROS. CL*28 002760 10 FILLER PIC X(01) VALUE SPACES. CL*28 002770 10 P-PLANNO PIC ZZZ9 VALUE ZEROS. CL*28 002780 10 FILLER PIC X(01) VALUE SPACES. CL*28 002790 10 P-METHOD PIC ZZZZZ9 VALUE ZEROS. CL*28 002800 10 FILLER PIC X(01) VALUE SPACES. CL*28 002810 10 P-TNAME PIC X(08) VALUE ZEROS. CL*28 002820 10 FILLER PIC X(01) VALUE SPACES. CL*28 002830 10 P-TABNO PIC ZZ9 VALUE ZEROS. CL*28 002840 10 FILLER PIC X(01) VALUE SPACES. CL*28 002850 10 P-ACCESSTYPE PIC X(06) VALUE SPACES. CL*28 002860 10 FILLER PIC X(01) VALUE SPACES. CL*28 002870 10 P-MATCHCOLS PIC ZZZZ9 VALUE ZEROS. CL*28 002880 10 FILLER PIC X(01) VALUE SPACES. CL*28 002890 10 P-MAXCOLS PIC ZZZ9 VALUE ZEROS. CL*28 002900 10 FILLER PIC X(01) VALUE SPACES. CL*28 002910 10 P-ACCESSNAME PIC X(08) VALUE SPACES. CL*28 002920 10 FILLER PIC X(01) VALUE SPACES. CL*28 002930 10 P-INDEXONLY PIC X(04) VALUE SPACES. CL*28 002940 10 FILLER PIC X(04) VALUE SPACES. CL*28 002950 10 P-SORTN-UNIQ PIC X(01) VALUE SPACES. CL*28 002960 10 FILLER PIC X(01) VALUE SPACES. CL*28 002970 10 P-SORTN-JOIN PIC X(01) VALUE SPACES. CL*28 002980 10 FILLER PIC X(01) VALUE SPACES. CL*28 002990 10 P-SORTN-ORDERBY PIC X(01) VALUE SPACES. CL*28 003000 10 FILLER PIC X(01) VALUE SPACES. CL*28 003010 10 P-SORTN-GROUPBY PIC X(01) VALUE SPACES. CL*28 003020 10 FILLER PIC X(05) VALUE SPACES. CL*28 003030 10 P-SORTC-UNIQ PIC X(01) VALUE SPACES. CL*28 003040 10 FILLER PIC X(01) VALUE SPACES. CL*28 003050 10 P-SORTC-JOIN PIC X(01) VALUE SPACES. CL*28 003060 10 FILLER PIC X(01) VALUE SPACES. CL*28 003070 10 P-SORTC-ORDERBY PIC X(01) VALUE SPACES. CL*28 003080 10 FILLER PIC X(01) VALUE SPACES. CL*28 003090 10 P-SORTC-GROUPBY PIC X(01) VALUE SPACES. CL*28 003100 10 FILLER PIC X(04) VALUE SPACES. CL*28 003110 10 P-TSLOCKMODE PIC X(05) VALUE SPACES. CL*28 003120 10 FILLER PIC X(20) VALUE SPACES. CL*28 003130 CL*28 003140 05 P-DETAIL-1. CL*28 003150 10 FILLER PIC X(01) VALUE ' '. CL*28 003160 10 FILLER PIC X(03) VALUE SPACES. CL*28 003170 10 P-PLNAME PIC X(08) VALUE SPACES. CL*28 003180 10 FILLER PIC X(02) VALUE SPACES. CL*28 003190 10 P-SEQNO PIC X(06) VALUE SPACES. CL*28 003200 10 FILLER PIC X(02) VALUE SPACES. CL*28 003210 10 P-STMTNO PIC X(06) VALUE SPACES. CL*28 003220 10 FILLER PIC X(02) VALUE SPACES. CL*28 003230 10 P-SECTNO PIC X(06) VALUE SPACES. CL*28 003240 10 FILLER PIC X(02) VALUE SPACES. CL*28 003250 10 P-STMT-TEXT PIC X(95) VALUE SPACES. CL*28 003260 CL*28 003270 01 T-STMT-TEXT-TABLE. CL*28 003280 05 T-STMT-TEXT-LINE OCCURS 3 TIMES PIC X(95). CL*28 003290 CL*28 003300 CL*28 003310 CL*28 003320/***************************************************************** CL*28 003330* D A T A B A S E R E C O R D S (DCLGENS) * CL*28 003340****************************************************************** CL*28 003350 CL*28 003360 CL*28 003370**************** CL*28 003380* SQLCA CL*28 003390**************** CL*28 003400 EXEC SQL CL*28 003410 INCLUDE SQLCA CL*28 003420 END-EXEC. CL*28 003430 CL*28 003440 CL*28 003450**************************** CL*28 003460* PLAN-TABLE CL*28 003470**************************** CL*28 003480 EXEC SQL CL*28 003490 INCLUDE PLANTAB CL*28 003500 END-EXEC. CL*28 003510 CL*28 003520 CL*28 003530**************************** CL*28 003540* SYSIBM.SYSSTMT CL*28 003550**************************** CL*28 003560 EXEC SQL CL*28 003570 INCLUDE STMTTAB CL*28 003580 END-EXEC. CL*28 003590 CL*28 003600**************************** CL*28 003610* SYSIBM.SYSINDEXES CL*28 003620**************************** CL*28 003630 EXEC SQL CL*28 003640 INCLUDE SYSINDX CL*28 003650 END-EXEC. CL*28 003660 CL*28 003670 CL*28 003680 ++INCLUDE CLTYDBWS CL*28 003690 CL*28 003700 01 FILLER PIC X(48) VALUE CL*28 003710 'PROGRAM EXPLNRPT WORKING STORAGE ENDS HERE'. CL*28 003720 CL*28 003730 CL*28 003740/***************************************************************** CL*28 003750 PROCEDURE DIVISION. CL*28 003760****************************************************************** CL*28 003770 CL*28 003780****************************************************************** CL*28 003790 C0000-CONTROL SECTION. CL*28 003800****************************************************************** CL*28 003810 CL*28 003820 PERFORM C0100-INITIALIZATION. CL*28 003830 PERFORM C0200-MAINLINE. CL*28 003840 PERFORM C0300-FINALIZATION. CL*28 003850 CL*28 003860 GOBACK. CL*28 003870 CL*28 003880 CL*28 003890****************************************************************** CL*28 003900 C0100-INITIALIZATION SECTION. CL*28 003910****************************************************************** CL*28 003920 CL*28 003930 PERFORM S0600-VALIDATE-PARM. CL*28 003940 CL*28 003950 OPEN OUTPUT EXPLAIN-REPORT-FILE. CL*28 003960 CL*28 003970 CL*28 003980**************************** CL*28 003990* CURSOR PLANCUR CL*28 004000**************************** CL*28 004010 EXEC SQL CL*28 004020 DECLARE PLANCUR CURSOR FOR CL*28 004030 SELECT QUERYNO, CL*28 004040 QBLOCKNO, CL*28 004050 PROGNAME, CL*28 004060 PLANNO, CL*28 004070 METHOD, CL*28 004080 TNAME, CL*28 004090 TABNO, CL*28 004100 ACCESSTYPE, CL*28 004110 MATCHCOLS, CL*28 004120 ACCESSNAME, CL*28 004130 INDEXONLY, CL*28 004140 SORTN_UNIQ, CL*28 004150 SORTN_JOIN, CL*28 004160 SORTN_ORDERBY, CL*28 004170 SORTN_GROUPBY, CL*28 004180 SORTC_UNIQ, CL*28 004190 SORTC_JOIN, CL*28 004200 SORTC_ORDERBY, CL*28 004210 SORTC_GROUPBY, CL*28 004220 TSLOCKMODE, CL*28 004230 TIMESTAMP CL*28 004240 FROM TS27CLT2.PLAN_TABLE CL*28 004250 WHERE PROGNAME = :PGMNAME CL*28 004260 ORDER BY QUERYNO CL*28 004270 END-EXEC. CL*28 004280 CL*28 004290 CL*28 004300**************************** CL*28 004310* CURSOR STMTCUR CL*28 004320**************************** CL*28 004330 EXEC SQL CL*28 004340 DECLARE STMTCUR CURSOR FOR CL*28 004350 SELECT PLNAME, CL*28 004360 SEQNO, CL*28 004370 STMTNO, CL*28 004380 SECTNO, CL*28 004390 TEXT CL*28 004400 FROM SYSIBM.SYSSTMT CL*28 004410 WHERE PLNAME = :PGMNAME CL*28 004420 ORDER BY STMTNO, SEQNO CL*28 004430 END-EXEC. CL*28 004440 CL*28 004450 EXEC SQL CL*28 004460 OPEN PLANCUR CL*28 004470 END-EXEC. CL*28 004480 CL*28 004490 EVALUATE TRUE CL*28 004500 WHEN SQLCODE = 0 CL*28 004510 CONTINUE CL*28 004520 WHEN OTHER CL*28 004530 DISPLAY 'ABORT ON CURSOR OPEN C0100 OF PGM EXPLNRPT' CL*28 004540 PERFORM S9000-DB2-ERROR CL*28 004550 END-EVALUATE. CL*28 004560 CL*28 004570 EXEC SQL CL*28 004580 OPEN STMTCUR CL*28 004590 END-EXEC. CL*28 004600 CL*28 004610 EVALUATE TRUE CL*28 004620 WHEN SQLCODE = 0 CL*28 004630 CONTINUE CL*28 004640 WHEN OTHER CL*28 004650 DISPLAY 'ABORT ON CURSOR OPEN C0100 OF PGM EXPLNRPT' CL*28 004660 PERFORM S9000-DB2-ERROR CL*28 004670 END-EVALUATE. CL*28 004680 CL*28 004690 PERFORM S0100-FETCH-CURSOR. CL*28 004700 CL*28 004710 IF NOT S-END-OF-CURSOR CL*28 004720 MOVE PROGNAME OF DCLPLAN-TABLE TO P-PGMNAME-HDR CL*28 004730 P-PGMNAME-HDR1A CL*28 004740 P-PGMNAME CL*28 004750 MOVE TIMESTAMP OF DCLPLAN-TABLE TO W-TIMESTAMP CL*28 004760 MOVE W-DATE-YYYY TO P-DATE-YYYY CL*28 004770 MOVE W-DATE-MM TO P-DATE-MM CL*28 004780 MOVE W-DATE-DD TO P-DATE-DD. CL*28 004790 CL*28 004800 CL*28 004810****************************************************************** CL*28 004820 C0200-MAINLINE SECTION. CL*28 004830****************************************************************** CL*28 004840 CL*28 004850 PERFORM S0200-PROCESS CL*28 004860 UNTIL S-END-OF-CURSOR. CL*28 004870 CL*28 004880 MOVE +66 TO A-LINE-CNT. CL*28 004890 MOVE 'N' TO S-EOC-SWT. CL*28 004900 PERFORM S0150-FETCH-CURSOR1. CL*28 004910 CL*28 004920 PERFORM S0210-PROCESS CL*28 004930 UNTIL S-END-OF-CURSOR. CL*28 004940 CL*28 004950 CL*28 004960****************************************************************** CL*28 004970 C0300-FINALIZATION SECTION. CL*28 004980****************************************************************** CL*28 004990 CL*28 005000 CLOSE EXPLAIN-REPORT-FILE. CL*28 005010 CL*28 005020 EXEC SQL CL*28 005030 CLOSE PLANCUR CL*28 005040 END-EXEC. CL*28 005050 CL*28 005060 EXEC SQL CL*28 005070 CLOSE STMTCUR CL*28 005080 END-EXEC. CL*28 005090 CL*28 005100 MOVE 0 TO RETURN-CODE. CL*28 005110 CL*28 005120 CL*28 005130/***************************************************************** CL*28 005140* S U B R O U T I N E S CL*28 005150****************************************************************** CL*28 005160 CL*28 005170/***************************************************************** CL*28 005180 S0100-FETCH-CURSOR SECTION. CL*28 005190* THIS SECTION POSTIONS POINTER IN CURSOR CL*28 005200****************************************************************** CL*28 005210 CL*28 005220 EXEC SQL CL*28 005230 FETCH PLANCUR CL*28 005240 INTO :DCLPLAN-TABLE.QUERYNO, CL*28 005250 :DCLPLAN-TABLE.QBLOCKNO, CL*28 005260 :DCLPLAN-TABLE.PROGNAME, CL*28 005270 :DCLPLAN-TABLE.PLANNO, CL*28 005280 :DCLPLAN-TABLE.METHOD, CL*28 005290 :DCLPLAN-TABLE.TNAME, CL*28 005300 :DCLPLAN-TABLE.TABNO, CL*28 005310 :DCLPLAN-TABLE.ACCESSTYPE, CL*28 005320 :DCLPLAN-TABLE.MATCHCOLS, CL*28 005330 :DCLPLAN-TABLE.ACCESSNAME, CL*28 005340 :DCLPLAN-TABLE.INDEXONLY, CL*28 005350 :DCLPLAN-TABLE.SORTN-UNIQ, CL*28 005360 :DCLPLAN-TABLE.SORTN-JOIN, CL*28 005370 :DCLPLAN-TABLE.SORTN-ORDERBY, CL*28 005380 :DCLPLAN-TABLE.SORTN-GROUPBY, CL*28 005390 :DCLPLAN-TABLE.SORTC-UNIQ, CL*28 005400 :DCLPLAN-TABLE.SORTC-JOIN, CL*28 005410 :DCLPLAN-TABLE.SORTC-ORDERBY, CL*28 005420 :DCLPLAN-TABLE.SORTC-GROUPBY, CL*28 005430 :DCLPLAN-TABLE.TSLOCKMODE, CL*28 005440 :DCLPLAN-TABLE.TIMESTAMP CL*28 005450 END-EXEC. CL*28 005460 CL*28 005470 IF SQLCODE = 100 CL*28 005480 MOVE 'Y' TO S-EOC-SWT. CL*28 005490 CL*28 005500 S0100-EXIT. CL*28 005510 EXIT. CL*28 005520 CL*28 005530 CL*28 005540/***************************************************************** CL*28 005550 S0150-FETCH-CURSOR1 SECTION. CL*28 005560* THIS SECTION POSTIONS POINTER IN CURSOR CL*28 005570****************************************************************** CL*28 005580 CL*28 005590 MOVE SPACES TO DCLTEXT OF DCLSYSSTMT. CL*28 005600 CL*28 005610 EXEC SQL CL*28 005620 FETCH STMTCUR CL*28 005630 INTO :DCLSYSSTMT.PLNAME, CL*28 005640 :DCLSYSSTMT.SEQNO, CL*28 005650 :DCLSYSSTMT.STMTNO, CL*28 005660 :DCLSYSSTMT.SECTNO, CL*28 005670 :DCLSYSSTMT.DCLTEXT CL*28 005680 END-EXEC. CL*28 005690 CL*28 005700 IF SQLCODE = 100 CL*28 005710 MOVE 'Y' TO S-EOC-SWT. CL*28 005720 CL*28 005730 S0150-EXIT. CL*28 005740 EXIT. CL*28 005750 CL*28 005760 CL*28 005770/***************************************************************** CL*28 005780 S0200-PROCESS SECTION. CL*28 005790* THIS SECTION CONTROLS THE PRINTING OF THE HEADERS AND * CL*28 005800* DETAIL OF THE REPORT. CL*28 005810****************************************************************** CL*28 005820 CL*28 005830 IF A-LINE-CNT > C-PAGE-LIMIT CL*28 005840 PERFORM S0400-HEADER. CL*28 005850 CL*28 005860 PERFORM S0300-DETAIL. CL*28 005870 CL*28 005880 PERFORM S0100-FETCH-CURSOR. CL*28 005890 CL*28 005900 CL*28 005910 S0200-EXIT. CL*28 005920 EXIT. CL*28 005930 CL*28 005940 CL*28 005950/***************************************************************** CL*28 005960 S0210-PROCESS SECTION. CL*28 005970* THIS SECTION CONTROLS THE PRINTING OF THE HEADERS AND * CL*28 005980* DETAIL OF THE REPORT. CL*28 005990****************************************************************** CL*28 006000 CL*28 006010 IF A-LINE-CNT > C-PAGE-LIMIT CL*28 006020 PERFORM S0410-HEADER. CL*28 006030 CL*28 006040 PERFORM S0310-DETAIL. CL*28 006050 CL*28 006060 PERFORM S0150-FETCH-CURSOR1. CL*28 006070 CL*28 006080 CL*28 006090 S0210-EXIT. CL*28 006100 EXIT. CL*28 006110 CL*28 006120/***************************************************************** CL*28 006130 S0300-DETAIL SECTION. CL*28 006140* THIS SECTION MOVES DATA TO THE DETAIL LINE AND PRINTS CL*28 006150* THE DETAIL. CL*28 006160****************************************************************** CL*28 006170 CL*28 006180 MOVE QUERYNO OF DCLPLAN-TABLE TO P-QUERYNO. CL*28 006190 MOVE QBLOCKNO OF DCLPLAN-TABLE TO P-QBLOCKNO. CL*28 006200 MOVE PLANNO OF DCLPLAN-TABLE TO P-PLANNO. CL*28 006210 MOVE METHOD OF DCLPLAN-TABLE TO P-METHOD. CL*28 006220 MOVE TNAME OF DCLPLAN-TABLE TO P-TNAME. CL*28 006230 MOVE TABNO OF DCLPLAN-TABLE TO P-TABNO. CL*28 006240 MOVE ACCESSTYPE OF DCLPLAN-TABLE TO P-ACCESSTYPE. CL*28 006250 MOVE MATCHCOLS OF DCLPLAN-TABLE TO P-MATCHCOLS. CL*28 006260 MOVE ACCESSNAME OF DCLPLAN-TABLE TO P-ACCESSNAME. CL*28 006270 MOVE INDEXONLY OF DCLPLAN-TABLE TO P-INDEXONLY. CL*28 006280 MOVE SORTN-UNIQ OF DCLPLAN-TABLE TO P-SORTN-UNIQ. CL*28 006290 MOVE SORTN-JOIN OF DCLPLAN-TABLE TO P-SORTN-JOIN. CL*28 006300 MOVE SORTN-ORDERBY OF DCLPLAN-TABLE TO P-SORTN-ORDERBY. CL*28 006310 MOVE SORTN-GROUPBY OF DCLPLAN-TABLE TO P-SORTN-GROUPBY. CL*28 006320 MOVE SORTC-UNIQ OF DCLPLAN-TABLE TO P-SORTC-UNIQ. CL*28 006330 MOVE SORTC-JOIN OF DCLPLAN-TABLE TO P-SORTC-JOIN. CL*28 006340 MOVE SORTC-ORDERBY OF DCLPLAN-TABLE TO P-SORTC-ORDERBY. CL*28 006350 MOVE SORTC-GROUPBY OF DCLPLAN-TABLE TO P-SORTC-GROUPBY. CL*28 006360 MOVE TSLOCKMODE OF DCLPLAN-TABLE TO P-TSLOCKMODE. CL*28 006370 CL*28 006380 IF ACCESSNAME OF DCLPLAN-TABLE NOT = SPACES CL*28 006390 EXEC SQL CL*28 006400 SELECT COLCOUNT CL*28 006410 INTO :DCLSYSINDEXES.COLCOUNT CL*28 006420 FROM SYSIBM.SYSINDEXES CL*28 006430 WHERE NAME = :DCLPLAN-TABLE.ACCESSNAME CL*29 006440 END-EXEC CL*28 006450 MOVE COLCOUNT OF DCLSYSINDEXES TO P-MAXCOLS. CL*28 006460 CL*28 006470 CL*28 006480 WRITE REPORT-RECORD FROM P-DETAIL. CL*28 006490 ADD +1 TO A-LINE-CNT. CL*28 006500 MOVE SPACES TO P-DETAIL. CL*28 006510 CL*28 006520 S0300-EXIT. CL*28 006530 EXIT. CL*28 006540 CL*28 006550 CL*28 006560/***************************************************************** CL*28 006570 S0310-DETAIL SECTION. CL*28 006580* THIS SECTION MOVES DATA TO THE DETAIL LINE AND PRINTS CL*28 006590* THE DETAIL. CL*28 006600****************************************************************** CL*28 006610 CL*28 006620 MOVE SPACES TO T-STMT-TEXT-TABLE. CL*28 006630 CL*28 006640 IF W-SAVE-STMTNO NOT = STMTNO OF DCLSYSSTMT CL*28 006650 MOVE STMTNO OF DCLSYSSTMT TO W-SAVE-STMTNO CL*28 006660 ADD +1 TO A-LINE-CNT CL*28 006670 MOVE SPACES TO P-DETAIL-1 CL*28 006680 WRITE REPORT-RECORD FROM P-DETAIL-1. CL*28 006690 CL*28 006700 MOVE SPACES TO P-DETAIL-1. CL*28 006710 MOVE PLNAME OF DCLSYSSTMT TO P-PLNAME. CL*28 006720 MOVE SEQNO OF DCLSYSSTMT TO W-SEQNO. CL*28 006730 MOVE W-SEQNO TO P-SEQNO. CL*28 006740 MOVE STMTNO OF DCLSYSSTMT TO W-STMTNO. CL*28 006750 MOVE W-STMTNO TO P-STMTNO. CL*28 006760 MOVE SECTNO OF DCLSYSSTMT TO W-SECTNO. CL*28 006770 MOVE W-SECTNO TO P-SECTNO. CL*28 006780 MOVE TEXT-TEXT OF DCLSYSSTMT TO T-STMT-TEXT-TABLE. CL*28 006790 CL*28 006800 IF SEQNO OF DCLSYSSTMT = ZEROS CL*28 006810 MOVE T-STMT-TEXT-LINE(1) TO W-SAVE-TEXT CL*28 006820 MOVE W-TEXT TO T-STMT-TEXT-LINE(1). CL*28 006830 CL*28 006840 MOVE T-STMT-TEXT-LINE(1) TO P-STMT-TEXT. CL*28 006850 CL*28 006860 WRITE REPORT-RECORD FROM P-DETAIL-1. CL*28 006870 ADD +1 TO A-LINE-CNT. CL*28 006880 MOVE SPACES TO P-DETAIL-1. CL*28 006890 CL*28 006900 IF T-STMT-TEXT-LINE(2) NOT = SPACES CL*28 006910 MOVE T-STMT-TEXT-LINE(2) TO P-STMT-TEXT CL*28 006920 CL*28 006930 WRITE REPORT-RECORD FROM P-DETAIL-1 CL*28 006940 ADD +1 TO A-LINE-CNT CL*28 006950 MOVE SPACES TO P-DETAIL-1. CL*28 006960 CL*28 006970 IF T-STMT-TEXT-LINE(3) NOT = SPACES CL*28 006980 MOVE T-STMT-TEXT-LINE(3) TO P-STMT-TEXT CL*28 006990 CL*28 007000 WRITE REPORT-RECORD FROM P-DETAIL-1 CL*28 007010 ADD +1 TO A-LINE-CNT CL*28 007020 MOVE SPACES TO P-DETAIL-1. CL*28 007030 CL*28 007040 S0310-EXIT. CL*28 007050 EXIT. CL*28 007060 CL*28 007070 CL*28 007080/***************************************************************** CL*28 007090 S0400-HEADER SECTION. CL*28 007100* THIS SECTION PRINTS HEADER RECORDS AND INITIALIZES COUNTERS CL*28 007110****************************************************************** CL*28 007120 CL*28 007130 MOVE +5 TO A-LINE-CNT. CL*28 007140 ADD +1 TO A-PAGE-CNT. CL*28 007150 MOVE A-PAGE-CNT TO P-PAGE-CNT. CL*28 007160 WRITE REPORT-RECORD FROM P-TITLE-1. CL*28 007170 WRITE REPORT-RECORD FROM P-TITLE-2. CL*28 007180 WRITE REPORT-RECORD FROM P-HEADING-1. CL*28 007190 WRITE REPORT-RECORD FROM P-HEADING-2. CL*28 007200 WRITE REPORT-RECORD FROM P-HEADING-3. CL*28 007210 WRITE REPORT-RECORD FROM P-HEADING-4. CL*28 007220 CL*28 007230 S0400-EXIT. CL*28 007240 EXIT. CL*28 007250 CL*28 007260/***************************************************************** CL*28 007270 S0410-HEADER SECTION. CL*28 007280* THIS SECTION PRINTS HEADER RECORDS AND INITIALIZES COUNTERS CL*28 007290****************************************************************** CL*28 007300 CL*28 007310 MOVE +5 TO A-LINE-CNT. CL*28 007320 ADD +1 TO A-PAGE-CNT. CL*28 007330 MOVE A-PAGE-CNT TO P-PAGE-CNT. CL*28 007340 WRITE REPORT-RECORD FROM P-TITLE-1A. CL*28 007350 WRITE REPORT-RECORD FROM P-TITLE-2. CL*28 007360 WRITE REPORT-RECORD FROM P-HEADING-1A. CL*28 007370 WRITE REPORT-RECORD FROM P-HEADING-2A. CL*28 007380 CL*28 007390 S0410-EXIT. CL*28 007400 EXIT. CL*28 007410 CL*28 007420/***************************************************************** CL*28 007430 S0600-VALIDATE-PARM SECTION. CL*28 007440* THIS SECTION VALIDATES THE INPUT PROGRAM NAME CL*28 007450****************************************************************** CL*28 007460 CL*28 007470 ACCEPT INPUT-PARM. CL*28 007480 CL*28 007490 IF PGMNAME = SPACES CL*28 007500 DISPLAY 'INVALID INPUT PARAMETER' CL*28 007510 PERFORM S9000-DB2-ERROR. CL*28 007520 CL*28 007530 S0600-EXIT. CL*28 007540 EXIT. CL*28 007550 CL*28 007560****************************************************************** CL*28 007570*S9000-DB2-ERROR SECTION. CL*28 007580****************************************************************** CL*28 007590 CL*28 007600 ++INCLUDE CLTYDBER CL*28 007610 CL*28 007620 S9999-EXIT. CL*28 007630 EXIT. CL*28 007640 CL*28 ./ ADD NAME=EXTRACT ISREDIT MACRO ISPEXEC CONTROL ERRORS RETURN /* CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS FREE DD(LINEDD) ALLOC DD(LINEDD) DSN(EXTRACT.LINES) MOD ISPEXEC VGET EXGOTO SHARED IF &STR(&EXGOTO) > THEN GOTO &STR(&EXGOTO) FATAL_SECTION: + OPENFILE LINEDD OUTPUT ISREDIT (MBR) = MEMBER ISREDIT BRANCH WRITE WORKING ON "FATL" IN "&MBR" SET X = 0 ISREDIT FIND NEXT ' FATL ' DO WHILE &LASTCC = 0 ISREDIT LABEL .ZCSR = .CURR ISREDIT FIND FIRST ' MOVE ' .CURR .CURR SET CC1 = &LASTCC ISREDIT FIND NEXT P' $###$ ' .CURR .CURR SET CC2 = &LASTCC ISREDIT (LN,CL) = CURSOR IF &CC1 ¬= 0 OR &CC2 ¬= 0 THEN GOTO CONTINUE1 ISREDIT (LINE) = LINE .ZCSR SET CODE = &SUBSTR(&CL+2:&CL+4,&STR(&SYSNSUB(1,&LINE))) SET CODE = &STR(FATL&CODE) SET X = &X + 1 SET Y = &SUBSTR(&LENGTH(&STR(000&X))-3:&LENGTH(&STR(000&X)),+ &STR(000&X)) ISREDIT (LINENUM) = LINENUM .CURR ISREDIT LABEL &EVAL(&LINENUM - 10) = .A ISREDIT LABEL &EVAL(&LINENUM + 10) = .B ISREDIT FIND FIRST P'=' 1 .A .B DO WHILE &LASTCC = 0 ISREDIT (LINE) = LINE .ZCSR SET LINEDD = &STR(&MBR &Y &CODE &SYSNSUB(1,&LINE)) PUTFILE LINEDD ISREDIT FIND NEXT P'=' 1 .A .B END CONTINUE1: + ISREDIT FIND LAST P'=' .CURR .CURR ISREDIT FIND NEXT ' FATL ' END CLOSFILE LINEDD ERROR_SECTION: + OPENFILE LINEDD OUTPUT ISREDIT CURSOR = 1 1 ISREDIT BRANCH WRITE WORKING ON "ERR" IN "&MBR" SET X = 0 ISREDIT FIND NEXT ' ERR ' DO WHILE &LASTCC = 0 ISREDIT LABEL .ZCSR = .CURR ISREDIT FIND FIRST ' MOVE ' .CURR .CURR SET CC1 = &LASTCC ISREDIT FIND NEXT P' $###$ ' .CURR .CURR SET CC2 = &LASTCC ISREDIT (LN,CL) = CURSOR IF &CC1 ¬= 0 OR &CC2 ¬= 0 THEN GOTO CONTINUE2 ISREDIT (LINE) = LINE .ZCSR SET CODE = &SUBSTR(&CL+2:&CL+4,&STR(&SYSNSUB(1,&LINE))) SET CODE = &STR(LOAN&CODE) SET X = &X + 1 SET Y = &SUBSTR(&LENGTH(&STR(000&X))-3:&LENGTH(&STR(000&X)),+ &STR(000&X)) ISREDIT (LINENUM) = LINENUM .CURR ISREDIT LABEL &EVAL(&LINENUM - 10) = .A ISREDIT LABEL &EVAL(&LINENUM + 10) = .B ISREDIT FIND FIRST P'=' 1 .A .B DO WHILE &LASTCC = 0 ISREDIT (LINE) = LINE .ZCSR SET LINEDD = &STR(&MBR &Y &CODE &SYSNSUB(1,&LINE)) PUTFILE LINEDD ISREDIT FIND NEXT P'=' 1 .A .B END CONTINUE2: + ISREDIT FIND LAST P'=' .CURR .CURR ISREDIT FIND NEXT ' ERR ' END CLOSFILE LINEDD INFO_SECTION: + OPENFILE LINEDD OUTPUT ISREDIT CURSOR = 1 1 ISREDIT BRANCH WRITE WORKING ON "INFO" IN "&MBR" SET X = 0 ISREDIT FIND NEXT ' INFO ' DO WHILE &LASTCC = 0 ISREDIT LABEL .ZCSR = .CURR ISREDIT FIND FIRST ' MOVE ' .CURR .CURR SET CC1 = &LASTCC ISREDIT FIND NEXT P' $###$ ' .CURR .CURR SET CC2 = &LASTCC ISREDIT (LN,CL) = CURSOR IF &CC1 ¬= 0 OR &CC2 ¬= 0 THEN GOTO CONTINUE3 ISREDIT (LINE) = LINE .ZCSR SET CODE = &SUBSTR(&CL+2:&CL+4,&STR(&SYSNSUB(1,&LINE))) SET CODE = &STR(INFO&CODE) SET X = &X + 1 SET Y = &SUBSTR(&LENGTH(&STR(000&X))-3:&LENGTH(&STR(000&X)),+ &STR(000&X)) ISREDIT (LINENUM) = LINENUM .CURR ISREDIT LABEL &EVAL(&LINENUM - 10) = .A ISREDIT LABEL &EVAL(&LINENUM + 10) = .B ISREDIT FIND FIRST P'=' 1 .A .B DO WHILE &LASTCC = 0 ISREDIT (LINE) = LINE .ZCSR SET LINEDD = &STR(&MBR &Y &CODE &SYSNSUB(1,&LINE)) PUTFILE LINEDD ISREDIT FIND NEXT P'=' 1 .A .B END CONTINUE3: + ISREDIT FIND LAST P'=' .CURR .CURR ISREDIT FIND NEXT ' INFO ' END CLOSFILE LINEDD FREE DD(LINEDD) SET EXGOTO = ISPEXEC VPUT EXGOTO SHARED ISREDIT CANCEL EXIT ./ ADD NAME=FASTPATH 000100 //IBMUSERF JOB (ACCT#),FASTPATH, 000200 // NOTIFY=&SYSUID, 000400 // CLASS=A,MSGCLASS=X,COND=(0,NE) 000500 //ASMH EXEC PGM=ASMA90,PARM=(NODECK,OBJECT,NOESD,NORLD,NOXREF, 000600 //*SYSPARM(STOP522), 000800 // BATCH),REGION=5M 000900 *********************************************************************** 001000 * * 001100 * MODULE NAME = FASTPATH * 001200 * * 001300 * DESCRIPTIVE NAME = ISPF fast-path command processor * 001400 * * 001500 * STATUS = R130 * 001600 * * 001700 * FUNCTION = This program allows the use of fast-path commands * 001800 * without requiring customization of the ISPF * 001900 * environment. It provides two types of functions: * 002000 * * 002100 * 1. Initialization * 002200 * * 002300 * a. add fast-path commands to the user's * 002400 * in-storage copy of ISPCMDS * 002500 * b. pre-load specific modules to enhance performance * 002600 * and allow access from a private LOAD library * 002700 * c. issue STIMER to prevent S522 time-out abends * 002800 * * 002900 * 2. Processing * 003000 * * 003100 * a. invoke EDIT, BROWSE, VIEW, WorkPlace and SDSF * 003200 * with the appropriate NEWAPPL parameter * 003300 * b. store and retrieves parameters associated * 003400 * with user-specified tags * 003500 * c. retrieve a dsname under which the cursor * 003600 * is positionned * 003700 * * 003800 * AUTHOR = Gilbert Saint-flour * 003900 * * 004000 * ENVIRONMENT = SEE BELOW * 004100 * * 004200 * DEPENDENCIES: MVS/ESA 4.3 (or above) * 004300 * ISPF/PDF V3 (or above) * 004400 * STRING macro R504 (or above) * 004500 * * 004600 * MODULE TYPE = PROCEDURE, (CSECT TYPE) * 004700 * * 004800 * PROCESSOR = IBM OS/ASSEMBLER H VERSION 2 OR * 004900 * IBM HIGH LEVEL ASSEMBLER/MVS * 005000 * * 005100 * MODULE SIZE = 12K * 005200 * * 005300 * ATTRIBUTES = REENTERABLE, RMODE ANY, AMODE 31, * 005400 * PROBLEM STATE, KEY 8 * 005500 * APF AUTHORIZATION: NONE * 005600 * * 005700 * OPERATION = SEE BELOW * 005800 * * 005900 * When it is invoked as a command, or without a parm, FASTPATH * 006000 * adds (or replaces) fast path commands to the in-storage copy * 006100 * of the ISPCMDS table. * 006200 * * 006300 * When invoked as a program with a PARM, FASTPATH processes a * 006400 * fast path command according to the parameters. * 006500 * * 006600 * PARAMETERS = The parm field is used to pass parameters to the * 006700 * program as a comma-delimited string. * 006800 * * 006900 * RETURN-CODES = SEE BELOW * 007000 * * 007100 * 0 OK * 007200 * 4 Already Initialized * 007300 * 16 ISPF not active * 007400 * * 007500 * CHANGE ACTIVITY * 007600 * * 007700 * $100 Initial release * 007800 * $101 Add STIMER function to prevent S522 abends * 007900 * $102 Use ISPZ000 message instead of ISRZ000 * 008000 * $103 VPUT for EDBR0001 fails when EDBR0000 is created * 008100 * $104 Add variable for VIEW function of ISPF 4.1 * 008200 * $105 Implement PRELOAD routine (from ISPTASK5) * 008300 * $106 Issue "ISPCMDS Updated" message * 008400 * $107 Reorg initialisation phase * 008500 * $108 Add support for Work-place shell (ISPF 4.2) * 008600 * $109 Fix addressability problem in PRELOAD routine * 008700 * $110 Extract dsn under cursor when a ED/BR/VI/WP command * 008800 * is entered without an option. * 008900 * $111 If Zvprof='' THEN Zvprof=Prof * 009000 * $112 Check for R1=>A(TLD) when invoked from ISPTASK * 009100 * $113 Simulate WP with %DSLIST in ISPF V3 or V4R1 * 009200 * Do not issue STIMER if running with TIME=1440 * 009300 * $114 Add MACLIB function to VIEW MACLIB/MODGEN member * 009400 * $115 FSHELP function (Full-screen HELP) * 009500 * $116 Name of builtin functions changed (E becomes EDIT) * 009600 * New functions added: E V B (Direct Edit, View and Browse) * 009700 * $117 FTINCL Function * 009800 * If cursor-driven BROWSE fails, invoke BR (the VSAM Browser) * 009900 * $118 Replace FSHELP with TSOFS which is more generic * 010000 * Add CNTL and TIME functions * 010100 * $119 Concatenate PVTMACS to MACLIB/MODGEN if it is cataloged * 010200 * Add SYSID function * 010300 * $120 CRASH/LOGON/LOGOFF functions * 010400 * Add D function (delete member) * 010500 * $121 Make sure I've been link'd with the RENT attribute * 010600 * Use external copy of ISPLINK module * 010700 * $122 Use new CRASH function for LOGON & LOGOFF * 010800 * $123 PARMLIB function for OS/390 R2 * 010900 * Prevent MSGIKJ56400A when CRASH LOGON or CRASH LOGOFF * 011000 * is issued and a CLIST or EXEC command is active * 011100 * Add NOENQ option to DELMBR function * 011200 * $124 Prevent S0C9 in dsname extraction routine when TLDCLSWD=0 * 011300 * $125 Support ZEDITWS and ZVIEWWS variables * 011400 * $126 Add PROFILE option on WorkPlace VPUT * 011500 * $127 New function: EXECPGM * 011600 * $128 Reset ECTIOWA when CRASH is entered with no operand * 011700 * $129 Rewrite dsname extraction routine. * 011800 * Use VIEW if user doesn't have update auth to SYS1.PARMLIB * 011900 * $130 Add ZDEL function to display/set ZDEL variable. * 012000 * Add VERASE function to delete a variable from profile * 012100 * Add CONNECT function to start/display connection to WS * 012200 * Add NETSTAT function (full-screen NETSTAT) * 012300 * Add REXXTRY function * 012400 * Change SYSID function to use ZDEL instead of ";". * 012500 * Enhance ED/VI/BR/WP for compatibility with CNAEBROW/CNAEEDIT * 012600 * CRASH * issues command from ZTSICMD * 012700 * STOP522 code only generated if assembled with SYSPARM(STOP522)* 012800 * FASTPATH can now be link-edited under a different name * 012900 * * 013000 &REL SETC 'R130i' * 013100 *********************************************************************** 013200 PUNCH ' ORDER FASTPATH(P),JUL2DAYS,ISPCMDS,PRELOAD' 013300 FASTPATH CSECT 013400 FASTPATH RMODE ANY 013500 SAVE (14,12),,'FASTPATH &REL' 013600 LR R11,R15 1st base reg 013700 USING FASTPATH,R11 013800 LA R12,4095(,R11) 2nd base reg 013900 USING FASTPATH+4095,R12 014000 LA R0,DYNAML LENGTH OF DYNAMIC STORAGE AREA 014100 GETMAIN R,LV=(0) ALLOCATE DYNAMIC STORAGE 014200 ST R13,4(,R1) 014300 ST R1,8(,R13) 014400 LA R14,72(,R1) clear working storage 014500 LA R15,DYNAML-72 clear working storage 014600 SLR R1,R1 clear working storage 014700 MVCL R14,R0 clear working storage 014800 LM R13,R1,8(R13) SET R13, RELOAD R14-R1 014900 LR R9,R1 save PARM/CPPL address 015000 USING DYNAM,R13 015100 MVI BLANKS,C' ' 015200 MVC BLANKS+1(L'BLANKS-1),BLANKS 015300 MVC OPT,BLANKS 015400 * 015500 CSVQUERY SEARCH=JPALPA, SEARCH JPAQ + 015600 INADDR=BASEADDR, ADDRESS + 015700 OUTEPNM=OWNNAME, RETURN EP NAME + 015800 MF=(E,CSVQRYWK) WORK AREA 016300 *---------------------------------------------------------------------* 016400 * * 016500 * Locate/validate ISPF control blocks: TLD, TSI * 016600 * * 016700 *---------------------------------------------------------------------* 016800 FINDTLD L R4,PSATOLD-PSA My TCB 016900 USING TCB,R4 017000 *loop 017100 FINDTLD2 L R1,TCBFSA first save area 017200 L R1,24(,R1) R1 SLOT (ADDR OF TLD PTR) 017300 L R5,0(,R1) R5 -> TLD 017400 USING TLD,R5 017500 CLC =C'TLD',TLDTBLID is this the TLD? 017600 BE FINDTLD5 yes, exit loop 017700 L R4,TCBOTC previous TCB (ISPTASK) 017800 CL R4,TCBJSTCB am I lost? 017900 BNE FINDTLD2 no, keep on going 018000 *endloop 018100 B FINDTLD7 error 018200 FINDTLD5 EQU * 018300 ST R5,TLD@ save TLD address 018400 L R4,TLDTSIP R4 -> TSI 018500 USING TSI,R4 018600 CLC =C'ISPTSI',TSITBLID am I lost? 018700 BNE FINDTLD7 yes, error 018800 ST R4,TSI@ save TSI address 018900 B INIT00 continue - TLD & TSI are OK 019000 DROP R4,R5 TLD,TSI 019100 FINDTLD7 EQU * 019200 STRING 'Module ',(OWNNAME,,T),' failed initialization;', X 019300 ' TLD=',(TLD@,,X),' TSI=',(TSI@,,X), X 019400 INTO=LONGMSG 019500 TPUT LONGMSG,(R15) issue error message 019600 B QUIT16 exit with rc=16 019700 *********************************************************************** 019800 * * 019900 * INITIALISATION * 020000 * * 020100 * 1. invoked from ISPTASK with R1=>A(TLD): perform SETUP * 020200 * 2. invoked as a Command processor (R1 points to a CPPL): * 020300 * perform SETUP then re-invoke myself as a program. * 020400 * 3. invoked as a program with PARM='', via the CALL command * 020500 * or the SELECT service: add commands to ISPCMDS * 020600 * 4. invoked as a program with a non-null parm: * 020700 * process the requested function * 020800 * * 020900 *********************************************************************** 021000 INIT00 EQU * 021100 L R1,0(,R9) point at PARM/CBUF/TLD 021200 CLC =C'TLD',0(R1) is this the TLD? 021300 BNE INIT10 no, process the parm or CBUF 021400 BAL R14,SETUP00 SETUP (URP) 021500 B QUIT90 exit 021600 * 021700 INIT10 EQU * 021800 LOAD EPLOC=OWNNAME bump my use count 021900 MVC NEWPGM,OWNNAME NEW PROGRAM 022000 * 022100 L R1,PSATOLD-PSA My TCB 022200 CLC TCBFSA-TCB(,R1),4(R13) invoked via CALL or as a CP? 022300 BNE INIT30 no, continue 022400 * 022500 BAL R14,SETUP00 SETUP (URP) 022600 B XCTL00 re-invoke myself 022700 * 022800 * Force a PAGEIN of the FASTPATH module 022900 * 023000 INIT30 L R7,=A(ISPCMDS) first table entry 023100 PGSER R,LOAD,A=(R11),EA=(R7),ECB=0 023200 * 023300 * ISPEXEC CONTROL ERRORS RETURN 023400 * 023500 LA R1,=A($CONTROL,$ERRORS,$RETURN+VL) 023600 LINK SF=(E,ISPLINK$) CONTROL ERRORS RETURN 023700 LTR R15,R15 023800 BNZ QUIT16 ISPF not active 023900 *---------------------------------------------------------------------* 024000 * * 024100 * At this point, I've determined that I've been invoked as a * 024200 * program at the ISPTASK level. The current value of ZAPPLID * 024300 * doesn't matter at this point. * 024400 * * 024500 * If I'm invoked with PARM='', invoke the ADDCMDS routine to * 024600 * add the fast-path commands to the ISPCMDS table, then exit. * 024700 * * 024800 *---------------------------------------------------------------------* 024900 INIT50 L R3,0(,R9) point at parm 025000 LH R5,0(,R3) parm length 025100 LTR R5,R5 do we have a parm? 025200 BP SCANPARM yes, jump 025300 BAL R14,ADDCMDS <- add commands to ISPCMDS 025400 SLR R7,R7 RC=00 025500 B QUIT90 EXIT 025600 *---------------------------------------------------------------------* 025700 MACRO macro 025800 &NAME ISPLINK &OPRNDS,&ERRET= macro 025900 &NAME LINK SF=(E,ISPLINK$),PARAM=&OPRNDS,MF=(E,SIXWORDS),VL=1 macro 026000 AIF (T'&ERRET EQ 'O').MEND macro 026100 LTR R15,R15 Any error? 026200 BNZ &ERRET yes, jump 026300 .MEND MEND macro 026400 MACRO macro 026500 &NAME $LINK &EP=,&PARAM=,&ERRET= macro 026600 &NAME LA R0,=CL8'&EP' EP name 026700 L R1,CVTPTR CVT 026800 L R1,CVTLINK-CVTMAP(,R1) SYS1.LINKLIB 026900 STM R0,R1,12(R13) SF=L 027000 LINK SF=(E,12(,R13)),PARAM=&PARAM,VL=1,MF=(E,TENWORDS) 027100 AIF (T'&ERRET EQ 'O').MEND macro 027200 LTR R15,R15 Any error? 027300 BNZ &ERRET yes, jump 027400 .MEND MEND macro 027500 MACRO macro 027600 &NAME BEGIN_PROC &SAVE=BAKR macro 027700 $LTORG LOCTR 027800 &NAME BAL R15,=X'4AFF,0000,07FF' 027900 DC Y(&NAME._START-*) 028000 $FARRTNE LOCTR 028100 DS 0D 028200 AIF ('&SAVE' EQ 'BAKR').BAKR 028300 &NAME._START SAVE (14,12),,&NAME 028400 LR R12,R15 028500 USING &NAME._START,R12 028600 MEXIT macro 028700 .BAKR DC CL8'&NAME' 028800 &NAME._START BAKR R14,0 SAVE REGISTERS 028900 LR R12,R15 029000 USING &NAME._START,R12 029100 MEND macro 029200 *---------------------------------------------------------------------* 029300 * * 029400 * Parse the parm * 029500 * * 029600 * Input: PARM='EDIT,abcd,efgh' * 029700 * * 029800 * output: FUNCTION='EDIT ' * 029900 * OPT='abcd' * 030000 * OPT8='ABCD' * 030100 * PARM3='efgh' * 030200 * * 030300 *---------------------------------------------------------------------* 030400 SCANPARM LA R4,2(,R3) parm address 030500 BAL R14,PARSE_PARM parse parm into function,opt 030600 DC S(L'FUNCTION,FUNCTION) first operand 030700 DC S(L'OPT,OPT) second operand 030800 DC S(L'PARM3,PARM3) third operand 030900 MVC OPT8,OPT Save first 8 bytes 031000 OC OPT8,BLANKS Convert to upper-case 031100 STRING (OPT,,T),INTO=OPT2 count characters 031200 ST R15,OPTLEN length of &OPT 031300 *---------------------------------------------------------------------* 031400 * * 031500 * Split PARM3 into PROF and PARM4 * 031600 * * 031700 *---------------------------------------------------------------------* 031800 LA R4,PARM3 parm address 031900 LA R5,L'PARM3 parm address 032000 BAL R14,PARSE_PARM split PARM3 032100 DC S(L'PROF,PROF) third operand 032200 DC S(L'PARM4,PARM4) fourth operand 032300 *---------------------------------------------------------------------* 032400 * * 032500 * Retrieve ISPF variables * 032600 * * 032700 *---------------------------------------------------------------------* 032800 ISPFVARS LA R14,L'ZENVIR max length 032900 LA R15,L'ZAPPLID max length 033000 LA R0,L'ZUSER max length 033100 LA R1,L'ZPREFIX max length 033200 LA R2,L'ZSCREEN max length 033300 LA R3,L'ZDEL max length 033400 LA R4,L'ZSPLIT max length 033500 LA R5,L'ZWSCON max length 033600 LA R6,L'ZTSICMD max length 033700 STM R14,R6,TENWORDS length array 033800 &VARS SETC 'ZENVIR ZAPPLID ZUSER ZPREFIX ZSCREEN' 033900 &VARS SETC '&VARS ZDEL ZSPLIT ZWSCON ZTSICMD' 034000 ISPLINK ($VCOPY,=C'(&VARS)',TENWORDS,ZENVIR,$MOVE) 034100 MVC NEWAPPL,=C'ISR ' new appl (default) 034200 PACK ISPFVM,ZENVIR+5(1) 4.2 -> X'4F' 034300 MVN ISPFVM,ZENVIR+5+2 4.2 -> X'42' 034400 *---------------------------------------------------------------------* 034500 * * 034600 * Invoke function processor * 034700 * * 034800 *---------------------------------------------------------------------* 034900 BAL R15,SCANPAR2 035000 DC AL2(EDBR800-*),CL5'B' Direct Browse 035100 DC AL2(EDBR010-*),CL5'BROWSE' Builtin: Browse 035200 DC AL2(CNTL-*),CL5'CNTL' CNTL,0 035300 DC AL2(CONNECT-*),CL5'WSCON' CONNECT to WorkStation 035400 DC AL2(CRASH-*),CL5'CRASH' CRASH/LOGON/LOGOFF 035500 DC AL2(DELMBR-*),CL5'D' Delete Member 035600 DC AL2(EDBR800-*),CL5'E' Direct Edit 035700 DC AL2(EDBR010-*),CL5'EDIT' Builtin: Edit 035800 DC AL2(EXECPGM-*),CL5'EXECPGM' Exec pgm from link-list 035900 DC AL2(FTINCL-*),CL5'FTINCL' FTINCL,&skel,&panel 036000 DC AL2(ICS-*),CL5'ICS' ISPF Command Shell 036100 DC AL2(MACLIB-*),CL5'MACLIB' MACLIB 036200 DC AL2(NETSTAT-*),CL5'NETSTAT' NETSTAT 036300 DC AL2(PARMLIB-*),CL5'PARMLIB' PARMLIB 036400 DC AL2(REXXTRY-*),CL5'REXXTRY' REXXTRY 036500 DC AL2(SDSF-*),CL5'SDSF' SDSF 036600 DC AL2(SYSID-*),CL5'SYSID' SYSID 036700 DC AL2(TIME-*),CL5'TIME' TIME 036800 DC AL2(TSOFS-*),CL5'TSOFS' Full-screen TSO 036900 DC AL2(UTIL-*),CL5'UTIL' PDF Utilities 037000 DC AL2(EDBR800-*),CL5'V' Direct View 037100 DC AL2(VERASE-*),CL5'VERASE' VERASE 037200 DC AL2(EDBR010-*),CL5'VIEW' Builtin: View 037300 DC AL2(EDBRVIWP-*),CL5'WP' Builtin: Work-place 037400 DC AL2(ZDELFUNC-*),CL5'ZDEL' ZDEL 037500 DC X'FF',0Y(0) 037600 *LOOP 037700 SCANPAR2 CLC FUNCTION(5),2(R15) SAME FUNCTION? 037800 BE SCANPAR4 YES, EXIT LOOP 037900 LA R15,5+2(,R15) NEXT TYPE 038000 CLI 0(R15),X'FF' END OF TABLE? 038100 BNE SCANPAR2 NOT YET 038200 *ENDLOOP 038300 B QUIT12 unknown function, exit 038400 * 038500 SCANPAR4 AH R15,0(,R15) Add offset 038600 BR R15 execute function 038700 $LTORG LOCTR 038800 $FARRTNE LOCTR 038900 CVT DSECT=YES,LIST=NO Define CVT for PARMLIB function 039000 $FARRTNE LOCTR 039100 *********************************************************************** 039200 * * 039300 * FUNCTION=EDIT, BROWSE, VIEW, WP * 039400 * * 039500 *********************************************************************** 039600 EDBRVIWP DS 0H 039700 CLI ISPFVM,X'42' ISPF 4.2 or up? 039800 BNL EDBR010 yes, jump 039900 STRING '%DSLIST',INTO=NEWCMD TSO %DSLIST 040000 B XCTL00 execute command 040100 * 040200 EDBR010 CLI OPT,C' ' OPT=''? 040300 BE EDBR700 yes, jump 040400 *---------------------------------------------------------------------* 040500 * * 040600 * I've been invoked with parm='E,opt' or PARM='B,opt'. * 040700 * * 040800 *---------------------------------------------------------------------* 040900 EDBR020 CLC ZAPPLID,NEWAPPL Current APPL OK? 041000 BNE APPL_ISR no, jump 041100 * 041200 * Define profile variables used on EDIT/BROWSE panels 041300 * 041400 ISPLINK ($VDEFINE,VARLIST,PRJ1,$CHAR,=F'8') 041500 OC OPT,BLANKS convert to uppercase 041600 ISPLINK ($VDEFINE,=C'ZWRKDSN ',ZWRKDSN,$CHAR,=A(L'ZWRKDSN)) 041700 * 041800 * Check for ED MY.DATA.SET or ED CLIST(MBR) 041900 * 042000 CLC =C'* ',OPT previous data set? 042100 BE EDBR620 yes, jump 042200 CLI OPT,C'''' fully-qualified dsname? 042300 BE EDBR660 yes, jump 042400 LA R1,OPT 1st pos of dsname 042500 LA R2,9 search 9 characters 042600 *loop 042700 EDBR031 CLI 0(R1),C'.' does this look like a dsname? 042800 BE EDBR670 yes, exit 042900 CLI 0(R1),C'(' does this look like a dsname? 043000 BE EDBR670 yes, exit 043100 LA R1,1(,R1) bump index up 043200 BCT R2,EDBR031 scan rest of dsname 043300 *endloop 043400 * 043500 * Get the value of the EDBR0000 profile variable. It contains 043600 * the highest nnnn ever assigned to an EDBRnnnn variable. 043700 * 043800 EDBR080 ISPLINK ($VDEFINE,$EDBR0000,EDBR0000,$CHAR,=F'4') 043900 LA R6,1 index 044000 MVC EDBRNNNN,$EDBR0000 EDBR0000 044100 MVI EDBRNNNN+7,C'1' EDBR0001 044200 LA R1,=A($VGET,$EDBR0000+VL) 044300 LINK SF=(E,ISPLINK$) VGET EDBR0000 044400 LTR R15,R15 first time ever? 044500 BNZ EDBR193 yes, jump 044600 PACK DWD,EDBR0000 Z'0123' -> P'123' 044700 CVB R7,DWD high water-mark 044900 *---------------------------------------------------------------------* 045000 * * 045100 * Scan all EDBRnnnn variables for &OPT * 045200 * * 045300 *---------------------------------------------------------------------* 045400 *LOOP 045500 EDBR111 CVD R6,DWD NNN% 045600 OI DWD+7,15 NNNN 045700 UNPK EDBRNNNN+4(4),DWD EDBRNNNN 045900 ISPLINK ($VGET,EDBRNNNN),ERRET=EDBR180 046100 LA R0,L'STRING1 max length of variable 046200 ST R0,DWD max length of variable 046300 ISPLINK ($VCOPY,EDBRNNNN,DWD,STRING1,$MOVE), X 046400 ERRET=EDBR180 046600 LA R4,STRING1 VARIABLE VALUE 046700 L R5,DWD VARIABLE LENGTH 046800 BAL R14,PARSE_PARM split OPT2 046900 DC S(L'OPT2,OPT2) search argument 047000 DC S(L'PRJ1,PRJ1) 047100 DC S(L'LIB1,LIB1) 047200 DC S(L'LIB2,LIB2) 047300 DC S(L'LIB3,LIB3) 047400 DC S(L'LIB4,LIB4) 047500 DC S(L'TYP1,TYP1) 047600 DC S(L'PROF,PROF) 047700 DC S(L'MIX,MIX) 047800 DC S(L'FNAM,FNAM) 047900 DC S(L'ZEDLOCK,ZEDLOCK) 048000 DC S(L'ZEDLOCKP,ZEDLOCKP) 048100 DC S(L'ZPCFMCN,ZPCFMCN) 048200 DC S(L'ZVIEW,ZVIEW) 048300 DC S(L'ZVIMAC,ZVIMAC) 048400 DC S(L'ZVPROF,ZVPROF) 048500 DC S(L'ZREFTYPE,ZREFTYPE) WP SHELL 048600 DC S(L'ZWRKVOL,ZWRKVOL) WP SHELL 048700 DC S(L'ZWRKDSN,ZWRKDSN) WP SHELL 048800 DC S(L'ZEDITWS,ZEDITWS) view/edit 4.2 048900 DC S(L'ZVIEWWS,ZVIEWWS) view/edit 4.2 049300 CLC OPT,OPT2 IS THIS WHAT I'M LOOKING FOR? 049400 BNE EDBR190 NO, TRY NEXT ONE 049500 CLI ZREFTYPE,C' ' FIRST TIME? 049600 BNE *+8 NO, JUMP 049700 MVI ZREFTYPE,C'L' YES, DEFAULT TYPE IS LIBRARY 049800 CLI ZVPROF,C' ' FIRST TIME? 049900 BNE *+10 NO, JUMP 050000 MVC ZVPROF,PROF YES, COPY EDIT PROFILE 050100 CLI PROF,C' ' FIRST TIME? 050200 BNE *+10 NO, JUMP 050300 MVC PROF,ZVPROF YES, COPY VIEW PROFILE 050400 B EDBR200 yes, exit loop 050500 * 050600 EDBR180 ICM R0,B'1111',GAP first gap? 050700 BNZ EDBR190 no, jump 050800 ST R6,GAP yes, remember it 050900 EDBR190 LA R6,1(,R6) increment index 051000 CLR R6,R7 hwm reached yet? 051100 BNH EDBR111 next EDBRnnnn variable 051200 *ENDLOOP 051300 *---------------------------------------------------------------------* 051400 * * 051500 * &OPT has not been found in the profile variables; * 051600 * Check if it's a user data set such as CLIST * 051700 * * 051800 *---------------------------------------------------------------------* 051900 CLI ZPREFIX,C' ' ZPREFIX=''? 052000 BE EDBR192 yes, jump 052100 STRING (ZPREFIX,,T),'.',(OPT,,T),INTO=ZWRKDSN 052200 BAL R14,LISTDSI check existence of data set 052300 LTR R15,R15 RC=0 from LOCATE? 052400 BNZ EDBR192 no, jump 052500 MVC OPT2,OPT restore dsname 052600 B EDBR670 yes, jump 052700 *---------------------------------------------------------------------* 052800 * * 052900 * Assign the next available EDBRnnn number. * 053000 * * 053100 *---------------------------------------------------------------------* 053200 EDBR192 EQU * 053300 ICM R0,B'1111',GAP did we find a gap? 053400 BNZ EDBR194 yes, jump 053500 * 053600 * no gap found, use hwm+1 and update EDBR0000 053700 * 053800 EDBR193 CVD R6,DWD NNN% 053900 OI DWD+7,15 NNNN 054000 UNPK EDBR0000,DWD NNNN 054100 LA R1,=A($VPUT,$EDBR0000,$PROFILE+VL) 054200 LINK SF=(E,ISPLINK$) VPUT EDBR0000 PROFILE 054300 LR R0,R6 gap=hwm+1 054400 * 054500 * reuse first gap 054600 * 054700 EDBR194 CVD R0,DWD NNN% 054800 OI DWD+7,15 NNNN 054900 UNPK EDBRNNNN+4(4),DWD EDBRNNNN 055100 * 055200 EDBR196 XC STRING1,STRING1 clear work area 055300 BAL R14,ZVIEW00 set ZVIEW to YES/NO for VI/BR 055400 BAL R14,VPUT00 update EDBRnnnn variable 055500 B EDBR500 do edit/browse 055600 *---------------------------------------------------------------------* 055700 * * 055800 * &OPT has been found in the profile. * 055900 * pass PRJ1-ZEDLOCKP values to edit/browse * 056000 * * 056100 *---------------------------------------------------------------------* 056200 EDBR200 BAL R14,ZVIEW00 set ZVIEW to YES/NO for VI/BR 056300 LA R1,=A($VPUT,VARLIST+VL) 056400 LINK SF=(E,ISPLINK$) VPUT (&VARLIST) 056600 *---------------------------------------------------------------------* 056700 * * 056800 * Display the EDIT, BROWSE or VIEW Entry Panel * 056900 * * 057000 *---------------------------------------------------------------------* 057100 EDBR500 STRING 'PGM(ISREDIT) PARM(P,ISREDM01)',INTO=COMMAND 057200 CLI FUNCTION,C'E' FUNCTION=E? 057300 BE EDBR530 yes, jump 057400 STRING 'PGM(ISRUDA) PARM(ISRWORK)',INTO=COMMAND 057500 CLI FUNCTION,C'W' FUNCTION=W? 057600 BE EDBR530 yes, jump 057700 STRING 'PGM(ISRBRO) PARM(ISRBRO01)',INTO=COMMAND 057800 EDBR530 ISPLINK ($SELECT,=A(L'COMMAND),COMMAND) 057900 * 058000 * The user has modified the values of PRJ1-ZEDLOCKP 058100 * Update the corresponding EDBRnnnn variable 058200 * 058300 BAL R14,VPUT00 update EDBRnnnn variable 058400 * 058500 * Delete all variables in function pool 058600 * 058700 LA R1,=A($VRESET+VL) 058800 LINK SF=(E,ISPLINK$) VRESET 058900 B QUIT90 exit 059000 *********************************************************************** 059100 * * 059200 * Direct Edit, Browse and View (CNAEBROW/CNAEEDIT) * 059300 * * 059400 * PARM='EDIT,CLIST(MBR)' * 059500 * * 059600 *********************************************************************** 059700 * 059800 * Retrieve BRDSN/BRMEM when invoked with 'EDIT,*' 059900 * 060000 EDBR620 EQU * 060100 LA R0,L'OPT max length 060200 ST R0,OPTLEN max length 060300 ISPLINK ($VCOPY,=C'BRDSN ',OPTLEN,OPT,$MOVE),ERRET=EDBR920 060400 LA R0,L'OPT8 max length 060500 ST R0,DWD max length 060600 ISPLINK ($VCOPY,=C'BRMEM ',DWD,OPT8,$MOVE),ERRET=EDBR626 060700 CLI OPT8,C' ' do we have a member name? 060800 BE EDBR626 yes, jump 060900 STRING (OPT,,T),'(',(OPT8,,T),')',INTO=OPT 061000 ST R15,OPTLEN update length 061100 EDBR626 EQU * 061200 LA R0,L'BRVOL max length 061300 ST R0,DWD max length 061400 ISPLINK ($VCOPY,=C'BRVOL ',DWD,BRVOL,$MOVE),ERRET=EDBR626 061500 B EDBR800 061600 * 061700 * Remove apostrophes that surround a fully-qualified dsname 061800 * 061900 EDBR660 EQU * 062000 L R1,OPTLEN get L'&OPT 062100 BCTR R1,0 minus 1 062200 BCTR R1,0 minus 2 062300 STRING (OPT2+1,(R1)),INTO=OPT remove surrounding quotes 062400 ST R15,OPTLEN update length 062500 B EDBR680 062600 * 062700 * Prefix &zprefix to a non fully-qualified dsname 062800 * 062900 EDBR670 EQU * 063000 CLI ZPREFIX,C' ' ZPREFIX=''? 063100 BE EDBR680 yes, jump 063200 STRING (ZPREFIX,,T),'.',(OPT2,,T),INTO=OPT 063300 ST R15,OPTLEN update length 063400 * 063500 * Update BRDSN/BRMEM/BRVOL in profile 063600 * 063700 EDBR680 EQU * 064100 ISPLINK ($VREPLACE,=C'BRDSN ',OPTLEN,OPT) 064200 ISPLINK ($VREPLACE,=C'BRMEM ',=F'1',BLANKS) BRMEM='' 064300 ISPLINK ($VREPLACE,=C'BRVOL ',=F'1',BLANKS) BRVOL='' 064400 ISPLINK ($VPUT,=C'(BRDSN BRMEM BRVOL)',$PROFILE) 064500 B EDBR800 invoke PDF service 064600 *********************************************************************** 064700 * * 064800 * No dsn or tag has been specified (OPT=''). * 064900 * Check for a cursor-driven invocation * 065000 * * 065100 *********************************************************************** 065200 EDBR700 BAL R14,CURSOR get dsn at cursor location 065300 LTR R1,R1 Dsname extracted? 065400 BNP EDBR920 no, jump 065500 STRING ((R1),(R0)),INTO=OPT 065600 ST R15,OPTLEN update length 065700 CLI PROF,C' ' profile specified? 065800 BNE EDBR800 yes, jump 065900 MVC PROF(3),=C'STD' no, use default profile 066000 *********************************************************************** 066100 * * 066200 * Direct Edit, Browse and View * 066300 * * 066400 * PARM='E,IBMUSER.JCL(XYZ),STD' * 066500 * * 066600 *********************************************************************** 066700 EDBR800 EQU * 066800 CLC ZAPPLID,NEWAPPL Current APPL OK? 066900 BNE APPL_ISR no, switch applid 067000 CLI FUNCTION,C'W' FUNCTION=W? 067100 BE EDBR950 yes, invoke Workplace 067200 * 067300 * delete () at end of dsname if no member has been specified 067400 * 067500 L R6,OPTLEN L'&OPT 067600 LA R1,OPT-2(R6) last 2 chars of dsname 067700 CLI 0(R1),C'(' IBMUSER.JCL() ? 067800 BNE *+8 NO, JUMP 067900 BCTR R6,0 yes, delete () 068000 BCTR R6,0 yes, delete () 068100 * 068200 * Set up the BROWSE, EDIT or VIEW command 068300 * 068400 STRING 'BROWSE DATASET(''',(OPT,(R6)),''')',INTO=COMMAND 068500 CLI FUNCTION,C'B' BROWSE? 068600 BE EDBR860 yes, execute command 068700 MVC COMMAND(6),=C'EDIT ' BROWSE->EDIT 068800 CLI FUNCTION,C'E' EDIT? 068900 BE EDBR855 yes, jump 069000 CLI ISPFVM,X'41' ISPF 4.1 or up? 069100 BL EDBR855 no, jump 069200 MVC COMMAND(4),=C'VIEW' EDIT->VIEW 069300 EDBR855 EQU * 069400 CLI PROF,C' ' profile specified? 069500 BE EDBR856 no, jump 069600 STRING (COMMAND,,T),' PROFILE(',(PROF,,T),')',INTO=COMMAND 069700 EDBR856 EQU * 069800 CLI BRVOL,C' ' volser available? 069900 BNH EDBR857 no, jump 070000 STRING (COMMAND,,T),' VOL(',(BRVOL,,T),')',INTO=COMMAND 070100 EDBR857 EQU * 070200 * 070300 * Invoke the BROWSE, EDIT or VIEW service. 070400 * 070500 EDBR860 LA R15,L'COMMAND length of command 070600 BAL R14,ISPEXEC <- execute command 070700 LTR R7,R15 DIALOG'S RETURN CODE 070800 BNZ EDBR870 NO, JUMP 070900 * 071000 * If EDIT returns RC=0, display "data set saved" message 071100 * 071200 CLI FUNCTION,C'E' EDIT? 071300 BNE EDBR890 NO, EXIT 071400 STRING 'Data Set Saved',INTO=SHORTMSG 071500 STRING (OPT,(R6)),' has been saved',INTO=LONGMSG 071600 BAL R14,SETMSG send message 071700 B EDBR890 EXIT 071800 * 071900 * If BROWSE failed, invoke PGM(BR) in case it's a VSAM data set. 072000 * 072100 EDBR870 CLI FUNCTION,C'B' BROWSE? 072200 BNE EDBR890 NO, EXIT 072300 MVC NEWPGM,=CL8'BR' VSAM BROWSE PGM 072400 LA R1,NEWPGM VSAM BROWSE PGM 072500 BAL R14,JPASEARCH Check for PGM(BR) 072600 LTR R15,R15 PGM(BR) available? 072700 BZ XCTL00 yes, invoke PGM(BR) PARM(&dsn) 072800 * 072900 EDBR890 LR R15,R7 DIALOG'S RETURN CODE 073000 B XCTL90 exit 073100 *********************************************************************** 073200 * * 073300 * Not a cursor-driven invocation * 073400 * XCTL to ISREDIT/ISRBRO/ISRUDA directly * 073500 * * 073600 *********************************************************************** 073700 EDBR920 CLI FUNCTION,C'W' FUNCTION=W? 073800 BE EDBR960 invoke ISPF service 073900 MVC NEWPGM,$ISREDIT EDIT PGM 074000 MVC OPT(10),=C'P,ISREDM01' EDIT PARM 074100 CLI FUNCTION,C'E' FUNCTION=E? 074200 BE XCTL00 invoke ISPF service 074300 CLC ZAPPLID,NEWAPPL Current APPL OK? 074400 BNE APPL_ISR no, jump 074500 MVC NEWPGM,$ISRBRO BROWSE PGM 074600 MVC OPT(10),=C'ISRBRO01 ' BROWSE PARM 074700 BAL R14,ZVIEW00 set ZVIEW to YES/NO for VI/BR 074800 ISPLINK ($VREPLACE,=C'ZVIEW ',=F'3',ZVIEW) 074900 ISPLINK ($VPUT,=C'ZVIEW ',$PROFILE) 075000 B XCTL00 invoke ISPF service 075100 *********************************************************************** 075200 * * 075300 * Invoke the Work-place * 075400 * * 075500 *********************************************************************** 075600 EDBR950 STRING '''',(OPT,,T),'''',INTO=ZWRKDSN 075700 ST R15,DWD length of dsname 075800 ISPLINK ($VREPLACE,=C'ZWRKDSN ',DWD,ZWRKDSN) 075900 ISPLINK ($VREPLACE,=C'ZWRKVOL ',=F'1',BLANKS) Zwrkvol='' 076000 ISPLINK ($VREPLACE,=C'ZREFTYPE ',=F'1',=C'D') Zreftype='D' 076100 ISPLINK ($VPUT,=C'(ZWRKDSN ZWRKVOL ZREFTYPE)',$PROFILE) 076200 EDBR960 MVC NEWPGM,$ISRUDA Work-place 076300 STRING 'ISRWORK',INTO=OPT WP PARM 076400 B XCTL00 invoke ISPF service 076500 *********************************************************************** 076600 * * 076700 * Update the EDBRnnnn profile variable * 076800 * * 076900 * 1. retrieve the values the user has entered on the * 077000 * EDIT/BROWSE panel * 077100 * * 077200 * 2. compare with the previous values in STRING1; * 077300 * if different, issue VREPLACE/VPUT * 077400 * * 077500 *********************************************************************** 077600 VPUT00 BAKR R14,0 save return address 077700 LA R1,=A($VGET,VARLIST+VL) 077800 LINK SF=(E,ISPLINK$) VGET (&VARLIST) 077900 STRING (OPT,,T),',',(PRJ1,,T),',',(LIB1,,T),',',(LIB2,,T),',',X 078000 (LIB3,,T),',',(LIB4,,T),',',(TYP1,,T),',',(PROF,,T),',',X 078100 (MIX,,T),',',(FNAM,,T),',',(ZEDLOCK,,T),',', X 078200 (ZEDLOCKP,,T),',',(ZPCFMCN,,T),',',(ZVIEW,,T),',', X 078300 (ZVIMAC,,T),',',(ZVPROF,,T),',', X 078400 (ZREFTYPE,,T),',',(ZWRKVOL,,T),',',(ZWRKDSN,,T),',', X 078500 (ZEDITWS,,T),',',(ZVIEWWS,,T),',', view/edit 4.2 X 078600 INTO=LONGMSG 078700 ST R15,DWD length 078800 CLC STRING1,LONGMSG any variable changed? 078900 BE VPUT99 no, exit 079000 ISPLINK ($VREPLACE,EDBRNNNN,DWD,LONGMSG) 079100 ISPLINK ($VPUT,EDBRNNNN,$PROFILE) 079200 VPUT99 PR return 079300 *********************************************************************** 079400 * * 079500 * Set ZVIEW to YES/NO for VIEW/BROWSE * 079600 * * 079700 *********************************************************************** 079800 ZVIEW00 CLI FUNCTION,C'B' FUNCTION=BROWSE? 079900 BNE *+10 no, jump 080000 MVC ZVIEW(3),=C'NO ' yes, set ZVIEW=NO 080100 CLI FUNCTION,C'V' FUNCTION=VIEW? 080200 BNER R14 no, goback 080300 MVC ZVIEW(3),=C'YES' yes, set ZVIEW=YES 080400 BR R14 goback 080500 *********************************************************************** 080600 * * 080700 * Process Function=ICS (ISPF Command Shell) * 080800 * * 080900 *********************************************************************** 081000 ICS MVC NEWPGM,=CL8'ISRRCL' NEW PROGRAM 081100 MVC OPT(2),=C'C1' PARM 081200 CLI ISPFVM,X'41' ISPF 4.1 or up? 081300 BNL XCTL00 yes, jump 081400 MVC NEWPGM,=CL8'ISRPTC' NEW PROGRAM 081500 MVC OPT,BLANKS NO PARM 081600 B XCTL00 INVOKE ISPF SERVICE 081700 *********************************************************************** 081800 * * 081900 * Process Function=TSOFS (TSO Full-screen) * 082000 * * 082100 * CALL OUTTRAP "L." * 082200 * "command" * 082300 * cc=rc * 082400 * CALL STEMDISP "BROWSE","L.",,,command * 082500 * EXIT cc * 082600 * * 082700 *********************************************************************** 082800 TSOFS CLI OPT,C' ' User specified a command? 082900 BE TSOFS80 no, issue error message 083000 CLC ZAPPLID,NEWAPPL Current APPL OK? 083100 BNE APPL_ISR no, switch applid 083200 STRING 'CALL OUTTRAP "L.";"',(OPT,,T), X 083300 '";CC=RC;CALL STEMDISP "BROWSE","L.",,,"',(OPT,,T), X 083400 '";EXIT CC', X 083500 INTO=STRING1 083600 LA R14,STRING1 addr of REXX stmt 083700 STM R14,R15,DWD store addr/len 083800 LA R1,DWD FIRST STMT ADDR/LEN 083900 LA R0,8 LENGTH OF ADDR/LEN ARRAY 084000 SLR R2,R2 No arguments 084100 L R15,=A(RUNEXEC) execute a REXX EXEC 084200 BALR R14,R15 execute a REXX EXEC 084300 B XCTL90 exit 084400 TSOFS80 EQU * 084500 ISPLINK ($SETMSG,=C'ISPG054 ') 084600 B QUIT90 084700 *********************************************************************** 084800 * * 084900 * Process Function=PARMLIB * 085000 * * 085100 * In OS/390 R2 and above, issue IEFPRMLB REQUEST=ALLOCATE * 085200 * to access the PARMLIB concatenation. Otherwise, use: * 085300 * * 085400 * ALLOC DD($PARMLIB) DS('SYS1.PARMLIB') SHR * 085500 * * 085600 *********************************************************************** 085700 PARMLIB CLC ZAPPLID,NEWAPPL Current APPL OK? 085800 BNE APPL_ISR no, switch applid 085900 MVC MACLIBDD,=CL8'$PARMLIB' MOVE DDNAME 086000 MVC VIEWEDIT,=C'VIEW' USE VIEW FOR PARMLIB 086100 LA R6,RACF_DYN POINT TO MY SAF PARM LIST 086200 USING SAFP,R6 086300 MVC SAFP(RACF_LEN),RACF_MOD 086400 STRING 'SYS1.PARMLIB',INTO=ZWRKDSN 086500 RACROUTE REQUEST=AUTH, X 086600 ENTITY=ZWRKDSN, DATA SET NAME X 086700 WORKA=RACFWORK, X 086800 MF=(E,SAFP) 086900 LTR R0,R15 ANY RACF DECISION ? 087000 BNZ PARMLIB2 NO, ASSUME READ ACCESS 087100 CLC SAFPRRET,=F'20' ACCESS RETURNED? 087200 BNE PARMLIB2 NO, FAIL 087300 CLC SAFPRREA,=F'08' ACCESS(UPDATE) ? 087400 BL PARMLIB2 NO, FAIL 087500 DROP R6 SAFP 087600 MVC VIEWEDIT,=C'EDIT' USE EDIT FOR PARMLIB 087700 PARMLIB2 EQU * 087800 DEVTYPE MACLIBDD,DWD Prevent IEF761I 087900 LTR R15,R15 ALREADY ALLOCATED? 088000 BZ MACLIB20 YES, JUMP 088100 AIF (NOT D'CVTPARMC).PARMLIB5 088300 L R1,CVTPTR CVT ADDR 088400 TM CVTOSLV1-CVTMAP(R1),CVTPARMC OS/390 R2? 088500 BNO PARMLIB5 no, jump 088600 IEFPRMLB REQUEST=ALLOCATE, X 088700 ALLOCDDNAME=MACLIBDD, X 088800 CALLERNAME=OWNNAME, X 088900 MF=(E,STRING1,COMPLETE) 089000 CH R15,=H'4' ALLOCATED? 089100 BNH MACLIB20 YES, JUMP 089200 PARMLIB5 EQU * 089300 .PARMLIB5 ANOP 089400 STRING 'CMD(ALLOCATE DD(',MACLIBDD, X 089500 ') SHR DS(''SYS1.PARMLIB''',INTO=COMMAND 089600 B MACLIB19 allocate 089700 * 089800 RACF_MOD RACROUTE REQUEST=AUTH, CHECK AUTHORIZATION X 089900 CLASS='DATASET', CHECK FOR DATASET AUTHORITY X 090000 DSTYPE=M, MODEL X 090100 STATUS=ACCESS, RETURN USER'S CURRENT ACCESS X 090200 RELEASE=1.9, RACF LEVEL X 090300 MF=L 090400 *********************************************************************** 090500 * * 090600 * Process Function=REXXTRY * 090700 * * 090800 *********************************************************************** 090900 REXXTRY EQU * 091000 LA R14,OPT addr of REXX stmt 091100 ICM R15,B'1111',OPTLEN length of REXX stmt 091200 BZ REXXT80 no stmt, error 091300 STM R14,R15,DWD store addr/len 091400 LA R1,DWD FIRST STMT ADDR/LEN 091500 LA R0,8 LENGTH OF ADDR/LEN ARRAY 091600 SLR R2,R2 No arguments 091700 L R15,=A(RUNEXEC) execute a REXX EXEC 091800 BALR R14,R15 execute a REXX EXEC 091900 LTR R7,R15 return code from IRXEXEC 092000 BNZ QUIT90 error, exit 092100 LTR R1,R1 any value returned? 092200 BNP QUIT90 error, exit 092300 STRING 'RC=',((R1),,L),INTO=SHORTMSG 092400 STRING 'The EXEC ended with return-code ',((R1),,L), X 092500 INTO=LONGMSG 092600 BAL R14,SETMSG send message 092700 B QUIT90 exit 092800 REXXT80 EQU * 092900 ISPLINK ($SETMSG,=C'ISPG054 ') 093000 B QUIT90 093100 *********************************************************************** 093200 * * 093300 * Process Function=MACLIB * 093400 * * 093500 * ALLOC DD($$MACLIB) DS('SYS1.MACLIB' 'SYS1.MODGEN') SHR * 093600 * LMINIT DATAID(ID1) DDN($$MACLIB) ENQ(SHRW) * 093700 * VIEW DATAID(&ID1) MEMBER(&OPT) PROFILE(STD) * 093800 * LMFREE DATAID(ID1) * 093900 * * 094000 * Check for the existence of a PVTMACS library and * 094100 * concatenate it if it is cataloged. * 094200 * The catalog is searched for the following dsnames: * 094300 * &ZUSER..PVTMACS.MACLIB * 094400 * &ZUSER..PVTMACS * 094500 * SYS1.PVTMACS * 094600 * * 094700 *********************************************************************** 094800 MACLIB CLC ZAPPLID,NEWAPPL Current APPL OK? 094900 BNE APPL_ISR no, switch applid 095000 MVC MACLIBDD,=CL8'$$MACLIB' MOVE DDNAME 095100 MVC VIEWEDIT,=C'VIEW' USE VIEW FOR MACLIB 095200 DEVTYPE MACLIBDD,DWD 095300 LTR R15,R15 ALREADY ALLOCATED? 095400 BZ MACLIB20 YES, JUMP 095500 STRING 'CMD(ALLOCATE DD(',MACLIBDD, X 095600 ') SHR DS(''SYS1.MACLIB'' ''SYS1.MODGEN''',INTO=COMMAND 095700 STRING (ZUSER,,T),'.PVTMACS.MACLIB',INTO=ZWRKDSN 095800 BAL R14,LISTDSI check existence of PVTMACS 095900 LTR R15,R15 RC=0 from LOCATE? 096000 BE MACLIB18 yes, jump 096100 STRING (ZUSER,,T),'.PVTMACS',INTO=ZWRKDSN 096200 BAL R14,LISTDSI check existence of PVTMACS 096300 LTR R15,R15 RC=0 from LOCATE? 096400 BE MACLIB18 yes, jump 096500 STRING 'SYS1.PVTMACS',INTO=ZWRKDSN 096600 BAL R14,LISTDSI check existence of PVTMACS 096700 LTR R15,R15 RC=0 from LOCATE? 096800 BNE MACLIB19 no, exit 096900 MACLIB18 EQU * 097000 STRING (COMMAND,,T),' ''',(ZWRKDSN,,T),'''',INTO=COMMAND 097100 MACLIB19 EQU * 097200 STRING (COMMAND,,T),')) MODE(FSCR)',INTO=COMMAND 097300 ST R15,DWD store length 097400 L R1,CVTPTR CVT ADDR 097500 L R1,CVTLINK-CVTMAP(,R1) DCB for SYS1.LINKLIB 097600 LOAD EP=ALLOC,DCB=(R1) pre-load ALLOCATE command 097700 ISPLINK ($SELECT,DWD,COMMAND),ERRET=MACLIB99 097800 MACLIB20 EQU * 097900 STRING 'LMINIT DATAID(ID1) DDNAME(',MACLIBDD,') ENQ(SHRW)', X 098000 INTO=COMMAND 098100 BAL R14,ISPEXEC <- execute command 098200 LTR R15,R15 COMMAND OK ? 098300 BNZ MACLIB99 NO, EXIT 098400 LA R0,L'DATAID max length 098500 ST R0,DWD max length 098600 ISPLINK ($VCOPY,=C'ID1 ',DWD,DATAID,$MOVE),ERRET=MACLIB99 098700 STRING VIEWEDIT,' DATAID(',DATAID,') MEMBER(',OPT, X 098800 ') PROFILE(STD)',INTO=COMMAND 098900 CLI VIEWEDIT,C'V' VIEW? 099000 BNE MACLIB44 no, jump 099100 CLI ISPFVM,X'41' ISPF 4.1 or up? 099200 BNL MACLIB44 yes, jump 099300 STRING 'BROWSE DATAID(',DATAID,') MEMBER(',OPT,')', X 099400 INTO=COMMAND 099500 MACLIB44 EQU * 099600 BAL R14,ISPEXEC <- execute command 099700 LR R7,R15 save return code 099800 STRING 'LMFREE DATAID(',DATAID,')',INTO=COMMAND 099900 BAL R14,ISPEXEC <- execute command 100000 LR R15,R7 restore return code 100100 MACLIB99 EQU * 100200 B XCTL90 exit 100300 *********************************************************************** 100400 * * 100500 * Process Function=NETSTAT (full-screen NETSTAT) * 100600 * * 100700 * "NETSTAT" opt "STACK" * 100800 * PUSH;DO i=1 TO QUEUED();PARSE PULL l.i;END;l.i="" * 100900 * CALL STEMDISP "BROWSE","L.",,i,"NETSTAT" opt * 101000 * * 101100 *********************************************************************** 101200 NETSTAT EQU * 101300 L R1,CVTPTR CVT address 101400 L R2,CVTECVT-CVTMAP(,R1) ECVT address 101500 ICM R0,B'1111',ECVTTCP-ECVT(R2) TCP/IP installed? 101600 BZ NETSTAT9 no, exit 101700 CLC ZAPPLID,NEWAPPL Current APPL OK? 101800 BNE APPL_ISR no, switch applid 101900 STRING '"NETSTAT ',(OPT,,T),' STACK";cc=rc;PUSH;', X 102000 'DO i=1 TO QUEUED();PARSE PULL l.i;END;l.i="";', X 102100 'CALL STEMDISP "BROWSE","l.",,i,"NETSTAT ',(OPT,,T), X 102200 '";EXIT cc', X 102300 INTO=STRING1 102400 LA R14,STRING1 addr of REXX stmt 102500 STM R14,R15,DWD store addr/len 102600 LA R1,DWD FIRST STMT ADDR/LEN 102700 LA R0,8 LENGTH OF ADDR/LEN ARRAY 102800 SLR R2,R2 No arguments 102900 L R15,=A(RUNEXEC) execute a REXX EXEC 103000 BALR R14,R15 execute a REXX EXEC 103100 B XCTL90 exit 103200 NETSTAT9 STRING 'Not Available',INTO=SHORTMSG 103300 STRING 'TCP/IP is not installed on this system.', X 103400 INTO=LONGMSG 103500 MVI ALARM,C'Y' error, beep. 103600 BAL R14,SETMSG send message 103700 B QUIT8 quit with RC=8 103800 *********************************************************************** 103900 * * 104000 * Process Function='D,dsname,member,NOENQ' (Delete Member) * 104100 * * 104200 *********************************************************************** 104300 DELMBR EQU * 104400 STRING 'LMINIT DATAID(ID1) DATASET(''',(OPT,,T), X 104500 '''),ENQ(SHRW)',INTO=COMMAND 104600 BAL R14,ISPEXEC <- execute command 104700 LTR R15,R15 COMMAND OK ? 104800 BNZ DELMBR99 NO, EXIT 104900 LA R0,L'DATAID max length 105000 ST R0,DWD max length 105100 ISPLINK ($VCOPY,=C'ID1 ',DWD,DATAID,$MOVE),ERRET=DELMBR99 105200 STRING 'LMOPEN DATAID(',DATAID,') OPTION(OUTPUT)', X 105300 INTO=COMMAND 105400 BAL R14,ISPEXEC <- execute command 105500 LTR R15,R15 COMMAND OK ? 105600 BNZ DELMBR98 NO, EXIT 105700 STRING 'LMMDEL DATAID(',DATAID,') MEMBER(',(PROF,,T),')', X 105800 INTO=COMMAND 105900 CLI PARM4,C' ' NOENQ? 106000 BE DELMBR85 NO, JUMP 106100 CLI ISPFVM,X'41' ISPF V4 or up? 106200 BL DELMBR85 NO, JUMP 106300 STRING (COMMAND,,T),1X,PARM4,INTO=COMMAND 106400 DELMBR85 EQU * 106500 BAL R14,ISPEXEC <- execute command 106600 LTR R15,R15 COMMAND OK ? 106700 BNZ DELMBR98 NO, EXIT 106800 STRING 'Member Deleted',INTO=SHORTMSG 106900 STRING 'Member ''',(OPT,,T),'(',(PROF,,T), X 107000 ')'' has been deleted',INTO=LONGMSG 107100 BAL R14,SETMSG send message 107200 DELMBR98 EQU * 107300 LR R7,R15 save return code 107400 STRING 'LMFREE DATAID(',DATAID,')',INTO=COMMAND 107500 BAL R14,ISPEXEC <- execute command 107600 LR R15,R7 restore return code 107700 DELMBR99 EQU * 107800 B XCTL90 exit 107900 *********************************************************************** 108000 * * 108100 * Process Function=CNTL (Edit SPFTEMPn) * 108200 * * 108300 *********************************************************************** 108400 CNTL CLI PROF,C' ' profile specified? 108500 BNE CNTL2 yes, jump 108600 MVC PROF(4),=C'CNTL' default profile 108700 CNTL2 LA R0,L'ZTEMPN LENGTH 108800 ST R0,DWD LENGTH 108900 ISPLINK ($VCOPY,=C'ZTEMPN ',DWD,ZTEMPN,$MOVE) 109000 CLC =C'0 ',OPT edit SPFTEMP0 ? 109100 BNE CNTL10 no, jump 109200 MVC ZTEMPN,=C'ISPCTL0 ' ddname for SPFTEMP0.CNTL 109300 DEVTYPE ZTEMPN,DWD check if DD is allocated 109400 LTR R15,R15 ISPCTL0 allocated? 109500 BZ CNTL10 yes, jump 109600 STRING (ZUSER,,T),'.SPFTEMP0.CNTL',INTO=ZWRKDSN 109700 STRING 'EDIT DATASET(''',(ZWRKDSN,,T),'''', X 109800 ') PROFILE(',(PROF,,T),')', X 109900 INTO=COMMAND 110000 BAL R14,ISPEXEC <- execute EDIT command 110100 LR R7,R15 save return code 110200 B CNTL90 exit 110300 CNTL10 EQU * 110400 STRING 'LMINIT DATAID(ID1) DDNAME(',ZTEMPN,') ENQ(SHRW)', X 110500 INTO=COMMAND 110600 BAL R14,ISPEXEC <- execute LMINIT command 110700 LTR R15,R15 COMMAND OK ? 110800 BNZ CNTL99 NO, EXIT 110900 LA R0,L'DATAID max length 111000 ST R0,DWD max length 111100 ISPLINK ($VCOPY,=C'ID1 ',DWD,DATAID,$MOVE),ERRET=CNTL99 111200 STRING 'EDIT DATAID(',DATAID, X 111300 ') PROFILE(',(PROF,,T),')', X 111400 INTO=COMMAND 111500 BAL R14,ISPEXEC <- execute EDIT command 111600 LR R7,R15 save return code 111700 STRING 'LMFREE DATAID(',DATAID,')',INTO=COMMAND 111800 BAL R14,ISPEXEC <- execute LMFREE command 111900 CNTL90 EQU * 112000 LTR R15,R7 data saved? 112100 BNZ CNTL99 no, jump 112200 STRING 'Data Set Saved',INTO=SHORTMSG 112300 STRING 'Control Data Set Saved: ',ZTEMPN,INTO=LONGMSG 112400 BAL R14,SETMSG send message 112500 CNTL99 EQU * 112600 B XCTL90 exit 112700 *********************************************************************** 112800 * * 112900 * Process Function=TIME * 113000 * * 113100 * The TIME function displays the time and date in a short * 113200 * message, and the Julian date in the long message. * 113300 * * 113400 *********************************************************************** 113500 TIME TIME DEC 113600 STM R0,R1,TENWORDS HHMMSSHH 0CYYDDDF 113700 STRING (TENWORDS+4,P,YYYY-MM-DD),1X, X 113800 (TENWORDS+0,1,X),'.', HH. X 113900 (TENWORDS+1,1,X),'.', HH.MM. X 114000 (TENWORDS+2,1,X), HH.MM.SS X 114100 INTO=SHORTMSG 114200 L R15,=V(JUL2DAYS) julian-days calc rtne 114300 BALR R14,R15 calc num of days since 1901.001 114400 LR R6,R1 POINT TO DAY-OF-THE-WEEK 114500 PACK DWD,SHORTMSG+5(2) MM 114600 CVB R1,DWD R1=MM 114700 MH R1,=H'3' mult by 3 114800 LA R7,MONTHTBL-3(R1) point at month name 114900 STRING ((R6),9,T),1X, Wednesday X 115000 (SHORTMSG+08,2),1X, Wednesday 19 X 115100 ((R7),3),1X, Wednesday 19 Nov X 115200 (SHORTMSG+0,4),2X, Wednesday 19 Nov 1995 X 115300 (SHORTMSG+0,4),'.', 1995. X 115400 (TENWORDS+6,P,R3Z),2X, 1995.033 X 115500 (SHORTMSG+11,8), HH.MM.SS X 115600 INTO=LONGMSG 115700 BAL R14,SETMSG send message 115800 B XCTL90 exit 115900 MONTHTBL DC C'JanFebMarAprMayJunJulAugSepOctNovDec' 116000 *********************************************************************** 116100 * * 116200 * Process Function=CONNECT (ISPF 4.2 or up) * 116300 * * 116400 *********************************************************************** 116500 CONNECT CLI ISPFVM,X'42' ISPF 4.2 or up? 116600 BL SYSID99 no, jump 116700 LA R0,L'OPT2 max length 116800 ST R0,DWD max length 116900 CLI ZWSCON,C' ' already connected? 117000 BE CONNECT5 no, jump 117100 ISPLINK ($SETMSG,=C'ISPO908 ') Already Connected 117200 CLI ZSPLIT,C'Y' Split screen ? 117300 BE QUIT8 yes, exit 117400 CONNECT5 STRING 'SETTINGS',ZDEL,'GUIINIT',INTO=LONGMSG 117500 B SYSIDCMD 117600 *********************************************************************** 117700 * * 117800 * Process Function=SYSID (ISPF 4.2 or up) * 117900 * * 118000 * The SYSID function uses SCRNAME to permanently display the * 118100 * SMF system-id in the upper left-hand corner of the screen. * 118200 * * 118300 * I learned the trick from Henrik Salminen who posted his * 118400 * THSCRNAM EXEC on the ISPF Cforum on TALKLINK. * 118500 * * 118600 *********************************************************************** 118700 SYSID CLI ISPFVM,X'42' ISPF 4.2 or up? 118800 BL SYSID99 no, jump 118900 CLC =C'OFF ',OPT8 SYSID OFF ? 119000 BE SYSIDOFF yes, jump 119100 L R1,CVTPTR CVT ADDRESS 119200 L R4,CVTSMCA-CVTMAP(,R1) SMCA ADDRESS 119300 USING SMCABASE,R4 119400 STRING 'PANELID OFF',ZDEL,'SCRNAME ON',ZDEL,'SCRNAME ', X 119500 (SMCASID,,T),'#',ZSCREEN,' PERM',INTO=LONGMSG 119600 B SYSIDCMD 119700 SYSIDOFF EQU * 119800 STRING 'SCRNAME OFF',INTO=LONGMSG 119900 SYSIDCMD EQU * 120000 ST R15,DWD store length 120100 ISPLINK ($VREPLACE,=C'CMD ',DWD,LONGMSG) 120200 STRING 'DISPLAY PANEL(ISPSTRTP) COMMAND(CMD)',INTO=COMMAND 120300 B XCTL61 INVOKE ISPF SERVICE 120400 * 120500 SYSID99 STRING 'Not Supported',INTO=SHORTMSG 120600 STRING 'Command ',(FUNCTION,,T), X 120700 ' is not supported in this environment.', X 120800 INTO=LONGMSG 120900 MVI ALARM,C'Y' error, beep. 121000 BAL R14,SETMSG send message 121100 B QUIT8 quit with RC=8 121200 DROP R4 was SMCA 121300 *********************************************************************** 121400 * * 121500 * Process Function=ZDEL * 121600 * * 121700 * This function uses an undocumented interface to retrieve * 121800 * and set the command delimiter character. * 121900 * * 122000 * Tested in 3.5, 4.2 and 4.4. * 122100 * * 122200 *********************************************************************** 122300 ZDELFUNC CLC OPTLEN,=F'1' one char specified? 122400 BNE ZDELSHOW no, display 122500 * 122600 * validate new character: anything but A-Z 0-9 = . 122700 * 122800 CLI OPT8,C'.' valid char? 122900 BE ZDELBADC no, bad parm 123000 CLI OPT8,C'=' valid char? 123100 BE ZDELBADC no, bad parm 123200 CLI OPT8,C'A' valid char? 41-C0 123300 BL ZDELUPD yes, update 123400 CLI OPT8,C'I' valid char? A-I 123500 BNH ZDELBADC no, bad parm 123600 CLI OPT8,C'J' valid char? CA-D0 123700 BL ZDELUPD yes, update 123800 CLI OPT8,C'R' valid char? J-R 123900 BNH ZDELBADC no, bad parm 124000 CLI OPT8,C'S' valid char? DA-E1 124100 BL ZDELUPD yes, update 124200 CLI OPT8,C'Z' valid char? S-Z 124300 BNH ZDELBADC no, bad parm 124400 CLI OPT8,C'0' valid char? EA-EF 124500 BL ZDELUPD yes, update 124600 CLI OPT8,C'9' valid char? 0-9 124700 BH ZDELUPD yes, update 124800 ZDELBADC ISPLINK ($SETMSG,=C'ISPO903 ') Invalid Character 124900 B QUIT8 exit 125000 * 125100 * update ZDEL in the TSV and update ISPSPROF 125200 * 125300 ZDELUPD L R4,TLD@ load TLD address 125400 USING TLD,R4 125500 L R5,TLDTSVP System Variables Table 125600 USING TSV,R5 125700 MVC TSVZDEL,OPT8 update ZDEL field in TSV 125800 LA R1,TLD@ TLD pointer 125900 L R15,TLDTSCP ISPTSC0 126000 L R15,272(,R15) ISPCUP (Update Profile) 126100 BALR R14,R15 refresh ZDEL 126200 STRING 'Delimiter set to ',TSVZDEL,INTO=SHORTMSG 126300 STRING 'Command Delimiter changed from ',ZDEL, X 126400 ' to ',TSVZDEL,INTO=LONGMSG 126500 BAL R14,SETMSG send message 126600 B QUIT0 quit with RC=0 126700 DROP R4,R5 TLD,TSV 126800 * 126900 * Display current ZDEL value 127000 * 127100 ZDELSHOW CLI OPT8,C' ' ZDEL display? 127200 BNE ZDELLENG no, bad parm 127300 STRING 'Delimiter is ',ZDEL,INTO=SHORTMSG 127400 STRING 'Command Delimiter is currently set to ',ZDEL, X 127500 INTO=LONGMSG 127600 BAL R14,SETMSG send message 127700 B QUIT0 exit with RC=0 127800 * 127900 * Specified parameter has invalid format 128000 * 128100 ZDELLENG STRING 'Invalid Parameter',INTO=SHORTMSG 128200 STRING 'Parameter must be specified as a single character.', X 128300 INTO=LONGMSG 128400 MVI ALARM,C'Y' error, beep. 128500 BAL R14,SETMSG send message (beep) 128600 B QUIT8 quit with RC=8 128700 *********************************************************************** 128800 * * 128900 * Process Function=VERASE * 129000 * * 129100 * This function issues VERASE to delete a variable from * 129200 * the shared and/or profile pool. * 129300 * * 129400 *********************************************************************** 129500 VERASE EQU * 129600 STRING 'VERASE ',(OPT,,T),INTO=COMMAND 129700 BAL R14,ISPEXEC <- execute command 129800 LTR R7,R15 129900 BNZ VERASE6 RC>0 (ERROR) 130000 STRING 'Variable(s) deleted',INTO=SHORTMSG 130100 STRING 'The specified variables have been successfully deleted.',X 130200 INTO=LONGMSG 130300 BAL R14,SETMSG send message (beep) 130400 B QUIT90 quit with RC=0 130500 VERASE6 CH R7,=H'8' severe error? 130600 BH XCTL91 RC>8 (ERROR) 130700 STRING 'Variable(s) not found',INTO=SHORTMSG 130800 STRING 'At least one specified variable does not exist', X 130900 INTO=LONGMSG 131000 MVI ALARM,C'Y' error, beep. 131100 BAL R14,SETMSG send message (beep) 131200 B QUIT90 quit with RC=8 131300 *********************************************************************** 131400 * * 131500 * Process Function=SDSF * 131600 * * 131700 *********************************************************************** 131800 SDSF MVC NEWAPPL,=C'ISF ' NEW APPL 131900 MVC NEWPGM,=CL8'ISFISP' NEW PROGRAM 132000 B XCTL00 INVOKE ISPF SERVICE 132100 *********************************************************************** 132200 * * 132300 * Process Function=UTIL (PDF Utilities) * 132400 * * 132500 *********************************************************************** 132600 UTIL MVC NEWPANEL,=CL8'ISRUTIL' NEW PANEL 132700 B XCTL00 INVOKE ISPF SERVICE 132800 *********************************************************************** 132900 * * 133000 * PARM='FTINCL,&skel,&panel,&applid' * 133100 * * 133200 *********************************************************************** 133300 FTINCL CLI PARM4,C' ' APPLID SPECIFIED? 133400 BE FTINCL2 NO, DO NOT SWITCH APPLID 133500 MVC NEWAPPL,PARM4 MOVE APPLID 133600 CLC ZAPPLID,NEWAPPL Current APPL OK? 133700 BNE APPL_ISR no, switch applid 133800 FTINCL2 EQU * 133900 CLI PROF,C' ' ENTER PANEL? 134000 BE FTINCL3 NO, JUMP 134100 * ISPEXEC DISPLAY PANEL(&panel) 134200 STRING 'DISPLAY PANEL(',(PROF,,T),')',INTO=COMMAND 134300 BAL R14,ISPEXEC <- execute command 134400 LTR R7,R15 134500 BNZ XCTL91 RC>0 (ERROR) 134600 * ISPEXEC FTOPEN TEMP 134700 FTINCL3 STRING 'FTOPEN TEMP',INTO=COMMAND 134800 BAL R14,ISPEXEC <- execute command 134900 CH R15,=H'8' 135000 BH XCTL90 RC>8 (ERROR) 135100 * ISPEXEC FTINCL &skel 135200 STRING 'FTINCL ',OPT,INTO=COMMAND 135300 BAL R14,ISPEXEC <- execute command 135400 LR R7,R15 SAVE RETURN CODE 135500 * ISPEXEC FTCLOSE 135600 STRING 'FTCLOSE ',INTO=COMMAND 135700 BAL R14,ISPEXEC <- execute command 135800 LTR R7,R7 ERROR IN FTINCL? 135900 BNZ XCTL91 RC>0 (ERROR) 136000 * ISPEXEC SELECT PGM(FASTPATH) PARM(CNTL) 136100 STRING 'SELECT PGM(',OWNNAME,') PARM(CNTL)',INTO=COMMAND 136200 B XCTL61 <- execute command 136300 *********************************************************************** 136400 * * 136500 * PARM='CRASH<,command>' (Quick exit from ISPF) * 136600 * * 136700 *********************************************************************** 136800 CRASH EQU * 136900 *---------------------------------------------------------------------* 137000 * * 137100 * Special processing for LOGON & LOGOFF commands * 137200 * * 137300 * This code prevents the TMP from issuing the * 137400 * IKJ56400A ENTER LOGON OR LOGOFF prompt when the user enters * 137500 * a CRASH LOGON or CRASH LOGOFF command while CLISTs or EXECs * 137600 * are executing in some of the logical screens. * 137700 * * 137800 *---------------------------------------------------------------------* 137900 CLC =C'LOGOFF ',OPT8 LOGON/LOGOFF ? 138000 BE CRASH32 YES, JUMP 138100 CLC =C'LOGON ',OPT8 LOGON/LOGOFF ? 138200 BNE CRASH51 no, exit 138300 MVC OPT8+6(2),BLANKS "LOGON XX" => "LOGON " 138400 * 138500 CRASH32 L R2,CVTPTR CVT ADDR 138600 L R2,CVTLINK-CVTMAP(,R2) DCB for SYS1.LINKLIB 138700 LOAD EPLOC=OPT8,DCB=(R2) PRE-LOAD LOGON/LOGOFF 138800 STRING 'CMD(TSOEXEC ',(OPT,,T),') MODE(FSCR)',INTO=COMMAND 138900 ST R15,DWD STORE LENGTH OF COMMAND 139000 LOAD EPLOC=COMMAND+4,DCB=(R2) PRE-LOAD TSOEXEC 139100 ISPLINK ($SELECT,DWD,COMMAND) 139200 LTR R7,R15 DIALOG'S RETURN CODE 139300 BZ CRASH71 GOOD, CONTINUE 139400 B XCTL91 BAD, EXIT 139500 *---------------------------------------------------------------------* 139600 * * 139700 * STACK a TSO command * 139800 * * 139900 *---------------------------------------------------------------------* 140000 CRASH51 EQU * 140100 L R4,TSI@ R4->TSI 140200 USING TSI,R4 140300 CLC =C'READY ',OPT8 go back to READY prompt? 140400 BE CRASH71 yes, skip STACK macro 140500 ICM R8,B'1111',OPTLEN anything to add to the stack? 140600 BZ CRASH61 no, jump 140700 * 140800 * If the user entered CRASH *, retrieve the command that 140900 * was used to enter ISPF from the ZTSICMD variable. 141000 * 141100 CL R8,=F'1' length=1 ? 141200 BNE CRASH54 no, jump 141300 CLI OPT,C'*' User entered "CRASH *" ? 141400 BNE CRASH54 no, jump 141500 STRING (ZTSICMD,,T),INTO=OPT move command 141600 LR R8,R15 pass length 141700 ST R8,OPTLEN save length 141800 CRASH54 EQU * 141900 * 142000 * Build List Source Descriptor (LSD) for STACK 142100 * 142200 LA R0,LSD_LENGTH(R8) length of the LSD + text 142300 GETMAIN RU,LV=(0),SP=78,LOC=BELOW 142400 LR R9,R1 ADDRESS OF THE LSD 142500 USING LSD,R9 142600 XC LSD(LSD_LENGTH),LSD Clear LSD 142700 LA R1,LSD+LSD_LENGTH POINT TO IN-STORAGE LIST 142800 ST R1,LSDADATA save addr into LSD 142900 ST R1,LSDANEXT save addr into LSD 143000 STH R8,LSDTOTLN store total length 143100 STH R8,LSDRCLEN length of F-len rec 143200 STRING OPT,INTO=(LSD+LSD_LENGTH,(R8)) 143300 DROP R9 LSD 143400 * 143500 L R5,TSIECTP ECT ADDRESS 143600 L R6,TSIUPTP UPT ADDRESS 143700 STACK PARM=STACKL,ECT=(R5),UPT=(R6),ECB=DWD, X 143800 STORAGE=((R9),PROCL),MF=(E,TENWORDS) 144200 B CRASH71 continue 144300 *---------------------------------------------------------------------* 144400 * * 144500 * If CRASH is entered without any operand, reset the ECTIOWA * 144600 * field in the primary ECT to the value it contained when ISPF * 144700 * was entered. This ensures that, if ISPF is invoked from a * 144800 * CLIST, processing will resume at the next CLIST statement. * 144900 * * 145000 *---------------------------------------------------------------------* 145100 CRASH61 EQU * 145200 L R4,TSITPDP A(TPD) 145300 USING TPD,R4 145400 CLC =C'TPD',TPDTBLID am I lost? 145500 BNE CRASH69 yes, exit 145600 L R4,TPDTLDP A(TLD0) 145700 USING TLD,R4 145800 CLC =C'TLD0',TLDTBLID am I lost? 145900 BNE CRASH69 yes, exit 146100 L R5,TLDECTP load ECT Address 146200 USING ECT,R5 146300 MVC ECTIOWA,TLDIOWA restore ECT Address 146400 DROP R4,R5 TLD,ECT 146500 CRASH69 EQU * 146600 *---------------------------------------------------------------------* 146700 * * 146800 * Terminate ISPF by abending the IKJEFT09 sub-task * 146900 * * 147000 *---------------------------------------------------------------------* 147100 CRASH71 EQU * 147200 LA R1,CRASH75 address of the abend routine 147300 STRING ((R1),,X),INTO=URPNAME address in EBCDIC 147400 IDENTIFY EPLOC=URPNAME,ENTRY=(R1) 147500 BAL R14,EXECURP <- Execute CRASH75 as a URP 147600 CRASH75 ABEND X'222',,,SYSTEM This is my URP !!! 147700 *********************************************************************** 147800 * * 147900 * PARM='EXECPGM,pgm<,parm>' (EXEC PGM from Link-list) * 148000 * * 148100 *********************************************************************** 148200 EXECPGM STRING (PARM3,,T),INTO=(STRING1+2,L'STRING1-2) 148300 STH R15,STRING1 length of parm 148400 LA R0,STRING1 addr of parm 148500 ST R0,SIXWORDS build parm 148600 OI SIXWORDS,X'80' build parm 148700 LA R1,SIXWORDS A(PARM) 148800 L R2,CVTPTR CVT address 148900 L R2,CVTLINK-CVTMAP(,R2) DCB for SYS1.LINKLIB 149000 ATTACH EPLOC=OPT,ECB=DWD,TASKLIB=(R2),SF=(E,ATTACHL) 149100 ST R1,DWD+4 save TCB address 149200 WAIT 1,ECB=DWD wait for completion 149300 DETACH DWD+4 detach sub-task 149400 LH R15,DWD+2 return code 149500 B XCTL90 149600 *********************************************************************** 149700 * * 149800 * Re-invoke myself with NEWAPPL(ISR) to allow access to * 149900 * EDBRnnnn variables in ISRPROF. * 150000 * * 150100 *********************************************************************** 150200 APPL_ISR L R3,0(,R9) point at parm 150300 LH R5,0(,R3) parm length 150400 STRING 'PGM(',(OWNNAME,,T),') PARM(',(2(R3),(R5),T),')', X 150500 INTO=COMMAND 150600 B XCTL22 150700 *********************************************************************** 150800 * * 150900 * Invoke a program or panel via the SELECT service. * 151000 * * 151100 *********************************************************************** 151200 XCTL00 STRING 'PANEL(',(NEWPANEL,,T), X 151300 ') OPT(',(OPT,,T),')', X 151400 INTO=COMMAND 151500 CLI NEWPANEL,0 SELECT PANEL ? 151600 BNE XCTL20 YES, JUMP 151700 STRING 'CMD(',(NEWCMD,,T),')', X 151800 INTO=COMMAND 151900 CLI NEWCMD,0 SELECT CMD ? 152000 BNE XCTL20 YES, JUMP 152100 STRING 'PGM(',(NEWPGM,,T), X 152200 ') PARM(',(OPT,,T),')', X 152300 INTO=COMMAND 152400 XCTL20 CLC ZAPPLID,NEWAPPL CURRENT APPLID OK? 152500 BE XCTL30 YES, JUMP 152600 * 152700 XCTL22 STRING 'Applid Switched',INTO=SHORTMSG 152800 STRING 'Applid switched from ',(ZAPPLID,,T),' to ',NEWAPPL, X 152900 INTO=LONGMSG 153000 BAL R14,SETMSG send message 153100 STRING (COMMAND,,T),' NEWAPPL(',NEWAPPL,')',INTO=COMMAND 153200 * 153300 XCTL30 ST R15,DWD STORE LENGTH OF COMMAND 153800 ISPLINK ($SELECT,DWD,COMMAND) 153900 B XCTL90 154000 * 154100 XCTL60 LA R15,L'COMMAND length of command 154200 XCTL61 BAL R14,ISPEXEC <- execute command 154300 * 154400 XCTL90 LTR R7,R15 DIALOG'S RETURN CODE 154500 BZ QUIT90 OK, EXIT 154600 XCTL91 LA R0,L'ZERRMSG max length 154700 ST R0,DWD max length 154800 ISPLINK ($VCOPY,$ZERRMSG,DWD,ZERRMSG,$MOVE),ERRET=QUIT90 154900 ISPLINK ($SETMSG,ZERRMSG) 155000 B QUIT90 155100 *********************************************************************** 155200 * * 155300 * Goback to ISPF * 155400 * * 155500 *********************************************************************** 155600 QUIT0 SLR R7,R7 RC=0 (OK) 155700 B QUIT90 155800 * 155900 QUIT4 LA R7,4 RC=4 (not 1st time and PARM='') 156000 B QUIT90 156100 * 156200 QUIT8 LA R7,8 RC=8 (invalid ISPF environment) 156300 B QUIT90 156400 * 156500 QUIT12 LA R7,12 RC=12 (unknown function) 156600 B QUIT90 156700 * 156800 QUIT16 LA R7,16 RC=16 (not running under ISPF) 156900 * 157000 QUIT90 LR R1,R13 Work area 157100 L R13,4(,R13) 157200 LA R0,DYNAML LENGTH OF DYNAMIC STORAGE AREA 157300 FREEMAIN R,LV=(0),A=(1) FREE DYNAMIC STORAGE 157400 LR R15,R7 Return code 157500 RETURN (14,12),RC=(15) 157600 * 157700 ISPEXEC ST R15,TOKEN store length 157800 LA R15,TOKEN length of command 157900 LA R0,COMMAND text of command 158000 STM R15,R0,DWD parm list for ISPEXEC 158100 OI DWD+4,X'80' parm list for ISPEXEC 158200 LOAD EP=ISPEXEC V(ISPEXEC) 158300 LR R15,R0 V(ISPEXEC) 158400 LA R1,DWD parm list for ISPEXEC 158500 BR R15 invoke ISPEXEC 158600 * 158700 JPASEARCH BAKR R14,0 158800 L R3,CVTPTR point to CVT 158900 USING CVTMAP,R3 159000 L R4,PSATOLD-PSA point to TCB 159100 USING TCB,R4 159200 L R4,TCBJSTCB point to JS TCB 159300 LA R8,TCBJPQ START OF CDE CHAIN 159400 LR R9,R1 Module name 159500 L R15,CVTQCDSR CDE SEARCH ROUTINE 159600 BALR R14,R15 USES R0, R1, R8, R9, R11 159700 B JPASCH9-*(,R14) +0 FOUND, QUIT 159800 JPASCH8 LA R15,4 RC=4 (not found) 159900 PR 160000 JPASCH9 SLR R15,R15 RC=0 (found) 160100 PR 160200 DROP R3,R4 CVT,TCB 160300 TITLE 'CURSOR: Extract Data Set Name from Screen Buffer' 160400 *********************************************************************** 160500 * * 160600 * Scan data at the cursor position for a dsname * 160700 * * 160800 * Some of this code has been lifted from ISPCDSN, * 160900 * in file 270 of the CBT tape. * 161000 * * 161100 *********************************************************************** 161200 CURSOR BEGIN_PROC 161300 L R6,TLD@ R6->TLD 161400 USING TLD,R6 161500 * 161600 * Retrieve screen buffer address and cursor position. 161700 * 161800 ICM R15,B'1111',TLDCLSWD screen width (zero if ISPSTRT) 161900 BZ CURSOR98 zero, exit to prevent S0C9 162000 SLR R0,R0 prepare "DR" 162100 L R1,TLDCSR get cursor offset 162200 DR R0,R15 get line # (R0) and offset (R1) 162300 LR R5,R0 cursor offset in line 162400 M R0,TLDCLSWD get offset to current line 162500 AL R1,TLDTLSP change offset to addr 162600 LR R4,R1 Current line in screen image 162700 *---------------------------------------------------------------------* 162800 * * 162900 * Build scan table for TRT. * 163000 * * 163100 *---------------------------------------------------------------------* 163200 CURSOR21 MVI TRNTBL,255 fill table with X'FF' 163300 MVC TRNTBL+1(255),TRNTBL fill table with X'FF' 163400 BAL R1,CURSOR22 branch around table, set R1 163500 DC C'$',AL1(1) $ 163600 DC C'.',AL1(1) . 163700 DC C'#',AL1(2) #@ 163800 DC C'a',AL1(9) a-i 163900 DC C'j',AL1(9) j-r 164000 DC C's',AL1(8) s-z 164100 DC C'{',AL1(1) C0 164200 DC C'-',AL1(1) 60 164300 DC C'A',AL1(9) A-I 164400 DC C'J',AL1(9) J-R 164500 DC C'S',AL1(8) S-Z 164600 DC C'0',AL1(10) 0-9 164700 DC X'00',0H'0' end of table 164800 *LOOP 164900 CURSOR22 SLR R3,R3 clear work reg 165000 IC R3,0(,R1) FIRST BYTE 165100 LA R2,TRNTBL(R3) point to TRNTBL+X'4A' 165200 IC R3,1(,R1) length 165300 SLR R15,R15 padding=X'00' 165400 MVCL R2,R14 clear (R3) bytes 165500 LA R1,2(,R1) NEXT ENTRY IN TABLE 165600 CLI 0(R1),0 END OF TABLE? 165700 BNE CURSOR22 NEXT STRING 165800 *ENDLOOP 165900 *---------------------------------------------------------------------* 166000 * * 166100 * Extend current line to facilitate dsname extraction * 166200 * * 166300 *---------------------------------------------------------------------* 166400 L R1,TLDCLSWD line length 166500 STRING 56X,((R4),(R1)),INTO=LONGMSG 166600 LA R4,LONGMSG new line 166700 LA R5,56(R5,R4) cursor address 166800 SLR R7,R7 no left paren 166900 DROP R6 was TLD 167000 *---------------------------------------------------------------------* 167100 * * 167200 * If the cursor is placed under DSN= or DSNAME= then * 167300 * move it under the 1st char to the right of the = sign. * 167400 * * 167500 *---------------------------------------------------------------------* 167600 CURSOR30 BAL R2,CURSOR31 branch around table 167700 DC AL1(3),C'DSN=' JCL 167800 DC AL1(6),C'DSNAME=' JCL 167900 DC X'00',0H'0' end of table 168000 *loop 168100 CURSOR31 SLR R3,R3 168200 IC R3,0(,R2) length of literal 168300 LA R0,1(,R3) length of scan area 168400 LR R1,R5 current position 168500 SR R1,R3 start of scan area 168600 *--loop 168700 CURSOR32 EX R3,CURSOR36 execute CLC 168800 BE CURSOR38 found, exit 168900 LA R1,1(,R1) bump index 169000 BCT R0,CURSOR32 scan further 169100 *--endloop 169200 LA R2,1+1(R3,R2) next entry in literal table 169300 CLI 0(R2),0 end of table? 169400 BNE CURSOR31 no, search for next literal 169500 *endloop 169600 B CURSOR39 169700 CURSOR36 CLC 0(*-*,R1),1(R2) scan for "DSN=" 169800 CURSOR38 LA R5,1(R3,R1) start of dsname 169900 CURSOR39 EQU * 170000 *---------------------------------------------------------------------* 170100 * * 170200 * If the cursor is positionned under a parenthesis, ignore it. * 170300 * * 170400 *---------------------------------------------------------------------* 170500 CURSOR42 EQU * 170600 CLI 0(R5),C'(' Is it left paren? 170700 BNE CURSOR43 no, jump 170800 LA R5,1(,R5) yes, skip to next char 170900 B CURSOR42 there may be several of them 171000 CURSOR43 EQU * 171100 CLI 0(R5),C')' Is it right paren? 171200 BNE CURSOR44 no, jump 171300 BCTR R5,0 yes, try char to the left 171400 B CURSOR43 there may be several of them 171500 CURSOR44 EQU * 171600 *---------------------------------------------------------------------* 171700 * * 171800 * Check that the cursor is under a valid dsname character * 171900 * * 172000 *---------------------------------------------------------------------* 172100 TRT 0(1,R5),TRNTBL cursor under a data set name? 172200 BZ CURSOR50 Yes, begin scanning for start 172300 CLI 0(R5),C'''' Is it a quote? 172400 BNE CURSOR98 No, cursor invalid 172500 MVI QFLAG,X'80' Yes, indicate left quote 172600 TRT 1(1,R5),TRNTBL Is dsn to right of quote? 172700 BZ CURSOR59 Yes, prepare to extract it 172800 BCTR R5,0 No, check left of quote 172900 CLI 0(R5),C')' 'my.dsn(mymbr)' ? 173000 BZ CURSOR48 Yes, accept it 173100 TRT 0(1,R5),TRNTBL Was it there? 173200 BNZ CURSOR98 No, cursor invalid 173300 CURSOR48 MVI QFLAG,X'01' Yes, indicate right quote 173400 *---------------------------------------------------------------------* 173500 * * 173600 * Scan backwards to locate beginning of dsname * 173700 * * 173800 *---------------------------------------------------------------------* 173900 CURSOR50 LR R2,R5 current position 174000 SR R2,R4 subtract addr of pos 1 174100 *loop 174200 CURSOR52 BCTR R5,0 R5-> cursor location 174300 TRT 0(1,R5),TRNTBL valid dsn char? 174400 BZ CURSOR54 yes, iterate 174500 CLI 0(R5),C'(' Was delimiter left paren? 174600 BNE CURSOR56 No, include parens in dsn 174700 MVI TRNTBL+C'.',255 set period invalid for scan 174800 TRT 1(9,R5),TRNTBL find delimiter 174900 MVI TRNTBL+C'.',0 reset period in scan table 175000 BZ CURSOR54 no dlm, continue 175100 CLI 0(R1),C'.' period found? 175200 BE CURSOR61 yes, must be dsn 175300 LTR R7,R7 first left paren? 175400 BNZ CURSOR61 no, leave 175500 LR R7,R5 yes, remember it 175600 CURSOR54 BCT R2,CURSOR52 Yes, decr offset; check next 175700 *endloop 175800 CURSOR56 LA R0,1(,R5) 1st byte of dsname 175900 CLR R0,R7 left paren at start of dsn? 176000 BNE CURSOR59 No, jump 176100 SLR R7,R7 yes, forget all about it 176200 LA R5,1(,R5) make "(" the dlm 176300 * 176400 * R5 now points to start of dsname 176500 * 176600 CURSOR59 EQU * 176700 CLI 0(R5),C'''' Was delimiter a quote? 176800 BNE CURSOR61 No, leave bits unchanged 176900 OI QFLAG,X'80' Yes, indicate left quote 177000 *---------------------------------------------------------------------* 177100 * * 177200 * scan dsname to locate its right boundary * 177300 * * 177400 *---------------------------------------------------------------------* 177500 CURSOR61 LA R5,1(,R5) R5-> start of dsname 177600 LTR R7,R7 do we have a member name? 177700 BNZ CURSOR65 no, do not look for right paren 177800 * 177900 * no mbr name found yet, check for a left parenthesis 178000 * 178100 TRT 0(56,R5),TRNTBL Scan until not in table 178200 BZ CURSOR98 end dlm not found, exit 178300 LR R2,R1 R2-> right delimiter 178400 CLI 0(R1),C'(' Was delimiter a left paren? 178500 BNE CURSOR66 no, this is the end of the dsn 178600 LR R7,R1 R7-> start of mbr name 178700 * 178800 * Find end of member name 178900 * 179000 CURSOR65 TRT 1(9,R7),TRNTBL Scan for right paren 179100 BZ CURSOR98 not found, ignore mbr name 179200 CLI 0(R1),C')' Was delimiter a right paren? 179300 BNE CURSOR98 no, ignore mbr name 179400 LA R2,1(,R1) point R2 past right paren 179500 * 179600 CURSOR66 EQU * 179700 CLI 0(R2),C'''' Was delimiter a quote? 179800 BNE CURSOR68 No, leave bits unchanged 179900 OI QFLAG,X'01' Yes, indicate right quote 180000 CURSOR68 TM QFLAG,X'81' Quotes surrounding dsname ? 180100 BM CURSOR98 no matching quotes 180200 *---------------------------------------------------------------------* 180300 * * 180400 * remove LISTCAT header * 180500 * * 180600 *---------------------------------------------------------------------* 180700 CURSOR80 BAL R1,CURSOR81 branch around table 180800 DC C'CLUSTER--' 180900 DC C'DATA-----' 181000 DC C'INDEX----' 181100 DC C'NONVSAM--' 181200 DC X'00',0H'0' end of table 181300 *loop 181400 CURSOR81 CLC 0(9,R1),0(R5) compare header 181500 BE CURSOR82 found, exit 181600 LA R1,9(,R1) next entry in header table 181700 CLI 0(R1),0 end of table? 181800 BNE CURSOR81 no, check next header 181900 *endloop 182000 B CURSOR90 182100 CURSOR82 LA R5,9(,R5) skip header 182200 *---------------------------------------------------------------------* 182300 * * 182400 * return dsname address and length to invoking routine * 182500 * 182600 *---------------------------------------------------------------------* 182700 CURSOR90 LR R0,R2 R0 = first byte after dsname 182800 LR R1,R5 R1 = first byte of dsname 182900 SLR R0,R1 R0 = length 183000 PR exit 183100 * 183200 CURSOR98 SLR R0,R0 no dsname 183300 SLR R1,R1 no dsname 183400 * 183500 CURSOR99 PR GOBACK 183600 TITLE 'SETUP: Perform Initialization' 183700 *********************************************************************** 183800 * * 183900 * SETUP (first time only) * 184000 * * 184100 * 1. Make myself permanently resident in memory. * 184200 * * 184300 * 2. Call the PRELOAD routine * 184400 * * 184500 * 3. Define the RESET edit macro * 184600 * * 184700 *********************************************************************** 184800 SETUP00 BEGIN_PROC 184900 LA R1,SETUP500 SETUP URP 185000 STRING ((R1),,X),INTO=URPNAME SETUP URP 185100 IDENTIFY EPLOC=URPNAME,ENTRY=(R1) 185200 LTR R15,R15 First time? 185300 BNZ SETUP99 NO, EXIT 185400 * 185500 * Check that I've been link'd with the RENT attribute 185600 * 185700 L R5,PSATOLD-PSA my TCB 185800 L R5,TCBJSTCB-TCB(,R5) job-step TCB 185900 L R5,TCBJPQ-TCB(,R5) first CDE on JPAQ 186000 USING CDENTRY,R5 186100 *loop 186200 SETUP14B CLC OWNNAME,CDNAME IS IT MY OWN ENTRY? 186300 BE SETUP14F YES, EXIT 186400 ICM R5,B'1111',CDCHAIN NEXT CDE 186500 BNZ SETUP14B CHECK NEXT CDE 186600 *endloop 186700 B SETUP14P OWN CDE NOT FOUND ON JPAQ 186800 SETUP14F TM CDATTR,CDREN RENT module? 186900 BO SETUP14X yes, exit 187000 SETUP14P STRING 'Module ',(OWNNAME,,T),' incorrectly installed', X 187100 INTO=LONGMSG 187200 TPUT LONGMSG,(R15) issue error message 187300 B SETUP99 exit 187400 SETUP14X EQU * 187500 DROP R5 CDENTRY 187600 * 187700 * Invoke the PRELOAD routine. If I've been invoked via CALL, 187800 * the tasklib will be first in the search sequence. 187900 * 188000 SETUP20 L R15,=A(PRELOAD) pre-load routine 188100 BALR R14,R15 invoke it 188200 * 188300 * Determine availability of the IKJURPS Routine (TSO/E 2.4 only) 188400 * 188500 L R2,CVTPTR CVT ADDRESS 188600 L R3,CVTTVT-CVTMAP(,R2) TSO VECTOR TABLE 188700 USING TSVT,R3 188800 CLC =C'2040',TSVTTSOL TSO/E 2.4 ? 188900 BH SETUP90 NO, EXIT 189000 DROP R3 TSVT 189100 * 189200 * Execute the SETUP500 routine as a URP to issue LOAD and 189300 * ensure that I stay in memory until ISPF terminates. 189400 * 189500 LA R1,SETUP500 init routine 189600 BAL R14,EXECURP <- Execute SETUP500 as a URP 189700 LTR R15,R15 OK? 189800 BNZ SETUP90 no, jump 189900 DELETE EPLOC=OWNNAME reduce use cnt at ISPTASK level 190000 *---------------------------------------------------------------------* 190100 * * 190200 * Define the "RESET" EDIT macro * 190300 * * 190400 * Note that this will prevent you from accessing a program * 190500 * or TSO CP called RESET; if it is a problem, comment out * 190600 * the IDENTIFY macro below. * 190700 * * 190800 *---------------------------------------------------------------------* 190900 SETUP90 EQU * 191000 IDENTIFY EP=RESET,ENTRY=SETUP800 191100 * 191200 SETUP99 PR 191300 *---------------------------------------------------------------------* 191400 * * 191500 * Execute the routine at (R1) as an URP * 191600 * * 191700 * Invoke the Un-authorized Resource Processor Service Routine. * 191800 * It schedules an IRB at the IKJEFT09 level to execute the * 191900 * routine whose address is passed in R1. * 192000 * * 192100 *---------------------------------------------------------------------* 192200 EXECURP BEGIN_PROC 192300 ST R13,TOKEN pass A(DYNAM) 192400 L R4,TSI@ V(TSI) 192500 USING TSI,R4 192600 $LINK EP=IKJURPS, + 192700 PARAM=(TSIECTP, 1 ECT ADDRESS + 192800 URPNAME, 2 EP name + 192900 TOKEN, 3 parameter + 193000 RETCODE, 4 RETCODE FROM SETUP500 + 193100 REASON, 5 REASON CODE FROM SETUP500 + 193200 RETCODE2, 6 RETCODE FROM IKJURPS + 193300 DWD+4, 7 *DUMMY* + 193400 DWD+4, 8 *DUMMY* + 193500 DWD+4, 9 *DUMMY* + 193600 =F'1') 10 issue messages 193700 PR 193800 PUSH USING 193900 DROP 194000 *---------------------------------------------------------------------* 194100 * * 194200 * RESET EDIT macro * 194300 * * 194400 *---------------------------------------------------------------------* 194500 SETUP800 BAKR R14,0 LOCAL BASE 194600 L R11,BASEADDR-SETUP800(,R15) literal pool 194700 USING FASTPATH,R11 194800 LR R12,R15 local base 194900 USING SETUP800,R12 195000 * ISREDIT MACRO 195100 LA R1,ISREDIT1 ISREDIT MACRO 195200 LINK SF=(E,ISPLINK$) ISREDIT MACRO 195300 * ISREDIT RESET 195400 LA R1,ISREDIT2 ISREDIT RESET 195500 LINK SF=(E,ISPLINK$) ISREDIT MACRO 195600 * RETURN TO SYSTEM 195700 SLR R15,R15 RETURN CODE 195800 PR GOBACK WITH RC=00 195900 DROP 196000 ISREDIT1 DC AL4($ISREDIT,F5,*+X'80000004'),C'MACRO' 196100 ISREDIT2 DC AL4($ISREDIT,F5,*+X'80000004'),C'RESET' 196200 F5 DC FL4'5' 196300 DROP 196400 *---------------------------------------------------------------------* 196500 * * 196600 * URP Routine (executes under the IKJEFT09 TCB) * 196700 * * 196800 * 1. make myself resident * 196900 * 2. invoke the PRELOAD routine * 197000 * 3. prime the timer to prevent S522 abends * 197100 * * 197200 *---------------------------------------------------------------------* 197400 SETUP500 BAKR R14,0 save regs 197500 L R10,4(,R1) A(DYNAM) 197600 L R10,0(,R10) A(DYNAM) 197700 USING DYNAM,R10 197800 L R11,BASEADDR-SETUP500(,R15) literal pool 197900 USING FASTPATH,R11 198000 LR R12,R15 local base 198100 USING SETUP500,R12 198200 * 198300 * Prime the timer (unless we have TIME=1440) 198400 * 198500 L R14,PSATOLD-PSA job step control block 198600 USING TCB,R14 198700 L R14,TCBJSCB job step control block 198800 USING IEZJSCB,R14 198900 L R14,JSCSCT Current step's SCT prefix 199000 USING INSMSCT-16,R14 199100 ICM R14,B'0111',SCTXBTTR address of SCTX (SCT extension) 199200 USING SCTXIN-16,R14 199300 CLC SCTXSTL,=A(1440*60*100) TIME=1440? 199400 BE SETUP520 yes, do not issue STIMER 199500 L R15,=A(STOP522) PRIME TIMER 199600 BALR R14,R15 PRIME TIMER 199800 SETUP520 EQU * 199900 * 200000 LOAD EPLOC=OWNNAME bump my use count 200100 * 200200 L R15,=A(PRELOAD) jpa modules 200300 BALR R14,R15 preload some ISP/ISR modules 200400 SLR R15,R15 RC=0 200500 PR goback 200600 BASEADDR DC A(FASTPATH) base addr for literal pool 200700 DROP 200800 *---------------------------------------------------------------------* 200900 * * 201000 * TIMER EXIT RTNE * 201100 * * 201200 *---------------------------------------------------------------------* 201300 STOP522 BAKR R14,0 save regs 201400 &STOP522 SETC 'NO' STOP522(NO) 201500 AIF ('&SYSPARM' NE 'STOP522').STOP522X 201600 &STOP522 SETC 'YES' STOP522(YES) 201700 LR R12,R15 A(STOP522) 201800 USING STOP522,R12 201900 TIME DEC R0=HHMMSSHH 202000 CLM R0,B'1100',STOP522T PAST 7PM? 202100 BH STOP522X YES, ALLOW S522 AGAIN 202200 LA R10,DYNAML length of dynamic storage area 202300 GETMAIN R,LV=(R10) get dynamic storage 202400 LR R13,R1 202500 USING DYNAM,R13 202600 L R1,CVTPTR CVTPTR 202700 L R1,CVTSMCA-CVT(,R1) SMF SMCA 202800 L R1,SMCAJWT-SMCABASE(,R1) JWT BIT 31 IS 1.048576 SECONDS 202900 LA R0,100 prepare MR 203000 MR R0,R0 APPROX TIME IN 1/100 TH OF A SEC 203100 ST R1,DWD STORE FOR STOP522 RTNE 203200 STIMERM SET, X 203300 ID=DWD+4, dummy parm X 203400 BINTVL=DWD, interval X 203500 EXIT=STOP522, exit addr X 203600 MF=(E,STIMERL) 203700 FREEMAIN R,LV=(R10),A=(R13) free dynamic storage 203800 .STOP522X ANOP 203900 STOP522X PR GOBACK 204000 * 204100 STOP522T DC X'1900' 7 PM 204200 POP USING 204300 *********************************************************************** 204400 * * 204500 * Add Fast-path commands to ISPCMDS * 204600 * * 204700 *********************************************************************** 204800 ADDCMDS BEGIN_PROC 204900 L R7,=A(ISPCMDS) first table entry 205000 STRING 'ISPCMDS updated',INTO=SHORTMSG 205100 &REST SETC 'The following fast-path commands have been installed:' 205200 STRING (OWNNAME,,T),' &REL STOP522(&STOP522) - &REST', X 205300 INTO=LONGMSG 205400 *LOOP 205500 ADDCMDS1 LA R1,=A($TBTOP,$ISPCMDS+VL) 205600 LINK SF=(E,ISPLINK$) TBTOP ISPCMDS 205700 * 205800 * Build Command String for opening message 205900 * 206000 STRING (LONGMSG,,T),1X,((R7),8),INTO=LONGMSG 206100 * 206200 MVC DWD,0(R7) move verb 206300 OC DWD,BLANKS ALL CAPS 206400 ISPLINK ($VREPLACE,$ZCTVERB,=F'8',DWD) 206500 LA R7,8(,R7) skip verb 206600 * 206700 * delete the table entry if it exists already 206800 * 206900 LA R1,=A($TBSCAN,$ISPCMDS,$ZCTVERB+VL) 207000 LINK SF=(E,ISPLINK$) TBSCAN ISPCMDS ZCTVERB 207100 LTR R15,R15 207200 BNZ ADDCMDS3 207300 LA R1,=A($TBDELETE,$ISPCMDS+VL) 207400 LINK SF=(E,ISPLINK$) TBDELETE ISPCMDS 207500 * 207600 ADDCMDS3 SLR R2,R2 207700 ISPLINK ($VREPLACE,$ZCTTRUNC,=F'1',(R7)) 207800 LA R7,1(,R7) skip trunc 207900 * 208000 IC R2,0(,R7) L'&ACT 208100 ST R2,DWD L'&ACT 208200 STRING (1(R7),(R2)),INTO=COMMAND 208300 CLC =C'SELECT PGM(FASTPATH) ',COMMAND 208400 BNE *+10 208500 MVC COMMAND+11(L'OWNNAME),OWNNAME FASTPATH->TESTPATH 208600 ISPLINK ($VREPLACE,$ZCTACT,DWD,COMMAND) 208700 LA R7,1(R2,R7) point past &ACT 208800 * 208900 IC R2,0(,R7) L'&DESC 209000 ST R2,DWD length 209100 ISPLINK ($VREPLACE,$ZCTDESC,DWD,1(R7)) 209200 LA R7,1(R2,R7) point past &DESC 209300 * 209400 LA R1,=A($TBADD,$ISPCMDS+VL) 209500 LINK SF=(E,ISPLINK$) TBADD ISPCMDS 209600 * 209700 CLI 0(R7),X'00' end of table? 209800 BNE ADDCMDS1 not yet, keep doing it 209900 *ENDLOOP 210000 LA R1,=A($TBTOP,$ISPCMDS+VL) 210100 LINK SF=(E,ISPLINK$) TBTOP ISPCMDS 210200 BAL R14,SETMSG send message 210300 * 210400 PR GOBACK 210500 *---------------------------------------------------------------------* 210600 * Issue message * 210700 *---------------------------------------------------------------------* 210800 SETMSG BEGIN_PROC 210900 STRING (SHORTMSG,,T),INTO=SHORTMSG count characters in message 211000 ST R15,DWD store length 211100 ISPLINK ($VREPLACE,$ZEDSMSG,DWD,SHORTMSG) 211200 STRING (LONGMSG,,T),INTO=LONGMSG count characters in message 211300 ST R15,DWD store length 211400 ISPLINK ($VREPLACE,$ZEDLMSG,DWD,LONGMSG) 211500 LA R1,=A($SETMSG,$ISRZ000,$COND+VL) 211600 CLI ALARM,C'Y' ALARM=YES? 211700 BNE *+8 no, jump 211800 LA R1,=A($SETMSG,$ISRZ001,$COND+VL) yes, use ISRZ001 211900 MVI ALARM,C'N' ALARM=NO (default) 212000 LINK SF=(E,ISPLINK$) SETMSG ISRZ000 212100 PR GOBACK 212200 *********************************************************************** 212300 $LTORG LOCTR 212400 ISPLINK$ LINK EP=ISPLINK,SF=L 212500 $ISREDIT DC C'ISREDIT ' PROGRAM 212600 $ISRBRO DC C'ISRBRO ' PROGRAM 212700 $ISRUDA DC C'ISRUDA ' PROGRAM 212800 $CONTROL DC C'CONTROL' FUNCTION 212900 $SELECT DC C'SELECT' FUNCTION 213000 $SETMSG DC C'SETMSG' FUNCTION 213100 $TBADD DC C'TBADD' FUNCTION 213200 $TBDELETE DC C'TBDELETE' FUNCTION 213300 $TBSCAN DC C'TBSCAN' FUNCTION 213400 $TBTOP DC C'TBTOP' FUNCTION 213500 $VCOPY DC C'VCOPY' FUNCTION 213600 $VDEFINE DC C'VDEFINE' FUNCTION 213700 $VERASE DC C'VERASE' FUNCTION 213800 $VGET DC C'VGET' FUNCTION 213900 $VPUT DC C'VPUT' FUNCTION 214000 $VREPLACE DC C'VREPLACE' FUNCTION 214100 $VRESET DC C'VRESET' FUNCTION 214200 $CHAR DC C'CHAR' OPTION 214300 $ERRORS DC C'ERRORS' OPTION 214400 $MOVE DC C'MOVE' OPTION 214500 $PROFILE DC C'PROFILE' OPTION 214600 $RETURN DC C'RETURN' OPTION 214700 $ZERRMSG DC C'ZERRMSG ' VARIABLE 214800 $EDBR0000 DC C'EDBR0000' VARIABLE 214900 $ISPCMDS DC C'ISPCMDS ' VARIABLE 215000 $ZCTACT DC C'ZCTACT ' VARIABLE 215100 $ZCTDESC DC C'ZCTDESC ' VARIABLE 215200 $ZCTTRUNC DC C'ZCTTRUNC' VARIABLE 215300 $ZCTVERB DC C'ZCTVERB ' VARIABLE 215400 $ISRZ000 DC C'ISRZ000 ' MSGID (ALARM=NO) 215500 $ISRZ001 DC C'ISRZ001 ' MSGID (ALARM=YES) 215600 $ZEDLMSG DC C'ZEDLMSG ' VARIABLE 215700 $ZEDSMSG DC C'ZEDSMSG ' VARIABLE 215800 $COND DC C'COND ' OPTION 215900 &REST SETC 'ZEDLOCK ZEDLOCKP ZPCFMCN ZVIEW ZVIMAC ZVPROF' 216000 &REST SETC '&REST ZREFTYPE ZWRKVOL' 216100 &REST SETC '&REST ZEDITWS ZVIEWWS' view/edit 4.2 216200 &REST SETC '&REST ZWRKDSN' must be last 216300 VARLIST DC C'(PRJ1 LIB1 LIB2 LIB3 LIB4 TYP1 PROF MIX FNAM &REST)' 216400 VL EQU X'80000000' end of list indicator 216500 *********************************************************************** 216600 * * 216700 * PARSE A COMMA-DELIMITED JCL PARM * 216800 * * 216900 * LA R4,PARM PARM VALUE * 217000 * LH R5,LENGTH PARM LENGTH * 217100 * BAL R14,PARSE_PARM * 217200 * DC S(L'PARM1,PARM1) LENGTH,ADDR * 217300 * DC S(L'PARM2,PARM2) LENGTH,ADDR * 217400 * * 217500 *********************************************************************** 217600 PARSE_PARM BEGIN_PROC SAVE=SAVE 217700 BCTR R4,0 START OF PARM - 1 217800 ALR R5,R4 LAST BYTE OF PARM 217900 *LOOP 218000 PARSE_PARM1 SLR R0,R0 R0 = 00000000 218100 ICM R0,B'0011',2(R14) R0 = 0000BDDD 218200 SRDL R0,12(0) R0 = 0000000B, R1= BBB..... 218300 SRL R1,20(0) R1 = 00000DDD DISPLACEMENT 218400 ALR R1,R13 ADD CALLER'S SAVE AREA ADDR 218500 LR R6,R1 ADDR OF TARGET FIELD 218600 LH R7,0(,R14) LENGTH OF TARGET FIELD 218700 * 218800 LA R2,1(,R4) FIRST BYTE OF CURRENT PARAMETER 218900 *--LOOP 219000 PARSE_PARM2 LA R4,1(,R4) BUMP POINTER 219100 CLR R4,R5 END OF PARM REACHED? 219200 BH PARSE_PARM3 YES, EXIT LOOP 219300 CLI 0(R4),C',' DELIMITER? 219400 BNE PARSE_PARM2 NO, KEEP LOOPIN' 219500 *--ENDLOOP 219600 PARSE_PARM3 LR R3,R4 POSITION OF ',' 219700 SR R3,R2 LENGTH OF SOURCE PARAM 219800 ICM R3,B'1000',BLANKS PADDING 219900 MVCL R6,R2 MOVE SOURCE TO TARGET 220000 LA R14,2+2(,R14) NEXT TARGET 220100 CLI 0(R14),0 IS THIS A FIELD DESCRIPTOR? 220200 BE PARSE_PARM1 YES, PROCESS IT 220300 *ENDLOOP 220400 RETURN (0,12) goback 220500 *********************************************************************** 220600 * * 220700 * Execute an in-storage REXX EXEC * 220800 * * 220900 * LA R1,=A(stmt1,L'stmt1) FIRST STMT ADDR/LEN * 221000 * LA R0,8 LENGTH OF ADDR/LEN ARRAY * 221100 * LA R2,TENWORDS+16 ADDR OF ARG LIST OR ZERO * 221200 * * 221300 *********************************************************************** 221400 RUNEXEC BEGIN_PROC 221500 LA R6,DYNAM_INSTBLK_HEADER ADDR OF IN-STORAGE BLOCK 221600 USING INSTBLK_HEADER,R6 221700 ST R1,INSTBLK_ADDRESS STORE INTO IN-STORAGE BLOCK 221800 ST R0,INSTBLK_USEDLEN COUNT STATEMENTS 221900 ST R6,PTR_INSTBLK ADDR OF IN-STORAGE BLOCK 222000 MVC INSTBLK_ACRONYM,=C'IRXINSTB' 222100 MVC INSTBLK_HDRLEN,=A(L'INSTBLK_HEADER) 222200 MVC INSTBLK_MEMBER,BLANKS 222300 MVC INSTBLK_DDNAME,=C'SYSIN ' 222400 MVC INSTBLK_SUBCOM,BLANKS 222500 * 222600 LA R7,DYNAM_EVALBLOCK ADDR OF EVAL BLOCK 222700 USING EVALBLOCK,R7 222800 ST R7,PTR_EVALBLOCK ADDR OF EXEC BLOCK 222900 LA R0,EVALBLOCK_LENGTH/8 LENGTH IN DOUBLE-WORDS 223000 ST R0,EVALBLOCK_EVSIZE LENGTH IN DOUBLE-WORDS 223100 LA R0,256 LENGTH OF DATA IN BYTES 223200 ST R0,EVALBLOCK_EVLEN LENGTH OF DATA IN BYTES 223300 * 223400 $LINK EP=IRXEXEC, REXX Interpreter X 223500 PARAM=(=A(0), EXEC BLOCK X 223600 (R2), ARGUMENTS, X 223700 =X'80000000', Invoke as a command X 223800 PTR_INSTBLK, IN-STORAGE BLOCK X 223900 =A(0), CPPL X 224000 PTR_EVALBLOCK, EVAL BLOCK X 224100 =A(0), WORK AREA X 224200 =A(0)) USER WORK AREA 224300 ICM R1,B'1111',EVALBLOCK_EVLEN length of the returned data 224400 BNP RUNEXEC8 no data returned, exit 224500 BCTR R1,0 for "EX" 224600 EX R1,RUNEXECP pack the result 224700 CVB R1,DWD return code from EXEC 224800 PR 224900 RUNEXEC8 EQU * 225000 BSM R1,0 no RC, return negative value 225100 PR 225200 RUNEXECP PACK DWD,EVALBLOCK_EVDATA(*-*) pack the result 225300 DROP R6,R7 225400 *********************************************************************** 225500 * * 225600 * Issue LOCATE macro to check for the existence of a data set * 225700 * * 225800 *********************************************************************** 225900 LISTDSI BEGIN_PROC 226000 L R14,LISTDSI_CAMLST FLAGS 226100 LA R15,ZWRKDSN DSNAME 226200 SLR R0,R0 NO CVOL 226300 LA R1,STRING1 265 BYTES 226400 STM R14,R1,TENWORDS relocate CAMLST 226500 LOCATE TENWORDS read catalog 226600 LISTDSI9 PR 226700 LISTDSI_CAMLST CAMLST NAME,0,,0 226800 *********************************************************************** 226900 * * 227000 * Dynamic Storage <-- R13 * 227100 * * 227200 *********************************************************************** 227300 DYNAM DSECT 227400 DS 18F SAVE AREA 227500 TENWORDS DS 10F WORK AREA 227600 SIXWORDS DS 6F WORK AREA 227700 DWD DS D WORK AREA 227800 TLD@ DS V(TLD) ISPF TLD 227900 TSI@ DS V(TSI) ISPF TSI 228000 OWNNAME DS CL8'FASTPATH' my own name 228100 * 228200 ZENVIR DS CL32'ISPF 3.2' CURRENT ISPF LEVEL 228300 ZAPPLID DS C'ISF ' CURRENT ISPF APPLICATION ID 228400 ZUSER DS C'IBMUSER' USER ID 228500 ZPREFIX DS CL8'SYSTEM99' Data Set Prefix 228600 ZSCREEN DS C'32' Screen number 228700 ZDEL DS C';' Command Delimiter ";" 228800 ZSPLIT DS C'YES' Split screen 228900 ZWSCON DS C'IP:255.255.255.255:65535' Workstation connection 229000 ZTSICMD DS CL50 Command used to invoke ISPF 229100 * 229200 DS 0D 229300 FUNCTION DS CL8 FUNCTION 229400 OPT DS CL56 2ND OPTION FROM PARM 229500 PARM3 DS CL100 3RD OPTION FROM PARM 229600 PARM4 DS CL8 4TH OPTION FROM PARM 229700 NEWAPPL DS C'ISR ' NEW ISPF APPL ID 229800 NEWPGM DS CL8 NEXT PGM 229900 NEWPANEL DS CL8 NEXT PANEL 230000 NEWCMD DS CL8 NEXT COMMAND 230100 OPT8 DS CL8 1st 8 chars of OPT 230200 OPTLEN DS A(L'OPT) length of 2nd parm 230300 OPT2 DS CL(L'OPT) work area 230400 BLANKS DS CL(L'OPT)' ' a bunch of blanks 230500 GAP DS F first gap found 230600 PRJ1 DS CL8 1 230700 LIB1 DS CL8 2 230800 LIB2 DS CL8 3 230900 LIB3 DS CL8 4 231000 LIB4 DS CL8 5 231100 TYP1 DS CL8 6 231200 PROF DS CL8 7 231300 MIX DS CL8 8 231400 FNAM DS CL8 9 231500 ZEDLOCK DS CL8 10 231600 ZEDLOCKP DS CL8 11 231700 ZPCFMCN DS CL8 12 231800 ZVIEW DS CL8 13 231900 ZVIMAC DS CL8 14 232000 ZVPROF DS CL8 15 232100 ZREFTYPE DS CL8 16 WORK-PLACE 232200 ZWRKVOL DS CL8 17 WORK-PLACE 232300 ZEDITWS DS CL8 18 view/edit 4.2 232400 ZVIEWWS DS CL8 19 view/edit 4.2 232500 * 232600 ZWRKDSN DS CL56 WORK-PLACE 232700 * 232800 STRING1 DS CL200,CL100 232900 COMMAND DS CL200 233000 SHORTMSG DS CL20 ISREZ000 233100 LONGMSG DS CL512 ISREZ000 233200 TRNTBL EQU RACFWORK,256,C'C' TRT Table 233300 ISPFVM DS X'35' CURRENT ISPF LEVEL 233400 ALARM DS C'N' ALARM=Y/N for SETMSG rtne 233500 QFLAG DS X 233600 URPNAME DS CL8 name of the URP 233700 BRDSN DS CL44 CNAEEDIT/CNAEBROW 233800 BRMEM DS CL8 CNAEEDIT/CNAEBROW 233900 BRVOL DS C'VOLSER' CNAEEDIT/CNAEBROW 234000 MACLIBDD DS CL8'$$MACLIB' ddname for MACLIB/PARMLIB 234100 VIEWEDIT DS CL4'VIEW' VIEW/EDIT FOR MACLIB/PARMLIB 234200 ZERRMSG DS C'ZERRMSG ' VARIABLE 234300 ZTEMPN DS C'ISR12345' VARIABLE 234400 EDBRNNNN DS C'EDBRNNNN ' VARIABLE NAME 234500 EDBR0000 DS C'NNNN' VARIABLE VALUE 234600 DATAID DS CL8 LMINIT 234700 TOKEN DS F IKJURPS 234800 RETCODE DS F IKJURPS 234900 REASON DS F IKJURPS 235000 RETCODE2 DS F IKJURPS 235100 REASON2 DS F IKJURPS 235200 CSVQUERY MF=(L,CSVQRYWK),PLISTVER=2 235300 STIMERL STIMERM SET,MF=L 235400 ATTACHL ATTACH SF=L 235500 PTR_INSTBLK DS A(DYNAM_INSTBLK_HEADER) 235600 DYNAM_INSTBLK_HEADER DS XL(L'INSTBLK_HEADER) 235700 PTR_EVALBLOCK DS A(DYNAM_EVALBLOCK) 235800 DYNAM_EVALBLOCK DS XL(EVALBLOCK_LENGTH) 235900 STACKL STACK MF=L 236000 * 236100 RACF_DYN RACROUTE REQUEST=AUTH,RELEASE=1.9,MF=L 236200 RACF_LEN EQU *-RACF_DYN 236300 RACFWORK DS 64D RACROUTE WORK AREA (512 BYTES) 236400 DYNAML EQU *-DYNAM 236500 STRING GENERATE,LOCTR 236600 DROP 236700 *********************************************************************** 236800 * * 236900 * Make some PDF modules resident in JPAQ (ESA 4.3 and up) * 237000 * * 237100 * The purpose of this routine is to speed up access * 237200 * to some PDF functions (Edit, Browse) when ISPLLIB and * 237300 * STEPLIB contain large numbers of libraries. * 237400 * * 237500 * LOAD and IDENTIFY macros are used to clone the LPDE, * 237600 * create two CDEs and one XTLST for each module and chain * 237700 * the CDEs to the JPAQ. Note that the modules * 237800 * themselves are not duplicated, the only version that * 237900 * exists is the one in PLPA; all we do here is to create * 238000 * entries in the JPAQ that point to the PLPA modules. * 238100 * * 238200 * Using this technique allows you to avoid time-consuming * 238300 * directory searches whenever you invoke the most common * 238400 * PDF functions. * 238500 * * 238600 * If you're lucky enough that you have no ISPLLIB or * 238700 * STEPLIB, this won't do you any good, but it won't do * 238800 * you any harm either. * 238900 * * 239000 * If you're so unlucky that ISPF/PDF is in the link-list * 239100 * and not in the LPA on your system (shame on your system * 239200 * programmers), then this will definitely help you. * 239300 * * 239400 *********************************************************************** 239500 PRELOAD CSECT 239600 PRELOAD RMODE ANY 239700 BAKR R14,0 save registers 239800 BALR R12,0 239900 USING *,R12 240000 BAL R7,PRELOAD1 issue LOAD/IDENTIFY 240100 DC C'ISRBRO ' PDF 1 240200 DC C'ISREDIT ' PDF 2 240300 DC C'ISRUDA ' PDF 3.1 & 3.2 240400 DC C'ISRUMC ' PDF 3.3 240500 DC C'ISRUDL ' PDF 3.4 240600 DC C'ISRPTC ' PDF 6 240700 DC C'ISRSUBS ' PDF RMODE31 routines 240800 DC C'ISRSUBX ' PDF RMODE24 routines 240900 * 241000 DC C'ISPEXEC ' ISPF application interface 241100 DC C'ISPQRY ' ISPF application interface 241200 DC C'ISPTUTOR' ISPF Tutorial 241300 * 241400 DC C'IRXINIT ' REXX main pgm 241500 DC C'IRXEXEC ' REXX interpreter 241600 DC C'IRXSTAMP' REXX stack manager 241700 DC C'IRXAPPC ' REXX APPC interface 241800 DC C'IRXECUSP' REXX ? 242000 * 242100 DC C'ALLOCATE' TSO ALLOCATE command 242200 DC C'EXEC ' TSO EXEC command 242300 DC C'CALL ' TSO CALL command 242400 DC C'DELETE ' TSO DELETE command 242500 DC C'IDCSATO ' IDCAMS interface for TSO 242600 DC C'HELP ' TSO HELP command 242700 DC C'SUBMIT ' TSO SUBMIT command 242800 DC C'RECEIVE ' TSO RECEIVE command 242900 * 243800 * 243900 DC C'IEFEB4UV' DEVICE TYPE SCAN ROUTINE 244000 DC C'CUTPGM ' CUT/PASTE EDIT macros 244100 DC C'ROUTEPGM' ROUTE EDIT macro 244200 DC C'BR ' BROWSE command 244400 DC C'STEMDISP' STEMDISP sub-rtne (REXX) 244500 DC C'IGGCSI00' Catalog Search Interface 244600 * 244700 DC X'FFFF' end of table 244800 *loop 244900 PRELOAD1 L R3,CVTPTR 245000 USING CVTMAP,R3 245100 GETMAIN R,LV=80 work area for BLDL 245200 XC 0(16,R1),0(R1) clear 16 bytes 245300 LR R4,R1 pass the address 245400 USING PDS2-4,R4 245500 MVI 1(R4),1 BLDLIST 245600 MVI 3(R4),80 BLDLIST 245700 MVC PDS2NAME,0(R7) module name 245900 * 246000 * JOB PACK AREA (JPAQ) 246100 * 246200 L R8,PSATOLD-PSA my TCB 246300 L R8,TCBJSTCB-TCB(,R8) job-step TCB 246400 LA R8,TCBJPQ-TCB(,R8) START OF CDE CHAIN (JPAQ) 246500 LR R9,R7 EP NAME 246600 L R15,CVTQCDSR CDE SEARCH ROUTINE 246700 BALR R14,R15 USES R0, R1, R8, R9, R11 246800 B PRELOAD4 +0 FOUND, re-issue LOAD 246900 * 247000 * Issue BLDL 247100 * 247200 BLDL 0,PDS2-4 search step/task/link lib 247300 LTR R15,R15 BLDL OK? 247400 BNZ PRELOAD5 no, search LPA 247500 * 247600 * Load the module in to the JPAQ 247700 * 247800 CLI PDS2LIBF,PDS2LJOB found in tasklib/steplib? 247900 BL PRELOAD5 no, look in LPA and LNKLST 248000 LOAD DE=PDS2 load from tasklib/steplib 248100 B PRELOAD9 next module 248200 * 248300 * Load the module in to the JPAQ 248400 * 248500 PRELOAD4 LOAD EPLOC=(R7) bump use count 248600 B PRELOAD9 next module 248700 * 248800 * ACTIVE LPA Q 248900 * 249000 PRELOAD5 L R8,CVTQLPAQ START OF CDE CHAIN (ALPAQ) 249100 LR R9,R7 EP NAME 249200 L R15,CVTQCDSR CDE SEARCH ROUTINE 249300 BALR R14,R15 USES R0, R1, R8, R9, R11 249400 B PRELOAD9 +0 FOUND, IGNORE 249500 * 249600 * PLPA DIRECTORY 249700 * 249900 LM R0,R1,PDS2NAME EP NAME 250000 L R15,CVTLPDSR LPA SEARCH ROUTINE 250100 BALR R14,R15 USES R6-R9 250200 B PRELOAD7 +0 FOUND, JUMP 250400 * 250500 * LOAD from link-list 250600 * 250700 CLI PDS2LIBF,PDS2LLNK found in link-list? 250800 BNE PRELOAD9 no, give up 250900 L R2,CVTLINK DCB for SYS1.LINKLIB 251000 LOAD EPLOC=PDS2NAME,DCB=(R2) load from link-list 251100 B PRELOAD9 next module 251200 * 251300 * create JPAQ entries for PLPA modules 251400 * 251500 PRELOAD7 EQU * 251600 USING LPDE,R8 set by LPDSR 251700 L R2,LPDENTP entry-point address 251800 TM LPDEATTR,LPDEMIN ALIAS? 251900 BO PRELOAD8 yes, issue IDENTIFY 252000 DROP R8 252100 L R2,CVTLINK LINKLIST DCB 252300 LOAD EPLOC=(R7), load ISRBRO X 252400 DCB=(R2) CVTLINK 252500 LR R2,R0 save entry point addr 252600 LA R4,4(,R4) point at member name 252700 MVI 3(R4),C'_' convert ISRBRO to ISR_BRO 252800 MVC 4(4,R4),3(R7) convert ISRBRO to ISR_BRO 252900 IDENTIFY EPLOC=(R4),ENTRY=(R2) define ISR_BRO 253000 LTR R15,R15 253100 BNZ PRELOAD9 253200 LOAD EPLOC=(R4) load ISR_BRO 253300 DELETE EPLOC=(R7) delete ISRBRO 253400 PRELOAD8 EQU * 253500 IDENTIFY EPLOC=(R7),ENTRY=(R2) define ISRBRO onto ISR_BRO 253600 * 253700 PRELOAD9 LA R7,8(,R7) next entry 253800 CLI 0(R7),X'FF' end of table reached? 253900 BNE PRELOAD1 not yet, process next entry 254000 *endloop 254100 FREEMAIN R,LV=80,A=(R4) FREE BLDL WORK AREA 254200 PR 254300 *---------------------------------------------------------------------* 254400 * DSECTs * 254500 *---------------------------------------------------------------------* 254600 PRINT NOGEN 254700 YREGS 254800 IHAECVT ECVT 254900 IKJTCB TCB 255000 IHAPDS PDSBLDL=YES directory entry 255100 PSA DSECT 255200 PSATOLD EQU *+X'021C' addr of my TCB 255300 IHALPDE LPA Directory Entry 255400 IHACDE Contents Directory Entry 255500 IKJECT Environment Control Table 255600 * 255700 IKJLSD List Source Descriptor 255800 LSD_LENGTH EQU *-LSD 255900 * 256000 IKJTSVT TSO/E VECTOR TABLE 256100 IEESMCA SMF 256200 IEZJSCB Job Step Control Block 256300 IEFASCTB Step Control Block 256400 IEFSCTX DSECT=YES Step Control Block Extension 256500 AIF (D'SCTXSTL).SCTX2 256600 SCTXSTL EQU SCTX+X'7C',4,C'F' step time limit (HBB4410) 256700 .SCTX2 ANOP 256800 ICHSAFP DSECT=YES RACROUTE 256900 IRXINSTB IN-STORAGE BLOCK 257000 IRXEVALB EVALUATION BLOCK 257100 ORG EVALBLOCK_EVDATA+256 256 bytes of data 257200 EVALBLOCK_LENGTH EQU *-EVALBLOCK 257300 * 257400 TLD DSECT ISPF LOGICAL DISPLAY TABLE 257500 TLDTBLID DS C'TLD' TLD TABLE ID 257600 TLDID DS C'1' TLD ID ('0','1',...) 257700 ORG TLD+X'034' 257800 TLDTSCP DS V(TSC) Common Subroutine Table 257900 TLDTSIP DS V(TSI) System Interface Table 258000 TLDTSVP DS V(TSV) System Variables Table 258100 ORG TLD+X'60' 258200 TLDTLSP DS V(TLS) Logical Screen Table 258300 ORG TLD+X'A4' 258400 TLDCSR DS F Cursor Offset 258500 ORG TLD+X'C0' 258600 TLDCLSWD DS F Current Line Width 258700 ORG TLD+X'1F4' 258800 TLDECTP DS V(ECT) Environment Control Table 258900 ORG TLD+X'210' 259000 TLDIOWA DS V(IORLS) I/O routine work area 259100 * 259200 TSI DSECT System Interface Table 259300 TSITBLID DS C'ISPTSI' 259400 ORG TSI+X'03C' 259500 TSITPDP DS A(TPD) Physical Display Table 259600 ORG TSI+X'0B8' 259700 TSICBUFP DS V(CBUF) CPPLCBUF 259800 TSIUPTP DS V(UPT) CPPLUPT 259900 TSIPSCBP DS V(PSCB) CPPLPSCB 260000 TSIECTP DS V(ECT) CPPLECT 260100 * 260200 TSV DSECT System Variables Table 260300 ORG TSV+X'018' 260400 DS C'=' Jump character 260500 DS C':' Line Command char 260600 DS C'>' Command Table bypass 260700 TSVZDEL DS C';' Command Delimiter 260800 * 260900 TPD DSECT Physical Display Table 261000 TPDTBLID DS C'TPD ' 261100 ORG TPD+X'080' 261200 TPDTLDP DS A(TLD) TLD0 261300 TITLE 'JUL2DAYS - Julian-to-days conversion routine' 261400 *********************************************************************** 261500 * * 261600 * Convert a packed julian date obtained from the TIME macro * 261700 * to an integer that represents the number of days since * 261800 * 1900/12/31. * 261900 * * 262000 * Input: R1=YYYYDDDF julian date from TIME macro * 262100 * * 262200 * The first byte of R1 is 00 for years 1900-1999 * 262300 * and 01 for years 2000-2099. * 262400 * * 262500 * Output: R15=day of the week (1=monday, 7=sunday) * 262600 * * 262700 * R0=number of days since 1900/12/31 * 262800 * * 262900 * R1=pointer to a 9-byte character string that * 263000 * represents the day of the week. * 263100 * * 263200 *********************************************************************** 263300 JUL2DAYS CSECT 263400 JUL2DAYS RMODE ANY 263500 SAVE (14,1),,* 263600 MVO 32(8,R13),24(2,R13) 00000YYY? 263700 OI 32+7(R13),X'0F' 00000YYYF 263800 CVB R14,32(,R13) R14=YEAR 263900 LA R0,365 number of days in a year 264000 LR R1,R14 R1=years since 1900 264100 MR R0,R0 years*365 264200 BCTR R14,0 R14=YEAR-1 264300 SRL R14,2 number of leap years since 1901 264400 AR R14,R1 NUMBER OF DAYS IN PREVIOUS YEARS 264500 XC 20(6,R13),20(R13) zero YYYY in 00000000YYYYDDDF 264600 CVB R0,20(,R13) NUMBER OF DAYS THIS YEAR 264700 AR R0,R14 number of days since 1900/12/31 264800 * 264900 * DETERMINE DAY OF THE WEEK 265000 * 265100 SLR R14,R14 PREPARE DIVISION 265200 LR R15,R0 DAYS SINCE 1900/12/31 265300 BCTR R15,0 DAYS-1 265400 LA R1,7 NUMBER OF DAYS IN WEEK 265500 DR R14,R1 DIVIDE BY NUM OF DAYS IN WEEK 265600 LA R15,1(,R14) Day of the week (1=monday) 265700 BALR R1,0 local base 265800 USING *,R1 265900 MH R14,JUL2D_H9 MULT BY LENGTH OF A TABLE ENTRY 266000 LA R1,JUL2D_TD(R14) POINT TO DAY-OF-THE-WEEK 266100 RETURN (14) goback 266200 * 266300 JUL2D_H9 DC H'9' length of a table entry 266400 JUL2D_TD DC C'Monday Tuesday WednesdayThursday Friday Saturday X 266500 Sunday ' 266600 ********************************************************************** 266700 MACRO 266800 ISPCMDS &VERB=,&TRUNC=,&ACT=,&DESC= 266900 DC CL8'&VERB' verb 267000 DC C'&TRUNC' truncation 267100 &LQ SETC 'L''' 267200 &LABEL SETC 'ISP&SYSNDX' 267300 DC AL1(&LQ&LABEL.A) K'&ACT-2 267400 &LABEL.A DC C&ACT DESCRIPTION 267500 DC AL1(&LQ&LABEL.D) K'&ACT-2 267600 &LABEL.D DC C&DESC DESCRIPTION 267700 MEND 267800 *********************************************************************** 267900 * * 268000 * Command Table Entries * 268100 * * 268200 *********************************************************************** 268300 ISPCMDS CSECT 268400 ISPCMDS RMODE ANY 268500 ISPCMDS VERB=BOTtom, X 268600 TRUNC=3, X 268700 ACT='ALIAS DOWN MAX', X 268800 DESC='Abbreviated BOTTOM command' 268900 * 269000 ISPCMDS VERB=BR, X 269100 TRUNC=0, X 269200 ACT='SELECT PGM(FASTPATH) PARM(BROWSE,&&ZPARM)', X 269300 DESC='Fast Path Command: BROWSE' 269400 * 269500 ISPCMDS VERB=CNTL, X 269600 TRUNC=0, X 269700 ACT='SELECT PGM(FASTPATH) PARM(CNTL,&&ZPARM,STD)', X 269800 DESC='Fast Path Command: CNTL' 269900 * 270000 ISPCMDS VERB=CONNECT, X 270100 TRUNC=4, X 270200 ACT='SELECT PGM(FASTPATH) PARM(WSCON)', X 270300 DESC='Establish connection to work-station' 270400 * 270500 ISPCMDS VERB=CRASH, X 270600 TRUNC=0, X 270700 ACT='SELECT PGM(FASTPATH) PARM(CRASH,&&ZPARM)', X 270800 DESC='Quick exit from ISPF' 270900 * 271000 ISPCMDS VERB=D2X, X 271100 TRUNC=0, X 271200 ACT='SELECT PGM(FASTPATH) PARM(REXXT,SAY D2X(&&ZPARM))',X 271300 DESC='Convert decimal to hex' 271400 * 271500 ISPCMDS VERB=ED, X 271600 TRUNC=0, X 271700 ACT='SELECT PGM(FASTPATH) PARM(EDIT,&&ZPARM)', X 271800 DESC='Fast Path Command: EDIT' 271900 * 272000 &HANDBOOK SETC '&&&&ZUSER..HANDBOOK' 272100 ISPCMDS VERB=HANDBook, X 272200 TRUNC=5, X 272300 ACT='SELECT PGM(FASTPATH) PARM(B,&HANDBOOK.(&&ZPARM))', X 272400 DESC='On-line Macro listing' 272500 * 272600 ISPCMDS VERB=ICS, X 272700 TRUNC=0, X 272800 ACT='SELECT PGM(FASTPATH) PARM(ICS,&&ZPARM)', X 272900 DESC='ISPF Command Shell' 273000 * 273100 ISPCMDS VERB=IND$FILE, X 273200 TRUNC=0, X 273300 ACT='SELECT CMD(IND$FILE &&ZPARM) MODE(FSCR)', X 273400 DESC='PC/3270 File Transfer' 273500 * 273600 ISPCMDS VERB=LISTBc, X 273700 TRUNC=5, X 273800 ACT='SELECT CMD(LISTBC &&ZPARM) MODE(FSCR)', X 273900 DESC='List Broadcast Messages' 274000 * 274100 ISPCMDS VERB=LOGOFf, X 274200 TRUNC=5, X 274300 ACT='SELECT PGM(FASTPATH) PARM(CRASH,LOGOFF)', X 274400 DESC='Quick LOGOFF from ISPF' 274500 * 274600 ISPCMDS VERB=LOGON, X 274700 TRUNC=0, X 274800 ACT='SELECT PGM(FASTPATH) PARM(CRASH,LOGON &&ZPARM)', X 274900 DESC='Quick re-LOGON from within ISPF' 275000 * 275100 ISPCMDS VERB=MAClib, X 275200 TRUNC=3, X 275300 ACT='SELECT PGM(FASTPATH) PARM(MACLIB,&&ZPARM)', X 275400 DESC='Fast Path Command: MACLIB' 275500 * 275600 ISPCMDS VERB=NETStat, X 275700 TRUNC=4, X 275800 ACT='SELECT PGM(FASTPATH) PARM(NETSTAT,&&ZPARM)', X 275900 DESC='Fast Path Command: NETSTAT' 276000 * 276100 ISPCMDS VERB=MAIL, X 276200 TRUNC=0, X 276300 ACT='SELECT CMD(%NEWAPPL MAIL)', X 276400 DESC='TSOMAIL Application' 276500 * 276600 ISPCMDS VERB=PARMLib, X 276700 TRUNC=5, X 276800 ACT='SELECT PGM(FASTPATH) PARM(PARMLIB,&&ZPARM)', X 276900 DESC='Fast Path Command: Edit Parmlib Member' 277000 * 277100 ISPCMDS VERB=RECEive, X 277200 TRUNC=4, X 277300 ACT='SELECT CMD(RECEIVE &&ZPARM) MODE(FSCR)', X 277400 DESC='TSO Interactive Transmit/Receive Facility' 277500 * 277600 ISPCMDS VERB=REXXTry, X 277700 TRUNC=5, X 277800 ACT='SELECT PGM(FASTPATH) PARM(REXXTRY,&&ZPARM)', X 277900 DESC='Execute REXX statement' 278000 * 278100 ISPCMDS VERB=RMFmon, X 278200 TRUNC=3, X 278300 ACT='SELECT CMD(RMFMON &&ZPARM) MODE(FSCR)', X 278400 DESC='RMFMON Command' 278500 * 278600 ISPCMDS VERB=SDsf, X 278700 TRUNC=2, X 278800 ACT='SELECT PGM(FASTPATH) PARM(SDSF,&&ZPARM)', X 278900 DESC='Fast Path Command: SDSF' 279000 * 279100 ISPCMDS VERB=SHOWMvs, X 279200 TRUNC=5, X 279300 ACT='SELECT CMD(SHOWMVS &&ZPARM) MODE(FSCR)', X 279400 DESC='SHOWMVS Utility' 279500 * 279600 ISPCMDS VERB=SYSID, X 279700 TRUNC=0, X 279800 ACT='SELECT PGM(FASTPATH) PARM(SYSID,&&ZPARM)', X 279900 DESC='Display System ID on every panel' 280000 * 280100 ISPCMDS VERB=TIME, X 280200 TRUNC=0, X 280300 ACT='SELECT PGM(FASTPATH) PARM(TIME)', X 280400 DESC='Fast Path Command: TIME' 280500 * 280600 ISPCMDS VERB=TSOFs, X 280700 TRUNC=4, X 280800 ACT='SELECT PGM(FASTPATH) PARM(TSOFS,&&ZPARM)', X 280900 DESC='TSO Full-screen Command' 281000 * 281100 ISPCMDS VERB=UTil, X 281200 TRUNC=2, X 281300 ACT='SELECT PGM(FASTPATH) PARM(UTIL,&&ZPARM)', X 281400 DESC='Fast Path Command: PDF Utilities' 281500 * 281600 ISPCMDS VERB=VERAse, X 281700 TRUNC=4, X 281800 ACT='SELECT PGM(FASTPATH) PARM(VERASE,&&ZPARM)', X 281900 DESC='Remove Variables from Shared and/or Profile Pool' 282000 * 282100 ISPCMDS VERB=VI, X 282200 TRUNC=0, X 282300 ACT='SELECT PGM(FASTPATH) PARM(VIEW,&&ZPARM)', X 282400 DESC='Fast Path Command: VIEW' 282500 * 282600 ISPCMDS VERB=WHOami, X 282700 TRUNC=3, X 282800 ACT='SELECT CMD(%WHOAMI)', X 282900 DESC='Display System ID and User ID in large letters' 283000 * 283100 ISPCMDS VERB=WP, X 283200 TRUNC=2, X 283300 ACT='SELECT PGM(FASTPATH) PARM(WP,&&ZPARM)', X 283400 DESC='Fast Path Command: Work-Place' 283500 * 283600 ISPCMDS VERB=X2D, X 283700 TRUNC=0, X 283800 ACT='SELECT PGM(FASTPATH) PARM(REXXT,SAY X2D(&&ZPARM))',X 283900 DESC='Convert hex to decimal' 284000 * 284100 ISPCMDS VERB=ZDEL, X 284200 TRUNC=0, X 284300 ACT='SELECT PGM(FASTPATH) PARM(ZDEL,&&ZPARM)', X 284400 DESC='Display/Set Command Delimiter' 284500 * 284600 DC X'00' end of table 284700 END FASTPATH 285000 //SYSLIB DD DISP=SHR,DSN=IBMUSER.ESA43.TRIMMAC STRING macro 285200 // DD DISP=SHR,DSN=SYS1.MACLIB 285300 // DD DISP=SHR,DSN=SYS1.MODGEN LWA/ASXB 285400 //SYSUT1 DD UNIT=VIO,SPACE=(CYL,2) 285500 //SYSPRINT DD SYSOUT=* 285600 //SYSLIN DD UNIT=VIO,SPACE=(TRK,1),DISP=(,PASS),DCB=BLKSIZE=3200 285700 //*------------------------------------------------------------------- 285800 //LKED EXEC PGM=HEWLKED,PARM='LIST,MAP,RENT' 285900 //SYSLIN DD DSN=*.ASMH.SYSLIN,DISP=(OLD,PASS) 286000 //SYSUT1 DD UNIT=VIO,SPACE=(CYL,1) 286200 //SYSLMOD DD DISP=SHR,DSN=CORTEX.A-M-S.LOAD(FASTPATH) 286300 //SYSPRINT DD SYSOUT=* ./ ADD NAME=FASTPDOC .-----------------------------------. | | | FASTPATH Utility For ISPF | | | | Rel 130 - 28 June 1998 | '-----------------------------------' FASTPATH is a multi-function utility program which allows a TSO user to take advantage of the fast-path command facility in ISPF without having to set up or modify the existing ISPF environment. FASTPATH temporarily installs its own commands as ISPF commands and provides the code to support them. FASTPATH was originally designed for consultants and application programmers who often are not allowed to customize the ISPF environment in which they have to work. To use FASTPATH, the TSO user must be able to issue a TSO command from within ISPF; that's all. For example, let's assume that you just logged on TSO as JOHNDOE using a LOGON procedure and ISPF set-up you know nothing about. You manage to link FASTPATH into the JOHNDOE.LOAD library. To activate FASTPATH, you issue TSO CALL 'JOHNDOE.LOAD(FASTPATH)', which returns to you with the "ISPCMDS Updated" message in the upper right hand corner of the ISPF screen. If you press the HELP key at this time, you get a long message that indicates the name of the commands that have been added. At this point, FASTPATH has initialized itself by doing the following: 1. make itself resident in memory for the rest of the ISPF session 2. add a set of ISPF commands to your own in-storage copy of ISPCMDS; They are: BR Browse Entry Panel CONNECT Connect to your Workstation CNTL 0 Edit your ISPCTL0 or SPFTEMP0.CNTL data set CNTL Edit your ISPCTLn or SPFTEMPn.CNTL data set CRASH Quick exit from ISPF to TSO READY D2X Convert a decimal value to hexadecimal ED EDIT Entry Panel ICS ISPF Command Shell (opt 6) IND$FILE IND$FILE command (this allows you to transfer files to/from your PC without having to go to TSO READY or opt 6) LISTBc LISTBC command LOGON Exit ISPF and re-LOGON LOGOFf Exit ISPF and LOGOFF MAClib View a member in SYS1.MACLIB or SYS1.MODGEN NETStat Display NETSTAT output in full-screen mode PARMLib Edit a member in SYS1.PARMLIB RECEive RECEIVE command REXXTry Execute a REXX statement RMFmon Start RMF SDsf SDSF SYSID Show system id in screen corner TIME Display time, date and julian date TSOFs TSO Full-screen UTil Utility Selection Panel (PDF opt 3) VERAse Remove a variable from the Shared and/or Profile pool. VI View Entry Panel (ISPF V4) WP Work-Place (ISPF 4.2) X2D Convert a hexadecimal value to decimal ZDEL Display and set the ZDEL variable 3. make specific TSO, ISPF and SDSF modules resident to improve performance 4. start a timer to prevent the TSO session from timing out (if FASTPATH has been assembled with the SYSPARM(STOP522) option) You're all set to use FASTPATH. Here are some of the capabilities you can take advantage of: 1. Command Stacking Enter ED and the EDIT Entry Panel appears on top of the current screen; Enter UT 4 and the Data Set List panel comes up. Enter any of the fast path commands to activate a new function on top of the current one. The number of functions you can "stack" in this fashion is only limited by the REGION parameter you specified at LOGON; to unstack, use the END, RETURN or CANCEL key. 2. Command Stacking with Tag Enter a character string (a "tag") after the ED, BR, VI or WP commands and the values you enter will be associated with the tag. For example, enter ED JCL and enter the values JOHNDOE USER JCL in the Project, Group and Type fields; from that point on, each time you invoke the ED, BR, VI or WP with the JCL tag, FASTPATH will present the same values to you, which you can change at any time. For the UT (utilities) and SD (SDSF) commands, the tag is the sub-option for the command; for example, UT 4 takes you to the Data Set List panel (PDF opt 3.4); SD H gets you directly into the SDSF Held Output Display. 2. Cursor-driven Command Stacking Enter BR in the command field, move the cursor under a data set name currently appearing on your screen and press ENTER. FASTPATH extracts the data set name from the screen and invokes BROWSE. This feature works for ED, BR, VI and WP. Installing FASTPATH Three different installation procedures can be used for FASTPATH. The choice is determined by the degree of commitment of the tech support staff toward FASTPATH: cold, lukewarm, hot. 1. Low-impact installation The easiest installation method consists in linking FASTPATH into a load-library that is *not* in the normal search sequence, i.e. not present in the ISPLLIB, STEPLIB or system concatenations. In this case, the user must invoke FASTPATH via the TSO CALL command at the beginning of each ISPF session. 2. Medium-impact installation In this scenario, FASTPATH is link-edited into a load-library that is in the normal search sequence, i.e. present in the ISPLLIB, STEPLIB or system concatenations. Users who want to take advantage of the FASTPATH facilities must invoke it once, via the TSO FASTPATH command, at the beginning of each ISPF session. 3. High-impact installation In this scenario also, FASTPATH is link-edited into a load-library that is in the normal search sequence, and the technician in charge of ISPF installation customizes the ISPCMDS table (or the site table in ISPF 4.2) to make fast-path commands permanently available. Users no longer have to invoke FASTPATH at the beginning of their ISPF session to activate fast-path commands. Note that initialization functions (such as PRELOAD and STOP522) are not available in this scenario. NOTE: FASTPATH works on any MVS/ESA or OS/390 system. For full functionality, MVS/ESA 4.3 and TSO/E 2.4 are required. Invoking FASTPATH FASTPATH can be invoked as a TSO command or as a program. Depending on how it is invoked, FASTPATH will execute an initialization procedure or perform a function. 1. Initialization is performed when FASTPATH is invoked as a command, as a program with PARM='', or as a program with R1=0. a. When FASTPATH is invoked as a TSO command, the following initialization routines are executed: o PRELOAD o RESET o STOP522 o ISPCMDS b. When FASTPATH is invoked as a program (without a parm), the following initialization routines are executed: o PRELOAD o RESET o STOP522 Initialization only occurs once during an ISPF session. As part of the initialization procedure, FASTPATH makes itself resident in memory until ISPF terminates. If a new version of FASTPATH is link-edited, it is not accessible to a user who has already initialized it, because the in-storage copy has precedence over any other version. However, you may issue TSO FASTPATH at any time to receive a message indicating what fast-path commands are available. 2. function Processing is performed when FASTPATH is invoked as a program with a parm that request a specific function (see parm format, below). Conflicts between FASTPATH and TSO commands Some FASTPATH commands have the same name as TSO/E commands. This can be an issue if a user wants to enter a TSO command such as NETSTAT in the ISPF Command Shell (PDF opt 6). ISPF provides tso ways around this problem: a. prefix the command with the greater-than sign >NETSTAT DEVL b. use the TSO command: TSO NETSTAT DEVL INITIALIZATION FUNCTIONS 1. ISPCMDS The ISPCMDS adds a set of fast-path commands to the in-storage copy of the ISPCMDS table. The commands are defined in a table at the end of the FASTPATH program. Example: ISPCMDS VERB=SDsf, X TRUNC=2, X ACT='SELECT PGM(FASTPATH) PARM(SDSF,&&ZPARM)', X DESC='Fast Path Command: SDSF' 2. PRELOAD The purpose of the PRELOAD routine is to speed up access to some re-entrant programs (such as PDF Edit and Browse) which normally reside in system libraries (LPA or link-list). The PRELOAD processing is driven by an in-line table which can be customized by the user. o For LPA modules, PRELOAD creates an entry in the Job Pack Area (JPAQ). When LOAD, LINK, ATTACH or XCTL is issued, MVS looks in the JPAQ for a useable copy of the module. If one is found there, I/O is reduced because the ISPLLIB and STEPLIB directories do not need to be searched. The following programs are among the LPA modules processed by PRELOAD: ISRBRO PDF 1 ISREDIT PDF 2 ISRUDA PDF 3.1 & 3.2 ISPEXEC ISPF application interface IRXEXEC REXX interpreter IRXSTAMP REXX stack manager o Other re-entrant modules (link-list, ISPLLIB, STEPLIB, etc), are made permanently resident in the user's address-space. This can improve performance because no directory searches or module loads are required when these programs are invoked. It can also increase paging activity; therefore, pre-loading non-LPA modules should be used with caution. o Other modules can be pre-loaded from the tasklib when FASTPATH is initialized using the CALL command (see "low-impact Installation" above). In this case, FASTPATH can pre-load modules that are present in the library from which it executes. These modules can be RENT or REUS. NOTE: Pre-loading of PLPA modules in available in MVS/ESA 4.3 and above. This function uses undocumented formats of the LOAD and IDENTIFY macros to clone the LPDE, create two CDEs and one XTLST for each module and chain the CDEs to the JPAQ. Note that the modules themselves are not duplicated, the only version that exists is the one in PLPA; all that PRELOAD does is create entries in the JPAQ that point to the PLPA modules. 3. RESET EDIT Macro FASTPATH issues the IDENTIFY macro to define the RESET entry point as a program. When RESET is executed as an EDIT macro, it issues the following statements: ISREDIT MACRO ISREDIT RESET This allows you to specify !RESET as an initial macro without having to have a program by that name anywhere. 4. STOP522 This function establishes a recurring timer that keeps the TSO session active between 8 am and 6 pm to prevent time-out abends (S522). STOP522 checks the current Job Wait Time (JWT) and sets up the timer just a minute before. For example, if the JWT is defined as 0030 (30 minutes), STOP522 uses a 29-minute interval between its activity. The STOP522 function has two prerequisites: 1. SYSPARM(STOP522) must be specified when FASTPATH is assembled. 2. FASTPATH must execute in a TSO/E 2.4 environment (or above). The ED, BR, VI and WP commands The BR, VI, ED and WP commands produce three different results: 1. Display the corresponding PDF Entry panel on top of the currently displayed application, or 2. Invoke the Browse, View or Edit PDF service using the data set name specified in the command, or 2. Invoke the Browse, View or Edit PDF service using the data set name under which the cursor is positionned when the user presses ENTER. This technique is often called "point-and-shoot". The BR, VI, ED and WP commands invoke the following FASTPATH functions: BROWSE, EDIT, VIEW and WP. FASTPATH always switches to NEWAPPL(ISR) to ensure predictable PFK configuration. 1. Display the PDF Entry Panel If the BR, VI, ED and WP command is entered without any parameter, then FASTPATH displays the corresponding PDF entry panel. For example, if the user enters BR, then the BROWSE Entry Panel is displayed in ISPF/PDF V3 and, in ISPF V4, the View Entry Panel is displayed with a / in the Browse Mode choice. If the user enters ED, then the Edit Entry panel is displayed. If the user specifies a tag such as J or ABCDEF along with the command, FASTPATH displays the corresponding entry panel with the values that were specified the last time the same tag was specified. For example, user JOHNDOE enters ED J, fills the Project, Group and Type fields with JOHNDOE, USER and JCL. Each time the user issues BR J, or VI J, or ED J, or WP J, the corresponding entry panel comes up with JOHNDOE, USER and JCL in the Project, Group and Type fields. FASTPATH keeps track of most of the fields on the entry panel, namely Project, Group (1 to 4), Type, Initial Macro, Format, and Browse Mode. For the Workplace, FASTPATH also keeps track of the last View (Library or Data set), the object name and volume serial. When a tag is specified for the first time, FASTPATH checks the catalog for an existing data set, using a dsname built by concatenating the TSO prefix to the tag. If the data set exists, FASTPATH treats the tag as a partially-qualified dsname and invokes the ISPF function directly. FASTPATH saves the tags and associated data in profile variables, using names EDBR0000, EDBR0001, etc. The user can clean unwanted variables from the profile using PDF option 7.3. 2. Explicit data set name The user can specify a partially or fully qualified data set name which may include a member name. For example, the user may enter BR CLIST, ED 'USER.CLIST' or VI CLIST(XXX*). When this format is used, FASTPATH directly invokes the corresponding ISPF service without displaying the service's entry panel. Instead of a dsname, the user may specify an asterisk, which FASTPATH interprets as "the last data set name explicitely specified". FASTPATH saves the dsname and volser in the BRDSN, BRMEM and BRVOL profile variables, for compatibility with the CNAEBROW and CNAEEDIT public-domain CLISTs. Note: If the ISPF BROWSE service fails and the BR command is available, FASTPATH invokes BR which is able to process data set formats that are not normally supported by ISPF BROWSE service: VSAM, BDAM, empty data sets, multi-volumes, etc. 3. Point-and-shoot If the command is entered without a parameter and FASTPATH detects that the cursor is positionned under a data set name, then the dsname is extracted and passed to the corresponding function. For example, if the user enters BR, VI or ED, moves the cursor under a dsname appearing on the screen and hits ENTER, the corresponding data set or PDS member is automatically browsed, viewed or edited. If WP is entered instead, the Work Place view is switched to Data Set and the Work Place panel is displayed with the dsname placed in the "Object Name" field. Dsname Extraction Rules: o the dsname must appear in totality on the screen and can not be on a message line or in a message window o the data set must be cataloged o the dsname can include a member name o the dsname can be enclosed in apostrophes (single quotes) or surrounded by parentheses. o the dsname can be in upper-case, lower-case or mixed-case. The following figure shows examples of data set names and the "hot-zone" (marked with hyphens) under which the cursor must be positionned for proper extraction of the data set name. EDSN(JOHNDOE.EXEC) ((JOHNDOE.DDIR)) -------------- ---------------- JOHNDOE.CLIST(LOGPROC) (JOHNDOE.ISPF.ISPPROF(ISREDIT) ---------------------- ------------------------------ dsn (johndoe.clist ) 'johndoe.ispf.ispprof(isredit)' -------------- ------------------------------- DSN=JOHNDOE.CLIST(PDF44) DSNAME='JOHNDOE.CLIST(PDF44)' ------------------------ ----------------------------- NONVSAM--JOHNDOE.EXEC --------------------- Notes: When a dsname is not properly extracted by BR, VI or ED, the user should retry with the WP command, correct the dsname, then enter the B, V or E action character. If the ISPF BROWSE service fails, FASTPATH invokes the BR command if it is available. The CONNECT Command The CONNECT command invokes the WSCON function of FASTPATH to initiate a connection with the Work-station (ISPF 4.2 and above). CONNECT is a shortcut to the panel normally reached using the Settings option. CONNECT has no operand. The CNTL Command The CNTL command allows the user to EDIT the ISPF control data set whether it's preallocated in the LOGON procedure to DDNAME(ISPCTLn) or allocated by ISPF to DSNAME(userid.SPFTEMn.CNTL). CNTL edits the control data set that corresponds to the logical screen in which the CNTL command is entered, except if CNTL 0 is entered, in which case the SUBMIT temporary data set (ISPCTL0) is edited. The CRASH, LOGON and LOGOFF commands The CRASH command causes ISPF and any application executing under it to terminate and control to return to the TMP. CRASH is useful when the user wants to exit ISPF in a hurry without properly closing work in progress such as EDIT sessions. For all intents and purposes, CRASH causes ISPF to terminate as if the TSO session was cancelled by the operator, except that the TSO session itself does not abend. The user can specify a TSO command to be executed at the READY prompt after the termination of ISPF. For example, entering CRASH PDF terminates ISPF and re-enters it immediately. Similarly, entering CRASH %MYCLIST or CRASH TSOLIB DEACT execute the corresponding command at the READY prompt. If the CRASH * command is entered, FASTPATH retrieves the value of the ZTSICMD variable (which contains the TSO command used to invoke ISPF) and executes it at the READY prompt. If CRASH is entered without a command, control returns to the READY prompt or, if ISPF was invoked from a CLIST, to the next CLIST statement. Note that, unlike CLISTs, REXX EXECs do not survive CRASH: any REXX EXEC started before ISPF (and still active at the time CRASH is executed) is terminated. The LOGON and LOGOFF fast-path commands are shortcuts to CRASH LOGON and CRASH LOGOFF. For example, entering LOGOFF terminates ISPF and executes the LOGOFF command. Entering LOGON JOHNDOE terminates ISPF and issues the LOGON JOHNDOE command to re-logon. If CRASH is issued while a CLIST or REXX EXEC is running within ISPF, the recovery routine of the EXEC command writes abend messages to the terminal. This is normal and can not be eliminated. The D2X Command The D2X command uses the REXXTRY function to convert a decimal value to hexadecimal. Example: D2X 12345+23 The ICS Command The ICS command invokes the ISPF Command Shell (PDF option 6). The IND$FILE Command The IND$FILE command allows 3270-type file transfer on any ISPF screen. This works with IBM's PC/3270 (aka PCOM) and Passport emulators, as well as with some (but not all) non-IBM emulators. The LISTBc command The LISTBc command invokes the TSO LISTBC command with MODE(FSCR) to ensure displayed messages are displayed at the top of the screen. The MACLib Command The MACLIB command displays a macro in the SYS1.MACLIB and SYS1.MODGEN concatenation using BROWSE in ISPF/PDF V3 or VIEW in ISPF V4. To display all the TSO macros, enter: MAClib IKJ* If FASTPATH finds a PVTMACS library on the system, it concatenates it to MACLIB and MODGEN. FASTPATH looks for the following names: SYS1.PVTMACS, &ZUSER..PVTMACS, &ZUSER..PVTMACS.MACLIB. The NETSTAT Command The NETSTAT command invokes the TCP/IP NETSTAT command and displays the result using BRIF. This funcction requires STEMVIEW or STEMDISP. The NETSTAT command accepts the same parameters as the TCP/IP NETSTAT command, except STACK and REPORT. For example: NETSTAT DEVLINK Note: Specifying NETSTAT without any parameter is equivalent to NETSTAT CONN. The PARMLib Command The PARMLib command EDITs members in SYS1.PARMLIB or in the PARMLIB concatenation (OS/390 R2 or above). If the user doesn't have UPDATE authority to SYS1.PARMLIB, then VIEW is used instead of EDIT. Example: PARML IEASYS* The REXXTry Command The REXXTry command executes a line of REXX code passed as an argument. For example: REXXTRY SAY 256*3 REXX and ISPF both use the semi-colon to separate statements and commands. Before REXXTry is invoked to execute a the line of code that contains multiple statements separated by a semi-colon, the ZDEL command should be issued to change the ISPF command delimiter to another character. For example: ZDEL : REXXT x='abcdef'; SAY x ZDEL ; The SDsf Command The SDdf command starts SDSF. An SDSF option can be specified in the command. For example: SD H ABC* The SYSID Command The SYSID command displays the system ID (SMFSID) and ISPF logical screen number in the upper left-hand corner of the screen (ISPF 4.2 or above). The display is permanent and only affects the current logical screen. Entering SYSID OFF or SCRNAME OFF turns the display off. This command can not be entered on an SDSF screen because SDSF has a SYSID command of its own. However, SYSID can be issued on the ISPF primary options menu before SDSF is started. To enter the command while already in SDSF, proceed as follows: 1. stack any non-SDSF panel on top of SDSF (e.g. enter BR) 2. issue SYSID 3. issue the END or RETURN command to go back to the SDSF screen The TIME Command The TIME command displays the date and time in the upper right-hand corner of the screen. Pressing the HELP key right after entering the TIME command displays the day of the week and the julian date. The TSOFs Command The TSOFs (TSO Full-Screen) command executes the TSO command passed as a parameter, captures the output using OUTTRAP and displays the result using BRIF (the ISPF BRowse InterFace). TSOFs requires the presence of the STEMDISP or STEMVIEW utility programs. To display the HELP text for the LISTCAT command, enter: TSOFs H LISTCAT TSOFs uses the standard TSO/E OUTTRAP facility and, consequently, only supports applications that use PUTLINE to write to the TSO terminal. Programs that use TPUT or BSAM/QSAM to write to the TSO terminal do not work with TSOFs. The UTil Command The UTil command invokes the Utility Selection Panel (PDF option 3). A sub-option can be specified in the command. For example, to invoke the Data Set Utility, enter: UTil 4 The VERASE Command The VERASE command removes a variable from the shared and/or the profile pool. To delete the EDBR0023 from the profile, enter: VERASE EDBR0023 The X2D Command The X2D command uses the REXXTRY function to convert a hexadecimal value to decimal. Example: D2X 3E8 The ZDEL Command The ZDEL command displays or sets the ZDEL variable, which specifies the character (the default is ";") used to chain ISPF commands. When entered without an operand, ZDEL displays the current value of the ZDEL variable (i.e. the current command delimiter). A new delimiter can be entered in the command; for example, to change the current delimiter to the back-slash, enter: ZDEL \ The ZDEL function uses an undocumented interface to update the ZDEL variable. This has been tested in ISPF 3.5 through 4.4 but may produce unexpected results in future releases of ISPF. The B, D, E and V functions These functions do not correspond to any fastpath command but are available when the BROWSE, LMMDEL, EDIT or VIEW services are needed in a panel. The EXECPGM function This function speeds up the execution of a program from the link-list. The FTINCL function This function performs a simple File Tayloring sequence which can be invoked from an ISPF panel. The format of the PARM is as follows: PARM='FTINCL,&skel,&panel,&applid' The FTINCL functions invokes the following ISPF services: DISPLAY PANEL(&panel) (optional) FTOPEN TEMP FTINCL &skel FTCLOSE EDIT DATASET(&ZTEMPF) FASTPATH PARM PARM=function<,option><,profile><,parm4> function | option | profile | parm4 --------------|-------------|----------|------------- B | dsn | profile | BROWSE | tag or dsn | | CONNECT | | | CNTL | dsn | profile | CRASH | command | | D | dsn | member | NOENQ E | dsn | profile | EDIT | tag | | EXECPGM | pgm name | parm | FTINCL | skeleton | panel | applid ICS | | | MACLIB | member | | NETSTAT | parameters | | PARMLIB | member | | SDSF | subcmd | | SYSID | OFF | | TIME | | | TSOFS | command | | UTIL | subopt | | V | dsn | profile | VERASE | var name | | VIEW | tag | | WP | tag | | ZDEL | new dlm | | Customizing FASTPATH 1. Tables FASTPATH contains two tables that can be easily modified. a. the ISPCMDS table, which contains the entries that FASTPATH adds to the ISPCMDS at the beginning of an ISPF session. This table can be found at the very end of the FASTPATH source . b. the PRELOAD table, which contains the name of the programs that FASTPATH pre-loads to enhance performance. 2. RESET The RESET EDIT macro may prevent you from accessing a real program also called "RESET". In that case, you may comment out the IDENTIFY macro that defines RESET. FASTPATH Q&A Q. What is the environment required to run FASTPATH? A. Fastpath runs on OS/390 and on MVS/ESA with TSO/E 2.4 and ISPF V3 or V4. Q. My installation does not allow "command stacking" in ISPF, they claim it "uses too many resources". A. This is not true. Command stacking uses less resources than any of its alternatives, particularly when a user constantly switches between functions using jump commands (such as =3.4). Q. We have already modified ISPCMDS and defined ED and BR as fast-path commands to invoke EDIT and BROWSE directly. We plan to use SITECMDS in ISPF V4.2. A. FASTPATH offers additional capabilities: tags, cursor-driven capabilities, and APPLid consistency. You can get the best of both worlds by modifying ISPCMDS to invoke FASTPATH built-in functions instead of calling directly EDIT and BROWSE. Q. We run ISPF 3.5 and have installed fast-path commands in ISRCMDS because we didn't want to modify ISPCMDS. A. In that case, fast-path commands can only be used when you're in PDF; for example, they won't work in SDSF. Q. We use ISPF V4 which has the action bar and Reference Lists. Do we still need FASTPATH commands? A. The action bar is only available when you are in ISPF and requires more key-strokes than FASTPATH. Reference lists also require key-strokes and scrolling. They offer no equivalent to the cursor-driven capabilities of FASTPATH commands . Q. Our systems Programmer is a 3.4 maniac who doesn't want to customize ISPF so we can use fast-path commands. What can we do? A. You can use FASTPATH just for yourself without having to make modifications to the ISPF environment. Link it into a private load-library and call it once at the beginning of an ISPF session: as long as you stay in ISPF, fast-path commands are available to you. Q. I used fast-path commands before but they were not always working properly: when stacking BROWSE on top of SDSF, for example, the FIND key wouldn't work right. A. This is an APPLid problem caused by an improper set-up. FASTPATH makes sure every function is invoked with the right APPLid to ensure predictable and constant behaviour. Q. When using FASTPATH's cursor-driven capabilities, we noticed that the dsname is not always extracted correctly. A. The dsname extraction algorithm in FASTPATH has been rewritten in release 129 and will be further improved in the future. Dsname extraction only works if the dsname is fully visible on the screen, and not in a message line or message window. ./ ADD NAME=FILEA PROC 0 HELP /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT IF &HELP = &STR(HELP) THEN GOTO HELPSEC ISPEXEC SELECT PANEL(IFAMU01) EXIT HELPSEC: + CLEAR WRITE *** HELP FOR CLIST FILEA *** WRITE WRITE HELP NOT WRITTEN AT THIS TIME WRITE WRITE *** END OF HELP *** NO PROCESSING PERFORMED EXIT ./ ADD NAME=FILECONV PROC 0 FROM() TO() WITH(D@UDAL.FILEAID.CONVERT) WITHMEM() /*** CHECK THE DEBUG SWITCH ***/ ISPEXEC VGET DBGSWTCH PROFILE IF &DBGSWTCH = ON THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS DELETE '&TO' FREE DD(TEMPDD) ALLOC DD(TEMPDD) DSN('&TO') + NEW CATALOG + UNIT(SYSDA) + SPACE(1,1) CYLINDERS RELEASE + RECFM(F B) LRECL(119) BLKSIZE(23443) DSORG(PS) FREE DD(TEMPDD) %PROFUPDT FAXE VARIABLE(RFDSNR) VALUE('''&WITH''') %PROFUPDT FAXE VARIABLE(MEM1) VALUE(&WITHMEM) %PROFUPDT FAXE VARIABLE(RFDSNI) VALUE('''&FROM''') %PROFUPDT FAXE VARIABLE(RFDSNO) VALUE('''&TO''') ISPEXEC SELECT PANEL(IFAMU01) NEWAPPL(FAXE) OPT(3.9) EXIT ./ ADD NAME=FINDALL ISREDIT MACRO (OPT1) ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /***************************************************************************/ /* */ /* 'FINDALL' EDIT MACRO. POSITION CURSOR ON DATA FIELD NAME AND EXECUTE */ /* TO FIND ALL THE OCCURRANCES OF THE DATA FIELD DURING AN EDIT SESSION. */ /* */ /* AUTHOR : JEFF JONES DATE : 10-22-89 SSEC */ /* */ /* REWRITTEN BY DAVID LEIGH FOR EFFICIENCY */ /***************************************************************************/ IF &OPT1 = &STR(HELP) THEN GOTO HELPSEC /* */ ISREDIT (LN,CL) = CURSOR IF &CL = 0 THEN + DO SET ZEDLMSG = &STR(*** YOUR CURSOR MUST BE IN THE "BODY" OF + THE DATA, NOT ON THE COMMAND LINE ***) ISPEXEC SETMSG MSG(UTLZ001) EXIT END ISREDIT FIND PREV ' ' .ZCSR .ZCSR ISREDIT FIND NEXT P'¬' .ZCSR .ZCSR ISREDIT (LN1,CL1) = CURSOR ISREDIT FIND NEXT ' ' .ZCSR .ZCSR ISREDIT FIND PREV P'¬' .ZCSR .ZCSR ISREDIT (LN2,CL2) = CURSOR ISREDIT (DATA) = LINE .ZCSR IF &CL1 > &CL2 OR + &SUBSTR(&CL:&CL,&STR(&SYSNSUB(1,&DATA))) = &STR( ) THEN + DO SET ZEDLMSG = &STR(*** YOUR CURSOR MUST BE ON A NON-BLANK + STRING. ***) ISPEXEC SETMSG MSG(UTLZ001) ISREDIT CURSOR = &LN &CL EXIT END SET STG = &SUBSTR(&CL1:&CL2,&STR(&SYSNSUB(1,&DATA))) IF &OPT1 = &STR(KEEP) THEN GOTO FINDALL ISREDIT EXCLUDE ALL FINDALL: + ISREDIT FIND ALL '&STR(&SYSNSUB(1,&STG))' EXIT HELPSEC: + WRITE WRITE *** HELP FOR EDIT MACRO 'FINDALL' *** WRITE WRITE THE FINDALL MACRO IS AN EDIT MACRO WHICH IS EXECUTABLE FROM A WRITE NORMAL EDIT SESSION. THE MACRO WORKS IN ANY EDIT SESSION WITH WRITE ANY TYPE OF PROGRAM OR DATASET, AS LONG AS IT CAN BE EDITED. WRITE WRITE THE FINDALL MACRO WILL ENABLE A USER TO PLACE THE CURSOR WRITE ANYWHERE ON A FIELD IN AN EDIT SESSION AND PRESS A PF KEY TO WRITE FIND ALL OCCURRENCES OF THE FIELD IN THE DATASET OR MEMBER BEING WRITE EDITED. IT DOESN'T MATTER WHERE ON THE FIELD THE CURSOR IS WRITE PLACED. THE MACRO WILL ISOLATE THE SPACE DELIMITED STRING THE WRITE CURSOR IS ON. WRITE WRITE FOR EXAMPLE: THE CURSOR MAY BE PLACED ON THE "L" IN THE FIELD WRITE "L-YEAR", OR ON THE 'E', OR 'R'. IT COULD BE PLACED ANYWHERE ON WRITE THE "C-80" FIELD. ONCE THE PF KEY IS PRESSED, THE CURSOR WILL WRITE BE POSITIONED ON THE FIRST OCCURRENCE OF "L-YEAR" OR "C-80" AND WRITE ALL LINES NOT CONTAINING THE STRING WILL BE "EXCLUDED". WRITE WRITE MOVE L-YEAR TO W-YEAR-2ND. WRITE IF L-YEAR < C-80 WRITE MOVE C-20 TO W-YEAR-1ST. WRITE WRITE IF THE CURSOR IS PLACED ON A SPACE, AN ERROR MESSAGE WILL BE WRITE DISPLAYED ON THE TOP LINE OF THE SCREEN. WRITE WRITE *** END OF HELP *** NO PROCESSING PERFORMED *** EXIT ./ ADD NAME=FINDCALL /* REXX */ /*===================================================================*/ /* */ /* UTILITY: FINDCALL */ /* */ /* AUTHOR: MARC VILLARS */ /* */ /* FUNCTION: REXX PROGRAM THAT STEPS THROUGH THE COBOL PROGRAMS */ /* AND ASSOCIATES LINKED TO OR CALLED PROGRAMS TO THE */ /* PROGRAMS WHICH CALLED THEM. */ /* */ /* TO INVOKE: EXECUTED IN BATCH */ /* */ /* INPUT DATASETS: P@UREX.TEST.CNTL(EXCLPROG) */ /* P@UREX.TEST.OUTPUT(PROGRAMS) */ /* */ /* OUTPUT DATASETS: P@UREX.TEST.OUTPUT(PROGCALL) */ /* */ /* OTHER REQUIREMENTS: NONE */ /* */ /* CALLED BY: USRX0001 */ /* */ /* CHANGE LOG: */ /* 06/01/1996 MGV ORIGINAL CODE AND TEST. */ /* */ /* 01/08/1999 MRB UPDATED TO UNIPAC STANDARDS. */ /* */ /*===================================================================*/ CNTL_FILE = 'P@UREX.TEST.CNTL' OUT_FILE = 'P@UREX.TEST.OUTPUT' SAY 'STARTING AT' TIME() REC_CNT = 0 "ALLOCATE F(PROGRAMS) DA('"OUT_FILE"(PROGRAMS)') SHR REUSE" "EXECIO * DISKR PROGRAMS (STEM PROGRAMS. FINIS" "FREE F(PROGRAMS)" "ALLOCATE F(EXCL) DA('"CNTL_FILE"(EXCLPROG)') SHR REUSE" "EXECIO * DISKR EXCL (STEM EXCL. FINIS" "FREE F(EXCL)" DO X = 1 TO PROGRAMS.0 PARSE VAR PROGRAMS.X PGM_NAME MODE_IND LNG_IND DB2_IND . CALL 'TTFNDCOB' PGM_NAME 'C' SRCELIB = RESULT IF SRCELIB = 0 THEN ITERATE "ALLOCATE F(SCANFILE) DA('"SRCELIB"("PGM_NAME")') SHR REUSE" "EXECIO * DISKR SCANFILE (STEM SCANFILE. FINIS" "FREE F(SCANFILE)" Y = 0 DO FOREVER Y = Y + 1 IF INDEX(SCANFILE.Y,'PROCEDURE DIVISION') > 0 THEN DO PROCDIV = Y LEAVE END END DO Y = Y TO SCANFILE.0 SCANFILE.Y = SUBSTR(SCANFILE.Y,1,72) IF SUBSTR(SCANFILE.Y,7,1) = '*' THEN ITERATE IF INDEX(SCANFILE.Y,'EXEC CICS') > 0 THEN CALL CHK_CICS IF INDEX(SCANFILE.Y,' CALL ') > 0 THEN CALL CHK_CALL END DROP SCANFILE. END "ALLOCATE F(FILEOT) DA('"OUT_FILE"(PROGCALL)') SHR REUSE" "EXECIO * DISKW FILEOT (STEM RECOUT. FINIS" "FREE F(FILEOT)" SAY 'FINISHED AT' TIME() EXIT /*================================================================ THIS ROUTINE DETERMINES IF IT IS A LINK OR XCTL TO A PROGRAM AND PARSES OUT THE NAME. ================================================================*/ CHK_CICS: PARSE VAR SCANFILE.Y . 'EXEC CICS' CVERB . PCALLED = "" IF CVERB = 'XCTL' ³ CVERB = 'LINK' THEN DO UNTIL INDEX(SCANFILE.Y,'END-EXEC') > 0 IF INDEX(SCANFILE.Y,'PROGRAM') > 0 THEN DO PAREN1 = INDEX(SCANFILE.Y,'(') PAREN2 = INDEX(SCANFILE.Y,')') IF (PAREN1 > 0) THEN DO PROG_BEG = PAREN1 + 1 PCALLED = SUBSTR(SCANFILE.Y,PROG_BEG) PCALLED = TRANSLATE(PCALLED,' ',"'") PCALLED = TRANSLATE(PCALLED,' ',")") PCALLED = STRIP(PCALLED,B) PRESOLVE = PCALLED CALL PRINT_REC END END Y = Y + 1 SCANFILE.Y = SUBSTR(SCANFILE.Y,1,72) END RETURN /*================================================================ THIS ROUTINE DETERMINES IF IT IS A CALL TO A PROGRAM AND PARSES OUT THE NAME. ================================================================*/ CHK_CALL: IF INDEX(SCANFILE.Y,' USING ') > 0 THEN NOP ELSE DO Y = Y + 1 SCANFILE.Y = SUBSTR(SCANFILE.Y,1,72) IF INDEX(SCANFILE.Y,' USING ') > 0 &, INDEX(SCANFILE.Y,' CALL ') = 0 THEN DO Y = Y - 1 END ELSE DO Y = Y - 1 RETURN END END CLOC = INDEX(SCANFILE.Y,'CALL') CTEMP = SUBSTR(SCANFILE.Y,CLOC) PARSE VAR CTEMP . PCALLED . IF INDEX(PCALLED,"'") > 0 THEN DO PCALLED = TRANSLATE(PCALLED,' ',"'") PCALLED = STRIP(PCALLED,B) PRESOLVE = PCALLED END ELSE DO PRESOLVE = PCALLED PRECALL = SUBSTR(PCALLED,1,4) SELECT WHEN INDEX(PRECALL,'C-') > 0 THEN PCALLED = SUBSTR(PCALLED,3) WHEN INDEX(PRECALL,'L-') > 0 THEN PCALLED = SUBSTR(PCALLED,3) WHEN INDEX(PRECALL,'LIT-') > 0 THEN PCALLED = SUBSTR(PCALLED,5) OTHERWISE NOP END END CALL_PRNT = PCALLED CVERB = 'CALL' CALL PRINT_REC RETURN /*================================================================ THIS ROUTINE ATTEMPTS TO RESOLVE CALL PARAMETERS THAT ARE NOT COBOL PROGRAM NAMES BY CHECKING WORKING STORAGE FOR A VARIABLE ASSIGNMENT. ================================================================*/ RESOLVE_NAME: IF PROCDIV = 0 THEN RETURN ELSE DO W = 1 TO PROCDIV SCANFILE.W = SUBSTR(SCANFILE.W,1,72) IF SUBSTR(SCANFILE.W,7,1) = '*' THEN ITERATE IF INDEX(SCANFILE.W,PRESOLVE) > 0 THEN DO PARSE VAR SCANFILE.W JUNK 'VALUE' VARVAL VARVAL = TRANSLATE(VARVAL,' ','.') VARVAL = TRANSLATE(VARVAL,' ',"'") VARVAL = STRIP(VARVAL,B) IF LENGTH(VARVAL) > 0 THEN DO CALL 'TTFNDCOB' VARVAL 'C' SRCELIB = RESULT IF SRCELIB <> 0 THEN DO PCALLED = VARVAL VALID = 1 END END LEAVE END END RETURN /*================================================================ PRINT RECORD ROUTINE WRITES THE OUTPUT TO A PDS MEMBER ================================================================*/ PRINT_REC: VALID = 0 XCOND = 0 CALL_PRNT = "" CALL 'TTFNDCOB' PCALLED 'C' SRCELIB = RESULT IF SRCELIB <> 0 THEN VALID = 1 ELSE CALL RESOLVE_NAME NAMELEN = LENGTH(PCALLED) NAMECH = SUBSTR(PCALLED,5,1) DO N1 = 1 TO EXCL.0 PARSE VAR EXCL.N1 XPROG . IF XPROG = PCALLED THEN DO XCOND = 1 LEAVE END END IF (NAMELEN = 5 & NAMECH = 'A') ³ XCOND = 1 THEN NOP ELSE DO CALL_PRNT = PCALLED REC_CNT = REC_CNT + 1 RECOUT.REC_CNT = PGM_NAME ³³ ',' ³³ CALL_PRNT ³³ ',', ³³ CVERB ³³ ',' ³³ VALID END RETURN ./ ADD NAME=FINDCOPY /* REXX */ /*===================================================================*/ /* */ /* UTILITY: FINDCOPY */ /* */ /* AUTHOR: MARK BOLSON */ /* */ /* FUNCTION: */ /* REXX EXEC TO LOCATE ALL THE COPYBOOKS USED IN A COBOL PROGRAM. */ /* OUTPUT IS A FILE FORMATED AS DESCRIBED: */ /* PGM (SLS1010) */ /* COPYBOOK (MASTER) */ /* */ /* TO INVOKE: EXECUTED IN BATCH */ /* */ /* INPUT DATASETS: P@UREX.TEST.CNTL(PGMLIST) */ /* P@UREX.TEST.OUTPUT(PROGRAMS) */ /* */ /* OUTPUT DATASETS: P@UREX.TEST.OUTPUT(COPY2PGM) */ /* P@UREX.TEST.DOWNLOAD(COPY2PGM) */ /* */ /* OTHER REQUIREMENTS: NONE */ /* */ /* CALLED BY: USER */ /* */ /* CHANGE LOG: */ /* 01/15/1999 MRB ORIGINAL CODE AND TEST. */ /* */ /*===================================================================*/ OUT_CNT = 0 CNTL_LIB = 'P@UREX.TEST.CNTL' OUTPUT_LIB = 'P@UREX.TEST.OUTPUT' OUTPUT_LIB2= 'P@UREX.TEST.DOWNLOAD' "ALLOCATE F(PGMLIST) DA('"CNTL_LIB"(PGMLIST)') SHR REUSE" "EXECIO * DISKR PGMLIST (STEM PGMLIST. FINIS" "FREE F(PGMLIST)" DO Y = 1 TO PGMLIST.0 PARSE VAR PGMLIST.Y CNTL_PGM_NAME CNTL_PDS_NAME . PGM_NAME = STRIP(CNTL_PGM_NAME,B) "ALLOCATE F(PGMIN) DA('"CNTL_PDS_NAME"("PGM_NAME")') SHR REUSE" "EXECIO * DISKR PGMIN (STEM PGMIN. FINIS" "FREE F(PGMIN)" DO Z = 1 TO PGMIN.0 IF SUBSTR(PGMIN.Z,7,1) = '*' THEN ITERATE Z SRC_LINE = SUBSTR(PGMIN.Z,7) IF (WORD(SRC_LINE,1) = 'COPY' ³, WORD(SRC_LINE,1) = '-INCLUDE ' ³, WORD(SRC_LINE,1) = '-INC' ) THEN DO LOC_COPY = INDEX(PGMIN.Z,' COPY ',7) LOC_INCL = INDEX(PGMIN.Z,'-INCLUDE',7) LOC_INC = INDEX(PGMIN.Z,'-INC ',7) LOC = MAX(LOC_COPY,LOC_INCL,LOC_INC) TMP_STR = SUBSTR(PGMIN.Z,LOC) COPYBOOK = STRIP(WORD(TMP_STR,2),B,'.') COPYBOOK = STRIP(COPYBOOK,B,' ') IF ¬DATATYPE(COPYBOOK,A) THEN ITERATE Z COPYBOOK = LEFT(COPYBOOK,8,' ') OUT_CNT = OUT_CNT + 1 OUT.OUT_CNT = COPYBOOK³³','³³PGM_NAME³³',' END END DROP PGMIN. END "ALLOCATE F(FILEOT) DA('"OUTPUT_LIB"(COPY2PGM)') SHR REUSE" "EXECIO * DISKW FILEOT (STEM OUT. FINIS" "FREE F(FILEOT)" "ALLOCATE F(FILEOT) DA('"OUTPUT_LIB2"(COPY2PGM)') SHR REUSE" "EXECIO * DISKW FILEOT (STEM OUT. FINIS" "FREE F(FILEOT)" EXIT ./ ADD NAME=FINDMOD /********************************************************************** /* UTILITY : FINDMOD * /* AUTHOR : DAVID LEIGH * /* FUNCTION : SEARCH A GIVEN ALLOCATED DDNAME CONCATENATION FOR THE * /* FIRST OCCURANCE OF THE PASSED MEMBER NAME. * /************************* MODIFICATIONS ****************************** /* WHO WHEN WHAT AND WHY * /* =========== ======== =========================================== * /* DAVID LEIGH 09/18/90 INITIAL CREATION OF THE UTILITY * /********************************************************************** PROC 2 MEMBER_TO_FIND DDNAME_TO_SEARCH UTILITY(FINDMOD) + EDIT BROWSE DEBUG BATCH IF &DEBBG = DEBUG THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT IF &MEMBER_TO_FIND = HELP THEN GOTO HELPSEC /********************************************************************** /* LET THE USER KNOW WHAT THE HECK IS HAPPENING * /********************************************************************** SET ZEDLMSG = &STR(SEARCHING FOR "&MEMBER_TO_FIND" IN THE + "&DDNAME_TO_SEARCH" DD CONCATENATION) IF &BATCH ¬= BATCH THEN + IF &SYSISPF = ACTIVE THEN + DO ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY PANEL(MSGPANEL) END ELSE + WRITE &STR(&ZEDLMSG) /********************************************************************** /* FIND THAT MEMBER! * /********************************************************************** SET ZEDLMSG = SET SPACE = &STR( ) SET SYSOUTTRAP = 500 LISTA ST DO &I = 3 TO &SYSOUTLINE SET CURRLINE = &&SYSOUTLINE&I SET H = &I - 1 SET PREVLINE = &&SYSOUTLINE&H SET J = &I + 1 SET NEXTLINE = &&SYSOUTLINE&J SET PREVLINE = &STR(&PREVLINE&SPACE) SET CURRLINE = &STR(&CURRLINE&SPACE) SET NEXTLINE = &STR(&NEXTLINE&SPACE) SELECT WHEN (&SUBSTR(3:10,&STR(&CURRLINE)) = &DDNAME_TO_SEARCH AND + &SUBSTR(1:2,&STR(&CURRLINE)) = &STR( )) + DO SET DSNAME = &PREVLINE SET SWITCH = ON END WHEN (&SUBSTR(1:10,&STR(&CURRLINE)) = &STR( )) + SET DSNAME = WHEN (&SUBSTR(3:10,&STR(&NEXTLINE)) > &STR( ) AND + &SUBSTR(1:2,&STR(&NEXTLINE)) = &STR( ) AND + &STR(&SWITCH) = ON) + DO SET DSNAME = SET I = &SYSOUTLINE + 1 END WHEN (&STR(&SWITCH) ¬= &STR(ON)) SET DSNAME = OTHERWISE SET DSNAME = &CURRLINE END IF &STR(&DSNAME) > THEN + IF &SYSDSN('&DSNAME(&MEMBER_TO_FIND)') = OK THEN + IF &BATCH = BATCH THEN + DO SET DSN = &STR(&DSNAME(&MEMBER_TO_FIND)) ISPEXEC VPUT DSN SHARED SET SYSOUTTRAP = 0 EXIT CODE(0) END ELSE + DO SET I = &SYSOUTLINE + 1 SET ZEDLMSG = &STR(*** "&MEMBER_TO_FIND" IS IN + "&DSNAME" IN DD : + "&DDNAME_TO_SEARCH" ***) IF &SYSISPF = ACTIVE THEN + ISPEXEC SETMSG MSG(UTLZ000) ELSE + WRITE &STR(&ZEDLMSG) END END SET SYSOUTTRAP = 0 IF &STR(&ZEDLMSG) = THEN + DO IF &BATCH = BATCH THEN EXIT CODE(8) ELSE + DO SET ZEDLMSG = &STR(*** "&MEMBER_TO_FIND" NOT FOUND IN + DD : "&DDNAME_TO_SEARCH" ***) IF &SYSISPF = ACTIVE THEN + ISPEXEC SETMSG MSG(UTLZ001) ELSE + WRITE &STR(&ZEDLMSG) END END ELSE + DO IF &EDIT = EDIT THEN + IF &SYSISPF = ACTIVE THEN + ISPEXEC EDIT DATASET('&DSNAME(&MEMBER_TO_FIND)') ELSE + DO PDS '&DSNAME' EDIT &MEMBER_TO_FIND END IF &LASTCC = 20 OR &BROWSE = BROWSE THEN + IF &SYSISPF = ACTIVE THEN + DO ISPEXEC BROWSE DATASET('&DSNAME(&MEMBER_TO_FIND)') IF &LASTCC = 20 THEN + DO SET ZEDLMSG = &STR(*** COULD NOT ACCESS + "&MEMBER_TO_FIND" IN "&DSNAME" ***) ISPEXEC SETMSG MSG(UTLZ001) END END ELSE + DO PDS '&DSNAME' BROWSE &MEMBER_TO_FIND END END EXIT HELPSEC: + WRITE *** HELP FOR CLIST "FINDMOD" *** WRITE WRITE "FINDMOD" WILL SEARCH A GIVEN DDNAME (LIKE "SYSPROC" OR WRITE "ISPPLIB") WHICH IS ACTUALLY A CONCATENATION OF SEVERAL PDS'S WRITE AND TELL YOU WHERE A SPECIFIC MEMBER IN THAT CONCATENATION IS WRITE FOUND FIRST. YOU MAY INVOKE "FINDMOD" BY TYPING "TSO FINDMOD WRITE XXXXXXXX YYYYYYYY" WHERE "XXXXXXXX" IS THE MEMBER YOU WISH TO WRITE FIND AND "YYYYYYYY" IS THE DDNAME YOU WISH TO SEARCH. IF YOU WRITE ARE NOT IN "ISPF" YOU CAN INVOKE THIS CLIST WITH THE SAME SYNTAX WRITE EXCEPT FOR THE "TSO" (E.G. "FINDMOD XYZCLIST SYSPROC"). WRITE WRITE *** END OF HELP *** NO PROCESSING PERFORMED *** EXIT ./ ADD NAME=FINDNAME /* REXX ***************************************************************/ /* */ /**********************************************************************/ ADDRESS ISPEXEC 'CONTROL ERRORS RETURN' 'VGET USERID SHARED' ADDRESS ISREDIT "MACRO" "FIND FIRST '"USERID"' 1" "(LINE) = LINE .ZCSR" PARSE VAR LINE 10 LNAME 26 FNAME 41 MI MI = SUBSTR(MI,1,1) ADDRESS ISPEXEC 'VPUT (FNAME LNAME MI) SHARED' "CANCEL" EXIT ./ ADD NAME=FINDNOLB /* REXX ***************************************************************/ /* */ /**********************************************************************/ ADDRESS ISPEXEC 'CONTROL ERRORS RETURN' ADDRESS ISREDIT "MACRO" "X ALL" "FIND ALL 'CREATE VIEW' 1" "FIND ALL 'LABEL ON TABLE'" "FIND FIRST P'=' 1 NX" DO WHILE RC = 0 "(LINE) = LINE .ZCSR" "LABEL .CURR = .PREV" "LABEL .ZCSR = .CURR" PARSE UPPER VAR LINE WORD1 WORD2 WORD3 WORD4 . SAY WORD1 LASTWORD WORD3 WORD4 SELECT WHEN WORD1 = 'CREATE' AND LASTWORD = 'CREATE' THEN DO TRACE ?I "LINE_BEFORE .PREV = '-- MISSING LABEL'" "FIND LAST P'=' .CURR .CURR" LASTWORD = 'CREATE' END WHEN WORD1 = 'CREATE' THEN DO LASTWORD = 'CREATE' END WHEN WORD1 = 'LABEL' THEN DO LASTWORD = 'LABEL' END OTHERWISE NOP END "FIND NEXT P'=' 1 NX" END ./ ADD NAME=FINDP ISREDIT MACRO ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ERROR DO SET ERRCC = &LASTCC SELECT (&LASTCC) WHEN (588) DO SET ZEDSMSG = &STR(FOUND ??) NOT INTERPRET THIS + RETURN END OTHERWISE RETURN END END ISREDIT FIND NEXT P'.' IF &LASTCC = 0 THEN + DO ISREDIT (HEX) = LINE .ZCSR ISREDIT (LN,CL) = CURSOR SET HEX = &SUBSTR(&CL:&CL,&STR(&SYSNSUB(1,&HEX))) IF &ERRCC > 0 THEN GOTO BADEND ERROR OFF ISPEXEC TBOPEN HEXVALS NOWRITE SHARE ISPEXEC TBTOP HEXVALS ISPEXEC TBGET HEXVALS SET ZEDSMSG = &STR(FOUND X'&TEXT') END ELSE SET ZEDSMSG = &STR(*BOTTOM OF DATA REACHED*) BADEND: + ISPEXEC SETMSG MSG(UTLZ000) ISPEXEC TBEND HEXVALS EXIT ./ ADD NAME=FINDSQL /* REXX */ /*===================================================================*/ /* */ /* UTILITY: FINDSQL */ /* */ /* AUTHOR: SYSTEMS ENGINEERING SERVICES, CORP */ /* */ /* FUNCTION: */ /* REXX EXEC TO DETERMINE IF THE PROGRAMS WE ARE DEALING WITH HAVE */ /* DB2 IN THEM. INPUTS ARE 'PROGRAMS' AND 'PGMLIST'. OUTPUT IS AN */ /* UPDATED VERSION OF 'PROGRAMS'. THE VERSION IS NOW: */ /* PGM (SLS1010) */ /* MODE_IND (B = BATCH, O = ONLINE) */ /* LANG_IND (C = COBOL, A = ASM) */ /* DB2_IND (Y = DB2 FOUND, N = NO DB2 FOUND) */ /* */ /* TO INVOKE: EXECUTED IN BATCH */ /* */ /* INPUT DATASETS: P@UREX.TEST.CNTL(PGMLIST) */ /* P@UREX.TEST.OPUTPUT(PROGRAMS) */ /* */ /* OUTPUT DATASETS: P@UREX.TEST.OUTPUT(PROGRAMS) */ /* */ /* OTHER REQUIREMENTS: NONE */ /* */ /* CALLED BY: USRX0001 */ /* */ /* CHANGE LOG: */ /* 06/01/1996 SES ORIGINAL CODE AND TEST. */ /* */ /* 01/08/1999 MRB UPDATED TO UNIPAC STANDARDS. */ /* */ /*===================================================================*/ OUT_CNT = 0 CNTL_LIB = 'P@UREX.TEST.CNTL' OUTPUT_LIB = 'P@UREX.TEST.OUTPUT' "ALLOCATE F(PGMLIST) DA('"CNTL_LIB"(PGMLIST)') SHR REUSE" "EXECIO * DISKR PGMLIST (STEM PGMLIST. FINIS" "FREE F(PGMLIST)" "ALLOCATE F(FILEIN) DA('"OUTPUT_LIB"(PROGRAMS)') SHR REUSE" "EXECIO * DISKR FILEIN (STEM FILEIN. FINIS" "FREE F(FILEIN)" DO X = 1 TO FILEIN.0 DB2_IND = 'U' PARSE VAR FILEIN.X PGM_NAME MODE_IND LNG_IND . PGM_NAME = STRIP(PGM_NAME,B) DO Y = 1 TO PGMLIST.0 PARSE VAR PGMLIST.Y CNTL_PGM_NAME CNTL_PDS_NAME . CNTL_PGM_NAME = STRIP(CNTL_PGM_NAME,B) IF PGM_NAME = CNTL_PGM_NAME THEN DO DB2_IND = 'N' "ALLOCATE F(PGMIN) DA('"CNTL_PDS_NAME"("PGM_NAME")') SHR REUSE" "EXECIO * DISKR PGMIN (STEM PGMIN. FINIS" "FREE F(PGMIN)" DO Z = 1 TO PGMIN.0 IF SUBSTR(PGMIN.Z,7,1) = '*' THEN ITERATE Z IF INDEX(PGMIN.Z,'EXEC SQL') > 0 THEN DO DB2_IND = 'Y' LEAVE END END END END PGM_NAME = JUSTIFY(PGM_NAME,10) OUT_CNT = OUT_CNT + 1 FILEOT.OUT_CNT = PGM_NAME ³³ MODE_IND LNG_IND DB2_IND DROP PGMIN. END "ALLOCATE F(FILEOT) DA('"OUTPUT_LIB"(PROGRAMS)') SHR REUSE" "EXECIO * DISKW FILEOT (STEM FILEOT. FINIS" "FREE F(FILEOT)" EXIT ./ ADD NAME=FINDUSER /* REXX ***************************************************************/ /* */ /**********************************************************************/ ADDRESS ISPEXEC 'CONTROL ERRORS RETURN' 'VGET (USERID GRPID) SHARED' ADDIT = 'YES' DFLT = 'YES' ADDRESS ISREDIT "MACRO" "EXCLUDE ALL P'=' 1" "FIND ALL '"USERID"' 1" IF RC = 0 THEN DFLT = 'NO' "FIND FIRST '"GRPID"' 9 NX" IF RC = 0 THEN ADDIT = 'NO' ADDRESS ISPEXEC 'VPUT (ADDIT DFLT) SHARED' "CANCEL" EXIT ./ ADD NAME=FIXBODY ISREDIT MACRO ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT SET SPACE = &STR( ) SET SAS1 = &STR(/*) SET SAS2 = &STR(*/) ISREDIT FIND FIRST '/* BODY WINDOW' 1 IF &LASTCC = 0 THEN ISREDIT END ISREDIT FIND FIRST 'WINDOW' SET CC1 = &LASTCC ISREDIT (LN1,CL1) = CURSOR ISREDIT FIND FIRST ')BODY' 1 SET CC2 = &LASTCC ISREDIT (LN2,CL2) = CURSOR IF &CC1 = 0 AND &CC2 = 0 AND &LN1 = &LN2 THEN + DO ISREDIT CURSOR = &LN1 &CL1 ISREDIT FIND NEXT ')' ISREDIT (LN3,CL3) = CURSOR ISREDIT (LINE) = LINE .ZCSR SET LINE = &STR(&SAS1 &LINE) ISREDIT CHANGE P'=' ' ' ALL &CL1 &CL3 .ZCSR .ZCSR ISREDIT LINE_BEFORE .ZCSR = (LINE) END ISREDIT END EXIT ./ ADD NAME=FIXDDL ISREDIT MACRO (DBNAME) ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /********************************************************************** /* SET UP DEFAULT VALUES FOR SOME OF THE CREATE OPTIONS * /********************************************************************** SET LP = &STR(( SET RP = &STR()) SET COMMON_PREFIX = US IF &DBNAME = THEN + SET DBNAME = &COMMON_PREFIX.MSTD00 ELSE + SET NEWDB = YES SET TSSTOGRP = DUSC1T00 SET IXSTOGRP = DUSC1X00 SET PRIQTY = 12 SET SECQTY = 12 SET ERASE = NO SET FREEPAGE = 0 SET IX_PCTFREE = 10 SET TS_PCTFREE = 5 SET BUFFERPOOL = BP0 SET LOCKSIZE = ANY SET CLOSE = YES SET SEGSIZE = 64 SET SUBPAGES = 4 /********************************************************************** /* COMMENT THE ADW COMMENTS WITH SUPFI COMMENTS * /********************************************************************** /* SET COMMENT = &STR(--) /* ISREDIT FIND FIRST 'SOURCE : ' 1 /* ISREDIT FIND NEXT P'¬' 1 /* ISREDIT FIND PREV ' ' 1 /* ISREDIT LABEL .ZCSR = .A /* ISREDIT FIND FIRST P'=' 1 .ZF .A /* DO WHILE &LASTCC = 0 /* ISREDIT (LINE) = LINE .ZCSR /* ISREDIT LINE .ZCSR = <1,(COMMENT) 4,(LINE)> /* ISREDIT FIND NEXT P'=' 1 .ZF .A /* END /********************************************************************** /* ADD CURRENT SQLID LINE * /********************************************************************** ISREDIT LINE_BEFORE .ZF = "SET CURRENT SQLID = 'USSTRD00';" /********************************************************************** /* SET EVERYTHING TO UPPER CASE * /********************************************************************** ISREDIT CHANGE P'<' P'>' ALL /********************************************************************** /* IF DATABASE NAME IS PASSED, ADD DATABASE LINES. * /********************************************************************** IF &NEWDB = YES THEN + DO ISREDIT FIND 'SET CURRENT SQLID' FIRST ISREDIT FIND NEXT P'¬' 1 ISREDIT LABEL .ZCSR = .CURR ISREDIT LINE_BEFORE .CURR = ' ' ISREDIT LINE_BEFORE .CURR = 'CREATE DATABASE &DBNAME' ISREDIT LINE_BEFORE .CURR = ' STOGROUP &TSSTOGRP' ISREDIT LINE_BEFORE .CURR = ' BUFFERPOOL BP0;' ISREDIT LINE_BEFORE .CURR = ' ' END /********************************************************************** /* LOOP THROUGH THE "CREATE TABLE"S AND ADD OTHER STUFF * /********************************************************************** ISREDIT FIND FIRST 'CREATE TABLE ' 1 DO WHILE &LASTCC = 0 ISREDIT LABEL .ZCSR = .CURR ISREDIT FIND FIRST 'TABLE' .CURR .CURR ISREDIT FIND NEXT ' ' .CURR .CURR ISREDIT (LN1,CL1) = CURSOR ISREDIT FIND LAST P'¬' .CURR .CURR ISREDIT (LN2,CL2) = CURSOR ISREDIT (TABL) = LINE .CURR SET SUBJECT_AREA = &SUBSTR(&CL1+1:&CL1+3,&STR(&SYSNSUB(1,&TABL))) SET TABLE_NUMBER = &SUBSTR(&CL1+4:&CL1+5,&STR(&SYSNSUB(1,&TABL))) SET TABLE_SUFFIX = &SUBSTR(&CL1+8:&CL2,&STR(&SYSNSUB(1,&TABL))) /*** STORE COLUMN NAMES ***/ ISREDIT FIND NEXT ' (' ISREDIT LABEL .ZCSR = .BEGIN ISREDIT (LN1,CL1) = CURSOR ISREDIT FIND NEXT '); ' ISREDIT (LN2,CL2) = CURSOR IF &LN2 > &LN1 THEN + DO ISREDIT LABEL .ZCSR = .END SET END = &STR(.END) END ELSE + SET END = &STR(.BEGIN) SET X = 0 ISREDIT FIND FIRST P'=' 1 .BEGIN &STR(&END) DO WHILE &LASTCC = 0 SET X = &X + 1 ISREDIT (SYSDVAL) = LINE .ZCSR READDVAL COL NULL SET COL&X = &STR(&SYSNSUB(1,&COL)) ISREDIT FIND NEXT P'=' 1 .BEGIN &STR(&END) END SET COLS = &X /*** TABLESPACE STATEMENTS ***/ ISREDIT LINE_BEFORE .CURR = ' ' ISREDIT LINE_BEFORE .CURR = '&STR(CREATE TABLESPACE )+ &STR(&COMMON_PREFIX.&SUBJECT_AREA.S&TABLE_NUMBER)' ISREDIT LINE_BEFORE .CURR = '&STR( IN &DBNAME)' ISREDIT LINE_BEFORE .CURR = '&STR( USING)' ISREDIT LINE_BEFORE .CURR = '&STR( STOGROUP &TSSTOGRP)' ISREDIT LINE_BEFORE .CURR = '&STR( PRIQTY &PRIQTY)' ISREDIT LINE_BEFORE .CURR = '&STR( SECQTY &SECQTY)' ISREDIT LINE_BEFORE .CURR = '&STR( ERASE &ERASE)' ISREDIT LINE_BEFORE .CURR = '&STR( FREEPAGE &FREEPAGE)' ISREDIT LINE_BEFORE .CURR = '&STR( PCTFREE &TS_PCTFREE)' ISREDIT LINE_BEFORE .CURR = '&STR( BUFFERPOOL &BUFFERPOOL)' ISREDIT LINE_BEFORE .CURR = '&STR( LOCKSIZE &LOCKSIZE)' ISREDIT LINE_BEFORE .CURR = '&STR( CLOSE &CLOSE)' ISREDIT LINE_BEFORE .CURR = '&STR( SEGSIZE &SEGSIZE;)' ISREDIT LINE_BEFORE .CURR = ' ' /*** "PRIMARY KEY" STATEMENT ***/ ISREDIT CHANGE NEXT ');' ',' ISREDIT FIND NEXT ' ' 1 ISREDIT LABEL .ZCSR = .CURR ISREDIT FIND NEXT 'CREATE UNIQUE INDEX' ISREDIT FIND NEXT '_' ISREDIT (LN1,CL1) = CURSOR ISREDIT FIND NEXT ' ' ISREDIT (LN2,CL2) = CURSOR ISREDIT (INDEX) = LINE .ZCSR SET INDEX_SUFFIX = &SUBSTR(&CL1+1:&CL2-1,&STR(&SYSNSUB(1,&INDEX))) IF &SYSINDEX(P,&STR(&INDEX_SUFFIX)) > 0 THEN + DO ISREDIT LINE_BEFORE .CURR = '&STR( PRIMARY KEY)' ISREDIT FIND FIRST P'=' .CURR .CURR ISREDIT FIND NEXT '(' ISREDIT LABEL .ZCSR = .A ISREDIT (LN1,CL1) = CURSOR ISREDIT FIND NEXT ')' ISREDIT (LN2,CL2) = CURSOR IF &LN2 > &LN1 THEN + DO ISREDIT LABEL .ZCSR = .B SET B = &STR(.B) END ELSE + SET B = &STR(.A) SET X = 0 ISREDIT FIND FIRST P'=' 1 .A &STR(&B) DO WHILE &LASTCC = 0 SET X = &X + 1 ISREDIT (LINE&X) = LINE .ZCSR ISREDIT FIND NEXT P'=' 1 .A &STR(&B) END DO &I = 1 TO &X SET LINE = &STR(&SYSNSUB(2,&&LINE&I)) ISREDIT LINE_BEFORE .CURR = (LINE) END ISREDIT FIND FIRST P'=' .CURR .CURR ISREDIT CHANGE PREV ';' ')' END ELSE + ISREDIT CHANGE PREV ',' ')' /*** "IN" STATEMENT ***/ ISREDIT LINE_BEFORE .CURR = '&STR( IN )+ &STR(&DBNAME..&COMMON_PREFIX.&SUBJECT_AREA.S&TABLE_NUMBER;)' /*** ADDITIONS TO "CREATE UNIQUE INDEX" ***/ ISREDIT FIND FIRST P'=' .CURR .CURR ISREDIT LABEL .ZCSR = .IA ISREDIT FIND NEXT 'CREATE TABLE ' IF &LASTCC = 0 THEN + DO ISREDIT FIND FIRST P'=' .ZCSR .ZCSR ISREDIT FIND PREV P'=' 1 SET IB = &STR(.IB) ISREDIT LABEL .ZCSR = .IB END ELSE + SET IB = &STR(.ZLAST) ISREDIT FIND FIRST ' INDEX ' .IA &STR(&IB) DO WHILE &LASTCC = 0 ISREDIT FIND NEXT '_' .ZCSR .ZCSR ISREDIT (LN1,CL1) = CURSOR ISREDIT FIND NEXT ' ' .ZCSR .ZCSR ISREDIT (LN2,CL2) = CURSOR ISREDIT (INDEX) = LINE .ZCSR SET INDEX_SUFFIX = + &SUBSTR(&CL1+1:&CL2-1,&STR(&SYSNSUB(1,&INDEX))) IF &SYSINDEX(&STR(U),&STR(&INDEX_SUFFIX)) > 0 THEN + ISREDIT CHANGE FIRST 'CREATE INDEX' + 'CREATE UNIQUE INDEX' .ZCSR .ZCSR ISREDIT CHANGE NEXT ';' ' ' ISREDIT FIND NEXT ' ' 1 IF &LASTCC = 0 THEN + DO ISREDIT (LN3,CL3) = CURSOR ISREDIT (LN2) = LINENUM &STR(&IB) IF &LN3 = &LN2 THEN + SET CURR = &STR(&IB) ELSE + DO SET CURR = &STR(.CURR) ISREDIT LABEL .ZCSR = .CURR END END ELSE + SET CURR = &STR(.ZLAST) ISREDIT LINE_BEFORE &STR(&CURR) = + '&STR( USING)' ISREDIT LINE_BEFORE &STR(&CURR) = + '&STR( STOGROUP &IXSTOGRP)' ISREDIT LINE_BEFORE &STR(&CURR) = + '&STR( PRIQTY &PRIQTY)' ISREDIT LINE_BEFORE &STR(&CURR) = + '&STR( SECQTY &SECQTY)' ISREDIT LINE_BEFORE &STR(&CURR) = + '&STR( ERASE &ERASE)' ISREDIT LINE_BEFORE &STR(&CURR) = + '&STR( FREEPAGE &FREEPAGE)' ISREDIT LINE_BEFORE &STR(&CURR) = + '&STR( PCTFREE &IX_PCTFREE)' ISREDIT LINE_BEFORE &STR(&CURR) = + '&STR( BUFFERPOOL &BUFFERPOOL)' IF &SYSINDEX(C,&STR(&INDEX_SUFFIX)) > 0 THEN + ISREDIT LINE_BEFORE &STR(&CURR) = '&STR( CLUSTER)' ISREDIT LINE_BEFORE &STR(&CURR) = '&STR( CLOSE &CLOSE)' ISREDIT LINE_BEFORE &STR(&CURR) = + '&STR( SUBPAGES &SUBPAGES;)' ISREDIT FIND NEXT ' INDEX ' .IA &STR(&IB) END /*** SET UP BASE VIEW ***/ ISREDIT LINE_BEFORE &STR(&IB) = ' ' ISREDIT LINE_BEFORE &STR(&IB) = '&STR(CREATE VIEW )+ &STR(&SUBJECT_AREA.&TABLE_NUMBER.V_&TABLE_SUFFIX )' DO &I = 1 TO &COLS SET COL = &STR(&SYSNSUB(2,&&COL&I)) SELECT (&I) WHEN (1) DO SET LN = &SYSINDEX(&STR( ),&STR(&COL)) SET COL = &STR(&LP)&SUBSTR(1:&LN-1,&STR(&COL)) IF &I ¬= &COLS THEN SET COL = &STR(&COL,) ELSE SET COL = &STR(&COL&RP) END WHEN (&COLS) SET COL = &STR( &COL&RP) OTHERWISE SET COL = &STR( &COL,) END ISREDIT LINE_BEFORE &STR(&IB) = <3,(COL)> END ISREDIT LINE_BEFORE &STR(&IB) = '&STR( AS SELECT)' DO &I = 1 TO &COLS SET COL = &STR(&SYSNSUB(2,&&COL&I)) SELECT (&I) WHEN (1) DO SET LN = &SYSINDEX(&STR( ),&STR(&COL)) SET COL = &STR(A.&SUBSTR(1:&LN-1,&STR(&COL))) IF &I ¬= &COLS THEN SET COL = &STR(&COL,) END WHEN (&COLS) SET COL = &STR(A.&COL) OTHERWISE SET COL = &STR(A.&COL,) END ISREDIT LINE_BEFORE &STR(&IB) = <3,(COL)> END ISREDIT LINE_BEFORE &STR(&IB) = '&STR( FROM )+ &STR(USSTRD00.&SUBJECT_AREA.&TABLE_NUMBER.T_&TABLE_SUFFIX A;)' ISREDIT FIND NEXT 'CREATE TABLE ' 1 END ISREDIT CURSOR = 1 1 EXIT ./ ADD NAME=FIXDDLX ISREDIT MACRO (DBNAME) ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /********************************************************************** /* SET UP DEFAULT VALUES FOR SOME OF THE CREATE OPTIONS * /********************************************************************** SET LP = &STR(( SET RP = &STR()) SET COMMON_PREFIX = US IF &DBNAME = THEN + SET DBNAME = &COMMON_PREFIX.MSTD00 ELSE + SET NEWDB = YES SET STOGROUP = &COMMON_PREFIX.STRG01 SET PRIQTY = 12 SET SECQTY = 12 SET ERASE = NO SET FREEPAGE = 0 SET IX_PCTFREE = 10 SET TS_PCTFREE = 5 SET BUFFERPOOL = BP0 SET LOCKSIZE = ANY SET CLOSE = YES SET SEGSIZE = 64 SET SUBPAGES = 4 /********************************************************************** /* COMMENT THE ADW COMMENTS WITH SUPFI COMMENTS * /********************************************************************** /* SET COMMENT = &STR(--) /* ISREDIT FIND FIRST 'SOURCE : ' 1 /* ISREDIT FIND NEXT P'.' 1 /* ISREDIT FIND PREV ' ' 1 /* ISREDIT LABEL .ZCSR = .A /* ISREDIT FIND FIRST P'=' 1 .ZF .A /* DO WHILE &LASTCC = 0 /* ISREDIT (LINE) = LINE .ZCSR /* ISREDIT LINE .ZCSR = <1,(COMMENT) 4,(LINE)> /* ISREDIT FIND NEXT P'=' 1 .ZF .A /* END /********************************************************************** /* ADD CURRENT SQLID LINE * /********************************************************************** ISREDIT LINE_AFTER .ZFIRST = "SET CURRENT SQLID = 'USSTRD00';" /********************************************************************** /* SET EVERYTHING TO UPPER CASE * /********************************************************************** ISREDIT CHANGE P'<' P'>' ALL /********************************************************************** /* IF DATABASE NAME IS PASSED, ADD DATABASE LINES. * /********************************************************************** /* IF &NEWDB = YES THEN + /* DO /* ISREDIT FIND 'SET CURRENT SQLID' FIRST /* ISREDIT FIND NEXT P'.' 1 /* ISREDIT LABEL .ZCSR = .CURR /* ISREDIT LINE_BEFORE .CURR = ' ' /* ISREDIT LINE_BEFORE .CURR = 'CREATE DATABASE &DBNAME' /* ISREDIT LINE_BEFORE .CURR = ' STOGROUP &STOGROUP' /* ISREDIT LINE_BEFORE .CURR = ' BUFFERPOOL BP0;' /* ISREDIT LINE_BEFORE .CURR = ' ' /* END /********************************************************************** /* LOOP THROUGH THE "CREATE TABLE"S AND ADD OTHER STUFF * /********************************************************************** ISREDIT FIND FIRST 'CREATE TABLE ' 1 DO WHILE &LASTCC = 0 ISREDIT LABEL .ZCSR = .CURR ISREDIT FIND FIRST 'TABLE' .CURR .CURR ISREDIT FIND NEXT ' ' .CURR .CURR ISREDIT (LN1,CL1) = CURSOR ISREDIT FIND LAST P'.' .CURR .CURR ISREDIT (LN2,CL2) = CURSOR ISREDIT (TABL) = LINE .CURR SET SUBJECT_AREA = &SUBSTR(&CL1+1:&CL1+3,&STR(&SYSNSUB(1,&TABL))) SET TABLE_NUMBER = &SUBSTR(&CL1+4:&CL1+5,&STR(&SYSNSUB(1,&TABL))) SET TABLE_SUFFIX = &SUBSTR(&CL1+8:&CL2,&STR(&SYSNSUB(1,&TABL))) /*** STORE COLUMN NAMES ***/ ISREDIT FIND NEXT ' (' ISREDIT LABEL .ZCSR = .BEGIN ISREDIT (LN1,CL1) = CURSOR ISREDIT FIND NEXT ' PRIMARY KEY ' ISREDIT FIND PREV ',' ISREDIT (LN2,CL2) = CURSOR IF &LN2 > &LN1 THEN + DO ISREDIT LABEL .ZCSR = .END SET END = &STR(.END) END ELSE + SET END = &STR(.BEGIN) SET X = 0 ISREDIT FIND FIRST P'=' 1 .BEGIN &STR(&END) DO WHILE &LASTCC = 0 SET X = &X + 1 ISREDIT (SYSDVAL) = LINE .ZCSR READDVAL COL NULL SET COL&X = &STR(&SYSNSUB(1,&COL)) ISREDIT FIND NEXT P'=' 1 .BEGIN &STR(&END) END SET COLS = &X /*** TABLESPACE STATEMENTS ***/ ISREDIT LINE_BEFORE .CURR = ' ' ISREDIT LINE_BEFORE .CURR = '&STR(CREATE TABLESPACE )+ &STR(&COMMON_PREFIX.&SUBJECT_AREA.S&TABLE_NUMBER)' ISREDIT LINE_BEFORE .CURR = '&STR( IN &DBNAME)' ISREDIT LINE_BEFORE .CURR = '&STR( USING)' ISREDIT LINE_BEFORE .CURR = '&STR( STOGROUP &STOGROUP)' ISREDIT LINE_BEFORE .CURR = '&STR( PRIQTY &PRIQTY)' ISREDIT LINE_BEFORE .CURR = '&STR( SECQTY &SECQTY)' ISREDIT LINE_BEFORE .CURR = '&STR( ERASE &ERASE)' ISREDIT LINE_BEFORE .CURR = '&STR( FREEPAGE &FREEPAGE)' ISREDIT LINE_BEFORE .CURR = '&STR( PCTFREE &TS_PCTFREE)' ISREDIT LINE_BEFORE .CURR = '&STR( BUFFERPOOL &BUFFERPOOL)' ISREDIT LINE_BEFORE .CURR = '&STR( LOCKSIZE &LOCKSIZE)' ISREDIT LINE_BEFORE .CURR = '&STR( CLOSE &CLOSE)' ISREDIT LINE_BEFORE .CURR = '&STR( SEGSIZE &SEGSIZE;)' ISREDIT LINE_BEFORE .CURR = ' ' /*** "PRIMARY KEY" STATEMENT ***/ /* ISREDIT CHANGE NEXT ');' ',' /* ISREDIT FIND NEXT ' ' 1 /* ISREDIT LABEL .ZCSR = .CURR /* ISREDIT FIND NEXT 'CREATE UNIQUE INDEX' /* ISREDIT FIND NEXT '_' /* ISREDIT (LN1,CL1) = CURSOR /* ISREDIT FIND NEXT ' ' /* ISREDIT (LN2,CL2) = CURSOR /* ISREDIT (INDEX) = LINE .ZCSR /* SET INDEX_SUFFIX = &SUBSTR(&CL1+1:&CL2-1,&STR(&SYSNSUB(1,&INDEX))) /* IF &SYSINDEX(P,&STR(&INDEX_SUFFIX)) > 0 THEN + /* DO /* ISREDIT LINE_BEFORE .CURR = '&STR( PRIMARY KEY)' /* ISREDIT FIND FIRST P'=' .CURR .CURR /* ISREDIT FIND NEXT '(' /* ISREDIT LABEL .ZCSR = .A /* ISREDIT (LN1,CL1) = CURSOR /* ISREDIT FIND NEXT ')' /* ISREDIT (LN2,CL2) = CURSOR /* IF &LN2 > &LN1 THEN + /* DO /* ISREDIT LABEL .ZCSR = .B /* SET B = &STR(.B) /* END /* ELSE + /* SET B = &STR(.A) /* SET X = 0 /* ISREDIT FIND FIRST P'=' 1 .A &STR(&B) /* DO WHILE &LASTCC = 0 /* SET X = &X + 1 /* ISREDIT (LINE&X) = LINE .ZCSR /* ISREDIT FIND NEXT P'=' 1 .A &STR(&B) /* END /* DO &I = 1 TO &X /* SET LINE = &STR(&SYSNSUB(2,&&LINE&I)) /* ISREDIT LINE_BEFORE .CURR = (LINE) /* END /* ISREDIT FIND FIRST P'=' .CURR .CURR /* ISREDIT CHANGE PREV ';' ')' /* END /* ELSE + /* ISREDIT CHANGE PREV ',' ')' /*** "IN" STATEMENT ***/ ISREDIT FIND NEXT ' INDEX ' ISREDIT CHANGE PREV ';' ' ' ISREDIT LINE_AFTER .ZCSR = '&STR( IN )+ &STR(&DBNAME..&COMMON_PREFIX.&SUBJECT_AREA.S&TABLE_NUMBER;)' /*** ADDITIONS TO "CREATE UNIQUE INDEX" ***/ ISREDIT FIND FIRST P'=' .CURR .CURR ISREDIT LABEL .ZCSR = .IA ISREDIT FIND NEXT 'CLOSE YES' ISREDIT FIND NEXT P'=' 1 IF &LASTCC = 0 THEN + DO ISREDIT FIND FIRST P'=' .ZCSR .ZCSR ISREDIT FIND PREV P'=' 1 SET IB = &STR(.IB) ISREDIT LABEL .ZCSR = .IB END ELSE + SET IB = &STR(.ZLAST) ISREDIT FIND FIRST ' INDEX ' .IA &STR(&IB) DO WHILE &LASTCC = 0 ISREDIT FIND NEXT '_' .ZCSR .ZCSR ISREDIT (LN1,CL1) = CURSOR ISREDIT FIND NEXT ' ' .ZCSR .ZCSR ISREDIT (LN2,CL2) = CURSOR ISREDIT (INDEX) = LINE .ZCSR SET INDEX_SUFFIX = + &SUBSTR(&CL1+1:&CL2-1,&STR(&SYSNSUB(1,&INDEX))) IF &SYSINDEX(&STR(U),&STR(&INDEX_SUFFIX)) > 0 THEN + ISREDIT CHANGE FIRST 'CREATE INDEX' + 'CREATE UNIQUE INDEX' .ZCSR .ZCSR /* /* ISREDIT CHANGE NEXT ';' ' ' /* ISREDIT FIND NEXT ' ' 1 /* IF &LASTCC = 0 THEN + /* DO /* ISREDIT (LN3,CL3) = CURSOR /* ISREDIT (LN2) = LINENUM &STR(&IB) /* IF &LN3 = &LN2 THEN + /* SET CURR = &STR(&IB) /* ELSE + /* DO /* SET CURR = &STR(.CURR) /* ISREDIT LABEL .ZCSR = .CURR /* END /* END /* ELSE + /* SET CURR = &STR(.ZLAST) ISREDIT LINE_BEFORE &STR(&IB) = + '&STR( USING)' ISREDIT LINE_BEFORE &STR(&IB) = + '&STR( STOGROUP &STOGROUP)' ISREDIT LINE_BEFORE &STR(&IB) = + '&STR( PRIQTY &PRIQTY)' ISREDIT LINE_BEFORE &STR(&IB) = + '&STR( SECQTY &SECQTY)' ISREDIT LINE_BEFORE &STR(&IB) = + '&STR( ERASE &ERASE)' ISREDIT LINE_BEFORE &STR(&IB) = + '&STR( FREEPAGE &FREEPAGE)' ISREDIT LINE_BEFORE &STR(&IB) = + '&STR( PCTFREE &IX_PCTFREE)' ISREDIT LINE_BEFORE &STR(&IB) = + '&STR( BUFFERPOOL &BUFFERPOOL)' IF &SYSINDEX(C,&STR(&INDEX_SUFFIX)) > 0 THEN + ISREDIT LINE_BEFORE &STR(&IB) = '&STR( CLUSTER)' ISREDIT LINE_BEFORE &STR(&IB) = '&STR( CLOSE &CLOSE)' ISREDIT LINE_BEFORE &STR(&IB) = + '&STR( SUBPAGES &SUBPAGES;)' ISREDIT FIND NEXT ' INDEX ' .IA &STR(&IB) END /*** SET UP BASE VIEW ***/ ISREDIT LINE_BEFORE &STR(&IB) = ' ' ISREDIT LINE_BEFORE &STR(&IB) = '&STR(CREATE VIEW )+ &STR(&SUBJECT_AREA.&TABLE_NUMBER.V_&TABLE_SUFFIX )' DO &I = 1 TO &COLS SET COL = &STR(&SYSNSUB(2,&&COL&I)) SELECT (&I) WHEN (1) DO SET LN = &SYSINDEX(&STR( ),&STR(&COL)) SET COL = &STR(&LP)&SUBSTR(1:&LN-1,&STR(&COL)) IF &I ¬= &COLS THEN SET COL = &STR(&COL,) ELSE SET COL = &STR(&COL&RP) END WHEN (&COLS) SET COL = &STR( &COL&RP) OTHERWISE SET COL = &STR( &COL,) END ISREDIT LINE_BEFORE &STR(&IB) = <3,(COL)> END ISREDIT LINE_BEFORE &STR(&IB) = '&STR( AS SELECT)' DO &I = 1 TO &COLS SET COL = &STR(&SYSNSUB(2,&&COL&I)) SELECT (&I) WHEN (1) DO SET LN = &SYSINDEX(&STR( ),&STR(&COL)) SET COL = &STR(A.&SUBSTR(1:&LN-1,&STR(&COL))) IF &I ¬= &COLS THEN SET COL = &STR(&COL,) END WHEN (&COLS) SET COL = &STR(A.&COL) OTHERWISE SET COL = &STR(A.&COL,) END ISREDIT LINE_BEFORE &STR(&IB) = <3,(COL)> END ISREDIT LINE_BEFORE &STR(&IB) = '&STR( FROM )+ &STR(USSTRD00.&SUBJECT_AREA.&TABLE_NUMBER.T_&TABLE_SUFFIX A;)' ISREDIT FIND NEXT 'CREATE TABLE ' 1 END ISREDIT EXCLUDE ALL P'=' 1 ISREDIT FIND ALL ' CLOSE YES ; ' ISREDIT DELETE ALL NX ISREDIT RESET EXCLUDED ISREDIT FIND FIRST 'COMMENT ON TABLE' DO WHILE &LASTCC = 0 ISREDIT FIND NEXT P'=' 1 ISREDIT TFLOW .ZCSR 70 ISREDIT FIND NEXT 'COMMENT ON TABLE' END ISREDIT CURSOR = 1 1 EXIT ./ ADD NAME=FIXPOP ISREDIT MACRO ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT SET SPACE = &STR( ) SET SAS1 = &STR(/*) SET SAS2 = &STR(*/) SET SAVE = &STR(ISPEXEC CONTROL DISPLAY SAVE &SAS1 FIXPOP &SAS2) SET RESTORE = &STR(ISPEXEC CONTROL DISPLAY RESTORE &SAS1 FIXPOP &SAS2) ISREDIT EXCLUDE ALL ISREDIT FIND ALL 'ADDPOP' ISREDIT FIND ALL 'REMPOP' ISREDIT CHANGE P'==' '/*' 1 ALL NX ISREDIT FIND FIRST 'ADDPOP' NX DO WHILE &LASTCC = 0 ISREDIT LINE_AFTER .ZCSR = (SAVE) ISREDIT FIND NEXT 'ADDPOP' NX END ISREDIT FIND FIRST 'REMPOP' NX DO WHILE &LASTCC = 0 ISREDIT LINE_AFTER .ZCSR = (RESTORE) ISREDIT FIND NEXT 'REMPOP' NX END /* ISREDIT END EXIT ./ ADD NAME=FIXSTRAT /* REXX ***************************************************************/ /* GENERAL PLACE TO PUT REPETITIVE FIXES TO PLATINUM STRATEGIES */ /* */ /**********************************************************************/ ADDRESS ISPEXEC 'CONTROL ERRORS RETURN' ADDRESS TSO "NEWSTACK" ADDRESS ISREDIT "MACRO" /**********************************************************************/ /* SAVE YOUR LINE POSITION TO RETURN TO IT */ /**********************************************************************/ "(SLN,SCR) = CURSOR" /**********************************************************************/ /* FIX THE "DROP FOREIGN KEY" PROBLEM */ /**********************************************************************/ "EXCLUDE ALL P'=' 1" "FIND ALL 'DROP FOREIGN KEY'" SRC = RC "(X1,X2) = FIND_COUNTS" "DELETE ALL NX" QUEUE "DELETED "X1" 'DROP FOREIGN KEY' LINES" "RESET" /**********************************************************************/ /* FIX THE CLOSE YES/NO PROBLEM */ /**********************************************************************/ "CHANGE 'CLOSE YES' 'CLOSE NO' ALL" SRC = RC "(X1,X2) = CHANGE_COUNTS" QUEUE "CHANGED 'CLOSE YES' TO 'CLOSE NO'" X1 "TIMES ON" X2 "LINES" /**********************************************************************/ /* RETURN TO WHERE YOU STARTED */ /**********************************************************************/ "CURSOR = "SLN SCR X = QUEUED() DO I = 1 TO X PULL MSGLINE "LINE_AFTER .ZCSR = MSGLINE (MSGLINE)" END EXIT /* THIS ONE ALLOWS YOU TO PUT YOUR CURSOR ON A CREATE VIEW STATEMENT */ /* IN A PLATINUM STRATEGY AND PRESS THE PFKEY ASSOCIATED WITH XXMACRO */ /* AND IT WILL CREATE A LABEL ON STATEMENT BEFORE THE SYNC. */ "(LINE) = LINE .ZCSR" "FIND 'VIEW'" "FIND ' '" "FIND P'.'" "(LN1,CL1) = CURSOR" "FIND '.'" "FIND P'.'" "(LN2,CL2) = CURSOR" "FIND ' '" "(LN3,CL3) = CURSOR" VIEWNAME = SUBSTR(LINE,CL1,CL3-CL1) LABNAME = "'" || SUBSTR(LINE,CL2,3) || 'XXXXX' || "'" "FIND ' FROM '" "FIND NEXT P'=' 1" "FIND NEXT '.SYNC'" "FIND PREV ';'" "LINE_AFTER .ZCSR = <1,'LABEL ON TABLE'", "16,(VIEWNAME)", "45,'IS'", "48,(LABNAME)", "58,';'>" "FIND 'XXXXX'" EXIT ./ ADD NAME=FIXVOL /* REXX ***************************************************************/ /* UTILITY: FIXVOL */ /* AUTHOR: DAVID LEIGH */ /* FUNCTION: EDIT THE JCL CREATED BY "TSO RECOVERY" AND OUR NIGHTLY */ /* PROCESS TO ADD VOLSERS TO STEPS WHERE SOME OF THE */ /* DATASETS SPAN THE VOLUME SPECIFIED. */ /**********************************************************************/ ADDRESS ISPEXEC "CONTROL ERRORS RETURN" DB2SSID = "DSNP" ADDRESS ISREDIT "MACRO" "FIND FIRST '//DD1 ' 1" DO WHILE RC = 0 "(LINE) = LINE .ZCSR" PARSE UPPER VAR LINE '.' LOC '.' DBNAME '.' TSNAME '.' "FIND NEXT 'RETAIN,SER='" "LABEL .ZCSR = .VOL" "(LINE) = LINE .ZCSR" PARSE UPPER VAR LINE 'SER=' DSVOLSER ')' SAVEVOL = DSVOLSER ZEDLMSG = 'PROCESSING STEP WITH VOLSER:' DSVOLSER ADDRESS ISPEXEC "CONTROL DISPLAY LOCK" ADDRESS ISPEXEC "DISPLAY MSG(UTLZ000W)" SQLQUERY = "SELECT SUBSTR(DSVOLSER,1,250), FILESEQNO, TSNAME", "FROM SYSIBM.SYSCOPY", "WHERE DBNAME = '"DBNAME"'", "AND DSVOLSER LIKE '"DSVOLSER ³³ '%'"'", "ORDER BY FILESEQNO" ADDRESS LINK "REXXSQL"; SQLRC = RC IF SQLRC = 0 THEN DO I = 1 TO _NROWS; PARSE UPPER VAR __VN1.I VOL.1 ',', VOL.2 ',', VOL.3 ',', VOL.4 ',', VOL.5 ',', VOL.6 ',', VOL.7 ',', VOL.8 ',', VOL.9 ',' NULL IF NULL > '' THEN DO SAY '**************************************************' SAY '* THERE WERE MORE THAN 9 VOLSERS FOR THIS START- *' SAY '* VOLSER. THE FIXVOL REXX EXEC MUST BE MODIFIED *' SAY '* TO HANDLE THIS NEW CONDITION. FOLLOWING ARE *' SAY '* THE 1ST 9 VOLSER''S IN QUESTION. THE JCL WILL *' SAY '* REFER TO THE FIRST ONE. *' SAY '**************************************************' SAY VOL.1 SAY VOL.2 SAY VOL.3 SAY VOL.4 SAY VOL.5 SAY VOL.6 SAY VOL.7 SAY VOL.8 SAY VOL.9 EXIT END DO V = 1 TO 9 IF STRIP(VOL.V) > '' THEN IF POS(STRIP(VOL.V),DSVOLSER) = 0 THEN DSVOLSER = DSVOLSER','VOL.V END END; IF SAVEVOL ¬= DSVOLSER THEN DO "CHANGE ALL 'SER="SAVEVOL"' 'SER=("DSVOLSER")'" "LINE_BEFORE .ZF = MSGLINE 'CHANGED "SAVEVOL" TO "DSVOLSER"'" "FIND FIRST P'=' .VOL .VOL" END "FIND NEXT '//DD1 ' 1" END ADDRESS ISPEXEC "LIBDEF ISPLLIB" "FIND FIRST P'='" EXIT ./ ADD NAME=FIX2DATE /* rexx ***************************************************************/ /* */ /**********************************************************************/ address ispexec "control errors return" "libdef isptabl" "libdef isptabl dataset id('syst.ispf.isptlib')" "tbopen techdocs write" "tbtop techdocs" x = 0 "tbskip techdocs" do while rc = 0 x = x + 1 if tntag > '' then do yy = substr(tntag,1,2) cc = 19 if yy = 20 then cc = '' if yy = 19 then cc = '' tntag = cc ³³ tntag end yy = substr(ludate,1,2) cc = 19 if yy = 20 then cc = '' if yy = 19 then cc = '' ludate = cc ³³ ludate if x // 50 = 0 then say "updated" x "rows" "tbput techdocs" "tbskip techdocs" end "tbclose techdocs newcopy library(isptabl)" "libdef isptabl" ./ ADD NAME=FLOW ISREDIT MACRO NOPROCESS (OPT1) ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT IF &OPT1 = HELP THEN GOTO HELPSEC /********************************************************************** /* UTILITY: FLOW * /* AUTHOR: DAVID LEIGH * /* FUCTION: INDENT AND "TFLOW" A PARAGRAPH TO THE POINT WHERE THE * /* CURSOR IS. * /********************************************************************** /********************************************************************** /* PARSE THE CURRENT SITUATION AND DO THE INITIAL FLOW. * /********************************************************************** ISREDIT (SLINE,SCOL) = CURSOR ISREDIT FIND FIRST P'¬' .ZCSR .ZCSR ISREDIT (LN,CL) = CURSOR ISREDIT LABEL .ZCSR = .CURR IF &DATATYPE(&OPT1) = NUM THEN + SET LRECL = &OPT1 ELSE + IF &STR(&OPT1) = DISPLAY THEN + ISREDIT (NULL,LRECL) = DISPLAY_COLS ELSE + ISREDIT (LRECL) = LRECL ISREDIT TFLOW .ZCSR &EVAL(&LRECL - &SCOL + 1) ISREDIT (X,Y) = FLOW_COUNTS /********************************************************************** /* LOOP THROUGH AND DO THE SHIFTS. * /********************************************************************** IF &EVAL(&SCOL - &CL) > 0 THEN + DO &I = 0 TO &EVAL(&Y - 1) ISREDIT CURSOR = &EVAL(&SLINE + &I) 1 ISREDIT SHIFT ) .ZCSR &EVAL(&SCOL - &CL) END /********************************************************************** /* RETURN TO THE ORIGINAL CURSOR POSITION * /********************************************************************** ISREDIT CURSOR = &SLINE &SCOL ISREDIT TFLOW .ZCSR &LRECL EXIT HELPSEC: + 02480000 ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) 02490000 SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR FLOW UTILITY + 02490000 *** NO PROCESSING PERFORMED ***) 02490000 ISPEXEC SETMSG MSG(UTLZ000) 02490000 EXIT ./ ADD NAME=FLOWFILE /********************************************************************** /* MACRO: FLOWFILE * /* AUTHOR: DAVID LEIGH * /* FUNCTION: THIS EDIT MACRO DOES A TEXT FLOW OF A EVERY PARAGRAPH IN * /* A WHOLE FILE. IN DEFAULT MODE IT FLOWS THE WHOLE FILE * /* FROM THE FIRST NON-BLANK COLUMN OF ANY LINE TO THE LRECL * /* OF THE FILE. IF THE SHARED POOL VARIABLE OF EXECTYPE * /* IS EQUAL TO "BATCH", IT WILL TRY TO VGET THE VARIABLES * /* BEGINCOL AND ENDCOL. IT WILL USE EITHER OR BOTH OF THESE* /* TO FLOW THE FILE TO THOSE LEFT AND RIGHT BOUNDRIES. * /* IF EXECTYPE IS BATCH, IT WILL ALSO ISSUE AN ISREDIT END * /* WHEN THE EDITING IS FINISHED. * /********************************************************************** ISREDIT MACRO ISPEXEC CONTROL ERRORS RETURN /**** 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 SET UTILLOG = NO ISPEXEC VPUT UTILLOG SHARED ISREDIT (DSN) = DATASET ISREDIT (MBR) = MEMBER IF &STR(&MBR) > THEN SET DSN = &STR(&DSN(&MBR)) ISPEXEC VGET EXECTYPE SHARED IF &STR(&EXECTYPE) = BATCH THEN + ISPEXEC VGET (BEGINCOL ENDCOL MSGINCR) SHARED IF &STR(&MSGINCR) = THEN SET MSGINCR = 10 ISREDIT FIND FIRST P'.' DO WHILE &LASTCC = 0 ISREDIT (LN,CL) = CURSOR IF &EVAL(&LN//&MSGINCR) = 0 THEN + WRITE &STR("&DSN" *** WORKING ON LINE &LN) IF &STR(&BEGINCOL) > 0 THEN + ISREDIT FIND FIRST P'=' &BEGINCOL .ZCSR .ZCSR ISREDIT %FLOW &ENDCOL ISREDIT FIND LAST P'.' .ZCSR .ZCSR ISREDIT FIND NEXT P'.' END IF &STR(&EXECTYPE) = BATCH THEN + ISREDIT END ./ ADD NAME=FMTPKSQL /********************************************************************** /* UTILITY: FMTPKSQL * /* AUTHOR: DAVID LEIGH * /* FUNCTION: CLEAN UP CSP PACKAGE SQL AND REFORMAT IT. * /* * /* * /* * /********************************************************************** ISREDIT MACRO ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ISREDIT CHANGE ' ' '' 12 ALL ISREDIT FIND FIRST P'###' 8 DO WHILE &LASTCC = 0 ISREDIT TFLOW .ZCSR 72 ISREDIT FIND NEXT P'###' 8 END ISREDIT FIND ':EZESQL' FIRST DO WHILE &LASTCC = 0 ISREDIT (LN1,CL1) = CURSOR ISREDIT FIND NEXT ' ' .ZCSR .ZCSR ISREDIT (LN2,CL2) = CURSOR SET EQUALS = DO &I = 1 TO &EVAL(&CL2 - &CL1) SET EQUALS = &STR(=&EQUALS) END ISREDIT CHANGE P'&STR(&EQUALS)' '?' FIRST &CL1 .ZCSR .ZCSR ISREDIT CURSOR = &LN1 &CL1 ISREDIT FIND ':EZESQL' NEXT END ISREDIT CHANGE ALL '? ?' '?' WRITE &STR(CLEAR THE DECLARES) ISREDIT FIND FIRST ' DECLARE ' DO WHILE &LASTCC = 0 ISREDIT FIND NEXT P'.' .ZCSR .ZCSR ISREDIT (LN1,CL1) = CURSOR ISREDIT FIND NEXT 'FOR SELECT' .ZCSR .ZCSR ISREDIT FIND NEXT ' ' .ZCSR .ZCSR ISREDIT (LN2,CL2) = CURSOR ISREDIT CHANGE P'=' '' &CL1 &CL2 ALL .ZCSR .ZCSR ISREDIT FIND NEXT ' DECLARE ' END WRITE &STR(FLOW THE SELECTS AND FROMS) ISREDIT FIND FIRST ' SELECT ' DO WHILE &LASTCC = 0 ISREDIT LABEL .ZCSR = .A ISREDIT FIND NEXT P'.' .ZCSR .ZCSR ISREDIT FIND NEXT ' ' .ZCSR .ZCSR ISREDIT (LN1,CL1) = CURSOR ISREDIT TFLOW .ZCSR &EVAL(&CL1 + 1) ISREDIT FIND FIRST P'=' 1 .A .A ISREDIT FIND NEXT P'=' 1 ISREDIT LABEL .ZCSR = .A ISREDIT FIND NEXT ' FROM ' ISREDIT FIND NEXT P'.' .ZCSR .ZCSR ISREDIT FIND NEXT ' ' .ZCSR .ZCSR ISREDIT (LN1,CL1) = CURSOR ISREDIT TFLOW .ZCSR &EVAL(&CL1 + 1) ISREDIT FIND PREV P'=' 1 ISREDIT RFIND ISREDIT LABEL .ZCSR = .B ISREDIT FIND FIRST P'=' 1 .A .B DO WHILE &LASTCC = 0 ISREDIT SHIFT ) .ZCSR 7 ISREDIT FIND NEXT P'=' 1 .A .B END ISREDIT FIND NEXT ' SELECT ' END WRITE &STR(SHIFT THE FROMS AND FLOW THE WHERES) ISREDIT FIND FIRST ' FROM ' DO WHILE &LASTCC = 0 ISREDIT FIND NEXT P'=' 1 DO WHILE &LASTCC = 0 ISREDIT (SYSDVAL) = LINE .ZCSR READDVAL VALUE NULL IF &STR(&VALUE) = WHERE THEN GOTO CONTINUE1 ISREDIT SHIFT ) .ZCSR 5 ISREDIT FIND NEXT P'=' 1 END CONTINUE1: + ISREDIT FIND NEXT ' FROM ' END WRITE &STR(SHIFT THE WHERES) ISREDIT FIND FIRST ' WHERE ' DO WHILE &LASTCC = 0 ISREDIT FIND NEXT P'=' 1 ISREDIT LABEL .ZCSR = .A ISREDIT FIND NEXT ' SELECT ' IF &LASTCC = 0 THEN + DO SET B = &STR(.B) ISREDIT FIND PREV P'=' 1 ISREDIT RFIND ISREDIT LABEL .ZCSR = .B END ELSE + SET B = &STR(.ZL) ISREDIT FIND FIRST P'=' 1 .A &STR(&B) DO WHILE &LASTCC = 0 ISREDIT SHIFT ) .ZCSR 6 ISREDIT FIND NEXT P'=' 1 .A &STR(&B) END ISREDIT FIND NEXT ' WHERE ' END WRITE &STR(FLOW THE INDIVIDUAL SECTIONS) ISREDIT FIND FIRST ' SELECT ' DO WHILE &LASTCC = 0 ISREDIT TFLOW .ZCSR 72 ISREDIT FIND NEXT ' SELECT ' END ISREDIT FIND FIRST ' FROM ' DO WHILE &LASTCC = 0 ISREDIT TFLOW .ZCSR 72 ISREDIT FIND NEXT ' FROM ' END ISREDIT FIND FIRST ' WHERE ' DO WHILE &LASTCC = 0 ISREDIT TFLOW .ZCSR 72 ISREDIT FIND NEXT ' WHERE ' END ISREDIT CHANGE '? ?' '?' ALL ./ ADD NAME=FMTSQL /* REXX ***************************************************************/ /* */ /**********************************************************************/ ADDRESS ISPEXEC 'CONTROL ERRORS RETURN' ADDRESS ISREDIT "MACRO" "FIND FIRST P'=' 1" DO WHILE RC = 0 "SHIFT < .ZCSR 80" "FIND NEXT P'=' 1" END LOOP = 0 "CHANGE ALL ' . ' '.' 2 80" DO WHILE RC = 0 LOOP = LOOP + 1 IF LOOP > 1000 THEN LEAVE "TFLOW .ZFIRST 70" "CHANGE ALL ' . ' '.' 2 80" END LOOP = 0 "CHANGE ALL '. ' '.'" DO WHILE RC = 0 LOOP = LOOP + 1 IF LOOP > 1000 THEN LEAVE "TFLOW .ZFIRST 70" "CHANGE ALL '. ' '.'" END LOOP = 0 "CHANGE ALL ' .' '.' 2 80" DO WHILE RC = 0 LOOP = LOOP + 1 IF LOOP > 1000 THEN LEAVE "TFLOW .ZFIRST 70" "CHANGE ALL ' .' '.' 2 80" END EXIT ./ ADD NAME=FNDSSNSH PROC 0 SSN() MODE(PPROD.STR.BATCH) HELP /********************************************************************** /* DISPLAY HELP IF REQUESTED * /********************************************************************** IF &HELP = HELP THEN GOTO HELPSEC IF &SYSISPF ¬= ACTIVE THEN SET &TYPE = NONISPF IF &TYPE = NONISPF AND &SSN = THEN + DO WRITE NO SSN ENTERED WRITE THE PROPER FORMAT OF THE INSTRUCTION IS: WRITE FNDSSNSH SSN(123456789) WRITE *** GOTO EXIT END IF &SYSISPF = ACTIVE THEN + IF &SYSISPF = ACTIVE THEN + ISPEXEC VGET DBGSWTCH PROFILE IF &DBGSWTCH = ON THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT IF &TYPE = NONISPF THEN + GOTO FINDSH IF &SSN ¬= THEN + DO SET &TYPE = CLIST GOTO FINDSH END REDISPLAY: + IF &TYPE = CLIST THEN GOTO EXIT IF &TYPE = NONISPF THEN + GOTO EXIT ELSE + ISPEXEC DISPLAY PANEL(FNDSSNSH) /*------------------------------------------------------* /* CHECK FOR PF3/PF15 TO END CLIST WITHOUT PROCESSING * /*------------------------------------------------------* IF &LASTCC = 8 THEN + DO FREE F(SYSOUD) GOTO EXIT END IF &LASTCC > 8 THEN + DO SET ZEDSMSG = &STR(Panel Error) ISPEXEC SETMSG MSG(UTLZ001) GOTO REDISPLAY END /*END-IF. /*-------------------------------------------------------* /* ENSURE THAT SPECIFIED TEST DATASET AND TABLE EXIST * /*-------------------------------------------------------* /* /* FINDSH: + FREE F(SYSOUD) ALLOC F(SYSOUD) DUMMY /*ALLOC F(SYSOUD) SYSOUT(X) CALL '&MODE..LOADLIB(SLS6304)' '&SSN.' SET &RETURN = &LASTCC IF &RETURN = 1 THEN + DO IF &TYPE = NONISPF THEN + WRITE &SSN ON SERVHSTA ELSE + DO SET ZEDSMSG = &STR(&SSN on servhsta ) ISPEXEC SETMSG MSG(UTLZ001) SET SHFILE = &STR(SERVHSTA ) GOTO REDISPLAY END END IF &RETURN = 2 THEN + DO IF &TYPE = NONISPF THEN + WRITE &SSN ON SERVHSTB ELSE + DO SET ZEDSMSG = &STR(&SSN on servhstb ) ISPEXEC SETMSG MSG(UTLZ001) SET SHFILE = &STR(SERVHSTB ) GOTO REDISPLAY END END IF &RETURN = 3 THEN + DO IF &TYPE = NONISPF THEN + WRITE &SSN ON SERVHSTC ELSE + DO SET ZEDSMSG = &STR(&SSN on servhstc ) ISPEXEC SETMSG MSG(UTLZ001) SET SHFILE = &STR(SERVHSTC ) GOTO REDISPLAY END END IF &RETURN = 4 THEN + DO IF &TYPE = NONISPF THEN + WRITE &SSN ON SERVHSTD ELSE + DO SET ZEDSMSG = &STR(&SSN on servhstd ) ISPEXEC SETMSG MSG(UTLZ001) SET SHFILE = &STR(SERVHSTD ) GOTO REDISPLAY END END IF &RETURN = 5 THEN + DO IF &TYPE = NONISPF THEN + WRITE &SSN ON SERVHSTE ELSE + DO SET ZEDSMSG = &STR(&SSN on servhste ) ISPEXEC SETMSG MSG(UTLZ001) SET SHFILE = &STR(SERVHSTE ) GOTO REDISPLAY END END IF &TYPE = NONISPF THEN + WRITE &SSN not found ELSE + DO SET ZEDSMSG = &STR(&SSN not found) ISPEXEC SETMSG MSG(UTLZ001) SET SHFILE = &STR() GOTO REDISPLAY END EXIT: + IF &TYPE ¬= NONISPF THEN + FREE F(SYSOUD) EXIT /********************************************************************** /* DISPLAY ANY "HELP" WHICH IS AVAILABLE FOR THIS UTILITY * /********************************************************************** HELPSEC: + ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR FNDSSNSH UTILITY + *** NO PROCESSING PERFORMED ***) ISPEXEC SETMSG MSG(UTLZ000) EXIT ./ ADD NAME=FORCE /* REXX ***************************************************************/ /* UTILITY: FORCE */ /* AUTHOR: DAVID LEIGH */ /* FUNCTION: THIS REXX PROGRAM STRIPS OFF THE HEADER LINES AND THE */ /* TRAILER LINE WHICH ISQL PUTS INTO IT'S BATCH OUTPUT SO */ /* THAT THE RESULTING FILE IS ONLY THE DATA. */ /**********************************************************************/ TRACE I "EXECIO * DISKR INPUTDD (FINIS STEM RECIN." "NEWSTACK" DO I = 1 TO RECIN.0 PARSE VAR RECIN.I 21 USERID 29 LINE = ' -DISPLAY DATABASE(' || STRIP(USERID) || , 'DB) SPACENAM(*) RESTRICT LIMIT(*)' QUEUE LINE END RECOUT = QUEUED() "EXECIO" RECOUT "DISKW OUTPUTDD (FINIS" ./ ADD NAME=FORMAT ISREDIT MACRO ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT SET ZEDLMSG = &STR(*** COPYRIGHT ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000) ISREDIT CHANGE ALL P'.' ' ' ISREDIT FIND FIRST 'THIS DOCUMENT IS THE PROPERTY OF' IF &LASTCC = 0 THEN + DO ISREDIT LABEL .ZCSR = .A SET A = YES END ISREDIT FIND FIRST 'RIGHTS RESERVED' IF &LASTCC = 0 THEN + DO ISREDIT LABEL .ZCSR = .B SET B = YES END IF &A = YES AND &B = YES THEN + DO ISREDIT DELETE .A .B ISREDIT COPY COPYRITE BEFORE .ZCSR END SET ZEDLMSG = &STR(*** SHIFTING ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000) ISREDIT (NBR) = LINENUM .ZLAST DO &I = 1 TO &NBR ISREDIT SHIFT ) &I 1 IF &EVAL(&I//100) = 0 THEN + DO SET ZEDLMSG = &STR(*** SHIFTED &I OF &NBR ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000) END END SET ZEDLMSG = &STR(*** PAGINATE ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000) ISREDIT FIND FIRST ' PAGE ' DO WHILE &LASTCC = 0 ISREDIT (LINE) = LINE .ZCSR IF &SYSINDEX(&STR(UNIPAC),&STR(&SYSNSUB(1,&LINE))) > 0 THEN + ISREDIT CHANGE NEXT ' ' '1' 1 ISREDIT FIND NEXT ' PAGE ' END ./ ADD NAME=FREEPACK /* REXX ***************************************************************/ /* UTILITY: FREEPACK */ /* AUTHOR: DAVID LEIGH */ /* FUNCTION: FREE PACK IS PASSED A PROGRAM NAME WHICH HAS JUST BEEN */ /* COMMITTED IN PRODUCTION. IT LOOKS FOR ALL THE DBRMS IN */ /* OUR STANDARD DBRMLIBS IN THE PRODUCTION SUBSYSTEM. IT */ /* THEN READS EACH ONE TO FIND THE CONSISTANCY TOKEN AND */ /* VERSION STRING. THE GROUP OF CONSISTANCY TOKENS AND */ /* VERSION STRINGS FROM THESE LIBRARIES REPRESENT THE LIST */ /* OF VALID PACKAGES. THE REMAINING SET ARE THE ONES THAT */ /* NEED TO BE FREED. */ /**********************************************************************/ /**********************************************************************/ /* CHECK TO SEE THAT A PROGRAM NAME TO PROCESS WAS PASSED */ /**********************************************************************/ ARG PROGRAM SSID IF PROGRAM = '' THEN DO SAY 'NO PROGRAM NAME PASSED!' EXIT 12 END PROGRAM = STRIP(PROGRAM) IF SSID = '' THEN SSID = 'DSNP' SAY '*******************************' SAY 'PROCESSING PROGRAM:' PROGRAM SAY 'DB2 SUBSYSTEM: ' SSID SAY 'DATE: ' DATE() SAY 'START TIME: ' TIME() SAY '*******************************' /**********************************************************************/ /* WRITE OUT "SRCHFOR" SELECT STATEMENT */ /**********************************************************************/ NEWSTACK QUEUE 'SELECT' PROGRAM "EXECIO" QUEUED() "DISKW FREESEL (FINIS)" /**********************************************************************/ /* DO A LISTCAT TO FIND ALL THE DBRMLIB PDS'S THAT WE NEED TO CHECK */ /* FOR DBRMS IN. */ /**********************************************************************/ ADDRESS TSO X = OUTTRAP('DBRMCNTL.') /***********************************/ "LISTCAT LEVEL('MMODO.*.DBRMLIB')" /* UPDATE THIS LIST OF DBRMLIBS */ "LISTCAT LEVEL('PPROD.*.DBRMLIB')" /* IF NEW STAGES ARE ADDED. */ "LISTCAT LEVEL('PEMER.*.DBRMLIB')" /* */ /***********************************/ X = OUTTRAP('OFF') /**********************************************************************/ /* NOW PARSE THE LISTCAT OUTPUT FOR JUST THE PDS NAMES */ /**********************************************************************/ J = 0 DO I = 1 TO DBRMCNTL.0 IF POS('NONVSAM',DBRMCNTL.I) = 1 THEN DO J = J + 1 PARSE UPPER VAR DBRMCNTL.I NULL1 NULL2 DBRMCNTL.J NULL3 DBRMCNTL.J = STRIP(DBRMCNTL.J) END END NBRLIB = J /**********************************************************************/ /* NOW CHECK IN THE DBRMLIBS FOR MEMBERS WITH THE SAME NAME AS THE */ /* PASSED IN PROGRAM AND THEN EXTRACT THE CONSISTANCY TOKEN AND */ /* VERSION STRING FROM THE FIRST TWO LINES OF THE DBRM MEMBER. PUT */ /* THAT IN A SET OF STEM ARRAYS FOR LATER USE. */ /**********************************************************************/ J = 0 LOWVER = '9999999999999999999999999999999999999999999999999999999999999' ADDRESS TSO DUMMY = OUTTRAP('NULL.') "FREE DD(DBRMLIB)" DO I = 1 TO NBRLIB DBRMCNTL.I = STRIP(DBRMCNTL.I) /*** CHECK DBRM MEMBERS IDENTICAL TO THE PROGRAM NAME ***/ IF SYSDSN("'"DBRMCNTL.I"("PROGRAM")'") = OK THEN DO J = J + 1 "ALLOCATE DD(DBRMLIB) DSN('"DBRMCNTL.I"("PROGRAM")') SHR REUSE" "EXECIO 2 DISKR DBRMLIB (STEM DBRMLIB. FINIS)" DBRMTOKN.J = C2X(SUBSTR(DBRMLIB.1,25,8)) DBRMPGM.J = STRIP(SUBSTR(DBRMLIB.1,17,8)) DBRMVER.J = STRIP(SUBSTR(DBRMLIB.2,3,64)) IF DBRMVER.J < LOWVER THEN LOWVER = DBRMVER.J END /*** CHECK MEMBERS WITH PROGRAM NAME PLUS "#" PREFIX ***/ IF SYSDSN("'"DBRMCNTL.I"(#"PROGRAM")'") = OK THEN DO J = J + 1 "ALLOCATE DD(DBRMLIB) DSN('"DBRMCNTL.I"(#"PROGRAM")') SHR REUSE" "EXECIO 2 DISKR DBRMLIB (STEM DBRMLIB. FINIS)" DBRMTOKN.J = C2X(SUBSTR(DBRMLIB.1,25,8)) DBRMPGM.J = STRIP(SUBSTR(DBRMLIB.1,17,8)) DBRMVER.J = STRIP(SUBSTR(DBRMLIB.2,3,64)) IF DBRMVER.J < LOWVER THEN LOWVER = DBRMVER.J END /*** CHECK MEMBERS WITH PROGRAM NAME PLUS "$" PREFIX ***/ IF SYSDSN("'"DBRMCNTL.I"($"PROGRAM")'") = OK THEN DO J = J + 1 "ALLOCATE DD(DBRMLIB) DSN('"DBRMCNTL.I"($"PROGRAM")') SHR REUSE" "EXECIO 2 DISKR DBRMLIB (STEM DBRMLIB. FINIS)" DBRMTOKN.J = C2X(SUBSTR(DBRMLIB.1,25,8)) DBRMPGM.J = STRIP(SUBSTR(DBRMLIB.1,17,8)) DBRMVER.J = STRIP(SUBSTR(DBRMLIB.2,3,64)) IF DBRMVER.J < LOWVER THEN LOWVER = DBRMVER.J END END "FREE DD(DBRMLIB)" DROP NULL. /**********************************************************************/ /* QUERY SYSIBM.SYSPACKAGE FOR THE PASSED IN PROGRAM TO FIND ALL THE */ /* INSTANCES OF THIS PROGRAM. THIS WILL PASSED ON TO COMPARE WITH */ /* THE DBRMLIB DATA. */ /**********************************************************************/ "NEWSTACK" QUEUE "SELECT A.NAME," QUEUE " A.COLLID," QUEUE " HEX(A.CONTOKEN)," QUEUE " A.VERSION" QUEUE "FROM SYSIBM.SYSPACKAGE A" QUEUE "WHERE A.NAME = '"PROGRAM"'" QUEUE "AND (A.COLLID LIKE '%STR%'" QUEUE " OR A.COLLID LIKE '%ELM%')" QUEUE "ORDER BY VERSION DESC;" "EXECIO" QUEUED() "DISKW SYSIN (FINIS)" QUEUE "RUN PROGRAM(DSNTIAUL) PLAN(DSNTIAUL) PARM('SQL')" QUEUE "END" "DSN SYSTEM("SSID")" /**********************************************************************/ /* NOW READ THE OUTPUT FROM THE SELECT AGAINST THE SYSPACKAGES IN THE */ /* DB2 CATALOG FOR THE PASSED IN PROGRAM. */ /**********************************************************************/ NBRDBRM = J SYNCNBR = 0 ADDRESS TSO "NEWSTACK" QUEUE '--' QUEUE '-- FREE PACKAGES FOR PROGRAM:' PROGRAM QUEUE '--' "EXECIO * DISKR SYSREC00 (STEM DB2PACK. FINIS)" /**********************************************************************/ /* NOW LOOP THROUGH THE DB2 INFORMATION AND CHECK IT AGAINST THE */ /* VERSION AND CONSISTANCY TOKEN INFORMATION LISTED IN THE DBRM STEM */ /* ARRAYS. THAT WHICH MATCHES WHAT IS IN THE DBRM STEM ARRAYS ARE */ /* PACKAGES WHICH MUST BE KEPT. OTHERWISE THE PACKAGE MAY BE FREED. */ /* */ /* NOTE: THE VERSION STRING MUST BE NOT EQUAL AND LESS THAN ONE OF */ /* THE DBRM STRINGS TO BE ELIGIBLE TO BE FREED. THIS SHOULD */ /* PROTECT US FROM DELETING NEW STUFF IN THE TRAINING ENVIRON- */ /* MENT THAT IS THERE ON PURPOSE FOR AN EXCEPTION SITUATION. */ /**********************************************************************/ KEEPTOK. = '' FREETOK. = '' K = 0 F = 0 DUMMY = OUTTRAP('NULL.') DO I = 1 TO DB2PACK.0 /*** PUT THE INPUT LINE INTO VARIOUS VARIABLES ***/ DB2PACK.I = TRANSLATE(DB2PACK.I,' ','00'X) DB2PACK.I = STRIP(DB2PACK.I) PARSE UPPER VAR DB2PACK.I DB2PGM 9 COLLID 27 DB2TOKEN 43 45 DB2VER DB2PGM = STRIP(DB2PGM) COLLID = STRIP(COLLID) DB2TOKEN = STRIP(DB2TOKEN) DB2TOKA = SUBSTR(DB2TOKEN,1,8) DB2TOKB = SUBSTR(DB2TOKEN,9,8) DB2VER = STRIP(DB2VER) /*** SAVE THE CONSISTANCY TOKEN WHEN IT CHANGES ***/ IF DB2TOKA ¬= SAVETOKA |, DB2TOKB ¬= SAVETOKB THEN DO SAVETOKA = DB2TOKA SAVETOKB = DB2TOKB TOKBREAK = 'YES' END KEEP = 'NO' /*** IDENTIFY VERSIONS TO KEEP BASED ON DBRM VERSIONS ***/ DO Q = 1 TO NBRDBRM IF DB2TOKEN = DBRMTOKN.Q &, DB2VER = DBRMVER.Q THEN KEEP = 'YES' END /*** ALSO KEEP VERSIONS THAT ARE "NEWER" BUT NOT IN THE DBRM LIST ***/ IF KEEP = 'NO' AND DB2VER > LOWVER THEN KEEP = 'YES' /*** IF WE'RE KEEPING THIS ONE, WRITE OUT KEEP COMMENT LINES ***/ IF KEEP = 'YES' THEN DO IF TOKBREAK = 'YES' THEN DO TOKBREAK = 'NO' K = K + 1 KEEPTOK.K = "SRCHFOR X'"SAVETOKA"'" K = K + 1 KEEPTOK.K = "SRCHFORC X'"SAVETOKB"'" END QUEUE '-- KEEP PACKAGE:' COLLID QUEUE '-- TOK/VER:' DB2TOKEN'/'DB2VER QUEUE '--' END ELSE /*** OTHERWISE WRITE OUT THE "FREE" LINES ***/ DO IF TOKBREAK = 'YES' THEN DO TOKBREAK = 'NO' F = F + 1 FREETOK.F = "SRCHFOR X'"SAVETOKA"'" F = F + 1 FREETOK.F = "SRCHFORC X'"SAVETOKB"'" END SYNCNBR = SYNCNBR + 5 QUEUE '-- TOK/VER:' DB2TOKEN'/'DB2VER QUEUE '.CALL DSN PARM('SSID')' QUEUE '.DATA' QUEUE 'FREE PACKAGE('COLLID'.'DB2PGM'.-' QUEUE '('DB2VER'));' QUEUE '.ENDDATA' QUEUE '.SYNC' SYNCNBR QUEUE ' ' END END /**********************************************************************/ /* WRITE OUT ALL THE OUTPUT FILES. */ /**********************************************************************/ "EXECIO" QUEUED() "DISKW FREEPACK (FINIS)" "EXECIO * DISKW FREESRCH (STEM FREETOK. FINIS)" "EXECIO * DISKW KEEPSRCH (STEM KEEPTOK. FINIS)" EXIT ./ ADD NAME=FTP 000100 /*****************************************************************REXX*/ 000200 /* */ 000300 /* MODULE NAME = FTP */ 000400 /* */ 000500 /* DESCRIPTIVE NAME = FTP EDIT Macro for ISPF/PDF */ 000600 /* */ 000700 /* STATUS = R102 */ 000800 /* */ 000900 /* FUNCTION = The FTP EDIT macro is used to transmit a copy of the */ 001000 /* data currently being edited to a remote host using */ 001100 /* text-mode FTP. This EDIT macro is useful to transmit */ 001200 /* data that does not exist on disk in a transmittable */ 001300 /* form, such as packed data, data modified during the */ 001400 /* current EDIT session, or data only accessible via the */ 001500 /* EDIT Interface (EDIF). */ 001600 /* */ 001700 /* AUTHOR = Gilbert Saint-flour */ 001800 /* */ 001900 /* Dependencies = TSO/E V2 */ 002000 /* ISPF/PDF V3 or ISPF V4 */ 002100 /* TCP/IP V3 */ 002200 /* ROUTEPGM utility R605 (optional) */ 002300 /* FASTPATH utility R128 (optional) */ 002400 /* */ 002500 /* SYNTAX = FTP */ 002600 /* host remote host or IP address */ 002700 /* userid userid to use */ 002800 /* (default: anonymous) */ 002900 /* password password for userid */ 003000 /* dir directory to change to */ 003100 /* */ 003200 /* OPERATION = see below */ 003300 /* */ 003400 /* FTP creates a temporary data set, copies the data into */ 003500 /* into it, then creates the control data set and issues */ 003600 /* the TCP/IP FTP command. */ 003700 /* */ 003800 /* CHANGES = see below */ 003900 /* */ 004000 /* $100 New packaging for the CBT tape */ 004100 /* $101 added userid/password and dir options - Lionel Dyck */ 004200 /* $102 Replace EXECIO with ROUTEPGM */ 004300 /* */ 004400 /**********************************************************************/ 004500 Routepgm='NO' /* Use the REXX stack and EXECIO */ 004600 Routepgm='YES' /* Use the ROUTEPGM program */ 004700 FastPath='NO' /* Invoke the FTP command directly */ 004800 FastPath='YES' /* Invoke FTP via the FASTPATH utility */ 004900 /* -------------------------- */ 005000 /* Allocate Tempftp file */ 005100 /* -------------------------- */ 005200 ftpdsn='tempftp.text' 005300 RC=LISTDSI(ftpdsn 'NORECALL') 005400 IF RC>0 THEN DO 005500 IF RC=16 & SYSREASON=9 THEN 005600 "HDELETE" ftpdsn "WAIT" 005700 "ALLOC DS("ftpdsn") NEW CATALOG", 005800 "TRACKS SPACE(10 10) UNIT(SYSALLDA)", 005900 "DSORG(PS) RECFM(V B) LRECL(255)" 006000 "FREE DS("ftpdsn")" 006100 END 006200 RC=LISTDSI('TEMPFTP' 'FILE') 006300 IF RC>0 THEN 006400 "ALLOC DD(TEMPFTP) DS("ftpdsn") OLD DELETE" 006500 /* -------------------------------- */ 006600 /* Retrieve ISPF variables */ 006700 /* -------------------------------- */ 006800 ADDRESS 'ISPEXEC' 006900 "CONTROL ERRORS RETURN" 007000 "ISREDIT MACRO (HOST)"; IF rc>0 THEN EXIT rc 007100 IF host='' THEN EXIT 12 007200 "VGET (ZTEMPF ZTEMPN)" 007300 /* -------------------------------- */ 007400 /* Write the text to tempftp.userid */ 007500 /* -------------------------------- */ 007600 IF Routepgm='YES' THEN 007700 "SELECT PGM(ROUTEPGM) PARM(TEMPFTP)" 007800 ELSE DO 007900 DO I=1 BY 1 008000 "ISREDIT (LINE) = LINE" I /* GET CURRENT LINE */ 008100 IF RC>0 THEN LEAVE 008200 IF line='' THEN 008300 QUEUE ' ' /* blank line */ 008400 ELSE 008500 QUEUE STRIP(line,'T') 008600 END 008700 QUEUE '' 008800 ADDRESS 'TSO' "EXECIO * DISKW TEMPFTP (FINIS" 008900 END 009000 /**********************************************************************/ 009100 /* */ 009200 /* Build the FTP control statements */ 009300 /* */ 009400 /**********************************************************************/ 009500 ADDRESS 'TSO' 009600 /* -------------------------- */ 009700 /* Clear out variables */ 009800 /* -------------------------- */ 009900 parse value "" with userid password dir 010000 010100 /* -------------------------- */ 010200 /* test for userid/password */ 010300 /* -------------------------- */ 010400 if words(host) > 1 then 010500 parse value host with host userid password dir . 010600 010700 QUEUE host 010800 010900 /* -------------------------- */ 011000 /* if userid then use it */ 011100 /* -------------------------- */ 011200 if length(userid) > 0 then 011300 QUEUE userid password 011400 else 011500 QUEUE 'anonymous' 011600 011700 /* -------------------------- */ 011800 /* test for dir */ 011900 /* -------------------------- */ 012000 if length(dir) > 0 then 012100 QUEUE 'cd' dir 012200 012300 /* -------------------------- */ 012400 /* queue out put command */ 012500 /* -------------------------- */ 012600 QUEUE 'put' ftpdsn 'tempftp.'userid() 012700 QUEUE 'quit' 012800 QUEUE '' 012900 "EXECIO * DISKW" ZTEMPN "(FINIS" 013000 /**********************************************************************/ 013100 /* */ 013200 /* Invoke the FTP client program */ 013300 /* */ 013400 /**********************************************************************/ 013500 "ALLOC DD(INPUT) OLD DS('"ZTEMPF"') REUSE" 013600 "ALLOC DD(OUTPUT) DS(*)" 013700 IF FastPath='YES' THEN 013800 "ISPEXEC SELECT PGM(FASTPATH) PARM(EXECPGM,FTP)" 013900 ELSE 014000 "FTP" 014100 "FREE DD(INPUT OUTPUT)" ./ ADD NAME=GCUT 000100 /*************************************************************** REXX */ 000200 /* */ 000300 /* MODULE NAME = CUT */ 000400 /* */ 000500 /* DESCRIPTIVE NAME = CUT EDIT Macro for ISPF/PDF */ 000600 /* */ 000700 /* STATUS = R401 */ 000800 /* */ 000900 /* FUNCTION = Copy the data being edited (or part of it) to a */ 001000 /* clip-board for later retrieval by the PASTE command. */ 001100 /* */ 001200 /* CUT is functionally similar to a CREATE command. */ 001300 /* It is used in conjunction with the PASTE macro. */ 001400 /* */ 001500 /* AUTHOR = Gilbert Saint-flour */ 001600 /* */ 001700 /* SYNTAX = CUT */ 001800 /* clipboard name of the clip board */ 001900 /* first First line .A */ 002000 /* last Last line .B */ 002100 /* */ 002200 /* The clip-board is an optional name, identical in */ 002300 /* syntax to a PDS member name. Each name refers to a */ 002400 /* different clip-board into which the data is stored. */ 002500 /* Clip-boards are managed by the CUTPGM program; they */ 002600 /* are deleted at the end of the TSO session. If no */ 002700 /* clip-board name is specified, the default clip-board */ 002800 /* is used. */ 002900 /* */ 003000 /* When data lines are cut, they replace the previous */ 003100 /* content of the clip-board, except when a + sign is */ 003200 /* specified instead of the name of a clip-board, in */ 003300 /* which case the lines are appended to the data already */ 003400 /* in the default clip-board. */ 003500 /* */ 003600 /* A range may be specified to limit the amount of data */ 003700 /* stored by the CUT macro. The range may be specified */ 003800 /* in the command (e.g. CUT .X .Y) or as a line command */ 003900 /* (e.g C, Cn, CC/CC or M, Mn or MM/MM). If no range is */ 004000 /* specified, the entire data set is copied to the */ 004100 /* clip-board. */ 004200 /* */ 004300 /* The number of lines that can be CUT is limited by the */ 004400 /* size of the clip-board, as set in the variable "blocks"*/ 004500 /* below; a block can hold 4K of data. */ 004600 /* */ 004700 /* The variable "compress" controls how the data is */ 004800 /* stored in a clip-board. If compress=0, no compression */ 004900 /* is performed and an 80-byte line takes up 82 bytes of */ 005000 /* storage. If compress=1, trailing blanks are removed */ 005100 /* before the data is moved to the clip-board. */ 005200 /* If compress=2, the MVS compression-expansion services */ 005300 /* are used to compress strings of redundant characters; */ 005400 /* this reduces paging but consumes extra CPU time, */ 005500 /* particularily when the hardware compression feature */ 005600 /* is not available on the system. */ 005700 /* */ 005800 /* DEPENDENCIES = MVS/ESA 4.2.2 */ 005900 /* TSO/E V2 */ 006000 /* ISPF and ISPF/PDF V3 */ 006100 /* CUTPGM utility program R400 */ 006200 /* */ 006300 /* CHANGE ACTIVITY */ 006400 /* */ 006500 /* $401 Correct various errors when user enters D/DD line commands */ 006600 /* */ 006700 /**********************************************************************/ 006800 ADDRESS ISPEXEC; 'CONTROL ERRORS RETURN';ZERRMSG='' 006900 'ISREDIT MACRO (PARM) NOPROCESS' 007000 IF rc>0 THEN 007100 SIGNAL Not_an_EDIT_macro 007200 007300 IF parm='?' THEN 007400 SIGNAL HELP_panel /* User requested HELP */ 007500 007600 'ISREDIT (LINE2) = LINENUM .ZLAST' /* Last Line */ 007700 IF rc>0 | line2=0 THEN 007800 SIGNAL Empty_dataset /* No lines to cut */ 007900 008000 /*-----------------------------------------------------------------*/ 008100 /* Define Default Parameters */ 008200 /*-----------------------------------------------------------------*/ 008300 008400 compress=0 /* No compression */ 008500 compress=2 /* Use MVS compression svcs */ 008600 compress=1 /* Truncate trailing spaces */ 008700 Cut_Line_Numbers='NO' /* Do NOT cut line numbers */ 008800 Cut_Line_Numbers='YES' /* Cut line numbers */ 008900 blocks=4096 /* clipboard size (4K units)*/ 009000 009100 /*-----------------------------------------------------------------*/ 009200 /* Define variables */ 009300 /*-----------------------------------------------------------------*/ 009400 009500 clipboard='' /* clip-board name */ 009600 append='' /* append/replace */ 009700 range1='' /* first line */ 009800 range2='' /* last line */ 009900 'ISREDIT (LRECL) = LRECL' 010000 010100 CALL Parse_parm /* Analyse the command */ 010200 010300 /*-----------------------------------------------------------------*/ 010400 /* Build the parm for the CUTPGM program, as follows: */ 010500 /* */ 010600 /* parm=Ccccccccc111111aklllll222222bbbbbb */ 010700 /* */ 010800 /* C function=CUT */ 010900 /* cccccccc 8-character clipboard name (or blanks) */ 011000 /* 111111 first line */ 011100 /* a + or blank (append flag) */ 011200 /* k compression level: 0 1 2 */ 011300 /* lllll data set's LRECL */ 011400 /* 222222 last line */ 011500 /* bbbbbb clipboard size in units of 4K blocks */ 011600 /*-----------------------------------------------------------------*/ 011700 011800 parm='C'||LEFT(clipboard,8)||RIGHT(line1,6,'0') 011900 parm=parm||RIGHT(append,1)||compress 012000 parm=parm||RIGHT(lrecl,5,'0')||RIGHT(line2,6,'0')||RIGHT(blocks,6,'0') 012100 012200 /*-----------------------------------------------------------------*/ 012300 /* Invoke the CUTPGM program; check the return code */ 012400 /*-----------------------------------------------------------------*/ 012500 012600 'ISREDIT (NUMMODE,NUMTYPE) = NUMBER' /* Query number mode info */ 012700 IF Nummode='ON' & Cut_Line_Numbers='YES' THEN 012800 'ISREDIT NUMBER = OFF' /* Turn OFF number mode */ 012900 013000 'SELECT PGM(CUTPGM) PARM('parm')'; Pgmrc=rc 013100 013200 'ISREDIT NUMBER =' Nummode /* Turn number mode back ON */ 013300 013400 IF Pgmrc>0 THEN EXIT Pgmrc 013500 013600 /*-----------------------------------------------------------------*/ 013700 /* Delete the lines just cut if user request MOVE */ 013800 /*-----------------------------------------------------------------*/ 013900 014000 IF CMD='M' THEN /* user requested MOVE */ 014100 'ISREDIT DELETE' line1 line2 /* delete lines copied */ 014200 014300 /*-----------------------------------------------------------------*/ 014400 /* Issue completion message and exit */ 014500 /*-----------------------------------------------------------------*/ 014600 014700 i=line2-line1+1 /* count lines copied */ 014800 zedsmsg=i 'lines cut' 014900 IF clipboard='' THEN 015000 zedlmsg=i 'lines have been copied to the default clipboard ' 015100 ELSE 015200 zedlmsg=i 'lines have been copied to clipboard' clipboard 015300 'SETMSG MSG(ISRZ000)' 015400 EXIT 0 015500 /**********************************************************************/ 015600 /* Parse Input Parm, process line commands. */ 015700 /**********************************************************************/ 015800 Parse_parm: 015900 UPPER parm 016000 DO i=1 to WORDS(parm) 016100 p=WORD(parm,i) /* Extract current word */ 016200 IF LEFT(p,1)='.' THEN DO 016300 IF range1='' THEN 016400 range1=p /* First label */ 016500 ELSE DO 016600 IF range2<>'' THEN SIGNAL Bad_clip_board 016700 range2=p /* Second label */ 016800 END 016900 END 017000 ELSE DO 017100 IF clipboard<>'' THEN SIGNAL Invalid_label 017200 IF append<>'' THEN SIGNAL Invalid_label 017300 IF p='+' THEN 017400 append=p 017500 ELSE DO 017600 /* Check the clip-board name for correct syntax. */ 017700 /* A clip-board name must be 1 to 8 characters; */ 017800 /* each character can be numeric (0-9), */ 017900 /* alphabetic (A-Z), or national (@#$). */ 018000 /* Clip-board names are not case-sensitive. */ 018100 IF LENGTH(p)>8 THEN /* name is too long */ 018200 SIGNAL Bad_clip_board 018300 IF VERIFY(p,'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789@#$ ') > 0 THEN 018400 SIGNAL Bad_clip_board /* invalid character */ 018500 clipboard=p 018600 END 018700 END 018800 END 018900 019000 IF range1<>'' & range2='' THEN 019100 SIGNAL Invalid_line_range 019200 019300 /* Check if the user selected a range by entering a line */ 019400 /* command such as C, Cnn, CC/CC or M, Mnn, MM/MM. If it is */ 019500 /* the case, set line1 and line2 to the first and last line */ 019600 /* numbers, respectively. If the user selected a range both */ 019700 /* in the CUT command (such as CUT .X .Y) and in a line */ 019800 /* command, issue an error message. */ 019900 020000 'ISREDIT PROCESS RANGE C M' 020100 SELECT 020200 WHEN rc=0 THEN DO 020300 'ISREDIT (CMD) = RANGE_CMD' /* get C or M */ 020400 IF range1<>'' THEN SIGNAL Command_conflict 020500 "ISREDIT (LINE1) = LINENUM .ZFRANGE" /* First line */ 020600 "ISREDIT (LINE2) = LINENUM .ZLRANGE" /* Last line */ 020700 END 020800 WHEN rc=4 THEN DO 020900 CMD='C' 021000 IF Range1<>'' THEN DO /* CUT .X .Y */ 021100 p=Range1 021200 "ISREDIT (LINE1) = LINENUM" Range1 /* LINENUM .X */ 021300 IF rc>0 THEN SIGNAL Invalid_label 021400 IF Range2='' THEN Range2='.ZLAST' /* DEFAULTS */ 021500 p=Range2 021600 "ISREDIT (LINE2) = LINENUM" Range2 /* LINENUM .Y */ 021700 IF rc>0 THEN SIGNAL Invalid_label 021800 IF Line2'' THEN 023200 'SETMSG MSG('zerrmsg')' /* Edit has created message */ 023300 EXIT Pgmrc 023400 END 023500 END 023600 RETURN 023700 /**********************************************************************/ 023800 /* Exception Routines */ 023900 /**********************************************************************/ 024000 Not_an_EDIT_macro: 024100 Zedsmsg = "EDIT Macro Only" /* Short message */ 024200 Zedlmsg = "CUT may only be invoked as an EDIT macro" 024300 "SETMSG MSG(ISRZ001)" /* send the message */ 024400 EXIT 8 024500 HELP_panel: 024600 'DISPLAY PANEL(CUTHLP1)' /* Display HELP panel */ 024700 IF rc>8 THEN 024800 'SETMSG MSG('zerrmsg')' /* HELP panel is missing */ 024900 EXIT RC 025000 Empty_dataset: 025100 zedsmsg='No lines to cut' 025200 zedlmsg='There are no lines to cut' 025300 'SETMSG MSG(ISRZ001)' 025400 EXIT 12 025500 Invalid_label: 025600 zerrsm='Probable label error' 025700 zerrlm=p 'recognized as invalid or undefined label.' 025800 SIGNAL Beep_msg 025900 Command_conflict: 026000 zerrsm='Command Conflict' 026100 zerrlm='"'cmd'" conflicts with range specification; blank it out.' 026200 SIGNAL Beep_msg 026300 Bad_clip_board: 026400 zerrsm='Invalid clip-board' 026500 zerrlm='The clip-board name must be a valid member name.' 026600 SIGNAL Beep_msg 026700 Invalid_line_range: 026800 zerrsm='Invalid line range' 026900 zerrlm='Only one label was specified, CUT requires two for range.' 027000 SIGNAL Beep_msg 027100 Beep_msg: 027200 zerralrm='YES' /* ALARM=YES */ 027300 zerrhm='CUTHLP1' /* HELP Panel */ 027400 'SETMSG MSG(ISRZ002)' /* Issue error message */ 027500 EXIT 20 ./ ADD NAME=GCUTHLP1 )BODY DEFAULT(%@_) %TUTORIAL -------------------- EDIT - 'CUT' COMMAND ------------------- TUTORIAL %COMMAND ===>_ZCMD @ @ The%CUT@command is used to copy one or more lines of the data being edited to a clip-board from which it can later be retrieved using the%PASTE@ command. The clip-boards are erased when you logoff. To specify the lines to be put into the clip-board, use line commands%C@or %CC@to copy line(s), or%M@or%MM@to move lines, or use%labels@. If you do not specify a line command or labels, then%ALL@of the lines are copied to the clip-board. If you specify a%clip-board@name as part of the command, you can use multiple clip-boards, each of which you can later refer to with the%PASTE@ command. A clip-board names has the same format as a PDS member name. If you specify a + sign instead of a clip-board name, the data is appended to the default clip-board. %COMMAND ===> cut @cuts the lines specified by line @commands to default clip-board. %COMMAND ===> cut 2 .zf .zl @cuts all lines to clip-board 2 )END ./ ADD NAME=GCUTHLP2 %TUTORIAL ------------------ EDIT - 'PASTE' COMMAND ------------------- TUTORIAL %COMMAND ===>_ZCMD + + + The%PASTE+command is used to copy one or more lines of data from a clip-board created by the%CUT+command to the data being edited. To specify where the data is to be copied, use the%A+(after) or%B+(before) line commands or specify%AFTER+or%BEFORE+as a parameter, followed by a%label+ name. %AFTER+and%BEFORE+can be abbreviated%AFT+and%BEF+. If you specify a clip-board name as part of the command, you can refer to any one of the clip-boards that have been created by the%CUT+command. %COMMAND ===> paste +copies the lines from the default +clip-board to a location specified +by a line command. %COMMAND ===> paste 2 before .zf +copies the lines from clip-board 2 +to the line before the first line. )END ./ ADD NAME=GCUTPGM 000100 //IBMUSERC JOB (ACCT#),CUTPGM, 000200 // NOTIFY=&SYSUID, 000300 // CLASS=A,MSGCLASS=X,COND=(0,NE) 000400 //ASMH EXEC PGM=IEV90,PARM=(OBJECT,NODECK,NOESD,NORLD,NOXREF) 000500 *********************************************************************** 000600 * * 000700 * MODULE NAME = CUTPGM * 000800 * * 000900 * DESCRIPTIVE NAME = UTILITY PROGRAM FOR THE CUT & PASTE EDIT MACROS * 001000 * * 001100 * FUNCTION = THIS PGM IS INVOKED BY THE CUT AND PASTE EDIT MACROS * 001200 * TO CREATE AND MAINTAIN CLIP-BOARDS USING DATA SPACES, * 001300 * NAME/TOKEN PAIRS AND COMPRESSION/EXPANSION SERVICES. * 001400 * * 001500 * STATUS = R402 * 001600 * * 001700 * AUTHOR = GILBERT SAINT-FLOUR * 001800 * * 001900 * ENVIRONMENT = SEE BELOW * 002000 * * 002100 * DEPENDENCIES: MVS/ESA 4.2.2 * 002200 * ISPF/PDF V3 * 002300 * CUT & PASTE EDIT MACROS R300 * 002400 * * 002500 * MODULE TYPE = PROCEDURE, (CSECT TYPE) * 002600 * * 002700 * PROCESSOR = IBM OS/ASSEMBLER H VERSION 2 OR * 002800 * IBM HIGH LEVEL ASSEMBLER/MVS * 002900 * * 003000 * MODULE SIZE = 2K * 003100 * * 003200 * ATTRIBUTES = REENTERABLE, RMODE ANY, AMODE 31, * 003300 * PROBLEM STATE, KEY 8 * 003400 * APF AUTHORIZATION: NONE * 003500 * * 003600 * OPERATION = SEE BELOW * 003700 * * 003800 * CUTPGM IS INVOKED BY THE CUT AND PASTE EDIT MACROS AND, * 003900 * DEPENDING ON THE PARM PASSED BY THE INVOKER, PROVIDES THE * 004000 * "CUT", "PASTE" AND "DUMP" FUNCTIONS. * 004100 * * 004200 * 1. "CUT" DEFINES A CLIP-BOARD AND COPIES DATA FROM THE EDIT * 004300 * SESSION TO THE CLIP-BOARD. DATA MAY OR MAY NOT BE * 004400 * COMPRESSED DURING THE COPY PROCESS, BASED ON A PARM OPTION. * 004500 * * 004600 * 2. "PASTE" RETRIEVES DATA FROM THE CLIP-BOARD AND INSERTS IT * 004700 * INTO THE CURRENT EDIT DATA. * 004800 * * 004900 * 3. "DUMP" DISPLAYS THE CONTENTS OF A CLIP-BOARD USING THE * 005000 * "BRIF" SERVICE. THIS FUNCTION IS INTENDED FOR DEBUGGING * 005100 * PURPOSES ONLY. * 005200 * * 005300 * THE PARM FIELD IS USED TO PASS PARAMETERS TO THE PROGRAM. * 005400 * PLEASE REFER TO THE "PARM" DSECT FOR THE FORMAT OF THE * 005500 * PARM FIELD. * 005600 * * 005700 * CLIP-BOARD NAMES HAVE THE SAME FORMAT AS PDS MEMBER NAMES. * 005800 * THE NUMBER OF CLIP-BOARDS IN USE AT A GIVEN TIME IS ONLY * 005900 * LIMITED BY THE SYSTEM. CLIP-BOARDS GET DELETED AT THE END * 006000 * OF THE TSO SESSION (I.E. AT LOGOFF TIME). * 006100 * * 006200 * EACH CLIP-BOARD IS ACTUALLY A DATA SPACE NAMED 'NNNNNCUT', * 006300 * WHERE NNNNN IS A SEQUENCE NUMBER GENERATED BY THE SYSTEM * 006400 * WHEN THE DSPSERV MACRO IS ISSUED TO CREATE A DATA SPACE. * 006500 * * 006600 * THIS PROGRAM USES NAME/TOKEN PAIRS TO RETRIEVE THE STOKEN AND * 006700 * ALET OF THE DATA SPACES IT CREATES. NAME/TOKEN PAIRS IS A * 006800 * FEATURE INTRODUCED IN MVS/ESA 4.2.2. CONSEQUENTLY, THIS * 006900 * PROGRAM WON'T LINK NOR EXECUTE ON MVS SYSTEMS PRIOR TO 4.2.2. * 007000 * * 007100 * TO REDUCE PAGING, DATA CAN BE STORED IN COMPRESSED FORMAT, * 007200 * DEPENDING ON A PARM OPTION. THREE LEVELS ARE AVAILABLE: * 007300 * * 007400 * 1. WHEN COMPRESS=0, DATA IS NOT COMPRESSED AND EACH RECORD * 007500 * USES UP TO LRECL+2 BYTES OF STORAGE. * 007600 * * 007700 * 2. WHEN COMPRESS=1, TRAILING BLANKS ARE REMOVED. * 007800 * * 007900 * 3. WHEN COMPRESS=2, MVS COMPRESSION/EXPANSION SERVICES * 008000 * (CSECRSRV MACRO) ARE USED TO COMPRESS STRINGS OF * 008100 * REDUNDANT CHARACTERS. * 008200 * * 008300 * RETURN-CODES = SEE BELOW * 008400 * * 008500 * 0 OK * 008600 * 12 UNDEFINED CLIP-BOARD (PASTE) * 008700 * 20 INVALID FUNCTION * 008800 * 1NN VDEFINE FAILED WITH RC=NN * 008900 * 2NN ISREDIT FAILED WITH RC=NN * 009000 * 5NN CSECRSRV FAILED WITH RC=NN * 009100 * 6NN OPEN FAILED WITH RC=NN * 009200 * 7NN BRIF FAILED WITH RC=NN * 009300 * 1NNN TCBTOKEN MACRO FAILED WITH RC=NNN * 009400 * 2NNN DSPSERV CREATE FAILED WITH RC=NNN * 009500 * 3NNN ALESERV ADD FAILED WITH RC=NNN * 009600 * 4NNN IEANTCR CALL FAILED WITH RC=NNN * 009700 * * 009800 * CHANGE ACTIVITY * 009900 * * 010000 * $400 COMPLETE REWRITE FOR ESA 4.2.2 * 010100 * $401 ISSUE LOAD TO MAKE MYSELF RESIDENT IN MEMORY * 010200 * $402 FIX PADDING ERROR IN PASTE ROUTINE * 010300 * * 010400 &VERMOD SETC 'R402' * 010500 *********************************************************************** 010600 CUTPGM CSECT 010700 CUTPGM RMODE ANY 010800 SAVE (14,12),,'CUTPGM &VERMOD' 010900 LR R11,R15 BASE REG 011000 USING CUTPGM,R11 011100 L R12,0(,R1) A(PARM) 011200 USING PARM,R12 011300 *---------------------------------------------------------------------* 011400 * * 011500 * INITIALISATION * 011600 * * 011700 * 1. ALLOCATE WORKING-STORAGE * 011800 * 2. RETRIEVE THE STOKEN/ALET OF THE DATA SPACE * 011900 * 3. CHECK PARAMETERS COMMON TO CUT AND PASTE FUNCTIONS * 012000 * * 012100 *---------------------------------------------------------------------* 012200 STORAGE OBTAIN, GET DYNAMIC STORAGE X 012300 LENGTH=DYNAML, LENGTH X 012400 LOC=BELOW, SNAPDCB X 012500 BNDRY=PAGE INITIALIZE WITH X'00' 012600 ST R13,4(,R1) 012700 ST R1,8(,R13) 012800 LM R13,R1,8(R13) A(DYNAM) 012900 USING DYNAM,R13 013000 * 013100 LOAD EP=CUTPGM MAKE MYSELF RESIDENT 013200 * 013300 LOAD EP=ISPLINK ISPF INTERFACE 013400 ST R0,ISPLINK@ SAVE THE ADDRESS 013500 * 013600 MVC CLIPNAME,=C'CUTPASTE' NAME OF MY DATA SPACE 013700 MVC CLIPNAME+8(8),CLIPBOARD BUFFER ID 013800 * 013900 * RETRIEVE THE STOKEN/ALET OF THE DATA SPACE 014000 * 014100 CALL IEANTRT, RETRIEVE X 014200 (=A(IEANT_HOME_LEVEL), SCOPE X 014300 CLIPNAME,DSPCSTKN, NAME/TOKEN X 014400 DWD), RETURN CODE X 014500 MF=(E,TENWORDS) 014600 LTR R15,R15 DATA SPACE EXISTS ALREADY? 014700 BNZ INIT30 NO, JUMP 014800 L R2,DSPCORG ORIGIN 014900 LAM R2,R2,DSPCALET POINT TO THE DATA SPACE 015000 SAC 512 MODE=AR 015100 MVC HEADER,0(R2) MOVE HEADER FROM "CUT" 015200 SAC 0 MODE=PRIMARY 015300 * 015400 INIT30 CLI FUNCTION,C'D' FUNCTION=DUMP? 015500 BE DUMP00 YES, GO THERE 015600 * 015700 PACK LINE1,LINE1 FIRST LINE 015800 * 015900 CLI FUNCTION,C'C' FUNCTION=CUT? 016000 BE CUT00 YES, GO THERE 016100 CLI FUNCTION,C'P' FUNCTION=PASTE? 016200 BE PASTE00 YES, GO THERE 016300 LA R15,20 RC=20 (INVALID FUNCTION) 016400 B EXIT15 QUIT 016500 *********************************************************************** 016600 * * 016700 * "DUMP" FUNCTION: DISPLAY THE CONTENTS OF THE DATA SPACE * 016800 * USING THE ISPF/PDF BROWSE INTERFACE (BRIF). * 016900 * * 017000 *********************************************************************** 017100 DUMP00 LA R15,12 DATA SPACE NOT FOUND 017200 OC HDRTCB,HDRTCB DATA SPACE LOCATED? 017300 BZ EXIT15 NO, QUIT 017400 LA R0,DYNAM DIALOG DATA ADDR 017500 ST R0,DWD DIALOG DATA PTR 017600 LA R14,=C'BRIF' ISPF FUNCTION 017700 LA R15,CLIPNAME DSNAME 017800 LA R0,=C'F ' RECFM 017900 LA R1,=F'80' LRECL 018000 LA R2,=A(DUMP500) READ ROUTINE 018100 SLR R3,R3 COMMAND RTNE ADDR 018200 LA R4,DWD PARM FOR READ ROUTINE 018300 STM R14,R4,TENWORDS PARAMETER LIST 018400 OI TENWORDS+24,X'80' END OF PARAMETER LIST 018500 LA R1,TENWORDS PARAMETER LIST 018600 L R15,ISPLINK@ ISPF INTERFACE 018700 BALR R14,R15 <- BRIF 018800 LTR R15,R15 BRIF OK? 018900 BZ EXIT00 YES, EXIT 019000 LA R15,700(,R15) ERROR: BRIF FAILED 019100 B EXIT15 NO, QUIT 019200 * 019300 * BRIF READ ROUTINE 019400 * 019500 PUSH USING 019600 DUMP500 BAKR R14,0 SAVE REGS 019700 LR R11,R15 BASE REG 019800 USING DUMP500,R11 019900 LM R2,R5,0(R1) LOAD PARM ADDR 020000 L R13,0(,R5) POINT TO DYNAMIC STORAGE AREA 020100 L R7,0(,R4) LINE NUMBER REQUESTED BY BRIF 020200 BCTR R7,0 RELATIVE TO ZERO 020300 M R6,=F'80' MULT BY LINE LENGTH 020400 *L R0,DSPCALET 020500 LAM R7,R7,DSPCALET POINT TO THE DATA SPACE 020600 SAC 512 MODE=AR 020700 MVC LINE(80),0(R7) MOVE LINE TO ADDRESS SPACE 020800 SAC 0 MODE=PRIMARY 020900 LA R0,LINE ADDRESS OF CURRENT RECORD 021000 ST R0,0(,R2) PASS ADDR BACK TO BRIF 021100 *STM R2,R7,LINE 021200 DUMP590 SLR R15,R15 GOBACK WITH RC=00 021300 PR 021400 POP USING 021500 *********************************************************************** 021600 * * 021700 * "CUT" FUNCTION * 021800 * * 021900 * 1. PROCESS PARM * 022000 * 2. DEFINE THE DATA SPACE * 022100 * 3. RETRIEVE DATA LINES AND STORE THEM INTO THE DATA SPACE * 022200 * 4. UPDATE DATA SPACE HEADER * 022300 * * 022400 *********************************************************************** 022500 CUT00 PACK LINE2,LINE2 LAST LINE 022600 * 022700 BAL R14,DEFSPC DEFINE DATA SPACE 022800 LTR R15,R15 OK? 022900 BNZ EXIT15 NO, QUIT 023000 * 023100 CLI APPEND,C'+' APPEND OPTION ? 023200 BE CUT40 YES, DO NOT RESET POINTERS 023300 MVC HDRCOMPR,COMPRESS SAVE COMPRESSION LEVEL 023400 XC HDRLINES,HDRLINES RESET LINE COUNTER 023500 * 023600 L R4,DSPCORG ORIGIN 023700 LA R4,L'HEADER(,R4) SKIP HEADER 023800 ST R4,HDRNEXTB FIRST BYTE OF DATA 023900 * 024000 PACK DWD,LRECL MAX RECORD SIZE 024100 CVB R0,DWD LENGTH 024200 ST R0,HDRLRECL LENGTH 024300 * 024400 CUT40 BAL R14,VDEFLINE VDEFINE LINE 024500 LTR R15,R15 CHECK RETURN CODE 024600 BNZ ERROR100 ISPLINK FAILED 024700 * 024800 CUT50 L R4,HDRNEXTB FIRST BYTE OF DATA 024900 LAM R4,R4,DSPCALET POINT TO THE DATA SPACE 025000 * 025100 L R5,HDRBLKS SIZE OF THE DATA SPACE (PAGES) 025200 SLL R5,12 SIZE OF THE DATA SPACE (BYTES) 025300 SL R5,DSPCORG MINUS ORIGIN 025400 SLR R5,R4 SIZE OF THE DATA PORTION 025500 * 025600 MVC COMMAND(20),=C'(LINE) = LINE 123456' 025700 *---------------------------------------------------------------------* 025800 * * 025900 * "CUT" FUNCTION: COPY DATA TO THE BUFFER * 026000 * * 026100 *---------------------------------------------------------------------* 026200 *LOOP 026300 CUT80 OI LINE1+L'LINE1-1,15 SUPPRESS SIGN 026400 UNPK COMMAND+14(6),LINE1 123456 026500 LA R0,20 LENGTH OF COMMAND 026600 BAL R14,ISREDIT 026700 LTR R15,R15 CHECK RETURN CODE 026800 BNZ ERROR200 ISREDIT FAILED 026900 * 027000 * MOVE LINE TO BUFFER 027100 * 027200 CUT81 LAE R2,LINE SOURCE TEXT 027300 L R3,HDRLRECL LENGTH OF SOURCE TEXT 027400 SAC 512 MODE=AR 027500 CLI HDRCOMPR,C'0' COMPRESS=NONE ? 027600 BE CUT84 YES, JUMP 027700 CLI HDRCOMPR,C'2' COMPRESS=CSRCE ? 027800 BE CUT85 YES, JUMP 027900 * 028000 * TRUNCATE TRAILING BLANKS (COMPRESS=1) 028100 * 028200 LA R1,LINE(R3) FIRST BYTE AFTER LINE 028300 CUT82 BCTR R1,0 028400 CLI 0(R1),C' ' IS IT A SPACE ? 028500 BNE CUT84 NO, EXIT 028600 BCT R3,CUT82 028700 LA R3,1 LENGTH=1 028800 * 028900 CUT84 STH R3,0(,R4) STORE LENGTH 029000 LA R4,2(,R4) SKIP LENGTH COUNTER 029100 LR R5,R3 RECORD SIZE 029200 MVCL R4,R2 MOVE DATA 029300 SAC 0 MODE=PRIMARY 029400 B CUT88 NEXT LINE 029500 * 029600 * COMPRESS DATA USING MVS COMPRESSION/EXPANSION SERVICES 029700 * 029800 CUT85 SLR R1,R1 NO WORK AREA 029900 LAE R6,0(,R4) SAVE ADDRESS 030000 LA R4,2(,R4) SKIP COUNT 030100 BCTR R5,0 030200 BCTR R5,0 030300 .OW10890 LAE 14,0 PREVENT S0C4 IN CSRCE 030400 CSRCESRV SERVICE=COMPRESS BUFFER<=LINE 030500 LR R1,R4 CALC LENGTH OF COMPRESSED TEXT 030600 SR R1,R6 CALC LENGTH OF COMPRESSED TEXT 030700 BCTR R1,0 CALC LENGTH OF COMPRESSED TEXT 030800 BCTR R1,0 CALC LENGTH OF COMPRESSED TEXT 030900 STH R1,0(,R6) SAVE LENGTH OF COMPRESSED TEXT 031000 **** MVI 0(R4),X'FF' END OF FILE MARK 031100 SAC 0 MODE=PRIMARY 031200 LTR R15,R15 OK? 031300 BNZ ERROR500 NO, EXIT 031400 * 031500 CUT88 LA R0,1 NUMBER OF LINES IN BUFFER 031600 AL R0,HDRLINES NUMBER OF LINES IN BUFFER 031700 ST R0,HDRLINES NUMBER OF LINES IN BUFFER 031800 * 031900 AP LINE1,=P'1' INCREMENT LINE NUMBER 032000 CP LINE1,LINE2 LAST LINE REACHED? 032100 BNH CUT80 NOT YET, PROCESS NEXT LINE 032200 *ENDLOOP 032300 ST R4,HDRNEXTB SAVE ADDR OF NEXT BYTE 032400 L R4,DSPCORG POINT TO HEADER 032500 SAC 512 MODE=AR 032600 MVC 0(L'HEADER,R4),HEADER MOVE HEADER FOR "PASTE" 032700 SAC 0 MODE=PRIMARY 032800 B EXIT00 032900 *********************************************************************** 033000 * * 033100 * "PASTE" FUNCTION * 033200 * * 033300 * RETRIEVE DATA LINES FROM THE DATA SPACE AND INSERT THEM * 033400 * AFTER &LINE1 * 033500 * * 033600 *********************************************************************** 033700 PASTE00 LA R15,12 DATA SPACE NOT FOUND 033800 OC HDRTCB,HDRTCB DATA SPACE LOCATED? 033900 BZ EXIT15 NO, QUIT 034000 BAL R14,VDEFLINE VDEFINE LINE 034100 LA R2,L'HEADER(,R2) POINT AT COMPRESSED TEXT 034200 L R8,HDRLINES NUMBER OF LINES IN BUFFER 034300 MVC COMMAND(35),=C'LINE_AFTER 123456 = DATALINE (LINE)' 034400 * 034500 * GET LINES FROM THE DATA SPACE AND PASS THEM TO ISPF EDIT 034600 *LOOP 034700 PASTE50 SAC 512 MODE=AR 034800 LH R3,0(,R2) SIZE OF RECORD STORED IN BUFFER 034900 LA R2,2(,R2) SKIP RCD LEN 035000 LAE R4,LINE SOURCE TEXT 035100 L R5,HDRLRECL LENGTH OF SOURCE TEXT 035200 CLI HDRCOMPR,C'2' COMPRESS=CSRCE ? 035300 BE PASTE55 YES, JUMP 035400 * 035500 ICM R3,B'1000',=C' ' PADDING 035600 MVCL R4,R2 MOVE FROM BUFFER 035700 SAC 0 MODE=PRIMARY 035800 B PASTE57 NEXT LINE 035900 * 036000 * EXPAND DATA USING MVS COMPRESSION/EXPANSION SERVICES 036100 * 036200 PASTE55 SLR R1,R1 NO WORK AREA 036300 CSRCESRV SERVICE=EXPAND BUFFER=>LINE 036400 SAC 0 MODE=PRIMARY 036500 LTR R15,R15 OK? 036600 BNZ ERROR500 NO, EXIT 036700 * 036800 * INSERT A LINE AFTER CURRENT 036900 * 037000 PASTE57 OI LINE1+L'LINE1-1,15 SUPPRESS SIGN 037100 UNPK COMMAND+11(6),LINE1 123456 037200 LA R0,35 LENGTH OF THE ISREDIT COMMAND 037300 BAL R14,ISREDIT 037400 CH R15,=H'4' LINE TRUNCATED? 037500 BH ERROR200 BAD, QUIT 037600 * 037700 AP LINE1,=P'1' NEXT LINE NUMBER 037800 BCT R8,PASTE50 KEEP ON DOING IT 037900 *ENDLOOP 038000 *********************************************************************** 038100 * * 038200 * RETURN TO CALLER * 038300 * * 038400 *********************************************************************** 038500 EXIT00 SLR R15,R15 RC=00 038600 B EXIT15 038700 * 038800 ERROR100 LA R15,100(,R15) ISPLINK FAILED (VDEFINE) 038900 B EXIT15 039000 * 039100 ERROR200 LA R15,200(,R15) ISPLINK FAILED (ISREDIT) 039200 B EXIT15 039300 * 039400 ERROR500 LA R15,500(,R15) CSRCESRV FAILED 039500 B EXIT15 039600 * 039700 EXIT15 LR R2,R15 SAVE RETURN CODE 039800 LR R1,R13 A(DYNAM) 039900 L R13,4(,R13) 040000 STORAGE RELEASE,LENGTH=DYNAML,ADDR=(1) FREE DYNAMIC STORAGE 040100 LR R15,R2 PASS RETURN CODE 040200 RETURN (14,12),RC=(15) GOBACK TO CALLER WITH RC IN R15 040300 *---------------------------------------------------------------------* 040400 * * 040500 * ISPLINK VDEFINE (LINE) CHAR * 040600 * * 040700 *---------------------------------------------------------------------* 040800 VDEFLINE BAKR R14,0 040900 LA R14,=C'VDEFINE' FUNCTION 041000 LA R15,=C'LINE ' NAME 041100 LA R0,LINE ADDRESS 041200 LA R1,=C'CHAR' TYPE 041300 LA R2,HDRLRECL LENGTH 041400 STM R14,R2,TENWORDS BUILD PARM LIST 041500 OI TENWORDS+16,X'80' MARK END OF LIST 041600 L R15,ISPLINK@ PICK UP ISPF INTERFACE ADDRESS 041700 LA R1,TENWORDS PARAM 041800 BALR R14,R15 GOTO ISPLINK 041900 PR 042000 *---------------------------------------------------------------------* 042100 * * 042200 * DEFINE THE DATA SPACE (FUNCTION=CUT) * 042300 * * 042400 *---------------------------------------------------------------------* 042500 DEFSPC BAKR R14,0 042600 OC HDRTCB,HDRTCB DATA SPACE CREATED ALREADY? 042700 BNZ DEFSPC7 YES, JUMP 042800 * 042900 PACK DWD,BLOCKS SIZE OF DATA SPACE IN BLOCKS 043000 CVB R0,DWD SIZE OF DATA SPACE IN BLOCKS 043100 ST R0,HDRBLKS SIZE OF DATA SPACE IN BLOCKS 043200 * 043300 * RETRIEVE THE TCBTOKEN OF MY JOB-STEP TCB 043400 * 043500 TCBTOKEN TTOKEN=STEPTOKN, TCBTOKEN OF MY JS TCB X 043600 TYPE=JOBSTEP, X 043700 MF=(E,TCBTOKN1) 043800 LTR R15,R15 OK? 043900 LA R15,1000(,R15) RC=10NN TCBTOKEN 044000 BNZ DEFSPC9 NO, EXIT 044100 * 044200 * DEFINE A DATA SPACE AND ASSIGN OWNERSHIP TO MY JOB-STEP TCB 044300 * 044400 DSPSERV CREATE, X 044500 NAME=CLIPNAME, C'CUTPASTE' X 044600 GENNAME=YES, DSPSERV GENERATES A NAME X 044700 OUTNAME=DSPCNAME, NAME OF DATA SPACE X 044800 BLOCKS=HDRBLKS, 16 MEGS X 044900 STOKEN=DSPCSTKN, X 045000 TTOKEN=STEPTOKN, TCBTOKEN OF MY JS TCB X 045100 ORIGIN=DSPCORG, X 045200 MF=(E,DSPSERV1) 045300 LTR R15,R15 OK? 045400 LA R15,2000(,R15) RC=20NN DSPSERV 045500 BNZ DEFSPC9 NO, EXIT 045600 MVC HDRTCB,PSATOLD-PSA OWNER OF THE DATA SPACE 045700 MVI APPEND,C'-' APPEND OPTION OFF 045800 * 045900 * ADD THE DATA SPACE TO THE PASN-AL TO ALLOW ACESS FROM 046000 * ANY TASK IN MY ADDRESS SPACE. 046100 * 046200 ALESERV ADD, X 046300 STOKEN=DSPCSTKN, X 046400 ALET=DSPCALET, X 046500 AL=PASN, MAKE IT PUBLIC X 046600 MF=(E,ALESERV1) 046700 LTR R15,R15 OK? 046800 LA R15,3000(,R15) RC=30NN ALESERV 046900 BNZ DEFSPC9 NO, EXIT 047000 * 047100 * CREATE A NAME/TOKEN PAIR TO BE ABLE TO RETRIEVE 047200 * THE DATA SPACE LATER ON. 047300 * 047400 CALL IEANTCR, CREATE A NAME/TOKEN PAIR X 047500 (=A(IEANT_HOME_LEVEL), X 047600 CLIPNAME,DSPCSTKN, NAME/TOKEN X 047700 =F'0', PERSIST OPTION X 047800 DWD), X 047900 MF=(E,TENWORDS) 048000 LTR R15,R15 OK? 048100 BZ DEFSPC8 YES, JUMP 048200 LA R15,4000(,R15) RC=40NN IEANTCR 048300 B DEFSPC9 NO, EXIT 048400 * 048500 * IF THE DATA SPACE EXISTS ALREADY AND I OWN IT, 048600 * ISSUE DSPSERV RELEASE TO PREVENT UNNECESSARY PAGING. 048700 * 048800 DEFSPC7 CLI APPEND,C'+' APPEND OPTION ? 048900 BE DEFSPC8 YES, DO NOT ISSUE RELEASE 049000 CLC HDRTCB,PSATOLD-PSA DO I OWN THIS DATA SPACE? 049100 BNE DEFSPC8 NO, DO NOT ISSUE RELEASE 049200 DSPSERV RELEASE, FREE PAGING SPACE X 049300 STOKEN=DSPCSTKN, X 049400 BLOCKS=HDRBLKS, SIZE X 049500 START=DSPCORG, ORIGIN X 049600 MF=(E,DSPSERV1) 049800 * 049900 DEFSPC8 SLR R15,R15 RC=0 050000 DEFSPC9 PR 050100 *---------------------------------------------------------------------* 050200 * * 050300 * EXECUTE ISREDIT FUNCTION * 050400 * * 050500 *---------------------------------------------------------------------* 050600 ISREDIT ST R0,TENWORDS+16 LENGTH OF THE COMMAND 050700 LA R15,=C'ISREDIT ' COMMAND 050800 LA R0,TENWORDS+16 LENGTH 050900 LA R1,COMMAND COMMAND 051000 STM R15,R1,TENWORDS BUILD PARM LIST 051100 OI TENWORDS+8,X'80' MARK END OF LIST 051200 L R15,ISPLINK@ ISPF INTERFACE 051300 LA R1,TENWORDS PARAM 051400 BR R15 GOTO ISPLINK 051500 *---------------------------------------------------------------------* 051600 * * 051700 * INPUT PARAMETERS * 051800 * * 051900 *---------------------------------------------------------------------* 052000 PARM DSECT 052100 DS H LENGTH 052200 FUNCTION DS C'C' FUNCTION: C/P/D 052300 CLIPBOARD DS C'12345678' CLIP BOARD 052400 LINE1 DS Z'123456' FIRST LINE (.ZF) 052500 APPEND DS C'+' APPEND/REPLACE (CUT ONLY) 052600 COMPRESS DS C'0' COMPRESSION LEVEL (CUT ONLY) 052700 LRECL DS Z'32767' MAX RECORD SIZE (CUT ONLY) 052800 LINE2 DS Z'123456' LAST LINE (.ZL) (CUT ONLY) 052900 BLOCKS DS Z'123456' SIZE OF DATA SPACE (CUT ONLY) 053000 *---------------------------------------------------------------------* 053100 * * 053200 * WORKING-STORAGE AREA * 053300 * * 053400 *---------------------------------------------------------------------* 053500 DYNAM DSECT 053600 DS 18F 053700 ISPLINK@ DS V(ISPLINK) 053800 TENWORDS DS 10F 053900 TCBTOKN1 TCBTOKEN MF=L 054000 DSPSERV MF=(L,DSPSERV1) 054100 ALESERV1 ALESERV MF=L 054200 * 054300 STEPTOKN DS XL16 TCBTOKEN OF MY JS TCB 054400 DWD DS D 054500 COMMAND DS CL40 ISREDIT COMMAND 054600 * 054700 * NAME/TOKEN PAIR 054800 * 054900 DS 0F 055000 CLIPNAME DS C'CUTPASTE',XL8'00' NAME OF THE CLIP-BOARD 055100 DSPCSTKN DS XL8 0 AS TOKEN 055200 DSPCALET DS F 8 ALET 055300 DSPCORG DS F 12 ORIGIN 055400 * 055500 * DATA SPACE HEADER 055600 * 055700 DS 0F 055800 HEADER DS 0CL32 DATA SPACE HEADER 055900 HDRBLKS DS F NUMBER OF BLOCKS 056000 HDRTCB DS A TCB THAT OWNS THE DATA SPACE 056100 HDRLRECL DS F RECORD LENGTH 056200 HDRLINES DS F NUMBER OF LINES 056300 HDRNEXTB DS A NEXT AVAILABLE BYTE 056400 HDRCOMPR DS C COMPRESSION LEVEL 056500 DS 3X RESERVED 056600 DSPCNAME DS C'12345CUT' NAME OF DATA SPACE 056700 * 056800 DS 0D 056900 LINE DS CL32767 RECORD AREA 057000 DYNAML EQU *-DYNAM 057100 *430 IEANTASM NAME/TOKEN EQUATES 057200 IEANT_HOME_LEVEL EQU 2 057300 * IHAPSA 057400 PSA DSECT 057500 PSATOLD EQU *+X'021C' A(TCB) 057600 YREGS 057700 END 057800 //SYSLIB DD DISP=SHR,DSN=SYS1.MACLIB 057900 //SYSUT1 DD UNIT=VIO,SPACE=(CYL,1) 058000 //SYSPRINT DD SYSOUT=* 058100 //SYSLIN DD UNIT=VIO,SPACE=(TRK,1),DISP=(,PASS),BLKSIZE=3200 058200 //* 058300 //LKED EXEC PGM=HEWL,PARM='MAP,RENT' 058400 //SYSPRINT DD SYSOUT=* 058500 //SYSLIN DD DSN=*.ASMH.SYSLIN,DISP=(OLD,DELETE) 058600 //SYSLIB DD DISP=SHR,DSN=SYS1.CSSLIB 058800 //SYSLMOD DD DISP=SHR,DSN=IBMUSER.LOAD(CUTPGM) ./ ADD NAME=GDASWTCH /********************************************************************** /* UTILITY: GDASWTCH * /* AUTHOR: DAVID LEIGH * /* FUNCTION: THIS CLIST RENAMES A PERSONAL GDA DATASET (IF IT EXISTS) * /* TO A DIFFERENT NAME. IF IT FINDS THE "DIFFERENT" NAME * /* IT RENAMES IT TO THE APPROPRIATE NAME FOR GDA TO FIND IT.* /********************************************************************** PROC 0 DEBUG NOEXEC GDANAME(&STR(ISPF.ISPPROF(GDAPRM01))) + RENAME(&STR(ISPF.ISPPROF(GDXPRM01))) + HELP IF &DEBUG = DEBUG THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS /********************************************************************** /* DISPLAY HELP IF REQUESTED * /********************************************************************** IF &HELP = HELP THEN GOTO HELPSEC IF &SYSDSN('&STR(&SYSUID..&GDANAME)') = &STR(OK) THEN + DO RENAME '&SYSUID..&GDANAME' '&SYSUID..&RENAME' WRITE &STR(*** SYSTEM DEFAULT GDA IN EFFECT NOW ***) IF &NOEXEC = NOEXEC THEN + EXIT ELSE + GDA * EXIT END IF &SYSDSN('&STR(&SYSUID..&RENAME)') = &STR(OK) THEN + DO RENAME '&SYSUID..&RENAME' '&SYSUID..&GDANAME' WRITE &STR(*** PERSONAL GDA IN EFFECT NOW ***) IF &NOEXEC = NOEXEC THEN + EXIT ELSE + GDA * EXIT END WRITE &STR(NO PERSONAL, OR RENAMED GDA FILES FOUND TO SWITCH) EXIT /********************************************************************** /* DISPLAY ANY "HELP" WHICH IS AVAILABLE FOR THIS UTILITY * /********************************************************************** HELPSEC: + ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR GDASWTCH UTILITY + *** NO PROCESSING PERFORMED ***) ISPEXEC SETMSG MSG(UTLZ000) EXIT ./ ADD NAME=GDGGEN /*******************************************************************/ /* CLIST : GDGGEN */ /* CREATED BY : DAVID LEIGH */ /* DATE : 6-22-89 */ /* DESCRIPTION : THIS CLIST TAKES THE INPUT DATASET AND OUTPUTS */ /* THE GDG GEN NODES IN THE FOLLOWING VARIABLES: */ /* LIMIT - THE NUMBER OF GENERATIONS ALLOWED FOR THIS*/ /* INDEX. */ /* GEN - HOW MANY DATASETS ARE ASSOCIATED WITH THIS */ /* INDEX. */ /* ZEROGEN - THE CURRENT "0" GENERATION DATASET. */ /* NEXTGEN - WHAT THE "+1" DATASET WOULD BE CALLED */ /* GIVEN THE CURRENT INDEX STATUS. */ /* MINUS0 - THE NAMES OF EACH OF THE EXISTING ACTUAL */ /* THRU DATASETS FOR THIS INDEX. MINUS0 WILL BE */ /* MINUSX THE SAME AS ZEROGEN. "X" IN "MINUSX" IS */ /* EQUAL TO "GEN - 1". */ /* ALL OF THESE VARIABLES ARE THEN "VPUT" INTO THE */ /* ISPF SHARED POOL. */ /* IF THIS CLIST IS CALLED FROM THE COMMAND LINE, */ /* THE USER WILL BE PROMPTED FOR A GDG INDEX BASE */ /* NAME, AND THE INFORMATION WILL BE DISPLAYED AT */ /* THE TERMINAL. */ /*******************************************************************/ PROC 0 DSN() EXCODE(0) HELP DEBUG /**** SET MESSAGE DISPLAY ON/OFF BASED ON THE DEBUG SWITCH ***/ IF &DEBUG = DEBUG THEN CONTROL MSG LIST CONLIST SYMLIST NOFLUSH ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT IF &HELP = &STR(HELP) THEN GOTO HELPSEC IF &SYSNEST = NO AND &STR(&DSN) = THEN + DO WRITENR ENTER GDG INDEX BASE NAME ==> READ DSN IF &STR(&DSN) = THEN + DO SET ZEDLMSG = &STR(*** NO DATASET NAME ENTERED *** + NO PROCESSING PERFORMED) IF &SYSISPF = ACTIVE THEN ISPEXEC SETMSG MSG(UTLZ001) ELSE WRITE &STR(&ZEDLMSG) EXIT END END IF &SYSNEST = YES AND &STR(&DSN) = THEN EXIT CODE(12) SET SYSOUTTRAP = 1000 LISTCAT ENTRY('&DSN') GDG ALL SET EXCODE = &LASTCC SET SYSOUTTRAP = 0 IF &EXCODE > 4 THEN + DO SET ZEDLMSG = &STR("&DSN" ERROR : &SYSDSN('&DSN')) IF &SYSISPF = ACTIVE THEN ISPEXEC SETMSG MSG(UTLZ001) ELSE WRITE &STR(&ZEDLMSG) EXIT CODE(&EXCODE) END SET GEN = 0 SET ALLVAR = &STR(LIMIT GEN) SET I = &SYSOUTLINE DO WHILE &I > 0 SET SYSUT2 = &STR(&&SYSOUTLINE&I) SET LEN = &LENGTH(&STR(&SYSUT2)) SELECT WHEN (&SUBSTR(7:13,&STR(&SYSUT2)) = &STR( LIMIT-)) DO SET LIMIT = &SUBSTR(31:31,&STR(&SYSUT2)) IF &DATATYPE(&SUBSTR(30:30,&STR(&SYSUT2))) = NUM THEN + SET LIMIT = &STR(&SUBSTR(30:30,&STR(&SYSUT2))&LIMIT) IF &DATATYPE(&SUBSTR(29:29,&STR(&SYSUT2))) = NUM THEN + SET LIMIT = &STR(&SUBSTR(29:29,&STR(&SYSUT2))&LIMIT) SET LIMIT = &LIMIT SET I = 0 END WHEN (&SUBSTR(7:16,&STR(&SYSUT2)) = &STR( NONVSAM--)) DO SET MINUS&GEN = &SUBSTR(17:&LEN,&STR(&SYSUT2)) IF &GEN = 0 THEN + DO SET ZEROGEN = &STR(&MINUS0) SET ALLVAR = &STR(&ALLVAR ZEROGEN NEXTGEN) SET X = &LENGTH(&STR(&ZEROGEN)) SET Y = &X - 1 SET VER = &SUBSTR(&Y:&X,&STR(&ZEROGEN)) SET Y = &X - 3 SET Z = &X - 6 SET XGEN = &SUBSTR(&Z:&Y,&STR(&ZEROGEN)) SET XGEN = &XGEN + 1 IF &XGEN > 9999 THEN + DO SET VER = &VER + 1 SET XGEN = 1 END SET NEXTGEN = &STR(&SUBSTR(1:+ &LENGTH(&STR(&ZEROGEN))-8,+ &STR(&ZEROGEN))+ G&SUBSTR(+ &LENGTH(&STR(000&XGEN))-3:+ &LENGTH(&STR(000&XGEN)),+ &STR(000&XGEN))+ V&SUBSTR(&LENGTH(&STR(0&VER))-1:+ &LENGTH(&STR(0&VER)),+ &STR(000&VER))) END SET ALLVAR = &STR(&ALLVAR MINUS&GEN) SET GEN = &GEN + 1 END END SET I = &I - 1 END IF &STR(&ZEROGEN) = THEN + DO SET NEXTGEN = &STR(&DSN..G0001V00) SET ALLVAR = &STR(&ALLVAR NEXTGEN) SET EXCODE = 4 END IF &SYSISPF ¬= ACTIVE OR &SYSNEST = NO THEN + DO WRITE BASE(&DSN) WRITE LIMIT(&LIMIT) WRITE GEN(&GEN) WRITE ZEROGEN(&ZEROGEN) WRITE NEXTGEN(&NEXTGEN) DO &I = 0 TO &EVAL(&GEN - 1) SET X = &&MINUS&I WRITE MINUS&I(&X) END END ELSE + ISPEXEC VPUT (&ALLVAR) SHARED EXIT CODE(&EXCODE) HELPSEC: + ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR GDGGEN UTILITY + *** NO PROCESSING PERFORMED ***) ISPEXEC SETMSG MSG(UTLZ000) EXIT ./ ADD NAME=GENCOPY /* REXX */ arg ssid objtype object . sysuid = sysvar(sysuid) select when ssid = "DSNS" then nop when ssid = "DSNT" then nop when ssid = "DSNP" then nop otherwise do say 'Invalid DB2 subsystem of' ssid say 'Must be "DSNS", "DSNT", or "DSNP"' exit(4) end end select when objtype = 'DB' then whereclause = 'AND DB.NAME ' when objtype = 'TS' then whereclause = 'AND TS.NAME ' otherwise do say 'Invalid Object Type of' objtype say 'Must be "DB" or "TS"' exit(4) end end compare = "=" splat = Index(object,'*') if splat > 0 then do object = Substr(object,1,splat-1) || '%' compare = "LIKE" end whereclause = whereclause||compare||" '"||object||"'" SQLQUERY = "SELECT TS.NAME, TS.DBNAME, SG.VCATNAME", "FROM SYSIBM.SYSTABLESPACE TS,", "SYSIBM.SYSSTOGROUP SG,", "SYSIBM.SYSDATABASE DB", "WHERE TS.DBNAME = DB.NAME "||whereclause, "AND DB.STGROUP = SG.NAME", "AND DB.NAME NOT IN ('DSNDB01', 'DSNDB07', 'DSNDB06')", "ORDER BY TS.DBNAME, TS.NAME" DB2SSID = ssid Address LINK 'REXXSQL' if _nrows = 0 then do say SQLQUERY say 'No tablespaces found' exit(4) end Address ISPEXEC 'TBERASE COPYDBTS' 'TBCREATE COPYDBTS NOWRITE REPLACE', 'NAMES(tgdg, thlq, tdb, tts, tsysc, tsysp)' do i = 1 to _nrows j = "00000"||i j = Substr(j,Length(j)-3,4) k = "00000"||i-1 k = Substr(k,Length(k)-3,4) thlq = Strip(vcatname.i) tdb = Strip(dbname.i) tts = Strip(name.i) tsysc = j tsysp = k tgdg = 'NO' copydsn = "'" thlq ".PRMF." ssid "." tdb "." tts "'" x = Outtrap("output.",'*') cmd = "LISTDS '"||copydsn||"'" output.1 = "" output.2 = "" output.3 = "" output.4 = "" output.5 = "" Address TSO interpret cmd x = Outtrap('OFF') line = output.3 parse var line x gdg if gdg <> 'GDG' then do tgdg = 'YES' end Address ISPEXEC 'TBADD COPYDBTS' end 'FTOPEN' 'FTINCL GENCOPY' 'FTCLOSE' exit ./ ADD NAME=GENSYNS /********************************************************************** /* UTILITY: GENSYNS * /* AUTHOR: DAVID LEIGH * /* FUNCTION: CREATE/DELETE DB2 SYNONYMS FOR A LIST OF USERS AND * /* MAINTAIN THAT LIST. * /********************************************************************** PROC 0 USER() + DBAS('D@UDAL D@ULLJ D@UJEF') + ACTION(CREATE) + VALID_ACTIONS('CREATE DROP') + DRIVER(PLATINUM) + VALID_DRIVERS('PLATINUM DSNTIAD') + EDIT + HELP /*** CHECK THE DEBUG SWITCH ***/ 02 ISPEXEC VGET DBGSWTCH PROFILE 02 IF &DBGSWTCH = ON THEN + 02 CONTROL MSG LIST CONLIST SYMLIST NOFLUSH PROMPT ASIS 00000702 ELSE + 02 CONTROL NOMSG NOLIST NOFLUSH PROMPT ASIS 00000902 IF &HELP = HELP THEN GOTO HELPSEC 02 ISPEXEC CONTROL ERRORS RETURN /********************************************************************** /* WIMPY SECURITY BY IGNORANCE * /********************************************************************** IF &SYSINDEX(&STR(&SYSUID),&STR(&DBAS)) = 0 THEN + IF &STR(&USER) = THEN SET USER = &SYSUID ELSE + IF &STR(&USER) ¬= &SYSUID THEN + DO SET ZEDLMSG = &STR(YOU MAY ONLY GENERATE SYNONYMS + FOR YOURSELF) ISPEXEC SETMSG MSG(UTLZ001) SET EXITCC = 20 GOTO FINISH END ELSE ELSE + IF &STR(&USER) = THEN + SET USER = ALL /********************************************************************** /* EDIT ACTION * /********************************************************************** IF &SYSINDEX(&STR(&ACTION),&STR(&VALID_ACTIONS)) = 0 THEN + DO SET ZEDLMSG = &STR(INVALID ACTIONS. VALID ACTIONS ARE: + &VALID_ACTIONS) ISPEXEC SETMSG MSG(UTLZ001W) SET EXITCC = 12 GOTO FINISH END /********************************************************************** /* EDIT DRIVER * /********************************************************************** IF &SYSINDEX(&STR(&DRIVER),&STR(&VALID_DRIVERS)) = 0 THEN + DO SET ZEDLMSG = &STR(INVALID DRIVER. VALID DRIVERS ARE: + &VALID_DRIVERS) ISPEXEC SETMSG MSG(UTLZ001W) SET EXITCC = 12 GOTO FINISH END /********************************************************************** /* ESTABLISH SOME PROCESSING VARIABLES * /********************************************************************** /* INITIALIZE SEVERAL VARIABLES WHICH WILL BE USED LATER IN THE * /* PROCESSING. * /********************************************************************** OPEN_CONTINUE: + CALL 'SYS2.USC1.LINKLIB(USERINFO)' '&SYSUID ' SET JCLDSN = &STR(&SYSUID..TEMP.GENSYNS) SET JOBNAME = &STR(&SYSUID.GSY) SET JOBNAME = &SUBSTR(1:8,&STR(&JOBNAME)) SET EXITCC = 0 SET LP = &STR(( SET RP = &STR() /********************************************************************** /* CREATE THE JCL * /********************************************************************** SET ZEDLMSG = &STR(*** CREATING JCL TO GENERATE SYNONYMS ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ001) SET PARM = &STR(PARMS('&ACTION &USER &DRIVER')) DELETE '&JCLDSN' FREE DDNAME(ISPFILE) ALLOCATE DDNAME(ISPFILE) DSN('&JCLDSN') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK$$$) + SPACE(2,2) TRACKS RELEASE + RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS) ISPEXEC FTOPEN ISPEXEC FTINCL GENSYNS ISPEXEC FTCLOSE FREE DD(ISPFILE) IF &EDIT = EDIT OR &EDITJCL = EDITJCL THEN + DO SET ZEDLMSG = &STR(NOTE: YOU MUST SUBMIT + THIS JCL YOURSELF. IT + WILL NOT RUN AUTOMATICALLY.) ISPEXEC SETMSG MSG(UTLZ001) ISPEXEC EDIT DATASET('&JCLDSN') SET EXITCC = 0 GOTO FINISH END SUBMIT '&JCLDSN' SET ZEDLMSG = &STR(*** GENSYNS JOB SUBMITTED ***) ISPEXEC SETMSG MSG(UTLZ000) /********************************************************************** /* CLOSE UP SHOP * /********************************************************************** FINISH: + EXIT CODE(&EXITCC) /********************************************************************** /* DISPLAY ANY "HELP" WHICH IS AVAILABLE FOR THIS UTILITY * /********************************************************************** HELPSEC: + ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR GENSYNS UTILITY + *** NO PROCESSING PERFORMED ***) ISPEXEC SETMSG MSG(UTLZ000) EXIT ./ ADD NAME=GETDBREC ISREDIT MACRO NOPROCESS (REC,SCHEMA,SSCHEMA) ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /******************************************************************/ /* 'GETDBREC' EDIT MACRO. RETRIEVE A DATABASE RECORD IN COBOL FMT.*/ /* AUTHOR : DAVID LEIGH DATE : 10-09-89 */ /******************************************************************/ IF &STR(&REC) = &STR(HELP) THEN GOTO HELPSEC ISREDIT PROCESS RANGE A B SET PROCCC = &LASTCC IF &PROCCC > 3 THEN + IF &PROCCC = 16 THEN SET LINECMD = A ELSE + DO SET ZEDLMSG = &STR(LINE COMMAND 'A' OR 'B' MUST BE + SPECIFIED) ISPEXEC SETMSG MSG(UTLZ001) EXIT END ELSE + ISREDIT (LINECMD) = RANGE_CMD /* CHECK TO MAKE SURE WE'RE ON THE RIGHT CPU 00001000 WTSPXSET * NAMES(SYSID) 00001500 IF &SYSID = &STR(P310) THEN 00016600 ELSE + 00016600 DO 00016600 SET ZEDLMSG = &STR(GETDBREC IS ONLY VALID ON CPU P310 *** + YOU ARE ON &SYSID CURRENTLY) ISPEXEC SETMSG MSG(UTLZ001) EXIT END 00016600 ISREDIT (SLN,SCL) = CURSOR ISREDIT (DSN) = DATASET ISREDIT (MBR) = MEMBER LISTDSI '&DSN' IF &SYSINDEX(&STR(PO),&STR(&SYSDSORG)) > 0 AND + &SYSLRECL = 80 THEN + SET SWITCH1 = &STR(ON) 00016600 IF &STR(&REC) = OR + &STR(&SCHEMA) = OR + &STR(&SSCHEMA) = THEN + DO CLEARSCR WRITE ********************************************************** WRITE * NOTE : THE RECORD NAME, SCHEMA AND SUBSCHEMA CAN BE * WRITE * ENTERED WHEN THE MACRO IS INVOKED. SYNTAX WOULD* WRITE * BE AS FOLLOWS : * WRITE * COMMAND ===> GETDBREC CT-UNME-RCD CTCSCORE CTCSCORE * WRITE ********************************************************** WRITE WRITE ENTER RECORD NAME, SCHEMA AND SUBSCHEMA BELOW : WRITENR ==> READ REC SCHEMA SSCHEMA IF &STR(&REC) = OR + &STR(&SCHEMA) = OR + &STR(&SSCHEMA) = THEN + DO SET ZEDLMSG = &STR(*** INPUT INFORMATION INCOMPLETE + *** NO PROCESSING PERFORMED ***) ISPEXEC SETMSG MSG(UTLZ001) EXIT END END /********************************************************************** /* THE FOLLOWING PROCESS WHICH ACCESS THE TABLE "PROJECT" COULD BE * /* REPLACED WITH SET STATEMENTS TO SET UP THE FOLLOWING VARIABLES : * /* "SCT" = THE SYSCTL DATASET NAME FOR THE CV SPECIFIED. * /* "SLIB" = THE IDMS STEPLIB FOR EXECUTING OLQBATCH FOR THE CV * /* SPECIFIED. THIS IS A LIST OF FULLY QUALIFIED DATASETS WITH* /* SINGLE QUOTES AND DELIMITED BY SPACES. * /* I.E. 'IDMS.CV99.TMPLIB' 'IDMS.CV99.LOADLIB' * /********************************************************************** ISPEXEC TBOPEN PROJECT NOWRITE ISPEXEC TBVCLEAR PROJECT SET TESTPROD = T SET PRJELEM = DBNAME ISPEXEC TBSCAN PROJECT ARGLIST(TESTPROD,PRJELEM) + CONDLIST(EQ,EQ) SET DBNAME = &PRJPARM ISPEXEC TBTOP PROJECT SET PRJELEM = DICTNAME ISPEXEC TBSCAN PROJECT ARGLIST(TESTPROD,PRJELEM) + CONDLIST(EQ,EQ) SET DICT = &PRJPARM ISPEXEC TBTOP PROJECT SET PRJELEM = SYSCTL ISPEXEC TBSCAN PROJECT ARGLIST(TESTPROD,PRJELEM) + CONDLIST(EQ,EQ) SET SCTL = &STR('&PRJPARM') ISPEXEC TBTOP PROJECT ISPEXEC TBSORT PROJECT FIELDS(PRJQUAL,C,A) SET TESTPROD = T SET PRJELEM = STEPLIB SET PRJQUAL = IDMS SET SLIB = SET CALLLIB = ISPEXEC TBSCAN PROJECT ARGLIST(TESTPROD,PRJELEM,PRJQUAL) + CONDLIST(EQ,EQ,GE) DO WHILE &LASTCC = 0 SET SLIB = &STR(&SLIB '&PRJPARM') IF &CALLLIB = THEN + DO ISPEXEC LMINIT DATAID(IDMSDID) DATASET('&PRJPARM') ENQ(SHR) ISPEXEC LMOPEN DATAID(&IDMSDID) ISPEXEC LMMFIND DATAID(&IDMSDID) MEMBER(RHDCMPUT) IF &LASTCC < 8 THEN SET CALLLIB = &PRJPARM ISPEXEC LMCLOSE DATAID(&IDMSDID) ISPEXEC LMFREE DATAID(&IDMSDID) END ISPEXEC TBSCAN PROJECT ARGLIST(TESTPROD,PRJELEM,PRJQUAL) + CONDLIST(EQ,EQ,GE) END ISPEXEC TBEND PROJECT FREE DDNAME(SYSCTL) ALLOC DD(SYSCTL) + DSN(&SCTL) + SHR KEEP FREE ATTRLIST(ATTRIB3) ATTRIB ATTRIB3 OUTPUT + RECFM(F B) + LRECL(80) + DSORG(PS) FREE DDNAME(SYSIPT) DELETE SYSIPT ALLOC DD(SYSIPT) + DSN(SYSIPT) + NEW CATALOG + UNIT(SYSDA) + SPACE(1,1) AVBLOCK(10796) RELEASE + USING(ATTRIB3) OPENFILE SYSIPT OUTPUT SET SYSIPT = &STR( *RETRIEVAL ) PUTFILE SYSIPT SET SYSIPT = &STR( SCHEMA SECTION.) PUTFILE SYSIPT SET SYSIPT = &STR( DB &SSCHEMA WITHIN &SCHEMA..) PUTFILE SYSIPT SET SYSIPT = &STR( COPY IDMS &REC..) PUTFILE SYSIPT CLOSFILE SYSIPT FREE ATTRLIST(ATTRIB4) ATTRIB ATTRIB4 OUTPUT + RECFM(F B A) + LRECL(133) + DSORG(PS) FREE DDNAME(SYSLST) DELETE SYSLST ALLOC DD(SYSLST) + DSN(SYSLST) + NEW CATALOG + UNIT(SYSDA) + SPACE(5,5) AVBLOCK(10796) RELEASE + USING(ATTRIB4) FREE DDNAME(SYSIPT) ALLOC DD(SYSIPT) + DSN(SYSIPT) + SHR KEEP FREE ATTRLIST(ATTRIB1) ATTRIB ATTRIB1 + DSORG(PS) + LRECL(80) + RECFM(F B) + OUTPUT FREE DDNAME(SYSPCH) IF &SWITCH1 = &STR(ON) THEN + DO SET PREFEND = &SUBSTR(5:7,&SYSUID) ALLOCATE DDNAME(SYSPCH) + DSNAME('&DSN($$GM&PREFEND)') + SHR KEEP END ELSE + DO SET RECDSN = &STR(&SYSUID..TEMP.GETDBREC.OUTPUT) DELETE '&RECDSN' ALLOCATE DDNAME(SYSPCH) + DSNAME('&RECDSN') + NEW CATALOG + UNIT(SYSDA) + SPACE(40,10) AVBLOCK(10796) RELEASE + USING(ATTRIB1) END FREE DDNAME(SYSOUT) IF &DBGSWTCH = ON THEN + ALLOC DD(SYSOUT) DSN(*) ELSE + ALLOC DD(SYSOUT) DUMMY STEPLIB SET DSNAME(&SLIB) CALL '&CALLLIB(IDMSDMLC)' 'DBNAME IS &DBNAME' SET SAVECC = &LASTCC STEPLIB RESET ALL FREE DDNAME(SYSCTL) FREE ATTRLIST(ATTRIB1) FREE ATTRLIST(ATTRIB3) FREE ATTRLIST(ATTRIB4) FREE DDNAME(SYSIPT) FREE DDNAME(SYSOUT) FREE DDNAME(SYSLST) IF &SAVECC > 4 THEN + DO SET ZEDLMSG = &STR(*** RC = &SAVECC FROM IDMSDMLC ***) ISPEXEC SETMSG MSG(UTLZ001) ISPEXEC BROWSE DATASET(SYSLST) EXIT END IF &SWITCH1 = &STR(ON) THEN + DO IF &LINECMD = A THEN + ISREDIT MOVE $$GM&PREFEND AFTER .ZFRANGE ELSE + ISREDIT MOVE $$GM&PREFEND BEFORE .ZLRANGE GOTO MSGSEC END ERROR DO SET ERRCC = &LASTCC IF &ERRCC = 400 THEN + DO SET EOF = YES RETURN END ELSE + IF &ERRCC > 12 THEN + DO WRITE *** ERROR CODE WAS : &ERRCC WRITE *** LAST COMMAND : &SYSPCMD WRITE *** LAST SUBCOMMAND : &SYSSCMD CLOSFILE SYSPCH FREE DDNAME(SYSPCH) DELETE SYSPCH SET ZEDSMSG = &STG(ERROR IN GETDBREC) ISPEXEC SETMSG MSG(UTLZ001) EXIT END ELSE RETURN END OPENFILE SYSPCH INPUT SET EOF = NO GETFILE SYSPCH ISREDIT (LINENUM) = LINENUM .ZFRANGE SET LINENUM = &LINENUM + 1 ISREDIT CURSOR = &LINENUM 1 SET LINECNT = 0 DO WHILE &EOF = NO IF &LINECMD = A THEN + ISREDIT LINE_BEFORE .ZCSR = (SYSPCH) ELSE + ISREDIT LINE_BEFORE .ZLRANGE = (SYSPCH) SET LINECNT = &LINECNT + 1 GETFILE SYSPCH END ERROR OFF CLOSFILE SYSPCH MSGSEC: + FREE DDNAME(SYSPCH) ISREDIT CURSOR = &SLN &SCL IF &LINECMD = A THEN + DO ISREDIT FIND FIRST P'=' .ZFRANGE .ZFRANGE ISREDIT FIND NEXT P'=' 1 END ELSE + DO ISREDIT FIND FIRST P'=' .ZLRANGE .ZLRANGE ISREDIT UP 5 ISREDIT FIND FIRST P'=' .ZLRANGE .ZLRANGE END SET STRING = &STR(**************************************************) ISREDIT LINE_BEFORE .ZCSR = MSGLINE '&STRING' SET STRING = &STR(* THIS IS THE COBOL LAYOUT FOR : &REC) ISREDIT LINE_BEFORE .ZCSR = MSGLINE '&STRING' SET STRING = &STR(* IT IS FROM DB : &DBNAME) ISREDIT LINE_BEFORE .ZCSR = MSGLINE '&STRING' SET STRING = &STR(**************************************************) ISREDIT LINE_BEFORE .ZCSR = MSGLINE '&STRING' SET ZEDSMSG = &STR(&MAP COPIED) ISPEXEC SETMSG MSG(UTLZ000) EXIT 02470000 HELPSEC: + 02480000 ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) 02490000 SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR GETDBREC UTILITY + 02490000 *** NO PROCESSING PERFORMED ***) 02490000 ISPEXEC SETMSG MSG(UTLZ000) 02490000 EXIT ./ ADD NAME=GETHELP PROC 1 COMMAND MAXLINES(80) HELP CONTROL NOFLUSH MSG ASIS /********************************************************************** /* UTILITY : GETHELP * /* AUTHOR : DAVE MONTGOMERY * /* FUNCTION : TRAP THE MESSAGES FROM A TSO "HELP" COMMAND AND LOAD * /* THEM INTO A DATASET. * /********************************************************************** CLEAR /* ERROR DO SET RC = &LASTCC ERROR OFF WRITE *** WRITE *** ERROR (&RC) IN &SYSICMD,&SYSPCMD IF &DATATYPE(&RC) = NUM THEN EXIT CODE(&RC) ELSE EXIT CODE(16) END /* ATTN DO SET CMD = &STR() &CMD EXIT CODE(0) END /* SET COMMAND = &SYSCAPS(&STR(&COMMAND)) IF &COMMAND = &STR(?) THEN GOTO HELP IF &HELP = HELP THEN GOTO HELP /* SET HNA = &STR(HELP NOT AVAILABLE) IF &DATATYPE(&MAXLINES) = NUM THEN - IF &MAXLINES = 80 OR - &MAXLINES = 60 THEN GOTO START WRITE *** INVALID PARAMETER MAXLINES(&STR(&MAXLINES)) WRITE *** GETHELP NOT PROCESSED GOTO EXIT /* START: - SET SYSOUTTRAP = 9999 HELP &COMMAND SET MAXOUT = &SYSOUTLINE IF &MAXOUT = 0 THEN GOTO ERROR SET TEXT = &STR(&SYSOUTLINE1) SET L = &LENGTH(&STR(&TEXT)) IF &L > 17 THEN - IF &SYSINDEX(&STR(&HNA),&STR(&TEXT)) > 0 THEN - GOTO ERROR /* SET TITLE = &STR( ---------- HELP TEXT FOR TSO COMMAND &COMMAND ) SET FILENAME = &STR(&SYSUID..TEMP.&COMMAND) IF &SYSDSN('&FILENAME') = OK THEN DELETE '&FILENAME' ALLOCATE DATASET('&FILENAME') FILE(OUT) NEW CATALOG RECFM(F B A) - LRECL(80) BLKSIZE(6160) UNIT(SYSDA) VOLUME(WRK$$$) + SPACE(5 2) RELEASE OPENFILE OUT OUTPUT SET P = 99 /* SET N = 2 DO WHILE &N <= &MAXOUT IF &P > &MAXLINES THEN - DO SET OUT = &STR(1 ) PUTFILE OUT SET OUT = &STR(&TITLE) PUTFILE OUT SET OUT = &STR( ) PUTFILE OUT SET P = 4 END SET OUT = &STR( &SYSNSUB(2,&&SYSOUTLINE&N)) PUTFILE OUT SET N = &N + 1 SET P = &P + 1 END /* CLOSFILE OUT FREE FILE(OUT) ERROR OFF ISPEXEC EDIT DATASET('&FILENAME') GOTO EXIT /* HELP: - WRITE *** HELP FOR CLIST GETHELP WRITE WRITE FORMAT: GETHELP MAXLINES(NN) WRITE WRITE IS ANY VALID TSO COMMAND WHICH HAS HELP WRITE AVAILABLE THROUGH THE TSO HELP COMMAND WRITE WRITE MAXLINES IS AN OPTIONAL PARAMETER TO SET PAGE LENGTH WRITE NN MAY BE EITHER 60 OR 80 (DEFAULT IS 80) WRITE WRITE GETHELP WILL CAPTURE THE HELP TEXT THAT IS NORMALLY WRITE DISPLAYED ON THE USER'S TERMINAL WHEN THE TSO HELP WRITE COMMAND IS ENTERED. THE TEXT IS STORED IN THE USER WRITE FILE &SYSUID..TEMP.. A PAGE TITLE AND WRITE CARRIAGE CONTROL CHARACTERS ARE ALSO INSERTED IN THE WRITE FILE SO THAT IT MAY BE PRINTED. WRITE WRITE *** END OF HELP GOTO EXIT /* ERROR: - WRITE *** HELP NOT AVAILABLE WRITE *** COMMAND &STR(&COMMAND) NOT FOUND EXIT: - EXIT ./ ADD NAME=GETJCL ISREDIT MACRO ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /* ISREDIT FIND PREV '|' ISREDIT FIND NEXT P'.' ISREDIT (LN1,CL1) = CURSOR ISREDIT FIND '|' ISREDIT FIND PREV P'.' ISREDIT (LN2,CL2) = CURSOR ISREDIT (MEMBER) = LINE .ZCSR SET MEMBER = &SUBSTR(&CL1:&CL2,&STR(&MEMBER)) ISPEXEC EDIT DATASET('D@UDAL.STR.JCLLIB(&MEMBER)') ./ ADD NAME=GETLOAN ISREDIT MACRO ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ISREDIT (LN,CL) = CURSOR IF &LN = 1 AND &CL = 0 THEN + DO SET ZEDLMSG = &STR(YOU MUST PUT YOUR CURSOR ON A LOAN LINE) ISPEXEC SETMSG MSG(UTLZ001) EXIT CODE(12) END ISREDIT F PREV ' ACQUISITION: ' ISREDIT FIND NEXT P'.' .ZCSR .ZCSR ISREDIT FIND NEXT ' ' .ZCSR .ZCSR ISREDIT FIND NEXT P'.' .ZCSR .ZCSR ISREDIT (NULL,COL1) = CURSOR ISREDIT FIND NEXT ' ' .ZCSR .ZCSR ISREDIT FIND PREV P'.' .ZCSR .ZCSR ISREDIT (NULL,COL2) = CURSOR ISREDIT (ACQNUM) = LINE .ZCSR SET ACQNUM = &SUBSTR(&COL1:&COL2,&STR(&ACQNUM)) ISREDIT CURSOR = &LN 1 ISREDIT FIND FIRST P'.' .ZCSR .ZCSR ISREDIT (NULL,COL1) = CURSOR ISREDIT FIND NEXT ' ' .ZCSR .ZCSR ISREDIT FIND PREV P'.' .ZCSR .ZCSR ISREDIT (NULL,COL2) = CURSOR ISREDIT FIND NEXT ' ' .ZCSR .ZCSR ISREDIT FIND NEXT P'.' .ZCSR .ZCSR ISREDIT (NULL,COL3) = CURSOR ISREDIT (LINE) = LINE .ZCSR SET SSN = &SUBSTR(&COL1:&COL2,&STR(&LINE)) SET SSN = &SUBSTR(1:3,&STR(&SSN))+ &SUBSTR(5:6,&STR(&SSN))+ &SUBSTR(8:11,&STR(&SSN)) SET LOANNUM = &SUBSTR(&COL3:&COL3,&STR(&LINE)) FREE DD(INSALE OUTSALE INLAD OUTLAD) DELETE '&SYSPREF..TEMP.GETLOAN' ALLOC DD(INLAD) DSN('USC10.SLSS.LADMSTR') SHR ALLOC DD(INSALE) DSN('USC10.SLSS.SALE.PATH1') SHR ALLOC DD(OUTLAD) DSN('&SYSPREF..TEMP.GETLOAN') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK005) + SPACE(1,1) TRACKS RELEASE + RECFM(V B) LRECL(5994) BLKSIZE(17982) DSORG(PS) ALLOC DD(OUTSALE) NEW + UNIT(SYSDA) VOLUME(WRK005) + SPACE(1,1) TRACKS RELEASE + RECFM(F B) LRECL(400) BLKSIZE(23200) DSORG(PS) REPRO INFILE(INLAD) OUTFILE(OUTLAD) + FROMKEY(&STR(&ACQNUM&SSN&LOANNUM))+ TOKEY(&STR(&ACQNUM&SSN&LOANNUM)) REPRO INFILE(INSALE) OUTFILE(OUTSALE) + FROMKEY(&STR(&SSN&LOANNUM&ACQNUM))+ TOKEY(&STR(&SSN&LOANNUM&ACQNUM)) FREE DD(INLAD OUTLAD INSALE) OPENFILE OUTSALE GETFILE OUTSALE ISPEXEC VPUT OUTSALE SHARED CLOSFILE OUTSALE FREE DD(OUTSALE) ALLOC DD(OUTSALE) DSN('&SYSPREF..TEMP.GETLOAN') MOD OPENFILE OUTSALE OUTPUT ISPEXEC VGET OUTSALE SHARED PUTFILE OUTSALE CLOSFILE OUTSALE FREE DD(OUTSALE) ISPEXEC BROWSE DATASET('&SYSPREF..TEMP.GETLOAN') ./ ADD NAME=GETMAP ISREDIT MACRO NOPROCESS (MAP) ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT IF &STR(MAP) = &STR(HELP) THEN GOTO HELPSEC /******************************************************************/ /* 'GETMAP' EDIT MACRO. DECOMPILE A MAP INTO YOUR EDIT SESSION. */ /* AUTHOR : DAVID LEIGH DATE : 08-02-90 */ /******************************************************************/ ISREDIT PROCESS RANGE A B SET PROCCC = &LASTCC IF &PROCCC > 3 THEN + IF &PROCCC = 16 THEN SET LINECMD = A ELSE + DO SET ZEDLMSG = &STR(LINE COMMAND 'A' OR 'B' MUST BE + SPECIFIED) ISPEXEC SETMSG MSG(UTLZ001) EXIT END ELSE + ISREDIT (LINECMD) = RANGE_CMD /* CHECK TO MAKE SURE WE'RE ON THE RIGHT CPU WTSPXSET * NAMES(SYSID) IF &SYSID = &STR(P310) THEN ELSE + DO SET ZEDLMSG = &STR(GETMAP IS ONLY VALID ON CPU P310 *** + YOU ARE ON &SYSID CURRENTLY) ISPEXEC SETMSG MSG(UTLZ001) EXIT END WRITE *** SET UP FOR CALL TO RHDCMPUT FOR MAP &MAP *** WRITE ISREDIT (SLN,SCL) = CURSOR ISREDIT (DSN) = DATASET ISREDIT (MBR) = MEMBER LISTDSI '&DSN' IF &SYSINDEX(&STR(PO),&STR(&SYSDSORG)) > 0 AND + &SYSLRECL = 80 THEN + SET SWITCH1 = &STR(ON) IF &STR(&MAP) = THEN + DO CLEARSCR WRITE ********************************************************** WRITE * NOTE : THE MAP NAME CAN BE ENTERED WHEN THE EDIT * WRITE * MACRO IS INVOKED. SYNTAX WOULD BE AS FOLLOWS : * WRITE * COMMAND ===> GETMAP CTCUI200 * WRITE ********************************************************** WRITE WRITENR ENTER MAP NAME HERE => READ MAP IF &LENGTH(&STR(&MAP)) = 0 THEN + DO SET ZEDLMSG = &STR(NO MAP NAME ENTERED *** + NO PROCESSING PERFORMED) ISPEXEC SETMSG MSG(UTLZ001) EXIT END END /********************************************************************** /* THE FOLLOWING PROCESS WHICH ACCESS THE TABLE "PROJECT" COULD BE * /* REPLACED WITH SET STATEMENTS TO SET UP THE FOLLOWING VARIABLES : * /* "SCT" = THE SYSCTL DATASET NAME FOR THE CV SPECIFIED. * /* "SLIB" = THE IDMS STEPLIB FOR EXECUTING OLQBATCH FOR THE CV * /* SPECIFIED. THIS IS A LIST OF FULLY QUALIFIED DATASETS WITH* /* SINGLE QUOTES AND DELIMITED BY SPACES. * /* I.E. 'IDMS.CV99.TMPLIB' 'IDMS.CV99.LOADLIB' * /********************************************************************** ISPEXEC TBOPEN PROJECT NOWRITE ISPEXEC TBVCLEAR PROJECT SET TESTPROD = T SET PRJELEM = DBNAME ISPEXEC TBSCAN PROJECT ARGLIST(TESTPROD,PRJELEM) + CONDLIST(EQ,EQ) SET DBNAME = &PRJPARM ISPEXEC TBTOP PROJECT SET PRJELEM = DICTNAME ISPEXEC TBSCAN PROJECT ARGLIST(TESTPROD,PRJELEM) + CONDLIST(EQ,EQ) SET DICT = &PRJPARM ISPEXEC TBTOP PROJECT SET PRJELEM = SYSCTL ISPEXEC TBSCAN PROJECT ARGLIST(TESTPROD,PRJELEM) + CONDLIST(EQ,EQ) SET SCTL = &STR('&PRJPARM') ISPEXEC TBTOP PROJECT ISPEXEC TBSORT PROJECT FIELDS(PRJQUAL,C,A) SET TESTPROD = T SET PRJELEM = STEPLIB SET PRJQUAL = IDMS SET SLIB = SET CALLLIB = ISPEXEC TBSCAN PROJECT ARGLIST(TESTPROD,PRJELEM,PRJQUAL) + CONDLIST(EQ,EQ,GE) DO WHILE &LASTCC = 0 SET SLIB = &STR(&SLIB '&PRJPARM') IF &CALLLIB = THEN + DO ISPEXEC LMINIT DATAID(IDMSDID) DATASET('&PRJPARM') ENQ(SHR) ISPEXEC LMOPEN DATAID(&IDMSDID) ISPEXEC LMMFIND DATAID(&IDMSDID) MEMBER(RHDCMPUT) IF &LASTCC < 8 THEN SET CALLLIB = &PRJPARM ISPEXEC LMCLOSE DATAID(&IDMSDID) ISPEXEC LMFREE DATAID(&IDMSDID) END ISPEXEC TBSCAN PROJECT ARGLIST(TESTPROD,PRJELEM,PRJQUAL) + CONDLIST(EQ,EQ,GE) END ISPEXEC TBEND PROJECT FREE ATTRLIST(ATTRIB1) ATTRIB ATTRIB1 + DSORG(PS) + LRECL(80) + RECFM(F B) + OUTPUT FREE ATTRLIST(ATTRIB2) ATTRIB ATTRIB2 + DSORG(PS) + LRECL(133) + RECFM(F B A) + OUTPUT DELETE SYSIPT.SYSIN FREE DDNAME(SYSIPT) FREE DDNAME(SYSCTL) FREE DDNAME(SYSLST) FREE DDNAME(SYSPCH) ALLOCATE DD(SYSCTL) + DSN(&SCTL) + SHR KEEP IF &SWITCH1 = &STR(ON) THEN + DO SET PREFEND = &SUBSTR(5:7,&SYSUID) ALLOCATE DDNAME(SYSPCH) + DSNAME('&DSN($$GM&PREFEND)') + SHR KEEP END ELSE + DO SET MAPDSN = &STR(&SYSUID..TEMP.GETMAP.OUTPUT) DELETE '&MAPDSN' ALLOCATE DDNAME(SYSPCH) + DSNAME('&MAPDSN') + NEW CATALOG + UNIT(SYSDA) + SPACE(40,10) AVBLOCK(10796) RELEASE + USING(ATTRIB1) END SET MAPLST = &STR(&SYSUID..TEMP.SYSLST) DELETE '&MAPLST' ALLOCATE DDNAME(SYSLST) + DSNAME('&MAPLST') + NEW CATALOG + UNIT(SYSDA) + SPACE(10,5) AVBLOCK(10796) RELEASE + USING(ATTRIB2) ALLOCATE DD(SYSIPT) + DSN(SYSIPT.SYSIN) + NEW CATALOG + UNIT(SYSDA) + SPACE(10,5) AVBLOCK(10796) RELEASE + USING(ATTRIB1) FREE DDNAME(CDMSLIB) ALLOCATE DD(CDMSLIB) + DSN(&SLIB) + SHR KEEP STEPLIB SET DSNAME(&SLIB) OPENFILE SYSIPT OUTPUT SET &SYSIPT = &STR(PROCESS=DECOMPILE) PUTFILE SYSIPT SET &SYSIPT = &STR(PANEL=&MAP-OLMPANEL) PUTFILE SYSIPT SET &SYSIPT = &STR(MAP=&MAP) PUTFILE SYSIPT CLOSFILE SYSIPT WRITE *** CALL RHDCMPUT *** WRITE CALL '&CALLLIB(RHDCMPUT)' 'DBNAME IS &DBNAME' SET RC = &LASTCC STEPLIB RESET ALL FREE ATTRLIST(ATTRIB1) FREE ATTRLIST(ATTRIB2) FREE ATTRLIST(ATTRIB3) FREE DDNAME(CDMSLIB) FREE DDNAME(SYSIPT) FREE DDNAME(SYSCTL) FREE DDNAME(SYSLST) DELETE SYSIPT.SYSIN IF &RC > 4 THEN + DO SET ZEDLMSG = &STR(DECOMPILE OF "&MAP" FAILED - RHDCMPUT CC = + &RC) ISPEXEC SETMSG MSG(UTLZ001) ISPEXEC BROWSE DATASET('&MAPLST') EXIT END IF &MBR > THEN SET DSN = &STR(&DSN(&MBR)) WRITE *** LOAD THE MAP INTO &DSN *** WRITE IF &SWITCH1 = &STR(ON) THEN + DO FREE DDNAME(SYSPCH) IF &LINECMD = A THEN + ISREDIT MOVE $$GM&PREFEND AFTER .ZFRANGE ELSE + ISREDIT MOVE $$GM&PREFEND BEFORE .ZLRANGE GOTO MSGSEC END ERROR DO IF &LASTCC = 400 THEN + DO SET EOF = YES RETURN END ELSE + DO WRITE *** ERROR CODE WAS : &LASTCC WRITE *** LAST COMMAND : &SYSPCMD WRITE *** LAST SUBCOMMAND : &SYSSCMD CLOSFILE SYSPCH FREE DDNAME(SYSPCH) DELETE SYSPCH SET ZEDSMSG = &STG(ERROR IN GETMAP) ISPEXEC SETMSG MSG(UTLZ001) EXIT END END OPENFILE SYSPCH INPUT SET EOF = NO GETFILE SYSPCH ISREDIT (LINENUM) = LINENUM .ZFRANGE SET LINENUM = &LINENUM + 1 ISREDIT CURSOR = &LINENUM 1 SET LINECNT = 0 DO WHILE &EOF = NO IF &LINECMD = A THEN + ISREDIT LINE_BEFORE .ZCSR = (SYSPCH) ELSE + ISREDIT LINE_BEFORE .ZLRANGE = (SYSPCH) SET LINECNT = &LINECNT + 1 GETFILE SYSPCH END ERROR OFF CLOSFILE SYSPCH MSGSEC: + ISREDIT CURSOR = &SLN &SCL IF &LINECMD = A THEN + DO ISREDIT FIND FIRST P'=' .ZFRANGE .ZFRANGE ISREDIT FIND NEXT P'=' 1 END ELSE + DO ISREDIT FIND FIRST P'=' .ZLRANGE .ZLRANGE ISREDIT UP 5 ISREDIT FIND FIRST P'=' .ZLRANGE .ZLRANGE END SET STRING = &STR(**************************************************) ISREDIT LINE_BEFORE .ZCSR = MSGLINE '&STRING' SET STRING = &STR(* THIS IS THE DECOMPILED MAP CODE FOR : &MAP) ISREDIT LINE_BEFORE .ZCSR = MSGLINE '&STRING' SET STRING = &STR(* IT IS FROM DB : &DBNAME) ISREDIT LINE_BEFORE .ZCSR = MSGLINE '&STRING' SET STRING = &STR(**************************************************) ISREDIT LINE_BEFORE .ZCSR = MSGLINE '&STRING' SET ZEDSMSG = &STR(&MAP COPIED) ISPEXEC SETMSG MSG(UTLZ000) EXIT HELPSEC: + CLEARSCR WRITE *** HELP FOR EDIT MACRO : GETMAP *** WRITE WRITE THIS MACRO ALLOWS THE USER TO IMMEDIATELY COPY CMC IDMS MAPS WRITE INTO THE DATASET THEY ARE CURRENTLY EDITING. THE MAPS ARE IN WRITE THEIR DECOMPILED FORM, AND EDIT MACRO "PUTMAP" MAY BE USED TO WRITE RECOMPILE THEM INTO CV22. WRITE WRITE SYNTAX : WRITE WRITE COMMAND ===> GETMAP WRITE WRITE THIS WILL CAUSE THE MACRO TO PROMPT YOU FOR A VALID MAP NAME WRITE WRITE COMMAND ===> GETMAP CTCUI200 WRITE WRITE THIS WILL BRING A COPY OF CMC MAP CTCUI200 DIRECTLY INTO THE WRITE DATASET CURRENTLY BEING EDITED. WRITE WRITE *** YOU MUST BE ON P310 TO EXECUTE THIS EDIT MACRO *** WRITE WRITE *** END OF HELP *** NO PROCESSING PERFORMED *** EXIT ./ ADD NAME=GETME PROC 0 THISNODE(FIDELITY) GETMID() GETMPASS() GETMCLAS() + GETMNODE() GETMACDE() GETMDSN() REPEAT HELP /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT IF &HELP = HELP THEN GOTO HELPSEC /********************************************************************** /* CLIST : GETME * /* AUTHOR : DAVE LEIGH * /* FUNCTION : THIS CLIST SUBMITS A BATCH JOB TO RUN REMOTELY WHICH * /* EXECUTES A BATCH TRANSMIT AT THE REMOTE LOCATION TO * /* SEND A DATASET BACK TO THIS LOCATION. * /********************************************************************** /********************************************************************** /* INITIALIZE THE VARIABLES * /********************************************************************** SET JCLREVEW = N ISPEXEC VPUT JCLREVEW SHARED IF &STR(&THISNODE) = THEN + DO WRITENR ENTER THE NAME OF THIS JES NODE ( TO QUIT) ==> READ THISNODE IF &STR(&THISNODE) = THEN EXIT END IF &STR(&GETMNODE) = THEN ISPEXEC VGET GETMNODE PROFILE IF &STR(&GETMID) = THEN ISPEXEC VGET GETMID PROFILE IF &STR(&GETMPASS) = THEN ISPEXEC VGET GETMPASS PROFILE IF &STR(&GETMACDE) = THEN ISPEXEC VGET GETMACDE PROFILE IF &STR(&GETMCLAS) = THEN ISPEXEC VGET GETMCLAS PROFILE /********************************************************************** /* DISPLAY THE INPUT PANEL * /********************************************************************** REDISPLAY: + ISPEXEC DISPLAY PANEL(GETME) IF &LASTCC > 7 THEN EXIT /********************************************************************** /* CREATE/EDIT OR EXECUTE THE JCL * /********************************************************************** SET ZEDLMSG = &STR(*** CREATING THE JCL ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) IF &JCLREVEW = &STR(Y) THEN + DO DELETE TEMP.JCL FREE DDNAME(ISPFILE QUICK) ALLOCATE DDNAME(QUICK) + DSN(TEMP.JCL) + NEW CATALOG + UNIT(TSTDA) + SPACE(1,1) TRACKS RELEASE + RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS) FREE DDNAME(QUICK) ALLOCATE DDNAME(ISPFILE) + DSN(TEMP.JCL) + OLD ISPEXEC FTOPEN ISPEXEC FTINCL GETME SET SAVECC = &LASTCC ISPEXEC FTCLOSE FREE DDNAME(ISPFILE) SET ZEDLMSG = &STR(*** JCL CREATION FAILED. RC = &SAVECC ***) IF &SAVECC > 0 THEN ISPEXEC SETMSG MSG(UTLZ001) ELSE + DO SET ZEDLMSG = &STR(*** NOTE: YOU MUST SUBMIT THE JOB + YOURSELF ***) ISPEXEC SETMSG MSG(UTLZ000) ISPEXEC EDIT DATASET(TEMP.JCL) END END ELSE + DO ISPEXEC FTOPEN TEMP ISPEXEC FTINCL GETME SET SAVECC = &LASTCC ISPEXEC FTCLOSE SET ZEDLMSG = &STR(*** JCL CREATION FAILED. RC = &SAVECC ***) IF &SAVECC > 0 THEN ISPEXEC SETMSG MSG(UTLZ001) ELSE + DO SET ZEDSMSG = &STR(JOB SUBMITTED) SET ZEDLMSG = &STR("&SYSUID.G" SUBMITTED TO GET "&GETMDSN" + FROM "&GETMNODE") ISPEXEC SETMSG MSG(UTLZ000) ISPEXEC VGET ZTEMPF SUBMIT '&ZTEMPF' END END IF &REPEAT = REPEAT THEN GOTO REDISPLAY EXIT HELPSEC: + 02480000 ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) 02490000 SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR GETME UTILITY + 02490000 *** NO PROCESSING PERFORMED ***) 02490000 ISPEXEC SETMSG MSG(UTLZ000) 02490000 EXIT ./ ADD NAME=GETMOD ISREDIT MACRO (MOD) ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT IF &STR(MOD) = &STR(HELP) THEN GOTO HELPSEC /******************************************************************/ /* 'GETMOD' EDIT MACRO. RETRIEVE A MODULE FROM THE IDD 'AS SYNTAX'*/ /* AUTHOR : DAVID LEIGH DATE : 02-20-89 */ /******************************************************************/ /* CHECK TO MAKE SURE WE'RE ON THE RIGHT CPU TSOPXSET * NAMES(SYSID) IF &SYSID = &STR(P310) THEN ELSE + DO SET ZEDLMSG = &STR(GETMOD IS ONLY VALID ON CPU P310 *** + YOU ARE ON &SYSID CURRENTLY) ISPEXEC SETMSG MSG(UTLZ001) EXIT END ISREDIT (SLN,SCL) = CURSOR ISREDIT (DSN) = DATASET LISTDSI '&DSN' IF &SYSINDEX(&STR(PO),&STR(&SYSDSORG)) > 0 AND + &SYSLRECL = 80 THEN + SET SWITCH1 = &STR(ON) IF &STR(&MOD) = THEN + DO CLEARSCR WRITE ********************************************************** WRITE * NOTE : THE MODULE NAME CAN BE ENTERED WHEN THE EDIT * WRITE * MACRO IS INVOKED. SYNTAX WOULD BE AS FOLLOWS : * WRITE * COMMAND ===> GETMOD XXXXXXXX * WRITE ********************************************************** WRITE WRITENR ENTER MODULE NAME HERE => READ MOD IF &LENGTH(&STR(&MOD)) = 0 THEN + DO SET ZEDLMSG = &STR(NO MODULE NAME ENTERED *** + NO PROCESSING PERFORMED) ISPEXEC SETMSG MSG(UTLZ001) EXIT END END SET ZEDLMSG = &STR(*** PREPARING TO EXTRACT "&MOD" FROM THE IDD ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) /********************************************************************** /* THE FOLLOWING PROCESS WHICH ACCESS THE TABLE "PROJECT" COULD BE * /* REPLACED WITH SET STATEMENTS TO SET UP THE FOLLOWING VARIABLES : * /* "SCT" = THE SYSCTL DATASET NAME FOR THE CV SPECIFIED. * /* "SLIB" = THE IDMS STEPLIB FOR EXECUTING OLQBATCH FOR THE CV * /* SPECIFIED. THIS IS A LIST OF FULLY QUALIFIED DATASETS WITH* /* SINGLE QUOTES AND DELIMITED BY SPACES. * /* I.E. 'IDMS.CV99.TMPLIB' 'IDMS.CV99.LOADLIB' * /********************************************************************** ISPEXEC TBOPEN PROJECT NOWRITE ISPEXEC TBVCLEAR PROJECT SET TESTPROD = T SET PRJELEM = DBNAME ISPEXEC TBSCAN PROJECT ARGLIST(TESTPROD,PRJELEM) + CONDLIST(EQ,EQ) SET DBNAME = &PRJPARM ISPEXEC TBTOP PROJECT SET PRJELEM = DICTNAME ISPEXEC TBSCAN PROJECT ARGLIST(TESTPROD,PRJELEM) + CONDLIST(EQ,EQ) SET DICT = &PRJPARM ISPEXEC TBTOP PROJECT SET PRJELEM = SYSCTL ISPEXEC TBSCAN PROJECT ARGLIST(TESTPROD,PRJELEM) + CONDLIST(EQ,EQ) SET SCTL = &STR('&PRJPARM') ISPEXEC TBTOP PROJECT ISPEXEC TBSORT PROJECT FIELDS(PRJQUAL,C,A) SET TESTPROD = T SET PRJELEM = STEPLIB SET PRJQUAL = IDMS SET SLIB = ISPEXEC TBSCAN PROJECT ARGLIST(TESTPROD,PRJELEM,PRJQUAL) + CONDLIST(EQ,EQ,GE) DO WHILE &LASTCC = 0 SET SLIB = &STR(&SLIB '&PRJPARM') ISPEXEC TBSCAN PROJECT ARGLIST(TESTPROD,PRJELEM,PRJQUAL) + CONDLIST(EQ,EQ,GE) END ISPEXEC TBEND PROJECT FREE ATTRLIST(FB80 FBA133) ATTRIB FB80 DSORG(PS) LRECL(80) RECFM(F B) OUTPUT ATTRIB FBA133 DSORG(PS) LRECL(133) RECFM(F B A) OUTPUT DELETE SYSIPT.SYSIN FREE DDNAME(SYSIPT SYSCTL SYSLST SYSPCH) ALLOCATE DD(SYSCTL) + DSN(&SCTL) + SHR KEEP IF &SWITCH1 = &STR(ON) THEN + DO SET PREFEND = &SUBSTR(5:7,&SYSUID) ALLOCATE DDNAME(SYSPCH) + DSNAME('&DSN($$GM&PREFEND)') + SHR KEEP END ELSE + DO SET IDDDSN = &STR(&SYSUID..TEMP.GETMOD.OUTPUT) DELETE '&IDDDSN' ALLOCATE DDNAME(SYSPCH) + DSNAME('&IDDDSN') + NEW CATALOG + UNIT(SYSDA) + SPACE(10,5) AVBLOCK(10796) RELEASE + USING(FB80) END SET IDDLST = &STR(&SYSUID..TEMP.SYSLST) DELETE '&IDDLST' ALLOCATE DDNAME(SYSLST) + DSNAME('&IDDLST') + NEW CATALOG + UNIT(SYSDA) + SPACE(10,5) AVBLOCK(10796) RELEASE + USING(FBA133) ALLOCATE DD(SYSIPT) + DSN(SYSIPT.SYSIN) + NEW CATALOG + UNIT(SYSDA) + SPACE(10,5) AVBLOCK(10796) RELEASE + USING(FB80) OPENFILE SYSIPT OUTPUT STEPLIB SET DSNAME(&SLIB) SET &SYSIPT = &STR( SIGNON USE &SYSUID DIC &DICT DBN &DBNAME..) PUTFILE SYSIPT SET &SYSIPT = &STR( PUN MOD &MOD AS SYNTAX.) PUTFILE SYSIPT SET &SYSIPT = &STR( BYE.) PUTFILE SYSIPT CLOSFILE SYSIPT SET ZEDLMSG = &STR(*** EXTRACTING "&MOD" FROM "&DICT" ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) IDMSDDDL SET RC = &LASTCC SET ZEDLMSG = &STR(*** COPYING EXTRACTED "&MOD" INTO THIS FILE ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) STEPLIB RESET ALL FREE ATTRLIST(FB80 FBA133) FREE DDNAME(SYSIPT SYSCTL SYSLST) DELETE SYSIPT.SYSIN IF &RC > 4 THEN + DO SET ZEDSMSG = &STR(IDMSDDDL FAILED - RC &RC) ISPEXEC SETMSG MSG(UTLZ000) ISPEXEC BROWSE DATASET('&IDDLST') EXIT END ELSE + DELETE '&IDDLST' IF &SWITCH1 = &STR(ON) THEN + DO FREE DDNAME(SYSPCH) ISREDIT MOVE $$GM&PREFEND AFTER .ZCSR SET STRING = &STR(MODULE "&MOD" IS FROM &DICT) ISREDIT LINE_BEFORE .ZCSR = MSGLINE '&STRING' SET ZEDSMSG = &STR(&MOD COPIED) ISPEXEC SETMSG MSG(UTLZ000) EXIT END ERROR DO IF &LASTCC = 400 THEN + DO SET EOF = YES RETURN END ELSE + DO WRITE *** ERROR CODE WAS : &LASTCC WRITE *** LAST COMMAND : &SYSPCMD WRITE *** LAST SUBCOMMAND : &SYSSCMD CLOSFILE SYSPCH FREE DDNAME(SYSPCH) DELETE SYSPCH SET ZEDSMSG = &STG(ERROR IN GETMOD) ISPEXEC SETMSG MSG(UTLZ001) EXIT END END OPENFILE SYSPCH INPUT SET EOF = NO GETFILE SYSPCH SET LINECNT = 0 ISREDIT LABEL &EVAL(&SLN + 1) = .TMPGM DO WHILE &EOF = NO ISREDIT LINE_BEFORE .TMPGM = (SYSPCH) SET LINECNT = &LINECNT + 1 GETFILE SYSPCH END ERROR OFF CLOSFILE SYSPCH DELETE SYSPCH ISREDIT CURSOR = &SLN &SCL SET STRING = &STR(MODULE "&MOD" IS FROM &DICT) ISREDIT LINE_BEFORE .ZCSR = MSGLINE '&STRING' SET ZEDSMSG = &STR(&LINECNT LINES COPIED) ISPEXEC SETMSG MSG(UTLZ000) EXIT HELPSEC: + CLEARSCR WRITE *** HELP FOR EDIT MACRO : GETMOD *** WRITE WRITE THIS MACRO ALLOWS THE USER TO IMMEDIATELY COPY ADS/O DIALOG WRITE MODULES INTO THE DATASET THEY ARE CURRENTLY EDITING. WRITE WRITE SYNTAX : WRITE WRITE COMMAND ===> GETMOD WRITE WRITE THIS WILL CAUSE THE MACRO TO PROMPT YOU FOR A VALID MODULE NAME WRITE WRITE COMMAND ===> GETMOD XXXXXXXX WRITE WRITE THIS WILL BRING A COPY OF DIALOG MODULE XXXXXXXX DIRECTLY INTO WRITE THE DATASET CURRENTLY BEING EDITED. WRITE WRITE *** YOU MUST BE ON P310 TO EXECUTE THIS EDIT MACRO *** WRITE WRITE *** END OF HELP *** NO PROCESSING PERFORMED *** EXIT ./ ADD NAME=GETMSG ISREDIT MACRO (OPT1,OPT2) ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT FREE DD(INDD OUTDD) ALLOC DD(INDD) DSN('USC00.SLSS.MESSAGE') SHR DELETE TEMP.MESSAGE ALLOC DD(OUTDD) DSN(TEMP.MESSAGE) + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK005) + SPACE(1,1) TRACKS RELEASE + RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS) ISREDIT FIND FIRST P'=' 1 DO WHILE &LASTCC = 0 ISREDIT (LINE) = LINE .ZCSR SET KEY = &SUBSTR(1:7,&STR(&SYSNSUB(1,&LINE))) WRITE WORKING ON KEY &KEY REPRO IFILE(INDD) OFILE(OUTDD) FROMKEY(&KEY) TOKEY(&KEY) IF &LASTCC = 0 THEN + DO OPENFILE OUTDD GETFILE OUTDD ISREDIT LINE .ZCSR = (OUTDD) CLOSFILE OUTDD ISREDIT FIND LAST P'=' .ZCSR .ZCSR END ISREDIT FIND NEXT P'=' 1 END FREE DD(INDD OUTDD) ISREDIT CURSOR = 1 1 ./ ADD NAME=GETOUTPT /********************************************************************** /* UTILITY: GETOUTPT * /* AUTHOR: DAVID LEIGH * /* FUNCTION: THIS CLIST READS THE SDSF HELD QUEUE FOR THE JOB NAME YOU* /* SPECIFY AND LOADS ALL THE SYSOUT FOR EACH JOB WITH THAT * /* NAME, INTO A DATASET. * /********************************************************************** PROC 1 JOBNAME PERMANENT EDIT BROWSE UTILITY(GETOUTPT) /*** CHECK THE DEBUG SWITCH ***/ ISPEXEC VGET DBGSWTCH PROFILE IF &DBGSWTCH = ON THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS IF &PERMANENT = PERMANENT THEN SET VOLUME = ELSE SET VOLUME = &STR(VOLUME(WRK$$$)) FREE DD(TEMPDD) SET LP = &STR(( SET RP = &STR()) SET SYSOUTTRAP = 1000 CONTROL MSG STATUS &JOBNAME CONTROL NOMSG SET SYSOUTTRAP = 0 SET X = &SYSOUTLINE DO I = 1 TO &X SET SYSDVAL = &STR(&SYSNSUB(2,&&SYSOUTLINE&I)) READDVAL PARM JOBNAME NULL IF &PARM = JOB THEN + DO SET A = &SYSINDEX(&STR(&LP),&STR(&JOBNAME)) SET B = &SYSINDEX(&STR(&RP),&STR(&JOBNAME)) SET NODEA = &SUBSTR(1:&A-1,&STR(&JOBNAME)) SET NODEB = &SUBSTR(&A+1:&B-1,&STR(&JOBNAME)) SET JOBDSN = &STR(&SYSUID..JES.SYSOUT.&NODEA..&NODEB) SET ZEDLMSG = &STR(*** LOADING "&JOBNAME" + INTO "&JOBDSN" ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY PANEL(MSGPANEL) DELETE '&JOBDSN' ALLOC DD(TEMPDD) DSN('&JOBDSN') + NEW CATALOG &STR(&VOLUME) + UNIT(SYSDA) &VOLUME + SPACE(10,10) CYLINDERS RELEASE DSORG(PS) + RECFM(F B A) LRECL(255) BLKSIZE(23460) FREE DD(TEMPDD) OUTPUT &JOBNAME PRINT('&JOBDSN') HOLD KEEP END END IF &EDIT = EDIT THEN ISPEXEC EDIT DATASET('&JOBDSN') IF &BROWSE = BROWSE THEN ISPEXEC BROWSE DATASET('&JOBDSN') EXIT ./ ADD NAME=GETPR PROC 1 PR_NUMBER + DATABASE(USC00.SLSS.MAINTLG) + TEMPDATA(&SYSUID..TEMP.PRDATA) + TEMPFILE(&SYSUID..TEMP.PROJECT.REQUEST) /*** CHECK THE DEBUG SWITCH ***/ ISPEXEC VGET DBGSWTCH PROFILE IF &DBGSWTCH = ON THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS IF &STR(&PR_NUMBER) = HELP THEN GOTO HELPSEC /********************************************************************** /* UTILITY: GETPR * /* AUTHOR: DAVE LEIGH * /* FUNCTION: THIS UTILITY REPROS THE MAINTENANCE LOG FILE TO GATHER * /* INFORMATION ON A GIVEN PR #. THE INFORMATION IS THEN * /* PRESENTED IN A FILE WHICH THE USER IS BROUGHT INTO IN * /* AN EDIT SESSION. * /********************************************************************** SET ZEDLMSG = &STR(*** SEARCHING FOR PR "&PR_NUMBER" INFORMATION ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) /********************************************************************** /* ALLOCATE THE FILES AND REPRO THE SELECTED PR * /********************************************************************** FREE DD(PRDATA INDATA) DELETE '&TEMPDATA' DELETE '&TEMPFILE' ALLOC DD(PRDATA) DSN('&TEMPDATA') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK$$$) + SPACE(5,5) TRACKS RELEASE + RECFM(F B) LRECL(1630) DSORG(PS) ALLOC DD(INDATA) DSN('&DATABASE') SHR REPRO INFILE(INDATA) OUTFILE(PRDATA) + FROMKEY(&PR_NUMBER) TOKEY(&PR_NUMBER) IF &LASTCC > 8 THEN + DO FREE DD(INDATA PRDATA) SET ZEDLMSG = &STR(*** PR: "&PR_NUMBER" WAS NOT FOUND ***) ISPEXEC SETMSG MSG(UTLZ001) EXIT END SET ZEDLMSG = &STR(*** FORMATTING PR "&PR_NUMBER" TEXT ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) /********************************************************************** /* STORE THE DATA IN A VARIABLE * /********************************************************************** FREE DD(INDATA) OPENFILE PRDATA GETFILE PRDATA SET INPUT = &STR(&SYSNSUB(1,&PRDATA)) CLOSFILE PRDATA FREE DD(PRDATA) ALLOC DD(PRDATA) DSN('&TEMPFILE') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK$$$) + SPACE(5,5) TRACKS RELEASE + RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS) /********************************************************************** /* FORMAT THE DATA INTO A NEW FILE * /********************************************************************** OPENFILE PRDATA OUTPUT SET PRNUMBER = &SUBSTR(2:7,&STR(&SYSNSUB(1,&INPUT))) SET PRDATA = &STR(******************) PUTFILE PRDATA SET PRDATA = &STR(***** &PRNUMBER *****) PUTFILE PRDATA SET PRDATA = &STR(******************) PUTFILE PRDATA SET PRDATA = &STR(PROGRAM ID: &SUBSTR(8:15,+ &STR(&SYSNSUB(1,&INPUT))) + PROGRAMMER INITIALS: &SUBSTR(16:18,+ &STR(&SYSNSUB(1,&INPUT)))) PUTFILE PRDATA SET PRDATA = &STR(DATE RECEIVED: &SUBSTR(19:20,+ &STR(&SYSNSUB(1,&INPUT)))/+ &SUBSTR(21:22,+ &STR(&SYSNSUB(1,&INPUT)))/+ &SUBSTR(23:24,+ &STR(&SYSNSUB(1,&INPUT))) + DATE COMPLETED: &SUBSTR(25:26,+ &STR(&SYSNSUB(1,&INPUT)))/+ &SUBSTR(27:28,+ &STR(&SYSNSUB(1,&INPUT)))/+ &SUBSTR(29:30,+ &STR(&SYSNSUB(1,&INPUT)))) PUTFILE PRDATA SET PRDATA = &STR(***********************) PUTFILE PRDATA SET PRDATA = &STR(* PROBLEM DESCRIPTION *) PUTFILE PRDATA SET PRDATA = &STR(***********************) PUTFILE PRDATA SET BEGIN = 31 SET END = &BEGIN + 59 DO &I = 1 TO 16 SET PRDATA = &STR( &SUBSTR(&BEGIN:&END,+ &STR(&SYSNSUB(1,&INPUT)))) IF &STR(&SYSNSUB(1,&PRDATA)) > &STR( ) THEN PUTFILE PRDATA SET BEGIN = &END + 1 SET END = &BEGIN + 59 END SET PRDATA = &STR(********************) PUTFILE PRDATA SET PRDATA = &STR(* PROBLEM SOLUTION *) PUTFILE PRDATA SET PRDATA = &STR(********************) PUTFILE PRDATA DO &I = 1 TO 8 SET PRDATA = &STR( &SUBSTR(&BEGIN:&END,+ &STR(&SYSNSUB(1,&INPUT)))) IF &STR(&SYSNSUB(1,&PRDATA)) > &STR( ) THEN PUTFILE PRDATA SET BEGIN = &END + 1 SET END = &BEGIN + 59 END CLOSFILE PRDATA FREE DD(PRDATA) /********************************************************************** /* EDIT THE RESULTS * /********************************************************************** ISPEXEC EDIT DATASET('&TEMPFILE') EXIT HELPSEC: + ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR GETPR UTILITY + *** NO PROCESSING PERFORMED ***) ISPEXEC SETMSG MSG(UTLZ000) EXIT ./ ADD NAME=GETSTRNG /* REXX ***************************************************************/ /* UTILITY: GETSTRNG */ /* AUTHOR: DAVID LEIGH */ /* FUNCTION: CAPTURE A STRING AT A SPECIFIC POSITION ON THE SCREEN */ /* STORE IT IN THE DESIRED PROFILE IN THE DESIRED VARIABLE */ /**********************************************************************/ PARSE UPPER ARG SCRLINE SCRCOL FORLEN PROFVAL VARNAME ADDRESS ISPEXEC /*********************************************************************/ /* INSTALLATION TAILORING - USING LIBDEF */ /* IF USING LIBDEF, UNCOMMENT THE LINE BELOW BY REMOVING THE "/ *" */ /* FROM THE BEGINNING OF THE STATEMENT AND THE "* /" FROM THE END OF */ /* THE STATEMENT. THEN, TAILOR THE ID PARAMETER TO INDICATE THE */ /* MVS/QUICKREF PROGRAM LIBRARY WHERE MODULE QWIKREF1 RESIDES. */ /* THE QWLOAD JCL DEFAULTS TO PROGRAM LIBRARY SYS2.QUICKREF.LINKLIB. */ /* "ISPEXEC LIBDEF ISPLLIB DATASET ID('SYS2.QUICKREF.LINKLIB')" */ /*********************************************************************/ "SELECT PGM(QWCURSOR)" /*********************************************************************/ /* INSTALLATION TAILORING - USING LIBDEF */ /* IF USING LIBDEF, UNCOMMENT LINE BELOW. */ /* "ISPEXEC LIBDEF ISPLLIB" */ /*********************************************************************/ IF RC > 0 THEN SIGNAL NO_QWCURSOR /* INTAB1 THROUGH INTAB6 ARE USED TO TRANSLATE CHARS INTO SPACES. */ INTAB1 = '000102030405060708090A0B0C0D0E0F'X ",=*/()?;{}" INTAB2 = '101112131415161718191A1B1C1D1E1F7D7F'X INTAB3 = '7D7F'X INTAB4 = "-" INTAB5 = "<>" INTAB6 = "+" "VGET (ZAPPLID ZSCREENW) SHARED" QWSCRENW = ZSCREENW /* COMPUTE LENGTH AND TRIM BUFFER. */ /* IMAGEL = ((C2D(QWCSRP) + QWSCRENW) % QWSCRENW) * QWSCRENW */ IMAGEL = ((1000 + QWSCRENW) % QWSCRENW) * QWSCRENW ISFBUF = STORAGE(D2X(C2D(ISFBUF)),IMAGEL) /* BLANK OUT UNWANTED BYTES USING TRANSLATE TABLES. */ CURAREA = TRANSLATE(ISFBUF," ",INTAB1) CURAREA = TRANSLATE(CURAREA," ",INTAB2) SAY CURAREA ./ ADD NAME=GETVAR PROC 0 VARS() ISPEXEC VGET (&VARS) PROFILE ISPEXEC VPUT (&VARS) SHARED EXIT ./ ADD NAME=GPASTE 000100 /*************************************************************** REXX */ 000200 /* */ 000300 /* MODULE NAME = PASTE */ 000400 /* */ 000500 /* DESCRIPTIVE NAME = PASTE EDIT Macro for ISPF/PDF */ 000600 /* */ 000700 /* STATUS = R403 */ 000800 /* */ 000900 /* FUNCTION = Retrieve the data stored in a clip-board by the CUT */ 001000 /* macro and insert it into the the current data set. */ 001100 /* */ 001200 /* PASTE is functionally similar to a COPY command. */ 001300 /* It is used in conjunction with the CUT macro. */ 001400 /* */ 001500 /* PASTE's OUTTRAP function executes a specified TSO */ 001600 /* command and pastes its output into the EDIT data set. */ 001700 /* */ 001800 /* AUTHOR = Gilbert Saint-flour */ 001900 /* */ 002000 /* SYNTAX = PASTE */ 002100 /* clipboard name of clip-board */ 002200 /* BEFORE|AFTER .label destination */ 002300 /* */ 002400 /* clip-board is the name you specified in the CUT */ 002500 /* command that you entered to CUT the data you now */ 002600 /* want to PASTE. */ 002700 /* */ 002800 /* Destination indicates where the data should be copied */ 002900 /* into the current data set. Specification is the same */ 003000 /* as in a COPY command: */ 003100 /* */ 003200 /* 1. as an operand of the PASTE command, such as: */ 003300 /* */ 003400 /* PASTE BEFORE .X */ 003500 /* or */ 003600 /* PASTE AFTER .ZL */ 003700 /* */ 003800 /* 2. with the A or B line commands. */ 003900 /* */ 004000 /* BEFORE and AFTER can be abbreviated BEF and AFT, */ 004100 /* respectively. The destination is not required if */ 004200 /* the current data set is empty. */ 004300 /* */ 004400 /* The data present in the clip-board are not deleted */ 004500 /* by the PASTE command and can be PASTE'd again until */ 004600 /* the end the TSO session. */ 004700 /* */ 004800 /* SYNTAX = PASTE */ 004900 /* * indicates OUTTRAP function */ 005000 /* TSO Command TSO command to execute */ 005100 /* */ 005200 /* When the user specifies an asterisk as clip-board name */ 005300 /* and a TSO command, as in PASTE * LISTA the TSO command */ 005400 /* is executed, its output trapped with the OUTTRAP */ 005500 /* function and pasted at the specified destination. */ 005600 /* */ 005700 /* DEPENDENCIES = MVS/ESA 4.2.2 */ 005800 /* TSO/E V2 */ 005900 /* ISPF and ISPF/PDF V3 */ 006000 /* CUTPGM utility program R400 */ 006100 /* */ 006200 /* CHANGE ACTIVITY */ 006300 /* */ 006400 /* $401 Remove EXIT stmt before last SETMSG command */ 006500 /* $402 OUTTRAP function */ 006600 /* $403 Clip-board name may be enclosed in quotes */ 006700 /* */ 006800 /**********************************************************************/ 006900 ADDRESS ISPEXEC; 'CONTROL ERRORS RETURN'; ZERRMSG='' 007000 007100 CALL Parse_parm /* Analyse the command */ 007200 CALL Process_dest /* Process Destination */ 007300 007400 IF LENGTH(Parm) > 2 & LEFT(Parm,2)='* ' THEN 007500 CALL Paste_OUTTRAP 007600 ELSE DO 007700 /*-----------------------------------------------------------------*/ 007800 /* Build the parm for the CUTPGM program, as follows: */ 007900 /* */ 008000 /* parm=Pcccccccc111111 */ 008100 /* */ 008200 /* P function=PASTE */ 008300 /* cccccccc 8-character clipboard name (or blanks) */ 008400 /* 111111 first line */ 008500 /*-----------------------------------------------------------------*/ 008600 008700 'ISREDIT (Nummode,Numtype) = NUMBER' /* Query number mode info */ 008800 IF Nummode='ON' THEN DO 008900 IF WORDPOS('COBOL',Numtype) >0 THEN 009000 'ISREDIT NUMBER = OFF' /* Turn OFF number mode */ 009100 END 009200 009300 parm='P'||LEFT(clipboard,8)||RIGHT(Line1,6,'0') 009400 009500 'SELECT PGM(CUTPGM) PARM('parm')'; Pgmrc=rc 009600 009700 'ISREDIT NUMBER =' Nummode /* Turn number mode back ON */ 009800 009900 IF Pgmrc = 12 THEN SIGNAL Empty_clipboard 010000 END 010100 /*-----------------------------------------------------------------*/ 010200 /* Issue completion message and exit */ 010300 /*-----------------------------------------------------------------*/ 010400 010500 'ISREDIT (Line1) = LINENUM .ZLAST' /* NUMBER OF LINES NOW */ 010600 I=Line1-Line2 /* NUMBER OF LINES PASTED */ 010700 zedsmsg=I 'Lines pasted' 010800 IF clipboard='' THEN 010900 zedlmsg=i 'lines have been copied from the default clipboard ' 011000 ELSE 011100 zedlmsg=i 'lines have been copied from clipboard' clipboard 011200 'SETMSG MSG(ISRZ000)' 011300 EXIT 0 011400 /**********************************************************************/ 011500 /* */ 011600 /* Parse Input Parm, process line commands. */ 011700 /* */ 011800 /**********************************************************************/ 011900 Parse_parm: 012000 'ISREDIT MACRO (PARM) NOPROCESS' 012100 IF rc>0 THEN 012200 SIGNAL Not_an_EDIT_macro /* Invoked as a TSO cmd */ 012300 012400 IF parm='?' THEN 012500 SIGNAL HELP_panel 012600 012700 UPPER parm; clipboard=''; after=''; Line1='' 012800 'ISREDIT (Line2) = LINENUM .ZLAST' /* Number of lines now */ 012900 013000 IF LENGTH(Parm) > 2 & LEFT(Parm,2)='* ' THEN /* OUTTRAP function */ 013100 RETURN 013200 013300 DO i=1 to WORDS(parm) 013400 p=WORD(parm,i) /* Extract current word */ 013500 IF LEFT(p,1)='.' THEN 013600 SIGNAL Invalid_label 013700 ELSE DO 013800 IF ABBREV('BEFORE',p,3) | ABBREV('AFTER',p,3) THEN DO 013900 IF after<>'' THEN SIGNAL Invalid_label 014000 IF i=WORDS(parm) THEN SIGNAL Missing_Label 014100 after=LEFT(p,1) /* save A or B */ 014200 i=i+1 014300 p=WORD(parm,i) /* get next word (label)*/ 014400 IF LEFT(p,1)='.' THEN DO 014500 'ISREDIT (Line1) = LINENUM' p 014600 IF rc>0 then SIGNAL Invalid_label 014700 IF after='B' THEN 014800 Line1=Line1-1 /* Before .X */ 014900 END 015000 ELSE 015100 SIGNAL Invalid_label /* AFTER xyz */ 015200 END 015300 ELSE DO 015400 IF clipboard<>'' THEN 015500 SIGNAL Invalid_label /* Duplicate clip-board */ 015600 /* Check the clip-board name for correct syntax. */ 015700 IF LEFT(p,1)="'" | LEFT(p,1)='"' THEN /* Quoted string */ 015800 p=STRIP(p,'B',LEFT(p,1)) 015900 IF LENGTH(p)>8 THEN /* name is too long */ 016000 SIGNAL Bad_clip_board 016100 IF VERIFY(p,'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789@#$ ') > 0 THEN 016200 SIGNAL Bad_clip_board /* invalid character */ 016300 clipboard=p 016400 END 016500 END 016600 END 016700 RETURN 016800 /**********************************************************************/ 016900 /* */ 017000 /* Check if the user selected a destination by entering a line */ 017100 /* command such as A or B. If it is the case, set line1 to the */ 017200 /* line number after which the data should be inserted. If the */ 017300 /* user selected a destination both in the PASTE command (as in */ 017400 /* PASTE AFT .X) and in a line command, issue an error message. */ 017500 /* */ 017600 /**********************************************************************/ 017700 Process_dest: 017800 'ISREDIT PROCESS DEST' /* set .ZDEST to destination */ 017900 SELECT 018000 WHEN RC=0 THEN DO /* A or B entered */ 018100 IF Line1<>'' THEN SIGNAL Command_conflict 018200 'ISREDIT (Line1) = LINENUM .ZDEST' 018300 END 018400 WHEN RC=8 THEN DO /* Neither A nor B entered */ 018500 IF Line1='' THEN DO 018600 zerrsm = 'Enter A or B line cmd' 018700 zerrlm = 'PASTE requires an A or B line command' 018800 SIGNAL Beep_msg 018900 END 019000 END 019100 WHEN RC=20 THEN /* Empty data set */ 019200 Line1=0 019300 OTHERWISE /* Line command conflict */ 019400 SIGNAL SETMSG /* Edit has created message */ 019500 END 019600 RETURN 019700 /**********************************************************************/ 019800 /* */ 019900 /* OUTTRAP Function (Sub-routine) */ 020000 /* */ 020100 /* This function is executed when the user specifies an asterisk */ 020200 /* as clip-board name and a TSO command, as in PASTE * LISTA. */ 020300 /* The TSO command is executed, its output trapped with the */ 020400 /* OUTTRAP function and pasted at the specified destination. */ 020500 /* */ 020600 /**********************************************************************/ 020700 Paste_OUTTRAP: 020800 cmd=RIGHT(Parm,LENGTH(Parm)-2) /* delete leading "*" */ 020900 Pgmrc = OUTTRAP('MSG.') /* TRAP PUTLINE */ 021000 ADDRESS TSO cmd 021100 DO I=MSG.0 TO 1 BY -1 021200 Line=Msg.I 021300 "ISREDIT LINE_AFTER" Line1 "= DATALINE (LINE)" 021400 END 021500 RETURN 021600 /**********************************************************************/ 021700 /* Exception Routines */ 021800 /**********************************************************************/ 021900 Not_an_EDIT_macro: 022000 Zedsmsg = "EDIT Macro Only" /* Short message */ 022100 Zedlmsg = "PASTE may only be invoked as an EDIT macro" 022200 "SETMSG MSG(ISRZ001)" /* send the message */ 022300 EXIT 8 022400 HELP_panel: 022500 'DISPLAY PANEL(CUTHLP2)' /* Display HELP panel */ 022600 IF rc>8 THEN 022700 SIGNAL SETMSG /* HELP panel is missing */ 022800 EXIT 0 022900 Missing_Label: 023000 zerrsm='Missing Label' 023100 p='You must specify a label after the "BEFORE" or "AFTER" keyword.' 023200 zerrlm=p 023300 SIGNAL Beep_msg 023400 Invalid_label: 023500 zerrsm='Probable label error' 023600 zerrlm=p 'recognized as invalid or undefined label.' 023700 SIGNAL Beep_msg 023800 Command_conflict: 023900 zerrsm='Command Conflict' 024000 zerrlm='A or B conflicts with range specification; blank it out.' 024100 SIGNAL Beep_msg 024200 Bad_clip_board: 024300 zerrsm='Invalid clip-board' 024400 zerrlm='The clip-board name must be a valid member name' 024500 SIGNAL Beep_msg 024600 Empty_clipboard: 024700 zerrsm='Empty clip-board' 024800 zerrlm='Nothing was cut to this clip-board during this TSO session.' 024900 SIGNAL Beep_msg 025000 Beep_msg: 025100 zerralrm='YES' /* ALARM=YES */ 025200 zerrhm='CUTHLP2' /* HELP Panel */ 025300 'SETMSG MSG(ISRZ002)' /* Issue error message */ 025400 EXIT 20 025500 SETMSG: 025600 'SETMSG MSG('zerrmsg')' 025700 EXIT 20 ./ ADD NAME=HELPSEC /********************************************************************** /* DISPLAY HELP IF REQUESTED * /********************************************************************** IF &HELP = HELP THEN GOTO HELPSEC /********************************************************************** /* DISPLAY ANY "HELP" WHICH IS AVAILABLE FOR THIS UTILITY * /********************************************************************** HELPSEC: + ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR XXXXXXXX UTILITY + *** NO PROCESSING PERFORMED ***) ISPEXEC SETMSG MSG(UTLZ000) EXIT ./ ADD NAME=HEXADD PROC 2 HEXNUM1 HEXNUM2 /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT IF &HEXNUM1 = &STR(HELP) THEN GOTO HELPSEC SET HLEN1 = &LENGTH(&HEXNUM1) IF &HLEN1 > 8 THEN GOTO END1 SET COUNT = 1 SET SLEN = &HLEN1 - 1 SET SNUM1 = 0 DO WHILE &COUNT LE &HLEN1 SET HCHAR = &SUBSTR(&COUNT,&HEXNUM1) IF &HCHAR = A THEN SET HCHAR = 10 IF &HCHAR = B THEN SET HCHAR = 11 IF &HCHAR = C THEN SET HCHAR = 12 IF &HCHAR = D THEN SET HCHAR = 13 IF &HCHAR = E THEN SET HCHAR = 14 IF &HCHAR = F THEN SET HCHAR = 15 SET SNUM1 = &SNUM1 + (&HCHAR * (16 ** &SLEN)) SET COUNT = &COUNT + 1 SET SLEN = &SLEN - 1 END /* SET HLEN2 = &LENGTH(&HEXNUM2) IF &HLEN2 > 8 THEN GOTO END2 SET COUNT = 1 SET SLEN = &HLEN2 - 1 SET SNUM2 = 0 DO WHILE &COUNT LE &HLEN2 SET HCHAR = &SUBSTR(&COUNT,&HEXNUM2) IF &HCHAR = A THEN SET HCHAR = 10 IF &HCHAR = B THEN SET HCHAR = 11 IF &HCHAR = C THEN SET HCHAR = 12 IF &HCHAR = D THEN SET HCHAR = 13 IF &HCHAR = E THEN SET HCHAR = 14 IF &HCHAR = F THEN SET HCHAR = 15 SET SNUM2 = &SNUM2 + (&HCHAR * (16 ** &SLEN)) SET COUNT = &COUNT + 1 SET SLEN = &SLEN - 1 END /* SET SNUM2 = &SNUM2 + &SNUM1 SET ANUM = &SNUM2 SET HLEN3 = &LENGTH(&SNUM2) SET COUNT = &HLEN3 /* DO WHILE &ANUM NE 0 SET BNUM = &ANUM / 16 SET CNUM = &BNUM * 16 SET RNUM = &ANUM - &CNUM SET ANUM = &BNUM IF &RNUM = 10 THEN SET RNUM = A IF &RNUM = 11 THEN SET RNUM = B IF &RNUM = 12 THEN SET RNUM = C IF &RNUM = 13 THEN SET RNUM = D IF &RNUM = 14 THEN SET RNUM = E IF &RNUM = 15 THEN SET RNUM = F IF &COUNT = 1 THEN SET &HC1 = &RNUM IF &COUNT = 2 THEN SET &HC2 = &RNUM IF &COUNT = 3 THEN SET &HC3 = &RNUM IF &COUNT = 4 THEN SET &HC4 = &RNUM IF &COUNT = 5 THEN SET &HC5 = &RNUM IF &COUNT = 6 THEN SET &HC6 = &RNUM IF &COUNT = 7 THEN SET &HC7 = &RNUM IF &COUNT = 8 THEN SET &HC8 = &RNUM SET COUNT = &COUNT - 1 END /* SET HNUM = &STR(&HC1&HC2&HC3&HC4&HC5&HC6&HC7&HC8) /* SET ZEDLMSG = + &STR(HEX (&HEXNUM1) + HEX (&HEXNUM2) = DECIMAL (&SNUM2) HEX (&HNUM)) ISPEXEC SETMSG MSG(UTLZ000) EXIT END1: + SET ZEDLMSG = + &STR("HEXADD" CANNOT HANDLE EITHER HEX NUMBER BEING GREATER THAN 8 + DIGITS) ISPEXEC SETMSG MSG(UTLZ001) EXIT END2: + SET ZEDLMSG = + &STR("HEXADD" CANNOT HANDLE EITHER HEX NUMBER BEING GREATER THAN 8 + DIGITS) ISPEXEC SETMSG MSG(UTLZ001) EXIT HELPSEC: + 04470000 CLEAR 04470000 WRITE *** HELP FOR CLIST HEXADD *** 04470000 WRITE 04470000 WRITE NO HELP WRITTEN AT THIS TIME 04470000 WRITE 04470000 WRITE *** END OF HELP *** NO PROCESSING PERFORMED *** 04470000 EXIT 04470000 ./ ADD NAME=HEXCONV 000100 PROC 1 DATA LENGTHOFDATA(4) CHARACTER HEXADECIMAL DEBUG 000200 /**********************************************************************/ 000300 /* */ 000400 /* FUNCTION: THIS CLIST EXECUTES AS AN IPCS CLIST SUBCOMMAND TO */ 000500 /* RETRIEVE DATA FROM A DUMP AND RETURN IT IN A GLOBAL */ 000600 /* CLIST VARIABLE. IT IS INVOKED BY CLIST SAVEDMP. */ 000700 /* */ 000800 /* THE ADDRESS OF THE DATA TO BE RETURNED IS THE REQUIRED */ 000900 /* FIRST PARM. THE LENGTH OF DATA IS OPTIONAL AND DEFAULTS*/ 001000 /* TO 4 BYTES. THE CONVERSION IS EITHER HEX OR CHARACTER, */ 001100 /* HEX IS THE DEFAULT. */ 001200 /* */ 001300 /* SYNTAX: %DATAEVAL DATA |LENGTHOFDATA(NN)| |CHARACTER| */ 001400 /* |HEXADECIMAL| */ 001500 /* */ 001600 /* DATA - ADDRESS OF THE DATA TO BE */ 001700 /* RETRIEVED FROM THE DUMP */ 001800 /* LENGTHOFDATA - LENGTH OF DATA TO BE RETRIEVED */ 001900 /* CHARACTER - SPECIFIES CHARACTER CONVERSION */ 002000 /* TO BE PERFORMED ON THE DATA */ 002100 /* HEXADECIMAL - SPECIFIES THAT THE DATA IS TO BE */ 002200 /* RETURNED IN HEX FORMAT (DEFAULT) */ 002300 /* */ 002400 /* */ 002500 /* THIS CLIST IS CALLED BY: SAVEDMP */ 002600 /* */ 002700 /* ****************************************************************** */ 002800 /* */ 002900 /* THE STATEMENT FOLLOWING PROVIDES A DEBUG OPTION TO DISPLAY THE */ 003000 /* FLOW OF STATEMENTS DURING CLIST PROCESSING. */ 003100 /* */ 003200 IF &DEBUG NE DEBUG THEN CONTROL MSG NOSYM NOCON NOLIST NOPROMPT 003300 ELSE CONTROL MSG SYM CON LIST NOPROMPT 003400 /* INITIALIZATION OF CLIST VARIABLES */ 003500 GLOBAL RVAL /* DEFINE GLOBAL FOR RETURN */ 003600 CONTROL NOMSG NOFLUSH /* SET UP CONTROL OPTIONS */ 003700 SET HSTR=&STR(0123456789ABCDEF) /* SET HEX CONVERSION STR */ 003800 SET CSTR=&STR(- 003900 ................................................................- 004000 ......... .<.+|.......... $*.;.-/.........,%_>?..........:#@¬="- 004100 .ABCDEFGHI........JKLMNOPQR........STUVWXYZ......0123456789.....- 004200 .ABCDEFGHI.......JKLMNOPQR........STUVWXYZ......0123456789......) 004300 /* ****************************************************************** */ 004400 /* VALIDATE LENGTH PARAMETER */ 004500 /* ****************************************************************** */ 004600 IF &DATATYPE(&LENGTHOFDATA) NE NUM THEN /* IF NOT NUMERIC LENGTH */+ 004700 SET &LENGTHOFDATA = 1 /* THEN SET DEFAULT LEN */ 004800 ELSE + 004900 IF &LENGTHOFDATA LE 0 THEN /* IF LENGTH IS TOO SMALL */+ 005000 SET &LENGTHOFDATA = 1 /* SET TO MIN VALUE */ 005100 IF &CHARACTER EQ CHARACTER THEN /* IF CHARACTER CONVERSION */+ 005200 DO /* */ 005300 IF &LENGTHOFDATA GT 256 THEN /* CHECK MAX LENGTH */+ 005400 SET &LENGTHOFDATA = 256 /* SET TO MAX LENGTH */ 005500 SET &LD = &LENGTHOFDATA*2 /* SET LIST LENGTH */ 005600 END /* */ 005700 ELSE /* ELSE HEX CONVERSION */+ 005800 DO /* */ 005900 IF &LENGTHOFDATA GT 128 THEN /* CHECK MAX HEX LENGTH */+ 006000 SET &LENGTHOFDATA=128 /* SET MAX HEX LENGTH */ 006100 SET &LD = &LENGTHOFDATA /* SET LIST LENGTH */ 006200 END /* */ 006300 /* ****************************************************************** */ 006400 /* VALIDATE DATA PARAMETER TO SEE IF DATA EXISTS */ 006500 /* ****************************************************************** */ 006600 SET RVAL=&SUBSTR(1:&LD,&STR(&CSTR)) /* SET DEFAULT STRING */ 006700 LIST &DATA. LEN(&LENGTHOFDATA.) CHAR /* IPCS LIST TO VALIDATE */ 006800 IF &LASTCC¬=0 THEN /* CHECK LIST RETURN CODE */+ 006900 EXIT CODE(16) /* EXIT IF NON-ZERO */ 007000 /* ****************************************************************** */ 007100 /* DATA RETRIEVED A BYTE AT A TIME VIA EVALUATE SUBCOMMAND */ 007200 /* ****************************************************************** */ 007300 SET OFF = 0 /* INITIALIZE OFFSET */ 007400 SET RVAL= /* INITIALIZE RETURN STR */ 007500 IF &CHARACTER EQ CHARACTER THEN /* IF CHARACTER CONVERSION */+ 007600 DO WHILE &OFF LT &LENGTHOFDATA /* LOOP THRU BYTE BY BYTE */ 007700 /* ****************************************************************** */ 007800 /* GET A BYTE AND CONVERT IT TO CHARACTER */ 007900 /* ****************************************************************** */ 008000 EVALUATE &DATA+&OFF.N LENGTH(1) /* GET BYTE VALUE IN LASTCC */ 008100 SET &CC = &LASTCC+1 /* CREATE INDEX INTO CSTR */ 008200 SET &RVAL=&STR(&RVAL&SUBSTR(&CC,&STR(&CSTR))) /* ADD CHAR TO STR */ 008300 SET &OFF=&OFF+1 /* BUMP TO NEXT BYTE */ 008400 END /* */ 008500 ELSE /* ELSE HEX CONVERSION */+ 008600 DO WHILE &OFF LT &LENGTHOFDATA /* GET A BYTE AT A TIME */ 008700 /* ****************************************************************** */ 008800 /* GET A BYTE AND CONVERT IT TO HEXADECIMAL */ 008900 /* ****************************************************************** */ 009000 EVALUATE &DATA+&OFF.N LENGTH(1) /* GET BYTE VALUE IN LASTCC */ 009100 SET &CC = &LASTCC /* SAVE LASTCC */ 009200 SET &RVAL=&STR(&RVAL&SUBSTR(&EVAL(&CC/16+1),&HSTR)+ 009300 &SUBSTR(&EVAL(&CC//16+1),&HSTR)) /* ADD BYTE TO STR */ 009400 SET &OFF = &OFF+1 /* BUMP TO NEXT BYTE */ 009500 END /* */ 009600 /* ****************************************************************** */ 009700 /* THEN EXIT WITH DATA IN GLOBAL VARIABLE RVAL */ 009800 /* ****************************************************************** */ 009900 EXIT CODE(0) /* EXIT - ALL'S WELL */ ./ ADD NAME=HEXSUB PROC 2 HEXNUM1 HEXNUM2 /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT IF &HEXNUM1 = &STR(HELP) THEN GOTO HELPSEC SET HLEN1 = &LENGTH(&HEXNUM1) IF &HLEN1 > 8 THEN GOTO END1 SET COUNT = 1 SET SLEN = &HLEN1 - 1 SET SNUM1 = 0 DO WHILE &COUNT LE &HLEN1 SET HCHAR = &SUBSTR(&COUNT,&HEXNUM1) IF &HCHAR = A THEN SET HCHAR = 10 IF &HCHAR = B THEN SET HCHAR = 11 IF &HCHAR = C THEN SET HCHAR = 12 IF &HCHAR = D THEN SET HCHAR = 13 IF &HCHAR = E THEN SET HCHAR = 14 IF &HCHAR = F THEN SET HCHAR = 15 SET SNUM1 = &SNUM1 + (&HCHAR * (16 ** &SLEN)) SET COUNT = &COUNT + 1 SET SLEN = &SLEN - 1 END /* SET HLEN2 = &LENGTH(&HEXNUM2) IF &HLEN2 > 8 THEN GOTO END2 SET COUNT = 1 SET SLEN = &HLEN2 - 1 SET SNUM2 = 0 DO WHILE &COUNT LE &HLEN2 SET HCHAR = &SUBSTR(&COUNT,&HEXNUM2) IF &HCHAR = A THEN SET HCHAR = 10 IF &HCHAR = B THEN SET HCHAR = 11 IF &HCHAR = C THEN SET HCHAR = 12 IF &HCHAR = D THEN SET HCHAR = 13 IF &HCHAR = E THEN SET HCHAR = 14 IF &HCHAR = F THEN SET HCHAR = 15 SET SNUM2 = &SNUM2 + (&HCHAR * (16 ** &SLEN)) SET COUNT = &COUNT + 1 SET SLEN = &SLEN - 1 END /* SET SNUM2 = &SNUM1 - &SNUM2 SET ANUM = &SNUM2 SET HLEN3 = &LENGTH(&SNUM2) SET COUNT = &HLEN3 /* DO WHILE &ANUM NE 0 SET BNUM = &ANUM / 16 SET CNUM = &BNUM * 16 SET RNUM = &ANUM - &CNUM SET ANUM = &BNUM IF &RNUM = 10 THEN SET RNUM = A IF &RNUM = 11 THEN SET RNUM = B IF &RNUM = 12 THEN SET RNUM = C IF &RNUM = 13 THEN SET RNUM = D IF &RNUM = 14 THEN SET RNUM = E IF &RNUM = 15 THEN SET RNUM = F IF &COUNT = 1 THEN SET &HC1 = &RNUM IF &COUNT = 2 THEN SET &HC2 = &RNUM IF &COUNT = 3 THEN SET &HC3 = &RNUM IF &COUNT = 4 THEN SET &HC4 = &RNUM IF &COUNT = 5 THEN SET &HC5 = &RNUM IF &COUNT = 6 THEN SET &HC6 = &RNUM IF &COUNT = 7 THEN SET &HC7 = &RNUM IF &COUNT = 8 THEN SET &HC8 = &RNUM SET COUNT = &COUNT - 1 END /* SET HNUM = &STR(&HC1&HC2&HC3&HC4&HC5&HC6&HC7&HC8) /* SET ZEDLMSG = + &STR(HEX (&HEXNUM1) - HEX (&HEXNUM2) = DECIMAL (&SNUM2) HEX (&HNUM)) ISPEXEC SETMSG MSG(UTLZ001) EXIT END1: + SET ZEDLMSG = + &STR("HEXSUB" CANNOT HANDLE EITHER HEX NUMBER BEING GREATER THAN 8 + DIGITS) ISPEXEC SETMSG MSG(UTLZ001) EXIT END2: + SET ZEDLMSG = + &STR("HEXSUB" CANNOT HANDLE EITHER HEX NUMBER BEING GREATER THAN 8 + DIGITS) ISPEXEC SETMSG MSG(UTLZ001) EXIT HELPSEC: + 04470000 CLEAR 04470000 WRITE *** HELP FOR CLIST HEXSUB *** 04470000 WRITE 04470000 WRITE NO HELP WRITTEN AT THIS TIME 04470000 WRITE 04470000 WRITE *** END OF HELP *** NO PROCESSING PERFORMED *** 04470000 EXIT 04470000 ./ ADD NAME=HEX2DEC /********************************************************************** /* UTILITY: HEX2DEC * /* AUTHOR: DAVID LEIGH * /* FUNCTION: THIS CLIST CALLS PROGRAM HEX2DECP TO CONVERT HEXADECIMAL * /* NUMBERS TO DECIMAL NUMBERS. * /********************************************************************** PROC 1 HEXNUM BATCH /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT IF &HEXNUM = &STR(HELP) THEN GOTO HELPSEC /********************************************************************** /* CALL THE CONVERSION PROGRAM * /********************************************************************** ISPEXEC SELECT PGM(HEX2DECP) PARM(&HEXNUM) ISPEXEC VGET DECNUM SHARED IF &BATCH ¬= BATCH THEN + DO SET ZEDLMSG = &STR(HEXADECIMAL NUMBER &HEXNUM = + DECIMAL NUMBER &DECNUM) ISPEXEC SETMSG MSG(UTLZ000) END EXIT HELPSEC: + 04470000 CLEAR 04470000 WRITE *** HELP FOR CLIST HEX2DEC *** 04470000 WRITE 04470000 WRITE NO HELP WRITTEN AT THIS TIME 04470000 WRITE 04470000 WRITE *** END OF HELP *** NO PROCESSING PERFORMED *** 04470000 EXIT 04470000 ./ ADD NAME=HYPRTEXT ISREDIT MACRO (HELP) ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /******************************************************************/ /* 'HYPRTEXT' EDIT MACRO. PERFORM A FUNCTION ASSOCIATED WITH A */ /* STRING ON WHICH THE CURSOR IS. */ /* AUTHOR : DAVID LEIGH DATE : 3-31-89 */ /******************************************************************/ IF &HELP = &STR(HELP) THEN GOTO HELPSEC ISREDIT (LN,CL) = CURSOR IF &CL = &STR(000) THEN + DO SET ZEDLMSG = &STR(THE CURSOR IS NOT ON A VALID DATA STRING) ISPEXEC SETMSG MSG(ISRZ001) EXIT END WRITE &LN &CL EXIT IF &SYSINDEX(&STR(. ),&STR(&DSN)) > 1 THEN + SET DSN = &SUBSTR(1:+ &EVAL(&SYSINDEX(&STR(. ),&STR(&DSN)) -1),&STR(&DSN)) IF &SYSINDEX(&STR(?),&STR(&DSN)) > 1 THEN + SET DSN = &SUBSTR(1:+ &EVAL(&SYSINDEX(&STR(?),&STR(&DSN)) -1),&STR(&DSN)) IF &SYSINDEX(&STR('),&STR(&DSN)) > 1 THEN + SET DSN = &SUBSTR(1:+ &EVAL(&SYSINDEX(&STR('),&STR(&DSN)) -1),&STR(&DSN)) IF &SYSINDEX(&STR("),&STR(&DSN)) > 1 THEN + SET DSN = &SUBSTR(1:+ &EVAL(&SYSINDEX(&STR("),&STR(&DSN)) -1),&STR(&DSN)) IF &SYSINDEX(&STR(:),&STR(&DSN)) > 1 THEN + SET DSN = &SUBSTR(1:+ &EVAL(&SYSINDEX(&STR(:),&STR(&DSN)) -1),&STR(&DSN)) IF &SYSINDEX(&STR(;),&STR(&DSN)) > 1 THEN + SET DSN = &SUBSTR(1:+ &EVAL(&SYSINDEX(&STR(;),&STR(&DSN)) -1),&STR(&DSN)) IF &SYSINDEX(&STR(,),&STR(&DSN)) > 1 THEN + SET DSN = &SUBSTR(1:+ &EVAL(&SYSINDEX(&STR(,),&STR(&DSN)) -1),&STR(&DSN)) IF &SYSINDEX(&STR(&LPAREN&RPAREN),&STR(&DSN)) > 1 THEN + DO SET A = &SYSINDEX(&STR(&LPAREN&RPAREN),&STR(&DSN)) - 1 SET DSN = &SUBSTR(1:&A,&STR(&DSN)) SET XDSN = &STR(&STR(&DSN)&STR((0))) END IF &SYSINDEX(&STR(+),&STR(&DSN)) > 1 THEN + DO SET A = &SYSINDEX(&STR(+),&STR(&DSN)) - 2 SET DSN = &SUBSTR(1:&A,&STR(&DSN)) SET XDSN = &STR(&STR(&DSN)&STR((0))) END IF &SYSINDEX(&STR(-),&STR(&DSN)) > 1 THEN + DO SET A = &SYSINDEX(&STR(-),&STR(&DSN)) - 2 SET DSN = &SUBSTR(1:&A,&STR(&DSN)) SET XDSN = &STR(&STR(&DSN)&STR((0))) END IF &SYSINDEX(&STR(&LPAREN.0),&STR(&DSN)) > 1 THEN + DO SET A = &SYSINDEX(&STR(&LPAREN.0),&STR(&DSN)) - 1 SET DSN = &SUBSTR(1:&A,&STR(&DSN)) SET XDSN = &STR(&STR(&DSN)&STR((0))) END SET ZEDSMSG = &STR(PROBLEM WITH DATASET) SET ZEDLMSG = &STR(&DSN PROBLEM : &SYSDSN('&DSN')) IF &LENGTH(&STR(&XDSN)) = 0 THEN SET XDSN = &STR(&DSN) IF &SYSDSN('&DSN') = OK OR + &SYSDSN('&DSN') = &STR(MEMBER NOT FOUND) THEN + DO SET A = &SYSINDEX(&STR(&LPAREN),&STR(&XDSN)) SET A = &A + 1 IF &A > 1 AND + &SUBSTR(&A,&STR(&XDSN)) ¬= &STR(+) AND + &SUBSTR(&A,&STR(&XDSN)) ¬= &STR(-) AND + &SUBSTR(&A,&STR(&XDSN)) ¬= &STR(0) AND + &SUBSTR(&A,&STR(&XDSN)) ¬= &STR(1) AND + &SUBSTR(&A,&STR(&XDSN)) ¬= &STR(2) AND + &SUBSTR(&A,&STR(&XDSN)) ¬= &STR(3) AND + &SUBSTR(&A,&STR(&XDSN)) ¬= &STR(4) AND + &SUBSTR(&A,&STR(&XDSN)) ¬= &STR(5) AND + &SUBSTR(&A,&STR(&XDSN)) ¬= &STR(6) AND + &SUBSTR(&A,&STR(&XDSN)) ¬= &STR(7) AND + &SUBSTR(&A,&STR(&XDSN)) ¬= &STR(8) AND + &SUBSTR(&A,&STR(&XDSN)) ¬= &STR(9) THEN + DO SET B = &A SET A = &A - 2 SET SWITCH = ON SET C = &EVAL(&LENGTH(&STR(&XDSN)) - 1) SET MEM = &SUBSTR(&B:&C,&STR(&XDSN)) SET XDSN = &SUBSTR(1:&A,&STR(&XDSN)) END ISPEXEC LMINIT DATAID(DID) DATASET('&XDSN') IF &SWITCH = ON THEN + DO ISPEXEC EDIT DATAID(&DID) MEMBER(&MEM) IF &LASTCC = 20 THEN + DO ISPEXEC BROWSE DATAID(&DID) MEMBER(&MEM) IF &LASTCC = 20 THEN + ISPEXEC SETMSG MSG(ISRZ001) ELSE END ELSE END ELSE + DO ISPEXEC EDIT DATAID(&DID) IF &LASTCC = 20 THEN + DO ISPEXEC BROWSE DATAID(&DID) IF &LASTCC = 20 THEN + ISPEXEC SETMSG MSG(ISRZ001) ELSE END ELSE END END ELSE + ISPEXEC SETMSG MSG(ISRZ001) ISPEXEC LMFREE DATAID(&DID) ISREDIT CURSOR = &LN &CL EXIT HELPSEC: + CLEAR WRITE *** HELP FOR EDIT MACRO 'VIEW' *** WRITE WRITE THE VIEW EDIT MACRO ALLOWS THE USER TO TYPE VIEW ON THE COMMAND WRITE LINE DURING AN EDIT SESSION, PLACE THE CURSOR ON THE BEGINNING OF WRITE A DATASET NAME IN THE BODY OF THE FILE, PRESS , AND BE WRITE TAKEN INTO AN EDIT OR BROWSE OF THAT DATASET. ADDITIONALLY, A WRITE PF KEY CAN BE SET TO THE STRING 'VIEW', AND THE USER COULD PLACE WRITE THE CURSOR ON THE DATASET NAME, AND PRESS THE PF KEY, AND ACCOM- WRITE PLISH THE SAME THING. WRITE WRITE BASIC SYNTAX : WRITE WRITE COMMAND ===> VIEW WRITE 000108 //JS010 EXEC PGM=WAAPDSUT WRITE 000109 //SYSUT1 DD DSN=TCWCA.TWB.WORKFILE(INDATA), WRITE 000110 // DISP=(SHR,KEEP,KEEP) WRITE 000111 //SYSUT2 DD DSN=TCWCA.TWBAT.INDATA.COPY, WRITE 000112 // DISP=(NEW,CATLG,DELETE) WRITE 000113 // UNIT=SYSDA, WRITE 000114 // SPACE=(TRK,(1,1),RLSE), WRITE 000115 // DCB=(RECFM=FB,LRECL=80,BLKSIZE=23440) WRITE WRITE IN THE ABOVE EXAMPLE, THE CURSOR WOULD BE PLACED ON THE 'T' WRITE IMMEDIATELY FOLLOWING EITHER 'DSN=' STRING (SYSUT2 WOULD BE AVAIL- WRITE ABLE PROVIDING THAT THE JCL HAD ALREADY BEEN RUN), AND THE WRITE KEY WOULD BE PRESSED. PROVIDED THAT THE USER HAD AUTHORITY, AND WRITE THE DATASET WAS NOT IN USE, AND THE LRECL OF THE DATASET FELL WRITE WITHIN THE ALLOWABLE LIMITS OF AN ISPF EDIT SESSION, THE USER WRITE WOULD BE TAKEN INTO AN EDIT OF THE DATASET. WRITE WRITE IF THE RETURN CODE FROM THE ATTEMPT TO EDIT THE DATASET WAS UN- WRITE SATISFACTORY, THE MACRO WILL ATTEMPT TO BROWSE THE DATASET WRITE INSTEAD. ACF2 VIOLATIONS, AND EXCLUSIVE ENQUEUES OF THE DATASET WRITE WOULD BE THE ONLY FACTORS WHICH WOULD PROHIBIT A BROWSE OF THE WRITE DATASET. WRITE WRITE IN THE CASE OF GDG DATASETS WITH RELATIVE GENERATION NUMBERS OR WRITE PGENS SPECIFIED IN THE DATASET NAME, THE MOST RECENT GENERATION WRITE WILL BE EDITED. WRITE WRITE THE STANDARD EDIT/BROWSE CONVENTIONS AND COMMANDS ARE AVAILABLE IN WRITE THE RESULTING EDIT/BROWSE SESSION. WRITE WRITE *** END OF HELP *** NO PROCESSING PERFORMED *** EXIT ./ ADD NAME=ICBACKUP /* REXX */ ADDRESS TSO "SUBMIT 'P@UDAL.STR.JCLLIB(ICBACKUP)'" ./ ADD NAME=IDD 000100 PROC 0 P() L() C() ENV(CMACIDD) EDIT HELP /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT IF &HELP = &STR(HELP) THEN GOTO HELPSEC /********************************************************************/ /* CLIST NAME : IDD AUTHOR : DAVID LEIGH DATE : 10/03/88 */ /* DESCRIPTION : THIS CLIST TAKES INPUT OF AN IDD COMMAND AND CALLS */ /* IDMSDDDL AND ENTERS THE IDD COMMAND. */ /********************************************************************/ 01000000 /* CHECK TO MAKE SURE WE'RE ON THE RIGHT CPU 00001000 WTSPXSET * NAMES(SYSID) 00001500 IF &SYSID = &STR(P310) THEN 00016600 ELSE + 00016600 DO 00016600 CLEARSCR WRITE *** YOU MUST BE ON P310 TO EXECUTE THIS CLIST *** 00016600 WRITE *** YOU ARE ON &SYSID *** 00016600 WRITE *** NO PROCESSING PERFORMED *** 00016600 EXIT END 00016600 00016600 IF &LENGTH(&STR(&C)) = 0 THEN + DO WRITENR ENTER IDD COMMAND HERE => READ C1 C2 C3 C4 C5 C6 C7 C8 C9 C10 C11 C12 C13 C14 C15 C16 C17 IF &LENGTH(&STR(&C1)) = 0 THEN + DO WRITE *** NO PROCESSING PERFORMED *** EXIT END ELSE SET C = &STR(&C1) + &STR(&C2) + &STR(&C3) + &STR(&C4) + &STR(&C5) + &STR(&C6) + &STR(&C7) + &STR(&C8) + &STR(&C9) + &STR(&C10) + &STR(&C11) + &STR(&C12) + &STR(&C13) + &STR(&C14) + &STR(&C15) + &STR(&C16) + &STR(&C17) END SET IDDDSN = &STR(&SYSPREF..TEMP.IDD.OUTPUT) CLEARSCR WRITE *** CALLING THE IDD USING COMMAND : WRITE WRITE &C WRITE /********************************************************************** /* THE FOLLOWING PROCESS WHICH ACCESS THE TABLE "PROJECT" COULD BE * /* REPLACED WITH SET STATEMENTS TO SET UP THE FOLLOWING VARIABLES : * /* "SCT" = THE SYSCTL DATASET NAME FOR THE CV SPECIFIED. * /* "SLIB" = THE IDMS STEPLIB FOR EXECUTING OLQBATCH FOR THE CV * /* SPECIFIED. THIS IS A LIST OF FULLY QUALIFIED DATASETS WITH* /* SINGLE QUOTES AND DELIMITED BY SPACES. * /* I.E. 'IDMS.CV99.TMPLIB' 'IDMS.CV99.LOADLIB' * /********************************************************************** ISPEXEC TBOPEN PROJECT NOWRITE ISPEXEC TBVCLEAR PROJECT SET TESTPROD = T SET PRJELEM = DBNAME ISPEXEC TBSCAN PROJECT ARGLIST(TESTPROD,PRJELEM) + CONDLIST(EQ,EQ) SET DBNAME = &PRJPARM ISPEXEC TBTOP PROJECT SET PRJELEM = DICTNAME ISPEXEC TBSCAN PROJECT ARGLIST(TESTPROD,PRJELEM) + CONDLIST(EQ,EQ) SET DICT = &PRJPARM ISPEXEC TBTOP PROJECT SET PRJELEM = SYSCTL ISPEXEC TBSCAN PROJECT ARGLIST(TESTPROD,PRJELEM) + CONDLIST(EQ,EQ) SET SCTL = &STR('&PRJPARM') ISPEXEC TBTOP PROJECT ISPEXEC TBSORT PROJECT FIELDS(PRJQUAL,C,A) SET PRJELEM = STEPLIB SET PRJQUAL = IDMS SET SLIB = ISPEXEC TBSCAN PROJECT ARGLIST(TESTPROD,PRJELEM,PRJQUAL) + CONDLIST(EQ,EQ,GE) DO WHILE &LASTCC = 0 SET SLIB = &STR(&SLIB '&PRJPARM') ISPEXEC TBSCAN PROJECT ARGLIST(TESTPROD,PRJELEM,PRJQUAL) + CONDLIST(EQ,EQ,GE) END ISPEXEC TBEND PROJECT FREE ATTRLIST(ATTRIB1) ATTRIB ATTRIB1 + DSORG(PS) + LRECL(80) + RECFM(F B) + OUTPUT FREE ATTRLIST(ATTRIB2) ATTRIB ATTRIB2 + DSORG(PS) + LRECL(132) + RECFM(F B) + OUTPUT FREE ATTRLIST(ATTRIB3) ATTRIB ATTRIB3 + DSORG(PS) + LRECL(80) + RECFM(F B) + OUTPUT DELETE SYSIPT.SYSIN FREE DDNAME(SYSIPT) FREE DDNAME(SYSCTL) FREE DDNAME(SYSLST) FREE DDNAME(SYSPCH) ALLOCATE DD(SYSCTL) + DSN(&SCTL) + SHR IF &SUBSTR(1:3,&C) = &STR(DIS) THEN + IF &EDIT = &STR(EDIT) THEN + DO ALLOCATE DD(SYSLST) + DSN('&IDDDSN') + NEW CATALOG + UNIT(SYSDA) + SPACE(100,50) AVBLOCK(10796) RELEASE + USING(ATTRIB1) ALLOCATE DDNAME(SYSPCH) DUMMY END ELSE + DO ALLOCATE DDNAME(SYSLST) + DSNAME(*) ALLOCATE DDNAME(SYSPCH) DUMMY END 03990600 IF &SUBSTR(1:3,&C) = &STR(PUN) THEN + IF &EDIT = &STR(EDIT) THEN + DO ALLOCATE DD(SYSPCH) + DSN('&IDDDSN') + NEW CATALOG + UNIT(SYSDA) + SPACE(100,50) AVBLOCK(10796) RELEASE + USING(ATTRIB1) DELETE SYSLST ALLOCATE DD(SYSLST) + DSN(SYSLST) + NEW CATALOG + UNIT(SYSDA) + SPACE(100,50) AVBLOCK(10796) RELEASE + USING(ATTRIB1) END ELSE + DO ALLOCATE DDNAME(SYSPCH) + DSNAME(*) DELETE SYSLST ALLOCATE DD(SYSLST) + DSN(SYSLST) + NEW CATALOG + UNIT(SYSDA) + SPACE(100,50) AVBLOCK(10796) RELEASE + USING(ATTRIB1) END 03990600 ALLOCATE DD(SYSIPT) + 03992000 DSN(SYSIPT.SYSIN) + 03992000 NEW CATALOG + UNIT(SYSDA) + SPACE(10,5) AVBLOCK(10796) RELEASE + USING(ATTRIB1) OPENFILE SYSIPT OUTPUT SET &SYSIPT = &STR( SIGNON USE &SYSUID DIC &DICT DBN &DBNAME..) PUTFILE SYSIPT SET &SYSIPT = &STR( &C..) PUTFILE SYSIPT SET &SYSIPT = &STR( BYE.) PUTFILE SYSIPT CLOSFILE SYSIPT STEPLIB SET DSNAME(&SLIB) IDMSDDDL SET DDDLCC = &LASTCC STEPLIB RESET ALL FREE DDNAME(SYSIPT) FREE DDNAME(SYSCTL) FREE DDNAME(SYSLST) FREE DDNAME(SYSPCH) DELETE SYSIPT.SYSIN IF &DDDLCC > 0 AND &C1 = PUN THEN + DO WRITE *** PRESS TO EDIT ERROR DATASET ISPEXEC EDIT DATASET(SYSLST) GOTO FINAL END IF &EDIT = &STR(EDIT) THEN + DO WRITE *** PRESS TO EDIT OUTPUT DATASET ISPEXEC EDIT DATASET('&IDDDSN') END FINAL: + EXIT HELPSEC: + CLEARSCR WRITE *** HELP FOR CLIST 'IDD' *** WRITE WRITE THE IDD CLIST ALLOWS YOU TO ENTER AN IDD COMMAND WHILE WITHIN TSO WRITE AND TO DISPLAY THE OUTPUT OR PLACE THE OUTPUT IN A DATASET AND BE WRITE TAKEN INTO AN EDIT OF THE OUTPUT. YOU MAY RECEIVE THE OUTPUT IN WRITE 'PUNCH' OR 'DISPLAY' FORMAT BY SPECIFYING THAT IN YOUR COMMAND. WRITE WRITE BASIC SYNTAX : WRITE WRITE COMMAND ===> TSO IDD WRITE WRITE WITH THIS EXAMPLE YOU WILL BE PROMPTED FOR THE IDD COMMAND YOU WRITE WHICH TO ENTER. WRITE WRITE TO SPECIFY YOUR IDD COMMAND AT CLIST EXECUTION WRITE WRITE COMMAND ===> TSO IDD C(DIS REC CT-DORG-RCD) WRITE WRITE WITH THIS EXAMPLE YOUR OUTPUT WILL BE DISPLAYED (NOT SAVED IN A WRITE DATASET) AND IT WILL BE IN IDD DISPLAY FORMAT. WRITE WRITE TO PLACE THE OUTPUT IN A DATASET AND EDIT THE DATASET AT THE END WRITE OF THE CLIST. WRITE WRITE COMMAND ===> TSO IDD C(DIS REC CA-CASE) EDIT WRITE WRITE WITH THIS EXAMPLE YOUR OUTPUT WILL BE SAVED INTO A DATASET AND THE WRITE DATASET WILL BE EDITED AT THE END OF THE CLIST. THE OUTPUT WILL WRITE BE IN IDD 'DISPLAY' FORMAT. WRITE WRITE TO HAVE THE IDD OUTPUT BE PRESENTED IN 'PUNCH' FORMAT. WRITE WRITE COMMAND ===> TSO IDD C(PUN REC CA-CASE) EDIT WRITE WRITE WITH THIS EXAMPLE YOUR OUTPUT WILL BE SAVED INTO A DATASET AND THE WRITE DATASET WILL BE EDITED AT THE END OF THE CLIST. THE OUTPUT WILL WRITE BE IN IDD 'PUNCH' FORMAT. WRITE WRITE *** END OF HELP *** NO PROCESSING PERFORMED *** EXIT ./ ADD NAME=IDFIX /* REXX ***************************************************************/ /* UTILITY: IDFIX */ /* AUTHOR: DAVID LEIGH */ /* FUNCTION: THIS UTILITY SCANS REGULAR PDS'S OR ISPF PROFILE PDS'S */ /* TO REPLACE OCCURANCES OF ONE'S OLD USER ID WITH ONE'S */ /* NEW USERID. */ /* */ /**********************************************************************/ ADDRESS ISPEXEC "CONTROL ERRORS RETURN" /**********************************************************************/ /* GET THE ID EITHER PASSED IN OR PROMPT FOR IT */ /**********************************************************************/ PARSE UPPER ARG DSN OLDID DO WHILE DSN = '' SAY 'PLEASE ENTER THE LIBRARY NAME TO SCAN OR "X" TO QUIT ==>' PULL DSN IF DSN = 'X' THEN EXIT END /**********************************************************************/ /* DETERMINE WHAT THE OLD ID WAS THAT YOU'RE CHANGING FROM */ /**********************************************************************/ OLDID = SUBSTR(SYSVAR(SYSUID),1,2) ³³, SUBSTR(SYSVAR(SYSUID),4,3) /**********************************************************************/ /* HAVE THE USER CONFIRM THIS AND GIVE THE OPPORTUNITY TO QUIT */ /**********************************************************************/ ADDRESS ISPEXEC "ADDPOP ROW(7) COLUMN(15)" DO FOREVER "DISPLAY PANEL(IDFIX)" SELECT WHEN RC = 0 & OLDID > '' THEN DO "VPUT OLDID SHARED" LEAVE END WHEN RC = 8 THEN DO "REMPOP" EXIT END OTHERWISE NOP END END /**********************************************************************/ /* PREP THE DATASET NAME AND DETERMINE IF THIS IS THE ISPF PROFILE */ /**********************************************************************/ QTE = "'" IF POS(QTE,DSN) = 0 THEN DSN = QTE ³³ DSN ³³ QTE IF DSN = "'" ³³ SYSVAR(SYSUID) ³³ ".ISPF.ISPPROF'" THEN PROFLIB = YES ELSE PROFLIB = NO /**********************************************************************/ /* SET UP THE PROCESSING MESSAGES TO GO TO A TEMPORARY FILE */ /**********************************************************************/ ADDRESS TSO DUMMY = OUTTRAP(NULL) "FREE DD(TEMPOUT)" TEMPFILE = SYSVAR(SYSUID)".TEMP.IDFIX.D"SUBSTR(DATE('S'),3,6) ³³, ".T"SUBSTR(TIME('N'),1,2) ³³, SUBSTR(TIME('N'),4,2) ³³, SUBSTR(TIME('N'),7,2) "DELETE '"TEMPFILE"'" "ALLOCATE DD(TEMPOUT) DSN('"TEMPFILE"')" , "NEW CATALOG" , "UNIT(SYSDA) VOLUME(WRK$$$)" , "SPACE(1,1) CYLINDERS RELEASE" , "RECFM(F B) LRECL(255) BLKSIZE(23460) DSORG(PS)" DROP NULL. "NEWSTACK" QUEUE "IDFIX RESULTS FOR DATASET: "DSN "EXECIO 1 DISKW TEMPOUT" "DELSTACK" /**********************************************************************/ /* POINT TO THE DATASET TO BE PROCESSED AND DO A PRIMING MEMBER READ */ /**********************************************************************/ ADDRESS ISPEXEC "ADDPOP" "LMINIT DATASET("DSN") DATAID(DID) ENQ(SHRW)" IF PROFLIB = 'YES' THEN DO "LIBDEF ISPTLIB" "LIBDEF ISPTLIB LIBRARY ID(ISPPROF)" "VGET ZAPPLID" END "LMOPEN DATAID("DID")" "LMMLIST DATAID("DID") MEMBER(MBR) OPTION(LIST)" /**********************************************************************/ /* LOOP THROUGH THE MEMBERS AND EDIT THEM TO FIX THEM. */ /**********************************************************************/ DO WHILE RC = 0 MBR = STRIP(MBR) IF PROFLIB = 'YES' THEN IF POS('PROF',MBR) = LENGTH(MBR) - 3 THEN DO APPL = SUBSTR(MBR,1,POS('PROF',MBR)-1) IF APPL ¬= 'ISPS' THEN DO IF APPL = ZAPPLID THEN DO APPL = '' SAMEAPPL = 'YES' END ELSE DO APPL = "NEWAPPL("APPL")" SAMEAPPL = 'NO' END "CONTROL DISPLAY LOCK" "DISPLAY PANEL(IDFIX2)" "SELECT CMD(%IDFIXPRF", OLDID MBR SAMEAPPL ")" APPL END END ELSE NOP ELSE DO "CONTROL DISPLAY LOCK" "DISPLAY PANEL(IDFIX2)" "EDIT DATAID("DID") MEMBER("MBR") MACRO(IDFIXLIB)" IF RC = 20 THEN DO XMBR = SUBSTR(MBR" ",1,8) "-" QUEUE XMBR "RC = 20, MESSAGE:" ZERRLM ADDRESS TSO "EXECIO 1 DISKW TEMPOUT" END END "LMMLIST DATAID("DID") MEMBER(MBR) OPTION(LIST)" END /**********************************************************************/ /* CLEAN UP AND LET THE USER KNOW WHERE THE OUTPUT IS. */ /**********************************************************************/ "LMMLIST DATAID("DID") MEMBER(MBR) OPTION(FREE)" "LMCLOSE DATAID("DID")" "LMFREE DATAID("DID")" "REMPOP" "REMPOP" ADDRESS TSO "EXECIO 0 DISKW TEMPOUT (FINIS" "FREE DD(TEMPOUT)" ADDRESS ISPEXEC "EDIT DATASET('"TEMPFILE"')" ./ ADD NAME=IDFIXLIB /* REXX ***************************************************************/ /* CALLED BY "IDFIX" */ /**********************************************************************/ /**********************************************************************/ /* INITIALIZATION STUFF */ /**********************************************************************/ ADDRESS ISPEXEC "CONTROL ERRORS RETURN" "VGET OLDID SHARED" ADDRESS TSO "NEWSTACK" ADDRESS ISREDIT "MACRO" "(MEMBER) = MEMBER" MEMBER = SUBSTR(MEMBER" ",1,8) "-" QUEUE " " /**********************************************************************/ /* RE-EXCLUDE ANY JCL COMMENT LINES AND THEN LOOK FOR JOB CARD AND */ /* ANY DSN CARDS AND MAKE SURE THEY DON'T CREATE INVALID JCL OR */ /* REFERENCE ANY UNKNOWN DATASETS. */ /**********************************************************************/ "EXCLUDE ALL '//*' 1" "FIND FIRST ' JOB ' NX" IF RC = 0 THEN DO "(LINE) = LINE .ZCSR" IF POS('//'SYSVAR(SYSUID),LINE) = 1 &, (POS(' JOB ',LINE) > 9 &, POS(' JOB ',LINE) < 25) THEN DO PARSE UPPER VAR LINE '//' JOBNAME DISCARD IF LENGTH(JOBNAME) > 8 THEN DO NEWNAME = SUBSTR(JOBNAME,1,8) QUEUE MEMBER "JOBNAME CHANGED FROM '"JOBNAME, "' TO '"NEWNAME"'" "CHANGE '//"JOBNAME"' '//"NEWNAME"'", "FIRST .ZCSR .ZCSR" CHANGED = 'YES' END ELSE QUEUE MEMBER "JOB CARD DETECTED BUT ID CHANGE", "DID NOT MAKE IT TOO LONG" END ELSE QUEUE MEMBER "NO" SYSVAR(SYSUID) "JOB CARD FOUND" END ELSE QUEUE MEMBER "NO JOB CARD FOUND" NUMMSGS = QUEUED() ADDRESS TSO "EXECIO" NUMMSGS "DISKW TEMPOUT" "DELSTACK" IF CHANGED = 'YES' THEN ADDRESS ISREDIT "END" ELSE ADDRESS ISREDIT "CANCEL" ./ ADD NAME=IDFIXPRF /* REXX ***************************************************************/ /* CALLED BY "IDFIX" */ /**********************************************************************/ /**********************************************************************/ /* INITIALIZATION STUFF */ /**********************************************************************/ PARSE UPPER ARG OLDID MBR SAMEAPPL ADDRESS ISPEXEC "CONTROL ERRORS RETURN" LO = LENGTH(OLDID) NEWID = SYSVAR(SYSUID) PROFTAB = MBR MBR = SUBSTR(MBR" ",1,8) "-" ADDRESS TSO "NEWSTACK" /**********************************************************************/ /* */ /**********************************************************************/ ADDRESS ISPEXEC IF SAMEAPPL = 'YES' THEN "TBTOP" PROFTAB "TBSKIP" PROFTAB "SAVENAME(SAVEVARS)" I = 0 DO WHILE SAVEVARS > '' I = I + 1 PARSE UPPER VAR SAVEVARS VAR.I SAVEVARS END DO X = 1 TO I CHANGED = 'NO' IF X = 1 THEN VAR.X = STRIP(VAR.X,'L','(') IF X = I THEN VAR.X = STRIP(VAR.X,'T',')') "VGET" VAR.X "PROFILE" CURRVAR = VALUE(VAR.X) Y = POS(OLDID,CURRVAR) DO WHILE Y > 0 CHANGED = 'YES' CURRVAR = DELSTR(CURRVAR,Y,LO) CURRVAR = INSERT(NEWID,CURRVAR,Y-1,) Y = POS(OLDID,CURRVAR) END IF CHANGED = 'YES' THEN QUEUE MBR "'"OLDID"' ==> '"NEWID"' IN VARIABLE '"VAR.X"'" IF POS('//'NEWID,CURRVAR) = 1 &, (POS(' JOB ',CURRVAR) > 9 &, POS(' JOB ',CURRVAR) < 25) THEN DO PARSE UPPER VAR CURRVAR '//' JOBNAME DISCARD IF LENGTH(JOBNAME) > 8 THEN DO NEWNAME = SUBSTR(JOBNAME,1,8) QUEUE MBR "JOBNAME CHANGED FROM '"JOBNAME, "' TO '"NEWNAME"' IN VARIABLE '"VAR.X"'" OLDNAME = "//" ³³ JOBNAME LOJ = LENGTH(OLDNAME) NEWNAME = "//" ³³ NEWNAME LNJ = LENGTH(NEWNAME) CURRVAR = DELSTR(CURRVAR,1,LOJ) CURRVAR = INSERT(NEWNAME,CURRVAR,0) END END IF CHANGED = 'YES' THEN DO CMMD = '= CURRVAR' CMMD = VALUE('VAR.X') CMMD INTERPRET CMMD "VPUT" VAR.X "PROFILE" END END NUMMSGS = QUEUED() ADDRESS TSO "EXECIO" NUMMSGS "DISKW TEMPOUT" "DELSTACK" ./ ADD NAME=IE PROC 0 DEBUG IF &DEBUG = &STR(DEBUG) THEN + CONTROL LIST MSG CONLIST SYMLIST PROMPT ELSE + CONTROL NOLIST NOMSG NOFLUSH NOPROMPT 00020000 ISPEXEC VGET (COMPLIST) SHARED ISPEXEC VGET (TESTSRC) SHARED ISPEXEC VGET (MEMBER) SHARED ISPEXEC VGET (DSTYPE) SHARED IF &DSTYPE ¬= COBIDMS THEN + DO WRITE *** DATASET TYPE FOR &MEMBER IS NOT "COBIDMS" *** WRITE *** NO PROCESSING PERFORMED *** EXIT END 01000000 IF &SYSDSN('&COMPLIST') = OK THEN + 01000000 DO 01000000 LISTDSI '&COMPLIST' 01000000 IF &STR(&SUBSTR(1:2,&SYSJDATE)&SUBSTR(4:6,&SYSJDATE) = + 01000000 &STR(&SUBSTR(3:4,&SYSREFDATE)&SUBSTR(6:7,&SYSREFDATE) THEN + 01000000 DO 01000000 WRITE *** THE COMPILED LISTING WAS NOT CREATED TODAY ***01000000 WRITE *** IT WAS CREATED : &SYSREFDATE *** 01000000 WRITE 01000000 WRITENR IS IT OK TO CONTINUE PROCESSING (Y/N) ? 01000000 READ YN1 01000000 IF &YN1 ¬= &STR(Y) THEN + 01000000 DO 01000000 WRITE *** NO PROCESSING PERFORMED *** 01000000 EXIT 01000000 END 01000000 END 01000000 END 01000000 ELSE + 01000000 DO 01000000 WRITE *** COMPILED LISTING NOT FOUND FOR &MEMBER *** 01000000 WRITE *** NO PROCESSING PERFORMED *** 01000000 EXIT 01000000 END 01000000 01000000 01000000 01000000 01000000 01000000 01000000 01000000 01000000 01000000 01000000 WRITE *** SCANNING BATCH BOOK FOR STEPS LISTING *** 01010000 01020000 FREE ATTRLIST(ATTRIB1) 01030000 ATTRIB ATTRIB1 + 01040000 BLKSIZE(15440) + 01050000 LRECL(80) + 01060000 RECFM(F B) + 01070000 OUTPUT 01080000 01340000 DELETE BBOUTPUT 01350000 FREE DDNAME(BBIN) 01360000 01440000 ALLOCATE DDNAME(BBIN) + 01450000 DSNAME('TCWCA.TWB.WORKFILE(BACHBOOK)') + 01460000 SHR KEEP 01470000 01480000 ALLOCATE DDNAME(BBOUT) + 01490000 DSNAME('&SYSPREF..BBOUTPUT') + 01500000 NEW CATALOG + 01510000 UNIT(SYSDA) + 01520000 SPACE(1,1) CYLINDERS RELEASE + 01530000 USING(ATTRIB1) 01540000 01620000 OPENFILE BBIN INPUT 01630000 OPENFILE BBOUT OUTPUT 02220000 02230000 SET &EOF = NO 02240000 02250000 ERROR DO 02260000 IF &LASTCC = 400 THEN + 02270000 DO 02280000 SET &EOF = YES 02290000 RETURN 02300000 END 02310000 ELSE + 02320000 DO 02330000 CLEAR 02350000 WRITE 02350000 WRITE *** UNEXPECTED ERROR IN CLIST BBSTEPS *** 02340000 WRITE 02350000 WRITE *** RETURN CODE WAS : &LASTCC *** 02340000 WRITE 02350000 WRITE *** PROGRAM VARIABLES ARE : 02350000 WRITE A = &A 02350000 WRITE B = &B 02350000 WRITE EOF = &EOF 02350000 WRITE BBIN = &BBIN 02350000 WRITE BBOUT = &BBOUT 02350000 CLOSFILE BBIN 02470000 CLOSFILE BBOUT 02480000 FREE DDNAME(ATTRIB1) 02360000 FREE DDNAME(BBIN) 02360000 FREE DDNAME(BBOUT) 02360000 DELETE BBOUTPUT 02370000 EXIT 02380000 END 02390000 END 02400000 02410000 GETFILE BBIN 02420000 02430000 DO WHILE &EOF = NO 02440000 IF &SYSINDEX(&STR( JOB STREAM: ),&BBIN) > 0 THEN + 02410000 DO 02410000 SET &A = &EVAL(&SYSINDEX(&STR(JOB STREAM:),&BBIN) + 12) SET &B = &A + 10 SET &BBOUT = &SUBSTR(&A:&B,&BBIN) /* CLEAR 02350000 /* WRITE *** PROGRAM VARIABLES ARE : 02350000 /* WRITE A = &A 02350000 /* WRITE B = &B 02350000 /* WRITE EOF = &EOF 02350000 /* WRITE BBIN = &BBIN 02350000 /* WRITE BBOUT = &BBOUT 02350000 /* EXIT 02350000 END 02410000 ELSE 02410000 IF &SYSINDEX(&STR( PROC STEP: ),&BBIN) > 0 THEN + 0241 DO 0241 SET &A = &EVAL(&SYSINDEX(&STR(PROC STEP:),&BBIN) + 11) SET &B = &A + 10 SET &BBIN = &SUBSTR(&A:&B,&BBIN) SET &BBOUT = &STR(&BBIN &BBOUT) PUTFILE BBOUT END 0241 GETFILE BBIN 02420000 END 02450000 02460000 CLOSFILE BBIN 02470000 CLOSFILE BBOUT 02480000 02490000 04420000 IF &OUTDSN = &STR(OUTDSN) THEN + 04430000 DO 04440000 CLEAR 04440000 %WAACEDIT '&SYSPREF..BBOUTPUT' 04450000 END 04460000 04470000 EXIT 04480000 ./ ADD NAME=IEBUPFMT PROC 1 DSN /**** 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 ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /* ISPEXEC EDIT DATASET('&DSN') MACRO(IEBUPFM2) EXIT ./ ADD NAME=IEBUPFM2 ISREDIT MACRO ISREDIT RECOVERY = OFF ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /* /********************************************************************** /* FIRST, DELETE ALIAS MEMBERS. * /********************************************************************** ISREDIT FIND FIRST ' DISPLAY ' 1 ISREDIT FIND NEXT P'=' 1 ISREDIT LABEL .ZCSR = .A ISREDIT FIND NEXT 'PDS300A ENTER OPTION ' 1 ISREDIT FIND PREV P'.' 1 ISREDIT LABEL .ZCSR = .B ISREDIT FIND FIRST '-A ' .A .B DO WHILE &LASTCC = 0 ISREDIT (LN2,CL2) = CURSOR SET CL2 = &CL2 - 1 SET CL1 = &CL2 - 7 ISREDIT (LINE) = LINE .ZCSR SET ALIAS = &SUBSTR(&CL1:&CL2,&STR(&SYSNSUB(1,&LINE))) ISREDIT FIND FIRST './ ADD NAME=&ALIAS' 1 IF &LASTCC = 0 THEN + DO ISREDIT LABEL .ZCSR = .ALA ISREDIT FIND NEXT './ ADD NAME=' 1 IF &LASTCC = 0 THEN + DO SET ALB = &STR(.ALB) ISREDIT FIND PREV P'=' 1 ISREDIT LABEL .ZCSR = &STR(&ALB) END ELSE SET ALB = &STR(.ZLAST) ISREDIT DELETE .ALA &STR(&ALB) END ISREDIT CURSOR = &LN2 &EVAL(&CL2 + 2) ISREDIT FIND NEXT '-A ' .A .B END /********************************************************************** /* DELETE THE PDS INITIAL COMMMAND DISPLAY LINES * /********************************************************************** ISREDIT FIND FIRST './ ADD NAME=' 1 ISREDIT FIND PREV ' ' 1 ISREDIT DELETE .ZF .ZCSR ISREDIT FIND LAST ' LINES IN THIS MEMBER ' 10 ISREDIT DELETE .ZCSR .ZL /********************************************************************** /* CHANGE THE LIST TO IEBUPDATE CARDS * /********************************************************************** ISREDIT EXCLUDE ALL P'$$ @@@@ .' 1 ISREDIT CHANGE ALL 1 './ ADD NAME=' './ ADD NAME=' X ISREDIT RESET EXCLUDED /********************************************************************** /* GET RID OF MEMBER TRAILER LINES PDS PUTS IN. * /********************************************************************** ISREDIT FIND FIRST ' LINES IN THIS MEMBER ' 10 DO WHILE &LASTCC = 0 ISREDIT EXCLUDE P'=' .ZCSR .ZCSR ISREDIT FIND NEXT P'=' 1 ISREDIT EXCLUDE P'=' .ZCSR .ZCSR ISREDIT FIND NEXT ' LINES IN THIS MEMBER ' 10 END ISREDIT DELETE .ZF .ZL X ISREDIT SAVE ISREDIT END ./ ADD NAME=IMPLEMNT /********************************************************************** /* UTILITY: IMPLEMNT * /* AUTHOR: DAVID LEIGH * /* FUNCTION: THIS CLIST EXTRACTS DB2 DATA, AND USES THAT DATA TO * /* DYNAMICALLY CREATE A JOB TO IMPLEMENT DATABASE CHANGES * /* TO THE DB2 ENVIRONMENT. .* /********************************************************************** PROC 0 IMPLPFX(PDBA.STR) /* POINT TO THE ISPF SET OF LIBRARIES */ + DCREATOR(USSTRP00) /* DB2 CREATOR FOR RUN DATE EXTRACT */ + DATETABL(ADM40T_GRPPROF) /* TABLE CONTAINING RUN DATE */ + DATESSID(DSNP) /* DB2 SUBSYSTEM CONTAINING RUN DATE TABLE */ + CCREATOR(DBAUTIL) /* DB2 CREATOR FOR THE CONTROL TABLE */ + CNTLTABL(CHG_CNTL_IMPL) /* DB CHANGE CONTROL TABLE */ + CNTLSSID(DSNT) /* DB2 SUBSYSTEM CONTAINING CONTROL TABLE */ + OUTJOB() /* NAME OF JOB TO BE CREATED AND ISPF TABLE */ + CNTLDSN() /* NAME OF THE TEMP FILE TO HOLD CONTROL TABLE */ + DB2SSID() /* DB2 TARGET SUBSYSTEM FOR IMPLEMENTATION */ + LOADDSNT(SYS4.DSN.PROD.DSNT.SDSNLOAD) /* DB2 LOAD LIB DSNT */ + LOADDSNP(SYS4.DSN.PROD.DSNP.SDSNLOAD) /* DB2 LOAD LIB DSNP */ + LIBDSNT(SYS4.DSN.PROD.DSNT.RUNLIB.LOAD) /*DB2 LOAD LIB DSNT */ + LIBDSNP(SYS4.DSN.PROD.DSNP.RUNLIB.LOAD) /*DB2 LOAD LIB DSNP */ + DEBUG /* TURN DEBUGGING ON */ ISPEXEC CONTROL ERRORS RETURN /*** CHECK THE DEBUG SWITCH ***/ IF &DEBUG = DEBUG THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS /********************************************************************** /* ESTABLISH SOME OTHER VARIABLES * /********************************************************************** SET LP = &STR(( SET RP = &STR()) SET ZISPFRC = 0 SET DSNLOAD = &STR(&SYSNSUB(2,&&LOAD&CNTLSSID)) /********************************************************************** /* PUT THE RUNDATE INTO AN ISPF VARIABLE * /********************************************************************** WRITE &STR(LOAD RUN DATE INTO ISPF) ERROR DO SET ERRCC = &LASTCC ERROR OFF WRITE &STR(!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!) WRITE &STR(ERROR LOADING RUNDATE) WRITE &STR(RETURN CODE: &ERRCC) WRITE &STR(FROM DD: SYSREC00) WRITE &STR(!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!) CLOSFILE SYSREC00 FREE DD(SYSREC00) IF &ZISPFRC < &ERRCC THEN SET ZISPFRC = &ERRCC ISPEXEC VPUT ZISPFRC SHARED RETURN END OPENFILE SYSREC00 GETFILE SYSREC00 SET RUNDATE = &SUBSTR(183:192,&STR(&SYSNSUB(1,&SYSREC00))) CLOSFILE SYSREC00 ERROR OFF FREE DD(SYSREC00) WRITE &STR(LOAD RUN DATE INTO ISPF)+ &STR(. RUNDATE: &RUNDATE) /**********************************************************************/ /* FOLLOWING CODE ADDED ON 9/9/95 BY DAVID LEIGH TO MAKE A ONE TIME */ /* CHANGE TO THE RUN DATE FOR THE IMPLEMENTATION OF THE CHANGES OF */ /* THE COBOL II RESERVED WORD PROJECT. THIS CODE MAY BE */ /* USED FOR OTHER SIMILAR CIRCUMSTANCES. */ /**********************************************************************/ IF &STR(&SYSSDATE) = &STR(96/01/13) THEN SET RUNDATE = &STR(1996-01-13) /**********************************************************************/ /* END OF CODE ADDED 9/9/95 */ /**********************************************************************/ /*********************************************************************** /* RECREATE TEMPORARY TABLE TO HOLD THE DB2 CONTROL TABLE * /*********************************************************************** WRITE &STR(CREATING THE ISPF TABLE) ISPEXEC LIBDEF ISPTLIB DATASET ID('&IMPLPFX..ISPTLIB') ISPEXEC LIBDEF ISPTABL DATASET ID('&IMPLPFX..ISPTLIB') ISPEXEC TBCREATE &STR(&OUTJOB) KEYS(STRATEGY STRATDSN STRATMBR) + NAMES(DATASET) + WRITE + REPLACE SET CREATECC = &LASTCC WRITE &STR(CREATING THE ISPF TABLE)+ &STR( RC: &CREATECC) IF &ZISPFRC < &CREATECC THEN SET ZISPFRC = &CREATECC ISPEXEC VPUT ZISPFRC SHARED /*********************************************************************** /* UNLOAD CHANGE CONTROL TABLE FOR TODAY'S CHANGES * /*********************************************************************** WRITE &STR(EXTRACTING THE CONTROL TABLE) FREE DD(SYSREC00 SYSIN SYSPRINT SYSPUNCH) ALLOC DD(SYSPRINT) DA(*) ALLOC DD(SYSPUNCH) DA(*) DELETE &STR('&CNTLDSN') ALLOC DD(SYSREC00) DSN('&CNTLDSN') + NEW CATALOG + UNIT(SYSDA) + SPACE(1,1) TRACKS RELEASE DSORG(PS) ALLOC DD(SYSIN) + NEW + UNIT(SYSDA) + SPACE(1,1) TRACKS RELEASE + RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS) OPENFILE SYSIN OUTPUT SET SYSIN = &STR(&CCREATOR..&CNTLTABL)+ &STR( WHERE D = '&RUNDATE' AND S = '&DB2SSID')+ &STR( ORDER BY 5) PUTFILE SYSIN CLOSFILE SYSIN CONTROL END(END@) DSN SYSTEM(&CNTLSSID) RUN PROGRAM(DSNTIAUL) PLAN(DSNTIAUL) END SET CNTLCC = &LASTCC WRITE &STR(EXTRACTING THE CONTROL TABLE)+ &STR( RC: &CNTLCC) CONTROL END(END) FREE DD(SYSIN SYSPRINT SYSPUNCH) IF &ZISPFRC < &CNTLCC THEN SET ZISPFRC = &CNTLCC ISPEXEC VPUT ZISPFRC SHARED /********************************************************************** /* LOAD THE CONTROL TABLE INTO AN ISPF TABLE * /********************************************************************** WRITE &STR(LOADING THE ISPF TABLE) ERROR DO SET ERRCC = &LASTCC SELECT (&ERRCC) WHEN (400) DO SET EOF = YES RETURN END OTHERWISE DO ERROR OFF WRITE &STR(!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!) WRITE &STR(ERROR LOADING ISPF TABLE) WRITE &STR(RETURN CODE: &ERRCC) WRITE &STR(WHILE PROCESSING RECORD #&REC) WRITE &STR(FROM: &CNTLDSN) WRITE &STR(!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!) CLOSFILE SYSREC00 FREE DD(SYSREC00) IF &ZISPFRC < &ERRCC THEN SET ZISPFRC = &ERRCC ISPEXEC VPUT ZISPFRC SHARED GOTO FINISH END END END SET REC = 0 SET ADDED = 0 SET EOF = NO OPENFILE SYSREC00 GETFILE SYSREC00 DO WHILE &EOF = NO SET REC = &REC + 1 SET STRATEGY = &SUBSTR(001:008,&STR(&SYSNSUB(1,&SYSREC00))) SET STRATDSN = &SUBSTR(009:052,&STR(&SYSNSUB(1,&SYSREC00))) SET STRATMBR = &SUBSTR(053:060,&STR(&SYSNSUB(1,&SYSREC00))) SET STRATMBR = &STRATMBR SET X = &SYSINDEX(&STR( ),&STR(&STRATDSN)) IF &X > 1 THEN + DO SET STRATDSN = &SUBSTR(1:&X-1,&STR(&STRATDSN)) SET DATASET = &STR(&STRATDSN(&STRATMBR)) END ISPEXEC TBADD &STR(&OUTJOB) SET ADDED = &ADDED + 1 GETFILE SYSREC00 END ERROR OFF CLOSFILE SYSREC00 FREE DD(SYSREC00) ISPEXEC TBCLOSE &STR(&OUTJOB) WRITE &STR(LOADING THE ISPF TABLE)+ &STR(. LOADED &ADDED ROWS) /********************************************************************** /* CREATE THE OUTPUT JOB * /********************************************************************** WRITE &STR(CREATING JOB &OUTJOB) ISPEXEC FTOPEN ISPEXEC FTINCL IMPLEMNT SET INCLCC = &LASTCC ISPEXEC FTCLOSE NAME(&OUTJOB) IF &ZISPFRC < &INCLCC THEN + DO SET ZISPFRC = &INCLCC ISPEXEC VPUT ZISPFRC SHARED GOTO FINISH END WRITE &STR(CREATING JOB &OUTJOB) + &STR( RC: &INCLCC) /********************************************************************** /* GET OUT! * /********************************************************************** FINISH: + EXIT ./ ADD NAME=INCLCOPY PROC 0 HELP /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT IF &HELP = &STR(HELP) THEN GOTO HELPSEC /********************************************************************** /* UTILITY : INCLCOPY * /* AUTHOR : DAVE LEIGH * /* FUNCTION : THIS UTILITY COPIES CHAMP STATUS 1 INCLUDE MEMBERS TO A * /* NON-CHAMP LIBRARY WHICH IS USED FOR COPY MEMBERS. * /********************************************************************** WTSPXSET * NAMES(PRGNAME) ISPEXEC VGET (JC SBOX) PROFILE ISPEXEC TBOPEN PROJECT NOWRITE ISPEXEC TBTOP PROJECT ISPEXEC TBVCLEAR PROJECT SET PRJELEM = SUPERID ISPEXEC TBSCAN PROJECT ARGLIST(PRJELEM) CONDLIST(EQ) IF &LASTCC = 0 THEN SET SUPERID = &PRJQUAL ELSE SET SUPERID = ISPEXEC TBTOP PROJECT ISPEXEC TBVCLEAR PROJECT ISPEXEC TBTOP PROJECT ISPEXEC TBVCLEAR PROJECT SET TESTPROD = T SET PRJELEM = BATCH SET PRJPARM = &STR(ACCESS CODE) ISPEXEC TBSCAN PROJECT ARGLIST(TESTPROD,PRJELEM,PRJPARM) + CONDLIST(EQ,EQ,EQ) IF &LASTCC = 0 THEN SET ACCESS = &PRJQUAL ELSE SET ACCESS = ISPEXEC TBTOP PROJECT ISPEXEC TBVCLEAR PROJECT SET TESTPROD = P SET PRJELEM = COPY SET PRJQUAL = LIBRARY ISPEXEC TBSCAN PROJECT ARGLIST(TESTPROD,PRJELEM,PRJQUAL) + CONDLIST(EQ,EQ,EQ) IF &LASTCC = 0 THEN SET INCLCOPY = &PRJPARM ELSE SET INCLCOPY = ISPEXEC TBEND PROJECT %BIMONTH ISPEXEC VGET (ACF2PW) SHARED SET SUPERPW = &NRSTR(&ACF2PW) SET ACF2PW = ISPEXEC VPUT (ACF2PW) SHARED SET SYSOUTTRAP = 1000 LISTCAT LEVEL(SYS4.&SYSPREF) SET B = &SYSOUTLINE SET SYSOUTTRAP = 0 SET DSN = SET A = 1 SET E = 0 DO WHILE &A <= &B SET &LINE = &&SYSOUTLINE&A IF &SYSINDEX(&STR(NONVSAM -),&STR(&LINE)) > 0 THEN + DO SET C = &EVAL(&SYSINDEX(+ &STR(NONVSAM -),&LINE) + 16) SET D = &LENGTH(&STR(&LINE)) SET DSN = &SUBSTR(&C:&D,&LINE) SET D = &EVAL(&SYSINDEX(&STR( ),&STR(&DSN)) - 1) IF &D > 0 THEN SET DSN = &SUBSTR(1:&D,&DSN) SET E = &E + 1 END SET A = &A + 1 END SET SYSOUTTRAP = 0 IF &E > 1 THEN SET DSN = ISPEXEC VPUT (DSN ACCESS SUPERID SUPERPW) SHARED ISPEXEC DISPLAY PANEL(UTILUPTM) IF &LASTCC = 8 THEN + DO SET ZEDLMSG = &STR("INCLCOPY" FUNCTION NOT EXECUTED) ISPEXEC SETMSG MSG(UTLZ000) EXIT END ELSE + DO ISPEXEC VGET (JCLREVEW) SHARED IF &SYSDSN('&DSN') ¬= OK THEN + DO SET ZEDLMSG = &STR("&DSN" PROBLEM : &SYSDSN('&DSN')) ISPEXEC SETMSG MSG(UTLZ001) EXIT END IF &JCLREVEW = &STR(Y) THEN + DO DELETE TEMP.JCL FREE DDNAME(ISPFILE) FREE DDNAME(QUICK) FREE ATTRLIST(ATTRIB1) ATTRIB ATTRIB1 + RECFM(F B) + LRECL(80) + DSORG(PS) + BLKSIZE(23440) + OUTPUT ALLOCATE DDNAME(QUICK) + DSN(TEMP.JCL) + NEW CATALOG + UNIT(SYSDA) + SPACE(1,1) TRACKS RELEASE + USING(ATTRIB1) FREE DDNAME(QUICK) ALLOCATE DDNAME(ISPFILE) + DSN(TEMP.JCL) + OLD ISPEXEC FTOPEN ISPEXEC FTINCL UTILUPTM SET SAVECC = &LASTCC ISPEXEC FTCLOSE FREE DDNAME(ISPFILE) IF &SAVECC > 0 THEN + DO SET ZEDLMSG = &STR(PROBLEM CREATING JCL) ISPEXEC SETMSG MSG(UTLZ001) EXIT END ELSE + DO ISPEXEC SETMSG MSG(UTILM030) ISPEXEC EDIT DATASET(TEMP.JCL) END END ELSE + DO ISPEXEC FTOPEN TEMP ISPEXEC FTINCL UTILUPTM SET SAVECC = &LASTCC ISPEXEC FTCLOSE IF &SAVECC > 0 THEN + DO SET ZEDLMSG = &STR(PROBLEM CREATING JCL) ISPEXEC SETMSG MSG(UTLZ001) EXIT END ELSE + DO SET ZEDLMSG = &STR("INCLCOPY" JOB SUBMITTED) ISPEXEC SETMSG MSG(UTLZ001) ISPEXEC VGET (ZTEMPF) SHARED SUBMIT '&ZTEMPF' END END END SET DSN = ISPEXEC VPUT (DSN) PROFILE EXIT HELPSEC: + CLEARSCR WRITE *** HELP FOR CLIST INCLCOPY *** WRITE WRITE HELP NOT WRITTEN AT THIS TIME WRITE WRITE *** END OF HELP *** NO PROCESSING PERFORMED EXIT ./ ADD NAME=INCLUDE ISREDIT MACRO (HELP) ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /******************************************************************/ /* 'INCLUDE' EDIT MACRO. EDIT OR BROWSE AN INCLUDE IN CHAMP */ /* AUTHOR : DAVID LEIGH DATE : 09-20-89 */ /******************************************************************/ IF &HELP = &STR(HELP) THEN GOTO HELPSEC ISPEXEC VGET (HOLDSRC HOLDTYPE TESTSRC TESTTYPE PRODSRC PRODTYPE + PANTYPE) SHARED IF &PRODSRC = AND + &HOLDSRC = AND + &TESTSRC = THEN + DO SET ZEDLMSG = &STR(NO INCLUDE LIBRARY CANNOT EXECUTE THIS MACRO) ISPEXEC SETMSG MSG(UTLZ001) GOTO FINAL END ISREDIT (LN,CL) = CURSOR ISREDIT (INCL) = LINE .ZCSR SET INCLEN = &LENGTH(&STR(&INCL)) SET A = &SYSINDEX(&STR(++INCLUDE),&STR(&INCL)) SET A = &A + 9 ISREDIT CURSOR = &LN &A ISREDIT FIND NEXT P'.' ISREDIT (LN1,CL1) = CURSOR SET INCL = &SUBSTR(&CL1:&INCLEN,&STR(&INCL)) SET A = &SYSINDEX(&STR( ),&STR(&INCL)) SET A = &A - 1 SET INCL = &SUBSTR(1:&A,&STR(&INCL) SET ACCESSCC = 0 IF &HOLDTYPE = V THEN + DO SET ZTRAIL = 2 SET PFLG = 1 SET EMSG = &Z SET PCLNG = &STR(&PANTYPE) ISPEXEC VPUT (ZTRAIL PFLG PCLNG EMSG) SHARED SET PNSL = &STR('&HOLDSRC(&INCL)') ISPEXEC VPUT (PNSL) PROFILE ISPEXEC SELECT PGM(PSPILINI) SET ACCESSCC = &LASTCC IF &ACCESSCC > 0 THEN + DO SET ZEDLMSG = &STR(*** COULD NOT EDIT "&INCL". + BROWSING INSTEAD ***) SET ZTRAIL = 1 ISPEXEC VPUT ZTRAIL SHARED ISPEXEC SELECT PGM(PSPILINI) SET ACCESSCC = &LASTCC END END ELSE + DO ISPEXEC EDIT DATASET('&HOLDSRC(&INCL)') SET ACCESSCC = &LASTCC IF &ACCESSCC > 0 THEN + DO ISPEXEC BROWSE DATASET('&HOLDSRC(&INCL)') SET ACCESSCC = &LASTCC END END IF &ACCESSCC = 0 THEN GOTO FINAL IF &TESTTYPE = V THEN + DO SET ZTRAIL = 2 SET PFLG = 1 SET EMSG = &Z SET PCLNG = &STR(&PANTYPE) ISPEXEC VPUT (ZTRAIL PFLG PCLNG EMSG) SHARED SET PNSL = &STR('&TESTSRC(&INCL)') ISPEXEC VPUT (PNSL) PROFILE ISPEXEC SELECT PGM(PSPILINI) SET ACCESSCC = &LASTCC IF &ACCESSCC > 0 THEN + DO SET ZEDLMSG = &STR(*** COULD NOT EDIT "&INCL". + BROWSING INSTEAD ***) SET ZTRAIL = 1 ISPEXEC VPUT ZTRAIL SHARED ISPEXEC SELECT PGM(PSPILINI) SET ACCESSCC = &LASTCC END END ELSE + DO ISPEXEC EDIT DATASET('&TESTSRC(&INCL)') SET ACCESSCC = &LASTCC IF &ACCESSCC > 0 THEN + DO ISPEXEC BROWSE DATASET('&TESTSRC(&INCL)') SET ACCESSCC = &LASTCC END END IF &ACCESSCC = 0 THEN GOTO FINAL IF &PRODTYPE = V THEN + DO SET ZTRAIL = 2 SET PFLG = 1 SET EMSG = &Z SET PCLNG = &STR(&PANTYPE) ISPEXEC VPUT (ZTRAIL PFLG PCLNG EMSG) SHARED SET PNSL = &STR('&PRODSRC(&INCL)') ISPEXEC VPUT (PNSL) PROFILE ISPEXEC SELECT PGM(PSPILINI) SET ACCESSCC = &LASTCC IF &ACCESSCC > 0 THEN + DO SET ZEDLMSG = &STR(*** COULD NOT EDIT "&INCL". + BROWSING INSTEAD ***) SET ZTRAIL = 1 ISPEXEC VPUT ZTRAIL SHARED ISPEXEC SELECT PGM(PSPILINI) SET ACCESSCC = &LASTCC END END ELSE + DO ISPEXEC EDIT DATASET('&PRODSRC(&INCL)') SET ACCESSCC = &LASTCC IF &ACCESSCC > 0 THEN + DO ISPEXEC BROWSE DATASET('&PRODSRC(&INCL)') SET ACCESSCC = &LASTCC END END IF &ACCESSCC > 8 THEN + DO SET ZEDLMSG = &STR(*** COULD NOT ACCESS INCLUDE "&INCL" ***) ISPEXEC SETMSG MSG(UTLZ001) END FINAL: + ISREDIT CURSOR = &LN &CL EXIT HELPSEC: + 02480000 ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL) 02490000 SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR INCLUDE UTILITY + 02490000 *** NO PROCESSING PERFORMED ***) 02490000 ISPEXEC SETMSG MSG(UTLZ000) 02490000 EXIT ./ ADD NAME=INCRMENT ISREDIT MACRO (AMOUNT) ISPEXEC CONTROL ERRORS RETURN /**** 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 ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT IF &DATATYPE(&AMOUNT) ¬= NUM THEN EXIT CODE(12) ISREDIT (LN1,CL1) = CURSOR SET A = &CL1 + 1 ISREDIT FIND NEXT P'#' ISREDIT (LN2,CL2) = CURSOR DO WHILE &CL2 = &A SET A = &A + 1 ISREDIT FIND NEXT P'#' ISREDIT (LN2,CL2) = CURSOR END SET A = &A - 1 ISREDIT (LINE) = LINE .ZCSR SET X = &SUBSTR(&CL1:&A,&STR(&LINE)) SET Y = &X SET Y = &Y + &AMOUNT DO WHILE &LENGTH(&STR(&X)) > &LENGTH(&STR(&Y)) SET Y = &STR(0&Y) END ISREDIT CURSOR = &LN1 &CL1 ISREDIT CHANGE '&STR(&X)' '&STR(&Y)' .ZCSR .ZCSR EXIT ./ ADD NAME=INDEXCM1 /********************************************************************** /* MACRO: INDEXCM1 * /* AUTHOR: DAVID LEIGH * /* FUNCTION: THIS EDIT MACRO WORKS WITH THE INDEXCOL UTILITY TO EDIT * /* THE OUTPUT OF DSNTIAUL, CLEAN IT UP AND ADD UP THE * /* LENGTH OF THE KEY AND POPULATE THE TABLE. * /********************************************************************** ISREDIT MACRO ISPEXEC CONTROL ERRORS RETURN /*** CHECK THE DEBUG SWITCH ***/ ISPEXEC VGET DBGSWTCH PROFILE IF &DBGSWTCH = ON THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS /********************************************************************** /* CREATE THE TEMPORARY TABLE * /********************************************************************** ISPEXEC TBCREATE TEMPNDXC NOWRITE REPLACE + KEYS(ICREATOR INDEX) + NAMES(SEL ILENGTH) /********************************************************************** /* SORT ON THE NAME, CREATOR AND SEQUENCE NUMBER * /********************************************************************** ISREDIT SORT 38 55 56 63 20 22 /********************************************************************** /* GET RID OF THE NASTY HEX CHARACTERS * /********************************************************************** ISREDIT CHANGE ALL P'.' ' ' ISREDIT RESET /********************************************************************** /* LOOP THROUGH AND ADD UP THE LENGTHS * /********************************************************************** ISPEXEC TBVCLEAR TEMPNDXC SET XINDEX = SET XCREATOR = ISREDIT FIND FIRST P'=' 1 DO WHILE &LASTCC = 0 ISREDIT (LINE) = LINE .ZCSR SET XINDEX = &SUBSTR(38:55,&STR(&SYSNSUB(1,&LINE))) SET XCREATOR = &SUBSTR(56:63,&STR(&SYSNSUB(1,&LINE))) IF &STR(&INDEX) ¬= &STR(&XINDEX) OR + &STR(&ICREATOR) ¬= &STR(&XCREATOR) THEN + DO IF &STR(&INDEX) > AND &STR(&ICREATOR) > THEN + DO ISREDIT LINE_BEFORE .ZCSR = '*** LENGTH = &ILENGTH' IF &ILENGTH < 10 THEN SET &ILENGTH = &STR( &ILENGTH) ISPEXEC TBADD TEMPNDXC END SET INDEX = &SUBSTR(38:55,&STR(&SYSNSUB(1,&LINE))) SET ICREATOR = &SUBSTR(56:63,&STR(&SYSNSUB(1,&LINE))) SET INDEX = &INDEX SET ICREATOR = &ICREATOR SET ILENGTH = 0 END SET TYPE = &SUBSTR(23:30,&STR(&SYSNSUB(1,&LINE))) SET XLEN = &SUBSTR(31:35,&STR(&SYSNSUB(1,&LINE))) IF &TYPE = DECIMAL THEN SET XLEN = &EVAL(&XLEN/2+1) SET ILENGTH = &ILENGTH + &XLEN ISREDIT FIND NEXT P'=' 1 END IF &STR(&XINDEX) > AND &STR(&XCREATOR) > THEN + DO ISREDIT LINE_AFTER .ZLAST = '*** LENGTH = &ILENGTH' IF &ILENGTH < 10 THEN SET &ILENGTH = &STR( &ILENGTH) ISPEXEC TBADD TEMPNDXC END ISPEXEC TBTOP TEMPNDXC ISREDIT END ./ ADD NAME=INDEXCOL /********************************************************************** /* UTILITY: INDEXCOL * /* AUTHOR: DAVID LEIGH * /* FUNCTION: THIS UTILITY PROMPTS FOR INPUT OF A DB2 INDEX NAME AND AN* /* ASSOCIATED CREATOR ID. I THEN DETERMINES THE LENGTH OF * /* THE INDEX. * /********************************************************************** PROC 0 CREATOR(USSTRD00) + UTILITY(INDEXCOL) + HELP + DEBUG /*** CHECK THE DEBUG SWITCH ***/ IF &DEBUG = DEBUG THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS ELSE + CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS IF &HELP = HELP THEN GOTO HELPSEC 02 /********************************************************************** /* GET THE USER'S FULL NAME * /********************************************************************** SET SYSOUTTRAP = 1000 ACF LIST * END SET SYSOUTTRAP = 0 SET SYSDVAL = &STR(&SYSNSUB(1,&SYSOUTLINE1)) READDVAL A B NAME1 NAME2 NAME3 NAME4 NAME5 SET FULLNAME = &STR(&NAME1 &NAME2 &NAME3 &NAME4 &NAME5) 02 /********************************************************************** /* ESTABLISH SOME PROCESSING VARIABLES * /********************************************************************** SET DB2FILE = &STR(&SYSUID..TEMP.INDEXCOL.WORK) SET SCANALL = ALL SET ZTDMARK = &STR(**** ALL ROWS SHOWN ****) SET LP = &STR(( SET RP = &STR() /********************************************************************** /* GET A LIST OF INDEXES FOR THE CURRENT CREATOR * /********************************************************************** INDEX_LIST: + SET SCREATOR = &STR(&CREATOR) SET ZEDSMSG = SET ZEDLMSG = &STR(*** EXTRACTING A LIST OF INDEXES FOR CREATOR + "&CREATOR" FROM DB2 ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY PANEL(MSGPANEL) FREE DD(SYSREC00 SYSIN SYSPRINT SYSPUNCH) IF &DEBUG = DEBUG THEN + DO ALLOC DD(SYSPRINT) DA(*) ALLOC DD(SYSPUNCH) DA(*) END ELSE + DO ALLOC DD(SYSPRINT) DUMMY ALLOC DD(SYSPUNCH) DUMMY END DELETE '&DB2FILE' ALLOC DD(SYSREC00) DSN('&DB2FILE') + NEW CATALOG + UNIT(SYSDA) VOLUME(WRK$$$) + SPACE(1,1) TRACKS RELEASE DSORG(PS) ALLOC DD(SYSIN) + NEW + UNIT(SYSDA) VOLUME(WRK$$$) + SPACE(1,1) TRACKS RELEASE + RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS) OPENFILE SYSIN OUTPUT SET SYSIN = &STR(SYSADM2.INDEXCOL WHERE C LIKE '&CREATOR') PUTFILE SYSIN CLOSFILE SYSIN DSN SYSTEM(DSNT) RUN PROGRAM(DSNTIAUL) PLAN(DSNTIAUL) - LIB('SYS4.DSN.DSNT.RUNLIB.LOAD') END FREE DD(SYSREC00 SYSIN SYSPRINT SYSPUNCH) SET ZEDSMSG = SET ZEDLMSG = &STR(*** LOADING THE LIST INTO AN ISPF TABLE ***) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY PANEL(MSGPANEL) ISPEXEC EDIT DATASET('&DB2FILE') MACRO(INDEXCM1) /********************************************************************** /* DISPLAY THE PANEL IF NO INPUT WAS PASSED * /********************************************************************** REDISPLAY: + ISPEXEC TBDISPL TEMPNDXC PANEL(INDEXCOL) IF &LASTCC > 7 THEN + GOTO FINISH ELSE + IF &STR(&SCREATOR) ¬= &STR(&CREATOR) THEN GOTO INDEX_LIST /********************************************************************** /* PROCESS ANY SELECTED ROWS * /********************************************************************** IF &ZTDSELS ¬= &STR(0000) THEN + DO ISPEXEC CONTROL DISPLAY SAVE DO WHILE &ZTDSELS ¬= &STR(0000) SELECT (&STR(&SEL)) /************ EXCLUDE THIS LINE ************/ WHEN (X) DO SET SEL = X SET SCANALL = SCAN ISPEXEC TBMOD TEMPNDXC ISPEXEC TBVCLEAR TEMPNDXC SET SEL = X ISPEXEC TBSARG TEMPNDXC NAMECOND(SEL NE) SET ZTDMARK = &STR(**** ROW(S) EXCLUDED ****) END OTHERWISE DO SET SEL = ISPEXEC TBMOD TEMPNDXC SET ZEDSMSG = SET ZEDLMSG = &STR("X" IS THE ONLY + VALID LINE COMMAND) ISPEXEC SETMSG MSG(UTLZ001) END END NEXT_LINE: IF &ZTDSELS > &STR(0001) THEN + DO ISPEXEC CONTROL DISPLAY RESTORE ISPEXEC TBDISPL TEMPNDXC ISPEXEC CONTROL DISPLAY SAVE END ELSE + DO SET ZTDSELS = &STR(0000) ISPEXEC CONTROL DISPLAY RESTORE IF &STR(&ZCMD) > THEN GOTO SCROLL END END END /******************************/ /* PROCESS "PRIMARY" COMMANDS */ /******************************/ IF &STR(&ZCMD) = THEN GOTO SCROLL SET SYSDVAL = &STR(&ZCMD) READDVAL ZCMD OPT1 OPT2 OPT3 OPT4 OPT5 OPT6 OPT7 OPT8 OPT9 OPT10 SELECT (&ZCMD) WHEN (DEBUG) DO IF &OPT1 = &STR(ON) THEN + DO SET DEBUG = DEBUG SET ZEDSMSG = &STR(DEBUG ON) SET ZEDLMSG = &STR(THE DEBUG SWITCH HAS BEEN SET ON) ISPEXEC SETMSG MSG(UTLZ000) CONTROL MSG LIST CONLIST SYMLIST NOFLUSH NOPROMPT ASIS SET ZCMD = GOTO SCROLL END IF &OPT1 = &STR(OFF) THEN + DO SET DEBUG = DEBUG SET ZEDSMSG = &STR(DEBUG OFF) SET ZEDLMSG = &STR(THE DEBUG SWITCH HAS BEEN SET OFF) ISPEXEC SETMSG MSG(UTLZ000) CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS SET ZCMD = GOTO SCROLL END END WHEN (E ³ ED ³ EDI ³ EDIT) ISPEXEC EDIT DATASET('&DB2FILE') WHEN (F ³ FI ³ FIN ³ FIND) DO SET ZEDSMSG = &STR("&OPT1" NOT FOUND) SET ZEDLMSG = &STR(THE STRING "&OPT1" WAS NOT FOUND) ISPEXEC SETMSG MSG(UTLZ001) ISPEXEC TBTOP TEMPNDXC ISPEXEC TBSKIP TEMPNDXC DO WHILE &LASTCC = 0 IF &SYSINDEX(&SYSCAPS(&STR(&OPT1)),&STR(&INDEX)) > 0 + THEN DO SET ZEDSMSG = &STR("&OPT1" FOUND) SET ZEDLMSG = &STR(THE STRING "&OPT1" WAS FOUND) ISPEXEC SETMSG MSG(UTLZ000) IF &STR(&SEL) = X THEN + DO SET SEL = ISPEXEC TBMOD TEMPNDXC END GOTO FIND_CONTINUE END ISPEXEC TBSKIP TEMPNDXC END FIND_CONTINUE: + END WHEN (R ³ RE ³ RES ³ RESE ³ RESET) DO SET SCANALL = ALL SET ZEDSMSG = SET ZEDLMSG = &STR(ALL ROWS SHOWN) ISPEXEC SETMSG MSG(UTLZ000) ISPEXEC TBTOP TEMPNDXC ISPEXEC TBVCLEAR TEMPNDXC SET SEL = X ISPEXEC TBSARG TEMPNDXC NAMECOND(SEL EQ) ISPEXEC TBSCAN TEMPNDXC DO WHILE &LASTCC = 0 SET SEL = ISPEXEC TBMOD TEMPNDXC SET SEL = X ISPEXEC TBSCAN TEMPNDXC END ISPEXEC TBTOP TEMPNDXC ISPEXEC TBVCLEAR TEMPNDXC SET ZTDMARK = &STR(**** ALL ROWS SHOWN ****) GOTO SCROLL END OTHERWISE DO SET ZEDLMSG = &STR(VALID PRIMARY COMMANDS: + "EDIT", + "FIND", + "DEBUG ON³OFF", + "RESET") ISPEXEC SETMSG MSG(UTLZ001) END END /*****************************/ /* MAINTAIN THE TOP OF TABLE */ /*****************************/ SCROLL: + IF &STR(&ZCMD) = THEN + DO ISPEXEC TBTOP TEMPNDXC ISPEXEC TBSKIP TEMPNDXC NUMBER(&ZTDTOP) ISPEXEC VGET (ZVERB ZSCROLLN) IF &ZVERB = &STR(UP) THEN + ISPEXEC TBSKIP TEMPNDXC NUMBER(-&ZSCROLLN) IF &ZVERB = &STR(DOWN) THEN + ISPEXEC TBSKIP TEMPNDXC NUMBER(&ZSCROLLN) END GOTO REDISPLAY /********************************************************************** /* GET OUT NOW * /********************************************************************** FINISH: EXIT ./ ADD NAME=INFODSN /**********************************************************************/ /* UTILITY NAME : INFODSN */ /* DATE WRITTEN : 8-15-89 */ /* AUTHOR : DAVE LEIGH */ /* DESCRIPTION : SHOW A SCREEN MUCH LIKE ISPF OPTION 3.2 WITH INFO */ /* : ABOUT A DATASET */ /*========================== MODIFICATIONS ===========================*/ /* WHO |WHEN |WHY */ /* --- |---- |--- */ /* | | */ /**********************************************************************/ PROC 0 HELP CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /* STANDARD INITIAL */ ERROR DO /* PROCESSING : */ SET MODE = CLIST /* 1. INVOCATION */ RETURN /* MODE ? */ END /* */ ISREDIT MACRO (HELP) /* */ ERROR OFF /* */ ISPEXEC CONTROL ERRORS RETURN /* LOGGING */ ISPEXEC VGET (DBGSWTCH) PROFILE /* 3. DEBUG MESSAGES*/ IF &DBGSWTCH = &STR(ON) THEN /* BASED ON */ + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH /* "DBGSWTCH" */ ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT /* VARIABLE. */ IF &HELP = HELP THEN GOTO HELPSEC /* 4. DISPLAY HELP */ IF &MODE ¬= CLIST THEN + DO ISREDIT (DSN) = DATASET ISREDIT (MBR) = MEMBER IF &STR(&MBR) > THEN SET DSN = &STR(&DSN(&MBR)) ISPEXEC VPUT DSN SHARED END ISPEXEC VGET (DSN) SHARED SET MBR = SET LPAREN = &STR(( SET RPAREN = &STR()) SET A = &SYSINDEX(&STR(&LPAREN),&STR(&DSN)) SET C = &A - 1 SET A = &A + 1 SET D = &A + 1 SET B = &LENGTH(&STR(&DSN)) SET B = &B - 1 IF &B < 1 THEN GOTO RESUME1 IF &A > 1 AND + &B > 0 AND + (&SUBSTR(&A:&A,&STR(&DSN)) = &STR(+) OR + &SUBSTR(&A:&A,&STR(&DSN)) = &STR(-) OR + &SUBSTR(&A:&A,&STR(&DSN)) = &STR(0) OR + &SUBSTR(&A:&A,&STR(&DSN)) = &STR(1) OR + &SUBSTR(&A:&A,&STR(&DSN)) = &STR(2) OR + &SUBSTR(&A:&A,&STR(&DSN)) = &STR(3) OR + &SUBSTR(&A:&A,&STR(&DSN)) = &STR(4) OR + &SUBSTR(&A:&A,&STR(&DSN)) = &STR(5) OR + &SUBSTR(&A:&A,&STR(&DSN)) = &STR(6) OR + &SUBSTR(&A:&A,&STR(&DSN)) = &STR(7) OR + &SUBSTR(&A:&A,&STR(&DSN)) = &STR(8) OR + &SUBSTR(&A:&A,&STR(&DSN)) = &STR(9)) THEN + DO SET GM = &SUBSTR(&A:&B,&STR(&DSN)) IF &SUBSTR(1:1,&STR(&GM)) = &STR(-) THEN + SET GM = &SUBSTR(2,&STR(&GM)) IF &LENGTH(&STR(&GM)) > 1 THEN + DO IF &SUBSTR(1:1,&STR(&GM)) = &STR(+) THEN + DO SET ZEDLMSG = &STR(NON-EXISTANT GENERATIONS )+ &STR(ARE NOT ALLOWED) ISPEXEC SETMSG MSG(UTLZ001) EXIT END IF &SUBSTR(1:2,&STR(&GM)) = &STR(+1) THEN + SET GM = NEXTGEN IF &SUBSTR(1:2,&STR(&GM)) = &STR(+0) THEN + SET GM = &STR(0) END SET XDSN = &SUBSTR(1:&C,&STR(&DSN)) SET ZEDLMSG = &STR(* RESOLVING DATASET)+ &STR( RELATIVE GDG GENERATION )+ &STR(NUMBER *) ISPEXEC SETMSG MSG(UTLZ000) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY PANEL(INFODSN) %GDGGEN DSN(&XDSN) SET GM = MINUS&GM ISPEXEC VGET (&GM GEN LIMIT) SHARED IF &STR(&&GM) > THEN + SET GEN = &&&GM ELSE + IF &LIMIT > 0 THEN + SET GEN = G0001V00 ELSE + DO SET ZEDLMSG = &STR("&DSN" IS NOT A GDG DATASET) ISPEXEC SETMSG MSG(UTLZ001) EXIT END SET DSN = &STR(&XDSN..&GEN) END RESUME1: + IF &DSN = THEN GOTO PREMAP LISTDSI '&DSN' DIRECTORY SET SAVECC = &LASTCC SET XSYS1 = &SYSVOLUME SET XSYS2 = &STR(&SYSCREATE) SET XSYS3 = &SYSUNIT SET XSYS4 = &STR(&SYSREFDATE) SET XSYS5 = &SYSTRKSCYL SET XSYS6 = &SYSUPDATED SET XSYS7 = &SYSDSORG SET XSYS8 = &SYSUNITS SET XSYS9 = &SYSRECFM SET XSYS10 = &SYSALLOC SET XSYS11 = &SYSLRECL SET XSYS12 = &SYSUSED SET XSYS13 = &SYSBLKSIZE SET XSYS14 = &SYSPRIMARY SET XSYS15 = &SYSKEYLEN SET XSYS16 = &SYSSECONDS SET XSYS17 = &SYSPASSWORD SET XSYS18 = &SYSEXTENTS SET XSYS19 = &SYSRACFA SET XSYS20 = &SYSEXDATE SET XSYS21 = &SYSBLKSTRK SET XSYS22 = &SYSADIRBLK SET XSYS23 = &SYSUDIRBLK SET XSYS24 = &SYSMEMBERS IF &SAVECC = 4 THEN + DO SET XSYS21 = SET XSYS22 = SET XSYS23 = SET XSYS24 = END ELSE + IF &SAVECC = 16 THEN + DO SET ZEDLMSG = &STR(&SYSDSN('&DSN)) ISPEXEC SETMSG MSG(UTLZ001) SET XSYS1 = SET XSYS3 = SET XSYS7 = SET XSYS9 = SET XSYS11 = SET XSYS13 = SET XSYS15 = SET XSYS10 = SET XSYS12 = SET XSYS14 = SET XSYS16 = SET XSYS8 = SET XSYS18 = SET XSYS2 = SET XSYS4 = SET XSYS20 = SET XSYS17 = SET XSYS19 = SET XSYS6 = SET XSYS5 = SET XSYS21 = SET XSYS22 = SET XSYS23 = SET XSYS24 = END ELSE + IF &SYSINDEX(&STR(PO),&STR(&XSYS7)) > 0 AND + &SYSINDEX(&STR(&LPAREN),&STR(&DSN)) > 0 THEN + DO SET A = &SYSINDEX(&STR(&LPAREN),&STR(&DSN)) SET B = &SYSINDEX(&STR(&RPAREN),&STR(&DSN)) SET A = &A + 1 SET B = &B - 1 SET MBR = &SUBSTR(&A:&B,&STR(&DSN)) SET A = &A - 2 SET XDSN = &SUBSTR(1:&A,&STR(&DSN)) ISPEXEC LMINIT DATAID(DID) DATASET('&XDSN') ISPEXEC LMOPEN DATAID(&DID) ISPEXEC LMMFIND DATAID(&DID) + MEMBER(&MBR) STATS(YES) IF &LASTCC > 0 THEN + DO SET ZEDLMSG = &STR(PROBLEM WITH MEMBER + "&MBR") ISPEXEC SETMSG MSG(UTLZ001) END END ELSE SET MBR = PREMAP: + ISPEXEC VPUT (XSYS1 XSYS3 XSYS7 XSYS9 XSYS11 XSYS13 XSYS15 XSYS10 + XSYS12 XSYS14 XSYS16 XSYS8 XSYS18 XSYS2 XSYS4 XSYS20 + XSYS17 XSYS19 XSYS6 XSYS5 XSYS21 XSYS22 XSYS23 XSYS24 + LINE1 LINE2 LINE3 XVAREND XVAR1 XVAR2 XVAR3 MBR) SHARED REDISP: + ISPEXEC DISPLAY PANEL(INFODSN) IF &LASTCC = 8 THEN GOTO FINISH ISPEXEC VGET (DSN) SHARED SET A = &SYSINDEX(&STR(&LPAREN),&STR(&DSN)) SET C = &A - 1 SET A = &A + 1 SET B = &LENGTH(&STR(&DSN)) SET B = &B - 1 IF &A > 1 AND + (&SUBSTR(&A:&A,&STR(&DSN)) = &STR(+) OR + &SUBSTR(&A:&A,&STR(&DSN)) = &STR(-) OR + &SUBSTR(&A:&A,&STR(&DSN)) = &STR(0) OR + &SUBSTR(&A:&A,&STR(&DSN)) = &STR(1) OR + &SUBSTR(&A:&A,&STR(&DSN)) = &STR(2) OR + &SUBSTR(&A:&A,&STR(&DSN)) = &STR(3) OR + &SUBSTR(&A:&A,&STR(&DSN)) = &STR(4) OR + &SUBSTR(&A:&A,&STR(&DSN)) = &STR(5) OR + &SUBSTR(&A:&A,&STR(&DSN)) = &STR(6) OR + &SUBSTR(&A:&A,&STR(&DSN)) = &STR(7) OR + &SUBSTR(&A:&A,&STR(&DSN)) = &STR(8) OR + &SUBSTR(&A:&A,&STR(&DSN)) = &STR(9)) THEN + DO SET GM = &SUBSTR(&A:&B,&STR(&DSN)) IF &SUBSTR(1:1,&STR(&GM)) = &STR(-) THEN + SET GM = &SUBSTR(2,&STR(&GM)) IF &LENGTH(&STR(&GM)) > 1 THEN + DO IF &SUBSTR(1:1,&STR(&GM)) = &STR(+) THEN + DO SET ZEDLMSG = &STR(NON-EXISTANT )+ &STR(GENERATIONS )+ &STR(ARE NOT ALLOWED) ISPEXEC SETMSG MSG(UTLZ001) GOTO REDISP END IF &SUBSTR(1:2,&STR(&GM)) = &STR(+1) THEN + SET GM = NEXTGEN IF &SUBSTR(1:2,&STR(&GM)) = &STR(+0) THEN + SET GM = &STR(0) END SET DSN = &SUBSTR(1:&C,&STR(&DSN)) SET ZEDLMSG = &STR(* RESOLVING DATASET)+ &STR( RELATIVE GDG GENERATION )+ &STR(NUMBER *) ISPEXEC SETMSG MSG(UTLZ000) ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY PANEL(INFODSN) %GDGGEN DSN(&DSN) SET GM = MINUS&GM ISPEXEC VGET (&GM GEN LIMIT) SHARED IF &STR(&&GM) > THEN + SET GEN = &&&GM ELSE + IF &LIMIT > 0 THEN + SET GEN = G0001V00 ELSE + DO SET ZEDLMSG = &STR("&DSN" IS NOT A GDG + DATASET) ISPEXEC SETMSG MSG(UTLZ001) EXIT END SET DSN = &STR(&DSN..&GEN) END LISTDSI '&DSN' DIRECTORY SET SAVECC = &LASTCC SET XSYS1 = &SYSVOLUME SET XSYS2 = &STR(&SYSCREATE) SET XSYS3 = &SYSUNIT SET XSYS4 = &STR(&SYSREFDATE) SET XSYS5 = &SYSTRKSCYL SET XSYS6 = &SYSUPDATED SET XSYS7 = &SYSDSORG SET XSYS8 = &SYSUNITS SET XSYS9 = &SYSRECFM SET XSYS10 = &SYSALLOC SET XSYS11 = &SYSLRECL SET XSYS12 = &SYSUSED SET XSYS13 = &SYSBLKSIZE SET XSYS14 = &SYSPRIMARY SET XSYS15 = &SYSKEYLEN SET XSYS16 = &SYSSECONDS SET XSYS17 = &SYSPASSWORD SET XSYS18 = &SYSEXTENTS SET XSYS19 = &SYSRACFA SET XSYS20 = &SYSEXDATE SET XSYS21 = &SYSBLKSTRK SET XSYS22 = &SYSADIRBLK SET XSYS23 = &SYSUDIRBLK SET XSYS24 = &SYSMEMBERS IF &SAVECC = 4 THEN + DO SET XSYS21 = SET XSYS22 = SET XSYS23 = SET XSYS24 = END ELSE + IF &SAVECC = 16 THEN + DO SET ZEDLMSG = &STR(&SYSDSN(&DSN)) ISPEXEC SETMSG MSG(UTLZ001) SET XSYS1 = SET XSYS3 = SET XSYS7 = SET XSYS9 = SET XSYS11 = SET XSYS13 = SET XSYS15 = SET XSYS10 = SET XSYS12 = SET XSYS14 = SET XSYS16 = SET XSYS8 = SET XSYS18 = SET XSYS2 = SET XSYS4 = SET XSYS20 = SET XSYS17 = SET XSYS19 = SET XSYS6 = SET XSYS5 = SET XSYS21 = SET XSYS22 = SET XSYS23 = SET XSYS24 = END ELSE + IF &SYSINDEX(&STR(PO),&STR(&XSYS7)) > 0 AND + &SYSINDEX(&STR(&LPAREN),&STR(&DSN)) > 0 THEN + DO SET A = &SYSINDEX(&STR(&LPAREN),&STR(&DSN)) SET B = &SYSINDEX(&STR(&RPAREN),&STR(&DSN)) SET A = &A + 1 SET B = &B - 1 SET MBR = &SUBSTR(&A:&B,&STR(&DSN)) SET A = &A - 2 SET XDSN = &SUBSTR(1:&A,&STR(&DSN)) ISPEXEC LMINIT DATAID(DID) DATASET('&XDSN') ISPEXEC LMOPEN DATAID(&DID) ISPEXEC LMMFIND DATAID(&DID) + MEMBER(&MBR) STATS(YES) IF &LASTCC > 0 THEN + DO SET ZEDLMSG = &STR(PROBLEM WITH MEMBER + "&MBR") ISPEXEC SETMSG MSG(UTLZ001) END END ELSE SET MBR = ISPEXEC VPUT (XSYS1 XSYS3 XSYS7 XSYS9 XSYS11 XSYS13 XSYS15 XSYS10 + XSYS12 XSYS14 XSYS16 XSYS8 XSYS18 XSYS2 XSYS4 XSYS20 + XSYS17 XSYS19 XSYS6 XSYS5 XSYS21 XSYS22 XSYS23 XSYS24 + LINE1 LINE2 LINE3 XVAREND XVAR1 XVAR2 XVAR3 MBR) SHARED GOTO REDISP FINISH: + IF &DID > THEN ISPEXEC LMFREE DATAID(&DID) EXIT HELPSEC: + WRITE *** .HELP FOR CLIST INFODSN *** WRITE WRITE *** END OF HELP *** NO PROCESSING PERFORMED *** EXIT ./ ADD NAME=INFRONT /********************************************************************** /* EDIT MACRO : INFRONT * /* AUTHOR : DAVID LEIGH * /* FUNCTION : PLACE A STRING IN COLUMN 1 OF EVERY IDENTIFIED LINE * /* TO BE PROCESSED. DATA IS SHIFTED RIGHT (CREATING * /* TRUNCATION IF NECESSARY) BY THE NUMBER OF BYTES IN * /* THE INPUT STRING. * /********************************************************************** ISREDIT MACRO (STRING,VAR1,VAR2,VAR3,VAR4,VAR5,VAR6,VAR7,VAR8,VAR9) ISPEXEC CONTROL ERRORS RETURN ISPEXEC VGET (DBGSWTCH) PROFILE IF &DBGSWTCH = &STR(ON) THEN + CONTROL MSG LIST CONLIST SYMLIST NOFLUSH ASIS ELSE CONTROL NOMSG NOLIST NOFLUSH NOPROMPT ASIS ISREDIT (SLN,SCL) = CURSOR IF &STR(&SYSNSUB(1,&STRING)) = HELP THEN GOTO HELPSEC DO &X = 1 TO 9 SET VARIABLES = &SYSCAPS(&STR(&VARIABLES &&VAR&X)) END IF &STR(&VARIABLES) = THEN + DO %YOUSURE COLUMN(10) ROW(5) ZWINTTL('PROCESS ALL LINES?!') IF &LASTCC > 0 THEN + DO SET ZEDLMSG = &STR(*** NO "INFRONT" PROCESSING + PERFORMED ***) ISPEXEC SETMSG MSG(UTLZ001) EXIT END END IF (&SUBSTR(1:1,&STR(&SYSNSUB(1,&STRING))) = &STR(') AND + &SUBSTR(&LENGTH(&STR(&SYSNSUB(1,&STRING))):+ &LENGTH(&STR(&SYSNSUB(1,&STRING))),+ &STR(&SYSNSUB(1,&STRING))) = &STR(')) OR + (&SUBSTR(1:1,&STR(&SYSNSUB(1,&STRING))) = &STR(") AND + &SUBSTR(&LENGTH(&STR(&SYSNSUB(1,&STRING))):+ &LENGTH(&STR(&SYSNSUB(1,&STRING))),+ &STR(&SYSNSUB(1,&STRING))) = &STR(")) THEN + SET STRING = + &SUBSTR(2:&EVAL(&LENGTH(&STR(&SYSNSUB(1,&STRING))) - 1),+ &STR(&SYSNSUB(1,&STRING))) IF &SYSINDEX(&STR('),&STR(&SYSNSUB(1,&STRING))) > 0 AND + &SYSINDEX(&STR("),&STR(&SYSNSUB(1,&STRING))) > 0 THEN + DO SET ZEDLMSG = &STR(*** "INFRONT" CANNOT PROCESS + STRINGS WITH BOTH SINGLE AND + DOUBLE QOUTES ***) ISPEXEC SETMSG MSG(UTLZ001) EXIT CODE(8) END SET ZEDLMSG = &STR(PLACING "&STRING" IN FRONT OF LINES W/CRITERIA + "&VARIABLES") ISPEXEC CONTROL DISPLAY LOCK ISPEXEC DISPLAY MSG(UTLZ000W) SET QT = &STR(') IF &SYSINDEX(&STR('),&STR(&SYSNSUB(1,&STRING))) > 0 THEN + SET QT = &STR