The END-RECEIVE statement represents a fundamental component of message queue communication and inter-program communication in COBOL, serving as an explicit scope terminator that clearly defines the boundaries of RECEIVE statement blocks. This statement embodies modern communication principles by providing unambiguous termination points for message reception operations, enabling sophisticated error handling for communication scenarios, and supporting the development of robust distributed applications that require precise control over message queue operations and communication protocols.
In contemporary enterprise COBOL development, END-RECEIVE plays a vital role in creating sophisticated message-driven systems that must handle various communication protocols, message types, and error conditions. By providing explicit termination for RECEIVE blocks, this statement enables developers to implement comprehensive message processing logic while maintaining code clarity and ensuring that communication operations are properly bounded and controlled within the application's messaging flow.
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239IDENTIFICATION DIVISION. PROGRAM-ID. END-RECEIVE-DEMO. ENVIRONMENT DIVISION. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT MESSAGE-LOG ASSIGN TO 'MESSAGE.LOG' ORGANIZATION IS SEQUENTIAL ACCESS MODE IS SEQUENTIAL. DATA DIVISION. FILE SECTION. FD MESSAGE-LOG. 01 LOG-RECORD PIC X(200). WORKING-STORAGE SECTION. 01 COMMUNICATION-CONTROLS. 05 QUEUE-NAME PIC X(20) VALUE 'PROCESSING_QUEUE'. 05 MESSAGE-BUFFER PIC X(1000). 05 MESSAGE-LENGTH PIC 9(4) COMP. 05 MESSAGE-ID PIC X(24). 05 MESSAGE-TYPE PIC X(8). 05 SENDER-ID PIC X(10). 01 PROCESSING-COUNTERS. 05 MESSAGES-RECEIVED PIC 9(7) VALUE 0. 05 MESSAGES-PROCESSED PIC 9(7) VALUE 0. 05 MESSAGES-FAILED PIC 9(7) VALUE 0. 05 TIMEOUT-COUNT PIC 9(5) VALUE 0. 01 COMMUNICATION-FLAGS. 05 RECEIVE-STATUS PIC XX. 88 RECEIVE-SUCCESSFUL VALUE '00'. 88 RECEIVE-TIMEOUT VALUE '01'. 88 RECEIVE-ERROR VALUE '02' THRU '99'. 05 CONTINUE-PROCESSING PIC X VALUE 'Y'. 88 PROCESSING-ACTIVE VALUE 'Y'. 88 PROCESSING-STOPPED VALUE 'N'. 01 MESSAGE-PROCESSING. 05 PARSED-MESSAGE. 10 MSG-HEADER. 15 MSG-VERSION PIC X(2). 15 MSG-TIMESTAMP PIC X(14). 15 MSG-PRIORITY PIC 9(1). 15 MSG-CORRELATION-ID PIC X(16). 10 MSG-BODY PIC X(500). 05 PROCESSING-RESULT PIC X(50). PROCEDURE DIVISION. MAIN-PROCESSING. PERFORM INITIALIZE-COMMUNICATION PERFORM PROCESS-MESSAGE-QUEUE PERFORM FINALIZE-COMMUNICATION STOP RUN. INITIALIZE-COMMUNICATION. DISPLAY 'Initializing message queue communication...' OPEN OUTPUT MESSAGE-LOG *> Initialize message queue connection CALL 'INIT-QUEUE' USING QUEUE-NAME, RECEIVE-STATUS IF NOT RECEIVE-SUCCESSFUL DISPLAY 'Failed to initialize message queue: ' RECEIVE-STATUS STOP RUN END-IF DISPLAY 'Message queue initialized successfully' DISPLAY 'Queue name: ' QUEUE-NAME SET PROCESSING-ACTIVE TO TRUE. PROCESS-MESSAGE-QUEUE. DISPLAY 'Starting message processing loop...' PERFORM UNTIL PROCESSING-STOPPED PERFORM RECEIVE-SINGLE-MESSAGE IF RECEIVE-SUCCESSFUL PERFORM PROCESS-RECEIVED-MESSAGE ELSE PERFORM HANDLE-RECEIVE-ERROR END-IF *> Check if we should continue processing IF MESSAGES-FAILED > 10 DISPLAY 'Too many failed messages - stopping' SET PROCESSING-STOPPED TO TRUE END-IF IF TIMEOUT-COUNT > 5 DISPLAY 'Too many timeouts - stopping' SET PROCESSING-STOPPED TO TRUE END-IF END-PERFORM. RECEIVE-SINGLE-MESSAGE. INITIALIZE MESSAGE-BUFFER MOVE 0 TO MESSAGE-LENGTH *> Receive message with timeout RECEIVE MESSAGE-BUFFER FROM QUEUE-NAME INTO MESSAGE-BUFFER SIZE MESSAGE-LENGTH MESSAGE-ID MESSAGE-ID SENDER-ID SENDER-ID TIMEOUT 30 ON EXCEPTION EVALUATE RECEIVE-STATUS WHEN '01' DISPLAY 'Receive timeout occurred' ADD 1 TO TIMEOUT-COUNT WHEN '02' DISPLAY 'Queue empty' WHEN '03' DISPLAY 'Communication error' WHEN OTHER DISPLAY 'Unknown receive error: ' RECEIVE-STATUS END-EVALUATE NOT ON EXCEPTION ADD 1 TO MESSAGES-RECEIVED DISPLAY 'Message received successfully' DISPLAY 'Message ID: ' MESSAGE-ID DISPLAY 'Sender: ' SENDER-ID DISPLAY 'Length: ' MESSAGE-LENGTH END-RECEIVE. PROCESS-RECEIVED-MESSAGE. *> Parse message header MOVE MESSAGE-BUFFER(1:50) TO MSG-HEADER MOVE MESSAGE-BUFFER(51:500) TO MSG-BODY DISPLAY 'Processing message:' DISPLAY 'Version: ' MSG-VERSION DISPLAY 'Timestamp: ' MSG-TIMESTAMP DISPLAY 'Priority: ' MSG-PRIORITY DISPLAY 'Correlation ID: ' MSG-CORRELATION-ID *> Process based on message type EVALUATE MSG-VERSION WHEN '01' PERFORM PROCESS-VERSION-1-MESSAGE WHEN '02' PERFORM PROCESS-VERSION-2-MESSAGE WHEN OTHER DISPLAY 'Unsupported message version: ' MSG-VERSION ADD 1 TO MESSAGES-FAILED MOVE 'Unsupported version' TO PROCESSING-RESULT END-EVALUATE *> Log message processing PERFORM LOG-MESSAGE-PROCESSING. PROCESS-VERSION-1-MESSAGE. DISPLAY 'Processing version 1 message' *> Simulate message processing IF MSG-PRIORITY >= 5 DISPLAY 'High priority message processing' MOVE 'HIGH_PRIORITY_PROCESSED' TO PROCESSING-RESULT ELSE DISPLAY 'Normal priority message processing' MOVE 'NORMAL_PRIORITY_PROCESSED' TO PROCESSING-RESULT END-IF ADD 1 TO MESSAGES-PROCESSED. PROCESS-VERSION-2-MESSAGE. DISPLAY 'Processing version 2 message' *> Enhanced processing for version 2 IF MSG-CORRELATION-ID NOT = SPACES DISPLAY 'Correlated message processing' MOVE 'CORRELATED_PROCESSED' TO PROCESSING-RESULT ELSE DISPLAY 'Standalone message processing' MOVE 'STANDALONE_PROCESSED' TO PROCESSING-RESULT END-IF ADD 1 TO MESSAGES-PROCESSED. HANDLE-RECEIVE-ERROR. ADD 1 TO MESSAGES-FAILED DISPLAY 'Message receive error occurred' DISPLAY 'Error status: ' RECEIVE-STATUS *> Log error details STRING 'ERROR: ' DELIMITED BY SIZE 'Status=' RECEIVE-STATUS DELIMITED BY SIZE ' Time=' FUNCTION CURRENT-DATE DELIMITED BY SIZE INTO LOG-RECORD END-STRING WRITE LOG-RECORD *> Implement retry logic for certain errors IF RECEIVE-STATUS = '03' *> Communication error DISPLAY 'Attempting to reconnect...' CALL 'RECONNECT-QUEUE' USING QUEUE-NAME, RECEIVE-STATUS IF RECEIVE-SUCCESSFUL DISPLAY 'Reconnection successful' ELSE DISPLAY 'Reconnection failed' SET PROCESSING-STOPPED TO TRUE END-IF END-IF. LOG-MESSAGE-PROCESSING. STRING 'PROCESSED: ' DELIMITED BY SIZE 'ID=' MESSAGE-ID DELIMITED BY SIZE ' Sender=' SENDER-ID DELIMITED BY SIZE ' Result=' PROCESSING-RESULT DELIMITED BY SIZE ' Time=' FUNCTION CURRENT-DATE DELIMITED BY SIZE INTO LOG-RECORD END-STRING WRITE LOG-RECORD. FINALIZE-COMMUNICATION. *> Close message queue connection CALL 'CLOSE-QUEUE' USING QUEUE-NAME, RECEIVE-STATUS CLOSE MESSAGE-LOG DISPLAY 'Message processing completed' DISPLAY 'Statistics:' DISPLAY 'Messages received: ' MESSAGES-RECEIVED DISPLAY 'Messages processed: ' MESSAGES-PROCESSED DISPLAY 'Messages failed: ' MESSAGES-FAILED DISPLAY 'Timeout count: ' TIMEOUT-COUNT IF MESSAGES-RECEIVED > 0 COMPUTE MESSAGES-PROCESSED = (MESSAGES-PROCESSED / MESSAGES-RECEIVED) * 100 DISPLAY 'Success rate: ' MESSAGES-PROCESSED '%' END-IF.
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352IDENTIFICATION DIVISION. PROGRAM-ID. ADVANCED-END-RECEIVE. DATA DIVISION. WORKING-STORAGE SECTION. 01 MULTI-QUEUE-PROCESSING. 05 QUEUE-TABLE. 10 QUEUE-ENTRIES OCCURS 5 TIMES. 15 QUEUE-NAME PIC X(20). 15 QUEUE-STATUS PIC XX. 15 QUEUE-PRIORITY PIC 9(1). 15 MESSAGES-COUNT PIC 9(7). 05 CURRENT-QUEUE-INDEX PIC 9(1). 05 ACTIVE-QUEUES PIC 9(1) VALUE 5. 01 MESSAGE-ROUTING. 05 ROUTING-TABLE. 10 ROUTING-ENTRIES OCCURS 10 TIMES. 15 MESSAGE-PATTERN PIC X(20). 15 TARGET-HANDLER PIC X(20). 15 PRIORITY-LEVEL PIC 9(1). 05 ROUTING-INDEX PIC 9(2). 05 HANDLER-FOUND PIC X VALUE 'N'. 88 HANDLER-LOCATED VALUE 'Y'. 01 ADVANCED-MESSAGE-BUFFER. 05 EXTENDED-HEADER. 10 PROTOCOL-VERSION PIC X(4). 10 MESSAGE-CLASS PIC X(10). 10 SECURITY-TOKEN PIC X(32). 10 COMPRESSION-FLAG PIC X(1). 10 ENCRYPTION-FLAG PIC X(1). 10 ROUTING-INFO PIC X(50). 05 PAYLOAD-DATA PIC X(2000). 05 DIGITAL-SIGNATURE PIC X(128). 01 BATCH-PROCESSING-CONTROLS. 05 BATCH-SIZE PIC 9(4) VALUE 100. 05 CURRENT-BATCH-COUNT PIC 9(4) VALUE 0. 05 BATCH-TIMEOUT PIC 9(3) VALUE 60. 05 BATCH-START-TIME PIC X(14). 05 BATCH-PROCESSING-FLAG PIC X VALUE 'N'. 88 BATCH-ACTIVE VALUE 'Y'. 88 BATCH-COMPLETE VALUE 'N'. 01 ERROR-RECOVERY-SYSTEM. 05 ERROR-RECOVERY-TABLE. 10 ERROR-ENTRIES OCCURS 10 TIMES. 15 ERROR-CODE PIC XX. 15 RETRY-COUNT PIC 9(2). 15 RETRY-DELAY PIC 9(3). 15 MAX-RETRIES PIC 9(2). 05 CURRENT-ERROR-INDEX PIC 9(2). 05 RECOVERY-ACTIVE PIC X VALUE 'N'. 88 RECOVERY-IN-PROGRESS VALUE 'Y'. PROCEDURE DIVISION. MAIN-PROCESSING. PERFORM INITIALIZE-MULTI-QUEUE-SYSTEM PERFORM SETUP-MESSAGE-ROUTING PERFORM PROCESS-MULTI-QUEUE-MESSAGES PERFORM CLEANUP-MULTI-QUEUE-SYSTEM STOP RUN. INITIALIZE-MULTI-QUEUE-SYSTEM. DISPLAY 'Initializing multi-queue processing system...' *> Initialize queue table MOVE 'HIGH_PRIORITY_QUEUE' TO QUEUE-NAME(1) MOVE 'NORMAL_QUEUE' TO QUEUE-NAME(2) MOVE 'BATCH_QUEUE' TO QUEUE-NAME(3) MOVE 'ERROR_QUEUE' TO QUEUE-NAME(4) MOVE 'AUDIT_QUEUE' TO QUEUE-NAME(5) MOVE 9 TO QUEUE-PRIORITY(1) MOVE 5 TO QUEUE-PRIORITY(2) MOVE 3 TO QUEUE-PRIORITY(3) MOVE 1 TO QUEUE-PRIORITY(4) MOVE 1 TO QUEUE-PRIORITY(5) *> Initialize each queue PERFORM VARYING CURRENT-QUEUE-INDEX FROM 1 BY 1 UNTIL CURRENT-QUEUE-INDEX > ACTIVE-QUEUES CALL 'INIT-QUEUE' USING QUEUE-NAME(CURRENT-QUEUE-INDEX), QUEUE-STATUS(CURRENT-QUEUE-INDEX) IF QUEUE-STATUS(CURRENT-QUEUE-INDEX) = '00' DISPLAY 'Queue initialized: ' QUEUE-NAME(CURRENT-QUEUE-INDEX) ELSE DISPLAY 'Queue init failed: ' QUEUE-NAME(CURRENT-QUEUE-INDEX) END-IF END-PERFORM. SETUP-MESSAGE-ROUTING. DISPLAY 'Setting up message routing table...' MOVE 'ORDER_*' TO MESSAGE-PATTERN(1) MOVE 'ORDER_HANDLER' TO TARGET-HANDLER(1) MOVE 9 TO PRIORITY-LEVEL(1) MOVE 'PAYMENT_*' TO MESSAGE-PATTERN(2) MOVE 'PAYMENT_HANDLER' TO TARGET-HANDLER(2) MOVE 8 TO PRIORITY-LEVEL(2) MOVE 'INVENTORY_*' TO MESSAGE-PATTERN(3) MOVE 'INVENTORY_HANDLER' TO TARGET-HANDLER(3) MOVE 6 TO PRIORITY-LEVEL(3) MOVE 'REPORT_*' TO MESSAGE-PATTERN(4) MOVE 'REPORT_HANDLER' TO TARGET-HANDLER(4) MOVE 3 TO PRIORITY-LEVEL(4) MOVE 'AUDIT_*' TO MESSAGE-PATTERN(5) MOVE 'AUDIT_HANDLER' TO TARGET-HANDLER(5) MOVE 2 TO PRIORITY-LEVEL(5) DISPLAY 'Message routing configured'. PROCESS-MULTI-QUEUE-MESSAGES. DISPLAY 'Starting multi-queue message processing...' SET PROCESSING-ACTIVE TO TRUE PERFORM UNTIL PROCESSING-STOPPED PERFORM PROCESS-PRIORITY-QUEUES PERFORM CHECK-BATCH-PROCESSING PERFORM MONITOR-SYSTEM-HEALTH END-PERFORM. PROCESS-PRIORITY-QUEUES. *> Process queues in priority order PERFORM VARYING CURRENT-QUEUE-INDEX FROM 1 BY 1 UNTIL CURRENT-QUEUE-INDEX > ACTIVE-QUEUES IF QUEUE-STATUS(CURRENT-QUEUE-INDEX) = '00' PERFORM PROCESS-QUEUE-MESSAGES END-IF END-PERFORM. PROCESS-QUEUE-MESSAGES. MOVE 0 TO CURRENT-BATCH-COUNT PERFORM UNTIL CURRENT-BATCH-COUNT >= BATCH-SIZE PERFORM RECEIVE-QUEUE-MESSAGE IF RECEIVE-SUCCESSFUL PERFORM ROUTE-AND-PROCESS-MESSAGE ADD 1 TO CURRENT-BATCH-COUNT ADD 1 TO MESSAGES-COUNT(CURRENT-QUEUE-INDEX) ELSE *> No more messages in this queue EXIT PERFORM END-IF END-PERFORM. RECEIVE-QUEUE-MESSAGE. INITIALIZE ADVANCED-MESSAGE-BUFFER RECEIVE ADVANCED-MESSAGE-BUFFER FROM QUEUE-NAME(CURRENT-QUEUE-INDEX) INTO ADVANCED-MESSAGE-BUFFER SIZE MESSAGE-LENGTH MESSAGE-ID MESSAGE-ID TIMEOUT 5 ON EXCEPTION EVALUATE RECEIVE-STATUS WHEN '01' *> Timeout - normal for empty queue CONTINUE WHEN '02' *> Queue empty CONTINUE WHEN OTHER DISPLAY 'Receive error from queue: ' QUEUE-NAME(CURRENT-QUEUE-INDEX) DISPLAY 'Error status: ' RECEIVE-STATUS PERFORM HANDLE-QUEUE-ERROR END-EVALUATE NOT ON EXCEPTION DISPLAY 'Message received from: ' QUEUE-NAME(CURRENT-QUEUE-INDEX) DISPLAY 'Message class: ' MESSAGE-CLASS DISPLAY 'Protocol version: ' PROTOCOL-VERSION END-RECEIVE. ROUTE-AND-PROCESS-MESSAGE. *> Find appropriate handler based on message class SET HANDLER-LOCATED TO FALSE PERFORM VARYING ROUTING-INDEX FROM 1 BY 1 UNTIL ROUTING-INDEX > 10 OR HANDLER-LOCATED IF MESSAGE-CLASS MATCHES MESSAGE-PATTERN(ROUTING-INDEX) SET HANDLER-LOCATED TO TRUE DISPLAY 'Routing to handler: ' TARGET-HANDLER(ROUTING-INDEX) PERFORM INVOKE-MESSAGE-HANDLER END-IF END-PERFORM IF NOT HANDLER-LOCATED DISPLAY 'No handler found for message class: ' MESSAGE-CLASS PERFORM SEND-TO-ERROR-QUEUE END-IF. INVOKE-MESSAGE-HANDLER. EVALUATE TARGET-HANDLER(ROUTING-INDEX) WHEN 'ORDER_HANDLER' PERFORM PROCESS-ORDER-MESSAGE WHEN 'PAYMENT_HANDLER' PERFORM PROCESS-PAYMENT-MESSAGE WHEN 'INVENTORY_HANDLER' PERFORM PROCESS-INVENTORY-MESSAGE WHEN 'REPORT_HANDLER' PERFORM PROCESS-REPORT-MESSAGE WHEN 'AUDIT_HANDLER' PERFORM PROCESS-AUDIT-MESSAGE WHEN OTHER DISPLAY 'Unknown handler: ' TARGET-HANDLER(ROUTING-INDEX) PERFORM SEND-TO-ERROR-QUEUE END-EVALUATE. PROCESS-ORDER-MESSAGE. DISPLAY 'Processing order message...' *> Decrypt if necessary IF ENCRYPTION-FLAG = 'Y' CALL 'DECRYPT-MESSAGE' USING PAYLOAD-DATA, SECURITY-TOKEN END-IF *> Decompress if necessary IF COMPRESSION-FLAG = 'Y' CALL 'DECOMPRESS-MESSAGE' USING PAYLOAD-DATA END-IF *> Process order logic CALL 'PROCESS-ORDER' USING PAYLOAD-DATA, PROCESSING-RESULT DISPLAY 'Order processing result: ' PROCESSING-RESULT. PROCESS-PAYMENT-MESSAGE. DISPLAY 'Processing payment message...' *> Validate digital signature CALL 'VERIFY-SIGNATURE' USING PAYLOAD-DATA, DIGITAL-SIGNATURE, PROCESSING-RESULT IF PROCESSING-RESULT = 'SIGNATURE_VALID' CALL 'PROCESS-PAYMENT' USING PAYLOAD-DATA, PROCESSING-RESULT DISPLAY 'Payment processing result: ' PROCESSING-RESULT ELSE DISPLAY 'Invalid digital signature - rejecting payment' PERFORM SEND-TO-ERROR-QUEUE END-IF. PROCESS-INVENTORY-MESSAGE. DISPLAY 'Processing inventory message...' CALL 'UPDATE-INVENTORY' USING PAYLOAD-DATA, PROCESSING-RESULT DISPLAY 'Inventory update result: ' PROCESSING-RESULT. PROCESS-REPORT-MESSAGE. DISPLAY 'Processing report message...' *> Check if batch processing is needed IF MESSAGE-CLASS = 'REPORT_BATCH' SET BATCH-ACTIVE TO TRUE MOVE FUNCTION CURRENT-DATE TO BATCH-START-TIME END-IF CALL 'GENERATE-REPORT' USING PAYLOAD-DATA, PROCESSING-RESULT DISPLAY 'Report generation result: ' PROCESSING-RESULT. PROCESS-AUDIT-MESSAGE. DISPLAY 'Processing audit message...' CALL 'LOG-AUDIT-EVENT' USING PAYLOAD-DATA, PROCESSING-RESULT DISPLAY 'Audit logging result: ' PROCESSING-RESULT. SEND-TO-ERROR-QUEUE. DISPLAY 'Sending message to error queue...' SEND ADVANCED-MESSAGE-BUFFER TO QUEUE-NAME(4) *> Error queue MESSAGE-ID MESSAGE-ID ON EXCEPTION DISPLAY 'Failed to send to error queue' NOT ON EXCEPTION DISPLAY 'Message sent to error queue' END-SEND. HANDLE-QUEUE-ERROR. DISPLAY 'Handling queue error for: ' QUEUE-NAME(CURRENT-QUEUE-INDEX) *> Mark queue as problematic MOVE '99' TO QUEUE-STATUS(CURRENT-QUEUE-INDEX) *> Attempt recovery CALL 'RECOVER-QUEUE' USING QUEUE-NAME(CURRENT-QUEUE-INDEX), QUEUE-STATUS(CURRENT-QUEUE-INDEX) IF QUEUE-STATUS(CURRENT-QUEUE-INDEX) = '00' DISPLAY 'Queue recovery successful' ELSE DISPLAY 'Queue recovery failed' END-IF. CHECK-BATCH-PROCESSING. IF BATCH-ACTIVE *> Check if batch timeout reached CALL 'CHECK-TIMEOUT' USING BATCH-START-TIME, BATCH-TIMEOUT, PROCESSING-RESULT IF PROCESSING-RESULT = 'TIMEOUT' DISPLAY 'Batch timeout reached - processing batch' PERFORM PROCESS-BATCH-COMPLETION SET BATCH-COMPLETE TO TRUE END-IF END-IF. PROCESS-BATCH-COMPLETION. DISPLAY 'Processing batch completion...' CALL 'FINALIZE-BATCH' USING BATCH-START-TIME, PROCESSING-RESULT DISPLAY 'Batch finalization result: ' PROCESSING-RESULT. MONITOR-SYSTEM-HEALTH. *> Check overall system health CALL 'CHECK-SYSTEM-HEALTH' USING PROCESSING-RESULT IF PROCESSING-RESULT = 'SYSTEM_OVERLOADED' DISPLAY 'System overloaded - reducing processing rate' CALL 'SYSTEM-DELAY' USING 1000 *> 1 second delay END-IF IF PROCESSING-RESULT = 'SYSTEM_CRITICAL' DISPLAY 'System critical - stopping processing' SET PROCESSING-STOPPED TO TRUE END-IF. CLEANUP-MULTI-QUEUE-SYSTEM. DISPLAY 'Cleaning up multi-queue system...' *> Close all queues PERFORM VARYING CURRENT-QUEUE-INDEX FROM 1 BY 1 UNTIL CURRENT-QUEUE-INDEX > ACTIVE-QUEUES CALL 'CLOSE-QUEUE' USING QUEUE-NAME(CURRENT-QUEUE-INDEX), QUEUE-STATUS(CURRENT-QUEUE-INDEX) END-PERFORM DISPLAY 'Multi-queue system cleanup completed' DISPLAY 'Final message counts:' PERFORM VARYING CURRENT-QUEUE-INDEX FROM 1 BY 1 UNTIL CURRENT-QUEUE-INDEX > ACTIVE-QUEUES DISPLAY QUEUE-NAME(CURRENT-QUEUE-INDEX) ': ' MESSAGES-COUNT(CURRENT-QUEUE-INDEX) END-PERFORM.