|
Back To LeighWeb Mainframe Utilities Page
View the documentation associated with this module
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 &STR(&OPT1) = HELP THEN GOTO HELPSEC
/**********************************************************************
/* UTILITY: JCLSCAN *
/* AUTHOR: DAVID LEIGH *
/* FUNCTION: SCAN A JOB AND INSERT ALL EXPANDED LINES AND ERROR LINES *
/* INTO TO THE JCL BEING EDITED AS MESSAGE LINES. *
/**********************************************************************
/**********************************************************************
/* VGET A VARIABLE TO DETERMINE WHAT PROCESSING TO DO *
/**********************************************************************
ISPEXEC VGET JSCNGOTO SHARED
IF &STR(&JSCNGOTO) > THEN GOTO &STR(&JSCNGOTO)
/**********************************************************************
/* INFORM THE USER OF THE CURRENT ACTIVITY *
/**********************************************************************
SET ZEDLMSG = &STR(*** CREATING "SCAN" JCL TO EXPAND THIS JOB ***)
ISPEXEC CONTROL DISPLAY LOCK
ISPEXEC DISPLAY MSG(UTLZ000W)
/**********************************************************************
/* PARSE THE USER INPUT IF ANY *
/**********************************************************************
IF &STR(&OPT1) = WRITE THEN +
DO
SET PROCLIB = &STR(&OPT2)
SET WRITE = YES
SET OPT1 =
SET OPT2 =
END
IF &STR(&OPT2) = WRITE THEN +
DO
SET PROCLIB = &STR(&OPT1)
SET WRITE = YES
SET OPT1 =
SET OPT2 =
END
IF &STR(&OPT1) = PRINT THEN +
DO
SET PROCLIB = &STR(&OPT2)
SET PRINT = YES
SET OPT1 =
SET OPT2 =
END
IF &STR(&OPT2) = PRINT THEN +
DO
SET PROCLIB = &STR(&OPT1)
SET PRINT = YES
SET OPT1 =
SET OPT2 =
END
IF &STR(&OPT1) = EDIT THEN +
DO
SET PROCLIB = &STR(&OPT2)
SET EDIT = YES
SET OPT1 =
SET OPT2 =
END
IF &STR(&OPT2) = EDIT THEN +
DO
SET PROCLIB = &STR(&OPT1)
SET EDIT = YES
SET OPT1 =
SET OPT2 =
END
IF &STR(&OPT2) > THEN SET PROCLIB = &STR(&OPT2)
IF &STR(&OPT1) > THEN SET PROCLIB = &STR(&OPT1)
IF &STR(&PROCLIB) > THEN +
DO
SET L = &LENGTH(&STR(&PROCLIB))
SET K = &L - 1
IF &K > 0 THEN +
DO
SET NUMBER = &SUBSTR(&K:&L,&STR(&PROCLIB))
SET TYPE = &DATATYPE(&NUMBER)
END
SET K = &K - 1
IF &K > 0 THEN +
SET PREFIX = &SUBSTR(1:&K,&STR(&PROCLIB))
IF &L < 5 OR +
&L > 6 OR +
&STR(&TYPE) ¬= NUM OR +
&STR(&PREFIX) ¬= PROC THEN +
DO
SET ZEDSMSG = &STR(INVALID PROCLIB PARM)
SET ZEDLMSG = &STR(VALID PARM FORMAT: "PROC99" WHERE +
"99" = "00" THROUGH "99")
ISPEXEC SETMSG MSG(UTLZ001W)
EXIT CODE(12)
END
END
/**********************************************************************
/* FIND THE JOB CARD AND INSERT A SPECIAL ONE *
/**********************************************************************
SET TEMPNAME = &SUBSTR(1:8,&STR(&SYSUID.ZYX ))
SET SLASH = &STR(/)
SET ASTERISK = &STR(*)
SET JCLCOMMENT = &STR(&SLASH&SLASH&ASTERISK)
CALL 'SYS2.USC1.LINKLIB(USERINFO)' '&SYSUID '
ISPEXEC VGET (BINNM CCNTR) PROFILE
SET ACCT = &STR(&CCNTR,&BINNM)
ISREDIT FIND LAST P'¬' 1 72 .ZFIRST .ZFIRST
ISREDIT (LN,CL1) = CURSOR
ISREDIT FIND LAST ',' 1 72 .ZFIRST .ZFIRST
ISREDIT (LN,CL2) = CURSOR
DO WHILE &CL1 = &CL2
ISREDIT FIND NEXT '// ' 1
ISREDIT FIND LAST P'¬' 1 72 .ZCSR .ZCSR
ISREDIT (LN,CL1) = CURSOR
ISREDIT FIND LAST ',' 1 72 .ZCSR .ZCSR
IF &LASTCC = 0 THEN +
ISREDIT (LN,CL2) = CURSOR
ELSE +
SET CL2 = 100
END
ISREDIT LABEL .ZCSR = .JSCNJ
ISREDIT FIND NEXT P'=' 1
ISREDIT LABEL .ZCSR = .CURR
ISREDIT LINE_BEFORE .CURR = +
'//&TEMPNAME JOB (&ACCT,A00000,O),SCAN,MSGCLASS=X,'
ISREDIT LINE_BEFORE .CURR = +
'// CLASS=V,TIME=(0,01),TYPRUN=SCAN'
ISREDIT FIND P'=' 1 .CURR .CURR
ISREDIT FIND PREV P'=' 1
ISREDIT LABEL .ZCSR = .JSCNB
ISREDIT FIND PREV P'=' 1
ISREDIT LABEL .ZCSR = .JSCNA
/**********************************************************************
/* PERFORM PROCLIB PROCESSING *
/**********************************************************************
SET SAVEPROC = &STR(&PROCLIB)
ISREDIT FIND FIRST '&SLASH&ASTERISK.JOBPARM ' 1 .CURR .ZLAST
SET PROCCC = &LASTCC
DO WHILE &PROCCC = 0
ISREDIT FIND FIRST ' P=' .ZCSR .ZCSR
SET SAVECC1 = &LASTCC
ISREDIT (LINENUM,CL1) = CURSOR
ISREDIT FIND FIRST ',P=' .ZCSR .ZCSR
SET SAVECC2 = &LASTCC
ISREDIT (LINENUM,CL2) = CURSOR
ISREDIT FIND FIRST ' PROCLIB=' .ZCSR .ZCSR
SET SAVECC3 = &LASTCC
ISREDIT (LINENUM,CL3) = CURSOR
ISREDIT FIND FIRST ',PROCLIB=' .ZCSR .ZCSR
SET SAVECC4 = &LASTCC
ISREDIT (LINENUM,CL4) = CURSOR
IF &SAVECC1 = 0 THEN +
DO
SET CL1 = &CL1 + 3
ISREDIT CURSOR = &LINENUM &CL1
ISREDIT FIND NEXT ',' .ZCSR .ZCSR
ISREDIT (LINENUM,CLA) = CURSOR
ISREDIT CURSOR = &LINENUM &CL1
ISREDIT FIND NEXT ' ' .ZCSR .ZCSR
ISREDIT (LINENUM,CLB) = CURSOR
SET X = 0
IF &CLA > &CL1 THEN +
IF &CLB > &CL1 THEN +
IF &CLA > &CLB THEN SET X = &CLB
ELSE SET X = &CLA
ELSE SET X = &CLA
ELSE +
IF &CLB > &CL1 THEN SET X = &CLB
ELSE SET X = &CL1
SET X = &X - 1
IF &STR(&PROCLIB) > THEN +
DO
SET EQL =
DO &I = 1 TO &EVAL(&X - &CL1 + 1)
SET EQL = &STR(&EQL¬=)
END
ISREDIT (SAVELINE) = LINE .ZCSR
ISREDIT LABEL .ZCSR = .JSCNC
ISREDIT CHANGE P'&STR(&EQL)' '&STR(&PROCLIB)' +
&CL1 FIRST .JSCNC .JSCNC
END
ELSE +
DO
ISREDIT (LINE) = LINE .ZCSR
SET PROCLIB = &SUBSTR(&CL1:&X,+
&STR(&SYSNSUB(1,&LINE)))
END
SET PROCCC = 2000
END
ELSE IF &SAVECC2 = 0 THEN +
DO
SET CL2 = &CL2 + 3
ISREDIT CURSOR = &LINENUM &CL2
ISREDIT FIND NEXT ',' .ZCSR .ZCSR
ISREDIT (LINENUM,CLA) = CURSOR
ISREDIT CURSOR = &LINENUM &CL2
ISREDIT FIND NEXT ' ' .ZCSR .ZCSR
ISREDIT (LINENUM,CLB) = CURSOR
SET X = 0
IF &CLA > &CL2 THEN +
IF &CLB > &CL2 THEN +
IF &CLA > &CLB THEN SET X = &CLB
ELSE SET X = &CLA
ELSE SET X = &CLA
ELSE +
IF &CLB > &CL2 THEN SET X = &CLB
ELSE SET X = &CL2
SET X = &X - 1
IF &STR(&PROCLIB) > THEN +
DO
SET EQL =
DO &I = 1 TO &EVAL(&X - &CL2 + 1)
SET EQL = &STR(&EQL¬=)
END
ISREDIT (SAVELINE) = LINE .ZCSR
ISREDIT LABEL .ZCSR = .JSCNC
ISREDIT CHANGE P'&STR(&EQL)' '&STR(&PROCLIB)' +
&CL2 FIRST .JSCNC .JSCNC
END
ELSE +
DO
ISREDIT (LINE) = LINE .ZCSR
SET PROCLIB = &SUBSTR(&CL2:&X,+
&STR(&SYSNSUB(1,&LINE)))
END
SET PROCCC = 2000
END
ELSE IF &SAVECC3 = 0 THEN +
DO
SET CL3 = &CL3 + 3
ISREDIT CURSOR = &LINENUM &CL3
ISREDIT FIND NEXT ',' .ZCSR .ZCSR
ISREDIT (LINENUM,CLA) = CURSOR
ISREDIT CURSOR = &LINENUM &CL3
ISREDIT FIND NEXT ' ' .ZCSR .ZCSR
ISREDIT (LINENUM,CLB) = CURSOR
SET X = 0
IF &CLA > &CL3 THEN +
IF &CLB > &CL3 THEN +
IF &CLA > &CLB THEN SET X = &CLB
ELSE SET X = &CLA
ELSE SET X = &CLA
ELSE +
IF &CLB > &CL3 THEN SET X = &CLB
ELSE SET X = &CL3
SET X = &X - 1
IF &STR(&PROCLIB) > THEN +
DO
SET EQL =
DO &I = 1 TO &EVAL(&X - &CL3 + 1)
SET EQL = &STR(&EQL¬=)
END
ISREDIT (SAVELINE) = LINE .ZCSR
ISREDIT LABEL .ZCSR = .JSCNC
ISREDIT CHANGE P'&STR(&EQL)' '&STR(&PROCLIB)' +
&CL3 FIRST .JSCNC .JSCNC
END
ELSE +
DO
ISREDIT (LINE) = LINE .ZCSR
SET PROCLIB = &SUBSTR(&CL3:&X,+
&STR(&SYSNSUB(1,&LINE)))
END
SET PROCCC = 2000
END
ELSE IF &SAVECC4 = 0 THEN +
DO
SET CL1 = &CL1 + 3
ISREDIT CURSOR = &LINENUM &CL1
ISREDIT FIND NEXT ',' .ZCSR .ZCSR
ISREDIT (LINENUM,CLA) = CURSOR
ISREDIT CURSOR = &LINENUM &CL1
ISREDIT FIND NEXT ' ' .ZCSR .ZCSR
ISREDIT (LINENUM,CLB) = CURSOR
SET X = 0
IF &CLA > &CL4 THEN +
IF &CLB > &CL4 THEN +
IF &CLA > &CLB THEN SET X = &CLB
ELSE SET X = &CLA
ELSE SET X = &CLA
ELSE +
IF &CLB > &CL4 THEN SET X = &CLB
ELSE SET X = &CL4
SET X = &X - 1
IF &STR(&PROCLIB) > THEN +
DO
SET EQL =
DO &I = 1 TO &EVAL(&X - &CL1 + 1)
SET EQL = &STR(&EQL¬=)
END
ISREDIT (SAVELINE) = LINE .ZCSR
ISREDIT LABEL .ZCSR = .JSCNC
ISREDIT CHANGE P'&STR(&EQL)' '&STR(&PROCLIB)' +
&CL1 FIRST .JSCNC .JSCNC
END
ELSE +
DO
ISREDIT (LINE) = LINE .ZCSR
SET PROCLIB = &SUBSTR(&CL4:&X,+
&STR(&SYSNSUB(1,&LINE)))
END
SET PROCCC = 2000
END
ELSE +
DO
ISREDIT FIND NEXT '&SLASH&ASTERISK.JOBPARM ' 1 .CURR .ZLAST
SET PROCCC = &LASTCC
END
END
IF &PROCCC = 4 AND &STR(&PROCLIB) > THEN +
DO
ISREDIT FIND NEXT P'=' 1
ISREDIT LINE_AFTER .ZCSR = '&STR(&SLASH&ASTERISK.JOBPARM +
P=&PROCLIB)'
ISREDIT FIND LAST P'=' .ZCSR .ZCSR
ISREDIT FIND NEXT P'=' 1
ISREDIT LABEL .ZCSR = .JSCNC
SET PROCCC = 2000
END
IF &PROCCC = 2000 OR +
(&STR(&PROCLIB) ¬= PROC00 AND +
&STR(&PROCLIB) > ) THEN +
DO
ISREDIT LINE_BEFORE .ZCSR = MSGLINE ' '
ISREDIT LINE_BEFORE .ZCSR = MSGLINE '&STR(!!! WARNING !!! +
PROCLIB IN +
USE ON THIS SCAN +
WAS "&PROCLIB" +
!!! WARNING !!!)'
ISREDIT LINE_BEFORE .ZCSR = MSGLINE ' '
ISREDIT LINE_AFTER .ZCSR = MSGLINE ' '
ISREDIT LINE_AFTER .ZCSR = MSGLINE '&STR(!!! WARNING !!! +
PROCLIB IN +
USE ON THIS SCAN +
WAS "&PROCLIB" +
!!! WARNING !!!)'
ISREDIT LINE_AFTER .ZCSR = MSGLINE ' '
SET PROCMSG = 6
END
ELSE SET PROCMSG = 0
/**********************************************************************
/* CREATE A TEMP FILE OF THE JCL TO SCAN *
/**********************************************************************
SET TEMPFILE = &STR(&SYSUID..TEMP.JCLSCAN.JCL)
DELETE '&TEMPFILE'
FREE DD(TEMPDD)
ALLOC DD(TEMPDD) DSN('&TEMPFILE') +
NEW CATALOG +
UNIT(SYSDA) VOLUME(WRK$$$) +
SPACE(2,2) TRACKS RELEASE +
RECFM(F B) LRECL(80) BLKSIZE(23440) DSORG(PS)
OPENFILE TEMPDD OUTPUT
/**********************************************************************
/* LOAD THE JCL INTO THE TEMP FILE *
/**********************************************************************
ISREDIT FIND FIRST P'=' 1 .JSCNA .ZLAST
DO WHILE &LASTCC = 0
ISREDIT (TEMPDD) = LINE .ZCSR
PUTFILE TEMPDD
ISREDIT FIND NEXT P'=' 1 .JSCNA .ZLAST
END
CLOSFILE TEMPDD
/**********************************************************************
/* INFORM THE USER OF THE CURRENT ACTIVITY *
/**********************************************************************
SET ZEDLMSG = &STR(*** "SCANNING" THE JCL ***)
ISPEXEC CONTROL DISPLAY LOCK
ISPEXEC DISPLAY MSG(UTLZ000W)
/**********************************************************************
/* FIND WHAT ZYX JOBS EXIST CURRENTLY *
/**********************************************************************
SET SYSOUTTRAP = 1000
CONTROL MSG
STATUS &TEMPNAME
CONTROL NOMSG
SET SYSOUTTRAP = 0
SET SYSDVAL = &&SYSOUTLINE&SYSOUTLINE
SET SYSDVAL = &SYSDVAL
READDVAL NULL LASTJOB
/**********************************************************************
/* SUBMIT THE SCAN *
/**********************************************************************
SUBMIT '&TEMPFILE'
/**********************************************************************
/* CLEAN UP THE TEMP JCL FILE *
/**********************************************************************
FREE DD(TEMPDD)
DELETE '&TEMPFILE'
/**********************************************************************
/* DELETE THE TEMPORARY JOB CARD LINES *
/**********************************************************************
ISREDIT FIND FIRST P'=' 1 .JSCNA .JSCNA
ISREDIT DELETE .JSCNA
ISREDIT DELETE .JSCNB
IF &STR(&SYSNSUB(1,&SAVELINE)) > THEN +
ISREDIT LINE_BEFORE .JSCNC = (SAVELINE)
SET SAVENUM = 0
ISREDIT (SAVENUM) = LINENUM .JSCNC
/**********************************************************************
/* GET PAST ANY JES2 STATEMENTS. *
/**********************************************************************
ISREDIT FIND FIRST '&STR(&SLASH&ASTERISK)' 1
DO WHILE &LASTCC = 0
ISREDIT LABEL .ZCSR = .HOLD
ISREDIT FIND PREV ' EXEC ' 4 65
DO WHILE &LASTCC = 0
ISREDIT FIND FIRST '//*' 1 .ZCSR .ZCSR
SET COMCC = &LASTCC
ISREDIT FIND FIRST P'¬' 3 .ZCSR .ZCSR
SET NONBLANKCC = &LASTCC
IF &COMCC > 0 AND &NONBLANKCC = 0 THEN +
DO
ISREDIT FIND PREV '&STR(&SLASH&ASTERISK)' 1
GOTO JES_CONTINUE
END
ISREDIT FIND PREV ' EXEC ' 4 65
END
ISREDIT FIND LAST P'=' .HOLD .HOLD
ISREDIT FIND NEXT '&STR(&SLASH&ASTERISK)' 1
END
JES_CONTINUE: +
ISREDIT FIND FIRST '&STR(&SLASH&ASTERISK)' 1 .ZCSR .ZCSR
IF &LASTCC = 0 THEN +
DO
ISREDIT FIND LAST P'=' .ZCSR .ZCSR
ISREDIT FIND NEXT P'=' 1
END
ISREDIT (CURRLINE) = LINE .ZCSR
ISREDIT DELETE &SAVENUM
/**********************************************************************
/* KEEP LOOKING FOR THE OUTPUT OF THE SCAN *
/**********************************************************************
SET SCANJOB = &STR(&LASTJOB)
DO WHILE &STR(&SCANJOB) = &STR(&LASTJOB) OR +
&STR(&TOKEN3 &TOKEN4 &TOKEN5) = &STR(WAITING FOR EXECUTION)
SET SYSOUTTRAP = 1000
CONTROL MSG
STATUS &TEMPNAME
CONTROL NOMSG
SET SYSOUTTRAP = 0
SET SYSDVAL = &&SYSOUTLINE&SYSOUTLINE
SET SYSDVAL = &SYSDVAL
READDVAL NULL SCANJOB TOKEN3 TOKEN4 TOKEN5
END
/**********************************************************************
/* RETRIEVE THE SCAN OUTPUT INTO A DATASET *
/**********************************************************************
SET LISTDSN = &STR(&SYSUID..TEMP.JCLSCAN.JOB)
DELETE '&LISTDSN'
FREE DD(TEMPDD)
ALLOC DD(TEMPDD) DSN('&LISTDSN') +
NEW CATALOG +
UNIT(SYSDA) VOLUME(WRK$$$) +
SPACE(1,1) CYLINDERS RELEASE +
RECFM(F B A) LRECL(132) BLKSIZE(23364) DSORG(PS)
OUTPUT &SCANJOB PRINT('&LISTDSN')
FREE DD(TEMPDD)
/**********************************************************************
/* EDIT THE SCAN OUTPUT AND PUT THE MESSAGE LINES WHERE THEY BELONG *
/**********************************************************************
SET JSCNGOTO = &STR(MESSAGE_SECTION)
ISPEXEC VPUT JSCNGOTO SHARED
ISPEXEC EDIT DATASET('&LISTDSN') MACRO(JCLSCAN)
SET JSCNGOTO =
ISPEXEC VPUT JSCNGOTO SHARED
/**********************************************************************
/* INFORM THE USER OF THE CURRENT ACTIVITY *
/**********************************************************************
SET ZEDLMSG = &STR(*** INSERTING MESSAGE LINES INTO THE JCL ***)
ISPEXEC CONTROL DISPLAY LOCK
ISPEXEC DISPLAY MSG(UTLZ000W)
/**********************************************************************
/* ADD A DUMMY LINE AT THE END SO THAT INSERTS ARE DONE PROPERLY *
/**********************************************************************
ISREDIT (LASTLINE) = LINENUM .ZLAST
SET TEMPLINE = &STR(//* **** JCLSCAN TEMP LINE **** &ZDATE/&ZTIME ****)
ISREDIT LINE_AFTER &LASTLINE = '&STR(&TEMPLINE)'
/**********************************************************************
/* FIND OUT IF THERE IS A JES2 ERROR TO MARK *
/**********************************************************************
ISPEXEC VGET (JSCNERRC JSCNJERL JSCNJERS) SHARED
IF &STR(&SYSNSUB(1,&JSCNJERL)) > THEN +
DO
ISREDIT FIND FIRST +
'&SUBSTR(1:72,&STR(&SYSNSUB(1,&JSCNJERS)))' 1
ISREDIT LINE_AFTER .ZCSR = MSGLINE '*** REMAINDER OF JOB WAS +
NOT SCANNED DUE TO THE +
JES2 ERROR ***'
ISREDIT LINE_AFTER .ZCSR = MSGLINE (JSCNJERL)
SET INSERTED = 2 + &PROCMSG
SET ZEDLMSG = &STR(*** &INSERTED MESSAGE LINES+
INSERTED (&JSCNERRC +
ERROR MESSAGES) ***)
ISPEXEC SETMSG MSG(UTLZ000W)
GOTO FINISH
END
ELSE +
SET INSERTED = 0
/**********************************************************************
/* LOAD THE EXPANDED LINES AS MSGLINES IN THE JCL *
/**********************************************************************
ISPEXEC VGET (JSCNVARS) SHARED
DO &I = 1 TO &JSCNVARS
ISPEXEC VGET (JSCN&I) SHARED
END
ISREDIT FIND FIRST '&STR(&SYSNSUB(1,&JSCN1))' 1
IF &LASTCC ¬= 0 THEN +
DO
SET ZEDLMSG = &STR(*** COULD NOT FIND FIRST LINE TO MARK ***)
ISPEXEC SETMSG MSG(UTLZ001W)
GOTO FINISH
END
SET TYPE = BEFORE
ISREDIT (CURRLINE) = LINE .ZCSR
DO &I = 1 TO &JSCNVARS
SET THISLINE = &&JSCN&I
SET THISLINE = &STR(&SYSNSUB(2,&THISLINE))
IF &SUBSTR(1:72,&STR(&SYSNSUB(1,&CURRLINE))) ¬= +
&STR(&SYSNSUB(1,&THISLINE)) THEN +
DO
IF &SUBSTR(1:2,&STR(&SYSNSUB(2,&&JSCN&I))) = &STR(//) AND +
&STR(&WRITE) = YES THEN +
ISREDIT LINE_&TYPE .ZCSR = (JSCN&I)
ELSE +
ISREDIT LINE_&TYPE .ZCSR = MSGLINE (JSCN&I)
SET INSERTED = &INSERTED + 1
END
ELSE +
DO
ISREDIT FIND ' DD ' FIRST .ZCSR .ZCSR
IF &LASTCC = 0 THEN +
DO
ISREDIT FIND NEXT P'¬' .ZCSR .ZCSR
ISREDIT FIND NEXT ' ' .ZCSR .ZCSR
ISREDIT (LN1,CL1) = CURSOR
IF &CL1 < 16 THEN SET X = 16
ELSE SET X = &CL1 + 1
ISREDIT FIND NEXT P'¬' .ZCSR .ZCSR
ISREDIT (LN2,CL2) = CURSOR
IF &CL2 <= &X THEN +
DO
ISREDIT FIND '*' &CL2 FIRST .ZCSR .ZCSR
SET CC1 = &LASTCC
ISREDIT FIND 'DATA' &CL2 FIRST .ZCSR .ZCSR
SET CC2 = &LASTCC
IF &CC1 = 0 OR &CC2 = 0 THEN +
DO
ISREDIT FIND NEXT '//' 1
IF &LASTCC ¬= 0 THEN +
DO
ISREDIT FIND FIRST P'=' .ZL
SET TYPE = AFTER
END
ELSE +
ISREDIT FIND PREV P'=' 1
END
END
END
ISREDIT FIND NEXT P'=' 1
IF &LASTCC ¬= 0 THEN SET TYPE = AFTER
ELSE ISREDIT (CURRLINE) = LINE .ZCSR
END
END
SET ZEDLMSG = &STR(*** &INSERTED MESSAGE LINES INSERTED (&JSCNERRC +
ERROR MESSAGES) ***)
ISPEXEC SETMSG MSG(UTLZ000W)
FINISH: +
ISREDIT FIND '&STR(&TEMPLINE)' LAST
IF &LASTCC = 0 THEN +
ISREDIT DELETE .ZCSR
ISREDIT CURSOR = 1 1
ISPEXEC VERASE (JSCNGOTO JSCNERRC JSCNJERL JSCNJERS) SHARED
DO &I = 1 TO &JSCNVARS
ISPEXEC VERASE (JSCN&JSCNVARS) SHARED
END
ISPEXEC VERASE (JSCNVARS) SHARED
IF &PRINT = YES THEN %PRINTIT PDSN(&LISTDSN)
IF &EDIT = YES THEN ISPEXEC EDIT DATASET('&LISTDSN')
EXIT
/**********************************************************************
/* MOVE MESSAGES TO WHERE THEY BELONG IN THE OUTPUT LISTING *
/**********************************************************************
MESSAGE_SECTION: +
SET JSCNERRC = 0
ISREDIT FIND FIRST 'STMT NO. MESSAGE' 3
IF &LASTCC = 0 THEN +
DO
SET SPACE = &STR( !!ERROR!!)
ISREDIT LABEL .ZCSR = .STMT
ISREDIT FIND NEXT P'# ' 10
DO WHILE &LASTCC = 0
ISREDIT LABEL .ZCSR = .JSCNC
ISREDIT FIND FIRST 'IEFC001I' .ZCSR .ZCSR
IF &LASTCC = 0 THEN GOTO ERROR_LOOP
SET JSCNERRC = &JSCNERRC + 1
ISREDIT (LINE) = LINE .ZCSR
ISREDIT FIND LAST P'¬' .ZCSR .ZCSR
ISREDIT (LN,CL) = CURSOR
SET SYSDVAL = &SUBSTR(2:&CL,&STR(&SYSNSUB(1,&LINE)))
READDVAL MARKLINE
SET MARKLINE = &MARKLINE + 1
SET LINE = &SUBSTR(12:&CL,&STR(&SYSNSUB(1,&LINE)))
SET LINE = &STR(&SPACE.ERROR>>> &SYSNSUB(1,&LINE))
ISREDIT FIND FIRST '&MARKLINE ' 2 10
IF &LASTCC = 0 THEN ISREDIT LINE_BEFORE .ZCSR = (LINE)
ELSE ISREDIT LINE_BEFORE .STMT = (LINE)
ERROR_LOOP: +
ISREDIT FIND LAST P'=' .JSCNC .JSCNC
ISREDIT FIND NEXT P'# ' 10 .ZCSR .ZLAST
END
ISREDIT FIND FIRST ' JES2 JOB STATISTICS '
ISREDIT FIND PREV 'JCL ERROR'
IF &LASTCC = 0 AND &JSCNERRC = 0 THEN +
DO
ISREDIT FIND NEXT 'IEF' 12 .STMT .ZLAST
DO WHILE &LASTCC = 0
SET MARKLINE = 0
SET JSCNERRC = &JSCNERRC + 1
ISREDIT LABEL .ZCSR = .JSCNC
ISREDIT (LINE) = LINE .ZCSR
ISREDIT FIND LAST P'¬' .ZCSR .ZCSR
ISREDIT (LN,CL) = CURSOR
ISREDIT FIND ' STATEMENT ' FIRST .ZCSR .ZCSR
IF &LASTCC = 0 THEN +
DO
ISREDIT FIND P'¬' NEXT .ZCSR .ZCSR
ISREDIT FIND P' ' NEXT .ZCSR .ZCSR
ISREDIT FIND P'#' NEXT .ZCSR .ZCSR
IF &LASTCC = 0 THEN +
DO
ISREDIT (LN1,CL1) = CURSOR
ISREDIT FIND P'-' NEXT .ZCSR .ZCSR
ISREDIT (LN2,CL2) = CURSOR
SET CL2 = &CL2 - 1
SET MARKLINE = &SUBSTR(&CL1:&CL2,+
&STR(&SYSNSUB(1,+
&LINE)))
SET MARKLINE = &MARKLINE + 1
END
END
SET LINE = &SUBSTR(12:&CL,&STR(&SYSNSUB(1,&LINE)))
SET LINE = &STR(&SPACE.ERROR>>> &SYSNSUB(1,&LINE))
IF &MARKLINE > 0 THEN +
ISREDIT FIND FIRST '&MARKLINE ' 2 10
ELSE +
ISREDIT FIND FIRST ' 1 //' 8
IF &LASTCC = 0 THEN +
ISREDIT LINE_BEFORE .ZCSR = (LINE)
ELSE ISREDIT LINE_BEFORE .STMT = (LINE)
ISREDIT FIND LAST P'=' .JSCNC .JSCNC
ISREDIT FIND NEXT 'IEF' 12 .ZCSR .ZLAST
END
END
ISREDIT DELETE .STMT .ZLAST
END
ISREDIT FIND FIRST '***** INVALID &SLASH&ASTERISK'
IF &LASTCC = 0 THEN +
DO
ISREDIT (JSCNJERL) = LINE .ZCSR
ISREDIT (X) = LINENUM .ZCSR
ISREDIT (JSCNJERS) = LINE &EVAL(&X-1)
SET JSCNERRC = &JSCNERRC + 1
END
ISREDIT SAVE
/**********************************************************************
/* CAPTURE THE JCL LINES IN SHARED ISPF VARIABLES FOR THE MARKING *
/**********************************************************************
ISREDIT FIND FIRST ' 2 ' 8
ISREDIT FIND PREV P'=' 1
ISREDIT FIND PREV P'=' 1
ISREDIT DELETE .ZFIRST .ZCSR
ISREDIT CHANGE ALL 'X' '/' 11 12
ISREDIT CHANGE ALL '+' '/' 11 12
ISREDIT CHANGE ALL '*' '/' 11 12
SET JSCNVARS = 0
ISREDIT FIND FIRST P'=' 1
DO WHILE &LASTCC = 0
SET JSCNVARS = &JSCNVARS + 1
ISREDIT (JLINE) = LINE .ZCSR
SET JSCN&JSCNVARS = &SUBSTR(11:82,&STR(&SYSNSUB(1,&JLINE)))
ISPEXEC VPUT (JSCN&JSCNVARS) SHARED
ISREDIT FIND NEXT P'=' 1
END
ISPEXEC VPUT (JSCNERRC JSCNJERL JSCNJERS JSCNVARS) SHARED
ISREDIT CANCEL
EXIT
HELPSEC: +
ISPEXEC SELECT PGM(ISPTUTOR) PARM(HELPSHEL)
SET ZEDLMSG = &STR(*** HELP DISPLAYED FOR JCLSCAN UTILITY +
*** NO PROCESSING PERFORMED ***)
ISPEXEC SETMSG MSG(UTLZ000)
EXIT
|
|