DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
729
CICS/DTSCU831.cob
Normal file
729
CICS/DTSCU831.cob
Normal file
@ -0,0 +1,729 @@
|
||||
00001 IDENTIFICATION DIVISION. 02/07/12
|
||||
00002 PROGRAM-ID. DTSCU831. DTSCU831
|
||||
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV009
|
||||
00004 DATE-WRITTEN. NOVEMBER 1991. DTSCU831
|
||||
00005 DATE-COMPILED. DTSCU831
|
||||
00006 SKIP3 DTSCU831
|
||||
00007 ***** DTSCU831
|
||||
00008 * DTSCU831
|
||||
00009 * FUNCTION: REFERENCE FILE INPUT/OUTPUT. DTSCU831
|
||||
00010 * DTSCU831
|
||||
00011 * DTSCU831
|
||||
00012 * MODIFICATION LOG: DTSCU831
|
||||
00013 * DTSCU831
|
||||
00014 * 11/12/91 INITIAL DEVELOPMENT. DTSCU831
|
||||
00015 * WORK ORDER: PROGRAMMER: TCL DTSCU831
|
||||
00016 * DTSCU831
|
||||
00017 * 04/01/94 MODIFIED FOR MONTANA. DTSCU831
|
||||
00018 * WORK ORDER: PROGRAMMER: TCL DTSCU831
|
||||
00019 * DTSCU831
|
||||
00020 * 08/12/1998 REVIEWED AND MODIFIED FOR DC. DTSCU831
|
||||
00021 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSCU831
|
||||
00022 * DTSCU831
|
||||
00023 * 05/09/2000 ADDED FFIS RECORD (2121/2221-MOVE) LOGIC. DTSCU831
|
||||
00024 * REFERENCE: DC DEVELOPMENT PROGRAMMER: ZL1 DTSCU831
|
||||
00025 * DTSCU831
|
||||
00026 * DTSCU831
|
||||
00027 * 05/15/2002 ADDED FAFD RECORD (2121/2221-MOVE) LOGIC. DTSCU831
|
||||
00028 * REFERENCE: HOUSEHOLD PROGRAMMER: ZL1 DTSCU831
|
||||
00029 * DTSCU831
|
||||
00030 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU831
|
||||
00031 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU831
|
||||
00032 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSCU831
|
||||
00033 * DTSCU831
|
||||
00034 * DTSCU831
|
||||
00035 * DESCRIPTION: DTSCU831
|
||||
00036 * DTSCU831
|
||||
00037 * DTSCU831 PERFORMS ALL REQUIRED REFERENCE FILE DTSCU831
|
||||
00038 * INPUT/OUTPUT. DTSCU831'S COMMAREA CONSISTS OF DTSCU831
|
||||
00039 * DTSIL831, FOLLOWED BY DTSIFSKL. SEE DFHCOMMAREA DTSCU831
|
||||
00040 * OF THIS MODULE FOR AN EXAMPLE. DTSCU831
|
||||
00041 * DTSCU831
|
||||
00042 * DTSCU831
|
||||
00043 * DTSCU831
|
||||
00044 ***** DTSCU831
|
||||
00045 SKIP3 DTSCU831
|
||||
00046 ENVIRONMENT DIVISION. DTSCU831
|
||||
00047 SKIP3 DTSCU831
|
||||
00048 DATA DIVISION. DTSCU831
|
||||
00049 SKIP3 DTSCU831
|
||||
00050 WORKING-STORAGE SECTION. DTSCU831
|
||||
000505 77 PAN-VALET PICTURE X(24) VALUE '009DTSCU831 02/07/12'. DTSCU831
|
||||
00051 SKIP3 DTSCU831
|
||||
00052 01 WRK-AREA. DTSCU831
|
||||
00053 05 WRK-ABEND-CD PIC X(04) VALUE 'U831'. DTSCU831
|
||||
00054 05 WRK-RESP-CD PIC S9(08) COMP. DTSCU831
|
||||
00055 DTSCU831
|
||||
00056 *****05 WRK-TEST-FILE-NAME PIC X(08) VALUE 'DTSFREF'. DTSCU831
|
||||
00057 *****05 WRK-TCL-FILE-NAME PIC X(08) VALUE 'DTSTREF'. DTSCU831
|
||||
00058 05 WRK-PROD-FILE-NAME PIC X(08) VALUE 'DTSFREF'. DTSCU831
|
||||
00059 DTSCU831
|
||||
00060 05 EMSG-NOT-AVAILABLE. DTSCU831
|
||||
00061 10 FILLER PIC X(04) VALUE 'E091'. DTSCU831
|
||||
00062 10 FILLER PIC X(06) VALUE 'FILE '. DTSCU831
|
||||
00063 10 EMSG-FILE-NAME PIC X(08). DTSCU831
|
||||
00064 10 FILLER PIC X(33) DTSCU831
|
||||
00065 VALUE ' NOT AVAILABLE PLEASE TRY LATER'. DTSCU831
|
||||
00066 SKIP3 DTSCU831
|
||||
00067 *****05 WRK-CICS-APPLID PIC X(08). DTSCU831
|
||||
00068 DTSCU831
|
||||
00069 *****05 WRK-CICS-OP-ID PIC X(08). DTSCU831
|
||||
00070 *********88 WRK-TCL-OP-ID-88 VALUES 'CE0756' DTSCU831
|
||||
00071 *******************************************'CE3568' DTSCU831
|
||||
00072 *******************************************'C84986'. DTSCU831
|
||||
00073 DTSCU831
|
||||
00074 05 WRK-FILE-NAME PIC X(08). DTSCU831
|
||||
00075 DTSCU831
|
||||
00076 05 WRK-REC-LENGTH PIC S9(04) COMP. DTSCU831
|
||||
00077 EJECT DTSCU831
|
||||
00078 01 FLEN-LITERALS. DTSCU831
|
||||
00079 ++INCLUDE DTSIFLEN DTSCU831
|
||||
00080 EJECT DTSCU831
|
||||
00081 01 FIO-REC. DTSCU831
|
||||
00082 ++INCLUDE DTSIFSKL DTSCU831
|
||||
00083 EJECT DTSCU831
|
||||
00084 LINKAGE SECTION. DTSCU831
|
||||
00085 SKIP3 DTSCU831
|
||||
00086 01 DFHCOMMAREA. DTSCU831
|
||||
00087 05 L831-CONTROL-BLOCK. DTSCU831
|
||||
00088 ++INCLUDE DTSIL831 DTSCU831
|
||||
00089 SKIP3 DTSCU831
|
||||
00090 05 FCOMM-REC. DTSCU831
|
||||
00091 ++INCLUDE DTSIFSKL DTSCU831
|
||||
00092 SKIP3 DTSCU831
|
||||
00093 05 FAFD-REC REDEFINES FCOMM-REC. DTSCU831
|
||||
00094 ++INCLUDE DTSIFAFD DTSCU831
|
||||
00095 SKIP3 DTSCU831
|
||||
00096 05 FCYR-REC REDEFINES FCOMM-REC. DTSCU831
|
||||
00097 ++INCLUDE DTSIFCYR DTSCU831
|
||||
00098 SKIP3 DTSCU831
|
||||
00099 05 FFAT-REC REDEFINES FCOMM-REC. DTSCU831
|
||||
00100 ++INCLUDE DTSIFFAT DTSCU831
|
||||
00101 SKIP3 DTSCU831
|
||||
00102 05 FFAZ-REC REDEFINES FCOMM-REC. DTSCU831
|
||||
00103 ++INCLUDE DTSIFFAZ DTSCU831
|
||||
00104 SKIP3 DTSCU831
|
||||
00105 05 FFID-REC REDEFINES FCOMM-REC. DTSCU831
|
||||
00106 ++INCLUDE DTSIFFID DTSCU831
|
||||
00107 SKIP3 DTSCU831
|
||||
00108 05 FFIS-REC REDEFINES FCOMM-REC. DTSCU831
|
||||
00109 ++INCLUDE DTSIFFIS DTSCU831
|
||||
00110 SKIP3 DTSCU831
|
||||
00111 05 FOPR-REC REDEFINES FCOMM-REC. DTSCU831
|
||||
00112 ++INCLUDE DTSIFOPR DTSCU831
|
||||
00113 SKIP3 DTSCU831
|
||||
00114 05 FQTR-REC REDEFINES FCOMM-REC. DTSCU831
|
||||
00115 ++INCLUDE DTSIFQTR DTSCU831
|
||||
00116 SKIP3 DTSCU831
|
||||
00117 05 FSEL-REC REDEFINES FCOMM-REC. DTSCU831
|
||||
00118 ++INCLUDE DTSIFSEL DTSCU831
|
||||
00119 SKIP3 DTSCU831
|
||||
00120 05 FUIR-REC REDEFINES FCOMM-REC. DTSCU831
|
||||
00121 ++INCLUDE DTSIFUIR DTSCU831
|
||||
00122 SKIP3 DTSCU831
|
||||
00123 05 F581-REC REDEFINES FCOMM-REC. DTSCU831
|
||||
00124 ++INCLUDE DTSIF581 DTSCU831
|
||||
00125 EJECT DTSCU831
|
||||
00126 PROCEDURE DIVISION. DTSCU831
|
||||
00127 SKIP2 DTSCU831
|
||||
00128 *****EXEC CICS DTSCU831
|
||||
00129 ***** ASSIGN DTSCU831
|
||||
00130 ***** APPLID (WRK-CICS-APPLID) DTSCU831
|
||||
00131 *****END-EXEC. DTSCU831
|
||||
00132 ***** DTSCU831
|
||||
00133 *****IF WRK-CICS-APPLID = 'CICSAORT' DTSCU831
|
||||
00134 ***** EXEC CICS DTSCU831
|
||||
00135 ***** ASSIGN DTSCU831
|
||||
00136 ***** USERID (WRK-CICS-OP-ID) DTSCU831
|
||||
00137 ***** END-EXEC DTSCU831
|
||||
00138 ***** DTSCU831
|
||||
00139 ***** IF WRK-TCL-OP-ID-88 DTSCU831
|
||||
00140 ***** MOVE WRK-TCL-FILE-NAME TO WRK-FILE-NAME DTSCU831
|
||||
00141 ***** ELSE DTSCU831
|
||||
00142 ***** MOVE WRK-TEST-FILE-NAME TO WRK-FILE-NAME DTSCU831
|
||||
00143 *****ELSE DTSCU831
|
||||
00144 DTSCU831
|
||||
00145 DTSCU831
|
||||
00146 DTSCU831
|
||||
00147 MOVE WRK-PROD-FILE-NAME TO WRK-FILE-NAME. DTSCU831
|
||||
00148 DTSCU831
|
||||
00149 MOVE SPACES TO L831-MSG-AREA. DTSCU831
|
||||
00150 DTSCU831
|
||||
00151 SET L831-OK-88 TO TRUE. DTSCU831
|
||||
00152 DTSCU831
|
||||
00153 IF L831-READ-NEXT-88 DTSCU831
|
||||
00154 PERFORM P2200-READ-NEXT THRU P2200-EXIT DTSCU831
|
||||
00155 ELSE DTSCU831
|
||||
00156 IF L831-READ-88 DTSCU831
|
||||
00157 PERFORM P1100-READ THRU P1100-EXIT DTSCU831
|
||||
00158 ELSE DTSCU831
|
||||
00159 IF L831-START-BROWSE-88 DTSCU831
|
||||
00160 PERFORM P2100-START-BROWSE THRU P2100-EXIT DTSCU831
|
||||
00161 ELSE DTSCU831
|
||||
00162 IF L831-END-BROWSE-88 DTSCU831
|
||||
00163 PERFORM P2400-END-BROWSE THRU P2400-EXIT DTSCU831
|
||||
00164 ELSE DTSCU831
|
||||
00165 IF L831-READ-PREV-88 DTSCU831
|
||||
00166 PERFORM P2300-READ-PREV THRU P2300-EXIT DTSCU831
|
||||
00167 ELSE DTSCU831
|
||||
00168 IF L831-WRITE-88 DTSCU831
|
||||
00169 PERFORM P3100-WRITE THRU P3100-EXIT DTSCU831
|
||||
00170 ELSE DTSCU831
|
||||
00171 IF L831-REWRITE-88 DTSCU831
|
||||
00172 PERFORM P3200-REWRITE THRU P3200-EXIT DTSCU831
|
||||
00173 ELSE DTSCU831
|
||||
00174 IF L831-DELETE-88 DTSCU831
|
||||
00175 PERFORM P3300-DELETE THRU P3300-EXIT DTSCU831
|
||||
00176 ELSE DTSCU831
|
||||
00177 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
||||
00178 SKIP2 DTSCU831
|
||||
00179 EXEC CICS DTSCU831
|
||||
00180 RETURN DTSCU831
|
||||
00181 END-EXEC. DTSCU831
|
||||
00182 SKIP2 DTSCU831
|
||||
00183 GOBACK. DTSCU831
|
||||
00184 EJECT DTSCU831
|
||||
00185 P1100-READ. DTSCU831
|
||||
00186 MOVE LOW-VALUES TO FIO-REC. DTSCU831
|
||||
00187 DTSCU831
|
||||
00188 MOVE FSKL-KEY-AREA OF FCOMM-REC TO FSKL-KEY-AREA OF FIO-REC. DTSCU831
|
||||
00189 DTSCU831
|
||||
00190 MOVE FLEN-MAX-REC-LEN TO WRK-REC-LENGTH. DTSCU831
|
||||
00191 DTSCU831
|
||||
00192 EXEC CICS DTSCU831
|
||||
00193 READ DTSCU831
|
||||
00194 DATASET (WRK-FILE-NAME) DTSCU831
|
||||
00195 INTO (FIO-REC) DTSCU831
|
||||
00196 LENGTH (WRK-REC-LENGTH) DTSCU831
|
||||
00197 RIDFLD (FSKL-KEY-AREA OF FIO-REC) DTSCU831
|
||||
00198 RESP (WRK-RESP-CD) DTSCU831
|
||||
00199 END-EXEC. DTSCU831
|
||||
00200 DTSCU831
|
||||
00201 IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED) DTSCU831
|
||||
00202 OR DFHRESP (SYSIDERR) DTSCU831
|
||||
00203 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU831
|
||||
00204 GO TO P1100-EXIT. DTSCU831
|
||||
00205 DTSCU831
|
||||
00206 IF WRK-RESP-CD = DFHRESP (NOTFND) DTSCU831
|
||||
00207 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU831
|
||||
00208 GO TO P1100-EXIT. DTSCU831
|
||||
00209 DTSCU831
|
||||
00210 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU831
|
||||
00211 PERFORM S2100-IO-TO-COMM THRU S2100-EXIT DTSCU831
|
||||
00212 ELSE DTSCU831
|
||||
00213 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
||||
00214 P1100-EXIT. DTSCU831
|
||||
00215 EXIT. DTSCU831
|
||||
00216 EJECT DTSCU831
|
||||
00217 P2100-START-BROWSE. DTSCU831
|
||||
00218 MOVE LOW-VALUES TO FIO-REC. DTSCU831
|
||||
00219 DTSCU831
|
||||
00220 MOVE FSKL-KEY-AREA OF FCOMM-REC TO FSKL-KEY-AREA OF FIO-REC. DTSCU831
|
||||
00221 DTSCU831
|
||||
00222 EXEC CICS DTSCU831
|
||||
00223 STARTBR DTSCU831
|
||||
00224 DATASET (WRK-FILE-NAME) DTSCU831
|
||||
00225 RIDFLD (FSKL-KEY-AREA OF FIO-REC) DTSCU831
|
||||
00226 RESP (WRK-RESP-CD) DTSCU831
|
||||
00227 END-EXEC. DTSCU831
|
||||
00228 DTSCU831
|
||||
00229 IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED) DTSCU831
|
||||
00230 OR DFHRESP (SYSIDERR) DTSCU831
|
||||
00231 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU831
|
||||
00232 GO TO P2100-EXIT. DTSCU831
|
||||
00233 DTSCU831
|
||||
00234 IF WRK-RESP-CD = DFHRESP (NOTFND) DTSCU831
|
||||
00235 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU831
|
||||
00236 GO TO P2100-EXIT. DTSCU831
|
||||
00237 DTSCU831
|
||||
00238 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU831
|
||||
00239 PERFORM P2200-READ-NEXT THRU P2200-EXIT DTSCU831
|
||||
00240 ELSE DTSCU831
|
||||
00241 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
||||
00242 P2100-EXIT. DTSCU831
|
||||
00243 EXIT. DTSCU831
|
||||
00244 EJECT DTSCU831
|
||||
00245 P2200-READ-NEXT. DTSCU831
|
||||
00246 IF L831-READ-NEXT-88 DTSCU831
|
||||
00247 MOVE LOW-VALUES TO FIO-REC DTSCU831
|
||||
00248 MOVE FSKL-KEY-AREA OF FCOMM-REC DTSCU831
|
||||
00249 TO FSKL-KEY-AREA OF FIO-REC. DTSCU831
|
||||
00250 DTSCU831
|
||||
00251 MOVE FLEN-MAX-REC-LEN TO WRK-REC-LENGTH. DTSCU831
|
||||
00252 DTSCU831
|
||||
00253 EXEC CICS DTSCU831
|
||||
00254 READNEXT DTSCU831
|
||||
00255 DATASET (WRK-FILE-NAME) DTSCU831
|
||||
00256 INTO (FIO-REC) DTSCU831
|
||||
00257 LENGTH (WRK-REC-LENGTH) DTSCU831
|
||||
00258 RIDFLD (FSKL-KEY-AREA OF FIO-REC) DTSCU831
|
||||
00259 RESP (WRK-RESP-CD) DTSCU831
|
||||
00260 END-EXEC. DTSCU831
|
||||
00261 DTSCU831
|
||||
00262 IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED) DTSCU831
|
||||
00263 OR DFHRESP (SYSIDERR) DTSCU831
|
||||
00264 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU831
|
||||
00265 GO TO P2200-EXIT. DTSCU831
|
||||
00266 DTSCU831
|
||||
00267 IF WRK-RESP-CD = DFHRESP (NOTFND) OR DFHRESP (ENDFILE) DTSCU831
|
||||
00268 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU831
|
||||
00269 PERFORM P2400-END-BROWSE THRU P2400-EXIT DTSCU831
|
||||
00270 GO TO P2200-EXIT. DTSCU831
|
||||
00271 DTSCU831
|
||||
00272 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU831
|
||||
00273 NEXT SENTENCE DTSCU831
|
||||
00274 ELSE DTSCU831
|
||||
00275 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
||||
00276 DTSCU831
|
||||
00277 IF FSKL-REC-TYPE OF FIO-REC = FSKL-REC-TYPE OF FCOMM-REC DTSCU831
|
||||
00278 PERFORM S2100-IO-TO-COMM THRU S2100-EXIT DTSCU831
|
||||
00279 ELSE DTSCU831
|
||||
00280 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU831
|
||||
00281 PERFORM P2400-END-BROWSE THRU P2400-EXIT. DTSCU831
|
||||
00282 P2200-EXIT. DTSCU831
|
||||
00283 EXIT. DTSCU831
|
||||
00284 EJECT DTSCU831
|
||||
00285 P2300-READ-PREV. DTSCU831
|
||||
00286 MOVE LOW-VALUES TO FIO-REC. DTSCU831
|
||||
00287 DTSCU831
|
||||
00288 MOVE FSKL-KEY-AREA OF FCOMM-REC DTSCU831
|
||||
00289 TO FSKL-KEY-AREA OF FIO-REC. DTSCU831
|
||||
00290 DTSCU831
|
||||
00291 MOVE FLEN-MAX-REC-LEN TO WRK-REC-LENGTH. DTSCU831
|
||||
00292 DTSCU831
|
||||
00293 EXEC CICS DTSCU831
|
||||
00294 READPREV DTSCU831
|
||||
00295 DATASET (WRK-FILE-NAME) DTSCU831
|
||||
00296 INTO (FIO-REC) DTSCU831
|
||||
00297 LENGTH (WRK-REC-LENGTH) DTSCU831
|
||||
00298 RIDFLD (FSKL-KEY-AREA OF FIO-REC) DTSCU831
|
||||
00299 RESP (WRK-RESP-CD) DTSCU831
|
||||
00300 END-EXEC. DTSCU831
|
||||
00301 DTSCU831
|
||||
00302 IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED) DTSCU831
|
||||
00303 OR DFHRESP (SYSIDERR) DTSCU831
|
||||
00304 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU831
|
||||
00305 GO TO P2300-EXIT. DTSCU831
|
||||
00306 DTSCU831
|
||||
00307 IF WRK-RESP-CD = DFHRESP (NOTFND) OR DFHRESP (ENDFILE) DTSCU831
|
||||
00308 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU831
|
||||
00309 PERFORM P2400-END-BROWSE THRU P2400-EXIT DTSCU831
|
||||
00310 GO TO P2300-EXIT. DTSCU831
|
||||
00311 DTSCU831
|
||||
00312 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU831
|
||||
00313 NEXT SENTENCE DTSCU831
|
||||
00314 ELSE DTSCU831
|
||||
00315 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
||||
00316 DTSCU831
|
||||
00317 IF FSKL-REC-TYPE OF FIO-REC = FSKL-REC-TYPE OF FCOMM-REC DTSCU831
|
||||
00318 PERFORM S2100-IO-TO-COMM THRU S2100-EXIT DTSCU831
|
||||
00319 ELSE DTSCU831
|
||||
00320 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU831
|
||||
00321 PERFORM P2400-END-BROWSE THRU P2400-EXIT. DTSCU831
|
||||
00322 P2300-EXIT. DTSCU831
|
||||
00323 EXIT. DTSCU831
|
||||
00324 EJECT DTSCU831
|
||||
00325 P2400-END-BROWSE. DTSCU831
|
||||
00326 DTSCU831
|
||||
00327 EXEC CICS DTSCU831
|
||||
00328 ENDBR DTSCU831
|
||||
00329 DATASET (WRK-FILE-NAME) DTSCU831
|
||||
00330 RESP (WRK-RESP-CD) DTSCU831
|
||||
00331 END-EXEC. DTSCU831
|
||||
00332 DTSCU831
|
||||
00333 IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN) DTSCU831
|
||||
00334 OR DFHRESP (SYSIDERR) DTSCU831
|
||||
00335 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU831
|
||||
00336 GO TO P2400-EXIT. DTSCU831
|
||||
00337 DTSCU831
|
||||
00338 IF WRK-RESP-CD = DFHRESP (NORMAL) OR DFHRESP (INVREQ) DTSCU831
|
||||
00339 NEXT SENTENCE DTSCU831
|
||||
00340 ELSE DTSCU831
|
||||
00341 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
||||
00342 P2400-EXIT. DTSCU831
|
||||
00343 EXIT. DTSCU831
|
||||
00344 EJECT DTSCU831
|
||||
00345 P3100-WRITE. DTSCU831
|
||||
00346 PERFORM S2200-COMM-TO-IO THRU S2200-EXIT. DTSCU831
|
||||
00347 DTSCU831
|
||||
00348 PERFORM S2300-CALCULATE-LENGTH THRU S2300-EXIT. DTSCU831
|
||||
00349 DTSCU831
|
||||
00350 EXEC CICS DTSCU831
|
||||
00351 WRITE DTSCU831
|
||||
00352 DATASET (WRK-FILE-NAME) DTSCU831
|
||||
00353 FROM (FIO-REC) DTSCU831
|
||||
00354 LENGTH (WRK-REC-LENGTH) DTSCU831
|
||||
00355 RIDFLD (FSKL-KEY-AREA OF FIO-REC) DTSCU831
|
||||
00356 RESP (WRK-RESP-CD) DTSCU831
|
||||
00357 END-EXEC. DTSCU831
|
||||
00358 DTSCU831
|
||||
00359 IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN) DTSCU831
|
||||
00360 OR DFHRESP (SYSIDERR) DTSCU831
|
||||
00361 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU831
|
||||
00362 GO TO P3100-EXIT. DTSCU831
|
||||
00363 DTSCU831
|
||||
00364 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU831
|
||||
00365 NEXT SENTENCE DTSCU831
|
||||
00366 ELSE DTSCU831
|
||||
00367 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
||||
00368 P3100-EXIT. DTSCU831
|
||||
00369 EXIT. DTSCU831
|
||||
00370 EJECT DTSCU831
|
||||
00371 P3200-REWRITE. DTSCU831
|
||||
00372 PERFORM S3100-READ-UPDATE THRU S3100-EXIT. DTSCU831
|
||||
00373 DTSCU831
|
||||
00374 IF L831-NO-REC-88 DTSCU831
|
||||
00375 PERFORM S899-ABEND THRU S899-EXIT DTSCU831
|
||||
00376 ELSE DTSCU831
|
||||
00377 IF L831-FILE-CLOSED-88 DTSCU831
|
||||
00378 GO TO P3200-EXIT. DTSCU831
|
||||
00379 DTSCU831
|
||||
00380 PERFORM S2200-COMM-TO-IO THRU S2200-EXIT. DTSCU831
|
||||
00381 DTSCU831
|
||||
00382 PERFORM S2300-CALCULATE-LENGTH THRU S2300-EXIT. DTSCU831
|
||||
00383 DTSCU831
|
||||
00384 EXEC CICS DTSCU831
|
||||
00385 REWRITE DTSCU831
|
||||
00386 DATASET (WRK-FILE-NAME) DTSCU831
|
||||
00387 FROM (FIO-REC) DTSCU831
|
||||
00388 LENGTH (WRK-REC-LENGTH) DTSCU831
|
||||
00389 RESP (WRK-RESP-CD) DTSCU831
|
||||
00390 END-EXEC. DTSCU831
|
||||
00391 DTSCU831
|
||||
00392 IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN) DTSCU831
|
||||
00393 OR DFHRESP (SYSIDERR) DTSCU831
|
||||
00394 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU831
|
||||
00395 GO TO P3200-EXIT. DTSCU831
|
||||
00396 DTSCU831
|
||||
00397 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU831
|
||||
00398 NEXT SENTENCE DTSCU831
|
||||
00399 ELSE DTSCU831
|
||||
00400 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
||||
00401 P3200-EXIT. DTSCU831
|
||||
00402 EXIT. DTSCU831
|
||||
00403 EJECT DTSCU831
|
||||
00404 P3300-DELETE. DTSCU831
|
||||
00405 PERFORM S3100-READ-UPDATE THRU S3100-EXIT. DTSCU831
|
||||
00406 DTSCU831
|
||||
00407 IF L831-NO-REC-88 DTSCU831
|
||||
00408 PERFORM S899-ABEND THRU S899-EXIT DTSCU831
|
||||
00409 ELSE DTSCU831
|
||||
00410 IF L831-FILE-CLOSED-88 DTSCU831
|
||||
00411 GO TO P3300-EXIT. DTSCU831
|
||||
00412 DTSCU831
|
||||
00413 EXEC CICS DTSCU831
|
||||
00414 DELETE DTSCU831
|
||||
00415 DATASET (WRK-FILE-NAME) DTSCU831
|
||||
00416 RESP (WRK-RESP-CD) DTSCU831
|
||||
00417 END-EXEC. DTSCU831
|
||||
00418 DTSCU831
|
||||
00419 IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN) DTSCU831
|
||||
00420 OR DFHRESP (SYSIDERR) DTSCU831
|
||||
00421 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU831
|
||||
00422 GO TO P3300-EXIT. DTSCU831
|
||||
00423 DTSCU831
|
||||
00424 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU831
|
||||
00425 NEXT SENTENCE DTSCU831
|
||||
00426 ELSE DTSCU831
|
||||
00427 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
||||
00428 P3300-EXIT. DTSCU831
|
||||
00429 EXIT. DTSCU831
|
||||
00430 EJECT DTSCU831
|
||||
00431 S1100-NOT-AVAILABLE. DTSCU831
|
||||
00432 MOVE WRK-FILE-NAME TO EMSG-FILE-NAME. DTSCU831
|
||||
00433 DTSCU831
|
||||
00434 MOVE EMSG-NOT-AVAILABLE TO L831-MSG-AREA. DTSCU831
|
||||
00435 DTSCU831
|
||||
00436 SET L831-FILE-CLOSED-88 TO TRUE. DTSCU831
|
||||
00437 S1100-EXIT. DTSCU831
|
||||
00438 EXIT. DTSCU831
|
||||
00439 SKIP3 DTSCU831
|
||||
00440 S1200-NOT-FOUND. DTSCU831
|
||||
00441 SET L831-NO-REC-88 TO TRUE. DTSCU831
|
||||
00442 S1200-EXIT. DTSCU831
|
||||
00443 EXIT. DTSCU831
|
||||
00444 EJECT DTSCU831
|
||||
00445 S2100-IO-TO-COMM. DTSCU831
|
||||
00446 GO TO S2101-MOVE DTSCU831
|
||||
00447 S2102-MOVE DTSCU831
|
||||
00448 S2103-MOVE DTSCU831
|
||||
00449 S2104-MOVE DTSCU831
|
||||
00450 S2105-MOVE DTSCU831
|
||||
00451 S2106-MOVE DTSCU831
|
||||
00452 S2107-MOVE DTSCU831
|
||||
00453 S2108-MOVE DTSCU831
|
||||
00454 S2109-MOVE DTSCU831
|
||||
00455 S2110-MOVE DTSCU831
|
||||
00456 S2111-MOVE DTSCU831
|
||||
00457 S2112-MOVE DTSCU831
|
||||
00458 S2113-MOVE DTSCU831
|
||||
00459 S2114-MOVE DTSCU831
|
||||
00460 S2115-MOVE DTSCU831
|
||||
00461 S2116-MOVE DTSCU831
|
||||
00462 S2117-MOVE DTSCU831
|
||||
00463 S2118-MOVE DTSCU831
|
||||
00464 S2119-MOVE DTSCU831
|
||||
00465 S2120-MOVE DTSCU831
|
||||
00466 DEPENDING ON FSKL-REC-TYPE OF FIO-REC. DTSCU831
|
||||
00467 DTSCU831
|
||||
00468 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
||||
00469 SKIP3 DTSCU831
|
||||
00470 S2101-MOVE. DTSCU831
|
||||
00471 MOVE FIO-REC TO FCYR-REC. DTSCU831
|
||||
00472 GO TO S2100-EXIT. DTSCU831
|
||||
00473 SKIP3 DTSCU831
|
||||
00474 S2102-MOVE. DTSCU831
|
||||
00475 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
||||
00476 GO TO S2100-EXIT. DTSCU831
|
||||
00477 SKIP3 DTSCU831
|
||||
00478 S2103-MOVE. DTSCU831
|
||||
00479 MOVE FIO-REC TO FFAT-REC. DTSCU831
|
||||
00480 GO TO S2100-EXIT. DTSCU831
|
||||
00481 SKIP3 DTSCU831
|
||||
00482 S2104-MOVE. DTSCU831
|
||||
00483 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
||||
00484 GO TO S2100-EXIT. DTSCU831
|
||||
00485 SKIP3 DTSCU831
|
||||
00486 S2105-MOVE. DTSCU831
|
||||
00487 MOVE FIO-REC TO FFAZ-REC. DTSCU831
|
||||
00488 GO TO S2100-EXIT. DTSCU831
|
||||
00489 SKIP3 DTSCU831
|
||||
00490 S2106-MOVE. DTSCU831
|
||||
00491 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
||||
00492 GO TO S2100-EXIT. DTSCU831
|
||||
00493 SKIP3 DTSCU831
|
||||
00494 S2107-MOVE. DTSCU831
|
||||
00495 MOVE FIO-REC TO FFID-REC. DTSCU831
|
||||
00496 GO TO S2100-EXIT. DTSCU831
|
||||
00497 SKIP3 DTSCU831
|
||||
00498 S2108-MOVE. DTSCU831
|
||||
00499 MOVE FIO-REC TO FFIS-REC. DTSCU831
|
||||
00500 GO TO S2100-EXIT. DTSCU831
|
||||
00501 SKIP3 DTSCU831
|
||||
00502 S2109-MOVE. DTSCU831
|
||||
00503 MOVE FIO-REC TO FOPR-REC. DTSCU831
|
||||
00504 GO TO S2100-EXIT. DTSCU831
|
||||
00505 SKIP3 DTSCU831
|
||||
00506 S2110-MOVE. DTSCU831
|
||||
00507 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
||||
00508 GO TO S2100-EXIT. DTSCU831
|
||||
00509 SKIP3 DTSCU831
|
||||
00510 S2111-MOVE. DTSCU831
|
||||
00511 MOVE FIO-REC TO FQTR-REC. DTSCU831
|
||||
00512 GO TO S2100-EXIT. DTSCU831
|
||||
00513 SKIP3 DTSCU831
|
||||
00514 S2112-MOVE. DTSCU831
|
||||
00515 MOVE FIO-REC TO FAFD-REC. DTSCU831
|
||||
00516 GO TO S2100-EXIT. DTSCU831
|
||||
00517 SKIP3 DTSCU831
|
||||
00518 S2113-MOVE. DTSCU831
|
||||
00519 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
||||
00520 GO TO S2100-EXIT. DTSCU831
|
||||
00521 SKIP3 DTSCU831
|
||||
00522 S2114-MOVE. DTSCU831
|
||||
00523 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
||||
00524 GO TO S2100-EXIT. DTSCU831
|
||||
00525 SKIP3 DTSCU831
|
||||
00526 S2115-MOVE. DTSCU831
|
||||
00527 MOVE FIO-REC TO FSEL-REC. DTSCU831
|
||||
00528 GO TO S2100-EXIT. DTSCU831
|
||||
00529 SKIP3 DTSCU831
|
||||
00530 S2116-MOVE. DTSCU831
|
||||
00531 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
||||
00532 GO TO S2100-EXIT. DTSCU831
|
||||
00533 SKIP3 DTSCU831
|
||||
00534 S2117-MOVE. DTSCU831
|
||||
00535 MOVE FIO-REC TO FUIR-REC. DTSCU831
|
||||
00536 GO TO S2100-EXIT. DTSCU831
|
||||
00537 SKIP3 DTSCU831
|
||||
00538 S2118-MOVE. DTSCU831
|
||||
00539 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
||||
00540 GO TO S2100-EXIT. DTSCU831
|
||||
00541 SKIP3 DTSCU831
|
||||
00542 S2119-MOVE. DTSCU831
|
||||
00543 MOVE FIO-REC TO F581-REC. DTSCU831
|
||||
00544 GO TO S2100-EXIT. DTSCU831
|
||||
00545 SKIP3 DTSCU831
|
||||
00546 S2120-MOVE. DTSCU831
|
||||
00547 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
||||
00548 GO TO S2100-EXIT. DTSCU831
|
||||
00549 SKIP3 DTSCU831
|
||||
00550 S2100-EXIT. DTSCU831
|
||||
00551 EXIT. DTSCU831
|
||||
00552 EJECT DTSCU831
|
||||
00553 S2200-COMM-TO-IO. DTSCU831
|
||||
00554 GO TO S2201-MOVE DTSCU831
|
||||
00555 S2202-MOVE DTSCU831
|
||||
00556 S2203-MOVE DTSCU831
|
||||
00557 S2204-MOVE DTSCU831
|
||||
00558 S2205-MOVE DTSCU831
|
||||
00559 S2206-MOVE DTSCU831
|
||||
00560 S2207-MOVE DTSCU831
|
||||
00561 S2208-MOVE DTSCU831
|
||||
00562 S2209-MOVE DTSCU831
|
||||
00563 S2210-MOVE DTSCU831
|
||||
00564 S2211-MOVE DTSCU831
|
||||
00565 S2212-MOVE DTSCU831
|
||||
00566 S2213-MOVE DTSCU831
|
||||
00567 S2214-MOVE DTSCU831
|
||||
00568 S2215-MOVE DTSCU831
|
||||
00569 S2216-MOVE DTSCU831
|
||||
00570 S2217-MOVE DTSCU831
|
||||
00571 S2218-MOVE DTSCU831
|
||||
00572 S2219-MOVE DTSCU831
|
||||
00573 S2220-MOVE DTSCU831
|
||||
00574 DEPENDING ON FSKL-REC-TYPE OF FCOMM-REC. DTSCU831
|
||||
00575 DTSCU831
|
||||
00576 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
||||
00577 SKIP3 DTSCU831
|
||||
00578 S2201-MOVE. DTSCU831
|
||||
00579 MOVE LOW-VALUES TO FCYR-KEY-FILLER. DTSCU831
|
||||
00580 MOVE FCYR-REC TO FIO-REC. DTSCU831
|
||||
00581 GO TO S2200-EXIT. DTSCU831
|
||||
00582 SKIP3 DTSCU831
|
||||
00583 S2202-MOVE. DTSCU831
|
||||
00584 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
||||
00585 GO TO S2200-EXIT. DTSCU831
|
||||
00586 SKIP3 DTSCU831
|
||||
00587 S2203-MOVE. DTSCU831
|
||||
00588 MOVE LOW-VALUES TO FFAT-KEY-FILLER. DTSCU831
|
||||
00589 MOVE FFAT-REC TO FIO-REC. DTSCU831
|
||||
00590 GO TO S2200-EXIT. DTSCU831
|
||||
00591 SKIP3 DTSCU831
|
||||
00592 S2204-MOVE. DTSCU831
|
||||
00593 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
||||
00594 GO TO S2200-EXIT. DTSCU831
|
||||
00595 SKIP3 DTSCU831
|
||||
00596 S2205-MOVE. DTSCU831
|
||||
00597 MOVE LOW-VALUES TO FFAZ-KEY-FILLER. DTSCU831
|
||||
00598 MOVE FFAZ-REC TO FIO-REC. DTSCU831
|
||||
00599 GO TO S2200-EXIT. DTSCU831
|
||||
00600 SKIP3 DTSCU831
|
||||
00601 S2206-MOVE. DTSCU831
|
||||
00602 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
||||
00603 GO TO S2200-EXIT. DTSCU831
|
||||
00604 SKIP3 DTSCU831
|
||||
00605 S2207-MOVE. DTSCU831
|
||||
00606 MOVE LOW-VALUES TO FFID-KEY-FILLER. DTSCU831
|
||||
00607 MOVE FFID-REC TO FIO-REC. DTSCU831
|
||||
00608 GO TO S2200-EXIT. DTSCU831
|
||||
00609 SKIP3 DTSCU831
|
||||
00610 S2208-MOVE. DTSCU831
|
||||
00611 MOVE LOW-VALUES TO FFIS-KEY-FILLER. DTSCU831
|
||||
00612 MOVE FFIS-REC TO FIO-REC. DTSCU831
|
||||
00613 GO TO S2200-EXIT. DTSCU831
|
||||
00614 SKIP3 DTSCU831
|
||||
00615 S2209-MOVE. DTSCU831
|
||||
00616 MOVE LOW-VALUES TO FOPR-KEY-FILLER. DTSCU831
|
||||
00617 MOVE FOPR-REC TO FIO-REC. DTSCU831
|
||||
00618 GO TO S2200-EXIT. DTSCU831
|
||||
00619 SKIP3 DTSCU831
|
||||
00620 S2210-MOVE. DTSCU831
|
||||
00621 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
||||
00622 GO TO S2200-EXIT. DTSCU831
|
||||
00623 SKIP3 DTSCU831
|
||||
00624 S2211-MOVE. DTSCU831
|
||||
00625 MOVE LOW-VALUES TO FQTR-KEY-FILLER. DTSCU831
|
||||
00626 MOVE FQTR-REC TO FIO-REC. DTSCU831
|
||||
00627 GO TO S2200-EXIT. DTSCU831
|
||||
00628 SKIP3 DTSCU831
|
||||
00629 S2212-MOVE. DTSCU831
|
||||
00630 MOVE LOW-VALUES TO FAFD-KEY-FILLER. DTSCU831
|
||||
00631 MOVE FAFD-REC TO FIO-REC. DTSCU831
|
||||
00632 GO TO S2200-EXIT. DTSCU831
|
||||
00633 SKIP3 DTSCU831
|
||||
00634 S2213-MOVE. DTSCU831
|
||||
00635 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
||||
00636 GO TO S2200-EXIT. DTSCU831
|
||||
00637 SKIP3 DTSCU831
|
||||
00638 S2214-MOVE. DTSCU831
|
||||
00639 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
||||
00640 GO TO S2200-EXIT. DTSCU831
|
||||
00641 SKIP3 DTSCU831
|
||||
00642 S2215-MOVE. DTSCU831
|
||||
00643 MOVE LOW-VALUES TO FSEL-KEY-FILLER. DTSCU831
|
||||
00644 MOVE FSEL-REC TO FIO-REC. DTSCU831
|
||||
00645 GO TO S2200-EXIT. DTSCU831
|
||||
00646 SKIP3 DTSCU831
|
||||
00647 S2216-MOVE. DTSCU831
|
||||
00648 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
||||
00649 GO TO S2200-EXIT. DTSCU831
|
||||
00650 SKIP3 DTSCU831
|
||||
00651 S2217-MOVE. DTSCU831
|
||||
00652 MOVE LOW-VALUES TO FUIR-KEY-FILLER. DTSCU831
|
||||
00653 MOVE FUIR-REC TO FIO-REC. DTSCU831
|
||||
00654 GO TO S2200-EXIT. DTSCU831
|
||||
00655 SKIP3 DTSCU831
|
||||
00656 S2218-MOVE. DTSCU831
|
||||
00657 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
||||
00658 GO TO S2200-EXIT. DTSCU831
|
||||
00659 SKIP3 DTSCU831
|
||||
00660 S2219-MOVE. DTSCU831
|
||||
00661 MOVE LOW-VALUES TO F581-KEY-FILLER. DTSCU831
|
||||
00662 MOVE F581-REC TO FIO-REC. DTSCU831
|
||||
00663 GO TO S2200-EXIT. DTSCU831
|
||||
00664 SKIP3 DTSCU831
|
||||
00665 S2220-MOVE. DTSCU831
|
||||
00666 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
||||
00667 GO TO S2200-EXIT. DTSCU831
|
||||
00668 SKIP3 DTSCU831
|
||||
00669 S2200-EXIT. DTSCU831
|
||||
00670 EXIT. DTSCU831
|
||||
00671 EJECT DTSCU831
|
||||
00672 S2300-CALCULATE-LENGTH. DTSCU831
|
||||
00673 IF (FSKL-REC-TYPE OF FCOMM-REC < +1) DTSCU831
|
||||
00674 OR DTSCU831
|
||||
00675 (FSKL-REC-TYPE OF FCOMM-REC > FLEN-MAX-REC-ID) DTSCU831
|
||||
00676 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
||||
00677 DTSCU831
|
||||
00678 SET FLEN-IDX TO FSKL-REC-TYPE OF FCOMM-REC. DTSCU831
|
||||
00679 DTSCU831
|
||||
00680 IF FLEN-REC-LEN (FLEN-IDX) = +0 DTSCU831
|
||||
00681 PERFORM S899-ABEND THRU S899-EXIT DTSCU831
|
||||
00682 ELSE DTSCU831
|
||||
00683 MOVE FLEN-REC-LEN (FLEN-IDX) TO WRK-REC-LENGTH. DTSCU831
|
||||
00684 S2300-EXIT. DTSCU831
|
||||
00685 EXIT. DTSCU831
|
||||
00686 EJECT DTSCU831
|
||||
00687 S3100-READ-UPDATE. DTSCU831
|
||||
00688 MOVE LOW-VALUES TO FIO-REC. DTSCU831
|
||||
00689 DTSCU831
|
||||
00690 MOVE FSKL-KEY-AREA OF FCOMM-REC TO FSKL-KEY-AREA OF FIO-REC. DTSCU831
|
||||
00691 DTSCU831
|
||||
00692 MOVE FLEN-MAX-REC-LEN TO WRK-REC-LENGTH. DTSCU831
|
||||
00693 DTSCU831
|
||||
00694 EXEC CICS DTSCU831
|
||||
00695 READ DTSCU831
|
||||
00696 DATASET (WRK-FILE-NAME) DTSCU831
|
||||
00697 INTO (FIO-REC) DTSCU831
|
||||
00698 LENGTH (WRK-REC-LENGTH) DTSCU831
|
||||
00699 RIDFLD (FSKL-KEY-AREA OF FIO-REC) DTSCU831
|
||||
00700 UPDATE DTSCU831
|
||||
00701 RESP (WRK-RESP-CD) DTSCU831
|
||||
00702 END-EXEC. DTSCU831
|
||||
00703 DTSCU831
|
||||
00704 IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED) DTSCU831
|
||||
00705 OR DFHRESP (SYSIDERR) DTSCU831
|
||||
00706 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU831
|
||||
00707 GO TO S3100-EXIT. DTSCU831
|
||||
00708 DTSCU831
|
||||
00709 IF WRK-RESP-CD = DFHRESP (NOTFND) DTSCU831
|
||||
00710 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU831
|
||||
00711 GO TO S3100-EXIT. DTSCU831
|
||||
00712 DTSCU831
|
||||
00713 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU831
|
||||
00714 NEXT SENTENCE DTSCU831
|
||||
00715 ELSE DTSCU831
|
||||
00716 PERFORM S899-ABEND THRU S899-EXIT. DTSCU831
|
||||
00717 S3100-EXIT. DTSCU831
|
||||
00718 EXIT. DTSCU831
|
||||
00719 EJECT DTSCU831
|
||||
00720 S899-ABEND. DTSCU831
|
||||
00721 DTSCU831
|
||||
00722 EXEC CICS DTSCU831
|
||||
00723 ABEND DTSCU831
|
||||
00724 ABCODE (WRK-ABEND-CD) DTSCU831
|
||||
00725 END-EXEC. DTSCU831
|
||||
00726 DTSCU831
|
||||
00727 S899-EXIT. DTSCU831
|
||||
00728 EXIT. DTSCU831
|
||||
Reference in New Issue
Block a user