S0C4 x'4' abend while reading VSAM KSDS file
in [Cobol]
|
From: Anonymous on 20 Jun 2008 11:42 In article <284af19c-3f88-4348-9e4a-2628dd841062(a)34g2000hsf.googlegroups.com>, <vbarathee(a)gmail.com> wrote: >Hi > >Give me some time to run the program without ILBOWATO module. No problem... anything worth doing takes time to do. > >The enhancement work came to us a month back. How many years ago was the unenhanced version outsourced to you? > >Could please explain me the reason behind why we need to run the >program without ILBOWATO , I'm sorry I'm confused. Bcoz the logic wud >change if we remove the traces of ILBOWATO . The reason for testing the program without ILBOWAT0 is that the program is blowing up when you include it. The program's logic will need to be changed to comply with the enhancement request... the question becomes what, *exactly*, needs to be changed. In order to determine what, exactly, needs to be changed testing needs to be done; I look forward to learning the results. DD
From: vbarathee on 21 Jun 2008 01:11 Hi I would like to share some more information regarding this issue. The original code which came to us before the enhancement contains the ILBOWATO module , it had only the PS file and the program just reads the PS file and writes into MQ , it was goin thru the wait time logic too and successfully running. As part of the enhancement we were told to include the VSAM file as another input and to get some more account number details from the KSDS file with account number as primary key. If the details were present it would write along with those PS file details into MQ , if not it should move spaces instead. After including the VSAM file in the program it gets abend when it goes into wait time logic. Since i'm not able to work from home , i cannot test the code as u mentioned at the earliest ,kindly wait for my reply. Thank u all , for ur efforts put towards my clarification. Regards, Barathi.v
From: Anonymous on 21 Jun 2008 07:47 In article <8f294bb3-60b9-48ca-a2a8-7e97cd20178c(a)c58g2000hsc.googlegroups.com>, <vbarathee(a)gmail.com> wrote: >Hi > >I would like to share some more information regarding this issue. > >The original code which came to us before the enhancement contains the >ILBOWATO module , it had only the PS file and the program just reads >the PS file and writes into MQ , it was goin thru the wait time logic >too and successfully running. This seemed readily apparent. Second request: how many years ago was the original source outsourced to you? [snip] >Since i'm not able to work from home , i cannot test the code as u >mentioned at the earliest ,kindly wait for my reply. As mentioned, doing anything worthwhile takes time. DD
From: vbarathee on 23 Jun 2008 02:09 Hi Please find the code below , where the enhancement changes done by me will be prefixed by % symbol , this was the original code when the program got abended when put into production. Since its official and due to some security reasons i was reluctant to post the code previously. IDENTIFICATION DIVISION. * THIS PROGRAM WILL READ THE INPUT FILE CONTAINING MQ FORMAT * RECORDS AND WRITES TO THE MQ SERIES * * NOTE: TO COMPILE/LINKEDIT THE PROGRAM IN ENDEVOR * USE COBPARM CARD WITH NODYNAM COMPILER OPTION * AND LINKSET CARD TO STATICALLY INCLUDE CSQBSTUB EJECT ENVIRONMENT DIVISION. * INPUT-OUTPUT SECTION. FILE-CONTROL. * SELECT MQFORM-FILE ASSIGN TO MQFORMFL FILE STATUS IS WS-MQFORM-STATUS. SELECT WAITPARM ASSIGN TO UT-S-WAITPARM. %SELECT DSCCQNMN-FILE ASSIGN TO DSCCQNMN % ORGANIZATION IS INDEXED % ACCESS MODE IS RANDOM % RECORD KEY IS QNMN-ACCT-NBR % FILE STATUS IS WS-DSCCQNMN-STATUS. * DATA DIVISION. FILE SECTION. * FD MQFORM-FILE RECORDING MODE IS F BLOCK CONTAINS 0 RECORDS LABEL RECORDS ARE STANDARD. * %01 MQ-INPUT-RECORD. % 05 MQFORM-RECORD PIC X(750). % 05 MQ-QUEUE-NAME PIC X(30). % 05 MQ-DATE PIC X(06). % 05 FILLER PIC X(14). * %FD DSCCQNMN-FILE % RECORD CONTAINS 100 CHARACTERS % LABEL RECORDS ARE STANDARD. %COPY DSCCQNMN. * FD WAITPARM LABEL RECORDS ARE STANDARD RECORDING MODE IS F BLOCK CONTAINS 0 RECORDS. 01 WAIT-PARM-REC PIC X(80). * WORKING-STORAGE SECTION. * 01 FILLER PIC X(36) VALUE 'DHMQTEST WORKING STORAGE STARTS HERE'. * **************************************************************** *C C O M M O N W O R K A R E A S **************************************************************** * 01 WS-LITERALS. 05 WS-LIT-QUEUE-NAME PIC X(20) * VALUE 'HNCDSCVR.LQ.FCMSHIGH'. VALUE 'HNCDSCVR.LQ.FCMSLOW'. * VALUE 'HNCDSCVR.LQ.VOLLOW'. 05 WS-LIT-YES PIC X(01) VALUE 'Y'. 05 WS-LIT-NO PIC X(01) VALUE 'N'. * 01 WS-VARIABLES. 05 WS-CNT PIC 9(07). 05 WS-MQ-CHECK-CNT PIC 9(06). 05 WS-WRITE-CNT PIC 9(07). 05 WS-DISPLAY-CNT PIC 9(02). 05 WS-MQ-FULL PIC X(01). 05 WS-NBR-ATTEMPTS PIC 9(01). 05 WAIT-MODULE PIC X(8) VALUE 'ILBOWAT0'. 05 WS-WAIT-TIME PIC S9(8) COMP. * **************************************************************** *C C O N S T A N T S **************************************************************** * 01 WS-CONSTANTS. 05 WS-ERROR-FLAG PIC X(01) VALUE 'N'. 88 WS-ERROR-FOUND VALUE 'Y'. 05 WS-EOF-FLAG PIC X(01) VALUE 'N'. 88 WS-EOF VALUE 'Y'. 05 WS-FIRST-READ-FLAG PIC X(01) VALUE 'N'. 88 WS-FIRST-RECORD VALUE 'Y'. 05 MQ-CONNECT-FLAG PIC X(01) VALUE 'N'. 88 MQ-CONNECTED VALUE 'Y'. 88 MQ-NOT-CONNECTED VALUE 'N'. 05 WS-ONE PIC S9(01) VALUE +1. 01 STATUS-VARIABLES. 05 WS-MQFORM-STATUS PIC X(02). 88 SUCCESSFUL-IO VALUE '00', '02', '97'. 88 END-OF-FILE VALUE '10'. 88 RECORD-NOT-FOUND VALUE '23'. 05 WS-DSCCQNMN-STATUS PIC X(02). 88 WS-SUCCESSFUL-IO VALUE '00','97'. 88 WS-RECORD-NOT-FOUND VALUE '23'. **************************************************************** *C E R R O R M E S S A G E S **************************************************************** * 01 ERROR-MESSAGES. 05 ERROR-OPENING-INPUT-FILE PIC X(58) VALUE '*** ERROR OPENING INPUT FILE *** '. 05 ERROR-OPENING-DSCCQNMN-FILE PIC X(58) VALUE '*** ERROR OPENING DSCCQNMN FILE *** '. 05 ERROR-READING-INPUT-FILE PIC X(58) VALUE '*** ERROR READING INPUT FILE *** '. 05 ERROR-IN-QMGR-NAME PIC X(58) VALUE '*** QUEUE MANAGER NAME INVALID IN PARM *** '. 05 ERROR-EMPTY-INPUT-FILE PIC X(58) VALUE '*** INPUT FILE IS EMPTY *** '. 05 MISSING-WAIT-PARM PIC X(58) VALUE '*** WAIT PARM FILE IS EMPTY *** '. 05 BAD-WAIT-PARMS PIC X(58) VALUE '*** NON-NUMERIC DATA IN PARM FILE *** '. 01 MQ-DEPTH-MESSAGE. 05 FILLER PIC X(14) VALUE '### MQ DEPTH: '. 05 WS-DISP-DEPTH PIC Z(8)9. 05 FILLER PIC X(18) VALUE ' RECORDS WRITTEN: '. 05 WS-DISP-WRITTEN PIC Z(8)9. 05 FILLER PIC X(02) VALUE SPACE. 05 WS-HH PIC 99. 05 FILLER PIC X(01) VALUE ':'. 05 WS-MM PIC 99. 05 FILLER PIC X(01) VALUE ':'. 05 WS-SS PIC 99. 01 RETURN-STATUS PIC S9(6) COMP. 01 ERROR-MESSAGE PIC X(58). 01 WS-RETURN-CODE PIC 9(06). 01 WS-CURRENT-TIME PIC 9(08). 01 WS-WAIT-PARMS. 05 WS-RECORDS-TO-SKIP PIC 9(07). 05 FILLER PIC X. 05 WS-SECONDS-TO-WAIT PIC 9(04). 05 FILLER PIC X. 05 WS-MQ-THRESHOLD PIC 9(07). 05 FILLER PIC X(60). * **************************************************************** *C M Q V A R I A B L E S **************************************************************** * 01 MQ-API-VARIABLES. 05 MQM-OPTIONS PIC S9(09) BINARY. 05 MQM-OBJECT-HANDLE PIC S9(09) BINARY. 05 MQM-COMPLETION-CODE PIC S9(09) BINARY. 05 MQM-REASON-CODE PIC S9(09) BINARY. * 01 WS-QUEUE-MANAGER. 05 WS-Q-MGRNAME PIC X(04). 05 FILLER PIC X(44) VALUE SPACES. * ** MQ PUT MESSAGE OPTIONS 01 MQM-PUT-MESSAGE-OPTIONS. COPY CMQPMOV. * *** MQ CONSTANTS 01 WS-MQ-CONSTANTS. COPY CMQV. COPY DHCCMQC0. * *** MQ API CONTROL BLOCKS 01 MQM-OBJECT-DESCRIPTOR. COPY CMQODV. * *** MQ INTERFACE 01 MQ-INTERFACE. COPY DHCCMQI0. COPY CMQMDV. * * 01 SELECTOR-COUNT PIC S9(9) COMP. 01 INT-ATTR-COUNT PIC S9(9) COMP. 01 INT-ATTRS PIC S9(9) COMP. 01 CHAR-ATTR-LENGTH PIC S9(9) COMP. 01 CHAR-ATTRS PIC X(01). 01 SELECTORS PIC S9(9) COMP. 01 WS-MQ-HCONN PIC S9(9) COMP. 01 DEPTH-LIMIT PIC S9(9) COMP VALUE 200. 01 MQ-DEPTH PIC S9(9) COMP. * *01 LK-API-REQ-MESSAGE PIC X(4194304). %*01 LK-API-REQ-MESSAGE PIC X(750). % 01 LK-API-REQ-MESSAGE PIC X(800). *01 LK-API-REQ-MESSAGE PIC X(919). *01 LK-API-REQ-MESSAGE PIC X(922). EJECT * LINKAGE SECTION. * *C THIS IS A PARM FOR THE MQ QUEUE MANAGER * 01 PARMDATA. 05 FILLER PIC S9(03) BINARY. 05 WS-PARM-QMGR PIC X(04). * ************************************************************** PROCEDURE DIVISION USING PARMDATA. * 1000-MAINLINE SECTION. **************************************************************** *C THIS SECTION CONTROLS THE MAIN PROCESSING OF THE PROGRAM. *C IT CALLS SECTIONS TO: *C - INITIALIZE PROGRAM VARIABLES *C - READS THE INPUT FILE AND CALLS MQ SERIES *C - TERMINATE THE PROGRAM. **************************************************************** * PERFORM 2000-HOUSEKEEPING THRU 2000-EXIT. PERFORM 3000-RETRIEVE-ACCEPTED THRU 3000-EXIT UNTIL WS-EOF OR WS-ERROR-FOUND. PERFORM 9000-TERMINATION THRU 9000-EXIT. * 1000-EXIT. GOBACK. * 2000-HOUSEKEEPING. ************************************************************** *C THIS SECTION INITIALIZES THE PROGRAM VARIABLES, CONNECTS *C TO THE MQ MANGR, OPENS THE MQ QUEUE, OPENS THE FILE, AND *C READS THE FIRST RECORD OF THE INPUT FILE. ************************************************************** * INITIALIZE WS-VARIABLES. * * ACCEPTS THE PARM FOR MQ MANAGER... * IF WS-PARM-QMGR = SPACES OR LOW-VALUES MOVE ERROR-IN-QMGR-NAME TO ERROR-MESSAGE MOVE 8 TO WS-RETURN-CODE SET MQ-NOT-CONNECTED TO TRUE SET WS-ERROR-FOUND TO TRUE PERFORM 9100-PROCESS-ERROR THRU 9100-EXIT GO TO 2000-EXIT ELSE MOVE WS-PARM-QMGR TO WS-Q-MGRNAME END-IF. * PERFORM 2100-READ-WAIT-PARMS THRU 2100-EXIT. IF WS-ERROR-FOUND GO TO 2000-EXIT END-IF. * *C CALLS MQCONN TO CONNECT TO QUEUE... * PERFORM 4000-MQ-CONNECT THRU 4000-EXIT. * *C CALLS MQOPEN TO OPEN THE QUEUE... * IF MQ-CONNECTED PERFORM 4100-MQ-OPEN THRU 4100-EXIT IF WS-ERROR-FOUND GO TO 2000-EXIT END-IF ELSE GO TO 2000-EXIT END-IF * *C OPENS THE INPUT AND OUTPUT FILE ... * OPEN INPUT MQFORM-FILE IF SUCCESSFUL-IO NEXT SENTENCE ELSE MOVE ERROR-OPENING-INPUT-FILE TO ERROR-MESSAGE MOVE WS-MQFORM-STATUS TO WS-RETURN-CODE SET WS-ERROR-FOUND TO TRUE PERFORM 9100-PROCESS-ERROR THRU 9100-EXIT GO TO 2000-EXIT END-IF * *C READS FIRST RECORD ... * SET WS-FIRST-RECORD TO TRUE. PERFORM 4400-READ-INPUT THRU 4400-EXIT. * OPEN INPUT DSCCQNMN-FILE IF WS-SUCCESSFUL-IO NEXT SENTENCE ELSE MOVE ERROR-OPENING-DSCCQNMN-FILE TO ERROR-MESSAGE MOVE WS-DSCCQNMN-STATUS TO WS-RETURN-CODE SET WS-ERROR-FOUND TO TRUE PERFORM 9100-PROCESS-ERROR THRU 9100-EXIT GO TO 2000-EXIT END-IF. 2000-EXIT. EXIT. * 2100-READ-WAIT-PARMS. OPEN INPUT WAITPARM. READ WAITPARM INTO WS-WAIT-PARMS AT END MOVE MISSING-WAIT-PARM TO ERROR-MESSAGE MOVE 8 TO WS-RETURN-CODE SET WS-ERROR-FOUND TO TRUE PERFORM 9100-PROCESS-ERROR THRU 9100-EXIT GO TO 2100-EXIT END-READ. IF WS-RECORDS-TO-SKIP NOT NUMERIC OR WS-SECONDS-TO-WAIT NOT NUMERIC OR WS-MQ-THRESHOLD NOT NUMERIC MOVE BAD-WAIT-PARMS TO ERROR-MESSAGE MOVE 8 TO WS-RETURN-CODE SET WS-ERROR-FOUND TO TRUE PERFORM 9100-PROCESS-ERROR THRU 9100-EXIT END-IF. CLOSE WAITPARM. 2100-EXIT. EXIT. * 3000-RETRIEVE-ACCEPTED. ************************************************************** *C THIS SECTION PROCESSES EACH ACCEPTED EXTERNAL FILE RECORD, *C BUILDS THE API SEGMENTS, AND THEN PERFORMS CALLS TO MQ. ************************************************************** * * INITIALIZE LK-API-REQ-MESSAGE % INITIALIZE DSCCQNMN-RECORD % MOVE MQFORM-RECORD(5:16) TO QNMN-ACCT-NBR % PERFORM 3300-READ-DSCCQNMN THRU 3300-EXIT % MOVE MQ-INPUT-RECORD TO LK-API-REQ-MESSAGE MOVE ZEROES TO WS-NBR-ATTEMPTS MOVE 'Y' TO WS-MQ-FULL PERFORM 4200-MQ-PUT THRU 4200-EXIT UNTIL WS-MQ-FULL = 'N' IF WS-ERROR-FOUND GO TO 3000-EXIT END-IF. ADD +1 TO WS-MQ-CHECK-CNT. IF WS-MQ-CHECK-CNT > WS-RECORDS-TO-SKIP MOVE ZERO TO WS-MQ-CHECK-CNT PERFORM 3100-GET-MQ-DEPTH THRU 3100-EXIT PERFORM UNTIL MQ-DEPTH < WS-MQ-THRESHOLD OR WS-ERROR-FOUND PERFORM 6000-WAIT-PARA THRU 6000-EXIT PERFORM 3100-GET-MQ-DEPTH THRU 3100-EXIT END-PERFORM END-IF. IF NOT WS-EOF AND NOT WS-ERROR-FOUND PERFORM 4400-READ-INPUT THRU 4400-EXIT ELSE CONTINUE END-IF. 3000-EXIT. EXIT. * 3100-GET-MQ-DEPTH. ************** MQINQ PARAMETERS: ************************** * WS-MQ-HCONN - CONNECTION HANDLE, IS RETURNED FROM MQ CONNECT * MQ-OBJECT-HANDLE - OBJECT HANDLE, RETURNED FROM MQ OPEN * SELECTOR-COUNT - NUMBER OF ALL ATTRIBUTES TO BE RETURNED * SELECTORS-TABLE - LIST OF ALL ATTRIBUTES TO BE RETURNED * INT-ATTR-COUNT - NUMBER OF INTEGER ATTRIBUTES * INT-ATTR-TABLE - LIST OF INTEGER ATTRIBUTES * CHAR-ATTR-LENGTH - LENGTH OF THE BUFFER WITH CHAR ATTRIBS * CHAR-ATTRS - THIS IS THE BUFFER WITH CHAR ATTRIBS * MQM-COMPLETION-CODE * MQM-REASON-CODE ************************************************************* * MOVE CONNECTION HANDLE, RECEIVED IN MQ CONNECT MOVE MQ-HCONN TO WS-MQ-HCONN. * WE ARE REQUESTING ONE QUEUE ATTRIBUTE: MOVE 1 TO SELECTOR-COUNT. * THIS IS 1 INTEGER ATTRIBUTE: CURRENT MQ DEPTH MOVE 1 TO INT-ATTR-COUNT. MOVE MQIA-CURRENT-Q-DEPTH TO SELECTORS. MOVE 0 TO CHAR-ATTR-LENGTH CALL 'MQINQ' USING 00020000 WS-MQ-HCONN, 00030000 MQ-OBJECT-HANDLE, 00040000 SELECTOR-COUNT, 00050000 SELECTORS, 00060000 INT-ATTR-COUNT, 00070000 INT-ATTRS, 00080000 CHAR-ATTR-LENGTH, 00090000 CHAR-ATTRS, 00100000 MQM-COMPLETION-CODE, 00110000 MQM-REASON-CODE. 00110000 IF (MQM-COMPLETION-CODE NOT = MQCC-OK) THEN SET WS-ERROR-FOUND TO TRUE MOVE INQUIRE-ERROR-MESSAGE TO ERROR-MESSAGE MOVE MQM-REASON-CODE TO WS-RETURN-CODE PERFORM 9100-PROCESS-ERROR THRU 9100-EXIT ELSE MOVE INT-ATTRS TO MQ-DEPTH PERFORM 3200-DISPLAY-DEPTH-MSG THRU 3200-EXIT END-IF. 3100-EXIT. EXIT. 3200-DISPLAY-DEPTH-MSG. MOVE MQ-DEPTH TO WS-DISP-DEPTH. MOVE WS-WRITE-CNT TO WS-DISP-WRITTEN. ACCEPT WS-CURRENT-TIME FROM TIME. MOVE WS-CURRENT-TIME(1:2) TO WS-HH. MOVE WS-CURRENT-TIME(3:2) TO WS-MM. MOVE WS-CURRENT-TIME(5:2) TO WS-SS. DISPLAY MQ-DEPTH-MESSAGE. 3200-EXIT. EXIT. % 3300-READ-DSCCQNMN. %**************************************************************** %* THIS SECTION READS THE DSCCQNMN FILE TO GET THE LAST QUEUE %* NAME AND THE DATE FOR THE CORRESPONDING ACCOUNT NUMBER. %**************************************************************** * % MOVE '3300-READ-DSCCQNMN' TO ERROR-MESSAGE. % READ DSCCQNMN-FILE % IF WS-SUCCESSFUL-IO % MOVE QNMN-QUEUE-NAME TO MQ-QUEUE-NAME % MOVE QNMN-DATE TO MQ-DATE % ELSE % IF WS-RECORD-NOT-FOUND % MOVE SPACES TO MQ-QUEUE-NAME % MOVE SPACES TO MQ-DATE % ELSE % SET WS-ERROR-FOUND TO TRUE % MOVE WS-DSCCQNMN-STATUS TO WS-RETURN-CODE % MOVE '**3300-READ-DSCCQNMN FAILED**' % TO ERROR-MESSAGE % PERFORM 9100-PROCESS-ERROR THRU 9100-EXIT % END-IF % END-IF. %3300-EXIT. % EXIT. 4000-MQ-CONNECT SECTION. **************************************************************** *C THIS SECTION CONNECTS TO THE QUEUE. **************************************************************** * MOVE WS-QUEUE-MANAGER TO MQ-TARGET-QUEUE. MOVE MQ-CONNECT TO MQ-FUNCTION-ID. PERFORM 5000-EXECUTE-REQUEST THRU 5000-EXIT IF MQ-RETURN-CODE = ZERO SET MQ-CONNECTED TO TRUE ELSE SET WS-ERROR-FOUND TO TRUE MOVE CONNECT-ERROR-MESSAGE TO ERROR-MESSAGE MOVE MQ-RETURN-CODE TO WS-RETURN-CODE PERFORM 9100-PROCESS-ERROR THRU 9100-EXIT END-IF. * 4000-EXIT. EXIT. * 4100-MQ-OPEN. **************************************************************** *C THIS SECTION OPENS THE MQ QUEUE 50MQ THRU F8MQ, WHICHEVER *C ARE BEING USED. **************************************************************** * MOVE ZERO TO MQ-RETURN-CODE. MOVE MQ-OPEN-OUT TO MQ-FUNCTION-ID. MOVE WS-LIT-NO TO MQ-OPT-SYNCPOINT. MOVE WS-LIT-NO TO MQ-OPT-CHAR-CONVERSION. MOVE MQ-CONTEXT-ALL TO MQ-OPT-CONTEXT. MOVE ZERO TO MQ-OBJECT-HANDLE. MOVE WS-LIT-QUEUE-NAME TO MQ-TARGET-QUEUE. DISPLAY 'MQ-TARGET-QUEUE : ' MQ-TARGET-QUEUE * *C CALL MQOPEN TO OPEN THE INPUT QUEUE * PERFORM 5000-EXECUTE-REQUEST THRU 5000-EXIT IF MQ-RETURN-CODE NOT = ZERO SET WS-ERROR-FOUND TO TRUE MOVE OPEN-ERROR-MESSAGE TO ERROR-MESSAGE MOVE MQ-RETURN-CODE TO WS-RETURN-CODE PERFORM 9100-PROCESS-ERROR THRU 9100-EXIT END-IF. * 4100-EXIT. EXIT. * 4200-MQ-PUT. **************************************************************** *C THIS SECTION MOVES THE APPLICATION DATA TO THE MQ QUEUE. *C IT ALSO BUILDS THE MSGID WITH A LENGTH OF 24 BYTES. *C IT USES FORMAT EXTFIL-KEY + LASTNAME(2-BYTE) + *C FIRSTNAME(2-BYTE)+QUEUE USED(1 BYTE)+DATE(MMDD)+(TIME)SS. *C MSGID SERVES AS INPUT AND OUTPUT TO MQ TO UNIQUELY IDENTIFY *C THE MESSAGE. IT IS PASSED BACK AND SAVED OFF IN A WS FIELD *C WS-OUTPUT-RECORD TO BE THE VSAM KEY. **************************************************************** * MOVE ZERO TO MQ-RETURN-CODE. MOVE 'N' TO WS-MQ-FULL MOVE MQ-PUT TO MQ-FUNCTION-ID. MOVE WS-LIT-NO TO MQ-OPT-SYNCPOINT. MOVE WS-LIT-NO TO MQ-OPT-CHAR-CONVERSION. MOVE MQ-CONTEXT-ALL TO MQ-OPT-CONTEXT. * MOVE MQMT-REQUEST TO MQMD-MSGTYPE. * MOVE MQPER-PERSISTENT TO MQMD-PERSISTENCE. MOVE MQPER-NOT-PERSISTENT TO MQMD-PERSISTENCE. * MOVE LENGTH OF MQFORM-RECORD TO MQ-MESSAGE-LEN. PERFORM 5000-EXECUTE-REQUEST THRU 5000-EXIT IF MQ-RETURN-CODE NOT = ZERO AND WS-MQ-FULL = 'N' SET WS-ERROR-FOUND TO TRUE MOVE PUT-ERROR-MESSAGE TO ERROR-MESSAGE MOVE MQ-RETURN-CODE TO WS-RETURN-CODE PERFORM 9100-PROCESS-ERROR THRU 9100-EXIT * ELSE * IF WS-NBR-ATTEMPTS > 5 * SET WS-ERROR-FOUND TO TRUE * MOVE PUT-ERROR-MESSAGE TO ERROR-MESSAGE * MOVE MQ-RETURN-CODE TO WS-RETURN-CODE * PERFORM 9100-PROCESS-ERROR THRU 9100-EXIT * MOVE 'N' TO WS-MQ-FULL * END-IF END-IF. * 4200-EXIT. EXIT. * 4300-MQ-CLOSE. ********************************************************* *C THIS SECTION CLOSES THE MQ QUEUE. ********************************************************* * MOVE MQ-CLOSE TO MQ-FUNCTION-ID. PERFORM 5000-EXECUTE-REQUEST THRU 5000-EXIT IF MQ-RETURN-CODE NOT = ZERO SET WS-ERROR-FOUND TO TRUE MOVE CLOSE-ERROR-MESSAGE TO ERROR-MESSAGE MOVE MQ-RETURN-CODE TO WS-RETURN-CODE PERFORM 9100-PROCESS-ERROR THRU 9100-EXIT END-IF. * 4300-EXIT. EXIT. * 4400-READ-INPUT. ********************************************************* *C THIS SECTION READS THE INPUT FILE. ********************************************************* * READ MQFORM-FILE. IF SUCCESSFUL-IO MOVE WS-LIT-NO TO WS-FIRST-READ-FLAG ADD 1 TO WS-CNT ELSE IF END-OF-FILE SET WS-EOF TO TRUE IF WS-FIRST-RECORD MOVE ERROR-EMPTY-INPUT-FILE TO ERROR-MESSAGE MOVE WS-MQFORM-STATUS TO WS-RETURN-CODE PERFORM 9100-PROCESS-ERROR THRU 9100-EXIT END-IF ELSE SET WS-ERROR-FOUND TO TRUE MOVE ERROR-READING-INPUT-FILE TO ERROR-MESSAGE MOVE WS-MQFORM-STATUS TO WS-RETURN-CODE PERFORM 9100-PROCESS-ERROR THRU 9100-EXIT END-IF. * 4400-EXIT. EXIT. * 5000-EXECUTE-REQUEST. **************************************************************** *C PURPOSE: *C - DETERMINE WHAT ACTION TO TAKE BASED UPON THE *C MQ FUNCTION ID **************************************************************** EVALUATE MQ-FUNCTION-ID WHEN MQ-OPEN-OUT IF MQ-OBJECT-HANDLE = ZERO PERFORM 5100-GENERIC-OPEN THRU 5100-EXIT ELSE CONTINUE END-IF WHEN MQ-PUT PERFORM 5200-PUT-RESP-MSG-TO-Q THRU 5200-EXIT WHEN MQ-CLOSE PERFORM 5300-GENERIC-CLOSE THRU 5300-EXIT WHEN MQ-CONNECT PERFORM 5400-CONNECT THRU 5400-EXIT WHEN MQ-DISCONNECT PERFORM 5500-DISCONNECT THRU 5500-EXIT END-EVALUATE. * 5000-EXIT. EXIT. * 5100-GENERIC-OPEN. **************************************************************** *C PURPOSE: *C - OPENS A QUEUE FOR INPUT **************************************************************** PERFORM 5150-SET-MQ-OPTIONS THRU 5150-EXIT. CALL 'MQOPEN' USING MQ-HCONN, MQM-OBJECT-DESCRIPTOR, MQM-OPTIONS, MQM-OBJECT-HANDLE, MQM-COMPLETION-CODE, MQM-REASON-CODE. DISPLAY '************** CALL TO MQOPEN *****************' DISPLAY 'MQM-OBJECT-HANDLE: ' MQM-OBJECT-HANDLE. DISPLAY 'MQM-REASON-CODE: ' MQM-REASON-CODE. IF MQM-COMPLETION-CODE = MQCC-OK MOVE ZERO TO MQ-RETURN-CODE MOVE MQM-OBJECT-HANDLE TO MQ-OBJECT-HANDLE ELSE IF MQM-REASON-CODE = MQRC-Q-MGR-QUIESCING OR MQM-REASON-CODE = MQRC-Q-MGR-STOPPING MOVE QUEUE-MANAGER-STOPPING TO MQ-RETURN-CODE ELSE MOVE MQM-REASON-CODE TO MQ-RETURN-CODE END-IF END-IF. * 5100-EXIT. EXIT. * 5150-SET-MQ-OPTIONS. **************************************************************** *C PURPOSE: *C - TO SET THE OPTIONS FOR MQOPEN **************************************************************** MOVE MQOT-Q TO MQOD-OBJECTTYPE. MOVE MQ-TARGET-QUEUE TO MQOD-OBJECTNAME. MOVE WS-QUEUE-MANAGER TO MQOD-OBJECTQMGRNAME. COMPUTE MQM-OPTIONS = MQOO-OUTPUT + MQOO-FAIL-IF-QUIESCING + MQOO-INQUIRE. IF MQ-OPT-CONTEXT = MQ-CONTEXT-IDENTITY COMPUTE MQM-OPTIONS = MQM-OPTIONS + MQOO-SET-IDENTITY-CONTEXT + MQOO-PASS-IDENTITY-CONTEXT ELSE IF MQ-OPT-CONTEXT = MQ-CONTEXT-ALL ADD MQOO-SET-ALL-CONTEXT TO MQM-OPTIONS END-IF END-IF. * 5150-EXIT. EXIT. * 5200-PUT-RESP-MSG-TO-Q. **************************************************************** *C PURPOSE: *C - TO SEND A MESSAGE FROM THE MAINFRAME TO ACAPS **************************************************************** COMPUTE MQPMO-OPTIONS = MQPMO-FAIL-IF-QUIESCING. IF MQ-OPT-CONTEXT = MQ-CONTEXT-IDENTITY COMPUTE MQPMO-OPTIONS = MQPMO-OPTIONS + MQPMO-SET-IDENTITY-CONTEXT + MQPMO-PASS-IDENTITY-CONTEXT ELSE IF MQ-OPT-CONTEXT = MQ-CONTEXT-ALL ADD MQPMO-SET-ALL-CONTEXT TO MQPMO-OPTIONS ELSE CONTINUE END-IF END-IF. IF MQ-OPT-SYNCPOINT = WS-LIT-YES CONTINUE ELSE COMPUTE MQPMO-OPTIONS = MQPMO-OPTIONS + MQPMO-NO-SYNCPOINT END-IF. CALL 'MQPUT' USING MQ-HCONN, MQ-OBJECT-HANDLE, MQMD, MQPMO, MQ-MESSAGE-LEN, LK-API-REQ-MESSAGE, MQM-COMPLETION-CODE, MQM-REASON-CODE. IF MQM-COMPLETION-CODE = MQCC-OK MOVE ZERO TO MQ-RETURN-CODE ADD 1 TO WS-WRITE-CNT * WS-DISPLAY-CNT * IF WS-DISPLAY-CNT > 10 * DISPLAY 'QUEUE FULL - WAITING ' WS-NBR-ATTEMPTS * DISPLAY 'WS-WRITE-CNT : ' WS-WRITE-CNT * PERFORM 6000-WAIT-PARA THRU 6000-EXIT * MOVE 0 TO WS-DISPLAY-CNT * END-IF ELSE EVALUATE MQM-REASON-CODE WHEN MQRC-Q-MGR-QUIESCING MOVE QUEUE-MANAGER-STOPPING TO MQ-RETURN-CODE WHEN MQRC-Q-MGR-STOPPING MOVE QUEUE-MANAGER-STOPPING TO MQ-RETURN-CODE WHEN MQRC-Q-FULL ADD 1 TO WS-NBR-ATTEMPTS DISPLAY 'QUEUE FULL - WAITING ' WS-NBR-ATTEMPTS DISPLAY 'WS-WRITE-CNT : ' WS-WRITE-CNT PERFORM 6000-WAIT-PARA THRU 6000-EXIT MOVE 'Y' TO WS-MQ-FULL WHEN OTHER MOVE MQM-REASON-CODE TO MQ-RETURN-CODE END-EVALUATE END-IF. * 5200-EXIT. EXIT. * 5300-GENERIC-CLOSE. **************************************************************** *C PURPOSE: *C - TO CLOSE A QUEUE **************************************************************** * DISPLAY '************** CALL TO MQCLOSE ****************' DISPLAY 'MQM-OBJECT-HANDLE: ' MQ-OBJECT-HANDLE. MOVE ZEROES TO MQM-OPTIONS. CALL 'MQCLOSE' USING MQ-HCONN, MQ-OBJECT-HANDLE, MQM-OPTIONS, MQM-COMPLETION-CODE, MQM-REASON-CODE. DISPLAY 'MQM-REASON-CODE: ' MQM-REASON-CODE. IF MQM-COMPLETION-CODE = MQCC-OK MOVE ZERO TO MQ-RETURN-CODE ELSE EVALUATE MQM-REASON-CODE WHEN MQRC-Q-MGR-QUIESCING MOVE QUEUE-MANAGER-STOPPING TO MQ-RETURN-CODE WHEN MQRC-Q-MGR-STOPPING MOVE QUEUE-MANAGER-STOPPING TO MQ-RETURN-CODE WHEN OTHER MOVE MQM-REASON-CODE TO MQ-RETURN-CODE END-EVALUATE END-IF. 5300-EXIT. EXIT. * 5400-CONNECT. **************************************************************** *C PURPOSE: *C - CONNECTS TO THE MQ QUEUE MANAGER **************************************************************** CALL 'MQCONN' USING MQ-TARGET-QUEUE, MQ-HCONN, MQM-COMPLETION-CODE, MQM-REASON-CODE. DISPLAY '************** CALL TO MQCONN *****************' DISPLAY 'MQM-REASON-CODE: ' MQM-REASON-CODE. IF MQM-COMPLETION-CODE = MQCC-OK MOVE ZERO TO MQ-RETURN-CODE ELSE MOVE MQM-REASON-CODE TO MQ-RETURN-CODE END-IF. 5400-EXIT. EXIT. * 5500-DISCONNECT. **************************************************************** *C PURPOSE: *C - DISCONNECT FROM THE MQ QUEUE MANAGER **************************************************************** CALL 'MQDISC' USING MQ-HCONN, MQM-COMPLETION-CODE, MQM-REASON-CODE. DISPLAY '************** CALL TO MQDISC *****************' DISPLAY 'MQM-REASON-CODE: ' MQM-REASON-CODE. IF MQM-COMPLETION-CODE = MQCC-OK MOVE ZERO TO MQ-RETURN-CODE ELSE MOVE MQM-REASON-CODE TO MQ-RETURN-CODE END-IF. 5500-EXIT. EXIT. * 6000-WAIT-PARA. * MOVE +180 TO WS-SECONDS-TO-WAIT. * MOVE +5 TO WS-SECONDS-TO-WAIT. MOVE WS-SECONDS-TO-WAIT TO WS-WAIT-TIME CALL 'ILBOWAT0' USING WS-WAIT-TIME. 6000-EXIT. EXIT. 9000-TERMINATION. ************************************************************** *C THIS SECTION PERFORMS A CLOSE ON THE MQ QUEUES, *C A DISCONNECT FROM THE QUEUE MANAGER, AND CLOSES THE *C PROGRAM FILES. ************************************************************** * IF MQ-CONNECTED PERFORM 4300-MQ-CLOSE THRU 4300-EXIT MOVE MQ-DISCONNECT TO MQ-FUNCTION-ID PERFORM 5000-EXECUTE-REQUEST THRU 5000-EXIT IF MQ-RETURN-CODE = ZERO CONTINUE ELSE SET WS-ERROR-FOUND TO TRUE MOVE DISCONNECT-ERROR-MESSAGE TO ERROR-MESSAGE MOVE MQ-RETURN-CODE TO WS-RETURN-CODE PERFORM 9100-PROCESS-ERROR THRU 9100-EXIT END-IF ELSE NEXT SENTENCE END-IF. CLOSE DSCCQNMN-FILE. CLOSE MQFORM-FILE. DISPLAY 'NUMBER OF RECORDS READ FROM INPUT : ' WS-CNT DISPLAY 'NUMBER OF RECORDS WRITTEN IN MQ : ' WS-WRITE-CNT IF WS-ERROR-FOUND MOVE '08' TO RETURN-CODE. * 9000-EXIT. EXIT. * 9100-PROCESS-ERROR. **************************************************************** *C THIS SECTION DISPLAYS THE ERROR MESSAGE TO SYSOUT **************************************************************** * DISPLAY ERROR-MESSAGE. DISPLAY 'RETURN CODE: ' WS-RETURN-CODE. * 9100-EXIT. EXIT. * Thanks
From: Anonymous on 23 Jun 2008 08:25
In article <20fea8bf-917f-466f-ba3d-71650acd09e4(a)k30g2000hse.googlegroups.com>, <vbarathee(a)gmail.com> wrote: >Hi > >Please find the code below , where the enhancement changes done by me >will be prefixed by % symbol , this was the original code when the >program got abended when put into production. [snip] > FD WAITPARM Passing parms by a file... I recall someone doing that because there were difficulties getting a FORTRAN progam to talk with a C program a couple of decades back. [snip] > VALUE 'HNCDSCVR.LQ.FCMSLOW'. Hmmmmm... smells like credit-card processing, don't ask me why. [snip] > 6000-WAIT-PARA. >* MOVE +180 TO WS-SECONDS-TO-WAIT. >* MOVE +5 TO WS-SECONDS-TO-WAIT. > > MOVE WS-SECONDS-TO-WAIT TO WS-WAIT-TIME > CALL 'ILBOWAT0' USING WS-WAIT-TIME. Here... right here. Never mind the discussions about static and dynamic linking that are likely to come, just comment out the MOVE and the CALL right here, recompile, re-link, re-run. Oh... and while you're at it... third and final request, how many years ago was the original source outsourced to you? DD |