Quelle  csq4cvd2.cob   Sprache: Cobol

CBL XOPTS(ANSI85)
CBL NODYNAM,LIB,OBJECT,RENT,RES,APOST,NUMPROC(NOPFD)
      * ------------------------------------------------------------- *
       IDENTIFICATION DIVISION.
      * ------------------------------------------------------------- *
       PROGRAM-ID. CSQ4CVD2.
      *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      : CSQ4CVD2                                  *
      *                                                               *
      *  Environment      : CICS/ESA Version 3.3; COBOL II            *
      *                                                               *
      *  Function         : This program provides display mail        *
      *                     awaiting and display chosen message       *
      *                     function for the mail manager sample.     *
      *                     See IBM MQSeries for MVS/ESA              *
      *                     Application Programming Reference,        *
      *                     for further details.                      *
      *                                                               *
      *  Description      : This program displays a list of the       *
      *                     messages on a users mail queue using      *
      *                     panel MAIL-VD2. When a user selects a     *
      *                     specific message, its contents are        *
      *                     displayed by program CSQ4CVD3.            *
      *                                                               *
      * ************************************************************* *
      *                                                               *
      *                      Program Logic                            *
      *                      -------------                            *
      *                                                               *
      *   Start  (A-MAIN SECTION)                                     *
      *   -----                                                       *
      *       Perform LIST-MESSAGES-ON-MAIL-Q                         *
      *                                                               *
      *       Perform DISPLAY-CURRENT-PAGE                            *
      *       Do while PF3 is not pressed                             *
      *          Evaluate user request                                *
      *             If Help (PF1) key pressed                         *
      *                Display the help screen until PF12 is pressed  *
      *             If End (PF3) key pressed                          *
      *                Do nothing                                     *
      *             If Previous page (PF7) key pressed                *
      *                Perform DISPLAY-PREVIOUS-PAGE                  *
      *             If Next page (PF8) key pressed                    *
      *                Perform DISPLAY-NEXT-PAGE                      *
      *             Else if enter key pressed                         *
      *                Perform DISPLAY-CHOSEN-MESSAGE                 *
      *             End-if                                            *
      *          End-evaluate                                         *
      *          Perform DISPLAY-CURRENT-PAGE                         *
      *       End-do                                                  *
      *                                                               *
      *       Delete the CICS ts queue                                *
      *                                                               *
      *       Return to CICS                                          *
      *                                                               *
      *                                                               *
      *   LIST-MESSAGES-ON-MAIL-Q SECTION                             *
      *   -------------------------------                             *
      *       Delete the CICS ts queue                                *
      *       Initialize the variables for the get browse call        *
      *       Browse the first message on the users mail queue        *
      *       Set line number to zero                                 *
      *       Do while get calls are successful and less than 99      *
      *       messages retrieved                                      *
      *          Add one to line number                               *
      *          Update page number if required                       *
      *          Write the message information to the CICS ts queue   *
      *          Browse the next message on the queue                 *
      *       End-do                                                  *
      *                                                               *
      *       If 99 messages retrieved                                *
      *          Build an information message                         *
      *       Else                                                    *
      *          If the reason for get failing is not no-msg-available*
      *             Build an error message                            *
      *          End-if                                               *
      *       End-if                                                  *
      *                                                               *
      *       Set current page number to maxpages                     *
      *                                                               *
      *       Return to performing section                            *
      *                                                               *
      *                                                               *
      *   DISPLAY-CHOSEN-MESSAGE SECTION                              *
      *   ------------------------------                              *
      *                                                               *
      *       If a valid message number has been entered              *
      *          Calculate which message is wanted                    *
      *          If the record exists                                 *
      *             Read the record of the message from the CICS ts   *
      *             queue                                             *
      *             If the message has not already been deleted       *
      *                Update the commarea                            *
      *                Call CSQ4CVD3 to display the message           *
      *                Syncpoint                                      *
      *                Update the CICS ts queue row (message deleted) *
      *             Else                                              *
      *                Set 'message already deleted' message          *
      *             End-if                                            *
      *          Else                                                 *
      *             Set 'choose a valid record' message               *
      *          End-if                                               *
      *       Else                                                    *
      *          Set 'choose a valid record' message                  *
      *       End-if                                                  *
      *                                                               *
      *       Return to performing section                            *
      *                                                               *
      *                                                               *
      *   DISPLAY-CURRENT-PAGE SECTION                                *
      *   ----------------------------                                *
      *       Set the screen fields                                   *
      *       Determine which message to get first                    *
      *       Set record number to zero                               *
      *       Do until details of 15 messages retrieved or until      *
      *       the last record retrieved                               *
      *          Add one to record number                             *
      *          Get record details from CICS ts queue                *
      *          Set the screen field for the appropriate line        *
      *       End-do                                                  *
      *       Perform DISPLAY-MAPVD2                                  *
      *                                                               *
      *       Return to performing section                            *
      *                                                               *
      *                                                               *
      *   DISPLAY-NEXT-PAGE SECTION                                   *
      *   -------------------------                                   *
      *       If last page is being displayed                         *
      *          Build 'last page being displayed' message            *
      *       Else                                                    *
      *          Set line number to 1                                 *
      *          Add 1 to page number                                 *
      *       End-if                                                  *
      *                                                               *
      *       Return to performing section                            *
      *                                                               *
      *                                                               *
      *   DISPLAY-PREVIOUS-PAGE SECTION                               *
      *   -----------------------------                               *
      *       If first page is being displayed                        *
      *          Build 'first page being displayed' message           *
      *       Else                                                    *
      *          Set line number to 1                                 *
      *          Subtract 1 from page number                          *
      *       End-if                                                  *
      *                                                               *
      *       Return to performing section                            *
      *                                                               *
      *                                                               *
      *   DISPLAY-MAPVD2 SECTION                                      *
      *   ----------------------                                      *
      *       Exec CICS send mail awaiting screen map                 *
      *       Exec CICS receive mail awaiting screen map              *
      *                                                               *
      *       Return to performing section                            *
      *                                                               *
      *                                                               *
      *   DISPLAY-HELP SECTION                                        *
      *   --------------------                                        *
      *       Do until PF12 key is pressed                            *
      *          Exec CICS send help screen map                       *
      *          Exec CICS receive help screen map                    *
      *       End-do                                                  *
      *                                                               *
      *       Return to performing section                            *
      *                                                               *
      *****************************************************************
      * ------------------------------------------------------------- *
       ENVIRONMENT DIVISION.
      * ------------------------------------------------------------- *
      * ------------------------------------------------------------- *
       DATA DIVISION.
      * ------------------------------------------------------------- *
       WORKING-STORAGE SECTION.
      * ------------------------------------------------------------- *
      *
      *    W00 - General work fields
      *
       01  W00-RECD-MAILQ.
           05                          PIC X(17).
           05  W00-SENT-FROM           PIC X(08)       VALUE SPACES.
           05                          PIC X(23).
      *
       01  W00-DATA-LENGTH             PIC S9(09) BINARY.
       01  W00-TOTAL-RECORDS           PIC S9(09) BINARY.
      *
       01  W00-SCREEN-LINE             PIC S9(09) BINARY.
       01  W00-MAX-PAGES               PIC S9(09) BINARY.
       01  W00-REC-NUM                 PIC S9(04) BINARY.
       01  W00-LINE-NUMBER             PIC 99            VALUE ZERO.
       01  W00-PAGE-NUMBER             PIC 9(04)         VALUE ZERO.
       01  W00-SKIP-NUMBER             PIC S9(08) BINARY VALUE ZERO.
       01  W00-RETURN-CODE             PIC S9(08) BINARY VALUE ZERO.
      *
       01  W00-QUEUE-DATE.
           05  W00-Q-YEAR              PIC 9(04)       VALUE ZERO.
           05  W00-Q-MONTH             PIC 9(02)       VALUE ZERO.
           05  W00-Q-DAY               PIC 9(02)       VALUE ZERO.
       01  W00-DISPLAY-DATE.
           05  W00-D-MONTH             PIC 9(02)       VALUE ZERO.
           05                          PIC X           VALUE '/'.
           05  W00-D-DAY               PIC 9(02)       VALUE ZERO.
           05                          PIC X           VALUE '/'.
           05  W00-D-YEAR              PIC 9(04)       VALUE ZERO.
      *
       01  W00-QUEUE-TIME.
           05  W00-Q-HOUR              PIC 9(02)       VALUE ZERO.
           05  W00-Q-MINUTE            PIC 9(02)       VALUE ZERO.
           05  W00-Q-SEC               PIC 9(02)       VALUE ZERO.
           05  W00-Q-100SEC            PIC 9(02)       VALUE ZERO.
       01  W00-DISPLAY-TIME.
           05  W00-D-HOUR              PIC 9(02)       VALUE ZERO.
           05                          PIC X           VALUE ':'.
           05  W00-D-MINUTE            PIC 9(02)       VALUE ZERO.
           05                          PIC X           VALUE ':'.
           05  W00-D-SEC               PIC 9(02)       VALUE ZERO.
      *
      *    W01 - CICS temporary dynamic queue name
      *
       01  W01-TSQ-NAME.
           05                          PIC X(04)       VALUE 'MAIL'.
           05  W01-TSQ-TERM            PIC X(04)       VALUE SPACES.
      *
      *    W02 - Field definitions for mail awaiting records
      *
       01  W02-TSQ-RECORD.
           05  W02-PAGENO              PIC S9(9) BINARY.
           05  W02-DISPLAY-DETAILS.
               10  W02-LINENO          PIC Z9           VALUE ZERO.
               10                      PIC XX           VALUE SPACES.
               10  W02-MSGFROM         PIC X(08)        VALUE SPACES.
               10                      PIC XX           VALUE SPACES.
               10  W02-MSGDATE         PIC X(10)        VALUE SPACES.
               10                      PIC XX           VALUE SPACES.
               10  W02-MSGTIME         PIC X(08)        VALUE SPACES.
           05                          PIC XX           VALUE SPACES.
           05  W02-MSGID               PIC X(24).
           05  W02-CORRELID            PIC X(24).
       01  W02-TSQ-RECORD-LENGTH       PIC S9(4) BINARY VALUE 88.
      *
      *    W03 - MQM API fields
      *
       01  W03-COMPCODE               PIC S9(09) BINARY VALUE ZERO.
       01  W03-REASON                 PIC S9(09) BINARY VALUE ZERO.
      *
      *
      *    W04 - Screen map name definitions
      *
       01  W04-MAPSET-NAME            PIC X(08)       VALUE 'CSQ4VDM'.
       01  W04-CSQ4VD2                PIC X(08)       VALUE 'CSQ4VD2'.
       01  W04-CSQ4VD6                PIC X(08)       VALUE 'CSQ4VD6'.
       01  W04-CSQ4CVD3               PIC X(08)       VALUE 'CSQ4CVD3'.
      *
      *    Fields used for communication between programs in mail
      *    manager sample
      *
       COPY CSQ4VD3.
      *
      *    Mail manager message definition
      *
       COPY CSQ4VD4.
      *
      *    The following copy book contains messages that will be
      *    displayed to the user
      *
       COPY CSQ4VD0.
      *
      *    Screen map definitions used by this sample program
      *
       COPY CSQ4VDM.
      *
      *    DFHAID contains the constants used for checking for
      *    attention identifiers
      *
       COPY DFHAID SUPPRESS.
      *
      *    API control blocks
      *
       01  MQM-OBJECT-DESCRIPTOR.
           COPY CMQODV SUPPRESS.
       01  MQM-MESSAGE-DESCRIPTOR.
           COPY CMQMDV SUPPRESS.
       01  MQM-GET-MESSAGE-OPTIONS.
           COPY CMQGMOV SUPPRESS.
      *
      *    Copy book of constants (for filling in the control blocks)
      *    and return codes (for testing the result of a call)
      *
       01  CMQV.
       COPY CMQV SUPPRESS.
           EJECT
      * ------------------------------------------------------------- *
       LINKAGE SECTION.
       01  DFHCOMMAREA                 PIC X(200).
      * ------------------------------------------------------------- *
           EJECT
      * ------------------------------------------------------------- *
       PROCEDURE DIVISION.
      * ------------------------------------------------------------- *
      * ------------------------------------------------------------- *
       A-MAIN SECTION.
      * ------------------------------------------------------------- *
      *                                                               *
      * This section calls LIST-MESSAGES-ON-MAIL-Q to build a list of *
      * the messages on a users mail queue in a CICS ts queue and     *
      * then displays the first page of messages from the list.       *
      * The section then enters a loop actioning user choices. The    *
      * user may display the next page of messages, the previous page *
      * of messages or the contents of a chosen message until the     *
      * user presses PF3.                                             *
      *                                                               *
      * Finally the CICS ts queue is deleted.                         *
      *                                                               *
      * ------------------------------------------------------------- *
      *
      *    Get the commarea passed
      *
           IF EIBCALEN = 0 THEN
              Move VD0-MESSAGE-27 TO VD3-MSG
              GO TO A-MAIN-EXIT
           END-IF.
           MOVE DFHCOMMAREA TO VD3-MAIL-COMMAREA.
      *
      *    Reset the message area
      *
           MOVE SPACES TO VD3-MSG.
      *
      *    Get list of messages on user's mail queue
      *
           PERFORM LIST-MESSAGES-ON-MAIL-Q.
      *
      *    Set to first page
      *
           MOVE 1 TO W00-LINE-NUMBER.
           MOVE 1 TO W00-PAGE-NUMBER.
      *
      *    Display first page of messages
      *
           EXEC CICS IGNORE CONDITION
                     MAPFAIL
           END-EXEC.
      *
           PERFORM DISPLAY-CURRENT-PAGE.
      *
      *    Loop from here to END-PERFORM until the PF3 key is pressed
      *
           PERFORM WITH TEST BEFORE UNTIL (EIBAID = DFHPF3 OR
                                           EIBAID = DFHPF15)
               MOVE SPACES TO VD3-MSG
      *
               EVALUATE TRUE
                   WHEN EIBAID = DFHPF1 OR EIBAID = DFHPF13
                       PERFORM DISPLAY-HELP
      *
                   WHEN EIBAID = DFHPF3 OR EIBAID = DFHPF15
                       CONTINUE
      *
                   WHEN EIBAID = DFHPF7 OR EIBAID = DFHPF19
                       PERFORM DISPLAY-PREVIOUS-PAGE
      *
                   WHEN EIBAID = DFHPF8 OR EIBAID = DFHPF20
                       PERFORM DISPLAY-NEXT-PAGE
      *
                   WHEN EIBAID = DFHENTER
                       PERFORM DISPLAY-CHOSEN-MESSAGE
      *
               END-EVALUATE
      *
               PERFORM DISPLAY-CURRENT-PAGE
      *
           END-PERFORM.
      *
       A-MAIN-EXIT.
      *
      *    Delete the CICS temporary storage queue
      *
           EXEC CICS IGNORE CONDITION
                     QIDERR
           END-EXEC.
           EXEC CICS DELETEQ TS
                     QUEUE(W01-TSQ-NAME)
           END-EXEC.
      *
      *    Return to calling program
      *
           EXEC CICS RETURN
           END-EXEC.
      *
           EXIT.
           EJECT
      *
      * ------------------------------------------------------------- *
       LIST-MESSAGES-ON-MAIL-Q SECTION.
      * ------------------------------------------------------------- *
      *                                                              *
      *  After ensuring it does not already exist, this section      *
      *  creates a CICS temporary storage queue. The users mail queue*
      *  is then browsed and a record written for each message on    *
      *  the queue.                                                  *
      *                                                              *
      *  If any error (other than no-msg-available from the get call)*
      *  occurs a message is set for display by  the calling section.*
      *                                                              *
      * ------------------------------------------------------------ *
      *
      *    Ensure the temporary storage queue does not exist
      *    - prior to creating it
      *
           MOVE EIBTRMID TO W01-TSQ-TERM.
           EXEC CICS IGNORE CONDITION
                     QIDERR
           END-EXEC.
           EXEC CICS DELETEQ TS
                     QUEUE(W01-TSQ-NAME)
           END-EXEC.
      *
      *    Initialize the variables for the first browse call
      *
           MOVE MQGMO-BROWSE-FIRST TO MQGMO-OPTIONS.
           ADD  MQGMO-NO-WAIT      TO MQGMO-OPTIONS.
      *
           MOVE MQMI-NONE  TO MQMD-MSGID.
           MOVE MQCI-NONE  TO MQMD-CORRELID.
      *
      *    Browse the first message
      *
           CALL 'MQGET' USING VD3-HCONN
                              VD3-HOBJ
                              MQMD
                              MQGMO
                              VD4-MSG-LENGTH
                              VD4-MESSAGE
                              W00-DATA-LENGTH
                              W03-COMPCODE
                              W03-REASON.
      *
      *    Test the output of the call with the perform loop
      *
           MOVE 1 TO W00-PAGE-NUMBER.
           MOVE 0 TO W00-TOTAL-RECORDS.
           MOVE 0 TO W00-LINE-NUMBER.
      *
           MOVE MQGMO-BROWSE-NEXT TO MQGMO-OPTIONS.
      *
           PERFORM WITH TEST BEFORE UNTIL ((W03-COMPCODE NOT = MQCC-OK)
                                       OR  (W00-TOTAL-RECORDS >= 99))
      *
      *        Update the line and page numbers
      *
               ADD 1 TO W00-TOTAL-RECORDS
               ADD 1 TO W00-LINE-NUMBER
               IF W00-LINE-NUMBER > 15 THEN
                  MOVE 1 TO W00-LINE-NUMBER
                  ADD  1 TO W00-PAGE-NUMBER
               END-IF
      *
      *        Put the message information on the temporary storage
      *        queue
      *
               MOVE SPACES               TO W02-TSQ-RECORD
               MOVE W00-LINE-NUMBER      TO W02-LINENO
               MOVE W00-PAGE-NUMBER      TO W02-PAGENO
               MOVE MQMD-MSGID           TO W02-MSGID
               MOVE MQMD-CORRELID        TO W02-CORRELID
               MOVE MQMD-REPLYTOQ        TO W00-RECD-MAILQ
               MOVE W00-SENT-FROM        TO W02-MSGFROM
               MOVE MQMD-PUTDATE         TO W00-QUEUE-DATE
               MOVE W00-Q-YEAR           TO W00-D-YEAR
               MOVE W00-Q-MONTH          TO W00-D-MONTH
               MOVE W00-Q-DAY            TO W00-D-DAY
               MOVE W00-DISPLAY-DATE     TO W02-MSGDATE
               MOVE MQMD-PUTTIME         TO W00-QUEUE-TIME
               MOVE W00-Q-HOUR           TO W00-D-HOUR
               MOVE W00-Q-MINUTE         TO W00-D-MINUTE
               MOVE W00-Q-SEC            TO W00-D-SEC
               MOVE W00-DISPLAY-TIME     TO W02-MSGTIME
      *
               MOVE LENGTH OF W02-TSQ-RECORD TO
                                            W02-TSQ-RECORD-LENGTH
      *
               EXEC CICS WRITEQ TS
                         QUEUE(W01-TSQ-NAME)
                         FROM(W02-TSQ-RECORD)
                         LENGTH(W02-TSQ-RECORD-LENGTH)
               END-EXEC
      *
      *        Browse the next message
      *
               MOVE MQMI-NONE  TO MQMD-MSGID
               MOVE MQCI-NONE  TO MQMD-CORRELID
      *
               CALL 'MQGET' USING VD3-HCONN
                                  VD3-HOBJ
                                  MQMD
                                  MQGMO
                                  VD4-MSG-LENGTH
                                  VD4-MESSAGE
                                  W00-DATA-LENGTH
                                  W03-COMPCODE
                                  W03-REASON
      *
           END-PERFORM.
      *
           IF (W03-COMPCODE = MQCC-OK) AND
              (W00-TOTAL-RECORDS = 99) THEN
               MOVE VD0-MESSAGE-8 TO VD3-MSG
      *
           ELSE
               IF (W03-COMPCODE NOT = MQCC-FAILED) AND
                  (W03-REASON NOT = MQRC-NO-MSG-AVAILABLE) THEN
                   MOVE 'LIST MSGS'   TO VD0-MSG1-TYPE
                   MOVE W03-COMPCODE  TO VD0-MSG1-COMPCODE
                   MOVE W03-REASON    TO VD0-MSG1-REASON
                   MOVE VD0-MESSAGE-1 TO VD3-MSG
               END-IF
           END-IF.
      *
           MOVE W00-PAGE-NUMBER TO W00-MAX-PAGES.
      *
       LIST-MESSAGES-ON-MAIL-Q-EXIT.
      *
      *    Return to performing section
      *
           EXIT.
           EJECT
      *
      * ------------------------------------------------------------- *
       DISPLAY-CHOSEN-MESSAGE SECTION.
      * ------------------------------------------------------------- *
      *                                                              *
      *  This section checks that a valid message number has been    *
      *  entered by the user, if an invalid message number has been  *
      *  entered an error message is built;  otherwise the section   *
      *  obtains details of the chosen message from the CICS ts      *
      *  queue and, using these, calls program CSQ4CVD3 to display   *
      *  the message to the user.   Once the user has finished       *
      *  viewing the message CSQ4CVD3 returns and removal of the     *
      *  message from the mail queue is committed and the CICS ts    *
      *  queue updated.                                              *
      *                                                              *
      * ------------------------------------------------------------ *
      *
      *    Check the value entered is in the range 1 to 15
      *
           MOVE VD2SNI TO W00-SCREEN-LINE.
           IF ((W00-SCREEN-LINE > 0) AND (W00-SCREEN-LINE < 16)) THEN
      *
      *        Calculate which record is wanted
      *
               COMPUTE W00-REC-NUM = (((W00-PAGE-NUMBER - 1) * 15)
                                      + W00-SCREEN-LINE)
      *
      *        If the record exists get it, otherwise build an
      *        error message
      *
               IF ((W00-REC-NUM >= 1) AND
                   (W00-REC-NUM <= W00-TOTAL-RECORDS)) THEN
      *
                   EXEC CICS READQ TS
                             QUEUE(W01-TSQ-NAME)
                             INTO(W02-TSQ-RECORD)
                             LENGTH(W02-TSQ-RECORD-LENGTH)
                             ITEM(W00-REC-NUM)
                   END-EXEC
      *
      *            Check that the record has not already been retrieved
      *
                   IF W02-MSGFROM NOT = 'Deleted'
      *
      *                Update the COMMAREA and display the message
      *
      *                MOVE W02-MSGFROM  TO VD3-USERID
                       MOVE W02-MSGDATE  TO VD3-DISPDATE
                       MOVE W02-MSGTIME  TO VD3-DISPTIME
                       MOVE W02-MSGID    TO VD3-MSGID
                       MOVE W02-CORRELID TO VD3-CORRELID
      *
                       MOVE LENGTH OF VD3-MAIL-COMMAREA TO
                                                  VD3-COMMAREA-LENGTH
      *
                       EXEC CICS LINK
                                 PROGRAM(W04-CSQ4CVD3)
                                 COMMAREA(VD3-MAIL-COMMAREA)
                                 LENGTH(VD3-COMMAREA-LENGTH)
                       END-EXEC
      *
      *                Complete retrieval of the message
      *
                       EXEC CICS SYNCPOINT
                       END-EXEC
      *
                       MOVE 'Deleted' TO W02-MSGFROM
                       MOVE SPACES    TO W02-MSGDATE
                       MOVE SPACES    TO W02-MSGTIME
      *
                       EXEC CICS WRITEQ TS
                             QUEUE(W01-TSQ-NAME)
                             FROM(W02-TSQ-RECORD)
                             LENGTH(W02-TSQ-RECORD-LENGTH)
                             ITEM(W00-REC-NUM)
                             REWRITE
                       END-EXEC
                   ELSE
                       MOVE VD0-MESSAGE-5 TO VD3-MSG
                   END-IF
      *
               ELSE
                   MOVE VD0-MESSAGE-4 TO VD3-MSG
               END-IF
      *
           ELSE
               MOVE VD0-MESSAGE-4 TO VD3-MSG
           END-IF.
      *
       DISPLAY-CHOSEN-MESSAGE-EXIT.
      *
      *    Return to performing section
      *
           EXIT.
           EJECT
      *
      * ------------------------------------------------------------- *
       DISPLAY-CURRENT-PAGE SECTION.
      * ------------------------------------------------------------- *
      *                                                              *
      *  This section displays the current page of messages waiting  *
      *  by reading the lines from the CICS temporary storage queue  *
      *  and moving the required data to the map fields.             *
      *                                                              *
      * ------------------------------------------------------------ *
      *
      *    Clear the map
      *
           MOVE LOW-VALUES TO CSQ4VD2O.
      *
      *    Update the screen map fields
      *
           MOVE VD3-USERID         TO VD2IDO.
           MOVE VD3-SUBSYS         TO VD2QMO.
           MOVE W00-MAX-PAGES      TO VD2PTOTO.
           MOVE W00-PAGE-NUMBER    TO VD2PNOO.
      *    MOVE W00-SCREEN-LINE    TO VD2SNO.
      *
      *    Decide which message to get first
      *
           COMPUTE W00-REC-NUM = ((W00-PAGE-NUMBER - 1) * 15).
      *
      *    Get a screenful of messages
      *
           PERFORM WITH TEST AFTER VARYING W00-SCREEN-LINE
                   FROM 1 BY 1 UNTIL (W00-SCREEN-LINE = 15 OR
                                      W00-REC-NUM = W00-TOTAL-RECORDS)
      *
               ADD 1 TO W00-REC-NUM
      *
               EXEC CICS READQ TS
                         QUEUE(W01-TSQ-NAME)
                         INTO(W02-TSQ-RECORD)
                         LENGTH(W02-TSQ-RECORD-LENGTH)
                         ITEM(W00-REC-NUM)
               END-EXEC
      *
               EVALUATE TRUE
                   WHEN W02-LINENO = ' 1'
                       MOVE W02-DISPLAY-DETAILS TO VD2L1O
                   WHEN W02-LINENO = ' 2'
                       MOVE W02-DISPLAY-DETAILS TO VD2L2O
                   WHEN W02-LINENO = ' 3'
                       MOVE W02-DISPLAY-DETAILS TO VD2L3O
                   WHEN W02-LINENO = ' 4'
                       MOVE W02-DISPLAY-DETAILS TO VD2L4O
                   WHEN W02-LINENO = ' 5'
                       MOVE W02-DISPLAY-DETAILS TO VD2L5O
                   WHEN W02-LINENO = ' 6'
                       MOVE W02-DISPLAY-DETAILS TO VD2L6O
                   WHEN W02-LINENO = ' 7'
                       MOVE W02-DISPLAY-DETAILS TO VD2L7O
                   WHEN W02-LINENO = ' 8'
                       MOVE W02-DISPLAY-DETAILS TO VD2L8O
                   WHEN W02-LINENO = ' 9'
                       MOVE W02-DISPLAY-DETAILS TO VD2L9O
                   WHEN W02-LINENO = '10'
                       MOVE W02-DISPLAY-DETAILS TO VD2L10O
                   WHEN W02-LINENO = '11'
                       MOVE W02-DISPLAY-DETAILS TO VD2L11O
                   WHEN W02-LINENO = '12'
                       MOVE W02-DISPLAY-DETAILS TO VD2L12O
                   WHEN W02-LINENO = '13'
                       MOVE W02-DISPLAY-DETAILS TO VD2L13O
                   WHEN W02-LINENO = '14'
                       MOVE W02-DISPLAY-DETAILS TO VD2L14O
                   WHEN W02-LINENO = '15'
                       MOVE W02-DISPLAY-DETAILS TO VD2L15O
                   WHEN OTHER
                       MOVE VD0-MESSAGE-24 TO VD2MSG0O
              END-EVALUATE
      *
           END-PERFORM.
      *
           MOVE VD3-MSG TO VD2MSG1O.
      *
           PERFORM DISPLAY-MAPVD2.
      *
       DISPLAY-CURRENT-PAGE-EXIT.
      *
      *    Return to performing section
      *
           EXIT.
           EJECT
      *
      * ------------------------------------------------------------- *
       DISPLAY-NEXT-PAGE SECTION.
      * ------------------------------------------------------------- *
      *                                                              *
      *  This section sets the line and page number so the next      *
      *  page will be displayed - if the last page is already        *
      *  being displayed an error message is set.                    *
      *                                                              *
      * ------------------------------------------------------------ *
      *
           IF W00-PAGE-NUMBER = W00-MAX-PAGES
                MOVE VD0-MESSAGE-7 TO VD3-MSG
           ELSE
                MOVE 1 TO W00-LINE-NUMBER
                ADD  1 TO W00-PAGE-NUMBER
           END-IF.
      *
       DISPLAY-NEXT-PAGE-EXIT.
      *
      *    Return to performing section
      *
           EXIT.
           EJECT
      *
      * ------------------------------------------------------------- *
       DISPLAY-PREVIOUS-PAGE SECTION.
      * ------------------------------------------------------------- *
      *                                                              *
      *  This section sets the line and page number so the previous  *
      *  page will be displayed - if the first page is already       *
      *  being displayed an error message is set.                    *
      *                                                              *
      * ------------------------------------------------------------ *
      *
      *
           IF W00-PAGE-NUMBER = 1
                MOVE VD0-MESSAGE-6 TO VD3-MSG
           ELSE
                MOVE      1 TO   W00-LINE-NUMBER
                SUBTRACT  1 FROM W00-PAGE-NUMBER
           END-IF.
      *
      *
       DISPLAY-PREVIOUS-PAGE-EXIT.
      *
      *    Return to performing section
      *
           EXIT.
           EJECT
      *
      * ------------------------------------------------------------- *
       DISPLAY-MAPVD2 SECTION.
      * ------------------------------------------------------------- *
      *                                                              *
      *  This section sends the immediate inquiry screen (MAIL-VD2)  *
      *  to the terminal and returns once the receive is complete    *
      *                                                              *
      * ------------------------------------------------------------ *
      *
              EXEC CICS SEND
                        MAP(W04-CSQ4VD2)
                        MAPSET(W04-MAPSET-NAME)
                        FROM(CSQ4VD2O)
                        ERASE
              END-EXEC.
      *
              EXEC CICS RECEIVE
                        MAP(W04-CSQ4VD2)
                        MAPSET(W04-MAPSET-NAME)
                        INTO(CSQ4VD2I)
              END-EXEC.
      *
       DISPLAY-MAPVD2-EXIT.
      *
      *    Return to performing section
      *
           EXIT.
           EJECT
      *
      * ------------------------------------------------------------- *
       DISPLAY-HELP SECTION.
      * ------------------------------------------------------------- *
      *                                                              *
      *  This section displays the help panel until PF12 is pressed  *
      *                                                              *
      * ------------------------------------------------------------ *
      *
             PERFORM WITH TEST BEFORE UNTIL EIBAID = DFHPF12
                                         OR EIBAID = DFHPF24
      *
                 EXEC CICS SEND
                           MAP(W04-CSQ4VD6)
                           MAPSET(W04-MAPSET-NAME)
                           FROM(CSQ4VD6O)
                           ERASE
                 END-EXEC
      *
                 EXEC CICS RECEIVE
                           MAP(W04-CSQ4VD6)
                           MAPSET(W04-MAPSET-NAME)
                           INTO(CSQ4VD6I)
                 END-EXEC
      *
             END-PERFORM.
      *
       DISPLAY-HELP-EXIT.
      *
      *    Return to performing section
      *
           EXIT.
           EJECT
      *
      * ---------------------------------------------------------------
      *                  End of program
      * ---------------------------------------------------------------