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