Ziele Untersuchung
mit Columbo Integrität von
Datenbanken Interaktion und
Portierbarkeit Ergonomie der
Schnittstellen

Angebot Produkte Projekt Beratung

Mittel Analytik Modellierung Sprachen Algebra Logik Hardware Denken Kreativität

Zusammenhänge Gesellschaft Wirtschaft Branche Firma


products/sources/formale Sprachen/Cobol/verschiedene-Autoren/MQ-Series/ (Columbo Version 0.7^©) Datei vom 4.1.2008 mit Größe 39 kB

Quelle csq4tvh1.cob Sprache: Cobol

CBL NODYNAM,LIB,OBJECT,RENT,RES,APOST
      * ------------------------------------------------------------- *
       IDENTIFICATION DIVISION.
      * ------------------------------------------------------------- *
       PROGRAM-ID. CSQ4TVH1.
      *REMARKS
      *****************************************************************
      * @START_COPYRIGHT@                                             *
      *   Statement:     Licensed Materials - Property of IBM         *
      *                                                               *
      *                  5695-137                                     *
      *                  (C) Copyright IBM Corporation. 1993, 1997    *
      *                                                               *
      *   Status:        Version 1 Release 2                          *
      * @END_COPYRIGHT@                                               *
      * ************************************************************* *
      *                                                               *
      *  Module Name           : CSQ4TVH1                             *
      *                                                               *
      *  Environment           : MVS TSO/ISPF; COBOL II               *
      *                                                               *
      *  Function    : This program validates the queue and queue     *
      *                manager names required for the Message         *
      *                Handler sample program.                        *
      *                See IBM message Queue Manager MVS/ESA          *
      *                Application Programming Reference, document    *
      *                number SC33-1212, for further details.         *
      *                                                               *
      *  Description : This program displays panel CSQ4CHP1 and       *
      *                validates the queue and queue manager names    *
      *                entered. When both are valid, program          *
      *                CSQ4TVH2 is initiated.                         *
      *                                                               *
      *                                                               *
      *****************************************************************
      *                                                               *
      *                      Program Logic                            *
      *                                                               *
      *---------------------------------------------------------------*
      *                                                               *
      * A-MAIN SECTION                                                *
      * --------------                                                *
      *                                                               *
      *    initialize variables used by ISPF                          *
      *    blank panel message line                                   *
      *    loop displaying panel until END command                    *
      *        connect to queue manager                               *
      *        if connect was successful                              *
      *            open the queue                                     *
      *            if open was successful                             *
      *                call CSQ4TVH2 passing MQ handles via ISPF      *
      *                get the panel message line from ISPF           *
      *                close the queue                                *
      *            endif                                              *
      *            disconnect from queue manager                      *
      *        endif                                                  *
      *    endloop                                                    *
      *    exit program                                               *
      *                                                               *
      *---------------------------------------------------------------*
      *                                                               *
      * CONNECT-TO-QMGR SECTION                                       *
      * -----------------------                                       *
      *                                                               *
      *    if queue manager name is undefined                         *
      *        blank the queue manager name                           *
      *    endif                                                      *
      *    call MQCONN with queue manager name                        *
      *    if connection unsuccessful                                 *
      *        display an appropriate error message for failure       *
      *    else                                                       *
      *        put the new connection handle to ISPF                  *
      *        if queue manager name blank                            *
      *            get the default queue manager name                 *
      *        endif                                                  *
      *        if a queue manager name is available                   *
      *            put the queue manager name to ISPF                 *
      *        else                                                   *
      *            display error message                              *
      *        endif                                                  *
      *    endif                                                      *
      *    exit from section                                          *
      *                                                               *
      *---------------------------------------------------------------*
      *                                                               *
      * DISCONNECT-QMGR SECTION                                       *
      * -----------------------                                       *
      *                                                               *
      *    call MQDISC                                                *
      *    if call successful                                         *
      *        put new connection handle to ISPF                      *
      *    else                                                       *
      *        display error message                                  *
      *    endif                                                      *
      *    exit from section                                          *
      *                                                               *
      *---------------------------------------------------------------*
      *                                                               *
      * GET-DEFAULT-QMGRNAME SECTION                                  *
      * ----------------------------                                  *
      *                                                               *
      *    set open options for queue manager                         *
      *    open queue manager (MQOPEN) for inquire                    *
      *    if open failed                                             *
      *        display error message                                  *
      *        exit from section                                      *
      *    endif                                                      *
      *    call MQINQ for queue manager name                          *
      *    if call successful                                         *
      *        copy the queue manager name from MQINQ variable        *
      *    endif                                                      *
      *    close the queue manager (MQCLOSE)                          *
      *    exit from section                                          *
      *                                                               *
      *---------------------------------------------------------------*
      * INQUIRE-Q SECITON                                             *
      * -----------------                                             *
      *                                                               *
      *    set open options for queue                                 *
      *    open queue manager (MQOPEN) for inquire                    *
      *    if open failed                                             *
      *        display error message                                  *
      *        exit from section                                      *
      *    endif                                                      *
      *    call MQINQ for queue type and queue definition type        *
      *    if call successful                                         *
      *        if queue is not local                                  *
      *           display error message                               *
      *           exit from section                                   *
      *        endif                                                  *
      *    else if reason code indicates queue is not local           *
      *        display error message                                  *
      *        exit from section                                      *
      *    else                                                       *
      *        display error message                                  *
      *        exit from section                                      *
      *    endif                                                      *
      *    close the queue manager (MQCLOSE)                          *
      *    exit from section                                          *
      *                                                               *
      *---------------------------------------------------------------*
      *                                                               *
      * CLOSE-Q SECTION                                               *
      * ---------------                                               *
      *                                                               *
      *    call MQCLOSE                                               *
      *    if call successful                                         *
      *        put new object handle to ISPF                          *
      *    else                                                       *
      *        display error message                                  *
      *    endif                                                      *
      *    exit from section                                          *
      *                                                               *
      *---------------------------------------------------------------*
      *                                                               *
      * OPEN-Q SECTION                                                *
      * --------------                                                *
      *                                                               *
      *    inquire on queue name                                      *
      *    if queue is local                                          *
      *       set open options for queue                              *
      *       open queue (MQOPEN) for inquire, browse, exclusive      *
      *                   input and to save all context information   *
      *       if open successful                                      *
      *           put the queue name to ISPF                          *
      *           put the new object handle to ISPF                   *
      *       else                                                    *
      *           display an error message                            *
      *       endif                                                   *
      *       exit from section                                       *
      *    else                                                       *
      *       exit from section                                       *
      *    endif                                                      *
      *    exit from section                                          *
      *                                                               *
      *---------------------------------------------------------------*
      *                                                               *
      * ERROR-MESSAGE SECTION                                         *
      * ---------------------                                         *
      *                                                               *
      *    copy error message into panel message line variable        *
      *    exit from section                                          *
      *                                                               *
      *---------------------------------------------------------------*
      *                                                               *
      * PRINT-MESSAGE SECTION                                         *
      * ---------------------                                         *
      *                                                               *
      *    copy message into panel message line variable              *
      *    exit from section                                          *
      *                                                               *
      *---------------------------------------------------------------*
      *                                                               *
      * ISPF-INIT SECTION                                             *
      * -----------------                                             *
      *                                                               *
      *    call VDEFINE for all variables to go into ISPF             *
      *                                     shared variable pool      *
      *    exit from section                                          *
      *                                                               *
      * ************************************************************* *
      * ------------------------------------------------------------- *
       ENVIRONMENT DIVISION.
      * ------------------------------------------------------------- *
      * ------------------------------------------------------------- *
       DATA DIVISION.
      * ------------------------------------------------------------- *
      * ------------------------------------------------------------- *
       WORKING-STORAGE SECTION.
      * ------------------------------------------------------------- *
      *
      *    W00 - General work fields
      *
       01  W00-ERRORMSG                PIC X(40)  VALUE SPACES.
       01  W00-RETCODE                 PIC S9(9) BINARY.
      *
      *    W01 - ISPF Variables
      *
       01  W01-QMGRNAME                PIC X(48)  VALUE SPACES.
       01  W01-QNAME                   PIC X(48)  VALUE SPACES.
       01  W01-HCONN                   PIC S9(09) BINARY.
       01  W01-HOBJ                    PIC S9(09) BINARY.
       01  W01-MESSAGE                 PIC X(79)  VALUE SPACES.
      *
      *    W02 - MQAPI Variables
      *
       01  W02-COMPCODE                PIC S9(9) BINARY.
       01  W02-COMPCODE-CHAR           PIC Z(1)9  VALUE SPACES.
       01  W02-REASON                  PIC S9(9) BINARY.
       01  W02-REASON-CHAR             PIC Z(4)9  VALUE SPACES.
       01  W02-QMGRHOBJ                PIC S9(09) BINARY.
       01  W02-SELECTORS-TABLE.
           05  W02-SELECTORS           PIC S9(09) BINARY OCCURS 2 TIMES.
       01  W02-SELECTORCOUNT           PIC S9(09) BINARY.
       01  W02-INTATTRS-TABLE.
           05  W02-INTATTRS            PIC S9(09) BINARY OCCURS 2 TIMES.
       01  W02-INTATTRCOUNT            PIC S9(09) BINARY.
       01  W02-CHARATTRS               PIC X(48)  VALUE SPACES.
       01  W02-CHARATTRLENGTH          PIC S9(09) BINARY.
       01  W02-OPENOPTIONS             PIC S9(09) BINARY.
      *
      *    API control blocks
      *
       01  MQM-OBJECT-DESCRIPTOR.
           COPY CMQODV.
       01  MQM-MESSAGE-DESCRIPTOR.
           COPY CMQMDV.
      *
      *    MQV contains constants (for filling in the control blocks)
      *    and return codes (for testing the result of a call)
      *
       01  MQM-CONSTANTS.
           COPY CMQV SUPPRESS.
      *
      *    ISPFLINK Strings
      *
       01  IDISPLAY                    PIC X(8)  VALUE 'DISPLAY '.
       01  ISELECT                     PIC X(8)  VALUE 'SELECT '.
       01  ISHARED                     PIC X(8)  VALUE 'SHARED '.
       01  IVDEFINE                    PIC X(8)  VALUE 'VDEFINE '.
       01  IVPUT                       PIC X(8)  VALUE 'VPUT '.
       01  IVGET                       PIC X(8)  VALUE 'VGET '.
       01  ICHAR                       PIC X(8)  VALUE 'CHAR '.
       01  IFIXED                      PIC X(8)  VALUE 'FIXED '.
       01  IPANEL1                     PIC X(8)  VALUE 'CSQ4CHP1'.
       01  I4                          PIC 9(6)  VALUE 4  COMP.
       01  I13                         PIC 9(6)  VALUE 13 COMP.
       01  I48                         PIC 9(6)  VALUE 48 COMP.
       01  I79                         PIC 9(6)  VALUE 79 COMP.
       01  IPROG2                      PIC X(13) VALUE 'PGM(CSQ4TVH2)'.
       01  IMESSAGE                    PIC X(8)  VALUE 'MSG '.
       01  IHOBJ                       PIC X(8)  VALUE 'HOBJ '.
       01  IHCONN                      PIC X(8)  VALUE 'HCONN '.
       01  IQNAME                      PIC X(8)  VALUE 'QNAME '.
       01  IQMGRNAME                   PIC X(8)  VALUE 'QMGRNAME'.
      *
      * ------------------------------------------------------------- *
       LINKAGE SECTION.
      * ------------------------------------------------------------- *
           EJECT
      * ------------------------------------------------------------- *
       PROCEDURE DIVISION.
      * ------------------------------------------------------------- *
      * ------------------------------------------------------------- *
       A-MAIN SECTION.
      * ------------------------------------------------------------- *
      *                                                               *
      *                Set up variables used with ISPF                *
      *                                                               *
           PERFORM ISPF-INIT.
      *                                                               *
      *                  Blank ISPF panel message                     *
      *                                                               *
           MOVE SPACES TO W01-MESSAGE.
           PERFORM PRINT-MESSAGE.
      *                                                               *
      *            Loop until ready to quit the program               *
      *                                                               *
           CALL 'ISPLINK' USING IDISPLAY IPANEL1.
           PERFORM WITH TEST BEFORE UNTIL (RETURN-CODE = 8)
      *                                                               *
      *       If connecting to the queue manager is successful        *
      *       then try opening the queue. If the open is also         *
      *       successful then call CSQ4TCH2 to display                *
      *       all the messages on specified queue.                    *
      *       Close the queue and disconnect on finishing.            *
      *                                                               *
              PERFORM CONNECT-TO-QMGR
              IF (MQRC-NONE = W02-REASON) THEN
                 PERFORM OPEN-Q
                 IF (MQRC-NONE = W02-REASON) THEN
                    CALL 'ISPLINK' USING IVPUT   IQMGRNAME ISHARED
                    CALL 'ISPLINK' USING IVPUT   IQNAME    ISHARED
                    CALL 'ISPLINK' USING ISELECT I13       IPROG2
                    CALL 'ISPLINK' USING IVGET   IMESSAGE  ISHARED
                    PERFORM CLOSE-Q
                 END-IF
                 PERFORM DISCONNECT-QMGR
              END-IF
      *
              CALL 'ISPLINK' USING IDISPLAY IPANEL1
      *
           END-PERFORM.
      *
       A-MAIN-EXIT.
      *
           GOBACK.
           EJECT
      *
      *---------------------------------------------------------------*
       CONNECT-TO-QMGR SECTION.
      *---------------------------------------------------------------*
      * This section tries to connect to the specified queue manager. *
      * If the connection is successful then the connection handle is *
      * returned.                                                     *
      * Upon failure an error message is displayed.                   *
      *---------------------------------------------------------------*
      *
      *                                                               *
      *          Connect to the specified queue manager               *
      *                                                               *
           CALL 'MQCONN' USING W01-QMGRNAME
                               W01-HCONN
                               W02-COMPCODE
                               W02-REASON.
      *
      *                                                               *
      *   If the connection was successful then add the connection    *
      *   handle details to the ISPF shared variable pool.            *
      *   If W01-QMGRNAME is blank then the GET-DEFAULT-QMGRNAME      *
      *   section is called.                                          *
      *   The queue manager name is then put into the ISPF shared     *
      *   variable pool.                                              *
      *                                                               *
      *   If the connection failed then an appropriate error          *
      *   is displayed. MQCC_WARNINGs can be ignored.                 *
      *                                                               *
           IF (MQCC-FAILED = W02-COMPCODE) THEN
      *
              EVALUATE TRUE
                 WHEN (MQRC-Q-MGR-NAME-ERROR = W02-REASON)
                    MOVE 'Queue manager name error.'  TO W00-ERRORMSG
                 WHEN (MQRC-Q-MGR-NOT-AVAILABLE = W02-REASON)
                    MOVE 'Queue manager not available.'
                                                      TO W00-ERRORMSG
                 WHEN OTHER
                    MOVE 'Unable to connect to queue manager.'
                                                      TO W00-ERRORMSG
              END-EVALUATE
              PERFORM ERROR-MESSAGE
      *
           ELSE
      *
              MOVE MQRC-NONE TO W02-REASON
              MOVE MQCC-OK   TO W02-COMPCODE
              CALL 'ISPLINK' USING IVPUT IHCONN ISHARED
      *
              IF (SPACES = W01-QMGRNAME) THEN
      *
                 PERFORM GET-DEFAULT-QMGRNAME
                 IF (MQRC-NONE NOT = W02-REASON)
      *
                    MOVE 'No queue manager name available.'
                                                      TO W00-ERRORMSG
                    PERFORM ERROR-MESSAGE
      *
                 END-IF
                 CALL 'ISPLINK' USING IVPUT IQMGRNAME ISHARED
      *
              END-IF.
      *
       CONNECT-TO-QMGR-EXIT.
      *
           EXIT.
           EJECT
      *
      *---------------------------------------------------------------*
       DISCONNECT-QMGR SECTION.
      *---------------------------------------------------------------*
      * This section attempts to disconnect from the queue manager.   *
      * The connection handle is set by the MQDISC call and upon      *
      * failure an error message is displayed.                        *
      *---------------------------------------------------------------*
      *
           CALL 'MQDISC' USING W01-HCONN
                               W02-COMPCODE
                               W02-REASON.
      *
      *                                                               *
      *   If the disconnect was successful then put the connection    *
      *   handle into the ISPF shared variable pool                   *
      *                                                               *
           IF (MQCC-OK = W02-COMPCODE) THEN
              CALL 'ISPLINK' USING IVPUT IHCONN ISHARED
           ELSE
              MOVE 'Disconnect from queue manager failed.'
                                                      TO W00-ERRORMSG
              PERFORM ERROR-MESSAGE
           END-IF.
      *
       DISCONNECT-TO-QMGR-EXIT.
      *
           EXIT.
           EJECT
      *
      *---------------------------------------------------------------*
       GET-DEFAULT-QMGRNAME SECTION.
      *---------------------------------------------------------------*
      *  This section opens the queue manager and inquires on the     *
      *  default queue manager name.                                  *
      *---------------------------------------------------------------*
      *
           MOVE 1                    TO W02-SELECTORCOUNT.
           MOVE 0                    TO W02-INTATTRCOUNT.
           MOVE MQ-Q-MGR-NAME-LENGTH TO W02-CHARATTRLENGTH.
      *                                                               *
      *     Set the open options to inquire on a queue manager        *
      *                                                               *
           MOVE MQOT-Q-MGR           TO MQOD-OBJECTTYPE.
           MOVE SPACES               TO MQOD-OBJECTNAME.
           MOVE MQOO-INQUIRE         TO W02-OPENOPTIONS.
      *
           CALL 'MQOPEN' USING W01-HCONN
                               MQOD
                               W02-OPENOPTIONS
                               W02-QMGRHOBJ
                               W02-COMPCODE
                               W02-REASON.
      *                                                               *
      *   If the open was unsuccessful then return the reason code    *
      *                                                               *
           IF (MQCC-OK NOT = W02-COMPCODE) THEN
              GO TO GET-DEFAULT-QMGRNAME-EXIT.
      *                                                               *
      *      Set the inquire options to inquire on the queue          *
      *      manager name and call MQINQ                              *
      *                                                               *
           MOVE MQCA-Q-MGR-NAME      TO W02-SELECTORS(1).
      *
           CALL 'MQINQ' USING W01-HCONN
                              W02-QMGRHOBJ
                              W02-SELECTORCOUNT
                              W02-SELECTORS-TABLE
                              W02-INTATTRCOUNT
                              W02-INTATTRS-TABLE
                              W02-CHARATTRLENGTH
                              W02-CHARATTRS
                              W02-COMPCODE
                              W02-REASON.
      *                                                               *
      *     If the inquire was successful then copy the default       *
      *     queue manager name to variable passed to function.        *
      *                                                               *
           IF (MQCC-OK = W02-COMPCODE) THEN
              MOVE W02-CHARATTRS        TO W01-QMGRNAME.
      *                                                               *
      *              Close the queue manager                          *
      *                                                               *
           CALL 'MQCLOSE' USING W01-HCONN
                                W02-QMGRHOBJ
                                MQCO-NONE
                                W02-COMPCODE
                                W00-RETCODE.
      *
       GET-DEFAULT-QMGRNAME-EXIT.
      *
           EXIT.
           EJECT
      *
      *---------------------------------------------------------------*
       INQUIRE-Q SECTION.
      *---------------------------------------------------------------*
      *  This section opens the specified queue to inquire on the     *
      *  queue and definition type. The definition type is required   *
      *  to distinguish local queues from dynamic queues created when *
      *  a model queue is opened for inquiry. If the queue is unable  *
      *  to be opened or the inquiry shows the queue is not a local   *
      *  queue, an appropriate error message is issued.               *
      *---------------------------------------------------------------*
      *
           MOVE 2                    TO W02-SELECTORCOUNT.
           MOVE 2                    TO W02-INTATTRCOUNT.
           MOVE ZEROES               TO W02-CHARATTRLENGTH.
      *                                                               *
      *     Set the open options to inquire on the queue.             *
      *                                                               *
           MOVE MQOT-Q               TO MQOD-OBJECTTYPE.
           MOVE W01-QNAME            TO MQOD-OBJECTNAME.
           MOVE MQOO-INQUIRE         TO W02-OPENOPTIONS.
      *
           CALL 'MQOPEN' USING W01-HCONN
                               MQOD
                               W02-OPENOPTIONS
                               W02-QMGRHOBJ
                               W02-COMPCODE
                               W02-REASON.
      *                                                               *
      *   If the open was unsuccessful, then issue an appropriate     *
      *   error message and return the reason code.                   *
      *                                                               *
           IF (MQCC-OK NOT = W02-COMPCODE) THEN
              MOVE 'Unable to open queue.'
                                                      TO W00-ERRORMSG
              PERFORM ERROR-MESSAGE
              GO TO INQUIRE-Q-EXIT.
      *                                                               *
      *      Set the inquire selectors for queue type and queue       *
      *      definition type.                                         *
      *                                                               *
           MOVE MQIA-Q-TYPE           TO W02-SELECTORS(1).
           MOVE MQIA-DEFINITION-TYPE  TO W02-SELECTORS(2).
      *
           CALL 'MQINQ' USING W01-HCONN
                              W02-QMGRHOBJ
                              W02-SELECTORCOUNT
                              W02-SELECTORS-TABLE
                              W02-INTATTRCOUNT
                              W02-INTATTRS-TABLE
                              W02-CHARATTRLENGTH
                              W02-CHARATTRS
                              W02-COMPCODE
                              W02-REASON.
      *                                                               *
      *     If the inquire was successful then check whether the      *
      *     queue is local. If not, issue an error message and set    *
      *     W02-REASON to a negative value for return to caller.      *
      *     If the inquire is unsucessful, then determine whether     *
      *     the reason for failure was because we inquired on an      *
      *     attribute not applicable to local queues or some other    *
      *     reason, and issue an appropriate error message.           *

           IF (MQRC-NONE = W02-REASON) THEN
              IF ( (W02-INTATTRS(1) NOT = MQQT-LOCAL) OR
                   (W02-INTATTRS(2) NOT = MQQDT-PREDEFINED) ) THEN
                 MOVE 'Queue Name is not a local queue.'
                                                      TO W01-MESSAGE
                 PERFORM PRINT-MESSAGE
                 MOVE -1 TO W02-REASON
                 GO TO INQUIRE-Q-CLOSE
              ELSE
                 GO TO INQUIRE-Q-CLOSE
              END-IF
           END-IF
           IF (MQRC-SELECTOR-NOT-FOR-TYPE = W02-REASON) THEN
              MOVE 'Queue Name is not a local queue.'
                                                      TO W01-MESSAGE
              PERFORM PRINT-MESSAGE
              MOVE -1 TO W02-REASON
              GO TO INQUIRE-Q-CLOSE
           ELSE
              MOVE 'Unable to inquire whether queue is local.'
                                                      TO W00-ERRORMSG
              PERFORM ERROR-MESSAGE
              MOVE -1 TO W02-REASON
              GO TO INQUIRE-Q-CLOSE
           END-IF.
      *                                                               *
      *              Close the queue.                                 *
      *                                                               *
      *
       INQUIRE-Q-CLOSE.
      *
           CALL 'MQCLOSE' USING W01-HCONN
                                W02-QMGRHOBJ
                                MQCO-NONE
                                W02-COMPCODE
                                W00-RETCODE.
      *
       INQUIRE-Q-EXIT.
      *
           EXIT.
           EJECT
      *
      *---------------------------------------------------------------*
       CLOSE-Q SECTION.
      *---------------------------------------------------------------*
      * This section closes the specified queue.                      *
      * If the close is successful then the updated object handle is  *
      * replaced in the ISPF shared variable pool.                    *
      * A failure will cause an error message to be displayed.        *
      *---------------------------------------------------------------*
      *
           CALL 'MQCLOSE' USING W01-HCONN
                                W01-HOBJ
                                MQCO-NONE
                                W02-COMPCODE
                                W02-REASON.
      *
           IF (MQCC-OK = W02-COMPCODE) THEN
              CALL 'ISPLINK' USING IVPUT IHOBJ ISHARED
           ELSE
              MOVE 'Failed when closing queue.' TO W00-ERRORMSG
              PERFORM ERROR-MESSAGE
           END-IF.
      *
       CLOSE-Q-EXIT.
      *
           EXIT.
           EJECT
      *
      *---------------------------------------------------------------*
       OPEN-Q SECTION.
      *---------------------------------------------------------------*
      * This section inquires on the specified queue to verify that   *
      * it is a local queue. If so, the section tries to open the     *
      * queue and return the object handle created.                   *
      * If successful then the queue name and new object handle will  *
      * be put into the ISPF shared variable pool.                    *
      * An error will cause an appropriate message to be displayed.   *
      *---------------------------------------------------------------*
      *
      *                                                               *
      *
           PERFORM INQUIRE-Q.
           IF (MQRC-NONE NOT = W02-REASON) THEN
              GO TO OPEN-Q-EXIT.
      *                                                               *
      *    Set MQOPEN options for a queue and set the queue name      *
      *                                                               *
           MOVE MQOT-Q       TO MQOD-OBJECTTYPE.
           MOVE W01-QNAME    TO MQOD-OBJECTNAME.
      *
      *                                                               *
      *     The specified queue is set for inquire, browse and        *
      *     exclusive input. The context of any message taken         *
      *     from the queue must also be available if that             *
      *     message is to be forwarded to another queue later         *
      *     on.                                                       *
      *                                                               *
           COMPUTE W02-OPENOPTIONS = MQOO-INQUIRE         +
                                     MQOO-BROWSE          +
                                     MQOO-INPUT-EXCLUSIVE +
                                     MQOO-SAVE-ALL-CONTEXT.
      *
           CALL 'MQOPEN' USING W01-HCONN
                               MQOD
                               W02-OPENOPTIONS
                               W01-HOBJ
                               W02-COMPCODE
                               W02-REASON.
      *
           IF (MQCC-OK = W02-COMPCODE) THEN
              CALL 'ISPLINK' USING IVPUT IHOBJ  ISHARED
              CALL 'ISPLINK' USING IVPUT IQNAME ISHARED
           ELSE
              MOVE 'Unable to open queue.' TO W00-ERRORMSG
              PERFORM ERROR-MESSAGE
           END-IF.
      *
       OPEN-Q-EXIT.
      *
           EXIT.
           EJECT
      *
      *---------------------------------------------------------------*
       ERROR-MESSAGE SECTION.
      *---------------------------------------------------------------*
      * This section puts an error message to the ISPF panel.         *
      * The message consists of some text message, a completion code  *
      * and a reason code.                                            *
      *---------------------------------------------------------------*
      *
           MOVE W02-COMPCODE TO W02-COMPCODE-CHAR.
           MOVE W02-REASON   TO W02-REASON-CHAR.
      *
           STRING W00-ERRORMSG, ' CompCode: ',
                  W02-COMPCODE-CHAR, ' Reason: ',
                  W02-REASON-CHAR, ' '
                  DELIMITED BY SIZE INTO W01-MESSAGE.
      *
           PERFORM PRINT-MESSAGE.
      *
       ERROR-MESSAGE-EXIT.
      *
           EXIT.
           EJECT
      *
      *---------------------------------------------------------------*
       PRINT-MESSAGE SECTION.
      *---------------------------------------------------------------*
      *  This section places a message onto the ISPF panel.           *
      *---------------------------------------------------------------*
      *
           CALL 'ISPLINK' USING IVPUT IMESSAGE ISHARED.
      *
       PRINT-MESSAGE-EXIT.
      *
           EXIT.
           EJECT
      *
      *---------------------------------------------------------------*
       ISPF-INIT SECTION.
      *---------------------------------------------------------------*
      * This section declares all variables which are to be stored    *
      * in the ISPF shared variable pool. These variables are used    *
      * with the ISPF panels or passed to the programs called.        *
      *---------------------------------------------------------------*
      *
           CALL 'ISPLINK' USING IVDEFINE
                                IQMGRNAME W01-QMGRNAME ICHAR  I48.
           CALL 'ISPLINK' USING IVDEFINE
                                IQNAME    W01-QNAME    ICHAR  I48.
           CALL 'ISPLINK' USING IVDEFINE
                                IHCONN    W01-HCONN    IFIXED I4.
           CALL 'ISPLINK' USING IVDEFINE
                                IHOBJ     W01-HOBJ     IFIXED I4.
           CALL 'ISPLINK' USING IVDEFINE
                                IMESSAGE  W01-MESSAGE  ICHAR  I79.
      *
       ISPF-INIT-EXIT.
      *
           EXIT.
           EJECT
      *
      * ------------------------------------------------------------- *
      *                    End of program                             *
      * ------------------------------------------------------------- *

quality96%

¤ Dauer der Verarbeitung: 0.21 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.