Pre-requisites for this solution: ACMQ activated on the Endevor installation and a JCL Validation routine. This outline was specific for ASG’s JCLPREP, but can be modified for any JCL validation application.
The first thing to be aware of is that the supplied processors were developed to help address what I typically refer to as the “chicken-and-egg” problem that occasionally crops up in Endevor processing.
In the case of JCL and PROCs, the situation arises by trying to determine the source type to associate the processing to. To illustrate, consider the following JCL and PROC examples.
//XXX99D JOB (123,12),’MY JOB’,
// TIME=10
/*JOBPARM Q=H,I
//STEPA EXEC PROC=XXX10,
// SYSOUT=X,
// IMS=IMSA,
// DB2=DB2D
Figure 1 – JCL Example
//XXX10 PROC SYSOUT=A,
// IMS=,
// DB2=
//*
//S10 EXEC PGM=XXXXXXX
//PSBLIB DD DSN=&IMS..PSBLIB,
// DISP=SHR
//STEPLIB DD DSN=SYS2.LOADLIB,
// DISP=SHR
// DD DSN=&DB2..LOADLIB,
// DISP=SHR
Figure 2 – PROC Example
Both of the JCL and PROC in these examples are dependent upon each other. The JCL cannot execute without the PROC that contains the rest of the statements, and the PROC cannot execute without the JCL to resolve the symbolic information.
So if I place these into Endevor, one with type JCL and the other with type PROC, which do I want CA-JCLCHECK (or some other JCL validation routine) to run against? As it turns out, I cannot do one without the other! Placing the validation on both will result in one or the other failing for “false” reasons.
Again, to illustrate, let’s suppose I use CA-JCLCHECK in Endevor against the JCL. When Endevor generates the element, it may fail because the developer has not yet placed the PROC in. But if the developer HAD placed the PROC into Endevor, the PROC would have failed because the JCL wasn’t in Endevor! So who goes first (hence my naming the scenario “chickens-and-eggs”!).
Ultimately, the “dominant” type must be chosen; that is to say, the element most likely to be changed and put though life-cycle management the most often. I would suggest that, in the case of JCL and PROCs, the dominant type is PROC. It is far more likely you will be changing PROC statements and re-promoting those changes than JCL statements. And it is likewise rare that you would be changing a JCL type without also changing its related PROC.
Assuming you agree with that assessment, you next must determine a process that will give you the validations you are looking for. That is the purpose of these processors. In short, the JCL processors should only check for SYNTAX errors i.e. is JOB spelled correctly? Is the accounting information correct?
The PROC processor, however, has an opportunity to go much further. With the supplied processors, the PROCs will take a copy of every JCL that invokes it and do a thorough validation; in other words, even though it is the PROC that is being changed, the JCL validation routine will invoke every JCL that uses that PROC. In the event of shared PROCs (i.e. PROCs that are used by more than one “driver” JCL), this ensures that changes to the PROC will not have an adverse affect on JCL that the developer perhaps forgot to include in their impact analysis. ACMQ will be used to drive this process.
Let’s start with the JCL Processors.
JCL Routines
Generate Processor = GJCL01J
The first JCL Process is named GJCL01J.
The first step (DUMYJCL) executes CONWRITE to take a copy of the JCL statements into a temporary dataset.
The second step (CONSCAN) executes the CA-supplied standard scanning utility for processors that checks and maintains the ACM information that provides the PROC-to-JCL information.
The third step (CONTYPE) executes a small custom program ZCK942. Since CONSCAN does not create the TYPE definition in the scan, this program will insert the value “PROC” since that is what we are scanning the JCL for and will be used as a qualifier when we search ACMQ later.
The fourth step (CONRELE) relates the elements in ACM and ACMQ.
The fifth and final step invokes the JCL validation routine. The program supplied in this processor is a product named JCLPREP from Allen Systems Group (ASG). However, this could be any JCL validation routine (i.e. CA-JCLCHECK). However, the invocation in this step should be for validation only; do not attempt to do anything beyond validation else you will encounter the “chicken-and-egg” syndrome!
Delete Processor = *NOPROC
No delete processor is needed
Move Processor = MJCL01J
The MOVE processor needs to move the ACM information from one stage to the next when the JCL moves from one stage to the next. Therefore, this needs to be a one-step processor invoking program BC1PMVCL.
PROC Routines
Generate Processor = GPROC01J
As I indicated earlier, the entire JCL validation is based on the premise that PROCs are your “dominant” source type. In other words, it is far more likely you will be conducing changes to the PROC type than you will the JCL type. Therefore, it makes sense, in this scenario, for PROC types to drive a more comprehensive JCL validation routine. The GPROC01J processor is based on this principle.
The first step (ACMQ) invokes program BC1PACMQ. This program reads through the ACMQ to find the JCL affected by the PROC invoking this processor.
The second step (CHKXREF) invokes program ZCK940. This program will read through the results found off the ACMQ utility in the first step and create CONWRITE statements to retrieve the JCL that invokes the PROC being modified.
The third step (CHKEMPT) invoked a proprietary program for which I do not have the source to give you. You may have another program already at your site that performs this function; conversely, some of the IBM utilities perform its function as well (I think). The program merely checks to see if the dataset provided is empty or whether it contains data. In this case, an empty dataset returns a COND CODE of 0002 and a valid one returns 0000.
This COND CODE is necessary in subsequent steps. It may be the developer is adding a new PROC for which they have not yet given Endevor the submission JCL. In this scenario, the JCL processor has not yet had an opportunity to capture and build the crossreference entry in ACMQ. Therefore, when ZCK940 executes, it will not find any matching rows (an idea just occurred to me!!! It would make sense to modify program ZCK940 to return cond code 0000 when everything is fine (i.e. rows are found) and 0002 when no rows are found. That way, this utility is unnecessary! Your choice, but I think this is a good idea!!).
At any rate, when no submission JCL is found, then GPROC01J needs to just check the PROC and not worry about submission JCL
The next step (ENDRJCL) retrieves a copy of all the JCL that uses the PROC to be validated.
Step DUMYJCL executes if not JCL exists to be retrieved. In that case, we need to create a dummy datatset to keep our JCL validation program happy!
Finally, step JPRPJCL executes JCLPREP to check all the JCL with the PROC being promoted.
In the event no JCL was found, the Condition Code checking executes the subsequent step instead; JPRPPRO. This step executes JCLPREP to check the PROC as stand-alone.
Last but not least is the GENER step. The results of the validation are not of any value unless reported back to the user. Therefore, if the condition code is greater than the condition code we want, this step executes to display the results. Note that SYSUT2 has a statement for TERM=TS. This allows this entire processor to execute in foreground and, if the JCL prep step fails, will display the results on their TSO terminal (if foreground) or on their print queue (if background).
Delete and Move Processors = *NOPROC
The other processors defined in the processor group for type JCL need only be *NOPROC; in other words, no processing is required to MOVE or DELETE the JCL statements other than the normal processing Endevor performs on the Base libraries. Since no output is created during the GENERATE process, there is no need for any output libraries to be MOVED or DELETED.
GJCL01J Processor
//*****************************************************************
//* *
//* PROCESSOR NAME: GJCL01J *
//* PURPOSE: JCLPREP ROUTINE FOR DRIVER JCL *
//* *
//*****************************************************************
//GJCL01J PROC ADMNLIB='CAIDEMO.NDVUT.LOADLIB',
// PREPCTL='NDVLIB.ADMIN.STG6.CTLLIB',
// PREPLIB='ISJCLPRP.PROD.LOADLIB',
// PREPOPT=ZCKJ005,
// PREPRC=4,
// PRULE=P$RDJCL,
// RULELIB='NDVLIB.ADMIN.STG6.RULELIB',
// SYSOUT=Z,
// WRKUNIT=VIO
//*
//*
//******************************************************************
//* *
//* USE CONWRITE TO COPY IMAGE OF JCL INTO TEMPORARY AREA *
//* *
//******************************************************************
//DUMYJCL EXEC PGM=CONWRITE,
// MAXRC=8,
// PARM='EXPINCL(N)'
//ELMOUT DD DSN=&&JCL,
// DISP=(NEW,PASS),
// UNIT=&WRKUNIT,
// SPACE=(6160,(100,100),RLSE),
// DCB=(RECFM=FB,BLKSIZE=6160,LRECL=80)
//*
//******************************************************************
//* *
//* INVOKE CONSCAN TO CHECK THE JCL FOR PROCS EXECUTED. *
//* *
//******************************************************************
//CONSCAN EXEC PGM=CONSCAN
//SRCIN DD DSN=&&JCL,
// DISP=(OLD,PASS)
//PARMSCAN DD *
*
* SCAN FOR PROC= STATEMENT
* START AT FIRST CHARACTER AFTER PROC= AND DELIMIT BY SPACE OR COMMA
*
SCANTYPE ELEMENT
FIND1 STRING='PROC=',POS=ANY
START TYPE=DFLT
END1 TYPE=CHAR,PARM=','
END2 TYPE=SPAC
*
* SCAN FOR EXEC STATEMENT AND IGNORE PGM
* DELIMIT BY SPACE OR BY COMMA
*
SCANTYPE ELEMENT
FIND1 STRING='EXEC',POS=ANY
FIND2 REJECT,STRING='PGM',POS=ANY
START TYPE=DFLT
END1 TYPE=CHAR,PARM=','
END2 TYPE=SPAC
/*
//ACMRELE DD DSN=&&ACMREL,
// DISP=(NEW,PASS),
// UNIT=&WRKUNIT,
// SPACE=(TRK,(10,50),RLSE),
// DCB=(LRECL=80,BLKSIZE=6160,RECFM=FB)
//SCANPRT DD SYSOUT=*
//SYSPRINT DD SYSOUT=*
//*
//*****************************************************************
//* *
//* INVOKE PGM TO ADD TYPE DECLARATION *
//* *
//*****************************************************************
//*
//CONTYPE EXEC PGM=ZCK942
//STEPLIB DD DSN=&ADMNLIB,
// DISP=SHR
//SCLIN DD DSN=&&ACMREL,
// DISP=SHR
//SCLOUT DD DSN=&&ACMRELS,
// DISP=(NEW,PASS),
// UNIT=&WRKUNIT,
// SPACE=(TRK,(10,50),RLSE),
// DCB=(LRECL=80,BLKSIZE=6160,RECFM=FB)
//*
//*****************************************************************
//* *
//* INVOKE CONRELE TO DOCUMENT THE PROC/JCL RELATIONSHIP *
//* *
//*****************************************************************
//*
//CONRELE EXEC PGM=CONRELE
//NDVRIPT DD DSN=&&ACMRELS,
// DISP=SHR
//*
//*JPRPJCL EXEC PGM=JCLPREP,
//* MAXRC=&PREPRC
//******************************************************************
//* *
//* INVOKE JCLPREP TO DO THE JCL SCAN FOR FOUND DRIVER JCL *
//* *
//******************************************************************
//*STEPLIB DD DSN=&PREPLIB,
//* DISP=(SHR,KEEP)
//*SYSUDUMP DD SYSOUT=*,
//* FREE=CLOSE
//*DDIN DD DSN=&&JCL,
//* DISP=(OLD,PASS)
//*DDOUT DD DUMMY,
//* DCB=(RECFM=FB,BLKSIZE=3120,LRECL=80)
//*DDXEFI DD DSN=&RULELIB(&PRULE),
//* DISP=(SHR,KEEP)
//*DDXEFW DD SYSOUT=*,
//* FREE=CLOSE
//*DDRPT DD DSN=&&DDRPT,
//* DISP=(NEW,PASS,DELETE),
//* UNIT=&WRKUNIT,
//* SPACE=(TRK,(10,10),RLSE),
//* DCB=(RECFM=FBA,BLKSIZE=6118,LRECL=133)
//*DDWORK1 DD DSN=&&DDWORK,
//* DISP=(NEW,PASS),
//* UNIT=&WRKUNIT,
//* SPACE=(8456,(100,500)),
//* DCB=DSORG=DA
//*DDWORK2 DD DSN=&&DDWORK,
//* DISP=SHR
//*DDRUN DD *
//*NOPDS
//*
//*DDOPT DD DSN=&PREPCTL(&PREPOPT),
//* DISP=SHR
//*
//*GENER EXEC PGM=IEBGENER,
//* COND=(&PREPRC,GE,JPRPJCL)
//******************************************************************
//* *
//* GENER THE REPORT TO OUTPUT IF THE THRESHOLD RC WAS EXCEEDED *
//* *
//******************************************************************
//*SYSPRINT DD SYSOUT=&SYSOUT,
//* FREE=CLOSE
//*SYSUT1 DD DSN=&&DDRPT,
//* DISP=(OLD,DELETE)
//*SYSUT2 DD SYSOUT=A,
//* FREE=CLOSE,
//* TERM=TS,
//* DEST=SARSAP,
//* DCB=(RECFM=FB,BLKSIZE=79,LRECL=79)
//*SYSIN DD *
//* GENERATE MAXFLDS=1
//* RECORD FIELD=(79,1)
//*
GPROC01J Processor
//*****************************************************************
//* *
//* PROCESSOR NAME: GPROC01J *
//* PURPOSE: JCLPREP ROUTINE FOR PROCEDURE JCL *
//* *
//*****************************************************************
//GPROC01J PROC ADMNLIB='CAIDEMO.NDVUT.LOADLIB',
// PREPCTL='NDVLIB.ADMIN.STG6.CTLLIB',
// PREPLIB='ISJCLPRP.PROD.LOADLIB',
// PREPOPT=ZCKJ003,
// PREPRC=4,
// PRULE=P$RDPRC,
// RULELIB='NDVLIB.ADMIN.STG6.RULELIB',
// SBASELIB='NDVLIB.&C1SSYSTEM..&C1SSTAGE..PROCLIB',
// WRKUNIT=VIO
//*
//*********************************************************************
//** EXECUTE THE ACM QUERY EXPLOSION REPORT **
//*********************************************************************
//ACMQ EXEC PGM=BC1PACMQ
//ACMOUT DD DSN=&&ACMREL,
// DISP=(NEW,PASS),
// UNIT=&WRKUNIT,
// SPACE=(6160,(10,10),RLSE),
// DCB=(LRECL=80,BLKSIZE=6160,RECFM=FB)
//ACMIN DD *
RECTYPE 3
ENVIRONMENT *
SYSTEM *
SUBSYSTEM *
TYPE PROC
ELEMENT &C1ELEMENT
STAGE *
SEARCH UP
/*
//*
//CHKXREF EXEC PGM=ZCK940,
// MAXRC=0
//******************************************************************
//* *
//* CHECK THE PROCXREF TABLE FOR *
//* ALL DRIVER JCL FOR THIS ELEMENT. *
//* *
//******************************************************************
//STEPLIB DD DSN=&ADMNLIB,
// DISP=SHR
//ZCK94001 DD DSN=&&ACMREL,
// DISP=SHR
//ZCK94002 DD DSN=&&ACMRELS,
// DISP=(NEW,PASS),
// UNIT=&WRKUNIT,
// SPACE=(6160,(10,10),RLSE),
// DCB=(RECFM=FB,BLKSIZE=6160,LRECL=80)
//SYSPRINT DD SYSOUT=*,
// FREE=CLOSE
//SYSOUT DD SYSOUT=*,
// FREE=CLOSE
//SYSUDUMP DD SYSOUT=*,
// FREE=CLOSE
//*
//CHKEMPT EXEC PGM=CEE010,
// MAXRC=2,
// PARM='RET,0002;RET,0000'
//******************************************************************
//* *
//* CHECK THE CREATED DATASET FOR CONTENTS. IF NONE EXIST, THEN *
//* NO DRIVER JCL WAS FOUND AND WE WILL PREP THE MEMBER AS IS. *
//* NO CONTENTS WILL RETURN A COND CODE OF 0002. *
//* *
//******************************************************************
//STEPLIB DD DSN=SYS2.LOADLIB,
// DISP=SHR
//CEE01001 DD DSN=&&SCL,
// DISP=(OLD,PASS)
//*
//ENDRJCL EXEC PGM=CONWRITE,
// COND=(0,NE,CHKEMPT),
// MAXRC=0
//******************************************************************
//* *
//* INVOKE CONWRITE TO RETRIEVE COPIES OF THE DRIVER JCL AS PER *
//* THE GENERATED SCL STATEMENTS. *
//* *
//******************************************************************
//CONWIN DD DSN=&&SCL,
// DISP=(OLD,PASS)
//JCLPRP DD DSN=&&JCL,
// DISP=(NEW,PASS,KEEP),
// UNIT=&WRKUNIT,
// SPACE=(6160,(100,100,100),RLSE),
// DCB=(RECFM=FB,BLKSIZE=6160,LRECL=80,DSORG=PO)
//*
//DUMYJCL EXEC PGM=CONWRITE,
// COND=(0,EQ,CHKEMPT),
// MAXRC=8,
// PARM='EXPINCL(N)'
//******************************************************************
//* *
//* IF THE CEE010 PROGRAM DID NOT FIND CONTENTS, THEN JUST USE *
//* THE PROC JCL FOR THE PREP STEP. *
//* *
//******************************************************************
//ELMOUT DD DSN=&&JCL,
// DISP=(NEW,PASS,KEEP),
// UNIT=&WRKUNIT,
// SPACE=(6160,(100,100),RLSE),
// DCB=(RECFM=FB,BLKSIZE=6160,LRECL=80)
//*
//JPRPJCL EXEC PGM=JCLPREP,
// COND=(0,NE,CHKEMPT),
// MAXRC=&PREPRC
//******************************************************************
//* *
//* INVOKE JCLPREP TO DO THE JCL SCAN FOR FOUND ENDEVOR DRIVER *
//* JCL *
//* *
//******************************************************************
//STEPLIB DD DSN=&PREPLIB,
// DISP=(SHR,KEEP)
//SYSUDUMP DD SYSOUT=*,
// FREE=CLOSE
//DDIN DD DSN=&&JCL,
// DISP=(OLD,PASS)
//DDOUT DD DUMMY,
// DCB=(RECFM=FB,BLKSIZE=3120,LRECL=80)
//DDXEFI DD DSN=&RULELIB(&PRULE),
// DISP=(SHR,KEEP)
//DDXEFW DD SYSOUT=*,
// FREE=CLOSE
//DDRPT DD DSN=&&DDRPT,
// DISP=(NEW,PASS,DELETE),
// UNIT=&WRKUNIT,
// SPACE=(TRK,(10,10),RLSE),
// DCB=(RECFM=FBA,BLKSIZE=6118,LRECL=133)
//DDWORK1 DD DSN=&&DDWORK,
// DISP=(NEW,PASS),
// UNIT=&WRKUNIT,
// SPACE=(8456,(100,500)),
// DCB=DSORG=DA
//DDWORK2 DD DSN=&&DDWORK,
// DISP=SHR
//DDRUN DD *
PDS INPUT
/*
//DDOPT DD DSN=&PREPCTL(&PREPOPT),
// DISP=SHR
// DD *
XEFOPT PROCLIB &C1BASELIB
XEFOPT PROCLIB NDVLIB.&C1SY..STG1.PROCLIB
XEFOPT PROCLIB NDVLIB.&C1SY..ST21.PROCLIB
XEFOPT PROCLIB NDVLIB.&C1SY..STG2.PROCLIB
XEFOPT PROCLIB NDVLIB.&C1SY..ST22.PROCLIB
XEFOPT PROCLIB NDVLIB.&C1SY..STG3.PROCLIB
XEFOPT PROCLIB NDVLIB.&C1SY..STG4.PROCLIB
XEFOPT PROCLIB NDVLIB.&C1SY..STG5.PROCLIB
XEFOPT PROCLIB NDVLIB.EMER.EMER1.PROCLIB
XEFOPT PROCLIB NDVLIB.EMER.EMER2.PROCLIB
XEFOPT PROCLIB NDVLIB.&C1SY..STG6.PROCLIB
XEFOPT PROCLIB SYS2.PROCLIB
XEFOPT PROCLIB SYS1.PROCLIB
XEFOPT PROCLIB SYS3.PROCLIB
XEFOPT PROCLIB SYS1.BASE.PROCLIB
/*
//*
//JPRPPRO EXEC PGM=JCLPREP,
// COND=(0,EQ,CHKEMPT),
// MAXRC=&PREPRC
//******************************************************************
//* *
//* INVOKE JCLPREP TO DO THE JCL SCAN FOR UNFOUND PROC JCL *
//* *
//******************************************************************
//STEPLIB DD DSN=&PREPLIB,
// DISP=(SHR,KEEP)
//SYSUDUMP DD SYSOUT=*,
// FREE=CLOSE
//DDIN DD DSN=&&JCL,
// DISP=(OLD,PASS)
//DDOUT DD DUMMY,
// DCB=(RECFM=FB,BLKSIZE=3120,LRECL=80)
//DDXEFI DD DSN=&RULELIB(&PRULE),
// DISP=(SHR,KEEP)
//DDXEFW DD SYSOUT=*,
// FREE=CLOSE
//DDRPT DD DSN=&&DDRPT,
// DISP=(NEW,PASS,DELETE),
// UNIT=&WRKUNIT,
// SPACE=(TRK,(10,10),RLSE),
// DCB=(RECFM=FBA,BLKSIZE=6118,LRECL=133)
//DDWORK1 DD DSN=&&DDWORK,
// DISP=(NEW,PASS),
// UNIT=&WRKUNIT,
// SPACE=(8456,(100,500)),
// DCB=DSORG=DA
//DDWORK2 DD DSN=&&DDWORK,
// DISP=SHR
//DDRUN DD *
NOPDS
/*
//DDOPT DD DSN=&PREPCTL(&PREPOPT),
// DISP=SHR
// DD *
XEFOPT PROCLIB &C1BASELIB
XEFOPT PROCLIB NDVLIB.&C1SY..STG1.PROCLIB
XEFOPT PROCLIB NDVLIB.&C1SY..ST21.PROCLIB
XEFOPT PROCLIB NDVLIB.&C1SY..STG2.PROCLIB
XEFOPT PROCLIB NDVLIB.&C1SY..ST22.PROCLIB
XEFOPT PROCLIB NDVLIB.&C1SY..STG3.PROCLIB
XEFOPT PROCLIB NDVLIB.&C1SY..STG4.PROCLIB
XEFOPT PROCLIB NDVLIB.&C1SY..STG5.PROCLIB
XEFOPT PROCLIB NDVLIB.EMER.EMER1.PROCLIB
XEFOPT PROCLIB NDVLIB.EMER.EMER2.PROCLIB
XEFOPT PROCLIB NDVLIB.&C1SY..STG6.PROCLIB
XEFOPT PROCLIB SYS2.PROCLIB
XEFOPT PROCLIB SYS1.PROCLIB
XEFOPT PROCLIB SYS3.PROCLIB
XEFOPT PROCLIB SYS1.BASE.PROCLIB
/*
//*
//GENER EXEC PGM=IEBGENER,
// COND=((&PREPRC,GE,JPRPJCL),(&PREPRC,GE,JPRPPRO))
//******************************************************************
//* *
//* GENER THE REPORT TO OUTPUT IF THE THRESHOLD RC WAS EXCEEDED *
//* *
//******************************************************************
//SYSPRINT DD SYSOUT=*,
// FREE=CLOSE
//SYSUT1 DD DSN=&&DDRPT,
// DISP=(OLD,DELETE)
//SYSUT2 DD SYSOUT=A,
// FREE=CLOSE,
// TERM=TS,
// DEST=SARSAP,
// DCB=(RECFM=FB,BLKSIZE=79,LRECL=79)
//SYSIN DD *
GENERATE MAXFLDS=1
RECORD FIELD=(79,1)
/*
ZCK940 COBOL Program
000100*************************
000200 IDENTIFICATION DIVISION.
000300*************************
000400 SKIP1
000500 PROGRAM-ID. ZCK940.
000600*AUTHOR. JOHN DUECKMAN
000700*DATE-WRITTEN. FEB 05,2001.
000800*DATE-COMPILED.
000900 SKIP1
001000*REMARKS.
001300 EJECT
001400**************************
001500 ENVIRONMENT DIVISION.
001600**************************
001700 SKIP1
001800 CONFIGURATION SECTION.
001900 SOURCE-COMPUTER. IBM-370.
002000 OBJECT-COMPUTER. IBM-370.
002100 INPUT-OUTPUT SECTION.
002200**************************
002300 FILE-CONTROL.
002400 SELECT PROC-IN ASSIGN TO UT-S-ZCK94001.
002500 SELECT JOB-OUT ASSIGN TO UT-S-ZCK94002.
002600 EJECT
002700**************************
002800 DATA DIVISION.
002900**************************
003000 SKIP1
003100**************************
003200 FILE SECTION.
003300**************************
003400 FD PROC-IN
003500 LABEL RECORDS ARE STANDARD
003600 RECORDING MODE IS F
003700 BLOCK CONTAINS 0 RECORDS
003800 DATA RECORD IS PROC-IN-AREA.
003900 01 PROC-IN-AREA PIC X(80).
004000 FD JOB-OUT
004100 LABEL RECORDS ARE STANDARD
004200 RECORDING MODE IS F
004300 BLOCK CONTAINS 0 RECORDS
004400 DATA RECORD IS JOB-OUT-AREA.
004500 01 JOB-OUT-AREA PIC X(80).
004600 SKIP1
004700**************************
004800 WORKING-STORAGE SECTION.
004900**************************
005600 01 WS1000-STORAGE-AREA.
005700 05 WS1000 PIC X(12) VALUE 'WS1000'.
005800 05 WS1000-PROC-IN PIC X(80).
005810 05 WS1000-PROC-IN-BKDWN REDEFINES WS1000-PROC-IN.
005820 10 WS1000-FILLER01 PIC X(05).
005830 10 WS1000-LEVEL-CODE PIC X(01).
005831 10 WS1000-FILLER02 PIC X(03).
005850 10 WS1000-JOBNAME PIC X(08).
005860 10 WS1000-FILLER03 PIC X(05).
005870 10 WS1000-TYPE PIC X(08).
005880 10 WS1000-FILLER04 PIC X(03).
005890 10 WS1000-ENV-NAME PIC X(08).
005891 10 WS1000-FILLER05 PIC X(03).
005892 10 WS1000-SYSNAME PIC X(08).
005893 10 WS1000-FILLER06 PIC X(03).
005894 10 WS1000-SUBSYSNAME PIC X(08).
005895 10 WS1000-FILLER07 PIC X(03).
005896 10 WS1000-STGID PIC X(01).
006300 05 WS1000-EOF-FLAG PIC X(03).
006400 88 WS1000-EOF VALUE 'EOF'.
006410 05 WS1000-FOUND-FLAG PIC X(05).
006420 88 WS1000-FOUND VALUE 'FOUND'.
006500 01 WS2000-STORAGE-AREA.
006600 05 WS2000 PIC X(12) VALUE 'WS2000'.
007300 05 WS2000-JOB-OUT PIC X(80).
007400 05 WS2000-JOB-OUT1.
007500 10 WS2000-JOB-OUT1-TEXT1 PIC X(18)
007600 VALUE 'WRITE ELEMENT "'.
007700 10 WS2000-JOB-OUT1-JOBNAME PIC X(08).
007800 10 WS2000-JOB-OUT1-TEXT2 PIC X(54) VALUE '"'.
007900 05 WS2000-JOB-OUT2.
008000 10 WS2000-JOB-OUT2-TEXT1 PIC X(13)
008100 VALUE 'FROM SYSTEM "'.
008200 10 WS2000-JOB-OUT2-SYSNAME PIC X(08).
008300 10 WS2000-JOB-OUT2-TEXT2 PIC X(13)
008400 VALUE '" SUBSYSTEM "'.
008500 10 WS2000-JOB-OUT2-SUBSYSNAME PIC X(08).
008600 10 WS2000-JOB-OUT2-TEXT3 PIC X(07) VALUE '" ENV "'.
008610 10 WS2000-JOB-OUT2-ENV PIC X(08).
008620 10 WS2000-JOB-OUT2-TEXT4 PIC X(23) VALUE '"'.
008700 05 WS2000-JOB-OUT3.
008800 10 WS2000-JOB-OUT3-TEXT1 PIC X(06)
008900 VALUE 'TYPE "'.
009000 10 WS2000-JOB-OUT3-TYPE PIC X(08).
009010 10 WS2000-JOB-OUT3-TEXT2 PIC X(08)
009020 VALUE '" STAGE '.
009030 10 WS2000-JOB-OUT3-STGID PIC X(01).
009040 10 WS2000-JOB-OUT3-TEXT3 PIC X(23)
009050 VALUE ' TO FILE "JCLPRP" MEM "'.
009210 10 WS2000-JOB-OUT3-JOBNAME PIC X(08).
009220 10 WS2000-JOB-OUT3-TEXT3 PIC X(26)
009230 VALUE '" OPTIONS SEARCH.'.
010500 EJECT
010600 PROCEDURE DIVISION.
010700***********************************************************
010800* M A I N L O G I C *
010900***********************************************************
011000 OPEN INPUT PROC-IN
011100 OUTPUT JOB-OUT.
011200 MOVE SPACES TO WS1000-EOF-FLAG.
011210 MOVE SPACES TO WS1000-FOUND-FLAG.
011300 PERFORM 1000-GET-RECORD
011400 THRU 1000-GET-RECORD-EXIT
011410 UNTIL WS1000-EOF
011420 OR WS1000-FOUND.
013000 MOVE 'JCL' TO WS2000-JOB-OUT3-TYPE.
013100 PERFORM 0000-LOOKUP-JOB
013200 THRU 0000-LOOKUP-JOB-EXIT
013300 UNTIL WS1000-EOF.
013700 CLOSE PROC-IN
013800 JOB-OUT.
013900 STOP RUN.
014000 EJECT
014100*******************************************************************
014200* LOOKUP-JOB - INTERNAL SUBROUTINE THAT READS THROUGH THE *
014300* FILE MATCHING ON PROCNAME. *
014400*******************************************************************
014500 0000-LOOKUP-JOB.
016600 MOVE WS1000-JOBNAME TO WS2000-JOB-OUT1-JOBNAME.
016700 MOVE WS2000-JOB-OUT1 TO WS2000-JOB-OUT.
016800 PERFORM 2000-WRITE-JOB
016900 THRU 2000-WRITE-JOB-EXIT.
016910 MOVE WS1000-ENV-NAME TO WS2000-JOB-OUT2-ENV.
017000 MOVE WS1000-SYSNAME TO WS2000-JOB-OUT2-SYSNAME.
017100 MOVE WS1000-SUBSYSNAME TO WS2000-JOB-OUT2-SUBSYSNAME.
017200 MOVE WS2000-JOB-OUT2 TO WS2000-JOB-OUT.
017300 PERFORM 2000-WRITE-JOB
017400 THRU 2000-WRITE-JOB-EXIT.
017401 MOVE WS1000-STGID TO WS2000-JOB-OUT3-STGID.
017410 MOVE WS1000-JOBNAME TO WS2000-JOB-OUT3-JOBNAME.
017500 MOVE WS2000-JOB-OUT3 TO WS2000-JOB-OUT.
017600 PERFORM 2000-WRITE-JOB
017700 THRU 2000-WRITE-JOB-EXIT.
017710 MOVE SPACES TO WS1000-FOUND-FLAG.
017720 PERFORM 1000-GET-RECORD
017730 THRU 1000-GET-RECORD-EXIT
017740 UNTIL WS1000-EOF
017750 OR WS1000-FOUND.
017800 0000-LOOKUP-JOB-EXIT.
017900 EXIT.
018000 EJECT
018100*******************************************************************
018200* GET-RECORD - INTERNAL SUBROUTINE THAT READS THE INPUT RECORD. *
018300*******************************************************************
018400 1000-GET-RECORD.
018500 READ PROC-IN
018600 AT END
018700 MOVE 'EOF' TO WS1000-EOF-FLAG
018800 GO TO 1000-GET-RECORD-EXIT.
018900 MOVE PROC-IN-AREA TO WS1000-PROC-IN.
018902 IF WS1000-LEVEL-CODE IS EQUAL TO '2'
018903 THEN
018904 MOVE 'FOUND' TO WS1000-FOUND-FLAG.
019000 1000-GET-RECORD-EXIT.
019100 EXIT.
019200 EJECT
019300*******************************************************************
019400* WRITE-JOB - INTERAL SUBROUTINE THAT WRITES THE FOUND JOB OUT. *
019500*******************************************************************
019600 2000-WRITE-JOB.
019700 MOVE WS2000-JOB-OUT TO JOB-OUT-AREA.
019800 WRITE JOB-OUT-AREA.
019900 2000-WRITE-JOB-EXIT.
020000 EXIT.
ZCK942 COBOL Program
000100*************************
000200 IDENTIFICATION DIVISION.
000300*************************
000400 SKIP1
000500 PROGRAM-ID. ZCK942.
000600*AUTHOR. JOHN DUECKMAN
000700*DATE-WRITTEN. FEB 05,2001.
000800*DATE-COMPILED.
001500 EJECT
001600**************************
001700 ENVIRONMENT DIVISION.
001800**************************
001900 SKIP1
002000 CONFIGURATION SECTION.
002100 SOURCE-COMPUTER. IBM-370.
002200 OBJECT-COMPUTER. IBM-370.
002300 INPUT-OUTPUT SECTION.
002400**************************
002500 FILE-CONTROL.
002700 SELECT SCLIN ASSIGN TO UT-S-SCLIN .
002800 SELECT SCLOUT ASSIGN TO UT-S-SCLOUT.
003000 EJECT
003100**************************
003200 DATA DIVISION.
003300**************************
003400 SKIP1
003500**************************
003600 FILE SECTION.
003700**************************
004310 FD SCLIN
004320 LABEL RECORDS ARE STANDARD
004330 RECORDING MODE IS F
004340 BLOCK CONTAINS 0 RECORDS
004350 DATA RECORD IS SCLIN-AREA.
004360 01 SCLIN-AREA PIC X(80).
004400 FD SCLOUT
004500 LABEL RECORDS ARE STANDARD
004600 RECORDING MODE IS F
004700 BLOCK CONTAINS 0 RECORDS
004800 DATA RECORD IS SCLOUT-AREA.
004900 01 SCLOUT-AREA PIC X(80).
006200 SKIP1
006300**************************
006400 WORKING-STORAGE SECTION.
006500**************************
006600 01 WS0000-STORAGE-AREA.
006700 05 WS0000 PIC X(12) VALUE 'WS0000'.
006710 05 WS0000-COUNTR PIC S9(09) COMP.
006720 05 WS0000-SCLIN-AREA PIC X(80).
006730 05 WS0000-CHECKTYPE PIC X(05) VALUE 'TYPE'.
006750 05 WS0000-NEWTYPE PIC X(80)
006760 VALUE ' TYPE = "PROC" '.
006800 01 WS1000-STORAGE-AREA.
006900 05 WS1000 PIC X(12) VALUE 'WS1000'.
007000 05 WS1000-EOF-FLAG PIC X(03) VALUE SPACES.
007100 88 WS1000-EOF VALUE 'EOF'.
050200 EJECT
050300 PROCEDURE DIVISION.
050400***********************************************************
050500* M A I N L O G I C *
050600***********************************************************
050710 OPEN INPUT SCLIN
050800 OUTPUT SCLOUT.
051100 PERFORM 1000-GET-RECORD
051200 THRU 1000-GET-RECORD-EXIT.
051300 MOVE SCLIN-AREA TO WS0000-SCLIN-AREA.
051400 PERFORM 0000-CHECK-TYPE
051500 THRU 0000-CHECK-TYPE-EXIT
051600 UNTIL WS1000-EOF.
054100 CLOSE SCLIN
054200 SCLOUT.
054500 STOP RUN.
054600 EJECT
054700*******************************************************************
054800* CHECK-TYPE - INTERNAL SUBROUTINE THAT CHECKS THE INPUT *
054900* RECORD FOR 'TYPE' STATEMENT. *
055000*******************************************************************
055100 0000-CHECK-TYPE.
055110 MOVE ZEROES TO WS0000-COUNTR.
055200 INSPECT SCLIN-AREA
055210 TALLYING WS0000-COUNTR FOR ALL WS0000-CHECKTYPE.
055220 IF WS0000-COUNTR IS EQUAL TO ZEROES
055230 THEN
055231 MOVE SCLIN-AREA TO SCLOUT-AREA
055250 ELSE
055260 MOVE WS0000-NEWTYPE TO SCLOUT-AREA.
055270 WRITE SCLOUT-AREA.
055280 PERFORM 1000-GET-RECORD
055290 THRU 1000-GET-RECORD-EXIT.
055291 0000-CHECK-TYPE-EXIT.
055292 EXIT.
055293 EJECT
064600*******************************************************************
064700* GET-RECORD - INTERNAL SUBROUTINE THAT READS THE INPUT RECORD. *
064800*******************************************************************
064900 1000-GET-RECORD.
065000 READ SCLIN
065100 AT END
065200 MOVE 'EOF' TO WS1000-EOF-FLAG
065300 GO TO 1000-GET-RECORD-EXIT.
065400 1000-GET-RECORD-EXIT.
065500 EXIT.