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