Fill examples:
There are three programs that accompany the notes for filling an empty table. They are
invfill.cbl, invfilla.cbl and invfillb.cbl. All three programs read invfill.data and all
three programs produce the same output - named invout.dat. The input and output files are
shown in this example.
invfill.cbl
IDENTIFICATION DIVISION.
PROGRAM-ID. INVFILL.
AUTHOR. GROCER.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT DATA-FILE
ASSIGN TO "C:\PCOBWIN\TABLES\INVFILL.DAT".
SELECT PRINT-FILE
* ASSIGN TO PRINTER.
ASSIGN TO "A:\INVOUT.DAT".
DATA DIVISION.
FILE SECTION.
FD DATA-FILE
DATA RECORDS ARE TABLE-INPUT, REGULAR-INPUT.
01 TABLE-INPUT.
05 ITEM-NUM-TI PIC 9(3).
05 PRICE-TI PIC 99V99.
05 FILLER PIC X(5).
01 REGULAR-INPUT.
05 CUST-NUM-IN PIC 9(4).
05 ITEM-NUM-IN PIC 9(3).
05 NUM-ORD-IN PIC 9(5).
FD PRINT-FILE
DATA RECORD IS PRINTZ.
01 PRINTZ.
05 FILLER PIC X.
05 CUST-NUM-PR PIC 9(4).
05 FILLER PIC X(5).
05 ITEM-NUM-PR PIC 9(3).
05 FILLER PIC X(5).
05 PRICE-PR PIC $ZZ.99.
05 FILLER PIC X(5).
05 NUM-ORD-PR PIC ZZ,ZZ9.
05 FILLER PIC X(5).
05 AMT-DUE-PR PIC $Z,ZZZ,ZZZ.99.
05 MSG-AREA-PR REDEFINES AMT-DUE-PR PIC X(13).
05 FILLER PIC X(27).
WORKING-STORAGE SECTION.
01 INDICATORZ.
05 MORE-RECS PIC XXX VALUE "YES".
05 MATCH-IND PIC XXX VALUE "NO ".
01 WORK-AREAS.
05 AMT-DUE-WS PIC 9(7)V99 VALUE 0.
01 CONSTANTZ.
05 ERR-MSG-CONST PIC X(13)
VALUE 'ITEM# INVALID'.
01 SUBSCRIPTZ.
05 SUB-IN PIC 9 VALUE 1.
05 SUBZ PIC 9 VALUE 0.
01 ITEM-TABLE.
05 ENTRIES OCCURS 6 TIMES.
10 ITEM-NUM-T PIC 9(3).
10 PRICE-T PIC 99V99.
PROCEDURE DIVISION.
A-100-MAINLINE.
PERFORM A-100-START.
PERFORM B-100-PROCESS.
PERFORM C-100-WRAPUP.
STOP RUN.
A-100-START.
OPEN INPUT DATA-FILE
OUTPUT PRINT-FILE.
MOVE 1 TO SUB-IN.
PERFORM U-100-FILL-TABLE
6 TIMES.
* UNTIL SUB-IN > 6.
B-100-PROCESS.
READ DATA-FILE
AT END
MOVE "NO " TO MORE-RECS.
PERFORM B-200-LOOP
UNTIL MORE-RECS = "NO ".
B-200-LOOP.
PERFORM B-300-DETAIL.
READ DATA-FILE
AT END
MOVE "NO " TO MORE-RECS.
B-300-DETAIL.
MOVE SPACES TO PRINTZ.
MOVE CUST-NUM-IN TO CUST-NUM-PR.
MOVE ITEM-NUM-IN TO ITEM-NUM-PR.
MOVE NUM-ORD-IN TO NUM-ORD-PR.
MOVE 1 TO SUBZ.
MOVE "NO " TO MATCH-IND.
PERFORM B-410-SEARCH
UNTIL SUBZ > 6 OR MATCH-IND = "YES".
IF MATCH-IND = 'YES'
MOVE PRICE-T (SUBZ) TO PRICE-PR
MULTIPLY PRICE-T (SUBZ) BY NUM-ORD-IN
GIVING AMT-DUE-WS
MOVE AMT-DUE-WS TO AMT-DUE-PR
ELSE
MOVE 0 TO PRICE-PR
MOVE 0 TO AMT-DUE-PR
MOVE ERR-MSG-CONST TO MSG-AREA-PR.
WRITE PRINTZ
AFTER ADVANCING 1 LINES.
B-410-SEARCH.
IF ITEM-NUM-IN = ITEM-NUM-T (SUBZ)
MOVE "YES" TO MATCH-IND
ELSE
ADD 1 TO SUBZ.
U-100-FILL-TABLE.
READ DATA-FILE
AT END
MOVE "NO " TO MORE-RECS.
MOVE ITEM-NUM-TI TO ITEM-NUM-T (SUB-IN).
MOVE PRICE-TI TO PRICE-T (SUB-IN).
ADD 1 TO SUB-IN.
C-100-WRAPUP.
CLOSE DATA-FILE
PRINT-FILE.
invfilla.cbl
IDENTIFICATION DIVISION.
PROGRAM-ID. INVFILLA.
AUTHOR. GROCER.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT DATA-FILE
ASSIGN TO "C:\PCOBWIN\TABLES\INVFILL.DAT".
SELECT PRINT-FILE
* ASSIGN TO PRINTER.
ASSIGN TO "A:\INVOUT.DAT".
DATA DIVISION.
FILE SECTION.
FD DATA-FILE
DATA RECORDS ARE DATA-INPUT.
01 DATA-INPUT PIC X(12).
FD PRINT-FILE
DATA RECORD IS PRINTZ.
01 PRINTZ.
05 FILLER PIC X.
05 CUST-NUM-PR PIC 9(4).
05 FILLER PIC X(5).
05 ITEM-NUM-PR PIC 9(3).
05 FILLER PIC X(5).
05 PRICE-PR PIC $ZZ.99.
05 FILLER PIC X(5).
05 NUM-ORD-PR PIC ZZ,ZZ9.
05 FILLER PIC X(5).
05 AMT-DUE-PR PIC $Z,ZZZ,ZZZ.99.
05 MSG-AREA-PR REDEFINES AMT-DUE-PR PIC X(13).
05 FILLER PIC X(27).
WORKING-STORAGE SECTION.
01 TABLE-INPUT.
05 ITEM-NUM-TI PIC 9(3).
05 PRICE-TI PIC 99V99.
05 FILLER PIC X(5).
01 REGULAR-INPUT.
05 CUST-NUM-IN PIC 9(4).
05 ITEM-NUM-IN PIC 9(3).
05 NUM-ORD-IN PIC 9(5).
01 INDICATORZ.
05 MORE-RECS PIC XXX VALUE "YES".
05 MATCH-IND PIC XXX VALUE "NO ".
01 WORK-AREAS.
05 AMT-DUE-WS PIC 9(7)V99 VALUE 0.
01 CONSTANTZ.
05 ERR-MSG-CONST PIC X(13)
VALUE 'ITEM# INVALID'.
01 SUBSCRIPTZ.
05 SUB-IN PIC 9 VALUE 1.
05 SUBZ PIC 9 VALUE 0.
01 ITEM-TABLE.
05 ENTRIES OCCURS 6 TIMES.
10 ITEM-NUM-T PIC 9(3).
10 PRICE-T PIC 99V99.
PROCEDURE DIVISION.
A-100-MAINLINE.
PERFORM A-100-START.
PERFORM B-100-PROCESS.
PERFORM C-100-WRAPUP.
STOP RUN.
A-100-START.
OPEN INPUT DATA-FILE
OUTPUT PRINT-FILE.
MOVE 1 TO SUB-IN.
PERFORM U-100-FILL-TABLE
6 TIMES.
* UNTIL SUB-IN > 6.
B-100-PROCESS.
READ DATA-FILE INTO REGULAR-INPUT
AT END
MOVE "NO " TO MORE-RECS.
PERFORM B-200-LOOP
UNTIL MORE-RECS = "NO ".
B-200-LOOP.
PERFORM B-300-DETAIL.
READ DATA-FILE INTO REGULAR-INPUT
AT END
MOVE "NO " TO MORE-RECS.
B-300-DETAIL.
MOVE SPACES TO PRINTZ.
MOVE CUST-NUM-IN TO CUST-NUM-PR.
MOVE ITEM-NUM-IN TO ITEM-NUM-PR.
MOVE NUM-ORD-IN TO NUM-ORD-PR.
MOVE 1 TO SUBZ.
MOVE "NO " TO MATCH-IND.
PERFORM B-410-SEARCH
UNTIL SUBZ > 6 OR MATCH-IND = "YES".
IF MATCH-IND = 'YES'
MOVE PRICE-T (SUBZ) TO PRICE-PR
MULTIPLY PRICE-T (SUBZ) BY NUM-ORD-IN
GIVING AMT-DUE-WS
MOVE AMT-DUE-WS TO AMT-DUE-PR
ELSE
MOVE 0 TO PRICE-PR
MOVE 0 TO AMT-DUE-PR
MOVE ERR-MSG-CONST TO MSG-AREA-PR.
WRITE PRINTZ
AFTER ADVANCING 1 LINES.
B-410-SEARCH.
IF ITEM-NUM-IN = ITEM-NUM-T (SUBZ)
MOVE "YES" TO MATCH-IND
ELSE
ADD 1 TO SUBZ.
U-100-FILL-TABLE.
READ DATA-FILE INTO TABLE-INPUT
AT END
MOVE "NO " TO MORE-RECS.
MOVE ITEM-NUM-TI TO ITEM-NUM-T (SUB-IN).
MOVE PRICE-TI TO PRICE-T (SUB-IN).
ADD 1 TO SUB-IN.
C-100-WRAPUP.
CLOSE DATA-FILE
PRINT-FILE.
invfillb.cbl
IDENTIFICATION DIVISION.
PROGRAM-ID. INVFILL.
AUTHOR. GROCER.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT DATA-FILE
ASSIGN TO "C:\PCOBWIN\TABLES\INVFILL.DAT".
SELECT PRINT-FILE
* ASSIGN TO PRINTER.
ASSIGN TO "A:\INVOUT.DAT".
DATA DIVISION.
FILE SECTION.
FD DATA-FILE
DATA RECORDS ARE REGULAR-INPUT.
01 REGULAR-INPUT.
05 CUST-NUM-IN PIC 9(4).
05 ITEM-NUM-IN PIC 9(3).
05 NUM-ORD-IN PIC 9(5).
FD PRINT-FILE
DATA RECORD IS PRINTZ.
01 PRINTZ.
05 FILLER PIC X.
05 CUST-NUM-PR PIC 9(4).
05 FILLER PIC X(5).
05 ITEM-NUM-PR PIC 9(3).
05 FILLER PIC X(5).
05 PRICE-PR PIC $ZZ.99.
05 FILLER PIC X(5).
05 NUM-ORD-PR PIC ZZ,ZZ9.
05 FILLER PIC X(5).
05 AMT-DUE-PR PIC $Z,ZZZ,ZZZ.99.
05 MSG-AREA-PR REDEFINES AMT-DUE-PR PIC X(13).
05 FILLER PIC X(27).
WORKING-STORAGE SECTION.
01 TABLE-INPUT.
05 ITEM-NUM-TI PIC 9(3).
05 PRICE-TI PIC 99V99.
05 FILLER PIC X(5).
01 INDICATORZ.
05 MORE-RECS PIC XXX VALUE "YES".
05 MATCH-IND PIC XXX VALUE "NO ".
01 WORK-AREAS.
05 AMT-DUE-WS PIC 9(7)V99 VALUE 0.
01 CONSTANTZ.
05 ERR-MSG-CONST PIC X(13)
VALUE 'ITEM# INVALID'.
01 SUBSCRIPTZ.
05 SUB-IN PIC 9 VALUE 1.
05 SUBZ PIC 9 VALUE 0.
01 ITEM-TABLE.
05 ENTRIES OCCURS 6 TIMES.
10 ITEM-NUM-T PIC 9(3).
10 PRICE-T PIC 99V99.
PROCEDURE DIVISION.
A-100-MAINLINE.
PERFORM A-100-START.
PERFORM B-100-PROCESS.
PERFORM C-100-WRAPUP.
STOP RUN.
A-100-START.
OPEN INPUT DATA-FILE
OUTPUT PRINT-FILE.
MOVE 1 TO SUB-IN.
PERFORM U-100-FILL-TABLE
6 TIMES.
* UNTIL SUB-IN > 6.
B-100-PROCESS.
READ DATA-FILE
AT END
MOVE "NO " TO MORE-RECS.
PERFORM B-200-LOOP
UNTIL MORE-RECS = "NO ".
B-200-LOOP.
PERFORM B-300-DETAIL.
READ DATA-FILE
AT END
MOVE "NO " TO MORE-RECS.
B-300-DETAIL.
MOVE SPACES TO PRINTZ.
MOVE CUST-NUM-IN TO CUST-NUM-PR.
MOVE ITEM-NUM-IN TO ITEM-NUM-PR.
MOVE NUM-ORD-IN TO NUM-ORD-PR.
MOVE 1 TO SUBZ.
MOVE "NO " TO MATCH-IND.
PERFORM B-410-SEARCH
UNTIL SUBZ > 6 OR MATCH-IND = "YES".
IF MATCH-IND = 'YES'
MOVE PRICE-T (SUBZ) TO PRICE-PR
MULTIPLY PRICE-T (SUBZ) BY NUM-ORD-IN
GIVING AMT-DUE-WS
MOVE AMT-DUE-WS TO AMT-DUE-PR
ELSE
MOVE 0 TO PRICE-PR
MOVE 0 TO AMT-DUE-PR
MOVE ERR-MSG-CONST TO MSG-AREA-PR.
WRITE PRINTZ
AFTER ADVANCING 1 LINES.
B-410-SEARCH.
IF ITEM-NUM-IN = ITEM-NUM-T (SUBZ)
MOVE "YES" TO MATCH-IND
ELSE
ADD 1 TO SUBZ.
U-100-FILL-TABLE.
READ DATA-FILE INTO TABLE-INPUT
AT END
MOVE "NO " TO MORE-RECS.
MOVE ITEM-NUM-TI TO ITEM-NUM-T (SUB-IN).
MOVE PRICE-TI TO PRICE-T (SUB-IN).
ADD 1 TO SUB-IN.
C-100-WRAPUP.
CLOSE DATA-FILE
PRINT-FILE.
invfill.dat
1112499
2221599
3333450
4441298
5552775
6663679
123422200001
124555500025
125633300050
145611100020
156766600030
223355500010
245633300023
256711100100
266611100020
277722200004
288833300024
299933300034
300044400090
312344400080
323455500045
345666600089
440044400040
556655500034
665423400010
667844400020
765445400030
777744400090
787834400010
797922200020
809022200010
invout.dat
1234 222 $15.99 1 $ 15.99
1245 555 $27.75 25 $ 693.75
1256 333 $34.50 50 $ 1,725.00
1456 111 $24.99 20 $ 499.80
1567 666 $36.79 30 $ 1,103.70
2233 555 $27.75 10 $ 277.50
2456 333 $34.50 23 $ 793.50
2567 111 $24.99 100 $ 2,499.00
2666 111 $24.99 20 $ 499.80
2777 222 $15.99 4 $ 63.96
2888 333 $34.50 24 $ 828.00
2999 333 $34.50 34 $ 1,173.00
3000 444 $12.98 90 $ 1,168.20
3123 444 $12.98 80 $ 1,038.40
3234 555 $27.75 45 $ 1,248.75
3456 666 $36.79 89 $ 3,274.31
4400 444 $12.98 40 $ 519.20
5566 555 $27.75 34 $ 943.50
6654 234 $ .00 10 ITEM# INVALID
6678 444 $12.98 20 $ 259.60
7654 454 $ .00 30 ITEM# INVALID
7777 444 $12.98 90 $ 1,168.20
7878 344 $ .00 10 ITEM# INVALID
7979 222 $15.99 20 $ 319.80
8090 222 $15.99 10 $ 159.90