Quelle  csq4tvd4.cob   Sprache: Cobol

CBL NODYNAM,LIB,OBJECT,RENT,RES,APOST
      * ------------------------------------------------------------- *
       IDENTIFICATION DIVISION.
      * ------------------------------------------------------------- *
       PROGRAM-ID. CSQ4TVD4.
      *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      : CSQ4TVD4                                  *
      *                                                               *
      *  Environment      : MVS TSO/ISPF                              *
      *                                                               *
      *  Function         : This program provides the send mail       *
      *                     function for the mail manager sample.     *
      *                     See IBM MQSeries for MVS/ESA              *
      *                     Application Programming Reference,        *
      *                     for further details.                      *
      *                                                               *
      *  Description      : This program displays panel CSQ4VDP4.     *
      *                     The user enters a user name, message and  *
      *                     optionally a queue manager name.          *
      *                     Once these have been entered the program  *
      *                     sends the message data to the appropriate *
      *                     queue; which can be a local, alias or     *
      *                     remote queue.                             *
      *                                                               *
      * ************************************************************* *
      *                                                               *
      *                      Program Logic                            *
      *                      -------------                            *
      *                                                               *
      *   Start  (A-MAIN SECTION)                                     *
      *   -----                                                       *
      *       Define required variables to ISPF                       *
      *                                                               *
      *       Display the send message panel (CSQ4VDP4)               *
      *                                                               *
      *       Do while return code from ISPF is zero                  *
      *          Perform SEND-MESSAGE                                 *
      *          Display the send message panel                       *
      *       End-do                                                  *
      *                                                               *
      *       Return to calling program                               *
      *                                                               *
      *                                                               *
      *   SEND-MESSAGE SECTION                                        *
      *   --------------------                                        *
      *       If user name is spaces                                  *
      *          Build 'enter user name' message                      *
      *                                                               *
      *       Else if message data is blank                           *
      *          Build 'enter message data' message                   *
      *                                                               *
      *       Else                                                    *
      *          Initialize the variable for the put1 call            *
      *          If a queue manager name has been entered             *
      *             Build the local mail queue name                   *
      *             Set the queue manager name to that entered        *
      *             Put the message on the queue                      *
      *          Else                                                 *
      *             Build the mail queue nickname name                *
      *             Set the queue manager name to spaces              *
      *             Put the message on the queue                      *
      *             If the queue name is unknown                      *
      *                Build the local mail queue name                *
      *                Put the message on the queue                   *
      *             End-if                                            *
      *          End-if                                               *
      *                                                               *
      *          Evaluate the results of the call                     *
      *             When call is completed successfully               *
      *                Build the 'successful completion' message      *
      *                (contains the user name and queue manager the  *
      *                message was sent to)                           *
      *             When the user name is unknown                     *
      *                Build the 'unknown user name' message          *
      *             When the queue manager name is unknown            *
      *                Build the 'unknown queue manager' message      *
      *             Otherwise                                         *
      *                Build a message including the compcode and     *
      *                reason                                         *
      *          End-evaluate                                         *
      *                                                               *
      *       End-if                                                  *
      *                                                               *
      *       Return to performing section                            *
      *                                                               *
      * ************************************************************* *
      * ------------------------------------------------------------- *
       ENVIRONMENT DIVISION.
      * ------------------------------------------------------------- *
      * ------------------------------------------------------------- *
       DATA DIVISION.
      * ------------------------------------------------------------- *
       WORKING-STORAGE SECTION.
      * ------------------------------------------------------------- *
      *
      *    W00 - General work fields
      *
       01  W00-SENT-TO-MAILQ.
           05                          PIC X(17)       VALUE SPACES.
           05  W00-SENT-TO             PIC X(8).
           05                          PIC X(23)       VALUE SPACES.
       01  W00-MY-MAILQ.
           05  W00-Q-PREFIX            PIC X(17)       VALUE
                                                   'CSQ4SAMP.MAILMGR.'.
           05  W00-USERID              PIC X(8).
           05                          PIC X(23)       VALUE SPACES.
       01  W00-MESSAGE-PRIORITY        PIC S9(09)      VALUE 2.
      *
      *    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-PANEL4               PIC X(08) VALUE 'CSQ4VDP4'.
      *
      *    ISPF variable definitions used in this program
      *
       COPY CSQ4VD2.
      *
       01  TOUSER                   PIC X(08) VALUE SPACES.
       01  TOQMGR                   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  W05-MQM-PUT-MESSAGE-OPTIONS.
           COPY CMQPMOV 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 and then displays *
      * the send message panel in a loop. Once the user has entered   *
      * data, this is validated and a message sent. Errors are        *
      * reported to the user. The program terminates when a non-zero  *
      * return code is returned by ISPF.                              *
      *                                                               *
      * ------------------------------------------------------------- *
      *
      *    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   VD1-TOQMGR   TOQMGR
                                     VD1-CHAR  VD1-LENGTH48  .
           CALL 'ISPLINK' USING  VD1-VDEFINE   VD1-TOUSER   TOUSER
                                     VD1-CHAR  VD1-LENGTH8  .
      *
           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  .
           CALL 'ISPLINK' USING  VD1-VDEFINE   VD1-SUBSYS   SUBSYS
                                     VD1-CHAR  VD1-LENGTH48 VD1-COPY  .
           CALL 'ISPLINK' USING  VD1-VDEFINE   VD1-USERID   USERID
                                     VD1-CHAR  VD1-LENGTH8  VD1-COPY  .
      *
      *    Initialize variables
      *
           MOVE W00-MESSAGE-PRIORITY  TO MQMD-PRIORITY.
           MOVE LENGTH OF VD4-MESSAGE TO VD4-MSG-LENGTH.
           MOVE USERID TO W00-USERID.
      *
      *    Update the relevant screen fields and display the
      *    send message panel
      *
           MOVE SPACES TO VD4-MESSAGE.
           MOVE SPACES TO MSG.
      *
           CALL 'ISPLINK' USING VD1-DISPLAY W01-PANEL4.
      *
      *    Loop from here to END-PERFORM 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 SEND-MESSAGE
      *
      *        Update the message to display
      *
               CALL 'ISPLINK' USING VD1-VPUT VD1-MSG
      *
               CALL 'ISPLINK' USING VD1-DISPLAY W01-PANEL4
      *
           END-PERFORM.
      *
       A-MAIN-EXIT.
      *
      *    Return to ISPF
      *
           STOP RUN.
           EJECT
      *
      * ------------------------------------------------------------- *
       SEND-MESSAGE SECTION.
      * ------------------------------------------------------------- *
      *                                                              *
      *  This section first ensures that the user has entered message*
      *  data and the user name of a recipient.                      *
      *  The message entered by the user is sent to the mail         *
      *  queue identified by the user-entered recipient details      *
      *                                                              *
      *  If the user has entered a name in TOQMGR the section        *
      *  sends the message to TOUSER at TOQMGR.                      *
      *  If no name has been entered in TOQMGR, the message is sent  *
      *  assuming the entry in TOUSER is a nickname. If the nickname *
      *  is unknown, the message is sent to the local mail queue     *
      *  identified in TOUSER.                                       *
      *                                                              *
      *  The result of the send is checked and a status or error     *
      *  message prepared for display by the calling section.        *
      *                                                              *
      * ------------------------------------------------------------ *
      *
      *    If no user name has been entered move an error message to
      *    the output message field
      *
           IF TOUSER = SPACES THEN
               MOVE VD0-MESSAGE-21 TO MSG
      *
      *    If no message text has been entered move an error message
      *    to the output message field, otherwise send the message
      *
           ELSE IF MSGL1 = SPACES THEN
               MOVE VD0-MESSAGE-20 TO MSG
           ELSE
      *
      *        Initialize the variables for the MQPUT1 call
      *
               MOVE LOW-VALUES   TO MQMD-MSGID
               MOVE LOW-VALUES   TO MQMD-CORRELID
               MOVE W00-MY-MAILQ TO MQMD-REPLYTOQ
               MOVE SUBSYS       TO MQMD-REPLYTOQMGR
      *
               COMPUTE MQPMO-OPTIONS = MQPMO-NO-SYNCPOINT
      *
      *        If a queue manager name has been entered, send the
      *        message to that queue manager; otherwise
      *        send the message to the local queue manager
      *
               IF TOQMGR NOT = SPACES THEN
      *
      *            Set the queue name and the queue manager name
      *            the message is to be sent to
      *
                   MOVE SPACES TO MQOD-OBJECTNAME
                   STRING W00-Q-PREFIX TOUSER
                          DELIMITED BY SPACES
                          INTO MQOD-OBJECTNAME
                   MOVE TOQMGR TO MQOD-OBJECTQMGRNAME
      *
                   CALL 'MQPUT1' USING HCONN
                                       MQOD
                                       MQMD
                                       MQPMO
                                       VD4-MSG-LENGTH
                                       VD4-MESSAGE
                                       COMPCODE
                                       REASON
      *
               ELSE
      *
      *            Set the queue name and the queue manager name
      *            the message is to be sent to.
      *            - assuming the name in TOUSER is a nickname
      *
                   MOVE SPACES   TO MQOD-OBJECTNAME
                   STRING W00-Q-PREFIX USERID '.' TOUSER
                          DELIMITED BY SPACES
                               INTO MQOD-OBJECTNAME
                   MOVE SPACES TO   MQOD-OBJECTQMGRNAME
      *
                   CALL 'MQPUT1' USING HCONN
                                       MQOD
                                       MQMD
                                       MQPMO
                                       VD4-MSG-LENGTH
                                       VD4-MESSAGE
                                       COMPCODE
                                       REASON
      *
      *            Test to see if the nickname queue name is unknown
      *
                   IF (REASON = MQRC-UNKNOWN-OBJECT-NAME) THEN
      *
      *                Set the local queue name the message
      *                is to be sent to.
      *
                       MOVE SPACES TO MQOD-OBJECTNAME
                       STRING W00-Q-PREFIX TOUSER
                              DELIMITED BY SPACES
                              INTO MQOD-OBJECTNAME
      *
                       CALL 'MQPUT1' USING HCONN
                                           MQOD
                                           MQMD
                                           MQPMO
                                           VD4-MSG-LENGTH
                                           VD4-MESSAGE
                                           COMPCODE
                                           REASON
      *
                   END-IF
      *
               END-IF
      *
      *        Test the output from the call
      *          If the message was sent successfully:
      *            Identify the queue and queue manager which received
      *            the message
      *          Otherwise:
      *            Set an appropriate error message
      *
               EVALUATE TRUE
                 WHEN COMPCODE = MQCC-OK
                   MOVE MQPMO-RESOLVEDQNAME    TO W00-SENT-TO-MAILQ
                   MOVE W00-SENT-TO            TO VD0-MSG9-TO-USER
                   MOVE MQPMO-RESOLVEDQMGRNAME TO VD0-MSG9-TO-QMGR
                   MOVE VD0-MESSAGE-9          TO MSG
                 WHEN REASON = MQRC-UNKNOWN-OBJECT-NAME
                   MOVE VD0-MESSAGE-22         TO MSG
                 WHEN REASON = MQRC-UNKNOWN-REMOTE-Q-MGR
                   MOVE VD0-MESSAGE-23         TO MSG
                 WHEN OTHER
                   MOVE 'SEND MSG' TO VD0-MSG1-TYPE
                   MOVE COMPCODE   TO VD0-MSG1-COMPCODE
                   MOVE REASON     TO VD0-MSG1-REASON
                   MOVE VD0-MESSAGE-1 TO MSG
               END-EVALUATE
      *
           END-IF.
      *
       SEND-MESSAGE-EXIT.
      *
      *    Return to performing section
      *
           EXIT.
      *
      * ---------------------------------------------------------------
      *                  End of program
      * ---------------------------------------------------------------