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