00001 IDENTIFICATION DIVISION. 11/16/11 00002 PROGRAM-ID. DTSCU823. DTSCU823 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV010 00004 DATE-WRITTEN. NOVEMBER 1991. DTSCU823 00005 DATE-COMPILED. DTSCU823 00006 SKIP3 DTSCU823 00007 ***** DTSCU823 00008 * DTSCU823 00009 * FUNCTION: ACCOUNTING TRANSACTION FILE INPUT/OUTPUT. DTSCU823 00010 * DTSCU823 00011 * DTSCU823 00012 * MODIFICATION LOG: DTSCU823 00013 * DTSCU823 00014 * 11/12/91 INITIAL DEVELOPMENT. DTSCU823 00015 * WORK ORDER: PROGRAMMER: TCL DTSCU823 00016 * DTSCU823 00017 * 04/12/94 MODIFIED FOR MONTANA. DTSCU823 00018 * WORK ORDER: PROGRAMMER: RHC DTSCU823 00019 * DTSCU823 00020 * 01/31/97 ADDED 88 LEVEL TO DTSIAHDR FOR ELECTRONIC FILER DTSCU823 00021 * BATCHES. ONLY USED BY DTSBD140 SO TO SAVE MONEY DTSCU823 00022 * THIS PROGRAM WASN'T RECOMPILED. DTSCU823 00023 * WORK ORDER: PROGRAMMER: MJA DTSCU823 00024 * DTSCU823 00025 * 12/27/2001 MODIFIED FOR ANNUAL REPORT ACCOUNTING TRANSACTIONDTSCU823 00026 * WORK ORDER: HOUSEHOLD PROGRAMMER: GD DTSCU823 00027 * DTSCU823 00028 * 12/19/2005 RECOMPILED FOR NEW VERSION OF AHDR. DTSCU823 00029 * WORK ORDER: PROGRAMMER: GD DTSCU823 00030 * DTSCU823 00031 * XX/XX/XXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU823 00032 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCU823 00033 * WORK ORDER: PROGRAMMER: XXX DTSCU823 00034 * DTSCU823 00035 * DTSCU823 00036 * DESCRIPTION: DTSCU823 00037 * DTSCU823 00038 * DTSCU823 PERFORMS ALL REQUIRED ACCOUNTING TRANSACTION DTSCU823 00039 * FILE INPUT/OUTPUT. DTSCU823'S COMMAREA CONSISTS OF DTSCU823 00040 * DTSIL823, FOLLOWED BY DTSIASKL. SEE DFHCOMMAREA DTSCU823 00041 * OF THIS MODULE FOR AN EXAMPLE. DTSCU823 00042 * DTSCU823 00043 * DTSCU823 00044 * GENERAL SPECIFICATIONS: DTSCU823 00045 * DTSCU823 00046 * IF AN INVALID COMMAND IS REQUESTED, THEN ABEND THE DTSCU823 00047 * MODULE. DTSCU823 00048 * DTSCU823 00049 * IF A CICS FILE COMMAND YIELDS A RESPONSE OTHER THAN DTSCU823 00050 * NORMAL, NOTFND, ENDFILE, NOTOPEN, OR DISABLED, DTSCU823 00051 * THEN ABEND THE MODULE (TOLERATE INVREQ FROM A DTSCU823 00052 * ENDBR). DTSCU823 00053 * DTSCU823 00054 * SPECIFY AIO-REC AS THE INTO OR FROM AREA OF THE CICS DTSCU823 00055 * FILE COMMAND. DTSCU823 00056 * DTSCU823 00057 * SPECIFY ASKL-KEY OF AIO-REC AS THE RIDFLD OF THE CICS DTSCU823 00058 * FILE COMMANDS. DTSCU823 00059 * DTSCU823 00060 * WHEN MOVING DATA FROM DFHCOMMAREA RECORDS TO AIO-REC DTSCU823 00061 * (PRIOR TO A WRITE OR REWRITE), REFER TO AHDR-REC, DTSCU823 00062 * ARPT-REC, ETC (NOT ACOMM-REC). IF AN UNKNOWN REC-TYPE DTSCU823 00063 * IS ENCOUNTERED, THEN ABEND THE MODULE. DTSCU823 00064 * DTSCU823 00065 * WHEN MOVING DATA FROM AIO-REC TO DFHCOMMAREA (AFTER DTSCU823 00066 * A SUCCESSFUL READ, READ UPDATE, STARTBR, READNEXT, DTSCU823 00067 * OR READPREV) REFER TO AHDR-REC, ARPT-REC, ETC (NOT DTSCU823 00068 * ACOMM-REC). IF AN UNKNOWN REC-TYPE IS ENCOUNTERED, DTSCU823 00069 * THEN ABEND THE MODULE. DTSCU823 00070 * DTSCU823 00071 * DTSCU823 00072 * COMMAND SPECIFIC SPECIFICATIONS: DTSCU823 00073 * DTSCU823 00074 * READ DTSCU823 00075 * DTSCU823 00076 * STARTBR DTSCU823 00077 * DTSCU823 00078 * PERFORM A STARTBR. IF THE STARTBR IS DTSCU823 00079 * SUCCESSFUL, THEN PERFORM A READNEXT. IF THE DTSCU823 00080 * READNEXT YIELDS AN ENDFILE CONDITION, THEN RETURN DTSCU823 00081 * L823-NO-REC-88. DTSCU823 00082 * DTSCU823 00083 * IF THE READNEXT RETURNS A L823-NO-REC-88, THEN DTSCU823 00084 * ISSUE AN ENDBR. DTSCU823 00085 * DTSCU823 00086 * READNEXT DTSCU823 00087 * PRIOR TO THE READNEXT, MOVE ASKL-KEY-AREA OF DTSCU823 00088 * ACOMM-REC TO ASKL-KEY-AREA OF AIO-REC. IF THE DTSCU823 00089 * READNEXT YIELDS AN ENDFILE CONDITION, THEN RETURN DTSCU823 00090 * L823-NO-REC-88. DTSCU823 00091 * DTSCU823 00092 * IF THE READNEXT RETURN A L823-NO-REC-88, THEN DTSCU823 00093 * ISSUE AN ENDBR. DTSCU823 00094 * DTSCU823 00095 * READPREV DTSCU823 00096 * PRIOR TO THE READPREV, MOVE ASKL-KEY-AREA OF DTSCU823 00097 * ACOMM-REC TO ASKL-KEY-AREA OF AIO-REC. IF THE DTSCU823 00098 * READPREV YIELDS AN ENDFILE CONDITION, THEN RETURN DTSCU823 00099 * L823-NO-REC-88. DTSCU823 00100 * DTSCU823 00101 * IF THE READPREV RETURN A L823-NO-REC-88, THEN DTSCU823 00102 * ISSUE AN ENDBR. DTSCU823 00103 * DTSCU823 00104 * ENDBR DTSCU823 00105 * TOLERATE THE INVREQ CONDITION. DTSCU823 00106 * DTSCU823 00107 * WRITE DTSCU823 00108 * DTSCU823 00109 * REWRITE DTSCU823 00110 * DTSCU823 00111 * DELETE DTSCU823 00112 * READ (UPDATE) THE RECORD TO BE DELETED. IF RECORD NOT DTSCU823 00113 * FOUND, ABEND THE MODULE. DTSCU823 00114 * DTSCU823 00115 * DELETE. DTSCU823 00116 * DTSCU823 00117 ***** DTSCU823 00118 SKIP3 DTSCU823 00119 ENVIRONMENT DIVISION. DTSCU823 00120 SKIP3 DTSCU823 00121 DATA DIVISION. DTSCU823 00122 SKIP3 DTSCU823 00123 WORKING-STORAGE SECTION. DTSCU823 001235 77 PAN-VALET PICTURE X(24) VALUE '010DTSCU823 11/16/11'. DTSCU823 00124 SKIP3 DTSCU823 00125 01 WRK-AREA. DTSCU823 00126 05 WRK-ABEND-CD PIC X(04) VALUE 'U823'. DTSCU823 00127 05 WRK-RESP-CD PIC S9(08) COMP. DTSCU823 00128 DTSCU823 00129 05 WRK-PROD-FILE-NAME PIC X(08) VALUE 'DTSFATC'. DTSCU823 00130 DTSCU823 00131 05 EMSG-NOT-AVAILABLE. DTSCU823 00132 10 FILLER PIC X(04) VALUE 'E091'. DTSCU823 00133 10 FILLER PIC X(06) VALUE 'FILE '. DTSCU823 00134 10 EMSG-FILE-NAME PIC X(08). DTSCU823 00135 10 FILLER PIC X(33) DTSCU823 00136 VALUE ' NOT AVAILABLE PLEASE TRY LATER'. DTSCU823 00137 SKIP3 DTSCU823 00138 *****05 WRK-CICS-APPLID PIC X(08). DTSCU823 00139 DTSCU823 00140 *****05 WRK-CICS-OP-ID PIC X(08). DTSCU823 00141 *********88 WRK-TCL-OP-ID-88 VALUE 'CE0756' DTSCU823 00142 *********************************************'CE3568' DTSCU823 00143 *********************************************'C84986'. DTSCU823 00144 DTSCU823 00145 05 WRK-FILE-NAME PIC X(08). DTSCU823 00146 DTSCU823 00147 05 WRK-REC-LENGTH PIC S9(04) COMP. DTSCU823 00148 EJECT DTSCU823 00149 01 ALEN-LITERALS. DTSCU823 00150 ++INCLUDE DTSIALEN DTSCU823 00151 EJECT DTSCU823 00152 01 AIO-REC. DTSCU823 00153 ++INCLUDE DTSIASKL DTSCU823 00154 EJECT DTSCU823 00155 LINKAGE SECTION. DTSCU823 00156 SKIP3 DTSCU823 00157 01 DFHCOMMAREA. DTSCU823 00158 05 L823-CONTROL-BLOCK. DTSCU823 00159 ++INCLUDE DTSIL823 DTSCU823 00160 SKIP3 DTSCU823 00161 05 ACOMM-REC. DTSCU823 00162 ++INCLUDE DTSIASKL DTSCU823 00163 SKIP3 DTSCU823 00164 05 AHDR-REC REDEFINES ACOMM-REC. DTSCU823 00165 ++INCLUDE DTSIAHDR DTSCU823 00166 SKIP3 DTSCU823 00167 05 ARPT-REC REDEFINES ACOMM-REC. DTSCU823 00168 ++INCLUDE DTSIARPT DTSCU823 00169 SKIP3 DTSCU823 00170 05 APAY-REC REDEFINES ACOMM-REC. DTSCU823 00171 ++INCLUDE DTSIAPAY DTSCU823 00172 SKIP3 DTSCU823 00173 05 AADJ-REC REDEFINES ACOMM-REC. DTSCU823 00174 ++INCLUDE DTSIAADJ DTSCU823 00175 EJECT DTSCU823 00176 05 AATX-REC REDEFINES ACOMM-REC. DTSCU823 00177 ++INCLUDE DTSIAATX DTSCU823 00178 EJECT DTSCU823 00179 PROCEDURE DIVISION. DTSCU823 00180 DTSCU823 00181 *****EXEC CICS DTSCU823 00182 ***** ASSIGN DTSCU823 00183 ***** APPLID (WRK-CICS-APPLID) DTSCU823 00184 *****END-EXEC. DTSCU823 00185 ***** DTSCU823 00186 *****IF WRK-CICS-APPLID = 'CICSAORT' DTSCU823 00187 ***** EXEC CICS DTSCU823 00188 ***** ASSIGN DTSCU823 00189 ***** USERID (WRK-CICS-OP-ID) DTSCU823 00190 ***** END-EXEC DTSCU823 00191 ***** DTSCU823 00192 ***** IF WRK-TCL-OP-ID-88 DTSCU823 00193 ***** MOVE WRK-TCL-FILE-NAME TO WRK-FILE-NAME DTSCU823 00194 ***** ELSE DTSCU823 00195 ***** MOVE WRK-TEST-FILE-NAME TO WRK-FILE-NAME DTSCU823 00196 *****ELSE DTSCU823 00197 MOVE WRK-PROD-FILE-NAME TO WRK-FILE-NAME. DTSCU823 00198 DTSCU823 00199 DTSCU823 00200 MOVE SPACES TO L823-MSG-AREA. DTSCU823 00201 DTSCU823 00202 SET L823-OK-88 TO TRUE. DTSCU823 00203 DTSCU823 00204 IF L823-READ-NEXT-88 DTSCU823 00205 PERFORM P2200-READ-NEXT THRU P2200-EXIT DTSCU823 00206 ELSE DTSCU823 00207 IF L823-READ-88 DTSCU823 00208 PERFORM P1100-READ THRU P1100-EXIT DTSCU823 00209 ELSE DTSCU823 00210 IF L823-START-BROWSE-88 DTSCU823 00211 PERFORM P2100-START-BROWSE THRU P2100-EXIT DTSCU823 00212 ELSE DTSCU823 00213 IF L823-END-BROWSE-88 DTSCU823 00214 PERFORM P2400-END-BROWSE THRU P2400-EXIT DTSCU823 00215 ELSE DTSCU823 00216 IF L823-READ-PREV-88 DTSCU823 00217 PERFORM P2300-READ-PREV THRU P2300-EXIT DTSCU823 00218 ELSE DTSCU823 00219 IF L823-WRITE-88 DTSCU823 00220 PERFORM P3100-WRITE THRU P3100-EXIT DTSCU823 00221 ELSE DTSCU823 00222 IF L823-REWRITE-88 DTSCU823 00223 PERFORM P3200-REWRITE THRU P3200-EXIT DTSCU823 00224 ELSE DTSCU823 00225 IF L823-DELETE-88 DTSCU823 00226 PERFORM P3300-DELETE THRU P3300-EXIT DTSCU823 00227 ELSE DTSCU823 00228 GO TO S899-ABEND. DTSCU823 00229 DTSCU823 00230 DTSCU823 00231 EXEC CICS DTSCU823 00232 RETURN DTSCU823 00233 END-EXEC. DTSCU823 00234 DTSCU823 00235 DTSCU823 00236 GOBACK. DTSCU823 00237 EJECT DTSCU823 00238 P1100-READ. DTSCU823 00239 MOVE LOW-VALUE TO AIO-REC. DTSCU823 00240 DTSCU823 00241 MOVE ASKL-KEY-AREA OF ACOMM-REC TO ASKL-KEY-AREA OF AIO-REC. DTSCU823 00242 DTSCU823 00243 MOVE ALEN-MAX-LENGTH TO WRK-REC-LENGTH. DTSCU823 00244 DTSCU823 00245 EXEC CICS DTSCU823 00246 READ DTSCU823 00247 DATASET (WRK-FILE-NAME) DTSCU823 00248 INTO (AIO-REC) DTSCU823 00249 LENGTH (WRK-REC-LENGTH) DTSCU823 00250 RIDFLD (ASKL-KEY-AREA OF AIO-REC) DTSCU823 00251 RESP (WRK-RESP-CD) DTSCU823 00252 END-EXEC. DTSCU823 00253 DTSCU823 00254 IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED) DTSCU823 00255 OR DFHRESP (SYSIDERR) DTSCU823 00256 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU823 00257 GO TO P1100-EXIT. DTSCU823 00258 DTSCU823 00259 IF WRK-RESP-CD = DFHRESP (NOTFND) DTSCU823 00260 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU823 00261 GO TO P1100-EXIT. DTSCU823 00262 DTSCU823 00263 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU823 00264 PERFORM S2100-IO-TO-COMM THRU S2100-EXIT DTSCU823 00265 ELSE DTSCU823 00266 GO TO S899-ABEND. DTSCU823 00267 P1100-EXIT. DTSCU823 00268 EXIT. DTSCU823 00269 EJECT DTSCU823 00270 P2100-START-BROWSE. DTSCU823 00271 MOVE LOW-VALUE TO AIO-REC. DTSCU823 00272 DTSCU823 00273 MOVE ASKL-KEY-AREA OF ACOMM-REC TO ASKL-KEY-AREA OF AIO-REC. DTSCU823 00274 DTSCU823 00275 EXEC CICS DTSCU823 00276 STARTBR DTSCU823 00277 DATASET (WRK-FILE-NAME) DTSCU823 00278 RIDFLD (ASKL-KEY-AREA OF AIO-REC) DTSCU823 00279 RESP (WRK-RESP-CD) DTSCU823 00280 END-EXEC. DTSCU823 00281 DTSCU823 00282 IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED) DTSCU823 00283 OR DFHRESP (SYSIDERR) DTSCU823 00284 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU823 00285 GO TO P2100-EXIT. DTSCU823 00286 DTSCU823 00287 IF WRK-RESP-CD = DFHRESP (NOTFND) DTSCU823 00288 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU823 00289 GO TO P2100-EXIT. DTSCU823 00290 DTSCU823 00291 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU823 00292 PERFORM P2200-READ-NEXT THRU P2200-EXIT DTSCU823 00293 ELSE DTSCU823 00294 GO TO S899-ABEND. DTSCU823 00295 P2100-EXIT. DTSCU823 00296 EXIT. DTSCU823 00297 EJECT DTSCU823 00298 P2200-READ-NEXT. DTSCU823 00299 IF L823-READ-NEXT-88 DTSCU823 00300 MOVE LOW-VALUE TO AIO-REC DTSCU823 00301 MOVE ASKL-KEY-AREA OF ACOMM-REC DTSCU823 00302 TO ASKL-KEY-AREA OF AIO-REC. DTSCU823 00303 DTSCU823 00304 MOVE ALEN-MAX-LENGTH TO WRK-REC-LENGTH. DTSCU823 00305 DTSCU823 00306 EXEC CICS DTSCU823 00307 READNEXT DTSCU823 00308 DATASET (WRK-FILE-NAME) DTSCU823 00309 INTO (AIO-REC) DTSCU823 00310 LENGTH (WRK-REC-LENGTH) DTSCU823 00311 RIDFLD (ASKL-KEY-AREA OF AIO-REC) DTSCU823 00312 RESP (WRK-RESP-CD) DTSCU823 00313 END-EXEC. DTSCU823 00314 DTSCU823 00315 IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED) DTSCU823 00316 OR DFHRESP (SYSIDERR) DTSCU823 00317 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU823 00318 GO TO P2200-EXIT. DTSCU823 00319 DTSCU823 00320 IF WRK-RESP-CD = DFHRESP (NOTFND) OR DFHRESP (ENDFILE) DTSCU823 00321 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU823 00322 PERFORM P2400-END-BROWSE THRU P2400-EXIT DTSCU823 00323 GO TO P2200-EXIT. DTSCU823 00324 DTSCU823 00325 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU823 00326 NEXT SENTENCE DTSCU823 00327 ELSE DTSCU823 00328 GO TO S899-ABEND. DTSCU823 00329 DTSCU823 00330 PERFORM S2100-IO-TO-COMM THRU S2100-EXIT. DTSCU823 00331 P2200-EXIT. DTSCU823 00332 EXIT. DTSCU823 00333 EJECT DTSCU823 00334 P2300-READ-PREV. DTSCU823 00335 MOVE LOW-VALUE TO AIO-REC. DTSCU823 00336 DTSCU823 00337 MOVE ASKL-KEY-AREA OF ACOMM-REC DTSCU823 00338 TO ASKL-KEY-AREA OF AIO-REC. DTSCU823 00339 DTSCU823 00340 MOVE ALEN-MAX-LENGTH TO WRK-REC-LENGTH. DTSCU823 00341 DTSCU823 00342 EXEC CICS DTSCU823 00343 READPREV DTSCU823 00344 DATASET (WRK-FILE-NAME) DTSCU823 00345 INTO (AIO-REC) DTSCU823 00346 LENGTH (WRK-REC-LENGTH) DTSCU823 00347 RIDFLD (ASKL-KEY-AREA OF AIO-REC) DTSCU823 00348 RESP (WRK-RESP-CD) DTSCU823 00349 END-EXEC. DTSCU823 00350 DTSCU823 00351 IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED) DTSCU823 00352 OR DFHRESP (SYSIDERR) DTSCU823 00353 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU823 00354 GO TO P2300-EXIT. DTSCU823 00355 DTSCU823 00356 IF WRK-RESP-CD = DFHRESP (NOTFND) OR DFHRESP (ENDFILE) DTSCU823 00357 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU823 00358 PERFORM P2400-END-BROWSE THRU P2400-EXIT DTSCU823 00359 GO TO P2300-EXIT. DTSCU823 00360 DTSCU823 00361 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU823 00362 NEXT SENTENCE DTSCU823 00363 ELSE DTSCU823 00364 GO TO S899-ABEND. DTSCU823 00365 DTSCU823 00366 PERFORM S2100-IO-TO-COMM THRU S2100-EXIT. DTSCU823 00367 P2300-EXIT. DTSCU823 00368 EXIT. DTSCU823 00369 EJECT DTSCU823 00370 P2400-END-BROWSE. DTSCU823 00371 DTSCU823 00372 EXEC CICS DTSCU823 00373 ENDBR DTSCU823 00374 DATASET (WRK-FILE-NAME) DTSCU823 00375 RESP (WRK-RESP-CD) DTSCU823 00376 END-EXEC. DTSCU823 00377 DTSCU823 00378 IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN) DTSCU823 00379 OR DFHRESP (SYSIDERR) DTSCU823 00380 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU823 00381 GO TO P2400-EXIT. DTSCU823 00382 DTSCU823 00383 IF WRK-RESP-CD = DFHRESP (NORMAL) OR DFHRESP (INVREQ) DTSCU823 00384 NEXT SENTENCE DTSCU823 00385 ELSE DTSCU823 00386 GO TO S899-ABEND. DTSCU823 00387 P2400-EXIT. DTSCU823 00388 EXIT. DTSCU823 00389 EJECT DTSCU823 00390 P3100-WRITE. DTSCU823 00391 PERFORM S2200-COMM-TO-IO THRU S2200-EXIT. DTSCU823 00392 DTSCU823 00393 PERFORM S2300-CALCULATE-LENGTH THRU S2300-EXIT. DTSCU823 00394 DTSCU823 00395 EXEC CICS DTSCU823 00396 WRITE DTSCU823 00397 DATASET (WRK-FILE-NAME) DTSCU823 00398 FROM (AIO-REC) DTSCU823 00399 LENGTH (WRK-REC-LENGTH) DTSCU823 00400 RIDFLD (ASKL-KEY-AREA OF AIO-REC) DTSCU823 00401 RESP (WRK-RESP-CD) DTSCU823 00402 END-EXEC. DTSCU823 00403 DTSCU823 00404 IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN) DTSCU823 00405 OR DFHRESP (SYSIDERR) DTSCU823 00406 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU823 00407 GO TO P3100-EXIT. DTSCU823 00408 DTSCU823 00409 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU823 00410 NEXT SENTENCE DTSCU823 00411 ELSE DTSCU823 00412 GO TO S899-ABEND. DTSCU823 00413 P3100-EXIT. DTSCU823 00414 EXIT. DTSCU823 00415 EJECT DTSCU823 00416 P3200-REWRITE. DTSCU823 00417 PERFORM S3100-READ-UPDATE THRU S3100-EXIT. DTSCU823 00418 DTSCU823 00419 IF L823-NO-REC-88 DTSCU823 00420 GO TO S899-ABEND DTSCU823 00421 ELSE DTSCU823 00422 IF L823-FILE-CLOSED-88 DTSCU823 00423 GO TO P3200-EXIT. DTSCU823 00424 DTSCU823 00425 PERFORM S2200-COMM-TO-IO THRU S2200-EXIT. DTSCU823 00426 DTSCU823 00427 PERFORM S2300-CALCULATE-LENGTH THRU S2300-EXIT. DTSCU823 00428 DTSCU823 00429 EXEC CICS DTSCU823 00430 REWRITE DTSCU823 00431 DATASET (WRK-FILE-NAME) DTSCU823 00432 FROM (AIO-REC) DTSCU823 00433 LENGTH (WRK-REC-LENGTH) DTSCU823 00434 RESP (WRK-RESP-CD) DTSCU823 00435 END-EXEC. DTSCU823 00436 DTSCU823 00437 IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN) DTSCU823 00438 OR DFHRESP (SYSIDERR) DTSCU823 00439 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU823 00440 GO TO P3200-EXIT. DTSCU823 00441 DTSCU823 00442 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU823 00443 NEXT SENTENCE DTSCU823 00444 ELSE DTSCU823 00445 GO TO S899-ABEND. DTSCU823 00446 P3200-EXIT. DTSCU823 00447 EXIT. DTSCU823 00448 EJECT DTSCU823 00449 P3300-DELETE. DTSCU823 00450 PERFORM S3100-READ-UPDATE THRU S3100-EXIT. DTSCU823 00451 DTSCU823 00452 IF L823-NO-REC-88 DTSCU823 00453 GO TO S899-ABEND DTSCU823 00454 ELSE DTSCU823 00455 IF L823-FILE-CLOSED-88 DTSCU823 00456 GO TO P3300-EXIT. DTSCU823 00457 DTSCU823 00458 EXEC CICS DTSCU823 00459 DELETE DTSCU823 00460 DATASET (WRK-FILE-NAME) DTSCU823 00461 RESP (WRK-RESP-CD) DTSCU823 00462 END-EXEC. DTSCU823 00463 DTSCU823 00464 IF WRK-RESP-CD = DFHRESP (DISABLED) OR DFHRESP (NOTOPEN) DTSCU823 00465 OR DFHRESP (SYSIDERR) DTSCU823 00466 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU823 00467 GO TO P3300-EXIT. DTSCU823 00468 DTSCU823 00469 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU823 00470 NEXT SENTENCE DTSCU823 00471 ELSE DTSCU823 00472 GO TO S899-ABEND. DTSCU823 00473 P3300-EXIT. DTSCU823 00474 EXIT. DTSCU823 00475 EJECT DTSCU823 00476 S1100-NOT-AVAILABLE. DTSCU823 00477 MOVE WRK-FILE-NAME TO EMSG-FILE-NAME. DTSCU823 00478 DTSCU823 00479 MOVE EMSG-NOT-AVAILABLE TO L823-MSG-AREA. DTSCU823 00480 DTSCU823 00481 SET L823-FILE-CLOSED-88 TO TRUE. DTSCU823 00482 S1100-EXIT. DTSCU823 00483 EXIT. DTSCU823 00484 SKIP3 DTSCU823 00485 S1200-NOT-FOUND. DTSCU823 00486 SET L823-NO-REC-88 TO TRUE. DTSCU823 00487 S1200-EXIT. DTSCU823 00488 EXIT. DTSCU823 00489 EJECT DTSCU823 00490 S2100-IO-TO-COMM. DTSCU823 00491 IF ASKL-ADJ-88 OF AIO-REC DTSCU823 00492 MOVE AIO-REC TO AADJ-REC DTSCU823 00493 ELSE DTSCU823 00494 IF ASKL-HDR-88 OF AIO-REC DTSCU823 00495 MOVE AIO-REC TO AHDR-REC DTSCU823 00496 ELSE DTSCU823 00497 IF ASKL-PAY-88 OF AIO-REC DTSCU823 00498 MOVE AIO-REC TO APAY-REC DTSCU823 00499 ELSE DTSCU823 00500 IF ASKL-RPT-88 OF AIO-REC DTSCU823 00501 MOVE AIO-REC TO ARPT-REC DTSCU823 00502 ELSE DTSCU823 00503 IF ASKL-ATX-88 OF AIO-REC DTSCU823 00504 MOVE AIO-REC TO AATX-REC DTSCU823 00505 ELSE DTSCU823 00506 GO TO S899-ABEND. DTSCU823 00507 SKIP3 DTSCU823 00508 S2100-EXIT. DTSCU823 00509 EXIT. DTSCU823 00510 EJECT DTSCU823 00511 S2200-COMM-TO-IO. DTSCU823 00512 IF ASKL-ADJ-88 OF ACOMM-REC DTSCU823 00513 MOVE AADJ-REC TO AIO-REC DTSCU823 00514 ELSE DTSCU823 00515 IF ASKL-HDR-88 OF ACOMM-REC DTSCU823 00516 MOVE AHDR-REC TO AIO-REC DTSCU823 00517 ELSE DTSCU823 00518 IF ASKL-PAY-88 OF ACOMM-REC DTSCU823 00519 MOVE APAY-REC TO AIO-REC DTSCU823 00520 ELSE DTSCU823 00521 IF ASKL-RPT-88 OF ACOMM-REC DTSCU823 00522 MOVE ARPT-REC TO AIO-REC DTSCU823 00523 ELSE DTSCU823 00524 IF ASKL-ATX-88 OF ACOMM-REC DTSCU823 00525 MOVE AATX-REC TO AIO-REC DTSCU823 00526 ELSE DTSCU823 00527 GO TO S899-ABEND. DTSCU823 00528 SKIP3 DTSCU823 00529 S2200-EXIT. DTSCU823 00530 EXIT. DTSCU823 00531 EJECT DTSCU823 00532 S2300-CALCULATE-LENGTH. DTSCU823 00533 IF ASKL-ADJ-88 OF ACOMM-REC DTSCU823 00534 MOVE ALEN-ADJ-LENGTH TO WRK-REC-LENGTH DTSCU823 00535 ELSE DTSCU823 00536 IF ASKL-HDR-88 OF ACOMM-REC DTSCU823 00537 MOVE ALEN-HDR-LENGTH TO WRK-REC-LENGTH DTSCU823 00538 ELSE DTSCU823 00539 IF ASKL-PAY-88 OF ACOMM-REC DTSCU823 00540 MOVE ALEN-PAY-LENGTH TO WRK-REC-LENGTH DTSCU823 00541 ELSE DTSCU823 00542 IF ASKL-RPT-88 OF ACOMM-REC DTSCU823 00543 MOVE ALEN-RPT-LENGTH TO WRK-REC-LENGTH DTSCU823 00544 ELSE DTSCU823 00545 IF ASKL-ATX-88 OF ACOMM-REC DTSCU823 00546 MOVE ALEN-ATX-LENGTH TO WRK-REC-LENGTH DTSCU823 00547 ELSE DTSCU823 00548 GO TO S899-ABEND. DTSCU823 00549 S2300-EXIT. DTSCU823 00550 EXIT. DTSCU823 00551 EJECT DTSCU823 00552 S3100-READ-UPDATE. DTSCU823 00553 MOVE LOW-VALUE TO AIO-REC. DTSCU823 00554 DTSCU823 00555 MOVE ASKL-KEY-AREA OF ACOMM-REC TO ASKL-KEY-AREA OF AIO-REC. DTSCU823 00556 DTSCU823 00557 MOVE ALEN-MAX-LENGTH TO WRK-REC-LENGTH. DTSCU823 00558 DTSCU823 00559 EXEC CICS DTSCU823 00560 READ DTSCU823 00561 DATASET (WRK-FILE-NAME) DTSCU823 00562 INTO (AIO-REC) DTSCU823 00563 LENGTH (WRK-REC-LENGTH) DTSCU823 00564 RIDFLD (ASKL-KEY-AREA OF AIO-REC) DTSCU823 00565 UPDATE DTSCU823 00566 RESP (WRK-RESP-CD) DTSCU823 00567 END-EXEC. DTSCU823 00568 DTSCU823 00569 IF WRK-RESP-CD = DFHRESP (NOTOPEN) OR DFHRESP (DISABLED) DTSCU823 00570 OR DFHRESP (SYSIDERR) DTSCU823 00571 PERFORM S1100-NOT-AVAILABLE THRU S1100-EXIT DTSCU823 00572 GO TO S3100-EXIT. DTSCU823 00573 DTSCU823 00574 IF WRK-RESP-CD = DFHRESP (NOTFND) DTSCU823 00575 PERFORM S1200-NOT-FOUND THRU S1200-EXIT DTSCU823 00576 GO TO S3100-EXIT. DTSCU823 00577 DTSCU823 00578 IF WRK-RESP-CD = DFHRESP (NORMAL) DTSCU823 00579 NEXT SENTENCE DTSCU823 00580 ELSE DTSCU823 00581 GO TO S899-ABEND. DTSCU823 00582 S3100-EXIT. DTSCU823 00583 EXIT. DTSCU823 00584 EJECT DTSCU823 00585 S899-ABEND. DTSCU823 00586 EXEC CICS DTSCU823 00587 ABEND DTSCU823 00588 ABCODE (WRK-ABEND-CD) DTSCU823 00589 END-EXEC. DTSCU823 00590 S899-EXIT. DTSCU823 00591 EXIT. DTSCU823