Quellcode-Bibliothek 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
      * ---------------------------------------------------------------

quality98%

¤ Die Informationen auf dieser Webseite wurden nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit, noch Qualität der bereit gestellten Informationen zugesichert.0.24Bemerkung: (vorverarbeitet) ¤

Wurzel

Suchen

Beweissystem der NASA

Beweissystem Isabelle

NIST Cobol Testsuite

Cephes Mathematical Library

Wiener Entwicklungsmethode

Haftungshinweis

Die Informationen auf dieser Webseite wurden nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit, noch Qualität der bereit gestellten Informationen zugesichert.

Bemerkung:

Die farbliche Syntaxdarstellung ist noch experimentell.