514 lines
41 KiB
COBOL
514 lines
41 KiB
COBOL
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
|