00001 IDENTIFICATION DIVISION. 06/17/13 00002 PROGRAM-ID. DTSBD181. DTSBD181 00003 AUTHOR. NGC. LV001 00004 DATE-WRITTEN. JUNE 2013. DTSBD181 00005 DATE-COMPILED. DTSBD181 00006 SKIP3 DTSBD181 00007 ***** DTSBD181 00008 * DTSBD181 00009 * FUNCTION: POST-UPDATE ACCOUNTING TRANSACTION COLLECTION DTSBD181 00010 * FILE: UPDATE LAST USED ITEM NUMBER. DTSBD181 00011 * DTSBD181 00012 * MODIFICATION LOG: DTSBD181 00013 * DTSBD181 00014 * 06/04/2113 INITIAL DEVELOPMENT. DTSBD181 00015 * WORK ORDER: PROGRAMMER: GD DTSBD181 00016 * DTSBD181 00017 * DTSBD181 00018 * DESCRIPTION: DTSBD181 00019 * DTSBD181 00020 * INITIATION: DTSBD181 00021 * DTSBD181 00022 * OPEN MASTER FILE (L910-OPEN-READ-88). DTSBD181 00023 * OPEN ATC FILE (L923-OPEN-UPDATE-88). DTSBD181 00024 * DTSBD181 00025 * READ THE MHDR RECORD. DTSBD181 00026 * IF L910-NO-REC-88 DTSBD181 00027 * ABEND THE MODULE. DTSBD181 00028 * DTSBD181 00029 * MOVE MHDR-PRIOR-RUN-DATE TO R301-CURR-RUN-DATE. DTSBD181 00030 * DTSBD181 00031 * MOVE +0 TO WORKING STORAGE COUNTERS. DTSBD181 00032 * DTSBD181 00033 * DTSBD181 00034 * PROCESSING: DTSBD181 00035 * DTSBD181 00036 * FOR EACH AHDR RECORD ON THE ATC FILE: DTSBD181 00037 * DTSBD181 00038 * IF AHDR-BATCH-BALANCED-NO-88 OR AHDR-BATCH-HELD-YES-88 DTSBD181 00039 * WRITE A R301 RECORD (WITH R301 FIELDS POPULATED FROM DTSBD181 00040 * AHDR FIELDS) DTSBD181 00041 * ELSE DTSBD181 00042 * SCAN THRU THE ATC FILE, SUMMING PROCESSED AND NOT DTSBD181 00043 * PROCESSED TRANSACTIONS IN THIS BATCH; DTSBD181 00044 * WRITE A R301 RECORD; DTSBD181 00045 * IF UNPROCESEED TRANSACTION RECORDS IN THIS BATCH DTSBD181 00046 * EXIST ON THE ATC FILE DTSBD181 00047 * RESET AHDR FIELDS AND REWRITE THE AHDR RECORD DTSBD181 00048 * ELSE DTSBD181 00049 * DELETE THE AHDR RECORD AND ALL ASSOCIATED DTSBD181 00050 * TRANSACTIONS. DTSBD181 00051 * DTSBD181 00052 * DTSBD181 00053 * TERMINATION: DTSBD181 00054 * DTSBD181 00055 * DISPLAY THE MODULE TERMINATION STATISTICS. DTSBD181 00056 * DTSBD181 00057 * CLOSE MASTER FILE, ATC FILE, S946-RPT-REC-O FILE. DTSBD181 00058 * DTSBD181 00059 * DTSBD181 00060 ***** DTSBD181 00061 SKIP3 DTSBD181 00062 ENVIRONMENT DIVISION. DTSBD181 00063 INPUT-OUTPUT SECTION. DTSBD181 00064 DTSBD181 00065 FILE-CONTROL. DTSBD181 00066 * SELECT SORT-FILE ASSIGN TO DTSFSORT DTSBD181 00067 * FILE STATUS IS SORT-STATUS. DTSBD181 00068 DTSBD181 00069 SKIP3 DTSBD181 00070 DATA DIVISION. DTSBD181 00071 FILE SECTION. DTSBD181 00072 DTSBD181 00073 *FD BX217-BATCH-FILE DTSBD181 00074 * RECORDING MODE IS F DTSBD181 00075 * BLOCK CONTAINS 0 RECORDS DTSBD181 00076 * LABEL RECORDS ARE OMITTED. DTSBD181 00077 * DTSBD181 00078 *01 BX217-REC PIC X(148). DTSBD181 00079 SKIP3 DTSBD181 00080 WORKING-STORAGE SECTION. DTSBD181 000805 77 PAN-VALET PICTURE X(24) VALUE '001DTSBD181 06/17/13'. DTSBD181 00081 77 PAN-VALET PICTURE X(24) VALUE '001DTSBD181 06/17/13'. DTSBD181 00082 77 PAN-VALET PICTURE X(24) VALUE '022DTSBD181 06/05/13'. DTSBD181 00083 77 PAN-VALET PICTURE X(24) VALUE '019DTSBD180 10/03/11'. DTSBD181 00084 SKIP3 DTSBD181 00085 01 WRK-AREA. DTSBD181 00086 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +181.DTSBD181 00087 DTSBD181 00088 05 WRK-MODULE-ID PIC X(08) VALUE 'DTSBD181'.DTSBD181 00089 DTSBD181 00090 05 BX217-STATUS PIC X(02). DTSBD181 00091 88 BX217-STATUS-OK-88 VALUE '00'. DTSBD181 00092 DTSBD181 00093 05 WRK-AHDR-REC-CNT PIC S9(07) COMP-3 DTSBD181 00094 VALUE +0. DTSBD181 00095 DTSBD181 00096 05 WRK-AHDR-UPD-CNT PIC S9(07) COMP-3 DTSBD181 00097 VALUE +0. DTSBD181 00098 DTSBD181 00099 05 WRK-LAST-USED-ITEM-NO PIC S9(03) COMP-3. DTSBD181 00100 DTSBD181 00101 DTSBD181 00102 01 WRK-INDICATORS. DTSBD181 00103 05 ATC-BATCH-BREAK-IND PIC X(01). DTSBD181 00104 DTSBD181 00105 DTSBD181 00106 DTSBD181 00107 EJECT DTSBD181 00108 01 L001-LINK-AREA. DTSBD181 00109 ++INCLUDE DTSIL001 DTSBD181 00110 SKIP3 DTSBD181 00111 01 L910-LINK-AREA. DTSBD181 00112 ++INCLUDE DTSIL910 DTSBD181 00113 SKIP3 DTSBD181 00114 01 MSKL-REC. DTSBD181 00115 ++INCLUDE DTSIMSKL DTSBD181 00116 SKIP3 DTSBD181 00117 01 MHDR-REC. DTSBD181 00118 ++INCLUDE DTSIMHDR DTSBD181 00119 EJECT DTSBD181 00120 01 MRPT-REC. DTSBD181 00121 ++INCLUDE DTSIMRPT DTSBD181 00122 EJECT DTSBD181 00123 01 MPAY-REC. DTSBD181 00124 ++INCLUDE DTSIMPAY DTSBD181 00125 EJECT DTSBD181 00126 01 MADJ-REC. DTSBD181 00127 ++INCLUDE DTSIMADJ DTSBD181 00128 EJECT DTSBD181 00129 01 L923-LINK-AREA. DTSBD181 00130 ++INCLUDE DTSIL923 DTSBD181 00131 SKIP3 DTSBD181 00132 01 ASKL-REC. DTSBD181 00133 ++INCLUDE DTSIASKL DTSBD181 00134 SKIP3 DTSBD181 00135 01 AHDR-REC. DTSBD181 00136 ++INCLUDE DTSIAHDR DTSBD181 00137 SKIP3 DTSBD181 00138 01 ARPT-REC. DTSBD181 00139 ++INCLUDE DTSIARPT DTSBD181 00140 SKIP3 DTSBD181 00141 01 AATX-REC. DTSBD181 00142 ++INCLUDE DTSIAATX DTSBD181 00143 SKIP3 DTSBD181 00144 01 APAY-REC. DTSBD181 00145 ++INCLUDE DTSIAPAY DTSBD181 00146 SKIP3 DTSBD181 00147 01 AADJ-REC. DTSBD181 00148 ++INCLUDE DTSIAADJ DTSBD181 00149 EJECT DTSBD181 00150 PROCEDURE DIVISION. DTSBD181 00151 DTSBD181 00152 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBD181 00153 DTSBD181 00154 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBD181 00155 DTSBD181 00156 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBD181 00157 DTSBD181 00158 DTSBD181 00159 GOBACK. DTSBD181 00160 EJECT DTSBD181 00161 I0000-INITIATE. DTSBD181 00162 PERFORM I1000-OPEN-FILES THRU I1000-EXIT. DTSBD181 00163 DTSBD181 00164 PERFORM I2000-INITIALIZE-WRK THRU I2000-EXIT. DTSBD181 00165 DTSBD181 00166 I0000-EXIT. DTSBD181 00167 EXIT. DTSBD181 00168 EJECT DTSBD181 00169 I1000-OPEN-FILES. DTSBD181 00170 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBD181 00171 DTSBD181 00172 *& PERFORM S923-OPEN-READ THRU S923-EXIT. DTSBD181 00173 PERFORM S923-OPEN-UPDATE THRU S923-EXIT. DTSBD181 00174 DTSBD181 00175 DTSBD181 00176 I1000-EXIT. DTSBD181 00177 EXIT. DTSBD181 00178 EJECT DTSBD181 00179 I2000-INITIALIZE-WRK. DTSBD181 00180 MOVE +0 TO WRK-AHDR-REC-CNT. DTSBD181 00181 DTSBD181 00182 MOVE LOW-VALUES TO MHDR-KEY-AREA. DTSBD181 00183 DTSBD181 00184 MOVE +0 TO MHDR-EMP-NO. DTSBD181 00185 DTSBD181 00186 SET MHDR-HDR-88 TO TRUE. DTSBD181 00187 DTSBD181 00188 MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA. DTSBD181 00189 DTSBD181 00190 PERFORM S910-READ THRU S910-EXIT. DTSBD181 00191 DTSBD181 00192 IF L910-NO-REC-88 DTSBD181 00193 PERFORM S999-ABEND THRU S999-EXIT. DTSBD181 00194 DTSBD181 00195 MOVE MSKL-REC TO MHDR-REC. DTSBD181 00196 DTSBD181 00197 I2000-EXIT. DTSBD181 00198 EXIT. DTSBD181 00199 DTSBD181 00200 P0000-PROCESS. DTSBD181 00201 MOVE +0 TO AHDR-BATCH-NO DTSBD181 00202 AHDR-ITEM-NO. DTSBD181 00203 DTSBD181 00204 PERFORM P1000-ATC-FILE THRU P1000-EXIT DTSBD181 00205 UNTIL L923-NO-REC-88. DTSBD181 00206 P0000-EXIT. DTSBD181 00207 EXIT. DTSBD181 00208 EJECT DTSBD181 00209 P1000-ATC-FILE. DTSBD181 00210 ADD +1 TO AHDR-BATCH-NO. DTSBD181 00211 DTSBD181 00212 MOVE 'N' TO ATC-BATCH-BREAK-IND. DTSBD181 00213 DTSBD181 00214 MOVE AHDR-KEY-AREA TO ASKL-KEY-AREA. DTSBD181 00215 DTSBD181 00216 PERFORM S923-START-BROWSE THRU S923-EXIT. DTSBD181 00217 DTSBD181 00218 IF L923-NO-REC-88 DTSBD181 00219 GO TO P1000-EXIT. DTSBD181 00220 DTSBD181 00221 DTSBD181 00222 IF NOT ASKL-HDR-88 DTSBD181 00223 PERFORM S999-ABEND THRU S999-EXIT. DTSBD181 00224 DTSBD181 00225 DTSBD181 00226 MOVE ASKL-REC TO AHDR-REC. DTSBD181 00227 DTSBD181 00228 MOVE +0 TO WRK-LAST-USED-ITEM-NO. DTSBD181 00229 ADD +1 TO WRK-AHDR-REC-CNT. DTSBD181 00230 DTSBD181 00231 PERFORM P2000-ATC-DETAIL THRU P2000-EXIT DTSBD181 00232 UNTIL L923-NO-REC-88 OR DTSBD181 00233 ATC-BATCH-BREAK-IND = 'Y'. DTSBD181 00234 DTSBD181 00235 IF WRK-LAST-USED-ITEM-NO > AHDR-LAST-USED-ITEM-NO DTSBD181 00236 PERFORM P4000-UPDATE-BATCH-HDR THRU P4000-EXIT DTSBD181 00237 END-IF. DTSBD181 00238 DTSBD181 00239 P1000-EXIT. DTSBD181 00240 EXIT. DTSBD181 00241 DTSBD181 00242 P2000-ATC-DETAIL. DTSBD181 00243 PERFORM S923-READ-NEXT THRU S923-EXIT. DTSBD181 00244 DTSBD181 00245 IF (L923-NO-REC-88) DTSBD181 00246 OR DTSBD181 00247 (ASKL-BATCH-NO NOT = AHDR-BATCH-NO) DTSBD181 00248 MOVE 'Y' TO ATC-BATCH-BREAK-IND DTSBD181 00249 ELSE DTSBD181 00250 PERFORM P2100-ACCUM-ACTUALS THRU P2100-EXIT. DTSBD181 00251 P2000-EXIT. DTSBD181 00252 EXIT. DTSBD181 00253 EJECT DTSBD181 00254 P2100-ACCUM-ACTUALS. DTSBD181 00255 IF ASKL-HDR-88 DTSBD181 00256 PERFORM S999-ABEND THRU S999-EXIT. DTSBD181 00257 DTSBD181 00258 EVALUATE TRUE DTSBD181 00259 WHEN ASKL-RPT-88 DTSBD181 00260 MOVE ASKL-REC TO ARPT-REC DTSBD181 00261 IF ARPT-PROCESSED-DATE > ZERO DTSBD181 00262 PERFORM P3000-RPT-LAST-ITEM THRU P3000-EXIT DTSBD181 00263 END-IF DTSBD181 00264 DTSBD181 00265 WHEN ASKL-ATX-88 DTSBD181 00266 MOVE ASKL-REC TO AATX-REC DTSBD181 00267 IF AATX-PROCESSED-DATE > ZERO DTSBD181 00268 PERFORM P3100-ATX-LAST-ITEM THRU P3100-EXIT DTSBD181 00269 END-IF DTSBD181 00270 DTSBD181 00271 WHEN ASKL-PAY-88 DTSBD181 00272 MOVE ASKL-REC TO APAY-REC DTSBD181 00273 IF APAY-PROCESSED-DATE > ZERO DTSBD181 00274 PERFORM P3200-PAY-LAST-ITEM THRU P3200-EXIT DTSBD181 00275 END-IF DTSBD181 00276 DTSBD181 00277 WHEN ASKL-ADJ-88 DTSBD181 00278 MOVE ASKL-REC TO AADJ-REC DTSBD181 00279 IF AADJ-PROCESSED-DATE > ZERO DTSBD181 00280 PERFORM P3300-ADJ-LAST-ITEM THRU P3300-EXIT DTSBD181 00281 END-IF DTSBD181 00282 DTSBD181 00283 END-EVALUATE. DTSBD181 00284 DTSBD181 00285 P2100-EXIT. DTSBD181 00286 EXIT. DTSBD181 00287 DTSBD181 00288 P3000-RPT-LAST-ITEM. DTSBD181 00289 * DISPLAY 'P3000' ARPT-BATCH-NO ' ' ARPT-ITEM-NO DTSBD181 00290 * ' ' ARPT-YRQ ' ' ARPT-RPT-TYPE DTSBD181 00291 MOVE LOW-VALUES TO MRPT-KEY-AREA DTSBD181 00292 MOVE ARPT-EMP-NO TO MRPT-EMP-NO DTSBD181 00293 MOVE ARPT-YRQ TO MRPT-YRQ DTSBD181 00294 SET MRPT-RPT-88 TO TRUE. DTSBD181 00295 MOVE +0 TO MRPT-BATCH-NO DTSBD181 00296 MRPT-ITEM-NO. DTSBD181 00297 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. DTSBD181 00298 DTSBD181 00299 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD181 00300 PERFORM UNTIL L910-NO-REC-88 DTSBD181 00301 MOVE MSKL-REC TO MRPT-REC DTSBD181 00302 IF MRPT-BATCH-NO = ARPT-BATCH-NO DTSBD181 00303 IF MRPT-ITEM-NO > WRK-LAST-USED-ITEM-NO DTSBD181 00304 MOVE MRPT-ITEM-NO TO WRK-LAST-USED-ITEM-NO DTSBD181 00305 END-IF DTSBD181 00306 END-IF DTSBD181 00307 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD181 00308 END-PERFORM. DTSBD181 00309 DTSBD181 00310 P3000-EXIT. DTSBD181 00311 EXIT. DTSBD181 00312 DTSBD181 00313 P3100-ATX-LAST-ITEM. DTSBD181 00314 * DISPLAY 'P3100 ' AATX-BATCH-NO ' ' AATX-ITEM-NO DTSBD181 00315 * ' ' AATX-YRQ ' ' AATX-RPT-TYPE DTSBD181 00316 MOVE LOW-VALUES TO MRPT-KEY-AREA DTSBD181 00317 MOVE AATX-EMP-NO TO MRPT-EMP-NO DTSBD181 00318 MOVE AATX-YRQ TO MRPT-YRQ DTSBD181 00319 SET MRPT-RPT-88 TO TRUE. DTSBD181 00320 MOVE +0 TO MRPT-BATCH-NO DTSBD181 00321 MRPT-ITEM-NO. DTSBD181 00322 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. DTSBD181 00323 DTSBD181 00324 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD181 00325 PERFORM UNTIL L910-NO-REC-88 DTSBD181 00326 MOVE MSKL-REC TO MRPT-REC DTSBD181 00327 IF MRPT-BATCH-NO = AATX-BATCH-NO DTSBD181 00328 IF MRPT-ITEM-NO > WRK-LAST-USED-ITEM-NO DTSBD181 00329 MOVE MRPT-ITEM-NO TO WRK-LAST-USED-ITEM-NO DTSBD181 00330 END-IF DTSBD181 00331 END-IF DTSBD181 00332 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD181 00333 END-PERFORM. DTSBD181 00334 DTSBD181 00335 P3100-EXIT. DTSBD181 00336 EXIT. DTSBD181 00337 DTSBD181 00338 P3200-PAY-LAST-ITEM. DTSBD181 00339 * DISPLAY 'P3200 ' APAY-BATCH-NO ' ' APAY-ITEM-NO DTSBD181 00340 * ' ' APAY-PAY-TYPE DTSBD181 00341 MOVE LOW-VALUES TO MPAY-KEY-AREA. DTSBD181 00342 MOVE APAY-EMP-NO TO MPAY-EMP-NO. DTSBD181 00343 SET MPAY-PAY-88 TO TRUE. DTSBD181 00344 MOVE APAY-BATCH-NO TO MPAY-BATCH-NO DTSBD181 00345 MOVE APAY-ITEM-NO TO MPAY-ITEM-NO. DTSBD181 00346 MOVE MPAY-KEY-AREA TO MSKL-KEY-AREA. DTSBD181 00347 DTSBD181 00348 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD181 00349 PERFORM UNTIL L910-NO-REC-88 DTSBD181 00350 MOVE MSKL-REC TO MPAY-REC DTSBD181 00351 IF MPAY-BATCH-NO = APAY-BATCH-NO DTSBD181 00352 IF MPAY-ITEM-NO > WRK-LAST-USED-ITEM-NO DTSBD181 00353 MOVE MPAY-ITEM-NO TO WRK-LAST-USED-ITEM-NO DTSBD181 00354 END-IF DTSBD181 00355 END-IF DTSBD181 00356 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD181 00357 END-PERFORM. DTSBD181 00358 DTSBD181 00359 P3200-EXIT. DTSBD181 00360 EXIT. DTSBD181 00361 DTSBD181 00362 P3300-ADJ-LAST-ITEM. DTSBD181 00363 * DISPLAY 'P3300 ' AADJ-BATCH-NO ' ' AADJ-ITEM-NO DTSBD181 00364 * ' ' AADJ-ADJ-TYPE DTSBD181 00365 MOVE LOW-VALUES TO MADJ-KEY-AREA. DTSBD181 00366 MOVE AADJ-EMP-NO TO MADJ-EMP-NO. DTSBD181 00367 SET MADJ-ADJ-88 TO TRUE. DTSBD181 00368 MOVE AADJ-BATCH-NO TO MADJ-BATCH-NO DTSBD181 00369 MOVE AADJ-ITEM-NO TO MADJ-ITEM-NO. DTSBD181 00370 MOVE MADJ-KEY-AREA TO MSKL-KEY-AREA. DTSBD181 00371 DTSBD181 00372 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD181 00373 PERFORM UNTIL L910-NO-REC-88 DTSBD181 00374 MOVE MSKL-REC TO MADJ-REC DTSBD181 00375 IF MADJ-BATCH-NO = AADJ-BATCH-NO DTSBD181 00376 IF MADJ-ITEM-NO > WRK-LAST-USED-ITEM-NO DTSBD181 00377 MOVE MADJ-ITEM-NO TO WRK-LAST-USED-ITEM-NO DTSBD181 00378 END-IF DTSBD181 00379 END-IF DTSBD181 00380 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD181 00381 END-PERFORM. DTSBD181 00382 DTSBD181 00383 P3300-EXIT. DTSBD181 00384 EXIT. DTSBD181 00385 DTSBD181 00386 P4000-UPDATE-BATCH-HDR. DTSBD181 00387 DISPLAY 'BD181 LAST ITEM1: ' AHDR-BATCH-NO DTSBD181 00388 ' ' AHDR-LAST-USED-ITEM-NO. DTSBD181 00389 DTSBD181 00390 MOVE WRK-LAST-USED-ITEM-NO TO AHDR-LAST-USED-ITEM-NO. DTSBD181 00391 DTSBD181 00392 DISPLAY 'BD181 LAST ITEM2: ' AHDR-BATCH-NO DTSBD181 00393 ' ' AHDR-LAST-USED-ITEM-NO. DTSBD181 00394 DTSBD181 00395 MOVE AHDR-REC TO ASKL-REC. DTSBD181 00396 DTSBD181 00397 PERFORM S923-REWRITE THRU S923-EXIT. DTSBD181 00398 DTSBD181 00399 P4000-EXIT. DTSBD181 00400 EXIT. DTSBD181 00401 DTSBD181 00402 T0000-TERMINATE. DTSBD181 00403 DISPLAY ' '. DTSBD181 00404 DTSBD181 00405 DISPLAY '*** DTSBD181 TERMINATION STATISTICS ***'. DTSBD181 00406 DTSBD181 00407 DISPLAY ' HEADER RECORDS FOUND : ' DTSBD181 00408 WRK-AHDR-REC-CNT. DTSBD181 00409 DISPLAY ' HEADER RECORDS UPDATED: ' DTSBD181 00410 WRK-AHDR-UPD-CNT. DTSBD181 00411 DTSBD181 00412 DISPLAY ' '. DTSBD181 00413 DTSBD181 00414 DTSBD181 00415 PERFORM S910-CLOSE THRU S910-EXIT. DTSBD181 00416 DTSBD181 00417 PERFORM S923-CLOSE THRU S923-EXIT. DTSBD181 00418 DTSBD181 00419 DTSBD181 00420 DTSBD181 00421 T0000-EXIT. DTSBD181 00422 EXIT. DTSBD181 00423 EJECT DTSBD181 00424 S001-FROM-FED-8. DTSBD181 00425 SET L001-FROM-FED-8 TO TRUE. DTSBD181 00426 GO TO S001-DATE. DTSBD181 00427 DTSBD181 00428 S001-FROM-ABS-DAY. DTSBD181 00429 SET L001-FROM-ABS-DAY TO TRUE. DTSBD181 00430 GO TO S001-DATE. DTSBD181 00431 DTSBD181 00432 S001-DATE. DTSBD181 00433 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBD181 00434 S001-EXIT. DTSBD181 00435 EXIT. DTSBD181 00436 DTSBD181 00437 S910-OPEN-READ. DTSBD181 00438 SET L910-OPEN-READ-88 TO TRUE. DTSBD181 00439 GO TO S910-MSTR-IO. DTSBD181 00440 DTSBD181 00441 S910-READ. DTSBD181 00442 SET L910-READ-88 TO TRUE. DTSBD181 00443 GO TO S910-MSTR-IO. DTSBD181 00444 DTSBD181 00445 S910-START-BROWSE. DTSBD181 00446 SET L910-START-BROWSE-88 TO TRUE. DTSBD181 00447 GO TO S910-MSTR-IO. DTSBD181 00448 DTSBD181 00449 S910-READ-NEXT. DTSBD181 00450 SET L910-READ-NEXT-88 TO TRUE. DTSBD181 00451 GO TO S910-MSTR-IO. DTSBD181 00452 DTSBD181 00453 *S910-COUNT. DTSBD181 00454 *****SET L910-COUNT-88 TO TRUE. DTSBD181 00455 *****GO TO S910-MSTR-IO. DTSBD181 00456 DTSBD181 00457 S910-CLOSE. DTSBD181 00458 SET L910-CLOSE-88 TO TRUE. DTSBD181 00459 GO TO S910-MSTR-IO. DTSBD181 00460 DTSBD181 00461 S910-MSTR-IO. DTSBD181 00462 CALL 'DTSBU910' USING L910-LINK-AREA DTSBD181 00463 MSKL-REC. DTSBD181 00464 S910-EXIT. DTSBD181 00465 EXIT. DTSBD181 00466 SKIP3 DTSBD181 00467 S923-OPEN-UPDATE. DTSBD181 00468 SET L923-OPEN-UPDATE-88 TO TRUE. DTSBD181 00469 GO TO S923-ATC-IO. DTSBD181 00470 DTSBD181 00471 S923-OPEN-READ. DTSBD181 00472 SET L923-OPEN-READ-88 TO TRUE. DTSBD181 00473 GO TO S923-ATC-IO. DTSBD181 00474 DTSBD181 00475 S923-READ. DTSBD181 00476 SET L923-READ-88 TO TRUE. DTSBD181 00477 GO TO S923-ATC-IO. DTSBD181 00478 DTSBD181 00479 S923-START-BROWSE. DTSBD181 00480 SET L923-START-BROWSE-88 TO TRUE. DTSBD181 00481 GO TO S923-ATC-IO. DTSBD181 00482 DTSBD181 00483 S923-READ-NEXT. DTSBD181 00484 SET L923-READ-NEXT-88 TO TRUE. DTSBD181 00485 GO TO S923-ATC-IO. DTSBD181 00486 DTSBD181 00487 *S923-WRITE. DTSBD181 00488 *****SET L923-WRITE-88 TO TRUE. DTSBD181 00489 *****GO TO S923-ATC-IO. DTSBD181 00490 DTSBD181 00491 S923-REWRITE. DTSBD181 00492 SET L923-REWRITE-88 TO TRUE. DTSBD181 00493 GO TO S923-ATC-IO. DTSBD181 00494 DTSBD181 00495 S923-DELETE. DTSBD181 00496 SET L923-DELETE-88 TO TRUE. DTSBD181 00497 GO TO S923-ATC-IO. DTSBD181 00498 DTSBD181 00499 S923-CLOSE. DTSBD181 00500 SET L923-CLOSE-88 TO TRUE. DTSBD181 00501 GO TO S923-ATC-IO. DTSBD181 00502 DTSBD181 00503 S923-ATC-IO. DTSBD181 00504 CALL 'DTSBU923' USING L923-LINK-AREA DTSBD181 00505 ASKL-REC. DTSBD181 00506 S923-EXIT. DTSBD181 00507 EXIT. DTSBD181 00508 SKIP3 DTSBD181 00509 S999-ABEND. DTSBD181 00510 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBD181 00511 S999-EXIT. DTSBD181 00512 EXIT. DTSBD181