|
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.75 Sekunden
(vorverarbeitet)
¤
|
schauen Sie vor die Tür
Fenster
Die Firma ist wie angegeben erreichbar.
Die farbliche Syntaxdarstellung ist noch experimentell.
|
