Quellcode-Bibliothek

^© Kompilation durch diese Firma

[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]

Datei: csq4cvd1.cob Sprache: Cobol

Original von: verschiedene^©

CBL XOPTS(ANSI85)
CBL NODYNAM,LIB,OBJECT,RENT,RES,APOST,NUMPROC(NOPFD)
      * ------------------------------------------------------------- *
       IDENTIFICATION DIVISION.
      * ------------------------------------------------------------- *
       PROGRAM-ID. CSQ4CVD1.
      *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           : CSQ4CVD1                             *
      *                                                               *
      *  Environment           : CICS/ESA Version 3.3; COBOL II       *
      *                                                               *
      *  CICS Transaction Name : MAIL                                 *
      *                                                               *
      *  Function         : This program provides initiation and      *
      *                     option menu for the mail manager sample.  *
      *                     See IBM MQSeries for MVS/ESA              *
      *                     Application Programming Reference,        *
      *                     for further details.                      *
      *                                                               *
      *  Description      : This program opens a users mail queue,    *
      *                     getting the userid from the user's        *
      *                     sign-on or from panel MAIL-VD0,           *
      *                     and creating the queue if required.       *
      *                     It then displays panel MAIL-VD1 and       *
      *                     initiates the other programs in suite to  *
      *                     perform the user selected function.       *
      *                                                               *
      * ************************************************************* *
      *                                                               *
      *                      Program Logic                            *
      *                      -------------                            *
      *                                                               *
      *   Start  (A-MAIN SECTION)                                     *
      *   -----                                                       *
      *       Perform GET-USERID                                      *
      *       If no userid is entered                                 *
      *          Build message and exit                               *
      *       End-if                                                  *
      *       Perform GET-QMGR-NAME                                   *
      *       If the queue manager name cannot be obtained            *
      *          Build error message and exit                         *
      *       End-if                                                  *
      *       Perform OPEN-USERS-MAIL-QUEUE                           *
      *       If open not successful                                  *
      *          Build error message and exit                         *
      *       End-if                                                  *
      *       Perform FIND-MAIL-QUEUE-DEPTH                           *
      *                                                               *
      *       Display the main menu panel (MAIL-VD1)                  *
      *       Do until PF3 is pressed                                 *
      *          Evaluate user request                                *
      *             If Help (PF1) key pressed                         *
      *                Display the help screen until PF12 is pressed  *
      *             Else if enter key pressed                         *
      *                Evaluate                                       *
      *                   When '1'  Perform FIND-MAIL-QUEUE-DEPTH     *
      *                             If messages available             *
      *                                Perform READ-MAIL              *
      *                             Else                              *
      *                                Build message                  *
      *                             End-if                            *
      *                   When '2'  Perform SEND-MAIL                 *
      *                   When '3'  Perform CREATE-NICKNAME           *
      *                   Otherwise build error message               *
      *                End-evaluate                                   *
      *             End-if                                            *
      *          End-evaluate                                         *
      *          Perform FIND-MAIL-QUEUE-DEPTH                        *
      *          Display the main menu panel                          *
      *       End-do                                                  *
      *                                                               *
      *       Close the users mail queue                              *
      *       If close not successful                                 *
      *          Build error message                                  *
      *       End-if                                                  *
      *                                                               *
      *       Prepare and display final message                       *
      *                                                               *
      *       Return to CICS                                          *
      *                                                               *
      *                                                               *
      *   GET-USERID SECTION                                          *
      *   ------------------                                          *
      *       Do until userid entered                                 *
      *          Display get-userid panel (MAIL-VD0)                  *
      *          Evaluate user response                               *
      *             If Help (PF1) key pressed                         *
      *                Display the help screen while PF12 not pressed *
      *             Else if end (PF3) key pressed                     *
      *                Move 'CANCEL' to userid                        *
      *             Otherwise do nothing                              *
      *             End-if                                            *
      *          End-evaluate                                         *
      *       End-do                                                  *
      *                                                               *
      *       Return to performing section                            *
      *                                                               *
      *                                                               *
      *   GET-QMGR-NAME SECTION                                       *
      *   ---------------------                                       *
      *       Initialize the variables for the open call              *
      *       Open the queue manager for inquiry                      *
      *       If open not successful                                  *
      *          Build an error message                               *
      *       Else                                                    *
      *          Initialize the variables for the inquire call        *
      *          If inquire not successful                            *
      *             Build an error message                            *
      *          Else                                                 *
      *             Save the quue manager name                        *
      *          End-if                                               *
      *          Close the queue manager                              *
      *       End-if                                                  *
      *                                                               *
      *       Return to performing section                            *
      *                                                               *
      *                                                               *
      *   OPEN-USERS-MAIL-QUEUE SECTION                               *
      *   -----------------------------                               *
      *       Initialize the variables for the open call              *
      *       Open the users mail queue                               *
      *       If open not successful                                  *
      *          If the queue does not exist                          *
      *             Perform CREATE-MAIL-QUEUE                         *
      *             Set number of messages to zero                    *
      *             If create queue was unsuccessful                  *
      *                Build an error message                         *
      *             End-if                                            *
      *          Else                                                 *
      *             Build an error message                            *
      *          End-if                                               *
      *       End-if                                                  *
      *                                                               *
      *       Return to performing section                            *
      *                                                               *
      *                                                               *
      *   CREATE-MAIL-QUEUE SECTION                                   *
      *   -------------------------                                   *
      *       Initialize the variables for the open call              *
      *       Open the temporary queue                                *
      *       If open not successful                                  *
      *          Build error message                                  *
      *          Go to CREATE-MAIL-QUEUE-EXIT                         *
      *       End-if                                                  *
      *                                                               *
      *       Initialize the variables for the put1 call              *
      *       Put1 the define queue message                           *
      *       If put1 not successful                                  *
      *          Build error message                                  *
      *          Go to CREATE-MAIL-QUEUE-TEMPQ-CLOSE                  *
      *       End-if                                                  *
      *                                                               *
      *       Initialize the variables for the get call               *
      *       Do until expected response message received or get fails*
      *          Get the message                                      *
      *          If message received                                  *
      *             If expected message received                      *
      *                If queue was created successfully              *
      *                   Set create-worked to Y                      *
      *                Else                                           *
      *                   Set create-worked to N                      *
      *                End-if                                         *
      *             End-if                                            *
      *          Else                                                 *
      *             If no message available                           *
      *                Set 'unable to create mail queue' message      *
      *             Else                                              *
      *                Build error message                            *
      *             End-if                                            *
      *          End-if                                               *
      *       End-do                                                  *
      *                                                               *
      *   CREATE-MAIL-QUEUE-TEMPQ-CLOSE                               *
      *       Close the temporary queue                               *
      *                                                               *
      *       If create-worked = Y                                    *
      *          Initialize the variables for the open call           *
      *          Open the users mail queue                            *
      *          If the open is not successful                        *
      *             Build an error message                            *
      *          End-if                                               *
      *       End-if                                                  *
      *                                                               *
      *   CREATE-MAIL-QUEUE-EXIT                                      *
      *       Return to performing section                            *
      *                                                               *
      *                                                               *
      *   FIND-MAIL-QUEUE-DEPTH SECTION                               *
      *   -----------------------------                               *
      *       Initialize the variables for the inquire call           *
      *       Inquire on the users mail queue depth                   *
      *       If inquire not successful                               *
      *          Build an error message                               *
      *          Set number of messages to zero                       *
      *       Else                                                    *
      *          Set number of messages to queue depth                *
      *       End-if                                                  *
      *                                                               *
      *       Return to performing section                            *
      *                                                               *
      *                                                               *
      *   READ-MAIL SECTION                                           *
      *   -----------------                                           *
      *       Exec CICS link to initiate the receive mail program     *
      *                                                               *
      *       Return to performing section                            *
      *                                                               *
      *                                                               *
      *   SEND-MAIL SECTION                                           *
      *   -----------------                                           *
      *       Exec CICS link to initiate the send mail program        *
      *                                                               *
      *       Return to performing section                            *
      *                                                               *
      *                                                               *
      *   CREATE-NICKNAME SECTION                                     *
      *   -----------------------                                     *
      *       Exec CICS link to initiate the create nickname program  *
      *                                                               *
      *       Return to performing section                            *
      *                                                               *
      *                                                               *
      *   DISPLAY-MAPVD1 SECTION                                      *
      *   ----------------------                                      *
      *       Exec CICS send main menu screen map                     *
      *       Exec CICS receive main menu 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-GET-WAIT-30SECS         PIC S9(09) BINARY VALUE 30000.
       01  W00-DATA-LENGTH             PIC S9(09) BINARY.
       01  W00-MESSAGE                 PIC X(80)         VALUE SPACES.
       01  W00-CREATE-WORKED           PIC X.
      *
      *    W01 - Queue name fields
      *
       01  W01-REPLY-QNAME             PIC X(48)       VALUE SPACES.
       01  W01-SYSTEM-REPLY-MODEL      PIC X(26)       VALUE
                                      'SYSTEM.DEFAULT.MODEL.QUEUE'.
       01  W01-SYSTEM-COMMAND-QUEUE    PIC X(20)       VALUE
                                      'SYSTEM.COMMAND.INPUT'.
       01  W01-SYSTEM-REPLY-INITIAL    PIC X(10)       VALUE
                                      'CSQ4SAMP.*'.
      *
      *    W02 - Command server query and response fields
      *
       01  W02-DEFINE-COMMAND.
           05                          PIC X(14)       VALUE
                                      'DEFINE QLOCAL('.
           05  MAILQ.
               10                      PIC X(17)       VALUE
                                      'CSQ4SAMP.MAILMGR.'.
               10  MAILQ-USER          PIC X(08)       VALUE SPACES.
               10                      PIC X(23)       VALUE SPACES.
           05                          PIC X(39)       VALUE
                          ') LIKE(CSQ4SAMP.MAILMGR.QUEUE.TEMPLATE)'.
       01  W02-DEFINE-LENGTH           PIC S9(09) BINARY.
      *
       01  W02-COMMAND-REPLY.
           05  W02-REPLY-NUM           PIC X(08).
           05                          PIC X(26).
           05  W02-RETURN-NUM          PIC X(08).
           05                          PIC X(09).
           05  W02-REASON-NUM          PIC X(08).
           05                          PIC X(41).
       01  W02-REPLY-LENGTH            PIC S9(09) BINARY.
      *
      *    W03 - MQM API fields
      *
       01  W03-COMPCODE                PIC S9(09) BINARY VALUE ZERO.
       01  W03-REASON                  PIC S9(09) BINARY VALUE ZERO.
       01  W03-OPTIONS                 PIC S9(09) BINARY.
       01  W03-SELECTORCOUNT           PIC S9(09) BINARY VALUE 1.
       01  W03-INTATTRCOUNT            PIC S9(09) BINARY.
       01  W03-CHARATTRLENGTH          PIC S9(09) BINARY.
       01  W03-CHARATTRS               PIC X(48)      VALUE LOW-VALUES.
       01  W03-SELECTORS-TABLE.
           05  W03-SELECTORS           PIC S9(09) BINARY.
       01  W03-INTATTRS-TABLE.
           05  W03-INTATTRS            PIC S9(09) BINARY.
      *
      *    W04 - Screen map name definitions
      *
       01  W04-MAPSET-NAME            PIC X(08)       VALUE 'CSQ4VDM'.
       01  W04-CSQ4VD0                PIC X(08)       VALUE 'CSQ4VD0'.
       01  W04-CSQ4VD1                PIC X(08)       VALUE 'CSQ4VD1'.
       01  W04-CSQ4VD6                PIC X(08)       VALUE 'CSQ4VD6'.
       01  W04-CSQ4CVD2               PIC X(08)       VALUE 'CSQ4CVD2'.
       01  W04-CSQ4CVD4               PIC X(08)       VALUE 'CSQ4CVD4'.
       01  W04-CSQ4CVD5               PIC X(08)       VALUE 'CSQ4CVD5'.
      *
      *    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.
       01  MQM-MESSAGE-DESCRIPTOR.
           COPY CMQMDV.
       01  MQM-GET-MESSAGE-OPTIONS.
           COPY CMQGMOV.
       01  MQM-PUT-MESSAGE-OPTIONS.
           COPY CMQPMOV.
      *
      *    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
      * ------------------------------------------------------------- *
       PROCEDURE DIVISION.
      * ------------------------------------------------------------- *
       A-MAIN SECTION.
      * ------------------------------------------------------------- *
      *                                                              *
      * This section gets the queue manager and userid.              *
      *                                                              *
      * The section then displays the mail manager main menu screen  *
      * in a loop and calls other programs to process the options    *
      * entered by the user. The number of messages in the mail      *
      * queue is updated within the loop.                            *
      *                                                              *
      * After exiting from the loop the users mail queue is closed   *
      * and control returned to CICS                                 *
      *                                                              *
      * ------------------------------------------------------------ *
      *
           MOVE SPACES TO VD3-MAIL-COMMAREA.
      *
           EXEC CICS IGNORE CONDITION
                     MAPFAIL
           END-EXEC.
      *
      *    Get users sign-on from CICS
      *
           EXEC CICS ASSIGN
                     USERID(MAILQ-USER)
           END-EXEC.
      *
      *    If the user is not signed on, get a userid.
      *
      *    The test assumes that the default CICS userid is CICSUSER,
      *    if this is not the case change CICSUSER to correct default
      *
           IF ((MAILQ-USER = SPACES) OR (MAILQ-USER = 'CICSUSER')) THEN
      *
               PERFORM GET-USERID
               MOVE VD0USERI TO MAILQ-USER
      *
      *        If no userid is entered - end program
      *
               IF VD0USERI = 'CANCEL' THEN
                   MOVE VD0-MESSAGE-19 to VD3-MSG
                   GO TO A-MAIN-EXIT
               END-IF
           END-IF.
      *
      *    Save the userid
      *
           MOVE MAILQ-USER TO VD3-USERID.
      *
           PERFORM GET-QMGR-NAME.
      *
      *    If the queue manager name could not be read, exit
      *    displaying the message set by GET-QMGR-NAME
      *
           IF (VD3-MSG NOT = SPACES) THEN
               GO TO A-MAIN-EXIT
           END-IF.
      *
      *    Open the users mail queue
      *
           PERFORM OPEN-USERS-MAIL-QUEUE.
      *
      *    If the open was unsuccessful, exit
      *    displaying the message set by OPEN-USERS-MAIL-QUEUE
      *
           IF (VD3-MSG NOT = SPACES) THEN
               GO TO A-MAIN-EXIT
           END-IF.
      *
      *    Initialize screen display fields
      *
           MOVE LOW-VALUES TO CSQ4VD1O.
           MOVE VD3-USERID TO VD1IDO.
           MOVE VD3-SUBSYS TO VD1QMO.
      *
           PERFORM FIND-MAIL-QUEUE-DEPTH
      *
      *    Update the relevant screen fields. If an error occurred
      *    it is recorded in VD3-MSG
      *
           MOVE VD3-NUMMSG       TO VD1NUMO.
           MOVE VD3-MSG          TO VD1MSG1O.
      *
           PERFORM DISPLAY-MAPVD1.
      *
      *    Loop from here to END-PERFORM until the PF3 key is pressed
      *
           PERFORM WITH TEST BEFORE UNTIL (EIBAID = DFHPF3  OR
                                           EIBAID = DFHPF15)
      *
               EVALUATE TRUE
                   WHEN EIBAID = DFHPF1 OR EIBAID = DFHPF13
                       PERFORM DISPLAY-HELP
      *
                   WHEN EIBAID = DFHENTER
      *
                       MOVE SPACES TO VD3-MSG
      *
      *                Process depending on the action entered by the
      *                user
      *
                       EVALUATE TRUE
                           WHEN VD1SELI = '1'
                                PERFORM FIND-MAIL-QUEUE-DEPTH
                                IF VD3-NUMMSG NOT = ' 0' THEN
                                    PERFORM READ-MAIL
                                ELSE
                                    MOVE VD0-MESSAGE-17 TO VD3-MSG
                                END-IF
                           WHEN VD1SELI = '2'
                                PERFORM SEND-MAIL
                           WHEN VD1SELI = '3'
                                PERFORM CREATE-NICKNAME
                           WHEN OTHER
                                MOVE VD0-MESSAGE-18 TO VD3-MSG
                                MOVE -1 TO VD1SELL
                       END-EVALUATE
      *
               END-EVALUATE
      *
      *        Move the message field into the corresponding
      *        screen map field and update the messages
      *        waiting field
      *
               PERFORM FIND-MAIL-QUEUE-DEPTH
               MOVE VD3-NUMMSG TO VD1NUMO
               MOVE VD3-MSG    TO VD1MSG1O
               MOVE VD3-USERID TO VD1IDO
               MOVE VD3-SUBSYS TO VD1QMO
      *
               PERFORM DISPLAY-MAPVD1
      *
           END-PERFORM.
      *
      *    Close the queue.
      *
           MOVE MQCO-NONE TO W03-OPTIONS.
      *
           CALL 'MQCLOSE' USING VD3-HCONN
                                VD3-HOBJ
                                W03-OPTIONS
                                W03-COMPCODE
                                W03-REASON.
      *
      *    Test the output of the MQCLOSE call.  If the call failed,
      *    build an error message showing the completion code and
      *    reason
      *
           IF (W03-COMPCODE = MQCC-FAILED) THEN
              MOVE 'MQCLOSE'      TO VD0-MSG1-TYPE
              MOVE W03-COMPCODE   TO VD0-MSG1-COMPCODE
              MOVE W03-REASON     TO VD0-MSG1-REASON
              MOVE VD0-MESSAGE-1  TO VD3-MSG
           ELSE
              MOVE VD0-MESSAGE-19 TO VD3-MSG
           END-IF.
      *
       A-MAIN-EXIT.
      *
           MOVE SPACES TO W00-MESSAGE.
           STRING EIBTRNID
                  SPACE
                  VD3-MSG
                  DELIMITED BY SIZE INTO W00-MESSAGE.
      *
           EXEC CICS SEND
                     TEXT
                     FROM(W00-MESSAGE)
                     FREEKB
                     ERASE
           END-EXEC.
      *
      *    Return to CICS
      *
           EXEC CICS RETURN
           END-EXEC.
      *
           EJECT
      *
      * ------------------------------------------------------------- *
       GET-USERID SECTION.
      * ------------------------------------------------------------- *
      *                                                              *
      * This section gets the name of the mail queue to be used      *
      * from the user.                                               *
      *                                                              *
      * ------------------------------------------------------------ *
      *
           MOVE LOW-VALUES TO CSQ4VD0O.
      *
           PERFORM WITH TEST AFTER UNTIL ((VD0USERI NOT = SPACES) AND
                                          (VD0USERI NOT = LOW-VALUES))
      *
                   EXEC CICS SEND
                             MAP(W04-CSQ4VD0)
                             MAPSET(W04-MAPSET-NAME)
                             FROM(CSQ4VD0O)
                             ERASE
                   END-EXEC
      *
                   EXEC CICS RECEIVE
                             MAP(W04-CSQ4VD0)
                             MAPSET(W04-MAPSET-NAME)
                             INTO(CSQ4VD0O)
                   END-EXEC
      *
             EVALUATE TRUE
               WHEN EIBAID = DFHPF1 OR EIBAID = DFHPF13
                   PERFORM DISPLAY-HELP
      *
               WHEN  EIBAID = DFHPF3 OR EIBAID = DFHPF15
                   MOVE 'CANCEL' TO VD0USERI
      *
             END-EVALUATE
           END-PERFORM.
      *
       GET-USERID-EXIT.
      *
      *    Return to performing section
      *
           EXIT.
           EJECT
      *
      * ------------------------------------------------------------- *
       GET-QMGR-NAME SECTION.
      * ------------------------------------------------------------- *
      *                                                              *
      * This section gets the name of the queue manager the CICS     *
      * system is attached to.                                       *
      *                                                              *
      * ------------------------------------------------------------ *
      *
      *    Initialize the Object Descriptor (MQOD) control block.
      *    (The copy book initializes remaining fields)
      *
           MOVE MQOT-Q-MGR               TO MQOD-OBJECTTYPE.
           MOVE SPACES                   TO MQOD-OBJECTNAME.
           MOVE SPACES                   TO MQOD-DYNAMICQNAME.
           MOVE ZERO                     TO VD3-HOBJ.
           MOVE MQHC-DEF-HCONN           TO VD3-HCONN.
      *
           MOVE MQOO-INQUIRE             TO W03-OPTIONS.
      *
      *    Open the queue manager
      *
           CALL 'MQOPEN' USING VD3-HCONN
                               MQOD
                               W03-OPTIONS
                               VD3-HOBJ
                               W03-COMPCODE
                               W03-REASON.
      *
      *    Test the output of the open call.  If the call failed, build
      *    an error message showing the completion code and reason code
      *
           IF (W03-COMPCODE NOT = MQCC-OK) THEN
              MOVE 'OPEN QMGR'   TO VD0-MSG1-TYPE
              MOVE W03-COMPCODE  TO VD0-MSG1-COMPCODE
              MOVE W03-REASON    TO VD0-MSG1-REASON
              MOVE VD0-MESSAGE-1 TO VD3-MSG
              GO TO GET-QMGR-NAME-EXIT
           END-IF.
      *
      *    Set selectors to inquire on queue manager name
      *
           MOVE MQCA-Q-MGR-NAME      TO W03-SELECTORS.
           MOVE ZERO                 TO W03-INTATTRCOUNT.
           MOVE MQ-Q-MGR-NAME-LENGTH TO W03-CHARATTRLENGTH.
      *
      *    Inquire on the attributes
      *
           CALL 'MQINQ' USING VD3-HCONN
                              VD3-HOBJ
                              W03-SELECTORCOUNT
                              W03-SELECTORS
                              W03-INTATTRCOUNT
                              W03-INTATTRS
                              W03-CHARATTRLENGTH
                              W03-CHARATTRS
                              W03-COMPCODE
                              W03-REASON.
      *
      *    Test the output from the inquiry:
      *
      *     - If the completion code is not ok, display an error
      *       message showing the completion and reason codes
      *
      *     - Otherwise, store the queue manager name
      *
           IF W03-COMPCODE NOT = MQCC-OK
               MOVE 'INQ QMGR'    TO VD0-MSG1-TYPE
               MOVE W03-COMPCODE  TO VD0-MSG1-COMPCODE
               MOVE W03-REASON    TO VD0-MSG1-REASON
               MOVE VD0-MESSAGE-1 TO VD3-MSG
               MOVE SPACES        TO VD3-SUBSYS
           ELSE
               MOVE SPACES        TO VD3-MSG
               MOVE W03-CHARATTRS TO VD3-SUBSYS
           END-IF.
      *
           CALL 'MQCLOSE' USING VD3-HCONN
                                VD3-HOBJ
                                MQCO-NONE
                                W03-COMPCODE
                                W03-REASON.
      *
       GET-QMGR-NAME-EXIT.
      *
      *    Return to performing section
      *
           EXIT.
           EJECT
      *
      * ------------------------------------------------------------- *
       OPEN-USERS-MAIL-QUEUE SECTION.
      * ------------------------------------------------------------- *
      *                                                              *
      * This section opens the user's mail queue - if this queue     *
      * does not exist the section calls CREATE-MAIL-QUEUE to        *
      * create the queue.                                            *
      * If the open fails, a message is built indicating the reason  *
      *                                                              *
      * ------------------------------------------------------------ *
      *
           MOVE SPACES TO VD3-MSG
      *
      *    Initialize the Object Descriptor (MQOD) control block.
      *    (The remaining fields are already initialized)
      *
           MOVE MQOT-Q TO MQOD-OBJECTTYPE.
           MOVE MAILQ  TO MQOD-OBJECTNAME.
      *
           MOVE MQOO-INQUIRE          TO W03-OPTIONS.
           ADD  MQOO-BROWSE           TO W03-OPTIONS.
           ADD  MQOO-INPUT-SHARED     TO W03-OPTIONS.
           ADD  MQOO-OUTPUT           TO W03-OPTIONS.
           MOVE ZERO TO VD3-HCONN.
           MOVE ZERO TO VD3-HOBJ.
      *
      *    Open the mail queue
      *
           CALL 'MQOPEN' USING VD3-HCONN
                               MQOD
                               W03-OPTIONS
                               VD3-HOBJ
                               W03-COMPCODE
                               W03-REASON.
      *
      *    Test the output of the open call.
      *       If the call failed for unknown object name - create
      *       the queue
      *       Else build an error message showing the completion
      *       code and reason
      *
           IF (W03-COMPCODE NOT = MQCC-OK) THEN
              IF (W03-REASON = MQRC-UNKNOWN-OBJECT-NAME) THEN
      *          Queue doesn't exist - create it
                 PERFORM CREATE-MAIL-QUEUE
                 MOVE ZERO TO VD3-NUMMSG
                 IF W00-CREATE-WORKED = 'N' THEN
      *             Couldn't create it - report it
                    MOVE VD0-MESSAGE-2 TO VD3-MSG
                 END-IF
              ELSE
      *          Something else is wrong - report it
                 MOVE 'OPEN MAILQ'  TO VD0-MSG1-TYPE
                 MOVE W03-COMPCODE  TO VD0-MSG1-COMPCODE
                 MOVE W03-REASON    TO VD0-MSG1-REASON
                 MOVE VD0-MESSAGE-1 TO VD3-MSG
              END-IF
           END-IF.
      *
       OPEN-USERS-MAIL-QUEUE-EXIT.
      *
      *    Return to performing section
      *
           EXIT.
           EJECT
      *
      * ------------------------------------------------------------- *
       CREATE-MAIL-QUEUE SECTION.
      * ------------------------------------------------------------- *
      *                                                              *
      *  This section creates the users mail queue. If the create    *
      *  fails, a message is built indicating the reason.            *
      *                                                              *
      * ------------------------------------------------------------ *
      *
      *    Initialize variables
      *
           MOVE LENGTH OF W02-DEFINE-COMMAND TO W02-DEFINE-LENGTH.
           MOVE LENGTH OF W02-COMMAND-REPLY  TO W02-REPLY-LENGTH.
           MOVE SPACE TO W00-CREATE-WORKED.
      *
      *    Initialize the Object Descriptor (MQOD) control block.
      *    (The remaining fields are already initialized)
      *
           MOVE MQOT-Q                   TO MQOD-OBJECTTYPE.
           MOVE W01-SYSTEM-REPLY-MODEL   TO MQOD-OBJECTNAME.
           MOVE W01-SYSTEM-REPLY-INITIAL TO MQOD-DYNAMICQNAME.
           MOVE ZERO                     TO VD3-HOBJ.
      *
           MOVE MQOO-INPUT-AS-Q-DEF      TO W03-OPTIONS.
      *
      *    Open the temporary queue
      *
           CALL 'MQOPEN' USING VD3-HCONN
                               MQOD
                               W03-OPTIONS
                               VD3-HOBJ
                               W03-COMPCODE
                               W03-REASON.
      *
      *    Test the output of the open call.  If the call failed, build
      *    an error message showing the completion code and reason
      *
           IF (W03-COMPCODE NOT = MQCC-OK) THEN
              MOVE 'OPEN TEMPQ'  TO VD0-MSG1-TYPE
              MOVE W03-COMPCODE  TO VD0-MSG1-COMPCODE
              MOVE W03-REASON    TO VD0-MSG1-REASON
              MOVE VD0-MESSAGE-1 TO VD3-MSG
              GO TO CREATE-MAIL-QUEUE-EXIT
           END-IF.
      *
      *    Send a 'define queue' message to the system command
      *    input queue
      *
           MOVE MQOD-OBJECTNAME          TO W01-REPLY-QNAME
                                            MQMD-REPLYTOQ.
           MOVE MQMT-REQUEST             TO MQMD-MSGTYPE.
           MOVE MQPER-NOT-PERSISTENT     TO MQMD-PERSISTENCE.
           MOVE MQOT-Q                   TO MQOD-OBJECTTYPE.
           MOVE W01-SYSTEM-COMMAND-QUEUE TO MQOD-OBJECTNAME.
           MOVE MQPMO-NO-SYNCPOINT       TO MQPMO-OPTIONS.
      *
           CALL 'MQPUT1' USING VD3-HCONN
                               MQOD
                               MQMD
                               MQPMO
                               W02-DEFINE-LENGTH
                               W02-DEFINE-COMMAND
                               W03-COMPCODE
                               W03-REASON.
      *
           IF (W03-COMPCODE NOT = MQCC-OK) THEN
              MOVE 'DEFQ PUT1'   TO VD0-MSG1-TYPE
              MOVE W03-COMPCODE  TO VD0-MSG1-COMPCODE
              MOVE W03-REASON    TO VD0-MSG1-REASON
              MOVE VD0-MESSAGE-1 TO VD3-MSG
              GO TO CREATE-MAIL-QUEUE-TEMPQ-CLOSE
           END-IF.
      *
           MOVE MQGMO-ACCEPT-TRUNCATED-MSG TO MQGMO-OPTIONS.
           ADD  MQGMO-WAIT                 TO MQGMO-OPTIONS.
           MOVE W00-GET-WAIT-30SECS        TO MQGMO-WAITINTERVAL.
      *
           PERFORM WITH TEST AFTER UNTIL ( (W03-COMPCODE NOT = MQCC-OK)
                                   OR (W00-CREATE-WORKED NOT = SPACE) )
      *
               MOVE LOW-VALUES TO MQMD-MSGID
                                  MQMD-CORRELID
               MOVE SPACES     TO W02-COMMAND-REPLY
      *
               CALL 'MQGET' USING VD3-HCONN
                                  VD3-HOBJ
                                  MQMD
                                  MQGMO
                                  W02-REPLY-LENGTH
                                  W02-COMMAND-REPLY
                                  W00-DATA-LENGTH
                                  W03-COMPCODE
                                  W03-REASON
      *
               IF (W03-COMPCODE = MQCC-OK) THEN
                   IF W02-REPLY-NUM = 'CSQN205I' THEN
                       IF W02-RETURN-NUM = '00000000' THEN
                           MOVE 'Y' TO W00-CREATE-WORKED
                       ELSE
                           MOVE 'N' TO W00-CREATE-WORKED
                       END-IF
      *            else
      *                Do nothing with this message
                   END-IF
               ELSE
                   IF (W03-REASON = MQRC-NO-MSG-AVAILABLE) THEN
                       MOVE VD0-MESSAGE-2 TO VD3-MSG
                   ELSE
                       MOVE 'DEFINE GET'  TO VD0-MSG1-TYPE
                       MOVE W03-COMPCODE  TO VD0-MSG1-COMPCODE
                       MOVE W03-REASON    TO VD0-MSG1-REASON
                       MOVE VD0-MESSAGE-1 TO VD3-MSG
                   END-IF
               END-IF
      *
           END-PERFORM.
      *
       CREATE-MAIL-QUEUE-TEMPQ-CLOSE.
      *
      *    Close, and thus delete, the temporary queue
      *
           CALL 'MQCLOSE' USING VD3-HCONN
                                VD3-HOBJ
                                MQCO-NONE
                                W03-COMPCODE
                                W03-REASON.
      *
      *    If the mail queue was created, open it
      *
           IF W00-CREATE-WORKED = 'Y' THEN
      *
      *        Initialize the Object Descriptor (MQOD) control block.
      *        (The remaining fields are already initialized)
      *
               MOVE MQOT-Q TO MQOD-OBJECTTYPE
               MOVE MAILQ  TO MQOD-OBJECTNAME
      *
      *        Initialize the working storage field required to open
      *        the queue
      *
               MOVE MQOO-INQUIRE         TO W03-OPTIONS
               ADD MQOO-BROWSE           TO W03-OPTIONS
               ADD MQOO-INPUT-SHARED     TO W03-OPTIONS
               ADD MQOO-OUTPUT           TO W03-OPTIONS
               ADD MQOO-SAVE-ALL-CONTEXT TO W03-OPTIONS
      *
      *        Open the queue
      *
               CALL 'MQOPEN' USING VD3-HCONN
                                   MQOD
                                   W03-OPTIONS
                                   VD3-HOBJ
                                   W03-COMPCODE
                                   W03-REASON
      *
      *        Test the output of the open call. If the call failed
      *        build an error message showing the completion code
      *        and reason
      *
               IF (W03-COMPCODE NOT = MQCC-OK) THEN
                   MOVE 'OPEN MAILQ'  TO VD0-MSG1-TYPE
                   MOVE W03-COMPCODE  TO VD0-MSG1-COMPCODE
                   MOVE W03-REASON    TO VD0-MSG1-REASON
                   MOVE VD0-MESSAGE-1 TO VD3-MSG
               END-IF
      *
           END-IF.
      *
       CREATE-MAIL-QUEUE-EXIT.
      *
      *    Return to performing section
      *
           EXIT.
           EJECT
      *
      * ------------------------------------------------------------- *
       FIND-MAIL-QUEUE-DEPTH SECTION.
      * ------------------------------------------------------------- *
      *                                                              *
      *  This section inquires on the users mail queue to find the   *
      *  number of messages on the queue.                            *
      *  It updates VD3-NUMMSG with this number                      *
      *                                                              *
      * ------------------------------------------------------------ *
      *
      *    Initialize the variables for the inquire call
      *
           MOVE MQIA-CURRENT-Q-DEPTH TO W03-SELECTORS.
           MOVE 1                    TO W03-SELECTORCOUNT.
           MOVE 1                    TO W03-INTATTRCOUNT.
           MOVE ZERO                 TO W03-CHARATTRLENGTH.
      *
      *    Inquire on the attributes
      *
           CALL 'MQINQ' USING VD3-HCONN
                              VD3-HOBJ
                              W03-SELECTORCOUNT
                              W03-SELECTORS-TABLE
                              W03-INTATTRCOUNT
                              W03-INTATTRS-TABLE
                              W03-CHARATTRLENGTH
                              W03-CHARATTRS
                              W03-COMPCODE
                              W03-REASON.
      *
      *    Test the output
      *      - If the completion code is not ok, build an error
      *        message showing the completion and reason codes
      *      - Otherwise, update the number of messages
      *
           IF W03-COMPCODE NOT = MQCC-OK THEN
               MOVE 'INQ DEPTH'   TO VD0-MSG1-TYPE
               MOVE W03-COMPCODE  TO VD0-MSG1-COMPCODE
               MOVE W03-REASON    TO VD0-MSG1-REASON
               MOVE VD0-MESSAGE-1 TO VD3-MSG
               MOVE ZERO          TO VD3-NUMMSG
           ELSE
               MOVE W03-INTATTRS  TO VD3-NUMMSG
           END-IF.
      *
       FIND-MAIL-QUEUE-DEPTH-EXIT.
      *
      *    Return to performing section
      *
           EXIT.
           EJECT
      *
      * ------------------------------------------------------------- *
       READ-MAIL SECTION.
      * ------------------------------------------------------------- *
      *                                                              *
      * This section calls the program which allows the user to      *
      * handle incoming mail                                         *
      *                                                              *
      * ------------------------------------------------------------ *
      *
           MOVE LENGTH OF VD3-MAIL-COMMAREA TO VD3-COMMAREA-LENGTH.
           EXEC CICS LINK
                     PROGRAM(W04-CSQ4CVD2)
                     COMMAREA(VD3-MAIL-COMMAREA)
                     LENGTH(VD3-COMMAREA-LENGTH)
           END-EXEC.
           MOVE DFHENTER TO EIBAID.
      *
       READ-MAIL-EXIT.
      *
      *    Return to performing section
      *
           EXIT.
           EJECT
      *
      * ------------------------------------------------------------- *
       SEND-MAIL SECTION.
      * ------------------------------------------------------------- *
      *                                                              *
      * This section calls the program which sends mail              *
      *                                                              *
      * ------------------------------------------------------------ *
      *
           MOVE LENGTH OF VD3-MAIL-COMMAREA TO VD3-COMMAREA-LENGTH.
           EXEC CICS LINK
                     PROGRAM(W04-CSQ4CVD4)
                     COMMAREA(VD3-MAIL-COMMAREA)
                     LENGTH(VD3-COMMAREA-LENGTH)
           END-EXEC.
           MOVE DFHENTER TO EIBAID.
      *
       SEND-MAIL-EXIT.
      *
      *    Return to performing section
      *
           EXIT.
           EJECT
      *
      * ------------------------------------------------------------- *
       CREATE-NICKNAME SECTION.
      * ------------------------------------------------------------- *
      *                                                              *
      * This section calls the program which controls nickname       *
      * creation                                                     *
      *                                                              *
      * ------------------------------------------------------------ *
      *
           MOVE LENGTH OF VD3-MAIL-COMMAREA TO VD3-COMMAREA-LENGTH.
           EXEC CICS LINK
                     PROGRAM(W04-CSQ4CVD5)
                     COMMAREA(VD3-MAIL-COMMAREA)
                     LENGTH(VD3-COMMAREA-LENGTH)
           END-EXEC.
           MOVE DFHENTER TO EIBAID.
      *
       CREATE-NICKNAME-EXIT.
      *
      *    Return to performing section
      *
           EXIT.
           EJECT
      *
      * ------------------------------------------------------------- *
       DISPLAY-MAPVD1 SECTION.
      * ------------------------------------------------------------- *
      *                                                              *
      *  This section sends the mail manager main menu (MAIL-VD1)    *
      *  to the terminal and returns once the receive is complete    *
      *                                                              *
      * ------------------------------------------------------------ *
      *
           EXEC CICS SEND
                     MAP(W04-CSQ4VD1)
                     MAPSET(W04-MAPSET-NAME)
                     FROM(CSQ4VD1O)
                     ERASE
           END-EXEC.
      *
           EXEC CICS RECEIVE
                     MAP(W04-CSQ4VD1)
                     MAPSET(W04-MAPSET-NAME)
                     INTO(CSQ4VD1O)
           END-EXEC.
      *
       DISPLAY-MAPVD1-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(W04-CSQ4VD6)
                           MAPSET(W04-MAPSET-NAME)
                           FROM(CSQ4VD6O)
                           ERASE
                 END-EXEC
      *
                 EXEC CICS RECEIVE
                           MAP(W04-CSQ4VD6)
                           MAPSET(W04-MAPSET-NAME)
                           INTO(CSQ4VD6I)
                 END-EXEC
      *
             END-PERFORM.
      *
       DISPLAY-HELP-EXIT.
      *
      *    Return to performing section
      *
           EXIT.
           EJECT
      *
      * ---------------------------------------------------------------
      *                  End of program
      * ---------------------------------------------------------------

¤ Dauer der Verarbeitung: 0.37 Sekunden (vorverarbeitet) ¤

Download des Quellennavigators
Download des sprechenden Kalenders
in der Quellcodebibliothek suchen

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.