Impressum csq4bva1.cob   Sprache: unbekannt

CBL NODYNAM,LIB,OBJECT,RENT,RES,APOST
      *                                                               *
      * ------------------------------------------------------------- *
       IDENTIFICATION DIVISION.
      * ------------------------------------------------------------- *
       PROGRAM-ID. CSQ4BVA1.
      *REMARKS
      *****************************************************************
      * @START_COPYRIGHT@                                             *
      *   Statement:     Licensed Materials - Property of IBM         *
      *                                                               *
      *                  5695-137                                     *
      *                  (C) Copyright IBM Corporation. 1993, 1997    *
      *                                                               *
      *   Status:        Version 1 Release 2                          *
      * @END_COPYRIGHT@                                               *
      *                                                               *
      * ************************************************************* *
      *                                                               *
      *  Product Number   : 5695-137                                  *
      *                                                               *
      *  Module Name      : CSQ4BVA1                                  *
      *                                                               *
      *  Environment      : MVS Batch; COBOL II                       *
      *                                                               *
      *  Description      : Sample program to print messages from a   *
      *                     specified queue.                          *
      *                                                               *
      *  Function         : This program prints a report showing all  *
      *                     the messages in a specified queue in a    *
      *                     specified queue manager                   *
      *                                                               *
      *                     The program processes the first 80 bytes  *
      *                     only of each message.  It uses the BROWSE *
      *                     option of the MQGET call to ensure that   *
      *                     data is not lost                          *
      *                                                               *
      *  Return Values    : 0 - Successful completion                 *
      *                     4 - Parameter error, eg: wrong number     *
      *                         of parameters passed                  *
      *                     8 - Error in MQ call, eg: unknown object  *
      *                         name                                  *
      *                                                               *
      * ************************************************************* *
      *                                                               *
      *                      Program logic                            *
      *                      -------------                            *
      *                                                               *
      *   Start  (A-MAIN SECTION)                                     *
      *   -----                                                       *
      *                                                               *
      *       Open print file                                         *
      *       Print first line of header (Perform PRINT-HEADER-1)     *
      *                                                               *
      *       Obtain the input data from PARM=(aaa,bbb):              *
      *          - aaa is the name of the queue manager               *
      *          - bbb is the name of the queue                       *
      *                                                               *
      *          If the name of the queue manager is missing          *
      *             Build a warning message and move it into data line*
      *             Print the line (Perform PRINT-LINE)               *
      *             Continue (using default queue manager name)       *
      *          End-if                                               *
      *                                                               *
      *          If the name of the queue is missing                  *
      *             Build an error message and move it into data line *
      *             Print the line (Perform PRINT-LINE)               *
      *             Branch to Exit2                                   *
      *          End-if                                               *
      *                                                               *
      *       Print the rest of the header (Perform PRINT-HEADER-2)   *
      *                                                               *
      *       Connect to the queue manager                            *
      *       If an error occurs                                      *
      *          Build an error message and move it into data line    *
      *          Print the line (Perform PRINT-LINE)                  *
      *          Branch to Exit2                                      *
      *       End-if                                                  *
      *                                                               *
      *       Open the queue                                          *
      *       If an error occurs                                      *
      *          Build an error message and move it into data line    *
      *          Print the line (Perform PRINT-LINE)                  *
      *          Branch to Exit1                                      *
      *       End-if                                                  *
      *                                                               *
      *       Get the first message (using BROWSE-FIRST option)       *
      *                                                               *
      *       Do while no error                                       *
      *                                                               *
      *          Add 1 to relative message number                     *
      *          Move message into print line (maximum 80 bytes)      *
      *          Print the line (Perform PRINT-LINE)                  *
      *                                                               *
      *          Get next message (using BROWSE-NEXT option)          *
      *                                                               *
      *       End-do                                                  *
      *                                                               *
      *       When an error occurs                                    *
      *          If no more messages                                  *
      *             Do nothing                                        *
      *          else                                                 *
      *             Build an error message and move it into data line *
      *             Print the line (Perform PRINT-LINE)               *
      *          End-if                                               *
      *       End-if                                                  *
      *                                                               *
      *       Close the queue                                         *
      *       If an error occurs                                      *
      *          Build an error message and move it into data line    *
      *          Print the line (Perform PRINT-LINE)                  *
      *       End-if                                                  *
      *                                                               *
      *   Exit1  (A-MAIN-DISCONNECT)                                  *
      *   -----                                                       *
      *                                                               *
      *       Disconnect from the queue manager                       *
      *       If an error occurs                                      *
      *          Build an error message and move it into data line    *
      *          Print the line (Perform PRINT-LINE)                  *
      *       End-if                                                  *
      *                                                               *
      *   Exit2  (A-MAIN-END)                                         *
      *   -----                                                       *
      *                                                               *
      *       Set the return code                                     *
      *                                                               *
      *       Close print file                                        *
      *                                                               *
      *       Stop run                                                *
      *                                                               *
      *   Print line  (PRINT-LINE SECTION)                            *
      *   ----------                                                  *
      *                                                               *
      *       If number of lines printed is greater than page maximum *
      *          Print first line of header (Perform PRINT-HEADER-1)  *
      *          Print the rest of the header (Perform PRINT-HEADER-2)*
      *       End-if                                                  *
      *                                                               *
      *       Print data line                                         *
      *                                                               *
      *       Add 1 to count of lines printed                         *
      *                                                               *
      *       Return to performing section                            *
      *                                                               *
      *   Print first line of header  (PRINT-HEADER-1 SECTION)        *
      *   --------------------------                                  *
      *                                                               *
      *       Add 1 to page number                                    *
      *                                                               *
      *       Print first line after jumping to top of page           *
      *                                                               *
      *       Set number of lines printed to 1                        *
      *                                                               *
      *       Return to performing section                            *
      *                                                               *
      *   Print rest of header  (PRINT-HEADER-2 SECTION)              *
      *   --------------------                                        *
      *                                                               *
      *       Print remaining header lines                            *
      *                                                               *
      *       Return to performing section                            *
      *                                                               *
      * ************************************************************* *
      * ------------------------------------------------------------- *
       ENVIRONMENT DIVISION.
      * ------------------------------------------------------------- *
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT SYSPRINT ASSIGN TO UT-S-SYSPRINT.
      * ------------------------------------------------------------- *
       DATA DIVISION.
      * ------------------------------------------------------------- *
       FILE SECTION.
       FD  SYSPRINT
           BLOCK CONTAINS 0 RECORDS
           RECORDING MODE IS F.
       01  PRINT-REC.
           05  CARRIAGE-CONTROL        PIC X.
           05  PRINT-DATA              PIC X(132).
      * ------------------------------------------------------------- *
       WORKING-STORAGE SECTION.
      * ------------------------------------------------------------- *
      *
      *    W00 - General work fields
      *
       01  W00-MAX-LINES               PIC S9(04) BINARY  VALUE +60.
       01  W00-LINE-COUNT              PIC S9(04) BINARY  VALUE ZERO.
       01  W00-PAGE-NUMBER             PIC S9(04) BINARY  VALUE ZERO.
       01  W00-MESSAGE-COUNT           PIC S9(09) BINARY  VALUE ZERO.
       01  W00-DATE.
           05  W00-YY                  PIC 99.
           05  W00-MM                  PIC 99.
           05  W00-DD                  PIC 99.
       01  W00-PRINT-DATA              PIC X(132).
       01  W00-RETURN-CODE             PIC S9(04) BINARY  VALUE ZERO.   .
      *
      *    W01 - Lines of the print report
      *
       01  W01-HEADER-1.
           05  FILLER                  PIC X(10) VALUE SPACES.
           05  W01-MM                  PIC 99.
           05  FILLER                  PIC X     VALUE '/'.
           05  W01-DD                  PIC 99.
           05  FILLER                  PIC X     VALUE '/'.
           05  W01-YY                  PIC 99.
           05  FILLER                  PIC X(38) VALUE SPACES.
           05  FILLER                  PIC X(19) VALUE
                                                  'SAMPLE QUEUE REPORT'.
           05  FILLER                  PIC X(38) VALUE SPACES.
           05  FILLER                  PIC X(05) VALUE 'PAGE '.
           05  W01-PAGE                PIC ZZZ9.
           05  FILLER                  PIC X(10) VALUE SPACES.
       01  W01-HEADER-2.
           05  FILLER                  PIC X(25) VALUE SPACES.
           05  FILLER                  PIC X(29) VALUE
                                       '        QUEUE MANAGER NAME : '.
           05  W01-MQM-NAME            PIC X(48) VALUE SPACES.
           05  FILLER                  PIC X(30) VALUE SPACES.
       01  W01-HEADER-3.
           05  FILLER                  PIC X(37) VALUE SPACES.
           05  FILLER                  PIC X(17) VALUE
                                                    '    QUEUE NAME : '.
           05  W01-QUEUE-NAME          PIC X(48) VALUE SPACES.
           05  FILLER                  PIC X(30) VALUE SPACES.
       01  W01-HEADER-4.
           05  FILLER                  PIC X(16)  VALUE SPACES.
           05  FILLER                  PIC X(116) VALUE '  RELATIVE'.
       01  W01-HEADER-5.
           05  FILLER                  PIC X(16)  VALUE SPACES.
           05  FILLER                  PIC X(10)  VALUE '   MESSAGE'.
           05  FILLER                  PIC X(106) VALUE '   MESSAGE'.
       01  W01-HEADER-6.
           05  FILLER                  PIC X(16) VALUE SPACES.
           05  FILLER                  PIC X(10) VALUE '   NUMBER '.
           05  FILLER                  PIC X(10) VALUE '   LENGTH '.
           05  FILLER                  PIC X(96) VALUE
                         '--------------------------------- MESSAGE DATA
      -                  ' ---------------------------------'.
       01  W01-REPORT-LINE.
           05  FILLER                  PIC X(16) VALUE SPACES.
           05  W01-MESSAGE-NUMBER      PIC Z(8)9.
           05  FILLER                  PIC X     VALUE SPACE.
           05  W01-MESSAGE-LENGTH      PIC Z(8)9.
           05  FILLER                  PIC X     VALUE SPACE.
           05  W01-DATA                PIC X(80).
           05  FILLER                  PIC X(16) VALUE SPACES.
      *
      *    W02 - Data fields derived from the PARM field
      *
       01  W02-MQM                     PIC X(48) VALUE SPACES.
       01  W02-OBJECT                  PIC X(48) VALUE SPACES.
      *
      *    W03 - MQM API fields
      *
       01  W03-BUFFER-LENGTH           PIC S9(9) BINARY  VALUE 80.
       01  W03-HCONN                   PIC S9(9) BINARY.
       01  W03-OPTIONS                 PIC S9(9) BINARY.
       01  W03-HOBJ                    PIC S9(9) BINARY.
       01  W03-DATA-LENGTH             PIC S9(9) BINARY.
       01  W03-COMPCODE                PIC S9(9) BINARY.
       01  W03-REASON                  PIC S9(9) BINARY.
       01  W03-MESSAGE-DATA            PIC X(80) VALUE SPACES.
      *
      *    W04 - Error and information messages
      *
       01  W04-MESSAGE-0.
           05  FILLER              PIC X(48) VALUE SPACES.
           05  FILLER              PIC X(35) VALUE
                                  '********** END OF REPORT **********'.
           05  FILLER              PIC X(49) VALUE SPACES.
       01  W04-MESSAGE-1.
           05  FILLER              PIC X(10)  VALUE SPACES.
           05  FILLER              PIC X(122) VALUE
              '********** NO DATA PASSED TO PROGRAM. PROGRAM REQUIRES A
      -       'QUEUE MANAGER NAME AND A QUEUE NAME. **********'.
       01  W04-MESSAGE-2.
           05  FILLER              PIC X(25)  VALUE SPACES.
           05  FILLER              PIC X(107) VALUE
              '********** NO QUEUE MANAGER NAME PASSED TO PROGRAM - DEFA
      -       'ULT USED *****'.
       01  W04-MESSAGE-3.
           05  FILLER              PIC X(38) VALUE SPACES.
           05  FILLER              PIC X(94) VALUE
              '********** NO QUEUE NAME PASSED TO PROGRAM. **********'.
       01  W04-MESSAGE-4.
           05  FILLER              PIC X(13) VALUE SPACES.
           05  FILLER              PIC X(32) VALUE
                   '********** AN ERROR OCCURRED IN '.
           05  W04-MSG4-TYPE       PIC X(10).
           05  FILLER              PIC X(20) VALUE
                   '. COMPLETION CODE = '.
           05  W04-MSG4-COMPCODE   PIC Z(8)9.
           05  FILLER              PIC X(15) VALUE ' REASON CODE ='.
           05  W04-MSG4-REASON     PIC Z(8)9.
           05  FILLER              PIC X(24) VALUE ' **********'.
      *
      *    The following copy files define API control blocks.
      *
       01  W05-MQM-OBJECT-DESCRIPTOR.
           COPY CMQODV.
       01  W05-MQM-MESSAGE-DESCRIPTOR.
           COPY CMQMDV.
       01  W05-MQM-GET-MESSAGE-OPTIONS.
           COPY CMQGMOV.
      *
      *    Copy file of constants (for filling in the control blocks)
      *    and return codes (for testing the result of a call)
      *
       01  W05-MQM-CONSTANTS.
           COPY CMQV.
      *
      *    W06 - Return values
      *
       01  W06-CSQ4-OK             PIC S9(4) VALUE 0.
       01  W06-CSQ4-WARNING        PIC S9(4) VALUE 4.
       01  W06-CSQ4-ERROR          PIC S9(4) VALUE 8.
      *
      * ------------------------------------------------------------- *
       LINKAGE SECTION.
      * ------------------------------------------------------------- *
       01  PARMDATA.
           05  PARM-LEN                PIC S9(03) BINARY.
           05  PARM-STRING             PIC X(100).
      *
           EJECT
      * ------------------------------------------------------------- *
       PROCEDURE DIVISION USING PARMDATA.
      * ------------------------------------------------------------- *
      * ------------------------------------------------------------- *
       A-MAIN SECTION.
      * ------------------------------------------------------------- *
      *                                                               *
      * This section receives the names of the queue manager and the  *
      * queue from the PARM statement in the JCL. It opens the queue, *
      * reads all the messages, and prints them                       *
      *                                                               *
      * This section uses the MQGET call with the BROWSE option to    *
      * ensure that the data is not removed from the queue            *
      *                                                               *
      * ------------------------------------------------------------- *
      *
      *    Open the print file, initialize the fields for the
      *    header date and the page number, and print the first
      *    line of the header
      *
           OPEN OUTPUT SYSPRINT.
      *
           ACCEPT W00-DATE FROM DATE.
           MOVE W00-MM TO W01-MM.
           MOVE W00-DD TO W01-DD.
           MOVE W00-YY TO W01-YY.
      *
           PERFORM PRINT-HEADER-1.
      *
      *    If no data was passed, create a message, print it, and
      *    exit
      *
           IF PARM-LEN = 0 THEN
              MOVE W04-MESSAGE-1 TO W00-PRINT-DATA
              PERFORM PRINT-LINE
              MOVE W06-CSQ4-WARNING TO W00-RETURN-CODE
              GO TO A-MAIN-END
           END-IF.
      *
      *    Separate into the relevant fields any data passed in the
      *    PARM statement
      *
           UNSTRING PARM-STRING DELIMITED BY ALL ','
                                   INTO W02-MQM
                                        W02-OBJECT.
      *
      *    Move the data (spaces if nothing is entered) into the
      *    relevant print fields
      *
           MOVE W02-MQM    TO W01-MQM-NAME.
           MOVE W02-OBJECT TO W01-QUEUE-NAME.
      *
      *    Print a message if the queue manager name is missing, the
      *    default queue manager will be used
      *
           IF W02-MQM = SPACES OR W02-MQM = LOW-VALUES THEN
              MOVE W04-MESSAGE-2 TO W00-PRINT-DATA
              PERFORM PRINT-LINE
           END-IF.
      *
      *    Print a message if the queue name is missing and exit from
      *    program
      *
           IF W02-OBJECT = SPACES OR W02-OBJECT = LOW-VALUES THEN
              MOVE W04-MESSAGE-3 TO W00-PRINT-DATA
              PERFORM PRINT-LINE
              MOVE W06-CSQ4-WARNING TO W00-RETURN-CODE
              GO TO A-MAIN-END
           END-IF.
      *
      *    Print the remaining header lines
      *
           PERFORM PRINT-HEADER-2.
      *
      *    Connect to the specified queue manager.
      *
           CALL 'MQCONN' USING W02-MQM
                               W03-HCONN
                               W03-COMPCODE
                               W03-REASON.
      *
      *    Test the output of the connect call.  If the call failed,
      *    print an error message showing the completion code and
      *    reason code
      *
           IF (W03-COMPCODE NOT = MQCC-OK) THEN
              MOVE 'CONNECT'     TO W04-MSG4-TYPE
              MOVE W03-COMPCODE  TO W04-MSG4-COMPCODE
              MOVE W03-REASON    TO W04-MSG4-REASON
              MOVE W04-MESSAGE-4 TO W00-PRINT-DATA
              PERFORM PRINT-LINE
              MOVE W06-CSQ4-ERROR TO W00-RETURN-CODE
              GO TO A-MAIN-END
           END-IF.
      *
      *    Initialize the object descriptor (MQOD) control block.
      *    (The copy file initializes all the other fields)
      *
           MOVE MQOT-Q            TO MQOD-OBJECTTYPE.
           MOVE W02-OBJECT        TO MQOD-OBJECTNAME.
      *
      *    Initialize the working storage fields required to open
      *    the queue
      *
      *      W03-OPTIONS is set to open the queue for browsing
      *      W03-HOBJ    is set by the MQOPEN call and is used by the
      *                  MQGET and MQCLOSE calls
      *
           MOVE MQOO-BROWSE       TO W03-OPTIONS.
      *
      *    Open the queue.
      *
           CALL 'MQOPEN' USING W03-HCONN
                               MQOD
                               W03-OPTIONS
                               W03-HOBJ
                               W03-COMPCODE
                               W03-REASON.
      *
      *    Test the output of the open call.  If the call failed, print
      *    an error message showing the completion code and reason code
      *
           IF (W03-COMPCODE NOT = MQCC-OK) THEN
              MOVE 'OPEN'        TO W04-MSG4-TYPE
              MOVE W03-COMPCODE  TO W04-MSG4-COMPCODE
              MOVE W03-REASON    TO W04-MSG4-REASON
              MOVE W04-MESSAGE-4 TO W00-PRINT-DATA
              PERFORM PRINT-LINE
              MOVE W06-CSQ4-ERROR TO W00-RETURN-CODE
              GO TO A-MAIN-DISCONNECT
           END-IF.
      *
      *    No need to change the Message Descriptor (MQMD) control
      *    block because the copy file initializes all the fields
      *
      *    Initialize the Get Message Options (MQGMO) control block.
      *    (The copy file initializes all the other fields)
      *
           MOVE MQGMO-NO-WAIT              TO MQGMO-OPTIONS.
           ADD  MQGMO-ACCEPT-TRUNCATED-MSG TO MQGMO-OPTIONS.
           ADD  MQGMO-BROWSE-FIRST         TO MQGMO-OPTIONS.
      *
      *    Make the first get call outside the loop because this call
      *    uses the BROWSE-FIRST option
      *
           CALL 'MQGET' USING W03-HCONN
                              W03-HOBJ
                              MQMD
                              MQGMO
                              W03-BUFFER-LENGTH
                              W03-MESSAGE-DATA
                              W03-DATA-LENGTH
                              W03-COMPCODE
                              W03-REASON.
      *
      *    Test the output of the get call using the PERFORM loop
      *    that follows.
      *
      *    Change the MQGMO Options field to BROWSE-NEXT.
      *
           MOVE MQGMO-NO-WAIT              TO MQGMO-OPTIONS.
           ADD  MQGMO-ACCEPT-TRUNCATED-MSG TO MQGMO-OPTIONS.
           ADD  MQGMO-BROWSE-NEXT          TO MQGMO-OPTIONS.
      *
      *    Loop from here to END-PERFORM until the get call fails
      *    - we test for call not successful and the one condition
      *      after which we want to continue within the loop
      *      (the received message has been truncated)
      *
           PERFORM WITH TEST BEFORE
                   UNTIL W03-COMPCODE NOT = MQCC-OK
                     AND NOT (W03-COMPCODE = MQCC-WARNING AND
                              W03-REASON = MQRC-TRUNCATED-MSG-ACCEPTED)
      *
      *       Increment the relative message number.  Move the message
      *       number and the message data into the print line
      *
              ADD 1                  TO W00-MESSAGE-COUNT
              MOVE W00-MESSAGE-COUNT TO W01-MESSAGE-NUMBER
              MOVE W03-DATA-LENGTH   TO W01-MESSAGE-LENGTH
              MOVE W03-MESSAGE-DATA  TO W01-DATA
              MOVE W01-REPORT-LINE   TO W00-PRINT-DATA
      *
      *       Print the message line
      *
              PERFORM PRINT-LINE
      *
      ******************************************************************
      *    MQMD-MSGID and MQMD-CORRELID are input/output fields that   *
      *    are filled and read by MQGET.  Clear them before the next   *
      *    MQGET call to ensure that all messages are retrieved.       *
      ******************************************************************
      *
              MOVE MQMI-NONE TO MQMD-MSGID
              MOVE MQCI-NONE TO MQMD-CORRELID
      *
      *    Clear the message data field before the next get call to
      *    ensure that no old data remains if the next line is shorter
      *
              MOVE SPACES TO W03-MESSAGE-DATA
      *
      *       Get the next message
      *
              CALL 'MQGET' USING W03-HCONN
                                 W03-HOBJ
                                 MQMD
                                 MQGMO
                                 W03-BUFFER-LENGTH
                                 W03-MESSAGE-DATA
                                 W03-DATA-LENGTH
                                 W03-COMPCODE
                                 W03-REASON
      *
      *       Test the output of the MQGET call at the top of the loop.
      *       Exit the loop if an error occurs
      *
           END-PERFORM.
      *
      *    Test the output of the get call
      *
      *    When the loop reaches the end of the messages, the
      *    completion code is MQCC-FAILED and the reason code
      *    is MQRC-NO-MSG-AVAILABLE
      *
      *    If the call failed for any other reason,
      *    print an error message showing the completion code and
      *    reason code
      *
           IF (W03-COMPCODE = MQCC-FAILED)  AND
              (W03-REASON = MQRC-NO-MSG-AVAILABLE) THEN
      *
              MOVE W04-MESSAGE-0 TO W00-PRINT-DATA
      *
           ELSE
              MOVE 'GET'         TO W04-MSG4-TYPE
              MOVE W03-COMPCODE  TO W04-MSG4-COMPCODE
              MOVE W03-REASON    TO W04-MSG4-REASON
              MOVE W04-MESSAGE-4 TO W00-PRINT-DATA
           END-IF.
      *
           PERFORM PRINT-LINE
      *
      * Close the queue
      *
           MOVE MQCO-NONE TO W03-OPTIONS.
      *
           CALL 'MQCLOSE' USING W03-HCONN
                                W03-HOBJ
                                W03-OPTIONS
                                W03-COMPCODE
                                W03-REASON.
      *
      *    Test the output of the MQCLOSE call.  If the call failed,
      *    print an error message showing the completion code and reason
      *    code
      *
           IF (W03-COMPCODE NOT = MQCC-OK) THEN
              MOVE 'CLOSE'       TO W04-MSG4-TYPE
              MOVE W03-COMPCODE  TO W04-MSG4-COMPCODE
              MOVE W03-REASON    TO W04-MSG4-REASON
              MOVE W04-MESSAGE-4 TO W00-PRINT-DATA
              PERFORM PRINT-LINE
              MOVE W06-CSQ4-ERROR TO W00-RETURN-CODE
           END-IF.
      *
       A-MAIN-DISCONNECT.
      *
      * Disconnect from the queue manager
      *
           CALL 'MQDISC' USING W03-HCONN
                               W03-COMPCODE
                               W03-REASON.
      *
      *    Test the output of the disconnect call.  If the call failed,
      *    print an error message showing the completion code and
      *    reason code
      *
           IF (W03-COMPCODE NOT = MQCC-OK) THEN
              MOVE 'DISCONNECT'  TO W04-MSG4-TYPE
              MOVE W03-COMPCODE  TO W04-MSG4-COMPCODE
              MOVE W03-REASON    TO W04-MSG4-REASON
              MOVE W04-MESSAGE-4 TO W00-PRINT-DATA
              MOVE W06-CSQ4-ERROR TO W00-RETURN-CODE
              PERFORM PRINT-LINE
           END-IF.
      *
       A-MAIN-END.
      *
      *    Set the return code
      *
           MOVE W00-RETURN-CODE to RETURN-CODE.
      *
      *    Close the print file and stop
      *
           CLOSE SYSPRINT.
           STOP RUN.
      *
      ******************************************************************
      *
       PRINT-LINE SECTION.
      *
      *    This section prints all data lines produced by the program
      *
      *    If the maximum number of lines for a page has been printed,
      *    start a new page
      *
           IF W00-LINE-COUNT > W00-MAX-LINES
              PERFORM PRINT-HEADER-1
              PERFORM PRINT-HEADER-2
           END-IF.
      *
           MOVE W00-PRINT-DATA TO PRINT-DATA.
           WRITE PRINT-REC AFTER ADVANCING 1.
      *
           ADD 1 TO W00-LINE-COUNT.
      *
       PRINT-LINE-END.
           EXIT.
      *
      ******************************************************************
      *
       PRINT-HEADER-1 SECTION.
      *
      *    This section prints the first line of the report.
      *    This is separate from the section that prints the other
      *    header lines because the first line is needed every time
      *    the program runs
      *
           ADD 1 TO W00-PAGE-NUMBER.
           MOVE W00-PAGE-NUMBER TO W01-PAGE.
           MOVE W01-HEADER-1 TO PRINT-DATA.
           WRITE PRINT-REC AFTER ADVANCING PAGE.
      *
           MOVE 1 TO W00-LINE-COUNT.
      *
       PRINT-HEADER-1-END.
           EXIT.
      *
      ******************************************************************
      *
       PRINT-HEADER-2 SECTION.
      *
      *    This section prints the remaining header lines
      *
           MOVE W01-HEADER-2 TO PRINT-DATA.
           WRITE PRINT-REC AFTER ADVANCING 2.
           ADD 2 TO W00-LINE-COUNT.
      *
           MOVE W01-HEADER-3 TO PRINT-DATA.
           WRITE PRINT-REC AFTER ADVANCING 1.
           ADD 1 TO W00-LINE-COUNT.
      *
           MOVE W01-HEADER-4 TO PRINT-DATA.
           WRITE PRINT-REC AFTER ADVANCING 2.
           ADD 2 TO W00-LINE-COUNT.
      *
           MOVE W01-HEADER-5 TO PRINT-DATA.
           WRITE PRINT-REC AFTER ADVANCING 1.
           ADD 1 TO W00-LINE-COUNT.
      *
           MOVE W01-HEADER-6 TO PRINT-DATA.
           WRITE PRINT-REC AFTER ADVANCING 1.
           ADD 1 TO W00-LINE-COUNT.
      *
           MOVE SPACES       TO PRINT-DATA.
           WRITE PRINT-REC AFTER ADVANCING 1.
           ADD 1 TO W00-LINE-COUNT.
      *
       PRINT-HEADER-2-END.
           EXIT.
      * --------------------------------------------------------------- *
      *                  End of program                                 *
      * --------------------------------------------------------------- *