WORKBENCH PROGRAMMER PRODUCTIVITY AID
____________________________________________________________________________________________________
Most application samples shown in the section assume thestandard BENCH proc is used. ERRORS=ABEND will cause a U1001 abend should editor process errors occur. The abend status will prevent your files fromcataloging. ERRORS=TRACE will request Workbench to issue messages on R01 thattrace each command as they are executed. The display contains internal hexvalues usable only to system support. For examples that use IMS or CA-DATACOMdatabases, see the BENCHIMS and BENCHDB procs that support those services.
STANDARD BENCH JCL PROC FOR OS/DB2/IDMS FILES:
//BENCH PROC ERRORS=,RGN=2048K
//*
//******************************************
//* EXEC WKBENCH UTILITY *
//******************************************
//*
//BENCH EXEC PGM=BENCH,PARM=&ERRORS,REGION=&RGN
//STEPLIB DD DSN=company.loadlib,DISP=SHR
//BENCHR01 DD SYSOUT=*,DCB=(BLKSIZE=133,LRECL=133,RECFM=FBA)
//BENCHR02 DD SYSOUT=*,DCB=(BLKSIZE=133,LRECL=133,RECFM=FBA)
//BENCHR03 DD SYSOUT=*,DCB=(BLKSIZE=133,LRECL=133,RECFM=FBA)
//BENCHR04 DD SYSOUT=*,DCB=(BLKSIZE=133,LRECL=133,RECFM=FBA)
//BENCHR05 DD SYSOUT=*,DCB=(BLKSIZE=133,LRECL=133,RECFM=FBA)
//BENCHR06 DD SYSOUT=*,DCB=(BLKSIZE=133,LRECL=133,RECFM=FBA)
//BENCHR07 DD SYSOUT=*,DCB=(BLKSIZE=133,LRECL=133,RECFM=FBA)
//BENCHR08 DD SYSOUT=*,DCB=(BLKSIZE=133,LRECL=133,RECFM=FBA)
//BENCHWRD DD DUMMY,DCB=(LRECL=34,RECFM=VB,BLKSIZE=6000)
//BENCHCMD DD DDNAME=SYSIN
//* PEND
The IMS application samples shown in the section assume thestandard BENCHIMS proc is used. PSB=xxxxxxxx is the desired application PSB.Because IMS and CA-DATACOM both require to be called first, you may not combineaccess to IMS and Datacom in the same run. You may, however, under either ofthese environments access OS, DB2, or IDMS file structures. PARM=ABEND or TRACEis also not available in this proc.
STANDARD BENCH JCL PROC FORIMS:
//BENCHIMS PROC RGN=4096K,PSB=
//******************************************
//* EXEC WORKBENCH UTILITY FOR IMS *
//******************************************
//BENCHIMS EXEC PGM=DFSRRC00,REGION=&RGN,
// PARM='DLI,BENCH,&PSB'
//STEPLIB DD DSN=company.loadlib,DISP=SHR
// DD DSN=company.ims.reslib,DISP=SHR
// DD DSN=company.ims.modlib,DISP=SHR
//IMS DD DSN=company.ims.pgmlib,DISP=SHR
//DFSVSAMP DD DSN=company.ctlcard(bufdef),DISP=SHR
//IEFRDER DD DUMMY
//SYSPRINT DD SYSOUT=*
//DFSSTAT DD DUMMY
//BENCHR01 DD SYSOUT=*,DCB=(BLKSIZE=133,LRECL=133,RECFM=FBA)
//BENCHR02 DD SYSOUT=*,DCB=(BLKSIZE=133,LRECL=133,RECFM=FBA)
//BENCHR03 DD SYSOUT=*,DCB=(BLKSIZE=133,LRECL=133,RECFM=FBA)
//BENCHR04 DD SYSOUT=*,DCB=(BLKSIZE=133,LRECL=133,RECFM=FBA)
//BENCHR05 DD SYSOUT=*,DCB=(BLKSIZE=133,LRECL=133,RECFM=FBA)
//BENCHR06 DD SYSOUT=*,DCB=(BLKSIZE=133,LRECL=133,RECFM=FBA)
//BENCHR07 DD SYSOUT=*,DCB=(BLKSIZE=133,LRECL=133,RECFM=FBA)
//BENCHR08 DD SYSOUT=*,DCB=(BLKSIZE=133.LRECL=133,RECFM=FBA)
//BENCHWRD DD DUMMY,DCB=(LRECL=34,BLKSIZE=6000,RECFM=VB)
//BENCHCMD DD DDNAME=SYSIN
//* PEND
The CA-DATACOM application samples shown in the sectionassume the standard BENCHDB proc is used. URT=xxxxxxxx is the desiredapplication PSB. Because IMS and CA-DATACOM both require to be called first, youmay not combine access to IMS and Datacom in the same run. You may however undereither of these environments access OS, DB2, or IDMS file structures. PARM=ABENDor TRACE is also not available in this proc.
STANDARD BENCH JCL PROC FOR CA-DATACOM:
//BENCHDB PROC RGN=4096K,URT='XXXXXXXX'
//******************************************
//* EXEC WORKBENCH UTILITY FOR CA-DATACOM *
//******************************************
//BENCHDB EXEC PGM=BENCHDB,PARM='URT=&URT',REGION=&RGN
//STEPLIB DD DSN=company.loadlib,DISP=SHR
// DD DSN=company.urt.loadlib,DISP=SHR
// DD DSN=company.db.loadlib,DISP=SHR
//BENCHR01 DD SYSOUT=*,DCB=(BLKSIZE=133,LRECL=133,RECFM=FBA)
//BENCHR02 DD SYSOUT=*,DCB=(BLKSIZE=133,LRECL=133,RECFM=FBA)
//BENCHR03 DD SYSOUT=*,DCB=(BLKSIZE=133,LRECL=133,RECFM=FBA)
//BENCHR04 DD SYSOUT=*,DCB=(BLKSIZE=133,LRECL=133,RECFM=FBA)
//BENCHR05 DD SYSOUT=*,DCB=(BLKSIZE=133,LRECL=133,RECFM=FBA)
//BENCHR06 DD SYSOUT=*,DCB=(BLKSIZE=133,LRECL=133,RECFM=FBA)
//BENCHR07 DD SYSOUT=*,DCB=(BLKSIZE=133,LRECL=133,RECFM=FBA)
//BENCHR08 DD SYSOUT=*,DCB=(BLKSIZE=133.LRECL=133,RECFM=FBA)
//BENCHWRD DD DUMMY,DCB=(LRECL=34,BLKSIZE=6000,RECFM=VB)
//BENCHCMD DD DDNAME=SYSIN
//* PEND
COPY FILE
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//prodfile DD DSN=comppin.data,DISP=SHR
//testfile DD DSN=compout.data,DISP=(NEW,CATLG,DELETE),
// SPACE=(TRK,(1,1),RLSE),UNIT=SYSDA,
// DCB=REF=*.prodfile
//SYSIN DD *
*********************************************
* BENCH COMMANDS START HERE *
*********************************************
copyloop READ prodfile. *copy
WRITE testfile FROM prodfile. *records
GOTO copyloop. *
/*
//
DESCRIPTION Copy one file.
INPUTS DDNAME Prodfile as input.
OUTPUTS Testfile created in this job.
PROCESS STEPS Read the production file.
Write the output file.
DCB information supplied by the JCL REF= method allows the output to becopied without
needing to know the input's DCB definition
COPY AND REBLOCK FILES
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//prodfile DD DSN=comppin.data,DISP=SHR,
// DCB=(LRECL=214,BLKSIZE=4280,RECFM=FB)
//testfile DD DSN=compout.data,DISP=(NEW,CATLG,DELETE),
// SPACE=(TRK,(1,1),RLSE),UNIT=SYSDA,
// DCB=(LRECL=214,BLKSIZE=2140,RECFM=FB)
//SYSIN DD *
*********************************************
* BENCH COMMANDS START HERE *
*********************************************
copyloop READ prodfile. *copy
WRITE testfile FROM prodfile. *records
GOTO copyloop. *
/*
//
DESCRIPTION Copy and Reblock a file.
INPUTS Production file is defined in system catalog.
OUTPUTS Test file created in this job.
PROCESS STEPS Read the production file.
Write the output file. (DCB information is defined in the JCL).
COPY AND CHANGE RECORD SIZE
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//prodfile DD DSN=comppin.data,DISP=SHR,
// DCB=(LRECL=214,BLKSIZE=4280,RECFM=FB)
//testfile DD DSN=compout.data,DISP=(NEW,CATLG,DELETE),
// SPACE=(TRK,(1,1),RLSE),UNIT=SYSDA,
// DCB=(LRECL=56,BLKSIZE=5600,RECFM=FB)
//SYSIN DD *
*********************************************
* BENCH COMMANDS START HERE *
*********************************************
copyloop READ prodfile. *copy
WRITE testfile FROM prodfile. *records
GOTO copyloop. *
/*
//
DESCRIPTION Copy and Change the record size.
INPUTS Production file is defined in system catalog.
OUTPUTS Test file created in this job.
PROCESS STEPS Read the production file.
Record truncates from 214 bytes to 56 bytes using the write verb.
Write the output file. (DCB information is defined in the JCL).
** Also see Sample 33 for expanding records.
COPY MULTIPLE FILES
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//prodfile DD DSN=comppin.data,DISP=SHR
//test01 DD DSN=test01.data,DISP=(NEW,CATLG,DELETE),
// SPACE=(TRK,(1,1),RLSE),UNIT=SYSDA,
// DCB=(LRECL=80,BLKSIZE=12960,RECFM=FB)
//test02 DD DSN=test02.data,DISP=(NEW,CATLG,DELETE),
// SPACE=(TRK,(1,1),RLSE),UNIT=SYSDA,
// DCB=(LRECL=80,BLKSIZE=12960,RECFM=FB)
//test03 DD DSN=test03.data,DISP=(NEW,CATLG,DELETE),
// SPACE=(TRK,(1,1),RLSE),UNIT=SYSDA,
// DCB=(LRECL=80,BLKSIZE=12960,RECFM=FB)
//test04 DD DSN=test04.data,DISP=(NEW,CATLG,DELETE),
// SPACE=(TRK,(1,1),RLSE),UNIT=SYSDA,
// DCB=(LRECL=80,BLKSIZE=12960,RECFM=FB)
//test05 DD DSN=test05.data,DISP=(NEW,CATLG,DELETE),
// SPACE=(TRK,(1,1),RLSE),UNIT=SYSDA,
// DCB=(LRECL=80,BLKSIZE=12960,RECFM=FB)
//SYSIN DD *
*********************************************
* BENCH COMMANDS START HERE *
*********************************************
copyloop READ prodfile. *read prod
WRITE test01 FROM prodfile. *write test01
WRITE test02 FROM prodfile. *write test02
WRITE test03 FROM prodfile. *write test03
WRITE test04 FROM prodfile. *write test04
WRITE test05 FROM prodfile. *write test05
GOTO copyloop. *loop
DESCRIPTION Copy and create five new test files.
INPUTS Production file is defined in system catalog.
OUTPUTS Test file 01 created in this job.
Test file 02 created in this job.
Test file 03 created in this job.
Test file 04 created in this job.
Test file 05 created in this job.
PROCESS STEPS Read the production file.
Write the output file. (DCB information is defined in the JCL).
COPY AND CHANGE RECORD FORMAT VB TO FB
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//prodfile DD DSN=comppin.data,DISP=SHR,
// DCB=(LRECL=14,BLKSIZE=6000,RECFM=VB)
//testfile DD DSN=compout.data,DISP=(NEW,CATLG,DELETE),
// SPACE=(TRK,(1,1),RLSE),UNIT=SYSDA,
// DCB=(LRECL=10,BLKSIZE=1000,RECFM=FB)
//SYSIN DD *
*********************************************
* BENCH WORK AREA DEFINES *
*********************************************
rec+4 DEFINES (F=prodfile,P=5,L=10)
rechold DEFINES (F=WORKAREA,P=1,L=10)
*********************************************
* BENCH COMMANDS START HERE *
*********************************************
copyloop READ prodfile. *read prod
MOVEX rec+4 TO rechold. *move rec offset 4
WRITE testfile FROM WORKAREA. *write from work
GOTO copyloop. *loop for more
/*
//
DESCRIPTION Copy and change the record format.
INPUTS Production file is defined in system catalog.
OUTPUTS Test file created in this job.
PROCESS STEPS Read the production file.
Move record from work.
Note: The MOVEX verb is used because most VB records will not be the full LRECL
size.
MOVEX reduces the sending field length automatically to the end of the logical record.
Write the output file. (DCB information is defined in the JCL).
COPY AND CHANGE RECORD FORMAT FB TO VB
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//prodfile DD DSN=comppin.data,DISP=SHR,
// DCB=(LRECL=10,BLKSIZE=1000,RECFM=FB)
//testfile DD DSN=compout.data,DISP=(NEW,CATLG,DELETE),
// SPACE=(TRK,(1,1),RLSE),UNIT=SYSDA,
// DCB=(LRECL=14,BLKSIZE=6000,RECFM=VB)
//SYSIN DD *
*********************************************
* BENCH WORK AREA DEFINES *
*********************************************
rechold DEFINES (F=WORKAREA,P=5,L=10)
rec DEFINES (F=prodfile,P=1,L=10)
rdwhold DEFINES (F=WORKAREA,P=1,L=4)
length DEFINES X'000E0000'
*********************************************
* BENCH COMMANDS START HERE *
*********************************************
copyloop READ prodfile. *read prod
MOVE rec TO rechold. *move rec offset 4
MOVE length TO rdwhold. *set rdw length
WRITE testfile FROM WORKAREA. *copy records
GOTO copyloop. *loop for more
/*
//
DESCRIPTION Copy and change the record format from FB to VB.
INPUTS Production file is defined in system catalog.
OUTPUTS Test file created in this job.
PROCESS STEPS Read the production file.
Move to hold.
Write the output file. (DCB information is defined in the JCL).
Also see Sample 67.......
COPY ONLY SELECTED RECORDS
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//prodfile DD DSN=comppin.data,DISP=SHR
//testfile DD DSN=compout.data,DISP=(NEW,CATLG,DELETE),
// SPACE=(TRK,(1,1),RLSE),UNIT=SYSDA,
// DCB=(LRECL=14,BLKSIZE=1400,RECFM=FB)
//SYSIN DD *
*********************************************
* BENCH WORK AREA DEFINES *
*********************************************
rectype DEFINES (F=prodfile,P=1,L=2)
*********************************************
* BENCH COMMANDS START HERE *
*********************************************
copyloop READ prodfile *read prod
IF rectype EQUAL C'70' *if record type 70
PERFORM putrec. * yes-do routine
IF rectype EQUAL C'89' *if record type 89
PERFORM putrec. * yes-do routine
IF rectype EQUAL C'14' *if record type 14
PERFORM putrec. * yes-do routine
GOTO copyloop. *loop for more
putrec PRINT prodfile. *print record
WRITE testfile FROM prodfile. *output it
RETURN. *exit perform
/*
//
DESCRIPTION Read and select only record types "70", "89",or "14" from the Production file.
INPUTS Production file is defined in system catalog.
OUTPUTS Test file created in this job.
PROCESS STEPS Read the production file.
Test for record type.
If correct type, perform write the output file.
COPY AND REMOVE SELECTED RECORDS
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//prodfile DD DSN=comppin.data,DISP=SHR
//testfile DD DSN=compout.data,DISP=(NEW,CATLG,DELETE),
// SPACE=(TRK,(1,1),RLSE),UNIT=SYSDA,
// DCB=(LRECL=14,BLKSIZE=1400,RECFM=FB)
//SYSIN DD *
*********************************************
* BENCH WORK AREA DEFINES *
*********************************************
rectype DEFINES (F=prodfile,P=1,L=2)
*********************************************
* BENCH COMMANDS START HERE *
*********************************************
copyloop READ prodfile *read prod
IF rectype EQUAL C'70' *if record type 70
DELETE prodfile. * yes-mark record
WRITE testfile FROM prodfile. *write out record
GOTO copyloop. *loop for more
/*
//
DESCRIPTION Read and select all record except type"70" from the prodfile. You could have simply issued
a GOTO COPYLOOP to drop the record, but the DELETEwill set statistics for
auditing purposes.
INPUTS Production file is defined in system catalog.
OUTPUTS Test file created in this job.
PROCESS STEPS Read the production file.
Test for record type.
Delete type "70" types.
Write the output file (DCB information is defined in the JCL).
COPY AND REMOVE SELECTED RECORDS
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//prodfile DD DSN=comppin.data,DISP=SHR
//testfile DD DSN=compout.data,DISP=(NEW,CATLG,DELETE),
// SPACE=(TRK,(1,1),RLSE),UNIT=SYSDA,
// DCB=(LRECL=14,BLKSIZE=1400,RECFM=FB)
//SYSIN DD *
*********************************************
* BENCH WORK AREA DEFINES *
*********************************************
rectype DEFINES (F=prodfile,P=1,L=2)
*********************************************
* BENCH COMMANDS START HERE *
*********************************************
copyloop READ prodfile *read prod
IF rectype EQUAL C'70' *if record type 70
GOTO copyloop. * yes-skip record
WRITE testfile FROM prodfile. *write out record
GOTO copyloop. *loop for more
/*
//
DESCRIPTION Read and select all records except type "70" from theprodfile.
INPUTS Production file is defined in system catalog.
OUTPUTS Test file created in this job.
PROCESS STEPS Read the production file.
Test for record type to skip.
Write the output file (DCB information is defined in the JCL).
COPYAND MODIFY DATA IN RECORDS
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//prodfile DD DSN=comppin.data,DISP=SHR
//testfile DD DSN=compout.data,DISP=(NEW,CATLG,DELETE),
// SPACE=(TRK,(1,1),RLSE),UNIT=SYSDA,
// DCB=(LRECL=14,BLKSIZE=1400,RECFM=FB)
//SYSIN DD *
*********************************************
* BENCH WORK AREA DEFINES *
*********************************************
date DEFINES (F=prodfile,P=8,L=6)
*********************************************
* BENCH COMMANDS START HERE *
*********************************************
copyloop READ prodfile *read prod
MOVE '830112' TO date. *Modify date on record
WRITE testfile FROM prodfile. *write out record
GOTO copyloop. *loop for more
/*
//
DESCRIPTION Read and modify all records to change date.
INPUTS Production file is defined in system catalog.
OUTPUTS Test file created in this job.
PROCESS STEPS Read the production file.
Modify date.
Write the output file (DCB information is defined in the JCL).
COPY AND MODIFY DATA IN SELECTED RECORDS
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//prodfile DD DSN=comppin.data,DISP=SHR
//testfile DD DSN=compout.data,DISP=(NEW,CATLG,DELETE),
// SPACE=(TRK,(1,1),RLSE),UNIT=SYSDA,
// DCB=(LRECL=14,BLKSIZE=1400,RECFM=FB)
//SYSIN DD *
*********************************************
* BENCH WORK AREA DEFINES *
*********************************************
date DEFINES (F=prodfile,P=8,L=6)
*********************************************
* BENCH COMMANDS START HERE *
*********************************************
copyloop READ prodfile *read prod
IF (F=prodfile,P=1,L=2) = '70' *if record type found
MOVE '830112' TO date. * yes-Modify date on record
WRITE testfile FROM prodfile. *write out record
GOTO copyloop. *loop for more
/*
//
DESCRIPTION Read and modify only "70" record types.
INPUTS Production file is defined in system catalog.
OUTPUTS Test file created in this job.
PROCESS STEPS Read the production file.
Modify date if the correct type.
Write the output file (DCB information is defined in the JCL).
COPY WITH LIMIT COUNT
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//prodfile DD DSN=comppin.data,DISP=SHR
//testfile DD DSN=compout.data,DISP=(NEW,CATLG,DELETE),
// SPACE=(TRK,(1,1),RLSE),UNIT=SYSDA,
// DCB=(LRECL=14,BLKSIZE=1400,RECFM=FB)
//SYSIN DD *
*********************************************
* BENCH WORK AREA DEFINES *
*********************************************
limit DEFINES C'120'
*********************************************
* BENCH COMMANDS START HERE *
*********************************************
copyloop READ prodfile *read prod
IF COUNTIN OF prodfile > limit *if enough records read
GOTO EOJ. * yes-end job
WRITE testfile FROM prodfile. *write out record
GOTO copyloop. *loop for more
/*
//
DESCRIPTION Copy 120 records to the test file. The IF statement automaticallyconverts the numeric values
for comparision. Countin is a 4 byte packed fieldand Limit is defined as character display for
3 bytes in this example.
INPUTS Production file is defined in system catalog.
OUTPUTS Test file created in this job.
PROCESS STEPS Read the production file.
Test for limit.
Write the output file (DCB information is defined in the JCL).
PRINT A FILE
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//prodfile DD DSN=comppin.data,DISP=SHR
//testfile DD DSN=compout.data,DISP=(NEW,CATLG,DELETE),
// SPACE=(TRK,(1,1),RLSE),UNIT=SYSDA,
// DCB=(LRECL=14,BLKSIZE=1400,RECFM=FB)
//SYSIN DD *
*********************************************
* BENCH WORK AREA DEFINES *
*********************************************
limit DEFINES C'120'
*********************************************
* BENCH COMMANDS START HERE *
*********************************************
prtloop READ prodfile *read prod
IF COUNTIN OF prodfile > limit *if enough records read
GOTO EOJ. * yes-end job
PRINT prodfile. *character print
GOTO prtloop. *loop for more
/*
//
DESCRIPTION Print 120 records to the test file.
INPUTS Production file is defined in system catalog.
OUTPUTS Test file created in this job.
PROCESS STEPS Read the production file.
Test for limit.
Print the records on the BENCHR02 report.
RECORD VERTICAL DUMP
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//prodfile DD DSN=comppin.data,DISP=SHR
//SYSIN DD *
*********************************************
* BENCH WORK AREA DEFINES *
*********************************************
limit DEFINES C'120'
*********************************************
* BENCH COMMANDS START HERE *
*********************************************
prtloop READ prodfile *read prod
IF COUNTIN OF prodfile > limit *if enough records read
GOTO EOJ. * yes-end job
DUMP prodfile. *dump print the records
GOTO prtloop. *loop for more
/*
//
DESCRIPTION Dump 120 records to the test file.
INPUTS Production file is defined in system catalog.
OUTPUTS Test file created in this job.
PROCESS STEPS Read the production file.
Test for limit.
Dump the records on the BENCHR03 report.
RECORD HORIZONTAL DUMP
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//prodfile DD DSN=comppin.data,DISP=SHR
//SYSIN DD *
*********************************************
* BENCH WORK AREA DEFINES *
*********************************************
limit DEFINES C'120'
*********************************************
* BENCH COMMANDS START HERE *
*********************************************
prtloop READ prodfile *read prod
IF COUNTIN OF prodfile > limit *if enough records read
GOTO EOJ. * yes-end job
DUMPH prodfile. *dump the records
GOTO prtloop. *loop for more
/*
//
DESCRIPTION Dump 120 records to the test file.
INPUTS Production file is defined in system catalog.
OUTPUTS Test file created in this job.
PROCESS STEPS Read the production file.
Test for limit.
Dump the records on the BENCHR04 report.
SELECTIVELY PRINT, DUMP, AND COPY FILES
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//prodfile DD DSN=comppin.data,DISP=SHR
//testfile DD DSN=compout.data,DISP=(NEW,CATLG,DELETE),
// SPACE=(TRK,(1,1),RLSE),UNIT=SYSDA,
// DCB=(LRECL=14,BLKSIZE=1400,RECFM=FB)
//SYSIN DD *
*********************************************
* BENCH WORK AREA DEFINES *
*********************************************
rectype DEFINES (F=prodfile,P=1,L=2)
*********************************************
* BENCH COMMANDS START HERE *
*********************************************
copyloop READ prodfile. *read prod
IF rectype EQUAL '70' *if type 70
PRINT prodfile * yes-print it
WRITE testfile FROM prodfile * yes-copy it
GOTO copyloop. * yes-loop
IF rectype EQUAL '50' *if type 50
PRINT prodfile * yes-print it
WRITE testfile FROM prodfile * yes-copy file
GOTO copyloop. * yes-loop
DUMP prodfile. *dump unknowns
GOTO copyloop. *loop for more
/*
//
DESCRIPTION Select 70 and 50 type records. Dump unknowns.
INPUTS Production file is defined in system catalog.
OUTPUTS Test file created in this job.
PROCESS STEPS Read the production file.
Test for record types 70 and 50 for print and copy.
Dump unknown types.
COMPARE TEST FILES BEFORE AND AFTER
&nb p;
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//before DD DSN=testin.data,DISP=SHR
//after DD DSN=testout.data,DISP=SHR
//SYSIN DD *
*********************************************
* BENCH COMMANDS START HERE *
*********************************************
readloop READ before. *read the before file
READ after. *read the after file
COMPARE before TO after. *compare files
GOTO readloop. *loop for more
/*
//
DESCRIPTION Compare entire files for records that have changed. This exampleassumes the same record
count and order. Refer to other examples in this sectionfor unequal record counts.
INPUTS Test file before process
OUTPUTS Test file after update process.
PROCESS STEPS Read before and after files.
Compare records.
Dump the two records on BENCHR05 if different.
SYNC FILES TO GET MATCH TEST DATA
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//policy DD DSN=policy.data,DISP=SHR
//billing DD DSN=billing.data,DISP=SHR
//rates DD DSN=rates.data,DISP=SHR
//txns DD DSN=txns.data,DISP=SHR
//polsel DD DSN=testpol.data,DISP=(NEW,CATLG,DELETE),
// SPACE=(TRK,(1,1)),UNIT=SYSDA,
// DCB=(LRECL=2000,RECFM=VB,BLKSIZE=19076)
//billsel DD DSN=testbill.data,DISP=(NEW,CATLG,DELETE),
// SPACE=(TRK,(1,1)),UNIT=SYSDA,
// DCB=(LRECL=56,RECFM=FB,BLKSIZE=5600)
//ratesel DD DSN=testrate.data,DISP=(NEW,CATLG,DELETE),
// SPACE=(TRK,(1,1)),UNIT=SYSDA,
// DCB=(LRECL=114,RECFM=FB,BLKSIZE=1400)
//transel DD DSN=testtxns.data,DISP=(NEW,CATLG,DELETE),
// SPACE=(TRK,(1,1)),UNIT=SYSDA,
// DCB=(LRECL=80,RECFM=FB,BLKSIZE=12960)
//SYSIN DD *
*********************************************
* BENCH WORK AREA DEFINES *
*********************************************
polin DEFINES (F=policy,P=1,L=10)
billin DEFINES (F=billing,P=1,L=10)
ratein DEFINES (F=rates,P=1,L=10)
txnin DEFINES (F=txns,P=3,L=10)
pol# DEFINES C'A005698300'
readloop SYNC polin - *sync policy
billin - * billing file
ratein - * rate
txnin. * transactions
IF polin NOT EQUAL pol# *if skip others
GOTO readloop. * yes-get next group
IF polin = billin *use if statements to
IF billin = ratein *insure all records are
IF ratein = txnin *available.
WRITE polsel policy *copy to test
WRITE ratesel rates *copy to test
WRITE billsel billing *copy to test
WRITE txnsel txns *copy to test
GOTO EOJ. *process done
DESCRIPTION Match all needed files to run a test on policy #A065098.
INPUTS Test files policy, billing, rates, txns.
OUTPUTS Selected mini file for the given policy number.
PROCESS STEPS Read and sync all files. Records are made available forprocessing
in groups of matched keys.
"IF" statements will only process on records that are available.The
statements will insure we have made a good selection of all files.
Copy all needed files.
SYNC FILES FOR A MERGE
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//testpol1 DD DSN=group1.data,DISP=SHR
//testpol2 DD DSN=group2.data,DISP=SHR
//polmerg DD DSN=mergpol.data,DISP=(NEW,CATLG,DELETE),
// SPACE=(TRK,(1,1)),UNIT=SYSDA,
// DCB=(LRECL=2000,RECFM=VB,BLKSIZE=19076)
//SYSIN DD *
*********************************************
* BENCH WORK AREA DEFINES *
*********************************************
pol1 DEFINES (F=testpol1,P=1,L=10)
pol2 DEFINES (F=testpol2,P=1,L=10)
*********************************************
* BENCH COMMANDS START HERE *
*********************************************
mergloop SYNC pol1 - *sync policy test 1
pol2. * policy test 2
WRITE polmerg FROM testpol1. *write out if available
WRITE polmerg FROM testpol2. *write out if available
GOTO mergloop. *loop for more
/*
//
DESCRIPTION Merge all files and write to output.
INPUTS Pre-sorted day1 and day2 policy files
OUTPUTS Merged file of day1 and day2 combined.
PROCESS STEPS Read and sync all files. Records are made available forprocessing in groups of matched keys
(some groups will only contain 1 filerecord).
The write statements will only process on those files that have a recordavailable.
The result is a merged file.
Loop for more.
SYNC FILES TO MODIFY DATA
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//prodpol DD DSN=policy.data(0),DISP=SHR
//polfix DD DSN=patch.data,DISP=SHR
//newprod DD DSN=policy.data(+1),DISP=(NEW,CATLG,DELETE),
// SPACE=(TRK,(1,1)),UNIT=SYSDA,
// DCB=(LRECL=2000,RECFM=VB,BLKSIZE=19076)
//SYSIN DD *
*********************************************
* BENCH WORK AREA DEFINES *
*********************************************
poldate DEFINES (F=prodpol,P=23,L=6)
date DEFINES P'0831231'
prod DEFINES (F=prodpol,P=1,L=10)
fix DEFINES (F=polfix,P=1,L=10)
readloop SYNC prod, fix. *sync policy production
MOVE date TO poldate. *if prod file available
IF prod EQUAL fix *if the two files matched
WRITE newprod FROM polfix *write out fixed record
DELETE prodpol. *set prod rec as deleted
WRITE newprod FROM prodpol. *write out if available
GOTO readloop. *loop for more
DESCRIPTION Sync the production and patched records. Patched records willreplace the production
records. For unmatched production records, the lastprocessed date will be modified. This
example assumes both files are pre-sortedby the key and a one-to-one relationship exists. For
one-to-many key matchingsee Sample 88.
INPUTS Production and the patched policy files.
OUTPUTS New production file with data modified.
PROCESS STEPS- Read and sync all files. Records are made available forprocessing in groups of matched
keys (some groups will only contain 1 filerecord). The move statement will only process on
those files having a recordavailable. If prod and fixed files are matching, the new record will
be writtenout.
-The production record will be marked as deleted.
-Write out non-matching prod records.
-Loop for more.
SYNC FILES TO REMOVE UNMATCHED RECORDS
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//policy DD DSN=policy.data(0),DISP=SHR
//ctlcard DD DSN=card.data,DISP=SHR
//testpol DD DSN=testpol.data,DISP=(NEW,CATLG,DELETE),
// SPACE=(TRK,(1,1)),UNIT=SYSDA,
// DCB=(LRECL=2000,RECFM=VB,BLKSIZE=19076)
//SYSIN DD *
*********************************************
* BENCH WORK AREA DEFINES *
*********************************************
prod DEFINES (F=policy,P=1,L=10)
ctl DEFINES (F=ctlcard,P=1,L=10)
*********************************************
* BENCH COMMANDS START HERE *
*********************************************
readloop SYNC prod - *sync policy production
ctl. * control cards
IF prod EQUAL ctl *if the two files matched
WRITE testpol FROM policy. * yes-write it out
GOTO readloop. *loop for more
/*
//
DESCRIPTION Sync the production with control cards to drop all unmatched.
INPUTS Production and the control cards.
OUTPUTS New test file.
PROCESS STEPS Read and sync all files. Records are made available forprocessing in groups of matched keys
(some groups will only contain 1 filerecord).
The "IF" statement will only process on those files that have arecord available.
Loop for more.
Should file have multiple records with the same key, they will be skipped. Toavoid skipping
add a move of the key to work and duplicate the IF and WRITEstmts testing on the
WORKAREA hold key.
SYNC FILES TO PRINT MATCHED SETS
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//policy DD DSN=policy.data,DISP=SHR
//billing DD DSN=billing.data,DISP=SHR
//rates DD DSN=rates.data,DISP=SHR
//txns DD DSN=txns.data,DISP=SHR
//SYSIN DD *
*********************************************
* BENCH WORK AREA DEFINES *
*********************************************
polin DEFINES (F=policy,P=1,L=10)
billin DEFINES (F=billing,P=1,L=10)
ratein DEFINES (F=rates,P=1,L=10)
txnin DEFINES (F=txns,P=3,L=10)
*********************************************
* BENCH COMMANDS START HERE *
*********************************************
readloop SYNC polin - *sync policy
billin - * billing file
ratein - * rate
txnin. * transactions
PRINT policy. *Print policy
PRINT billing. *Print billing record
PRINT rates. *Print rate record
PRINT txns. *Print transaction
GOTO readloop. *loop for more
/*
//
DESCRIPTION Print file records groups.
INPUTS Test files policy, billing, rates, txns
OUTPUTS Print all groups.
PROCESS STEPS Read and sync all files. Records are made available forprocessing in groups of matched
keys.
Print the record group.
SYNC FILES TO COMPARE RECORDS
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//policy DD DSN=policy.data,DISP=SHR
//testin DD DSN=tstfile.data,DISP=SHR
//SYSIN DD *
*********************************************
* BENCH WORK AREA DEFINES *
*********************************************
prodpol DEFINES (F=policy,P=1,L=10)
testpol DEFINES (F=testin,P=1,L=10)
*********************************************
* BENCH COMMANDS START HERE *
*********************************************
readloop SYNC prodpol - *sync policy
testpol. * test policy
COMPARE policy TO testin. *compare the records.
GOTO readloop. *loop for more
/*
//
DESCRIPTION Compare all file records
INPUTS Policy files Prod and test,
OUTPUTS Compare report on differences.
PROCESS STEPS Read and sync all files. Records are made available forprocessing in groups of matched
keys.
Compare records and indicate adds and deletes in the file.
GENERATE TEST DATA RECORDS
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//janbill DD DSN=janbill.data,DISP=(NEW,CATLG,DELETE),
// SPACE=(TRK,(1,1),UNIT=SYSDA,
// DCB=(LRECL=56,RECFM=FB,BLKSIZE=5600)
//SYSIN DD *
*********************************************
* BENCH WORK AREA DEFINES *
*********************************************
billrec DEFINES (F=WORKAREA,P=1,L=56)
rec-id DEFINES (F=WORKAREA,P=1,L=2)
pol-num DEFINES (F=WORKAREA,P=3,L=10)
date DEFINES (F=WORKAREA,P=13,L=6)
amount DEFINES (F=WORKAREA,P=19,L=4)
LOOP MOVE ' ' TO billrec. *space out the entire rec
MOVE '43' TO rec-id. *set record id
MOVE '12A0007563' TO pol-num. *set policy number
MOVE '830115' TO date. *set date
MOVE P'0017631' TO amount. *set amount
WRITE janbill FROM WORKAREA. *create january bill card
IF COUNTOUT OF janbill > '50' *if limit reached
GOTO EOJ. * yes-stop run
GOTO loop. *Loop until limit hit
/*
//
DESCRIPTION Create a January billing card for testing.
INPUTS Production billing file to get work area
OUTPUTS Generated billing card.
PROCESS STEPS Because no read has occurred the job will loop until manuallyshut off with the count limit.
Blank out the work area (move will blank fill if moving a short data elementto a larger
element).
Move in all data needed from constants.
Write out the record from the Workarea.
GENERATE CONTROL CARDS FROM A REPORT
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//report DD DSN=errors.data,DISP=SHR,
// DCB=(LRECL=133,RECFM=FB,BLKSIZE=1330)
//ctlcards DD DSN=select.data,DISP=(NEW,CATLG,DELETE),
// SPACE=(TRK,(5,1)),UNIT=SYSDA,
// DCB=(LRECL=80,RECFM=FB,BLKSIZE=12960)
//SYSIN DD *
*********************************************
* BENCH WORK AREA DEFINES *
*********************************************
program DEFINES (F=report,P=110,8)
select DEFINES C' SELECT MEMBER='
member DEFINES (F=report,P=21,L=8)
rest DEFINES (F=report,P=28,L=105)
*********************************************
* BENCH COMMANDS START HERE *
*********************************************
readloop READ report. *read expiration
MOVE select TO (F=report,P=1,L=20 *move control card verbs
MOVE program TO member. *move in program name
MOVE ' ' TO rest. *blank out to col 80
WRITE ctlcard FROM report. *write out 80 bytes
GOTO readloop. *loop for more
/*
//
DESCRIPTION Create control cards from an expiration report.
INPUTS Expiration report on disk.
OUTPUTS Generated control cards for IEBCOPY utility
PROCESS STEPS Read Expiration report line.
Build a control card using the program name from the report line.
Write out the built record.
SCAN A FILE FOR VALUES IN ANY POSITION
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//billdata DD DSN=billing.data,DISP=SHR
//SYSIN DD *
*********************************************
* BENCH WORK AREA DEFINES *
*********************************************
date DEFINES p'+831231'
acct# DEFINES C'12345789'
count DEFINES X'000001C3'
*********************************************
* BENCH COMMANDS START HERE *
*********************************************
readloop READ billdata. *read file
SCAN billdata FOR date. *search for process date
SCAN billdata FOR acct#. *search for account num
SCAN billdata FOR count. *search for binary letter
SCAN billdata FOR C'ABCDEF' *search for values
GOTO readloop. *loop for more
/*
//
DESCRIPTION Read input file and scan for values.
INPUTS Billing file on disk.
OUTPUTS BENCHR01 report on only "hits" of scan.
PROCESS STEPS Read Billing file.
Search for values requested.
Prints automatically on R01 report records found with the values.
SCAN/REPLACE DATA ON A FILE
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//filein DD DSN=balance.control.file,DISP=SHR
//fileout DD DSN=fixed.balance.control.file,DISP=(,CATLG,DELETE),
// DCB=(RECFM=FB,LRECL=10000,BLKSIZE=10000),
// UNIT=SYSDA,SPACE=(BLK,(1))
//SYSIN DD *
*********************************************
* BENCH COMMANDS START HERE *
* THIS FILE HAS ONLY ONE RECORD BUT MULTIPLE*
* +43 AND +5 BALANCE CONTROL COUNTS TO CLEAR*
*********************************************
count DEFINES (F=filein,L=2,P=LOC) *CLEARING FIELD
count1 DEFINES (F=filein,L=1,P=2889) *CLEARING FIELD
count2 DEFINES (F=filein,L=2,P=3898) *CLEARING FIELD
READ filein. *read old bal cntl file
PRINT filein. *print before image
MOVE X'0C' TO count1 *clear count
MOVE X'000C' TO count2 *clear count
loop SCANTEST filein FOR X'043C' *find packed count
IF SCANHIT OF filein = 'Y' *if scan found
MOVE X'000C' TO count * yes=clear count
GOTO loop. *loop for more fields
SCANTEST filein FOR X'005C' *find packed count
IF SCANHIT OF filein = 'Y' *if scan found
MOVE X'000C' TO count * yes=clear count
GOTO loop. *loop for more fields
WRITE fileout FROM filein. *write rec out
GOTO EOJ. *stop run
//
DESCRIPTION Read input file and scan/replace values.
INPUTS Balance Control File.
OUTPUTS BENCHR02 report prints before & after images.
PROCESS STEPS Read file.
Search for values and set location pointer.
Replace value using the MOVE verb and P=LOC which points to the startinglocation of the
scan value.
SCAN PROCLIB FOR A PROGRAM
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//procin DD DSN=prod.proclib,DISP=SHR
//SYSIN DD *
*********************************************
* BENCH COMMANDS WHERE IS PGM USED? *
*********************************************
loop READPDS procin FOR ft****** . *read all "FT" jobs
SCAN procin FOR 'FDS040' . *scan & print hits- member
GOTO loop. *name appear on R02 report
/*
//
DESCRIPTION Read pds file, each record in each "FT" member.
INPUTS Prod proclib.
OUTPUTS BENCHR02 report prints hits with member names.
PROCESS STEPS Read file member records.
Search for values and print if found.
SCAN/REPLACE A TEST DATA LIBRARY
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//filein DD DSN=system.test.level4.test.cases,DISP=SHR
//fileout DD DSN=system.test.level4.updte.cases,DISP=(,CATLG,DELETE),
// DCB=(LRECL=80,RECFM=FB,BLKSIZE=6000),
// UNIT=SYSDA,SPACE=(TRK,(5,5,10),RLSE)
//SYSIN DD *
*********************************************
* BENCH COMMANDS *
*********************************************
issue DEFINES 'AAF' *stock issue
oldprice DEFINES '4000' *old value
newprice DEFINES '0400' *new value
price DEFINES (F=FILEIN,L=4,P=LOC) *replace spot
loop READPDS filein FOR L4*JAN** . *read level4 jan cases
SCANTEST filein FOR issue. *find issue
IF SCANHIT OF filein = 'Y' *if found
SCANTEST filein FOR oldprice *scan for price
IF SCANHIT filein FOR 'Y' *if found
PRINT filein *print before
MOVE newprice to price *replace data
PRINT filein. *print after
WRITEPDS fileout FROM filein. *write out record
GOTO loop. *get more
DESCRIPTION System test cases need prices updated on issue AAF.
INPUTS System test case library level4 cases.
OUTPUTS New output case library.
PROCESS STEPS Read file member reocrds.
Search for values and replace prices.
Note: Output file name and input file may be the same, butdisp=old should be used to avoid other users from updating at the same time. Ifsomeone does update while you are updating, a directory crash will occur. Thebest advice is to always create new or back up the input before processing.
CROSS REFERENCE AN APPLICATION
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//source DD DSN=system.source.pds,DISP=SHR
//SORTWK01 DD UNIT=SYSDA,SPACE=(CYL,(10,10),RLSE)
//SORTWK02 DD UNIT=SYSDA,SPACE=(CYL,(10,10),RLSE)
//SORTWK03 DD UNIT=SYSDA,SPACE=(CYL,(10,10),RLSE)
//SYSIN DD *
*********************************************
* BENCH COMMANDS XREF EXCEPT 900XX *
*********************************************
loop READPDS source FOR ******** . *read all members
IF MENNAME OF source = 'PAC900XX' *if test pgm
DELETE source. * skip it
XREF source. *release record to xref
GOTO loop. *get more
/*
//
DESCRIPTION System wide cross reference with the exclusion of a test programPAC900XX.
INPUTS Cobol or PL1 source statements Sortwk for work files
OUTPUTS Report BENCHR07 XREF.
PROCESS STEPS Read each source statement.
Skip records from the PAC900XX member.
Release to Xref facility to select names with a dash ( - ) or underscore ( _).
At end of job the report will automatically sort all data names and report.
COVERT FIELDS FROM BINARY TO CHARACTER
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//infile DD DSN=system.master,DISP=SHR
//otfile DD DSN=test.master,DISP=(NEW,CATLG),
// DCB=(*.INFILE),
// UNIT=SYSDA,SPACE=(TRK,(5,5),RLSE)
//SYSIN DD *
*********************************************
* BENCH COMMANDS *
*********************************************
flda DEFINES (F=infile,P=7,L=4,T=X) *binary field
fldb DEFINES (F=infile,P=15,L=8,T=P) *packed field
fldxa DEFINES (F=infile,P=76,L=15,T=C) *converted field
fldxb DEFINES (F=infile,P=90,L=15,T=C) *converted field
loop READ infile. *read file
CVTCHAR flda TO fldxa. *reset fld to char
CVTCHAR fldb TO fldxb. *reset fld to char
WRITE otfile FROM infile. *output rec
GOTO loop. *get more
/*
//
DESCRIPTION The input file is read contains a binary and a packed field thatis converted to character
format.
INPUTS Production file
OUTPUTS New file using original file's DCB attributes
PROCESS STEPS Read each record.
Convert the binary into character.
Convert the packed field into character.
Write and loop for more.
READ AND REMOVE DUPLICATE RECORDS
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//infile DD DSN=system.master,DISP=SHR
//otfile DD DSN=test.master,DISP=(NEW,CATLG),
// DCB=(LRECL=100,RECFM=FB,BLKSIZE=6000),
// UNIT=SYSDA,SPACE=(TRK,(5,5),RLSE)
//SYSIN DD *
*********************************************
* BENCH COMMANDS REMOVE DUPLICATES *
*********************************************
recin DEFINES (F=infile,P=1,L=100) *record area
cm# DEFINES (F=infile,P=1,L=3) *record id
holdrec DEFINES (F=WORKAREA,P=1,L=100) *hold rec area
holdcm# DEFINES (F=WORKAREA,P=1,L=3) *hold cm#
loop READ infile. *read file
IF holdcm# NOT = cm# *if hold not = current
MOVE recin TO holdrec * -hold old rec
WRITE otfile FROM infile. * -output 1st rec
GOTO loop. *dup -skip it
/*
//
DESCRIPTION The input file has some duplicate records and we wish to removeall but the first record.
INPUTS Production file
OUTPUTS New file for testing with duplicates dropped.
PROCESS STEPS Read each record.
Test for record key.
If record is not the same as before, output it.
Those that are duplicates will be skipped.
ADD FIELDS INTO THE CENTER OF A RECORD
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//infile DD DSN=system.master,DISP=SHR,
// DCB=(LRECL=200,RECFM=FB,BLKSIZE=6000)
//otfile DD DSN=test.master,DISP=(NEW,CATLG),
// DCB=(LRECL=250,RECFM=FB,BLKSIZE=6000),
// UNIT=SYSDA,SPACE=(TRK,(5,5),RLSE)
//SYSIN DD *
*********************************************
* BENCH COMMANDS INSERT FIELDS *
*********************************************
oldbeg DEFINES (F=infile,P=1,L=100) *1st part
oldend DEFINES (F=infile,P=101,L=125) *end part
wkbeg DEFINES (F=WORKAREA,P=1,L=100) *work 1st part
wkpk1 DEFINES (F=WORKAREA,P=101,L=12) *work new fld
wkfill DEFINES (F=WORKAREA,P=113,L=01) *work filler
wkpk2 DEFINES (F=WORKAREA,P=114,L=12) *work new fld
wkend DEFINES (F=WORKAREA,P=126,L=125) *work end part
pkfill DEFINES X'000C000C000C000C000C000C000C'
loop READ infile. *read file
MOVE oldbeg TO wkbeg. *save begin part
MOVE pkfill TO wkpk1. *init new fields
MOVE ' ' TO wkfill. *clear filler
MOVE pkfill TO wkpk2. *init new fields
MOVE oldend TO wkend. *save end fields
WRITE otfile FROM WORKAREA. *output rec
GOTO loop. *loop for more
DESCRIPTION The input file needs to be stretched in the center with newfields.
INPUTS Production file input.
OUTPUTS New file for testing added fields.
PROCESS STEPS Read each record.
Split record and add fields.
Output new record size from workarea.
SYNC MASTER AND PATCH FILE TO MODIFY REC
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//pos DD DSN=system.master,DISP=SHR
//patch DD DSN=test.patches.data,DISP=SHR
//newpos DD DSN=system.master.new,DISP=(NEW,CATLG),
// DCB=(LRECL=250,RECFM=FB,BLKSIZE=6000),
// UNIT=SYSDA,SPACE=(TRK,(5,5),RLSE)
//SYSIN DD *
*********************************************
* BENCH COMMANDS SYNC PATCH FIELDS *
*********************************************
poskey DEFINES (F=pos,P=3,L=8) *master file seq
poslong DEFINES (F=pos,P=45,L=4) *long quantity
patkey DEFINES (F=patch,P=1,L=8) *patch file seq
patvalue DEFINES (F=patch,P=10,L=4) *patch value
loop SYNC poskey, patkey. *automatic reads
IF poskey = patkey *if match
MOVE patvalue TO poslong. * replace value
WRITE newpos FROM pos. *init new fields
GOTO loop. *loop for more
/*
//
DESCRIPTION The input master file called "Positions" must bepatched on certain records. The Patch file
will contain the matching key and thenew value.
INPUTS Production file input & the patch file.
OUTPUTS New file for with the field replaced.
PROCESS STEPS Sync read both files.
When both files match then replace value.
Output new record.
COMPARE MASTER RECORDS
FOR THOSE ON A CONTROL LIST
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//today DD DSN=system.master(+0),DISP=SHR
//yestd DD DSN=system.master(-1),DISP=SHR
//list DD DSN=test.list,DISP=SHR
//SYSIN DD *
*********************************************
* BENCH COMMANDS SYNC COMPARE LIST *
*********************************************
todaykey DEFINES (F=today,P=1,L=34) *keys
yestdkey DEFINES (F=yestd,P=1,L=34) *
listkey DEFINES (F=list,P=1,L=34) *
loop SYNC todaykey - *automatic reads
yestdkey -
listkey.
IF listkey = todaykey *if matches list
GOTO process. * compare
IF listkey = yestdkey *if matches list
GOTO process. * compare both
GOTO loop. *skip compare
process COMPARE today TO yestd. *compare
GOTO loop.
DESCRIPTION Two master files will compare only those records that are on thecontrol file list.
INPUTS Yesterday and today's master files, and a control list to match keys.
OUTPUTS Compare report.
PROCESS STEPS Sync read all files.
When either file matches do the compare.
Note: By allowing the compare on just one file match you will be able to seeadds and deletes as well as changes.
COMPARE BUT EXCLUDE DATE
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//today DD DSN=system.master(+0),DISP=SHR
//yestd DD DSN=system.master(-1),DISP=SHR
//SYSIN DD *
*********************************************
* BENCH COMMANDS COMPARE BUT EXCLUDE *
*********************************************
todaykey DEFINES (F=today,P=1,L=34) *keys
yestdkey DEFINES (F=yestd,P=1,L=34) *
tdate DEFINES (F=today,P=45,L=6) *date
ydate DEFINES (F=yestd,P=45,L=6) *date
loop SYNC todaykey - *automatic reads
yestdkey
MOVE ' ' TO tdate. *blank out date
MOVE ' ' TO ydate. *blank out date
COMPARE today TO yestd. *compare
GOTO loop.
/*
//
DESCRIPTION Two master files will compare but exclude the date field becausewe blanked them out.
INPUTS Yesterday and today's master files.
OUTPUTS Compare report.
PROCESS STEPS Sync read all files.
Blank out date fields.
Compare the files.
Note: Should a file not be present the MOVE request will automatically beskipped.
COMPARE SELECTED FIELDS
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//today DD DSN=system.master(+0),DISP=SHR
//yestd DD DSN=system.master(-1),DISP=SHR
//SYSIN DD *
*********************************************
* BENCH COMMANDS COMPARE SELECTED FIELDS *
*********************************************
todaykey DEFINES (F=today,P=1,L=10) *keys
yestdkey DEFINES (F=yestd,P=1,L=10) *
yestdcm# DEFINES (F=yestd,P=1,L=2) *id number
todaycm# DEFINES (F=today,P=1,L=2) *id number
todaybeg DEFINES (F=today,P=1,L=10) *start of rec
tdlong DEFINES (F=today,P=11,L=2) *long x'000C' fld
tdshort DEFINES (F=today,P=13,L=2) *short x'000C' fld
todayend DEFINES (F=today,P=14,L=66) *end of record
yestdbeg DEFINES (F=yestd,P=1,L=10) *start of rec
ytlong DEFINES (F=yestd,P=11,L=2) *long x'000C' fld
tyshort DEFINES (F=yestd,P=13,L=2) *short x'000C' fld
yestdend DEFINES (F=yestd,P=14,L=66) *end of record
loop SYNC todaykey - *automatic reads
yestdkey
IF yestdcm# = '54' *if id 54
PERFORM process. * yes-process
IF yestdcm# = '30' *if id 54
PERFORM process. * yes-process
IF todaycm# = '54' *if id 54
PERFORM process. * yes-process
IF todaycm# = '30' *if id 54
PERFORM process. * yes-process
GOTO loop. *
process MOVE ' ' TO todaybeg. *clear fields
MOVE ' ' TO todayend. *
MOVE ' ' TO yestdbeg. *
MOVE ' ' TO yestdend. *
COMPARE today TO yestd. *compare
RETURN. *exit
DESCRIPTION Two master files will compare but only the two "long"and "short" fields will compare.
INPUTS Yesterday and today's master files.
OUTPUTS Compare report.
PROCESS STEPS Sync read all files.
Blank out fields.
Compare the files.
COMPARE QUANTITY HISTORY TRACE
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//file01 DD DSN=system.master(+0),DISP=SHR
//file02 DD DSN=system.master(-1),DISP=SHR
//file03 DD DSN=system.master(-2),DISP=SHR
//file04 DD DSN=system.master(-3),DISP=SHR
.
. (illustration only)
.
//file99 DD DSN=system.master(-98),DISP=SHR
//SYSIN DD *
*********************************************
* BENCH COMMANDS COMPARE TRACE *
*********************************************
key01 DEFINES (F=file01,P=1,L=10) *keys
key02 DEFINES (F=file02,P=1,L=10) *
key03 DEFINES (F=file02,P=1,L=10) *
.
. (illustration only)
.
key99 DEFINES (F=file02,P=1,L=10) *
loop SYNC key01 - *automatic reads
key02 -
key03 - etc...
key99.
MOVE ' ' to (F=file01,P=1,L=74) *clear all but qty
MOVE ' ' to (F=file02,P=1,L=74) *clear all but qty
MOVE ' ' to (F=file03,P=1,L=74) *clear all but qty
MOVE ' ' to (F=file99,P=1,L=74) *clear all but qty
COMPARE file01 TO file02. *compare
COMPARE file02 TO file03. *compare
COMPARE file03 TO file99. *compare
GOTO loop.
DESCRIPTION The input files get their fields blanked out before the staggeredcompares.
INPUTS Up to 99 files used.
OUTPUTS Compare report.
PROCESS STEPS Sync read all files.
Blank out fields.
Compare the files.
PRINT ALL REFERENCES TO A FILE AND ITS PROGRAM
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//lib DD DSN=prod.proclib,DISP=SHR
//SYSIN DD *
*********************************************
* BENCH COMMANDS START HERE *
* PRINT ALL PROCS USING THE BANK FILE AND *
* DISPLAY THE PROGRAM USING IT. *
*********************************************
card DEFINES (F=lib,P=1,L=80) *card area
holdpgm DEFINES (F=WORKAREA,P=1,L=80) *hold pgm area
holdfile DEFINES (F=WORKAREA,P=100,L=80) *hold file name
loop READPDS lib FOR FT******. *read "FT" members
SCANTEST lib FOR ' EXEC '. *
IF SCANHIT OF lib = 'Y' *if exec card
MOVE card TO holdpgm. * y-save pgm card
SCANTEST lib FOR 'DC130UR.NDC030.BANK'.
IF SCANHIT OF lib = 'Y' *if file found
MOVE card TO holdfile * y-save file
MOVE holdpgm TO card * -reset for print
PRINT lib * -print pgm name
MOVE holdfile TO card * -reset file card
PRINT lib. * -print file
GOTO loop. *loop
DESCRIPTION This sample will produce a quick display of the file we aresearching for with its program
name using it.
INPUTS Production procedure library.
OUTPUTS BENCHR02 report prints.
PROCESS STEPS Read each member record.
Search and save each EXEC card.
Search for file and when found print the previously save exec card print thefile card.
Loop until the library is done.
SCAN PROCLIB FOR FILE, PRINTING PGM & PROC WHEN FOUND
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//BENCHR08 DD DUMMY,DCB=BLKSIZE=133
//lib DD DSN=prod.proclib,DISP=SHR
//display DD SYSOUT=*,(LRECL=80,RECFM=FBA,BLKSIZE=6000)
//SYSIN DD *
*********************************************
* BENCH COMMANDS START HERE *
* PRINT ALL PROCS USING THE BANK FILE AND *
* DISPLAY THE PROGRAM USING IT. *
*********************************************
workmemp DEFINES (F=WORKAREA,P=8,L=8) *prt member name
workpgm DEFINES (F=WORKAREA,P=20,L=8) *save prog name
worklit DEFINES (F=WORKAREA,P=2,L=32) *prt literal
workval DEFINES (F=WORKAREA,P=34,L=40) *prt scan value
workmem DEFINES (F=WORKAREA,P=200,L=8) *save member name
scanlit DEFINES C'PROGRAMS (BY PROC) WHICH ACCESS'
scanval DEFINES C'BG000CD.GDC000.BALANCE.CONTROL'
colhdgs DEFINES C' -PROC- -PROGRAM-'
MOVE scanlit TO worklit. *init work titles
MOVE scanval TO workval. *
WRITE display FROM WORKAREA. *
MOVE ' ' TO workval. *
MOVE colhdgs TO worklit. *
WRITE display FROM WORKAREA. *
MOVE ' ' TO workval. *
MOVE ' ' TO worklit. *
loop READPDS lib FOR FT******. *read "FT" members
SCANTEST lib FOR ' PGM='. *if jcl stmt has
IF SCANHIT OF lib = 'Y' * pgm= then save
MOVE (F=lib,P=LOC+4,L=8) TO workpgm.
SCANTEST lib FOR scanval. *if jcl stmt has
IF SCANHIT OF lib = 'Y' * dsn= scanval
IF MEMNAME OF lib NOT = workmem * print members
MOVE MEMNAME OF lib TO workmem * only for 1st
MOVE MEMNAME OF lib TO workmemp * program listed
GOTO CHKPRT. &n sp; *
IF SCANHIT OF lib = 'Y' * otherwise reset
IF MEMNAME OF lib = workmem * print member
MOVE ' ' TO workmemp.
chkprt IF SCANHIT OF lib = 'Y' * print prog name
WRITE display FROM WORKAREA. *
GOTO loop. *loop
//* - - - SAMPLE OUTPUT - - -
//*
//* PROGRAMS (BY PROC) WHICH ACCESS BG000CD.GDC000.BALANCE.CONTROL
//* -PROC- -PROGRAM-
//* BG010CR &GSC210,
//* &GSC220,
//* &GSC230, etc....
DESCRIPTION This sample will produce a quick formatted display of the file weare searching for with its
proc & programs using it.
INPUTS Production procedure library.
OUTPUTS Display file for sysout report.
PROCESS STEPS Read each member record. Search and save each PGM card.
Search for file and when found print the previously saved pgm name print procname if 1st
time.
Loop until the library is done.
READ SEQUENTIAL FILE AND CREATE PDS MEMBERS
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//filein DD DSN=test.load.jcl,DISP=SHR
//lib DD DSN=test.proclib,DISP=SHR
//SYSIN DD *
*********************************************
* BENCH COMMANDS START HERE *
* READ SEQ FILE AND FOR EVERY JOB CARD USE *
* THE JOB NAME TO CREATE A SEPARATE MEMBER *
*********************************************
jobname DEFINES (F=filein,P=3,L=8) *job card //FT???UD
holdname DEFINES (F=WORKAREA,P=1,L=8) *save membername
loop READ filein. *read seq file
SCANTEST filein FOR ' JOB ' *if job card
IF SCANHIT OF filein = 'Y' *
MOVE jobname to holdname. * yes-save name
MOVE holdname TO MEMNAME OF filein. *set membername
WRITEPDS lib FROM filein. *output member rec
GOTO loop. *loop
/*
//
DESCRIPTION This sample loads a pds from a sequential file using the job cardto determine the member
name to set.
INPUTS Sequential file input.
OUTPUTS PDS file out.
PROCESS STEPS Read each record looking for a job card.
When job card found, set the member name.
Write the pds using the seq file as source.
Loop until the library is done.
MERGE ALL MEMBERS TO A SINGLE MEMBER
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//libin DD DSN=test.proclib1,DISP=SHR
//libout DD DSN=test.proclib2,DISP=SHR
//SYSIN DD *
*********************************************
* BENCH COMMANDS START HERE *
* READ PDS FILE AND MERGE ALL MEMBERS INTO *
* ONE MEMBER CALLED "COMBINED" *
*********************************************
loop READPDS libin FOR ********. *read all members
MOVE 'combined' TO MEMNAME OF libin. *reset memname
WRITEPDS libout FROM libin. *output rec
GOTO loop. *loop
/*
//
DESCRIPTION This sample demonstrates the technique to reset the member namewhich will combine
members.
INPUTS PDS file input.
OUTPUTS PDS file out.
PROCESS STEPS Read each record.
Reset input library's member name
Write the member record. Because the name never changes, all the records getcombined.
Loop until the library is done
INSERT A /*ROUTE CARD IN EACH MEMBER
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//libin DD DSN=test.proclib1,DISP=SHR
//libout DD DSN=test.proclib2,DISP=SHR
//SYSIN DD *
*********************************************
* BENCH COMMANDS START HERE *
*********************************************
newcard DEFINES (F=libin,P=1,L=80) *new card area
value DEFINES '/*ROUTE PRINT NEWYORK' *new value
loop READPDS libin FOR ********. *read all members
SCANTEST libin FOR '/*ROUTE XEQ' *if this is a xeq card
IF SCANHIT OF libin = 'Y' *
WRITEPDS libout FROM libin *output xeq
MOVE value to newcard. *set up new card
WRITEPDS libout FROM libin. *output rec
GOTO loop. *loop
/*
//
DESCRIPTION This sample will insert an additional record after each XEQ card.
INPUTS PDS file input.
OUTPUTS PDS file out.
PROCESS STEPS Read each record.
When an XEQ card is found, XEQ card will be written and the new card will beadded.
Loop until the library is done.
DELETE A /*ROUTE CARD IN EACH MEMBER
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//libin DD DSN=test.proclib1,DISP=SHR
//libout DD DSN=test.proclib2,DISP=SHR
//SYSIN DD *
*********************************************
* BENCH COMMANDS START HERE *
*********************************************
loop READPDS libin FOR ********. *read all members
SCANTEST libin FOR '/*ROUTE PRINT' *if this is a print
IF SCANHIT OF libin = 'Y' *
DELETE libin. *set as not available
WRITEPDS libout FROM libin. *output rec
GOTO loop. *loop
/*
//
DESCRIPTION This sample will delete the /*ROUTE PRINT cards by making thoserecords "not
available".
INPUTS PDS file input.
OUTPUTS PDS file out.
PROCESS STEPS Read each record.
Set delete indicator when a PRINT card is found.
Output all active records.
Loop until the library is done.
MASS JCL SCAN
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//libin DD DSN=test.proclib1,DISP=SHR
//reader DD SYSOUT=(A,INTRDR),
// DCB=(LRECL=80,RECFM=FB,BLKSIZE=80)
//SYSIN DD *
*********************************************
* BENCH COMMANDS START HERE *
*********************************************
newcard DEFINES (F=libin,P=1,L=80) *new card area
value DEFINES '// TYPRUN=SCAN, ' *new value
loop READPDS libin FOR ********. *read all members
SCANTEST libin FOR ' JOB ' *if this a job card
IF SCANHIT OF libin = 'Y' *
WRITE reader FROM libin *output xeq
MOVE value to newcard. *set up new card
WRITE reader FROM libin. *output rec
GOTO loop. *loop
/*
//
DESCRIPTION This sample will insert a scan request and then submit the recordto the internal reader.
Sample assumes job cards will have two or more lines.
INPUTS PDS file input.
OUTPUTS The internal reader.
PROCESS STEPS Read each record.
When an JOB card is found, JOB card will be written and the new card will beadded.
Loop until the library is done.
COMPARE CONTROL CARD LIBS
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//prod DD DSN=prod.cntlcard,DISP=SHR
//test DD DSN=test.cntlcard,DISP=SHR
//SYSIN DD *
high DEFINES X'FFFFFFFFFFFFFFFF' *high values
PERFORM readprod. *init reads
PERFORM readtest. *
process IF RECORDSW OF prod = 'Y' *if at end
MOVE high TO MENNAME OF prod. * y-set high values
IF RECORDSW OF test = 'Y' *if at end
MOVE high TO MEMNAME OF test. * y-set high values
IF MEMNAME OF prod = MEMNAME OF test
COMPARE prod TO test *if names match
PERFORM readprod * then compare recs
PERFORM readtest *
GOTO process.
IF MEMNAME OF prod > MEMNAME OF test
DELETE test *if test has more recs
PERFORM readtest * then drop test rec
GOTO process. *
IF MEMNAME OF prod < MEMNAME OF test
DELETE prod *if prod has more recs
PERFORM readprod * then drop prod rec
GOTO process. *
GOTO loop. *loop for more
readprod READPDS prod FOR FT******. *read prod
RETURN.
readtest READPDS test FOR FT******. *read test
RETURN.
DESCRIPTION This routine will compare the two libraries and not only indicatemember differences
but also indicate members missing on either library by thedelete counts (see the stats
report).
INPUTS PDS file input.
OUTPUTS The compare and stats reports.
PROCESS STEPS Read initial records both files.
If the members match compare.
If one member is higher then re-sync.
Loop until the libraries are done.
SEND JCL TO PRINTER WITH PAGE EJECTS
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//libin DD DSN=prod.proclib,DISP=SHR
//display DD SYSOUT=*,DCB=(LRECL=90,RECFM=FBA,BLKSIZE=9000)
//SYSIN DD *
*********************************************
* BENCH COMMANDS START HERE *
*********************************************
prtline DEFINES (F=WORKAREA,P=2,L=89) *print line
prtcc DEFINES (F=WORKAREA,P=1,L=1) *carriage control
prtmem DEFINES (F=WORKAREA,P=74,L=8) *print member name
memwork DEFINES (F=WORKAREA,P=200,L=8) *hold mem name
jclrec DEFINES (F=libin,P=1,L=80) *jcl record
loop READPDS libin FOR ********. *init reads
MOVE ' ' TO prtcc. *clear cc control
IF MEMNAME OF libin NOT = memwork *if new member
MOVE MEMNAME OF libin TO memwork * save name
MOVE '1' TO prtcc. * set page eject
MOVE jclrec TO prtline. *set print detail
MOVE memwork TO prtmem. *set member name
WRITE display FROM libin. *output print line
GOTO loop. *loop for more
/*
//
DESCRIPTION This routine will cause page ejects for each new member started.
INPUTS PDS file input.
OUTPUTS The display sysout.
PROCESS STEPS Read library.
Set page eject when member names change.
Set up detail into workarea making room for cc.
Loop until the libraries are done.
DISPLAY ADDRESS TEXT
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//test DD DSN=test.address.file,DISP=SHR
//SYSIN DD *
*********************************************
* BENCH COMMANDS START HERE *
*********************************************
loop READ test. *read
EXHIBIT (F=test,P=15,L=30) *display address
GOTO loop. *loop
/*
//
DESCRIPTION This sample displays address on R01.
INPUTS Address file.
OUTPUTS BENCHR01 reports addresses.
PROCESS STEPS Read file.
Display field.
Loop until done.
CHECK SPELLING ON TEXT FILE
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//text DD DSN=test.pgmdoc.text,DISP=SHR
//SYSIN DD *
*********************************************
* BENCH COMMANDS START HERE *
*********************************************
loop READPDS text FOR PGM*****. *read "PGM" documents
SPELL text. *check spelling
GOTO loop. *loop
/*
//
DESCRIPTION This sample will produce on R01 all words not found on it'sdictionary.
INPUTS Documentation library.
OUTPUTS BENCHR01 reports misspelled words.
PROCESS STEPS Read pds members starting with PGM.
Separate each word & check dictionary.
If not found print error on R01.
Loop until the library is done.
SOURCE CODE COMPARE
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//prod DD DSN=prod.project.cobol,DISP=SHR
//test DD DSN=test.project.cobol,DISP=SHR
//SYSIN DD *
*********************************************
* BENCH COMMANDS START HERE *
*********************************************
loop READPDS prod FOR ACCP01. *read test program
READPDS test FOR ACCP01. *read prod version
LOADSRC prod TO test. *load & compare
GOTO loop. *loop until load done
/*
//
DESCRIPTION This sample will load into the source code compare tables prod& test versions of
ACCP01. Compare will automatically occur when both filesare EOF.
INPUTS Prod & test libraries.
OUTPUTS BENCHR06 reports changes to prod version.
PROCESS STEPS Read source from pds libraries.
Load both into compare tables.
Continue load until both files done.
Compare occurs at EOJ processing.
LIBRARY SOURCE CODE COMPARE
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//before DD DSN=prod.project.ctlcard,DISP=SHR
//after DD DSN=test.project.ctlcard,DISP=SHR
//SYSIN DD *
*************************************
* comprehensive library compare *
*************************************
hold DEFINES C'AAAAAAAA' *hold member
high DEFINES X'FFFFFFFFFFFFFFFF' *high values
seqb DEFINES (F=before,P=72,L=9) *seq num
seqa DEFINES (F=after,P=72,L=9) *seq num
hldid DEFINES 'Y' *file ind
READPDS before FOR ******** *init reads
READPDS after FOR ******** *
loop IF RECORDSW OF before = 'Y' *if eof set high
MOVE high TO MEMNAME OF before. *
IF RECORDSW OF after = 'Y' *
MOVE high TO MEMNAME OF after. *
IF MEMNAME OF before = MEMNAME OF after
IF MEMNAME OF before = hold *
MOVE ' ' TO seqb *if same member
MOVE ' ' TO seqa * then clear seq
LOADSRC before after * load and read
READPDS before FOR ******** * next records
READPDS after FOR ******** *
GOTO loop. *
IF MEMNAME OF before > hold *if member done
IF MEMNAME OF after > hold * then request
COMPSRC * a compare
GOTO reset. * and reset hold
IF MEMNAME OF before = hold *if before not
GOTO loadb. * done finish it
IF MEMNAME OF after = hold *if after not
GOTO loada. * done finish it
GOTO loop. *
loadb MOVE RECORDSW OF after TO hldid. *save file ind
loadbl IF MEMNAME OF before = hold *
MOVE 'E' TO RECORDSW OF after *finish up before
MOVE ' ' TO seqb * member loading
LOADSRC before after * before reqst
MOVE hldid TO RECORDSW OF after * reset ind
READPDS before FOR ******** * compare
GOTO loadbl. * and reset
COMPSRC. *
GOTO reset. *
loada MOVE RECORDSW OF before TO hldid. *save file ind
loadal IF MEMNAME OF after = hold *finish after
MOVE 'E' TO RECORDSW OF before *switch set empty
MOVE ' ' TO seqa *or deleted to
LOADSRC before after *avoid before rec
MOVE hldid TO RECORDSW OF before * reset ind
READPDS after FOR ******** *being loaded
GOTO loadal. *too early
COMPSRC. *
GOTO reset. *
reset IF MEMNAME OF before = MEMNAME OF after
MOVE MEMNAME OF before TO hold.
IF MEMNAME OF before < MEMNAME OF after
MOVE MEMNAME OF before TO hold.
IF MEMNAME OF before > MEMNAME OF after
MOVE MEMNAME OF after TO hold.
GOTO loop. *
/*
//
DESCRIPTION This sample will load into the source code compare tables before& after versions of all
members.
INPUTS Before & after libraries.
OUTPUTS BENCHR06 reports changes to prod version.
PROCESS STEPS Read source from pds libraries.
Load both into compare tables.
Continue load & compare until both files done.
Compare occurs at EOJ processing.
MASS COMPILE PROCESSING
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//jclin DD DSN=test.cobol.cntl,DISP=SHR
//ctlin DD DSN=test.pgm.cards,DISP=SHR
//reader DD SYSOUT=(A,INTRDR),
// DCB=(LRECL=80,RECFM=FB,BLKSIZE=80)
//SYSIN DD *
*********************************************
* BENCH COMMANDS START HERE *
*********************************************
ctlname DEFINES (F=ctlin,P=1,L=6) *pgm name
jclname DEFINES (F=jclin,P=LOC,L=8) *replace name
ctl READ ctlin. *read control card
jcloop READ jclin. *read next jcl stmt
IF RECORDSW OF ctlin = 'Y' *if end of control cards
GOTO EOJ. * y-shut down
IF RECORDSW OF jclin = 'Y' *if end of control cards
RESTART jclin * y-restart file
GOTO ctl. * y-get next ctl card
SCANTEST jclin FOR 'PGMXXXXX' *scan for pgm name
IF SCANHIT OF jclin = 'Y' *if found
EDIT ctlname TO jclname. * y-replace name
WRITE reader FROM jclin. *output jcl to reader
GOTO jcloop. *loop until load done
DESCRIPTION This sample scan/replaces the program name for the program namefound on the control
file. The JCL is submitted to the reader to be processed.Note, the EDIT verb will shift to
the left until a blank is found.
INPUTS Compile JCL and a control list of programs.
OUTPUTS JCL on reader queue.
PROCESS STEPS Read program to compile.
Scan/replace program in JCL.
Submit JCL to reader.
When JCL finished restart JCL and get next control program name to use.
CALL USER MODULES FOR PROCESSING
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//userfile DD DSN=test.user.file,DISP=SHR
//output DD DSN=test.mst.extract,DISP=(NEW,CATLG),
// DCB=(LRECL=50,RECFM=FB,BLKSIZE=50)
//SYSIN DD *
recwk DEFINES (F=WORKAREA,P=1,L=50) *workarea
recamt DEFINES (F=WORKAREA,P=5,L=5,T=P) *workarea amt packed
userind DEFINES (F=WORKAREA,P=45,L=1) *user ind
lenght DEFINES '50' *length of work
amount DEFINES '01498' *amount
total DEFINES '0000000000' *total work area
done DEFINES 'NO ' *done ind
loop CALL ACCP01 USING recwk - *get user record
done. *
IF RETURN-CODE NOT = '0' *if cc not 0
EXHIBIT 'bad return code' * display msg
EXHIBIT RETURN-CODE * display code
GOTO EOJ. * shutdown
IF done = 'YES' *if user done
EXHIBIT total * y-print total
GOTO EOJ. * y-shut down
EXHIBIT recwk. *display user rec
MASKAND X'80' TO userind *set only high bit on
ADD recamt TO total. *tally amounts
CALL ACCP09 USING total - *call 09
amount - *
recwk. *
WRITE output FROM WORKAREA. *output extract
GOTO loop. *
DESCRIPTION This sample uses a user routine to issue reads and specialprocessing. Processing will stop
when the user routine request "done".Note, because Workbench does not request a read,
processing will continue untilforced to shut down.
INPUTS User I/O facility.
OUTPUTS Extract file.
PROCESS STEPS Read via user I/O routine set off all but high bit accum total(can accum unlike types/sizes)
Call module to calculate
Output extract & loop until done
RESET NUMERIC FIELDS
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//input DD DSN=test.mstr.file,DISP=SHR
//output DD DSN=test.mstr.output,DISP=(NEW,CATLG),
// DCB=(LRECL=50,RECFM=FB,BLKSIZE=50)
//SYSIN DD *
*********************************************
* BENCH COMMANDS START HERE *
*********************************************
amount DEFINES (F=input,P=23,L=3,T=P) *amount
fix DEFINES X'00000C' *zeros packed
loop READ input. *read rec
IF amount NOT NUMERIC *if amt not numeric
MOVE fix TO amount. * set to zero
WRITE output FROM input. *output new
GOTO loop. *
/*
//
DESCRIPTION This sample will reset amount fields that are not numeric.
INPUTS Master file input.
OUTPUTS New master file will fixes.
PROCESS STEPS Read records.
Test for not numerics.
Reset packed field if not numeric.
Output extract & loop until done.
TALLY NUMERIC FIELDS
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//input DD DSN=test.mstr.file,DISP=SHR
//SYSIN DD *
*********************************************
* BENCH COMMANDS START HERE *
&n sp; *********************************************
amt1 DEFINES (F=input,P=15,L=2,T=P) *amount
amt2 DEFINES (F=input,P=17,L=5,T=C) *amount
amt3 DEFINES (F=input,P=22,L=2,T=X) *amount
amtx DEFINES C'000' *remainder
totamt DEFINES C'0000000000000' *zeros char
loop READ input. *read rec
IF amt1 NUMERIC *if amt numeric
ADD amt1 TO totamt. * accum
IF amt2 NUMERIC *if amt numeric
ADD amt2 TO totamt. * accum
IF amt3 NUMERIC *if amt numeric
SUBTRACT amt3 FROM totamt. * reduce amt
MULTIPLY amt2 by amt1. *multiply sample
DIVIDE amt2 by amt1 REMAINDER amtx *divide sample
WRITE output FROM input. *output new
GOTO loop. *
EPILOGUE EXHIBIT totamt. *display total
GOTO EOJ. *stop run
DESCRIPTION This sample will accumulate numeric fields of different formats.Note, total will display after
file is eof because the EPILOGUE tag will getcontrol. GOTO EOJ must be use to
terminate a job using EPILOGUE or a loop willresult.
INPUTS Master file input.
OUTPUTS Total amount.
PROCESS STEPS Read records.
If numeric tally amt1, amt2.
If numeric reduce by amt3.
Loop until done.
Display when eof.
CONVERT NUMERIC FIELDS
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//input DD DSN=test.mstr.file,DISP=SHR
//output DD DSN=test.mstr.output,DISP=(NEW,CATLG),
// DCB=(LRECL=50,RECFM=FB,BLKSIZE=6000)
//SYSIN DD *
*********************************************
* BENCH COMMANDS START HERE *
*********************************************
amt1 DEFINES (F=input,P=15,L=2,T=P) *amt pack
amt2 DEFINES (F=input,P=17,L=5,T=C) *amt char
amt3 DEFINES (F=input,P=22,L=4,T=X) *amt hex
amt4 DEFINES (F=input,P=33,L=1,T=C) *amt char
amt1X DEFINES (F=input,P=25,L=4,T=X) *amt hex
amt2X DEFINES (F=input,P=37,L=3,T=P) *amt pack
amt3X DEFINES (F=input,P=01,L=07,T=C) *amt char
amt3XS DEFINES (F=input,P=07,L=01,T=C) *amt char
amt4x DEFINES (F=input,P=34,L=1,T=P) *amt pack
loop READ input. *read rec
UNPACK amt3 TO amt3x *unpack field
MASKOR X'F0' TO amt3xs *set sign
PACK amt2 TO amt2x *unpack field
CVTBIN amt1 TO amt1x *convert to binary
CVTDEC amt4 TO amt4x. *convert to packed
MOVEN amt4 TO amt4x. *convert to packed
MOVEN amt3 TO amt3x *convert to display
MOVEN amt1 TO ant1x. *convert to binary
WRITE output FROM input. *output new
GOTO loop. *
DESCRIPTION This sample shows various ways to convert numbers into differentformats.
INPUTS Master file input.
OUTPUTS New master output.
PROCESS STEPS Read records.
Convert fields.
Output new record.
Loop until done.
IMS DATA BASE ACCESS
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCHIMS,PSB='psbname'
//userdb1 DD DSN=test1.database,DISP=SHR
//userdb2 DD DSN=test2.database,DISP=SHR
//userdb3 DD DSN=test3.database,DISP=SHR
//seqfile DD DSN=test.seq.file,DISP=(NEW,CATLG),
// DCB=(LRECL=200,RECFM=FB,BLKSIZE=6000),
// SPACE=(CYL,(5,5),RLSE),UNIT=SYSDA
//SYSIN DD *
**************************************************
* DLI DATA BASE SAMPLE
**************************************************
ENTRY DLITCBL USING pcb1 -
pcb2 -
pcb3.
pcb1 DLILINK (N=pcb1,P=1,L=50) *pcb area 1
pcb1rc DLILINK (N=pcb1,P=11,L=2) *
pcb2 DLILINK (N=pcb2,P=1,L=50) *pcb area 2
pcb2rc DLILINK (N=pcb2,P=11,L=2) *
pcb3 DLILINK (N=pcb3,P=1,L=50) *pcb area 3
pcb3rc DLILINK (N=pcb3,P=11,L=2) *
outarea DEFINES (F=WORKAREA,P=1,L=500) *output file build area
insarea DEFINES (F=WORKAREA,P=1000,L=100) *ims i/o area1
clmarea DEFINES (F=WORKAREA,P=2000,L=170) * area2
pvdarea DEFINES (F=WORKAREA,P=3000,L=200) * area3
gn DEFINES 'GN ' *access get next
ssa1 DEFINES 'INSURED ' *segment name
ssa2 DEFINES 'CLAIM ' *segment name
ssa3 DEFINES 'PROVIDER ' *segment name
total DEFINES P'0000000' *
good DEFINES ' ' *
loop1 CALL CBLTDLI USING gn, pcb1, insarea, ssa1.
IF pcb1rc NOT EQUAL good
EXHIBIT total
EXHIBIT pcb1
GOTO EOJ.
MOVE insarea TO outarea.
WRITE outfile FROM WORKAREA.
ADD '1' TO total.
IF total > '035'
MOVE P'0000000' TO total
GOTO loop2.
GOTO loop1.
loop2 CALL CBLTDLI USING gn, pcb2, clmarea, ssa2.
IF pcb2rc NOT EQUAL good
EXHIBIT pcb2
GOTO EOJ.
MOVE clmarea TO outarea.
WRITE outfile FROM WORKAREA.
ADD '1' TO total.
IF total > '035'
MOVE P'0000000' TO total
GOTO loop3.
GOTO loop2.
loop3 CALL CBLTDLI USING gn, pcb3, pvdarea, ssa3.
IF pcb3rc NOT EQUAL good
EXHIBIT total
EXHIBIT pcb3
GOTO EOJ.
MOVE pvdarea TO outarea.
WRITE outfile FROM WORKAREA.
ADD '1' TO total.
IF total > '035'
GOTO EOJ.
GOTO loop3.
DESCRIPTION This sample shows three database segments being written out to asequential file. File
compares prints, scan/replace tasks can also be done.
INPUTS Data bases for insured, claim, provider segments.
OUTPUTS Sequential file out with 35 records of each type.
PROCESS STEPS Read segments via DLI call.
Loop 35 times for each segment type.
Output fixed record size.
CROSS REFERENCE AN APPLICATION ON PANVALET
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(1,0)
//STEP1 EXEC BENCH
//source DD DSN=system.source.panlib,DISP=SHR
//SORTWK01 DD UNIT=SYSDA,SPACE=(CYL,(10,10),RLSE)
//SORTWK02 DD UNIT=SYSDA,SPACE=(CYL,(10,10),RLSE)
//SORTWK03 DD UNIT=SYSDA,SPACE=(CYL,(10,10),RLSE)
//SYSIN DD *
*********************************************
* BENCH COMMANDS XREF EXCEPT 900XX *
*********************************************
loop READPAN source FOR ********** . *read all members
IF MENNAME OF source = 'PAC900XX ' *if test pgm
DELETE source. * skip it
XREF source. *release record to xref
GOTO loop. *get more
/*
//
DESCRIPTION System wide cross reference with the exclusion of a test programPAC900XX from a
Panvalet file. Task does not lock out other users.
INPUTS Cobol or PL1 source statements
Sortwk for work files
OUTPUTS Report BENCHR07 XREF.
PROCESS STEPS Read each source statement.
Skip records from the PAC900XX member.
Release to Xref facility to select names with a dash ( - ) or underscore ( _).
At end of job the report will automatically sort all data names and report.
SCAN LIBRARIAN FILE FOR VALUES
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//mastin DD DSN=prod.source,DISP=SHR
//SYSIN DD *
*********************************************
* BENCH COMMANDS WHERE IS PGM USED? *
*********************************************
loop READLIB mastin FOR ft****** . *read all "FT" members
SCAN mastin FOR 'FDS040' . *scan & print hits- member
GOTO loop. *name appear on R02 report
/*
//
DESCRIPTION Read Librarian file, each record in each "FT" member.
INPUTS Prod source code.
OUTPUTS BENCHR02 report prints hits with member names.
PROCESS STEPS Read file member records.
Search for values and print if found.
SCAN/REPLACE DATA ON A FILE
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//filein DD DSN=balance.control.file,DISP=SHR
//fileout DD DSN=fixed.balance.control.file,DISP=(,CATLG,DELETE),
// DCB=(RECFM=FB,LRECL=10000,BLKSIZE=10000),
// UNIT=SYSDA,SPACE=(BLK,(1))
//SYSIN DD *
*********************************************
* BENCH COMMANDS START HERE *
* THIS FILE HAS ONLY ONE RECORD BUT MULTIPLE*
* +43 AND +5 BALANCE CONTROL COUNTS TO CLEAR*
* THE FIRST +5 MUST BE SKIPPED *
*********************************************
count DEFINES (F=filein,L=2,P=LOC) *CLEARING FIELD
count1 DEFINES (F=filein,L=1,P=2889) *CLEARING FIELD
count2 DEFINES (F=filein,L=2,P=3898) *CLEARING FIELD
READ filein. *read old bal cntl file
PRINT filein. *print before image
MOVE X'0C' TO count1 *clear count
MOVE X'000C' TO count2 *clear count
loop1 SCANTEST filein FOR X'043C' *find packed count
IF SCANHIT OF filein = 'Y' *if scan found
MOVE X'000C' TO count * yes=clear count
GOTO loop1. *loop for more fields
SCANTEST filein for X'005C'. *find & skip 1st +5
loop2 SCANSTEP filein FOR X'005C'. *find next count
IF SCANHIT OF filein = 'Y' *if scan found
MOVE X'000C' TO count * yes=clear count
GOTO loop2. *loop for more fields
WRITE fileout FROM filein. *write rec out
GOTO EOJ. *stop run
DESCRIPTION Read input file and scan/replace values.
INPUTS Balance Control File.
OUTPUTS BENCHR02 report prints before & after images.
PROCESS STEPS Read file.
Search for values and set location pointer.
Replace value using the MOVE verb and P=LOC which points to the startinglocation
of the scan value.
BUILD A SYSTEM DATASET NAME CROSS REFERENCE
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//procin DD DSN=prod.proclib,DISP=SHR
//SORTWK01 DD UNIT=SYSDA,SPACE=(CYL,(10,10),RLSE)
//SORTWK02 DD UNIT=SYSDA,SPACE=(CYL,(10,10),RLSE)
//SORTWK03 DD UNIT=SYSDA,SPACE=(CYL,(10,10),RLSE)
//SYSIN DD *
*********************************************
* BENCH COMMANDS *
*********************************************
loop READPDS procin FOR ******** . *read all members
XREFDSN procin. *find DSN= & xref
GOTO loop. *get more
/*
//
DESCRIPTION System wide cross reference of the data set names as identifiedby the DSN= key in
the JCL.
INPUTS Production proclib members
Sortwk for work files
OUTPUTS Report BENCHR07 XREF.
PROCESS STEPS Read each JCL statement.
Release to Xref facility to select names with a DSN= keyword.
At end of job the report will automatically sort all data names and report.
MASTER FILE WITH VARIABLE TRAILERS
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//prodfile DD DSN=comppin.data,DISP=SHR,
// DCB=(LRECL=8000,BLKSIZE=13030,RECFM=VB)
//testfile DD DSN=compout.data,DISP=(NEW,CATLG,DELETE),
// SPACE=(TRK,(1,1),RLSE),UNIT=SYSDA,
// DCB=(LRECL=80,BLKSIZE=6000,RECFM=FB)
//SYSIN DD *
*********************************************
* BENCH WORK AREA DEFINES *
*********************************************
trllen DEFINES (F=prodfile,P=loc,L=1,T=X) *rec trailer size
trlid DEFINES (F=prodfile,P=loc+1,L=2) *trailer id
trlarea DEFINES (F=prodfile,P=loc,l=var) *var trailer area
wkarea DEFINES (F=WORKAREA,P=1,l=80) *work area
newrec READ prodfile. *read prod
CVTBIN '20' TO LOC OF prodfile. *skip fixed portion
PERFORM trailer. *do trailer extract
extloop IF trlid = '99' *last trailer
GOTO newrec. * yes-read new rec
ADD trllen TO LOC OF prodfile. * no-up location
PERFORM trailer. * -extract trailer
GOTO extloop. * -go for next trl
trailer CVTBIN trllen TO VAR OF prodfile. *set trailer size for
MOVE trlarea TO wkarea. *moving data
WRITE testfile FROM workarea. *output trailer
RETURN. *exit
DESCRIPTION Read the master file and write all trailer areas for each record.The master file has fixed
area, then any number of variable sections within thesame logical record called a trailer.
INPUTS Production file is defined in system catalog.
OUTPUTS Test file created in this job.
PROCESS STEPS Read the production file.
Skip the first fixed portion of record.
Output the trailer by manipulating the location and variable length of thefield "trlarea".
Write the output file.
COPY ONLY SELECTED RECORDS
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//prodfile DD DSN=comppin.data,DISP=SHR
//testfile DD DSN=compout.data,DISP=(NEW,CATLG,DELETE),
// SPACE=(TRK,(1,1),RLSE),UNIT=SYSDA,
// DCB=(LRECL=14,BLKSIZE=1400,RECFM=FB)
//SYSIN DD *
*********************************************
* BENCH WORK AREA DEFINES *
*********************************************
rectype DEFINES (F=prodfile,P=1,L=2)
*********************************************
* BENCH COMMANDS START HERE *
*********************************************
copyloop READ prodfile *read prod
IFX rectype EQUAL X'F7F0' *if record type 70
WRITE testfile FROM prodfile. * yes-write out record
GOTO copyloop. *loop for more
/*
//
DESCRIPTION Read and select only record types "70" from theProduction file.
INPUTS Production file is defined in system catalog.
OUTPUTS Test file created in this job.
PROCESS STEPS Read the production file.
Test for record type without numeric conversions.
Write the output file (DCB information is defined in the JCL).
ENCRYPT SOURCE CODE FOR SECURITY
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//libin DD DSN=comppin.lib,DISP=SHR
//libout DD DSN=compout.lib,DISP=OLD
//SYSIN DD *
*********************************************
* BENCH WORK AREA DEFINES *
*********************************************
password DEFINES (F=WORKAREA,P=1,L=8)
alpha1 DEFINES (F=WORKAREA,P=1,L=2)
digits DEFINES (F=WORKAREA,P=3,L=4,T=X)
alpha2 DEFINES (F=WORKAREA,P=7,L=2)
*********************************************
* BENCH COMMANDS START HERE *
*********************************************
MOVE 'Q' TO alpha1. *init password
MOVE '%@' TO alpha2. *
MOVE X'000000000C' TO digits. *
copyloop READPDS libin FOR pac*****. *read pac members
CVTBIN COUNTIN OF libin TO digits. *set password to rec#
ENCODE libin USING password. *encode 1st time
ADD '1' TO digits. *up counter
ENCODE libin USING password. *encode 2nd time
WRITEPDS libout FROM libin. *write out record
GOTO copyloop. *loop for more
DESCRIPTION Read members that need to be encoded.
INPUTS Source library.
OUTPUTS Source library out.
PROCESS STEPS Read the source library members.
Set the middle of the password to record count.
Encode the record.
Up the password counter & encode again.
Write the output file (DCB information is defined in the JCL).
DECODE SOURCE CODE FROM SAMPLE 64
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//libin DD DSN=comppin.lib,DISP=SHR
//libout DD DSN=compout.lib,DISP=OLD
//SYSIN DD *
*********************************************
* BENCH WORK AREA DEFINES *
*********************************************
password DEFINES (F=WORKAREA,P=1,L=8)
alpha1 DEFINES (F=WORKAREA,P=1,L=2)
digits DEFINES (F=WORKAREA,P=3,L=4,T=X)
alpha2 DEFINES (F=WORKAREA,P=7,L=2)
*********************************************
* BENCH COMMANDS START HERE *
*********************************************
MOVE 'Q' TO alpha1. *init password
MOVE '%@' TO alpha2. *
MOVE X'000000000C' TO digits. *
copyloop READPDS libin FOR pac*****. *read pac members
CVTBIN COUNTIN OF libin TO digits. *set password to rec#
ADD '1' TO digits. *up counter
DECODE libin USING password. *decode 1st time
SUBTRACT '1' FROM digits. *up counter
DECODE libin USING password. *decode 2nd time
WRITEPDS libout FROM libin. * yes-write out record
GOTO copyloop. *loop for more
DESCRIPTION Read members that need to be encoded.
INPUTS Source library.
OUTPUTS Source library out.
PROCESS STEPS Read the source library members.
Set the middle of the password to record count.
Encode the record.
Up the password counter & encode again.
Write the output file (DCB information is defined in the JCL).
ENCODE AN INDIVIDUAL FIELD
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//filein DD DSN=test.data,DISP=SHR
//fileout DD DSN=test.out,DISP=OLD
//SYSIN DD *
*********************************************
* BENCH WORK AREA DEFINES *
*********************************************
password DEFINES 'ariz1414'
len DEFINES X'005a0000'
recfld DEFINES (F=filein,P=45,L=90)
encode DEFINES 'E'
decode DEFINES 'D'
*********************************************
* BENCH COMMANDS START HERE *
*********************************************
copyloop READ filein. *read records in
CALL BENCH16 USING password, - *call BENCH16 w/ key
len, - *field length
recfld, - *field to encode
encode. *function request E
WRITE fileout FROM filein. *output records
GOTO copyloop. *loop for more
DESCRIPTION Read each record in to be partially encoded.
INPUTS Test file input.
OUTPUTS Test file output.
PROCESS STEPS Read each record.
Locate field to encode via DEFINES label.
Call BENCH16 module passing parms of password, field length (full word binarywith
size in first half word 005a = 90), the field to encode, and the functioncode of 'E' to
encode or 'D' to decode.
Output record and loop for more.
FB TO A COMPUTED VB RECORD SIZE
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//prodfile DD DSN=comppin.data,DISP=SHR,
// DCB=(LRECL=10,BLKSIZE=1000,RECFM=FB)
//testfile DD DSN=compout.data,DISP=(NEW,CATLG,DELETE),
// SPACE=(TRK,(1,1),RLSE),UNIT=SYSDA,
// DCB=(LRECL=14,BLKSIZE=6000,RECFM=VB)
//SYSIN DD *
rec DEFINES (F=prodfile,P=1,L=10)
rechold DEFINES (F=WORKAREA,P=5,L=10)
rdwhold DEFINES (F=WORKAREA,P=1,L=2)
rdwfill DEFINES (F=WORKAREA,P=1,L=4)
area DEFINES (F=WORKAREA,P=1,L=200)
length DEFINES (F=WORKAREA,P=100,L=4)
calrdw DEFINES (F=WORKAREA,P=102,L=2)
spaces DEFINES C' '
MOVE spaces to area. *init area to spaces
copyloop READ prodfile. *read prod
MOVE rec TO rechold. *move rec offset 4
MOVE X'00000000' TO rdwfill *set binary zero fill
SCANTEST rechold FOR spaces *find end of record
MOVE LOC OF prodfile TO length *save location pointer
MOVE calrdw TO rdwhold. *set rdw length
WRITE testfile FROM WORKAREA. *copy records
GOTO copyloop. *loop for more
DESCRIPTION Copy and change the record format from FB to VB. The rdw iscomputed by finding the
trailing spaces. This sample assumes a space marks theend of the record, but any unique
ending value could be used.
INPUTS Production file is defined in system catalog.
OUTPUTS Test file created in this job.
PROCESS STEPS First time, set the end of work to spaces.
Read the file.
Move the record to hold.
Issue a scan to find the record's end.
Note: The LOC of ddname is a binary field. Set the rdw with the LOC value.
Write the output file. (DCB information is defined in the JCL).
COMPRESS A FILE
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//filein DD DSN=test.data,DISP=SHR, *info only
// DCB=(LRECL=80,RECFM=FB,BLKSIZE=3120) *info only
//fileout DD DSN=test.out,DISP=(,CATLG), *
// UNIT=SYSDA,SPACE=(TRK,(3,3)), *
// DCB=(LRECL=85,RECFM=VB,BLKSIZE=3120) *req orig+5
//SYSIN DD *
*********************************************
* BENCH COMMANDS START HERE *
*********************************************
copyloop READ filein. *read record in
COMPRESS filein TO WORKAREA. *squeeze the record
WRITE fileout FROM WORKAREA. *write out vb file
&nbs ; GOTO copyloop. *loop for more
DESCRIPTION This sample will compress each record looking for duplicate byte.The output file must be
JCL defined as VB with an LRECL of at least 5 bytes morethan the original. Block size as
large as reasonable. The 5 bytes are in case arecord does not have compressible data. The
record created in WORKAREA will havethe RDW in bytes 1-4 preset. Byte 5 is reserved
as a control flag.
INPUTS Test file input.
OUTPUTS Test file output.
PROCESS STEPS Read each record.
Compress the record and set rdw length.
Output record and loop for more.
DECOMPRESS A SELECTED RECORD
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//filein DD DSN=test.out,DISP=SHR, *info only
// DCB=(LRECL=85,RECFM=VB,BLKSIZE=3120) *info only
//fileout DD DSN=test.data,DISP=(,CATLG) *
// UNIT=SYSDA,SPACE=(TRK,(3,3)), *new file
// DCB=(LRECL=80,RECFM=FB,BLKSIZE=3120) *orig size
//SYSIN DD *
*********************************************
* BENCH COMMANDS START HERE *
*********************************************
type DEFINES (F=filein,P=6,L=3) *record id type
copyloop READ filein. *read record in
IF type = '815' *If type found
DECOMPRESS filein TO WORKAREA * expand the record
WRITE fileout FROM WORKAREA. * write out file
GOTO copyloop. *loop for more
DESCRIPTION This sample will decompress a record that was squeezed by theCOMPRESS verb.
Each logical record matches the original file. Therefore, recordscan be selectively
expanded. The record created in WORKAREA will have the RDWautomatically
stripped.
INPUTS Test file input.
OUTPUTS Test file output.
PROCESS STEPS Read each record.
Decompress only type 815 records
Output record and loop for more.
STRING MEMBER NAMES TO BUILD LINKAGE CARDS
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//filein DD DSN=test.member.list,DISP=SHR
//fileout DD DSN=test.cards,DISP=OLD
//SYSIN DD *
*********************************************
* BENCH COMMANDS START HERE *
*********************************************
member DEFINES (F=filein,P=1,L=8) *member name
constant DEFINES C' include syslib' *literals
flda DEFINES (F=WORKAREA,P=1,L=15) *build area
fldb DEFINES (F=WORKAREA,P=16,L=55) *area for member
cardrec DEFINES (F=WORKAREA,P=1,L=80) *rec area
MOVE ' ' TO cardrec. *init rec to spaces
loop READ filein. *read members
MOVE constant TO flda. *move literals
STRING member, '(r)' INTO fldb *string data
DELIMITED BY ' '. *
WRITE fileout FROM filein. *
GOTO loop. *loop for more
DESCRIPTION This sample builds include cards for the linkage editor using thestring verb.
INPUTS Member list in.
OUTPUTS Linkage cards out.
PROCESS STEPS Read each record.
Build the linkage card.
Output record and loop for more.
UNSTRING NAME AND ADDRESS INFORMATION
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//filein DD DSN=test.address.file,DISP=SHR
//SYSIN DD *
*********************************************
* BENCH COMMANDS START HERE *
*********************************************
card DEFINES (F=filein,P=1,l=80) *string input
flda DEFINES (F=WORKAREA,P=001,L=80) *name
fldb DEFINES (F=WORKAREA,P=101,L=80) *title
fldc DEFINES (F=WORKAREA,P=201,L=80) *city
loop READ filein. *read
UNSTRING card INTO - *break up data
flda - *looking for comma
fldb - *to separate fields
fldc - *
DELIMITED BY ','.
EXHIBIT flda. *display values
EXHIBIT fldb. *
EXHIBIT fldc. *
GOTO loop. *loop for more
DESCRIPTION The sample reads name, title, & city information andseparates the variable length fields
into individual fields.
INPUTS List of names as "nnnn n nnnn, ttttttt, ccccccc"
OUTPUTS Displays of individual fields
PROCESS STEPS Read each record.
Separate the characters.
Display fields and loop for more.
IDMS ADS/O SOURCE CODE SCAN
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//STEPLIB DD DSN=company.bench.loadlib,disp=shr
// DD DSN=company.primary.idms.loadlib,DISP=SHR
// DD DSN=SYS2.ID100CD.IDMS.LOADLIB,DISP=SHR
//SYSJRNL DD DUMMY
//SYSCTL DD DSN=SYS2.ID100CD.IDMS.SYSCTLT,DISP=SHR
//SYSOUD DD SYSOUT=*
//SYSDBOUT DD SYSOUT=*
//SYSIN DD *
*********************************************
* ADS/O SOURCE CODE SCAN *
*********************************************
modarea DEFAREA SIZE=168 *memory work space
textarea DEFAREA SIZE=88 *memory work space
rc1work DEFINES (F=modarea,P=1,L=168) *
pgmname DEFINES (F=modarea,P=1,L=8) *first 8 used for pgmname
module DEFINES (F=modarea,P=1,L=32) *full module name
rc2work DEFINES (F=textarea,P=1,L=88) *source code text
codeline DEFINES (F=textarea,P=1,L=4,T=X) *source line number
db1name DEFINES 'dev5dict ' *16 byte dict name
ss1name DEFINES 'idmsnwka ' *16 byte subschema name
rc1name DEFINES 'module-067 ' *record name
rc2name DEFINES 'text-088 ' *text record name
ar1name DEFINES 'ddldml ' *record area
set1name DEFINES 'module-text ' *path name
start BIND RUN-UNIT FOR ss1name DBNAME db1name.
BIND rc1name TO rc1work. *set work to receive
BIND rc2name TO rc2work. *
READY ar1name. *ready retrieval
OBTAIN FIRST rc1name WITHIN AREA ar1name. *get first module
pgmloop IF IDMS-STATUS NOT = '0000' *if all modules done
EXHIBIT IDMS-STATUS * yes-finish stats
GOTO done. *
ADD '1' TO COUNTIN OF modarea. *up module count
MOVE pgmname TO MEMNAME OF modarea. *set name in rpts
MOVE pgmname TO MEMNAME OF textarea. *
PRINT modarea. *print module name
PERFORM readcode. *search source
FIND CURRENT rc1name. *repoint to current
OBTAIN NEXT rc1name WITHIN AREA ar1name. *get next pgmname
GOTO pgmloop. *loop until done
readcode OBTAIN FIRST rc2name WITHIN set1name.
codeloop IF IDMS-STATUS NOT = '0000' *end of stmts
RETURN. * yes-exit
CVTDEC codeline TO COUNTIN OF textarea. *set line number
MOVE ' ' TO CODELINE.
*** **add scan verbs here
SCAN textarea for 'CALL SETMAP'.
SCAN textarea for 'CALL SETMAP1'.
OBTAIN NEXT rc2name WITHIN set1name. *get next stmt
GOTO codeloop. *continue
done FINISH. *wrap up with stats
EXHIBIT ' '. *
EXHIBIT '---total modarea---' *
EXHIBIT COUNTIN OF modarea. *
EXHIBIT '---total records---' *
EXHIBIT COUNTIN OF textarea. *
GOTO eoj. *shutdown
DESCRIPTION Sample does a source code scan of ADS/O stored on the dictionary.
INPUTS IDMS source found on the data dictionary dev5dict.
OUTPUTS Prints of source code records found.
PROCESS STEPS Read each module name found.
For each module name, read and scan all it's source statements.
Display all scan hits.
IDMS RECORD AREA SWEEP PRINTS
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//STEPLIB DD DSN=company.bench.loadlib,disp=shr
// DD DSN=company.primary.idms.loadlib,DISP=SHR
// DD DSN=SYS2.ID100CD.IDMS.LOADLIB,DISP=SHR
//SYSJRNL DD DUMMY
//SYSCTL DD DSN=SYS2.ID100CD.IDMS.SYSCTLT,DISP=SHR
//SYSOUD DD SYSOUT=*
//SYSDBOUT DD SYSOUT=*
//SYSIN DD *
*********************************************
* record area sweep dump *
*********************************************
umtcxfr DEFAREA SIZE=220 *memory work space
rc1work DEFINES (F=umtcxfr,P=1,L=220) *
db1name DEFINES 'dev5dict ' *16 byte dict name
ss1name DEFINES 'intssc01 ' *16 byte subschema name
rc1name DEFINES 'umtcxfr ' *record name
ar1name DEFINES 'pend-area ' *record area
start BIND RUN-UNIT FOR ss1name DBNAME db1name.
BIND rc1name TO rc1work. *set work to receive
READY ar1name. *ready retrieval
OBTAIN FIRST rc1name WITHIN AREA ar1name. *get first record
loop IF IDMS-STATUS NOT = '0000' *if all records done
EXHIBIT IDMS-STATUS * yes-finish stats
GOTO done. *
ADD '1' TO COUNTIN OF umtcxfr. *up record count
PRINT umtcxfr. *print record
DUMP umtcxfr. *dump record
OBTAIN NEXT rc1name WITHIN AREA ar1name. *get next
GOTO loop. *loop until done
done FINISH. *wrap up with stats
EXHIBIT ' '. *
EXHIBIT '---total records---' *
EXHIBIT COUNTIN OF umtcxfr. *
GOTO eoj. *shutdown
DESCRIPTION Sample sweeps and record prints those found.
INPUTS IDMS database records found in area umtcxfr.
OUTPUTS Prints and dumps of records found.
PROCESS STEPS Read each record based on an area sweep.
For each record, print and dump it.
Display final statistics.
IDMS ADS/O LOAD SIZE, MAP DATE
AND GEN DATE PRINT
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//STEPLIB DD DSN=company.bench.loadlib,disp=shr
// DD DSN=company.primary.idms.loadlib,DISP=SHR
// DD DSN=SYS2.ID100CD.IDMS.LOADLIB,DISP=SHR
//SYSJRNL DD DUMMY
//SYSCTL DD DSN=SYS2.ID100CD.IDMS.SYSCTLT,DISP=SHR
//SYSOUD DD SYSOUT=*
//SYSDBOUT DD SYSOUT=*
//SYSIN DD *
*********************************************
* ADS/O GEN AND MAP DATE PRINT *
*********************************************
headarea DEFAREA SIZE=1000 *memory work space
textarea DEFAREA SIZE=6000 *memory work space
outarea DEFAREA SIZE=80 *memory work space
rc1work DEFINES (F=headarea,P=1,L=100) *
pgmname DEFINES (F=headarea,P=1,L=8) *first 8 used for pgmname
loadsze DEFINES (F=headarea,P=17,L=4,T=X) *load module size
gendte1 DEFINES (F=headarea,P=21,L=8) *gen date of module
rc2work DEFINES (F=textarea,P=1,L=100) *load text
fdbname DEFINES (F=textarea,P=1,L=3) *dbname
mapname DEFINES (F=textarea,P=29,L=8) *map name
scname DEFINES (F=textarea,P=53,L=53) *schema name
ssname DEFINES (F=textarea,P=61,L=8) *subschema name
gendte DEFINES (F=textarea,P=13,L=8) *gendate of map
mapdte DEFINES (F=textarea,P=37,L=8) *map gen date
rc4work DEFINES (F=outarea,P=1,L=100) *output print line
progout DEFINES (F=outarea,P=1,L=8) *pgmname
genout DEFINES (F=outarea,P=10,L=8) *gen date
mapout DEFINES (F=outarea,P=20,L=8) *map name
mdteout DEFINES (F=outarea,P=30,L=8) *map date
loadout DEFINES (F=outarea,P=40,L=10) *load size
scout DEFINES (F=outarea,P=52,L=8) *schema name
ssout DEFINES (F=outarea,P=62,L=8) *subschema name
devout DEFINES (F=outarea,P=72,L=8) *dictionary out
db1name DEFINES 'dev5dict ' &nb p; *16 byte dict name
ss1name DEFINES 'idmsnwka ' *16 byte subschema name
rc1name DEFINES 'loadhdr-156 ' *record name
rc2name DEFINES 'loadtext-157 ' *text record name
ar1name DEFINES 'dddclod ' *record area
set1name DEFINES 'loadhdr-loadtext' *path name
start BIND RUN-UNIT FOR ss1name DBNAME db1name.
BIND rc1name TO rc1work. *set work to receive
BIND rc2name TO rc2work. *
READY ar1name. *ready retrieval
OBTAIN FIRST rc1name WITHIN AREA ar1name. *get first module
MOVE ' ' TO rc4work. *clear output area
pgmloop IF IDMS-STATUS NOT = '0000' *if all modules done
EXHIBIT IDMS-STATUS * yes-finish stats
GOTO done. *
OBTAIN FIRST rc2name WITHIN set1name. *get load text
IF IDMS-STATUS NOT = '0000' *if text not found
GOTO skip. * then skip it
ADD '1' TO COUNTIN OF headarea. *up module count
IF fdbname = 'fdb' *if load module
GOTO fdbhit. * yes-get info
GOTO fdbless. *handle without load
fdbhit MOVE progname TO progout. *build info
MOVE gendte TO genout. *
MOVE mapname TO mapout. *
MOVE mapdte TO mdteout. *
MOVE scname TO scout. *
MOVE ssname TO ssout. *
CVTCHAR loadsze TO loadout. *
MOVE db1name TO devout. *
GOTO out. *
fdbless MOVE progname TO progout. *build info
MOVE gendte1 TO genout. *
MOVE ' ' TO mapout. *
MOVE ' ' TO mdteout. *
MOVE ' ' TO scout. *
MOVE ' ' TO ssout. *
CVTCHAR loadsze TO loadout. *
MOVE db1name TO devout. *
GOTO out. *
out PRINT outarea. *print detail line
skip FIND CURRENT rc1name. *
OBTAIN NEXT rc1name WITHIN AREA ar1name. *get next pgmname
GOTO pgmloop. *loop until done
done FINISH. *wrap up with stats
EXHIBIT ' '. *
EXHIBIT '---total program---' *
EXHIBIT COUNTIN OF headarea. *
GOTO eoj. *shutdown
DESCRIPTION Purpose of the sample is to list the ADS/O load modules withrelevant statistics. Often
production and development libraries get out of sync.By running this sample and printing
or outputing the results to disk, comparesof various dictionaries can be done.
INPUTS IDMS load found on the data dictionary dev5dict.
OUTPUTS Prints of load stat including dates, load size, and subschema names.
PROCESS STEPS Read each module name found.
For each module name, locate a possible load text.
Build a statistics work line for printing or extracting.
DB2 TABLE EXTRACT AND PRINT
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//extract DD DSN=test.lsmttem.extract,DISP=(NEW,CATLG),
// DCB=(LRECL=60,RECFM=FB,BLKSIZE=6000),
// UNIT=DISK,SPACE=(CYL,(5,1),RLSE)
//SYSIN DD *
*********************************************
* print and dump out all rows *
*********************************************
lsmttem DEFAREA SIZE=60 *memory work space
row1work DEFINES (F=lsmttem,P=1,L=60) *full work size
start DB2-CONNECT SYSTEM=DB2T. *connect to db2
EXEC SQL DECLARE cur1 CURSOR FOR
SELECT * FROM db2.lsmttem END-EXEC. *declare cursor
EXEC SQL OPEN cur1 END-EXEC. *open cursor
loop EXEC SQL FETCH cur1
INTO :row1work END-EXEC. *read row
IF SQLCODE NOT = '0' *if read failed
EXHIBIT SQLCODE * yes-display
GOTO done. * -exit
ADD '1' TO COUNTIN OF lsmttem. *manually up counts
PRINT lsmttem. *print record
WRITE extract FROM lsmttem. *output extract
GOTO loop. *loop for more
done EXEC SQL CLOSE cur1 END-EXEC. *close cursor
DB2-DISCONNECT. *terminate DBMS
EXHIBIT '---total rows---'. *display counts
EXHIBIT COUNTIN OF lsmttem. *
GOTO EOJ. *shutdown
DESCRIPTION: Sample uses a cursor selectingall elements without a WHERE clause to limit the range. All elements will bestacked side by side starting in position 1 of the rc1work. Should the elementsoverflow the work size, Workbench will issue a message stating how much more itneeds.
Manual counts may be kept in the countin, out, del internalfields. The print reports will display these counts when issued.
You may reevaluate a DECLARE statement by having the processlogic pass over it. This is different from COBOL where the declare is static.Using Workbench, the declare is rebuilt when executed under dynamic planpreperation. The execution of the open statement and then the first fetch causesthe the cursor to actually be opened and read. The Workbench waits for the firstfetch to actually open so it knows where to place the received elements.
Fetches into must be in a working storage located hostvariable not a moving record buffer. This is the same retriction COBOL has wherehost variable may not be in the FD area or linkage without possible problems.This is because the DB2 software statically identifies receiving field positionat the time of open. Record reads in an FD, for instance, move the elementreferences in the i/o buffer. Eventually you will get a S0C4 as yourunpredictable, predictable result.
INPUTS DB2 database table lsmttem.
OUTPUTS Prints and an output extract file.
PROCESS STEPS Read each row name found.
For each row, print it and output an extract.
Loop until done.
DB2 EXTRACT AND DELETE SELECTED ROWS
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//list DD DSN=test.remove.list,DISP=SHR
//extract DD DSN=test.lsmttem.extract,DISP=(NEW,CATLG),
// DCB=(LRECL=60,RECFM=FB,BLKSIZE=6000),
// UNIT=DISK,SPACE=(CYL,(5,1),RLSE)
//SYSIN DD *
*********************************************
* print and dump out all rows *
*********************************************
lsmttem DEFAREA SIZE=60 *memory work space
row1work DEFINES (F=lsmttem,P=1,L=60) *full work size
teamid DEFINES (F=lsmttem,P=1,L=7) *team id
teamname DEFINES (F=lsmttem,P=8,L=30) *name field
origin DEFINES (F=lsmttem,P=38,L=2) *data origin code
removeid DEFINES (F=list,P=1,L=7) *id to drop
start DB2-CONNECT SYSTEM=DB2T. *connect to db2
loop READ list. *read next id
MOVE removeid TO teamid. *set up select
EXEC SQL
SELECT team_id, team_name, team_origin
INTO :teamid, :teamname, :origin
FROM db2.lsmttem
WHERE team_id = :teamid
AND team_origin = 'rt' END-EXEC.
IF SQLCODE NOT = '0' *if read failed
EXHIBIT 'id not found' * yes-issue message
EXHIBIT listid * -display id
EXHIBIT SQLCODE * -display code
GOTO loop. * -get next id
ADD '1' TO COUNTIN OF lsmttem. *manually up counts
PRINT lsmttem. *print record
WRITE extract FROM lsmttem. *output extract
EXEC SQL DELETE FROM db2.lsmttem
WHERE team_id = :teamid END-EXEC.
IF SQLCODE NOT = '0' *if delete failed
EXHIBIT 'delete failed' * yes-issue message
EXHIBIT removeid * -display id
EXHIBIT SQLCODE. * -display code
GOTO loop. *get next on list
EPILOGUE DB2-DISCONNECT. *terminate DBMS
EXHIBIT '---total rows---'. *display counts
EXHIBIT COUNTIN OF lsmttem. *
GOTO EOJ. *shutdown
DESCRIPTION The purpose of sample is to demonstrate how you can read in alist and process SQL
based on this elements.
INPUTS DB2 database table lsmttem.
OUTPUTS Prints and an output extract file.
PROCESS STEPS Read id to delete.
For each row, print it, output an audit trail extract, and delete it.
Loop until done.
DB2 EXTRACT, UPDATE, AND COMPARE ROWS
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//list DD DSN=test.update.list,DISP=SHR
//extract DD DSN=test.lsmttem.extract,DISP=(NEW,CATLG),
// DCB=(LRECL=60,RECFM=FB,BLKSIZE=6000),
// UNIT=DISK,SPACE=(CYL,(5,1),RLSE)
//SYSIN DD *
*********************************************
* print and dump out all rows *
*********************************************
lsmttem DEFAREA SIZE=60 *memory work space
row1work DEFINES (F=lsmttem,P=1,L=60) *full work size
teamid DEFINES (F=lsmttem,P=1,L=7) *team id
teamname DEFINES (F=lsmttem,P=8,L=30) *name field
ordcount DEFINES (F=lsmttem,P=38,L=8,T=P) *order count
updateid DEFINES (F=list,P=1,L=7) *id to update
updtecnt DEFINES (F=list,P=10,L=15,T=C) *new count to set
lsmttemi DEFAREA SIZE=60 *memory work space
row2work DEFINES (F=lsmttemi,P=1,L=60) *full work size
start DB2-CONNECT SYSTEM=DB2T. *connect to db2
loop READ list. *read next id
MOVE updateid TO teamid. *set up select
EXEC SQL
SELECT team_id, team_name, team_order_count
INTO :teamid, :teamname, :ordcount
FROM db2.lsmttem
WHERE team_id = :teamid END-EXEC.
IF SQLCODE NOT = '0' *if read failed
EXHIBIT 'id not found' * yes-issue message
EXHIBIT listid * -display id
EXHIBIT SQLCODE * -display code
GOTO loop. * -get next id
ADD '1' TO COUNTIN OF lsmttem. *up counts
MOVE COUNTIN OF lsmttem TO COUNTIN OF lsmttemi.
MOVE row1work TO row2work. *hold initial row
WRITE extract FROM lsmttem. *output extract
CVTDEC updtecnt TO ordcount. *reset numeric field
COMPARE lsmttemi TO lsmttem. *compare before/after
EXEC SQL UPDATE db2.lsmttem
SET team_order_count = :ordcount,
last_updated = CURRENT TIMESTAMP
WHERE team_id = :teamid END-EXEC.
IF SQLCODE NOT = '0' *if delete failed
EXHIBIT 'update failed' * yes-issue message
EXHIBIT updateid * -display id
EXHIBIT SQLCODE. * -display code
EXEC SQL ROLLBACK END-EXEC. * -rollback
GOTO loop. *get next on list
EPILOGUE DB2-DISCONNECT. *terminate DBMS
EXHIBIT '---total rows---'. *display counts
EXHIBIT COUNTIN OF lsmttem. *
GOTO EOJ. *shutdown
DESCRIPTION: The purpose of sample is to demonstrate how to zap rows based ona control file driver.
All rows are extracted for audit trail needs and comparereport is issued on the change
before and after the zap. Should an update erroroccur, the entire update is rollbacked.
INPUTS: DB2 database table lsmttem.
OUTPUTS: Compare before/after rows; Audit trail extract file.
PROCESS STEPS: Read id to delete.
For each row, print it, output an audit trail extract, and delete it.
IMS DATA BASE PRINT AND DUMP
//jobname JOB (12345,12345),'name ',MSGCLASS=X,CLASS=A
//step01 EXEC BENCHIMS,PSB='psbname',REGION=6M
//userdb1 DD DSN=test1.database,DISP=SHR
//userdb2 DD DSN=test2.database,DISP=SHR
//userdb3 DD DSN=test3.database,DISP=SHR
//seqfile DD DSN=test.seq.file,DISP=(NEW,CATLG),
// DCB=(LRECL=500,RECFM=FB,BLKSIZE=6000),
// SPACE=(CYL,(5,5),RLSE),UNIT=SYSDA
//SYSIN DD *
**************************************************
* dli data base print and dump
**************************************************
ENTRY DLITCBL USING pcb1.
insarea DEFAREA SIZE=500 *memory work
pcb1 DLILINK (N=pcb1,P=1,L=50) *pcb area 1
pcb1rc DLILINK (N=pcb1,P=11,L=2) *
insrec DEFINES (F=insarea,P=1,L=500) *segment build area
gn DEFINES 'GN ' *access get next
ssa1 DEFINES 'INSURED ' *segment name
total DEFINES P'0000000' *
good DEFINES ' ' *
loop CALL CBLTDLI USING gn -
pcb1 -
insrec -
ssa1. *get segment
IF pcb1rc NOT EQUAL good *if end of segment
EXHIBIT total * yes-shutdown
EXHIBIT pcb1
GOTO EOJ.
ADD '1' TO COUNTIN OF insarea. *up record count
IF date = '19891209' *if correct date
DUMP insarea * yes-dump segment
WRITE seqfile FROM insarea. * -output an extract
GOTO loop. *do until done
//
DESCRIPTION This sample dumps and unloads IMS database segments under thename of INSURED.
Only segments with a date of 1989-12-09 will be chosen.
INPUTS Data bases for insured segments.
OUTPUTS Sequential file of extracts and dump report R05.type.
PROCESS STEPS Read segments via DLI call.
Loop until done.
Output fixed record size.
DB2 PARTIAL TABLE DELETE AND RELOAD
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//list DD DSN=test.update.list,DISP=SHR
//tablein DD DSN=lmstest.c320.data,DISP=SHR
//SYSIN DD *
***********************************
* workbench process will reload *
* the c320 description *
* codes from a dataset *
***********************************
rec DEFINES (F=tablein,P=1,L=200)
id DEFINES (F=tablein,P=01,L=4)
key DEFINES (F=tablein,P=05,L=10)
result DEFINES (F=tablein,P=15,L=80)
DB2-CONNECT SYSTEM=db2t.
EXEC SQL lock table in share mode END-EXEC.
EXEC SQL DELETE FROM db2.lmsttbt
WHERE table_id = 'c320'
END-EXEC.
EXHIBIT '--total deleted--'
EXHIBIT SQLCOUNT
LOOP READ tablein
PRINT tablein.
EXEC SQL INSERT INTO db2.lmsttbt
(table_id,
table_key,
table_result,
online_timestamp)
VALUES (:id, :key, :result, CURRENT TIMESTAMP)
END-EXEC.
IF SQLCODE NOT = '0'
EXHIBIT 'error....'
EXHIBIT key
EXHIBIT SQLCODE
EXEC SQL ROLLBACK END-EXEC
DB2-DISCONNECT
GOTO EOJ.
GOTO LOOP.
EPILOGUE EXEC SQL COMMIT END-EXEC.
DB2-DISCONNECT.
GOTO EOJ.
DESCRIPTION: Reload a DB2 control table containing process codes anddescriptions.
INPUTS: DB2 database table lsmttbt.
OUTPUTS: Old rows deleted, new ones added.
PROCESS STEPS: Lock table space in share mode (optional)
Delete old codes and descriptions.
Print the number of rows deleted.
Read each record to load.
Insert the new row.
Loop until done.
CONVERT IDMS RECORDS TO DB2 ROWS
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//STEPLIB DD DSN=company.bench.loadlib,disp=shr
// DD DSN=company.primary.idms.loadlib,DISP=SHR
// DD DSN=SYS2.ID100CD.IDMS.LOADLIB,DISP=SHR
//SYSJRNL DD DUMMY
//SYSCTL DD DSN=SYS2.ID100CD.IDMS.SYSCTLT,DISP=SHR
//SYSOUD DD SYSOUT=*
//SYSDBOUT DD SYSOUT=*
//SYSIN DD *
*********************************************
* convert idms records to db2 table *
* note: numerics automatically translate *
* from character to packed. *
*********************************************
umtcxfr DEFAREA SIZE=220 *memory work space
rc1work DEFINES (F=umtcxfr,P=1,L=220) *
db1name DEFINES 'dev5dict ' *16 byte dict name
ss1name DEFINES 'intssc01 ' *16 byte subschema name
rc1name DEFINES 'umtcxfr ' *record name
ar1name DEFINES 'pend-area ' *record area
policy DEFINES (F=umtcxfr,P=01,L=9)
date DEFINES (F=umtcxfr,P=10,L=10)
premium DEFINES (F=umtcxfr,P=50,L=8,T=P,D=2)
type DEFINES (F=umtcxfr,P=139,L=2)
paymode DEFINES (F=umtcxfr,P=152,L=1)
newtype DEFINES (F=WORKAREA,P=1,L=2) *scratch pad work
paycnt DEFINES (F=WORKAREA,P=5,L=4,T=X)
start BIND RUN-UNIT FOR ss1name DBNAME db1name.
BIND rc1name TO rc1work. *set work to receive
READY ar1name. *ready retrieval
DB2-CONNECT SYSTEM=db2t.
EXEC SQL LOCK TABLE IN SHARE MODE END-EXEC.
OBTAIN FIRST rc1name WITHIN AREA ar1name. *get first record
loop IF IDMS-STATUS NOT = '0000' *if all records done
EXHIBIT IDMS-STATUS * yes-finish stats
GOTO done. *
ADD '1' TO COUNTIN OF umtcxfr. *up record count
CVTBIN '01' TO paycnt *default annual pay
MOVE 'AU' TO newtype. *default auto policy
IF type = '54' *if homeowner policy
IF paymode = 'M' * and monthly payment
CVTBIN '12' TO paycnt * set db2's pay count
MOVE 'HO' TO newtype. * set new policy type
DUMP umtcxfr. *dump record
EXEC SQL insert into db2.polprems
(policy_number,
policy_inception_date,
net_single_premium,
payment_count,
policy_type,
online_timestamp)
values (:policy, :date, :premium,
:paycnt, :newtype, current timestamp)
END-EXEC.
IF SQLCODE NOT = '0'
EXHIBIT 'insert error on policy number....'
EXHIBIT policy
EXHIBIT SQLCODE
EXEC SQL ROLLBACK END-EXEC
GOTO done.
OBTAIN NEXT rc1name WITHIN AREA ar1name.
GOTO loop. *loop until done
done FINISH. *disconnect idms from task
EXEC SQL COMMIT END-EXEC. *commit db2 and release lock
DB2-DISCONNECT. *disconnect db2 from task
GOTO eoj. *shutdown
DESCRIPTION: Load a DB2 table using IDMS as the input source. Connection ismade to both
environments at the same time. Please consult with your DBA's forpossible data center
restrictions or conflicts. Should you have trouble,separate the task into two steps, one for
the IDMS unload and another for theDB2 conversion.
INPUTS: IDMS database area umtcxfr.
OUTPUTS: DB2 row with converted fields.
PROCESS STEPS: Init IDMS and DB2 connections.
Read each idms record to load.
Convert any fields needed. Please note, DB2 may have a different numericformat on it's
DCL-gen. In most cases, Workbench will automatically convert themwithout
assistance. The decimal places (D=2 command) is the exeception.
Insert the new row.
Loop until done.
Disconnect from both IDMS and DB2.
SYNC PATCH FILE TO MASS UPDATE DB2 ROWS
//jobname JOB (12345,12345),'name ',MSGCLASS=X,CLASS=A
//step1 EXEC BENCH
//quotes DD DSN=nyse.vsam.security.quotes,DISP=SHR
//zaplist DD DSN=oxxtest.cusips.to.zap,DISP=SHR
//SYSIN DD *
******************************************************************
* Workbench - process will zap the security row based on a control
* list containg the cusip id. The zap list is synchronized to a *
* vsam file for price values. Files are in ascending order. *
******************************************************************
qtekey DEFINES (F=quotes,P=5,L=9) *cusip id
qteprice DEFINES (F=quotes,P=26,L=15,T=C) *vsam zone decimal
zapkey DEFINES (F=zaplist,P=1,L=9) *zap cusip id
oxxsecr DEFAREA SIZE=100 *scratch pad area
cusip DEFINES (F=oxxsecr,P=001,L=9) *table cusip
quote DEFINES (F=oxxsecr,P=010,L=8,T=P,D=7) *packed decimal
DB2-CONNECT SYSTEM=prod. *
loop SYNC zapkey, qtekey. *coordinated read
IF zapkey = qtekey *if matching price
GOTO process. * to quote, process
GOTO loop. * no-loop until found
process MOVE zapcusip to cusip *set up for select
EXEC SQL
SELECT cusip, close_quote
INTO :cusip, :quote
FROM prod.oxxsecr
WHERE cusip = :cusip END-EXEC.
IF SQLCODE NOT = '0' *if not found
GOTO loop. * skip this row
MOVE qteprice TO quote. *set value for shift
EXEC SQL
UPDATE prod.oxxserc
SET cusip = :cusip, close_quote = :quote
WHERE cusip = :cusip END-EXEC.
DUMP oxxsecr. *audit trail of zaps
GOTO loop. *go for more id
EPILOGUE EXHIBIT 'finishing oxxsecr correction....'
EXHIBIT 'rolling back for test' *debug test run
EXEC SQL ROLLBACK END-EXEC. *
DB2-DISCONNECT. *
GOTO EOJ. *SHUTDOWN
DESCRIPTION: The DB2 table will be updated from the VSAM master file, but foronly selected keys.
These keys were created from an error report.
INPUTS: VSAM prices master file and a control list synchronized
OUTPUTS: DB2 row with update prices.
PROCESS STEPS: Sync VSAM prices to control list.
Read the DB2 row for every entry on the control list file.
Convert the numeric field.
Update the row.
Loop until done.
Disconnect from DB2.
PATCH CA-DATACOM DATA BASE AND ISSUE COMPARE
//jobname JOB (12345,12345),'name ',MSGCLASS=X,CLASS=A
//step1 EXEC BENCHDB,URT=D1M890U1
//SYSIN DD *
*************************************************
* working storage area *
*************************************************
litdlr DEFINES '0005594' <============ TA dealer nbr to select
litbrn DEFINES '000 ' <============ TA branch id to zap
com1 DEFAREA SIZE=400
userinf1 DEFINES (F=com1,P=001,L=32) ***Datacom request block
request1 DEFINES (F=com1,P=100,L=203)
reqcmd1 DEFINES (F=com1,P=100,L=005)
tblname1 DEFINES (F=com1,P=105,L=003)
keyname1 DEFINES (F=com1,P=108,L=005)
rc1 DEFINES (F=com1,P=113,L=002)
f11 DEFINES (F=com1,P=115,L=001)
dbid1 DEFINES (F=com1,P=116,L=002,T=X)
tblid1 DEFINES (F=com1,P=118,L=002,T=X)
recid1 DEFINES (F=com1,P=120,L=005)
f21 DEFINES (F=com1,P=125,L=051)
*
key1 DEFINES (F=com1,P=176,L=027) *key area
kydlr DEFINES (F=com1,P=176,L=007)
kybrn DEFINES (F=com1,P=183,L=009)
eml DEFAREA SIZE=60
elmlist1 DEFINES (F=eml,P=001,L=012) *element list
& bsp; dealer DEFAREA SIZE=309
drec DEFINES (F=dealer,P=001,L=309) *returned dlr record
dkey DEFINES (F=dealer,P=001,L=010) *dealer file key
dxyzkey DEFINES (F=dealer,P=004,L=007) *dlr key
dnamKY DEFINES (F=dealer,P=011,L=010) *nam key
dtadlr DEFINES (F=dealer,P=021,L=007) *ta dealer key
before DEFAREA SIZE=162
brec DEFINES (F=before,P=001,L=162) *before compare area
after DEFAREA SIZE=162
arec DEFINES (F=after,P=001,L=162) *after compare area
branch DEFAREA SIZE=162
rec DEFINES (F=branch,P=001,L=162) *returned brn record
bkey DEFINES (F=branch,P=001,L=010) *branch file key
bco DEFINES (F=branch,P=001,L=003) *company key
bbrnky DEFINES (F=branch,P=004,L=007) *xyz brn key
bdlrky DEFINES (F=branch,P=011,L=007) *xyz dlr key
bnamky DEFINES (F=branch,P=018,L=010) *xyz nam key
btabrn DEFINES (F=branch,P=028,L=009) *ta branch key
bstatus DEFINES (F=branch,P=095,L=001) *branch status
boperid DEFINES (F=branch,P=111,L=003) *operator id
bmaintdt DEFINES (F=branch,P=122,L=008) *maint date
bmainttm DEFINES (F=branch,P=130,L=006) *maint time
*************************************************
* Read the dealer by TA-DEALER-NO then *
* Read the branch by TA-BRANCH-NO and XYZ-DLR *
*************************************************
BEGIN PERFORM GETDLR *Get the dealer key
INIT MOVE 'BRN' TO tblname1.
MOVE 'BRNK1' TO keyname1.
CVTBIN '74' TO dbid1. *Dbase area
MOVE 'BRNRE' TO elmlist1.
MOVE dxyzkey TO kydlr. *xyz dealer key
MOVE ' ' TO kybrn. *TA branch no
** ***Position record
START MOVE 'GSETL' TO reqcmd1.
CALL DBNTRY USING userinf1, -
request1, -
rec, -
elmlist1.
** ***Read next record
LOOP MOVE 'GETIT' TO reqcmd1.
CALL DBNTRY USING userinf1, -
request1, -
rec, -
elmlist1.
IF rc1 NOT EQUAL ' ' *If done
EXHIBIT ' ' * display msg
EXHIBIT 'TASK FINISHED' * and shutdown
EXHIBIT rc1 *
GOTO EOJ. *
IF bdlrky NOT EQUAL dxyzkey *If end of dealer
EXHIBIT 'END OF PROCESS' * display msg
GOTO EOJ. * shutdown
IF btabrn = litbrn *If tA branch found
ADD '1' TO COUNTIN OF before * up rec count
ADD '1' TO COUNTIN OF after * up rec count
MOVE rec TO brec * save before image
MOVE '0' TO bstatus * reset status code
MOVE 'D1M' TO boperid * reset operid
MOVE '19911030' TO bmaintdt * reset maint date
MOVE '000000' TO bmainttm * reset maint date
PERFORM BRNUPD * perform upd brn
MOVE rec TO arec * save after image
COMPARE before TO after. * issue compare rpt
GOTO LOOP.
*************************************************
* Update the branch with new data *
*************************************************
BRNUPD MOVE 'UPDAT' TO reqcmd1.
CALL DBNTRY USING userinf1, -
request1, -
rec, -
elmlist1.
IF rc1 NOT EQUAL ' ' *If done
EXHIBIT ' ' * display msg
EXHIBIT 'UPDATE FAILED' * and shutdown
EXHIBIT 'TASK FINISHED' *
EXHIBIT rc1 *
GOTO EOJ. *
RETURN.
*************************************************
* Get the dealer xyz key for the branch read *
*************************************************
GETDLR MOVE 'DLR' TO tblname1.
MOVE 'DLRK1' TO keyname1.
CVTBIN '74' TO dbid1. *date base area
MOVE 'DLRRE' TO elmlist1.
MOVE litdlr TO kydlr. *TA dealer no
** ***position record
MOVE 'GSETL' TO reqcmd1.
CALL DBNTRY USING userinf1, -
request1, -
drec, -
elmlist1.
** ***read next record
MOVE 'GETIT' TO reqcmd1.
CALL DBNTRY USING userinf1, -
request1, -
drec, -
elmlist1.
IF rc1 NOT EQUAL ' ' *If done
EXHIBIT ' ' * display msg
EXHIBIT 'TASK FINISHED' * and shutdown
EXHIBIT 'dealer NOT FOUND' *
EXHIBIT rc1 *
GOTO EOJ. *
IF dtadlr NOT EQUAL litdlr *If end of dealer
EXHIBIT 'dealer NOT FOUND' * display msg
GOTO EOJ. * shutdown
ADD '1' TO COUNTIN OF dealer. *Up rec count
RETURN.
DESCRIPTION: The CA-DATACOM database record will be updated and a before andafter data compare
will be made to audit the changes made. Keys are selected andread. An image is held in a
work area before it is modified and updated. Thecompare request then prints the audit.
INPUTS: CA-DATACOM files as defined in the URT. URT's can be borrowed fromnormal
application programs. WORKBENCH access will be limited the URT's limits.
OUTPUTS: Modified database record.
PROCESS STEPS: Database is read using NATIVE mode.
The branch key is stored in the dealer record.
Get the Branch record and reset the desired fields.
Update the row.
Compare the before to after records for auditing.
Terminate.
LIST IMS SEGMENTS WITH BAD DATES
//jobname JOB (12345,12345),'name ',MSGCLASS=X,CLASS=A
//step01 EXEC BENCHIMS,PSB='arcsecg#',REGION=6M
//arcsec1 DD DSN=arc.test.sec1,DISP=SHR
//arcsec2 DD DSN=arc.test.sec2,DISP=SHR
//arcseci DD DSN=arc.test.seci,DISP=SHR
//arcsecx DD DSN=arc.test.secx,DISP=SHR
//SYSIN DD *
*****************************************************
* Process will select all t-bill securities that *
* have a bad issue/maturity date *
*****************************************************
ENTRY DLITCBL USING pcb1.
pcb1 DLILINK (N=pcb1,P=1,L=50)
pcb1RC DLILINK (N=pcb1,P=11,L=2)
pcb1NAM DLILINK (N=pcb1,P=21,L=8)
*
sec DEFAREA SIZE=200
sec2 DEFAREA SIZE=100
wrk1 DEFAREA SIZE=100
*
sec1 DEFINES (F=sec,P=1,L=200) *
sec1sec DEFINES (F=sec,P=01,L=10,T=C) *
sec1cat DEFINES (F=sec,P=11,L=1,T=C) *Looking for "K"
sec1typ DEFINES (F=sec,P=14,L=2,T=C) *Looking for "01"
sec1mat DEFINES (F=sec,P=50,L=5,T=P) *Maturity date
sec2 DEFINES (F=sec2,P=1,L=100) *
sec2iss DEFINES (F=sec2,P=41,L=4,T=P) *Issue date
* *
ssa1 DEFINES (F=wrk1,P=1,L=100) *
ssa1cmd DEFINES (F=wrk1,P=18,L=02,T=C) *SSA access cmd
ssa1sec DEFINES (F=wrk1,P=20,L=10,T=C) *Set up the security cusip nbr
wkdate DEFINES (F=wrk1,P=50,L=5,T=P) *Work maturity date
good DEFINES ' '
gn DEFINES 'GN '
gu DEFINES 'GU '
ssa0 DEFINES 'sec '
ssa1lit DEFINES 'sec (KEY >0000000000)'
ssa2 DEFINES 'sec2 '
total DEFINES P'+0000000'
swfound DEFINES 'N'
* *
begin MOVE ssa1lit TO ssa1. *Init ssa1 literal
nextent CALL CBLTDLI USING gn, pcb1, sec1, ssa1. *Get next sec1
MOVE sec1sec TO ssa1sec. *Init ssa1 literal
next010 IF pcb1rc NOT EQUAL good *If not ok
EXHIBIT 'SEC1 FINISHED' * terminate
EXHIBIT pcb1rc *
EXHIBIT total *
GOTO EOJ. *
MOVE 'N' TO swfound. *Reset flag
ADD '1' TO COUNTIN OF sec. *Up count
IF sec1cat = 'K' *Catagory K and
IF sec1typ = '01' * pricetype = 01
MOVE 'Y' TO swfound * set found ind
PERFORM getsec2. * get issue date
IF swfound = 'Y' *IF sec1&sec2 found
IF sec1mat NUMERIC * and valid numeric
IF sec2iss NUMERIC *
MOVE sec1mat TO wkdate * mat - issue date
SUBTRACT sec2iss FROM wkdate * must be less than
IF wkdate > '19010000' * a year
PERFORM rpterr. * report the error
GOTO nextent. *Get next list
*****************************************************
* Test to see if the security exists *
*****************************************************
getsec2 MOVE '=' TO ssa1cmd.
CALL CBLTDLI USING gn, pcb1, sec2, ssa1, ssa2.
MOVE '>' TO ssa1cmd.
IF pcb1rc NOT EQUAL good *If not ok
MOVE 'N' TO swfound * set not found
RETURN. *
ADD '1' TO COUNTIN OF sec2. *Up count
MOVE 'Y' TO swfound. *
RETURN. *
*****************************************************
* Report the security in a report format *
*****************************************************
rpterr EXHIBIT sec1sec. *
EXHIBIT sec2iss. *
EXHIBIT sec1mat. *
ADD '1' TO total. *
RETURN. *
DESCRIPTION: The IMS database segments will be searched for any securityissues of a particular
classification to see if it's issue/maturity dates arebad.
INPUTS: IMS database files. WORKBENCH access is limited by the PSB limits.
OUTPUTS: Exhibit listing.
PROCESS STEPS: Database is read using normal DLI calls.
Every security root is examined for dates in the dependent
segment.
IMS TO DB2 DATA BASE TRANSFER
//jobname JOB (12345,12345),'name ',MSGCLASS=X,CLASS=A
//step01 EXEC BENCHIMS,PSB='psbname',REGION=6M
//userdb1 DD DSN=test1.database,DISP=SHR
//userdb2 DD DSN=test2.database,DISP=SHR
//userdb3 DD DSN=test3.database,DISP=SHR
//SYSIN DD *
**************************************************
* dli data base print and dump
**************************************************
ENTRY DLITCBL USING pcb1.
insarea DEFAREA SIZE=500 *memory work
pcb1 DLILINK (N=pcb1,P=1,L=50) *pcb area 1
pcb1rc DLILINK (N=pcb1,P=11,L=2) *
insrec DEFINES (F=insarea,P=1,L=500) *segment build area
id DEFINES (F=insarea,P=01,L=4) *
key DEFINES (F=insarea,P=05,L=10) & bsp; *
result DEFINES (F=insarea,P=15,L=80) *
gn DEFINES 'GN ' *access get next
ssa1 DEFINES 'INSURED ' *segment name
total DEFINES P'0000000' *
good DEFINES ' ' *
DB2-CONNECT SYSTEM=db2t. *access DB2 environment
loop CALL CBLTDLI USING gn pcb1 insrec ssa1. *get IMS segment
IF pcb1rc NOT EQUAL good *if end of segment
EXHIBIT total * yes-shutdown
EXHIBIT pcb1
GOTO EPILOGUE.
ADD '1' TO COUNTIN OF insarea. *up record count
IF date = '19891209' *if correct date
DUMP insarea * yes-dump segment
EXEC SQL INSERT IN TO db2.lmsttbt
(table_id, table_key, table_result, online_timestamp)
VALUES (:id, :key, :result, CURRENT TIMESTAMP) END-EXEC
IF SQLCODE NOT = '0'
EXHIBIT 'insert error....'
EXHIBIT key
EXHIBIT SQLCODE
EXEC SQL ROLLBACK END-EXEC
GOTO EPILOGUE.
GOTO LOOP.
EPILOGUE DB2-DISCONNECT.
GOTO EOJ.
DESCRIPTION This sample dumps and loads IMS database segments under the nameof INSURED to a DB2
table. Only segments with a date of 1989-12-09 will bechosen. Fields can be modified or
converted before inserts.
INPUTS IMS Data bases for insured segments.
OUTPUTS DB2 table
PROCESS STEPS: Begin process under IMS control using BENCHIMS proc
Read segments via DLI call.
Insert the new row into DB2.
Loop until done.
LOAD CA-DATACOM TO A DB2 DATA BASE
//jobname JOB (12345,12345),'name ',MSGCLASS=X,CLASS=A
//step1 EXEC BENCHDB,URT=D1M890U1
//SYSIN DD *
*************************************************
* working storage area *
*************************************************
litdlr DEFINES '0005594' <============ TA dealer nbr to load
com1 DEFAREA SIZE=400
userinf1 DEFINES (F=com1,P=001,L=32) ***Datacom request block
request1 DEFINES (F=com1,P=100,L=203)
reqcmd1 DEFINES (F=com1,P=100,L=005)
tblname1 DEFINES (F=com1,P=105,L=003)
keyname1 DEFINES (F=com1,P=108,L=005)
rc1 DEFINES (F=com1,P=113,L=002)
f11 DEFINES (F=com1,P=115,L=001)
dbid1 DEFINES (F=com1,P=116,L=002,T=X)
tblid1 DEFINES (F=com1,P=118,L=002,T=X)
recid1 DEFINES (F=com1,P=120,L=005)
f21 DEFINES (F=com1,P=125,L=051)
key1 DEFINES (F=com1,P=176,L=027) *key area
kydlr DEFINES (F=com1,P=176,L=007)
kybrn DEFINES (F=com1,P=183,L=009)
eml DEFAREA SIZE=60
elmlist1 DEFINES (F=eml,P=001,L=012) *element list
dealer DEFAREA SIZE=309
drec DEFINES (F=dealer,P=001,L=309) *returned dlr record
dkey DEFINES (F=dealer,P=001,L=010) *dealer file key
dxyzkey DEFINES (F=dealer,P=004,L=007) *dlr key
dnamky DEFINES (F=dealer,P=011,L=010) *nam key
dtadlr DEFINES (F=dealer,P=021,L=007) *ta dealer key
*************************************************
* Get the dealer xyz key to load into DB2 *
*************************************************
DB2-CONNECT SYSTEM=db2t. *access DB2 environment
GETDLR MOVE 'DLR' TO tblname1.
MOVE 'DLRK1' TO keyname1.
CVTBIN '74' TO dbid1. *date base area
MOVE 'DLRRE' TO elmlist1.
MOVE litdlr TO kydlr. *TA dealer no
MOVE 'GSETL' TO reqcmd1. *get record
CALL DBNTRY USING userinf1, request1, drec, elmlist1.
MOVE 'GETIT' TO reqcmd1.
CALL DBNTRY USING userinf1, request1, drec, elmlist1.
IF rc1 NOT EQUAL ' ' *If done
EXHIBIT 'dealer NOT FOUND' * shutdown
EXHIBIT rc1 *
GOTO EPILOGIE. *
IF dtadlr NOT EQUAL litdlr *If end of dealer
EXHIBIT 'dealer NOT FOUND' * display msg
GOTO EPILOGUE. * shutdown
EXEC SQL INSERT IN TO db2.lmsttbt
(dlr_key, name_key, ta_dlr_nbr, online_timestamp)
VALUES (:dxyzkey, :dnamky, :dtadlr, CURRENT TIMESTAMP) END-EXEC
IF SQLCODE NOT = '0'
EXHIBIT 'insert error....'
EXHIBIT SQLCODE
GOTO EPILOGUE.
EPILOGUE DB2-DISCONNECT.
GOTO EOJ.
DESCRIPTION: The CA-DATACOM database record will be read andloaded to a DB2 table.
INPUTS: CA-DATACOM files as defined in the URT.
OUTPUTS: Modified DB2 database record.
PROCESS STEPS: Database is read using NATIVE mode.
Insert using DB2 SQL commands.
Terminate.
DYNAMIC FILE CREATION FROM A LIST
//jobname JOB (12345,12345),'name ',MSGCLASS=X,CLASS=A
//step1 EXEC BENCH
//LIST DD *
ACCT1
ACCT2
ACCT3
ACCT4
//DATA DD *
DATA REC1
DATA REC2
DATA REC3
//SYSIN DD *
*********************************************
* INPUT RECORDS *
*********************************************
ACCTNUM DEFINES (F=LIST,P=1,L=5)
DATAREC DEFINES (F=DATA,P=1,L=80)
*********************************************
* DYNALLOC REQUEST BLOCK FOR INFO MESSAGES *
*********************************************
WORK1 DEFAREA SIZE=300
REQBLOCK DEFINES (F=WORK1,P=1,L=20)
REQBSIZE DEFINES (F=WORK1,P=1,L=1,T=X)
REQBVERB DEFINES (F=WORK1,P=2,L=1,T=X)
REQBFLG1 DEFINES (F=WORK1,P=3,L=2,T=X)
REQBERR DEFINES (F=WORK1,P=5,L=2,T=X)
REQBINFO DEFINES (F=WORK1,P=7,L=2,T=X)
REQBTEXT DEFINES (F=WORK1,P=9,L=4,T=X)
REQBRSRV DEFINES (F=WORK1,P=13,L=4,T=X)
REQBFLG2 DEFINES (F=WORK1,P=17,L=4,T=X)
*********************************************
* DYNALLOC REQUEST TEXT AREA *
*********************************************
TEXT1 DEFINES (F=WORK1,P=101,L=12)
TXT1DATA DEFINES (F=WORK1,P=107,L=6,T=C)
TEXT2 DEFINES (F=WORK1,P=201,L=24)
TXT2DATA DEFINES (F=WORK1,P=207,L=18,T=C)
TXT2ACCT DEFINES (F=WORK1,P=212,L=5,T=C)
TEXT1L DEFINES X'000100010006' *REQUEST DDNAME LEN=6
TEXT2L DEFINES X'000200010012' *REQUEST DATASETNAME LEN=18
TEXT3 DEFINES X'00040001000104' *DISP=(NEW,
TEXT4 DEFINES X'00050001000102' *DISP=( ,CATLG
TEXT5 DEFINES X'00060001000104' *DISP=( , ,DELETE)
TEXT6 DEFINES X'001500010004C4C9E2D2' *UNIT=DISK
TEXT7 DEFINES X'00070000' *SPACE=TRACKS
TEXT8 DEFINES X'000A00010003000005' *SPACE PRIMARY 5 TRKS
TEXT9 DEFINES X'0030000100021F40' *BLKSIZE = 8000
TEXTA DEFINES X'0042000100020050' *LRECL = 80
TEXTB DEFINES X'00490001000190' *RECFM=FB = X'10'+'80'
TEXTC DEFINES X'00040001000102' *DISP=(MOD,
TEXTD DEFINES X'00050001000104' *DISP=( ,DELETE
TEXTE DEFINES X'00060001000104' *DISP=( , ,DELETE)
*********************************************
* INITIALIZE DYNAMIC REQUEST TEXT *
*********************************************
MOVE TEXT1L TO TEXT1. *REQUEST DDNAME
MOVE 'OUTPUT' TO TXT1DATA. *DDNAME=OUTPUT
MOVE TEXT2L TO TEXT2. *REQUEST DATASETNAME
MOVE 'TEST.ACCTX.OUTLIST' TO TXT2DATA.
CVTBIN '20' TO REQBSIZE. *INIT REQUEST BLOCK SIZE
*********************************************
* PROCESS LOOP FOR ACCOUNT LIST *
*********************************************
LOOP1 READ LIST. *READ THE CONTROL LIST
IF RECORDSW OF LIST = 'Y' *IF DONE, STOP JOB
GOTO EOJ. *
MOVE ACCTNUM TO TXT2ACCT *
EXHIBIT 'BUILDING FILE:' *DISPLAY THE FILE NAME
EXHIBIT TXT2DATA *
CVTBIN '1' TO REQBVERB. *REQUEST ALLOC DSNAME "MOD"
** *DELETE THE FILE IF PRESENT
DYNALLOC OUTPUT USING REQBLOCK, TEXT1, TEXT2, TEXTC, TEXTD, -
TEXTE, TEXT6, TEXT7, TEXT8, -
TEXT9, TEXTA, TEXTB.
IF REQBERR NOT = '0' *DISPLAY ANY ERROR
EXHIBIT REQBERR *
EXHIBIT REQBINFO. *
CVTBIN '2' TO REQBVERB. *REQUEST DEALLOCATE DSNAME
** *DELETE THE FILE IF PRESENT
DYNALLOC OUTPUT USING REQBLOCK, TEXT1, TEXT2.
IF REQBERR NOT = '0' *DISPLAY ANY ERRORS
EXHIBIT REQBERR *
EXHIBIT REQBINFO. *
** *ALLOCATE THE FILE
CVTBIN '1' TO REQBVERB. *REQUEST ALLOC DSNAME
DYNALLOC OUTPUT USING REQBLOCK, TEXT1, TEXT2, TEXT3, TEXT4, -
TEXT5, TEXT6, TEXT7, TEXT8, -
TEXT9, TEXTA, TEXTB.
IF REQBERR NOT = '0' *DISPLAY ANY ERRORS
EXHIBIT REQBERR *
EXHIBIT REQBINFO. *
DYNOPEN OUTPUT. *OPEN THE DYNAMIC FILE
******************************************
* OUTPUT THE GIVEN FILE *
******************************************
LOOP READ DATA. *
IF RECORDSW OF DATA = 'Y' *
DYNCLOSE OUTPUT *CLOSE THE DYNAMIC FILE
CVTBIN '2' TO REQBVERB *REQUEST DEALLOCATE DSNAME
DYNALLOC OUTPUT USING REQBLOCK, TEXT1, TEXT2
RESTART DATA *
GOTO LOOP1. *
WRITE OUTPUT FROM DATA. *OUTPUT THE DATA RECORD
GOTO LOOP2. *
DESCRIPTION: This run will read a list of account numbersfrom the list file. For every account read, a new file is created containing allthe records in the detail record file. (Also see the Command Section DYNALLOCfor details on calling text parms.)
INPUTS: List - contains account ids used to build the file names.
Data - contains the data record samples to write on each file.
OUTPUTS: Output - a dynamicly build dataset name 'test.xxxxx.outlist'
test.acct1.outlist as a recfm=fb, blk=8000, len=80
test.acct2.outlist
test.acct3.outlist
test.acct4.outlist
PROCESS STEPS: Read the next account to build a file.
Delete the file name dynamically (mod,delete, delete)
Allocate the file defining the name, unit, and DCB info
Open the file
Write all detail records to the file
Close, and free the dynamic file
Loop for next account to process.
DYNAMIC FILE CREATION FROM TRANSACTION
//jobnameJOB(12345,12345),'name',MSGCLASS=X,CLASS=A
//step1 EXEC BENCH
//TRANFILE DD *
2466AC247657822C890478902789048907V TRANSACTION 1 WE42483234243T1
2466AC247657822C890478902789048907V TRANSACTION 2 WE42483234243T1
2466AC247657822C890478902789048907V TRANSACTION 3 WE42483234243T1
2466AC456757822C890478902789048907V TRANSACTION 1 WE42483234243T1
2466AC557757822C890478902789048907V TRANSACTION 1 WE42483234243T1
2466AC867857822C890478902789048907V TRANSACTION 1 WE42483234243T1
//SYSIN DD *
*********************************************
* INPUT RECORDS *
*********************************************
ACCTNUM DEFINES (F=TRANFILE,P=5,L=6)
CNTOUT DEFINES P'+0000000' *WORK COUNTER
*********************************************
* DYNALLOC REQUEST BLOCK FOR INFO MESSAGES *
*********************************************
WORK1 DEFAREA SIZE=300
REQBLOCK DEFINES (F=WORK1,P=1,L=20)
REQBSIZE DEFINES (F=WORK1,P=1,L=1,T=X)
REQBVERB DEFINES (F=WORK1,P=2,L=1,T=X)
REQBERR DEFINES (F=WORK1,P=5,L=2,T=X)
REQBINFO DEFINES (F=WORK1,P=7,L=2,T=X)
*********************************************
* DYNALLOC REQUEST TEXT AREA *
*********************************************
TEXT1 DEFINES (F=WORK1,P=101,L=12)
TXT1DATA DEFINES (F=WORK1,P=107,L=6,T=C)
TEXT2 DEFINES (F=WORK1,P=201,L=24)
TXT2DATA DEFINES (F=WORK1,P=207,L=18,T=C)
TXT2ACCT DEFINES (F=WORK1,P=212,L=6,T=C)
TEXT1L DEFINES X'000100010006' *REQUEST DDNAME LEN=6
TEXT2L DEFINES X'000200010012' *REQUEST DATASETNAME LEN=18
TEXT3 DEFINES X'00040001000104' *DISP=(NEW,
TEXT4 DEFINES X'00050001000102' *DISP=( ,CATLG
TEXT5 DEFINES X'00060001000104' *DISP=( , ,DELETE)
TEXT6 DEFINES X'001500010004C4C9E2D2' *UNIT=DISK
TEXT7 DEFINES X'00070000' *SPACE=TRACKS
TEXT8 DEFINES X'000A00010003000005' *SPACE PRIMARY 5 TRKS
TEXT9 DEFINES X'0030000100021F40' *BLKSIZE = 8000
TEXTA DEFINES X'0042000100020050' *LRECL = 80
TEXTB DEFINES X'00490001000190' *RECFM=FB = X'10'+'80'
*********************************************
* WORKBENCH PROCESS STATEMENTS
*********************************************
MOVE TEXT1L TO TEXT1. *REQUEST DDNAME
MOVE 'OUTPUT' TO TXT1DATA. *DDNAME=OUTPUT
MOVE TEXT2L TO TEXT2. *REQUEST DATASETNAME
MOVE 'TEST.ACXXXX.TRNOUT' TO TXT2DATA.
CVTBIN '20' TO REQBSIZE. *INIT REQUEST BLOCK SIZE
READ TRANFILE. *READ THE CONTROL LIST
LOOP1 MOVE ACCTNUM TO TXT2ACCT *
** *ALLOCATE THE FILE
CVTBIN '1' TO REQBVERB. *REQUEST ALLOC DSNAME
DYNALLOC OUTPUT USING REQBLOCK, TEXT1, TEXT2, TEXT3, TEXT4, -
TEXT5, TEXT6, TEXT7, TEXT8, -
TEXT9, TEXTA, TEXTB.
IF REQBERR NOT = '0' *DISPLAY ANY ERRORS
EXHIBIT REQBERR *
EXHIBIT REQBINFO. *
DYNOPEN OUTPUT. *OPEN THE DYNAMIC FILE
CVTDEC '0' TO CNTOUT. *CLEAR COUNTER
LOOP2 WRITE OUTPUT FROM TRANFILE. *OUTPUT THE DATA RECORD
ADD '1' TO CNTOUT. *ADD 1 TO COUNTER
READ TRANFILE. *
IF ACCTNUM = TXT2ACCT *
GOTO LOOP2. *
DYNCLOSE OUTPUT. *CLOSE THE DYNAMIC FILE
EXHIBIT 'RECORDS ON FILE:'. *DISPLAY THE FILE NAME
EXHIBIT TXT2DATA. *
EXHIBIT CNTOUT. *DISPLAY TOTAL RECORDS WRITTEN
CVTBIN '2' TO REQBVERB *REQUEST DEALLOCATE DSNAME
DYNALLOC OUTPUT USING REQBLOCK, TEXT1, TEXT2
GOTO LOOP1. *
EPILOGUE DYNCLOSE OUTPUT *CLOSE THE DYNAMIC FILE
EXHIBIT 'RECORDS ON FILE:'. *DISPLAY THE FILE NAME
EXHIBIT TXT2DATA. *
EXHIBIT CNTOUT. *DISPLAY TOTAL RECORDS WRITTEN
CVTBIN '2' TO REQBVERB *REQUEST DEALLOCATE DSNAME
DYNALLOC OUTPUT USING REQBLOCK, TEXT1, TEXT2
GOTO EOJ. *
DESCRIPTION: This run will read a transaction file and splitthe file into separate cataloged output files based on
the data on the inputfile. The file must be sorted in account id order. Totals are manually
printedfor each file. (See the DYNALLOC command in the Command Section for
explainations of the request block and text areas passed.)
INPUTS: Tranfile - contains transactions for the day.
OUTPUTS: Output - a dynamicly build dataset name 'test.xxxxxx.trnout'' and the output files catalogued
will vary based on the input.
PROCESS STEPS: Read the transaction
(The steps to delete existing file are not shown. See Sample 86)
Allocate the file defining the name, unit, and DCB info
Open the file
Write all detail records to the file
Close, and free the dynamic file
Loop for next account to process.
SYNC FILES TO MODIFY DATA - ONE TO MANY
//jobname JOB (12345,12345),'name',CLASS=A,MSGCLASS=A,TIME=(,10)
//STEP1 EXEC BENCH
//prodpol DD DSN=policy.data(0),DISP=SHR
//polfix DD DSN=patch.data,DISP=SHR
//newprod DD DSN=policy.data(+1),DISP=(NEW,CATLG,DELETE),
// SPACE=(TRK,(1,1)),UNIT=SYSDA,
// DCB=(LRECL=2000,RECFM=VB,BLKSIZE=19076)
//SYSIN DD *
*********************************************
* BENCH WORK AREA DEFINES *
*********************************************
poldate DEFINES (F=prodpol,P=23,L=6)
date DEFINES P'0831231'
prod DEFINES (F=prodpol,P=1,L=10)
fix DEFINES (F=polfix,P=1,L=10)
holdkey DEFINES C'xxxxxxxxxx' *current working key
readloop SYNC prod, fix. *sync policy production
MOVE fix TO holdkey. *save current key to fix
MOVE date TO poldate. *if prod file available
IF prod EQUAL holdkey *if the two files matched
WRITE newprod FROM polfix *write out fixed record
DELETE prodpol. *set prod rec as deleted
WRITE newprod FROM prodpol. *write out if available
GOTO readloop. *loop for more
DESCRIPTION Sync the production and patched records. Patched records willreplace all the production
records matching the patching key.
This example works because the MOVE statement on holdkey will only activatewhen the patch file is present. The holdkey, therefore, remains constant until anew patch record syncs up with a matching production file. This sample is aone-to-many example. For every patch record, all master records are affected.See Sample 20 for a one-to-one example.
INPUTS Production and the patched policy files.
OUTPUTS New production file with data modified.
PROCESS STEPS -Read and sync all files. Records are made available forprocessing in groups of matched keys (some groups will only contain 1 filerecord). The move statement will only process on those files having a recordavailable. If prod and fixed files are matching, the new record will be writtenout.
-The production record will be marked as deleted.
-Write out non-matching prod records.
-Loop for more.