Quelle csq4cvd5.cob Sprache: Cobol

CBL XOPTS(ANSI85)
CBL NODYNAM,LIB,OBJECT,RENT,RES,APOST,NUMPROC(NOPFD)
      * ------------------------------------------------------------- *
       IDENTIFICATION DIVISION.
      * ------------------------------------------------------------- *
       PROGRAM-ID. CSQ4CVD5.
      *REMARKS
      * ************************************************************* *
      * @START_COPYRIGHT@                                             *
      *   Statement:     Licensed Materials - Property of IBM         *
      *                                                               *
      *                  5695-137                                     *
      *                  (C) Copyright IBM Corporation. 1993, 1996    *
      *                                                               *
      *   Status:        Version 1 Release 1                          *
      * @END_COPYRIGHT@                                               *
      * ************************************************************* *
      *                                                               *
      *  Product Number   : 5695-137                                  *
      *                                                               *
      *  Module Name      : CSQ4CVD5                                  *
      *                                                               *
      *  Environment      : CICS/ESA Version 3.3; COBOL II            *
      *                                                               *
      *  Function         : This program provides nickname creation   *
      *                     function for the mail manager sample.     *
      *                     See IBM MQSeries for MVS/ESA              *
      *                     Application Programming Reference,        *
      *                     for further details.                      *
      *                                                               *
      *  Description      : This program will allow the user to define*
      *                     nicknames for users of the system         *
      *                     that are commonly contacted. This program *
      *                     will put all requests on to the           *
      *                     SYSTEM.COMMAND.INPUT queue to be processed*
      *                     by the command server. All replies will   *
      *                     be returned to a temporary dynamic queue  *
      *                     based on the model queue                  *
      *                     SYSTEM.DEFAULT.MODEL.QUEUE.               *
      *                                                               *
      * ************************************************************* *
      *                                                               *
      *                      Program Logic                            *
      *                      -------------                            *
      *                                                               *
      *   Start  (A-MAIN SECTION)                                     *
      *   -----                                                       *
      *       Display the create nickname panel (MAIL-VD5)            *
      *                                                               *
      *       Do while PF3 is not pressed                             *
      *          If help key (PF1) pressed                            *
      *             Display help screen until PF12 pressed            *
      *          Else if PF4 pressed                                  *
      *             Clear the entered data from the screen            *
      *          Else if enter pressed                                *
      *             Perform VALIDATE-USER-ENTRY                       *
      *             If valid user entry                               *
      *                Perform CREATE-NICKNAME                        *
      *             End-if                                            *
      *          End-if                                               *
      *          Display the create nickname panel                    *
      *       End-do                                                  *
      *                                                               *
      *       Return to CICS                                          *
      *                                                               *
      *                                                               *
      *   VALIDATE-USER-ENTRY SECTION                                 *
      *   ---------------------------                                 *
      *       If no nickname has been entered                         *
      *          Build 'enter valid nickname' message                 *
      *       Else                                                    *
      *          Check that nickname entered starts in the first      *
      *          position of the variable and contains no spaces      *
      *          If check fails                                       *
      *             Build 'enter valid nickname' message              *
      *          Else                                                 *
      *             If no userid has been entered                     *
      *                Build 'Enter valid userid' message             *
      *             Else                                              *
      *                Check that userid entered starts in the first  *
      *                position of the variable and contains no spaces*
      *                If check fails                                 *
      *                   Build 'enter valid userid' message          *
      *                End-if                                         *
      *             End-if                                            *
      *          End-if                                               *
      *       End-if                                                  *
      *                                                               *
      *       Return to performing section                            *
      *                                                               *
      *                                                               *
      *   SET-UP-NICKNAME-FIELDS SECTION                              *
      *   ------------------------------                              *
      *       Put the information from screen map variables           *
      *       into the program variables to be used for nickname      *
      *       checking and creation                                   *
      *                                                               *
      *       Return to performing section                            *
      *                                                               *
      *                                                               *
      *   CREATE-NICKNAME SECTION                                     *
      *   -----------------------                                     *
      *       Perform SET-UP-NICKNAME-FIELDS                          *
      *       Perform CHECK-NICKNAME                                  *
      *       Evaluate                                                *
      *          When message not spaces                              *
      *             do nothing (because there is an error)            *
      *          When user has not entered a queue manager name       *
      *             Perform CREATE-ALIAS-QUEUE                        *
      *          Otherwise                                            *
      *             If queue manager name is not local queue manager  *
      *                Perform CREATE-REMOTE-QUEUE                    *
      *             Else                                              *
      *                Perform CREATE-ALIAS-QUEUE                     *
      *             End-if                                            *
      *       End-evaluate                                            *
      *                                                               *
      *       Return to performing section                            *
      *                                                               *
      *                                                               *
      *   CHECK-NICKNAME SECTION                                      *
      *   ----------------------                                      *
      *       Set the variables for the open call                     *
      *       Open the nickname queue for inquire                     *
      *       If the call is successful                               *
      *          Build 'nickname already exists' message              *
      *       Else                                                    *
      *          If reason for call failure is not unknown object name*
      *             Build error message                               *
      *          Else                                                 *
      *             Set message to spaces                             *
      *          End-if                                               *
      *       End-if                                                  *
      *                                                               *
      *       Return to performing section                            *
      *                                                               *
      *                                                               *
      *   CREATE-REMOTE-QUEUE SECTION                                 *
      *   ---------------------------                                 *
      *       Perform CREATE-TEMP-DYNAMIC-QUEUE                       *
      *       If the queue is not created successfully                *
      *          Build an error message                               *
      *          Go to CREATE-REMOTE-QUEUE-EXIT                       *
      *       End-if                                                  *
      *                                                               *
      *       Initialize the variables for the put1 call              *
      *       Put the define queue message on the system command queue*
      *       If the put1 is not successful                           *
      *          Build an error message                               *
      *       Else                                                    *
      *          Perform GET-COMMAND-SERVER-RESP                      *
      *       End-if                                                  *
      *                                                               *
      *       Perform CLOSE-TEMP-DYNAMIC-QUEUE                        *
      *                                                               *
      *   CREATE-REMOTE-QUEUE-EXIT                                    *
      *                                                               *
      *       Return to performing section                            *
      *                                                               *
      *                                                               *
      *   CREATE-ALIAS-QUEUE SECTION                                  *
      *   --------------------------                                  *
      *       Perform CREATE-TEMP-DYNAMIC-QUEUE                       *
      *       If the queue is not created successfully                *
      *          Build an error message                               *
      *          Go to CREATE-ALIAS-QUEUE-EXIT                        *
      *       End-if                                                  *
      *                                                               *
      *       Initialize the variables for the put1 call              *
      *       Put the define queue message on the system command queue*
      *       If the put1 is not successful                           *
      *          Build an error message                               *
      *       Else                                                    *
      *          Perform GET-COMMAND-SERVER-RESP                      *
      *       End-if                                                  *
      *                                                               *
      *       Perform CLOSE-TEMP-DYNAMIC-QUEUE                        *
      *                                                               *
      *   CREATE-ALIAS-QUEUE-EXIT                                     *
      *                                                               *
      *       Return to performing section                            *
      *                                                               *
      *                                                               *
      *   CREATE-TEMP-DYNAMIC-QUEUE SECTION                           *
      *   ---------------------------------                           *
      *       Initialize the variables for the open call              *
      *       Create the temporary dynamic queue by opening the model *
      *       queue                                                   *
      *                                                               *
      *       Return to performing section                            *
      *                                                               *
      *                                                               *
      *   GET-COMMAND-SERVER-RESPONSE SECTION                         *
      *   -----------------------------------                         *
      *       Initialize the variables for the get call               *
      *       Do until expected response message received or get fails*
      *          Get the message                                      *
      *          If compcode not ok                                   *
      *             If not no message available                       *
      *                Build an error message                         *
      *             End-if                                            *
      *          Else                                                 *
      *             If expected message received                      *
      *                If queue was created successfully              *
      *                   Set create-worked to Y                      *
      *                Else                                           *
      *                   Set create-worked to N                      *
      *                   Perform GET-ERROR-DETAILS                   *
      *                End-if                                         *
      *             End-if                                            *
      *          End-if                                               *
      *       End-do                                                  *
      *                                                               *
      *       If create queue worked                                  *
      *          Set 'nickname created' message                       *
      *       End-if                                                  *
      *                                                               *
      *       Return to performing section                            *
      *                                                               *
      *                                                               *
      *   CLOSE-TEMP-DYNAMIC-QUEUE SECTION                            *
      *   --------------------------------                            *
      *       Close the queue                                         *
      *                                                               *
      *       Return to performing section                            *
      *                                                               *
      *                                                               *
      *   GET-ERROR-DETAILS SECTION                                   *
      *   -------------------------                                   *
      *       Initialize the variables for the get call               *
      *       Get the next message from the temporary queue           *
      *       Move the message received to the display message 2 line *
      *                                                               *
      *       Initialize the variables for the get call               *
      *       Get the next message from the temporary queue           *
      *       Move the message received to the display message 3 line *
      *                                                               *
      *       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                            *
      *                                                               *
      *                                                               *
      *   DISPLAY-MAPVD5 SECTION                                      *
      *   ----------------------                                      *
      *       Exec CICS send create nickname screen map               *
      *       Exec CICS receive create nickname screen map            *
      *                                                               *
      *       Return to performing section                            *
      *                                                               *
      *                                                               *
      * ************************************************************* *
      * ------------------------------------------------------------- *
       ENVIRONMENT DIVISION.
      * ------------------------------------------------------------- *
       DATA DIVISION.
      * ------------------------------------------------------------- *
       WORKING-STORAGE SECTION.
      * ------------------------------------------------------------- *
      *
      *    W00 - General work fields
      *
       01  W00-NICKNAME                PIC X(08)         VALUE SPACES.
       01  W00-USERQ                   PIC X(08)         VALUE SPACES.
       01  W00-VALIDATE                PIC X(01)         VALUE SPACES.
      *
       01  W00-QNAME                   PIC X(48)         VALUE SPACES.
       01  W00-Q-PREFIX                PIC X(17)         VALUE
                                      'CSQ4SAMP.MAILMGR.'.
       01  W00-SYSTEM-REPLY-MODEL      PIC X(26)         VALUE
                                      'SYSTEM.DEFAULT.MODEL.QUEUE'.
       01  W00-SYSTEM-COMMAND-QUEUE    PIC X(20)         VALUE
                                      'SYSTEM.COMMAND.INPUT'.
       01  W00-SYSTEM-REPLY-INITIAL    PIC X(10)         VALUE
                                      'CSQ4SAMP.*'.
      *
       01  W00-GET-WAIT-30SECS         PIC S9(09) BINARY VALUE 30000.
       01  W00-GET-WAIT-2SECS          PIC S9(09) BINARY VALUE 2000.
      *
       01  W00-DEFINE-ALIAS-COMMAND.
           05                          PIC X(14)         VALUE
                                      'DEFINE QALIAS('.
           05  W00-ALIAS-QNAME         PIC X(48).
           05                          PIC X(63)         VALUE
                                      ') LIKE(CSQ4SAMP.MAILMGR.ALIAS.TEM
      -                               'PLATE) TARGQ(CSQ4SAMP.MAILMGR.'.
           05  W00-TARGQ-QNAME         PIC X(08)         VALUE SPACES.
           05                          PIC X             VALUE
                                       ')'.
       01  W00-DEFINE-REMOTE-COMMAND.
           05                          PIC X(16)         VALUE
                                      'DEFINE QREMOTE('.
           05  W00-LOCAL-QNAME         PIC X(48).
           05                          PIC X(63)         VALUE
                                      ') PUT(ENABLED) DEFPRTY(2) DEFPSIS
      -                               'T(YES) RNAME(CSQ4SAMP.MAILMGR.'.
           05  W00-REMOTE-QNAME        PIC X(08)         VALUE SPACES.
           05                          PIC X(10)         VALUE
                                      ') RQMNAME('.
           05  W00-REMOTE-QMGR         PIC X(48)         VALUE SPACES.
           05                          PIC X(08)         VALUE
                                      ') XMITQ('.
           05  W00-XMIT-QNAME          PIC X(48)         VALUE SPACES.
           05                          PIC X             VALUE
                                      ')'.
       01  W00-DEFINE-ALIAS-LENGTH     PIC S9(09) BINARY.
       01  W00-DEFINE-REMOTE-LENGTH    PIC S9(09) BINARY.
       01  W00-REPLY-LENGTH            PIC S9(09) BINARY VALUE 100.
       01  W00-COMMAND-REPLY.
           05  W00-REPLY-NUM           PIC X(08).
           05                          PIC X(26).
           05  W00-RETURN              PIC X(08).
           05                          PIC X(09).
           05  W00-REASON              PIC X(08).
           05                          PIC X(41).
       01  W00-CREATE-WORKED           PIC X.
      *
      *    W01 - API fields
      *
       01  W01-DATA-LENGTH             PIC S9(9) BINARY.
       01  W01-OPTIONS                 PIC S9(9) BINARY VALUE ZERO.
       01  W01-HOBJ                    PIC S9(9) BINARY VALUE ZERO.
       01  W01-COMPCODE                PIC S9(9) BINARY VALUE ZERO.
       01  W01-REASON                  PIC S9(9) BINARY VALUE ZERO.
      *
      *    W02 - Screen map name definitions
      *
       01  W02-MAPSET-NAME            PIC X(08)       VALUE 'CSQ4VDM'.
       01  W02-CSQ4VD5                PIC X(08)       VALUE 'CSQ4VD5'.
       01  W02-CSQ4VD6                PIC X(08)       VALUE 'CSQ4VD6'.
      *
      *    Fields used for communication between programs in mail
      *    manager sample
      *
       COPY CSQ4VD3.
      *
      *    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-PUT-MESSAGE-OPTIONS.
           COPY CMQPMOV 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 displays the create nickname panel in a loop.    *
      * Once the user has entered data a check is made to validate    *
      * that the nickname does not already exist. If it does not exist*
      * it will be created by sending a message to the system command *
      * input queue.                                                  *
      *                                                               *
      * Errors are reported to the user. The program terminates when  *
      * the user presses PF3.                                         *
      *                                                               *
      * ------------------------------------------------------------- *
      *
      *    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.
      *
           EXEC CICS IGNORE CONDITION
                     MAPFAIL
           END-EXEC.
      *
      *    Display first page of messages
      *
           MOVE LOW-VALUES TO CSQ4VD5O.
           MOVE VD3-MSG    TO VD5MSG1O.
           MOVE VD3-USERID TO VD5IDO.
           MOVE VD3-SUBSYS TO VD5QMO.
      *
           PERFORM DISPLAY-MAPVD5
      *
      *    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 VD5MSG1O
      *
               EVALUATE TRUE
                   WHEN EIBAID = DFHPF1 OR EIBAID = DFHPF13
                       PERFORM DISPLAY-HELP
      *
                   WHEN EIBAID = DFHENTER
                       PERFORM VALIDATE-USER-ENTRY
                       IF VD5MSG1O = SPACES THEN
                           PERFORM CREATE-NICKNAME
                       END-IF
      *
                   WHEN EIBAID = DFHPF3 OR EIBAID = DFHPF15
                       CONTINUE
      *
                   WHEN EIBAID = DFHPF4 OR EIBAID = DFHPF16
                       MOVE LOW-VALUES TO CSQ4VD5O
      *
               END-EVALUATE
      *
               MOVE VD3-USERID TO VD5IDO
               MOVE VD3-SUBSYS TO VD5QMO
               PERFORM DISPLAY-MAPVD5
      *
           END-PERFORM.
      *
       A-MAIN-EXIT.
      *
      *    Return to calling function
      *
           EXEC CICS RETURN
           END-EXEC.
      *
           EJECT
      *
      * ------------------------------------------------------------- *
       VALIDATE-USER-ENTRY SECTION.
      * ------------------------------------------------------------- *
      *                                                               *
      *    Validate that both alias and user mail queue names have    *
      *    been entered.                                              *
      *                                                               *
      * ------------------------------------------------------------- *
      *
           IF ((VD5ALASI = SPACES) OR (VD5ALASI = LOW-VALUES)) THEN
              MOVE VD0-MESSAGE-10 TO VD5MSG1O
           ELSE
              MOVE SPACES TO W00-NICKNAME W00-VALIDATE
              UNSTRING VD5ALASI DELIMITED BY ALL SPACE
                                INTO W00-NICKNAME W00-VALIDATE
              IF ((W00-NICKNAME = SPACES) OR
                  (W00-VALIDATE NOT = SPACE))
                  MOVE VD0-MESSAGE-10 TO VD5MSG1O
              ELSE
                  IF  ((VD5USERI = SPACES) OR
                       (VD5USERI = LOW-VALUES)) THEN
                      MOVE VD0-MESSAGE-11     TO VD5MSG1O
                  ELSE
                      MOVE SPACES TO W00-USERQ W00-VALIDATE
                      UNSTRING VD5USERI DELIMITED BY ALL SPACE
                                        INTO W00-USERQ W00-VALIDATE
                      IF ((W00-NICKNAME = SPACES) OR
                          (W00-VALIDATE NOT = SPACE))
                          MOVE VD0-MESSAGE-11 TO VD5MSG1O
                      END-IF
                  END-IF
              END-IF
           END-IF.
      *
       VALIDATE-USER-ENTRY-EXIT.
      *
      *    Return to performing section
      *
           EXIT.
           EJECT
      *
      * ------------------------------------------------------------- *
       SET-UP-NICKNAME-FIELDS SECTION.
      * ------------------------------------------------------------- *
      *                                                              *
      * This section puts the information from screen variables      *
      * into the program variables to be used for nickname           *
      * checking and creation.                                       *
      *                                                              *
      * ------------------------------------------------------------ *
      *
           MOVE VD5USERI  TO W00-TARGQ-QNAME
                             W00-REMOTE-QNAME.
           MOVE VD5QMGRI  TO W00-REMOTE-QMGR
                             W00-XMIT-QNAME.
      *
           MOVE SPACES    TO W00-QNAME.
           STRING W00-Q-PREFIX VD3-USERID '.' VD5ALASI
                        DELIMITED BY SPACES
                        INTO W00-QNAME.
      *
           MOVE W00-QNAME TO W00-ALIAS-QNAME
                             W00-LOCAL-QNAME.
      *
      *
       SET-UP-NICKNAME-FIELDS-EXIT.
      *
      *    Return to performing section
      *
           EXIT.
           EJECT
      *
      * ------------------------------------------------------------- *
       CREATE-NICKNAME SECTION.
      * ------------------------------------------------------------- *
      *                                                              *
      * This section checks whether the nickname to be created       *
      * already exists, if it does the program returns to the        *
      * calling section. Otherwise a nickname will be created.       *
      *                                                              *
      * If the target queue is on the local queue manager, an alias  *
      * queue is created by performing CREATE-ALIAS-QUEUE. If the    *
      * target queue is on another queue manager, a remote queue     *
      * is created by performing CREATE-REMOTE-QUEUE.                *
      *                                                              *
      * Error messages are set by performed sections and displayed   *
      * by the performing section.                                   *
      *                                                              *
      * ------------------------------------------------------------ *
      *
           PERFORM SET-UP-NICKNAME-FIELDS.
      *
           PERFORM CHECK-NICKNAME.
      *
      *    Test for an error in CHECK-NICKNAME
      *        If an error has occurred - return to report it
      *        If no error has occurred - create the nickname
      *
           EVALUATE TRUE
               WHEN VD5MSG1O NOT = SPACES
                   CONTINUE
      *
               WHEN VD5QMGRI = SPACES
               WHEN VD5QMGRI = LOW-VALUES
                       PERFORM CREATE-ALIAS-QUEUE
      *
               WHEN OTHER
                   IF (VD5QMGRI NOT = VD3-SUBSYS)
                       PERFORM CREATE-REMOTE-QUEUE
                   ELSE
                       PERFORM CREATE-ALIAS-QUEUE
                   END-IF
      *
           END-EVALUATE.
      *
       CREATE-NICKNAME-EXIT.
      *
           EXIT.
           EJECT
      *
      * ------------------------------------------------------------- *
       CHECK-NICKNAME SECTION.
      * ------------------------------------------------------------- *
      *                                                              *
      * This section checks whether a nickname exists by trying to   *
      * open the queue corresponding to the nickname for inquiry.    *
      *                                                              *
      * If the open fails for unknown object name the nickname does  *
      * not exist (so no error message is set). If the open succeeds *
      * or fails for any other reason an error message is set for    *
      * display to the user by the calling section.  If the          *
      * queue was opened it is closed.                               *
      *                                                              *
      * ------------------------------------------------------------ *
      *
      *    Set up the MQSeries API control blocks.
      *    Apart from the following values, all other values in the
      *    control blocks will be set to their default values
      *
           MOVE MQOT-Q          TO MQOD-OBJECTTYPE.
           MOVE W00-QNAME       TO MQOD-OBJECTNAME.
      *
      *    W01-OPTIONS is set to open the queue for INQUIRE
      *           NOTE: The open option is irrelevant to this
      *                 program. The open is only used to
      *                 validate if the nickname already
      *                 exists
      *
           MOVE MQOO-INQUIRE TO W01-OPTIONS.
      *
      *    Open the queue
      *
           CALL 'MQOPEN' USING VD3-HCONN
                               MQOD
                               W01-OPTIONS
                               W01-HOBJ
                               W01-COMPCODE
                               W01-REASON.
      *
      *    Test the output of the open call.
      *
      *    If the open succeeds, the queue already exists. Move an
      *    error message to the panel, close the queue.
      *
      *    If the open fails and the reason is not UNKNOWN-OBJECT-NAME
      *    move an error message showing the completion and reason codes
      *    to the panel.
      *
      *    If the open fails with UNKNOWN-OBJECT-NAME, set the message
      *    to blanks
      *
           IF W01-COMPCODE = MQCC-OK THEN
               MOVE VD0-MESSAGE-12 TO VD5MSG1O
               CALL 'MQCLOSE' USING VD3-HCONN
                                    W01-HOBJ
                                    MQCO-NONE
                                    W01-COMPCODE
                                    W01-REASON
           ELSE
               IF (W01-REASON NOT = MQRC-UNKNOWN-OBJECT-NAME) THEN
                   MOVE 'OPEN NICKQ'     TO VD0-MSG1-TYPE
                   MOVE W01-COMPCODE     TO VD0-MSG1-COMPCODE
                   MOVE W01-REASON       TO VD0-MSG1-REASON
                   MOVE VD0-MESSAGE-1    TO VD5MSG1O
               ELSE
                 MOVE SPACES TO VD5MSG1O
              END-IF
           END-IF.
      *
       CHECK-NICKNAME-EXIT.
      *
      *    Return to performing section
      *
           EXIT.
           EJECT
      *
      * ------------------------------------------------------------- *
       CREATE-REMOTE-QUEUE SECTION.
      * ------------------------------------------------------------- *
      *                                                              *
      * This section creates a remote queue by sending a command to  *
      * the queue manager system command input queue.  A temporary   *
      * dynamic queue is created to receive the command server       *
      * responses and these responses are checked to determine if    *
      * the queue has been successfully created.                     *
      * Status and error messages are prepared for display by the    *
      * calling section.                                             *
      *                                                              *
      * ------------------------------------------------------------ *
      *
           PERFORM CREATE-TEMP-DYNAMIC-QUEUE.
      *
      *    Test the output of the open call.  If the call failed,
      *    build an error message showing the completion code and
      *    reason, and return to the performing section to allow
      *    it to be displayed
      *
           IF (W01-COMPCODE NOT = MQCC-OK) THEN
              MOVE 'OPEN TEMPDQ-R' TO VD0-MSG1-TYPE
              MOVE W01-COMPCODE    TO VD0-MSG1-COMPCODE
              MOVE W01-REASON      TO VD0-MSG1-REASON
              MOVE VD0-MESSAGE-1   TO VD5MSG1O
              GO TO CREATE-REMOTE-QUEUE-EXIT
           END-IF.
      *
      *    Save the queue name and also place it in the REPLYTOQ field.
      *    Use the REQUEST message type to ensure that the Command
      *    Server sends back all reply messages. The define remote queue
      *    message is then written to the SYSTEM-COMMAND-INPUT queue to
      *    be processed
      *
           MOVE MQOD-OBJECTNAME          TO MQMD-REPLYTOQ.
           MOVE MQMT-REQUEST             TO MQMD-MSGTYPE.
           MOVE MQPER-NOT-PERSISTENT     TO MQMD-PERSISTENCE.
           MOVE MQOT-Q                   TO MQOD-OBJECTTYPE.
           MOVE W00-SYSTEM-COMMAND-QUEUE TO MQOD-OBJECTNAME.
           MOVE MQPMO-NO-SYNCPOINT       TO MQPMO-OPTIONS.
      *
           MOVE LENGTH OF W00-DEFINE-REMOTE-COMMAND
                                         TO W00-DEFINE-REMOTE-LENGTH.
      *
      *    Put the define remote command
      *
           CALL 'MQPUT1' USING VD3-HCONN
                               MQOD
                               MQMD
                               MQPMO
                               W00-DEFINE-REMOTE-LENGTH
                               W00-DEFINE-REMOTE-COMMAND
                               W01-COMPCODE
                               W01-REASON.
      *
      *    If the compcode is not ok after the put1 request
      *    display an error message and return
      *
           IF (W01-COMPCODE NOT = MQCC-OK) THEN
               MOVE 'MQPUT1-R '  TO VD0-MSG1-TYPE
               MOVE W01-COMPCODE  TO VD0-MSG1-COMPCODE
               MOVE W01-REASON    TO VD0-MSG1-REASON
               MOVE VD0-MESSAGE-1 TO VD5MSG1O
           ELSE
               PERFORM GET-COMMAND-SERVER-RESP
      *
      *        The response messages are set in the function, no
      *        testing is done after return
      *
           END-IF.
      *
           PERFORM CLOSE-TEMP-DYNAMIC-QUEUE.
      *
       CREATE-REMOTE-QUEUE-EXIT.
      *
      *    Return to performing section
      *
           EXIT.
           EJECT
      *
      * ------------------------------------------------------------- *
       CREATE-ALIAS-QUEUE SECTION.
      * ------------------------------------------------------------- *
      *                                                              *
      * This section creates an alias queue by sending a command to  *
      * the queue manager system command input queue.  A temporary   *
      * dynamic queue is created to receive the command server       *
      * responses and these responses are checked to determine if    *
      * the queue has been successfully created.                     *
      * Status and error messages are prepared for display by the    *
      * performing section.                                          *
      *                                                              *
      * ------------------------------------------------------------ *
      *
           PERFORM CREATE-TEMP-DYNAMIC-QUEUE.
      *
      *    Test the output of the open call.  If the call failed,
      *    build an error message showing the completion code and
      *    reason, and return to the performing section to allow
      *    it to be displayed
      *
           IF (W01-COMPCODE NOT = MQCC-OK) THEN
              MOVE 'OPEN TEMPDQ-A' TO VD0-MSG1-TYPE
              MOVE W01-COMPCODE    TO VD0-MSG1-COMPCODE
              MOVE W01-REASON      TO VD0-MSG1-REASON
              MOVE VD0-MESSAGE-1   TO VD5MSG1O
              GO TO CREATE-ALIAS-QUEUE-EXIT
           END-IF.
      *
      *    Save the queue name and also place it in the REPLYTOQ field.
      *    Use the REQUEST message type to ensure that the Command
      *    Server sends back all reply messages. The define alias queue
      *    message is then written to the SYSTEM-COMMAND-INPUT queue to
      *    be processed.
      *
           MOVE MQOD-OBJECTNAME          TO MQMD-REPLYTOQ.
           MOVE MQMT-REQUEST             TO MQMD-MSGTYPE.
           MOVE MQPER-NOT-PERSISTENT     TO MQMD-PERSISTENCE.
           MOVE MQOT-Q                   TO MQOD-OBJECTTYPE.
           MOVE W00-SYSTEM-COMMAND-QUEUE TO MQOD-OBJECTNAME.
           MOVE MQPMO-NO-SYNCPOINT       TO MQPMO-OPTIONS.
      *
           MOVE LENGTH OF W00-DEFINE-ALIAS-COMMAND
                                         TO W00-DEFINE-ALIAS-LENGTH.
      *
      *    Put the define alias command
      *
           CALL 'MQPUT1' USING VD3-HCONN
                               MQOD
                               MQMD
                               MQPMO
                               W00-DEFINE-ALIAS-LENGTH
                               W00-DEFINE-ALIAS-COMMAND
                               W01-COMPCODE
                               W01-REASON.
      *
      *    If the compcode is not ok after the put1 request
      *    display an error message and return.
      *
           IF (W01-COMPCODE NOT = MQCC-OK) THEN
               MOVE 'MQPUT1-A '  TO VD0-MSG1-TYPE
               MOVE W01-COMPCODE  TO VD0-MSG1-COMPCODE
               MOVE W01-REASON    TO VD0-MSG1-REASON
               MOVE VD0-MESSAGE-1 TO VD5MSG1O
           ELSE
               PERFORM GET-COMMAND-SERVER-RESP
      *
      *        The response messages are set in the function, no
      *        testing is done after return
      *
           END-IF.
      *
      *    Return to performing section
      *
       CREATE-ALIAS-QUEUE-EXIT.
      *
      *    Return to performing section
      *
           EXIT.
           EJECT
      *
      * ------------------------------------------------------------- *
       CREATE-TEMP-DYNAMIC-QUEUE SECTION.
      * ------------------------------------------------------------- *
      * This section creates a temporary dynamic queue using a       *
      * model queue.                                                 *
      *                                                              *
      * ------------------------------------------------------------ *
      *
      *    Initialize the Object Descriptor (MQOD) control block.
      *    (The remaining fields are already initialized)
      *
      *    OBJECTNAME   - Contains the name of the model queue that is
      *                   to be used to create the Temporary Dynamic
      *                   queue name.
      *    DYNAMICQNAME - Contains the characters that the queue name
      *                   is to begin with.
      *
           MOVE MQOT-Q                   TO MQOD-OBJECTTYPE.
           MOVE W00-SYSTEM-REPLY-MODEL   TO MQOD-OBJECTNAME.
           MOVE W00-SYSTEM-REPLY-INITIAL TO MQOD-DYNAMICQNAME.
           MOVE ZERO                     TO W01-HOBJ.
           MOVE MQOO-INPUT-AS-Q-DEF      TO W01-OPTIONS.
      *
      *    Open the queue and, therefore, create the queue
      *
           CALL 'MQOPEN' USING VD3-HCONN
                               MQOD
                               W01-OPTIONS
                               W01-HOBJ
                               W01-COMPCODE
                               W01-REASON.
      *
       CREATE-TEMP-DYNAMIC-QUEUE-EXIT.
      *
      *    Return to performing section
      *
           EXIT.
      *
      * ------------------------------------------------------------- *
       GET-COMMAND-SERVER-RESP SECTION.
      * ------------------------------------------------------------- *
      *                                                              *
      * This section gets the command server responses in a loop     *
      * until the right message (CSQN205I) arrives or an error       *
      * occurs.                                                      *
      * When the message is received it is checked to see if the     *
      * queue creation was successful - if it was an appropriate     *
      * message is prepared for display by the calling section,      *
      * otherwise GET-ERROR-DETAILS is called to get the reasons     *
      * for the error.                                               *
      * If any errors occur, appropriate messages are prepared for   *
      * display by the calling section.                              *
      *                                                              *
      * ------------------------------------------------------------ *
      *
      *    Set up the options for the get-wait call
      *
           MOVE MQGMO-ACCEPT-TRUNCATED-MSG TO MQGMO-OPTIONS.
           ADD  MQGMO-WAIT                 TO MQGMO-OPTIONS.
           ADD  MQGMO-NO-SYNCPOINT         TO MQGMO-OPTIONS.
           MOVE W00-GET-WAIT-30SECS        TO MQGMO-WAITINTERVAL.
      *
      *    Loop around until an error occurs or until the right
      *    message arrives
      *
           MOVE SPACES TO W00-CREATE-WORKED
           PERFORM WITH TEST AFTER UNTIL ((W01-COMPCODE NOT = MQCC-OK)
                                   OR (W00-CREATE-WORKED NOT = SPACES))
      *
               MOVE MQMI-NONE  TO MQMD-MSGID
               MOVE MQMI-NONE  TO MQMD-CORRELID
               MOVE SPACES     TO W00-COMMAND-REPLY
      *
               CALL 'MQGET' USING VD3-HCONN
                                  W01-HOBJ
                                  MQMD
                                  MQGMO
                                  W00-REPLY-LENGTH
                                  W00-COMMAND-REPLY
                                  W01-DATA-LENGTH
                                  W01-COMPCODE
                                  W01-REASON
      *
      *        If the compcode is not ok after the get, and the reason
      *        is not NO-MSG-AVAILABLE, build an error message.
      *        If the reason is NO-MSG-AVAILABLE exit the loop.
      *        Otherwise each message is checked to locate the command
      *        server reply (CSQN205I). When this is located the return
      *        code is checked. Depending on the return code received
      *        the create worked flag is set. If the create failed,
      *        the error details are retrieved and built for display
      *
               IF (W01-COMPCODE NOT = MQCC-OK) THEN
                   IF (W01-REASON NOT = MQRC-NO-MSG-AVAILABLE) THEN
                       MOVE 'MQGET '  TO VD0-MSG1-TYPE
                       MOVE W01-COMPCODE  TO VD0-MSG1-COMPCODE
                       MOVE W01-REASON    TO VD0-MSG1-REASON
                       MOVE VD0-MESSAGE-1 TO VD5MSG1O
                       MOVE 'N'           TO W00-CREATE-WORKED
                   END-IF
               ELSE
                   IF W00-REPLY-NUM = 'CSQN205I' THEN
      *            Validate the response from the create queue section.
      *            Move either a 'success' or 'fail' message to the
      *            panel dependant on W00-CREATE-WORKED
      *
                       IF W00-RETURN = '00000000' THEN
                           MOVE 'Y' TO W00-CREATE-WORKED
                           MOVE VD0-MESSAGE-14 TO VD5MSG1O
                       ELSE
                           MOVE 'N' TO W00-CREATE-WORKED
                           MOVE VD0-MESSAGE-13 TO VD5MSG0O
      *
      *                    The next two messages should contain
      *                    details of the failure. GET-ERROR-DETAILS
      *                    puts them in the screen message fields
      *
                           PERFORM GET-ERROR-DETAILS
      *
                       END-IF
                   END-IF
               END-IF
      *
           END-PERFORM.
      *
           IF W00-CREATE-WORKED = SPACES THEN
               MOVE VD0-MESSAGE-26 TO VD5MSG1O
           END-IF.
      *
       GET-COMMAND-SERVER-RESP-EXIT.
      *
      *    Return to performing section
      *
           EXIT.
      *
      * ------------------------------------------------------------- *
       CLOSE-TEMP-DYNAMIC-QUEUE SECTION.
      * ------------------------------------------------------------- *
      *                                                              *
      * This section closes, and thus deletes, the temporary         *
      * dynamic queue.                                               *
      *                                                              *
      * ------------------------------------------------------------ *
      *
      *
      *    Close the reply queue and purge it
      *
           CALL 'MQCLOSE' USING VD3-HCONN
                                W01-HOBJ
                                MQCO-NONE
                                W01-COMPCODE
                                W01-REASON.
      *
       CLOSE-TEMP-DYNAMIC-QUEUE-EXIT.
      *
      *
      *    Return to performing section
      *
           EXIT.
      *
      * ------------------------------------------------------------- *
       GET-ERROR-DETAILS SECTION.
      * ------------------------------------------------------------- *
      *                                                              *
      * This section get two messages from the queue and puts the    *
      * message data into message fields for display by the calling  *
      * section. If errors occur in getting these messages, no       *
      * additional data will be available to the user.  No error     *
      * checking is done on the calls.                               *
      *                                                              *
      * ------------------------------------------------------------ *
      *
      *    Get the next message on the queue which should
      *    contain a displayable message of what went wrong
      *
           MOVE W00-GET-WAIT-2SECS TO MQGMO-WAITINTERVAL.
            MOVE MQMI-NONE         TO MQMD-MSGID.
            MOVE MQMI-NONE         TO MQMD-CORRELID.
           MOVE SPACES             TO W00-COMMAND-REPLY.
      *
           CALL 'MQGET' USING VD3-HCONN
                              W01-HOBJ
                              MQMD
                              MQGMO
                              W00-REPLY-LENGTH
                              W00-COMMAND-REPLY
                              W01-DATA-LENGTH
                              W01-COMPCODE
                              W01-REASON.
      *
           MOVE W00-COMMAND-REPLY TO VD5MSG1O.
      *
      *    Get the next message on the queue which should
      *    contain another displayable message of what went wrong
      *
           MOVE MQMI-NONE  TO MQMD-MSGID.
           MOVE MQMI-NONE  TO MQMD-CORRELID.
           MOVE SPACES     TO W00-COMMAND-REPLY.
      *
           CALL 'MQGET' USING VD3-HCONN
                              W01-HOBJ
                              MQMD
                              MQGMO
                              W00-REPLY-LENGTH
                              W00-COMMAND-REPLY
                              W01-DATA-LENGTH
                              W01-COMPCODE
                              W01-REASON.
      *
           MOVE W00-COMMAND-REPLY TO VD5MSG2O.
      *
      *
       GET-ERROR-DETAILS-EXIT.
      *
      *
      *    Return to performing section
      *
           EXIT.
      *
      * ------------------------------------------------------------- *
       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(W02-CSQ4VD6)
                           MAPSET(W02-MAPSET-NAME)
                           FROM(CSQ4VD6O)
                           ERASE
                 END-EXEC
      *
                 EXEC CICS RECEIVE
                           MAP(W02-CSQ4VD6)
                           MAPSET(W02-MAPSET-NAME)
                           INTO(CSQ4VD6I)
                 END-EXEC
      *
             END-PERFORM.
      *
       DISPLAY-HELP-EXIT.
      *
      *    Return to performing section
      *
           EXIT.
           EJECT
      *
      * ------------------------------------------------------------- *
       DISPLAY-MAPVD5 SECTION.
      * ------------------------------------------------------------- *
      *                                                              *
      *  This section sends the create nickname screen (MAIL-VD5)    *
      *  to the terminal and returns once the receive is complete    *
      *                                                              *
      * ------------------------------------------------------------ *
      *
           EXEC CICS SEND
                     MAP(W02-CSQ4VD5)
                     MAPSET(W02-MAPSET-NAME)
                     FROM(CSQ4VD5O)
                     ERASE
           END-EXEC.
      *
           EXEC CICS RECEIVE
                     MAP(W02-CSQ4VD5)
                     MAPSET(W02-MAPSET-NAME)
                     INTO(CSQ4VD5O)
           END-EXEC.
      *
       DISPLAY-MAPVD5-EXIT.
      *
      *    Return to performing section
      *
           EXIT.
      *
      * ---------------------------------------------------------------
      *                  End of program
      * ---------------------------------------------------------------

quality97%

¤ Dauer der Verarbeitung: 0.26 Sekunden ¤

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.