BCS MVS COBOL Parameter Access

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.

Leave a Reply