Title : IMSGEN Stage 2 Automation Submitter : Joe Owens Standard Life 8 Glenogle Road Edinburgh EH3 5HN Phone : 031-245-3261 Release Submitter Details - Y Text :- The following programs and JCL automate the IMSGEN stage 2 jobstream TITLE 'LIVEDIT EDIT IMS STAGE 2' 00010000 *---------------------------------------------------------------------- 00020000 PRINT NOGEN 00030000 *---------------------------------------------------------------------- 00040000 * 00050000 * COPY THE FILE INFILE TO OUTFILE, 00050000 * CHANGING AS REQUIRED BY DD CARDS 00050000 * CARDS RECORD 1 IS FROM STRING, DELIMITED BY ³ OR BLANK 00050000 * RECORD 2 IS TO STRING, DELIMITED BY ³ OR BLANK 00050000 * THESE MAY BE DIFFERING LENGTHS. REPEAT FOR UP TO 50 00050000 * STRING CHANGES 00050000 * 00050000 * ANY CHANGES WHICH FAIL DUE TO LENGTH ARE REPORTED TO DD 00050000 * OUTLIST, WHICH ALSO REPORT RECORDS READ AND CHANGES MADE TOTS 00050000 *---------------------------------------------------------------------- 00120000 LIVEDIT SAVER 00130000 BAL R14,INIT INITIALISE 00140000 BAL R14,PROC PROCESS BAL R14,TIDY COMPLETE CLI BAD,X'FF' SOME FAILED ? BNE EXIT LA R15,5 EXIT EXITR RC=0(R15) 00220000 INITSAVE DS F 00230000 INIT EQU * 00240000 ST R14,INITSAVE SAVE RETURN ADDRESS 00250000 OPEN (CARDS,INPUT) INPUT FILE 00260000 OPEN (OUTLIST,OUTPUT) OUTPUT FILE 00260000 MVI OUTREC,C' ' MVC OUTREC+1(L'OUTREC-1),OUTREC BLANK FIELD MVC OUTREC+20(37),=C'*** CARDS READ FROM DD NAME CARDS ***' PUT OUTLIST,OUTREC LA R10,50 MAX NUMBER OF CHANGE STRINGS LA R9,STRNGTAB TABLE OF STRINGS USING TABENT,R9 MAP DSECT INIT0040 GET CARDS,CARDREC GET I/P CARD 00260000 CLI CARDEOD,X'FF' EOD BE INIT0090 YES MVC OUTREC+1(L'CARDREC),CARDREC PUT OUTLIST,OUTREC LA R8,79 ASSUME LENGTH OF STRING IS 80 XR R1,R1 TRT CARDREC,EOSTAB CHECK FOR END OF STRING 00270000 BNZ INIT0050 GOT IT 00540001 XR R1,R1 TRT CARDREC,BLKTAB CHECK FOR BLANK THEN 00560000 BZ INIT0060 NO 00650000 INIT0050 LA R8,CARDREC START OF RECORD SR R1,R8 LEN OF STRING LR R8,R1 BCTR R8,0 -1 INIT0060 ST R8,FROMLEN SAVE IN TABLE 00660000 MVC FROMSTR,CARDREC MOVE IN FROM RECORD GET CARDS,CARDREC GET I/P CARD 00260000 CLI CARDEOD,X'FF' EOD BE INIT0090 YES MVC OUTREC+1(L'CARDREC),CARDREC PUT OUTLIST,OUTREC LA R8,79 ASSUME LENGTH OF STRING IS 80 TRT CARDREC,EOSTAB CHECK FOR END OF STRING 00270000 BNZ INIT0070 GOT IT 00540001 TRT CARDREC,BLKTAB CHECK FOR BLANK THEN 00560000 BZ INIT0080 NO 00650000 INIT0070 LA R8,CARDREC START OF RECORD SR R1,R8 LEN OF STRING LR R8,R1 BCTR R8,0 -1 INIT0080 ST R8,TOLEN SAVE IN TABLE 00660000 MVC TOSTR,CARDREC MOVE IN FROM RECORD LA R9,TABENTL(,R9) POINT TO NEXT TABENT BCT R10,INIT0040 CONTINUE TO EOD OR 50 STRINGS INIT0090 L R10,=H'-1' END OF TABLE MARKER ST R10,0(,R9) MARK END OF TABLE OPEN (INFILE,INPUT) OPEN (OUTFILE,OUTPUT) ZAP CHNGCNT,=P'0' ZAP RECCNT,=P'0' L R14,INITSAVE BR R14 EJECT 00670000 PROCSAVE DS F PROC ST R14,PROCSAVE PROC0005 GET INFILE,INREC GET NEXT RECORD CLI INEOD,X'FF' EOD ? BE PROCEXIT AP RECCNT,=P'1' COUNT RECORDS READ CLC =C'//',INREC JCL STATEMENT ? BE PROC0007 YES DO ALL THE CHECKS MVC WORKREC,INREC MOVE RECORD IN UNMODIFIED B PROC0125 WRITE IT OUT PROC0007 MVI WORKREC,C' ' MVC WORKREC+1(L'WORKREC-1),WORKREC BLANK OUT LA R5,INREC START OF INREC LA R6,WORKREC START OF WORKREC XR R7,R7 INDEX INTO INREC XR R8,R8 INDEX INTO WORKREC PROC0010 LA R9,STRNGTAB START OF TABLE PROC0020 ICM R3,B'1111',FROMLEN NEXT ENTRY IN TABLE BM PROC0100 LAST TABLE ENTRY - NO MATCHES L R4,TOLEN LR R1,R3 LENGTH OF STRING AR R1,R7 + LENGTH SO FAR CH R1,=H'79' GREATER THE RECLEN ? BH PROC0070 DON'T DO CLC - GO TO NEXT ENT LA R1,0(R5,R7) R1 -> CURRENT BYTE INREC EX R3,CLCFROM BNE PROC0070 NO MOVE TO NEXT RECORD LR R1,R4 LENGTH OF TO STRING AR R1,R8 + CURRENT WORK POINTER CH R1,=H'71' TO LONG TO MOVE IN ? BNH PROC0050 NO ITS OK LR R15,R1 MVI OUTREC,C' ' MVI OUTREC+1,C'*' MVC OUTREC+2(L'OUTREC-2),OUTREC+1 PUT OUTLIST,OUTREC MVI OUTREC,C' ' MVC OUTREC+1(L'OUTREC-1),OUTREC UNPK ERRLINE,RECCNT OI ERRLINE+L'ERRLINE-1,X'F0' MVC OUTREC+1(ERRRECL),ERRREC PUT OUTLIST,OUTREC MVI OUTREC,C' ' MVC OUTREC+1(L'OUTREC-1),OUTREC MVC OUTREC+1(L'FROMSTR),FROMSTR PUT OUTLIST,OUTREC MVC OUTREC+1(L'TOSTR),TOSTR PUT OUTLIST,OUTREC MVC OUTREC+1(L'INREC),INREC PUT OUTLIST,OUTREC MVI OUTREC+1,C'*' MVC OUTREC+2(L'OUTREC-2),OUTREC+1 PUT OUTLIST,OUTREC MVI BAD,X'FF' MVC WORKREC,INREC B PROC0070 CHECK NEXT PROC0050 LA R1,0(R6,R8) R1 -> CURRENT BYTE WORKREC EX R4,MVCTO MOVE IN NEW STRING AP CHNGCNT,=P'1' COUNT CHANGES MADE LA R7,1(R3,R7) INCREMENT INREC INDEX LA R8,1(R4,R8) INCREMENT WORKREC INDEX B PROC0010 CHECK NEXT BYTE PROC0070 LA R9,TABENTL(,R9) POINT TO NEXT TABLE ENTRY B PROC0020 CHECK IT PROC0100 EQU * NO MATCH FOR ANY STRING HERE LA R1,0(R7,R5) R1 -> INREC CURR BYTE LA R2,0(R8,R6) R2 -> WORKREC CURR BYTE CLI 0(R1),C' ' BLANK ? BNE PROC0110 NO CR R7,R8 COMPARE INDEXES BL PROC0120 LEAVE TO IS BIGGER PROC0110 MVC 0(1,R2),0(R1) MOVE 1 BYTE IN LA R8,1(,R8) INC WORK INDEX PROC0120 LA R7,1(,R7) INC INREC INDEX CH R7,=H'79' END OF INREC ? BNE PROC0010 DO STRING COMPARES PROC0125 PUT OUTFILE,WORKREC B PROC0005 READ NEXT RECORD PROCEXIT L R14,PROCSAVE BR R14 EJECT TIDYSAVE DS F TIDY ST R14,TIDYSAVE UNPK PUTREC,RECCNT OI PUTREC+L'PUTREC-1,X'F0' UNPK PUTCHNG,CHNGCNT OI PUTCHNG+L'PUTCHNG-1,X'F0' MVI OUTREC,C' ' MVC OUTREC+1(L'OUTREC-1),OUTREC MVC OUTREC+1(STATRECL),STATREC PUT OUTLIST,OUTREC CLOSE CARDS CLOSE OUTLIST CLOSE INFILE CLOSE OUTFILE L R14,TIDYSAVE EJECT BR R14 OUTLIST DCB DDNAME=OUTLIST, X00091700 DSORG=PS, X00091800 MACRF=PM, X00091900 RECFM=FBA, X00092000 LRECL=133, X00092100 BLKSIZE=0 00092200 CARDS DCB DDNAME=CARDS, X00091700 EODAD=EOD1, X00091700 DSORG=PS, X00091800 MACRF=GM, X00091900 RECFM=FB, X00092000 LRECL=80, X00092100 BLKSIZE=0 00092200 EOD1 DS 0H MVI CARDEOD,X'FF' BR R14 INFILE DCB DDNAME=INFILE, X00091700 EODAD=EOD2, X00091700 DSORG=PS, X00091800 MACRF=GM, X00091900 RECFM=FB, X00092000 LRECL=80, X00092100 BLKSIZE=0 00092200 EOD2 DS 0H MVI INEOD,X'FF' BR R14 OUTFILE DCB DDNAME=OUTFILE, X00091700 DSORG=PS, X00091800 MACRF=PM, X00091900 RECFM=FB, X00092000 LRECL=80, X00092100 BLKSIZE=0 00092200 CARDEOD DC X'00' INEOD DC X'00' BAD DC X'00' CARDREC DS CL80 ORG CARDREC INREC DS CL80 ORG OUTREC DS CL133 ORG OUTREC WORKREC DS CL80 ORG STATREC DS 0C DC C'******* RECORDS READ = ' PUTREC DS CL8 DC C' MODIFICATIONS MADE = ' PUTCHNG DS CL8 DC C' *******' STATRECL EQU *-STATREC ERRREC DS C DC C'** CHANGE FAILED *** LINE ' ERRLINE DS CL8 DC C' FROM, TO STRINGS AND RECORD FOLLOW' ERRRECL EQU *-ERRREC CLCFROM CLC 0(1,R1),FROMSTR MVCTO MVC 0(1,R1),TOSTR CHNGCNT DS PL4 RECCNT DS PL4 EOSTAB DC 256X'00' ORG EOSTAB+C'³' DC X'FF' ORG BLKTAB DC 256X'00' ORG BLKTAB+C' ' DC X'FF' ORG LTORG DC C'TABLE==>' STRNGTAB DS 50CL(TABENTL) DS CL4 TABENT DSECT FROMLEN DS A TOLEN DS A FROMSTR DS CL80 TOSTR DS CL80 TABENTL EQU *-TABENT END 02300000 //*************************************************************** //* //* ASSEMBLE AND LINK EDIT ASM SOURCE CODE //* //*************************************************************** //ASMLINK PROC MBR=TEMPNAME //P01 EXEC PGM=IEV90 //SYSPRINT DD SYSOUT=* //SYSLIB DD DSN=SYS1.MACLIB,DISP=SHR // DD DSN=SLAC.MACRO,DISP=SHR // DD DSN=SYS1.AMODGEN,DISP=SHR //SYSUT1 DD UNIT=DISK, // SPACE=(2048,(100,20)) //SYSPUNCH DD DSN=&&FILE(&MBR.),UNIT=DISK,DISP=(NEW,PASS), // SPACE=(80,(200,50,20)) //*YSIN DD DSN=SG.SL803D.ASMB(&MBR.),DISP=SHR //*SYSIN DD DSN=SG.MASTER.SOURCE(&MBR.),DISP=SHR //*YSIN DD DSN=IV.PROD.MRSOURCE(&MBR.),DISP=SHR //P02 EXEC PGM=IEWL,PARM='AC=0',COND=(5,LT,P01) //SYSPRINT DD SYSOUT=* //OBJ DD DSN=&&FILE,DISP=(OLD,DELETE,DELETE) //SYSUT1 DD UNIT=DISK, // SPACE=(1024,(50,20)) //SYSLMOD DD DSN=SG.SL803D.LOAD,DISP=SHR //*YSLMOD DD DSN=SGMX.MASTER.LOAD,DISP=SHR //RESLIB DD DSN=IMSVSD.RESLIB,DISP=SHR //SYSLIB DD DSN=SYS1.LINKLIB,DISP=SHR // PEND //S01 EXEC ASMLINK,MBR=LIVSUB //P01.SYSIN DD * TITLE 'LIVSUB SUBMIT A STAGE 2 IMS JOB' 00010000 *---------------------------------------------------------------------- 00020000 PRINT NOGEN 00030000 *---------------------------------------------------------------------- 00040000 * 00050000 * SUBMIT A GIVEN JOB FROM THE IMS STAGE 2 STREAM 00050000 * ADD AN EXTRA STEP TO SUBMIT THE NEXT JOB IF 00050000 * ALL IS OK 00050000 *---------------------------------------------------------------------- 00120000 LIVSUB SAVER 00130000 LR R9,R1 PARMS (JCL FORMAT) BAL R14,INIT INITIALISE 00140000 BAL R14,PROC PROCESS ST R15,PROCRC SAVE RETURN CODE TM BAD,NOTFOUND+LASTJOB LAST JOB OR NOT FOUND BNZ LIVSUB2 DON'T SUB BAL R14,STEP WRITE THE EXTRA STEP BAL R14,WTMP SUBMIT TEMP DSET LIVSUB2 BAL R14,TIDY COMPLETE L R15,PROCRC EXIT EXITR RC=0(R15) 00220000 INITSAVE DS F 00230000 INIT EQU * 00240000 ST R14,INITSAVE SAVE RETURN ADDRESS 00250000 RDJFCB INFILE MVC STEPDSN,JFCBDSNM REMEMBER THE DSN WE ARE USING OPEN (INFILE,INPUT) OPEN (TEMPOUT,OUTPUT) OPEN TEMPFILE 00260000 OPEN (OUTFILE,OUTPUT) OPEN TEMPFILE 00260000 L R9,0(,R9) LOAD PARM ADDRESS LA R9,0(,R9) KNOCK OFF VL BIT MVC JOBNAME,2(R9) REMEMBER JOB WE WANT L R14,INITSAVE BR R14 EJECT 00670000 *********************************************************************** * * * PROC - READ THE INPUT FILE TILL WE GET TO OUR JOBNAME * * WRITE OUR JOB TO TEMPFILE * * * * RETURN CODES 0 - OK * * 4 - JOB IS LAST ON THE QUEUE - (MFS) * * 8 - JOB NOT FOUND * * * *********************************************************************** PROCSAVE DS F PROC ST R14,PROCSAVE PROC0005 GET INFILE,REC GET NEXT RECORD CLI INEOD,X'FF' EOD ? BNE PROC0010 NO CONTINUE OI BAD,NOTFOUND SET FLAG LA R15,8 FAILED TO FIND OUR JOB B PROCEXIT PROC0010 BAL R14,TJOB IS IT A JOBCARD ? LTR R15,R15 WELL? BNE PROC0005 NO KEEP ON READING CLC JOBNAME,NEWJOB IS IT OUR JOBNAME BNE PROC0005 NO CARRY ON PROC0020 PUT TEMPOUT,REC SAVE THE RECORD GET INFILE,REC GET THE NEXT1 CLI INEOD,X'FF' EOD ?? BNE PROC0030 HANDLE IT LA R15,4 JOB IS LAST 1 - DON'T SUB OI BAD,LASTJOB SET FLAG B PROCEXIT PROC0030 BAL R14,TJOB IS IT A JOB CARD LTR R15,R15 BNE PROC0020 NO KEEP ON READING XR R15,R15 GOOD END PROCEXIT L R14,PROCSAVE BR R14 EJECT *********************************************************************** * * * TJOB - TEST INREC TO SEE IF IT A JOBCARD - ' JOB ' IN COLS 2-22 * * IF SO MOVE THE JOBNAME TO NEWJOB * * * * RETURN CODES 0 - OK * * 4 - CARD IS NOT A JOB * * * *********************************************************************** TJOBSAVE DS F TJOB ST R14,TJOBSAVE CLC =C'//',REC // AT START ? BE TJOB0005 YES CARRY ON LA R15,4 CAN'T BE A JOB CARD B TJOBEXIT TJOB0005 LA R2,REC+2 GET PAST // LA R1,20 LOOK UP TO COLUMN 22 TJOB0010 CLC =C' JOB ',0(R2) JOB STATEMENT ? BE TJOB0020 YES LOOK AT IT LA R2,1(,R2) LOOK A BIT FURTHER ALONG BCT R1,TJOB0010 TRY AGAIN LA R15,4 NOT A JOBCARD B TJOBEXIT TJOB0020 MVC NEWJOB,=CL8' ' BLANK OUT NEWJOB LA R1,REC+2+8 MAX END OF JOBNAME TRT REC+2(8),BLKTAB FIND THE FIRST SPACE LA R2,REC+2 START OF JOBNAME SR R1,R2 R1 = LENGTH OF JOBNAME BCTR R1,0 -1 FOR MOVE EX R1,MVCJOB MOVE TO NEWJOB XR R15,R15 GOT HIM TJOBEXIT L R14,TJOBSAVE BR R14 EJECT TIDYSAVE DS F TIDY ST R14,TIDYSAVE CLOSE TEMPIN CLOSE INFILE CLOSE OUTFILE L R14,TIDYSAVE BR R14 EJECT *********************************************************************** * * * STEP - WRITE EXTRA STEP TO END OF JOB * * IF SO MOVE THE JOBNAME TO NEWJOB * * * * * *********************************************************************** STEPSAVE DS F STEP ST R14,STEPSAVE LA R3,STEPDATA START OF DATA LA R4,STEPRNO NUMBER OF RECORDS STEP0010 PUT TEMPOUT,(R3) PUT THE DATA OUT LA R3,STEPRLN(,R3) NEXT 1 BCT R4,STEP0010 DO TILL END L R14,STEPSAVE BR R14 *********************************************************************** * * * WTMP - WRITE TEMP FILE TO OUTFILE * * * *********************************************************************** WTMPSAVE DS F WTMP ST R14,WTMPSAVE CLOSE TEMPOUT OPEN (TEMPIN,INPUT) WTMP0010 GET TEMPIN,REC CLI TEMPEOD,X'FF' END ? BE WTMPEXIT YES PUT OUTFILE,REC B WTMP0010 WTMPEXIT L R14,WTMPSAVE BR R14 EJECT TEMPIN DCB DDNAME=TEMPFILE, X00091700 EODAD=EOD1, X00091700 DSORG=PS, X00091800 MACRF=GM, X00091900 RECFM=FB, X00092000 LRECL=80, X00092100 BLKSIZE=0 00092200 EOD1 DS 0H MVI TEMPEOD,X'FF' BR R14 TEMPOUT DCB DDNAME=TEMPFILE, X00091700 EODAD=EOD1, X00091700 DSORG=PS, X00091800 MACRF=PM, X00091900 RECFM=FB, X00092000 LRECL=80, X00092100 BLKSIZE=0 00092200 INFILE DCB DDNAME=INFILE, X00091700 EODAD=EOD2, X00091700 EXLST=INEXLST, X00092100 DSORG=PS, X00091800 MACRF=GM, X00091900 RECFM=FB, X00092000 LRECL=80, X00092100 BLKSIZE=0 00092200 EOD2 DS 0H MVI INEOD,X'FF' BR R14 INEXLST DS 0F DC X'87',AL3(MYJFCB) MYJFCB DS 0F IEFJFCBN OUTFILE DCB DDNAME=OUTFILE, X00091700 DSORG=PS, X00091800 MACRF=PM, X00091900 RECFM=FB, X00092000 LRECL=80, X00092100 BLKSIZE=0 00092200 PROCRC DS F TEMPEOD DC X'00' INEOD DC X'00' BAD DC X'00' NOTFOUND EQU X'01' LASTJOB EQU X'02' REC DS CL80 JOBNAME DS CL8 MVCJOB MVC NEWJOB(1),0(R2) BLKTAB DC 256X'00' ORG BLKTAB+C' ' DC X'FF' ORG LTORG DC C'TABLE==>' STEPRLN EQU 80 LENGTH OF ENTRY STEPDATA EQU * STEPCOND DC CL(STEPRLN)' ' ABEND CARD IF COND IS BAD ORG STEPCOND DC C'//TESTCOND EXEC PGM=IEFBR14,COND=(1,LT)' ORG STEPABND DC CL(STEPRLN)' ' ABEND CARD IF COND IS BAD ORG STEPABND DC C'//LGZDUMP EXEC PGM=LGZDUMP,COND=(0,EQ,TESTCOND)' ORG STEPCOMA DC CL(STEPRLN)' ' COMMENT CARD ORG STEPCOMA DC C'//**** ABEND THE JOB IF WE HAVE HAD A BAD CC *****' ORG STEPEXEC DC CL(STEPRLN)' ' EXEC CARD ORG STEPEXEC DC C'//LIVSUB EXEC PGM=LIVSUB,COND=(0,NE),PARM=' NEWJOB DS CL8 NEXT JOB TO SUBMIT ORG STEPCOMM DC CL(STEPRLN)' ' COMMENT CARD ORG STEPCOMM DC C'//**** SUBMIT NEXT GEN JOB IF THIS ONE IS OK *****' ORG STEPLIB DC CL(STEPRLN)' ' STEPLIB CARD ORG STEPLIB DC C'//STEPLIB DD DISP=SHR,DSN=SG.UPDATE.LOAD' ORG STEPIN DC CL(STEPRLN)' ' //INFILE CARD ORG STEPIN DC C'//INFILE DD DISP=SHR,DSN=' STEPDSN DC CL44' ' STAGE 2 DSN GOES HERE ORG STEPOUT DC CL(STEPRLN)'//OUTFILE DD SYSOUT=(A,INTRDR)' STEPTEMP DC CL(STEPRLN)'//TEMPFILE DD UNIT=DISK,SPACE=(CYL,(10,10))' STEPDL EQU *-STEPDATA STEPRNO EQU STEPDL/STEPRLN END 02300000 //P02.SYSLIN DD * INCLUDE OBJ(LIVSUB) NAME LIVSUB(R) // //DOIT EXEC PGM=LIVSUB,PARM=IVALCTJ1,COND=(0,NE) 00030003 //STEPLIB DD DSN=SG.SL803D.LOAD,DISP=SHR 00070007 //OUTFILE DD DSN=SG.SL803D.STAGE2A,DISP=SHR, 00080007 // DCB=BUFNO=10 //SYSUDUMP DD SYSOUT=* //TEMPFILE DD UNIT=DISK,SPACE=(CYL,(10,10)) //INFILE DD DSN=SG.SL803D.TEST,DISP=SHR