00001 IDENTIFICATION DIVISION. 04/05/04 00002 PROGRAM-ID. DTSCU882. DTSCU882 00003 AUTHOR. TRW. LV001 00004 DATE-WRITTEN. FEBRUARY 2002. DTSCU882 00005 DATE-COMPILED. DTSCU882 00006 SKIP3 DTSCU882 00007 ***** DTSCU882 00008 * DTSCU882 00009 * FUNCTION: NAME FILE FILE INPUT/OUTPUT. DTSCU882 00010 * DTSCU882 00011 * DTSCU882 00012 * MODIFICATION LOG: DTSCU882 00013 * DTSCU882 00014 * 03/24/2004 INITIAL DEVELOPMENT. DTSCU882 00015 * WORK ORDER: HOUSEHOLD PROGRAMMER: GD DTSCU882 00016 * DTSCU882 00017 * XX/XX/XXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU882 00018 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU882 00019 * WORK ORDER: PROGRAMMER: XXX DTSCU882 00020 * DTSCU882 00021 * DTSCU882 00022 * DESCRIPTION: DTSCU882 00023 * DTSCU882 00024 * DTSCU882 PERFORMS ALL REQUIRED EMPLOYEE NAME DTSCU882 00025 * FILE INPUT/OUTPUT. DTSCU882'S COMMAREA CONSISTS OF DTSCU882 00026 * DTSIL882, FOLLOWED BY DTSIWNAM. SEE DFHCOMMAREA DTSCU882 00027 * OF THIS MODULE FOR AN EXAMPLE. DTSCU882 00028 * DTSCU882 00029 * DTSCU882 00030 * GENERAL SPECIFICATIONS: DTSCU882 00031 * DTSCU882 00032 * IF AN INVALID COMMAND IS REQUESTED, THEN ABEND THE DTSCU882 00033 * MODULE. DTSCU882 00034 * DTSCU882 00035 * IF A CICS FILE COMMAND YIELDS A RESPONSE OTHER THAN DTSCU882 00036 * NORMAL, NOTFND, ENDFILE, NOTOPEN, OR DISABLED, DTSCU882 00037 * THEN ABEND THE MODULE (TOLERATE INVREQ FROM A DTSCU882 00038 * ENDBR). DTSCU882 00039 * DTSCU882 00040 * SPECIFY WIO-REC AS THE INTO OR FROM AREA OF THE CICS DTSCU882 00041 * FILE COMMAND. DTSCU882 00042 * DTSCU882 00043 * SPECIFY WNAM-KEY OF WIO-REC AS THE RIDFLD OF THE CICS DTSCU882 00044 * FILE COMMANDS. DTSCU882 00045 * DTSCU882 00046 * WHEN MOVING DATA FROM DFHCOMMAREA RECORDS TO WIO-REC DTSCU882 00047 * (PRIOR TO A WRITE OR REWRITE), REFER TO WNAM-REC, DTSCU882 00048 * (NOT WCOMM-REC). DTSCU882 00049 * DTSCU882 00050 * WHEN MOVING DATA FROM WIO-REC TO DFHCOMMAREA (AFTER DTSCU882 00051 * A SUCCESSFUL READ, READ UPDATE, STARTBR, READNEXT, DTSCU882 00052 * OR READPREV) REFER TO W001-REC (NOT WCOMM-REC). DTSCU882 00053 * DTSCU882 00054 * DTSCU882 00055 * COMMAND SPECIFIC SPECIFICATIONS: DTSCU882 00056 * DTSCU882 00057 * READ DTSCU882 00058 * DTSCU882 00059 * STARTBR DTSCU882 00060 * DTSCU882 00061 * PERFORM A STARTBR. IF THE STARTBR IS DTSCU882 00062 * SUCCESSFUL, THEN PERFORM A READNEXT. IF THE DTSCU882 00063 * READNEXT YIELDS AN ENDFILE CONDITION, THEN RETURN DTSCU882 00064 * L882-NO-REC-88. DTSCU882 00065 * DTSCU882 00066 * IF THE READNEXT RETURNS A L882-NO-REC-88, THEN DTSCU882 00067 * ISSUE AN ENDBR. DTSCU882 00068 * DTSCU882 00069 * READNEXT DTSCU882 00070 * PRIOR TO THE READNEXT, MOVE WNAM-KEY-AREA OF DTSCU882 00071 * WCOMM-REC TO WNAM-KEY-AREA OF WIO-REC. IF THE DTSCU882 00072 * READNEXT YIELDS AN ENDFILE CONDITION, THEN RETURN DTSCU882 00073 * L882-NO-REC-88. DTSCU882 00074 * DTSCU882 00075 * IF THE READNEXT RETURN A L882-NO-REC-88, THEN DTSCU882 00076 * ISSUE AN ENDBR. DTSCU882 00077 * DTSCU882 00078 * READPREV DTSCU882 00079 * PRIOR TO THE READPREV, MOVE WNAM-KEY-AREA OF DTSCU882 00080 * WCOMM-REC TO WNAM-KEY-AREA OF WIO-REC. IF THE DTSCU882 00081 * READPREV YIELDS AN ENDFILE CONDITION, THEN RETURN DTSCU882 00082 * L882-NO-REC-88. DTSCU882 00083 * DTSCU882 00084 * IF THE READPREV RETURN A L882-NO-REC-88, THEN DTSCU882 00085 * ISSUE AN ENDBR. DTSCU882 00086 * DTSCU882 00087 * ENDBR DTSCU882 00088 * TOLERATE THE INVREQ CONDITION. DTSCU882 00089 * DTSCU882 00090 * WRITE DTSCU882 00091 * DTSCU882 00092 * REWRITE DTSCU882 00093 * DTSCU882 00094 * DELETE DTSCU882 00095 * READ (UPDATE) THE RECORD TO BE DELETED. IF RECORD NOT DTSCU882 00096 * FOUND, ABEND THE MODULE. DTSCU882 00097 * DTSCU882 00098 * DELETE. DTSCU882 00099 * DTSCU882 00100 ***** DTSCU882 00101 SKIP3 DTSCU882 00102 ENVIRONMENT DIVISION. DTSCU882 00103 SKIP3 DTSCU882 00104 DATA DIVISION. DTSCU882 00105 SKIP3 DTSCU882 00106 WORKING-STORAGE SECTION. DTSCU882 001065 77 PAN-VALET PICTURE X(24) VALUE '001DTSCU882 04/05/04'. DTSCU882 00107 SKIP3 DTSCU882 00108 01 WRK-AREA. DTSCU882 00109 05 WRK-ABEND-CD PIC X(04) VALUE 'U882'. DTSCU882 00110 05 WRK-RESP-CD PIC S9(08) COMP. DTSCU882 00111 DTSCU882 00112 05 WRK-PROD-FILE-NAME PIC X(08) VALUE 'DTSFWNAM'.DTSCU882 00113 DTSCU882 00114 05 EMSG-NOT-AVAILABLE. DTSCU882 00115 10 FILLER PIC X(04) VALUE 'E082'. DTSCU882 00116 10 FILLER PIC X(06) VALUE 'FILE '. DTSCU882 00117 10 EMSG-FILE-NAME PIC X(08). DTSCU882 00118 10 FILLER PIC X(33) DTSCU882 00119 VALUE ' NOT AVAILABLE PLEASE TRY LATER'. DTSCU882 00120 SKIP3 DTSCU882 00121 *****05 WRK-CICS-APPLID PIC X(08). DTSCU882 00122 DTSCU882 00123 05 WRK-FILE-NAME PIC X(08). DTSCU882 00124 DTSCU882 00125 05 WRK-REC-LENGTH PIC S9(04) COMP DTSCU882 00126 VALUE +51. DTSCU882 00127 EJECT DTSCU882 00128 01 WIO-REC. DTSCU882 00129 ++INCLUDE DTSIWNAM DTSCU882 00130 EJECT DTSCU882 00131 LINKAGE SECTION. DTSCU882 00132 SKIP3 DTSCU882 00133 01 DFHCOMMAREA. DTSCU882 00134 05 L882-CONTROL-BLOCK. DTSCU882 00135 ++INCLUDE DTSIL882 DTSCU882 00136 SKIP3 DTSCU882 00137 05 WCOMM-REC. DTSCU882 00138 ++INCLUDE DTSIWNAM DTSCU882 00139 SKIP3 DTSCU882 00140 PROCEDURE DIVISION. DTSCU882 00141 DTSCU882 00142 *****EXEC CICS DTSCU882 00143 ***** ASSIGN DTSCU882 00144 ***** APPLID (WRK-CICS-APPLID) DTSCU882 00145 *****END-EXEC. DTSCU882 00146 ***** DTSCU882 00147 *****IF WRK-CICS-APPLID = 'CICSAORT' DTSCU882 00148 ***** EXEC CICS DTSCU882 00149 ***** ASSIGN DTSCU882 00150 ***** USERID (WRK-CICS-OP-ID) DTSCU882 00151 ***** END-EXEC DTSCU882 00152 ***** DTSCU882 00153 ***** IF WRK-TCL-OP-ID-88 DTSCU882 00154 ***** MOVE WRK-TCL-FILE-NAME TO WRK-FILE-NAME DTSCU882 00155 ***** ELSE DTSCU882 00156 ***** MOVE WRK-TEST-FILE-NAME TO WRK-FILE-NAME DTSCU882 00157 *****ELSE DTSCU882 00158 MOVE WRK-PROD-FILE-NAME TO WRK-FILE-NAME. DTSCU882 00159 DTSCU882 00160 DTSCU882 00161 MOVE SPACES TO L882-MSG-AREA. DTSCU882 00162 DTSCU882 00163 SET L882-OK-88 TO TRUE. DTSCU882 00164 DTSCU882 00165 IF L882-READ-NEXT-88 DTSCU882 00166 PERFORM P2200-READ-NEXT THRU P2200-EXIT DTSCU882 00167 ELSE DTSCU882 00168 IF L882-READ-88 DTSCU882 00169 PERFORM P1100-READ THRU P1100-EXIT DTSCU882 00170 ELSE DTSCU882 00171 IF L882-START-BROWSE-88 DTSCU882 00172 PERFORM P2100-START-BROWSE THRU P2100-EXIT DTSCU882 00173 ELSE DTSCU882 00174 IF L882-END-BROWSE-88 DTSCU882 00175 PERFORM P2400-END-BROWSE THRU P2400-EXIT DTSCU882 00176 ELSE DTSCU882 00177 IF L882-READ-PREV-88 DTSCU882 00178 PERFORM P2300-READ-PREV THRU P2300-EXIT DTSCU882 00179 ELSE DTSCU882 00180 IF L882-WRITE-88 DTSCU882 00181 PERFORM P3100-WRITE THRU P3100-EXIT DTSCU882 00182 ELSE DTSCU882 00183 IF L882-REWRITE-88 DTSCU882 00184 PERFORM P3200-REWRITE THRU P3200-EXIT DTSCU882 00185 ELSE DTSCU882 00186 IF L882-DELETE-88 DTSCU882 00187 PERFORM P3300-DELETE THRU P3300-EXIT DTSCU882 00188 ELSE DTSCU882 00189 GO TO S899-ABEND. DTSCU882 00190 DTSCU882 00191 DTSCU882 00192 EXEC CICS DTSCU882 00193 RETURN DTSCU882 00194 END-EXEC. DTSCU882 00195 DTSCU882 00196 DTSCU882 00197 GOBACK. DTSCU882 00198 EJECT DTSCU882 00199 P1100-READ. DTSCU882 00200 MOVE LOW-VALUE TO WIO-REC. DTSCU882 00201 DTSCU882 00202 MOVE WNAM-KEY-AREA OF WCOMM-REC TO WNAM-KEY-AREA OF WIO-REC. DTSCU882 00203 DTSCU882 00204 DTSCU882 00205 EXEC CICS DTSCU882 00206 READ DTSCU882 00207 DATASET (WRK-FILE-NAME) DTSCU882 00208 INTO (WIO-REC) DTSCU882 00209 LENGTH (WRK-REC-LENGTH) DTSCU882 00210 RIDFLD (WNAM-KEY-AREA OF WIO-REC) DTSCU882 00211 RESP (WRK-RESP-CD) DTSCU882 00212 END-EXEC. DTSCU882 00213 DTSCU882 00214 IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED) DTSCU882 00215 OR DFHRESP (SYSIDERR) DTSCU882 00216 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU882 00217 GO TO P1100-EXIT. DTSCU882 00218 DTSCU882 00219 IF WRK-RESP-CD = DFHRESP (NOTFND) DTSCU882 00220 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU882 00221 GO TO P1100-EXIT. DTSCU882 00222 DTSCU882 00223 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU882 00224 MOVE WIO-REC TO WCOMM-REC DTSCU882 00225 ELSE DTSCU882 00226 GO TO S899-ABEND. DTSCU882 00227 P1100-EXIT. DTSCU882 00228 EXIT. DTSCU882 00229 EJECT DTSCU882 00230 P2100-START-BROWSE. DTSCU882 00231 MOVE LOW-VALUE TO WIO-REC. DTSCU882 00232 DTSCU882 00233 MOVE WNAM-KEY-AREA OF WCOMM-REC TO WNAM-KEY-AREA OF WIO-REC. DTSCU882 00234 DTSCU882 00235 EXEC CICS DTSCU882 00236 STARTBR DTSCU882 00237 DATASET (WRK-FILE-NAME) DTSCU882 00238 RIDFLD (WNAM-KEY-AREA OF WIO-REC) DTSCU882 00239 RESP (WRK-RESP-CD) DTSCU882 00240 END-EXEC. DTSCU882 00241 DTSCU882 00242 IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED) DTSCU882 00243 OR DFHRESP (SYSIDERR) DTSCU882 00244 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU882 00245 GO TO P2100-EXIT. DTSCU882 00246 DTSCU882 00247 IF WRK-RESP-CD = DFHRESP (NOTFND) DTSCU882 00248 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU882 00249 GO TO P2100-EXIT. DTSCU882 00250 DTSCU882 00251 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU882 00252 PERFORM P2200-READ-NEXT THRU P2200-EXIT DTSCU882 00253 ELSE DTSCU882 00254 GO TO S899-ABEND. DTSCU882 00255 P2100-EXIT. DTSCU882 00256 EXIT. DTSCU882 00257 EJECT DTSCU882 00258 P2200-READ-NEXT. DTSCU882 00259 IF L882-READ-NEXT-88 DTSCU882 00260 MOVE LOW-VALUE TO WIO-REC DTSCU882 00261 MOVE WNAM-KEY-AREA OF WCOMM-REC DTSCU882 00262 TO WNAM-KEY-AREA OF WIO-REC. DTSCU882 00263 DTSCU882 00264 EXEC CICS DTSCU882 00265 READNEXT DTSCU882 00266 DATASET (WRK-FILE-NAME) DTSCU882 00267 INTO (WIO-REC) DTSCU882 00268 LENGTH (WRK-REC-LENGTH) DTSCU882 00269 RIDFLD (WNAM-KEY-AREA OF WIO-REC) DTSCU882 00270 RESP (WRK-RESP-CD) DTSCU882 00271 END-EXEC. DTSCU882 00272 DTSCU882 00273 IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED) DTSCU882 00274 OR DFHRESP (SYSIDERR) DTSCU882 00275 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU882 00276 GO TO P2200-EXIT. DTSCU882 00277 DTSCU882 00278 IF WRK-RESP-CD = DFHRESP (NOTFND) OR DFHRESP (ENDFILE) DTSCU882 00279 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU882 00280 PERFORM P2400-END-BROWSE THRU P2400-EXIT DTSCU882 00281 GO TO P2200-EXIT. DTSCU882 00282 DTSCU882 00283 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU882 00284 NEXT SENTENCE DTSCU882 00285 ELSE DTSCU882 00286 GO TO S899-ABEND. DTSCU882 00287 DTSCU882 00288 IF WNAM-SSN OF WIO-REC = WNAM-SSN OF WCOMM-REC DTSCU882 00289 MOVE WIO-REC TO WCOMM-REC DTSCU882 00290 ELSE DTSCU882 00291 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU882 00292 PERFORM P2400-END-BROWSE THRU P2400-EXIT DTSCU882 00293 GO TO P2200-EXIT. DTSCU882 00294 DTSCU882 00295 P2200-EXIT. DTSCU882 00296 EXIT. DTSCU882 00297 EJECT DTSCU882 00298 P2300-READ-PREV. DTSCU882 00299 MOVE LOW-VALUE TO WIO-REC. DTSCU882 00300 DTSCU882 00301 MOVE WNAM-KEY-AREA OF WCOMM-REC DTSCU882 00302 TO WNAM-KEY-AREA OF WIO-REC. DTSCU882 00303 DTSCU882 00304 EXEC CICS DTSCU882 00305 READPREV DTSCU882 00306 DATASET (WRK-FILE-NAME) DTSCU882 00307 INTO (WIO-REC) DTSCU882 00308 LENGTH (WRK-REC-LENGTH) DTSCU882 00309 RIDFLD (WNAM-KEY-AREA OF WIO-REC) DTSCU882 00310 RESP (WRK-RESP-CD) DTSCU882 00311 END-EXEC. DTSCU882 00312 DTSCU882 00313 IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED) DTSCU882 00314 OR DFHRESP (SYSIDERR) DTSCU882 00315 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU882 00316 GO TO P2300-EXIT. DTSCU882 00317 DTSCU882 00318 IF WRK-RESP-CD = DFHRESP (NOTFND) OR DFHRESP (ENDFILE) DTSCU882 00319 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU882 00320 PERFORM P2400-END-BROWSE THRU P2400-EXIT DTSCU882 00321 GO TO P2300-EXIT. DTSCU882 00322 DTSCU882 00323 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU882 00324 NEXT SENTENCE DTSCU882 00325 ELSE DTSCU882 00326 GO TO S899-ABEND. DTSCU882 00327 DTSCU882 00328 IF WNAM-SSN OF WIO-REC = WNAM-SSN OF WCOMM-REC DTSCU882 00329 MOVE WIO-REC TO WCOMM-REC DTSCU882 00330 ELSE DTSCU882 00331 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU882 00332 PERFORM P2400-END-BROWSE THRU P2400-EXIT DTSCU882 00333 GO TO P2300-EXIT. DTSCU882 00334 P2300-EXIT. DTSCU882 00335 EXIT. DTSCU882 00336 EJECT DTSCU882 00337 P2400-END-BROWSE. DTSCU882 00338 DTSCU882 00339 EXEC CICS DTSCU882 00340 ENDBR DTSCU882 00341 DATASET (WRK-FILE-NAME) DTSCU882 00342 RESP (WRK-RESP-CD) DTSCU882 00343 END-EXEC. DTSCU882 00344 DTSCU882 00345 IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN) DTSCU882 00346 OR DFHRESP (SYSIDERR) DTSCU882 00347 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU882 00348 GO TO P2400-EXIT. DTSCU882 00349 DTSCU882 00350 IF WRK-RESP-CD = DFHRESP (NORMAL) OR DFHRESP (INVREQ) DTSCU882 00351 NEXT SENTENCE DTSCU882 00352 ELSE DTSCU882 00353 GO TO S899-ABEND. DTSCU882 00354 P2400-EXIT. DTSCU882 00355 EXIT. DTSCU882 00356 EJECT DTSCU882 00357 P3100-WRITE. DTSCU882 00358 MOVE WCOMM-REC TO WIO-REC. DTSCU882 00359 DTSCU882 00360 EXEC CICS DTSCU882 00361 WRITE DTSCU882 00362 DATASET (WRK-FILE-NAME) DTSCU882 00363 FROM (WIO-REC) DTSCU882 00364 LENGTH (WRK-REC-LENGTH) DTSCU882 00365 RIDFLD (WNAM-KEY-AREA OF WIO-REC) DTSCU882 00366 RESP (WRK-RESP-CD) DTSCU882 00367 END-EXEC. DTSCU882 00368 DTSCU882 00369 IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN) DTSCU882 00370 OR DFHRESP (SYSIDERR) DTSCU882 00371 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU882 00372 GO TO P3100-EXIT. DTSCU882 00373 DTSCU882 00374 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU882 00375 NEXT SENTENCE DTSCU882 00376 ELSE DTSCU882 00377 GO TO S899-ABEND. DTSCU882 00378 P3100-EXIT. DTSCU882 00379 EXIT. DTSCU882 00380 EJECT DTSCU882 00381 P3200-REWRITE. DTSCU882 00382 PERFORM S3100-READ-UPDATE THRU S3100-EXIT. DTSCU882 00383 DTSCU882 00384 IF L882-NO-REC-88 DTSCU882 00385 GO TO S899-ABEND DTSCU882 00386 ELSE DTSCU882 00387 IF L882-FILE-CLOSED-88 DTSCU882 00388 GO TO P3200-EXIT. DTSCU882 00389 DTSCU882 00390 MOVE WCOMM-REC TO WIO-REC. DTSCU882 00391 DTSCU882 00392 EXEC CICS DTSCU882 00393 REWRITE DTSCU882 00394 DATASET (WRK-FILE-NAME) DTSCU882 00395 FROM (WIO-REC) DTSCU882 00396 LENGTH (WRK-REC-LENGTH) DTSCU882 00397 RESP (WRK-RESP-CD) DTSCU882 00398 END-EXEC. DTSCU882 00399 DTSCU882 00400 IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN) DTSCU882 00401 OR DFHRESP (SYSIDERR) DTSCU882 00402 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU882 00403 GO TO P3200-EXIT. DTSCU882 00404 DTSCU882 00405 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU882 00406 NEXT SENTENCE DTSCU882 00407 ELSE DTSCU882 00408 GO TO S899-ABEND. DTSCU882 00409 P3200-EXIT. DTSCU882 00410 EXIT. DTSCU882 00411 EJECT DTSCU882 00412 P3300-DELETE. DTSCU882 00413 PERFORM S3100-READ-UPDATE THRU S3100-EXIT. DTSCU882 00414 DTSCU882 00415 IF L882-NO-REC-88 DTSCU882 00416 GO TO S899-ABEND DTSCU882 00417 ELSE DTSCU882 00418 IF L882-FILE-CLOSED-88 DTSCU882 00419 GO TO P3300-EXIT. DTSCU882 00420 DTSCU882 00421 EXEC CICS DTSCU882 00422 DELETE DTSCU882 00423 DATASET (WRK-FILE-NAME) DTSCU882 00424 RESP (WRK-RESP-CD) DTSCU882 00425 END-EXEC. DTSCU882 00426 DTSCU882 00427 IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN) DTSCU882 00428 OR DFHRESP (SYSIDERR) DTSCU882 00429 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU882 00430 GO TO P3300-EXIT. DTSCU882 00431 DTSCU882 00432 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU882 00433 NEXT SENTENCE DTSCU882 00434 ELSE DTSCU882 00435 GO TO S899-ABEND. DTSCU882 00436 P3300-EXIT. DTSCU882 00437 EXIT. DTSCU882 00438 EJECT DTSCU882 00439 S1100-NOT-AVAILABLE. DTSCU882 00440 MOVE WRK-FILE-NAME TO EMSG-FILE-NAME. DTSCU882 00441 DTSCU882 00442 MOVE EMSG-NOT-AVAILABLE TO L882-MSG-AREA. DTSCU882 00443 DTSCU882 00444 SET L882-FILE-CLOSED-88 TO TRUE. DTSCU882 00445 S1100-EXIT. DTSCU882 00446 EXIT. DTSCU882 00447 SKIP3 DTSCU882 00448 S1200-NOT-FOUND. DTSCU882 00449 SET L882-NO-REC-88 TO TRUE. DTSCU882 00450 S1200-EXIT. DTSCU882 00451 EXIT. DTSCU882 00452 EJECT DTSCU882 00453 S3100-READ-UPDATE. DTSCU882 00454 MOVE LOW-VALUE TO WIO-REC. DTSCU882 00455 DTSCU882 00456 MOVE WNAM-KEY-AREA OF WCOMM-REC TO WNAM-KEY-AREA OF WIO-REC. DTSCU882 00457 DTSCU882 00458 EXEC CICS DTSCU882 00459 READ DTSCU882 00460 DATASET (WRK-FILE-NAME) DTSCU882 00461 INTO (WIO-REC) DTSCU882 00462 LENGTH (WRK-REC-LENGTH) DTSCU882 00463 RIDFLD (WNAM-KEY-AREA OF WIO-REC) DTSCU882 00464 UPDATE DTSCU882 00465 RESP (WRK-RESP-CD) DTSCU882 00466 END-EXEC. DTSCU882 00467 DTSCU882 00468 IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED) DTSCU882 00469 OR DFHRESP (SYSIDERR) DTSCU882 00470 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU882 00471 GO TO S3100-EXIT. DTSCU882 00472 DTSCU882 00473 IF WRK-RESP-CD = DFHRESP (NOTFND) DTSCU882 00474 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU882 00475 GO TO S3100-EXIT. DTSCU882 00476 DTSCU882 00477 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU882 00478 NEXT SENTENCE DTSCU882 00479 ELSE DTSCU882 00480 GO TO S899-ABEND. DTSCU882 00481 S3100-EXIT. DTSCU882 00482 EXIT. DTSCU882 00483 EJECT DTSCU882 00484 S899-ABEND. DTSCU882 00485 EXEC CICS DTSCU882 00486 ABEND DTSCU882 00487 ABCODE (WRK-ABEND-CD) DTSCU882 00488 END-EXEC. DTSCU882 00489 S899-EXIT. DTSCU882 00490 EXIT. DTSCU882