00001 IDENTIFICATION DIVISION. 07/08/08 00002 PROGRAM-ID. DTSCU821. DTSCU821 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV012 00004 DATE-WRITTEN. NOVEMBER 1991. DTSCU821 00005 DATE-COMPILED. DTSCU821 00006 SKIP3 DTSCU821 00007 ***** DTSCU821 00008 * DTSCU821 00009 * FUNCTION: ALTERNATE INDEX FILE INPUT/OUTPUT. DTSCU821 00010 * DTSCU821 00011 * DTSCU821 00012 * MODIFICATION LOG: DTSCU821 00013 * DTSCU821 00014 * 11/13/91 INITIAL DEVELOPMENT. DTSCU821 00015 * WORK ORDER: PROGRAMMER: TCL DTSCU821 00016 * DTSCU821 00017 * 04/12/94 MODIFIED FOR MONTANA. DTSCU821 00018 * WORK ORDER: PROGRAMMER: RHC DTSCU821 00019 * DTSCU821 00020 * 09/18/95 IWHO RECORD PROCESSING ADDED. DTSCU821 00021 * WORK ORDER: JR PROGRAMMER: EHH DTSCU821 00022 * DTSCU821 00023 * 08/31/1998 REVIEWED AND MODIFIED FOR DC. DTSCU821 00024 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSCU821 00025 * DTSCU821 00026 * DTSCU821 00027 * 04/24/2004 RECOMPILED FOR NEW IIPES COPYBOOK DTSCU821 00028 * REFERENCE: DC DEVELOPMENT PROGRAMMER: ZL1 DTSCU821 00029 * DTSCU821 00030 * 02/15/2008 UPDATED FOR IRFD REFUND AIX RECORD. DTSCU821 00031 * REFERENCE: CFO REFUNDS PROGRAMMER: GD DTSCU821 00032 * DTSCU821 00033 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU821 00034 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU821 00035 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSCU821 00036 * DTSCU821 00037 * DTSCU821 00038 * DESCRIPTION: DTSCU821 00039 * DTSCU821 00040 * DTSCU821 PERFORMS ALL REQUIRED ALTERNATE INDEX FILE DTSCU821 00041 * INPUT/OUTPUT. DTSCU821'S COMMAREA CONSISTS OF DTSCU821 00042 * DTSIL821, FOLLOWED BY DTSIISKL. SEE DFHCOMMAREA DTSCU821 00043 * OF THIS MODULE FOR AN EXAMPLE. DTSCU821 00044 * DTSCU821 00045 * DTSCU821 00046 * GENERAL SPECIFICATIONS: DTSCU821 00047 * DTSCU821 00048 * IF AN INVALID COMMAND IS REQUESTED, THEN ABEND THE DTSCU821 00049 * MODULE. DTSCU821 00050 * DTSCU821 00051 * IF A CICS FILE COMMAND YIELDS A RESPONSE OTHER THAN DTSCU821 00052 * NORMAL, NOTFND, ENDFILE, NOTOPEN, OR DISABLED, DTSCU821 00053 * THEN ABEND THE MODULE (TOLERATE AN INVREQ FROM AN DTSCU821 00054 * ENDBR). DTSCU821 00055 * DTSCU821 00056 * SPECIFY IIO-REC AS THE INTO OR FROM AREA OF THE CICS DTSCU821 00057 * FILE COMMAND. DTSCU821 00058 * DTSCU821 00059 * SPECIFY ISKL-KEY-AREA OF IIO-REC AS THE RIDFLD OF DTSCU821 00060 * THE CICS FILE COMMANDS. DTSCU821 00061 * DTSCU821 00062 * DTSCU821 00063 * COMMAND SPECIFIC SPECIFICATIONS: DTSCU821 00064 * DTSCU821 00065 * READ DTSCU821 00066 * DTSCU821 00067 * STARTBR DTSCU821 00068 * PERFORM A STARTBR. IF THE STARTBR IS DTSCU821 00069 * SUCCESSFUL, THEN PERFORM A READNEXT. IF THE DTSCU821 00070 * READNEXT YIELDS AN ENDFILE CONDITION, THEN RETURN DTSCU821 00071 * L821-NO-REC-88. IF THE READNEXT YIELDS A REC-TYPE DTSCU821 00072 * NOT EQUAL TO THE REQUESTED REC-TYPE (ISKL-REC-TYPE OF DTSCU821 00073 * IIO-REC NOT EQUAL TO ISKL-REC-TYPE OF ICOMM-REC), THEN DTSCU821 00074 * RETURN L821-NO-REC-88. DTSCU821 00075 * DTSCU821 00076 * IF THE READNEXT YIELDS A L821-NO-REC-88, THEN ISSUE DTSCU821 00077 * AN ENDBR. DTSCU821 00078 * DTSCU821 00079 * READNEXT DTSCU821 00080 * PRIOR TO THE READNEXT, MOVE ISKL-KEY-AREA OF DTSCU821 00081 * ICOMM-REC TO ISKL-KEY-AREA OF IIO-REC. IF THE DTSCU821 00082 * READNEXT YIELDS AN ENDFILE CONDITION, THEN RETURN DTSCU821 00083 * L821-NO-REC-88. IF THE READNEXT YIELDS A REC-TYPE DTSCU821 00084 * NOT EQUAL TO THE REQUESTED REC-TYPE (ISKL-REC-TYPE OF DTSCU821 00085 * IIO-REC NOT EQUAL TO ISKL-REC-TYPE OF ICOMM-REC), THEN DTSCU821 00086 * RETURN L821-NO-REC-88. DTSCU821 00087 * DTSCU821 00088 * IF THE READNEXT YIELDS A L821-NO-REC-88, THEN ISSUE DTSCU821 00089 * AN ENDBR. DTSCU821 00090 * DTSCU821 00091 * READPREV DTSCU821 00092 * PRIOR TO THE READPREV, MOVE ISKL-KEY-AREA OF DTSCU821 00093 * ICOMM-REC TO ISKL-KEY-AREA OF IIO-REC. IF THE DTSCU821 00094 * READPREV YIELDS AN END FILE CONDITION, THEN RETURN DTSCU821 00095 * L821-NO-REC-88. IF THE READPREV YIELDS A REC-TYPE DTSCU821 00096 * NOT EQUAL TO THE REQUESTED REC-TYPE (ISKL-REC-TYPE OF DTSCU821 00097 * IIO-REC NOT EQUAL TO ISKL-REC-TYPE OF ICOMM-REC), THEN DTSCU821 00098 * RETURN L821-NO-REC-88. DTSCU821 00099 * DTSCU821 00100 * IF THE READPREV YIELDS A L821-NO-REC-88, THEN ISSUE DTSCU821 00101 * AN ENDBR. DTSCU821 00102 * DTSCU821 00103 * ENDBR DTSCU821 00104 * TOLERATE THE INVREQ CONDITION. DTSCU821 00105 * DTSCU821 00106 * WRITE DTSCU821 00107 * PRIOR TO THE MOVE FROM ICOMM-REC TO IIO-REC, INITIALIZE DTSCU821 00108 * THE APPROPRIATE I***-KEY-FILLER AREA TO LOW-VALUES. DTSCU821 00109 * DTSCU821 00110 * REWRITE DTSCU821 00111 * REWRITE IS NOT A VALID COMMAND. THE ALTERNATE INDEX DTSCU821 00112 * FILE KEY AREA IS EQUAL TO THE ALTERNATE INDEX FILE DTSCU821 00113 * RECORD, THUS A REWRITE COMMAND IS NOT POSSIBLE. DTSCU821 00114 * DTSCU821 00115 * DELETE DTSCU821 00116 * READ (WITH UPDATE) THE RECORD. IF NOT FOUND, THEN ABEND.DTSCU821 00117 * DELETE. DTSCU821 00118 * DTSCU821 00119 ***** DTSCU821 00120 SKIP3 DTSCU821 00121 ENVIRONMENT DIVISION. DTSCU821 00122 SKIP3 DTSCU821 00123 DATA DIVISION. DTSCU821 00124 SKIP3 DTSCU821 00125 WORKING-STORAGE SECTION. DTSCU821 001255 77 PAN-VALET PICTURE X(24) VALUE '012DTSCU821 07/08/08'. DTSCU821 00126 SKIP3 DTSCU821 00127 01 WRK-AREA. DTSCU821 00128 05 WRK-ABEND-CD PIC X(04) VALUE 'U821'. DTSCU821 00129 DTSCU821 00130 05 WRK-RESP-CD PIC S9(08) COMP. DTSCU821 00131 DTSCU821 00132 DTSCU821 00133 05 WRK-PROD-FILE-NAME PIC X(08) VALUE 'DTSFAIX'. DTSCU821 00134 DTSCU821 00135 05 WRK-COMB-FILE-NAME PIC X(08) VALUE 'DTSCAIX'. DTSCU821 00136 DTSCU821 00137 DTSCU821 00138 05 EMSG-NOT-AVAILABLE. DTSCU821 00139 10 FILLER PIC X(04) VALUE 'E091'. DTSCU821 00140 10 FILLER PIC X(06) VALUE 'FILE '. DTSCU821 00141 10 EMSG-FILE-NAME PIC X(08). DTSCU821 00142 10 FILLER PIC X(33) DTSCU821 00143 VALUE ' NOT AVAILABLE PLEASE TRY LATER'. DTSCU821 00144 DTSCU821 00145 DTSCU821 00146 05 WRK-FILE-NAME PIC X(08). DTSCU821 00147 DTSCU821 00148 DTSCU821 00149 05 WRK-REC-LENGTH PIC S9(04) COMP. DTSCU821 00150 EJECT DTSCU821 00151 01 ILEN-LENGTH-LITERALS. DTSCU821 00152 ++INCLUDE DTSIILEN DTSCU821 00153 EJECT DTSCU821 00154 01 IIO-REC. DTSCU821 00155 ++INCLUDE DTSIISKL DTSCU821 00156 EJECT DTSCU821 00157 LINKAGE SECTION. DTSCU821 00158 SKIP3 DTSCU821 00159 01 DFHCOMMAREA. DTSCU821 00160 05 L821-CONTROL-BLOCK. DTSCU821 00161 ++INCLUDE DTSIL821 DTSCU821 00162 SKIP3 DTSCU821 00163 05 ICOMM-REC. DTSCU821 00164 ++INCLUDE DTSIISKL DTSCU821 00165 SKIP3 DTSCU821 00166 05 IBTB-REC REDEFINES ICOMM-REC. DTSCU821 00167 ++INCLUDE DTSIIBTB DTSCU821 00168 SKIP3 DTSCU821 00169 05 IEIN-REC REDEFINES ICOMM-REC. DTSCU821 00170 ++INCLUDE DTSIIEIN DTSCU821 00171 SKIP3 DTSCU821 00172 05 IFAN-REC REDEFINES ICOMM-REC. DTSCU821 00173 ++INCLUDE DTSIIFAN DTSCU821 00174 SKIP3 DTSCU821 00175 05 IFID-REC REDEFINES ICOMM-REC. DTSCU821 00176 ++INCLUDE DTSIIFID DTSCU821 00177 SKIP3 DTSCU821 00178 05 IOPN-REC REDEFINES ICOMM-REC. DTSCU821 00179 ++INCLUDE DTSIIOPN DTSCU821 00180 SKIP3 DTSCU821 00181 05 IOPS-REC REDEFINES ICOMM-REC. DTSCU821 00182 ++INCLUDE DTSIIOPS DTSCU821 00183 SKIP3 DTSCU821 00184 05 IPES-REC REDEFINES ICOMM-REC. DTSCU821 00185 ++INCLUDE DTSIIPES DTSCU821 00186 SKIP3 DTSCU821 00187 05 ITDS-REC REDEFINES ICOMM-REC. DTSCU821 00188 ++INCLUDE DTSIITDS DTSCU821 00189 SKIP3 DTSCU821 00190 05 IZIP-REC REDEFINES ICOMM-REC. DTSCU821 00191 ++INCLUDE DTSIIZIP DTSCU821 00192 SKIP3 DTSCU821 00193 05 IBTN-REC REDEFINES ICOMM-REC. DTSCU821 00194 ++INCLUDE DTSIIBTN DTSCU821 00195 SKIP3 DTSCU821 00196 05 IENM-REC REDEFINES ICOMM-REC. DTSCU821 00197 ++INCLUDE DTSIIENM DTSCU821 00198 SKIP3 DTSCU821 00199 05 IEAL-REC REDEFINES ICOMM-REC. DTSCU821 00200 ++INCLUDE DTSIIEAL DTSCU821 00201 SKIP3 DTSCU821 00202 05 IEAE-REC REDEFINES ICOMM-REC. DTSCU821 00203 ++INCLUDE DTSIIEAE DTSCU821 00204 SKIP3 DTSCU821 00205 05 IEBX-REC REDEFINES ICOMM-REC. DTSCU821 00206 ++INCLUDE DTSIIEBX DTSCU821 00207 SKIP3 DTSCU821 00208 05 IEOP-REC REDEFINES ICOMM-REC. DTSCU821 00209 ++INCLUDE DTSIIEOP DTSCU821 00210 SKIP3 DTSCU821 00211 05 IESR-REC REDEFINES ICOMM-REC. DTSCU821 00212 ++INCLUDE DTSIIESR DTSCU821 00213 SKIP3 DTSCU821 00214 05 IEER-REC REDEFINES ICOMM-REC. DTSCU821 00215 ++INCLUDE DTSIIEER DTSCU821 00216 SKIP3 DTSCU821 00217 05 IEET-REC REDEFINES ICOMM-REC. DTSCU821 00218 ++INCLUDE DTSIIEET DTSCU821 00219 SKIP3 DTSCU821 00220 05 IEPR-REC REDEFINES ICOMM-REC. DTSCU821 00221 ++INCLUDE DTSIIEPR DTSCU821 00222 DTSCU821 00223 05 ITRT-REC REDEFINES ICOMM-REC. DTSCU821 00224 ++INCLUDE DTSIITRT DTSCU821 00225 DTSCU821 00226 05 ITRE-REC REDEFINES ICOMM-REC. DTSCU821 00227 ++INCLUDE DTSIITRE DTSCU821 00228 DTSCU821 00229 05 IRFD-REC REDEFINES ICOMM-REC. DTSCU821 00230 ++INCLUDE DTSIIRFD DTSCU821 00231 EJECT DTSCU821 00232 PROCEDURE DIVISION. DTSCU821 00233 SKIP2 DTSCU821 00234 IF EIBTRNID = 'DTSC' DTSCU821 00235 MOVE WRK-COMB-FILE-NAME TO WRK-FILE-NAME DTSCU821 00236 ELSE DTSCU821 00237 MOVE WRK-PROD-FILE-NAME TO WRK-FILE-NAME. DTSCU821 00238 DTSCU821 00239 DTSCU821 00240 MOVE SPACES TO L821-MSG-AREA. DTSCU821 00241 DTSCU821 00242 SET L821-OK-88 TO TRUE. DTSCU821 00243 DTSCU821 00244 DTSCU821 00245 IF L821-READ-NEXT-88 DTSCU821 00246 PERFORM P2200-READ-NEXT THRU P2200-EXIT DTSCU821 00247 ELSE DTSCU821 00248 IF L821-READ-88 DTSCU821 00249 PERFORM P1100-READ THRU P1100-EXIT DTSCU821 00250 ELSE DTSCU821 00251 IF L821-START-BROWSE-88 DTSCU821 00252 PERFORM P2100-START-BROWSE THRU P2100-EXIT DTSCU821 00253 ELSE DTSCU821 00254 IF L821-END-BROWSE-88 DTSCU821 00255 PERFORM P2400-END-BROWSE THRU P2400-EXIT DTSCU821 00256 ELSE DTSCU821 00257 IF L821-READ-PREV-88 DTSCU821 00258 PERFORM P2300-READ-PREV THRU P2300-EXIT DTSCU821 00259 ELSE DTSCU821 00260 IF L821-WRITE-88 DTSCU821 00261 PERFORM P3100-WRITE THRU P3100-EXIT DTSCU821 00262 ELSE DTSCU821 00263 IF L821-DELETE-88 DTSCU821 00264 PERFORM P3300-DELETE THRU P3300-EXIT DTSCU821 00265 ELSE DTSCU821 00266 GO TO S899-ABEND. DTSCU821 00267 DTSCU821 00268 DTSCU821 00269 EXEC CICS DTSCU821 00270 RETURN DTSCU821 00271 END-EXEC. DTSCU821 00272 DTSCU821 00273 DTSCU821 00274 GOBACK. DTSCU821 00275 EJECT DTSCU821 00276 P1100-READ. DTSCU821 00277 MOVE LOW-VALUE TO IIO-REC. DTSCU821 00278 DTSCU821 00279 MOVE ISKL-KEY-AREA OF ICOMM-REC TO ISKL-KEY-AREA OF IIO-REC. DTSCU821 00280 DTSCU821 00281 MOVE ILEN-LENGTH TO WRK-REC-LENGTH. DTSCU821 00282 DTSCU821 00283 EXEC CICS DTSCU821 00284 READ DTSCU821 00285 DATASET (WRK-FILE-NAME) DTSCU821 00286 INTO (IIO-REC) DTSCU821 00287 LENGTH (WRK-REC-LENGTH) DTSCU821 00288 RIDFLD (ISKL-KEY-AREA OF IIO-REC) DTSCU821 00289 RESP (WRK-RESP-CD) DTSCU821 00290 END-EXEC. DTSCU821 00291 DTSCU821 00292 IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED) DTSCU821 00293 OR DFHRESP (SYSIDERR) DTSCU821 00294 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU821 00295 GO TO P1100-EXIT. DTSCU821 00296 DTSCU821 00297 IF WRK-RESP-CD = DFHRESP (NOTFND) DTSCU821 00298 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU821 00299 GO TO P1100-EXIT. DTSCU821 00300 DTSCU821 00301 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU821 00302 PERFORM S2100-IO-TO-COMM THRU S2100-EXIT DTSCU821 00303 ELSE DTSCU821 00304 GO TO S899-ABEND. DTSCU821 00305 P1100-EXIT. DTSCU821 00306 EXIT. DTSCU821 00307 EJECT DTSCU821 00308 P2100-START-BROWSE. DTSCU821 00309 MOVE LOW-VALUE TO IIO-REC. DTSCU821 00310 DTSCU821 00311 MOVE ISKL-KEY-AREA OF ICOMM-REC TO ISKL-KEY-AREA OF IIO-REC. DTSCU821 00312 DTSCU821 00313 EXEC CICS DTSCU821 00314 STARTBR DTSCU821 00315 DATASET (WRK-FILE-NAME) DTSCU821 00316 RIDFLD (ISKL-KEY-AREA OF IIO-REC) DTSCU821 00317 RESP (WRK-RESP-CD) DTSCU821 00318 END-EXEC. DTSCU821 00319 DTSCU821 00320 IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED) DTSCU821 00321 OR DFHRESP (SYSIDERR) DTSCU821 00322 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU821 00323 GO TO P2100-EXIT. DTSCU821 00324 DTSCU821 00325 IF WRK-RESP-CD = DFHRESP (NOTFND) DTSCU821 00326 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU821 00327 GO TO P2100-EXIT. DTSCU821 00328 DTSCU821 00329 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU821 00330 PERFORM P2200-READ-NEXT THRU P2200-EXIT DTSCU821 00331 ELSE DTSCU821 00332 GO TO S899-ABEND. DTSCU821 00333 P2100-EXIT. DTSCU821 00334 EXIT. DTSCU821 00335 EJECT DTSCU821 00336 P2200-READ-NEXT. DTSCU821 00337 IF L821-READ-NEXT-88 DTSCU821 00338 MOVE LOW-VALUE TO IIO-REC DTSCU821 00339 MOVE ISKL-KEY-AREA OF ICOMM-REC DTSCU821 00340 TO ISKL-KEY-AREA OF IIO-REC. DTSCU821 00341 DTSCU821 00342 MOVE ILEN-LENGTH TO WRK-REC-LENGTH. DTSCU821 00343 DTSCU821 00344 EXEC CICS DTSCU821 00345 READNEXT DTSCU821 00346 DATASET (WRK-FILE-NAME) DTSCU821 00347 INTO (IIO-REC) DTSCU821 00348 LENGTH (WRK-REC-LENGTH) DTSCU821 00349 RIDFLD (ISKL-KEY-AREA OF IIO-REC) DTSCU821 00350 RESP (WRK-RESP-CD) DTSCU821 00351 END-EXEC. DTSCU821 00352 DTSCU821 00353 IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED) DTSCU821 00354 OR DFHRESP (SYSIDERR) DTSCU821 00355 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU821 00356 GO TO P2200-EXIT. DTSCU821 00357 DTSCU821 00358 IF WRK-RESP-CD = DFHRESP (NOTFND) OR DFHRESP (ENDFILE) DTSCU821 00359 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU821 00360 PERFORM P2400-END-BROWSE THRU P2400-EXIT DTSCU821 00361 GO TO P2200-EXIT. DTSCU821 00362 DTSCU821 00363 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU821 00364 NEXT SENTENCE DTSCU821 00365 ELSE DTSCU821 00366 GO TO S899-ABEND. DTSCU821 00367 DTSCU821 00368 IF ISKL-REC-TYPE OF IIO-REC = ISKL-REC-TYPE OF ICOMM-REC DTSCU821 00369 PERFORM S2100-IO-TO-COMM THRU S2100-EXIT DTSCU821 00370 ELSE DTSCU821 00371 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU821 00372 PERFORM P2400-END-BROWSE THRU P2400-EXIT. DTSCU821 00373 P2200-EXIT. DTSCU821 00374 EXIT. DTSCU821 00375 EJECT DTSCU821 00376 P2300-READ-PREV. DTSCU821 00377 MOVE LOW-VALUE TO IIO-REC. DTSCU821 00378 DTSCU821 00379 MOVE ISKL-KEY-AREA OF ICOMM-REC DTSCU821 00380 TO ISKL-KEY-AREA OF IIO-REC. DTSCU821 00381 DTSCU821 00382 MOVE ILEN-LENGTH TO WRK-REC-LENGTH. DTSCU821 00383 DTSCU821 00384 EXEC CICS DTSCU821 00385 READPREV DTSCU821 00386 DATASET (WRK-FILE-NAME) DTSCU821 00387 INTO (IIO-REC) DTSCU821 00388 LENGTH (WRK-REC-LENGTH) DTSCU821 00389 RIDFLD (ISKL-KEY-AREA OF IIO-REC) DTSCU821 00390 RESP (WRK-RESP-CD) DTSCU821 00391 END-EXEC. DTSCU821 00392 DTSCU821 00393 IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED) DTSCU821 00394 OR DFHRESP (SYSIDERR) DTSCU821 00395 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU821 00396 GO TO P2300-EXIT. DTSCU821 00397 DTSCU821 00398 IF WRK-RESP-CD = DFHRESP (NOTFND) OR DFHRESP (ENDFILE) DTSCU821 00399 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU821 00400 PERFORM P2400-END-BROWSE THRU P2400-EXIT DTSCU821 00401 GO TO P2300-EXIT. DTSCU821 00402 DTSCU821 00403 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU821 00404 NEXT SENTENCE DTSCU821 00405 ELSE DTSCU821 00406 GO TO S899-ABEND. DTSCU821 00407 DTSCU821 00408 IF ISKL-REC-TYPE OF IIO-REC = ISKL-REC-TYPE OF ICOMM-REC DTSCU821 00409 PERFORM S2100-IO-TO-COMM THRU S2100-EXIT DTSCU821 00410 ELSE DTSCU821 00411 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU821 00412 PERFORM P2400-END-BROWSE THRU P2400-EXIT. DTSCU821 00413 P2300-EXIT. DTSCU821 00414 EXIT. DTSCU821 00415 EJECT DTSCU821 00416 P2400-END-BROWSE. DTSCU821 00417 DTSCU821 00418 EXEC CICS DTSCU821 00419 ENDBR DTSCU821 00420 DATASET (WRK-FILE-NAME) DTSCU821 00421 RESP (WRK-RESP-CD) DTSCU821 00422 END-EXEC. DTSCU821 00423 DTSCU821 00424 IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN) DTSCU821 00425 OR DFHRESP (SYSIDERR) DTSCU821 00426 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU821 00427 GO TO P2400-EXIT. DTSCU821 00428 DTSCU821 00429 IF WRK-RESP-CD = DFHRESP (NORMAL) OR DFHRESP (INVREQ) DTSCU821 00430 NEXT SENTENCE DTSCU821 00431 ELSE DTSCU821 00432 GO TO S899-ABEND. DTSCU821 00433 P2400-EXIT. DTSCU821 00434 EXIT. DTSCU821 00435 EJECT DTSCU821 00436 P3100-WRITE. DTSCU821 00437 PERFORM S2200-COMM-TO-IO THRU S2200-EXIT. DTSCU821 00438 DTSCU821 00439 PERFORM S2300-CALCULATE-LENGTH THRU S2300-EXIT. DTSCU821 00440 DTSCU821 00441 EXEC CICS DTSCU821 00442 WRITE DTSCU821 00443 DATASET (WRK-FILE-NAME) DTSCU821 00444 FROM (IIO-REC) DTSCU821 00445 LENGTH (WRK-REC-LENGTH) DTSCU821 00446 RIDFLD (ISKL-KEY-AREA OF IIO-REC) DTSCU821 00447 RESP (WRK-RESP-CD) DTSCU821 00448 END-EXEC. DTSCU821 00449 DTSCU821 00450 IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN) DTSCU821 00451 OR DFHRESP (SYSIDERR) DTSCU821 00452 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU821 00453 GO TO P3100-EXIT. DTSCU821 00454 DTSCU821 00455 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU821 00456 NEXT SENTENCE DTSCU821 00457 ELSE DTSCU821 00458 GO TO S899-ABEND. DTSCU821 00459 P3100-EXIT. DTSCU821 00460 EXIT. DTSCU821 00461 EJECT DTSCU821 00462 P3300-DELETE. DTSCU821 00463 DTSCU821 00464 PERFORM S3100-READ-UPDATE THRU S3100-EXIT. DTSCU821 00465 DTSCU821 00466 IF L821-NO-REC-88 DTSCU821 00467 GO TO S899-ABEND DTSCU821 00468 ELSE DTSCU821 00469 IF L821-FILE-CLOSED-88 DTSCU821 00470 GO TO P3300-EXIT. DTSCU821 00471 DTSCU821 00472 EXEC CICS DTSCU821 00473 DELETE DTSCU821 00474 DATASET (WRK-FILE-NAME) DTSCU821 00475 RESP (WRK-RESP-CD) DTSCU821 00476 END-EXEC. DTSCU821 00477 DTSCU821 00478 IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN) DTSCU821 00479 OR DFHRESP (SYSIDERR) DTSCU821 00480 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU821 00481 GO TO P3300-EXIT. DTSCU821 00482 DTSCU821 00483 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU821 00484 NEXT SENTENCE DTSCU821 00485 ELSE DTSCU821 00486 GO TO S899-ABEND. DTSCU821 00487 P3300-EXIT. DTSCU821 00488 EXIT. DTSCU821 00489 EJECT DTSCU821 00490 S1100-NOT-AVAILABLE. DTSCU821 00491 MOVE WRK-FILE-NAME TO EMSG-FILE-NAME. DTSCU821 00492 DTSCU821 00493 MOVE EMSG-NOT-AVAILABLE TO L821-MSG-AREA. DTSCU821 00494 DTSCU821 00495 SET L821-FILE-CLOSED-88 TO TRUE. DTSCU821 00496 S1100-EXIT. DTSCU821 00497 EXIT. DTSCU821 00498 SKIP3 DTSCU821 00499 S1200-NOT-FOUND. DTSCU821 00500 SET L821-NO-REC-88 TO TRUE. DTSCU821 00501 S1200-EXIT. DTSCU821 00502 EXIT. DTSCU821 00503 EJECT DTSCU821 00504 S2100-IO-TO-COMM. DTSCU821 00505 GO TO S2101-MOVE DTSCU821 00506 S2102-MOVE DTSCU821 00507 S2103-MOVE DTSCU821 00508 S2104-MOVE DTSCU821 00509 S2105-MOVE DTSCU821 00510 S2106-MOVE DTSCU821 00511 S2107-MOVE DTSCU821 00512 S2108-MOVE DTSCU821 00513 S2109-MOVE DTSCU821 00514 S2110-MOVE DTSCU821 00515 S2111-MOVE DTSCU821 00516 S2112-MOVE DTSCU821 00517 S2113-MOVE DTSCU821 00518 S2114-MOVE DTSCU821 00519 S2115-MOVE DTSCU821 00520 S2116-MOVE DTSCU821 00521 S2117-MOVE DTSCU821 00522 S2118-MOVE DTSCU821 00523 S2119-MOVE DTSCU821 00524 S2120-MOVE DTSCU821 00525 S2121-MOVE DTSCU821 00526 S2122-MOVE DTSCU821 00527 DEPENDING ON ISKL-REC-TYPE OF IIO-REC. DTSCU821 00528 DTSCU821 00529 GO TO S899-ABEND. DTSCU821 00530 SKIP3 DTSCU821 00531 S2101-MOVE. DTSCU821 00532 MOVE IIO-REC TO IBTB-REC. DTSCU821 00533 GO TO S2100-EXIT. DTSCU821 00534 SKIP3 DTSCU821 00535 S2102-MOVE. DTSCU821 00536 MOVE IIO-REC TO IEIN-REC. DTSCU821 00537 GO TO S2100-EXIT. DTSCU821 00538 SKIP3 DTSCU821 00539 S2103-MOVE. DTSCU821 00540 MOVE IIO-REC TO IFAN-REC. DTSCU821 00541 GO TO S2100-EXIT. DTSCU821 00542 SKIP3 DTSCU821 00543 S2104-MOVE. DTSCU821 00544 MOVE IIO-REC TO IFID-REC. DTSCU821 00545 GO TO S2100-EXIT. DTSCU821 00546 SKIP3 DTSCU821 00547 S2105-MOVE. DTSCU821 00548 MOVE IIO-REC TO IOPN-REC. DTSCU821 00549 GO TO S2100-EXIT. DTSCU821 00550 SKIP3 DTSCU821 00551 S2106-MOVE. DTSCU821 00552 MOVE IIO-REC TO IOPS-REC. DTSCU821 00553 GO TO S2100-EXIT. DTSCU821 00554 SKIP3 DTSCU821 00555 S2107-MOVE. DTSCU821 00556 MOVE IIO-REC TO IPES-REC. DTSCU821 00557 GO TO S2100-EXIT. DTSCU821 00558 SKIP3 DTSCU821 00559 S2108-MOVE. DTSCU821 00560 MOVE IIO-REC TO ITDS-REC. DTSCU821 00561 GO TO S2100-EXIT. DTSCU821 00562 SKIP3 DTSCU821 00563 S2109-MOVE. DTSCU821 00564 MOVE IIO-REC TO IZIP-REC. DTSCU821 00565 GO TO S2100-EXIT. DTSCU821 00566 SKIP3 DTSCU821 00567 S2110-MOVE. DTSCU821 00568 MOVE IIO-REC TO IBTN-REC. DTSCU821 00569 GO TO S2100-EXIT. DTSCU821 00570 SKIP3 DTSCU821 00571 S2111-MOVE. DTSCU821 00572 MOVE IIO-REC TO IENM-REC. DTSCU821 00573 GO TO S2100-EXIT. DTSCU821 00574 SKIP3 DTSCU821 00575 S2112-MOVE. DTSCU821 00576 MOVE IIO-REC TO IEAL-REC. DTSCU821 00577 GO TO S2100-EXIT. DTSCU821 00578 SKIP3 DTSCU821 00579 S2113-MOVE. DTSCU821 00580 MOVE IIO-REC TO IEAE-REC. DTSCU821 00581 GO TO S2100-EXIT. DTSCU821 00582 SKIP3 DTSCU821 00583 S2114-MOVE. DTSCU821 00584 MOVE IIO-REC TO IEBX-REC. DTSCU821 00585 GO TO S2100-EXIT. DTSCU821 00586 SKIP3 DTSCU821 00587 S2115-MOVE. DTSCU821 00588 MOVE IIO-REC TO IEOP-REC. DTSCU821 00589 GO TO S2100-EXIT. DTSCU821 00590 SKIP3 DTSCU821 00591 S2116-MOVE. DTSCU821 00592 MOVE IIO-REC TO IESR-REC. DTSCU821 00593 GO TO S2100-EXIT. DTSCU821 00594 SKIP3 DTSCU821 00595 S2117-MOVE. DTSCU821 00596 MOVE IIO-REC TO IEER-REC. DTSCU821 00597 GO TO S2100-EXIT. DTSCU821 00598 SKIP3 DTSCU821 00599 S2118-MOVE. DTSCU821 00600 MOVE IIO-REC TO IEET-REC. DTSCU821 00601 GO TO S2100-EXIT. DTSCU821 00602 SKIP3 DTSCU821 00603 S2119-MOVE. DTSCU821 00604 MOVE IIO-REC TO IEPR-REC. DTSCU821 00605 GO TO S2100-EXIT. DTSCU821 00606 SKIP3 DTSCU821 00607 S2120-MOVE. DTSCU821 00608 MOVE IIO-REC TO ITRT-REC. DTSCU821 00609 GO TO S2100-EXIT. DTSCU821 00610 SKIP3 DTSCU821 00611 S2121-MOVE. DTSCU821 00612 MOVE IIO-REC TO ITRE-REC. DTSCU821 00613 GO TO S2100-EXIT. DTSCU821 00614 SKIP3 DTSCU821 00615 S2122-MOVE. DTSCU821 00616 MOVE IIO-REC TO IRFD-REC. DTSCU821 00617 GO TO S2100-EXIT. DTSCU821 00618 SKIP3 DTSCU821 00619 S2100-EXIT. DTSCU821 00620 EXIT. DTSCU821 00621 EJECT DTSCU821 00622 S2200-COMM-TO-IO. DTSCU821 00623 GO TO S2201-MOVE DTSCU821 00624 S2202-MOVE DTSCU821 00625 S2203-MOVE DTSCU821 00626 S2204-MOVE DTSCU821 00627 S2205-MOVE DTSCU821 00628 S2206-MOVE DTSCU821 00629 S2207-MOVE DTSCU821 00630 S2208-MOVE DTSCU821 00631 S2209-MOVE DTSCU821 00632 S2210-MOVE DTSCU821 00633 S2211-MOVE DTSCU821 00634 S2212-MOVE DTSCU821 00635 S2213-MOVE DTSCU821 00636 S2214-MOVE DTSCU821 00637 S2215-MOVE DTSCU821 00638 S2216-MOVE DTSCU821 00639 S2217-MOVE DTSCU821 00640 S2218-MOVE DTSCU821 00641 S2219-MOVE DTSCU821 00642 S2220-MOVE DTSCU821 00643 S2221-MOVE DTSCU821 00644 S2222-MOVE DTSCU821 00645 DEPENDING ON ISKL-REC-TYPE OF ICOMM-REC. DTSCU821 00646 DTSCU821 00647 GO TO S899-ABEND. DTSCU821 00648 SKIP3 DTSCU821 00649 S2201-MOVE. DTSCU821 00650 MOVE LOW-VALUES TO IBTB-KEY-FILLER. DTSCU821 00651 MOVE IBTB-REC TO IIO-REC. DTSCU821 00652 GO TO S2200-EXIT. DTSCU821 00653 SKIP3 DTSCU821 00654 S2202-MOVE. DTSCU821 00655 MOVE LOW-VALUES TO IEIN-KEY-FILLER. DTSCU821 00656 MOVE IEIN-REC TO IIO-REC. DTSCU821 00657 GO TO S2200-EXIT. DTSCU821 00658 SKIP3 DTSCU821 00659 S2203-MOVE. DTSCU821 00660 MOVE LOW-VALUES TO IFAN-KEY-FILLER. DTSCU821 00661 MOVE IFAN-REC TO IIO-REC. DTSCU821 00662 GO TO S2200-EXIT. DTSCU821 00663 SKIP3 DTSCU821 00664 S2204-MOVE. DTSCU821 00665 MOVE LOW-VALUES TO IFID-KEY-FILLER. DTSCU821 00666 MOVE IFID-REC TO IIO-REC. DTSCU821 00667 GO TO S2200-EXIT. DTSCU821 00668 SKIP3 DTSCU821 00669 S2205-MOVE. DTSCU821 00670 MOVE LOW-VALUES TO IOPN-KEY-FILLER. DTSCU821 00671 MOVE IOPN-REC TO IIO-REC. DTSCU821 00672 GO TO S2200-EXIT. DTSCU821 00673 SKIP3 DTSCU821 00674 S2206-MOVE. DTSCU821 00675 MOVE LOW-VALUES TO IOPS-KEY-FILLER. DTSCU821 00676 MOVE IOPS-REC TO IIO-REC. DTSCU821 00677 GO TO S2200-EXIT. DTSCU821 00678 SKIP3 DTSCU821 00679 S2207-MOVE. DTSCU821 00680 MOVE LOW-VALUES TO IPES-KEY-FILLER. DTSCU821 00681 MOVE IPES-REC TO IIO-REC. DTSCU821 00682 GO TO S2200-EXIT. DTSCU821 00683 SKIP3 DTSCU821 00684 S2208-MOVE. DTSCU821 00685 MOVE LOW-VALUES TO ITDS-KEY-FILLER. DTSCU821 00686 MOVE ITDS-REC TO IIO-REC. DTSCU821 00687 GO TO S2200-EXIT. DTSCU821 00688 SKIP3 DTSCU821 00689 S2209-MOVE. DTSCU821 00690 MOVE LOW-VALUES TO IZIP-KEY-FILLER. DTSCU821 00691 MOVE IZIP-REC TO IIO-REC. DTSCU821 00692 GO TO S2200-EXIT. DTSCU821 00693 SKIP3 DTSCU821 00694 S2210-MOVE. DTSCU821 00695 MOVE LOW-VALUES TO IBTN-KEY-FILLER. DTSCU821 00696 MOVE IBTN-REC TO IIO-REC. DTSCU821 00697 GO TO S2200-EXIT. DTSCU821 00698 SKIP3 DTSCU821 00699 S2211-MOVE. DTSCU821 00700 MOVE LOW-VALUES TO IENM-KEY-FILLER. DTSCU821 00701 MOVE IENM-REC TO IIO-REC. DTSCU821 00702 GO TO S2200-EXIT. DTSCU821 00703 SKIP3 DTSCU821 00704 S2212-MOVE. DTSCU821 00705 MOVE LOW-VALUES TO IEAL-KEY-FILLER. DTSCU821 00706 MOVE IEAL-REC TO IIO-REC. DTSCU821 00707 GO TO S2200-EXIT. DTSCU821 00708 SKIP3 DTSCU821 00709 S2213-MOVE. DTSCU821 00710 MOVE LOW-VALUES TO IEAE-KEY-FILLER. DTSCU821 00711 MOVE IEAE-REC TO IIO-REC. DTSCU821 00712 GO TO S2200-EXIT. DTSCU821 00713 SKIP3 DTSCU821 00714 S2214-MOVE. DTSCU821 00715 MOVE LOW-VALUES TO IEBX-KEY-FILLER. DTSCU821 00716 MOVE IEBX-REC TO IIO-REC. DTSCU821 00717 GO TO S2200-EXIT. DTSCU821 00718 SKIP3 DTSCU821 00719 S2215-MOVE. DTSCU821 00720 MOVE LOW-VALUES TO IEOP-KEY-FILLER. DTSCU821 00721 MOVE IEOP-REC TO IIO-REC. DTSCU821 00722 GO TO S2200-EXIT. DTSCU821 00723 SKIP3 DTSCU821 00724 S2216-MOVE. DTSCU821 00725 MOVE LOW-VALUES TO IESR-KEY-FILLER. DTSCU821 00726 MOVE IESR-REC TO IIO-REC. DTSCU821 00727 GO TO S2200-EXIT. DTSCU821 00728 SKIP3 DTSCU821 00729 S2217-MOVE. DTSCU821 00730 MOVE LOW-VALUES TO IEER-KEY-FILLER. DTSCU821 00731 MOVE IEER-REC TO IIO-REC. DTSCU821 00732 GO TO S2200-EXIT. DTSCU821 00733 SKIP3 DTSCU821 00734 S2218-MOVE. DTSCU821 00735 MOVE LOW-VALUES TO IEET-KEY-FILLER. DTSCU821 00736 MOVE IEET-REC TO IIO-REC. DTSCU821 00737 GO TO S2200-EXIT. DTSCU821 00738 SKIP3 DTSCU821 00739 S2219-MOVE. DTSCU821 00740 MOVE LOW-VALUES TO IEPR-KEY-FILLER. DTSCU821 00741 MOVE IEPR-REC TO IIO-REC. DTSCU821 00742 GO TO S2200-EXIT. DTSCU821 00743 SKIP3 DTSCU821 00744 S2220-MOVE. DTSCU821 00745 MOVE LOW-VALUES TO ITRT-KEY-FILLER. DTSCU821 00746 MOVE ITRT-REC TO IIO-REC. DTSCU821 00747 GO TO S2200-EXIT. DTSCU821 00748 SKIP3 DTSCU821 00749 S2221-MOVE. DTSCU821 00750 MOVE LOW-VALUES TO ITRE-KEY-FILLER. DTSCU821 00751 MOVE ITRE-REC TO IIO-REC. DTSCU821 00752 GO TO S2200-EXIT. DTSCU821 00753 SKIP3 DTSCU821 00754 S2222-MOVE. DTSCU821 00755 MOVE LOW-VALUES TO IRFD-KEY-FILLER. DTSCU821 00756 MOVE IRFD-REC TO IIO-REC. DTSCU821 00757 GO TO S2200-EXIT. DTSCU821 00758 SKIP3 DTSCU821 00759 S2200-EXIT. DTSCU821 00760 EXIT. DTSCU821 00761 EJECT DTSCU821 00762 S2300-CALCULATE-LENGTH. DTSCU821 00763 MOVE ILEN-LENGTH TO WRK-REC-LENGTH. DTSCU821 00764 S2300-EXIT. DTSCU821 00765 EXIT. DTSCU821 00766 EJECT DTSCU821 00767 S3100-READ-UPDATE. DTSCU821 00768 MOVE LOW-VALUE TO IIO-REC. DTSCU821 00769 DTSCU821 00770 MOVE ISKL-KEY-AREA OF ICOMM-REC TO ISKL-KEY-AREA OF IIO-REC. DTSCU821 00771 DTSCU821 00772 MOVE ILEN-LENGTH TO WRK-REC-LENGTH. DTSCU821 00773 DTSCU821 00774 EXEC CICS DTSCU821 00775 READ DTSCU821 00776 DATASET (WRK-FILE-NAME) DTSCU821 00777 INTO (IIO-REC) DTSCU821 00778 LENGTH (WRK-REC-LENGTH) DTSCU821 00779 RIDFLD (ISKL-KEY-AREA OF IIO-REC) DTSCU821 00780 UPDATE DTSCU821 00781 RESP (WRK-RESP-CD) DTSCU821 00782 END-EXEC. DTSCU821 00783 DTSCU821 00784 IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED) DTSCU821 00785 OR DFHRESP (SYSIDERR) DTSCU821 00786 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU821 00787 GO TO S3100-EXIT. DTSCU821 00788 DTSCU821 00789 IF WRK-RESP-CD = DFHRESP (NOTFND) DTSCU821 00790 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU821 00791 GO TO S3100-EXIT. DTSCU821 00792 DTSCU821 00793 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU821 00794 NEXT SENTENCE DTSCU821 00795 ELSE DTSCU821 00796 GO TO S899-ABEND. DTSCU821 00797 S3100-EXIT. DTSCU821 00798 EXIT. DTSCU821 00799 EJECT DTSCU821 00800 S899-ABEND. DTSCU821 00801 DTSCU821 00802 EXEC CICS DTSCU821 00803 ABEND DTSCU821 00804 ABCODE (WRK-ABEND-CD) DTSCU821 00805 END-EXEC. DTSCU821 00806 DTSCU821 00807 S899-EXIT. DTSCU821 00808 EXIT. DTSCU821