In this post we will try to explore a sample program, which creates a variable length file using the COBOL Occurs Depending on clause.
I am assuming that you are familiar with the clause and its function so we wont delve into detailed explanation and COBOL syntax but rather explain the use of occurs depending on and creating a VB file using a sample program.
The below program read a fixed file 85 bytes containing inventory data of items, storage location and quantity available in each location and write the same into a variable length output file using occurs depending on clause.
File – Control
No changes here, as usual just provide JCL DD name vs COBOL program file name mapping
FILE-CONTROL.
SELECT ITEM ASSIGN TO DDIN.
SELECT OUTFILE ASSIGN TO DDOUT.
Data Division
We define the 85 byte long Fixed input ITMFILE here containing the item description warehouse location and quantity available in each location. Please note that some of the items may have fewer storage locations that others and the no of warehouse locations which hold that respective item stored in the filed ITEM-IN-NO-OF-LOC.
For example if an item is stored only in one warehouse, ITEM-IN-NO-OF-LOC will have a value of “1” and name and quantity available at the location will be stored in ITEM-IN-LOC1 and ITEM-IN-LOC1-QTY respectively, the rest of bytes of the file will not have any data as other locations are not applicable
FD ITEMFILE
RECORDING MODE IS F
RECORD CONTAINS 85 CHARACTERS.
01 ITMREC.
10 ITEM-IN-CDE PIC X(02).
10 ITEM-IN-NAME PIC X(06).
10 ITEM-IN-NO-OF-LOC PIC 9(2).
10 ITEM-IN-LOC1 PIC X(10).
10 ITEM-IN-LOC1-QTY PIC S9(9) COMP-3.
10 ITEM-IN-LOC2 PIC X(10).
10 ITEM-IN-LOC2-QTY PIC S9(9) COMP-3.
10 ITEM-IN-LOC3 PIC X(10).
10 ITEM-IN-LOC3-QTY PIC S9(9) COMP-3.
10 ITEM-IN-LOC4 PIC X(10).
10 ITEM-IN-LOC4-QTY PIC S9(9) COMP-3.
10 ITEM-IN-LOC5 PIC X(10).
10 ITEM-IN-LOC5-QTY PIC S9(9) COMP-3.
For the output file the Recording mode of Variable (V) is selected denoting that this is a Variable length file and we using the “Record Contains” clause to give the minimum and maximum record length expected. Note that the record definition contains a fixed part of Item code, Item Name and No of locations which is 10 bytes long and a variable part 15 bytes which can be repeated 5 times making a maximum possible length of 85 [10 + (15 * 5)]
FD OUTFILE
RECORDING MODE IS V
RECORD CONTAINS 10 TO 85 CHARACTERS.
The record layout has a fixed portion of 10 bytes and a variable array whose size depends on the no of locations; the no of locations can have a minimum value of 1 to a maximum value of 5
01 OUTREC.
10 ITEM-OUT-CDE PIC X(02).
10 ITEM-OUT-NAME PIC X(06).
10 ITEM-OUT-NO-OF-LOC PIC 9(2).
10 ITEM-OUT-LOC-DTLS OCCURS 1 TO 5 TIMES
DEPENDING ON ITEM-OUT-NO-OF-LOC.
15 ITEM-OUT-LOC PIC X(10).
15 ITEM-OUT-LOC-QTY PIC S9(9) COMP-3.
Procedure Division
The logic of the program is to read each input record and depending of the value of ITEM-IN-NO-OF-LOC , perform different paragraphs which writes the data into the variable array part of the output file , its self explanatory and I would urge you to go through the code
PROCEDURE DIVISION
1000-MAIN-PROCESS.
PERFORM 101-INIT-PARA
PERFORM 102-PROCESS-PARA \
UNTIL END-OF-FILE = ‘Y’.
PERFORM 103-WRAPUP-PARA
STOP RUN.
101-INIT-PARA.
OPEN INPUT ITMFILE.
OPEN OUTPUT OUTFILE.
PERFORM 104-READ-PARA
104-READ-PARA.
INITIALIZE ITMREC.
READ ITMFILE
AT END MOVE ‘Y’ TO END-OF-FILE
END-READ.
103-WRAPUP-PARA.
CLOSE ITMFILE.
CLOSE OUTFILE.
102-PROCESS-PARA.
EVALUATE ITEM-IN-NO-OF-LOC
WHEN 1
PERFORM 105-WRITE-1-PARA
WHEN 2
PERFORM 106-WRITE-2-PARA
WHEN 3
PERFORM 107-WRITE-3-PARA
WHEN 4
PERFORM 108-WRITE-4-PARA
WHEN 5
PERFORM 109-WRITE-5-PARA
END-EVALUATE.
PERFORM 104-READ-PARA
105-WRITE-1-PARA.
MOVE ITEM-IN-CDE TO ITEM-OUT-CDE.
MOVE ITEM-IN-NAME TO ITEM-OUT-CDE.
MOVE ITEM-IN-NO-OF-LOC TO ITEM-OUT-NO-OF-LOC.
MOVE ITEM-IN-LOC1 TO ITEM-OUT-LOC(1).
MOVE ITEM-IN-LOC1-QTY TO ITEM-OUT-LOC-QTY(1).
WRITE OUTREC.
106-WRITE-2-PARA.
MOVE ITEM-IN-CDE TO ITEM-OUT-CDE.
MOVE ITEM-IN-NAME TO ITEM-OUT-CDE.
MOVE ITEM-IN-NO-OF-LOC TO ITEM-OUT-NO-OF-LOC.
MOVE ITEM-IN-LOC1 TO ITEM-OUT-LOC(1).
MOVE ITEM-IN-LOC1-QTY TO ITEM-OUT-LOC-QTY(1).
MOVE ITEM-IN-LOC2 TO ITEM-OUT-LOC(2).
MOVE ITEM-IN-LOC2-QTY TO ITEM-OUT-LOC-QTY(2).
WRITE OUTREC.
107-WRITE-3-PARA.
MOVE ITEM-IN-CDE TO ITEM-OUT-CDE.
MOVE ITEM-IN-NAME TO ITEM-OUT-CDE.
MOVE ITEM-IN-NO-OF-LOC TO ITEM-OUT-NO-OF-LOC.
MOVE ITEM-IN-LOC1 TO ITEM-OUT-LOC(1).
MOVE ITEM-IN-LOC1-QTY TO ITEM-OUT-LOC-QTY(1).
MOVE ITEM-IN-LOC2 TO ITEM-OUT-LOC(2).
MOVE ITEM-IN-LOC2-QTY TO ITEM-OUT-LOC-QTY(2).
MOVE ITEM-IN-LOC3 TO ITEM-OUT-LOC(3).
MOVE ITEM-IN-LOC3-QTY TO ITEM-OUT-LOC-QTY(3).
WRITE OUTREC.
108-WRITE-4-PARA.
MOVE ITEM-IN-CDE TO ITEM-OUT-CDE.
MOVE ITEM-IN-NAME TO ITEM-OUT-CDE.
MOVE ITEM-IN-NO-OF-LOC TO ITEM-OUT-NO-OF-LOC.
MOVE ITEM-IN-LOC1 TO ITEM-OUT-LOC(1).
MOVE ITEM-IN-LOC1-QTY TO ITEM-OUT-LOC-QTY(1).
MOVE ITEM-IN-LOC2 TO ITEM-OUT-LOC(2).
MOVE ITEM-IN-LOC2-QTY TO ITEM-OUT-LOC-QTY(2).
MOVE ITEM-IN-LOC3 TO ITEM-OUT-LOC(3).
MOVE ITEM-IN-LOC3-QTY TO ITEM-OUT-LOC-QTY(3).
MOVE ITEM-IN-LOC4 TO ITEM-OUT-LOC(4).
MOVE ITEM-IN-LOC4-QTY TO ITEM-OUT-LOC-QTY(4).
WRITE OUTREC.
109-WRITE-5-PARA.
MOVE ITEM-IN-CDE TO ITEM-OUT-CDE.
MOVE ITEM-IN-NAME TO ITEM-OUT-CDE.
MOVE ITEM-IN-NO-OF-LOC TO ITEM-OUT-NO-OF-LOC.
MOVE ITEM-IN-LOC1 TO ITEM-OUT-LOC(1).
MOVE ITEM-IN-LOC1-QTY TO ITEM-OUT-LOC-QTY(1).
MOVE ITEM-IN-LOC2 TO ITEM-OUT-LOC(2).
MOVE ITEM-IN-LOC2-QTY TO ITEM-OUT-LOC-QTY(2).
MOVE ITEM-IN-LOC3 TO ITEM-OUT-LOC(3).
MOVE ITEM-IN-LOC3-QTY TO ITEM-OUT-LOC-QTY(3).
MOVE ITEM-IN-LOC4 TO ITEM-OUT-LOC(4).
MOVE ITEM-IN-LOC4-QTY TO ITEM-OUT-LOC-QTY(4).
MOVE ITEM-IN-LOC5 TO ITEM-OUT-LOC(5).
MOVE ITEM-IN-LOC5-QTY TO ITEM-OUT-LOC-QTY(5).
WRITE OUTREC.
JCL Considerations
Please note the LREC for the output variable length file in the JLC , this is given as 89 bytes , this included the 4 bytes RDW bytes , the actual max length of the output file as per the program is 85 (see above) and 4 byes RDW bytes make it 89 . The length inclusive of the RDW bytes is given only in the JCL and not in the program
//STEP01 EXEC PGM=PROGRAM1
//STEPLIB DD DSN=COBOL.LOADLIB,DISP=SHR
//DDIN DD DSN=INPUT.FILE,DISP=SHR
//DDOUT DD DSN=OUTPUT.FILE,
// DISP=(NEW,CATLG,DELETE),
// SPACE=(TRK,(1,1),RLSE),
// UNIT=SYSDA,
// DCB(RECFM=VB,LRECL=89) //SYSOUT DD SYSOUT=*
//*
Recent Comments