00001 IDENTIFICATION DIVISION. 01/23/16 00002 PROGRAM-ID. DTSBX522. DTSBX522 00003 AUTHOR. NGC. LV068 00004 DATE-WRITTEN. OCTOBER 2007. DTSBX522 00005 DATE-COMPILED. DTSBX522 00006 SKIP3 DTSBX522 00007 ***** DTSBX522 00008 * DTSBX522 00009 * FUNCTION: INTERNAL WEB MAINFRAME EXTRACT - ACCOUNTING DTSBX522 00010 * >>> INITIAL CONVERSION <<< DTSBX522 00011 * DTSBX522 00012 * DTSBX342 IS FOR THE DAILY INCREMENTAL UPDATE DTSBX522 00013 * DTSBX522 00014 * MODIFICATION LOG: DTSBX522 00015 * DTSBX522 00016 * 10/22/2007 INITIAL DEVELOPMENT. DTSBX522 00017 * REFERENCE: PROGRAMMER: GD DTSBX522 00018 * DTSBX522 00019 * 04/17/2008 CORRECTED SELECTION FOR REPORTS IN P3100. DTSBX522 00020 * THE PROCESS THAT ATTEMPTED TO COMBINE 4 DTSBX522 00021 * QUARTERLY REPORTS INTO ONE ANNUAL REPORT DTSBX522 00022 * HAD A PROBLEM WITH THE READS AND RESULTED DTSBX522 00023 * IN SOME NON-ANNUAL REPORTS BEING BYPASSED. DTSBX522 00024 * THE ANNUAL REPORTS ARE NOW WRITTEN IN DTSBX522 00025 * EXACTLY THE SAME WAY AS QUARTERLY REPORTS. DTSBX522 00026 * REFERENCE: PROGRAMMER: GD DTSBX522 00027 * DTSBX522 00028 * 03/02/2009 MODIFIED P5000 (PAY DISTRIBUTION) TO SELECT DTSBX522 00029 * RECORDS FOR ALL EMPLOYERS - NOT JUST THOSE DTSBX522 00030 * WITH CREDITS. DTSBX522 00031 * REFERENCE: PROGRAMMER: GD DTSBX522 00032 * DTSBX522 00033 * 03/11/2009 MODIFIED FOR INCREMENTAL UPDATE OF ACCOUNTING DTSBX522 00034 * TRANSACTION FILES. PARAGRAPHS AFFECTED: DTSBX522 00035 * P2110, P3110, P3210, P3310. DTSBX522 00036 * NEW, TEMPORARY, FILES ADDED FOR INCREMENTAL DTSBX522 00037 * RECORDS FOR TESTING. THE REGULAR FILES CONTINUE DTSBX522 00038 * TO BE PRODUCED FOR THE PRODUCTION DATABASE. DTSBX522 00039 * REFERENCE: PROGRAMMER: GD DTSBX522 00040 * DTSBX522 00041 * 11/05/2009 REMOVED TRAN AND ACCT FILES - ONLY THE DTSBX522 00042 * INCREMENTALLY UPDATED VERSIONS WILL BE WRITTEN. DTSBX522 00043 * REFERENCE: PROGRAMMER: GD DTSBX522 00044 * DTSBX522 00045 * 01/22/2010 MODIFIED PROCESS THAT SETS BALANCE DUE IN DTSBX522 00046 * P1210-BAL-DUE. IF CURRENT DATE < THE TAX DUE DTSBX522 00047 * DATE FOR THE QUARTER, SET THE BALANCE DUE TO 0. DTSBX522 00048 * REFERENCE: PROGRAMMER: GD DTSBX522 00049 * DTSBX522 00050 * 04/05/2010 ADDED TAX DUE DATE TO TA1-QUARTER TABLE. DTSBX522 00051 * ADDED RECEIVED DATE TO TA3-ACCT-DETAIL TABLE. DTSBX522 00052 * ADDED RESP ACTIVITY AND RESP OPID TO DTSBX522 00053 * TA2-TRAN-DETAIL. DTSBX522 00054 * REFERENCE: PROGRAMMER: GD DTSBX522 00055 * DTSBX522 00056 * 05/14/2010 CORRECTED ORDER OF FIELDS IN W-QTR-REC TO DTSBX522 00057 * MATCH ORDER EXPECTED IN SQL SERVER DATABASE. DTSBX522 00058 * REFERENCE: PROGRAMMER: GD DTSBX522 00059 * DTSBX522 00060 * 12/10/2015 PROGRAM RENAMED FROM BX355 TO BX522 CL*67 00061 * REFERENCE: PROGRAMMER: ZL1 CL*67 00062 * CL*67 00063 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX522 00064 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBX522 00065 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBX522 00066 * DTSBX522 00067 * DTSBX522 00068 * DESCRIPTION: DTSBX522 00069 * DTSBX522 00070 * DTSBX522 00071 * INITIATION: DTSBX522 00072 * DTSBX522 00073 * DTSBX522 00074 * DTSBX522 00075 * PROCESSING: DTSBX522 00076 * DTSBX522 00077 * DTSBX522 00078 * TERMINATION: DTSBX522 00079 * DTSBX522 00080 * DTSBX522 00081 * DTSBX522 00082 * RECORDS READ: DTSBX522 00083 * DTSBX522 00084 * MASTER: DTSBX522 00085 * DTSBX522 00086 * MQTR DTSBX522 00087 * MJRN DTSBX522 00088 * MPAY DTSBX522 00089 * MRPT DTSBX522 00090 * MADJ DTSBX522 00091 * DTSBX522 00092 * DTSBX522 00093 * ALTERNATE INDEX: DTSBX522 00094 * DTSBX522 00095 * NONE. DTSBX522 00096 * DTSBX522 00097 * DTSBX522 00098 * REFERENCE: DTSBX522 00099 * DTSBX522 00100 * DTSBX522 00101 * DTSBX522 00102 * RECORDS UPDATED: DTSBX522 00103 * DTSBX522 00104 * NONE DTSBX522 00105 * DTSBX522 00106 * DTSBX522 00107 * OUTPUT RECORDS WRITTEN: DTSBX522 00108 * DTSBX522 00109 * DTSBX331 DTSBX522 00110 * DTSBX522 00111 * DTSBX522 00112 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBX522 00113 * DTSBX522 00114 * NONE. DTSBX522 00115 * DTSBX522 00116 * DTSBX522 00117 * MODULES CALLED: DTSBX522 00118 * DTSBX522 00119 * DTSBU001 DATE EDIT/CONVERSION. DTSBX522 00120 * DTSBU004 QUARTER EDIT/CONVERSION. DTSBX522 00121 * DTSBU910 MASTER FILE I/O. DTSBX522 00122 * DTSBX522 00123 * DTSBX522 00124 * DTSBX522 00125 ***** DTSBX522 00126 SKIP3 DTSBX522 00127 ENVIRONMENT DIVISION. DTSBX522 00128 INPUT-OUTPUT SECTION. DTSBX522 00129 FILE-CONTROL. DTSBX522 00130 ** SELECT ACCT-FILE ASSIGN TO DTSFACC1 DTSBX522 00131 ** FILE STATUS IS ACCT-STATUS. DTSBX522 00132 DTSBX522 00133 SELECT ACCT-FILE-INCR ASSIGN TO DTSFACC3 DTSBX522 00134 FILE STATUS IS ACCT-I-STATUS. DTSBX522 00135 DTSBX522 00136 ** SELECT TRAN-FILE ASSIGN TO DTSFTRN1 DTSBX522 00137 ** FILE STATUS IS TRAN-STATUS. DTSBX522 00138 DTSBX522 00139 SELECT TRAN-FILE-INCR ASSIGN TO DTSFTRN3 DTSBX522 00140 FILE STATUS IS TRAN-I-STATUS. DTSBX522 00141 DTSBX522 00142 SELECT QTR-FILE ASSIGN TO DTSFQTR1 DTSBX522 00143 FILE STATUS IS QTR-STATUS. DTSBX522 00144 DTSBX522 00145 SELECT SUMMARY-FILE ASSIGN TO DTSFSUM1 DTSBX522 00146 FILE STATUS IS SUMMARY-STATUS. DTSBX522 00147 DTSBX522 00148 SELECT PAY-DIST-FILE ASSIGN TO DTSFDST1 DTSBX522 00149 FILE STATUS IS PAYDIST-STATUS. DTSBX522 00150 DTSBX522 00151 DATA DIVISION. DTSBX522 00152 FILE SECTION. DTSBX522 00153 FD ACCT-FILE-INCR DTSBX522 00154 RECORDING MODE IS F DTSBX522 00155 LABEL RECORDS ARE STANDARD DTSBX522 00156 BLOCK CONTAINS 0 CHARACTERS. DTSBX522 00157 DTSBX522 00158 01 ACCT-INCR-REC PIC X(81). CL*63 00159 *01 ACCT-INCR-REC PIC X(72). CL*63 00160 DTSBX522 00161 FD TRAN-FILE-INCR DTSBX522 00162 RECORDING MODE IS F DTSBX522 00163 LABEL RECORDS ARE STANDARD DTSBX522 00164 BLOCK CONTAINS 0 CHARACTERS. DTSBX522 00165 DTSBX522 00166 01 TRAN-INCR-REC PIC X(141). DTSBX522 00167 DTSBX522 00168 FD QTR-FILE DTSBX522 00169 RECORDING MODE IS F DTSBX522 00170 LABEL RECORDS ARE STANDARD DTSBX522 00171 BLOCK CONTAINS 0 CHARACTERS. DTSBX522 00172 DTSBX522 00173 01 QTR-REC PIC X(63). DTSBX522 00174 DTSBX522 00175 FD SUMMARY-FILE DTSBX522 00176 RECORDING MODE IS F. DTSBX522 00177 01 SUMMARY-REC PIC X(73). DTSBX522 00178 DTSBX522 00179 FD PAY-DIST-FILE DTSBX522 00180 RECORDING MODE IS F. DTSBX522 00181 01 PAY-DIST-REC PIC X(50). DTSBX522 00182 DTSBX522 00183 WORKING-STORAGE SECTION. DTSBX522 001835 77 PAN-VALET PICTURE X(24) VALUE '068DTSBX522 01/23/16'. DTSBX522 00184 SKIP3 DTSBX522 00185 01 W-AREA. DTSBX522 00186 05 W-ABEND-CD PIC S9(04) COMP VALUE +343.DTSBX522 00187 DTSBX522 00188 DTSBX522 00189 05 ABEND-MSG PIC X(60). DTSBX522 00190 DTSBX522 00191 05 PARM-STATUS PIC X(02). DTSBX522 00192 88 PARM-STATUS-OK-88 VALUE '00'. DTSBX522 00193 05 ACCT-STATUS PIC X(02). DTSBX522 00194 88 ACCT-STATUS-OK-88 VALUE '00'. DTSBX522 00195 88 ACCT-STATUS-EOF-88 VALUE '10'. DTSBX522 00196 05 ACCT-I-STATUS PIC X(02). DTSBX522 00197 88 ACCT-I-STATUS-OK-88 VALUE '00'. DTSBX522 00198 88 ACCT-I-STATUS-EOF-88 VALUE '10'. DTSBX522 00199 05 TRAN-STATUS PIC X(02). DTSBX522 00200 88 TRAN-STATUS-OK-88 VALUE '00'. DTSBX522 00201 05 TRAN-I-STATUS PIC X(02). DTSBX522 00202 88 TRAN-I-STATUS-OK-88 VALUE '00'. DTSBX522 00203 05 QTR-STATUS PIC X(02). DTSBX522 00204 88 QTR-STATUS-OK-88 VALUE '00'. DTSBX522 00205 05 QCOLL-STATUS PIC X(02). DTSBX522 00206 88 QCOLL-STATUS-OK-88 VALUE '00'. DTSBX522 00207 05 SUMMARY-STATUS PIC X(02). DTSBX522 00208 88 SUMMARY-STATUS-OK-88 VALUE '00'. DTSBX522 00209 05 PAYDIST-STATUS PIC X(02). DTSBX522 00210 88 PAYDIST-STATUS-OK-88 VALUE '00'. DTSBX522 00211 DTSBX522 00212 05 EMP-STATUS PIC X(02). DTSBX522 00213 88 EMP-STATUS-OK-88 VALUE '00'. DTSBX522 00214 DTSBX522 00215 05 W-ERROR-IND PIC X(01) VALUE 'N'. DTSBX522 00216 88 W-ERROR-YES-88 VALUE 'Y'. DTSBX522 00217 88 W-ERROR-NO-88 VALUE 'N'. DTSBX522 00218 DTSBX522 00219 05 W-RPT-COMPLETE-IND PIC X(01). DTSBX522 00220 88 W-RPT-COMPLETE-YES-88 VALUE 'Y'. DTSBX522 00221 88 W-RPT-COMPLETE-NO-88 VALUE 'N'. DTSBX522 00222 88 W-RPT-COMPLETE-NULL-88 VALUE ' '. DTSBX522 00223 DTSBX522 00224 05 W-UI-CHARGE-IND PIC X(01). DTSBX522 00225 88 W-UI-CHARGE-YES-88 VALUE 'Y'. DTSBX522 00226 88 W-UI-CHARGE-NO-88 VALUE 'N'. DTSBX522 00227 05 W-LP-CHARGE-IND PIC X(01). DTSBX522 00228 88 W-LP-CHARGE-YES-88 VALUE 'Y'. DTSBX522 00229 88 W-LP-CHARGE-NO-88 VALUE 'N'. DTSBX522 00230 05 WK-JRN-HOLD-KEY-AREA PIC X(16). CL*56 00231 05 W-STATUS-CD PIC X(02). DTSBX522 00232 88 W-STATUS-WITHDRAWN-88 VALUE '04', '05'. DTSBX522 00233 DTSBX522 00234 05 CONV-QTR-SUB PIC S9(04) COMP. DTSBX522 00235 05 QSUB PIC S9(04) COMP. DTSBX522 00236 05 QMAX PIC S9(04) COMP VALUE +400. DTSBX522 00237 05 ACCT-TABLE OCCURS 400 TIMES. DTSBX522 00238 10 TBL-YRQ PIC S9(05) COMP-3. DTSBX522 00239 10 TBL-JRN-IND PIC X(01). DTSBX522 00240 88 TBL-JRN-GOOD-88 VALUE '0'. DTSBX522 00241 88 TBL-JRN-BAD-88 VALUE '1'. DTSBX522 00242 10 Q-UI-CHG PIC S9(11)V99 COMP-3. DTSBX522 00243 10 Q-UI-PD PIC S9(11)V99 COMP-3. DTSBX522 00244 10 Q-UI-WV PIC S9(11)V99 COMP-3. DTSBX522 00245 10 Q-UI-WO PIC S9(11)V99 COMP-3. DTSBX522 00246 10 Q-UI-TL PIC S9(11)V99 COMP-3. DTSBX522 00247 10 Q-UI-BAL PIC S9(11)V99 COMP-3. DTSBX522 00248 10 J-UI-CHG PIC S9(11)V99 COMP-3. DTSBX522 00249 10 J-UI-PD PIC S9(11)V99 COMP-3. DTSBX522 00250 10 J-UI-WV PIC S9(11)V99 COMP-3. DTSBX522 00251 10 J-UI-WO PIC S9(11)V99 COMP-3. DTSBX522 00252 10 J-UI-TL PIC S9(11)V99 COMP-3. DTSBX522 00253 10 J-UI-BAL PIC S9(11)V99 COMP-3. DTSBX522 00254 10 Q-INT-CHG PIC S9(11)V99 COMP-3. DTSBX522 00255 10 Q-INT-PD PIC S9(11)V99 COMP-3. DTSBX522 00256 10 Q-INT-WV PIC S9(11)V99 COMP-3. DTSBX522 00257 10 Q-INT-WO PIC S9(11)V99 COMP-3. DTSBX522 00258 10 Q-INT-TL PIC S9(11)V99 COMP-3. DTSBX522 00259 10 Q-INT-BAL PIC S9(11)V99 COMP-3. DTSBX522 00260 10 J-INT-CHG PIC S9(11)V99 COMP-3. DTSBX522 00261 10 J-INT-PD PIC S9(11)V99 COMP-3. DTSBX522 00262 10 J-INT-WV PIC S9(11)V99 COMP-3. DTSBX522 00263 10 J-INT-WO PIC S9(11)V99 COMP-3. DTSBX522 00264 10 J-INT-TL PIC S9(11)V99 COMP-3. DTSBX522 00265 10 J-INT-BAL PIC S9(11)V99 COMP-3. DTSBX522 00266 10 Q-LP-CHG PIC S9(11)V99 COMP-3. DTSBX522 00267 10 Q-LP-PD PIC S9(11)V99 COMP-3. DTSBX522 00268 10 Q-LP-WV PIC S9(11)V99 COMP-3. DTSBX522 00269 10 Q-LP-WO PIC S9(11)V99 COMP-3. DTSBX522 00270 10 Q-LP-TL PIC S9(11)V99 COMP-3. DTSBX522 00271 10 Q-LP-BAL PIC S9(11)V99 COMP-3. DTSBX522 00272 10 J-LP-CHG PIC S9(11)V99 COMP-3. DTSBX522 00273 10 J-LP-PD PIC S9(11)V99 COMP-3. DTSBX522 00274 10 J-LP-WV PIC S9(11)V99 COMP-3. DTSBX522 00275 10 J-LP-WO PIC S9(11)V99 COMP-3. DTSBX522 00276 10 J-LP-TL PIC S9(11)V99 COMP-3. DTSBX522 00277 10 J-LP-BAL PIC S9(11)V99 COMP-3. DTSBX522 00278 10 Q-NP-CHG PIC S9(11)V99 COMP-3. DTSBX522 00279 10 Q-NP-PD PIC S9(11)V99 COMP-3. DTSBX522 00280 10 Q-NP-WV PIC S9(11)V99 COMP-3. DTSBX522 00281 10 Q-NP-WO PIC S9(11)V99 COMP-3. DTSBX522 00282 10 Q-NP-TL PIC S9(11)V99 COMP-3. DTSBX522 00283 10 Q-NP-BAL PIC S9(11)V99 COMP-3. DTSBX522 00284 10 J-NP-CHG PIC S9(11)V99 COMP-3. DTSBX522 00285 10 J-NP-PD PIC S9(11)V99 COMP-3. DTSBX522 00286 10 J-NP-WV PIC S9(11)V99 COMP-3. DTSBX522 00287 10 J-NP-WO PIC S9(11)V99 COMP-3. DTSBX522 00288 10 J-NP-TL PIC S9(11)V99 COMP-3. DTSBX522 00289 10 J-NP-BAL PIC S9(11)V99 COMP-3. DTSBX522 00290 10 Q-MP-CHG PIC S9(11)V99 COMP-3. DTSBX522 00291 10 Q-MP-PD PIC S9(11)V99 COMP-3. DTSBX522 00292 10 Q-MP-WV PIC S9(11)V99 COMP-3. DTSBX522 00293 10 Q-MP-WO PIC S9(11)V99 COMP-3. DTSBX522 00294 10 Q-MP-TL PIC S9(11)V99 COMP-3. DTSBX522 00295 10 Q-MP-BAL PIC S9(11)V99 COMP-3. DTSBX522 00296 10 J-MP-CHG PIC S9(11)V99 COMP-3. DTSBX522 00297 10 J-MP-PD PIC S9(11)V99 COMP-3. DTSBX522 00298 10 J-MP-WV PIC S9(11)V99 COMP-3. DTSBX522 00299 10 J-MP-WO PIC S9(11)V99 COMP-3. DTSBX522 00300 10 J-MP-TL PIC S9(11)V99 COMP-3. DTSBX522 00301 10 J-MP-BAL PIC S9(11)V99 COMP-3. DTSBX522 00302 10 Q-SU-CHG PIC S9(11)V99 COMP-3. DTSBX522 00303 10 Q-SU-PD PIC S9(11)V99 COMP-3. DTSBX522 00304 10 Q-SU-WV PIC S9(11)V99 COMP-3. DTSBX522 00305 10 Q-SU-WO PIC S9(11)V99 COMP-3. DTSBX522 00306 10 Q-SU-TL PIC S9(11)V99 COMP-3. DTSBX522 00307 10 Q-SU-BAL PIC S9(11)V99 COMP-3. DTSBX522 00308 10 J-SU-CHG PIC S9(11)V99 COMP-3. DTSBX522 00309 10 J-SU-PD PIC S9(11)V99 COMP-3. DTSBX522 00310 10 J-SU-WV PIC S9(11)V99 COMP-3. DTSBX522 00311 10 J-SU-WO PIC S9(11)V99 COMP-3. DTSBX522 00312 10 J-SU-TL PIC S9(11)V99 COMP-3. DTSBX522 00313 10 J-SU-BAL PIC S9(11)V99 COMP-3. DTSBX522 00314 DTSBX522 00315 05 W-AMT PIC S9(11)V99 COMP-3. DTSBX522 00316 05 W-TOT-CHG PIC S9(11)V99 COMP-3 DTSBX522 00317 VALUE +0. DTSBX522 00318 05 W-TOT-PD PIC S9(11)V99 COMP-3 DTSBX522 00319 VALUE +0. DTSBX522 00320 05 W-TOT-CREDIT PIC S9(11)V99 COMP-3 DTSBX522 00321 VALUE +0. DTSBX522 00322 05 W-CREDIT-CORRECT PIC S9(11)V99 COMP-3 DTSBX522 00323 VALUE +0. DTSBX522 00324 DTSBX522 00325 05 W-DEFAULT-DATE PIC X(10) DTSBX522 00326 VALUE '12/31/1994'. DTSBX522 00327 DTSBX522 00328 05 W-MPRF-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX522 00329 05 W-MJRN-READ-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX522 00330 05 W-ERROR-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX522 00331 05 W-ACCT-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX522 00332 05 W-ACCT-CNT-INCR PIC S9(07) COMP-3 VALUE +0. DTSBX522 00333 05 W-TRAN-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX522 00334 05 W-TRAN-CNT-INCR PIC S9(07) COMP-3 VALUE +0. DTSBX522 00335 05 W-SUMMARY-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX522 00336 05 W-RPT-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX522 00337 05 W-ANN-RPT-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX522 00338 05 W-PAY-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX522 00339 05 W-PAY-DIST-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX522 00340 05 W-ADJ-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX522 00341 05 W-QTR-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX522 00342 05 W-CR-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX522 00343 05 W-BATCH PIC S9(05) COMP-3 VALUE +0. DTSBX522 00344 05 W-ITEM PIC S9(03) COMP-3 VALUE +0. DTSBX522 00345 05 ADJ-CHG PIC S9(09)V99 COMP-3. DTSBX522 00346 05 ADJ-PD PIC S9(09)V99 COMP-3. DTSBX522 00347 05 ADJ-WV PIC S9(09)V99 COMP-3. DTSBX522 00348 05 ADJ-WO PIC S9(09)V99 COMP-3. DTSBX522 00349 05 ADJ-TL PIC S9(09)V99 COMP-3. DTSBX522 00350 05 W-CHG PIC S9(09)V99 COMP-3. DTSBX522 00351 05 W-PD PIC S9(09)V99 COMP-3. DTSBX522 00352 05 W-WV PIC S9(09)V99 COMP-3. DTSBX522 00353 05 W-WO PIC S9(09)V99 COMP-3. DTSBX522 00354 05 W-TL PIC S9(09)V99 COMP-3. DTSBX522 00355 05 W-BAL PIC S9(09)V99 COMP-3. DTSBX522 00356 05 W-QTR-BAL PIC S9(11)V99 COMP-3. DTSBX522 00357 05 W-RATE PIC S9(03)V9(04) COMP-3. DTSBX522 00358 05 W-JC-BATCH PIC S9(05) COMP-3 DTSBX522 00359 VALUE +00010. DTSBX522 00360 05 W-JC-ITEM PIC S9(03) COMP-3 DTSBX522 00361 VALUE +0. DTSBX522 00362 DTSBX522 00363 05 ASUB PIC S9(04) COMP. DTSBX522 00364 05 ASUB1 PIC S9(04) COMP. DTSBX522 00365 05 ASUB-MAX PIC S9(04) COMP VALUE +50. DTSBX522 00366 05 ASUB-LAST PIC S9(04) COMP VALUE +0. DTSBX522 00367 05 ANN-RPT-TABLE OCCURS 50 TIMES. DTSBX522 00368 10 W-ANN-RPT-TYPE PIC X(02). DTSBX522 00369 10 W-ANN-YRQ PIC 9(05). DTSBX522 00370 10 FILLER REDEFINES W-ANN-YRQ. DTSBX522 00371 15 W-ANN-YRQ-CCYY PIC 9(04). DTSBX522 00372 15 W-ANN-YRQ-Q PIC 9(01). DTSBX522 00373 DTSBX522 00374 10 W-ANN-BATCH PIC S9(05) COMP-3. DTSBX522 00375 10 W-ANN-ITEM PIC S9(03) COMP-3. DTSBX522 00376 10 W-ANN-RATE PIC S9(03)V9(04) COMP-3. DTSBX522 00377 10 W-ANN-REMIT PIC S9(09)V99 COMP-3. DTSBX522 00378 10 W-ANN-TOT-WAGE PIC S9(09)V99 COMP-3. DTSBX522 00379 10 W-ANN-TAX-WAGE PIC S9(09)V99 COMP-3. DTSBX522 00380 10 W-ANN-EXCESS-WAGE PIC S9(09)V99 COMP-3. DTSBX522 00381 10 W-ANN-RCVD-DT PIC S9(09) COMP-3. DTSBX522 00382 10 W-ANN-PROCESS-DT PIC S9(09) COMP-3. DTSBX522 00383 DTSBX522 00384 05 W-LAST-ANN-YRQ PIC S9(05) COMP-3. DTSBX522 00385 DTSBX522 00386 05 W-ACCT-REC. DTSBX522 00387 10 ACCT-EMP-NO PIC 9(06). DTSBX522 00388 10 FILLER PIC X(01) VALUE ','. DTSBX522 00389 10 ACCT-YRQ PIC X(06). DTSBX522 00390 10 FILLER PIC X(01) VALUE ','. DTSBX522 00391 10 ACCT-BATCH PIC 9(05). DTSBX522 00392 10 FILLER PIC X(01) VALUE ','. DTSBX522 00393 10 ACCT-ITEM PIC 9(03). DTSBX522 00394 10 FILLER PIC X(01) VALUE ','. DTSBX522 00395 10 ACCT-TRAN PIC X(02). DTSBX522 00396 10 FILLER PIC X(01) VALUE ','. DTSBX522 00397 10 ACCT-ROW PIC X(02). DTSBX522 00398 10 FILLER PIC X(01) VALUE ','. DTSBX522 00399 10 ACCT-COL PIC X(02). DTSBX522 00400 10 FILLER PIC X(01) VALUE ','. DTSBX522 00401 10 ACCT-AMT PIC ---------9.99. DTSBX522 00402 10 ACCT-AMT-9 REDEFINES ACCT-AMT PIC 9(10).99. DTSBX522 00403 10 FILLER PIC X(01) VALUE ','. DTSBX522 00404 10 ACCT-CAT PIC X(01). DTSBX522 00405 10 FILLER PIC X(01) VALUE ','. DTSBX522 00406 10 ACCT-PROCESS-DT PIC X(10). DTSBX522 00407 10 FILLER PIC X(01) VALUE ','. DTSBX522 00408 10 ACCT-SOURCE PIC X(01). DTSBX522 00409 88 ACCT-SOURCE-CR-DB-88 VALUE '1'. DTSBX522 00410 88 ACCT-SOURCE-STATUS-88 VALUE '2'. DTSBX522 00411 88 ACCT-SOURCE-ERROR-88 VALUE '3'. DTSBX522 00412 10 FILLER PIC X(01) VALUE ','. DTSBX522 00413 10 ACCT-RCVD-DT PIC X(10). DTSBX522 00414 10 FILLER PIC X(01) VALUE ','. CL*20 00415 10 ACCT-PAYMENT-ID PIC 9(08). CL*20 00416 DTSBX522 00417 05 W-TRAN-REC. DTSBX522 00418 10 TRAN-EMP-NO PIC 9(06). DTSBX522 00419 10 FILLER PIC X(01) VALUE ','. DTSBX522 00420 10 TRAN-YRQ PIC X(06). DTSBX522 00421 10 FILLER PIC X(01) VALUE ','. DTSBX522 00422 10 TRAN-BATCH PIC 9(05). DTSBX522 00423 10 FILLER PIC X(01) VALUE ','. DTSBX522 00424 10 TRAN-ITEM PIC 9(03). DTSBX522 00425 10 FILLER PIC X(01) VALUE ','. DTSBX522 00426 10 TRAN-TRANS PIC X(02). DTSBX522 00427 10 FILLER PIC X(01) VALUE ','. DTSBX522 00428 10 TRAN-AMT PIC --------9.99. DTSBX522 00429 10 FILLER PIC X(01) VALUE ','. DTSBX522 00430 10 TRAN-TOT-WAGE PIC ----------9.99. DTSBX522 00431 10 TRAN-TOT-WAGE-X REDEFINES TRAN-TOT-WAGE DTSBX522 00432 PIC X(14). DTSBX522 00433 10 FILLER PIC X(01) VALUE ','. DTSBX522 00434 10 TRAN-TAX-WAGE PIC ----------9.99. DTSBX522 00435 10 TRAN-TAX-WAGE-X REDEFINES TRAN-TAX-WAGE DTSBX522 00436 PIC X(14). DTSBX522 00437 10 FILLER PIC X(01) VALUE ','. DTSBX522 00438 10 TRAN-EXC-WAGE PIC ----------9.99. DTSBX522 00439 10 TRAN-EXC-WAGE-X REDEFINES TRAN-EXC-WAGE DTSBX522 00440 PIC X(14). DTSBX522 00441 10 FILLER PIC X(01) VALUE ','. DTSBX522 00442 10 TRAN-RATE PIC Z9.9. DTSBX522 00443 10 TRAN-RATE-X REDEFINES TRAN-RATE DTSBX522 00444 PIC X(04). DTSBX522 00445 10 FILLER PIC X(01) VALUE ','. DTSBX522 00446 10 TRAN-ACCT PIC X(02). DTSBX522 00447 10 FILLER PIC X(01) VALUE ','. DTSBX522 00448 10 TRAN-CAT PIC X(01). DTSBX522 00449 10 FILLER PIC X(01) VALUE ','. DTSBX522 00450 10 TRAN-SOURCE PIC X(01). DTSBX522 00451 88 TRAN-SOURCE-CR-DB-88 VALUE '1'. DTSBX522 00452 88 TRAN-SOURCE-STATUS-88 VALUE '2'. DTSBX522 00453 88 TRAN-SOURCE-ERROR-88 VALUE '3'. DTSBX522 00454 10 FILLER PIC X(01) VALUE ','. DTSBX522 00455 10 TRAN-RCVD-DT PIC X(10). DTSBX522 00456 10 FILLER PIC X(01) VALUE ','. DTSBX522 00457 10 TRAN-PROCESS-DT PIC X(10). DTSBX522 00458 10 FILLER PIC X(01) VALUE ','. DTSBX522 00459 10 TRAN-APPLIC-BATCH PIC 9(05). DTSBX522 00460 10 FILLER PIC X(01) VALUE ','. DTSBX522 00461 10 TRAN-APPLIC-ITEM PIC 9(03). DTSBX522 00462 10 FILLER PIC X(01) VALUE ','. DTSBX522 00463 10 TRAN-RESP-ACTIVITY PIC X(03). DTSBX522 00464 10 FILLER PIC X(01) VALUE ','. DTSBX522 00465 10 TRAN-RESP-OPID PIC X(08). DTSBX522 00466 DTSBX522 00467 05 W-QTR-REC. DTSBX522 00468 10 QTR-EMP-NO PIC 9(06). DTSBX522 00469 10 FILLER PIC X(01) VALUE ','. DTSBX522 00470 10 QTR-QUARTER PIC X(06). DTSBX522 00471 10 FILLER PIC X(01) VALUE ','. DTSBX522 00472 10 QTR-RPT-STATUS PIC X(01). DTSBX522 00473 10 FILLER PIC X(01) VALUE ','. DTSBX522 00474 10 QTR-RPT-DUE-DT PIC X(10). DTSBX522 00475 10 FILLER PIC X(01) VALUE ','. DTSBX522 00476 10 QTR-PROCESS-DT PIC X(10). DTSBX522 00477 10 FILLER PIC X(01) VALUE ','. DTSBX522 00478 10 QTR-BAL-DUE PIC ----------9.99. DTSBX522 00479 10 FILLER PIC X(01) VALUE ','. DTSBX522 00480 10 QTR-TAX-DUE-DT PIC X(10). DTSBX522 00481 DTSBX522 00482 05 W-SUMMARY-REC. DTSBX522 00483 10 SUMMARY-PROCESS-DT PIC X(10). DTSBX522 00484 10 FILLER PIC X(01) VALUE ','. DTSBX522 00485 10 SUMMARY-MESSAGE PIC X(40). DTSBX522 00486 10 FILLER PIC X(01) VALUE ','. DTSBX522 00487 10 SUMMARY-EMP-NO PIC 9(06). DTSBX522 00488 10 FILLER PIC X(01) VALUE ','. DTSBX522 00489 10 SUMMARY-BATCH PIC 9(05). DTSBX522 00490 10 FILLER PIC X(01) VALUE ','. DTSBX522 00491 10 SUMMARY-ITEM PIC 9(03). DTSBX522 00492 10 FILLER PIC X(01) VALUE ','. DTSBX522 00493 10 SUMMARY-TRAN PIC X(02). DTSBX522 00494 10 FILLER PIC X(01) VALUE ','. DTSBX522 00495 10 SUMMARY-SOURCE PIC X(01). DTSBX522 00496 88 SUMMARY-SOURCE-CR-DB-88 VALUE '1'. DTSBX522 00497 88 SUMMARY-SOURCE-STATUS-88 VALUE '2'. DTSBX522 00498 88 SUMMARY-SOURCE-ERROR-88 VALUE '3'. DTSBX522 00499 DTSBX522 00500 05 W-PAY-DIST-REC. DTSBX522 00501 10 DST-EMP-NO PIC 9(06). DTSBX522 00502 10 FILLER PIC X(01) VALUE ','. DTSBX522 00503 10 DST-BATCH PIC 9(05). DTSBX522 00504 10 FILLER PIC X(01) VALUE ','. DTSBX522 00505 10 DST-ITEM PIC 9(03). DTSBX522 00506 10 FILLER PIC X(01) VALUE ','. DTSBX522 00507 10 DST-QTR PIC X(06). DTSBX522 00508 10 FILLER PIC X(01) VALUE ','. DTSBX522 00509 10 DST-ACCT PIC X(02). DTSBX522 00510 10 FILLER PIC X(01) VALUE ','. DTSBX522 00511 10 DST-AMT PIC --------9.99. DTSBX522 00512 10 FILLER PIC X(01) VALUE ','. DTSBX522 00513 10 DST-CHNG-DT PIC X(10). DTSBX522 00514 DTSBX522 00515 05 W-CURR-UI-TOT PIC S9(11)V99 COMP-3 DTSBX522 00516 VALUE +0. DTSBX522 00517 DTSBX522 00518 05 DISPLAY-CNT PIC Z(06)9. DTSBX522 00519 DTSBX522 00520 05 DISPLAY-AMT1-X PIC X(14). DTSBX522 00521 05 DISPLAY-AMT1 REDEFINES DISPLAY-AMT1-X DTSBX522 00522 PIC ---,---,--9.99. DTSBX522 00523 05 DISPLAY-AMT2-X PIC X(14). DTSBX522 00524 05 DISPLAY-AMT2 REDEFINES DISPLAY-AMT2-X DTSBX522 00525 PIC ---,---,--9.99. DTSBX522 00526 05 DISPLAY-AMT3-X PIC X(14). DTSBX522 00527 05 DISPLAY-AMT3 REDEFINES DISPLAY-AMT3-X DTSBX522 00528 PIC ---,---,--9.99. DTSBX522 00529 05 DISPLAY-AMT4-X PIC X(14). DTSBX522 00530 05 DISPLAY-AMT4 REDEFINES DISPLAY-AMT4-X DTSBX522 00531 PIC ---,---,--9.99. DTSBX522 00532 EJECT DTSBX522 00533 01 L001-LINK-AREA. DTSBX522 00534 ++INCLUDE DTSIL001 DTSBX522 00535 EJECT DTSBX522 00536 01 L004-LINK-AREA. DTSBX522 00537 ++INCLUDE DTSIL004 DTSBX522 00538 EJECT DTSBX522 00539 01 L005-LINK-AREA. DTSBX522 00540 ++INCLUDE DTSIL005 DTSBX522 00541 DTSBX522 00542 01 L910-LINK-AREA. DTSBX522 00543 ++INCLUDE DTSIL910 DTSBX522 00544 SKIP3 DTSBX522 00545 01 MSKL-REC. DTSBX522 00546 ++INCLUDE DTSIMSKL DTSBX522 00547 SKIP3 DTSBX522 00548 01 MHDR-REC. DTSBX522 00549 ++INCLUDE DTSIMHDR DTSBX522 00550 SKIP3 DTSBX522 00551 01 MQTR-REC. DTSBX522 00552 ++INCLUDE DTSIMQTR DTSBX522 00553 SKIP3 DTSBX522 00554 01 MJRN-REC. DTSBX522 00555 ++INCLUDE DTSIMJRN DTSBX522 00556 SKIP3 DTSBX522 00557 01 MRPT-REC. DTSBX522 00558 ++INCLUDE DTSIMRPT DTSBX522 00559 SKIP3 DTSBX522 00560 01 MADJ-REC. DTSBX522 00561 ++INCLUDE DTSIMADJ DTSBX522 00562 SKIP3 DTSBX522 00563 01 MPAY-REC. DTSBX522 00564 ++INCLUDE DTSIMPAY DTSBX522 00565 SKIP3 DTSBX522 00566 01 MDST-REC. DTSBX522 00567 ++INCLUDE DTSIMDST DTSBX522 00568 SKIP3 DTSBX522 00569 01 MRTE-REC. DTSBX522 00570 ++INCLUDE DTSIMRTE DTSBX522 00571 SKIP3 DTSBX522 00572 01 MEVL-REC. DTSBX522 00573 ++INCLUDE DTSIMEVL DTSBX522 00574 SKIP3 DTSBX522 00575 01 MSOL-REC. DTSBX522 00576 ++INCLUDE DTSIMSOL DTSBX522 00577 SKIP3 DTSBX522 00578 01 MFSC-REC. DTSBX522 00579 ++INCLUDE DTSIMFSC DTSBX522 00580 SKIP3 DTSBX522 00581 01 MTAD-REC. DTSBX522 00582 ++INCLUDE DTSIMTAD DTSBX522 00583 SKIP3 DTSBX522 00584 01 MTAA-REC. DTSBX522 00585 ++INCLUDE DTSIMTAA DTSBX522 00586 SKIP3 DTSBX522 00587 01 MLOG-REC. DTSBX522 00588 ++INCLUDE DTSIMLOG DTSBX522 00589 SKIP3 DTSBX522 00590 01 L931-LINK-AREA. DTSBX522 00591 ++INCLUDE DTSIL931 DTSBX522 00592 SKIP3 DTSBX522 00593 01 FSKL-REC. DTSBX522 00594 ++INCLUDE DTSIFSKL DTSBX522 00595 SKIP3 DTSBX522 00596 01 FQTR-REC. DTSBX522 00597 ++INCLUDE DTSIFQTR DTSBX522 00598 DTSBX522 00599 LINKAGE SECTION. DTSBX522 00600 DTSBX522 00601 01 LX34-LINK-AREA. DTSBX522 00602 ++INCLUDE DTSILX34 DTSBX522 00603 DTSBX522 00604 01 MPRF-REC. DTSBX522 00605 ++INCLUDE DTSIMPRF DTSBX522 00606 EJECT DTSBX522 00607 PROCEDURE DIVISION USING LX34-LINK-AREA DTSBX522 00608 MPRF-REC. DTSBX522 00609 DTSBX522 00610 EVALUATE TRUE DTSBX522 00611 WHEN LX34-INITIALIZE-88 DTSBX522 00612 PERFORM I0000-INITIALIZE THRU I0000-EXIT DTSBX522 00613 WHEN LX34-PROCESS-88 DTSBX522 00614 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBX522 00615 WHEN LX34-TERMINATE-88 DTSBX522 00616 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBX522 00617 END-EVALUATE. DTSBX522 00618 DTSBX522 00619 GOBACK. DTSBX522 00620 DTSBX522 00621 I0000-INITIALIZE. DTSBX522 00622 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBX522 00623 DTSBX522 00624 I0000-EXIT. DTSBX522 00625 EXIT. DTSBX522 00626 DTSBX522 00627 I2000-OPEN-FILES. DTSBX522 00628 ** OPEN OUTPUT ACCT-FILE. DTSBX522 00629 * IF NOT ACCT-STATUS-OK-88 DTSBX522 00630 * DISPLAY 'BX343 ACCT FILE OPEN ERROR: ' ACCT-STATUS DTSBX522 00631 * MOVE 'FILE OPEN ERROR' DTSBX522 00632 * TO ABEND-MSG DTSBX522 00633 * PERFORM S999-ABEND THRU S999-EXIT DTSBX522 00634 ** END-IF. DTSBX522 00635 DTSBX522 00636 OPEN OUTPUT ACCT-FILE-INCR. DTSBX522 00637 IF NOT ACCT-I-STATUS-OK-88 DTSBX522 00638 DISPLAY 'BX343 ACCT INCR OPEN ERROR: ' ACCT-I-STATUS DTSBX522 00639 MOVE 'FILE OPEN ERROR' DTSBX522 00640 TO ABEND-MSG DTSBX522 00641 PERFORM S999-ABEND THRU S999-EXIT DTSBX522 00642 END-IF. DTSBX522 00643 DTSBX522 00644 ** OPEN OUTPUT TRAN-FILE. DTSBX522 00645 * IF NOT TRAN-STATUS-OK-88 DTSBX522 00646 * DISPLAY 'BX343 TRAN FILE OPEN ERROR: ' TRAN-STATUS DTSBX522 00647 * MOVE 'FILE OPEN ERROR' DTSBX522 00648 * TO ABEND-MSG DTSBX522 00649 * PERFORM S999-ABEND THRU S999-EXIT DTSBX522 00650 ** END-IF. DTSBX522 00651 DTSBX522 00652 OPEN OUTPUT TRAN-FILE-INCR. DTSBX522 00653 IF NOT TRAN-I-STATUS-OK-88 DTSBX522 00654 DISPLAY 'BX343 TRAN FILE INCR ERROR: ' TRAN-I-STATUS DTSBX522 00655 MOVE 'FILE OPEN ERROR' DTSBX522 00656 TO ABEND-MSG DTSBX522 00657 PERFORM S999-ABEND THRU S999-EXIT DTSBX522 00658 END-IF. DTSBX522 00659 DTSBX522 00660 OPEN OUTPUT QTR-FILE. DTSBX522 00661 IF NOT QTR-STATUS-OK-88 DTSBX522 00662 DISPLAY 'BX343 QTR FILE OPEN ERROR: ' QTR-STATUS DTSBX522 00663 MOVE 'FILE OPEN ERROR' DTSBX522 00664 TO ABEND-MSG DTSBX522 00665 PERFORM S999-ABEND THRU S999-EXIT DTSBX522 00666 END-IF. DTSBX522 00667 DTSBX522 00668 OPEN OUTPUT SUMMARY-FILE. DTSBX522 00669 IF NOT SUMMARY-STATUS-OK-88 DTSBX522 00670 DISPLAY 'BX343 SUMMARY FILE OPEN ERROR: ' DTSBX522 00671 SUMMARY-STATUS DTSBX522 00672 MOVE 'FILE OPEN ERROR' DTSBX522 00673 TO ABEND-MSG DTSBX522 00674 PERFORM S999-ABEND THRU S999-EXIT DTSBX522 00675 END-IF. DTSBX522 00676 DTSBX522 00677 OPEN OUTPUT PAY-DIST-FILE. DTSBX522 00678 IF NOT PAYDIST-STATUS-OK-88 DTSBX522 00679 DISPLAY 'BX343 PAY DIST FILE OPEN ERROR: ' DTSBX522 00680 PAYDIST-STATUS DTSBX522 00681 MOVE 'FILE OPEN ERROR' DTSBX522 00682 TO ABEND-MSG DTSBX522 00683 PERFORM S999-ABEND THRU S999-EXIT DTSBX522 00684 END-IF. DTSBX522 00685 DTSBX522 00686 I2000-EXIT. DTSBX522 00687 EXIT. DTSBX522 00688 DTSBX522 00689 P0000-PROCESS. DTSBX522 00690 PERFORM P0100-INIT-TABLE THRU P0100-EXIT. DTSBX522 00691 DTSBX522 00692 ** PERFORM P1000-QUARTER THRU P1000-EXIT CL*54 00693 PERFORM P2000-ACCTS-RECEIVABLE THRU P2000-EXIT. CL*55 00694 ** PERFORM P3000-TRANSACTION-DETAIL THRU P3000-EXIT. CL*65 00695 ** PERFORM P4000-CORRECTIONS THRU P4000-EXIT. CL*54 00696 ** IF MPRF-TOT-CREDIT-AMT > ZERO DTSBX522 00697 ** PERFORM P5000-PAY-DISTRIBUTION THRU P5000-EXIT. CL*54 00698 ** END-IF. DTSBX522 00699 DTSBX522 00700 P0000-EXIT. DTSBX522 00701 EXIT. DTSBX522 00702 DTSBX522 00703 P0100-INIT-TABLE. DTSBX522 00704 PERFORM DTSBX522 00705 VARYING QSUB FROM +1 BY +1 DTSBX522 00706 UNTIL QSUB > QMAX DTSBX522 00707 SET TBL-JRN-GOOD-88 (QSUB) TO TRUE DTSBX522 00708 MOVE +0 TO TBL-YRQ (QSUB) DTSBX522 00709 Q-UI-CHG (QSUB) DTSBX522 00710 Q-UI-PD (QSUB) DTSBX522 00711 Q-UI-WV (QSUB) DTSBX522 00712 Q-UI-WO (QSUB) DTSBX522 00713 Q-UI-TL (QSUB) DTSBX522 00714 Q-UI-BAL (QSUB) DTSBX522 00715 J-UI-CHG (QSUB) DTSBX522 00716 J-UI-PD (QSUB) DTSBX522 00717 J-UI-WV (QSUB) DTSBX522 00718 J-UI-WO (QSUB) DTSBX522 00719 J-UI-TL (QSUB) DTSBX522 00720 Q-INT-CHG (QSUB) DTSBX522 00721 Q-INT-PD (QSUB) DTSBX522 00722 Q-INT-WV (QSUB) DTSBX522 00723 Q-INT-WO (QSUB) DTSBX522 00724 Q-INT-TL (QSUB) DTSBX522 00725 Q-INT-BAL (QSUB) DTSBX522 00726 J-INT-CHG (QSUB) DTSBX522 00727 J-INT-PD (QSUB) DTSBX522 00728 J-INT-WV (QSUB) DTSBX522 00729 J-INT-WO (QSUB) DTSBX522 00730 J-INT-TL (QSUB) DTSBX522 00731 Q-LP-CHG (QSUB) DTSBX522 00732 Q-LP-PD (QSUB) DTSBX522 00733 Q-LP-WV (QSUB) DTSBX522 00734 Q-LP-WO (QSUB) DTSBX522 00735 Q-LP-TL (QSUB) DTSBX522 00736 Q-LP-BAL (QSUB) DTSBX522 00737 J-LP-CHG (QSUB) DTSBX522 00738 J-LP-PD (QSUB) DTSBX522 00739 J-LP-WV (QSUB) DTSBX522 00740 J-LP-WO (QSUB) DTSBX522 00741 J-LP-TL (QSUB) DTSBX522 00742 Q-NP-CHG (QSUB) DTSBX522 00743 Q-NP-PD (QSUB) DTSBX522 00744 Q-NP-WV (QSUB) DTSBX522 00745 Q-NP-WO (QSUB) DTSBX522 00746 Q-NP-TL (QSUB) DTSBX522 00747 Q-NP-BAL (QSUB) DTSBX522 00748 J-NP-CHG (QSUB) DTSBX522 00749 J-NP-PD (QSUB) DTSBX522 00750 J-NP-WV (QSUB) DTSBX522 00751 J-NP-WO (QSUB) DTSBX522 00752 J-NP-TL (QSUB) DTSBX522 00753 Q-MP-CHG (QSUB) DTSBX522 00754 Q-MP-PD (QSUB) DTSBX522 00755 Q-MP-WV (QSUB) DTSBX522 00756 Q-MP-WO (QSUB) DTSBX522 00757 Q-MP-TL (QSUB) DTSBX522 00758 Q-MP-BAL (QSUB) DTSBX522 00759 J-MP-CHG (QSUB) DTSBX522 00760 J-MP-PD (QSUB) DTSBX522 00761 J-MP-WV (QSUB) DTSBX522 00762 J-MP-WO (QSUB) DTSBX522 00763 J-MP-TL (QSUB) DTSBX522 00764 Q-SU-CHG (QSUB) DTSBX522 00765 Q-SU-PD (QSUB) DTSBX522 00766 Q-SU-WV (QSUB) DTSBX522 00767 Q-SU-WO (QSUB) DTSBX522 00768 Q-SU-TL (QSUB) DTSBX522 00769 Q-SU-BAL (QSUB) DTSBX522 00770 J-SU-CHG (QSUB) DTSBX522 00771 J-SU-PD (QSUB) DTSBX522 00772 J-SU-WV (QSUB) DTSBX522 00773 J-SU-WO (QSUB) DTSBX522 00774 J-SU-TL (QSUB) DTSBX522 00775 END-PERFORM. DTSBX522 00776 DTSBX522 00777 P0100-EXIT. DTSBX522 00778 EXIT. DTSBX522 00779 DTSBX522 00780 P1000-QUARTER. DTSBX522 00781 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBX522 00782 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBX522 00783 SET MQTR-QTR-88 TO TRUE. DTSBX522 00784 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBX522 00785 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX522 00786 PERFORM UNTIL L910-NO-REC-88 DTSBX522 00787 MOVE MSKL-REC TO MQTR-REC DTSBX522 00788 PERFORM P1100-SAVE-QTR THRU P1100-EXIT DTSBX522 00789 PERFORM P1200-BUILD-QTR THRU P1200-EXIT DTSBX522 00790 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX522 00791 END-PERFORM. DTSBX522 00792 DTSBX522 00793 P1000-EXIT. DTSBX522 00794 EXIT. DTSBX522 00795 DTSBX522 00796 P1100-SAVE-QTR. DTSBX522 00797 MOVE MQTR-YRQ TO L004-QTR-5-9. DTSBX522 00798 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBX522 00799 MOVE L004-ABS-QTR TO QSUB. DTSBX522 00800 DTSBX522 00801 MOVE MQTR-YRQ TO TBL-YRQ (QSUB). DTSBX522 00802 DTSBX522 00803 SET W-UI-CHARGE-NO-88 TO TRUE. DTSBX522 00804 SET W-LP-CHARGE-NO-88 TO TRUE. DTSBX522 00805 DTSBX522 00806 PERFORM DTSBX522 00807 VARYING MQTR-ACCT-IDX FROM +1 BY +1 DTSBX522 00808 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSBX522 00809 PERFORM P1105-GET-AMTS THRU P1105-EXIT DTSBX522 00810 EVALUATE TRUE DTSBX522 00811 WHEN MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSBX522 00812 PERFORM P1110-TABLE-UI THRU P1110-EXIT DTSBX522 00813 DTSBX522 00814 WHEN MQTR-ACCT-INT-88 (MQTR-ACCT-IDX) DTSBX522 00815 PERFORM P1111-TABLE-INT THRU P1111-EXIT DTSBX522 00816 DTSBX522 00817 WHEN MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX) DTSBX522 00818 PERFORM P1112-TABLE-LP THRU P1112-EXIT DTSBX522 00819 DTSBX522 00820 WHEN MQTR-ACCT-MISC-PEN-88 (MQTR-ACCT-IDX) DTSBX522 00821 PERFORM P1113-TABLE-MP THRU P1113-EXIT DTSBX522 00822 DTSBX522 00823 WHEN MQTR-ACCT-NSF-PEN-88 (MQTR-ACCT-IDX) DTSBX522 00824 PERFORM P1114-TABLE-NP THRU P1114-EXIT DTSBX522 00825 DTSBX522 00826 WHEN MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) DTSBX522 00827 PERFORM P1115-TABLE-SU THRU P1115-EXIT DTSBX522 00828 DTSBX522 00829 END-EVALUATE DTSBX522 00830 END-PERFORM. DTSBX522 00831 DTSBX522 00832 IF MQTR-YRQ < 20001 DTSBX522 00833 IF W-UI-CHARGE-NO-88 DTSBX522 00834 AND W-LP-CHARGE-NO-88 DTSBX522 00835 SET TBL-JRN-BAD-88 (QSUB) TO TRUE DTSBX522 00836 END-IF DTSBX522 00837 END-IF. DTSBX522 00838 DTSBX522 00839 * IF MQTR-EMP-NO = 030450 DTSBX522 00840 * IF MQTR-YRQ > 20041 DTSBX522 00841 * IF W-UI-BAL NOT = ZERO DTSBX522 00842 * OR W-LP-BAL NOT = ZERO DTSBX522 00843 * OR W-NP-BAL NOT = ZERO DTSBX522 00844 * OR W-INT-BAL NOT = ZERO DTSBX522 00845 * DISPLAY 'P1100 ' MPRF-EMP-NO ' ' MQTR-YRQ. DTSBX522 00846 DTSBX522 00847 DTSBX522 00848 P1100-EXIT. DTSBX522 00849 EXIT. DTSBX522 00850 DTSBX522 00851 P1105-GET-AMTS. DTSBX522 00852 MOVE MQTR-CHARGED-AMT (MQTR-ACCT-IDX) TO W-CHG. DTSBX522 00853 MOVE MQTR-PAID-AMT (MQTR-ACCT-IDX) TO W-PD. DTSBX522 00854 MOVE MQTR-WAIVED-AMT (MQTR-ACCT-IDX) TO W-WV. DTSBX522 00855 MOVE MQTR-WRITTEN-OFF-AMT (MQTR-ACCT-IDX) TO W-WO. DTSBX522 00856 MOVE MQTR-TOLER-AMT (MQTR-ACCT-IDX) TO W-TL. DTSBX522 00857 MOVE MQTR-BALANCE-AMT (MQTR-ACCT-IDX) TO W-BAL. DTSBX522 00858 DTSBX522 00859 P1105-EXIT. DTSBX522 00860 EXIT. DTSBX522 00861 DTSBX522 00862 P1110-TABLE-UI. DTSBX522 00863 IF W-CHG > ZERO DTSBX522 00864 SET W-UI-CHARGE-YES-88 TO TRUE DTSBX522 00865 END-IF. DTSBX522 00866 DTSBX522 00867 ADD W-CHG TO Q-UI-CHG (QSUB). DTSBX522 00868 ADD W-PD TO Q-UI-PD (QSUB). DTSBX522 00869 ADD W-WV TO Q-UI-WV (QSUB). DTSBX522 00870 ADD W-WO TO Q-UI-WO (QSUB). DTSBX522 00871 ADD W-TL TO Q-UI-TL (QSUB). DTSBX522 00872 ADD W-BAL TO Q-UI-BAL (QSUB). DTSBX522 00873 DTSBX522 00874 ** IF MPRF-EMP-NO = 062362 OR 073765 DTSBX522 00875 * MOVE Q-UI-BAL (QSUB) TO DISPLAY-AMT1 DTSBX522 00876 * DISPLAY 'P1110 ' MPRF-EMP-NO ' ' MQTR-YRQ DTSBX522 00877 * ' UI ' DISPLAY-AMT1 DTSBX522 00878 ** END-IF. DTSBX522 00879 DTSBX522 00880 P1110-EXIT. DTSBX522 00881 EXIT. DTSBX522 00882 DTSBX522 00883 P1111-TABLE-INT. DTSBX522 00884 ADD W-CHG TO Q-INT-CHG (QSUB). DTSBX522 00885 ADD W-PD TO Q-INT-PD (QSUB). DTSBX522 00886 ADD W-WV TO Q-INT-WV (QSUB). DTSBX522 00887 ADD W-WO TO Q-INT-WO (QSUB). DTSBX522 00888 ADD W-TL TO Q-INT-TL (QSUB). DTSBX522 00889 ADD W-BAL TO Q-INT-BAL (QSUB). DTSBX522 00890 DTSBX522 00891 P1111-EXIT. DTSBX522 00892 EXIT. DTSBX522 00893 DTSBX522 00894 P1112-TABLE-LP. DTSBX522 00895 IF W-CHG > ZERO DTSBX522 00896 SET W-LP-CHARGE-YES-88 TO TRUE DTSBX522 00897 END-IF. DTSBX522 00898 DTSBX522 00899 ADD W-CHG TO Q-LP-CHG (QSUB). DTSBX522 00900 ADD W-PD TO Q-LP-PD (QSUB). DTSBX522 00901 ADD W-WV TO Q-LP-WV (QSUB). DTSBX522 00902 ADD W-WO TO Q-LP-WO (QSUB). DTSBX522 00903 ADD W-TL TO Q-LP-TL (QSUB). DTSBX522 00904 ADD W-BAL TO Q-LP-BAL (QSUB). DTSBX522 00905 DTSBX522 00906 ** IF MPRF-EMP-NO = 137540 DTSBX522 00907 * MOVE Q-LP-BAL (QSUB) TO DISPLAY-AMT2 DTSBX522 00908 * DISPLAY 'P1112 ' MPRF-EMP-NO ' ' MQTR-YRQ DTSBX522 00909 * ' PEN ' DISPLAY-AMT2 DTSBX522 00910 ** END-IF. DTSBX522 00911 DTSBX522 00912 P1112-EXIT. DTSBX522 00913 EXIT. DTSBX522 00914 DTSBX522 00915 P1113-TABLE-MP. DTSBX522 00916 ADD W-CHG TO Q-MP-CHG (QSUB). DTSBX522 00917 ADD W-PD TO Q-MP-PD (QSUB). DTSBX522 00918 ADD W-WV TO Q-MP-WV (QSUB). DTSBX522 00919 ADD W-WO TO Q-MP-WO (QSUB). DTSBX522 00920 ADD W-TL TO Q-MP-TL (QSUB). DTSBX522 00921 ADD W-BAL TO Q-MP-BAL (QSUB). DTSBX522 00922 DTSBX522 00923 P1113-EXIT. DTSBX522 00924 EXIT. DTSBX522 00925 DTSBX522 00926 P1114-TABLE-NP. DTSBX522 00927 ADD W-CHG TO Q-NP-CHG (QSUB). DTSBX522 00928 ADD W-PD TO Q-NP-PD (QSUB). DTSBX522 00929 ADD W-WV TO Q-NP-WV (QSUB). DTSBX522 00930 ADD W-WO TO Q-NP-WO (QSUB). DTSBX522 00931 ADD W-TL TO Q-NP-TL (QSUB). DTSBX522 00932 ADD W-BAL TO Q-NP-BAL (QSUB). DTSBX522 00933 DTSBX522 00934 P1114-EXIT. DTSBX522 00935 EXIT. DTSBX522 00936 DTSBX522 00937 P1115-TABLE-SU. DTSBX522 00938 ADD W-CHG TO Q-SU-CHG (QSUB). DTSBX522 00939 ADD W-PD TO Q-SU-PD (QSUB). DTSBX522 00940 ADD W-WV TO Q-SU-WV (QSUB). DTSBX522 00941 ADD W-WO TO Q-SU-WO (QSUB). DTSBX522 00942 ADD W-TL TO Q-SU-TL (QSUB). DTSBX522 00943 ADD W-BAL TO Q-SU-BAL (QSUB). DTSBX522 00944 DTSBX522 00945 P1115-EXIT. DTSBX522 00946 EXIT. DTSBX522 00947 DTSBX522 00948 DTSBX522 00949 P1200-BUILD-QTR. DTSBX522 00950 MOVE MQTR-YRQ TO L004-QTR-5-9. DTSBX522 00951 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBX522 00952 MOVE L004-ABS-QTR TO LX34-SUB. DTSBX522 00953 IF LX34-QTR-EXISTS-YES-88 (LX34-SUB) DTSBX522 00954 GO TO P1200-EXIT DTSBX522 00955 ELSE DTSBX522 00956 SET LX34-QTR-EXISTS-YES-88 (LX34-SUB) TO TRUE DTSBX522 00957 END-IF. DTSBX522 00958 DTSBX522 00959 MOVE ZERO TO W-QTR-BAL. DTSBX522 00960 IF MPRF-TOT-BALANCE-AMT > ZERO DTSBX522 00961 AND MQTR-TAX-DUE-DATE < LX34-CURR-RUN-DATE DTSBX522 00962 PERFORM P1210-BAL-DUE THRU P1210-EXIT DTSBX522 00963 END-IF. DTSBX522 00964 DTSBX522 00965 MOVE MQTR-EMP-NO TO QTR-EMP-NO. DTSBX522 00966 MOVE MQTR-YRQ TO L004-QTR-5-9. DTSBX522 00967 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBX522 00968 IF L004-VALID-QTR DTSBX522 00969 MOVE L004-SLASH-5-QTR TO QTR-QUARTER DTSBX522 00970 ELSE DTSBX522 00971 GO TO P1200-EXIT DTSBX522 00972 END-IF. DTSBX522 00973 MOVE MQTR-CURR-RPT-TYPE TO QTR-RPT-STATUS. DTSBX522 00974 MOVE MQTR-RPT-DUE-DATE TO L001-FED-8-DATE-9. DTSBX522 00975 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX522 00976 MOVE L001-SLASH-8-DATE TO QTR-RPT-DUE-DT. DTSBX522 00977 MOVE MQTR-TAX-DUE-DATE TO L001-FED-8-DATE-9. DTSBX522 00978 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX522 00979 MOVE L001-SLASH-8-DATE TO QTR-TAX-DUE-DT. DTSBX522 00980 MOVE W-QTR-BAL TO QTR-BAL-DUE. DTSBX522 00981 DTSBX522 00982 MOVE MQTR-ESTB-DATE TO L001-FED-8-DATE-9. DTSBX522 00983 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX522 00984 IF L001-VALID-DATE DTSBX522 00985 MOVE L001-SLASH-8-DATE TO QTR-PROCESS-DT DTSBX522 00986 ELSE DTSBX522 00987 MOVE W-DEFAULT-DATE TO QTR-PROCESS-DT DTSBX522 00988 END-IF. DTSBX522 00989 DTSBX522 00990 IF QTR-PROCESS-DT = W-DEFAULT-DATE DTSBX522 00991 MOVE MQTR-CHNG-DATE TO L001-FED-8-DATE-9 DTSBX522 00992 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBX522 00993 IF L001-VALID-DATE DTSBX522 00994 MOVE L001-SLASH-8-DATE TO QTR-PROCESS-DT DTSBX522 00995 END-IF DTSBX522 00996 END-IF. DTSBX522 00997 DTSBX522 00998 WRITE QTR-REC FROM W-QTR-REC DTSBX522 00999 IF NOT QTR-STATUS-OK-88 DTSBX522 01000 DISPLAY 'CANNOT WRITE TO QTR FILE ' DTSBX522 01001 ' ' QTR-STATUS ' ' QTR-EMP-NO DTSBX522 01002 ELSE DTSBX522 01003 ADD +1 TO W-QTR-CNT DTSBX522 01004 END-IF. DTSBX522 01005 DTSBX522 01006 P1200-EXIT. DTSBX522 01007 EXIT. DTSBX522 01008 DTSBX522 01009 P1210-BAL-DUE. DTSBX522 01010 PERFORM DTSBX522 01011 VARYING MQTR-ACCT-IDX FROM +1 BY +1 DTSBX522 01012 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSBX522 01013 IF MPRF-CLASS-SELF-INS-88 DTSBX522 01014 AND MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) DTSBX522 01015 CONTINUE DTSBX522 01016 ELSE DTSBX522 01017 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBX522 01018 TO W-QTR-BAL DTSBX522 01019 END-IF DTSBX522 01020 END-PERFORM. DTSBX522 01021 DTSBX522 01022 P1210-EXIT. DTSBX522 01023 EXIT. DTSBX522 01024 DTSBX522 01025 DTSBX522 01026 P2000-ACCTS-RECEIVABLE. DTSBX522 01027 MOVE ZERO TO W-TOT-CREDIT. DTSBX522 01028 DTSBX522 01029 MOVE LOW-VALUES TO MJRN-KEY-AREA. DTSBX522 01030 MOVE MPRF-EMP-NO TO MJRN-EMP-NO. DTSBX522 01031 SET MJRN-JRN-88 TO TRUE. DTSBX522 01032 MOVE MJRN-KEY-AREA TO MSKL-KEY-AREA. DTSBX522 01033 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX522 01034 PERFORM UNTIL L910-NO-REC-88 DTSBX522 01035 MOVE MSKL-REC TO MJRN-REC DTSBX522 01036 ADD +1 TO W-MJRN-READ-CNT DTSBX522 01037 IF NOT MJRN-TRAN-CNVR-88 DTSBX522 01038 PERFORM P2100-BUILD-ACCT THRU P2100-EXIT DTSBX522 01039 END-IF DTSBX522 01040 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX522 01041 END-PERFORM. DTSBX522 01042 DTSBX522 01043 ** MOVE MPRF-TOT-CREDIT-AMT TO DISPLAY-AMT1. DTSBX522 01044 ** MOVE W-TOT-CREDIT TO DISPLAY-AMT2. DTSBX522 01045 IF W-TOT-CREDIT NOT = MPRF-TOT-CREDIT-AMT DTSBX522 01046 * PERFORM P2010-CORRECT-CR THRU P2010-EXIT CL*68 01047 ** DISPLAY 'CREDIT ' MPRF-EMP-NO DTSBX522 01048 ** ' MPRF ' DISPLAY-AMT1 DTSBX522 01049 ** ' ' DISPLAY-AMT2 DTSBX522 01050 END-IF. DTSBX522 01051 P2000-EXIT. DTSBX522 01052 EXIT. DTSBX522 01053 DTSBX522 01054 P2010-CORRECT-CR. DTSBX522 01055 PERFORM S1000-CORRECTION-BATCH THRU S1000-EXIT. DTSBX522 01056 MOVE W-JC-BATCH TO ACCT-BATCH DTSBX522 01057 MOVE W-JC-ITEM TO ACCT-ITEM. DTSBX522 01058 DTSBX522 01059 MOVE MPRF-EMP-NO TO ACCT-EMP-NO. DTSBX522 01060 MOVE SPACES TO ACCT-YRQ. DTSBX522 01061 MOVE 'CR' TO ACCT-ROW. DTSBX522 01062 MOVE 'PD' TO ACCT-COL. DTSBX522 01063 COMPUTE W-CREDIT-CORRECT = DTSBX522 01064 (MPRF-TOT-CREDIT-AMT - W-TOT-CREDIT). DTSBX522 01065 MOVE W-CREDIT-CORRECT TO ACCT-AMT. DTSBX522 01066 MOVE 'JC' TO ACCT-TRAN DTSBX522 01067 MOVE 'B' TO ACCT-CAT. DTSBX522 01068 MOVE W-DEFAULT-DATE TO ACCT-RCVD-DT DTSBX522 01069 ACCT-PROCESS-DT. DTSBX522 01070 DTSBX522 01071 SET ACCT-SOURCE-CR-DB-88 TO TRUE. DTSBX522 01072 DTSBX522 01073 ** WRITE ACCT-REC FROM W-ACCT-REC DTSBX522 01074 * IF NOT ACCT-STATUS-OK-88 DTSBX522 01075 * DISPLAY 'CANNOT WRITE TO ACCT FILE ' DTSBX522 01076 * ' ' ACCT-STATUS ' ' ACCT-EMP-NO DTSBX522 01077 * ELSE DTSBX522 01078 * ADD +1 TO W-ACCT-CNT DTSBX522 01079 * ADD +1 TO W-CR-CNT DTSBX522 01080 ** END-IF. DTSBX522 01081 DTSBX522 01082 P2010-EXIT. DTSBX522 01083 EXIT. DTSBX522 01084 DTSBX522 01085 P2100-BUILD-ACCT. DTSBX522 01086 PERFORM DTSBX522 01087 VARYING MJRN-OCC-IDX FROM +1 BY +1 DTSBX522 01088 UNTIL MJRN-OCC-IDX > MJRN-OCC-CNT DTSBX522 01089 IF MJRN-ROW-CREDIT-88 (MJRN-OCC-IDX) DTSBX522 01090 ADD MJRN-AMT (MJRN-OCC-IDX) TO W-TOT-CREDIT DTSBX522 01091 PERFORM P2110-WRITE-ACCT THRU P2110-EXIT DTSBX522 01092 ELSE DTSBX522 01093 MOVE MJRN-YRQ (MJRN-OCC-IDX) TO L004-QTR-5-9 DTSBX522 01094 PERFORM S004-FROM-5 THRU S004-EXIT DTSBX522 01095 MOVE L004-SLASH-5-QTR TO ACCT-YRQ DTSBX522 01096 MOVE L004-ABS-QTR TO QSUB DTSBX522 01097 IF TBL-JRN-GOOD-88 (QSUB) DTSBX522 01098 PERFORM P2110-WRITE-ACCT THRU P2110-EXIT DTSBX522 01099 * PERFORM P2120-SAVE-JRN THRU P2120-EXIT CL*68 01100 END-IF DTSBX522 01101 END-IF DTSBX522 01102 END-PERFORM. DTSBX522 01103 DTSBX522 01104 P2100-EXIT. DTSBX522 01105 EXIT. DTSBX522 01106 DTSBX522 01107 P2110-WRITE-ACCT. DTSBX522 01108 IF MJRN-YRQ (MJRN-OCC-IDX) = 99999 DTSBX522 01109 MOVE SPACES TO ACCT-YRQ DTSBX522 01110 ELSE DTSBX522 01111 MOVE MJRN-YRQ (MJRN-OCC-IDX) TO L004-QTR-5-9 DTSBX522 01112 PERFORM S004-FROM-5 THRU S004-EXIT DTSBX522 01113 MOVE L004-SLASH-5-QTR TO ACCT-YRQ DTSBX522 01114 END-IF. DTSBX522 01115 DTSBX522 01116 MOVE MJRN-BATCH-NO TO ACCT-BATCH. DTSBX522 01117 MOVE MJRN-ITEM-NO TO ACCT-ITEM. DTSBX522 01118 MOVE MPRF-EMP-NO TO ACCT-EMP-NO. DTSBX522 01119 MOVE MJRN-TRAN-TYPE TO ACCT-TRAN. DTSBX522 01120 MOVE MJRN-ACCT-ROW (MJRN-OCC-IDX) TO ACCT-ROW. DTSBX522 01121 MOVE MJRN-ACCT-COL (MJRN-OCC-IDX) TO ACCT-COL. DTSBX522 01122 IF ACCT-ROW = 'CR' DTSBX522 01123 MOVE MJRN-AMT (MJRN-OCC-IDX) TO ACCT-AMT DTSBX522 01124 MOVE ZEROS TO ACCT-PAYMENT-ID CL*37 01125 ELSE DTSBX522 01126 IF ACCT-COL NOT = 'CH' DTSBX522 01127 COMPUTE ACCT-AMT = DTSBX522 01128 (MJRN-AMT (MJRN-OCC-IDX) * -1) DTSBX522 01129 ELSE DTSBX522 01130 MOVE MJRN-AMT (MJRN-OCC-IDX) TO ACCT-AMT DTSBX522 01131 MOVE ZEROS TO ACCT-PAYMENT-ID CL*37 01132 END-IF DTSBX522 01133 END-IF. DTSBX522 01134 DTSBX522 01135 MOVE MJRN-TRAN-CATEGORY TO ACCT-CAT. DTSBX522 01136 MOVE MJRN-ESTB-DATE TO L001-FED-8-DATE-9. DTSBX522 01137 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX522 01138 IF L001-VALID-DATE DTSBX522 01139 MOVE L001-SLASH-8-DATE TO ACCT-PROCESS-DT DTSBX522 01140 ELSE DTSBX522 01141 MOVE LX34-SYS-DATE TO ACCT-PROCESS-DT DTSBX522 01142 END-IF. DTSBX522 01143 MOVE MJRN-RECEIVED-DATE TO L001-FED-8-DATE-9. DTSBX522 01144 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX522 01145 IF L001-VALID-DATE DTSBX522 01146 MOVE L001-SLASH-8-DATE TO ACCT-RCVD-DT DTSBX522 01147 ELSE DTSBX522 01148 MOVE LX34-SYS-DATE TO ACCT-RCVD-DT DTSBX522 01149 END-IF. DTSBX522 01150 SET ACCT-SOURCE-CR-DB-88 TO TRUE. DTSBX522 01151 CL*25 01152 ** WRITE ACCT-REC FROM W-ACCT-REC DTSBX522 01153 * IF NOT ACCT-STATUS-OK-88 DTSBX522 01154 * DISPLAY 'CANNOT WRITE TO ACCT FILE ' DTSBX522 01155 * ' ' ACCT-STATUS ' ' ACCT-EMP-NO DTSBX522 01156 * ELSE DTSBX522 01157 * ADD +1 TO W-ACCT-CNT DTSBX522 01158 ** END-IF. DTSBX522 01159 DTSBX522 01160 *** SELECT ONLY JOURNAL ENTRIES FROM MOST RECENT DATE. *** DTSBX522 01161 IF MJRN-ESTB-DATE = LX34-PRIOR-RUN-DATE DTSBX522 01162 DISPLAY 'MJRN-KEY ' MSKL-KEY-AREA CL*56 01163 MOVE MSKL-KEY-AREA TO WK-JRN-HOLD-KEY-AREA CL*57 01164 * PERFORM P2101-PAYMENT-ID THRU P2101-EXIT CL*68 01165 MOVE WK-JRN-HOLD-KEY-AREA TO MSKL-KEY-AREA CL*57 01166 DISPLAY 'MPAY-TRACE-ID ' MPAY-TRACE-NO CL*32 01167 DISPLAY 'MJRN-EMP-NO ' MJRN-EMP-NO CL*32 01168 WRITE ACCT-INCR-REC FROM W-ACCT-REC DTSBX522 01169 IF NOT ACCT-I-STATUS-OK-88 DTSBX522 01170 DISPLAY 'CANNOT WRITE TO ACCT FILE INCR ' DTSBX522 01171 ' ' ACCT-I-STATUS ' ' ACCT-EMP-NO DTSBX522 01172 ELSE DTSBX522 01173 ADD +1 TO W-ACCT-CNT-INCR DTSBX522 01174 END-IF DTSBX522 01175 END-IF. DTSBX522 01176 DTSBX522 01177 ** IF MPRF-EMP-NO = 156293 DTSBX522 01178 * DISPLAY 'P2110 ' MPRF-EMP-NO ' ' ACCT-YRQ DTSBX522 01179 * ' ' ACCT-BATCH '/' ACCT-ITEM DTSBX522 01180 * DISPLAY ' ' ACCT-ROW ' ' ACCT-COL DTSBX522 01181 * ' ' ACCT-TRAN ' ' ACCT-AMT DTSBX522 01182 ** END-IF. DTSBX522 01183 DTSBX522 01184 P2110-EXIT. DTSBX522 01185 EXIT. DTSBX522 01186 CL*40 01187 P2101-PAYMENT-ID. CL*40 01188 MOVE LOW-VALUES TO MSKL-KEY-AREA. CL*59 01189 MOVE MJRN-BATCH-NO TO MPAY-BATCH-NO, CL*40 01190 MOVE MJRN-ITEM-NO TO MPAY-ITEM-NO. CL*40 01191 MOVE MPRF-EMP-NO TO MPAY-EMP-NO. CL*40 01192 CL*40 01193 SET MPAY-PAY-88 TO TRUE. CL*40 01194 CL*40 01195 MOVE MPAY-KEY-AREA TO MSKL-KEY-AREA. CL*40 01196 CL*40 01197 PERFORM S910-READ THRU S910-EXIT. CL*50 01198 CL*52 01199 IF L910-OK-88 CL*52 01200 MOVE MSKL-REC TO MPAY-REC CL*59 01201 MOVE MPAY-TRACE-NO TO ACCT-PAYMENT-ID CL*59 01202 ELSE CL*52 01203 DISPLAY 'MPAY TRACE NO NOT FOUND ' CL*53 01204 DISPLAY 'MPAY-BATCH-NO ' MPAY-BATCH-NO CL*59 01205 DISPLAY 'MPAY-ITEM-NO ' MPAY-ITEM-NO CL*59 01206 DISPLAY 'MPAY-EMP-NO ' MPAY-EMP-NO CL*59 01207 MOVE ZEROS TO ACCT-PAYMENT-ID CL*52 01208 END-IF. CL*52 01209 CL*52 01210 P2101-EXIT. CL*40 01211 EXIT. CL*40 01212 CL*40 01213 P2120-SAVE-JRN. DTSBX522 01214 MOVE MJRN-YRQ (MJRN-OCC-IDX) TO L004-QTR-5-9. DTSBX522 01215 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBX522 01216 IF L004-INVALID-QTR DTSBX522 01217 GO TO P2120-EXIT DTSBX522 01218 ELSE DTSBX522 01219 MOVE L004-ABS-QTR TO QSUB DTSBX522 01220 IF TBL-YRQ (QSUB) = ZERO DTSBX522 01221 MOVE L004-QTR-5-9 TO TBL-YRQ (QSUB) DTSBX522 01222 END-IF DTSBX522 01223 END-IF. DTSBX522 01224 DTSBX522 01225 EVALUATE TRUE DTSBX522 01226 WHEN MJRN-ACCT-ROW (MJRN-OCC-IDX) = 'UI' DTSBX522 01227 PERFORM P2121-TABLE-UI THRU P2121-EXIT DTSBX522 01228 DTSBX522 01229 WHEN MJRN-ACCT-ROW (MJRN-OCC-IDX) = 'LP' DTSBX522 01230 PERFORM P2122-TABLE-LP THRU P2122-EXIT DTSBX522 01231 DTSBX522 01232 WHEN MJRN-ACCT-ROW (MJRN-OCC-IDX) = 'NP' DTSBX522 01233 PERFORM P2123-TABLE-NP THRU P2123-EXIT DTSBX522 01234 DTSBX522 01235 WHEN MJRN-ACCT-ROW (MJRN-OCC-IDX) = 'MP' DTSBX522 01236 PERFORM P2124-TABLE-MP THRU P2124-EXIT DTSBX522 01237 DTSBX522 01238 WHEN MJRN-ACCT-ROW (MJRN-OCC-IDX) = 'I ' DTSBX522 01239 PERFORM P2125-TABLE-INT THRU P2125-EXIT DTSBX522 01240 DTSBX522 01241 WHEN MJRN-ACCT-ROW (MJRN-OCC-IDX) = 'SU' DTSBX522 01242 PERFORM P2126-TABLE-SU THRU P2126-EXIT DTSBX522 01243 DTSBX522 01244 END-EVALUATE. DTSBX522 01245 DTSBX522 01246 ** IF MJRN-EMP-NO = 062362 OR 073765 DTSBX522 01247 * MOVE J-UI-CHG (QSUB) TO DISPLAY-AMT1 DTSBX522 01248 * MOVE Q-UI-CHG (QSUB) TO DISPLAY-AMT2 DTSBX522 01249 * MOVE J-UI-PD (QSUB) TO DISPLAY-AMT3 DTSBX522 01250 * MOVE Q-UI-PD (QSUB) TO DISPLAY-AMT4 DTSBX522 01251 * DISPLAY 'P2121 ' MPRF-EMP-NO ' ' L004-QTR-5-9 DTSBX522 01252 * ' ' MJRN-ACCT-COL (MJRN-OCC-IDX) DTSBX522 01253 * ' Q CHG ' DISPLAY-AMT2 DTSBX522 01254 * ' J CHG ' DISPLAY-AMT1 DTSBX522 01255 * ' Q PD ' DISPLAY-AMT4 DTSBX522 01256 * ' J PD ' DISPLAY-AMT3 DTSBX522 01257 ** END-IF. DTSBX522 01258 P2120-EXIT. DTSBX522 01259 EXIT. DTSBX522 01260 DTSBX522 01261 P2121-TABLE-UI. DTSBX522 01262 EVALUATE TRUE DTSBX522 01263 WHEN MJRN-COL-CHARGED-88 (MJRN-OCC-IDX) DTSBX522 01264 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-UI-CHG (QSUB) DTSBX522 01265 WHEN MJRN-COL-PAID-88 (MJRN-OCC-IDX) DTSBX522 01266 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-UI-PD (QSUB) DTSBX522 01267 WHEN MJRN-COL-WAIVED-88 (MJRN-OCC-IDX) DTSBX522 01268 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-UI-WV (QSUB) DTSBX522 01269 WHEN MJRN-COL-WRITTEN-OFF-88 (MJRN-OCC-IDX) DTSBX522 01270 ADD MJRN-AMT (MJRN-OCC-IDX) DTSBX522 01271 TO J-UI-WO (QSUB) DTSBX522 01272 WHEN MJRN-COL-TOLERATED-88 (MJRN-OCC-IDX) DTSBX522 01273 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-UI-TL (QSUB) DTSBX522 01274 END-EVALUATE. DTSBX522 01275 DTSBX522 01276 ** IF MPRF-EMP-NO = 137540 DTSBX522 01277 * MOVE J-UI-CHG (QSUB) TO DISPLAY-AMT1 DTSBX522 01278 * MOVE J-UI-PD (QSUB) TO DISPLAY-AMT2 DTSBX522 01279 * DISPLAY 'P2121 ' MPRF-EMP-NO DTSBX522 01280 * ' ' MJRN-YRQ (MJRN-OCC-IDX) DTSBX522 01281 * ' UI CH ' DISPLAY-AMT1 DTSBX522 01282 * ' UI PD ' DISPLAY-AMT2 DTSBX522 01283 ** END-IF. DTSBX522 01284 P2121-EXIT. DTSBX522 01285 EXIT. DTSBX522 01286 DTSBX522 01287 P2122-TABLE-LP. DTSBX522 01288 EVALUATE TRUE DTSBX522 01289 WHEN MJRN-COL-CHARGED-88 (MJRN-OCC-IDX) DTSBX522 01290 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-LP-CHG (QSUB) DTSBX522 01291 WHEN MJRN-COL-PAID-88 (MJRN-OCC-IDX) DTSBX522 01292 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-LP-PD (QSUB) DTSBX522 01293 WHEN MJRN-COL-WAIVED-88 (MJRN-OCC-IDX) DTSBX522 01294 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-LP-WV (QSUB) DTSBX522 01295 WHEN MJRN-COL-WRITTEN-OFF-88 (MJRN-OCC-IDX) DTSBX522 01296 ADD MJRN-AMT (MJRN-OCC-IDX) DTSBX522 01297 TO J-LP-WO (QSUB) DTSBX522 01298 WHEN MJRN-COL-TOLERATED-88 (MJRN-OCC-IDX) DTSBX522 01299 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-LP-TL (QSUB) DTSBX522 01300 END-EVALUATE. DTSBX522 01301 DTSBX522 01302 ** IF MPRF-EMP-NO = 137540 DTSBX522 01303 * MOVE J-LP-CHG (QSUB) TO DISPLAY-AMT1 DTSBX522 01304 * MOVE J-LP-PD (QSUB) TO DISPLAY-AMT2 DTSBX522 01305 * DISPLAY 'P2122 ' MPRF-EMP-NO DTSBX522 01306 * ' ' MJRN-YRQ (MJRN-OCC-IDX) DTSBX522 01307 * ' LP CH ' DISPLAY-AMT1 DTSBX522 01308 * ' LP PD ' DISPLAY-AMT2 DTSBX522 01309 ** END-IF. DTSBX522 01310 P2122-EXIT. DTSBX522 01311 EXIT. DTSBX522 01312 DTSBX522 01313 P2123-TABLE-NP. DTSBX522 01314 EVALUATE TRUE DTSBX522 01315 WHEN MJRN-COL-CHARGED-88 (MJRN-OCC-IDX) DTSBX522 01316 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-NP-CHG (QSUB) DTSBX522 01317 WHEN MJRN-COL-PAID-88 (MJRN-OCC-IDX) DTSBX522 01318 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-NP-PD (QSUB) DTSBX522 01319 WHEN MJRN-COL-WAIVED-88 (MJRN-OCC-IDX) DTSBX522 01320 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-NP-WV (QSUB) DTSBX522 01321 WHEN MJRN-COL-WRITTEN-OFF-88 (MJRN-OCC-IDX) DTSBX522 01322 ADD MJRN-AMT (MJRN-OCC-IDX) DTSBX522 01323 TO J-NP-WO (QSUB) DTSBX522 01324 WHEN MJRN-COL-TOLERATED-88 (MJRN-OCC-IDX) DTSBX522 01325 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-NP-TL (QSUB) DTSBX522 01326 END-EVALUATE. DTSBX522 01327 DTSBX522 01328 P2123-EXIT. DTSBX522 01329 EXIT. DTSBX522 01330 DTSBX522 01331 P2124-TABLE-MP. DTSBX522 01332 EVALUATE TRUE DTSBX522 01333 WHEN MJRN-COL-CHARGED-88 (MJRN-OCC-IDX) DTSBX522 01334 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-MP-CHG (QSUB) DTSBX522 01335 WHEN MJRN-COL-PAID-88 (MJRN-OCC-IDX) DTSBX522 01336 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-MP-PD (QSUB) DTSBX522 01337 WHEN MJRN-COL-WAIVED-88 (MJRN-OCC-IDX) DTSBX522 01338 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-MP-WV (QSUB) DTSBX522 01339 WHEN MJRN-COL-WRITTEN-OFF-88 (MJRN-OCC-IDX) DTSBX522 01340 ADD MJRN-AMT (MJRN-OCC-IDX) DTSBX522 01341 TO J-MP-WO (QSUB) DTSBX522 01342 WHEN MJRN-COL-TOLERATED-88 (MJRN-OCC-IDX) DTSBX522 01343 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-MP-TL (QSUB) DTSBX522 01344 END-EVALUATE. DTSBX522 01345 DTSBX522 01346 P2124-EXIT. DTSBX522 01347 EXIT. DTSBX522 01348 DTSBX522 01349 P2125-TABLE-INT. DTSBX522 01350 EVALUATE TRUE DTSBX522 01351 WHEN MJRN-COL-CHARGED-88 (MJRN-OCC-IDX) DTSBX522 01352 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-INT-CHG (QSUB) DTSBX522 01353 WHEN MJRN-COL-PAID-88 (MJRN-OCC-IDX) DTSBX522 01354 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-INT-PD (QSUB) DTSBX522 01355 WHEN MJRN-COL-WAIVED-88 (MJRN-OCC-IDX) DTSBX522 01356 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-INT-WV (QSUB) DTSBX522 01357 WHEN MJRN-COL-WRITTEN-OFF-88 (MJRN-OCC-IDX) DTSBX522 01358 ADD MJRN-AMT (MJRN-OCC-IDX) DTSBX522 01359 TO J-INT-WO (QSUB) DTSBX522 01360 WHEN MJRN-COL-TOLERATED-88 (MJRN-OCC-IDX) DTSBX522 01361 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-INT-TL (QSUB) DTSBX522 01362 END-EVALUATE. DTSBX522 01363 DTSBX522 01364 P2125-EXIT. DTSBX522 01365 EXIT. DTSBX522 01366 DTSBX522 01367 P2126-TABLE-SU. DTSBX522 01368 EVALUATE TRUE DTSBX522 01369 WHEN MJRN-COL-CHARGED-88 (MJRN-OCC-IDX) DTSBX522 01370 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-SU-CHG (QSUB) DTSBX522 01371 WHEN MJRN-COL-PAID-88 (MJRN-OCC-IDX) DTSBX522 01372 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-SU-PD (QSUB) DTSBX522 01373 WHEN MJRN-COL-WAIVED-88 (MJRN-OCC-IDX) DTSBX522 01374 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-SU-WV (QSUB) DTSBX522 01375 WHEN MJRN-COL-WRITTEN-OFF-88 (MJRN-OCC-IDX) DTSBX522 01376 ADD MJRN-AMT (MJRN-OCC-IDX) DTSBX522 01377 TO J-SU-WO (QSUB) DTSBX522 01378 WHEN MJRN-COL-TOLERATED-88 (MJRN-OCC-IDX) DTSBX522 01379 ADD MJRN-AMT (MJRN-OCC-IDX) TO J-SU-TL (QSUB) DTSBX522 01380 END-EVALUATE. DTSBX522 01381 DTSBX522 01382 P2126-EXIT. DTSBX522 01383 EXIT. DTSBX522 01384 DTSBX522 01385 DTSBX522 01386 P3000-TRANSACTION-DETAIL. DTSBX522 01387 PERFORM P3100-REPORTS THRU P3100-EXIT. DTSBX522 01388 PERFORM P3200-PAYMENT THRU P3200-EXIT. DTSBX522 01389 PERFORM P3300-ADJUSTMENT THRU P3300-EXIT. DTSBX522 01390 DTSBX522 01391 P3000-EXIT. DTSBX522 01392 EXIT. DTSBX522 01393 DTSBX522 01394 DTSBX522 01395 P3100-REPORTS. DTSBX522 01396 MOVE LOW-VALUES TO MRPT-KEY-AREA. DTSBX522 01397 MOVE MPRF-EMP-NO TO MRPT-EMP-NO. DTSBX522 01398 SET MRPT-RPT-88 TO TRUE. DTSBX522 01399 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. DTSBX522 01400 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX522 01401 IF L910-NO-REC-88 DTSBX522 01402 GO TO P3100-EXIT DTSBX522 01403 ELSE DTSBX522 01404 PERFORM DTSBX522 01405 UNTIL L910-NO-REC-88 DTSBX522 01406 MOVE MSKL-REC TO MRPT-REC DTSBX522 01407 IF MRPT-STATUS-CHNG-YES-88 DTSBX522 01408 PERFORM P3130-STATUS-CHANGE THRU P3130-EXIT DTSBX522 01409 END-IF DTSBX522 01410 PERFORM P3110-WRITE THRU P3110-EXIT DTSBX522 01411 ** IF MRPT-ESTB-DATE > 20070731 DTSBX522 01412 * OR MRPT-YRQ > 20031 DTSBX522 01413 * IF MRPT-ANNUAL-YES-88 DTSBX522 01414 * PERFORM P3120-ANNUAL THRU P3120-EXIT DTSBX522 01415 * ELSE DTSBX522 01416 * PERFORM P3110-WRITE THRU P3110-EXIT DTSBX522 01417 * PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX522 01418 * END-IF DTSBX522 01419 ** END-IF DTSBX522 01420 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX522 01421 END-PERFORM DTSBX522 01422 END-IF. DTSBX522 01423 DTSBX522 01424 P3100-EXIT. DTSBX522 01425 EXIT. DTSBX522 01426 DTSBX522 01427 P3110-WRITE. DTSBX522 01428 MOVE MRPT-RPT-TYPE TO TRAN-TRANS. DTSBX522 01429 MOVE MRPT-BATCH-NO TO TRAN-BATCH. DTSBX522 01430 MOVE MRPT-ITEM-NO TO TRAN-ITEM. DTSBX522 01431 MOVE MPRF-EMP-NO TO TRAN-EMP-NO. DTSBX522 01432 MOVE MRPT-YRQ TO L004-QTR-5-9 DTSBX522 01433 PERFORM S004-FROM-5 THRU S004-EXIT DTSBX522 01434 MOVE L004-SLASH-5-QTR TO TRAN-YRQ DTSBX522 01435 MOVE MRPT-REMIT-AMT TO TRAN-AMT. DTSBX522 01436 MOVE MRPT-TOT-WAGE TO TRAN-TOT-WAGE. DTSBX522 01437 MOVE MRPT-TAX-WAGE TO TRAN-TAX-WAGE. DTSBX522 01438 MOVE MRPT-EXCESS-WAGE TO TRAN-EXC-WAGE. DTSBX522 01439 IF MPRF-CLASS-SELF-INS-88 DTSBX522 01440 MOVE ZERO TO TRAN-RATE DTSBX522 01441 ELSE DTSBX522 01442 COMPUTE W-RATE = (MRPT-UI-RATE * 100) DTSBX522 01443 MOVE W-RATE TO TRAN-RATE DTSBX522 01444 END-IF DTSBX522 01445 MOVE SPACES TO TRAN-ACCT. DTSBX522 01446 MOVE ZEROS TO TRAN-APPLIC-BATCH DTSBX522 01447 TRAN-APPLIC-ITEM. DTSBX522 01448 IF MRPT-ANNUAL-YES-88 DTSBX522 01449 MOVE 'T' TO TRAN-CAT DTSBX522 01450 ELSE DTSBX522 01451 MOVE 'R' TO TRAN-CAT DTSBX522 01452 END-IF. DTSBX522 01453 SET TRAN-SOURCE-CR-DB-88 TO TRUE. DTSBX522 01454 MOVE MRPT-RECEIVED-DATE TO L001-FED-8-DATE-9. DTSBX522 01455 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX522 01456 MOVE L001-SLASH-8-DATE TO TRAN-RCVD-DT. DTSBX522 01457 MOVE MRPT-ESTB-DATE TO L001-FED-8-DATE-9. DTSBX522 01458 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX522 01459 IF L001-VALID-DATE DTSBX522 01460 MOVE L001-SLASH-8-DATE TO TRAN-PROCESS-DT DTSBX522 01461 ELSE DTSBX522 01462 MOVE TRAN-RCVD-DT TO TRAN-PROCESS-DT DTSBX522 01463 END-IF. DTSBX522 01464 DTSBX522 01465 MOVE MRPT-RESPONSIBLE-ACTIVITY TO TRAN-RESP-ACTIVITY. DTSBX522 01466 MOVE MRPT-RESPONSIBLE-OP-ID TO TRAN-RESP-OPID. DTSBX522 01467 DTSBX522 01468 ** WRITE TRAN-REC FROM W-TRAN-REC DTSBX522 01469 * IF NOT TRAN-STATUS-OK-88 DTSBX522 01470 * DISPLAY 'CANNOT WRITE TO TRAN FILE ' DTSBX522 01471 * ' ' TRAN-STATUS ' ' TRAN-EMP-NO DTSBX522 01472 * ELSE DTSBX522 01473 * ADD +1 TO W-TRAN-CNT DTSBX522 01474 * W-RPT-CNT DTSBX522 01475 ** END-IF. DTSBX522 01476 DTSBX522 01477 *** SELECT ONLY TRANSACTIONS FROM MOST RECENT DATE. *** DTSBX522 01478 IF MRPT-ESTB-DATE = LX34-PRIOR-RUN-DATE DTSBX522 01479 WRITE TRAN-INCR-REC FROM W-TRAN-REC DTSBX522 01480 IF NOT TRAN-I-STATUS-OK-88 DTSBX522 01481 DISPLAY 'CANNOT WRITE TO TRAN INCR FILE ' DTSBX522 01482 ' ' TRAN-I-STATUS ' ' TRAN-EMP-NO DTSBX522 01483 ELSE DTSBX522 01484 ADD +1 TO W-TRAN-CNT-INCR DTSBX522 01485 END-IF DTSBX522 01486 END-IF. DTSBX522 01487 DTSBX522 01488 P3110-EXIT. DTSBX522 01489 EXIT. DTSBX522 01490 DTSBX522 01491 *P3120-ANNUAL. DTSBX522 01492 ** DISPLAY 'ANNUAL ' MPRF-EMP-NO ' ' MRPT-YRQ. DTSBX522 01493 * DTSBX522 01494 * PERFORM P3122-INIT-ANN-TBL THRU P3122-EXIT. DTSBX522 01495 * DTSBX522 01496 * SET W-RPT-COMPLETE-NULL-88 TO TRUE. DTSBX522 01497 * DTSBX522 01498 * MOVE MRPT-YRQ TO L004-QTR-5-9. DTSBX522 01499 * MOVE 4 TO L004-QTR-5-Q. DTSBX522 01500 * MOVE L004-QTR-5-9 TO W-LAST-ANN-YRQ. DTSBX522 01501 * DTSBX522 01502 * MOVE MRPT-BATCH-NO TO W-BATCH. DTSBX522 01503 * MOVE MRPT-ITEM-NO TO W-ITEM. DTSBX522 01504 * DTSBX522 01505 * PERFORM DTSBX522 01506 * UNTIL L910-NO-REC-88 OR W-RPT-COMPLETE-YES-88 DTSBX522 01507 * MOVE MSKL-REC TO MRPT-REC DTSBX522 01508 * IF MRPT-YRQ > W-LAST-ANN-YRQ DTSBX522 01509 * OR MPRF-EMP-NO DTSBX522 01510 * SET W-RPT-COMPLETE-YES-88 TO TRUE DTSBX522 01511 * ELSE DTSBX522 01512 * PERFORM P3121-SUM-DATA THRU P3121-EXIT DTSBX522 01513 * PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX522 01514 * END-IF DTSBX522 01515 * END-PERFORM. DTSBX522 01516 * DTSBX522 01517 * PERFORM DTSBX522 01518 * VARYING ASUB FROM +1 BY +1 DTSBX522 01519 * UNTIL ASUB > ASUB-LAST DTSBX522 01520 * PERFORM P3123-WRITE THRU P3123-EXIT DTSBX522 01521 * END-PERFORM. DTSBX522 01522 * DTSBX522 01523 * DTSBX522 01524 *P3120-EXIT. DTSBX522 01525 * EXIT. DTSBX522 01526 * DTSBX522 01527 *P3121-SUM-DATA. DTSBX522 01528 * MOVE +0 TO ASUB. DTSBX522 01529 * PERFORM DTSBX522 01530 * VARYING ASUB1 FROM +1 BY +1 DTSBX522 01531 * UNTIL ASUB > +0 DTSBX522 01532 * OR ASUB1 > ASUB-LAST DTSBX522 01533 * IF W-ANN-BATCH (ASUB1) = MRPT-BATCH-NO DTSBX522 01534 * AND W-ANN-ITEM (ASUB1) = MRPT-ITEM-NO DTSBX522 01535 * MOVE ASUB1 TO ASUB DTSBX522 01536 * END-IF DTSBX522 01537 * END-PERFORM. DTSBX522 01538 * DTSBX522 01539 * IF ASUB = ZERO DTSBX522 01540 * ADD +1 TO ASUB-LAST DTSBX522 01541 * MOVE ASUB-LAST TO ASUB DTSBX522 01542 * ELSE DTSBX522 01543 * ADD MRPT-REMIT-AMT TO W-ANN-REMIT (ASUB) DTSBX522 01544 * ADD MRPT-TOT-WAGE TO W-ANN-TOT-WAGE (ASUB) DTSBX522 01545 * ADD MRPT-TAX-WAGE TO W-ANN-TAX-WAGE (ASUB) DTSBX522 01546 * ADD MRPT-EXCESS-WAGE TO W-ANN-EXCESS-WAGE (ASUB) DTSBX522 01547 * GO TO P3121-EXIT DTSBX522 01548 * END-IF. DTSBX522 01549 * DTSBX522 01550 * MOVE MRPT-RPT-TYPE DTSBX522 01551 * TO W-ANN-RPT-TYPE (ASUB). DTSBX522 01552 * MOVE MRPT-YRQ TO W-ANN-YRQ (ASUB). DTSBX522 01553 * MOVE MRPT-BATCH-NO TO W-ANN-BATCH (ASUB). DTSBX522 01554 * MOVE MRPT-ITEM-NO TO W-ANN-ITEM (ASUB). DTSBX522 01555 * ADD MRPT-REMIT-AMT TO W-ANN-REMIT (ASUB). DTSBX522 01556 * ADD MRPT-TOT-WAGE TO W-ANN-TOT-WAGE (ASUB). DTSBX522 01557 * ADD MRPT-TAX-WAGE TO W-ANN-TAX-WAGE (ASUB). DTSBX522 01558 * ADD MRPT-EXCESS-WAGE TO W-ANN-EXCESS-WAGE (ASUB). DTSBX522 01559 * MOVE MRPT-UI-RATE TO W-ANN-RATE (ASUB). DTSBX522 01560 * MOVE MRPT-RECEIVED-DATE TO W-ANN-RCVD-DT (ASUB). DTSBX522 01561 * MOVE MRPT-ESTB-DATE TO W-ANN-PROCESS-DT (ASUB). DTSBX522 01562 * DTSBX522 01563 *P3121-EXIT. DTSBX522 01564 * EXIT. DTSBX522 01565 * DTSBX522 01566 *P3122-INIT-ANN-TBL. DTSBX522 01567 * MOVE ZERO TO ASUB-LAST. DTSBX522 01568 * PERFORM DTSBX522 01569 * VARYING ASUB FROM +1 BY +1 DTSBX522 01570 * UNTIL ASUB > ASUB-MAX DTSBX522 01571 * MOVE SPACES TO W-ANN-RPT-TYPE (ASUB) DTSBX522 01572 * MOVE ZERO TO W-ANN-YRQ (ASUB) DTSBX522 01573 * W-ANN-RATE (ASUB) DTSBX522 01574 * W-ANN-REMIT (ASUB) DTSBX522 01575 * W-ANN-BATCH (ASUB) DTSBX522 01576 * W-ANN-ITEM (ASUB) DTSBX522 01577 * W-ANN-TOT-WAGE (ASUB) DTSBX522 01578 * W-ANN-TAX-WAGE (ASUB) DTSBX522 01579 * W-ANN-EXCESS-WAGE (ASUB) DTSBX522 01580 * W-ANN-RCVD-DT (ASUB) DTSBX522 01581 * W-ANN-PROCESS-DT (ASUB) DTSBX522 01582 * END-PERFORM. DTSBX522 01583 * DTSBX522 01584 *P3122-EXIT. DTSBX522 01585 * EXIT. DTSBX522 01586 * DTSBX522 01587 *P3123-WRITE. DTSBX522 01588 * MOVE W-ANN-RPT-TYPE (ASUB) TO TRAN-TRANS. DTSBX522 01589 * MOVE W-ANN-BATCH (ASUB) TO TRAN-BATCH. DTSBX522 01590 * MOVE W-ANN-ITEM (ASUB) TO TRAN-ITEM. DTSBX522 01591 * MOVE MPRF-EMP-NO TO TRAN-EMP-NO. DTSBX522 01592 * MOVE 1 TO W-ANN-YRQ-Q (ASUB). DTSBX522 01593 * MOVE W-ANN-YRQ (ASUB) TO L004-QTR-5-9 DTSBX522 01594 * PERFORM S004-FROM-5 THRU S004-EXIT DTSBX522 01595 * MOVE L004-SLASH-5-QTR TO TRAN-YRQ DTSBX522 01596 * MOVE W-ANN-REMIT (ASUB) TO TRAN-AMT. DTSBX522 01597 * MOVE W-ANN-TOT-WAGE (ASUB) TO TRAN-TOT-WAGE. DTSBX522 01598 * MOVE W-ANN-TAX-WAGE (ASUB) TO TRAN-TAX-WAGE. DTSBX522 01599 * MOVE W-ANN-EXCESS-WAGE (ASUB) TO TRAN-EXC-WAGE. DTSBX522 01600 * COMPUTE W-RATE = (W-ANN-RATE (ASUB) * 100). DTSBX522 01601 * MOVE W-RATE TO TRAN-RATE. DTSBX522 01602 * MOVE SPACES TO TRAN-ACCT. DTSBX522 01603 * MOVE 'T' TO TRAN-CAT. DTSBX522 01604 * SET TRAN-SOURCE-CR-DB-88 TO TRUE. DTSBX522 01605 * MOVE W-ANN-RCVD-DT (ASUB) TO L001-FED-8-DATE-9. DTSBX522 01606 * PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX522 01607 * MOVE L001-SLASH-8-DATE TO TRAN-RCVD-DT. DTSBX522 01608 * MOVE W-ANN-PROCESS-DT (ASUB) TO L001-FED-8-DATE-9. DTSBX522 01609 * PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX522 01610 * MOVE L001-SLASH-8-DATE TO TRAN-PROCESS-DT. DTSBX522 01611 * DTSBX522 01612 * WRITE TRAN-REC FROM W-TRAN-REC. DTSBX522 01613 * IF NOT TRAN-STATUS-OK-88 DTSBX522 01614 * DISPLAY 'CANNOT WRITE TO TRAN FILE ' DTSBX522 01615 * ' ' TRAN-STATUS ' ' TRAN-EMP-NO DTSBX522 01616 * ELSE DTSBX522 01617 * ADD +1 TO W-TRAN-CNT DTSBX522 01618 * W-ANN-RPT-CNT DTSBX522 01619 * END-IF. DTSBX522 01620 * DTSBX522 01621 *P3123-EXIT. DTSBX522 01622 * EXIT. DTSBX522 01623 DTSBX522 01624 P3130-STATUS-CHANGE. DTSBX522 01625 *** DISPLAY 'STATUS ' MRPT-EMP-NO ' ' MRPT-BATCH-NO DTSBX522 01626 *** ' ' MRPT-ITEM-NO. DTSBX522 01627 MOVE LX34-PRIOR-RUN-DATE TO L001-FED-8-DATE-9. DTSBX522 01628 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX522 01629 MOVE L001-SLASH-8-DATE TO SUMMARY-PROCESS-DT. DTSBX522 01630 MOVE 'STATUS CHANGE ' TO SUMMARY-MESSAGE. DTSBX522 01631 MOVE MRPT-EMP-NO TO SUMMARY-EMP-NO DTSBX522 01632 DTSBX522 01633 MOVE MRPT-BATCH-NO TO SUMMARY-BATCH. DTSBX522 01634 MOVE MRPT-ITEM-NO TO SUMMARY-ITEM. DTSBX522 01635 MOVE MRPT-RPT-TYPE TO SUMMARY-TRAN. DTSBX522 01636 SET SUMMARY-SOURCE-STATUS-88 TO TRUE DTSBX522 01637 DTSBX522 01638 WRITE SUMMARY-REC FROM W-SUMMARY-REC. DTSBX522 01639 ADD +1 TO W-SUMMARY-CNT. DTSBX522 01640 DTSBX522 01641 P3130-EXIT. DTSBX522 01642 EXIT. DTSBX522 01643 DTSBX522 01644 P3200-PAYMENT. DTSBX522 01645 MOVE LOW-VALUES TO MPAY-KEY-AREA. DTSBX522 01646 MOVE MPRF-EMP-NO TO MPAY-EMP-NO. DTSBX522 01647 SET MPAY-PAY-88 TO TRUE. DTSBX522 01648 MOVE MPAY-KEY-AREA TO MSKL-KEY-AREA. DTSBX522 01649 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX522 01650 IF L910-NO-REC-88 DTSBX522 01651 GO TO P3200-EXIT DTSBX522 01652 ELSE DTSBX522 01653 PERFORM DTSBX522 01654 UNTIL L910-NO-REC-88 DTSBX522 01655 MOVE MSKL-REC TO MPAY-REC DTSBX522 01656 PERFORM P3210-WRITE THRU P3210-EXIT DTSBX522 01657 *& IF MPAY-ESTB-DATE = LECM-PRIOR-RUN-DATE DTSBX522 01658 ** DISPLAY 'P3200 ' MPRF-EMP-NO ' ' MPAY-BATCH-NO CL*64 01659 ** ' ' MPAY-ITEM-NO CL*64 01660 ** ' ' MPAY-TRACE-NO CL*64 01661 ** PERFORM P3210-WRITE THRU P3210-EXIT CL*39 01662 *& END-IF DTSBX522 01663 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX522 01664 END-PERFORM DTSBX522 01665 END-IF. DTSBX522 01666 DTSBX522 01667 P3200-EXIT. DTSBX522 01668 EXIT. DTSBX522 01669 DTSBX522 01670 P3210-WRITE. DTSBX522 01671 MOVE MPAY-PAY-TYPE TO TRAN-TRANS. DTSBX522 01672 IF MPAY-APPLIC-YRQ > ZERO DTSBX522 01673 MOVE MPAY-APPLIC-YRQ TO L004-QTR-5-9 DTSBX522 01674 PERFORM S004-FROM-5 THRU S004-EXIT DTSBX522 01675 MOVE L004-SLASH-5-QTR TO TRAN-YRQ DTSBX522 01676 ELSE DTSBX522 01677 MOVE SPACES TO TRAN-YRQ DTSBX522 01678 END-IF. DTSBX522 01679 MOVE MPRF-EMP-NO TO TRAN-EMP-NO. DTSBX522 01680 MOVE MPAY-BATCH-NO TO TRAN-BATCH. DTSBX522 01681 MOVE MPAY-ITEM-NO TO TRAN-ITEM. DTSBX522 01682 MOVE MPAY-REMIT-AMT TO TRAN-AMT. DTSBX522 01683 MOVE ZERO TO TRAN-TAX-WAGE DTSBX522 01684 TRAN-TOT-WAGE DTSBX522 01685 TRAN-EXC-WAGE DTSBX522 01686 TRAN-RATE. DTSBX522 01687 MOVE MPAY-APPLIC-IND TO TRAN-ACCT. DTSBX522 01688 MOVE MPAY-APPLIC-BATCH-NO TO TRAN-APPLIC-BATCH. DTSBX522 01689 MOVE MPAY-APPLIC-ITEM-NO TO TRAN-APPLIC-ITEM. DTSBX522 01690 MOVE 'P' TO TRAN-CAT. DTSBX522 01691 SET TRAN-SOURCE-CR-DB-88 TO TRUE. DTSBX522 01692 MOVE MPAY-RECEIVED-DATE TO L001-FED-8-DATE-9. DTSBX522 01693 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX522 01694 MOVE L001-SLASH-8-DATE TO TRAN-RCVD-DT. DTSBX522 01695 MOVE MPAY-ESTB-DATE TO L001-FED-8-DATE-9. DTSBX522 01696 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX522 01697 IF L001-VALID-DATE DTSBX522 01698 MOVE L001-SLASH-8-DATE TO TRAN-PROCESS-DT DTSBX522 01699 ELSE DTSBX522 01700 MOVE TRAN-RCVD-DT TO TRAN-PROCESS-DT DTSBX522 01701 ** MOVE W-DEFAULT-DATE TO TRAN-PROCESS-DT DTSBX522 01702 END-IF. DTSBX522 01703 DTSBX522 01704 MOVE MPAY-RESPONSIBLE-ACTIVITY TO TRAN-RESP-ACTIVITY. DTSBX522 01705 MOVE MPAY-RESPONSIBLE-OP-ID TO TRAN-RESP-OPID. DTSBX522 01706 DTSBX522 01707 ** WRITE TRAN-REC FROM W-TRAN-REC DTSBX522 01708 * IF NOT TRAN-STATUS-OK-88 DTSBX522 01709 * DISPLAY 'CANNOT WRITE TO TRAN FILE ' DTSBX522 01710 * ' ' TRAN-STATUS ' ' TRAN-EMP-NO DTSBX522 01711 * ELSE DTSBX522 01712 * ADD +1 TO W-TRAN-CNT DTSBX522 01713 * W-PAY-CNT DTSBX522 01714 ** END-IF. DTSBX522 01715 DTSBX522 01716 *** SELECT ONLY TRANSACTIONS FROM MOST RECENT DATE. *** DTSBX522 01717 IF MPAY-ESTB-DATE = LX34-PRIOR-RUN-DATE DTSBX522 01718 WRITE TRAN-INCR-REC FROM W-TRAN-REC DTSBX522 01719 IF NOT TRAN-I-STATUS-OK-88 DTSBX522 01720 DISPLAY 'CANNOT WRITE TO TRAN FILE ' DTSBX522 01721 ' ' TRAN-I-STATUS ' ' TRAN-EMP-NO DTSBX522 01722 ELSE DTSBX522 01723 ADD +1 TO W-TRAN-CNT DTSBX522 01724 END-IF DTSBX522 01725 END-IF. DTSBX522 01726 DTSBX522 01727 P3210-EXIT. DTSBX522 01728 EXIT. DTSBX522 01729 DTSBX522 01730 P3300-ADJUSTMENT. DTSBX522 01731 MOVE LOW-VALUES TO MADJ-KEY-AREA. DTSBX522 01732 MOVE MPRF-EMP-NO TO MADJ-EMP-NO. DTSBX522 01733 SET MADJ-ADJ-88 TO TRUE. DTSBX522 01734 MOVE MADJ-KEY-AREA TO MSKL-KEY-AREA. DTSBX522 01735 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX522 01736 IF L910-NO-REC-88 DTSBX522 01737 GO TO P3300-EXIT DTSBX522 01738 ELSE DTSBX522 01739 PERFORM DTSBX522 01740 UNTIL L910-NO-REC-88 DTSBX522 01741 MOVE MSKL-REC TO MADJ-REC DTSBX522 01742 PERFORM P3310-WRITE THRU P3310-EXIT DTSBX522 01743 *& IF MADJ-ESTB-DATE = LECM-PRIOR-RUN-DATE DTSBX522 01744 * PERFORM P3310-WRITE THRU P3310-EXIT DTSBX522 01745 *& END-IF DTSBX522 01746 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX522 01747 END-PERFORM DTSBX522 01748 END-IF. DTSBX522 01749 DTSBX522 01750 P3300-EXIT. DTSBX522 01751 EXIT. DTSBX522 01752 DTSBX522 01753 P3310-WRITE. DTSBX522 01754 IF MADJ-CHRG-88 DTSBX522 01755 OR MADJ-WAIVE-88 DTSBX522 01756 OR MADJ-TOLER-88 DTSBX522 01757 OR MADJ-WRITE-OFF-88 DTSBX522 01758 OR MADJ-WRITE-OFF-REV-88 DTSBX522 01759 NEXT SENTENCE DTSBX522 01760 ELSE DTSBX522 01761 GO TO P3310-EXIT DTSBX522 01762 END-IF. DTSBX522 01763 MOVE MADJ-ADJ-TYPE TO TRAN-TRANS. DTSBX522 01764 MOVE MADJ-BATCH-NO TO TRAN-BATCH. DTSBX522 01765 MOVE MADJ-ITEM-NO TO TRAN-ITEM. DTSBX522 01766 IF MADJ-APPLIC-YRQ > ZERO DTSBX522 01767 MOVE MADJ-APPLIC-YRQ TO L004-QTR-5-9 DTSBX522 01768 PERFORM S004-FROM-5 THRU S004-EXIT DTSBX522 01769 MOVE L004-SLASH-5-QTR TO TRAN-YRQ DTSBX522 01770 ELSE DTSBX522 01771 MOVE SPACES TO TRAN-YRQ DTSBX522 01772 END-IF. DTSBX522 01773 MOVE MPRF-EMP-NO TO TRAN-EMP-NO. DTSBX522 01774 MOVE MADJ-AMT TO TRAN-AMT. DTSBX522 01775 DTSBX522 01776 MOVE ZERO TO TRAN-TOT-WAGE DTSBX522 01777 TRAN-TAX-WAGE DTSBX522 01778 TRAN-EXC-WAGE DTSBX522 01779 TRAN-RATE. DTSBX522 01780 MOVE MADJ-APPLIC-IND TO TRAN-ACCT. DTSBX522 01781 MOVE MADJ-APPLIC-BATCH-NO TO TRAN-APPLIC-BATCH. DTSBX522 01782 MOVE MADJ-APPLIC-ITEM-NO TO TRAN-APPLIC-ITEM. DTSBX522 01783 MOVE 'A' TO TRAN-CAT. DTSBX522 01784 SET TRAN-SOURCE-CR-DB-88 TO TRUE. DTSBX522 01785 MOVE MADJ-RECEIVED-DATE TO L001-FED-8-DATE-9. DTSBX522 01786 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX522 01787 MOVE L001-SLASH-8-DATE TO TRAN-RCVD-DT. DTSBX522 01788 MOVE MADJ-ESTB-DATE TO L001-FED-8-DATE-9. DTSBX522 01789 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX522 01790 IF L001-VALID-DATE DTSBX522 01791 MOVE L001-SLASH-8-DATE TO TRAN-PROCESS-DT DTSBX522 01792 ELSE DTSBX522 01793 ** MOVE W-DEFAULT-DATE TO TRAN-PROCESS-DT DTSBX522 01794 MOVE TRAN-RCVD-DT TO TRAN-PROCESS-DT DTSBX522 01795 END-IF. DTSBX522 01796 DTSBX522 01797 MOVE MADJ-RESPONSIBLE-ACTIVITY TO TRAN-RESP-ACTIVITY. DTSBX522 01798 MOVE MADJ-RESPONSIBLE-OP-ID TO TRAN-RESP-OPID. DTSBX522 01799 DTSBX522 01800 ** WRITE TRAN-REC FROM W-TRAN-REC DTSBX522 01801 * IF NOT TRAN-STATUS-OK-88 DTSBX522 01802 * DISPLAY 'CANNOT WRITE TO TRAN FILE ' DTSBX522 01803 * ' ' TRAN-STATUS ' ' TRAN-EMP-NO DTSBX522 01804 * ELSE DTSBX522 01805 * ADD +1 TO W-TRAN-CNT DTSBX522 01806 * W-ADJ-CNT DTSBX522 01807 ** END-IF. DTSBX522 01808 DTSBX522 01809 *** SELECT ONLY TRANSACTIONS FROM MOST RECENT DATE. *** DTSBX522 01810 IF MADJ-ESTB-DATE = LX34-PRIOR-RUN-DATE DTSBX522 01811 WRITE TRAN-INCR-REC FROM W-TRAN-REC DTSBX522 01812 IF NOT TRAN-I-STATUS-OK-88 DTSBX522 01813 DISPLAY 'CANNOT WRITE TO TRAN INCR FILE ' DTSBX522 01814 ' ' TRAN-I-STATUS ' ' TRAN-EMP-NO DTSBX522 01815 ELSE DTSBX522 01816 ADD +1 TO W-TRAN-CNT DTSBX522 01817 END-IF DTSBX522 01818 END-IF. DTSBX522 01819 DTSBX522 01820 P3310-EXIT. DTSBX522 01821 EXIT. DTSBX522 01822 DTSBX522 01823 P4000-CORRECTIONS. DTSBX522 01824 PERFORM DTSBX522 01825 VARYING QSUB FROM +1 BY +1 DTSBX522 01826 UNTIL QSUB > QMAX DTSBX522 01827 IF (Q-UI-CHG (QSUB) NOT = J-UI-CHG (QSUB) DTSBX522 01828 OR Q-UI-PD (QSUB) NOT = J-UI-PD (QSUB) DTSBX522 01829 OR Q-UI-WV (QSUB) NOT = J-UI-WV (QSUB) DTSBX522 01830 OR Q-UI-WO (QSUB) NOT = J-UI-WO (QSUB) DTSBX522 01831 OR Q-UI-TL (QSUB) NOT = J-UI-TL (QSUB)) DTSBX522 01832 PERFORM P4100-CORRECT-UI THRU P4100-EXIT DTSBX522 01833 END-IF DTSBX522 01834 IF (Q-INT-CHG (QSUB) NOT = J-INT-CHG (QSUB) DTSBX522 01835 OR Q-INT-PD (QSUB) NOT = J-INT-PD (QSUB) DTSBX522 01836 OR Q-INT-WV (QSUB) NOT = J-INT-WV (QSUB) DTSBX522 01837 OR Q-INT-WO (QSUB) NOT = J-INT-WO (QSUB) DTSBX522 01838 OR Q-INT-TL (QSUB) NOT = J-INT-TL (QSUB)) DTSBX522 01839 PERFORM P4200-CORRECT-INT THRU P4200-EXIT DTSBX522 01840 END-IF DTSBX522 01841 IF (Q-LP-CHG (QSUB) NOT = J-LP-CHG (QSUB) DTSBX522 01842 OR Q-LP-PD (QSUB) NOT = J-LP-PD (QSUB) DTSBX522 01843 OR Q-LP-WV (QSUB) NOT = J-LP-WV (QSUB) DTSBX522 01844 OR Q-LP-WO (QSUB) NOT = J-LP-WO (QSUB) DTSBX522 01845 OR Q-LP-TL (QSUB) NOT = J-LP-TL (QSUB)) DTSBX522 01846 PERFORM P4300-CORRECT-LP THRU P4300-EXIT DTSBX522 01847 END-IF DTSBX522 01848 IF (Q-NP-CHG (QSUB) NOT = J-NP-CHG (QSUB) DTSBX522 01849 OR Q-NP-PD (QSUB) NOT = J-NP-PD (QSUB) DTSBX522 01850 OR Q-NP-WV (QSUB) NOT = J-NP-WV (QSUB) DTSBX522 01851 OR Q-NP-WO (QSUB) NOT = J-NP-WO (QSUB) DTSBX522 01852 OR Q-NP-TL (QSUB) NOT = J-NP-TL (QSUB)) DTSBX522 01853 PERFORM P4400-CORRECT-NP THRU P4400-EXIT DTSBX522 01854 END-IF DTSBX522 01855 IF (Q-MP-CHG (QSUB) NOT = J-MP-CHG (QSUB) DTSBX522 01856 OR Q-MP-PD (QSUB) NOT = J-MP-PD (QSUB) DTSBX522 01857 OR Q-MP-WV (QSUB) NOT = J-MP-WV (QSUB) DTSBX522 01858 OR Q-MP-WO (QSUB) NOT = J-MP-WO (QSUB) DTSBX522 01859 OR Q-MP-TL (QSUB) NOT = J-MP-TL (QSUB)) DTSBX522 01860 PERFORM P4500-CORRECT-MP THRU P4500-EXIT DTSBX522 01861 END-IF DTSBX522 01862 IF (Q-SU-CHG (QSUB) NOT = J-SU-CHG (QSUB) DTSBX522 01863 OR Q-SU-PD (QSUB) NOT = J-SU-PD (QSUB) DTSBX522 01864 OR Q-SU-WV (QSUB) NOT = J-SU-WV (QSUB) DTSBX522 01865 OR Q-SU-WO (QSUB) NOT = J-SU-WO (QSUB) DTSBX522 01866 OR Q-SU-TL (QSUB) NOT = J-SU-TL (QSUB)) DTSBX522 01867 PERFORM P4600-CORRECT-SU THRU P4600-EXIT DTSBX522 01868 END-IF DTSBX522 01869 END-PERFORM. DTSBX522 01870 DTSBX522 01871 P4000-EXIT. DTSBX522 01872 EXIT. DTSBX522 01873 DTSBX522 01874 P4100-CORRECT-UI. DTSBX522 01875 IF TBL-JRN-BAD-88 (QSUB) DTSBX522 01876 GO TO P4100-EXIT DTSBX522 01877 ELSE DTSBX522 01878 ADD +1 TO W-ERROR-CNT DTSBX522 01879 END-IF. DTSBX522 01880 DTSBX522 01881 MOVE 'UI' TO ACCT-ROW. DTSBX522 01882 DTSBX522 01883 MOVE ZERO TO ADJ-CHG DTSBX522 01884 ADJ-PD DTSBX522 01885 ADJ-WV DTSBX522 01886 ADJ-WO DTSBX522 01887 ADJ-TL. DTSBX522 01888 DTSBX522 01889 COMPUTE ADJ-CHG = (Q-UI-CHG (QSUB) - J-UI-CHG (QSUB)). DTSBX522 01890 COMPUTE ADJ-PD = (Q-UI-PD (QSUB) - J-UI-PD (QSUB)). DTSBX522 01891 COMPUTE ADJ-WV = (Q-UI-WV (QSUB) - J-UI-WV (QSUB)). DTSBX522 01892 COMPUTE ADJ-WO = (Q-UI-WO (QSUB) - J-UI-WO (QSUB)). DTSBX522 01893 COMPUTE ADJ-TL = (Q-UI-TL (QSUB) - J-UI-TL (QSUB)). DTSBX522 01894 DTSBX522 01895 ** DISPLAY 'P4900 Q CHG ' Q-UI-CHG (QSUB) DTSBX522 01896 * ' Q PD ' Q-UI-PD (QSUB) DTSBX522 01897 * DISPLAY ' J CHG ' J-UI-CHG (QSUB) DTSBX522 01898 ** ' J PD ' J-UI-PD (QSUB). DTSBX522 01899 PERFORM P4900-WRITE-ACCT THRU P4900-EXIT. DTSBX522 01900 DTSBX522 01901 P4100-EXIT. DTSBX522 01902 EXIT. DTSBX522 01903 DTSBX522 01904 P4200-CORRECT-INT. DTSBX522 01905 IF TBL-JRN-BAD-88 (QSUB) DTSBX522 01906 GO TO P4200-EXIT DTSBX522 01907 ELSE DTSBX522 01908 ADD +1 TO W-ERROR-CNT DTSBX522 01909 END-IF. DTSBX522 01910 DTSBX522 01911 MOVE 'I ' TO ACCT-ROW. DTSBX522 01912 DTSBX522 01913 MOVE ZERO TO ADJ-CHG DTSBX522 01914 ADJ-PD DTSBX522 01915 ADJ-WV DTSBX522 01916 ADJ-WO DTSBX522 01917 ADJ-TL. DTSBX522 01918 DTSBX522 01919 COMPUTE ADJ-CHG = (Q-INT-CHG (QSUB) - J-INT-CHG (QSUB)). DTSBX522 01920 COMPUTE ADJ-PD = (Q-INT-PD (QSUB) - J-INT-PD (QSUB)). DTSBX522 01921 COMPUTE ADJ-WV = (Q-INT-WV (QSUB) - J-INT-WV (QSUB)). DTSBX522 01922 COMPUTE ADJ-WO = (Q-INT-WO (QSUB) - J-INT-WO (QSUB)). DTSBX522 01923 COMPUTE ADJ-TL = (Q-INT-TL (QSUB) - J-INT-TL (QSUB)). DTSBX522 01924 DTSBX522 01925 PERFORM P4900-WRITE-ACCT THRU P4900-EXIT. DTSBX522 01926 DTSBX522 01927 P4200-EXIT. DTSBX522 01928 EXIT. DTSBX522 01929 DTSBX522 01930 P4300-CORRECT-LP. DTSBX522 01931 IF TBL-JRN-BAD-88 (QSUB) DTSBX522 01932 ** DISPLAY 'P4300 LP ' MPRF-EMP-NO ' ' DTSBX522 01933 ** TBL-YRQ (QSUB) DTSBX522 01934 GO TO P4300-EXIT DTSBX522 01935 ELSE DTSBX522 01936 ADD +1 TO W-ERROR-CNT DTSBX522 01937 END-IF. DTSBX522 01938 DTSBX522 01939 MOVE 'LP' TO ACCT-ROW. DTSBX522 01940 DTSBX522 01941 MOVE ZERO TO ADJ-CHG DTSBX522 01942 ADJ-PD DTSBX522 01943 ADJ-WV DTSBX522 01944 ADJ-WO DTSBX522 01945 ADJ-TL. DTSBX522 01946 DTSBX522 01947 COMPUTE ADJ-CHG = (Q-LP-CHG (QSUB) - J-LP-CHG (QSUB)). DTSBX522 01948 COMPUTE ADJ-PD = (Q-LP-PD (QSUB) - J-LP-PD (QSUB)). DTSBX522 01949 COMPUTE ADJ-WV = (Q-LP-WV (QSUB) - J-LP-WV (QSUB)). DTSBX522 01950 COMPUTE ADJ-WO = (Q-LP-WO (QSUB) - J-LP-WO (QSUB)). DTSBX522 01951 COMPUTE ADJ-TL = (Q-LP-TL (QSUB) - J-LP-TL (QSUB)). DTSBX522 01952 DTSBX522 01953 PERFORM P4900-WRITE-ACCT THRU P4900-EXIT. DTSBX522 01954 DTSBX522 01955 P4300-EXIT. DTSBX522 01956 EXIT. DTSBX522 01957 DTSBX522 01958 P4400-CORRECT-NP. DTSBX522 01959 IF TBL-JRN-BAD-88 (QSUB) DTSBX522 01960 ** DISPLAY 'P4400 NP ' MPRF-EMP-NO ' ' DTSBX522 01961 ** TBL-YRQ (QSUB) DTSBX522 01962 GO TO P4400-EXIT DTSBX522 01963 ELSE DTSBX522 01964 ADD +1 TO W-ERROR-CNT DTSBX522 01965 END-IF. DTSBX522 01966 DTSBX522 01967 MOVE 'NP' TO ACCT-ROW. DTSBX522 01968 DTSBX522 01969 MOVE ZERO TO ADJ-CHG DTSBX522 01970 ADJ-PD DTSBX522 01971 ADJ-WV DTSBX522 01972 ADJ-WO DTSBX522 01973 ADJ-TL. DTSBX522 01974 DTSBX522 01975 COMPUTE ADJ-CHG = (Q-NP-CHG (QSUB) - J-NP-CHG (QSUB)). DTSBX522 01976 COMPUTE ADJ-PD = (Q-NP-PD (QSUB) - J-NP-PD (QSUB)). DTSBX522 01977 COMPUTE ADJ-WV = (Q-NP-WV (QSUB) - J-NP-WV (QSUB)). DTSBX522 01978 COMPUTE ADJ-WO = (Q-NP-WO (QSUB) - J-NP-WO (QSUB)). DTSBX522 01979 COMPUTE ADJ-TL = (Q-NP-TL (QSUB) - J-NP-TL (QSUB)). DTSBX522 01980 DTSBX522 01981 PERFORM P4900-WRITE-ACCT THRU P4900-EXIT. DTSBX522 01982 DTSBX522 01983 P4400-EXIT. DTSBX522 01984 EXIT. DTSBX522 01985 DTSBX522 01986 P4500-CORRECT-MP. DTSBX522 01987 IF TBL-JRN-BAD-88 (QSUB) DTSBX522 01988 ** DISPLAY 'P4500 MP ' MPRF-EMP-NO ' ' DTSBX522 01989 ** TBL-YRQ (QSUB) DTSBX522 01990 GO TO P4500-EXIT DTSBX522 01991 ELSE DTSBX522 01992 ADD +1 TO W-ERROR-CNT DTSBX522 01993 END-IF. DTSBX522 01994 DTSBX522 01995 MOVE 'MP' TO ACCT-ROW. DTSBX522 01996 DTSBX522 01997 MOVE ZERO TO ADJ-CHG DTSBX522 01998 ADJ-PD DTSBX522 01999 ADJ-WV DTSBX522 02000 ADJ-WO DTSBX522 02001 ADJ-TL. DTSBX522 02002 DTSBX522 02003 COMPUTE ADJ-CHG = (Q-MP-CHG (QSUB) - J-MP-CHG (QSUB)). DTSBX522 02004 COMPUTE ADJ-PD = (Q-MP-PD (QSUB) - J-MP-PD (QSUB)). DTSBX522 02005 COMPUTE ADJ-WV = (Q-MP-WV (QSUB) - J-MP-WV (QSUB)). DTSBX522 02006 COMPUTE ADJ-WO = (Q-MP-WO (QSUB) - J-MP-WO (QSUB)). DTSBX522 02007 COMPUTE ADJ-TL = (Q-MP-TL (QSUB) - J-MP-TL (QSUB)). DTSBX522 02008 DTSBX522 02009 PERFORM P4900-WRITE-ACCT THRU P4900-EXIT. DTSBX522 02010 DTSBX522 02011 P4500-EXIT. DTSBX522 02012 EXIT. DTSBX522 02013 DTSBX522 02014 P4600-CORRECT-SU. DTSBX522 02015 IF TBL-JRN-BAD-88 (QSUB) DTSBX522 02016 ** DISPLAY 'P4600 SU ' MPRF-EMP-NO ' ' DTSBX522 02017 ** TBL-YRQ (QSUB) DTSBX522 02018 GO TO P4600-EXIT DTSBX522 02019 ELSE DTSBX522 02020 ADD +1 TO W-ERROR-CNT DTSBX522 02021 END-IF. DTSBX522 02022 DTSBX522 02023 MOVE 'SU' TO ACCT-ROW. DTSBX522 02024 DTSBX522 02025 MOVE ZERO TO ADJ-CHG DTSBX522 02026 ADJ-PD DTSBX522 02027 ADJ-WV DTSBX522 02028 ADJ-WO DTSBX522 02029 ADJ-TL. DTSBX522 02030 DTSBX522 02031 COMPUTE ADJ-CHG = (Q-SU-CHG (QSUB) - J-SU-CHG (QSUB)). DTSBX522 02032 COMPUTE ADJ-PD = (Q-SU-PD (QSUB) - J-SU-PD (QSUB)). DTSBX522 02033 COMPUTE ADJ-WV = (Q-SU-WV (QSUB) - J-SU-WV (QSUB)). DTSBX522 02034 COMPUTE ADJ-WO = (Q-SU-WO (QSUB) - J-SU-WO (QSUB)). DTSBX522 02035 COMPUTE ADJ-TL = (Q-SU-TL (QSUB) - J-SU-TL (QSUB)). DTSBX522 02036 DTSBX522 02037 PERFORM P4900-WRITE-ACCT THRU P4900-EXIT. DTSBX522 02038 DTSBX522 02039 P4600-EXIT. DTSBX522 02040 EXIT. DTSBX522 02041 DTSBX522 02042 P4900-WRITE-ACCT. DTSBX522 02043 IF ADJ-CHG NOT = ZERO DTSBX522 02044 MOVE 'CH' TO ACCT-COL DTSBX522 02045 MOVE ADJ-CHG TO ACCT-AMT DTSBX522 02046 PERFORM P4910-WRITE THRU P4910-EXIT DTSBX522 02047 END-IF. DTSBX522 02048 DTSBX522 02049 IF ADJ-PD NOT = ZERO DTSBX522 02050 MOVE 'PD' TO ACCT-COL DTSBX522 02051 COMPUTE ADJ-PD = (ADJ-PD * -1) DTSBX522 02052 MOVE ADJ-PD TO ACCT-AMT DTSBX522 02053 PERFORM P4910-WRITE THRU P4910-EXIT DTSBX522 02054 END-IF. DTSBX522 02055 DTSBX522 02056 IF ADJ-WV NOT = ZERO DTSBX522 02057 MOVE 'WV' TO ACCT-COL DTSBX522 02058 COMPUTE ADJ-WV = (ADJ-WV * -1) DTSBX522 02059 MOVE ADJ-WV TO ACCT-AMT DTSBX522 02060 PERFORM P4910-WRITE THRU P4910-EXIT DTSBX522 02061 END-IF. DTSBX522 02062 DTSBX522 02063 IF ADJ-WO NOT = ZERO DTSBX522 02064 MOVE 'WO' TO ACCT-COL DTSBX522 02065 COMPUTE ADJ-WO = (ADJ-WO * -1) DTSBX522 02066 MOVE ADJ-WO TO ACCT-AMT DTSBX522 02067 PERFORM P4910-WRITE THRU P4910-EXIT DTSBX522 02068 END-IF. DTSBX522 02069 DTSBX522 02070 IF ADJ-TL NOT = ZERO DTSBX522 02071 MOVE 'TL' TO ACCT-COL DTSBX522 02072 COMPUTE ADJ-TL = (ADJ-TL * -1) DTSBX522 02073 MOVE ADJ-TL TO ACCT-AMT DTSBX522 02074 PERFORM P4910-WRITE THRU P4910-EXIT DTSBX522 02075 END-IF. DTSBX522 02076 DTSBX522 02077 P4900-EXIT. DTSBX522 02078 EXIT. DTSBX522 02079 DTSBX522 02080 P4910-WRITE. DTSBX522 02081 ** DISPLAY 'P4910 ADJ JRN ' TBL-YRQ (QSUB). DTSBX522 02082 DTSBX522 02083 PERFORM S1000-CORRECTION-BATCH THRU S1000-EXIT. DTSBX522 02084 MOVE W-JC-BATCH TO ACCT-BATCH DTSBX522 02085 MOVE W-JC-ITEM TO ACCT-ITEM. DTSBX522 02086 DTSBX522 02087 MOVE MPRF-EMP-NO TO ACCT-EMP-NO. DTSBX522 02088 MOVE TBL-YRQ (QSUB) TO L004-QTR-5-9. DTSBX522 02089 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBX522 02090 MOVE L004-SLASH-5-QTR TO ACCT-YRQ. DTSBX522 02091 MOVE 'JC' TO ACCT-TRAN DTSBX522 02092 MOVE 'B' TO ACCT-CAT. DTSBX522 02093 ** MOVE W-DEFAULT-DATE TO L001-FED-8-DATE-9. DTSBX522 02094 MOVE L004-QTR-DEFAULT-DUE-DATE TO L001-FED-8-DATE-9. DTSBX522 02095 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX522 02096 IF L001-VALID-DATE DTSBX522 02097 MOVE L001-SLASH-8-DATE TO ACCT-PROCESS-DT DTSBX522 02098 ACCT-RCVD-DT DTSBX522 02099 END-IF. DTSBX522 02100 DTSBX522 02101 SET ACCT-SOURCE-CR-DB-88 TO TRUE. DTSBX522 02102 DTSBX522 02103 ** WRITE ACCT-REC FROM W-ACCT-REC DTSBX522 02104 * IF NOT ACCT-STATUS-OK-88 DTSBX522 02105 * DISPLAY 'CANNOT WRITE TO ACCT FILE ' DTSBX522 02106 * ' ' ACCT-STATUS ' ' ACCT-EMP-NO DTSBX522 02107 * ELSE DTSBX522 02108 * ADD +1 TO W-ACCT-CNT DTSBX522 02109 ** END-IF. DTSBX522 02110 DTSBX522 02111 ** IF MPRF-EMP-NO = 010021 DTSBX522 02112 * DISPLAY 'P4910 ' MPRF-EMP-NO ' ' ACCT-YRQ DTSBX522 02113 * ' ' ACCT-BATCH '/' ACCT-ITEM DTSBX522 02114 * DISPLAY ' ' ACCT-ROW ' ' ACCT-COL DTSBX522 02115 * ' ' ACCT-TRAN ' ' ACCT-AMT DTSBX522 02116 ** END-IF. DTSBX522 02117 P4910-EXIT. DTSBX522 02118 EXIT. DTSBX522 02119 DTSBX522 02120 P5000-PAY-DISTRIBUTION. DTSBX522 02121 MOVE LOW-VALUES TO MDST-KEY-AREA. DTSBX522 02122 MOVE MPRF-EMP-NO TO MDST-EMP-NO. DTSBX522 02123 SET MDST-DST-88 TO TRUE. DTSBX522 02124 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSBX522 02125 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBX522 02126 PERFORM UNTIL L910-NO-REC-88 DTSBX522 02127 MOVE MSKL-REC TO MDST-REC DTSBX522 02128 PERFORM P5100-BUILD-OUTPUT THRU P5100-EXIT DTSBX522 02129 MOVE MDST-REC TO MSKL-REC DTSBX522 02130 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBX522 02131 END-PERFORM. DTSBX522 02132 DTSBX522 02133 P5000-EXIT. DTSBX522 02134 EXIT. DTSBX522 02135 DTSBX522 02136 P5100-BUILD-OUTPUT. DTSBX522 02137 MOVE MDST-EMP-NO TO DST-EMP-NO. DTSBX522 02138 MOVE MDST-BATCH-NO TO DST-BATCH. DTSBX522 02139 MOVE MDST-ITEM-NO TO DST-ITEM. DTSBX522 02140 MOVE MDST-YRQ TO L004-QTR-5-9. DTSBX522 02141 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBX522 02142 MOVE L004-SLASH-5-QTR TO DST-QTR DTSBX522 02143 MOVE MDST-CHNG-DATE TO L001-FED-8-DATE-9. DTSBX522 02144 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX522 02145 MOVE L001-SLASH-8-DATE TO DST-CHNG-DT. DTSBX522 02146 IF L001-INVALID-DATE DTSBX522 02147 DISPLAY 'P5100 INVALID MDST-CHNG-DATE ' DTSBX522 02148 MDST-EMP-NO ' ' MDST-BATCH-NO DTSBX522 02149 ' ' MDST-ITEM-NO DTSBX522 02150 GO TO P5100-EXIT DTSBX522 02151 ELSE DTSBX522 02152 PERFORM DTSBX522 02153 VARYING MDST-ACCT-IDX FROM +1 BY +1 DTSBX522 02154 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT DTSBX522 02155 MOVE MDST-ACCT-IND (MDST-ACCT-IDX) TO DST-ACCT DTSBX522 02156 MOVE MDST-AMT (MDST-ACCT-IDX) TO DST-AMT DTSBX522 02157 PERFORM P5110-WRITE THRU P5110-EXIT DTSBX522 02158 END-PERFORM DTSBX522 02159 END-IF. DTSBX522 02160 DTSBX522 02161 P5100-EXIT. DTSBX522 02162 EXIT. DTSBX522 02163 DTSBX522 02164 P5110-WRITE. DTSBX522 02165 WRITE PAY-DIST-REC FROM W-PAY-DIST-REC. DTSBX522 02166 IF NOT PAYDIST-STATUS-OK-88 DTSBX522 02167 DISPLAY 'CANNOT WRITE TO PAY DIST FILE ' DTSBX522 02168 ' ' PAYDIST-STATUS ' ' DST-EMP-NO DTSBX522 02169 ELSE DTSBX522 02170 ADD +1 TO W-PAY-DIST-CNT DTSBX522 02171 END-IF. DTSBX522 02172 DTSBX522 02173 P5110-EXIT. DTSBX522 02174 EXIT. DTSBX522 02175 DTSBX522 02176 T0000-TERMINATE. DTSBX522 02177 ** CLOSE ACCT-FILE DTSBX522 02178 CLOSE ACCT-FILE-INCR DTSBX522 02179 QTR-FILE DTSBX522 02180 ** TRAN-FILE DTSBX522 02181 TRAN-FILE-INCR DTSBX522 02182 SUMMARY-FILE DTSBX522 02183 PAY-DIST-FILE. DTSBX522 02184 DTSBX522 02185 MOVE W-CURR-UI-TOT TO DISPLAY-AMT1. DTSBX522 02186 DISPLAY '*********************************************'. DTSBX522 02187 DISPLAY '** DTSBX343 TERMINATION STATISTICS **'. DTSBX522 02188 DISPLAY '** **'. DTSBX522 02189 DISPLAY '** QUARTERS ' W-QTR-CNT DTSBX522 02190 ' **'. DTSBX522 02191 DISPLAY '** ACOUNTING ' W-ACCT-CNT DTSBX522 02192 ' **'. DTSBX522 02193 DISPLAY '** ACOUNTING INCR ' W-ACCT-CNT-INCR DTSBX522 02194 ' **'. DTSBX522 02195 DISPLAY '** TRANSACTIONS ' W-TRAN-CNT DTSBX522 02196 ' **'. DTSBX522 02197 DISPLAY '** TRANSACTIONS INCR ' W-TRAN-CNT-INCR DTSBX522 02198 ' **'. DTSBX522 02199 DISPLAY '** REPORTS ' W-RPT-CNT DTSBX522 02200 ' **'. DTSBX522 02201 DISPLAY '** ANN REPORTS ' W-ANN-RPT-CNT DTSBX522 02202 ' **'. DTSBX522 02203 DISPLAY '** PAYMENTS ' W-PAY-CNT DTSBX522 02204 ' **'. DTSBX522 02205 DISPLAY '** PAY DIST ' W-PAY-DIST-CNT DTSBX522 02206 ' **'. DTSBX522 02207 DISPLAY '** ADJUST ' W-ADJ-CNT DTSBX522 02208 ' **'. DTSBX522 02209 DISPLAY '** ERRORS ' W-ERROR-CNT DTSBX522 02210 ' **'. DTSBX522 02211 DISPLAY '** CREDITS CORRECTED ' W-CR-CNT DTSBX522 02212 ' **'. DTSBX522 02213 DISPLAY '** LAST JC BATCH/ITEM ' DTSBX522 02214 W-JC-BATCH '/' W-JC-ITEM DTSBX522 02215 ' **'. DTSBX522 02216 DISPLAY '** **'. DTSBX522 02217 DISPLAY '** **'. DTSBX522 02218 DISPLAY '*********************************************'. DTSBX522 02219 DTSBX522 02220 *** PERFORM T1000-ACCT-TOT THRU T1000-EXIT. DTSBX522 02221 DTSBX522 02222 T0000-EXIT. DTSBX522 02223 EXIT. DTSBX522 02224 DTSBX522 02225 *T1000-ACCT-TOT. DTSBX522 02226 * OPEN INPUT ACCT-FILE. DTSBX522 02227 * IF NOT ACCT-STATUS-OK-88 DTSBX522 02228 * DISPLAY 'T1000 ACCT FILE OPEN ERROR: ' ACCT-STATUS DTSBX522 02229 * MOVE 'FILE OPEN ERROR' DTSBX522 02230 * TO ABEND-MSG DTSBX522 02231 * PERFORM S999-ABEND THRU S999-EXIT DTSBX522 02232 * END-IF. DTSBX522 02233 * DTSBX522 02234 * READ ACCT-FILE INTO W-ACCT-REC. DTSBX522 02235 * IF NOT ACCT-STATUS-OK-88 DTSBX522 02236 * DISPLAY 'T1000 ACCT FILE EMPTY: ' ACCT-STATUS DTSBX522 02237 * ELSE DTSBX522 02238 * PERFORM UNTIL ACCT-STATUS-EOF-88 DTSBX522 02239 * IF ACCT-ROW = 'UI' DTSBX522 02240 * EVALUATE TRUE DTSBX522 02241 * WHEN ACCT-COL = 'CH' DTSBX522 02242 * ADD ACCT-AMT-9 TO W-TOT-CHG DTSBX522 02243 * WHEN ACCT-COL = 'PD' DTSBX522 02244 * ADD ACCT-AMT-9 TO W-TOT-PD DTSBX522 02245 * END-EVALUATE DTSBX522 02246 * END-IF DTSBX522 02247 * END-PERFORM DTSBX522 02248 * END-IF. DTSBX522 02249 * DTSBX522 02250 * CLOSE ACCT-FILE. DTSBX522 02251 * MOVE W-TOT-CHG TO DISPLAY-AMT1. DTSBX522 02252 * MOVE W-TOT-PD TO DISPLAY-AMT2. DTSBX522 02253 * DISPLAY 'BX343 UI CHARGED ' DISPLAY-AMT1. DTSBX522 02254 * DISPLAY ' UI PAID ' DISPLAY-AMT2. DTSBX522 02255 * COMPUTE W-AMT = (W-TOT-CHG - W-TOT-PD). DTSBX522 02256 * MOVE W-AMT TO DISPLAY-AMT3. DTSBX522 02257 * DISPLAY ' BALANCE ' DISPLAY-AMT3. DTSBX522 02258 * DTSBX522 02259 *T1000-EXIT. DTSBX522 02260 * EXIT. DTSBX522 02261 DTSBX522 02262 S001-FROM-FED-8. DTSBX522 02263 SET L001-FROM-FED-8 TO TRUE. DTSBX522 02264 GO TO S001-DATE. DTSBX522 02265 DTSBX522 02266 S001-FROM-ABS-DAY. DTSBX522 02267 SET L001-FROM-ABS-DAY TO TRUE. DTSBX522 02268 GO TO S001-DATE. DTSBX522 02269 DTSBX522 02270 S001-FROM-CAL-6. DTSBX522 02271 SET L001-FROM-CAL-6 TO TRUE. DTSBX522 02272 GO TO S001-DATE. DTSBX522 02273 DTSBX522 02274 S001-DATE. DTSBX522 02275 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX522 02276 S001-EXIT. DTSBX522 02277 EXIT. DTSBX522 02278 SKIP3 DTSBX522 02279 S004-FROM-5. DTSBX522 02280 SET L004-FROM-5 TO TRUE. DTSBX522 02281 GO TO S004-QTR. DTSBX522 02282 DTSBX522 02283 S004-FROM-ABS. DTSBX522 02284 SET L004-FROM-ABS TO TRUE. DTSBX522 02285 GO TO S004-QTR. DTSBX522 02286 DTSBX522 02287 S004-FROM-3. DTSBX522 02288 SET L004-FROM-3 TO TRUE. DTSBX522 02289 GO TO S004-QTR. DTSBX522 02290 DTSBX522 02291 S004-FROM-DATE. DTSBX522 02292 SET L004-FROM-DATE TO TRUE. DTSBX522 02293 GO TO S004-QTR. DTSBX522 02294 DTSBX522 02295 S004-QTR. DTSBX522 02296 DTSBX522 02297 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX522 02298 DTSBX522 02299 S004-EXIT. DTSBX522 02300 EXIT. DTSBX522 02301 SKIP3 DTSBX522 02302 S005-FROM-DATE-TIME. DTSBX522 02303 SET L005-FROM-DATE-TIME TO TRUE. DTSBX522 02304 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBX522 02305 S005-EXIT. DTSBX522 02306 EXIT. DTSBX522 02307 DTSBX522 02308 S910-OPEN-READ. DTSBX522 02309 SET L910-OPEN-READ-88 TO TRUE. DTSBX522 02310 GO TO S910-MSTR-IO. DTSBX522 02311 DTSBX522 02312 S910-READ. DTSBX522 02313 SET L910-READ-88 TO TRUE. DTSBX522 02314 GO TO S910-MSTR-IO. DTSBX522 02315 DTSBX522 02316 S910-START-BROWSE. DTSBX522 02317 SET L910-START-BROWSE-88 TO TRUE. DTSBX522 02318 GO TO S910-MSTR-IO. DTSBX522 02319 DTSBX522 02320 S910-READ-NEXT. DTSBX522 02321 SET L910-READ-NEXT-88 TO TRUE. DTSBX522 02322 GO TO S910-MSTR-IO. DTSBX522 02323 DTSBX522 02324 S910-COUNT. DTSBX522 02325 SET L910-COUNT-88 TO TRUE. DTSBX522 02326 GO TO S910-MSTR-IO. DTSBX522 02327 DTSBX522 02328 S910-REWRITE. DTSBX522 02329 SET L910-REWRITE-88 TO TRUE. DTSBX522 02330 GO TO S910-MSTR-IO. DTSBX522 02331 DTSBX522 02332 S910-CLOSE. DTSBX522 02333 SET L910-CLOSE-88 TO TRUE. DTSBX522 02334 GO TO S910-MSTR-IO. DTSBX522 02335 DTSBX522 02336 S910-MSTR-IO. DTSBX522 02337 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX522 02338 MSKL-REC. DTSBX522 02339 S910-EXIT. DTSBX522 02340 EXIT. DTSBX522 02341 SKIP3 DTSBX522 02342 DTSBX522 02343 S931-READ. DTSBX522 02344 SET L931-READ-88 TO TRUE. DTSBX522 02345 GO TO S931-REF-IO. DTSBX522 02346 DTSBX522 02347 S931-REF-IO. DTSBX522 02348 CALL 'DTSBU931' USING L931-LINK-AREA DTSBX522 02349 FSKL-REC. DTSBX522 02350 S931-EXIT. DTSBX522 02351 EXIT. DTSBX522 02352 DTSBX522 02353 S1000-CORRECTION-BATCH. DTSBX522 02354 IF W-JC-ITEM < +999 DTSBX522 02355 ADD +1 TO W-JC-ITEM DTSBX522 02356 ELSE DTSBX522 02357 ADD +1 TO W-JC-BATCH DTSBX522 02358 MOVE +1 TO W-JC-ITEM DTSBX522 02359 END-IF. DTSBX522 02360 DTSBX522 02361 S1000-EXIT. DTSBX522 02362 EXIT. DTSBX522 02363 DTSBX522 02364 S999-ABEND. DTSBX522 02365 DISPLAY '*** DTSBX343 ABENDING. ' DTSBX522 02366 ABEND-MSG. DTSBX522 02367 DTSBX522 02368 CALL 'DTSBU999' USING W-ABEND-CD. DTSBX522 02369 S999-EXIT. DTSBX522 02370 EXIT. DTSBX522