Quality, Reliability & Service
Mainframe computing has evolved over the years. Now many of the huge operating environments will function on a 64 bit inexpensive computing platform.
To learn more about mainframe computing please click here.
Mr. Arch Brooks, Software Engineer, Brooks Computing Systems, LLC authored this article.
There are those times when it is necessary to unload a partitioned data set. The unloaded PDS can the be used in a subsequent restore.
//AMBMVS JOB (SYS), 'BROOKS COMPUTING SYSTEMS,LLC',CLASS=A,MSGCLASS=A,
// MSGLEVEL=(1,1)
//PDSUNLD PROC
//SETP0001 EXEC PGM=IEBCOPY
//SYSPRINT DD SYSOUT=*
//SYSUT1 DD DISP=SHR,DSN=AMBMVS.PDS.&LLQ
//SYSUT2 DD DISP=(,CATLG,DELETE),DSN=AMBMVS.&LLQ..OUT,
// UNIT=3390,SPACE=(TRK,(1,2),RLSE),VOL=SER=USR003
//SYSIN DD DISP=SHR,DSN=AMBMVS.PDS.CNTL(UNLD1)
// PEND
//STEP0001 EXEC PDSUNLD,LLQ=ASM
//STEP0002 EXEC PDSUNLD,LLQ=CLIST
//STEP0003 EXEC PDSUNLD,LLQ=CNTL
//STEP0004 EXEC PDSUNLD,LLQ=COBOL
//STEP0005 EXEC PDSUNLD,LLQ=JCL
//STEP0006 EXEC PDSUNLD,LLQ=LOAD
//STEP0007 EXEC PDSUNLD,LLQ=LPRT
//STEP0008 EXEC PDSUNLD,LLQ=OBJ
//STEP0009 EXEC PDSUNLD,LLQ=PLIB
//STEP0009 EXEC PDSUNLD,LLQ=SPRTI prefer to use in stream procedures as opposed to cataloged procedures. In stream procedures allow to apply special configuration as in this example and allow the file naming scheme perform all the perfunctory tasks.
It is a simple modification to add or remove addition PDS’s (partitioned data sets).
Mr. Arch Brooks, Software Engineer, Brooks Computing Systems, LLC authored this article.
There are those time when a different cataloged procedure is required that does not have an entry in the linklist or the proclib concatenation for your mainframe account on Z/OS. The safest way to accomplish the desired effect is to use the proclib statement.
When you specify JCLLIB on the proclib statement you are able to set a search order for locating cataloged procedures from a procedure library that is not defined in your operating system.
//AMBMVS JOB (SYS), 'BROOKS COMPUTING SYSTEMS, LLC',CLASS=A,
// MSGCLASS=A,MSGLEVEL=(1,1)
//*
//*
//PROCLIB JCLLIB ORDER=SYSC.PROCLIB
//STEP0001 EXEC FORTGC
//SYSIN DD DISP=SHR,DSN=AMBMVS.PDS.FORT(TP01)This technique allows the user to avoid creating in stream procs or adding procs to the default proc libraries.
Mr. Arch Brooks, Software Engineer, Brooks Computing Systems, LLC authored this article.
It would be nice to dynamically allocate and free the files need for applications via COBOL. This article describes how a subroutine may be used to accomplish such a feat.
First we will examine the sub program that allow us to accomplish dynamic allocation. The BPXWDYN routine allows a text interface access to the allocate process. The string command may be used but I found it did not exactly give me the result I desired so I used a couple existing programs to fill the bill. The sub program ABS00004 that detects the end of the string performs most of the heavy lifting.
000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. ABS00018.
000300 AUTHOR. ARCH BROOKS.
000400 INSTALLATION BROOKS COMPUTING SYSTEMS, LLC.
000500 DATE-WRITTEN. 10/24/2014.
000600 DATE-COMPILED. 10/24/2014.
000700 ENVIRONMENT DIVISION.
000800 CONFIGURATION SECTION.
000900 SOURCE-COMPUTER. IBM-Z-OS.
001000 OBJECT-COMPUTER. IBM-Z-OS.
001100 INPUT-OUTPUT SECTION.
001200 FILE-CONTROL.
001300 DATA DIVISION.
001400 FILE SECTION.
001500 WORKING-STORAGE SECTION.
001600 01 PGM PIC X(8) VALUE 'BPXWDYN'.
001700 01 BUF-500 PIC X(500).
001800 01 CMD-BUF PIC X(250).
001900 01 RLEN PIC S9(9) COMP.
002000 01 RCOB PIC S9(9) COMP.
002100 LINKAGE SECTION.
002200 01 DDNAME PIC X(9).
002300 01 DSN PIC X(100).
002400 01 DISP PIC X(50).
002500 01 DCB PIC X(100).
002600 01 FREE-CMD PIC X(100).
002700 01 RC PIC S9(9) COMP.
002800 PROCEDURE DIVISION USING DDNAME DSN DISP DCB RC.
002900 MOVE 'ALLOC FI(' TO CMD-BUF.
003000 PERFORM 0010-DET-RCOB-LEN.
003100 MOVE DDNAME TO BUF-500.
003200 PERFORM 0020-GET-500-LEN.
003300 MOVE DDNAME TO CMD-BUF(RCOB:).
003400 PERFORM 0010-DET-RCOB-LEN.
003500 MOVE DSN TO BUF-500.
003600 PERFORM 0020-GET-500-LEN.
003700 MOVE ') DSN(' TO CMD-BUF(RCOB:).
003800 PERFORM 0010-DET-RCOB-LEN.
003900 MOVE DSN TO CMD-BUF(RCOB:).
004000 PERFORM 0010-DET-RCOB-LEN.
004100 MOVE ')' TO CMD-BUF(RCOB:).
004200 PERFORM 0010-DET-RCOB-LEN.
004300 MOVE DISP TO BUF-500.
004400 PERFORM 0020-GET-500-LEN.
004500 ADD 1 TO RCOB.
004600 PERFORM 0010-DET-RCOB-LEN.
004700 ADD 1 TO RCOB.
004800 MOVE DISP TO CMD-BUF(RCOB:).
004900 PERFORM 0010-DET-RCOB-LEN.
005000 PERFORM 0040-XQT-ALLOC.
005100 PERFORM 0030-LEAVE-PROGRAM.
005200 ENTRY 'ABS0018A' USING FREE-CMD RC.
005300 MOVE FREE-CMD TO CMD-BUF.
005400 PERFORM 0040-XQT-ALLOC.
005500 PERFORM 0030-LEAVE-PROGRAM.
005600 0010-DET-RCOB-LEN.
005700 MOVE CMD-BUF TO BUF-500.
005800 CALL 'ABS00004' USING BUF-500 RCOB.
005900 ADD 1 TO RCOB.
006000 0020-GET-500-LEN.
006100 CALL 'ABS00004' USING BUF-500 RLEN.
006200 0030-LEAVE-PROGRAM.
006300 GOBACK.
006400 0040-XQT-ALLOC.
006500 CALL PGM USING CMD-BUF.
006600 MOVE RETURN-CODE TO RC.I have added the subroutine that actually performs the IO write to verify that the allocation was successful.
000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. ABS00003.
000300 AUTHOR. ARCH BROOKS.
000400 INSTALLATION BROOKS COMPUTING SYSTEMS, LLC.
000500 DATE-WRITTEN. 09/15/2014.
000600 DATE-COMPILED. 09/15/2014.
000700*
000800*
000900* THIS PROGRAM IS DESIGNED TO WRITE RECORDS TO THE FILE.
001000*
001100*
001200*
001300*
001400 ENVIRONMENT DIVISION.
001500 INPUT-OUTPUT SECTION.
001600 FILE-CONTROL.
001700 SELECT F-FILE ASSIGN TO UT-S-FSOUT
001800 ORGANIZATION IS SEQUENTIAL.
001900 DATA DIVISION.
002000 FILE SECTION.
002100 FD F-FILE
002200 DATA RECORD IS F-RECORD
002300 BLOCK CONTAINS 0 RECORDS
002400 RECORDING MODE IS F.
002500 01 F-RECORD PIC X(80).
002600 WORKING-STORAGE SECTION.
002700 LINKAGE SECTION.
002800 01 LSBUF PIC X(80).
002900 PROCEDURE DIVISION.
003000* OPEN THE OUTPUT FILE
003100 OPEN OUTPUT F-FILE.
003200 PERFORM 0010-RETURN.
003300* WRITE A RECORD
003400 ENTRY 'ABS0003A' USING LSBUF.
003500 WRITE F-RECORD FROM LSBUF.
003600 PERFORM 0010-RETURN.
003700* CLOSE THE FILE
003800 ENTRY 'ABS0003B'.
003900 CLOSE F-FILE.
004000 PERFORM 0010-RETURN.
004100* LETS GET OUT OF HERE
004200 0010-RETURN.
004300 GOBACK.Next we will review our driver or calling program.
000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. ABM00026.
000300 AUTHOR. ARCH BROOKS.
000400 INSTALLATION BROOKS COMPUTING SYSTEMS, LLC.
000500 DATE-WRITTEN. 10/24/2014.
000600 DATE-COMPILED. 10/24/2014.
000700 ENVIRONMENT DIVISION.
000800 CONFIGURATION SECTION.
000900 SOURCE-COMPUTER. IBM-Z-OS.
001000 OBJECT-COMPUTER. IBM-Z-OS.
001100 INPUT-OUTPUT SECTION.
001200 FILE-CONTROL.
001300 DATA DIVISION.
001400 FILE SECTION.
001500 WORKING-STORAGE SECTION.
001600 01 DDNAME PIC X(9).
001700 01 DSN PIC X(100).
001800 01 DISP PIC X(50).
001900 01 DCB PIC X(100).
002000 01 RC PIC S9(9) COMP.
002100 01 OBUF PIC X(80).
002200 01 FREE-CMD PIC X(100).
002300 PROCEDURE DIVISION.
002400*
002500* PREPARE ALLOCATE STATEMENT
002600*
002700 MOVE 'FSOUT' TO DDNAME.
002800 MOVE 'AMBMVS.PDS.JCL(XXXALC)' TO DSN.
002900 MOVE 'SHR' TO DISP.
003000 MOVE ' ' TO DCB.
003100*
003200* INVOKE ALLOCATE STATEMENT
003300*
003400 CALL 'ABS00018' USING DDNAME DSN DISP DCB RC.
003500*
003600* OPEN OUTPUT FILE
003700*
003800 CALL 'ABS00003'.
003900 MOVE 'CCCC' TO OBUF.
004000*
004100* WRITE A RECORD TO OTPUT FILE
004200*
004300 CALL 'ABS0003A' USING OBUF.
004400 MOVE 'DDDD' TO OBUF.
004500*
004600* WRITE A RECORD TO OTPUT FILE
004700*
004800 CALL 'ABS0003A' USING OBUF.
004900*
005000* CLOSE OUTPUT FILE
005100*
005200 CALL 'ABS0003B'.
005300*
005400* PREPARE FREE COMMAND
005500*
005600 MOVE 'FREE FI(FSOUT)' TO FREE-CMD.
005700*
005800* INVOKE FREE COMMAND
005900*
006000 CALL 'ABS0018B' USING FREE-CMD RC.
006100 GOBACK.Mr. Arch Brooks, Software Engineer, Brooks Computing Systems, LLC authored this article.
There are those time when a KSDS (key sequenced data set) using the VSAM (virtual sequential access method) fits the users requirements. The following example explains how such a feat is accomplished. First we need to create the KSDS and the JCL listed below defines how we will create our cluster.
//AMBMVS JOB (SYS), 'BROOKS COMPUTING SYSTEMS, LLC',CLASS=A,
// MSGCLASS=A,MSGLEVEL=(1,1)
//*
//*
//DEFKSDS EXEC PGM=IDCAMS
//SYSPRINT DD DSN=AMBMVS.PDS.SPRT(KSDS),DISP=SHR
//SYSIN DD *
DELETE (AMBMVS.VSAMKSDS.EMPSORTD) CLUSTER
DEFINE CLUSTER ( -
NAME (AMBMVS.VSAMKSDS.EMPSORTD) -
CYLINDERS(1,1) -
KEYS(20,0) -
VOLUME(USR003) -
RECORDSIZE(80,80) -
INDEXED )
REPRO INFILE(INFILE) OUTDATASET(AMBMVS.VSAMKSDS.EMPSORTD)
/*
//INFILE DD DSN=AMBMVS.PDS.CNTL(INPKSDS),DISP=SHR
//*The input data is listed below.
BUD WHYZER 05000 9 0001 0000001 000000
RALPH CRAMDEN 03000 1 0040 0000055 000022
MIKE KEE 06000 1 0200 0000020 000020
L. A. VATOR 07000 5 0020 0000033 000033
PAUL LONGA 04000 0 0002 0000022 000011
PEARLE E. GATES 01000 2 0010 0000020 000300
MIKE MENZA 02000 3 0030 0000050 000020Next we will review the COBOL sub program that will perform the VSAM IO.
000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. ABS00017.
000300 AUTHOR. ARCH BROOKS.
000400 INSTALLATION BROOKS COMPUTING SYSTEMS, LLC.
000500 DATE-WRITTEN. 10/21/2014.
000600 DATE-COMPILED. 10/21/2014.
000700 ENVIRONMENT DIVISION.
000800 CONFIGURATION SECTION.
000900 SOURCE-COMPUTER. IBM-Z-OS.
001000 OBJECT-COMPUTER. IBM-Z-OS.
001100 INPUT-OUTPUT SECTION.
001200 FILE-CONTROL.
001300 SELECT VSAM-KSDS-FILE ASSIGN VSAMKSDS
001400 ORGANIZATION IS INDEXED
001500 ACCESS MODE IS RANDOM
001600 RECORD KEY IS VSAM-KSDS-RECORD-KEY
001700 FILE STATUS IS VSAM-STATUS-CODE.
001800 DATA DIVISION.
001900 FILE SECTION.
002000 FD VSAM-KSDS-FILE.
002100 01 VSAM-KSDS-RECORD.
002200 05 VSAM-KSDS-RECORD-KEY PIC X(20).
002300 05 VSAM-KSDS-EMP-INFO PIC X(60).
002400 WORKING-STORAGE SECTION.
002500 LINKAGE SECTION.
002600 01 VSAM-STATUS-CODE.
002700 05 VSAM-STATUS-CODE-BYTE1 PIC X.
002800 05 VSAM-STATUS-CODE-BYTE2 PIC X.
002900 01 REC-KEY PIC X(20).
003000 01 REC-BUF PIC X(80).
003100 PROCEDURE DIVISION USING VSAM-STATUS-CODE.
003200 PERFORM 0010-INIT.
003300 0010-INIT.
003400 OPEN INPUT VSAM-KSDS-FILE
003500 IF VSAM-STATUS-CODE IS NOT EQUAL TO '00' THEN
003600 PERFORM 0050-ERROR-EXIT.
003700 PERFORM 0060-LEAVE-PROGRAM.
003800 ENTRY 'ABS0017A' USING VSAM-STATUS-CODE REC-KEY REC-BUF.
003900 0030-RANDOM-READ.
004000 MOVE REC-KEY TO VSAM-KSDS-RECORD-KEY.
004100 READ VSAM-KSDS-FILE.
004200 MOVE VSAM-KSDS-RECORD TO REC-BUF.
004300 PERFORM 0060-LEAVE-PROGRAM.
004400 ENTRY 'ABS0017B' USING VSAM-STATUS-CODE.
004500 0040-TERMINATION.
004600 CLOSE VSAM-KSDS-FILE.
004700 PERFORM 0060-LEAVE-PROGRAM.
004800 0050-ERROR-EXIT.
004900 DISPLAY 'ERROR DETECTED '.
005000 PERFORM 0060-LEAVE-PROGRAM.
005100 0060-LEAVE-PROGRAM.
005200 GOBACK.Now we will review the calling COBOL program.
000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. ABM00025.
000300 AUTHOR. ARCH BROOKS.
000400 INSTALLATION BROOKS COMPUTING SYSTEMS, LLC.
000500 DATE-WRITTEN. 10/23/2014.
000600 DATE-COMPILED. 10/23/2014.
000700 ENVIRONMENT DIVISION.
000800 CONFIGURATION SECTION.
000900 SOURCE-COMPUTER. IBM-Z-OS.
001000 OBJECT-COMPUTER. IBM-Z-OS.
001100 INPUT-OUTPUT SECTION.
001200 FILE-CONTROL.
001300 DATA DIVISION.
001400 FILE SECTION.
001500 WORKING-STORAGE SECTION.
001600 01 REC-KEY PIC X(20).
001700 01 S-CODE PIC XX.
001800 01 REC-BUF PIC X(80).
001900 PROCEDURE DIVISION.
002000 MOVE ' ' TO S-CODE.
002100 CALL 'ABS00017' USING S-CODE.
002200 DISPLAY 'OPEN STATUS IS ' S-CODE.
002300 MOVE 'BUD WHYZER' TO REC-KEY
002400 CALL 'ABS0017A' USING S-CODE REC-KEY REC-BUF.
002500 IF S-CODE = '00'
002600 THEN DISPLAY 'RECORD READ ' REC-KEY
002700 DISPLAY REC-BUF
002800 ELSE IF S-CODE = '23'
002900 THEN DISPLAY 'RECORD NOT FOUND ' REC-KEY.
003000 CALL 'ABS0017B' USING S-CODE.
003100 GOBACK.Now we will review the command procedure that invokes the calling program.
PROC 0
CONTROL NOLIST NOMSG
FREE FI(SYSPRINT SYSOUT FSFIN VSAMKSDS))
ALLOC F(VSAMKSDS) DA(VSAMKSDS.EMPSORTD) SHR
ALLOC FI(SYSPRINT) DA(*)
ALLOC FI(FSFIN) DA(*)
ALLOC FI(SYSOUT) DA(*)
CALL 'AMBMVS.PDS.LOAD(ABM00025)'
FREE FI(SYSPRINT SYSOUT FSFIN VSAMKSDS)Upon successful execution of the command procedure you will notice the return code and well as the fetched record will be displayed.
Mr. Arch Brooks, Software Engineer, Brooks Computing Systems, LLC authored this article.
We maintain Z/OS mainframe accounts which allows us to maintain continuity with state of the art operating environments.
Mr. Arch Brooks, Software Engineer, Brooks Computing Systems, LLC authored this article.
There are those times when parameters are useful to provide solution to automation tasks. This program takes a string of parameters delimited by a specific character and parses each parameter into a data area which is employed in subsequent processing.
000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. ABM00015.
000300 AUTHOR. ARCH BROOKS.
000400 INSTALLATION BROOKS COMPUTING SYSTEMS, LLC.
000500 DATE-WRITTEN. 09/27/2014.
000600 DATE-COMPILED. 09/27/2014.
000700 ENVIRONMENT DIVISION.
000800 CONFIGURATION SECTION.
000900 SOURCE-COMPUTER. IBM-Z-OS.
001000 OBJECT-COMPUTER. IBM-Z-OS.
001100 INPUT-OUTPUT SECTION.
001200 FILE-CONTROL.
001300 DATA DIVISION.
001400 FILE SECTION.
001500 WORKING-STORAGE SECTION.
001600 01 PNDX PIC S9(4) COMP.
001700 01 PBUF-AREA.
001800 05 PBUF PIC X(100) OCCURS 100 TIMES.
001900 01 PARM-BUFFER.
002000 05 PARM-LENGTH PIC S9(4) COMP.
002100 05 PARM-DATA PIC X(256).
002200 01 NUM PIC S9(4) COMP.
002300 01 PARM-DELIMITER PIC X.
002400 PROCEDURE DIVISION.
002500 MOVE '@PARM1@PARM2@PARM3@PARM4@PARM5' TO PARM-DATA.
002600 MOVE 30 TO PARM-LENGTH.
002700 MOVE '@' TO PARM-DELIMITER.
002800 CALL 'ABS00011' USING PARM-BUFFER PBUF-AREA NUM
002900 PARM-DELIMITER.
003000 DISPLAY 'NUM = *' NUM '*'.
003100 MOVE 1 TO PNDX.
003200 PERFORM 0010-DISP-PARMS UNTIL PNDX > NUM.
003300 GOBACK.
003400 0010-DISP-PARMS.
003500 DISPLAY 'PB AREA =*' PBUF (PNDX) '*'.
003600 ADD 1 TO PNDX.The called sub program that unstinting the parameters is shown here.
000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. ABS00011.
000300 AUTHOR. ARCH BROOKS.
000400 INSTALLATION BROOKS COMPUTING SYSTEMS, LLC.
000500 DATE-WRITTEN. 09/27/2014.
000600 DATE-COMPILED. 09/27/2014.
000700 ENVIRONMENT DIVISION.
000800 CONFIGURATION SECTION.
000900 SOURCE-COMPUTER. IBM-Z-OS.
001000 OBJECT-COMPUTER. IBM-Z-OS.
001100 INPUT-OUTPUT SECTION.
001200 FILE-CONTROL.
001300 DATA DIVISION.
001400 FILE SECTION.
001500 WORKING-STORAGE SECTION.
001600 77 PC-INDX PIC 99.
001700 77 BF PIC 99.
001800 77 EF PIC 99.
001900 77 DNDX PIC 99.
002000 77 PNDX PIC 99.
002100 77 SOP PIC 99.
002200 77 EP PIC 99.
002300 77 RX PIC 99.
002400 77 PP PIC 99.
002500 01 PPD-AREA.
002600 05 PPD PIC X OCCURS 100 TIMES.
002700 01 DET-NDX-AREA.
002800 05 DET-NDX PIC 99 OCCURS 100 TIMES.
002900 01 PP2 PIC S9(4) COMP.
003000 LINKAGE SECTION.
003100 01 PARM-BUFFER.
003200 05 PARM-LENGTH PIC S9(4) COMP.
003300 05 PARM-DATA PIC X(256).
003400 05 PARM-CHAR-AREA REDEFINES PARM-DATA.
003500 10 PARM-CHAR OCCURS 256 TIMES PIC X.
003600 01 PBUF-AREA.
003700 05 PBUF PIC X(100) OCCURS 100 TIMES.
003800 01 ROP PIC S9(4) COMP.
003900 01 PARM-DELIMITER PIC X.
004000 PROCEDURE DIVISION USING PARM-BUFFER PBUF-AREA ROP
004100 PARM-DELIMITER.
004200* MOVE '@PARM1@PARM2@PARM3@PARM4@PARM5' TO PARM-DATA.
004300* MOVE 30 TO PARM-LENGTH.
004400 MOVE 1 TO DNDX.
004500 PERFORM 0010-DET-FLAG VARYING PC-INDX FROM 1 BY 1
004600 UNTIL PC-INDX > PARM-LENGTH.
004700 PERFORM 0030-GET-PARMS.
004800 PERFORM 0050-PRINT-PARMS.
004900 GOBACK.
005000 0010-DET-FLAG.
005100 IF PARM-CHAR (PC-INDX) = PARM-DELIMITER THEN
005200 PERFORM 0020-FIELD-FOUND.
005300 0020-FIELD-FOUND.
005400 MOVE PC-INDX TO DET-NDX (DNDX).
005500 ADD 1 TO DNDX.
005600 0030-GET-PARMS.
005700 SUBTRACT 1 FROM DNDX.
005800 MOVE DNDX TO ROP.
005900 MOVE 1 TO DNDX.
006000 PERFORM 0040-FETCH-PARM UNTIL DNDX > ROP.
006100 0040-FETCH-PARM.
006200 COMPUTE SOP = DET-NDX (DNDX) + 1.
006300 IF DNDX < ROP THEN
006400 COMPUTE EP = DET-NDX (DNDX + 1) - 1
006500 ELSE
006600 COMPUTE EP = PARM-LENGTH.
006700 MOVE SPACES TO PBUF (DNDX).
006800 MOVE PARM-DATA (SOP:EP) TO PBUF (DNDX).
006900 PERFORM 0070-GET-CHARS.
007000 MOVE PPD-AREA TO PBUF (DNDX).
007100 ADD 1 TO DNDX.
007200 0050-PRINT-PARMS.
007300 MOVE 1 TO DNDX.
007400 PERFORM 0060-DISP-PARMS ROP TIMES.
007500 0060-DISP-PARMS.
007600 ADD 1 TO DNDX.
007700 0070-GET-CHARS.
007800 MOVE 1 TO RX.
007900 MOVE SOP TO PP.
008000 MOVE EP TO PP2.
008100 PERFORM 0080-MOVE-CHAR UNTIL PP > PP2.
008200* DISPLAY 'PPD = *' PPD-AREA '*'.
008300 0080-MOVE-CHAR.
008400 MOVE PARM-DATA (PP:PP) TO PPD (RX).
008500 ADD 1 TO RX.
008600 ADD 1 TO PP.The clist (command procedure) for invoking the main program is as follows.
PROC 0
CONTROL NOLIST NOMSG
FREE FI(SYSOUT SYSPRINT)
ALLOC FI(SYSPRINT) DA(*)
ALLOC FI(SYSOUT) DA(OUT) SHR
CALL 'AMBMVS.PDS.LOAD(ABM00015)'
FREE FI(SYSOUT SYSPRINT)
ISPEXEC BROWSE DATASET(OUT)Notice the clist provide file allocations and calls the main program for execution. Upon execution the dialog management facility browse in invoked without further user input.
Mr. Arch Brooks, Software Engineer, Brooks Computing Systems, LLC authored this article.
There comes the time when it is beneficial to format the current date and time. The following COBOL sub routine does exactly that.
000100 IDENTIFICATION DIVISION. 00010000
000200 PROGRAM-ID. ABS00010. 00020000
000300 AUTHOR. ARCH BROOKS. 00030000
000400 INSTALLATION BROOKS COMPUTING SYSTEMS, LLC. 00040000
000500 DATE-WRITTEN. 09/25/2014. 00050000
000600 DATE-COMPILED. 09/25/2014. 00060000
000700 ENVIRONMENT DIVISION. 00070000
000800 CONFIGURATION SECTION. 00080000
000900 SOURCE-COMPUTER. IBM-Z-OS. 00090000
001000 OBJECT-COMPUTER. IBM-Z-OS. 00100000
001100 INPUT-OUTPUT SECTION. 00110000
001200 FILE-CONTROL. 00120000
001300 DATA DIVISION. 00130000
001400 FILE SECTION. 00140000
001500 WORKING-STORAGE SECTION. 00150000
001600 01 WS-CURRENT-DATE. 00160002
001700 05 CC PIC XX. 00170001
001800 05 YY PIC XX. 00180001
001900 05 MM PIC XX. 00190001
002000 05 DD PIC XX. 00200001
002100 05 HH PIC XX. 00210001
002200 05 MN PIC XX. 00220006
002300 05 SS PIC XX. 00230001
002400 05 SSHH PIC XX. 00240001
002500 05 GMTO PIC X(5). 00250001
003210 LINKAGE SECTION. 00321003
003300 01 FMT-DATE PIC X(10). 00330002
003310 01 SHORT-DATE REDEFINES FMT-DATE. 00331003
003320 05 MM PIC XX. 00332003
003330 05 P1 PIC X. 00333005
003340 05 DD PIC XX. 00334003
003350 05 P2 PIC X. 00335005
003360 05 CC PIC XX. 00336003
003370 05 YY PIC XX. 00337003
003400 PROCEDURE DIVISION USING FMT-DATE. 00340001
003500 MOVE FUNCTION CURRENT-DATE TO WS-CURRENT-DATE. 00350002
003510 MOVE '/' TO P1. 00351005
003520 MOVE '/' TO P2. 00352005
003600 MOVE CORR WS-CURRENT-DATE TO SHORT-DATE. 00360002
003700 CALL 'ABS00007'. 00370000Notice the usage of move corr (esponding) statement. This one statement properly populates the formatted output area. As long as the data names correspond this statement works flawlessly.
Mr. Arch Brooks, Software Engineer, Brooks Computing Systems, LLC authored this article.
This example demonstrates how to use available COBOL sub programs to perform reproduction of 80 column records. This framework hands you the underpinnings clone source code.
000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. ABM00017.
000300 AUTHOR. ARCH BROOKS.
000400 INSTALLATION BROOKS COMPUTING SYSTEMS, LLC.
000500 DATE-WRITTEN. 09/30/2014.
000600 DATE-COMPILED. 09/30/2014.
000700*
000800*
000900* THIS PROGRAM PROVIDES ALL NECESSARY COMMUNICATION TO PROCESS
001000* ALL THE RECORDS IN THE INPUT FILE.
001100*
001200* AFTER PROCESSING IS COMPLETE THE FILES ARE CLOSED
001300*
001400*
001500 ENVIRONMENT DIVISION.
001600 CONFIGURATION SECTION.
001700 SOURCE-COMPUTER. IBM-Z-OS.
001800 OBJECT-COMPUTER. IBM-Z-OS.
001900 INPUT-OUTPUT SECTION.
002000 FILE-CONTROL.
002100 DATA DIVISION.
002200 FILE SECTION.
002300 WORKING-STORAGE SECTION.
002400 01 EOF-SW PIC X.
002500 88 EOF VALUE 'X'.
002600 01 BUF PIC X(80).
002700 PROCEDURE DIVISION.
002800* OPEN INPUT FILE
002900 CALL 'ABS00014' USING EOF-SW.
003000* OPEN OUTPUT FILE
003100 CALL 'ABS00003'.
003200* PREPARE RECORDS UNTIL ALL ARE PROCESSED
003300 PERFORM 0010-PROC-RECS UNTIL EOF.
003400* CLOSE INPUT FILE
003500 CALL 'ABS0014B'.
003600* CLOSE OUTPUT FILE
003700 CALL 'ABS0003B'.
003800 GOBACK.
003900* PROCESS ALL RECORDS
004000 0010-PROC-RECS.
004100 CALL 'ABS0014A' USING BUF, EOF-SW.
004200 IF NOT EOF THEN
004300 PERFORM 0020-FIX-REC.
004400* MODIFY RECORDS BEFORE WRITING THE TO THE OUTPUT FILE.
004500 0020-FIX-REC.
004600 CALL 'ABS0003A' USING BUF.The following code describes the code that reads the records.
000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. ABS00014.
000300 AUTHOR. ARCH BROOKS.
000400 INSTALLATION BROOKS COMPUTING SYSTEMS, LLC.
000500 DATE-WRITTEN. 09/15/2014.
000600 DATE-COMPILED. 09/15/2014.
000700*
000800* THIS PROGRAM IS DESIGNED TO PROVIDE ALL NECESSARY COMMMUNCATIONS
000900* TO READ 80 BYTE RECORDS FROM THE INPUT FILE.
001000*
001100* THE END OF FILE SWITCH IS SET WHEN THE END OF THE DATA IS REACHED.
001200*
001300 ENVIRONMENT DIVISION.
001400 INPUT-OUTPUT SECTION.
001500 FILE-CONTROL.
001600 SELECT I-FILE ASSIGN TO UT-S-FSIN
001700 ORGANIZATION IS SEQUENTIAL.
001800 DATA DIVISION.
001900 FILE SECTION.
002000 FD I-FILE
002100 DATA RECORD IS I-RECORD
002200 BLOCK CONTAINS 0 RECORDS
002300 RECORDING MODE IS F.
002400 01 I-RECORD PIC X(80).
002500 WORKING-STORAGE SECTION.
002600 LINKAGE SECTION.
002700 01 EOF-SW PIC X.
002800 88 EOF VALUE 'X'.
002900 01 LSBUF PIC X(80).
003000 PROCEDURE DIVISION USING EOF-SW.
003100* OPEN THE INPUT FILE
003200 MOVE ' ' TO EOF-SW.
003300 OPEN INPUT I-FILE.
003400 PERFORM 0020-RETURN.
003500* READ THE FILE
003600 ENTRY 'ABS0014A' USING LSBUF EOF-SW.
003700 READ I-FILE
003800 AT END MOVE 'X' TO EOF-SW.
003900 IF NOT EOF THEN
004000 PERFORM 0010-FIX-RECORD.
004100 PERFORM 0020-RETURN.
004200 0010-FIX-RECORD.
004300 MOVE I-RECORD TO LSBUF.
004400 0012-STOP-FLOW.
004500* CLOSE THE FILE
004600 ENTRY 'ABS0014B'.
004700 CLOSE I-FILE.
004800 PERFORM 0020-RETURN.
004900* LET'S GET OUT OF HERE
005000 0020-RETURN.
005100 GOBACK.Now the code in this section allows us to output the data.
000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. ABS00003.
000300 AUTHOR. ARCH BROOKS.
000400 INSTALLATION BROOKS COMPUTING SYSTEMS, LLC.
000500 DATE-WRITTEN. 09/15/2014.
000600 DATE-COMPILED. 09/15/2014.
000700*
000800*
000900* THIS PROGRAM IS DESIGNED TO WRITE RECORDS TO THE FILE.
001000*
001100*
001200*
001300*
001400 ENVIRONMENT DIVISION.
001500 INPUT-OUTPUT SECTION.
001600 FILE-CONTROL.
001700 SELECT F-FILE ASSIGN TO UT-S-FSOUT
001800 ORGANIZATION IS SEQUENTIAL.
001900 DATA DIVISION.
002000 FILE SECTION.
002100 FD F-FILE
002200 DATA RECORD IS F-RECORD
002300 BLOCK CONTAINS 0 RECORDS
002400 RECORDING MODE IS F.
002500 01 F-RECORD PIC X(80).
002600 WORKING-STORAGE SECTION.
002700 LINKAGE SECTION.
002800 01 LSBUF PIC X(80).
002900 PROCEDURE DIVISION.
003000* OPEN THE OUTPUT FILE
003100 OPEN OUTPUT F-FILE.
003200 PERFORM 0010-RETURN.
003300* WRITE A RECORD
003400 ENTRY 'ABS0003A' USING LSBUF.
003500 WRITE F-RECORD FROM LSBUF.
003600 PERFORM 0010-RETURN.
003700* CLOSE THE FILE
003800 ENTRY 'ABS0003B'.
003900 CLOSE F-FILE.
004000 PERFORM 0010-RETURN.
004100* LETS GET OUT OF HERE
004200 0010-RETURN.
004300 GOBACK.The code below describes the command list (clist) employed to invoke the program after compiling and linking.
PROC 0
CONTROL NOLIST NOMSG
FREE FI(SYSOUT SYSPRINT FSIN FSOUT)
ALLOC FI(SYSPRINT) DA(*)
ALLOC FI(SYSOUT) DA(OUT) SHR
ALLOC FI(FSIN) DA(PDS.COBOL(ABM00016))
ALLOC FI(FSOUT) DA(TST)
CALL 'AMBMVS.PDS.LOAD(ABM00017)'
FREE FI(SYSOUT SYSPRINT FSIN FSOUT)
ISPEXEC BROWSE DATASET(TST)These routines can be used to tailor almost any type of source code. What I recommend is to clone a copy of this software then add the desirable functionality to generate the end result source code.
Mr. Arch Brooks, Software Engineer, Brooks Computing Systems, LLC authored this article.
This routine’s function is quite simple.It’s only function is to execute the goback command. Almost every program uses goback at least once. By using this approach COBOL programs avoid code bloat. There is overhead using goback. This approach minimizes that code bloat.
000100 IDENTIFICATION DIVISION. 00010000
000200 PROGRAM-ID. ABS00007. 00020000
000300 AUTHOR. ARCH BROOKS. 00030000
000400 INSTALLATION BROOKS COMPUTING SYSTEMS, LLC. 00040000
000500 DATE-WRITTEN. 09/15/2014. 00050000
000600 DATE-COMPILED. 09/15/2014. 00060000
000700 ENVIRONMENT DIVISION. 00070000
000800 CONFIGURATION SECTION. 00080000
000900 SOURCE-COMPUTER. IBM-Z-OS. 00090000
001000 OBJECT-COMPUTER. IBM-Z-OS. 00100000
001010 INPUT-OUTPUT SECTION. 00101000
001020 FILE-CONTROL. 00102000
001030 DATA DIVISION. 00103000
001040 FILE SECTION. 00104000
001050 WORKING-STORAGE SECTION. 00105000
001060 PROCEDURE DIVISION. 00106000
001070 GOBACK. 00107000Below is the compiler output.
1PP 5655-S71 IBM Enterprise COBOL for z/OS 4.1.0 Date 09/21/2014 Time 06:57:58 Page 1
0Invocation parameters:
VBREF
0Options in effect:
NOADATA
ADV
QUOTE
ARITH(COMPAT)
NOAWO
BUFSIZE(4096)
NOCICS
CODEPAGE(1140)
NOCOMPILE(S)
NOCURRENCY
DATA(31)
NODATEPROC
DBCS
NODECK
NODIAGTRUNC
NODLL
NODUMP
NODYNAM
NOEXIT
NOEXPORTALL
NOFASTSRT
FLAG(I,I)
NOFLAGSTD
INTDATE(ANSI)
LANGUAGE(EN)
NOLIB
LINECOUNT(60)
NOLIST
NOMAP
NOMDECK
NONAME
NSYMBOL(NATIONAL)
NONUMBER
NUMPROC(NOPFD)
OBJECT
NOOFFSET
NOOPTIMIZE
OUTDD(SYSOUT)
PGMNAME(COMPAT)
RENT
RMODE(AUTO)
SEQUENCE
SIZE(MAX)
SOURCE
SPACE(1)
NOSQL
SQLCCSID
NOSSRANGE
NOTERM
NOTEST
NOTHREAD
TRUNC(STD)
VBREF
NOWORD
1PP 5655-S71 IBM Enterprise COBOL for z/OS 4.1.0 Date 09/21/2014 Time 06:57:58 Page 2
0 XMLPARSE(XMLSS)
XREF(FULL)
YEARWINDOW(1900)
ZWB
1PP 5655-S71 IBM Enterprise COBOL for z/OS 4.1.0 ABS00007 Date 09/21/2014 Time 06:57:58 Page 3
LineID PL SL ----+-*A-1-B--+----2----+----3----+----4----+----5----+----6----+----7-|--+----8 Map and Cross Reference
0 000001 000100 IDENTIFICATION DIVISION. 00010000
000002 000200 PROGRAM-ID. ABS00007. 00020000
000003 000300 AUTHOR. ARCH BROOKS. 00030000
000004 000400 INSTALLATION BROOKS COMPUTING SYSTEMS, LLC. 00040000
000005 000500 DATE-WRITTEN. 09/15/2014. 00050000
000006 000600 DATE-COMPILED. 09/21/14. 00060000
000007 000700 ENVIRONMENT DIVISION. 00070000
000008 000800 CONFIGURATION SECTION. 00080000
000009 000900 SOURCE-COMPUTER. IBM-Z-OS. 00090000
000010 001000 OBJECT-COMPUTER. IBM-Z-OS. 00100000
000011 001010 INPUT-OUTPUT SECTION. 00101000
000012 001020 FILE-CONTROL. 00102000
000013 001030 DATA DIVISION. 00103000
000014 001040 FILE SECTION. 00104000
000015 001050 WORKING-STORAGE SECTION. 00105000
000016 001060 PROCEDURE DIVISION. 00106000
000017 001070 GOBACK. 00107000
1PP 5655-S71 IBM Enterprise COBOL for z/OS 4.1.0 ABS00007 Date 09/21/2014 Time 06:57:58 Page 4
0 Count Cross-reference of verbs References
1 GOBACK . . . . . . . . . . . . 17
1PP 5655-S71 IBM Enterprise COBOL for z/OS 4.1.0 ABS00007 Date 09/21/2014 Time 06:57:58 Page 5
0An "M" preceding a data-name reference indicates that the data-name is modified by this reference.
Defined Cross-reference of data names References
1PP 5655-S71 IBM Enterprise COBOL for z/OS 4.1.0 ABS00007 Date 09/21/2014 Time 06:57:58 Page 6
0 Defined Cross-reference of programs References
2 ABS00007
-* Statistics for COBOL program ABS00007:
* Source records = 17
* Data Division statements = 0
* Procedure Division statements = 1
0End of compilation 1, program ABS00007, no statements flagged.
0Return code 0Mr. Arch Brooks, Software Engineer, Brooks Computing Systems, LLC authored this article.