Quelle  csq4tvd2.cob   Sprache: Cobol

CBL NODYNAM,LIB,OBJECT,RENT,RES,APOST
      * ------------------------------------------------------------- *
       IDENTIFICATION DIVISION.
      * ------------------------------------------------------------- *
       PROGRAM-ID. CSQ4TVD2.
      *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      : CSQ4TVD2                                  *
      *                                                               *
      *  Environment      : MVS TSO/ISPF; 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 CSQ4VDP2. When a user selects a     *
      *                     specific message, its contents are        *
      *                     displayed on panel CSQ4VDP3.              *
      *                                                               *
      * ************************************************************* *
      *                                                               *
      *                      Program Logic                            *
      *                      -------------                            *
      *                                                               *
      *   Start  (A-MAIN SECTION)                                     *
      *   -----                                                       *
      *                                                               *
      *       Define required variables to ISPF                       *
      *                                                               *
      *       Perform LIST-MESSAGES-ON-MAIL-Q                         *
      *                                                               *
      *       If ISPF return code is zero and get-browse finished     *
      *       because no message available                            *
      *          Set pointer to top of table                          *
      *          Display the ISPF table on panel CSQ4VDP3             *
      *                                                               *
      *          Do while ISPF return code is zero (until PF3 pressed)*
      *             Perform DISPLAY-CHOSEN-MESSAGE                    *
      *             Redisplay the ISPF table                          *
      *          End-do                                               *
      *       End-if                                                  *
      *                                                               *
      *       Close the ISPF table                                    *
      *                                                               *
      *       Return to ISPF                                          *
      *                                                               *
      *                                                               *
      *   LIST-MESSAGES-ON-MAIL-Q SECTION                             *
      *   -------------------------------                             *
      *                                                               *
      *       Create a memory resident ISPF table                     *
      *       If create not successful                                *
      *          Build error message and exit                         *
      *       End-if                                                  *
      *                                                               *
      *       Initialize the variables for the get browse call        *
      *       Browse the first message on the users mail queue        *
      *       Set line number to zero                                 *
      *       Do while return code from ISPF is zero and get calls    *
      *       are successful and less than 99 messages retrieved      *
      *          Add one to line number                               *
      *          Write the message information to the table row       *
      *          Add the row to the ISPF table                        *
      *          If ISPF return code is zero                          *
      *             Browse the next message on the queue              *
      *          End-if                                               *
      *       End-do                                                  *
      *                                                               *
      *       If the ISPF return code is not zero                     *
      *          Build an error message                               *
      *          Display it using ISPF SETMSG                         *
      *       Else                                                    *
      *          If 99 messages retrieved - set message to tell user  *
      *       Else                                                    *
      *          If the reason for get failing is not no-msg-available*
      *             Build an error message                            *
      *             Display it using ISPF SETMSG                      *
      *          End-if                                               *
      *       End-if                                                  *
      *                                                               *
      *       Set maxlines to current line number                     *
      *       Put the value of maxlines in the ISPF shared pool       *
      *                                                               *
      *       Return to performing section                            *
      *                                                               *
      *                                                               *
      *   DISPLAY-CHOSEN-MESSAGE SECTION                              *
      *   ------------------------------                              *
      *                                                               *
      *       Move the user selection number to the table row number  *
      *       Get the row from the ISPF table                         *
      *       If the ISPF return code is not zero                     *
      *          Build an error message                               *
      *       Else                                                    *
      *          If the message has not already been deleted          *
      *             Initialize the variables to get the message       *
      *             Get the chosen message                            *
      *             If the call is unsuccessful                       *
      *                Build an error message                         *
      *             Else                                              *
      *                Perform SHOW-MESSAGE                           *
      *                Commit the message get                         *
      *                If commit not successful                       *
      *                   Build an error message                      *
      *                Else                                           *
      *                   Update the table row (message deleted)      *
      *                   Put the updated row in the ISPF table       *
      *                   If the ISPF put not successful              *
      *                      Build an error message                   *
      *                   End-if                                      *
      *                End-if                                         *
      *             End-if                                            *
      *          Else                                                 *
      *             Set 'message already deleted' message             *
      *          End-if                                               *
      *       End-if                                                  *
      *                                                               *
      *       Put the message in the ISPF shared pool                 *
      *                                                               *
      *       Return to performing section                            *
      *                                                               *
      *                                                               *
      *   SHOW-MESSAGE SECTION                                        *
      *   --------------------                                        *
      *                                                               *
      *       Do until ISPF return code not zero                      *
      *          Display panel CSQ4VDP3                               *
      *       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-LINE-NUMBER             PIC S9(09) 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.
      *
      *    The following copy book contains messages that will be
      *    displayed to the user
      *
       COPY CSQ4VD0.
      *
      *    ISPF definitions used in this program
      *
       COPY CSQ4VD1.
      *
       01  W01-MSGID                   PIC X(08) VALUE 'MSGID'.
       01  W01-CORRELID                PIC X(08) VALUE 'CORRELID'.
       01  W01-MSGFROM                 PIC X(08) VALUE 'MSGFROM'.
       01  W01-MSGDATE                 PIC X(08) VALUE 'MSGDATE'.
       01  W01-MSGTIME                 PIC X(08) VALUE 'MSGTIME'.
       01  W01-MAXLINES                PIC X(08) VALUE 'MAXLINES'.
       01  W01-LINENO                  PIC X(08) VALUE 'LINENO'.
       01  W01-SN                      PIC X(08) VALUE 'SN'.
       01  W01-PANEL2                  PIC X(08) VALUE 'CSQ4VDP2'.
       01  W01-PANEL3                  PIC X(08) VALUE 'CSQ4VDP3'.
      *
      *    ISPF variable definitions used in this program
      *
       COPY CSQ4VD2.
      *
       01  LINENO                      PIC 9(02) VALUE ZERO.
       01  MAXLINES                    PIC 9(04) VALUE ZERO.
       01  SN                          PIC 9(02) VALUE ZERO.
       01  QMGR                        PIC X(48) VALUE SPACES.
      *
      *    Mail manager message definition
      *
       COPY CSQ4VD4.
      *
      *    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.
      * ------------------------------------------------------------- *
           EJECT
      * ------------------------------------------------------------- *
       PROCEDURE DIVISION.
      * ------------------------------------------------------------- *
      * ------------------------------------------------------------- *
       A-MAIN SECTION.
      * ------------------------------------------------------------- *
      *                                                               *
      * This section initializes the ISPF variables, calls            *
      * LIST-MESSAGES-ON-MAIL-Q to build list of messages on a users  *
      * mail queue in an ISPF table and then displays the table.      *
      * The section then enters a loop displaying a chosen message    *
      * and redisplaying the ISPF table until the user presses PF3    *
      * or until an ISPF error occurs.                                *
      * Finally the table is closed and thus deleted.                 *
      *                                                               *
      * ------------------------------------------------------------- *
      *
      *    Define the variables to ISPF
      *    - this also copies current values into the program
      *      of those variables already known to ISPF
      *
           CALL 'ISPLINK' USING  VD1-VDEFINE   W01-CORRELID CORRELID
                                     VD1-CHAR  VD1-LENGTH24 .
           CALL 'ISPLINK' USING  VD1-VDEFINE   W01-LINENO   LINENO
                                     VD1-CHAR  VD1-LENGTH2 .
           CALL 'ISPLINK' USING  VD1-VDEFINE   W01-MAXLINES MAXLINES
                                     VD1-CHAR  VD1-LENGTH4 .
           CALL 'ISPLINK' USING  VD1-VDEFINE   W01-MSGDATE  MSGDATE
                                     VD1-CHAR  VD1-LENGTH10 .
           CALL 'ISPLINK' USING  VD1-VDEFINE   W01-MSGFROM  MSGFROM
                                     VD1-CHAR  VD1-LENGTH8  .
           CALL 'ISPLINK' USING  VD1-VDEFINE   W01-MSGID    MSGID
                                     VD1-CHAR  VD1-LENGTH24 .
           CALL 'ISPLINK' USING  VD1-VDEFINE   W01-MSGTIME  MSGTIME
                                     VD1-CHAR  VD1-LENGTH8  .
           CALL 'ISPLINK' USING  VD1-VDEFINE   VD1-QMGR     QMGR
                                     VD1-CHAR  VD1-LENGTH48.
           CALL 'ISPLINK' USING  VD1-VDEFINE   W01-SN       SN
                                     VD1-CHAR  VD1-LENGTH2 .
      *
           CALL 'ISPLINK' USING  VD1-VDEFINE
                                 VD1-DISPLAYLINES
                                 VD4-MESSAGE
                                 VD1-DISPLAYLINES-TYPE
                                 VD1-DISPLAYLINES-LENGTH
                                 VD1-LIST.
      *
           CALL 'ISPLINK' USING  VD1-VDEFINE   VD1-HCONN    HCONN
                                     VD1-CHAR  VD1-LENGTH4  VD1-COPY  .
           CALL 'ISPLINK' USING  VD1-VDEFINE   VD1-HOBJ     HOBJ
                                     VD1-CHAR  VD1-LENGTH4  VD1-COPY  .
           CALL 'ISPLINK' USING  VD1-VDEFINE   VD1-MSG      MSG
                                     VD1-CHAR  VD1-LENGTH60 VD1-COPY  .
      *
      *    Initialize variables
      *
           MOVE LENGTH OF VD4-MESSAGE TO VD4-MSG-LENGTH.
           MOVE SPACES TO MSG.
      *
      *    Get list of messages on user's mail queue
      *
           PERFORM LIST-MESSAGES-ON-MAIL-Q.
      *
      *    If this is successful -
      *    display the selection panel to allow the user to choose
      *    a message
      *
           IF ( (RETURN-CODE = ZERO)  AND
                ( (REASON = MQRC-NO-MSG-AVAILABLE) OR
                  (MAXLINES = 99)                ) ) THEN
      *
               CALL 'ISPLINK' USING VD1-TBTOP VD1-TABLE-NAME
               CALL 'ISPLINK' USING VD1-TBDISPLAY
                                    VD1-TABLE-NAME
                                    W01-PANEL2
      *
      *        Loop until the PF3 key is pressed or until an ISPF
      *        error occurs
      *
               PERFORM WITH TEST BEFORE UNTIL RETURN-CODE NOT = ZERO
      *
                   MOVE SPACES TO MSG
      *
                   PERFORM DISPLAY-CHOSEN-MESSAGE
      *
                   CALL 'ISPLINK' USING VD1-TBDISPLAY
                                        VD1-TABLE-NAME
                                        W01-PANEL2
      *
               END-PERFORM
      *
           END-IF.
      *
           CALL 'ISPLINK' USING VD1-TBCLOSE
                                VD1-TABLE-NAME.
      *
       A-MAIN-EXIT.
      *
      *    Return to ISPF
      *
           STOP RUN.
           EJECT
      *
      * ------------------------------------------------------------- *
       LIST-MESSAGES-ON-MAIL-Q SECTION.
      * ------------------------------------------------------------- *
      *                                                              *
      *  This section creates a memory resident ISPF table. The      *
      *  users mail queue is then browsed, a table row being         *
      *  completed for each message on the queue.                    *
      *                                                              *
      *  If any error (other than no-msg-available from the get call)*
      *  occurs a message is sent for display on the next ISPF panel *
      *  (using ISPF SETMSG) and control is returned to the          *
      *  performing section.                                         *
      *                                                              *
      * ------------------------------------------------------------ *
      *
      *
           CALL 'ISPLINK' USING VD1-TBCREATE
                                VD1-TABLE-NAME
                                VD1-TABLE-KEY
                                VD1-TABLE-FIELDS
                                VD1-NOWRITE
                                VD1-REPLACE.
      *
      *    Test the output of the table create
      *
           IF RETURN-CODE NOT = 0 THEN
               MOVE VD1-TBCREATE   TO VD0-MSG16-CALL
               MOVE RETURN-CODE    TO VD0-MSG16-RETURN
               MOVE VD0-MESSAGE-16 TO MSG
               CALL 'ISPLINK' USING VD1-VPUT VD1-MSG
               CALL 'ISPLINK' USING VD1-SETMSG VD1-MSGFILE-1
               GO TO LIST-MESSAGES-ON-MAIL-Q-EXIT
           END-IF.
      *
      *    Initialize the variables for the first browse call
      *
           MOVE MQGMO-BROWSE-FIRST TO MQGMO-OPTIONS.
           ADD  MQGMO-NO-WAIT      TO MQGMO-OPTIONS.
      *
           MOVE SPACES             TO VD4-MESSAGE.
           MOVE MQMI-NONE          TO MQMD-MSGID.
           MOVE MQCI-NONE          TO MQMD-CORRELID.
      *
      *    Browse the first message
      *
           CALL 'MQGET' USING HCONN
                              HOBJ
                              MQMD
                              MQGMO
                              VD4-MSG-LENGTH
                              VD4-MESSAGE
                              W00-DATA-LENGTH
                              COMPCODE
                              REASON.
      *
      *    Test the output of the call with the perform loop
      *
           MOVE ZERO TO W00-LINE-NUMBER.
      *
           MOVE ZERO TO RETURN-CODE.
      *
           MOVE MQGMO-BROWSE-NEXT TO MQGMO-OPTIONS.
      *
           PERFORM WITH TEST BEFORE UNTIL ((COMPCODE NOT = MQCC-OK) OR
                                          (RETURN-CODE NOT = 0)     OR
                                          (W00-LINE-NUMBER >= 99))
      *
               ADD 1 TO W00-LINE-NUMBER
      *
      *        Write the message information to the table row
      *
               MOVE W00-LINE-NUMBER      TO LINENO
               MOVE MQMD-MSGID           TO MSGID
               MOVE MQMD-CORRELID        TO CORRELID
               MOVE MQMD-REPLYTOQ        TO W00-RECD-MAILQ
               MOVE W00-SENT-FROM        TO 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 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 MSGTIME
      *
               CALL 'ISPLINK' USING VD1-TBADD VD1-TABLE-NAME
      *
      *        If adding this data to the table was ok browse the
      *        next message
      *
               IF RETURN-CODE = ZERO THEN
                   MOVE MQMI-NONE  TO MQMD-MSGID
                   MOVE MQCI-NONE  TO MQMD-CORRELID
      *
                   CALL 'MQGET' USING HCONN
                                      HOBJ
                                      MQMD
                                      MQGMO
                                      VD4-MSG-LENGTH
                                      VD4-MESSAGE
                                      W00-DATA-LENGTH
                                      COMPCODE
                                      REASON
      *
                   MOVE ZERO TO RETURN-CODE
               END-IF
      *
           END-PERFORM.
      *
      *    Test the output of the table add
      *
           IF RETURN-CODE NOT = 0 THEN
               MOVE VD1-TBADD      TO VD0-MSG16-CALL
               MOVE RETURN-CODE    TO VD0-MSG16-RETURN
               MOVE VD0-MESSAGE-16 TO MSG
               CALL 'ISPLINK' USING VD1-VPUT VD1-MSG
               CALL 'ISPLINK' USING VD1-SETMSG VD1-MSGFILE-1
           ELSE
      *
               IF (COMPCODE = MQCC-OK) AND
                  (W00-LINE-NUMBER = 99) THEN
                   MOVE VD0-MESSAGE-8 TO MSG
      *
               ELSE
      *
                   IF (COMPCODE NOT = MQCC-FAILED) AND
                      (REASON NOT = MQRC-NO-MSG-AVAILABLE) THEN
                       MOVE 'LIST MSGS' TO VD0-MSG1-TYPE
                       MOVE COMPCODE TO VD0-MSG1-COMPCODE
                       MOVE REASON  TO VD0-MSG1-REASON
                       MOVE VD0-MESSAGE-1 TO MSG
                       CALL 'ISPLINK' USING VD1-VPUT VD1-MSG
                       CALL 'ISPLINK' USING VD1-SETMSG VD1-MSGFILE-1
                   END-IF
               END-IF
           END-IF.
      *
           MOVE W00-LINE-NUMBER TO MAXLINES.
           CALL 'ISPLINK' USING VD1-VPUT W01-MAXLINES.
      *
       LIST-MESSAGES-ON-MAIL-Q-EXIT.
      *
      *    Return to performing section
      *
           EXIT.
           EJECT
      *
      * ------------------------------------------------------------- *
       DISPLAY-CHOSEN-MESSAGE SECTION.
      * ------------------------------------------------------------- *
      *                                                              *
      *  This section obtains details of the chosen message from the *
      *  ISPF table and, using these, gets the message and displays  *
      *  it to the user.  Once the user has finshed viewing the      *
      *  message the removal of the message from the queue is        *
      *  committed and the ISPF table is updated.                    *
      *                                                              *
      * ------------------------------------------------------------ *
      *
           MOVE SN TO LINENO.
           CALL 'ISPLINK' USING VD1-TBGET VD1-TABLE-NAME.
      *
           IF RETURN-CODE NOT = 0 THEN
               MOVE VD1-TBGET      TO VD0-MSG16-CALL
               MOVE RETURN-CODE    TO VD0-MSG16-RETURN
               MOVE VD0-MESSAGE-16 TO MSG
      *
           ELSE
               IF MSGFROM NOT = 'Deleted'
      *
      *            Get the message
      *
                   MOVE MQGMO-SYNCPOINT TO MQGMO-OPTIONS
                   ADD  MQGMO-NO-WAIT   TO MQGMO-OPTIONS
                   MOVE MSGID           TO MQMD-MSGID
                   MOVE CORRELID        TO MQMD-CORRELID
      *
                   CALL 'MQGET' USING HCONN
                                      HOBJ
                                      MQMD
                                      MQGMO
                                      VD4-MSG-LENGTH
                                      VD4-MESSAGE
                                      W00-DATA-LENGTH
                                      COMPCODE
                                      REASON
      *
                   IF COMPCODE NOT = MQCC-OK
                       MOVE 'GET MSG' TO VD0-MSG1-TYPE
                       MOVE COMPCODE  TO VD0-MSG1-COMPCODE
                       MOVE REASON TO VD0-MSG1-REASON
                       MOVE VD0-MESSAGE-1 TO MSG
                   ELSE
      *
      *                The table and message retrieval have set the
      *                variables - so display the panel
      *
                       MOVE MQMD-REPLYTOQMGR TO QMGR
      *
                       PERFORM SHOW-MESSAGE
      *
      *                Complete retrieval of the message
      *
                       CALL 'MQCMIT' USING HCONN
                                           COMPCODE
                                           REASON
      *
                       IF COMPCODE NOT = MQCC-OK
                           MOVE 'MQCMIT' TO VD0-MSG1-TYPE
                           MOVE COMPCODE TO VD0-MSG1-COMPCODE
                           MOVE REASON TO VD0-MSG1-REASON
                           MOVE VD0-MESSAGE-1 TO MSG
                       ELSE
      *
      *                    The get has been committed
      *
                           MOVE 'Deleted' TO MSGFROM
                           MOVE SPACES    TO MSGDATE
                           MOVE SPACES    TO MSGTIME
      *
                           CALL 'ISPLINK' USING VD1-TBPUT
                                                VD1-TABLE-NAME
      *
                           IF RETURN-CODE NOT = 0 THEN
                               MOVE VD1-TBPUT      TO VD0-MSG16-CALL
                               MOVE RETURN-CODE    TO VD0-MSG16-RETURN
                               MOVE VD0-MESSAGE-16 TO MSG
                           END-IF
      *
                       END-IF
                   END-IF
               ELSE
      *            Message already deleted
                   MOVE VD0-MESSAGE-5 TO MSG
               END-IF
           END-IF.
      *
           CALL 'ISPLINK' USING VD1-VPUT VD1-MSG.
      *
       DISPLAY-CHOSEN-MESSAGE-EXIT.
      *
      *    Return to performing section
      *
           EXIT.
           EJECT
      *
      * ------------------------------------------------------------- *
       SHOW-MESSAGE SECTION.
      * ------------------------------------------------------------- *
      *                                                              *
      *  This section displays the chosen message until the user     *
      *  presses PF3 or until an ISPF error occurs                   *
      *                                                              *
      * ------------------------------------------------------------ *
      *
      *
           PERFORM WITH TEST AFTER UNTIL RETURN-CODE NOT = 0
               CALL 'ISPLINK' USING VD1-DISPLAY W01-PANEL3
           END-PERFORM.
      *
       SHOW-MESSAGE-EXIT.
      *
      *    Return to performing section
      *
           EXIT.
           EJECT
      *
      * ---------------------------------------------------------------
      *                  End of program
      * ---------------------------------------------------------------