Quelle  csq4cvd1.cob   Sprache: Cobol

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
      * ---------------------------------------------------------------