1223 lines
97 KiB
COBOL
1223 lines
97 KiB
COBOL
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
|