CODATE01
Source: app-vsam-mq/cbl/CODATE01.cbl
Type: CICS transaction program
CODATE01 — Program Documentation
Purpose
CODATE01 is a CICS transaction that acts as an MQ-based "date/time server." It listens on an MQ queue for incoming request messages, and for each request replies with the current system date and time (as formatted by CICS) via a reply-to queue. It appears to be a simple demo/utility service (queue names reference "CARD.DEMO") used to test or support request/reply messaging patterns rather than perform core business processing.
How it works
- 1000-CONTROL (main entry) initializes working storage, opens the error queue (
2100-OPEN-ERROR-QUEUE), then issuesEXEC CICS RETRIEVEto obtain the name of the queue that triggered the transaction (MQTM-QNAME). If retrieval succeeds, the input queue name is set from the triggering queue and the reply queue name is hard-coded toCARD.DEMO.REPLY.DATE. If the retrieve fails, the program logs an error and terminates. - It then opens the input queue (
2300-OPEN-INPUT-QUEUE) and output/reply queue (2400-OPEN-OUTPUT-QUEUE), performs an initial3000-GET-REQUEST, and loops on4000-MAIN-PROCESSuntilNO-MORE-MSGSis set. - 4000-MAIN-PROCESS issues a CICS
SYNCPOINT(commits unit of work) then calls3000-GET-REQUESTagain to fetch the next message — this is the read loop. - 3000-GET-REQUEST calls
MQGETagainst the input queue with a 5-second wait interval (MQGMO-WAIT,MQGMO-WAITINTERVAL= 5000 ms), syncpoint and convert options. On success it saves the message ID, correlation ID, and reply-to-queue name, then performs 4000-PROCESS-REQUEST-REPLY. IfMQRC-NO-MSG-AVAILABLEis returned, it setsNO-MORE-MSGSto end the loop. Any other non-OK condition triggers9000-ERRORand8000-TERMINATION. - 4000-PROCESS-REQUEST-REPLY captures the current date/time using
EXEC CICS ASKTIMEandEXEC CICS FORMATTIME(formatMM-DD-YYYY, time with separator), builds a reply string"SYSTEM DATE : <date>SYSTEM TIME : <time>", and calls 4100-PUT-REPLY. - 4100-PUT-REPLY calls
MQPUTto place the reply message on the output/reply queue, reusing the saved message ID and correlation ID from the original request so the requester can correlate the reply. Errors here trigger9000-ERRORand8000-TERMINATION. - 9000-ERROR puts a formatted error message (queue name, condition/reason codes, return message) onto the error queue via
MQPUT. If that put itself fails, it displays the error and terminates. - 8000-TERMINATION closes any open queues (
5000-CLOSE-INPUT-QUEUE,5100-CLOSE-OUTPUT-QUEUE,5200-CLOSE-ERROR-QUEUE, guarded by status flags), issuesEXEC CICS RETURN END, andGOBACKs. This paragraph is called from many error paths throughout the program, so it acts as a common exit point.
Inputs & outputs
| Resource | Type | Purpose |
|---|---|---|
Input queue (name from MQTM-QNAME via EXEC CICS RETRIEVE) |
MQ queue | Source of incoming request messages; opened shared for input (MQOO-INPUT-SHARED). |
CARD.DEMO.REPLY.DATE (hard-coded) |
MQ queue | Output queue where date/time reply messages are put; opened for output with pass-all-context. |
CARD.DEMO.ERROR (hard-coded) |
MQ queue | Error queue where diagnostic messages (MQ-ERR-DISPLAY) are put when failures occur. |
MQ message descriptor / options copybooks (CMQGMOV, CMQPMOV, CMQMDV, CMQODV, CMQV, CMQTML) |
Copybooks | Standard IBM MQ structures for get/put options, message descriptor, object descriptor, constants, and the trigger message layout (MQTM). |
CICS system clock (ASKTIME/FORMATTIME) |
CICS service | Source of the date/time returned to the requester; no external file or database is read. |
No VSAM files, DB2 tables, or other datasets are used — sql_tables and files are empty in the parsed facts, and the source confirms all I/O is via MQ calls and CICS services only.
Things to know
- Hard-coded queue names: the reply queue (
CARD.DEMO.REPLY.DATE) and error queue (CARD.DEMO.ERROR) are literal constants in the code (1000-CONTROL and 2100-OPEN-ERROR-QUEUE). Changing environments (e.g., test vs. prod queue managers) requires a code change/recompile, not configuration. - Trigger-driven queue name: the input queue name is not hard-coded but comes from the CICS
RETRIEVEof the triggeringMQTMstructure — this program is designed to be started by an MQ trigger monitor, not run standalone. - 8000-TERMINATION is a shared exit point invoked from nearly every error branch (MQOPEN, MQGET, MQPUT, MQCLOSE failures) as well as normal completion — this is a common but somewhat risky COBOL pattern where the same paragraph handles both graceful shutdown and abnormal termination, with no differentiation in return code shown to the caller/CICS beyond queue closes.
- Nested error handling calls:
5200-CLOSE-ERROR-QUEUEitself performs9000-ERRORon failure, which in turn could invoke8000-TERMINATIONagain — since8000-TERMINATIONalready may have been in progress, this suggests potential re-entrancy/recursion risk if a close on the error queue fails during termination (not fully guarded against by the status flags, which only prevent redundant closes, not redundant9000-ERROR/termination calls). - Fixed buffer/message sizes: buffers (
MQ-BUFFER,REQUEST-MESSAGE,REPLY-MESSAGE,ERROR-MESSAGE) are all fixed atPIC X(1000); larger MQ messages would be truncated silently (no length validation beyondMQ-BUFFER-LENGTH= 1000 fixed). - WAIT interval of 5 seconds is hard-coded (
MQGMO-WAITINTERVAL= 5000 ms) forMQGET; this governs how long the transaction waits for a message before treating it as "no more messages" and looping out — not configurable externally. - No SQL/database use — this program only interacts with MQ and CICS services; it does not read/write any VSAM file or DB2 table despite being grouped under
app-vsam-mq. - REQUEST-MSG-COPY layout parsed but not used: The program moves the incoming request into
REQUEST-MSG-COPY(with fieldsWS-FUNC,WS-KEY,WS-FILLER), but the source shown does not appear to useWS-FUNC/WS-KEYvalues to branch logic — the reply is always the same date/time string regardless of request content. This may indicate incomplete/demo logic, or logic omitted from the excerpt. - Error display format is fixed (
MQ-ERR-DISPLAY) with condition code as 2-digit and reason code as 5-digit numeric edited fields — large/negative MQ codes could display unexpectedly if they don't fit these picture clauses.
CICS commands
RETRIEVE, ASKTIME, FORMATTIME, RETURN END
Copybooks
CMQGMOV, CMQMDV, CMQODV, CMQPMOV, CMQTML, CMQV, REPLACING
Calls
MQCLOSE, MQGET, MQOPEN, MQPUT
Paragraph flow
flowchart TD
1000_CONTROL["1000-CONTROL"]
2300_OPEN_INPUT_QUEUE["2300-OPEN-INPUT-QUEUE"]
2400_OPEN_OUTPUT_QUEUE["2400-OPEN-OUTPUT-QUEUE"]
2100_OPEN_ERROR_QUEUE["2100-OPEN-ERROR-QUEUE"]
4000_MAIN_PROCESS["4000-MAIN-PROCESS"]
3000_GET_REQUEST["3000-GET-REQUEST"]
4000_PROCESS_REQUEST_REPLY["4000-PROCESS-REQUEST-REPLY"]
4100_PUT_REPLY["4100-PUT-REPLY"]
9000_ERROR["9000-ERROR"]
8000_TERMINATION["8000-TERMINATION"]
5000_CLOSE_INPUT_QUEUE["5000-CLOSE-INPUT-QUEUE"]
5100_CLOSE_OUTPUT_QUEUE["5100-CLOSE-OUTPUT-QUEUE"]
5200_CLOSE_ERROR_QUEUE["5200-CLOSE-ERROR-QUEUE"]
1000_CONTROL --> 2100_OPEN_ERROR_QUEUE
1000_CONTROL --> 2300_OPEN_INPUT_QUEUE
1000_CONTROL --> 2400_OPEN_OUTPUT_QUEUE
1000_CONTROL --> 3000_GET_REQUEST
1000_CONTROL --> 4000_MAIN_PROCESS
1000_CONTROL --> 8000_TERMINATION
1000_CONTROL --> 9000_ERROR
2100_OPEN_ERROR_QUEUE --> 8000_TERMINATION
2300_OPEN_INPUT_QUEUE --> 8000_TERMINATION
2300_OPEN_INPUT_QUEUE --> 9000_ERROR
2400_OPEN_OUTPUT_QUEUE --> 8000_TERMINATION
2400_OPEN_OUTPUT_QUEUE --> 9000_ERROR
3000_GET_REQUEST --> 4000_PROCESS_REQUEST_REPLY
3000_GET_REQUEST --> 8000_TERMINATION
3000_GET_REQUEST --> 9000_ERROR
4000_MAIN_PROCESS --> 3000_GET_REQUEST
4000_PROCESS_REQUEST_REPLY --> 4100_PUT_REPLY
4100_PUT_REPLY --> 8000_TERMINATION
4100_PUT_REPLY --> 9000_ERROR
5000_CLOSE_INPUT_QUEUE --> 8000_TERMINATION
5100_CLOSE_OUTPUT_QUEUE --> 8000_TERMINATION
5200_CLOSE_ERROR_QUEUE --> 8000_TERMINATION
5200_CLOSE_ERROR_QUEUE --> 9000_ERROR
8000_TERMINATION --> 5000_CLOSE_INPUT_QUEUE
8000_TERMINATION --> 5100_CLOSE_OUTPUT_QUEUE
8000_TERMINATION --> 5200_CLOSE_ERROR_QUEUE
9000_ERROR --> 8000_TERMINATION
Paragraphs
| Paragraph | Line | Performs |
|---|---|---|
| 1000-CONTROL | 127 | 2100-OPEN-ERROR-QUEUE, 9000-ERROR, 8000-TERMINATION, 2300-OPEN-INPUT-QUEUE, 2400-OPEN-OUTPUT-QUEUE, 3000-GET-REQUEST |
| 2300-OPEN-INPUT-QUEUE | 171 | 9000-ERROR, 8000-TERMINATION |
| 2400-OPEN-OUTPUT-QUEUE | 204 | 9000-ERROR, 8000-TERMINATION |
| 2100-OPEN-ERROR-QUEUE | 238 | 8000-TERMINATION |
| 4000-MAIN-PROCESS | 274 | 3000-GET-REQUEST |
| 3000-GET-REQUEST | 283 | 4000-PROCESS-REQUEST-REPLY, 9000-ERROR, 8000-TERMINATION |
| 4000-PROCESS-REQUEST-REPLY | 339 | 4100-PUT-REPLY |
| 4100-PUT-REPLY | 366 | 9000-ERROR, 8000-TERMINATION |
| 9000-ERROR | 405 | 8000-TERMINATION |
| 8000-TERMINATION | 442 | 5000-CLOSE-INPUT-QUEUE, 5100-CLOSE-OUTPUT-QUEUE, 5200-CLOSE-ERROR-QUEUE |
| 5000-CLOSE-INPUT-QUEUE | 456 | 8000-TERMINATION |
| 5100-CLOSE-OUTPUT-QUEUE | 478 | 8000-TERMINATION |
| 5200-CLOSE-ERROR-QUEUE | 501 | 9000-ERROR, 8000-TERMINATION |