COBOL Program to the Pascal Memorial Library pays the author a small sum of money as royalty

Category > COBOL || Published on : Friday, May 8, 2015 || Views: 2468 || Indexed Files Print Files READ..NEXT RECORD READ..KEY IS START REWRITE WRITE MULTIPLY SET




      $ SET SOURCEFORMAT"FREE"
IDENTIFICATION DIVISION.
PROGRAM-ID.   LibRoyaltyRpt.
AUTHOR.  MICHAEL COUGHLAN.
* DP291-1991-Exam.
*Originally written for VAX COBOL 1991
*Converted to Microfocus NetExpress 2002

ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
    SELECT BOOK-FILE ASSIGN TO "BOOKS.DAT"
            ORGANIZATION IS INDEXED
            ACCESS MODE IS DYNAMIC
            RECORD KEY IS BOOK-NUMBER-FA
            ALTERNATE RECORD KEY IS AUTHOR-NUMBER-FA
                WITH DUPLICATES
            FILE STATUS IS BOOK-ERROR-STATUS.

    SELECT AUTHOR-FILE ASSIGN TO "AUTHOR.DAT"
            ORGANIZATION IS INDEXED
            ACCESS MODE IS DYNAMIC
            RECORD KEY IS AUTHOR-NUM-FB
            ALTERNATE RECORD KEY IS AGENT-NAME-FB
                                WITH DUPLICATES
            FILE STATUS IS AUTHOR-ERROR-STATUS.

    SELECT PRINT-FILE ASSIGN TO "ROYALTIES.RPT".


DATA DIVISION.
FILE SECTION.
    
FD  BOOK-FILE.
01  BOOK-REC-FA.
    02 BOOK-NUMBER-FA            PIC 9(7).
    02 BOOK-NAME-FA              PIC X(25).
    02 AUTHOR-NUMBER-FA          PIC 9(7).
    02 ROYALTY-RATE-FA           PIC V999.
    02 QTR-BORROWINGS-FA         PIC 999.

FD  AUTHOR-FILE.
01  AUTHOR-REC-FB.            
    02 AUTHOR-NUM-FB             PIC 9(7).
    02 AUTHOR-NAME-FB            PIC X(25).
    02 AGENT-NAME-FB             PIC X(25).


FD  PRINT-FILE.
01  PRINT-LINE-FC                PIC X(130).

WORKING-STORAGE SECTION.
01  ERROR-STATES.
    02 BOOK-ERROR-STATUS         PIC X(2).
       88 RECORD-ALREADY-EXISTS  VALUE "22".
       88 RECORD-DOES-NOT-EXIST  VALUE "23".
    02 AUTHOR-ERROR-STATUS       PIC X(2).
       88 RECORD-ALREADY-EXISTS  VALUE "22".
       88 RECORD-DOES-NOT-EXIST  VALUE "23".

01  INTERMEDIATE-VARIABLES.
    02 BOOK-ROYALTY              PIC 9(3)V99.
    02 QTR-AUTHOR-BORROWS        PIC 9(4).
    02 AUTHOR-ROYALTIES          PIC 9(4)V99.
    02 AGENT-PAYMENT             PIC 9(6)V99.
    02 PREV-AUTHOR               PIC 9(7).
    02 PREV-AGENT                PIC X(25).

01  EOF-FLAGS.
    02 FILLER                    PIC 9 VALUE 0.
       88 END-OF-AUTHOR-FILE     VALUE 1.
    02 FILLER                    PIC 9 VALUE 0.
       88 END-OF-BOOK-FILE       VALUE 1.
       88 NOT-END-OF-BOOK-FILE   VALUE 0.

01  REPORT-LINES.
    02 REPORT-HEADER.
       03 FILLER                 PIC X(37) VALUE SPACES.
       03 FILLER                 PIC X(24) VALUE
                "ROYALTY  PAYMENT  REPORT".

    02 UNDER-LINE.
       03 FILLER                 PIC X(36) VALUE SPACES.
       03 FILLER                 PIC X(25) VALUE ALL "-".

    02 FIELD-HEADERS.
       03 FILLER                 PIC X(9) VALUE SPACES.
       03 FILLER                 PIC X(5) VALUE "AGENT".
       03 FILLER                 PIC X(21) VALUE SPACES.
       03 FILLER                 PIC X(6) VALUE "AUTHOR".
       03 FILLER                 PIC X(20) VALUE SPACES.
       03 FILLER                 PIC X(4) VALUE "BOOK".
       03 FILLER                 PIC X(16) VALUE SPACES.
       03 FILLER                 PIC X(7) VALUE "QTR.BRW".
       03 FILLER                 PIC X(9) VALUE "  ROYALTY".

    02 BOOK-LINE.
       03 AGENT-NAME-PRN         PIC X(25).
       03 AUTHOR-NAME-PRN        PIC BBX(25).
       03 BOOK-NAME-PRN          PIC BBX(25).
       03 BOOK-QTR-BORROWS-PRN   PIC BBBBZZ9.
       03 BOOK-ROYALTY-PRN       PIC BBBB$$$9.99.

    02 AUTHOR-LINES.
       03 QTR-BORROWS-LINE.
          04 FILLER              PIC X(54) VALUE SPACES.
          04 FILLER              PIC X(36) VALUE
                    "QUARTER BORROWINGS FOR THIS AUTHOR =".
          04 QTR-BORROWS-PRN     PIC BBBBBZ,ZZ9.

       03 QTR-ROYALTIES-LINE.
          04 FILLER              PIC X(54) VALUE SPACES.
          04 FILLER              PIC X(36) VALUE
                    "ROYALTIES OWED TO THIS AUTHOR      =".
          04 QTR-ROYALTIES-PRN   PIC B$$,$$9.99.

    02 AGENT-LINE.
       03 FILLER                 PIC X(55) VALUE SPACES.
       03 FILLER                 PIC X(33) VALUE
                "AMOUNT TO BE PAID TO THIS AGENT =".
       03 AGENT-ROYALTIES-PRN    PIC B$$$$,$$9.99.



PROCEDURE DIVISION.
10-BEGIN.
    OPEN  I-O  BOOK-FILE.
    OPEN  I-O AUTHOR-FILE.
    OPEN OUTPUT PRINT-FILE.
    MOVE SPACES TO PRINT-LINE-FC.
    WRITE PRINT-LINE-FC AFTER ADVANCING PAGE.
    WRITE PRINT-LINE-FC FROM REPORT-HEADER AFTER ADVANCING 1  LINE.
        WRITE PRINT-LINE-FC FROM UNDER-LINE AFTER ADVANCING 1 LINE.
    WRITE PRINT-LINE-FC FROM FIELD-HEADERS AFTER ADVANCING 3 LINES.
    MOVE SPACES TO PRINT-LINE-FC.
    WRITE PRINT-LINE-FC AFTER ADVANCING 1 LINE.
    MOVE SPACES TO AGENT-NAME-FB.
    START AUTHOR-FILE KEY IS GREATER THAN AGENT-NAME-FB
        INVALID KEY DISPLAY "OH DEAR SOMETHING WRONG IN 10-START"
    END-START.
    READ AUTHOR-FILE NEXT RECORD 
        AT END SET END-OF-AUTHOR-FILE TO TRUE
    END-READ.
    PERFORM 20-PROCESS-AGENTS UNTIL END-OF-AUTHOR-FILE.
    CLOSE BOOK-FILE.
    CLOSE AUTHOR-FILE.
    CLOSE PRINT-FILE.
    STOP RUN.    

20-PROCESS-AGENTS.
    MOVE AGENT-NAME-FB TO AGENT-NAME-PRN, PREV-AGENT.
    MOVE ZEROS TO AGENT-PAYMENT.

    PERFORM 30-PROCESS-AUTHORS 
        UNTIL END-OF-AUTHOR-FILE
            OR AGENT-NAME-FB NOT EQUAL TO PREV-AGENT.

    MOVE AGENT-PAYMENT TO AGENT-ROYALTIES-PRN.
    WRITE PRINT-LINE-FC FROM AGENT-LINE AFTER ADVANCING 1 LINE.
    MOVE SPACES TO PRINT-LINE-FC.
    WRITE PRINT-LINE-FC AFTER ADVANCING 2 LINES.

        


30-PROCESS-AUTHORS.
    MOVE ZEROS TO QTR-AUTHOR-BORROWS, AUTHOR-ROYALTIES.
    MOVE AUTHOR-NUM-FB TO AUTHOR-NUMBER-FA, PREV-AUTHOR.
    DISPLAY "AUTHOR NUMBER " AUTHOR-NUMBER-FA.
    MOVE AUTHOR-NAME-FB TO AUTHOR-NAME-PRN.
    READ BOOK-FILE 
        KEY IS AUTHOR-NUMBER-FA
        INVALID KEY
         DISPLAY "ERROR IN 20-PROCESS-AGENTS = " BOOK-ERROR-STATUS
    END-READ.
    DISPLAY "BOOK RECORD IN 20-PROCESS-AGENTS "  BOOK-REC-FA.
    PERFORM 40-PROCESS-BOOKS 
        UNTIL END-OF-BOOK-FILE 
            OR AUTHOR-NUMBER-FA NOT EQUAL TO PREV-AUTHOR.
    SET NOT-END-OF-BOOK-FILE TO TRUE.
    MOVE QTR-AUTHOR-BORROWS TO QTR-BORROWS-PRN.
    MOVE AUTHOR-ROYALTIES    TO QTR-ROYALTIES-PRN.
    WRITE PRINT-LINE-FC FROM QTR-BORROWS-LINE AFTER ADVANCING 2 LINES.
    WRITE PRINT-LINE-FC FROM QTR-ROYALTIES-LINE AFTER ADVANCING 1 LINE.
    MOVE SPACES TO PRINT-LINE-FC.
    WRITE PRINT-LINE-FC AFTER ADVANCING 2 LINES.
    READ AUTHOR-FILE NEXT RECORD 
        AT END SET END-OF-AUTHOR-FILE TO TRUE
    END-READ.

40-PROCESS-BOOKS.
    PERFORM 50-PROCESS-ONE-BOOK.
    READ BOOK-FILE    NEXT RECORD
        AT END SET END-OF-BOOK-FILE TO TRUE
    END-READ.
    MOVE SPACES TO AUTHOR-NAME-PRN, AGENT-NAME-PRN.

50-PROCESS-ONE-BOOK.
    MULTIPLY QTR-BORROWINGS-FA BY ROYALTY-RATE-FA 
        GIVING BOOK-ROYALTY ROUNDED.
    ADD QTR-BORROWINGS-FA  TO QTR-AUTHOR-BORROWS.
    ADD BOOK-ROYALTY  TO AUTHOR-ROYALTIES, AGENT-PAYMENT.
    MOVE BOOK-NAME-FA TO BOOK-NAME-PRN.
    MOVE QTR-BORROWINGS-FA TO BOOK-QTR-BORROWS-PRN.
    MOVE BOOK-ROYALTY TO BOOK-ROYALTY-PRN.
    WRITE PRINT-LINE-FC FROM BOOK-LINE
             AFTER ADVANCING 1 LINE.

    MOVE ZEROS TO QTR-BORROWINGS-FA.
    REWRITE BOOK-REC-FA
        INVALID KEY
        DISPLAY "REWRITE 50-PROCESS-ONE-BOOK " BOOK-ERROR-STATUS
    END-REWRITE.