00001 IDENTIFICATION DIVISION. 01/26/16 00002 PROGRAM-ID. DTSBX521. DTSBX521 00003 AUTHOR. NGC. LV111 00004 DATE-WRITTEN. OCTOBER 2012. CL**4 00005 DATE-COMPILED. DTSBX521 00006 SKIP3 DTSBX521 00007 ** CL*20 00008 * DTSBX521 00009 * FUNCTION: EXTRACT ACCOUNTING AND JOURNAL ENTRIES POSTED CL**4 00010 * DURING THE CURRENT DAILY CYCLE. CL**4 00011 * DTSBX521 00012 * DTSBX521 00013 * MODIFICATION LOG: DTSBX521 00014 * DTSBX521 00015 * 10/07/2012 INITIAL DEVELOPMENT. CL**4 00016 * REFERENCE: PROGRAMMER: GD DTSBX521 00017 * DTSBX521 00018 * 08/07/2015 MODIFIED TO FIND PAYMENTS AND DISTRIBUTION CL*76 00019 * TO MATCH JOURNAL ENTRIES FOR ESSP CL*76 00020 * REFERENCE: PROGRAMMER: ZL1 CL*76 00021 * CL*76 00022 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX521 00023 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX521 00024 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBX521 00025 * DTSBX521 00026 * DTSBX521 00027 * DESCRIPTION: DTSBX521 00028 * DTSBX521 00029 * DTSBX521 00030 * INITIATION: DTSBX521 00031 * DTSBX521 00032 * DTSBX521 00033 * DTSBX521 00034 * PROCESSING: DTSBX521 00035 * DTSBX521 00036 * DTSBX521 00037 * TERMINATION: DTSBX521 00038 * DTSBX521 00039 * DTSBX521 00040 * DTSBX521 00041 * RECORDS READ: DTSBX521 00042 * DTSBX521 00043 * MASTER: DTSBX521 00044 * DTSBX521 00045 * MQTR DTSBX521 00046 * MJRN DTSBX521 00047 * MPAY DTSBX521 00048 * MRPT DTSBX521 00049 * MADJ DTSBX521 00050 * DTSBX521 00051 * DTSBX521 00052 * ALTERNATE INDEX: DTSBX521 00053 * DTSBX521 00054 * NONE. DTSBX521 00055 * DTSBX521 00056 * DTSBX521 00057 * REFERENCE: DTSBX521 00058 * DTSBX521 00059 * DTSBX521 00060 * DTSBX521 00061 * RECORDS UPDATED: DTSBX521 00062 * DTSBX521 00063 * NONE DTSBX521 00064 * DTSBX521 00065 * DTSBX521 00066 * OUTPUT RECORDS WRITTEN: DTSBX521 00067 * DTSBX521 00068 * DTSBX331 DTSBX521 00069 * DTSBX521 00070 * DTSBX521 00071 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBX521 00072 * DTSBX521 00073 * NONE. DTSBX521 00074 * DTSBX521 00075 * DTSBX521 00076 * MODULES CALLED: DTSBX521 00077 * DTSBX521 00078 * DTSBU001 DATE EDIT/CONVERSION. DTSBX521 00079 * DTSBU004 QUARTER EDIT/CONVERSION. DTSBX521 00080 * DTSBU910 MASTER FILE I/O. DTSBX521 00081 * DTSBX521 00082 * DTSBX521 00083 * DTSBX521 00084 ***** DTSBX521 00085 SKIP3 DTSBX521 00086 ENVIRONMENT DIVISION. DTSBX521 00087 INPUT-OUTPUT SECTION. DTSBX521 00088 FILE-CONTROL. DTSBX521 00089 SELECT ACCT-FILE-OUT ASSIGN TO DTSFACCT CL*34 00090 FILE STATUS IS ACCT-I-STATUS. DTSBX521 00091 DTSBX521 00092 SELECT ACCT-FILE-IN ASSIGN TO DTSFTRAN CL*34 00093 FILE STATUS IS TRAN-I-STATUS. DTSBX521 00094 DTSBX521 00095 SELECT PAYD-FILE ASSIGN TO DTSFPAYD CL*65 00096 FILE STATUS IS QTR-STATUS. CL*65 00097 * CL**6 00098 * SELECT SUMMARY-FILE ASSIGN TO DTSFSUM1 CL**6 00099 ** FILE STATUS IS SUMMARY-STATUS. CL**6 00100 DTSBX521 00101 SELECT PAYMT-FILE-OUT ASSIGN TO DTSFPAYT CL*34 00102 FILE STATUS IS PAYDIST-STATUS. CL*29 00103 DTSBX521 00104 DATA DIVISION. DTSBX521 00105 FILE SECTION. DTSBX521 00106 FD ACCT-FILE-OUT CL*34 00107 RECORDING MODE IS F DTSBX521 00108 LABEL RECORDS ARE STANDARD DTSBX521 00109 BLOCK CONTAINS 0 CHARACTERS. DTSBX521 00110 DTSBX521 00111 01 ACCT-OUT-REC PIC X(253). CL*57 00112 DTSBX521 00113 FD ACCT-FILE-IN CL*34 00114 RECORDING MODE IS F DTSBX521 00115 LABEL RECORDS ARE STANDARD DTSBX521 00116 BLOCK CONTAINS 0 CHARACTERS. DTSBX521 00117 DTSBX521 00118 01 ACCT-IN-REC PIC X(081). CL*41 00119 DTSBX521 00120 FD PAYD-FILE CL*65 00121 RECORDING MODE IS F CL*65 00122 LABEL RECORDS ARE STANDARD CL*65 00123 BLOCK CONTAINS 0 CHARACTERS. CL*65 00124 CL*65 00125 01 PAYD-REC PIC X(63). CL*65 00126 CL*65 00127 *FD SUMMARY-FILE CL**6 00128 * RECORDING MODE IS F. CL**6 00129 *01 SUMMARY-REC PIC X(73). CL**6 00130 * CL**6 00131 FD PAYMT-FILE-OUT CL*40 00132 RECORDING MODE IS F. CL*29 00133 01 PAYMT-REC PIC X(120). CL*46 00134 DTSBX521 00135 WORKING-STORAGE SECTION. DTSBX521 001355 77 PAN-VALET PICTURE X(24) VALUE '111DTSBX521 01/26/16'. DTSBX521 00136 77 PAN-VALET PICTURE X(24) VALUE '019DTSBX343 05/14/10'. DTSBX521 00137 SKIP3 DTSBX521 00138 01 W-AREA. DTSBX521 00139 05 W-ABEND-CD PIC S9(04) COMP VALUE +478. CL**4 00140 DTSBX521 00141 DTSBX521 00142 05 ABEND-MSG PIC X(60). DTSBX521 00143 DTSBX521 00144 05 PARM-STATUS PIC X(02). DTSBX521 00145 88 PARM-STATUS-OK-88 VALUE '00'. DTSBX521 00146 05 ACCT-I-STATUS PIC X(02). DTSBX521 00147 88 ACCT-I-STATUS-OK-88 VALUE '00'. DTSBX521 00148 88 ACCT-I-STATUS-EOF-88 VALUE '10'. DTSBX521 00149 05 TRAN-I-STATUS PIC X(02). CL**4 00150 88 TRAN-I-STATUS-OK-88 VALUE '00'. DTSBX521 00151 88 TRAN-I-STATUS-EOF-88 VALUE '10'. CL**4 00152 05 QTR-STATUS PIC X(02). DTSBX521 00153 88 QTR-STATUS-OK-88 VALUE '00'. DTSBX521 00154 05 QCOLL-STATUS PIC X(02). DTSBX521 00155 88 QCOLL-STATUS-OK-88 VALUE '00'. DTSBX521 00156 05 SUMMARY-STATUS PIC X(02). DTSBX521 00157 88 SUMMARY-STATUS-OK-88 VALUE '00'. DTSBX521 00158 05 PAYDIST-STATUS PIC X(02). DTSBX521 00159 88 PAYDIST-STATUS-OK-88 VALUE '00'. DTSBX521 00160 DTSBX521 00161 05 EMP-STATUS PIC X(02). DTSBX521 00162 88 EMP-STATUS-OK-88 VALUE '00'. DTSBX521 00163 DTSBX521 00164 05 W-ERROR-IND PIC X(01) VALUE 'N'. DTSBX521 00165 88 W-ERROR-YES-88 VALUE 'Y'. DTSBX521 00166 88 W-ERROR-NO-88 VALUE 'N'. DTSBX521 00167 DTSBX521 00168 05 W-RPT-COMPLETE-IND PIC X(01). DTSBX521 00169 88 W-RPT-COMPLETE-YES-88 VALUE 'Y'. DTSBX521 00170 88 W-RPT-COMPLETE-NO-88 VALUE 'N'. DTSBX521 00171 88 W-RPT-COMPLETE-NULL-88 VALUE ' '. DTSBX521 00172 DTSBX521 00173 05 W-UI-CHARGE-IND PIC X(01). DTSBX521 00174 88 W-UI-CHARGE-YES-88 VALUE 'Y'. DTSBX521 00175 88 W-UI-CHARGE-NO-88 VALUE 'N'. DTSBX521 00176 05 W-LP-CHARGE-IND PIC X(01). DTSBX521 00177 88 W-LP-CHARGE-YES-88 VALUE 'Y'. DTSBX521 00178 88 W-LP-CHARGE-NO-88 VALUE 'N'. DTSBX521 00179 DTSBX521 00180 05 W-STATUS-CD PIC X(02). DTSBX521 00181 88 W-STATUS-WITHDRAWN-88 VALUE '04', '05'. DTSBX521 00182 DTSBX521 00183 05 WS-ACIN-EMP-NO PIC 9(06) VALUE ZEROS. CL*88 00184 05 ACCT-EOF PIC 9(01) VALUE 0. CL*39 00185 05 WRK-CREDIT-CNTR PIC 9(02) VALUE 0. CL*55 00186 05 CONV-QTR-SUB PIC S9(04) COMP. CL*39 00187 05 AMT-DISP PIC ---,---,---,--9.99. CL*63 00188 05 AMT-DISP1 PIC ---,---,---,--9.99. CL*63 00189 05 AMT-DISP2 PIC ---,---,---,--9.99. CL*63 00190 05 QSUB PIC S9(04) COMP. DTSBX521 00191 05 QMAX PIC S9(04) COMP VALUE +400. DTSBX521 00192 05 ACCT-TABLE OCCURS 400 TIMES. DTSBX521 00193 10 TBL-YRQ PIC S9(05) COMP-3. DTSBX521 00194 10 TBL-JRN-IND PIC X(01). DTSBX521 00195 88 TBL-JRN-GOOD-88 VALUE '0'. DTSBX521 00196 88 TBL-JRN-BAD-88 VALUE '1'. DTSBX521 00197 10 Q-UI-CHG PIC S9(11)V99 COMP-3. DTSBX521 00198 10 Q-UI-PD PIC S9(11)V99 COMP-3. DTSBX521 00199 10 Q-UI-WV PIC S9(11)V99 COMP-3. DTSBX521 00200 10 Q-UI-WO PIC S9(11)V99 COMP-3. DTSBX521 00201 10 Q-UI-TL PIC S9(11)V99 COMP-3. DTSBX521 00202 10 Q-UI-BAL PIC S9(11)V99 COMP-3. DTSBX521 00203 10 J-UI-CHG PIC S9(11)V99 COMP-3. DTSBX521 00204 10 J-UI-PD PIC S9(11)V99 COMP-3. DTSBX521 00205 10 J-UI-WV PIC S9(11)V99 COMP-3. DTSBX521 00206 10 J-UI-WO PIC S9(11)V99 COMP-3. DTSBX521 00207 10 J-UI-TL PIC S9(11)V99 COMP-3. DTSBX521 00208 10 J-UI-BAL PIC S9(11)V99 COMP-3. DTSBX521 00209 10 Q-INT-CHG PIC S9(11)V99 COMP-3. DTSBX521 00210 10 Q-INT-PD PIC S9(11)V99 COMP-3. DTSBX521 00211 10 Q-INT-WV PIC S9(11)V99 COMP-3. DTSBX521 00212 10 Q-INT-WO PIC S9(11)V99 COMP-3. DTSBX521 00213 10 Q-INT-TL PIC S9(11)V99 COMP-3. DTSBX521 00214 10 Q-INT-BAL PIC S9(11)V99 COMP-3. DTSBX521 00215 10 J-INT-CHG PIC S9(11)V99 COMP-3. DTSBX521 00216 10 J-INT-PD PIC S9(11)V99 COMP-3. DTSBX521 00217 10 J-INT-WV PIC S9(11)V99 COMP-3. DTSBX521 00218 10 J-INT-WO PIC S9(11)V99 COMP-3. DTSBX521 00219 10 J-INT-TL PIC S9(11)V99 COMP-3. DTSBX521 00220 10 J-INT-BAL PIC S9(11)V99 COMP-3. DTSBX521 00221 10 Q-LP-CHG PIC S9(11)V99 COMP-3. DTSBX521 00222 10 Q-LP-PD PIC S9(11)V99 COMP-3. DTSBX521 00223 10 Q-LP-WV PIC S9(11)V99 COMP-3. DTSBX521 00224 10 Q-LP-WO PIC S9(11)V99 COMP-3. DTSBX521 00225 10 Q-LP-TL PIC S9(11)V99 COMP-3. DTSBX521 00226 10 Q-LP-BAL PIC S9(11)V99 COMP-3. DTSBX521 00227 10 J-LP-CHG PIC S9(11)V99 COMP-3. DTSBX521 00228 10 J-LP-PD PIC S9(11)V99 COMP-3. DTSBX521 00229 10 J-LP-WV PIC S9(11)V99 COMP-3. DTSBX521 00230 10 J-LP-WO PIC S9(11)V99 COMP-3. DTSBX521 00231 10 J-LP-TL PIC S9(11)V99 COMP-3. DTSBX521 00232 10 J-LP-BAL PIC S9(11)V99 COMP-3. DTSBX521 00233 10 Q-NP-CHG PIC S9(11)V99 COMP-3. DTSBX521 00234 10 Q-NP-PD PIC S9(11)V99 COMP-3. DTSBX521 00235 10 Q-NP-WV PIC S9(11)V99 COMP-3. DTSBX521 00236 10 Q-NP-WO PIC S9(11)V99 COMP-3. DTSBX521 00237 10 Q-NP-TL PIC S9(11)V99 COMP-3. DTSBX521 00238 10 Q-NP-BAL PIC S9(11)V99 COMP-3. DTSBX521 00239 10 J-NP-CHG PIC S9(11)V99 COMP-3. DTSBX521 00240 10 J-NP-PD PIC S9(11)V99 COMP-3. DTSBX521 00241 10 J-NP-WV PIC S9(11)V99 COMP-3. DTSBX521 00242 10 J-NP-WO PIC S9(11)V99 COMP-3. DTSBX521 00243 10 J-NP-TL PIC S9(11)V99 COMP-3. DTSBX521 00244 10 J-NP-BAL PIC S9(11)V99 COMP-3. DTSBX521 00245 10 Q-MP-CHG PIC S9(11)V99 COMP-3. DTSBX521 00246 10 Q-MP-PD PIC S9(11)V99 COMP-3. DTSBX521 00247 10 Q-MP-WV PIC S9(11)V99 COMP-3. DTSBX521 00248 10 Q-MP-WO PIC S9(11)V99 COMP-3. DTSBX521 00249 10 Q-MP-TL PIC S9(11)V99 COMP-3. DTSBX521 00250 10 Q-MP-BAL PIC S9(11)V99 COMP-3. DTSBX521 00251 10 J-MP-CHG PIC S9(11)V99 COMP-3. DTSBX521 00252 10 J-MP-PD PIC S9(11)V99 COMP-3. DTSBX521 00253 10 J-MP-WV PIC S9(11)V99 COMP-3. DTSBX521 00254 10 J-MP-WO PIC S9(11)V99 COMP-3. DTSBX521 00255 10 J-MP-TL PIC S9(11)V99 COMP-3. DTSBX521 00256 10 J-MP-BAL PIC S9(11)V99 COMP-3. DTSBX521 00257 10 Q-SU-CHG PIC S9(11)V99 COMP-3. DTSBX521 00258 10 Q-SU-PD PIC S9(11)V99 COMP-3. DTSBX521 00259 10 Q-SU-WV PIC S9(11)V99 COMP-3. DTSBX521 00260 10 Q-SU-WO PIC S9(11)V99 COMP-3. DTSBX521 00261 10 Q-SU-TL PIC S9(11)V99 COMP-3. DTSBX521 00262 10 Q-SU-BAL PIC S9(11)V99 COMP-3. DTSBX521 00263 10 J-SU-CHG PIC S9(11)V99 COMP-3. DTSBX521 00264 10 J-SU-PD PIC S9(11)V99 COMP-3. DTSBX521 00265 10 J-SU-WV PIC S9(11)V99 COMP-3. DTSBX521 00266 10 J-SU-WO PIC S9(11)V99 COMP-3. DTSBX521 00267 10 J-SU-TL PIC S9(11)V99 COMP-3. DTSBX521 00268 10 J-SU-BAL PIC S9(11)V99 COMP-3. DTSBX521 00269 DTSBX521 00270 05 W-AMT PIC S9(11)V99 COMP-3. DTSBX521 00271 05 W-TOT-CHG PIC S9(11)V99 COMP-3 DTSBX521 00272 VALUE +0. DTSBX521 00273 05 W-TOT-PD PIC S9(11)V99 COMP-3 DTSBX521 00274 VALUE +0. DTSBX521 00275 05 W-TOT-CREDIT PIC S9(11)V99 COMP-3 DTSBX521 00276 VALUE +0. DTSBX521 00277 05 W-CREDIT-CORRECT PIC S9(11)V99 COMP-3 DTSBX521 00278 VALUE +0. DTSBX521 00279 DTSBX521 00280 05 W-TOT-MPRF-CREDIT PIC S9(11)V99 COMP-3 CL*15 00281 VALUE +0. CL*15 00282 05 W-TOT-MJRN-CREDIT PIC S9(11)V99 COMP-3 CL*15 00283 VALUE +0. CL*15 00284 CL*15 00285 05 W-DIF-MPRF-CREDIT PIC S9(11)V99 COMP-3 CL*15 00286 VALUE +0. CL*15 00287 05 W-DIF-MJRN-CREDIT PIC S9(11)V99 COMP-3 CL*15 00288 VALUE +0. CL*15 00289 CL*15 00290 05 W-DEFAULT-DATE PIC X(10) DTSBX521 00291 VALUE '12/31/1994'. DTSBX521 00292 DTSBX521 00293 05 WRK-EMP-NO PIC S9(07) COMP-3 VALUE +0. CL*65 00294 05 W-MPRF-CNT PIC S9(07) COMP-3 VALUE +0. CL*65 00295 05 W-MJRN-READ-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX521 00296 05 W-ERROR-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX521 00297 05 W-ACCT-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX521 00298 05 W-ACCT-CNT-INCR PIC S9(07) COMP-3 VALUE +0. DTSBX521 00299 05 W-PAYT-CNT PIC S9(07) COMP-3 VALUE +0. CL*42 00300 05 W-TRAN-CNT PIC S9(07) COMP-3 VALUE +0. CL*42 00301 05 W-TRAN-CNT-INCR PIC S9(07) COMP-3 VALUE +0. DTSBX521 00302 05 W-SUMMARY-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX521 00303 05 W-RPT-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX521 00304 05 W-ANN-RPT-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX521 00305 05 W-PAY-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX521 00306 05 W-PAY-DIST-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX521 00307 05 W-ADJ-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX521 00308 05 W-QTR-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX521 00309 05 W-CR-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX521 00310 05 W-BATCH PIC S9(05) COMP-3 VALUE +0. DTSBX521 00311 05 W-ITEM PIC S9(03) COMP-3 VALUE +0. DTSBX521 00312 05 ADJ-CHG PIC S9(09)V99 COMP-3. DTSBX521 00313 05 ADJ-PD PIC S9(09)V99 COMP-3. DTSBX521 00314 05 ADJ-WV PIC S9(09)V99 COMP-3. DTSBX521 00315 05 ADJ-WO PIC S9(09)V99 COMP-3. DTSBX521 00316 05 ADJ-TL PIC S9(09)V99 COMP-3. DTSBX521 00317 05 W-CHG PIC S9(09)V99 COMP-3. DTSBX521 00318 05 W-PD PIC S9(09)V99 COMP-3. DTSBX521 00319 05 W-WV PIC S9(09)V99 COMP-3. DTSBX521 00320 05 W-WO PIC S9(09)V99 COMP-3. DTSBX521 00321 05 W-TL PIC S9(09)V99 COMP-3. DTSBX521 00322 05 W-BAL PIC S9(09)V99 COMP-3. DTSBX521 00323 05 W-QTR-BAL PIC S9(11)V99 COMP-3. DTSBX521 00324 05 W-RATE PIC S9(03)V9(04) COMP-3. DTSBX521 00325 05 W-JC-BATCH PIC S9(05) COMP-3 DTSBX521 00326 VALUE +00010. DTSBX521 00327 05 W-JC-ITEM PIC S9(03) COMP-3 DTSBX521 00328 VALUE +0. DTSBX521 00329 DTSBX521 00330 05 ASUB PIC S9(04) COMP. DTSBX521 00331 05 ASUB1 PIC S9(04) COMP. DTSBX521 00332 05 ASUB-MAX PIC S9(04) COMP VALUE +50. DTSBX521 00333 05 ASUB-LAST PIC S9(04) COMP VALUE +0. DTSBX521 00334 05 ANN-RPT-TABLE OCCURS 50 TIMES. DTSBX521 00335 10 W-ANN-RPT-TYPE PIC X(02). DTSBX521 00336 10 W-ANN-YRQ PIC 9(05). DTSBX521 00337 10 FILLER REDEFINES W-ANN-YRQ. DTSBX521 00338 15 W-ANN-YRQ-CCYY PIC 9(04). DTSBX521 00339 15 W-ANN-YRQ-Q PIC 9(01). DTSBX521 00340 DTSBX521 00341 10 W-ANN-BATCH PIC S9(05) COMP-3. DTSBX521 00342 10 W-ANN-ITEM PIC S9(03) COMP-3. DTSBX521 00343 10 W-ANN-RATE PIC S9(03)V9(04) COMP-3. DTSBX521 00344 10 W-ANN-REMIT PIC S9(09)V99 COMP-3. DTSBX521 00345 10 W-ANN-TOT-WAGE PIC S9(09)V99 COMP-3. DTSBX521 00346 10 W-ANN-TAX-WAGE PIC S9(09)V99 COMP-3. DTSBX521 00347 10 W-ANN-EXCESS-WAGE PIC S9(09)V99 COMP-3. DTSBX521 00348 10 W-ANN-RCVD-DT PIC S9(09) COMP-3. DTSBX521 00349 10 W-ANN-PROCESS-DT PIC S9(09) COMP-3. DTSBX521 00350 DTSBX521 00351 05 W-LAST-ANN-YRQ PIC S9(05) COMP-3. DTSBX521 00352 DTSBX521 00353 05 W-ACCT-IN. CL*34 00354 10 W-ACCT-IN-DATA. CL*39 00355 15 ACIN-EMP-NO PIC 9(06). CL*39 00356 15 FILLER PIC X(01) VALUE ','. CL*39 00357 15 ACIN-YRQ PIC X(06). CL*39 00358 15 FILLER PIC X(01) VALUE ','. CL*39 00359 15 ACIN-BATCH-NO PIC 9(05). CL*40 00360 15 FILLER PIC X(01) VALUE ','. CL*39 00361 15 ACIN-ITEM-NO PIC 9(03). CL*40 00362 15 FILLER PIC X(01) VALUE ','. CL*39 00363 15 ACIN-TRAN PIC X(02). CL*39 00364 15 FILLER PIC X(01) VALUE ','. CL*39 00365 15 ACIN-ROW PIC X(02). CL*39 00366 15 FILLER PIC X(01) VALUE ','. CL*39 00367 15 ACIN-COL PIC X(02). CL*39 00368 15 FILLER PIC X(01) VALUE ','. CL*39 00369 15 ACIN-AMT PIC ---------9.99. CL*39 00370 15 ACIN-AMT-9 REDEFINES ACIN-AMT PIC 9(10).99. CL*39 00371 15 FILLER PIC X(01) VALUE ','. CL*39 00372 15 ACIN-CAT PIC X(01). CL*39 00373 15 FILLER PIC X(01) VALUE ','. CL*39 00374 15 ACIN-PROCESS-DT PIC X(10). CL*39 00375 15 FILLER PIC X(01) VALUE ','. CL*39 00376 15 ACIN-SOURCE PIC X(01). CL*39 00377 88 ACIN-SOURCE-CR-DB-88 VALUE '1'. CL*39 00378 88 ACIN-SOURCE-STATUS-88 VALUE '2'. CL*39 00379 88 ACIN-SOURCE-ERROR-88 VALUE '3'. CL*39 00380 15 FILLER PIC X(01) VALUE ','. CL*39 00381 15 ACIN-RCVD-DT PIC X(10). CL*39 00382 15 FILLER PIC X(01) VALUE ','. CL*39 00383 10 FILLER PIC X(10). CL*39 00384 DTSBX521 00385 CL*34 00386 05 W-ACCT-OUT. CL*34 00387 10 ACCT-OUT-DATA PIC X(73). CL*39 00388 10 ACCT-NEW-DATA. CL*39 00389 15 ACCT-PAYMT-ID PIC 9(10). CL*39 00390 15 FILLER PIC X(01) VALUE ' '. CL*82 00391 15 ACCT-ORIG-BATCH-NO1 PIC X(05). CL*82 00392 15 FILLER PIC X(01) VALUE ' '. CL*82 00393 15 ACCT-ORIG-ITEM-NO1 PIC X(03). CL*82 00394 15 FILLER PIC X(01) VALUE ' '. CL*82 00395 15 ACCT-OPID PIC X(10). CL*52 00396 15 FILLER PIC X(01) VALUE ' '. CL*82 00397 15 FILLER PIC X(05) VALUE SPACES. CL*52 00398 15 FILLER PIC X(01) VALUE ' '. CL*75 00399 CL*34 00400 CL*29 00401 05 W-PAYMT-REC. CL*29 00402 10 PAYT-EMP-NO PIC 9(06). CL*29 00403 10 FILLER PIC X(01) VALUE ','. CL*29 00404 10 PAYT-YRQ PIC X(06). CL*29 00405 10 FILLER PIC X(01) VALUE ','. CL*29 00406 10 PAYT-BATCH PIC 9(05). CL*29 00407 10 FILLER PIC X(01) VALUE ','. CL*29 00408 10 PAYT-ITEM PIC 9(03). CL*29 00409 10 FILLER PIC X(01) VALUE ','. CL*29 00410 10 PAYT-PAY-TYPE PIC X(02). CL*30 00411 10 FILLER PIC X(01) VALUE ','. CL*29 00412 10 PAYT-WI-IND PIC X(01). CL*29 00413 10 FILLER PIC X(01) VALUE ','. CL*29 00414 10 PAYT-WLP-IND PIC X(01). CL*29 00415 10 FILLER PIC X(01) VALUE ','. CL*29 00416 10 PAYT-WNP-IND PIC X(01). CL*29 00417 10 FILLER PIC X(01) VALUE ','. CL*29 00418 10 PAYT-AMT PIC ---------9.99. CL*29 00419 10 PAYT-AMT-9 REDEFINES PAYT-AMT PIC 9(10).99. CL*29 00420 10 FILLER PIC X(01) VALUE ','. CL*29 00421 10 PAYT-RCVD-DT PIC X(10). CL*29 00422 10 FILLER PIC X(01) VALUE ','. CL*29 00423 10 PAYT-DEPOSIT-DT PIC X(10). CL*29 00424 10 FILLER PIC X(01) VALUE ','. CL*29 00425 10 PAYT-IND PIC X(02). CL*29 00426 10 FILLER PIC X(01) VALUE ','. CL*29 00427 10 PAYT-ORIG-BATCH-NO PIC X(05). CL*29 00428 10 FILLER PIC X(01) VALUE ','. CL*29 00429 10 PAYT-ORIG-ITEM-NO PIC X(03). CL*29 00430 10 FILLER PIC X(01) VALUE ','. CL*29 00431 10 PAYT-PAYMT-ID PIC 9(10). CL*46 00432 10 FILLER PIC X(01) VALUE ','. CL*29 00433 10 PAYT-OPID PIC X(10). CL*29 00434 10 FILLER PIC X(16) VALUE SPACES. CL*44 00435 10 FILLER PIC X(01) VALUE ' '. CL*75 00436 CL*29 00437 05 W-TRAN-REC. DTSBX521 00438 10 TRAN-EMP-NO PIC 9(06). DTSBX521 00439 10 FILLER PIC X(01) VALUE ','. DTSBX521 00440 10 TRAN-YRQ PIC X(06). DTSBX521 00441 10 FILLER PIC X(01) VALUE ','. DTSBX521 00442 10 TRAN-BATCH PIC 9(05). DTSBX521 00443 10 FILLER PIC X(01) VALUE ','. DTSBX521 00444 10 TRAN-ITEM PIC 9(03). DTSBX521 00445 10 FILLER PIC X(01) VALUE ','. DTSBX521 00446 10 TRAN-TRANS PIC X(02). DTSBX521 00447 10 FILLER PIC X(01) VALUE ','. DTSBX521 00448 10 TRAN-AMT PIC --------9.99. DTSBX521 00449 10 FILLER PIC X(01) VALUE ','. DTSBX521 00450 10 TRAN-TOT-WAGE PIC ----------9.99. DTSBX521 00451 10 TRAN-TOT-WAGE-X REDEFINES TRAN-TOT-WAGE DTSBX521 00452 PIC X(14). DTSBX521 00453 10 FILLER PIC X(01) VALUE ','. DTSBX521 00454 10 TRAN-TAX-WAGE PIC ----------9.99. DTSBX521 00455 10 TRAN-TAX-WAGE-X REDEFINES TRAN-TAX-WAGE DTSBX521 00456 PIC X(14). DTSBX521 00457 10 FILLER PIC X(01) VALUE ','. DTSBX521 00458 10 TRAN-EXC-WAGE PIC ----------9.99. DTSBX521 00459 10 TRAN-EXC-WAGE-X REDEFINES TRAN-EXC-WAGE DTSBX521 00460 PIC X(14). DTSBX521 00461 10 FILLER PIC X(01) VALUE ','. DTSBX521 00462 10 TRAN-RATE PIC Z9.9. DTSBX521 00463 10 TRAN-RATE-X REDEFINES TRAN-RATE DTSBX521 00464 PIC X(04). DTSBX521 00465 10 FILLER PIC X(01) VALUE ','. DTSBX521 00466 10 TRAN-ACCT PIC X(02). DTSBX521 00467 10 FILLER PIC X(01) VALUE ','. DTSBX521 00468 10 TRAN-CAT PIC X(01). DTSBX521 00469 10 FILLER PIC X(01) VALUE ','. DTSBX521 00470 10 TRAN-SOURCE PIC X(01). DTSBX521 00471 88 TRAN-SOURCE-CR-DB-88 VALUE '1'. DTSBX521 00472 88 TRAN-SOURCE-STATUS-88 VALUE '2'. DTSBX521 00473 88 TRAN-SOURCE-ERROR-88 VALUE '3'. DTSBX521 00474 10 FILLER PIC X(01) VALUE ','. DTSBX521 00475 10 TRAN-RCVD-DT PIC X(10). DTSBX521 00476 10 FILLER PIC X(01) VALUE ','. DTSBX521 00477 10 TRAN-PROCESS-DT PIC X(10). DTSBX521 00478 10 FILLER PIC X(01) VALUE ','. DTSBX521 00479 10 TRAN-APPLIC-BATCH PIC 9(05). DTSBX521 00480 10 FILLER PIC X(01) VALUE ','. DTSBX521 00481 10 TRAN-APPLIC-ITEM PIC 9(03). DTSBX521 00482 10 FILLER PIC X(01) VALUE ','. DTSBX521 00483 10 TRAN-RESP-ACTIVITY PIC X(03). DTSBX521 00484 10 FILLER PIC X(01) VALUE ','. DTSBX521 00485 10 TRAN-RESP-OPID PIC X(08). DTSBX521 00486 DTSBX521 00487 05 W-QTR-REC. DTSBX521 00488 10 QTR-EMP-NO PIC 9(06). DTSBX521 00489 10 FILLER PIC X(01) VALUE ','. DTSBX521 00490 10 QTR-QUARTER PIC X(06). DTSBX521 00491 10 FILLER PIC X(01) VALUE ','. DTSBX521 00492 10 QTR-RPT-STATUS PIC X(01). DTSBX521 00493 10 FILLER PIC X(01) VALUE ','. DTSBX521 00494 10 QTR-RPT-DUE-DT PIC X(10). DTSBX521 00495 10 FILLER PIC X(01) VALUE ','. DTSBX521 00496 10 QTR-PROCESS-DT PIC X(10). DTSBX521 00497 10 FILLER PIC X(01) VALUE ','. DTSBX521 00498 10 QTR-BAL-DUE PIC ----------9.99. DTSBX521 00499 10 FILLER PIC X(01) VALUE ','. DTSBX521 00500 10 QTR-TAX-DUE-DT PIC X(10). DTSBX521 00501 DTSBX521 00502 05 W-SUMMARY-REC. DTSBX521 00503 10 SUMMARY-PROCESS-DT PIC X(10). DTSBX521 00504 10 FILLER PIC X(01) VALUE ','. DTSBX521 00505 10 SUMMARY-MESSAGE PIC X(40). DTSBX521 00506 10 FILLER PIC X(01) VALUE ','. DTSBX521 00507 10 SUMMARY-EMP-NO PIC 9(06). DTSBX521 00508 10 FILLER PIC X(01) VALUE ','. DTSBX521 00509 10 SUMMARY-BATCH PIC 9(05). DTSBX521 00510 10 FILLER PIC X(01) VALUE ','. DTSBX521 00511 10 SUMMARY-ITEM PIC 9(03). DTSBX521 00512 10 FILLER PIC X(01) VALUE ','. DTSBX521 00513 10 SUMMARY-TRAN PIC X(02). DTSBX521 00514 10 FILLER PIC X(01) VALUE ','. DTSBX521 00515 10 SUMMARY-SOURCE PIC X(01). DTSBX521 00516 88 SUMMARY-SOURCE-CR-DB-88 VALUE '1'. DTSBX521 00517 88 SUMMARY-SOURCE-STATUS-88 VALUE '2'. DTSBX521 00518 88 SUMMARY-SOURCE-ERROR-88 VALUE '3'. DTSBX521 00519 DTSBX521 00520 05 W-PAY-DIST-REC. DTSBX521 00521 10 DST-EMP-NO PIC 9(06). DTSBX521 00522 10 FILLER PIC X(01) VALUE ','. DTSBX521 00523 10 DST-BATCH PIC 9(05). DTSBX521 00524 10 FILLER PIC X(01) VALUE ','. DTSBX521 00525 10 DST-ITEM PIC 9(03). DTSBX521 00526 10 FILLER PIC X(01) VALUE ','. DTSBX521 00527 10 DST-YRQ PIC X(06). CL*66 00528 10 FILLER PIC X(01) VALUE ','. DTSBX521 00529 10 DST-ACCT PIC X(02). DTSBX521 00530 10 FILLER PIC X(01) VALUE ','. DTSBX521 00531 10 DST-AMT PIC --------9.99. DTSBX521 00532 10 FILLER PIC X(01) VALUE ','. DTSBX521 00533 10 DST-CHNG-DT PIC X(10). DTSBX521 00534 DTSBX521 00535 05 W-CURR-UI-TOT PIC S9(11)V99 COMP-3 DTSBX521 00536 VALUE +0. DTSBX521 00537 DTSBX521 00538 05 DISPLAY-CNT PIC Z(06)9. DTSBX521 00539 DTSBX521 00540 05 DISPLAY-AMT1-X PIC X(14). DTSBX521 00541 05 DISPLAY-AMT1 REDEFINES DISPLAY-AMT1-X DTSBX521 00542 PIC ---,---,--9.99. DTSBX521 00543 05 DISPLAY-AMT2-X PIC X(14). DTSBX521 00544 05 DISPLAY-AMT2 REDEFINES DISPLAY-AMT2-X DTSBX521 00545 PIC ---,---,--9.99. DTSBX521 00546 05 DISPLAY-AMT3-X PIC X(14). DTSBX521 00547 05 DISPLAY-AMT3 REDEFINES DISPLAY-AMT3-X DTSBX521 00548 PIC ---,---,--9.99. DTSBX521 00549 05 DISPLAY-AMT4-X PIC X(14). DTSBX521 00550 05 DISPLAY-AMT4 REDEFINES DISPLAY-AMT4-X DTSBX521 00551 PIC ---,---,--9.99. DTSBX521 00552 EJECT DTSBX521 00553 01 L001-LINK-AREA. DTSBX521 00554 ++INCLUDE DTSIL001 DTSBX521 00555 EJECT DTSBX521 00556 01 L004-LINK-AREA. DTSBX521 00557 ++INCLUDE DTSIL004 DTSBX521 00558 EJECT DTSBX521 00559 01 L005-LINK-AREA. DTSBX521 00560 ++INCLUDE DTSIL005 DTSBX521 00561 DTSBX521 00562 01 L910-LINK-AREA. DTSBX521 00563 ++INCLUDE DTSIL910 DTSBX521 00564 SKIP3 DTSBX521 00565 01 MSKL-REC. DTSBX521 00566 ++INCLUDE DTSIMSKL DTSBX521 00567 SKIP3 DTSBX521 00568 01 MHDR-REC. DTSBX521 00569 ++INCLUDE DTSIMHDR DTSBX521 00570 SKIP3 DTSBX521 00571 01 MPRF-REC. CL**4 00572 ++INCLUDE DTSIMPRF CL**4 00573 CL**4 00574 01 MQTR-REC. DTSBX521 00575 ++INCLUDE DTSIMQTR DTSBX521 00576 SKIP3 DTSBX521 00577 01 MJRN-REC. DTSBX521 00578 ++INCLUDE DTSIMJRN DTSBX521 00579 SKIP3 DTSBX521 00580 01 MRPT-REC. DTSBX521 00581 ++INCLUDE DTSIMRPT DTSBX521 00582 SKIP3 DTSBX521 00583 01 MADJ-REC. DTSBX521 00584 ++INCLUDE DTSIMADJ DTSBX521 00585 SKIP3 DTSBX521 00586 01 MPAY-REC. DTSBX521 00587 ++INCLUDE DTSIMPAY DTSBX521 00588 SKIP3 DTSBX521 00589 01 MDST-REC. DTSBX521 00590 ++INCLUDE DTSIMDST DTSBX521 00591 SKIP3 DTSBX521 00592 01 MRTE-REC. DTSBX521 00593 ++INCLUDE DTSIMRTE DTSBX521 00594 SKIP3 DTSBX521 00595 01 MEVL-REC. DTSBX521 00596 ++INCLUDE DTSIMEVL DTSBX521 00597 SKIP3 DTSBX521 00598 01 MSOL-REC. DTSBX521 00599 ++INCLUDE DTSIMSOL DTSBX521 00600 SKIP3 DTSBX521 00601 01 MFSC-REC. DTSBX521 00602 ++INCLUDE DTSIMFSC DTSBX521 00603 SKIP3 DTSBX521 00604 01 MTAD-REC. DTSBX521 00605 ++INCLUDE DTSIMTAD DTSBX521 00606 SKIP3 DTSBX521 00607 01 MTAA-REC. DTSBX521 00608 ++INCLUDE DTSIMTAA DTSBX521 00609 SKIP3 DTSBX521 00610 01 MLOG-REC. DTSBX521 00611 ++INCLUDE DTSIMLOG DTSBX521 00612 CL**5 00613 01 L921-LINK-AREA. CL**5 00614 ++INCLUDE DTSIL921 CL**5 00615 SKIP3 CL**5 00616 01 ISKL-REC. CL**5 00617 ++INCLUDE DTSIISKL CL**5 00618 CL**5 00619 01 L931-LINK-AREA. DTSBX521 00620 ++INCLUDE DTSIL931 DTSBX521 00621 SKIP3 DTSBX521 00622 01 FSKL-REC. DTSBX521 00623 ++INCLUDE DTSIFSKL DTSBX521 00624 SKIP3 DTSBX521 00625 01 FQTR-REC. DTSBX521 00626 ++INCLUDE DTSIFQTR DTSBX521 00627 DTSBX521 00628 EJECT DTSBX521 00629 PROCEDURE DIVISION. CL**4 00630 DTSBX521 00631 PERFORM I0000-INITIALIZE THRU I0000-EXIT. CL**4 00632 CL**4 00633 PERFORM P0000-PROCESS THRU P0000-EXIT. CL**4 00634 CL**4 00635 PERFORM T0000-TERMINATE THRU T0000-EXIT. CL**4 00636 DTSBX521 00637 GOBACK. DTSBX521 00638 DTSBX521 00639 I0000-INITIALIZE. DTSBX521 00640 SET L005-FROM-SYS TO TRUE. CL**4 00641 PERFORM S005-SYS-DATE THRU S005-EXIT. CL**4 00642 CL**4 00643 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBX521 00644 DTSBX521 00645 PERFORM I3000-GET-MHDR THRU I3000-EXIT. CL**5 00646 CL**4 00647 I0000-EXIT. DTSBX521 00648 EXIT. DTSBX521 00649 DTSBX521 00650 I2000-OPEN-FILES. DTSBX521 00651 PERFORM S910-OPEN-READ THRU S910-EXIT. CL**4 00652 CL**4 00653 PERFORM S921-OPEN-READ THRU S921-EXIT. CL**4 00654 CL**4 00655 PERFORM S931-OPEN-READ THRU S931-EXIT. CL**4 00656 DTSBX521 00657 OPEN OUTPUT ACCT-FILE-OUT. CL*35 00658 IF NOT ACCT-I-STATUS-OK-88 DTSBX521 00659 DISPLAY 'BZ478 ACCT INCR OPEN ERROR: ' ACCT-I-STATUS CL**7 00660 MOVE 'FILE OPEN ERROR' DTSBX521 00661 TO ABEND-MSG DTSBX521 00662 PERFORM S999-ABEND THRU S999-EXIT DTSBX521 00663 END-IF. DTSBX521 00664 DTSBX521 00665 OPEN INPUT ACCT-FILE-IN. CL*35 00666 IF NOT TRAN-I-STATUS-OK-88 DTSBX521 00667 DISPLAY 'BZ478 TRAN FILE INPUT ERROR: ' TRAN-I-STATUS CL*35 00668 MOVE 'FILE OPEN ERROR' DTSBX521 00669 TO ABEND-MSG DTSBX521 00670 PERFORM S999-ABEND THRU S999-EXIT DTSBX521 00671 END-IF. DTSBX521 00672 DTSBX521 00673 OPEN OUTPUT PAYD-FILE. CL*65 00674 IF NOT QTR-STATUS-OK-88 CL*65 00675 DISPLAY 'PAYMENT DISTRIBUTION FILE PROBLEM: ' QTR-STATUS CL*65 00676 MOVE 'FILE OPEN ERROR' CL*65 00677 TO ABEND-MSG CL*65 00678 PERFORM S999-ABEND THRU S999-EXIT CL*65 00679 END-IF. CL*65 00680 DTSBX521 00681 ** OPEN OUTPUT SUMMARY-FILE. CL**6 00682 * IF NOT SUMMARY-STATUS-OK-88 CL**6 00683 * DISPLAY 'BX343 SUMMARY FILE OPEN ERROR: ' CL**6 00684 * SUMMARY-STATUS CL**6 00685 * MOVE 'FILE OPEN ERROR' CL**6 00686 * TO ABEND-MSG CL**6 00687 * PERFORM S999-ABEND THRU S999-EXIT CL**6 00688 ** END-IF. CL**6 00689 DTSBX521 00690 OPEN OUTPUT PAYMT-FILE-OUT. CL*35 00691 IF NOT PAYDIST-STATUS-OK-88 CL*29 00692 DISPLAY 'BX343 PAYMT FILE OPEN ERROR: ' CL*35 00693 PAYDIST-STATUS CL*29 00694 MOVE 'FILE OPEN ERROR' CL*29 00695 TO ABEND-MSG CL*29 00696 PERFORM S999-ABEND THRU S999-EXIT CL*29 00697 END-IF. CL*29 00698 DTSBX521 00699 I2000-EXIT. DTSBX521 00700 EXIT. DTSBX521 00701 DTSBX521 00702 I3000-GET-MHDR. CL**4 00703 MOVE LOW-VALUES TO MSKL-REC. CL**4 00704 MOVE +0 TO MSKL-EMP-NO. CL**4 00705 SET MSKL-HDR-88 TO TRUE. CL**4 00706 CL**4 00707 PERFORM S910-READ THRU S910-EXIT. CL**4 00708 IF L910-NO-REC-88 CL**4 00709 DISPLAY 'DTSBZ478: MHDR RECORD IS MISSING' CL**4 00710 SET W-ERROR-YES-88 TO TRUE CL**4 00711 GO TO I3000-EXIT CL**4 00712 ELSE CL**4 00713 MOVE MSKL-REC TO MHDR-REC CL**4 00714 END-IF. CL**4 00715 CL**4 00716 I3000-EXIT. CL**4 00717 EXIT. CL**4 00718 CL**4 00719 P0000-PROCESS. CL*11 00720 PERFORM P1000-READ-ACCTS-IN THRU P1000-EXIT CL*37 00721 UNTIL ACCT-EOF = 1. CL*40 00722 CL**4 00723 CL**4 00724 MOVE LOW-VALUES TO MSKL-KEY-AREA. CL*32 00725 MOVE +0 TO MSKL-EMP-NO. CL*32 00726 SET MSKL-PRF-88 TO TRUE. CL*32 00727 CL*32 00728 PERFORM S910-START-BROWSE THRU S910-EXIT. CL*32 00729 CL*32 00730 PERFORM UNTIL L910-NO-REC-88 CL*32 00731 MOVE MSKL-REC TO MPRF-REC CL*32 00732 * IF MPRF-STATUS-SUB-88 CL*39 00733 PERFORM P3200-PAYMENT THRU P3200-EXIT CL*32 00734 * END-IF CL*39 00735 MOVE MPRF-REC TO MSKL-REC CL*32 00736 PERFORM S910-READ-NEXT THRU S910-EXIT CL*32 00737 END-PERFORM. CL*32 00738 CL*32 00739 CL*32 00740 DTSBX521 00741 P0000-EXIT. DTSBX521 00742 EXIT. DTSBX521 00743 DTSBX521 00744 P1000-READ-ACCTS-IN. CL*37 00745 READ ACCT-FILE-IN INTO W-ACCT-IN AT END CL*37 00746 MOVE 1 TO ACCT-EOF CL*37 00747 GO TO P1000-EXIT. CL*37 00748 CL*37 00749 ADD +1 TO W-TRAN-CNT CL*42 00750 MOVE LOW-VALUES TO MSKL-KEY-AREA. CL*37 00751 MOVE LOW-VALUES TO MPRF-KEY-AREA. CL*37 00752 CL*37 00753 MOVE +0 TO MSKL-EMP-NO. CL*37 00754 CL*37 00755 SET MPRF-PRF-88 TO TRUE. CL*37 00756 MOVE ACIN-EMP-NO TO MPRF-EMP-NO CL*39 00757 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. CL*37 00758 PERFORM S910-READ THRU S910-EXIT. CL*37 00759 IF L910-OK-88 CL*37 00760 MOVE MSKL-REC TO MPRF-REC CL*37 00761 ELSE CL*37 00762 DISPLAY 'MPRF NOT FOUND ' L910-RESULT-IND ' ' ACIN-EMP-NO CL*39 00763 SET L910-NO-REC-88 TO TRUE CL*37 00764 GO TO P1000-EXIT. CL*37 00765 CL*37 00766 PERFORM P2000-ACCTS-RECEIVABLE THRU P2000-EXIT. CL*40 00767 CL*37 00768 P1000-EXIT. CL*37 00769 EXIT. CL*37 00770 CL*37 00771 P2000-ACCTS-RECEIVABLE. DTSBX521 00772 MOVE ZEROS TO ACCT-PAYMT-ID CL*37 00773 CL*37 00774 MOVE ZERO TO W-TOT-CREDIT CL*56 00775 WRK-CREDIT-CNTR. CL*82 00776 * ACCT-ORIG-BATCH-NO1 CL*82 00777 * ACCT-ORIG-ITEM-NO1. CL*82 00778 PERFORM P2100-PAYMENT-DATA THRU P2100-EXIT. CL*39 00779 CL*82 00780 IF ACIN-TRAN = 'AC' OR 'FS' OR 'EA' CL*82 00781 GO TO P2000-EXIT. CL*82 00782 CL*82 00783 IF ACIN-YRQ = SPACES AND ACIN-ROW = 'CR' AND ACIN-COL = 'PD' CL*80 00784 IF ACIN-EMP-NO NOT = WS-ACIN-EMP-NO CL*88 00785 MOVE ACIN-EMP-NO TO WS-ACIN-EMP-NO CL*88 00786 PERFORM P2500-FIND-MDST THRU P2500-EXIT. CL*88 00787 * PERFORM P3000-CREDIT-INFO THRU P3000-EXIT. CL*63 00788 CL*37 00789 MOVE W-ACCT-IN-DATA TO ACCT-OUT-DATA. CL*39 00790 CL*39 00791 WRITE ACCT-OUT-REC FROM W-ACCT-OUT. CL*39 00792 IF NOT ACCT-I-STATUS-OK-88 CL*39 00793 DISPLAY 'CANNOT WRITE TO ACCT FILE INCR ' CL*39 00794 ' ' ACCT-I-STATUS ' ' ACIN-EMP-NO CL*39 00795 ELSE CL*39 00796 ADD +1 TO W-ACCT-CNT-INCR CL*39 00797 END-IF. CL*39 00798 CL*38 00799 P2000-EXIT. CL*38 00800 EXIT. CL*38 00801 CL*38 00802 P2100-PAYMENT-DATA. CL*39 00803 MOVE LOW-VALUES TO MSKL-KEY-AREA. CL*39 00804 MOVE LOW-VALUES TO MPAY-KEY-AREA. CL*39 00805 MOVE ACIN-BATCH-NO TO MPAY-BATCH-NO, CL*38 00806 MOVE ACIN-ITEM-NO TO MPAY-ITEM-NO. CL*38 00807 MOVE ACIN-EMP-NO TO MPAY-EMP-NO. CL*38 00808 CL*38 00809 SET MPAY-PAY-88 TO TRUE. CL*38 00810 CL*38 00811 MOVE MPAY-KEY-AREA TO MSKL-KEY-AREA. CL*38 00812 CL*38 00813 PERFORM S910-READ THRU S910-EXIT. CL*38 00814 CL*38 00815 IF L910-OK-88 CL*38 00816 MOVE MSKL-REC TO MPAY-REC CL*38 00817 * DISPLAY 'MPAY ' MPAY-EMP-NO ' ' MPAY-APPLIC-YRQ ' ' CL*65 00818 * MPAY-BATCH-NO ' ' MPAY-ITEM-NO ' ' CL*65 00819 * MPAY-PAY-TYPE ' ' MPAY-REMIT-AMT ' ' CL*65 00820 * MPAY-APPLIC-IND ' ' MPAY-TRACE-NO ' ' CL*65 00821 * MPAY-APPLIC-BATCH-NO ' ' CL*65 00822 * MPAY-APPLIC-ITEM-NO CL*65 00823 MOVE MPAY-TRACE-NO TO ACCT-PAYMT-ID CL*38 00824 MOVE SPACES TO ACCT-ORIG-BATCH-NO1 CL*82 00825 MOVE SPACES TO ACCT-ORIG-ITEM-NO1 CL*82 00826 MOVE SPACES TO ACCT-OPID CL*82 00827 ELSE CL*38 00828 SET L910-OK-88 TO TRUE CL*38 00829 END-IF. CL*38 00830 CL*38 00831 CL*60 00832 P2100-EXIT. CL*39 00833 EXIT. CL*38 00834 CL*38 00835 CL*38 00836 P2500-FIND-MDST. CL*59 00837 * MOVE 20124 TO L004-QTR-5-9. CL*59 00838 * MOVE 1 TO L004-QTR-5-Q. CL*59 00839 * MOVE L004-QTR-5-9 TO WRK-LAST-YRQ. CL*59 00840 * MOVE 4 TO L004-QTR-5-Q. CL*59 00841 * MOVE L004-QTR-5-9 TO WRK-NEXT-YRQ. CL*59 00842 * DISPLAY 'P2831 QTRS ' WRK-LAST-YRQ ' ' WRK-NEXT-YRQ. CL*59 00843 CL*59 00844 MOVE LOW-VALUES TO MDST-KEY-AREA. CL*59 00845 MOVE MPRF-EMP-NO TO MDST-EMP-NO. CL*69 00846 SET MDST-DST-88 TO TRUE. CL*59 00847 * SET MDST-CREDIT-REC-88 TO TRUE CL*59 00848 * MOVE MPAY-BATCH-NO TO MDST-BATCH-NO CL*59 00849 * MOVE MPAY-ITEM-NO TO MDST-ITEM-NO. CL*59 00850 MOVE MDST-REC TO MSKL-REC. CL*59 00851 CL*59 00852 PERFORM S910-START-BROWSE THRU S910-EXIT. CL*59 00853 * PERFORM S910-READ THRU S910-EXIT CL*59 00854 * IF L910-OK-88 CL*59 00855 * MOVE MSKL-REC TO MDST-REC CL*59 00856 * PERFORM CL*59 00857 * VARYING MDST-ACCT-IDX FROM 1 BY 1 CL*59 00858 * UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT CL*59 00859 * IF MDST-ACCT-CR-AVAIL-88 (MDST-ACCT-IDX) CL*59 00860 * ADD +1 TO WRK-TOT-EMPS CL*59 00861 * MOVE MDST-AMT (MDST-ACCT-IDX) TO AMT-DISP CL*59 00862 * DISPLAY ' ' MDST-BATCH-NO ' ' MDST-ITEM-NO CL*59 00863 * ' AMT ' AMT-DISP CL*59 00864 * END-IF CL*59 00865 * END-PERFORM CL*59 00866 ** END-IF. CL*59 00867 PERFORM P2510-SCAN-MDST THRU P2510-EXIT CL*59 00868 UNTIL L910-NO-REC-88. CL*59 00869 P2500-EXIT. CL*59 00870 EXIT. CL*59 00871 CL*59 00872 P2510-SCAN-MDST. CL*59 00873 MOVE MSKL-REC TO MDST-REC. CL*59 00874 CL*59 00875 IF MDST-EMP-NO = 027554 CL*72 00876 DISPLAY MDST-EMP-NO CL*69 00877 ' YRQ ' MDST-YRQ CL*69 00878 ' BATCH ' MDST-BATCH-NO CL*69 00879 ' ITEM ' MDST-ITEM-NO CL*69 00880 ' EDATE ' MDST-ESTB-DATE CL*69 00881 ' CDATE ' MDST-CHNG-DATE. CL*69 00882 CL*65 00883 IF MDST-CHNG-DATE = MHDR-PRIOR-RUN-DATE CL111 00884 * IF MDST-CHNG-DATE = 20160122 CL111 00885 PERFORM CL*59 00886 VARYING MDST-ACCT-IDX FROM 1 BY 1 CL*59 00887 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT CL*59 00888 MOVE MDST-EMP-NO TO DST-EMP-NO CL*71 00889 MOVE MDST-BATCH-NO TO DST-BATCH CL*71 00890 MOVE MDST-ITEM-NO TO DST-ITEM CL*65 00891 MOVE MDST-YRQ TO L004-QTR-5-9 CL*65 00892 PERFORM S004-FROM-5 THRU S004-EXIT CL*65 00893 MOVE L004-SLASH-5-QTR TO DST-YRQ CL*65 00894 MOVE MDST-ACCT-IND(MDST-ACCT-IDX) TO DST-ACCT CL*66 00895 MOVE MDST-AMT(MDST-ACCT-IDX) TO DST-AMT CL*67 00896 MOVE MDST-ESTB-DATE TO L001-FED-8-DATE-9 CL*65 00897 PERFORM S001-FROM-FED-8 THRU S001-EXIT CL*65 00898 IF L001-VALID-DATE CL*65 00899 MOVE L001-SLASH-8-DATE TO DST-CHNG-DT CL*65 00900 ELSE CL*65 00901 MOVE SPACES TO DST-CHNG-DT CL*65 00902 END-IF CL*65 00903 WRITE PAYD-REC FROM W-PAY-DIST-REC CL*70 00904 END-PERFORM CL*81 00905 END-IF. CL*81 00906 CL*59 00907 PERFORM S910-READ-NEXT THRU S910-EXIT. CL*59 00908 CL*59 00909 P2510-EXIT. CL*59 00910 EXIT. CL*59 00911 CL*59 00912 CL*59 00913 P3000-CREDIT-INFO. CL*38 00914 CL*55 00915 MOVE LOW-VALUES TO MJRN-KEY-AREA. DTSBX521 00916 MOVE ACIN-EMP-NO TO MJRN-EMP-NO. CL*39 00917 SET MJRN-JRN-88 TO TRUE. DTSBX521 00918 MOVE MJRN-KEY-AREA TO MSKL-KEY-AREA. DTSBX521 00919 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX521 00920 PERFORM UNTIL L910-NO-REC-88 DTSBX521 00921 MOVE MSKL-REC TO MJRN-REC DTSBX521 00922 ADD +1 TO W-MJRN-READ-CNT DTSBX521 00923 IF NOT MJRN-TRAN-CNVR-88 CL*26 00924 PERFORM P3100-CREDIT-PAYMT THRU P3100-EXIT CL*47 00925 END-IF CL*28 00926 MOVE MJRN-REC TO MSKL-REC CL*33 00927 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX521 00928 END-PERFORM. DTSBX521 00929 DTSBX521 00930 P3000-EXIT. CL*39 00931 EXIT. DTSBX521 00932 DTSBX521 00933 P3100-CREDIT-PAYMT. CL*47 00934 IF MJRN-TRAN-ADJ-88 CL*47 00935 GO TO P3100-EXIT. CL*47 00936 CL*47 00937 IF MJRN-DEPOSIT-DATE > MHDR-PRIOR-RUN-DATE CL111 00938 * IF MJRN-DEPOSIT-DATE > 20160122 CL111 00939 GO TO P3100-EXIT. CL*83 00940 CL*48 00941 IF MJRN-ROW-CREDIT-88 (MJRN-OCC-IDX) AND CL*47 00942 MJRN-COL-PAID-88 (MJRN-OCC-IDX) CL*47 00943 DISPLAY ' MJRN CR PAID ' MJRN-EMP-NO ' ' CL*47 00944 MJRN-BATCH-NO ' ' MJRN-ITEM-NO ' ' CL*47 00945 MJRN-TRAN-CATEGORY ' ' MJRN-TRAN-TYPE ' ' CL*47 00946 MJRN-AMT (MJRN-OCC-IDX) ' ' CL*48 00947 MJRN-RECEIVED-DATE ' ' CL*48 00948 MJRN-DEPOSIT-DATE CL*48 00949 MOVE +1 TO WRK-CREDIT-CNTR CL*63 00950 IF WRK-CREDIT-CNTR < 5 CL*58 00951 PERFORM P3150-MOVE-CREDIT THRU P3150-EXIT CL*55 00952 END-IF. CL*47 00953 CL*47 00954 P3100-EXIT. CL*47 00955 EXIT. CL*47 00956 P3150-MOVE-CREDIT. CL*55 00957 IF WRK-CREDIT-CNTR = 1 CL*55 00958 MOVE MJRN-BATCH-NO TO ACCT-ORIG-BATCH-NO1 CL*55 00959 MOVE MJRN-ITEM-NO TO ACCT-ORIG-ITEM-NO1 CL*55 00960 * MJRN-AMT (MJRN-OCC-IDX) ACCT-AMT1 CL*64 00961 ELSE CL*55 00962 DISPLAY ' ************ FATAL ERROR *****************' CL*55 00963 DISPLAY ' MJRN CR PAID HAS MORE THAN 4 CREDITS AVAIL' CL*55 00964 DISPLAY ' EXTEND CREDIT TABLE !!!!!!!!!!!!!!!!!!! ' CL*55 00965 DISPLAY ' ************ FATAL ERROR *****************' CL*55 00966 PERFORM S999-ABEND THRU S999-EXIT. CL*55 00967 P3150-EXIT. CL*55 00968 EXIT. CL*55 00969 CL*55 00970 P3200-PAYMENT. CL*29 00971 MOVE LOW-VALUES TO MPAY-KEY-AREA. DTSBX521 00972 MOVE MPRF-EMP-NO TO MPAY-EMP-NO. DTSBX521 00973 SET MPAY-PAY-88 TO TRUE. DTSBX521 00974 MOVE MPAY-KEY-AREA TO MSKL-KEY-AREA. DTSBX521 00975 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX521 00976 IF L910-NO-REC-88 DTSBX521 00977 GO TO P3200-EXIT CL*29 00978 ELSE DTSBX521 00979 PERFORM DTSBX521 00980 UNTIL L910-NO-REC-88 DTSBX521 00981 MOVE MSKL-REC TO MPAY-REC DTSBX521 00982 PERFORM P3210-WRITE THRU P3210-EXIT DTSBX521 00983 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX521 00984 END-PERFORM DTSBX521 00985 END-IF. DTSBX521 00986 DTSBX521 00987 P3200-EXIT. DTSBX521 00988 EXIT. DTSBX521 00989 DTSBX521 00990 P3210-WRITE. DTSBX521 00991 MOVE MPAY-PAY-TYPE TO PAYT-PAY-TYPE CL*29 00992 IF MPAY-APPLIC-YRQ > ZERO DTSBX521 00993 MOVE MPAY-APPLIC-YRQ TO L004-QTR-5-9 DTSBX521 00994 PERFORM S004-FROM-5 THRU S004-EXIT DTSBX521 00995 MOVE L004-SLASH-5-QTR TO PAYT-YRQ CL*29 00996 ELSE DTSBX521 00997 MOVE SPACES TO PAYT-YRQ CL*29 00998 END-IF. DTSBX521 00999 MOVE MPRF-EMP-NO TO PAYT-EMP-NO. CL*29 01000 MOVE MPAY-BATCH-NO TO PAYT-BATCH. CL*29 01001 MOVE MPAY-ITEM-NO TO PAYT-ITEM. CL*29 01002 MOVE MPAY-REMIT-AMT TO PAYT-AMT. CL*29 01003 MOVE MPAY-TRACE-NO TO PAYT-PAYMT-ID. CL*44 01004 DTSBX521 01005 MOVE MPAY-WAIVE-INT-IND TO PAYT-WI-IND CL*51 01006 MOVE MPAY-WAIVE-LATE-PEN-IND TO PAYT-WLP-IND CL*51 01007 MOVE MPAY-NSF-PEN-CHARGE-IND TO PAYT-WNP-IND CL*51 01008 CL*51 01009 MOVE MPAY-APPLIC-IND TO PAYT-IND. CL*29 01010 MOVE MPAY-APPLIC-BATCH-NO TO PAYT-ORIG-BATCH-NO. CL*30 01011 MOVE MPAY-APPLIC-ITEM-NO TO PAYT-ORIG-ITEM-NO CL*30 01012 MOVE MPAY-RECEIVED-DATE TO L001-FED-8-DATE-9. DTSBX521 01013 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX521 01014 MOVE L001-SLASH-8-DATE TO PAYT-RCVD-DT. CL*29 01015 MOVE MPAY-DEPOSIT-DATE TO L001-FED-8-DATE-9. CL*29 01016 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX521 01017 IF L001-VALID-DATE DTSBX521 01018 MOVE L001-SLASH-8-DATE TO PAYT-DEPOSIT-DT CL*29 01019 ELSE DTSBX521 01020 MOVE ZEROS TO PAYT-DEPOSIT-DT CL*31 01021 END-IF. DTSBX521 01022 DTSBX521 01023 MOVE MPAY-RESPONSIBLE-OP-ID TO PAYT-OPID. CL*29 01024 DTSBX521 01025 DTSBX521 01026 *** SELECT ONLY TRANSACTIONS FROM MOST RECENT DATE. *** DTSBX521 01027 CL*29 01028 ** IF MPAY-ESTB-DATE = 20160122 CL111 01029 IF MPAY-ESTB-DATE = MHDR-PRIOR-RUN-DATE CL111 01030 WRITE PAYMT-REC FROM W-PAYMT-REC CL*30 01031 IF NOT PAYDIST-STATUS-OK-88 CL*42 01032 DISPLAY 'CANNOT WRITE TO PAYMT FILE ' CL*42 01033 ' ' PAYDIST-STATUS ' ' ACIN-EMP-NO CL*42 01034 ELSE DTSBX521 01035 ADD +1 TO W-PAYT-CNT CL*42 01036 END-IF DTSBX521 01037 END-IF. DTSBX521 01038 DTSBX521 01039 P3210-EXIT. DTSBX521 01040 EXIT. DTSBX521 01041 DTSBX521 01042 T0000-TERMINATE. DTSBX521 01043 PERFORM S910-CLOSE THRU S910-EXIT. CL**4 01044 PERFORM S921-CLOSE THRU S921-EXIT. CL**4 01045 PERFORM S931-CLOSE THRU S931-EXIT. CL**4 01046 CL**4 01047 CLOSE ACCT-FILE-OUT CL*35 01048 ACCT-FILE-IN CL*35 01049 PAYD-FILE CL*65 01050 ** SUMMARY-FILE CL**6 01051 PAYMT-FILE-OUT. CL*35 01052 DTSBX521 01053 DISPLAY '*********************************************'. DTSBX521 01054 DISPLAY '** DTSBX521 TERMINATION STATISTICS **'. CL*76 01055 DISPLAY '** **'. DTSBX521 01056 DISPLAY '** ACOUNTING ' W-ACCT-CNT DTSBX521 01057 DISPLAY '** ACOUNTING INCR ' W-ACCT-CNT-INCR DTSBX521 01058 DISPLAY '** TRANSACTIONS ' W-TRAN-CNT DTSBX521 01059 DISPLAY '** TRANSACTIONS INCR ' W-TRAN-CNT-INCR DTSBX521 01060 DISPLAY '** PAYMENTS ' W-PAY-CNT DTSBX521 01061 ' **'. DTSBX521 01062 DISPLAY '** PAY DIST ' W-PAY-DIST-CNT DTSBX521 01063 ' **'. DTSBX521 01064 DISPLAY '** ADJUST ' W-ADJ-CNT DTSBX521 01065 ' **'. DTSBX521 01066 DISPLAY '** ERRORS ' W-ERROR-CNT DTSBX521 01067 ' **'. DTSBX521 01068 DISPLAY '** CREDITS CORRECTED ' W-CR-CNT DTSBX521 01069 ' **'. DTSBX521 01070 DISPLAY '** LAST JC BATCH/ITEM ' DTSBX521 01071 W-JC-BATCH '/' W-JC-ITEM DTSBX521 01072 ' **'. DTSBX521 01073 DISPLAY '*********************************************'. CL*15 01074 DISPLAY '*******TOTAL CRDEITS ON MJRN AND MPRF RECS **'. CL*15 01075 DISPLAY '**' CL*15 01076 DISPLAY '** TOTAL-MPRF-CREDIT = ' W-TOT-MPRF-CREDIT CL*15 01077 DISPLAY '** TOTAL-MJRN-CREDIT = ' W-TOT-MJRN-CREDIT CL*15 01078 DISPLAY '**' CL*15 01079 DISPLAY '*********************************************'. CL*15 01080 DISPLAY '*******MPRF CRDITS NOT EQ TO MJRN CREDITS **'. CL*15 01081 DISPLAY '**' CL*15 01082 DISPLAY '** TOTAL-MPRF-CREDIT = ' W-DIF-MPRF-CREDIT CL*15 01083 DISPLAY '** TOTAL-MJRN-CREDIT = ' W-DIF-MJRN-CREDIT CL*15 01084 DISPLAY '**' CL*15 01085 DISPLAY '*********************************************'. CL*15 01086 DISPLAY '*********************************************'. DTSBX521 01087 DTSBX521 01088 DTSBX521 01089 T0000-EXIT. DTSBX521 01090 EXIT. DTSBX521 01091 DTSBX521 01092 DTSBX521 01093 S001-FROM-FED-8. DTSBX521 01094 SET L001-FROM-FED-8 TO TRUE. DTSBX521 01095 GO TO S001-DATE. DTSBX521 01096 DTSBX521 01097 S001-FROM-ABS-DAY. DTSBX521 01098 SET L001-FROM-ABS-DAY TO TRUE. DTSBX521 01099 GO TO S001-DATE. DTSBX521 01100 DTSBX521 01101 S001-FROM-CAL-6. DTSBX521 01102 SET L001-FROM-CAL-6 TO TRUE. DTSBX521 01103 GO TO S001-DATE. DTSBX521 01104 DTSBX521 01105 S001-DATE. DTSBX521 01106 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX521 01107 S001-EXIT. DTSBX521 01108 EXIT. DTSBX521 01109 SKIP3 DTSBX521 01110 S004-FROM-5. DTSBX521 01111 SET L004-FROM-5 TO TRUE. DTSBX521 01112 GO TO S004-QTR. DTSBX521 01113 DTSBX521 01114 S004-FROM-ABS. DTSBX521 01115 SET L004-FROM-ABS TO TRUE. DTSBX521 01116 GO TO S004-QTR. DTSBX521 01117 DTSBX521 01118 S004-FROM-3. DTSBX521 01119 SET L004-FROM-3 TO TRUE. DTSBX521 01120 GO TO S004-QTR. DTSBX521 01121 DTSBX521 01122 S004-FROM-DATE. DTSBX521 01123 SET L004-FROM-DATE TO TRUE. DTSBX521 01124 GO TO S004-QTR. DTSBX521 01125 DTSBX521 01126 S004-QTR. DTSBX521 01127 DTSBX521 01128 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX521 01129 DTSBX521 01130 S004-EXIT. DTSBX521 01131 EXIT. DTSBX521 01132 SKIP3 DTSBX521 01133 S005-SYS-DATE. CL**4 01134 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBX521 01135 S005-EXIT. DTSBX521 01136 EXIT. DTSBX521 01137 DTSBX521 01138 S910-OPEN-READ. DTSBX521 01139 SET L910-OPEN-READ-88 TO TRUE. DTSBX521 01140 GO TO S910-MSTR-IO. DTSBX521 01141 DTSBX521 01142 S910-READ. DTSBX521 01143 SET L910-READ-88 TO TRUE. DTSBX521 01144 GO TO S910-MSTR-IO. DTSBX521 01145 DTSBX521 01146 S910-START-BROWSE. DTSBX521 01147 SET L910-START-BROWSE-88 TO TRUE. DTSBX521 01148 GO TO S910-MSTR-IO. DTSBX521 01149 DTSBX521 01150 S910-READ-NEXT. DTSBX521 01151 SET L910-READ-NEXT-88 TO TRUE. DTSBX521 01152 GO TO S910-MSTR-IO. DTSBX521 01153 DTSBX521 01154 S910-COUNT. DTSBX521 01155 SET L910-COUNT-88 TO TRUE. DTSBX521 01156 GO TO S910-MSTR-IO. DTSBX521 01157 DTSBX521 01158 S910-REWRITE. DTSBX521 01159 SET L910-REWRITE-88 TO TRUE. DTSBX521 01160 GO TO S910-MSTR-IO. DTSBX521 01161 DTSBX521 01162 S910-CLOSE. DTSBX521 01163 SET L910-CLOSE-88 TO TRUE. DTSBX521 01164 GO TO S910-MSTR-IO. DTSBX521 01165 DTSBX521 01166 S910-MSTR-IO. DTSBX521 01167 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX521 01168 MSKL-REC. DTSBX521 01169 S910-EXIT. DTSBX521 01170 EXIT. DTSBX521 01171 CL**4 01172 S921-OPEN-READ. CL**4 01173 SET L921-OPEN-READ-88 TO TRUE. CL**4 01174 GO TO S921-AIX-IO. CL**4 01175 CL**4 01176 S921-CLOSE. CL**4 01177 SET L921-CLOSE-88 TO TRUE. CL**4 01178 GO TO S921-AIX-IO. CL**4 01179 CL**4 01180 S921-AIX-IO. CL**4 01181 CALL 'DTSBU921' USING L921-LINK-AREA CL**4 01182 ISKL-REC. CL**4 01183 S921-EXIT. CL**4 01184 EXIT. CL**4 01185 DTSBX521 01186 S931-OPEN-READ. CL**5 01187 SET L931-OPEN-READ-88 TO TRUE CL**5 01188 GO TO S931-REF-IO. CL**5 01189 CL**5 01190 S931-READ. DTSBX521 01191 SET L931-READ-88 TO TRUE. DTSBX521 01192 GO TO S931-REF-IO. DTSBX521 01193 DTSBX521 01194 S931-CLOSE. CL**5 01195 SET L931-CLOSE-88 TO TRUE. CL**5 01196 GO TO S931-REF-IO. CL**5 01197 CL**5 01198 S931-REF-IO. DTSBX521 01199 CALL 'DTSBU931' USING L931-LINK-AREA DTSBX521 01200 FSKL-REC. DTSBX521 01201 S931-EXIT. DTSBX521 01202 EXIT. DTSBX521 01203 DTSBX521 01204 S1000-CORRECTION-BATCH. DTSBX521 01205 IF W-JC-ITEM < +999 DTSBX521 01206 ADD +1 TO W-JC-ITEM DTSBX521 01207 ELSE DTSBX521 01208 ADD +1 TO W-JC-BATCH DTSBX521 01209 MOVE +1 TO W-JC-ITEM DTSBX521 01210 END-IF. DTSBX521 01211 DTSBX521 01212 S1000-EXIT. DTSBX521 01213 EXIT. DTSBX521 01214 DTSBX521 01215 S999-ABEND. DTSBX521 01216 DISPLAY '*** DTSBX343 ABENDING. ' DTSBX521 01217 ABEND-MSG. DTSBX521 01218 DTSBX521 01219 CALL 'DTSBU999' USING W-ABEND-CD. DTSBX521 01220 S999-EXIT. DTSBX521 01221 EXIT. DTSBX521