S0C4 x'4' abend while reading VSAM KSDS file
in [Cobol]
|
From: William M. Klein on 24 Jun 2008 23:33 How is QNMN-ACCT-NBR defined? How is the key of the VSAM cluster defined? Are you certain that MQFORM-RECORD has the account number in (5:16) -- Bill Klein wmklein <at> ix.netcom.com <vbarathee(a)gmail.com> wrote in message news:20fea8bf-917f-466f-ba3d-71650acd09e4(a)k30g2000hse.googlegroups.com... > 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: William M. Klein on 24 Jun 2008 23:40 As anyone asked you yet which COBOL or LE run-time libraries are available in your - steplib - joblib - linklist - lpa If you have the OS/VS COBOL or VS COBOL II libraries CONCATENATED ahead of the LE library and you call ILBOWAT0 and then have an error condition, this may WELL cause a S0C4. Try running with ONLY the LE library (I also think that adding the INVALID KEY phrase will get rid of the ABEND - but won't explain why you aren't finding the record that you think is there.) -- Bill Klein wmklein <at> ix.netcom.com <vbarathee(a)gmail.com> wrote in message news:a9a3f442-72d5-496f-be8c-3e361866b1d5(a)z72g2000hsb.googlegroups.com... hi all , Hope someone can resolve my clarifications on cobol , please find below the scenario, We have a batch job runs with two input files, one PS file and a VSAM KSDS file , we read the acct number from the PS file and check with KSDS file , we use the acct no as key and take details , then we write into MQ series . Also we have a wait time logic in the pgm which calls ILBOWAT module so that once the threshold reaches some 250,000 in MQ , all the jobs will wait for 180 secs and then it will continue writing into MQ. This program was a generic one and used by 10 split jobs running parallely in production , recently we added the VSAM file , previously the pgm had only PS file. Now the job is getting abend with S0C4 x'4' when it waits for the threshold limit and abends exactly when it tries to read the input VSAM file. The VSAM file was defined in Online region , but no job or region would update or access the file at the time of run. The share option for VSAM was (3,3) and no RLS option was used. Please find below abend code details , MQM-REASON-CODE: 000000000 MQ-TARGET-QUEUE : HNCDSCVR.LQ.FCMSLOW ************** CALL TO MQOPEN ***************** MQM-OBJECT-HANDLE: 000000001 MQM-REASON-CODE: 000000000 ### MQ DEPTH: 79481 RECORDS WRITTEN: 10001 02:32:22 ### MQ DEPTH: 159281 RECORDS WRITTEN: 20002 02:33:04 ### MQ DEPTH: 244216 RECORDS WRITTEN: 30003 02:33:33 ### MQ DEPTH: 327990 RECORDS WRITTEN: 40004 02:34:01 ### MQ DEPTH: 227646 RECORDS WRITTEN: 40004 02:37:01 CEE3204S The system detected a protection exception (System Completion Code=0C4). From compile unit DSCB6100 at entry point DSCB6100 at compile unit offset +000545C4 at entry offset +000545C4 at address 0005B904. 02.37.02 JOB02101 +IDI0001I Fault Analyzer V6R1M0 (PK29971 2006/08/24) invoked by IDIXDCAP using MVSP.FANALYZE.PARMLIB(IDICNF00) 02.37.03 JOB02101 +IDI0081I IEWBIND unusual condition INCLUDE DSCB6100 rc=3000526 02.37.19 JOB02101 +IDI0002I Module IGZCXFR offset X'280': Abend S0C4- X'4' (Protection Exception) 02.37.19 JOB02101 +IDI0003I Fault ID F04475 assigned in history file MVSP.FA.PROD.BATCH.HIST Fault analyzer details : File Name . . . . . . . . . : DSCCQUEU RT��� Data Set Name . . . . . . : DSCP.VO00P.CICS160I.DSCCQUEU �RT� 5 File Attributes . . . . . : ORGANIZATION=INDEXED VSAM, ACCESS MODE=RANDOM, �RT��� RECFM=FIXED �RT��� Last I/O Function . . . . : READ �RT��� Open Status . . . . . . . : INPUT RT��� File Status Code. . . . . : 23 �RT� 5 An attempt was made to randomly access a record �RT� 5 �RT� 5 that does not exist in the file, or a START or �RT� 5 �RT� 5 random READ statement was attempted on an optional �RT� 5 �RT input file that was not present. �RT �RT��� Return Code . . . . . . . : X'8' �RT��� Function Code . . . . . . : X'0' �RT��� Feedback Code . . . . . . : X'10' �RTass Record not found, or the RBA is not found in the �RTass �RT��� buffer pool. (If multiple RPL requests are issued �RT��� �RT��� for alternate indexes, getting return code �RT��� �RT��� 16(X'10') might mean a temporary situation where �RT��� �RT��� processing has not been completed on either the �RT��� �RT base cluster or the associated alternate indexes.) �RT The same code works fine when we use Dynamic access mode and a START verb before reading the VSAM file. We are able to track the pgm where it gets abend , but we are unable to locate the exact reason . The same code runs in testing environment fine if it is not going to wait time logic . Please let me know ur findings. Thanks Barathi.v
From: vbarathee on 25 Jun 2008 11:31 Hi all Thanks for ur suggestions and replies. Here are my test results and my reply to the above queries. * By default the compiler options would be Amode(24) ,Rmode(24)and this program has used the same. * The VSAM file was defined properly with the key and able to display the key before the VSAM read. * The program ran to completion successfully when the original code was changed like below, READ DSCCQUEU-FILE INVALID KEY MOVE SPACES TO WS-MQUEUE-NAME,WS-MQ-DATE NOT INVALID KEY IF WS-SUCCESSFUL-IO MOVE QUEU-QUEUE-NAME TO WS-MQUEUE-NAME MOVE QUEU-DATE TO WS-MQ-DATE ELSE SET WS-ERROR-FOUND TO TRUE MOVE WS-DSCCQUEU-STATUS TO WS-RETURN-CODE MOVE '**3300-READ-DSCCQUEU FAILED**' TO ERROR-MESSAGE PERFORM 9100-PROCESS-ERROR THRU 9100-EXIT END-IF END-READ. * Also the program ran to completion , when the code was commented with ILBOWATO module. * My shop doesnt have CEE3DLY or CEEDLYM modules. Please let me know ur suggestions. Thanks, Barathi.v
From: Anonymous on 25 Jun 2008 12:15 In article <a70e5adb-b887-40d9-a829-3a75f63aad88(a)u36g2000prf.googlegroups.com>, <vbarathee(a)gmail.com> wrote: [snip] >* Also the program ran to completion , when the code was commented >with ILBOWATO module. Bingo. Still no word on when the code was outsourced, though. > >* My shop doesnt have CEE3DLY or CEEDLYM modules. > >Please let me know ur suggestions. Knowing how to deal with these things is worth money. I suggest you get someone in there who knows how to deal with the situation and pay very, very well to let that be done. DD
From: vbarathee on 25 Jun 2008 13:02
Hi DD I think you are more concerned about the enhancemnt work when it got outsourced to us rather than the abend. I have given my answer in my previous post , as a month back we got this enhancement work. I have posted the original code and given my test results , this wudnt be enough to analyze the abend ? Regards Barathi.V |