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