[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 Three Level Subtotal (Control Break) Program

The Three Level Subtotal (Control Break) COBOL Program


8. The Three Level Subtotal (Control Break) Program

BRKLV3.
Similar to the One Level Subtotal (Control Break) Program, #7 above, but now there are three levels of subtotals, corresponding to three levels of fields in the data. Typical levels might be Salesperson within State within District. If you can handle this program, you can handle a Two or Four or Six or Eleven level program.

This program is even more Real World. Most businesses are organized in a hierarchical manner - Salesperson within Department within District within Region is typical. Each level of the company has its head honcho. She or he will want to know everything about her or his level and everything under it. This report provides everything needed for those long meetings and discussions about “how we did last quarter.”

Here is the program BRKLV3:

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



000200 IDENTIFICATION DIVISION.
000300* 3 level control break - model program
000400* this is an excellent example of a 3 level control break
000500* (subtotal) program.  Use it as a model when writing yours.
000600 PROGRAM-ID. BRKLV3.
000700 ENVIRONMENT DIVISION.
000800 CONFIGURATION SECTION.
000900 INPUT-OUTPUT SECTION.
001000 FILE-CONTROL.
001100     SELECT SALES-FILE ASSIGN SALES3.
001400     SELECT REPORT-FILE ASSIGN REPORTFI.
001700*
001800 DATA DIVISION.
001900 FILE SECTION.
002000*
002100 FD  SALES-FILE
002200     RECORDING MODE IS F
002400     RECORD CONTAINS  80 CHARACTERS.
002600*
002700 01  SALES-RECORD.
002800*       The program assumes that the input data is sorted
002900*          by salesperson within branch within state
003000      05  SR-STATE             PIC X(02).
003100      05  FILLER               PIC X(03).
003200      05  SR-BRANCH            PIC X(10).
003400      05  SR-SALESPERSON       PIC X(15).
003500      05  FILLER               PIC X(05).
003600      05  SR-ITEM-SOLD         PIC X(15).
003700      05  FILLER               PIC X(05).
003800      05  SR-AMOUNT-SOLD       PIC S9(7)V99.
003900      05  FILLER               PIC X(16).
004000*
004100 FD  REPORT-FILE
004200     RECORDING MODE IS F
004400     RECORD CONTAINS 133 CHARACTERS.
004600*
004700 01  REPORT-RECORD             PIC X(133).
004800*
004900 WORKING-STORAGE SECTION.
005000 01  SWITCHES.
005100     05  FILE-AT-END              PIC X  VALUE 'N'.
005200*
005300 01  ACCUMULATORS.
005400     05  GRAND-TOTAL-ACCUM        PIC S9(9)V99
005500            PACKED-DECIMAL VALUE +0.
005600     05  STATE-ACCUM              PIC S9(9)V99
005700             PACKED-DECIMAL VALUE +0.
005800     05  BRANCH-ACCUM             PIC S9(9)V99
005900             PACKED-DECIMAL VALUE +0.
006000     05  SALESPERSON-ACCUM        PIC S9(9)V99
006100            PACKED-DECIMAL VALUE +0.
006200*
006300 01  LINE-AND-PAGE-CTRS.
006400     05  LINE-CTR                    PIC S9(3)
006500            PACKED-DECIMAL VALUE +0.
006600     05  MAX-LINES-PER-PAGE          PIC S9(3)
006700             PACKED-DECIMAL VALUE +40.
006800     05  PAGE-CTR                    PIC S9(3)
006900             PACKED-DECIMAL VALUE +0.
007000*     *
007100 01  SAVE-AREAS.
007200     05  SAVE-STATE               PIC X(02) VALUE SPACES.
007300     05  SAVE-BRANCH              PIC X(10) VALUE SPACES.
007400     05  SAVE-SALESPERSON         PIC X(15) VALUE SPACES.
007500*
007600 01  PRINT-LINES.
007700     05  GRAND-TOTAL-LINE.
007800         10  FILLER               PIC X(02) VALUE SPACES.
007900         10  FILLER               PIC X(20)
008000             VALUE '*** GRAND TOTAL ***'.
008100         10  FILLER               PIC X(43) VALUE SPACES.
008200         10  GTL-AMOUNT-SOLD      PIC  Z(9).99-.
008300*
008400     05  STATE-TOTAL-LINE.
008500         10  FILLER               PIC X(04) VALUE SPACES.
008600         10  FILLER               PIC X(20)
008700             VALUE '***  TOTAL FOR  ***'.
008800         10  FILLER               PIC X(02) VALUE SPACES.
008900         10  STL-STATE            PIC X(02) VALUE SPACES.
009000         10  FILLER               PIC X(37) VALUE SPACES.
009100         10  STL-AMOUNT-SOLD      PIC  Z(9).99-.
009200*
009300     05  BRANCH-TOTAL-LINE.
009400         10  FILLER               PIC X(06) VALUE SPACES.
009500         10  FILLER               PIC X(20)
009600             VALUE '***  TOTAL FOR  ***'.
009700         10  FILLER               PIC X(02) VALUE SPACES.
009800         10  BTL-BRANCH           PIC X(10) VALUE SPACES.
009900         10  FILLER               PIC X(27) VALUE SPACES.
010000         10  BTL-AMOUNT-SOLD      PIC  Z(9).99-.
010100*
010200     05  SALESPERSON-TOTAL-LINE.
010300         10  FILLER               PIC X(08) VALUE SPACES.
010400         10  FILLER               PIC X(20)
010500             VALUE '*** TOTAL FOR ***'.
010600         10  SLSTL-SALESPERSON    PIC X(15) VALUE SPACES.
010700         10  FILLER               PIC X(22) VALUE SPACES.
010800         10  SLSTL-AMOUNT-SOLD      PIC  Z(9).99-.
010900*
011000     05  DETAIL-PRINT-LINE.
011100         10  FILLER               PIC X(05) VALUE SPACES.
011200         10  DPL-STATE            PIC X(02) VALUE SPACES.
011300         10  FILLER               PIC X(05) VALUE SPACES.
011400         10  DPL-BRANCH           PIC X(10) VALUE SPACES.
011500         10  FILLER               PIC X(06) VALUE SPACES.
011600         10  DPL-SALESPERSON      PIC X(15) VALUE SPACES.
011700         10  FILLER               PIC X(05) VALUE SPACES.
011800         10  DPL-ITEM-SOLD        PIC X(15) VALUE SPACES.
011900         10  FILLER               PIC X(04) VALUE SPACES.
012000         10  DPL-AMOUNT-SOLD      PIC  Z(7).99-.
012100*
012200 01   BLANK-LINE.
012300      05  FILLER                  PIC X(133) VALUE SPACES.
012400*
012500 01   HEADING-LINE-1.
012600      05  FILLER                  PIC X(30) VALUE SPACES.
012700      05  FILLER                  PIC X(40)
012800          VALUE 'MODEL CONTROL BREAK REPORT'.
012900      05  FILLER                  PIC X(50) VALUE SPACES.
013000      05  HL1-PAGE                PIC ZZZ.
013100*
013200 01   HEADING-LINE-2.
013300      05  FILLER                  PIC X(2) VALUE SPACES.
013400      05  FILLER                  PIC X(10)
013500          VALUE 'STATE'.
013600      05  FILLER                  PIC X(16)
013700          VALUE 'BRANCH'.
013800      05  FILLER                  PIC X(20)
013900          VALUE 'SALESPERSON'.
014000*
014100 PROCEDURE DIVISION.
014200     PERFORM INITIALIZATION
014300     PERFORM PRODUCE-THE-REPORT
014400        UNTIL FILE-AT-END = 'Y'
014500     PERFORM TERMINATION
014600     GOBACK.
014700*
014800 INITIALIZATION.
014900     OPEN INPUT SALES-FILE
015000                OUTPUT REPORT-FILE
015100     PERFORM READ-A-RECORD
015200     MOVE SR-STATE       TO SAVE-STATE
015300     MOVE SR-BRANCH      TO SAVE-BRANCH
015400     MOVE SR-SALESPERSON TO SAVE-SALESPERSON
015500     MOVE ZEROS TO GTL-AMOUNT-SOLD
015600     MOVE ZEROS TO STL-AMOUNT-SOLD
015700     MOVE ZEROS TO BTL-AMOUNT-SOLD
015800     MOVE ZEROS TO SLSTL-AMOUNT-SOLD
015900     MOVE ZEROS TO DPL-AMOUNT-SOLD
016000     PERFORM PRINT-HEADER-LINES.
016100*
016200 PRODUCE-THE-REPORT.
016300     IF SR-STATE IS NOT EQUAL TO SAVE-STATE
016400     THEN PERFORM STATE-BREAK
016500     END-IF
016600*
016700     IF SR-BRANCH IS NOT EQUAL TO SAVE-BRANCH
016800     THEN PERFORM BRANCH-BREAK
016900     END-IF
017000*
017100     IF SR-SALESPERSON IS NOT EQUAL TO SAVE-SALESPERSON
017200     THEN PERFORM SALESPERSON-BREAK
017300     END-IF
017400*
017500     PERFORM DETAIL-PROCESSING
017600     PERFORM READ-A-RECORD.
017700
017800 DETAIL-PROCESSING.
017900*    Add detail amount   to lowest level (salesperson) total.
018000*    format detail line for printing.
018100*    print  detail line.
018200     ADD SR-AMOUNT-SOLD  TO SALESPERSON-ACCUM
018300     MOVE SR-STATE       TO DPL-STATE
018400     MOVE SR-BRANCH      TO DPL-BRANCH
018500     MOVE SR-SALESPERSON TO DPL-SALESPERSON
018600     MOVE SR-ITEM-SOLD   TO DPL-ITEM-SOLD
018700     MOVE SR-AMOUNT-SOLD TO DPL-AMOUNT-SOLD
018800     WRITE REPORT-RECORD FROM DETAIL-PRINT-LINE
018900        AFTER ADVANCING 1 LINE
019000     ADD 1 TO LINE-CTR
019100     IF LINE-CTR  IS GREATER THAN MAX-LINES-PER-PAGE
019200     THEN PERFORM PRINT-HEADER-LINES
019300     END-IF.
019400*
019500 STATE-BREAK.
019600*   Highest level break.
019700*   perform next lower level break (branch)
019800*   write out this level (state) totals
019900*   add this level totals (state) to next level (grand total)
020000*   zero out this level totals (state)
020100*   save this level input field (save input state)
020200*  if program requirements dictate, perform print-header-lines.
020300*
020400     PERFORM BRANCH-BREAK

020500     PERFORM PRINT-STATE-TOTALS
020600     ADD STATE-ACCUM TO GRAND-TOTAL-ACCUM
020700     MOVE ZERO TO STATE-ACCUM
020800     MOVE SR-STATE TO SAVE-STATE.
020900*
021000 BRANCH-BREAK.
021100*   Middle level break
021200*   perform next level break (salesperson)
021300*   write out this level totals (branch)
021400*   add this level totals (branch) to next level (state)
021500*   zero out this level totals (branch)
021600*   save this level input field (save input branch)
021700*
021800     PERFORM SALESPERSON-BREAK
021900     PERFORM PRINT-BRANCH-TOTALS
022000     ADD BRANCH-ACCUM TO STATE-ACCUM
022100     MOVE ZERO TO BRANCH-ACCUM
022200     MOVE SR-BRANCH TO SAVE-BRANCH.
022300*
022400 SALESPERSON-BREAK.
022500*   Lowest level break
022600*   write out this level totals (salesperson)
022700*   add this level total (salesperson) to next level (branch)
022800*   zero out this level totals (salesperson)
022900*   save this level input field (save input salesperson)
023000*
023100     PERFORM PRINT-SALESPERSON-TOTALS
023200     ADD SALESPERSON-ACCUM TO BRANCH-ACCUM
023300     MOVE ZERO TO SALESPERSON-ACCUM
023400     MOVE SR-SALESPERSON TO SAVE-SALESPERSON.
023500*
023600 PRINT-STATE-TOTALS.
023700     MOVE SAVE-STATE TO STL-STATE
023800     MOVE STATE-ACCUM TO STL-AMOUNT-SOLD
023900     WRITE REPORT-RECORD FROM STATE-TOTAL-LINE
024000        AFTER ADVANCING 3 LINES
024100     WRITE REPORT-RECORD FROM BLANK-LINE
024200        AFTER ADVANCING 2 LINES
024300     ADD 5 TO LINE-CTR
024400     IF LINE-CTR     IS GREATER THAN MAX-LINES-PER-PAGE
024500     THEN PERFORM PRINT-HEADER-LINES
024600     END-IF.
024700*
024800 PRINT-BRANCH-TOTALS.
024900     MOVE SAVE-BRANCH TO BTL-BRANCH
025000     MOVE BRANCH-ACCUM TO BTL-AMOUNT-SOLD
025100     WRITE REPORT-RECORD FROM BRANCH-TOTAL-LINE
025200         AFTER ADVANCING 3 LINES
025300     WRITE REPORT-RECORD FROM BLANK-LINE
025400        AFTER ADVANCING 2 LINES
025500     ADD 5 TO LINE-CTR
025600     IF LINE-CTR     IS GREATER THAN MAX-LINES-PER-PAGE
025700     THEN PERFORM PRINT-HEADER-LINES
025800     END-IF.
025900*
026000 PRINT-SALESPERSON-TOTALS.
026100     MOVE SAVE-SALESPERSON TO SLSTL-SALESPERSON
026200     MOVE SALESPERSON-ACCUM TO SLSTL-AMOUNT-SOLD
026300     WRITE REPORT-RECORD FROM SALESPERSON-TOTAL-LINE
026400        AFTER ADVANCING 3 LINES
026500     WRITE REPORT-RECORD FROM BLANK-LINE
026600        AFTER ADVANCING 2 LINES
026700     ADD 5 TO LINE-CTR
026800     IF LINE-CTR     IS GREATER THAN MAX-LINES-PER-PAGE
026900     THEN PERFORM PRINT-HEADER-LINES
027000     END-IF.
027100*
027200 PRINT-GRAND-TOTALS.
027300     MOVE GRAND-TOTAL-ACCUM TO GTL-AMOUNT-SOLD
027400     WRITE REPORT-RECORD FROM GRAND-TOTAL-LINE
027500        AFTER ADVANCING 3 LINES.
027600*
027700 PRINT-HEADER-LINES.
027800     ADD  1 TO PAGE-CTR
027900     MOVE PAGE-CTR TO HL1-PAGE
028000     MOVE 0 TO LINE-CTR
028100     WRITE REPORT-RECORD FROM HEADING-LINE-1
028200        AFTER ADVANCING PAGE
028300     WRITE REPORT-RECORD FROM HEADING-LINE-2
028400        AFTER ADVANCING 1 LINE
028500     WRITE REPORT-RECORD FROM BLANK-LINE
028600        AFTER ADVANCING 3 LINES.
028800 READ-A-RECORD.
028900     READ SALES-FILE
029000         AT END MOVE 'Y' TO FILE-AT-END
029200     END-READ.
030200 TERMINATION.
030300     PERFORM STATE-BREAK
030400     PERFORM PRINT-GRAND-TOTALS
030500     CLOSE SALES-FILE
030600           REPORT-FILE.

Compliments of Gabe Gargiulo, author of several recent books on programming and modern languages, available at Amazon.com.
Here is the input data file SALES3: (the next two lines are a column ruler) 1 2 3 4 5 6 123456789.123456789.123456789.123456789.123456789.123456789.12345678 CT HARTFORD ANN T. HILL CHEVELLE 000800000 CT HARTFORD SAL MONELLA FERRARI 006000000 CT NEW HAVEN ANNA KONDA OMNI 000030000 CT NEW HAVEN ANNA KONDA STING RAY 000200000 CT NEW HAVEN ANNA KONDA STING RAY 000200000 CT NEW HAVEN ANNA KONDA STING RAY 000200000 CT NEW HAVEN BILL COLLECTOR CAMARO 000600000 CT NEW HAVEN CAL ZONI JAGUAR 009000000 CT NEW HAVEN CAL ZONI PEUGEOT 000200000 CT NEW HAVEN ROSE BUSH PINTO 000040000 MA BOSTON MOE PEDD HONDA 000010000 MA BOSTON RON ZONEY LEMON 000020000 MA BOSTON RON ZONEY SUBARU 000010000 MI DETROIT LEN GUINI EDSEL 000000010 MI DETROIT LEN GUINI FIAT 004000000 MI DETROIT LEN GUINI FORD 000020000 MI DETROIT LEN GUINI STUDEBAKER 000000600 NY ALBANY MAC A. RONEY CONTINENTAL 002000000 NY ALBANY MAC A. RONEY ESCORT 000010000 NY ALBANY MAC A. RONEY FORD 000010000 NY ALBANY MAC A. RONEY HYUNDAI 000010000 NY ALBANY MAC A. RONEY HYUNDAI 000010000 NY ROCHESTER BILL E. GOAT MASERATI 000001000 Here is sample JCL: //STEP1 EXEC PGM=BRKLV3 //STEPLIB DD DSN=your.executable.program.library.goes.here,DISP=SHR //*OF COURSE, THE NEXT LIBRARY NAME MAY BE DIFFERENT AT YOUR COMPANY //SALES3 DD DSN=userid.COBBOOK.DATA(SALES3),DISP=SHR //REPORTFI 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 |