[USflag] The American Programmer [USflag]


Home
Books on Mainframe Programming
Mainframe Manuals and Tutorials
System Abend codes, Sqlcodes, VSAM/QSAM codes
Everything about the IBM AS/400 Midrange Computer - iSeries
Everything about CICS
Cobol programs, manuals, books
  Sample Cobol code: The Simple, Single File COBOL Program
  Sample Cobol code: The Simple, Single File Report COBOL Program with Record Count or Final Totals
  Sample Cobol code: The Simple, Single File Report COBOL Program with Record Count or Final Totals
  Sample Cobol code: The Sequence Check COBOL Program
  Sample Cobol code: The Record Selection COBOL Program
  Sample Cobol code: The Edit or Validate COBOL Program
  Sample Cobol code: The The One Level Subtotal (Control Break) COBOL Program
  Sample Cobol code: The Three Level Subtotal (Control Break) COBOL Program
  Sample Cobol code: The Sequential File, Batch Update COBOL Program
  Sample Cobol code: The COBOL Sort
  Sample Cobol code: The CASE Structure: COBOL EVALUATE
  Sample Cobol code: Direct Subscripting in COBOL
  Sample Cobol code: The Sequential, or Serial Search in COBOL
  Sample Cobol code: The Binary Search in COBOL
  Sample Cobol code: Loading a Table from a Sequential File in a COBOL program
  Sample Cobol code: The VSAM File Read Sequentially in a COBOL program
  Sample Cobol code: The VSAM KSDS, Read Randomly in a COBOL program
  Sample Cobol code: The VSAM File, Read Randomly in a COBOL program
  Sample Cobol code: VSAM Initial Load in a COBOL program
  Sample Cobol code: VSAM File Maintenance (Add, Change, Delete) in a COBOL program
  Sample Cobol code: VSAM Read Sequentially, with START, in a COBOL program
  Sample Cobol code: Creating a Variable Format File in a COBOL program
  Sample Cobol code: Reading a Variable Format File in a COBOL program
  Sample Cobol code: Creating a Variable Format File with Occurs Depending On in a COBOL program
  Sample Cobol code: COBOL Reading a Variable Format File with Occurs Depending On, in a COBOL program
  Sample Cobol code: COBOL The Table Load with Occurs Depending On
  Sample Cobol/DB2 code: Singleton Select
  Manuals on the COBOL programming language.
  Books on Cobol
  Abend Codes from Cobol programs
Everything about DB2 and SQL
Everything about IMS
Everything about Java and JavaScript
Everything about JCL and JES
Everything about REXX
Everything about zOS, VSAM, Tivoli, Assembler
Everything about TSO, ISPF, Spufi
Site Map and Site Search

           Home   > COBOL   > The Simple, Single File Report Program with Record Count or Final Totals

The Simple, Single File Report COBOL Program with Record Count or Final Totals


3. The Simple, Single File Report Program with Record Count or Final Totals

SEQRPT2.
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:

Compliments of Gabe Gargiulo, author of several recent books on programming and modern languages, available at Amazon.com.



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.
015300 HEADING-ROUTINE.
015400     WRITE OUT-RECORD FROM HEADER-1 AFTER ADVANCING PAGE
015500     MOVE 0 TO LINES-PRINTED.

Compliments of Gabe Gargiulo, author of several recent books on programming and modern languages, available at Amazon.com.
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.COBBOOK.DATA(PARTS),DISP=SHR //OUTFILE DD SYSOUT=* //SYSOUT DD SYSOUT=* //SYSUDUMP DD SYSOUT=*

Top of Page

Your email and other personal information will not be given to anyone
[Books Computer]

Home Books for Computer Professionals Privacy Terms |
Site Map and Site Search Programming Manuals and Tutorials The REXX Files Top of Page |