DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
Neeraj Kumar
513
Batch/DTSBD181.cob
Normal file
513
Batch/DTSBD181.cob
Normal file
@ -0,0 +1,513 @@
|
||||
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
|
||||
Reference in New Issue
Block a user