Same as The Simple, Single File Report Program, #2 above, but also counts records, or accumulates totals. Then at the end of the file, it prints a record count or total of some money amount.

This type of program may not sound very difficult. It is not. But it is extremely useful: it is the meat and potatoes of many businesses. It absolutely must be accurate: It prints out in clear usable form the entire business’ or business application’s records. Final or grand totals answer the questions: "How much did we produce last year?", "What is the bottom line? "

Here is the program SEQRPT2:

000200 IDENTIFICATION DIVISION.

000300 PROGRAM-ID. SEQRPT2.

000400* Read and print every record

000500* header line, detail line, page change, final total

000600* & rec count

000700 ENVIRONMENT DIVISION.

000800 CONFIGURATION SECTION.

000900 INPUT-OUTPUT SECTION.

001000 FILE-CONTROL.

001100* INPUT FILE: PARTS

001200 SELECT IN-FILE ASSIGN PARTS.

001500* OUTFILE: SEND TO PRINTER

001600 SELECT OUT-FILE ASSIGN OUTFILE.

001900 DATA DIVISION.

002000 FILE SECTION.

002100 FD IN-FILE

002110 RECORDING MODE IS F

002500 RECORD CONTAINS 80 CHARACTERS.

002600 01 IN-RECORD PIC X(80).

002610 05 PART-NUMBER PIC X(6).

002620 05 filler pic x.

002630 05 PART-DESC PIC X(30).

002640 05 filler pic x.

002650 05 QTY-ON-HAND PIC 9(3).

002660 05 filler pic x.

002670 05 QTY-ON-ORDER PIC 9(3).

002680 05 filler pic x.

002690 05 QTY-ON-RESERVE PIC 9(3).

002700 05 filler pic x.

002710 05 PART-PRICE PIC 9(3)V99.

002720 05 UNUSED PIC X(25).

002730

002800 FD OUT-FILE

002810 RECORDING MODE IS F

003000* Record length can be more than input file

003100* because you are printing, not copying to a file

003200 RECORD CONTAINS 133 CHARACTERS.

003500 01 OUT-RECORD PIC X(133).

003600

003700 WORKING-STORAGE SECTION.

003800 01 SWITCHES.

003900 05 FILE-AT-END PIC X VALUE 'N'.

004000 01 COUNTERS-AND-ACCUMULATORS.

004100 05 LINES-PRINTED PIC S9(5) PACKED-DECIMAL

004200 VALUE ZERO.

004300 05 INPUT-RECORD-COUNT PIC S9(5) PACKED-DECIMAL

004400 VALUE ZERO.

004500 05 TOTAL-QUANTITY PIC S9(7) PACKED-DECIMAL

004600 VALUE ZERO.

004700 05 OUTPUT-RECORD-COUNT PIC S9(5) PACKED-DECIMAL

004800 VALUE ZERO.

004900 05 MAX-PER-PAGE PIC S9(5) PACKED-DECIMAL

005000 VALUE +55.

005100

006600 01 WS-OUT-RECORD.

006700* We will use edit fields for the numeric fields

006800* we are using fillers between the fields for legibility

006900* Leave first character position blank

007000* because of after advancing

007100 05 FILLER PIC X(3) VALUE SPACES.

007200 05 OUT-PART-NUMBER PIC X(6).

007300 05 FILLER PIC X(3) VALUE SPACES.

007400 05 OUT-PART-DESC PIC X(30).

007500 05 FILLER PIC X(3) VALUE SPACES.

007600 05 OUT-QTY-ON-HAND PIC ZZ9.

007700 05 FILLER PIC X(3) VALUE SPACES.

007800 05 OUT-QTY-ON-ORDER PIC ZZ9.

007900 05 FILLER PIC X(3) VALUE SPACES.

008000 05 OUT-QTY-ON-RESERVE PIC ZZ9.

008100 05 FILLER PIC X(3) VALUE SPACES.

008200 05 OUT-PART-PRICE PIC ZZZ.99.

008300 05 FILLER PIC X(3) VALUE SPACES.

008400 05 OUT-UNUSED PIC X(30).

008500 05 FILLER PIC X(31) VALUE SPACES.

008600

008700 01 HEADER-1.

008800* Leave first character position blank

008900* because of after advancing

009000 05 FILLER PIC X VALUE SPACE.

009100 05 FILLER PIC X(80)

009200 VALUE 'PRINT OF DATA FILE FOR ABC COMPANY'.

009300

009400 01 FINAL-TOTAL-LINE.

009500* LEAVE FIRST CHARACTER POSITION BLANK

009600* BECAUSE OF AFTER ADVANCING

009700 05 FILLER PIC X VALUE SPACE.

009800 05 FILLER PIC X(20)

009900 VALUE 'TOTAL QUANTITY '.

010000 05 FILLER PIC X VALUE SPACE.

010100 05 PRINT-TOTAL-QUANTITY PIC Z(7)-.

010200 05 FILLER PIC X(20)

010300 VALUE ' RECORDS READ '.

010400 05 FILLER PIC X VALUE SPACE.

010500 05 PRINT-INPUT-RECORD-COUNT PIC Z(7)-.

010600

010700 PROCEDURE DIVISION.

010800 PERFORM INITIALIZATION

010900* UPPER CASE Y, PLEASE

011000 PERFORM PROCESS-ALL

011100 UNTIL FILE-AT-END = 'Y'

011200 PERFORM TERMINATION

011300 GOBACK.

011400

011500 INITIALIZATION.

011600 OPEN INPUT IN-FILE

011700 OUTPUT OUT-FILE

011800 PERFORM HEADING-ROUTINE

011900 PERFORM READ-PAR.

012000

012100 PROCESS-ALL.

012200 IF LINES-PRINTED > MAX-PER-PAGE

012300 THEN

012400 PERFORM HEADING-ROUTINE

012500 END-IF

012600 ADD QTY-ON-HAND TO TOTAL-QUANTITY

012700 MOVE PART-NUMBER TO OUT-PART-NUMBER

012800 MOVE PART-DESC TO OUT-PART-DESC

012900 MOVE QTY-ON-HAND TO OUT-QTY-ON-HAND

013000 MOVE QTY-ON-ORDER TO OUT-QTY-ON-ORDER

013100 MOVE QTY-ON-RESERVE TO OUT-QTY-ON-RESERVE

013200 MOVE PART-PRICE TO OUT-PART-PRICE

013300 MOVE UNUSED TO OUT-UNUSED

013400 WRITE OUT-RECORD FROM WS-OUT-RECORD

013500 AFTER ADVANCING 1 LINE

013600 ADD 1 TO OUTPUT-RECORD-COUNT

013700 ADD 1 TO LINES-PRINTED

013800 PERFORM READ-PAR.

013900

014000 TERMINATION.

014100 MOVE TOTAL-QUANTITY TO PRINT-TOTAL-QUANTITY

014200 MOVE INPUT-RECORD-COUNT TO PRINT-INPUT-RECORD-COUNT

014300 WRITE OUT-RECORD FROM FINAL-TOTAL-LINE

014400 AFTER ADVANCING 5 LINES

014500 CLOSE IN-FILE OUT-FILE.

014600

014700 READ-PAR.

014800 READ IN-FILE

014900 AT END MOVE 'Y' TO FILE-AT-END

015000 NOT AT END ADD 1 TO INPUT-RECORD-COUNT

015100 END-READ.

015200

015300 HEADING-ROUTINE.

015400 WRITE OUT-RECORD FROM HEADER-1 AFTER ADVANCING PAGE

015500 MOVE 0 TO LINES-PRINTED.

Here is the input data file PARTS: (the next two lines are a column ruler)

1 2 3 4 5 6

123456789.123456789.123456789.123456789.123456789.123456789.12345678

PART01 LEFT HANDED WIDGET WRENCHES 003 007 002 10022

PART02 LEAD-WINGED GLIDERS 004 006 001 14054

PART04 LEFT FOOT REEBOKS 021 002 004 04323

PART06 286 COMPUTERS W 4K HARD DISK 043 077 012 00042

Here is sample JCL:

//STEP1 EXEC PGM=SEQRPT2

//STEPLIB DD DSN=your.executable.program.library.goes.here,DISP=SHR

//*OF COURSE, THE NEXT LIBRARY NAME MAY BE DIFFERENT AT YOUR COMPANY

//PARTS DD DSN=userid.CLASS.DATA(PARTS),DISP=SHR

//OUTFILE DD SYSOUT=*

//SYSOUT DD SYSOUT=*

//SYSUDUMP DD SYSOUT=*