Quelle csq4cvd4.cob Sprache: Cobol

CBL XOPTS(ANSI85)
CBL NODYNAM,LIB,OBJECT,RENT,RES,APOST,NUMPROC(NOPFD)
      * ------------------------------------------------------------- *
       IDENTIFICATION DIVISION.
      * ------------------------------------------------------------- *
       PROGRAM-ID. CSQ4CVD4.
      *REMARKS
      * ************************************************************* *
      * @START_COPYRIGHT@                                             *
      *   Statement:     Licensed Materials - Property of IBM         *
      *                                                               *
      *                  5695-137                                     *
      *                  (C) Copyright IBM Corporation. 1993, 1997    *
      *                                                               *
      *   Status:        Version 1 Release 2                          *
      * @END_COPYRIGHT@                                               *
      * ************************************************************* *
      *                                                               *
      *  Product Number   : 5695-137                                  *
      *                                                               *
      *  Module Name      : CSQ4CVD4                                  *
      *                                                               *
      *  Environment      : CICS/ESA Version 3.3; COBOL II            *
      *                                                               *
      *  Function         : This program provides the send mail       *
      *                     function for the mail manager sample.     *
      *                     See IBM MQSeries for MVS/ESA              *
      *                     Application Programming Reference,        *
      *                     for further details.                      *
      *                                                               *
      *  Description      : This program displays panel MAIL-VD4.     *
      *                     The user enters a user name, message and  *
      *                     optionally a queue manager name.          *
      *                     Once these have been entered the program  *
      *                     sends the message data to the appropriate *
      *                     queue; which can be a local, alias or     *
      *                     remote queue.                             *
      *                                                               *
      * ************************************************************* *
      *                                                               *
      *                      Program Logic                            *
      *                      -------------                            *
      *                                                               *
      *   Start  (A-MAIN SECTION)                                     *
      *   -----                                                       *
      *       Display the send message screen (MAIL-VD4)              *
      *                                                               *
      *       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 SEND-MESSAGE                              *
      *          End-if                                               *
      *          Display the send message screen                      *
      *       End-do                                                  *
      *                                                               *
      *       Return to CICS                                          *
      *                                                               *
      *                                                               *
      *   SEND-MESSAGE SECTION                                        *
      *   --------------------                                        *
      *       If user name is spaces                                  *
      *          Build 'enter user name' message                      *
      *                                                               *
      *       Else if message data is blank                           *
      *          Build 'enter message data' message                   *
      *                                                               *
      *       Else                                                    *
      *          Initialize the variable for the put1 call            *
      *          If a queue manager name has been entered             *
      *             Build the local mail queue name                   *
      *             Set the queue manager name to that entered        *
      *             Put the message on the queue                      *
      *          Else                                                 *
      *             Build the mail queue nickname name                *
      *             Set the queue manager name to spaces              *
      *             Put the message on the queue                      *
      *             If the queue name is unknown                      *
      *                Build the local mail queue name                *
      *                Put the message on the queue                   *
      *             End-if                                            *
      *          End-if                                               *
      *                                                               *
      *          Evaluate the results of the call                     *
      *             When call is completed successfully               *
      *                Build the 'successful completion' message      *
      *                (contains the user name and queue manager the  *
      *                message was sent to)                           *
      *             When the user name is unknown                     *
      *                Build the 'unknown user name' message          *
      *             When the queue manager name is unknown            *
      *                Build the 'unknown queue manager' message      *
      *             Otherwise                                         *
      *                Build a message including the compcode and     *
      *                reason                                         *
      *          End-evaluate                                         *
      *                                                               *
      *       End-if                                                  *
      *                                                               *
      *       Return to performing section                            *
      *                                                               *
      *                                                               *
      *   DISPLAY-MAPVD2 SECTION                                      *
      *   ----------------------                                      *
      *       Exec CICS send the send mail screen map                 *
      *       Exec CICS receive the send mail screen map              *
      *                                                               *
      *       Return to performing section                            *
      *                                                               *
      *                                                               *
      *   DISPLAY-HELP SECTION                                        *
      *   --------------------                                        *
      *       Do until PF12 key is pressed                            *
      *          Exec CICS send help screen map                       *
      *          Exec CICS receive help screen map                    *
      *       End-do                                                  *
      *                                                               *
      *       Return to performing section                            *
      *                                                               *
      * ************************************************************* *
      * ------------------------------------------------------------- *
       ENVIRONMENT DIVISION.
      * ------------------------------------------------------------- *
      * ------------------------------------------------------------- *
       DATA DIVISION.
      * ------------------------------------------------------------- *
       WORKING-STORAGE SECTION.
      * ------------------------------------------------------------- *
      *
      *    W00 - General work fields
      *
       01  W00-SENT-TO-MAILQ.
           05                          PIC X(17)       VALUE SPACES.
           05  W00-SENT-TO             PIC X(8).
           05                          PIC X(23)       VALUE SPACES.
       01  W00-MY-MAILQ.
           05  W00-Q-PREFIX            PIC X(17)       VALUE
                                                   'CSQ4SAMP.MAILMGR.'.
           05  W00-USERID              PIC X(8).
           05                          PIC X(23)       VALUE SPACES.
       01  W00-MESSAGE-PRIORITY        PIC S9(09)      VALUE 2.
      *
      *    W01 - MQM API fields
      *
       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-CSQ4VD4                PIC X(08)       VALUE 'CSQ4VD4'.
       01  W02-CSQ4VD6                PIC X(08)       VALUE 'CSQ4VD6'.
      *
      *    Fields used for communication between programs in mail
      *    manager sample
      *
       COPY CSQ4VD3.
      *
      *    Mail manager message definition
      *
       COPY CSQ4VD4.
      *
      *    The following copy book contains messages that will be
      *    displayed to the user
      *
       COPY CSQ4VD0.
      *
      *    Screen map definitions used by this sample program
      *
       COPY CSQ4VDM.
      *
      *    DFHAID contains the constants used for checking for
      *    attention identifiers
      *
       COPY DFHAID SUPPRESS.
      *
      *    API control blocks
      *
       01  MQM-OBJECT-DESCRIPTOR.
           COPY CMQODV SUPPRESS.
       01  MQM-MESSAGE-DESCRIPTOR.
           COPY CMQMDV SUPPRESS.
       01  W05-MQM-PUT-MESSAGE-OPTIONS.
           COPY CMQPMOV SUPPRESS.
      *
      *    Copy book of constants (for filling in the control blocks)
      *    and return codes (for testing the result of a call)
      *
       01  CMQV.
       COPY CMQV SUPPRESS.
           EJECT
      * ------------------------------------------------------------- *
       LINKAGE SECTION.
       01  DFHCOMMAREA                 PIC X(200).
      * ------------------------------------------------------------- *
           EJECT
      * ------------------------------------------------------------- *
       PROCEDURE DIVISION.
      * ------------------------------------------------------------- *
      * ------------------------------------------------------------- *
       A-MAIN SECTION.
      * ------------------------------------------------------------- *
      *                                                               *
      *                                                               *
      *                                                               *
      *                                                               *
      *                                                               *
      *                                                               *
      * ------------------------------------------------------------- *
      *
      *    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.
      *
      *    Set the message priority to be used
      *
           MOVE W00-MESSAGE-PRIORITY TO MQMD-PRIORITY.
      *
      *    Display first page of messages
      *
           MOVE LOW-VALUES TO CSQ4VD4O.
           MOVE VD3-MSG TO VD4MSG1O.
           MOVE VD3-USERID TO VD4IDO.
           MOVE VD3-SUBSYS TO VD4QMO.
      *
           PERFORM DISPLAY-MAPVD4
      *
      *    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 VD4MSG1O
      *
               EVALUATE TRUE
                   WHEN EIBAID = DFHPF1 OR EIBAID = DFHPF13
                       PERFORM DISPLAY-HELP
      *
                   WHEN EIBAID = DFHPF4 OR EIBAID = DFHPF16
                       MOVE LOW-VALUES TO CSQ4VD4O
      *
                   WHEN EIBAID = DFHPF3 OR EIBAID = DFHPF15
                       CONTINUE
      *
                   WHEN EIBAID = DFHENTER
                       PERFORM SEND-MESSAGE
      *
               END-EVALUATE
      *
               MOVE VD3-USERID TO VD4IDO
               MOVE VD3-SUBSYS TO VD4QMO
               PERFORM DISPLAY-MAPVD4
      *
           END-PERFORM.
      *
       A-MAIN-EXIT.
      *
      *    Return to CICS
      *
           EXEC CICS RETURN
           END-EXEC.
      *
           EJECT
      *
      * ------------------------------------------------------------- *
       SEND-MESSAGE SECTION.
      * ------------------------------------------------------------- *
      *                                                              *
      *  This section first ensures that the user has entered message*
      *  data and the user name of a recipient.                      *
      *  The message entered by the user is sent to the mail         *
      *  queue identified by the user-entered recipient details      *
      *                                                              *
      *  If the user has entered a name in VD4QMGRI the section      *
      *  sends the message to VD4USERI at VD4QMGRI.                  *
      *  If no name has been entered in VD4QMGRI, the message is     *
      *  sent assuming the entry in VD4USERI is a nickname. If the   *
      *  nickname is unknown, the message is sent to the local mail  *
      *  queue identified in VD4USERI.                               *
      *                                                              *
      *  The result of the send is checked and a status or error     *
      *  message prepared for display by the calling section.        *
      *                                                              *
      * ------------------------------------------------------------ *
      *
      *    Build the message
      *
           MOVE VD4L1I         TO MSGL1.
           MOVE VD4L2I         TO MSGL2.
           MOVE VD4L3I         TO MSGL3.
           MOVE VD4L4I         TO MSGL4.
           MOVE VD4L5I         TO MSGL5.
           MOVE VD4L6I         TO MSGL6.
           MOVE VD4L7I         TO MSGL7.
           MOVE VD4L8I         TO MSGL8.
           MOVE VD4L9I         TO MSGL9.
           MOVE VD4L10I        TO MSGL10.
      *
      *    If no user name has been entered move an error message to
      *    the output message field
      *
           IF (VD4USERI = SPACES) OR (VD4USERI = LOW-VALUES)
               MOVE VD0-MESSAGE-21 TO VD4MSG1O
      *
      *    If no message text has been entered move an error message
      *    to the output message field, otherwise send the message
      *
           ELSE IF (VD4-MSG-DATA = SPACES)  OR
                   (VD4-MSG-DATA = LOW-VALUES)
               MOVE VD0-MESSAGE-20 TO VD4MSG1O
           ELSE
      *
      *        Initialize the variables for the MQPUT1 call
      *
               MOVE LOW-VALUES   TO MQMD-MSGID
               MOVE LOW-VALUES   TO MQMD-CORRELID
               MOVE VD3-USERID   TO W00-USERID
               MOVE W00-MY-MAILQ TO MQMD-REPLYTOQ
               MOVE VD3-SUBSYS   TO MQMD-REPLYTOQMGR
      *
               COMPUTE MQPMO-OPTIONS = MQPMO-NO-SYNCPOINT
      *
      *        If a queue manager name has been entered, send the
      *        message to that queue manager; otherwise
      *        send the message to the local queue manager
      *
               IF ((VD4QMGRI NOT = SPACES) AND
                   (VD4QMGRI NOT = LOW-VALUES))
      *
      *            Set the queue name and the queue manager name
      *            the message is to be sent to
      *
                   MOVE SPACES TO MQOD-OBJECTNAME
                   STRING W00-Q-PREFIX VD4USERI
                          DELIMITED BY SPACES
                          INTO MQOD-OBJECTNAME
                   MOVE VD4QMGRI TO MQOD-OBJECTQMGRNAME
      *
                   CALL 'MQPUT1' USING VD3-HCONN
                                       MQOD
                                       MQMD
                                       MQPMO
                                       VD4-MSG-LENGTH
                                       VD4-MESSAGE
                                       W01-COMPCODE
                                       W01-REASON
      *
               ELSE
      *
      *            Set the queue name and the queue manager name
      *            the message is to be sent to.
      *            - assuming the name in VD4USERI is a nickname
      *
                   MOVE SPACES   TO MQOD-OBJECTNAME
                   STRING W00-Q-PREFIX VD3-USERID '.' VD4USERI
                          DELIMITED BY SPACES
                               INTO MQOD-OBJECTNAME
                   MOVE SPACES TO   MQOD-OBJECTQMGRNAME
      *
                   CALL 'MQPUT1' USING VD3-HCONN
                                       MQOD
                                       MQMD
                                       MQPMO
                                       VD4-MSG-LENGTH
                                       VD4-MESSAGE
                                       W01-COMPCODE
                                       W01-REASON
      *
      *            Test to see if the nickname queue name is unknown
      *
                   IF (W01-REASON = MQRC-UNKNOWN-OBJECT-NAME) THEN
      *
      *                Set the local queue name the message
      *                is to be sent to.
      *
                       MOVE SPACES TO MQOD-OBJECTNAME
                       STRING W00-Q-PREFIX VD4USERI
                              DELIMITED BY SPACES
                              INTO MQOD-OBJECTNAME
                       MOVE SPACES TO MQOD-OBJECTQMGRNAME
      *
                       CALL 'MQPUT1' USING VD3-HCONN
                                           MQOD
                                           MQMD
                                           MQPMO
                                           VD4-MSG-LENGTH
                                           VD4-MESSAGE
                                           W01-COMPCODE
                                           W01-REASON
      *
                   END-IF
      *
               END-IF
      *
      *        Test the output from the call
      *          If the message was sent successfully:
      *            Identify the queue and queue manager which received
      *            the message
      *          Otherwise:
      *            Set an appropriate error message
      *
               EVALUATE TRUE
                 WHEN W01-COMPCODE = MQCC-OK
                   MOVE MQPMO-RESOLVEDQNAME    TO W00-SENT-TO-MAILQ
                   MOVE W00-SENT-TO            TO VD0-MSG9-TO-USER
                   MOVE MQPMO-RESOLVEDQMGRNAME TO VD0-MSG9-TO-QMGR
                   MOVE VD0-MESSAGE-9          TO VD4MSG1O
                 WHEN W01-REASON = MQRC-UNKNOWN-OBJECT-NAME
                   MOVE VD0-MESSAGE-22         TO VD4MSG1O
                 WHEN W01-REASON = MQRC-UNKNOWN-REMOTE-Q-MGR
                   MOVE VD0-MESSAGE-23         TO VD4MSG1O
                 WHEN OTHER
                   MOVE 'SEND MSG'   TO VD0-MSG1-TYPE
                   MOVE W01-COMPCODE TO VD0-MSG1-COMPCODE
                   MOVE W01-REASON TO VD0-MSG1-REASON
                   MOVE VD0-MESSAGE-1 TO VD4MSG1O
               END-EVALUATE
      *
           END-IF.
      *
       SEND-MESSAGE-EXIT.
      *
      *    Return to performing section
      *
           EXIT.
      *
      * ------------------------------------------------------------- *
       DISPLAY-MAPVD4 SECTION.
      * ------------------------------------------------------------- *
      *                                                              *
      *  This section sends the send mail screen (MAIL-VD4)          *
      *  to the terminal and returns once the receive is complete    *
      *                                                              *
      * ------------------------------------------------------------ *
      *
           EXEC CICS SEND
                     MAP(W02-CSQ4VD4)
                     MAPSET(W02-MAPSET-NAME)
                     FROM(CSQ4VD4O)
                     ERASE
           END-EXEC.
      *
           EXEC CICS RECEIVE
                     MAP(W02-CSQ4VD4)
                     MAPSET(W02-MAPSET-NAME)
                     INTO(CSQ4VD4O)
           END-EXEC.
      *
       DISPLAY-MAPVD4-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
      *
      * ---------------------------------------------------------------
      *                  End of program
      * ---------------------------------------------------------------

quality96%

¤ Dauer der Verarbeitung: 0.19 Sekunden (vorverarbeitet) ¤

Wurzel

Suchen

Beweissystem der NASA

Beweissystem Isabelle

NIST Cobol Testsuite

Cephes Mathematical Library

Wiener Entwicklungsmethode

Haftungshinweis

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

Bemerkung:

Die farbliche Syntaxdarstellung ist noch experimentell.