>>SOURCE FORMAT IS FREE *> cobol-write-report.cob — read a fixed-width *> transaction file and write a paginated report: a page header *> with the run date and page number, column headings, edited *> detail lines, a control total at the foot of every page, and *> a summary page of grand totals *> Dialect: GnuCOBOL 3.x, free format *> Status : desk-checked against the GnuCOBOL Programmer's Guide; *> NOT compiled (no cobc on the authoring machine). The report *> arithmetic was verified by running the Python companion. *> Inputs : datasets/cobol-write-report-file-page-breaks.dat *> (LINE SEQUENTIAL, 64 bytes per record, 47 records) *> code/cobol-write-report-file-page-breaks.cpy (record layout) *> Outputs: register.txt — 80 report lines across 4 logical pages *> Build : cobc -x -I code -o write-register \ *> code/cobol-write-report.cob *> (run from the folder that holds code/ and datasets/) *> Run : ./write-register (Windows: write-register.exe) IDENTIFICATION DIVISION. PROGRAM-ID. WRITE-REGISTER. ENVIRONMENT DIVISION. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT Txn-File ASSIGN TO "datasets/cobol-write-report-file-page-breaks.dat" ORGANIZATION IS LINE SEQUENTIAL FILE STATUS IS WS-Txn-Status. SELECT Report-File ASSIGN TO "register.txt" ORGANIZATION IS LINE SEQUENTIAL FILE STATUS IS WS-Rpt-Status. DATA DIVISION. FILE SECTION. FD Txn-File. COPY "cobol-write-report-file-page-breaks.cpy". *> The report record is one print line. Nothing is described inside it: *> every line is built in WORKING-STORAGE and written with FROM. FD Report-File. 01 Report-Line PIC X(72). WORKING-STORAGE SECTION. 77 WS-Txn-Status PIC XX. 77 WS-Rpt-Status PIC XX. 01 WS-Flags. 05 WS-EOF-Flag PIC X VALUE "N". 88 End-Of-File VALUE "Y". 05 WS-Page-Kind PIC X VALUE "D". 88 Summary-Page VALUE "S". *> Page geometry. Change these and the whole report re-paginates: *> 30 usable lines = 5 header + 23 detail + 2 footer. 77 WS-Page-Size PIC 9(3) VALUE 30. 77 WS-Header-Lines PIC 9(3) VALUE 5. 77 WS-Footer-Lines PIC 9(3) VALUE 2. 77 WS-Summary-Lines PIC 9(3) VALUE 7. *> The hand-kept line counter: how many lines this page already holds. 77 WS-Page-Line PIC 9(3) VALUE 0. 77 WS-Page-No PIC 9(3) VALUE 0. 77 WS-Wanted PIC 9(3) VALUE 0. 77 WS-Needed PIC 9(3) VALUE 0. *> Accumulators. 77 WS-Read-Count PIC 9(5) VALUE 0. 77 WS-Detail-Count PIC 9(5) VALUE 0. 77 WS-Page-Total PIC 9(9)V99 VALUE 0. 77 WS-Debit-Total PIC 9(9)V99 VALUE 0. 77 WS-Credit-Total PIC 9(9)V99 VALUE 0. 77 WS-Net PIC S9(9)V99 VALUE 0. 77 WS-Show-Count PIC ZZ,ZZ9. *> FUNCTION CURRENT-DATE returns 21 characters: YYYYMMDDhhmmsshh then the *> sign and size of the offset from Greenwich. Only the first 14 are used. 01 WS-Now. 05 WS-Now-Ymd PIC 9(8). 05 WS-Now-Hh PIC 9(2). 05 WS-Now-Mi PIC 9(2). 05 WS-Now-Ss PIC 9(2). 05 FILLER PIC X(7). *> ------------------------------------------------------------------ *> The print lines. Every one of them is exactly 72 characters, so the *> columns line up whichever line is being written. *> ------------------------------------------------------------------ 01 WS-Head-1. 05 FILLER PIC X(2) VALUE SPACES. 05 FILLER PIC X(26) VALUE "DAILY TRANSACTION REGISTER". 05 FILLER PIC X(28) VALUE SPACES. 05 FILLER PIC X(5) VALUE "PAGE ". 05 HD-Page PIC ZZ9. 05 FILLER PIC X(8) VALUE SPACES. 01 WS-Head-2. 05 FILLER PIC X(2) VALUE SPACES. 05 FILLER PIC X(4) VALUE "RUN ". 05 HD-Date PIC 9(4)/9(2)/9(2). 05 FILLER PIC X(2) VALUE SPACES. 05 HD-Hour PIC 9(2). 05 FILLER PIC X VALUE ":". 05 HD-Minute PIC 9(2). 05 FILLER PIC X VALUE ":". 05 HD-Second PIC 9(2). 05 FILLER PIC X(46) VALUE SPACES. 01 WS-Head-Cols. 05 FILLER PIC X(2) VALUE SPACES. 05 FILLER PIC X(6) VALUE "REF". 05 FILLER PIC X(2) VALUE SPACES. 05 FILLER PIC X(10) VALUE "DATE". 05 FILLER PIC X(2) VALUE SPACES. 05 FILLER PIC X(3) VALUE "BR". 05 FILLER PIC X(2) VALUE SPACES. 05 FILLER PIC X(28) VALUE "DESCRIPTION". 05 FILLER PIC X(2) VALUE SPACES. 05 FILLER PIC X(12) VALUE " AMOUNT". 05 FILLER PIC X(3) VALUE " T ". 01 WS-Head-Summary. 05 FILLER PIC X(2) VALUE SPACES. 05 FILLER PIC X(70) VALUE "REPORT SUMMARY". 01 WS-Blank-Line PIC X(72) VALUE SPACES. 01 WS-Rule-Line PIC X(72) VALUE ALL "-". 01 WS-Detail-Line. 05 FILLER PIC X(2) VALUE SPACES. 05 DL-Ref PIC X(6). 05 FILLER PIC X(2) VALUE SPACES. 05 DL-Date PIC 9(4)/9(2)/9(2). 05 FILLER PIC X(2) VALUE SPACES. 05 DL-Branch PIC X(3). 05 FILLER PIC X(2) VALUE SPACES. 05 DL-Desc PIC X(28). 05 FILLER PIC X(2) VALUE SPACES. 05 DL-Amount PIC Z,ZZZ,ZZ9.99. 05 FILLER PIC X VALUE SPACE. 05 DL-DC PIC X. 05 FILLER PIC X VALUE SPACE. 01 WS-Page-Total-Line. 05 FILLER PIC X(2) VALUE SPACES. 05 FILLER PIC X(38) VALUE SPACES. 05 FILLER PIC X(5) VALUE "PAGE ". 05 PT-Page PIC ZZ9. 05 FILLER PIC X(7) VALUE " TOTAL ". 05 FILLER PIC X(2) VALUE SPACES. 05 PT-Amount PIC Z,ZZZ,ZZ9.99. 05 FILLER PIC X(3) VALUE SPACES. 01 WS-Total-Line. 05 FILLER PIC X(2) VALUE SPACES. 05 TL-Label PIC X(53). 05 FILLER PIC X(2) VALUE SPACES. 05 TL-Amount PIC Z,ZZZ,ZZ9.99CR. 05 FILLER PIC X VALUE SPACE. 01 WS-Count-Line. 05 FILLER PIC X(2) VALUE SPACES. 05 CL-Label PIC X(53). 05 FILLER PIC X(10) VALUE SPACES. 05 CL-Count PIC ZZ,ZZ9. 05 FILLER PIC X VALUE SPACE. PROCEDURE DIVISION. Main-Paragraph. PERFORM Start-Report PERFORM Read-Next-Txn PERFORM UNTIL End-Of-File PERFORM Print-Detail PERFORM Read-Next-Txn END-PERFORM PERFORM End-Page PERFORM Print-Summary PERFORM End-Report STOP RUN. Start-Report. OPEN INPUT Txn-File IF WS-Txn-Status NOT = "00" DISPLAY "Cannot open the transaction file, status " WS-Txn-Status STOP RUN END-IF OPEN OUTPUT Report-File IF WS-Rpt-Status NOT = "00" DISPLAY "Cannot open the report file, status " WS-Rpt-Status STOP RUN END-IF *> The run stamp is set once and printed on every page header. MOVE FUNCTION CURRENT-DATE TO WS-Now MOVE WS-Now-Ymd TO HD-Date MOVE WS-Now-Hh TO HD-Hour MOVE WS-Now-Mi TO HD-Minute MOVE WS-Now-Ss TO HD-Second PERFORM Start-Page. Read-Next-Txn. READ Txn-File AT END SET End-Of-File TO TRUE NOT AT END ADD 1 TO WS-Read-Count END-READ IF WS-Txn-Status NOT = "00" AND WS-Txn-Status NOT = "10" DISPLAY "Read failed, file status " WS-Txn-Status STOP RUN END-IF. *> Page 1 starts where the paper is; every later page starts with a *> form feed, which is what ADVANCING PAGE writes when the FD has no *> LINAGE clause. Start-Page. ADD 1 TO WS-Page-No MOVE WS-Page-No TO HD-Page IF WS-Page-No = 1 WRITE Report-Line FROM WS-Head-1 AFTER ADVANCING 1 LINE ELSE WRITE Report-Line FROM WS-Head-1 AFTER ADVANCING PAGE END-IF WRITE Report-Line FROM WS-Head-2 AFTER ADVANCING 1 LINE WRITE Report-Line FROM WS-Blank-Line AFTER ADVANCING 1 LINE IF Summary-Page WRITE Report-Line FROM WS-Head-Summary AFTER ADVANCING 1 LINE ELSE WRITE Report-Line FROM WS-Head-Cols AFTER ADVANCING 1 LINE END-IF WRITE Report-Line FROM WS-Rule-Line AFTER ADVANCING 1 LINE MOVE WS-Header-Lines TO WS-Page-Line MOVE 0 TO WS-Page-Total. *> The page-break test. WS-Wanted holds the number of lines the caller *> is about to write; the footer must still fit under them. Check-Room. COMPUTE WS-Needed = WS-Page-Line + WS-Wanted + WS-Footer-Lines IF WS-Needed > WS-Page-Size PERFORM End-Page PERFORM Start-Page END-IF. Print-Detail. MOVE 1 TO WS-Wanted PERFORM Check-Room MOVE Txn-Ref TO DL-Ref MOVE Txn-Date TO DL-Date MOVE Txn-Branch TO DL-Branch MOVE Txn-Desc TO DL-Desc MOVE Txn-Amount TO DL-Amount MOVE Txn-DC TO DL-DC WRITE Report-Line FROM WS-Detail-Line AFTER ADVANCING 1 LINE ADD 1 TO WS-Page-Line ADD 1 TO WS-Detail-Count ADD Txn-Amount TO WS-Page-Total EVALUATE Txn-DC WHEN "D" ADD Txn-Amount TO WS-Debit-Total WHEN "C" ADD Txn-Amount TO WS-Credit-Total WHEN OTHER DISPLAY "Unexpected type [" Txn-DC "] on " Txn-Ref END-EVALUATE. End-Page. WRITE Report-Line FROM WS-Rule-Line AFTER ADVANCING 1 LINE MOVE WS-Page-No TO PT-Page MOVE WS-Page-Total TO PT-Amount WRITE Report-Line FROM WS-Page-Total-Line AFTER ADVANCING 1 LINE ADD WS-Footer-Lines TO WS-Page-Line. *> The grand totals always start a fresh page. To let them share the *> last detail page instead, replace the PERFORM Start-Page below with *> MOVE WS-Summary-Lines TO WS-Wanted and PERFORM Check-Room. Print-Summary. SET Summary-Page TO TRUE PERFORM Start-Page WRITE Report-Line FROM WS-Blank-Line AFTER ADVANCING 1 LINE WRITE Report-Line FROM WS-Rule-Line AFTER ADVANCING 1 LINE MOVE "RECORDS READ" TO CL-Label MOVE WS-Read-Count TO CL-Count WRITE Report-Line FROM WS-Count-Line AFTER ADVANCING 1 LINE MOVE "DEBIT TOTAL" TO TL-Label MOVE WS-Debit-Total TO TL-Amount WRITE Report-Line FROM WS-Total-Line AFTER ADVANCING 1 LINE MOVE "CREDIT TOTAL" TO TL-Label MOVE WS-Credit-Total TO TL-Amount WRITE Report-Line FROM WS-Total-Line AFTER ADVANCING 1 LINE COMPUTE WS-Net = WS-Debit-Total - WS-Credit-Total MOVE "NET (DEBITS LESS CREDITS)" TO TL-Label MOVE WS-Net TO TL-Amount WRITE Report-Line FROM WS-Total-Line AFTER ADVANCING 1 LINE MOVE "PAGES PRINTED" TO CL-Label MOVE WS-Page-No TO CL-Count WRITE Report-Line FROM WS-Count-Line AFTER ADVANCING 1 LINE ADD WS-Summary-Lines TO WS-Page-Line. End-Report. CLOSE Txn-File Report-File IF WS-Rpt-Status NOT = "00" DISPLAY "Close of the report file failed, status " WS-Rpt-Status END-IF MOVE WS-Read-Count TO WS-Show-Count DISPLAY "Records read : " WS-Show-Count MOVE WS-Detail-Count TO WS-Show-Count DISPLAY "Detail lines : " WS-Show-Count MOVE WS-Page-No TO WS-Show-Count DISPLAY "Pages printed : " WS-Show-Count.