Skip to content

CODATE01

Source: app-vsam-mq/cbl/CODATE01.cbl

Type: CICS transaction program

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 issues EXEC CICS RETRIEVE to 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 to CARD.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 initial 3000-GET-REQUEST, and loops on 4000-MAIN-PROCESS until NO-MORE-MSGS is set.

  • 4000-MAIN-PROCESS issues a CICS SYNCPOINT (commits unit of work) then calls 3000-GET-REQUEST again to fetch the next message — this is the read loop.

  • 3000-GET-REQUEST calls MQGET against 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. If MQRC-NO-MSG-AVAILABLE is returned, it sets NO-MORE-MSGS to end the loop. Any other non-OK condition triggers 9000-ERROR and 8000-TERMINATION.

  • 4000-PROCESS-REQUEST-REPLY captures the current date/time using EXEC CICS ASKTIME and EXEC CICS FORMATTIME (format MM-DD-YYYY, time with separator), builds a reply string "SYSTEM DATE : SYSTEM TIME : ", and calls 4100-PUT-REPLY.

  • 4100-PUT-REPLY calls MQPUT to 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 trigger 9000-ERROR and 8000-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), issues EXEC CICS RETURN END, and GOBACKs. This paragraph is called from many error paths throughout the program, so it acts as a common exit point.

Inputs & outputs

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 RETRIEVE of the triggering MQTM structure — 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-QUEUE itself performs 9000-ERROR on failure, which in turn could invoke 8000-TERMINATION again — since 8000-TERMINATION already 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 redundant 9000-ERROR/termination calls).

  • Fixed buffer/message sizes: buffers (MQ-BUFFER, REQUEST-MESSAGE, REPLY-MESSAGE, ERROR-MESSAGE) are all fixed at PIC X(1000); larger MQ messages would be truncated silently (no length validation beyond MQ-BUFFER-LENGTH = 1000 fixed).

  • WAIT interval of 5 seconds is hard-coded (MQGMO-WAITINTERVAL = 5000 ms) for MQGET; 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 fields WS-FUNC, WS-KEY, WS-FILLER), but the source shown does not appear to use WS-FUNC/WS-KEY values 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