00001 IDENTIFICATION DIVISION. 07/09/24 00002 PROGRAM-ID. DTSBE444. DTSBE444 00003 AUTHOR. TRW. LV061 00004 DATE-WRITTEN. NOVEMBER 2000. DTSBE444 00005 DATE-COMPILED. DTSBE444 00006 SKIP3 DTSBE444 00007 ***** DTSBE444 00008 * DTSBE444 00009 * FUNCTION: AGING OF ACCOUNTS RECEIVABLE WEEKLY VERSION CL**2 00010 * DTSBE444 00011 * DTSBE444 00012 * MODIFICATION LOG: DTSBE444 00013 * DTSBE444 00014 * 11/01/2000 MODIFED FROM DTSBE440. DTSBE444 00015 * WORK ORDER: DIR00084 PROGRAMMER: GD DTSBE444 00016 * DTSBE444 00017 * 01/24/2006 MODIFED FOR CFO - MONTHLY TRACKING. DTSBE444 00018 * WORK ORDER: PROGRAMMER: GD DTSBE444 00019 * DTSBE444 00020 * 05/13/2008 REQUEST FROM CFO - ADDED EMP CLASS TO AGING DTSBE444 00021 * QUARTER EXTRACT. DTSBE444 00022 * WORK ORDER: PROGRAMMER: GD DTSBE444 00023 * DTSBE444 00024 * 02/22/2404 CREATED WEEKLY VERSION OF PROGRAM CL**2 00025 * QUARTER EXTRACT. CL**2 00026 * WORK ORDER: PROGRAMMER: ZL1 CL**2 00027 * CL**2 00028 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE444 00029 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE444 00030 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBE444 00031 * DTSBE444 00032 * DTSBE444 00033 * DESCRIPTION: DTSBE444 00034 * DTSBE444 00035 * DTSBE444 00036 * INITIATION: DTSBE444 00037 * DTSBE444 00038 * SET LECM-MST-OPEN-READ-88 TO TRUE. DTSBE444 00039 * DTSBE444 00040 * EDIT AND DEFAULT PARAMETERS. DTSBE444 00041 * DTSBE444 00042 * DTSBE444 00043 * PROCESSING: DTSBE444 00044 * DTSBE444 00045 * SEE PRINTED OUTPUTS DESCRIPTION AND LAYOUTS (442R1). DTSBE444 00046 * DTSBE444 00047 * DTSBE444 00048 * TERMINATION: DTSBE444 00049 * DTSBE444 00050 * DTSBE444 00051 * DTSBE444 00052 * DTSBE444 00053 * RECORDS READ: DTSBE444 00054 * DTSBE444 00055 * MASTER: DTSBE444 00056 * DTSBE444 00057 * MHDR DTSBE444 00058 * MSOL DTSBE444 00059 * MQTR DTSBE444 00060 * MJRN DTSBE444 00061 * DTSBE444 00062 * DTSBE444 00063 * ALTERNATE INDEX: DTSBE444 00064 * DTSBE444 00065 * NONE. DTSBE444 00066 * DTSBE444 00067 * DTSBE444 00068 * REFERENCE: DTSBE444 00069 * DTSBE444 00070 * DTSBE444 00071 * DTSBE444 00072 * RECORDS UPDATED: DTSBE444 00073 * DTSBE444 00074 * NONE DTSBE444 00075 * DTSBE444 00076 * DTSBE444 00077 * REPORT RECORDS WRITTEN: DTSBE444 00078 * DTSBE444 00079 * R442 ACCOUNTS RECEIVABLE AGING. DTSBE444 00080 * DTSBE444 00081 * DTSBE444 00082 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBE444 00083 * DTSBE444 00084 * NONE. DTSBE444 00085 * DTSBE444 00086 * DTSBE444 00087 * MODULES CALLED: DTSBE444 00088 * DTSBE444 00089 * DTSBU001 DATE EDIT/CONVERSION. DTSBE444 00090 * DTSBU004 QUARTER EDIT/CONVERSION. DTSBE444 00091 * DTSBU005 ABSOLUTE TIME CONVERSION/EDIT. DTSBE444 00092 * DTSBU910 MASTER FILE I/O. DTSBE444 00093 * DTSBU946 VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1. DTSBE444 00094 * DTSBE444 00095 * DTSBE444 00096 ***** DTSBE444 00097 SKIP3 DTSBE444 00098 ENVIRONMENT DIVISION. DTSBE444 00099 INPUT-OUTPUT SECTION. DTSBE444 00100 DTSBE444 00101 FILE-CONTROL. DTSBE444 00102 DTSBE444 00103 SELECT AGING-REPORT ASSIGN TO AGINGFLE DTSBE444 00104 FILE STATUS IS AGING-STATUS. DTSBE444 00105 DTSBE444 00106 SELECT AUDIT-FILE ASSIGN TO AUDTFILE DTSBE444 00107 FILE STATUS IS AUDIT-STATUS. DTSBE444 00108 DTSBE444 00109 SELECT QTR-FILE ASSIGN TO QTRFILE DTSBE444 00110 FILE STATUS IS QTR-STATUS. DTSBE444 00111 DTSBE444 00112 SELECT PAY-FILE ASSIGN TO PAYFILE DTSBE444 00113 FILE STATUS IS PAY-STATUS. DTSBE444 00114 DTSBE444 00115 SELECT CREDIT-FILE ASSIGN TO CREDFILE DTSBE444 00116 FILE STATUS IS CREDIT-STATUS. DTSBE444 00117 DTSBE444 00118 DATA DIVISION. DTSBE444 00119 FILE SECTION. DTSBE444 00120 DTSBE444 00121 FD AGING-REPORT DTSBE444 00122 RECORDING MODE IS F DTSBE444 00123 BLOCK CONTAINS 0 RECORDS DTSBE444 00124 LABEL RECORDS ARE OMITTED. DTSBE444 00125 DTSBE444 00126 01 AGING-REC PIC X(100). CL*16 00127 DTSBE444 00128 FD AUDIT-FILE DTSBE444 00129 RECORDING MODE IS F DTSBE444 00130 BLOCK CONTAINS 0 RECORDS DTSBE444 00131 LABEL RECORDS ARE OMITTED. DTSBE444 00132 DTSBE444 00133 01 AUDIT-REC PIC X(97). DTSBE444 00134 DTSBE444 00135 FD QTR-FILE DTSBE444 00136 RECORDING MODE IS F DTSBE444 00137 BLOCK CONTAINS 0 RECORDS DTSBE444 00138 LABEL RECORDS ARE OMITTED. DTSBE444 00139 DTSBE444 00140 01 QTR-REC PIC X(144). CL*59 00141 DTSBE444 00142 FD PAY-FILE DTSBE444 00143 RECORDING MODE IS F DTSBE444 00144 BLOCK CONTAINS 0 RECORDS DTSBE444 00145 LABEL RECORDS ARE OMITTED. DTSBE444 00146 DTSBE444 00147 01 PAY-REC PIC X(97). DTSBE444 00148 DTSBE444 00149 FD CREDIT-FILE DTSBE444 00150 RECORDING MODE IS F DTSBE444 00151 BLOCK CONTAINS 0 RECORDS DTSBE444 00152 LABEL RECORDS ARE OMITTED. DTSBE444 00153 DTSBE444 00154 01 CREDIT-REC PIC X(86). DTSBE444 00155 DTSBE444 00156 WORKING-STORAGE SECTION. DTSBE444 001565 77 PAN-VALET PICTURE X(24) VALUE '061DTSBE444 07/09/24'. DTSBE444 00157 77 PAN-VALET PICTURE X(24) VALUE '005DTSBE442 05/16/08'. DTSBE444 00158 SKIP3 DTSBE444 00159 01 WRK-AREA. DTSBE444 00160 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +442.DTSBE444 00161 DTSBE444 00162 05 ABEND-MSG PIC X(60). DTSBE444 00163 DTSBE444 00164 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBE442'.DTSBE444 00165 DTSBE444 00166 05 AGING-STATUS PIC X(02). DTSBE444 00167 88 AGING-STATUS-OK-88 VALUE '00'. DTSBE444 00168 88 AGING-STATUS-EOF-88 VALUE '10'. DTSBE444 00169 DTSBE444 00170 05 AUDIT-STATUS PIC X(02). DTSBE444 00171 88 AUDIT-STATUS-OK-88 VALUE '00'. DTSBE444 00172 DTSBE444 00173 05 QTR-STATUS PIC X(02). DTSBE444 00174 88 QTR-STATUS-OK-88 VALUE '00'. DTSBE444 00175 DTSBE444 00176 05 PAY-STATUS PIC X(02). DTSBE444 00177 88 PAY-STATUS-OK-88 VALUE '00'. DTSBE444 00178 DTSBE444 00179 05 CREDIT-STATUS PIC X(02). DTSBE444 00180 88 CREDIT-STATUS-OK-88 VALUE '00'. DTSBE444 00181 DTSBE444 00182 05 WRK-SEQ-NO PIC S9(07) COMP-3 DTSBE444 00183 VALUE +0. DTSBE444 00184 DTSBE444 00185 05 WRK-LAST-DEL-YRQ PIC S9(05) COMP-3. DTSBE444 00186 DTSBE444 00187 05 WRK-3-YEARS-AGO-YRQ PIC S9(05) COMP-3. DTSBE444 00188 DTSBE444 00189 05 WRK-19994-YRQ PIC S9(05) COMP-3. DTSBE444 00190 DTSBE444 00191 05 WRK-3-YEARS-AGO-DATE PIC S9(09) COMP-3. DTSBE444 00192 DTSBE444 00193 05 WRK-MTH-BEGIN-DATE PIC S9(09) COMP-3. DTSBE444 00194 05 WRK-MTH-END-DATE PIC S9(09) COMP-3. DTSBE444 00195 DTSBE444 00196 05 WRK-INACT-DATE PIC S9(09) COMP-3. DTSBE444 00197 DTSBE444 00198 05 TSUB PIC 9(04) VALUE ZEROS. CL*24 00199 05 ZSUB PIC 9(04) VALUE ZEROS. CL*34 00200 DTSBE444 00201 05 TSUB-MAX PIC S9(04) COMP DTSBE444 00202 VALUE +150. CL*35 00203 05 QTR-UIT PIC S9(11)V99 COMP-3 VALUE 0. CL*39 00204 05 QTR-SURT PIC S9(11)V99 COMP-3 VALUE 0. CL*39 00205 05 QTR-LPT PIC S9(11)V99 COMP-3 VALUE 0. CL*39 00206 05 QTR-NSFT PIC S9(11)V99 COMP-3 VALUE 0. CL*39 00207 05 QTR-MSFT PIC S9(11)V99 COMP-3 VALUE 0. CL*39 00208 05 QTR-INTT PIC S9(11)V99 COMP-3 VALUE 0. CL*39 00209 05 QTR-DEFT PIC S9(11)V99 COMP-3 VALUE 0. CL*45 00210 DTSBE444 00211 05 CTAB-CORRECTION-TABLE OCCURS 150 TIMES. CL*35 00212 * INDEXED BY CTAB-IDX. CL*33 00213 10 CTAB-QTR-YRQ PIC S9(05) COMP-3 VALUE 0. CL*36 00214 10 CTAB-QTR-TAX-BAL PIC S9(11)V99 COMP-3 VALUE 0. CL*36 00215 10 CTAB-QTR-UI-BAL PIC S9(11)V99 COMP-3 VALUE 0. CL*36 00216 10 CTAB-QTR-SUR-BAL PIC S9(11)V99 COMP-3 VALUE 0. CL*36 00217 10 CTAB-QTR-PEN-BAL PIC S9(11)V99 COMP-3 VALUE 0. CL*36 00218 10 CTAB-QTR-LP-BAL PIC S9(11)V99 COMP-3 VALUE 0. CL*36 00219 10 CTAB-QTR-NSF-BAL PIC S9(11)V99 COMP-3 VALUE 0. CL*36 00220 10 CTAB-QTR-MSF-BAL PIC S9(11)V99 COMP-3 VALUE 0. CL*36 00221 10 CTAB-QTR-INT-BAL PIC S9(11)V99 COMP-3 VALUE 0. CL*36 00222 10 CTAB-QTR-DEF-BAL PIC S9(11)V99 COMP-3 VALUE 0. CL*44 00223 10 CTAB-QTR-20051-PEN PIC S9(11)V99 COMP-3 VALUE 0. CL*36 00224 10 CTAB-JRN-TAX-BAL PIC S9(11)V99 COMP-3 VALUE 0. CL*36 00225 10 CTAB-JRN-PEN-BAL PIC S9(11)V99 COMP-3 VALUE 0. CL*36 00226 10 CTAB-JRN-INT-BAL PIC S9(11)V99 COMP-3 VALUE 0. CL*36 00227 10 CTAB-JRN-20051-PEN PIC S9(11)V99 COMP-3 VALUE 0. CL*36 00228 DTSBE444 00229 05 WRK-MQTR-TAX-BAL PIC S9(11)V99 COMP-3 VALUE 0. CL*31 00230 05 WRK-MQTR-PEN-BAL PIC S9(11)V99 COMP-3 VALUE 0. CL*31 00231 05 WRK-MQTR-INT-BAL PIC S9(11)V99 COMP-3 VALUE 0. CL*31 00232 05 QTR-TOTAL PIC S9(11)V99 COMP-3 VALUE 0. CL*40 00233 05 WRK-AMT PIC S9(11)V99 COMP-3. CL*10 00234 05 WRK-CREDIT-PAID-RATED PIC S9(11)V99 COMP-3. DTSBE444 00235 05 WRK-CREDIT-TOL-RATED PIC S9(11)V99 COMP-3. DTSBE444 00236 05 WRK-CREDIT-WRITEOFF-RATED PIC S9(11)V99 COMP-3. DTSBE444 00237 05 WRK-CREDIT-PAID-SI PIC S9(11)V99 COMP-3. DTSBE444 00238 05 WRK-CREDIT-TOL-SI PIC S9(11)V99 COMP-3. DTSBE444 00239 05 WRK-CREDIT-WRITEOFF-SI PIC S9(11)V99 COMP-3. DTSBE444 00240 05 WRK-CREDIT-PAID-UNK PIC S9(11)V99 COMP-3. DTSBE444 00241 05 WRK-CREDIT-TOL-UNK PIC S9(11)V99 COMP-3. DTSBE444 00242 05 WRK-CREDIT-WRITEOFF-UNK PIC S9(11)V99 COMP-3. DTSBE444 00243 05 WRK-CREDIT-AMT PIC S9(11)V99 COMP-3. DTSBE444 00244 05 WRK-TOTAL-RATED-TAX PIC S9(11)V99 COMP-3 DTSBE444 00245 VALUE +0. DTSBE444 00246 05 WRK-TOT-SI-TAX PIC S9(11)V99 COMP-3 DTSBE444 00247 VALUE +0. DTSBE444 00248 DTSBE444 00249 05 SUB PIC S9(04) COMP. DTSBE444 00250 DTSBE444 00251 05 WRK-QTR-MAX PIC S9(04) COMP DTSBE444 00252 VALUE +7. DTSBE444 00253 DTSBE444 00254 05 WRK-QTR-TABLE OCCURS 7 TIMES DTSBE444 00255 INDEXED BY WRK-QTR-IDX. DTSBE444 00256 10 WRK-QTR-YRQ PIC S9(05) COMP-3. DTSBE444 00257 10 WRK-QTR-RATED-TAX PIC S9(11)V99 COMP-3. DTSBE444 00258 10 WRK-QTR-RATED-PEN PIC S9(11)V99 COMP-3. DTSBE444 00259 10 WRK-QTR-RATED-INT PIC S9(11)V99 COMP-3. DTSBE444 00260 10 WRK-QTR-SELF-INS-TAX PIC S9(11)V99 COMP-3. DTSBE444 00261 10 WRK-QTR-SELF-INS-PEN PIC S9(11)V99 COMP-3. DTSBE444 00262 10 WRK-QTR-SELF-INS-INT PIC S9(11)V99 COMP-3. DTSBE444 00263 DTSBE444 00264 05 WRK-3-YR-RATED-TAX PIC S9(11)V99 COMP-3. DTSBE444 00265 05 WRK-3-YR-RATED-PEN PIC S9(11)V99 COMP-3. DTSBE444 00266 05 WRK-3-YR-RATED-INT PIC S9(11)V99 COMP-3. DTSBE444 00267 05 WRK-3-YR-SELF-INS-TAX PIC S9(11)V99 COMP-3. DTSBE444 00268 05 WRK-3-YR-SELF-INS-PEN PIC S9(11)V99 COMP-3. DTSBE444 00269 05 WRK-3-YR-SELF-INS-INT PIC S9(11)V99 COMP-3. DTSBE444 00270 DTSBE444 00271 05 WRK-TOT-RATED-TAX PIC S9(11)V99 COMP-3. DTSBE444 00272 05 WRK-TOT-RATED-PEN PIC S9(11)V99 COMP-3. DTSBE444 00273 05 WRK-TOT-RATED-INT PIC S9(11)V99 COMP-3. DTSBE444 00274 05 WRK-TOT-SELF-INS-TAX PIC S9(11)V99 COMP-3. DTSBE444 00275 05 WRK-TOT-SELF-INS-PEN PIC S9(11)V99 COMP-3. DTSBE444 00276 05 WRK-TOT-SELF-INS-INT PIC S9(11)V99 COMP-3. DTSBE444 00277 DTSBE444 00278 05 WRK-ACTIVE-RATED-TAX PIC S9(11)V99 COMP-3. DTSBE444 00279 05 WRK-ACTIVE-RATED-PEN PIC S9(11)V99 COMP-3. DTSBE444 00280 05 WRK-ACTIVE-RATED-INT PIC S9(11)V99 COMP-3. DTSBE444 00281 05 WRK-ACTIVE-SELF-INS-TAX PIC S9(11)V99 COMP-3. DTSBE444 00282 05 WRK-ACTIVE-SELF-INS-PEN PIC S9(11)V99 COMP-3. DTSBE444 00283 05 WRK-ACTIVE-SELF-INS-INT PIC S9(11)V99 COMP-3. DTSBE444 00284 DTSBE444 00285 05 WRK-INACT-RATED-TAX PIC S9(11)V99 COMP-3. DTSBE444 00286 05 WRK-INACT-RATED-PEN PIC S9(11)V99 COMP-3. DTSBE444 00287 05 WRK-INACT-RATED-INT PIC S9(11)V99 COMP-3. DTSBE444 00288 05 WRK-INACT-SELF-INS-TAX PIC S9(11)V99 COMP-3. DTSBE444 00289 05 WRK-INACT-SELF-INS-PEN PIC S9(11)V99 COMP-3. DTSBE444 00290 05 WRK-INACT-SELF-INS-INT PIC S9(11)V99 COMP-3. DTSBE444 00291 DTSBE444 00292 05 WRK-INACT-3YR-RATED-TAX PIC S9(11)V99 COMP-3. DTSBE444 00293 05 WRK-INACT-3YR-RATED-PEN PIC S9(11)V99 COMP-3. DTSBE444 00294 05 WRK-INACT-3YR-RATED-INT PIC S9(11)V99 COMP-3. DTSBE444 00295 05 WRK-INACT-3YR-SELF-INS-TAX PIC S9(11)V99 COMP-3. DTSBE444 00296 05 WRK-INACT-3YR-SELF-INS-PEN PIC S9(11)V99 COMP-3. DTSBE444 00297 05 WRK-INACT-3YR-SELF-INS-INT PIC S9(11)V99 COMP-3. DTSBE444 00298 DTSBE444 00299 05 WRK-CHAPTER-7-RATED-TAX PIC S9(11)V99 COMP-3. DTSBE444 00300 05 WRK-CHAPTER-7-RATED-PEN PIC S9(11)V99 COMP-3. DTSBE444 00301 05 WRK-CHAPTER-7-RATED-INT PIC S9(11)V99 COMP-3. DTSBE444 00302 05 WRK-CHAPTER-7-SELF-INS-TAX PIC S9(11)V99 COMP-3. DTSBE444 00303 05 WRK-CHAPTER-7-SELF-INS-PEN PIC S9(11)V99 COMP-3. DTSBE444 00304 05 WRK-CHAPTER-7-SELF-INS-INT PIC S9(11)V99 COMP-3. DTSBE444 00305 DTSBE444 00306 05 WRK-CHAPTER-11-RATED-TAX PIC S9(11)V99 COMP-3. DTSBE444 00307 05 WRK-CHAPTER-11-RATED-PEN PIC S9(11)V99 COMP-3. DTSBE444 00308 05 WRK-CHAPTER-11-RATED-INT PIC S9(11)V99 COMP-3. DTSBE444 00309 05 WRK-CHAPTER-11-SELF-INS-TAX PIC S9(11)V99 COMP-3. DTSBE444 00310 05 WRK-CHAPTER-11-SELF-INS-PEN PIC S9(11)V99 COMP-3. DTSBE444 00311 05 WRK-CHAPTER-11-SELF-INS-INT PIC S9(11)V99 COMP-3. DTSBE444 00312 DTSBE444 00313 05 WRK-19994-RATED-TAX PIC S9(11)V99 COMP-3. DTSBE444 00314 05 WRK-19994-RATED-PEN PIC S9(11)V99 COMP-3. DTSBE444 00315 05 WRK-19994-RATED-INT PIC S9(11)V99 COMP-3. DTSBE444 00316 05 WRK-19994-SELF-INS-TAX PIC S9(11)V99 COMP-3. DTSBE444 00317 05 WRK-19994-SELF-INS-PEN PIC S9(11)V99 COMP-3. DTSBE444 00318 05 WRK-19994-SELF-INS-INT PIC S9(11)V99 COMP-3. DTSBE444 00319 DTSBE444 00320 05 WRK-MTH-RATED-TAX-PAY PIC S9(11)V99 COMP-3. DTSBE444 00321 05 WRK-MTH-RATED-PEN-PAY PIC S9(11)V99 COMP-3. DTSBE444 00322 05 WRK-MTH-RATED-INT-PAY PIC S9(11)V99 COMP-3. DTSBE444 00323 05 WRK-MTH-RATED-CRED-PAY PIC S9(11)V99 COMP-3. DTSBE444 00324 DTSBE444 00325 05 WRK-MTH-SI-TAX-PAY PIC S9(11)V99 COMP-3. DTSBE444 00326 05 WRK-MTH-SI-PEN-PAY PIC S9(11)V99 COMP-3. DTSBE444 00327 05 WRK-MTH-SI-INT-PAY PIC S9(11)V99 COMP-3. DTSBE444 00328 05 WRK-MTH-SI-CRED-PAY PIC S9(11)V99 COMP-3. DTSBE444 00329 DTSBE444 00330 05 WRK-MTH-UNK-TAX-PAY PIC S9(11)V99 COMP-3. DTSBE444 00331 05 WRK-MTH-UNK-PEN-PAY PIC S9(11)V99 COMP-3. DTSBE444 00332 05 WRK-MTH-UNK-INT-PAY PIC S9(11)V99 COMP-3. DTSBE444 00333 05 WRK-MTH-UNK-CRED-PAY PIC S9(11)V99 COMP-3. DTSBE444 00334 DTSBE444 00335 05 WRK-ERROR-IND PIC X(01). DTSBE444 00336 DTSBE444 00337 88 WRK-ERROR-YES-88 VALUE 'Y'. DTSBE444 00338 88 WRK-ERROR-NO-88 VALUE 'N'. DTSBE444 00339 DTSBE444 00340 05 WRK-STATUS-IND PIC X(01). DTSBE444 00341 88 WRK-STAT-ACTIVE VALUE '0'. DTSBE444 00342 88 WRK-STAT-INACT VALUE '1'. DTSBE444 00343 88 WRK-STAT-INACT-3-YR VALUE '2'. DTSBE444 00344 88 WRK-STAT-INVALID VALUE '9'. DTSBE444 00345 DTSBE444 00346 05 WRK-BANKRUPTCY-IND PIC X(01). DTSBE444 00347 88 WRK-BNK-NONE VALUE '0'. DTSBE444 00348 88 WRK-BNK-CHAP-7 VALUE '1'. DTSBE444 00349 88 WRK-BNK-CHAP-11 VALUE '2'. DTSBE444 00350 DTSBE444 00351 05 WRK-AUDIT-HEADER1. DTSBE444 00352 10 FILLER PIC X(26) DTSBE444 00353 VALUE 'RECEIVABLE DETAIL THROUGH '. DTSBE444 00354 10 AUDIT-HDR1-DATE PIC X(10). DTSBE444 00355 DTSBE444 00356 05 WRK-AUDIT-HEADER2. DTSBE444 00357 10 FILLER PIC X(08) DTSBE444 00358 VALUE 'EMPLOYER'. DTSBE444 00359 10 FILLER PIC X(01) VALUE ','. DTSBE444 00360 10 FILLER PIC X(04) DTSBE444 00361 VALUE 'NAME'. DTSBE444 00362 10 FILLER PIC X(01) VALUE ','. DTSBE444 00363 10 FILLER PIC X(05) DTSBE444 00364 VALUE 'CLASS'. DTSBE444 00365 10 FILLER PIC X(01) VALUE ','. DTSBE444 00366 10 FILLER PIC X(05) DTSBE444 00367 VALUE 'BATCH'. DTSBE444 00368 10 FILLER PIC X(01) VALUE ','. DTSBE444 00369 10 FILLER PIC X(04) DTSBE444 00370 VALUE 'ITEM'. DTSBE444 00371 10 FILLER PIC X(01) VALUE ','. DTSBE444 00372 10 FILLER PIC X(04) DTSBE444 00373 VALUE 'TYPE'. DTSBE444 00374 10 FILLER PIC X(01) VALUE ','. DTSBE444 00375 10 FILLER PIC X(14) DTSBE444 00376 VALUE 'PROCESSED DATE'. DTSBE444 00377 10 FILLER PIC X(01) VALUE ','. DTSBE444 00378 10 FILLER PIC X(06) DTSBE444 00379 VALUE 'AMOUNT'. DTSBE444 00380 10 FILLER PIC X(01) VALUE ','. DTSBE444 00381 10 FILLER PIC X(07) DTSBE444 00382 VALUE 'ACCOUNT'. DTSBE444 00383 10 FILLER PIC X(01) VALUE ','. DTSBE444 00384 10 FILLER PIC X(07) DTSBE444 00385 VALUE 'QUARTER'. DTSBE444 00386 DTSBE444 00387 05 WRK-AUDIT-REC. DTSBE444 00388 ** 10 AUDIT-SEQ-NO PIC 9(07). DTSBE444 00389 ** 10 FILLER PIC X(01) VALUE ','. DTSBE444 00390 10 AUDIT-EMP-NO PIC 9(06). DTSBE444 00391 10 FILLER PIC X(01) VALUE ','. DTSBE444 00392 10 AUDIT-PRIMARY-NAME PIC X(40). DTSBE444 00393 10 FILLER PIC X(01) VALUE ','. DTSBE444 00394 10 AUDIT-EMP-CLASS PIC X(02). DTSBE444 00395 10 FILLER PIC X(01) VALUE ','. DTSBE444 00396 10 AUDIT-BATCH-NO PIC 9(05). DTSBE444 00397 10 FILLER PIC X(01) VALUE ','. DTSBE444 00398 10 AUDIT-ITEM-NO PIC 9(03). DTSBE444 00399 10 FILLER PIC X(01) VALUE ','. DTSBE444 00400 10 AUDIT-TRAN PIC X(02). DTSBE444 00401 10 FILLER PIC X(01) VALUE ','. DTSBE444 00402 10 AUDIT-PROC-DATE PIC X(10). DTSBE444 00403 10 FILLER PIC X(01) VALUE ','. DTSBE444 00404 10 AUDIT-AMT PIC --------9.99. DTSBE444 00405 10 FILLER PIC X(01) VALUE ','. DTSBE444 00406 10 AUDIT-ACCT PIC X(02). DTSBE444 00407 10 FILLER PIC X(01) VALUE ','. DTSBE444 00408 10 AUDIT-YRQ PIC X(06). DTSBE444 00409 DTSBE444 00410 05 WRK-QTR-HEADER1. DTSBE444 00411 10 FILLER PIC X(50) VALUE SPACES. CL*59 00412 10 FILLER PIC X(28) CL*59 00413 VALUE ' WEEKLY RECEIVABLES THROUGH '. CL*59 00414 10 QTR-HDR1-DATE PIC X(10). DTSBE444 00415 DTSBE444 00416 05 WRK-QTR-HEADER2. DTSBE444 00417 10 FILLER PIC X(40) VALUE CL*61 00418 'EAN,NAME,CLASS,STATUS,QTR,UI-TAX,SU-TAX,'. CL*61 00419 10 FILLER PIC X(43) VALUE CL*59 00420 'LATE-PEN,NSF-PEN,MISC-PEN,INTEREST,AMT-OWED'. CL*59 00421 10 FILLER PIC X(20) VALUE SPACES. CL*59 00422 DTSBE444 00423 05 WRK-QTR-REC. DTSBE444 00424 10 QTR-EMP-NO PIC 9(06). DTSBE444 00425 10 FILLER PIC X(01) VALUE ','. DTSBE444 00426 10 QTR-PRIMARY-NAME PIC X(40). DTSBE444 00427 10 FILLER PIC X(01) VALUE ','. DTSBE444 00428 10 QTR-EMP-CLASS PIC X(01). DTSBE444 00429 10 FILLER PIC X(01) VALUE ','. DTSBE444 00430 10 QTR-EMP-STATUS PIC X(01). CL*59 00431 10 FILLER PIC X(01) VALUE ','. CL*59 00432 10 QTR-YRQ PIC X(06). DTSBE444 00433 10 FILLER PIC X(01) VALUE ','. DTSBE444 00434 10 QTR-UI PIC -------9.99. CL**3 00435 10 FILLER PIC X(01) VALUE ','. DTSBE444 00436 10 QTR-SUR PIC -------9.99. CL**3 00437 10 FILLER PIC X(01) VALUE ','. CL**3 00438 10 QTR-LP PIC -------9.99. CL**3 00439 10 FILLER PIC X(01) VALUE ','. DTSBE444 00440 10 QTR-NSF PIC -------9.99. CL**5 00441 10 FILLER PIC X(01) VALUE ','. CL**3 00442 10 QTR-MSF PIC -------9.99. CL**5 00443 10 FILLER PIC X(01) VALUE ','. CL**3 00444 10 QTR-INT PIC -------9.99. CL**3 00445 * 10 FILLER PIC X(01) VALUE ','. CL*51 00446 * 10 QTR-DEF PIC ---------9.99. CL*51 00447 10 FILLER PIC X(01) VALUE ','. CL*44 00448 10 QTR-TOT PIC ---------9.99. CL*44 00449 DTSBE444 00450 05 WRK-CREDIT-HEADER1. DTSBE444 00451 10 FILLER PIC X(16) DTSBE444 00452 VALUE 'CREDITS THROUGH '. DTSBE444 00453 10 CREDIT-HDR1-DATE PIC X(10). DTSBE444 00454 DTSBE444 00455 05 WRK-CREDIT-HEADER2. DTSBE444 00456 10 FILLER PIC X(08) DTSBE444 00457 VALUE 'EMPLOYER'. DTSBE444 00458 10 FILLER PIC X(01) VALUE ','. DTSBE444 00459 10 FILLER PIC X(04) DTSBE444 00460 VALUE 'NAME'. DTSBE444 00461 10 FILLER PIC X(01) VALUE ','. DTSBE444 00462 10 FILLER PIC X(05) DTSBE444 00463 VALUE 'CLASS'. DTSBE444 00464 10 FILLER PIC X(01) VALUE ','. DTSBE444 00465 10 FILLER PIC X(05) DTSBE444 00466 VALUE 'BATCH'. DTSBE444 00467 10 FILLER PIC X(01) VALUE ','. DTSBE444 00468 10 FILLER PIC X(04) DTSBE444 00469 VALUE 'ITEM'. DTSBE444 00470 10 FILLER PIC X(01) VALUE ','. DTSBE444 00471 10 FILLER PIC X(14) DTSBE444 00472 VALUE 'PROCESSED DATE'. DTSBE444 00473 10 FILLER PIC X(01) VALUE ','. DTSBE444 00474 10 FILLER PIC X(06) DTSBE444 00475 VALUE 'AMOUNT'. DTSBE444 00476 DTSBE444 00477 05 WRK-CREDIT-REC. DTSBE444 00478 10 CREDIT-EMP-NO PIC 9(06). DTSBE444 00479 10 FILLER PIC X(01) VALUE ','. DTSBE444 00480 10 CREDIT-PRIMARY-NAME PIC X(40). DTSBE444 00481 10 FILLER PIC X(01) VALUE ','. DTSBE444 00482 10 CREDIT-EMP-CLASS PIC X(02). DTSBE444 00483 10 FILLER PIC X(01) VALUE ','. DTSBE444 00484 10 CREDIT-BATCH-NO PIC 9(05). DTSBE444 00485 10 FILLER PIC X(01) VALUE ','. DTSBE444 00486 10 CREDIT-ITEM-NO PIC 9(03). DTSBE444 00487 10 FILLER PIC X(01) VALUE ','. DTSBE444 00488 10 CREDIT-PROC-DATE PIC X(10). DTSBE444 00489 10 FILLER PIC X(01) VALUE ','. DTSBE444 00490 10 CREDIT-AMT PIC ----------9.99. DTSBE444 00491 DTSBE444 00492 05 WRK-RPT-HEADER1. DTSBE444 00493 10 FILLER PIC X(31) VALUE SPACES. DTSBE444 00494 10 FILLER PIC X(37) DTSBE444 00495 VALUE 'AGING OF EMPLOYER ACCOUNTS RECEIVABLE'. DTSBE444 00496 10 FILLER PIC X(32) VALUE SPACES. DTSBE444 00497 DTSBE444 00498 05 WRK-RPT-HEADER2. DTSBE444 00499 10 FILLER PIC X(44) VALUE SPACES. DTSBE444 00500 10 WRK-RPT-EMP-CLASS PIC X(12). DTSBE444 00501 10 FILLER PIC X(44) VALUE SPACES. DTSBE444 00502 DTSBE444 00503 05 WRK-RPT-HEADER3. DTSBE444 00504 10 FILLER PIC X(30) VALUE SPACES. DTSBE444 00505 10 FILLER PIC X(30) VALUE DTSBE444 00506 'INCLUDES TRANSACTIONS THROUGH '. DTSBE444 00507 10 WRK-RPT-HEADER-DATE PIC X(10). DTSBE444 00508 10 FILLER PIC X(30) VALUE SPACES. DTSBE444 00509 DTSBE444 00510 05 WRK-RPT-HEADER4. DTSBE444 00511 10 FILLER PIC X(06) VALUE SPACES. DTSBE444 00512 10 WRK-RPT-HDR4-DESC PIC X(20) VALUE DTSBE444 00513 'QUARTER/DESCRIPTION'. DTSBE444 00514 10 FILLER PIC X(04) VALUE SPACES. DTSBE444 00515 10 WRK-RPT-HDR4-TAX PIC X(17) VALUE DTSBE444 00516 ' TAX '. DTSBE444 00517 10 FILLER PIC X(04) VALUE SPACES. DTSBE444 00518 10 WRK-RPT-HDR4-PEN PIC X(17) VALUE DTSBE444 00519 ' PENALTY '. DTSBE444 00520 10 FILLER PIC X(04) VALUE SPACES. DTSBE444 00521 10 WRK-RPT-HDR4-INT PIC X(17) VALUE DTSBE444 00522 ' INTEREST '. DTSBE444 00523 DTSBE444 00524 05 WRK-RPT-DATA-LINE. DTSBE444 00525 10 FILLER PIC X(06) VALUE SPACES. DTSBE444 00526 10 WRK-RPT-DESCRIPTION PIC X(20). DTSBE444 00527 10 FILLER PIC X(04) VALUE SPACES. DTSBE444 00528 10 WRK-RPT-TAX PIC --,---,---,--9.99. DTSBE444 00529 10 FILLER PIC X(04) VALUE SPACES. DTSBE444 00530 10 WRK-RPT-PEN PIC --,---,---,--9.99. DTSBE444 00531 10 FILLER PIC X(04) VALUE SPACES. DTSBE444 00532 10 WRK-RPT-INT PIC --,---,---,--9.99. DTSBE444 00533 DTSBE444 00534 05 WRK-AUDIT-CNT PIC S9(07) COMP-3 DTSBE444 00535 VALUE +0. DTSBE444 00536 05 WRK-AGING-CNT PIC S9(07) COMP-3 DTSBE444 00537 VALUE +0. DTSBE444 00538 05 WRK-QTR-CNT PIC S9(07) COMP-3 DTSBE444 00539 VALUE +0. DTSBE444 00540 05 WRK-CREDIT-CNT PIC S9(07) COMP-3 DTSBE444 00541 VALUE +0. DTSBE444 00542 DTSBE444 00543 05 DISPLAY-TAX PIC ZZZ,ZZZ,ZZZ,ZZ9.99-. DTSBE444 00544 05 DISPLAY-TAX1 PIC ZZZ,ZZZ,ZZZ,ZZ9.99-. DTSBE444 00545 05 DISPLAY-TAX2 PIC ZZZ,ZZZ,ZZZ,ZZ9.99-. DTSBE444 00546 05 DISPLAY-PEN PIC ZZZ,ZZZ,ZZZ,ZZ9.99-. DTSBE444 00547 05 DISPLAY-INT PIC ZZZ,ZZZ,ZZZ,ZZ9.99-. DTSBE444 00548 DTSBE444 00549 EJECT DTSBE444 00550 01 L001-LINK-AREA. DTSBE444 00551 ++INCLUDE DTSIL001 DTSBE444 00552 EJECT DTSBE444 00553 01 L004-LINK-AREA. DTSBE444 00554 ++INCLUDE DTSIL004 DTSBE444 00555 EJECT DTSBE444 00556 01 L005-LINK-AREA. DTSBE444 00557 ++INCLUDE DTSIL005 DTSBE444 00558 EJECT DTSBE444 00559 01 L910-LINK-AREA. DTSBE444 00560 ++INCLUDE DTSIL910 DTSBE444 00561 SKIP3 DTSBE444 00562 01 MSKL-REC. DTSBE444 00563 ++INCLUDE DTSIMSKL DTSBE444 00564 SKIP3 DTSBE444 00565 01 MHDR-REC. DTSBE444 00566 ++INCLUDE DTSIMHDR DTSBE444 00567 SKIP3 DTSBE444 00568 01 MSOL-REC. DTSBE444 00569 ++INCLUDE DTSIMSOL DTSBE444 00570 SKIP3 DTSBE444 00571 01 MRPT-REC. CL*52 00572 ++INCLUDE DTSIMRPT CL*52 00573 SKIP3 CL*52 00574 01 MCOL-REC. DTSBE444 00575 ++INCLUDE DTSIMCOL DTSBE444 00576 SKIP3 DTSBE444 00577 01 MJRN-REC. DTSBE444 00578 ++INCLUDE DTSIMJRN DTSBE444 00579 SKIP3 DTSBE444 00580 01 MQTR-REC. DTSBE444 00581 ++INCLUDE DTSIMQTR DTSBE444 00582 SKIP3 DTSBE444 00583 01 MDST-REC. DTSBE444 00584 ++INCLUDE DTSIMDST DTSBE444 00585 SKIP3 DTSBE444 00586 01 X442-REC. DTSBE444 00587 ++INCLUDE DTSIX442 DTSBE444 00588 SKIP3 DTSBE444 00589 01 R442-REC. DTSBE444 00590 ++INCLUDE DTSIR442 DTSBE444 00591 EJECT DTSBE444 00592 CL*44 00593 01 L101-LINK-AREA. CL*44 00594 ++INCLUDE DTSIL101 CL*44 00595 CL*44 00596 LINKAGE SECTION. DTSBE444 00597 SKIP3 DTSBE444 00598 01 LECM-LINK-AREA. DTSBE444 00599 ++INCLUDE DTSILECM DTSBE444 00600 SKIP3 DTSBE444 00601 10 FILLER REDEFINES LECM-EXTRACT-PARMS. DTSBE444 00602 15 LECM-PARM-LAST-DEL-YRQ PIC 9(03). DTSBE444 00603 15 FILLER PIC X(65). DTSBE444 00604 EJECT DTSBE444 00605 01 MPRF-LINK-REC. DTSBE444 00606 ++INCLUDE DTSIMPRF DTSBE444 00607 EJECT DTSBE444 00608 PROCEDURE DIVISION USING LECM-LINK-AREA DTSBE444 00609 MPRF-LINK-REC. DTSBE444 00610 SKIP2 DTSBE444 00611 IF LECM-PROCESS-88 DTSBE444 00612 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBE444 00613 ELSE DTSBE444 00614 IF LECM-INITIALIZE-88 DTSBE444 00615 PERFORM I0000-INITIALIZE THRU I0000-EXIT DTSBE444 00616 ELSE DTSBE444 00617 IF LECM-TERMINATE-88 DTSBE444 00618 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBE444 00619 ELSE DTSBE444 00620 MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED' DTSBE444 00621 TO ABEND-MSG DTSBE444 00622 PERFORM S999-ABEND THRU S999-EXIT. DTSBE444 00623 SKIP2 DTSBE444 00624 GOBACK. DTSBE444 00625 EJECT DTSBE444 00626 I0000-INITIALIZE. DTSBE444 00627 SET WRK-ERROR-NO-88 TO TRUE. DTSBE444 00628 DTSBE444 00629 MOVE LECM-TRACE-IND TO L910-TRACE-IND. DTSBE444 00630 DTSBE444 00631 MOVE WRK-MOD-NAME TO L910-MOD-NAME. DTSBE444 00632 DTSBE444 00633 MOVE LENGTH OF R442-REC TO R442-LENGTH. DTSBE444 00634 MOVE '442' TO R442-REC-TYPE. DTSBE444 00635 DTSBE444 00636 MOVE ZERO TO WRK-3-YR-RATED-TAX DTSBE444 00637 WRK-3-YR-RATED-PEN DTSBE444 00638 WRK-3-YR-RATED-INT DTSBE444 00639 WRK-3-YR-SELF-INS-TAX DTSBE444 00640 WRK-3-YR-SELF-INS-PEN DTSBE444 00641 WRK-3-YR-SELF-INS-INT DTSBE444 00642 WRK-TOT-RATED-TAX DTSBE444 00643 WRK-TOT-RATED-PEN DTSBE444 00644 WRK-TOT-RATED-INT DTSBE444 00645 WRK-TOT-SELF-INS-TAX DTSBE444 00646 WRK-TOT-SELF-INS-PEN DTSBE444 00647 WRK-TOT-SELF-INS-INT DTSBE444 00648 WRK-ACTIVE-RATED-TAX DTSBE444 00649 WRK-ACTIVE-RATED-PEN DTSBE444 00650 WRK-ACTIVE-RATED-INT DTSBE444 00651 WRK-INACT-RATED-TAX DTSBE444 00652 WRK-INACT-RATED-PEN DTSBE444 00653 WRK-INACT-RATED-INT DTSBE444 00654 WRK-INACT-3YR-RATED-TAX DTSBE444 00655 WRK-INACT-3YR-RATED-PEN DTSBE444 00656 WRK-INACT-3YR-RATED-INT DTSBE444 00657 WRK-CHAPTER-7-RATED-TAX DTSBE444 00658 WRK-CHAPTER-7-RATED-PEN DTSBE444 00659 WRK-CHAPTER-7-RATED-INT DTSBE444 00660 WRK-CHAPTER-11-RATED-TAX DTSBE444 00661 WRK-CHAPTER-11-RATED-PEN DTSBE444 00662 WRK-CHAPTER-11-RATED-INT DTSBE444 00663 WRK-ACTIVE-SELF-INS-TAX DTSBE444 00664 WRK-ACTIVE-SELF-INS-PEN DTSBE444 00665 WRK-ACTIVE-SELF-INS-INT DTSBE444 00666 WRK-INACT-SELF-INS-TAX DTSBE444 00667 WRK-INACT-SELF-INS-PEN DTSBE444 00668 WRK-INACT-SELF-INS-INT DTSBE444 00669 WRK-INACT-3YR-SELF-INS-TAX DTSBE444 00670 WRK-INACT-3YR-SELF-INS-PEN DTSBE444 00671 WRK-INACT-3YR-SELF-INS-INT DTSBE444 00672 WRK-CHAPTER-7-SELF-INS-TAX DTSBE444 00673 WRK-CHAPTER-7-SELF-INS-PEN DTSBE444 00674 WRK-CHAPTER-7-SELF-INS-INT DTSBE444 00675 WRK-CHAPTER-11-SELF-INS-TAX DTSBE444 00676 WRK-CHAPTER-11-SELF-INS-PEN DTSBE444 00677 WRK-CHAPTER-11-SELF-INS-INT DTSBE444 00678 WRK-MTH-RATED-TAX-PAY DTSBE444 00679 WRK-MTH-RATED-PEN-PAY DTSBE444 00680 WRK-MTH-RATED-INT-PAY DTSBE444 00681 WRK-MTH-RATED-CRED-PAY DTSBE444 00682 WRK-MTH-SI-TAX-PAY DTSBE444 00683 WRK-MTH-SI-PEN-PAY DTSBE444 00684 WRK-MTH-SI-INT-PAY DTSBE444 00685 WRK-MTH-SI-CRED-PAY DTSBE444 00686 WRK-MTH-UNK-CRED-PAY DTSBE444 00687 WRK-MTH-UNK-TAX-PAY DTSBE444 00688 WRK-MTH-UNK-PEN-PAY DTSBE444 00689 WRK-MTH-UNK-INT-PAY DTSBE444 00690 WRK-MTH-UNK-CRED-PAY DTSBE444 00691 DTSBE444 00692 WRK-19994-RATED-TAX DTSBE444 00693 WRK-19994-RATED-PEN DTSBE444 00694 WRK-19994-RATED-INT DTSBE444 00695 WRK-19994-SELF-INS-TAX DTSBE444 00696 WRK-19994-SELF-INS-PEN DTSBE444 00697 WRK-19994-SELF-INS-INT DTSBE444 00698 WRK-CREDIT-PAID-RATED DTSBE444 00699 WRK-CREDIT-TOL-RATED DTSBE444 00700 WRK-CREDIT-WRITEOFF-RATED DTSBE444 00701 WRK-CREDIT-PAID-SI DTSBE444 00702 WRK-CREDIT-TOL-SI DTSBE444 00703 WRK-CREDIT-WRITEOFF-SI DTSBE444 00704 WRK-CREDIT-PAID-UNK DTSBE444 00705 WRK-CREDIT-TOL-UNK DTSBE444 00706 WRK-CREDIT-WRITEOFF-UNK DTSBE444 00707 WRK-CREDIT-AMT. DTSBE444 00708 DTSBE444 00709 DTSBE444 00710 DTSBE444 00711 PERFORM I1000-READ-MHDR THRU I1000-EXIT. DTSBE444 00712 DTSBE444 00713 PERFORM I2000-OPEN-FILE THRU I2000-EXIT. DTSBE444 00714 DTSBE444 00715 PERFORM I3000-EDIT-AND-DEFAULT-PARMS THRU I3000-EXIT. DTSBE444 00716 DTSBE444 00717 PERFORM I4000-BUILD-QTR-TABLE THRU I4000-EXIT. DTSBE444 00718 DTSBE444 00719 PERFORM I5000-WRITE-HEADERS THRU I5000-EXIT. DTSBE444 00720 DTSBE444 00721 SET LECM-MST-OPEN-READ-88 TO TRUE. DTSBE444 00722 DTSBE444 00723 I0000-EXIT. DTSBE444 00724 EXIT. DTSBE444 00725 DTSBE444 00726 I1000-READ-MHDR. DTSBE444 00727 MOVE LOW-VALUES TO MHDR-KEY-AREA. DTSBE444 00728 MOVE +0 TO MHDR-EMP-NO. DTSBE444 00729 SET MHDR-HDR-88 TO TRUE. DTSBE444 00730 MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA. DTSBE444 00731 PERFORM S910-READ THRU S910-EXIT. DTSBE444 00732 IF L910-NO-REC-88 DTSBE444 00733 MOVE 'MHDR RECORD NOT FOUND' DTSBE444 00734 TO ABEND-MSG DTSBE444 00735 PERFORM S999-ABEND THRU S999-EXIT DTSBE444 00736 ELSE DTSBE444 00737 MOVE MSKL-REC TO MHDR-REC. DTSBE444 00738 DTSBE444 00739 MOVE MHDR-CURR-RUN-DATE TO R442-CURR-RUN-DATE. DTSBE444 00740 DTSBE444 00741 I1000-EXIT. DTSBE444 00742 EXIT. DTSBE444 00743 DTSBE444 00744 I2000-OPEN-FILE. DTSBE444 00745 OPEN OUTPUT AUDIT-FILE DTSBE444 00746 IF NOT AUDIT-STATUS-OK-88 DTSBE444 00747 DISPLAY 'CANNOT OPEN AUDIT FILE ' AUDIT-STATUS DTSBE444 00748 SET WRK-ERROR-YES-88 TO TRUE DTSBE444 00749 END-IF. DTSBE444 00750 DTSBE444 00751 OPEN OUTPUT AGING-REPORT. DTSBE444 00752 IF NOT AGING-STATUS-OK-88 DTSBE444 00753 DISPLAY 'CANNOT OPEN AGING REPORT ' AGING-STATUS DTSBE444 00754 SET WRK-ERROR-YES-88 TO TRUE DTSBE444 00755 END-IF. DTSBE444 00756 DTSBE444 00757 OPEN OUTPUT QTR-FILE. DTSBE444 00758 IF NOT QTR-STATUS-OK-88 DTSBE444 00759 DISPLAY 'CANNOT OPEN QTR REPORT ' QTR-STATUS DTSBE444 00760 SET WRK-ERROR-YES-88 TO TRUE DTSBE444 00761 END-IF. DTSBE444 00762 DTSBE444 00763 OPEN OUTPUT PAY-FILE. DTSBE444 00764 IF NOT PAY-STATUS-OK-88 DTSBE444 00765 DISPLAY 'CANNOT OPEN PAY FILE ' PAY-STATUS DTSBE444 00766 SET WRK-ERROR-YES-88 TO TRUE DTSBE444 00767 END-IF. DTSBE444 00768 DTSBE444 00769 OPEN OUTPUT CREDIT-FILE. DTSBE444 00770 IF NOT CREDIT-STATUS-OK-88 DTSBE444 00771 DISPLAY 'CANNOT OPEN CREDIT FILE ' CREDIT-STATUS DTSBE444 00772 SET WRK-ERROR-YES-88 TO TRUE DTSBE444 00773 END-IF. DTSBE444 00774 DTSBE444 00775 I2000-EXIT. DTSBE444 00776 EXIT. DTSBE444 00777 DTSBE444 00778 I3000-EDIT-AND-DEFAULT-PARMS. DTSBE444 00779 MOVE +19994 TO WRK-19994-YRQ. DTSBE444 00780 DTSBE444 00781 PERFORM I3100-LAST-DEL-YRQ THRU I3100-EXIT. DTSBE444 00782 DTSBE444 00783 PERFORM I3200-3-YEARS-AGO THRU I3200-EXIT. DTSBE444 00784 DTSBE444 00785 MOVE MHDR-CMPL-WEEK-BEGIN-DATE TO WRK-MTH-BEGIN-DATE. CL*14 00786 MOVE MHDR-CMPL-WEEK-END-DATE TO WRK-MTH-END-DATE CL*14 00787 * MOVE MHDR-CMPL-MONTH-BEGIN-DATE TO WRK-MTH-BEGIN-DATE. CL*14 00788 * MOVE MHDR-CMPL-MONTH-END-DATE TO WRK-MTH-END-DATE CL*14 00789 L001-FED-8-DATE-9. DTSBE444 00790 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBE444 00791 MOVE L001-SLASH-8-DATE TO WRK-RPT-HEADER-DATE DTSBE444 00792 AUDIT-HDR1-DATE DTSBE444 00793 QTR-HDR1-DATE DTSBE444 00794 CREDIT-HDR1-DATE. DTSBE444 00795 DISPLAY SPACE. DTSBE444 00796 DISPLAY '*** DTSBE443 PARMS ***' CL*14 00797 DISPLAY 'LAST DELINQUENT QUARTER ' WRK-LAST-DEL-YRQ. DTSBE444 00798 DISPLAY '3 YEARS AGO ' WRK-3-YEARS-AGO-YRQ DTSBE444 00799 ' ' WRK-3-YEARS-AGO-DATE. DTSBE444 00800 DISPLAY 'CURRENT RUN DATE ' MHDR-CURR-RUN-DATE. DTSBE444 00801 DISPLAY 'FOURTH QTR 1999 ' WRK-19994-YRQ. DTSBE444 00802 DISPLAY 'MONTH BEGIN ' WRK-MTH-BEGIN-DATE. DTSBE444 00803 DISPLAY 'MONTH END ' WRK-MTH-END-DATE. DTSBE444 00804 DISPLAY SPACE. DTSBE444 00805 DISPLAY '************************'. DTSBE444 00806 DTSBE444 00807 I3000-EXIT. DTSBE444 00808 EXIT. DTSBE444 00809 SKIP3 DTSBE444 00810 I3100-LAST-DEL-YRQ. DTSBE444 00811 IF LECM-PARM-LAST-DEL-YRQ = SPACES OR LOW-VALUES DTSBE444 00812 MOVE MHDR-LAST-UC30-DEL-MAIL-YRQ TO WRK-LAST-DEL-YRQ DTSBE444 00813 ELSE DTSBE444 00814 PERFORM I3110-EDIT-LAST-DEL-YRQ THRU I3110-EXIT. DTSBE444 00815 DTSBE444 00816 I3100-EXIT. DTSBE444 00817 EXIT. DTSBE444 00818 DTSBE444 00819 I3110-EDIT-LAST-DEL-YRQ. DTSBE444 00820 MOVE LECM-PARM-LAST-DEL-YRQ TO L004-QTR-3-X. DTSBE444 00821 PERFORM S004-FROM-3 THRU S004-EXIT. DTSBE444 00822 IF L004-INVALID-QTR DTSBE444 00823 MOVE 'LECM-PARM-LAST-DEL-YRQ NOT VALID' DTSBE444 00824 TO ABEND-MSG DTSBE444 00825 PERFORM S999-ABEND THRU S999-EXIT DTSBE444 00826 ELSE DTSBE444 00827 MOVE L004-QTR-5-9 TO WRK-LAST-DEL-YRQ DTSBE444 00828 END-IF. DTSBE444 00829 DTSBE444 00830 I3110-EXIT. DTSBE444 00831 EXIT. DTSBE444 00832 DTSBE444 00833 I3200-3-YEARS-AGO. DTSBE444 00834 MOVE WRK-LAST-DEL-YRQ TO L004-QTR-5-9. DTSBE444 00835 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE444 00836 SUBTRACT +12 FROM L004-ABS-QTR. DTSBE444 00837 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBE444 00838 MOVE L004-QTR-5-9 TO WRK-3-YEARS-AGO-YRQ. DTSBE444 00839 MOVE L004-QTR-END-DATE TO WRK-3-YEARS-AGO-DATE. DTSBE444 00840 DTSBE444 00841 I3200-EXIT. DTSBE444 00842 EXIT. DTSBE444 00843 DTSBE444 00844 I4000-BUILD-QTR-TABLE. DTSBE444 00845 MOVE ZERO TO WRK-QTR-RATED-TAX (1) DTSBE444 00846 WRK-QTR-RATED-PEN (1) DTSBE444 00847 WRK-QTR-RATED-INT (1) DTSBE444 00848 WRK-QTR-SELF-INS-TAX (1) DTSBE444 00849 WRK-QTR-SELF-INS-PEN (1) DTSBE444 00850 WRK-QTR-SELF-INS-INT (1). DTSBE444 00851 DTSBE444 00852 MOVE WRK-LAST-DEL-YRQ TO WRK-QTR-YRQ (1) DTSBE444 00853 L004-QTR-5-9. DTSBE444 00854 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE444 00855 DTSBE444 00856 PERFORM I4100-PREVIOUS-YRQ THRU I4100-EXIT DTSBE444 00857 VARYING SUB FROM +2 BY +1 DTSBE444 00858 UNTIL SUB > WRK-QTR-MAX. DTSBE444 00859 DTSBE444 00860 IF WRK-QTR-YRQ (WRK-QTR-MAX) < MHDR-FIRST-PURSUED-RPT-YRQ DTSBE444 00861 MOVE 'REQUESTED QTR PURGED FROM DATABASE' DTSBE444 00862 TO ABEND-MSG DTSBE444 00863 PERFORM S999-ABEND THRU S999-EXIT. DTSBE444 00864 DTSBE444 00865 I4000-EXIT. DTSBE444 00866 EXIT. DTSBE444 00867 DTSBE444 00868 I4100-PREVIOUS-YRQ. DTSBE444 00869 SUBTRACT +1 FROM L004-ABS-QTR. DTSBE444 00870 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBE444 00871 MOVE L004-QTR-5-9 TO WRK-QTR-YRQ (SUB). DTSBE444 00872 DTSBE444 00873 MOVE ZERO TO WRK-QTR-RATED-TAX (SUB) DTSBE444 00874 WRK-QTR-RATED-PEN (SUB) DTSBE444 00875 WRK-QTR-RATED-INT (SUB) DTSBE444 00876 WRK-QTR-SELF-INS-TAX (SUB) DTSBE444 00877 WRK-QTR-SELF-INS-PEN (SUB) DTSBE444 00878 WRK-QTR-SELF-INS-INT (SUB). DTSBE444 00879 DTSBE444 00880 I4100-EXIT. DTSBE444 00881 EXIT. DTSBE444 00882 DTSBE444 00883 I5000-WRITE-HEADERS. DTSBE444 00884 WRITE PAY-REC FROM WRK-AUDIT-HEADER1. DTSBE444 00885 WRITE PAY-REC FROM WRK-AUDIT-HEADER2. DTSBE444 00886 DTSBE444 00887 WRITE QTR-REC FROM WRK-QTR-HEADER1. DTSBE444 00888 WRITE QTR-REC FROM WRK-QTR-HEADER2. DTSBE444 00889 DTSBE444 00890 WRITE CREDIT-REC FROM WRK-CREDIT-HEADER1. DTSBE444 00891 WRITE CREDIT-REC FROM WRK-CREDIT-HEADER2. DTSBE444 00892 DTSBE444 00893 I5000-EXIT. DTSBE444 00894 EXIT. DTSBE444 00895 DTSBE444 00896 P0000-PROCESS. DTSBE444 00897 IF WRK-ERROR-YES-88 DTSBE444 00898 GO TO P0000-EXIT DTSBE444 00899 END-IF. DTSBE444 00900 CL*20 00901 IF MPRF-TOT-BALANCE-AMT < +01 CL*20 00902 GO TO P0000-EXIT CL*20 00903 CL*20 00904 PERFORM P0100-INIT-QTR-TABLE THRU P0100-EXIT. DTSBE444 00905 DTSBE444 00906 IF MPRF-CLASS-SUB-88 DTSBE444 00907 PERFORM P1000-DETERMINE-STATUS THRU P1000-EXIT DTSBE444 00908 IF WRK-STAT-INVALID DTSBE444 00909 NEXT SENTENCE DTSBE444 00910 ELSE DTSBE444 00911 PERFORM P2000-QTR-RECEIVABLES THRU P2000-EXIT DTSBE444 00912 PERFORM P4000-QTR-SUMMARY THRU P4000-EXIT CL*15 00913 * PERFORM P3000-JRN-RECEIVABLES THRU P3000-EXIT CL*18 00914 END-IF DTSBE444 00915 END-IF. DTSBE444 00916 DTSBE444 00917 * PERFORM P5000-CREDITS THRU P5000-EXIT. CL*18 00918 DTSBE444 00919 DTSBE444 00920 *& PERFORM DTSBE444 00921 * VARYING TSUB FROM +1 BY +1 DTSBE444 00922 * UNTIL TSUB > TSUB-MAX DTSBE444 00923 * IF (CTAB-QTR-TAX-BAL(TSUB) NOT = DTSBE444 00924 * CTAB-JRN-TAX-BAL(TSUB)) DTSBE444 00925 * MOVE TSUB TO L004-ABS-QTR DTSBE444 00926 * PERFORM S004-FROM-ABS THRU S004-EXIT DTSBE444 00927 * MOVE CTAB-QTR-TAX-BAL(TSUB) TO DISPLAY-TAX DTSBE444 00928 * MOVE CTAB-JRN-TAX-BAL(TSUB) TO DISPLAY-TAX1 DTSBE444 00929 * DISPLAY 'QTR/JRN TAX ' MPRF-EMP-NO DTSBE444 00930 * ' ' L004-SLASH-5-QTR DTSBE444 00931 * ' ' DISPLAY-TAX ' ' DISPLAY-TAX1 DTSBE444 00932 * END-IF DTSBE444 00933 * DTSBE444 00934 * IF (CTAB-QTR-PEN-BAL(TSUB) NOT = DTSBE444 00935 * CTAB-JRN-PEN-BAL(TSUB)) DTSBE444 00936 ** IF (CTAB-QTR-20051-PEN(TSUB) NOT = DTSBE444 00937 ** CTAB-JRN-20051-PEN(TSUB)) DTSBE444 00938 * MOVE TSUB TO L004-ABS-QTR DTSBE444 00939 * PERFORM S004-FROM-ABS THRU S004-EXIT DTSBE444 00940 * IF L004-QTR-5-9 = 20051 DTSBE444 00941 * MOVE CTAB-QTR-PEN-BAL(TSUB) TO DISPLAY-TAX DTSBE444 00942 * MOVE CTAB-JRN-PEN-BAL(TSUB) TO DISPLAY-TAX1 DTSBE444 00943 ** MOVE CTAB-QTR-20051-PEN (TSUB) TO DISPLAY-TAX DTSBE444 00944 ** MOVE CTAB-JRN-20051-PEN (TSUB) TO DISPLAY-TAX1 DTSBE444 00945 * DISPLAY 'QTR/JRN PEN ' MPRF-EMP-NO DTSBE444 00946 * ' ' L004-SLASH-5-QTR DTSBE444 00947 * ' ' DISPLAY-TAX ' ' DISPLAY-TAX1 DTSBE444 00948 * END-IF DTSBE444 00949 * END-IF DTSBE444 00950 * DTSBE444 00951 * IF (CTAB-QTR-INT-BAL(TSUB) NOT = DTSBE444 00952 * CTAB-JRN-INT-BAL(TSUB)) DTSBE444 00953 * MOVE TSUB TO L004-ABS-QTR DTSBE444 00954 * PERFORM S004-FROM-ABS THRU S004-EXIT DTSBE444 00955 * MOVE CTAB-QTR-INT-BAL(TSUB) TO DISPLAY-TAX DTSBE444 00956 * MOVE CTAB-JRN-INT-BAL(TSUB) TO DISPLAY-TAX1 DTSBE444 00957 * DISPLAY 'QTR/JRN INT ' MPRF-EMP-NO DTSBE444 00958 * ' ' L004-SLASH-5-QTR DTSBE444 00959 * ' ' DISPLAY-TAX ' ' DISPLAY-TAX1 DTSBE444 00960 * END-IF DTSBE444 00961 * DTSBE444 00962 *& END-PERFORM. DTSBE444 00963 DTSBE444 00964 P0000-EXIT. DTSBE444 00965 EXIT. DTSBE444 00966 EJECT DTSBE444 00967 P0100-INIT-QTR-TABLE. DTSBE444 00968 PERFORM DTSBE444 00969 VARYING TSUB FROM +1 BY +1 CL*33 00970 UNTIL TSUB > TSUB-MAX CL*33 00971 MOVE ZEROS TO CTAB-QTR-YRQ (TSUB) CL*33 00972 CTAB-QTR-TAX-BAL (TSUB) CL*33 00973 CTAB-QTR-UI-BAL (TSUB) CL*33 00974 CTAB-QTR-SUR-BAL (TSUB) CL*33 00975 CTAB-QTR-PEN-BAL (TSUB) CL*33 00976 CTAB-QTR-LP-BAL (TSUB) CL*33 00977 CTAB-QTR-NSF-BAL (TSUB) CL*33 00978 CTAB-QTR-MSF-BAL (TSUB) CL*33 00979 CTAB-QTR-INT-BAL (TSUB) CL*33 00980 CTAB-QTR-DEF-BAL (TSUB) CL*47 00981 CTAB-QTR-20051-PEN (TSUB) CL*33 00982 CTAB-JRN-TAX-BAL (TSUB) CL*33 00983 CTAB-JRN-PEN-BAL (TSUB) CL*33 00984 CTAB-JRN-INT-BAL (TSUB) CL*33 00985 CTAB-JRN-20051-PEN (TSUB) CL*33 00986 END-PERFORM. DTSBE444 00987 DTSBE444 00988 P0100-EXIT. DTSBE444 00989 EXIT. DTSBE444 00990 DTSBE444 00991 P1000-DETERMINE-STATUS. DTSBE444 00992 IF MPRF-STATUS-ACT-88 DTSBE444 00993 SET WRK-STAT-ACTIVE TO TRUE DTSBE444 00994 ELSE DTSBE444 00995 PERFORM P1100-INACTIVE THRU P1100-EXIT. DTSBE444 00996 DTSBE444 00997 * PERFORM P1200-BANKRUPTCY THRU P1200-EXIT. CL*24 00998 DTSBE444 00999 P1000-EXIT. DTSBE444 01000 EXIT. DTSBE444 01001 DTSBE444 01002 P1100-INACTIVE. DTSBE444 01003 MOVE LOW-VALUES TO MSOL-KEY-AREA. DTSBE444 01004 MOVE MPRF-EMP-NO TO MSOL-EMP-NO. DTSBE444 01005 SET MSOL-SOL-88 TO TRUE. DTSBE444 01006 MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA. DTSBE444 01007 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE444 01008 IF L910-NO-REC-88 DTSBE444 01009 SET WRK-STAT-INVALID TO TRUE DTSBE444 01010 GO TO P1100-EXIT. DTSBE444 01011 DTSBE444 01012 PERFORM P1110-SCAN-MSOL THRU P1110-EXIT DTSBE444 01013 UNTIL L910-NO-REC-88. DTSBE444 01014 DTSBE444 01015 IF WRK-STAT-INACT DTSBE444 01016 IF WRK-INACT-DATE <= WRK-3-YEARS-AGO-DATE DTSBE444 01017 SET WRK-STAT-INACT-3-YR TO TRUE. DTSBE444 01018 DTSBE444 01019 P1100-EXIT. DTSBE444 01020 EXIT. DTSBE444 01021 DTSBE444 01022 P1110-SCAN-MSOL. DTSBE444 01023 MOVE MSKL-REC TO MSOL-REC. DTSBE444 01024 DTSBE444 01025 IF MSOL-INACT-WITHDRAWN-88 DTSBE444 01026 GO TO P1110-READ-NEXT DTSBE444 01027 ELSE DTSBE444 01028 IF MSOL-INACT-INACTIVE-88 DTSBE444 01029 SET WRK-STAT-INACT TO TRUE DTSBE444 01030 MOVE MSOL-INACT-DATE TO WRK-INACT-DATE DTSBE444 01031 ELSE DTSBE444 01032 SET WRK-STAT-ACTIVE TO TRUE DTSBE444 01033 END-IF DTSBE444 01034 END-IF. DTSBE444 01035 DTSBE444 01036 P1110-READ-NEXT. DTSBE444 01037 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE444 01038 DTSBE444 01039 P1110-EXIT. DTSBE444 01040 EXIT. DTSBE444 01041 DTSBE444 01042 P1200-BANKRUPTCY. DTSBE444 01043 SET WRK-BNK-NONE TO TRUE. DTSBE444 01044 DTSBE444 01045 MOVE LOW-VALUES TO MCOL-KEY-AREA. DTSBE444 01046 MOVE MPRF-EMP-NO TO MCOL-EMP-NO. DTSBE444 01047 SET MCOL-COL-88 TO TRUE. DTSBE444 01048 MOVE MCOL-KEY-AREA TO MSKL-KEY-AREA. DTSBE444 01049 PERFORM S910-READ THRU S910-EXIT. DTSBE444 01050 IF L910-NO-REC-88 DTSBE444 01051 GO TO P1200-EXIT. DTSBE444 01052 DTSBE444 01053 MOVE MSKL-REC TO MCOL-REC. DTSBE444 01054 DTSBE444 01055 IF (MCOL-BNK-PETITION-DATE > ZERO DTSBE444 01056 AND (MCOL-BNK-DISCHRG-CLOSE-DATE = ZERO DTSBE444 01057 AND MCOL-BNK-DISMISS-DATE = ZERO)) DTSBE444 01058 IF MCOL-BNK-CHAPTER-7-88 DTSBE444 01059 SET WRK-BNK-CHAP-7 TO TRUE DTSBE444 01060 ELSE DTSBE444 01061 IF MCOL-BNK-CHAPTER-11-88 DTSBE444 01062 SET WRK-BNK-CHAP-11 TO TRUE DTSBE444 01063 END-IF DTSBE444 01064 END-IF DTSBE444 01065 END-IF. DTSBE444 01066 DTSBE444 01067 P1200-EXIT. DTSBE444 01068 EXIT. DTSBE444 01069 DTSBE444 01070 P2000-QTR-RECEIVABLES. DTSBE444 01071 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBE444 01072 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBE444 01073 SET MQTR-QTR-88 TO TRUE. DTSBE444 01074 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBE444 01075 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE444 01076 IF L910-NO-REC-88 DTSBE444 01077 GO TO P2000-EXIT. DTSBE444 01078 DTSBE444 01079 DISPLAY 'P2000- ' MPRF-EMP-NO ' ' CL*55 01080 MOVE +0 TO TSUB ZSUB CL*34 01081 PERFORM P2100-SCAN-MQTR THRU P2100-EXIT DTSBE444 01082 UNTIL L910-NO-REC-88. DTSBE444 01083 DTSBE444 01084 *& DTSBE444 01085 * PERFORM DTSBE444 01086 * VARYING TSUB FROM +1 BY +1 DTSBE444 01087 * UNTIL TSUB > TSUB-MAX DTSBE444 01088 * IF CTAB-QTR-TAX-BAL (TSUB) > ZERO DTSBE444 01089 * MOVE CTAB-QTR-TAX-BAL (TSUB) TO DISPLAY-TAX DTSBE444 01090 * MOVE TSUB TO L004-ABS-QTR DTSBE444 01091 * PERFORM S004-FROM-ABS THRU S004-EXIT DTSBE444 01092 * DISPLAY 'P2 ' MPRF-EMP-NO ' ' L004-SLASH-5-QTR DTSBE444 01093 * ' ' DISPLAY-TAX DTSBE444 01094 * END-IF DTSBE444 01095 * END-PERFORM. DTSBE444 01096 *& DTSBE444 01097 P2000-EXIT. DTSBE444 01098 EXIT. DTSBE444 01099 SKIP2 DTSBE444 01100 P2100-SCAN-MQTR. DTSBE444 01101 * DISPLAY 'P2100-SCAN-MQTR......' MQTR-EMP-NO ' ' MQTR-YRQ. CL*56 01102 MOVE MSKL-REC TO MQTR-REC. DTSBE444 01103 MOVE ZEROS TO L101-PAID-CHNG. CL*44 01104 DTSBE444 01105 *& IF MQTR-YRQ > WRK-LAST-DEL-YRQ DTSBE444 01106 * SET L910-NO-REC-88 TO TRUE DTSBE444 01107 *& GO TO P2100-EXIT. DTSBE444 01108 DTSBE444 01109 ADD +1 TO TSUB ZSUB CL*34 01110 * PERFORM P2110-SET-SUB THRU P2110-EXIT. CL*23 01111 * IF SUB > ZERO CL*21 01112 IF MPRF-CLASS-RATED-88 DTSBE444 01113 PERFORM P2130-RATED THRU P2130-EXIT DTSBE444 01114 ELSE DTSBE444 01115 IF MPRF-CLASS-SELF-INS-88 DTSBE444 01116 PERFORM P2140-SELF-INS THRU P2140-EXIT DTSBE444 01117 END-IF DTSBE444 01118 * END-IF CL*21 01119 END-IF. DTSBE444 01120 DTSBE444 01121 IF L101-PAID-CHNG > +0 CL*49 01122 PERFORM P2150-ACC-INT THRU P2150-EXIT CL*55 01123 MOVE ZEROS TO L101-PAID-CHNG. CL*55 01124 CL*49 01125 MOVE MQTR-REC TO MSKL-REC CL*55 01126 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE444 01127 DTSBE444 01128 P2100-EXIT. DTSBE444 01129 EXIT. DTSBE444 01130 SKIP2 DTSBE444 01131 ************************************************************ DTSBE444 01132 * THIS PARAGRAPH SETS THE SUBSCRIPT INTO WRK-QTR-TABLE. DTSBE444 01133 * THE TABLE STORES THE TOTAL AMOUNTS RECEIVABLE FOR THE 6 DTSBE444 01134 * MOST RECENT DELINQUENT QUARTERS IN THE FIRST 6 TABLE DTSBE444 01135 * OCCCURRENCES. DTSBE444 01136 * IT STORES ANY RECEIVABLES FOR EARLIER QUARTERS IN THE DTSBE444 01137 * SEVENTH OCCURRENCE (WRK-QTR-MAX). DTSBE444 01138 ************************************************************ DTSBE444 01139 P2110-SET-SUB. DTSBE444 01140 MOVE +1 TO SUB. CL*21 01141 DTSBE444 01142 MOVE MQTR-YRQ TO L004-QTR-5-9. DTSBE444 01143 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE444 01144 MOVE L004-ABS-QTR TO TSUB. DTSBE444 01145 GO TO P2110-EXIT. CL*21 01146 DTSBE444 01147 IF MQTR-YRQ <= WRK-QTR-YRQ (WRK-QTR-MAX) DTSBE444 01148 MOVE WRK-QTR-MAX TO SUB DTSBE444 01149 ELSE DTSBE444 01150 PERFORM DTSBE444 01151 VARYING WRK-QTR-IDX FROM +1 BY +1 DTSBE444 01152 UNTIL WRK-QTR-IDX > WRK-QTR-MAX DTSBE444 01153 OR SUB NOT = ZERO DTSBE444 01154 IF WRK-QTR-YRQ (WRK-QTR-IDX) = MQTR-YRQ DTSBE444 01155 SET SUB TO WRK-QTR-IDX DTSBE444 01156 END-IF DTSBE444 01157 END-PERFORM DTSBE444 01158 END-IF. DTSBE444 01159 DTSBE444 01160 IF SUB = ZERO DTSBE444 01161 DISPLAY 'P2110 SUB = 0 ' MPRF-EMP-NO ' ' MQTR-YRQ DTSBE444 01162 END-IF. DTSBE444 01163 DTSBE444 01164 P2110-EXIT. DTSBE444 01165 EXIT. DTSBE444 01166 DTSBE444 01167 P2130-RATED. DTSBE444 01168 PERFORM DTSBE444 01169 VARYING MQTR-ACCT-IDX FROM +1 BY +1 DTSBE444 01170 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSBE444 01171 * IF MQTR-ACCT-TAX-88 (MQTR-ACCT-IDX) CL*19 01172 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) CL*19 01173 OR MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) CL*17 01174 PERFORM P2131-ADD-RATED-TAX THRU P2131-EXIT DTSBE444 01175 ELSE DTSBE444 01176 IF MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX) DTSBE444 01177 OR MQTR-ACCT-NSF-PEN-88 (MQTR-ACCT-IDX) DTSBE444 01178 OR MQTR-ACCT-MISC-PEN-88 (MQTR-ACCT-IDX) DTSBE444 01179 PERFORM P2132-ADD-RATED-PEN THRU P2132-EXIT DTSBE444 01180 ELSE DTSBE444 01181 IF MQTR-ACCT-INT-88 (MQTR-ACCT-IDX) DTSBE444 01182 PERFORM P2133-ADD-RATED-INT THRU P2133-EXIT DTSBE444 01183 END-IF DTSBE444 01184 END-IF DTSBE444 01185 END-IF DTSBE444 01186 END-PERFORM. DTSBE444 01187 DTSBE444 01188 P2130-EXIT. DTSBE444 01189 EXIT. DTSBE444 01190 DTSBE444 01191 P2131-ADD-RATED-TAX. DTSBE444 01192 *& DTSBE444 01193 * DISPLAY 'P2131 ' MQTR-EMP-NO ' YR ' MQTR-YRQ ' T ' TSUB CL*56 01194 * ' ' WRK-MQTR-TAX-BAL CL*38 01195 *& CL*24 01196 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) TO DTSBE444 01197 WRK-TOTAL-RATED-TAX. DTSBE444 01198 *& DTSBE444 01199 MOVE MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBE444 01200 TO WRK-MQTR-TAX-BAL. DTSBE444 01201 CL*53 01202 * IF MQTR-ACCT-TAX-88 (MQTR-ACCT-IDX) CL*53 01203 IF MQTR-ACCT-TAX-88 (MQTR-ACCT-IDX) CL*53 01204 IF MQTR-BALANCE-AMT (MQTR-ACCT-IDX) > 0 CL*53 01205 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) CL*53 01206 TO L101-PAID-CHNG CL*53 01207 PERFORM P5001-READ-MRPT THRU P5001-EXIT CL*53 01208 END-IF CL*53 01209 END-IF. CL*53 01210 DTSBE444 01211 IF WRK-MQTR-TAX-BAL = ZERO DTSBE444 01212 GO TO P2131-EXIT. DTSBE444 01213 DTSBE444 01214 CL*50 01215 ADD WRK-MQTR-TAX-BAL CL*30 01216 * TO WRK-QTR-RATED-TAX (SUB) CL*24 01217 TO CTAB-QTR-TAX-BAL (TSUB) CL*38 01218 CL*19 01219 MOVE MQTR-YRQ TO CTAB-QTR-YRQ (TSUB). CL*21 01220 CL*38 01221 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) CL**3 01222 ADD WRK-MQTR-TAX-BAL CL**3 01223 TO CTAB-QTR-UI-BAL(TSUB) CL*33 01224 ELSE CL*13 01225 IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) CL**3 01226 ADD WRK-MQTR-TAX-BAL CL**3 01227 TO CTAB-QTR-SUR-BAL (TSUB). CL*50 01228 CL**3 01229 GO TO P2131-EXIT. CL*24 01230 CL*24 01231 IF MQTR-YRQ <= WRK-3-YEARS-AGO-YRQ DTSBE444 01232 ADD WRK-MQTR-TAX-BAL DTSBE444 01233 TO WRK-3-YR-RATED-TAX. DTSBE444 01234 DTSBE444 01235 IF MQTR-YRQ >= WRK-19994-YRQ DTSBE444 01236 ADD WRK-MQTR-TAX-BAL DTSBE444 01237 TO WRK-19994-RATED-TAX. DTSBE444 01238 DTSBE444 01239 IF WRK-STAT-ACTIVE DTSBE444 01240 ADD WRK-MQTR-TAX-BAL DTSBE444 01241 TO WRK-ACTIVE-RATED-TAX DTSBE444 01242 ELSE DTSBE444 01243 IF WRK-STAT-INACT DTSBE444 01244 ADD WRK-MQTR-TAX-BAL DTSBE444 01245 TO WRK-INACT-RATED-TAX DTSBE444 01246 ELSE DTSBE444 01247 IF WRK-STAT-INACT-3-YR DTSBE444 01248 ADD WRK-MQTR-TAX-BAL DTSBE444 01249 TO WRK-INACT-3YR-RATED-TAX DTSBE444 01250 END-IF DTSBE444 01251 END-IF DTSBE444 01252 END-IF. DTSBE444 01253 DTSBE444 01254 IF WRK-BNK-CHAP-7 DTSBE444 01255 ADD WRK-MQTR-TAX-BAL DTSBE444 01256 TO WRK-CHAPTER-7-RATED-TAX DTSBE444 01257 ELSE DTSBE444 01258 IF WRK-BNK-CHAP-11 DTSBE444 01259 ADD WRK-MQTR-TAX-BAL DTSBE444 01260 TO WRK-CHAPTER-11-RATED-TAX DTSBE444 01261 END-IF DTSBE444 01262 END-IF. DTSBE444 01263 DTSBE444 01264 P2131-EXIT. DTSBE444 01265 EXIT. DTSBE444 01266 DTSBE444 01267 P2132-ADD-RATED-PEN. DTSBE444 01268 *& DTSBE444 01269 * DISPLAY 'P2132 ' MQTR-EMP-NO ' YR ' MQTR-YRQ ' T ' TSUB. CL*38 01270 * IF MQTR-YRQ = 20051 DTSBE444 01271 * IF MPRF-EMP-NO = 084792 OR 121420 OR 143098 DTSBE444 01272 * OR 145516 DTSBE444 01273 * GO TO P2132-EXIT DTSBE444 01274 * END-IF DTSBE444 01275 * END-IF. DTSBE444 01276 *& DTSBE444 01277 MOVE MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBE444 01278 TO WRK-MQTR-PEN-BAL. DTSBE444 01279 DTSBE444 01280 IF WRK-MQTR-PEN-BAL = ZERO DTSBE444 01281 GO TO P2132-EXIT. DTSBE444 01282 DTSBE444 01283 MOVE MQTR-YRQ TO CTAB-QTR-YRQ (TSUB). CL*21 01284 * ADD WRK-MQTR-PEN-BAL CL*24 01285 * TO WRK-QTR-RATED-PEN (SUB) CL*24 01286 * TO CTAB-QTR-PEN-BAL (TSUB). CL*24 01287 DTSBE444 01288 IF MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX) CL**3 01289 ADD WRK-MQTR-PEN-BAL CL**3 01290 TO CTAB-QTR-LP-BAL (TSUB) CL*13 01291 ELSE CL*13 01292 IF MQTR-ACCT-NSF-PEN-88 (MQTR-ACCT-IDX) CL**3 01293 ADD WRK-MQTR-PEN-BAL CL**3 01294 TO CTAB-QTR-NSF-BAL (TSUB) CL*13 01295 ELSE CL*13 01296 IF MQTR-ACCT-MISC-PEN-88 (MQTR-ACCT-IDX) CL**3 01297 ADD WRK-MQTR-PEN-BAL CL**3 01298 TO CTAB-QTR-MSF-BAL (TSUB). CL**7 01299 CL**3 01300 GO TO P2132-EXIT. CL*24 01301 CL*24 01302 IF MQTR-YRQ = 20051 DTSBE444 01303 ADD WRK-MQTR-PEN-BAL DTSBE444 01304 TO CTAB-QTR-20051-PEN (TSUB). DTSBE444 01305 DTSBE444 01306 IF MQTR-YRQ <= WRK-3-YEARS-AGO-YRQ DTSBE444 01307 ADD WRK-MQTR-PEN-BAL DTSBE444 01308 TO WRK-3-YR-RATED-PEN. DTSBE444 01309 DTSBE444 01310 IF MQTR-YRQ >= WRK-19994-YRQ DTSBE444 01311 ADD WRK-MQTR-PEN-BAL DTSBE444 01312 TO WRK-19994-RATED-PEN. DTSBE444 01313 DTSBE444 01314 IF WRK-STAT-ACTIVE DTSBE444 01315 ADD WRK-MQTR-PEN-BAL DTSBE444 01316 TO WRK-ACTIVE-RATED-PEN DTSBE444 01317 ELSE DTSBE444 01318 IF WRK-STAT-INACT DTSBE444 01319 ADD WRK-MQTR-PEN-BAL DTSBE444 01320 TO WRK-INACT-RATED-PEN DTSBE444 01321 ELSE DTSBE444 01322 IF WRK-STAT-INACT-3-YR DTSBE444 01323 ADD WRK-MQTR-PEN-BAL DTSBE444 01324 TO WRK-INACT-3YR-RATED-PEN DTSBE444 01325 END-IF DTSBE444 01326 END-IF DTSBE444 01327 END-IF. DTSBE444 01328 DTSBE444 01329 IF WRK-BNK-CHAP-7 DTSBE444 01330 ADD WRK-MQTR-PEN-BAL DTSBE444 01331 TO WRK-CHAPTER-7-RATED-PEN DTSBE444 01332 ELSE DTSBE444 01333 IF WRK-BNK-CHAP-11 DTSBE444 01334 ADD WRK-MQTR-PEN-BAL DTSBE444 01335 TO WRK-CHAPTER-11-RATED-PEN DTSBE444 01336 END-IF DTSBE444 01337 END-IF. DTSBE444 01338 DTSBE444 01339 P2132-EXIT. DTSBE444 01340 EXIT. DTSBE444 01341 DTSBE444 01342 P2133-ADD-RATED-INT. DTSBE444 01343 MOVE MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBE444 01344 TO WRK-MQTR-INT-BAL. DTSBE444 01345 DTSBE444 01346 * DISPLAY 'P2133 ' MQTR-EMP-NO ' YR ' MQTR-YRQ ' T ' TSUB. CL*38 01347 *& ADD WRK-CORRECTION-INT-AMT DTSBE444 01348 * TO WRK-MQTR-INT-BAL. DTSBE444 01349 * DTSBE444 01350 * IF WRK-MQTR-INT-BAL < ZERO DTSBE444 01351 * MOVE WRK-MQTR-INT-BAL TO DISPLAY-INT DTSBE444 01352 * DISPLAY 'INT BAL < ZERO ' MPRF-EMP-NO DTSBE444 01353 * ' ' MQTR-YRQ DTSBE444 01354 *& ' ' DISPLAY-INT. DTSBE444 01355 DTSBE444 01356 IF WRK-MQTR-INT-BAL <= ZERO DTSBE444 01357 GO TO P2133-EXIT. DTSBE444 01358 DTSBE444 01359 ADD WRK-MQTR-INT-BAL DTSBE444 01360 * TO WRK-QTR-RATED-INT (SUB) CL*24 01361 TO CTAB-QTR-INT-BAL (TSUB). CL*24 01362 DTSBE444 01363 GO TO P2133-EXIT. CL*24 01364 MOVE MQTR-YRQ TO CTAB-QTR-YRQ (TSUB). CL*21 01365 IF MQTR-YRQ <= WRK-3-YEARS-AGO-YRQ DTSBE444 01366 ADD WRK-MQTR-INT-BAL DTSBE444 01367 TO WRK-3-YR-RATED-INT. DTSBE444 01368 DTSBE444 01369 IF MQTR-YRQ >= WRK-19994-YRQ DTSBE444 01370 ADD WRK-MQTR-INT-BAL DTSBE444 01371 TO WRK-19994-RATED-INT. DTSBE444 01372 DTSBE444 01373 IF WRK-STAT-ACTIVE DTSBE444 01374 ADD WRK-MQTR-INT-BAL DTSBE444 01375 TO WRK-ACTIVE-RATED-INT DTSBE444 01376 ELSE DTSBE444 01377 IF WRK-STAT-INACT DTSBE444 01378 ADD WRK-MQTR-INT-BAL DTSBE444 01379 TO WRK-INACT-RATED-INT DTSBE444 01380 ELSE DTSBE444 01381 IF WRK-STAT-INACT-3-YR DTSBE444 01382 ADD WRK-MQTR-INT-BAL DTSBE444 01383 TO WRK-INACT-3YR-RATED-INT DTSBE444 01384 END-IF DTSBE444 01385 END-IF DTSBE444 01386 END-IF. DTSBE444 01387 DTSBE444 01388 IF WRK-BNK-CHAP-7 DTSBE444 01389 ADD WRK-MQTR-INT-BAL DTSBE444 01390 TO WRK-CHAPTER-7-RATED-INT DTSBE444 01391 ELSE DTSBE444 01392 IF WRK-BNK-CHAP-11 DTSBE444 01393 ADD WRK-MQTR-INT-BAL DTSBE444 01394 TO WRK-CHAPTER-11-RATED-INT DTSBE444 01395 END-IF DTSBE444 01396 END-IF. DTSBE444 01397 DTSBE444 01398 P2133-EXIT. DTSBE444 01399 EXIT. DTSBE444 01400 DTSBE444 01401 P2140-SELF-INS. DTSBE444 01402 PERFORM DTSBE444 01403 VARYING MQTR-ACCT-IDX FROM +1 BY +1 DTSBE444 01404 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSBE444 01405 * IF MQTR-ACCT-TAX-88 (MQTR-ACCT-IDX) CL*19 01406 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) CL*19 01407 OR MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) CL*17 01408 PERFORM P2141-ADD-SELF-INS-TAX THRU P2141-EXIT DTSBE444 01409 ELSE DTSBE444 01410 IF MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX) DTSBE444 01411 OR MQTR-ACCT-NSF-PEN-88 (MQTR-ACCT-IDX) DTSBE444 01412 OR MQTR-ACCT-MISC-PEN-88 (MQTR-ACCT-IDX) DTSBE444 01413 PERFORM P2142-ADD-SELF-INS-PEN DTSBE444 01414 THRU P2142-EXIT DTSBE444 01415 ELSE DTSBE444 01416 IF MQTR-ACCT-INT-88 (MQTR-ACCT-IDX) DTSBE444 01417 PERFORM P2143-ADD-SELF-INS-INT DTSBE444 01418 THRU P2143-EXIT DTSBE444 01419 END-IF DTSBE444 01420 END-IF DTSBE444 01421 END-IF DTSBE444 01422 END-PERFORM. DTSBE444 01423 DTSBE444 01424 P2140-EXIT. DTSBE444 01425 EXIT. DTSBE444 01426 DTSBE444 01427 P2141-ADD-SELF-INS-TAX. DTSBE444 01428 MOVE MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBE444 01429 TO WRK-MQTR-TAX-BAL. DTSBE444 01430 DTSBE444 01431 CL*50 01432 * DISPLAY ' P2141-ADD-SELF-INS-TAX.' CL*56 01433 * IF MQTR-ACCT-TAX-88 (MQTR-ACCT-IDX) CL*50 01434 IF MQTR-ACCT-TAX-88 (MQTR-ACCT-IDX) CL*50 01435 IF MQTR-BALANCE-AMT (MQTR-ACCT-IDX) > 0 CL*50 01436 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) CL*50 01437 TO L101-PAID-CHNG CL*50 01438 PERFORM P5001-READ-MRPT THRU P5001-EXIT CL*50 01439 END-IF CL*50 01440 END-IF. CL*50 01441 * DISPLAY 'P2141 ' MQTR-EMP-NO ' YR ' MQTR-YRQ ' T ' TSUB. CL*38 01442 *& ADD WRK-CORRECTION-TAX-AMT DTSBE444 01443 * TO WRK-MQTR-TAX-BAL DTSBE444 01444 * DTSBE444 01445 * IF WRK-MQTR-TAX-BAL < ZERO DTSBE444 01446 * MOVE WRK-MQTR-TAX-BAL TO DISPLAY-TAX DTSBE444 01447 * DISPLAY 'TAX BAL < ZERO ' MPRF-EMP-NO DTSBE444 01448 * ' ' MQTR-YRQ DTSBE444 01449 *& ' ' DISPLAY-TAX. DTSBE444 01450 DTSBE444 01451 IF WRK-MQTR-TAX-BAL = ZERO DTSBE444 01452 GO TO P2141-EXIT. DTSBE444 01453 DTSBE444 01454 MOVE MQTR-YRQ TO CTAB-QTR-YRQ (TSUB). CL*21 01455 * MOVE WRK-CORRECTION-TAX-AMT DTSBE444 01456 * TO DISPLAY-TAX. DTSBE444 01457 * DISPLAY 'CORRECTION AMT ' DTSBE444 01458 * MPRF-EMP-NO DTSBE444 01459 * ' ' MQTR-YRQ DTSBE444 01460 * ' ' DISPLAY-TAX. DTSBE444 01461 DTSBE444 01462 * IF MQTR-ACCT-TAX-88 (MQTR-ACCT-IDX) CL*19 01463 * ADD WRK-MQTR-TAX-BAL CL*24 01464 * TO WRK-QTR-SELF-INS-TAX (SUB) CL*24 01465 * CTAB-QTR-TAX-BAL (TSUB) CL*24 01466 * WRK-TOT-SI-TAX. CL*24 01467 CL*19 01468 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) CL**3 01469 ADD WRK-MQTR-TAX-BAL CL**3 01470 TO CTAB-QTR-UI-BAL (TSUB) CL*13 01471 ELSE CL*13 01472 IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) CL**3 01473 ADD WRK-MQTR-TAX-BAL CL**3 01474 TO CTAB-QTR-SUR-BAL (TSUB). CL*50 01475 CL**3 01476 GO TO P2141-EXIT. CL*24 01477 DTSBE444 01478 IF MQTR-YRQ <= WRK-3-YEARS-AGO-YRQ DTSBE444 01479 ADD WRK-MQTR-TAX-BAL DTSBE444 01480 TO WRK-3-YR-SELF-INS-TAX. DTSBE444 01481 DTSBE444 01482 IF MQTR-YRQ >= WRK-19994-YRQ DTSBE444 01483 ADD WRK-MQTR-TAX-BAL DTSBE444 01484 TO WRK-19994-SELF-INS-TAX. DTSBE444 01485 DTSBE444 01486 IF WRK-STAT-ACTIVE DTSBE444 01487 ADD WRK-MQTR-TAX-BAL DTSBE444 01488 TO WRK-ACTIVE-SELF-INS-TAX DTSBE444 01489 ELSE DTSBE444 01490 IF WRK-STAT-INACT DTSBE444 01491 ADD WRK-MQTR-TAX-BAL DTSBE444 01492 TO WRK-INACT-SELF-INS-TAX DTSBE444 01493 ELSE DTSBE444 01494 IF WRK-STAT-INACT-3-YR DTSBE444 01495 ADD WRK-MQTR-TAX-BAL DTSBE444 01496 TO WRK-INACT-3YR-SELF-INS-TAX DTSBE444 01497 END-IF DTSBE444 01498 END-IF DTSBE444 01499 END-IF. DTSBE444 01500 DTSBE444 01501 IF WRK-BNK-CHAP-7 DTSBE444 01502 ADD WRK-MQTR-TAX-BAL DTSBE444 01503 TO WRK-CHAPTER-7-SELF-INS-TAX DTSBE444 01504 ELSE DTSBE444 01505 IF WRK-BNK-CHAP-11 DTSBE444 01506 ADD WRK-MQTR-TAX-BAL DTSBE444 01507 TO WRK-CHAPTER-11-SELF-INS-TAX DTSBE444 01508 END-IF DTSBE444 01509 END-IF. DTSBE444 01510 DTSBE444 01511 P2141-EXIT. DTSBE444 01512 EXIT. DTSBE444 01513 DTSBE444 01514 P2142-ADD-SELF-INS-PEN. DTSBE444 01515 MOVE MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBE444 01516 TO WRK-MQTR-PEN-BAL. DTSBE444 01517 DTSBE444 01518 * DISPLAY 'P2142 ' MQTR-EMP-NO ' YR ' MQTR-YRQ ' T ' TSUB. CL*38 01519 *& ADD WRK-CORRECTION-PEN-AMT DTSBE444 01520 * TO WRK-MQTR-PEN-BAL. DTSBE444 01521 * DTSBE444 01522 * IF WRK-MQTR-PEN-BAL < ZERO DTSBE444 01523 * MOVE WRK-MQTR-PEN-BAL TO DISPLAY-PEN DTSBE444 01524 * DISPLAY 'PEN BAL < ZERO ' MPRF-EMP-NO DTSBE444 01525 * ' ' MQTR-YRQ DTSBE444 01526 *& ' ' DISPLAY-PEN. DTSBE444 01527 DTSBE444 01528 IF WRK-MQTR-PEN-BAL = ZERO DTSBE444 01529 GO TO P2142-EXIT. DTSBE444 01530 DTSBE444 01531 * ADD WRK-MQTR-PEN-BAL CL*24 01532 * TO WRK-QTR-SELF-INS-PEN (SUB) CL*24 01533 * CTAB-QTR-PEN-BAL (TSUB). CL*24 01534 DTSBE444 01535 MOVE MQTR-YRQ TO CTAB-QTR-YRQ (TSUB). CL*21 01536 IF MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX) CL**3 01537 ADD WRK-MQTR-PEN-BAL CL**3 01538 TO CTAB-QTR-LP-BAL (TSUB) CL*13 01539 ELSE CL*13 01540 IF MQTR-ACCT-NSF-PEN-88 (MQTR-ACCT-IDX) CL**3 01541 ADD WRK-MQTR-PEN-BAL CL**3 01542 TO CTAB-QTR-NSF-BAL (TSUB) CL*13 01543 ELSE CL*13 01544 IF MQTR-ACCT-MISC-PEN-88 (MQTR-ACCT-IDX) CL**3 01545 ADD WRK-MQTR-PEN-BAL CL**3 01546 TO CTAB-QTR-MSF-BAL (TSUB). CL**7 01547 CL*24 01548 GO TO P2142-EXIT. CL*24 01549 CL**3 01550 IF MQTR-YRQ = 20051 DTSBE444 01551 ADD WRK-MQTR-PEN-BAL DTSBE444 01552 TO CTAB-QTR-20051-PEN (TSUB). DTSBE444 01553 DTSBE444 01554 IF MQTR-YRQ <= WRK-3-YEARS-AGO-YRQ DTSBE444 01555 ADD WRK-MQTR-PEN-BAL DTSBE444 01556 TO WRK-3-YR-SELF-INS-PEN. DTSBE444 01557 DTSBE444 01558 IF MQTR-YRQ >= WRK-19994-YRQ DTSBE444 01559 ADD WRK-MQTR-PEN-BAL DTSBE444 01560 TO WRK-19994-SELF-INS-PEN. DTSBE444 01561 DTSBE444 01562 IF WRK-STAT-ACTIVE DTSBE444 01563 ADD WRK-MQTR-PEN-BAL DTSBE444 01564 TO WRK-ACTIVE-SELF-INS-PEN DTSBE444 01565 ELSE DTSBE444 01566 IF WRK-STAT-INACT DTSBE444 01567 ADD WRK-MQTR-PEN-BAL DTSBE444 01568 TO WRK-INACT-SELF-INS-PEN DTSBE444 01569 ELSE DTSBE444 01570 IF WRK-STAT-INACT-3-YR DTSBE444 01571 ADD WRK-MQTR-PEN-BAL DTSBE444 01572 TO WRK-INACT-3YR-SELF-INS-PEN DTSBE444 01573 END-IF DTSBE444 01574 END-IF DTSBE444 01575 END-IF. DTSBE444 01576 DTSBE444 01577 IF WRK-BNK-CHAP-7 DTSBE444 01578 ADD WRK-MQTR-PEN-BAL DTSBE444 01579 TO WRK-CHAPTER-7-SELF-INS-PEN DTSBE444 01580 ELSE DTSBE444 01581 IF WRK-BNK-CHAP-11 DTSBE444 01582 ADD WRK-MQTR-PEN-BAL DTSBE444 01583 TO WRK-CHAPTER-11-SELF-INS-PEN DTSBE444 01584 END-IF DTSBE444 01585 END-IF. DTSBE444 01586 DTSBE444 01587 P2142-EXIT. DTSBE444 01588 EXIT. DTSBE444 01589 DTSBE444 01590 P2143-ADD-SELF-INS-INT. DTSBE444 01591 MOVE MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBE444 01592 TO WRK-MQTR-INT-BAL. DTSBE444 01593 DTSBE444 01594 * DISPLAY 'P2143 ' MQTR-EMP-NO ' YR ' MQTR-YRQ ' T ' TSUB. CL*38 01595 *& ADD WRK-CORRECTION-INT-AMT DTSBE444 01596 * TO WRK-MQTR-INT-BAL. DTSBE444 01597 * DTSBE444 01598 * IF WRK-MQTR-INT-BAL < ZERO DTSBE444 01599 * MOVE WRK-MQTR-INT-BAL TO DISPLAY-INT DTSBE444 01600 * DISPLAY 'PEN INT < ZERO ' MPRF-EMP-NO DTSBE444 01601 * ' ' MQTR-YRQ DTSBE444 01602 *& ' ' DISPLAY-INT. DTSBE444 01603 DTSBE444 01604 IF WRK-MQTR-INT-BAL = ZERO DTSBE444 01605 GO TO P2143-EXIT. DTSBE444 01606 DTSBE444 01607 ADD WRK-MQTR-INT-BAL DTSBE444 01608 * TO WRK-QTR-SELF-INS-INT (SUB) CL*24 01609 TO CTAB-QTR-INT-BAL (TSUB). CL*24 01610 DTSBE444 01611 GO TO P2143-EXIT. CL*24 01612 CL*24 01613 IF MQTR-YRQ <= WRK-3-YEARS-AGO-YRQ DTSBE444 01614 ADD WRK-MQTR-INT-BAL DTSBE444 01615 TO WRK-3-YR-SELF-INS-INT. DTSBE444 01616 DTSBE444 01617 IF MQTR-YRQ >= WRK-19994-YRQ DTSBE444 01618 ADD WRK-MQTR-INT-BAL DTSBE444 01619 TO WRK-19994-SELF-INS-INT. DTSBE444 01620 DTSBE444 01621 IF WRK-STAT-ACTIVE DTSBE444 01622 ADD WRK-MQTR-INT-BAL DTSBE444 01623 TO WRK-ACTIVE-SELF-INS-INT DTSBE444 01624 ELSE DTSBE444 01625 IF WRK-STAT-INACT DTSBE444 01626 ADD WRK-MQTR-INT-BAL DTSBE444 01627 TO WRK-INACT-SELF-INS-INT DTSBE444 01628 ELSE DTSBE444 01629 IF WRK-STAT-INACT-3-YR DTSBE444 01630 ADD WRK-MQTR-INT-BAL DTSBE444 01631 TO WRK-INACT-3YR-SELF-INS-INT DTSBE444 01632 END-IF DTSBE444 01633 END-IF DTSBE444 01634 END-IF. DTSBE444 01635 DTSBE444 01636 IF WRK-BNK-CHAP-7 DTSBE444 01637 ADD WRK-MQTR-INT-BAL DTSBE444 01638 TO WRK-CHAPTER-7-SELF-INS-INT DTSBE444 01639 ELSE DTSBE444 01640 IF WRK-BNK-CHAP-11 DTSBE444 01641 ADD WRK-MQTR-INT-BAL DTSBE444 01642 TO WRK-CHAPTER-11-SELF-INS-INT DTSBE444 01643 END-IF DTSBE444 01644 END-IF. DTSBE444 01645 DTSBE444 01646 P2143-EXIT. DTSBE444 01647 EXIT. DTSBE444 01648 DTSBE444 01649 P2150-ACC-INT. CL*44 01650 DISPLAY 'P2150 ' MPRF-EMP-NO ' ' MQTR-YRQ. CL*54 01651 IF L101-PAID-CHNG > +0 CL*44 01652 NEXT SENTENCE CL*44 01653 ELSE CL*44 01654 GO TO P2150-EXIT. CL*44 01655 CL*44 01656 SET L101-WAIVE-INT-NO-88 TO TRUE. CL*44 01657 * SET L101-ABATE-PEN-NO-88 TO TRUE. CL*44 01658 CL*44 01659 MOVE MHDR-PRIOR-MAIL-DATE TO L101-RECEIVED-DATE CL*58 01660 MOVE MQTR-TAX-DUE-DATE TO L101-TAX-DUE-DATE. CL*44 01661 CL*44 01662 MOVE MQTR-INT-AREA TO L101-INT-AREA. CL*44 01663 CL*44 01664 * DISPLAY 'B101 ======= INT ' MPRF-EMP-NO CL*56 01665 PERFORM S101-PER-MONTH-NO THRU S101-EXIT. CL*57 01666 * DISPLAY 'A101 ======= INT ' MPRF-EMP-NO CL*56 01667 CL*44 01668 ADD L101-INT-CHARGE-CHNG CL*44 01669 TO CTAB-QTR-DEF-BAL (TSUB). CL*44 01670 CL*44 01671 CL*44 01672 DISPLAY 'EMP N0 : ' MQTR-EMP-NO ' ' MQTR-YRQ CL*54 01673 ' TAX AMT: ' L101-PAID-CHNG CL*44 01674 ' INT AMT: ' L101-INT-CHARGE-CHNG. CL*44 01675 CL*44 01676 P2150-EXIT. CL*44 01677 EXIT. CL*44 01678 P3000-JRN-RECEIVABLES. DTSBE444 01679 MOVE LOW-VALUES TO MJRN-KEY-AREA. DTSBE444 01680 MOVE MPRF-EMP-NO TO MJRN-EMP-NO. DTSBE444 01681 SET MJRN-JRN-88 TO TRUE. DTSBE444 01682 MOVE MJRN-KEY-AREA TO MSKL-KEY-AREA. DTSBE444 01683 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE444 01684 IF L910-NO-REC-88 DTSBE444 01685 GO TO P3000-EXIT. DTSBE444 01686 DTSBE444 01687 PERFORM P3200-SCAN-MJRN THRU P3200-EXIT DTSBE444 01688 UNTIL L910-NO-REC-88. DTSBE444 01689 DTSBE444 01690 DTSBE444 01691 P3000-EXIT. DTSBE444 01692 EXIT. DTSBE444 01693 * DTSBE444 01694 P3200-SCAN-MJRN. DTSBE444 01695 MOVE MSKL-REC TO MJRN-REC. DTSBE444 01696 DTSBE444 01697 *& >> BYPASS INVALID TRANSACTIONS << DTSBE444 01698 IF (MJRN-BATCH-NO = 36870 DTSBE444 01699 AND MJRN-ITEM-NO = 29) DTSBE444 01700 OR (MJRN-BATCH-NO = 37955 DTSBE444 01701 AND MJRN-ITEM-NO = 9) DTSBE444 01702 NEXT SENTENCE DTSBE444 01703 ELSE DTSBE444 01704 *& DTSBE444 01705 IF MJRN-REFUND-PAY-88 DTSBE444 01706 OR MJRN-TRAN-CNVR-88 DTSBE444 01707 NEXT SENTENCE DTSBE444 01708 ELSE DTSBE444 01709 PERFORM P3210-MJRN-ACCT-GROUP THRU P3210-EXIT DTSBE444 01710 VARYING MJRN-OCC-IDX FROM +1 BY +1 DTSBE444 01711 UNTIL MJRN-OCC-IDX > MJRN-OCC-CNT DTSBE444 01712 END-IF. DTSBE444 01713 DTSBE444 01714 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE444 01715 DTSBE444 01716 P3200-EXIT. DTSBE444 01717 EXIT. DTSBE444 01718 DTSBE444 01719 P3210-MJRN-ACCT-GROUP. DTSBE444 01720 PERFORM P3230-WRITE-PAY THRU P3230-EXIT. DTSBE444 01721 DTSBE444 01722 IF MJRN-YRQ (MJRN-OCC-IDX) > WRK-LAST-DEL-YRQ DTSBE444 01723 OR MJRN-YRQ (MJRN-OCC-IDX) < 19994 DTSBE444 01724 GO TO P3210-EXIT DTSBE444 01725 ELSE DTSBE444 01726 MOVE MJRN-YRQ (MJRN-OCC-IDX) TO L004-QTR-5-9 DTSBE444 01727 PERFORM S004-FROM-5 THRU S004-EXIT DTSBE444 01728 IF L004-VALID-QTR DTSBE444 01729 MOVE L004-ABS-QTR TO TSUB DTSBE444 01730 ELSE DTSBE444 01731 MOVE ZERO TO TSUB DTSBE444 01732 END-IF DTSBE444 01733 END-IF. DTSBE444 01734 DTSBE444 01735 IF TSUB > ZERO DTSBE444 01736 IF (CTAB-QTR-TAX-BAL(TSUB) > ZERO DTSBE444 01737 OR CTAB-QTR-PEN-BAL(TSUB) > ZERO DTSBE444 01738 OR CTAB-QTR-INT-BAL(TSUB) > ZERO) DTSBE444 01739 PERFORM P3220-WRITE-OUTPUT THRU P3220-EXIT DTSBE444 01740 END-IF DTSBE444 01741 END-IF. DTSBE444 01742 DTSBE444 01743 IF MJRN-ROW-UI-88 (MJRN-OCC-IDX) DTSBE444 01744 PERFORM P3211-TAX THRU P3211-EXIT DTSBE444 01745 ELSE DTSBE444 01746 IF MJRN-ROW-LATE-PEN-88 (MJRN-OCC-IDX) DTSBE444 01747 OR MJRN-ROW-NSF-PEN-88 (MJRN-OCC-IDX) DTSBE444 01748 OR MJRN-ROW-MISC-PEN-88 (MJRN-OCC-IDX) DTSBE444 01749 PERFORM P3212-PEN THRU P3212-EXIT DTSBE444 01750 ELSE DTSBE444 01751 IF MJRN-ROW-INT-88 (MJRN-OCC-IDX) DTSBE444 01752 PERFORM P3213-INT THRU P3213-EXIT DTSBE444 01753 END-IF DTSBE444 01754 END-IF DTSBE444 01755 END-IF. DTSBE444 01756 DTSBE444 01757 P3210-EXIT. DTSBE444 01758 EXIT. DTSBE444 01759 DTSBE444 01760 P3211-TAX. DTSBE444 01761 IF MJRN-COL-CHARGED-88 (MJRN-OCC-IDX) DTSBE444 01762 ADD MJRN-AMT (MJRN-OCC-IDX) DTSBE444 01763 TO CTAB-JRN-TAX-BAL (TSUB) DTSBE444 01764 ELSE DTSBE444 01765 SUBTRACT MJRN-AMT (MJRN-OCC-IDX) DTSBE444 01766 FROM CTAB-JRN-TAX-BAL (TSUB) DTSBE444 01767 END-IF. DTSBE444 01768 DTSBE444 01769 P3211-EXIT. DTSBE444 01770 EXIT. DTSBE444 01771 DTSBE444 01772 P3212-PEN. DTSBE444 01773 IF MJRN-COL-CHARGED-88 (MJRN-OCC-IDX) DTSBE444 01774 ADD MJRN-AMT (MJRN-OCC-IDX) DTSBE444 01775 TO CTAB-JRN-PEN-BAL (TSUB) DTSBE444 01776 ELSE DTSBE444 01777 SUBTRACT MJRN-AMT (MJRN-OCC-IDX) DTSBE444 01778 FROM CTAB-JRN-PEN-BAL (TSUB) DTSBE444 01779 END-IF. DTSBE444 01780 DTSBE444 01781 *& DTSBE444 01782 IF MJRN-YRQ (MJRN-OCC-IDX) = 20051 DTSBE444 01783 IF MJRN-COL-CHARGED-88 (MJRN-OCC-IDX) DTSBE444 01784 ADD MJRN-AMT (MJRN-OCC-IDX) DTSBE444 01785 TO CTAB-JRN-20051-PEN (TSUB) DTSBE444 01786 ELSE DTSBE444 01787 SUBTRACT MJRN-AMT (MJRN-OCC-IDX) DTSBE444 01788 FROM CTAB-JRN-20051-PEN (TSUB) DTSBE444 01789 END-IF DTSBE444 01790 END-IF. DTSBE444 01791 DTSBE444 01792 *& DTSBE444 01793 P3212-EXIT. DTSBE444 01794 EXIT. DTSBE444 01795 DTSBE444 01796 P3213-INT. DTSBE444 01797 IF MJRN-COL-CHARGED-88 (MJRN-OCC-IDX) DTSBE444 01798 ADD MJRN-AMT (MJRN-OCC-IDX) DTSBE444 01799 TO CTAB-JRN-INT-BAL (TSUB) DTSBE444 01800 ELSE DTSBE444 01801 SUBTRACT MJRN-AMT (MJRN-OCC-IDX) DTSBE444 01802 FROM CTAB-JRN-INT-BAL (TSUB) DTSBE444 01803 END-IF. DTSBE444 01804 DTSBE444 01805 P3213-EXIT. DTSBE444 01806 EXIT. DTSBE444 01807 DTSBE444 01808 P3220-WRITE-OUTPUT. DTSBE444 01809 *& DTSBE444 01810 * MOVE CTAB-QTR-TAX-BAL(TSUB) TO DISPLAY-TAX. DTSBE444 01811 * MOVE MJRN-AMT (MJRN-OCC-IDX) TO DISPLAY-TAX1 DTSBE444 01812 * DISPLAY 'P322 ' MPRF-EMP-NO ' ' MJRN-YRQ (MJRN-OCC-IDX) DTSBE444 01813 * ' ' DISPLAY-TAX ' ' MJRN-BATCH-NO ' ' MJRN-ITEM-NO. DTSBE444 01814 * DISPLAY ' JRN ' DISPLAY-TAX1 DTSBE444 01815 * ' ' MJRN-ACCT-ROW (MJRN-OCC-IDX) DTSBE444 01816 * ' ' MJRN-ACCT-COL (MJRN-OCC-IDX). DTSBE444 01817 *& DTSBE444 01818 DTSBE444 01819 ** ADD +1 TO WRK-SEQ-NO. DTSBE444 01820 ** MOVE WRK-SEQ-NO TO AUDIT-SEQ-NO. DTSBE444 01821 MOVE MPRF-EMP-NO TO AUDIT-EMP-NO. DTSBE444 01822 MOVE MPRF-PRIMARY-NAME TO AUDIT-PRIMARY-NAME. DTSBE444 01823 INSPECT AUDIT-PRIMARY-NAME REPLACING ALL ',' BY SPACE. DTSBE444 01824 MOVE MPRF-EMP-CLASS TO AUDIT-EMP-CLASS. DTSBE444 01825 MOVE MJRN-BATCH-NO TO AUDIT-BATCH-NO. DTSBE444 01826 MOVE MJRN-ITEM-NO TO AUDIT-ITEM-NO. DTSBE444 01827 DTSBE444 01828 MOVE MJRN-ESTB-DATE TO L001-FED-8-DATE-9. DTSBE444 01829 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBE444 01830 MOVE L001-SLASH-8-DATE TO AUDIT-PROC-DATE. DTSBE444 01831 DTSBE444 01832 * MOVE MJRN-RECEIVED-DATE TO L001-FED-8-DATE-9. DTSBE444 01833 * PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBE444 01834 * MOVE L001-SLASH-8-DATE TO AUDIT-RCVD-DATE. DTSBE444 01835 DTSBE444 01836 IF MJRN-COL-CHARGED-88 (MJRN-OCC-IDX) DTSBE444 01837 MOVE MJRN-AMT (MJRN-OCC-IDX) TO AUDIT-AMT DTSBE444 01838 ELSE DTSBE444 01839 COMPUTE WRK-AMT = DTSBE444 01840 (MJRN-AMT (MJRN-OCC-IDX) * -1) DTSBE444 01841 MOVE WRK-AMT TO AUDIT-AMT DTSBE444 01842 END-IF. DTSBE444 01843 DTSBE444 01844 MOVE MJRN-TRAN-TYPE TO AUDIT-TRAN. DTSBE444 01845 MOVE MJRN-ACCT-ROW (MJRN-OCC-IDX) TO AUDIT-ACCT. DTSBE444 01846 DTSBE444 01847 MOVE MJRN-YRQ (MJRN-OCC-IDX) TO L004-QTR-5-9. DTSBE444 01848 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE444 01849 MOVE L004-SLASH-5-QTR TO AUDIT-YRQ. DTSBE444 01850 DTSBE444 01851 *& WRITE TEMP-REC FROM WRK-AUDIT-REC. DTSBE444 01852 WRITE AUDIT-REC FROM WRK-AUDIT-REC. DTSBE444 01853 ADD +1 TO WRK-AUDIT-CNT. DTSBE444 01854 DTSBE444 01855 P3220-EXIT. DTSBE444 01856 EXIT. DTSBE444 01857 DTSBE444 01858 P3230-WRITE-PAY. DTSBE444 01859 IF MJRN-ESTB-DATE >= WRK-MTH-BEGIN-DATE DTSBE444 01860 AND MJRN-ESTB-DATE <= WRK-MTH-END-DATE DTSBE444 01861 NEXT SENTENCE DTSBE444 01862 ELSE DTSBE444 01863 GO TO P3230-EXIT DTSBE444 01864 END-IF. DTSBE444 01865 DTSBE444 01866 *** IF MJRN-ROW-CREDIT-88 (MJRN-OCC-IDX) DTSBE444 01867 * EVALUATE TRUE DTSBE444 01868 * WHEN MPRF-CLASS-RATED-88 DTSBE444 01869 * ADD MJRN-AMT (MJRN-OCC-IDX) DTSBE444 01870 * TO WRK-MTH-RATED-CRED-PAY DTSBE444 01871 * WHEN MPRF-CLASS-SELF-INS-88 DTSBE444 01872 * ADD MJRN-AMT (MJRN-OCC-IDX) DTSBE444 01873 * TO WRK-MTH-SI-CRED-PAY DTSBE444 01874 * WHEN OTHER DTSBE444 01875 * ADD MJRN-AMT (MJRN-OCC-IDX) DTSBE444 01876 * TO WRK-MTH-UNK-CRED-PAY DTSBE444 01877 * END-EVALUATE DTSBE444 01878 *** END-IF. DTSBE444 01879 DTSBE444 01880 IF MJRN-COL-PAID-88 (MJRN-OCC-IDX) DTSBE444 01881 NEXT SENTENCE DTSBE444 01882 ELSE DTSBE444 01883 GO TO P3230-EXIT DTSBE444 01884 END-IF. DTSBE444 01885 DTSBE444 01886 IF MJRN-ROW-UI-88 (MJRN-OCC-IDX) DTSBE444 01887 OR MJRN-ROW-SUR-88 (MJRN-OCC-IDX) DTSBE444 01888 EVALUATE TRUE DTSBE444 01889 WHEN MPRF-CLASS-RATED-88 DTSBE444 01890 ADD MJRN-AMT (MJRN-OCC-IDX) DTSBE444 01891 TO WRK-MTH-RATED-TAX-PAY DTSBE444 01892 WHEN MPRF-CLASS-SELF-INS-88 DTSBE444 01893 ADD MJRN-AMT (MJRN-OCC-IDX) DTSBE444 01894 TO WRK-MTH-SI-TAX-PAY DTSBE444 01895 WHEN OTHER DTSBE444 01896 ADD MJRN-AMT (MJRN-OCC-IDX) DTSBE444 01897 TO WRK-MTH-UNK-TAX-PAY DTSBE444 01898 END-EVALUATE DTSBE444 01899 END-IF. DTSBE444 01900 DTSBE444 01901 IF MJRN-ROW-LATE-PEN-88 (MJRN-OCC-IDX) DTSBE444 01902 OR MJRN-ROW-NSF-PEN-88 (MJRN-OCC-IDX) DTSBE444 01903 OR MJRN-ROW-MISC-PEN-88 (MJRN-OCC-IDX) DTSBE444 01904 EVALUATE TRUE DTSBE444 01905 WHEN MPRF-CLASS-RATED-88 DTSBE444 01906 ADD MJRN-AMT (MJRN-OCC-IDX) DTSBE444 01907 TO WRK-MTH-RATED-PEN-PAY DTSBE444 01908 WHEN MPRF-CLASS-SELF-INS-88 DTSBE444 01909 ADD MJRN-AMT (MJRN-OCC-IDX) DTSBE444 01910 TO WRK-MTH-SI-PEN-PAY DTSBE444 01911 WHEN OTHER DTSBE444 01912 ADD MJRN-AMT (MJRN-OCC-IDX) DTSBE444 01913 TO WRK-MTH-UNK-PEN-PAY DTSBE444 01914 END-EVALUATE DTSBE444 01915 END-IF. DTSBE444 01916 DTSBE444 01917 IF MJRN-ROW-INT-88 (MJRN-OCC-IDX) DTSBE444 01918 EVALUATE TRUE DTSBE444 01919 WHEN MPRF-CLASS-RATED-88 DTSBE444 01920 ADD MJRN-AMT (MJRN-OCC-IDX) DTSBE444 01921 TO WRK-MTH-RATED-INT-PAY DTSBE444 01922 WHEN MPRF-CLASS-SELF-INS-88 DTSBE444 01923 ADD MJRN-AMT (MJRN-OCC-IDX) DTSBE444 01924 TO WRK-MTH-SI-INT-PAY DTSBE444 01925 WHEN OTHER DTSBE444 01926 ADD MJRN-AMT (MJRN-OCC-IDX) DTSBE444 01927 TO WRK-MTH-UNK-INT-PAY DTSBE444 01928 END-EVALUATE DTSBE444 01929 END-IF. DTSBE444 01930 DTSBE444 01931 DTSBE444 01932 ** ADD +1 TO WRK-SEQ-NO. DTSBE444 01933 ** MOVE WRK-SEQ-NO TO AUDIT-SEQ-NO. DTSBE444 01934 MOVE MPRF-EMP-NO TO AUDIT-EMP-NO. DTSBE444 01935 MOVE MPRF-PRIMARY-NAME TO AUDIT-PRIMARY-NAME. DTSBE444 01936 INSPECT AUDIT-PRIMARY-NAME REPLACING ALL ',' BY SPACE. DTSBE444 01937 MOVE MPRF-EMP-CLASS TO AUDIT-EMP-CLASS. DTSBE444 01938 MOVE MJRN-BATCH-NO TO AUDIT-BATCH-NO. DTSBE444 01939 MOVE MJRN-ITEM-NO TO AUDIT-ITEM-NO. DTSBE444 01940 DTSBE444 01941 MOVE MJRN-ESTB-DATE TO L001-FED-8-DATE-9. DTSBE444 01942 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBE444 01943 MOVE L001-SLASH-8-DATE TO AUDIT-PROC-DATE. DTSBE444 01944 DTSBE444 01945 * MOVE MJRN-RECEIVED-DATE TO L001-FED-8-DATE-9. DTSBE444 01946 * PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBE444 01947 * MOVE L001-SLASH-8-DATE TO AUDIT-RCVD-DATE. DTSBE444 01948 DTSBE444 01949 MOVE MJRN-AMT (MJRN-OCC-IDX) TO AUDIT-AMT, DTSBE444 01950 DTSBE444 01951 MOVE MJRN-TRAN-TYPE TO AUDIT-TRAN. DTSBE444 01952 MOVE MJRN-ACCT-ROW (MJRN-OCC-IDX) TO AUDIT-ACCT. DTSBE444 01953 DTSBE444 01954 MOVE MJRN-YRQ (MJRN-OCC-IDX) TO L004-QTR-5-9. DTSBE444 01955 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE444 01956 MOVE L004-SLASH-5-QTR TO AUDIT-YRQ. DTSBE444 01957 DTSBE444 01958 WRITE PAY-REC FROM WRK-AUDIT-REC. DTSBE444 01959 ADD +1 TO WRK-AUDIT-CNT. DTSBE444 01960 DTSBE444 01961 P3230-EXIT. DTSBE444 01962 EXIT. DTSBE444 01963 DTSBE444 01964 P4000-QTR-SUMMARY. DTSBE444 01965 DISPLAY 'P4000 ' MPRF-EMP-NO CL*48 01966 MOVE MPRF-EMP-NO TO QTR-EMP-NO. DTSBE444 01967 MOVE MPRF-PRIMARY-NAME TO QTR-PRIMARY-NAME. DTSBE444 01968 INSPECT QTR-PRIMARY-NAME REPLACING ALL ',' BY SPACE. DTSBE444 01969 MOVE MPRF-EMP-STATUS TO QTR-EMP-STATUS. CL*60 01970 MOVE MPRF-EMP-CLASS TO QTR-EMP-CLASS. CL*60 01971 MOVE ZEROS TO QTR-TOTAL. CL*10 01972 CL**9 01973 MOVE ZEROS TO QTR-UIT CL*40 01974 QTR-SURT CL*40 01975 QTR-LPT CL*40 01976 QTR-NSFT CL*40 01977 QTR-MSFT CL*40 01978 QTR-INTT CL*40 01979 QTR-DEFT CL*44 01980 QTR-TOTAL. CL*40 01981 CL*40 01982 PERFORM DTSBE444 01983 VARYING TSUB FROM +1 BY +1 DTSBE444 01984 UNTIL TSUB > TSUB-MAX DTSBE444 01985 IF CTAB-QTR-SUR-BAL(TSUB) > ZERO CL*42 01986 OR CTAB-QTR-UI-BAL(TSUB) > ZERO CL*42 01987 OR CTAB-QTR-LP-BAL(TSUB) > ZERO CL*42 01988 OR CTAB-QTR-INT-BAL(TSUB) > ZERO DTSBE444 01989 DISPLAY 'EMP ' MPRF-EMP-NO ' YRQ ' CTAB-QTR-YRQ(TSUB) CL*42 01990 * MOVE TSUB TO L004-ABS-QTR CL*23 01991 * PERFORM S004-FROM-ABS THRU S004-EXIT CL*23 01992 * MOVE L004-SLASH-5-QTR TO QTR-YRQ CL*23 01993 * MOVE ZEROS TO QTR-TOTAL CL*41 01994 MOVE CTAB-QTR-YRQ(TSUB) TO QTR-YRQ CL*23 01995 * MOVE CTAB-QTR-UI-BAL(TSUB) TO QTR-UI CL*38 01996 * MOVE CTAB-QTR-SUR-BAL(TSUB) TO QTR-SUR CL*38 01997 * MOVE CTAB-QTR-LP-BAL(TSUB) TO QTR-LP CL*38 01998 * MOVE CTAB-QTR-NSF-BAL(TSUB) TO QTR-NSF CL*38 01999 * MOVE CTAB-QTR-MSF-BAL(TSUB) TO QTR-MSF CL*38 02000 * MOVE CTAB-QTR-INT-BAL(TSUB) TO QTR-INT CL*38 02001 ADD CTAB-QTR-UI-BAL(TSUB) TO QTR-UIT QTR-TOTAL CL*38 02002 ADD CTAB-QTR-SUR-BAL(TSUB) TO QTR-SURT QTR-TOTAL CL*38 02003 ADD CTAB-QTR-LP-BAL(TSUB) TO QTR-LPT QTR-TOTAL CL*38 02004 ADD CTAB-QTR-NSF-BAL(TSUB) TO QTR-NSFT QTR-TOTAL CL*38 02005 ADD CTAB-QTR-MSF-BAL(TSUB) TO QTR-MSFT QTR-TOTAL CL*38 02006 ADD CTAB-QTR-INT-BAL(TSUB) TO QTR-INTT QTR-TOTAL CL*38 02007 ADD CTAB-QTR-DEF-BAL(TSUB) TO QTR-INTT QTR-TOTAL CL*51 02008 * MOVE QTR-TOTAL TO QTR-TOT CL*38 02009 * WRITE QTR-REC FROM WRK-QTR-REC CL*38 02010 ADD +1 TO WRK-QTR-CNT DTSBE444 02011 END-IF DTSBE444 02012 END-PERFORM. DTSBE444 02013 CL*38 02014 MOVE QTR-UIT TO QTR-UI CL*38 02015 MOVE QTR-SURT TO QTR-SUR CL*38 02016 MOVE QTR-LPT TO QTR-LP CL*38 02017 MOVE QTR-NSFT TO QTR-NSF CL*38 02018 MOVE QTR-MSFT TO QTR-MSF CL*38 02019 MOVE QTR-INTT TO QTR-INT CL*38 02020 * MOVE QTR-DEFT TO QTR-DEF CL*51 02021 MOVE QTR-TOTAL TO QTR-TOT CL*38 02022 WRITE QTR-REC FROM WRK-QTR-REC. CL*38 02023 DTSBE444 02024 PERFORM P0100-INIT-QTR-TABLE THRU P0100-EXIT. CL*43 02025 CL*42 02026 P4000-EXIT. DTSBE444 02027 EXIT. DTSBE444 02028 P5001-READ-MRPT. CL*51 02029 MOVE LOW-VALUES TO MRPT-KEY-AREA. CL*51 02030 MOVE MPRF-EMP-NO TO MRPT-EMP-NO. CL*51 02031 MOVE MQTR-YRQ TO MRPT-YRQ CL*51 02032 CL*51 02033 * DISPLAY '>>>> P5001-READ-MRPT> ' MPRF-EMP-NO ' ' MQTR-YRQ. CL*56 02034 SET MRPT-RPT-88 TO TRUE. CL*51 02035 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. CL*51 02036 CL*51 02037 MOVE ZEROS TO L101-RECEIVED-DATE. CL*51 02038 PERFORM S910-START-BROWSE THRU S910-EXIT. CL*51 02039 CL*51 02040 IF L910-NO-REC-88 CL*51 02041 DISPLAY ' RPT REC NOT FOUND ' MPRF-EMP-NO CL*51 02042 MOVE MHDR-CURR-RUN-DATE TO L101-RECEIVED-DATE CL*51 02043 GO TO P5001-EXIT. CL*51 02044 CL*51 02045 PERFORM P5002-MRPT-SCAN THRU P5002-EXIT CL*51 02046 UNTIL L910-NO-REC-88. CL*51 02047 CL*51 02048 CL*51 02049 P5001-EXIT. CL*51 02050 EXIT. CL*51 02051 CL*51 02052 P5002-MRPT-SCAN. CL*51 02053 MOVE MSKL-REC TO MRPT-REC. CL*51 02054 * DISPLAY '> P5002-SCAN-MRPT>>> ' MPRF-EMP-NO ' ' MQTR-YRQ. CL*56 02055 IF MRPT-ORIG-88 OR MRPT-ESTIM-88 CL*51 02056 MOVE MRPT-RECEIVED-DATE TO L101-RECEIVED-DATE CL*51 02057 * DISPLAY ' MRPT ' MRPT-RECEIVED-DATE ' ' L101-RECEIVED-DATE CL*56 02058 SET L910-NO-REC-88 TO TRUE CL*51 02059 GO TO P5002-EXIT. CL*51 02060 CL*51 02061 MOVE MRPT-REC TO MSKL-REC. CL*51 02062 PERFORM S910-READ-NEXT THRU S910-EXIT. CL*51 02063 IF L910-NO-REC-88 CL*51 02064 SET L910-NO-REC-88 TO TRUE CL*51 02065 GO TO P5002-EXIT. CL*51 02066 CL*51 02067 CL*51 02068 P5002-EXIT. CL*51 02069 EXIT. CL*51 02070 DTSBE444 02071 P5000-CREDITS. DTSBE444 02072 MOVE LOW-VALUES TO MDST-KEY-AREA. DTSBE444 02073 MOVE MPRF-EMP-NO TO MDST-EMP-NO. DTSBE444 02074 SET MDST-DST-88 TO TRUE. DTSBE444 02075 SET MDST-CREDIT-REC-88 TO TRUE. DTSBE444 02076 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSBE444 02077 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE444 02078 PERFORM P5100-SCAN-MDST THRU P5100-EXIT DTSBE444 02079 UNTIL L910-NO-REC-88. DTSBE444 02080 DTSBE444 02081 P5000-EXIT. DTSBE444 02082 EXIT. DTSBE444 02083 DTSBE444 02084 P5100-SCAN-MDST. DTSBE444 02085 MOVE MSKL-REC TO MDST-REC. DTSBE444 02086 DTSBE444 02087 IF MDST-CREDIT-REC-88 DTSBE444 02088 NEXT SENTENCE DTSBE444 02089 ELSE DTSBE444 02090 SET L910-NO-REC-88 TO TRUE DTSBE444 02091 GO TO P5100-EXIT. DTSBE444 02092 DTSBE444 02093 PERFORM P5110-MDST-ACCT THRU P5110-EXIT DTSBE444 02094 VARYING MDST-ACCT-IDX FROM 1 BY 1 DTSBE444 02095 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT. DTSBE444 02096 DTSBE444 02097 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE444 02098 DTSBE444 02099 P5100-EXIT. DTSBE444 02100 EXIT. DTSBE444 02101 DTSBE444 02102 P5110-MDST-ACCT. DTSBE444 02103 DTSBE444 02104 EVALUATE TRUE DTSBE444 02105 WHEN MPRF-CLASS-RATED-88 DTSBE444 02106 EVALUATE TRUE DTSBE444 02107 WHEN MDST-ACCT-CR-AVAIL-88 (MDST-ACCT-IDX) DTSBE444 02108 ADD MDST-AMT (MDST-ACCT-IDX) DTSBE444 02109 TO WRK-CREDIT-PAID-RATED DTSBE444 02110 WRK-MTH-RATED-CRED-PAY DTSBE444 02111 PERFORM P5111-WRITE-OUTPUT THRU P5111-EXIT DTSBE444 02112 WHEN MDST-ACCT-CR-TOL-88 (MDST-ACCT-IDX) DTSBE444 02113 ADD MDST-AMT (MDST-ACCT-IDX) DTSBE444 02114 TO WRK-CREDIT-TOL-RATED DTSBE444 02115 WHEN MDST-ACCT-CR-WRITE-OFF-88 (MDST-ACCT-IDX) DTSBE444 02116 ADD MDST-AMT (MDST-ACCT-IDX) DTSBE444 02117 TO WRK-CREDIT-WRITEOFF-RATED DTSBE444 02118 END-EVALUATE DTSBE444 02119 DTSBE444 02120 WHEN MPRF-CLASS-SELF-INS-88 DTSBE444 02121 EVALUATE TRUE DTSBE444 02122 WHEN MDST-ACCT-CR-AVAIL-88 (MDST-ACCT-IDX) DTSBE444 02123 ADD MDST-AMT (MDST-ACCT-IDX) DTSBE444 02124 TO WRK-CREDIT-PAID-SI DTSBE444 02125 WRK-MTH-SI-CRED-PAY DTSBE444 02126 PERFORM P5111-WRITE-OUTPUT THRU P5111-EXIT DTSBE444 02127 WHEN MDST-ACCT-CR-TOL-88 (MDST-ACCT-IDX) DTSBE444 02128 ADD MDST-AMT (MDST-ACCT-IDX) DTSBE444 02129 TO WRK-CREDIT-TOL-SI DTSBE444 02130 WHEN MDST-ACCT-CR-WRITE-OFF-88 (MDST-ACCT-IDX) DTSBE444 02131 ADD MDST-AMT (MDST-ACCT-IDX) DTSBE444 02132 TO WRK-CREDIT-WRITEOFF-SI DTSBE444 02133 END-EVALUATE DTSBE444 02134 DTSBE444 02135 WHEN OTHER DTSBE444 02136 EVALUATE TRUE DTSBE444 02137 WHEN MDST-ACCT-CR-AVAIL-88 (MDST-ACCT-IDX) DTSBE444 02138 ADD MDST-AMT (MDST-ACCT-IDX) DTSBE444 02139 TO WRK-CREDIT-PAID-UNK DTSBE444 02140 WRK-MTH-UNK-CRED-PAY DTSBE444 02141 PERFORM P5111-WRITE-OUTPUT THRU P5111-EXIT DTSBE444 02142 WHEN MDST-ACCT-CR-TOL-88 (MDST-ACCT-IDX) DTSBE444 02143 ADD MDST-AMT (MDST-ACCT-IDX) DTSBE444 02144 TO WRK-CREDIT-TOL-UNK DTSBE444 02145 WHEN MDST-ACCT-CR-WRITE-OFF-88 (MDST-ACCT-IDX) DTSBE444 02146 ADD MDST-AMT (MDST-ACCT-IDX) DTSBE444 02147 TO WRK-CREDIT-WRITEOFF-UNK DTSBE444 02148 END-EVALUATE DTSBE444 02149 DTSBE444 02150 END-EVALUATE. DTSBE444 02151 DTSBE444 02152 DTSBE444 02153 P5110-EXIT. DTSBE444 02154 EXIT. DTSBE444 02155 DTSBE444 02156 P5111-WRITE-OUTPUT. DTSBE444 02157 MOVE MPRF-EMP-NO TO CREDIT-EMP-NO. DTSBE444 02158 MOVE MPRF-PRIMARY-NAME TO CREDIT-PRIMARY-NAME. DTSBE444 02159 INSPECT CREDIT-PRIMARY-NAME REPLACING ALL ',' BY SPACE. DTSBE444 02160 MOVE MPRF-EMP-CLASS TO CREDIT-EMP-CLASS. DTSBE444 02161 MOVE MDST-BATCH-NO TO CREDIT-BATCH-NO. DTSBE444 02162 MOVE MDST-ITEM-NO TO CREDIT-ITEM-NO. DTSBE444 02163 DTSBE444 02164 MOVE MDST-ESTB-DATE TO L001-FED-8-DATE-9. DTSBE444 02165 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBE444 02166 MOVE L001-SLASH-8-DATE TO CREDIT-PROC-DATE. DTSBE444 02167 DTSBE444 02168 MOVE MDST-AMT (MDST-ACCT-IDX) TO CREDIT-AMT, DTSBE444 02169 DTSBE444 02170 WRITE CREDIT-REC FROM WRK-CREDIT-REC. DTSBE444 02171 ADD +1 TO WRK-CREDIT-CNT. DTSBE444 02172 DTSBE444 02173 DTSBE444 02174 P5111-EXIT. DTSBE444 02175 EXIT. DTSBE444 02176 DTSBE444 02177 T0000-TERMINATE. DTSBE444 02178 PERFORM T1000-WRITE-R442 THRU T1000-EXIT. DTSBE444 02179 DTSBE444 02180 CLOSE AUDIT-FILE DTSBE444 02181 AGING-REPORT DTSBE444 02182 QTR-FILE DTSBE444 02183 PAY-FILE DTSBE444 02184 CREDIT-FILE. DTSBE444 02185 DTSBE444 02186 T0000-EXIT. DTSBE444 02187 EXIT. DTSBE444 02188 DTSBE444 02189 T1000-WRITE-R442. DTSBE444 02190 MOVE WRK-TOTAL-RATED-TAX TO DISPLAY-TAX. DTSBE444 02191 DISPLAY '*** RATED TOTAL: ' DISPLAY-TAX. DTSBE444 02192 DISPLAY SPACE. DTSBE444 02193 DISPLAY '*** RATED PAYMENTS ***'. DTSBE444 02194 MOVE WRK-MTH-RATED-TAX-PAY TO DISPLAY-TAX. DTSBE444 02195 MOVE WRK-MTH-RATED-PEN-PAY TO DISPLAY-PEN. DTSBE444 02196 MOVE WRK-MTH-RATED-INT-PAY TO DISPLAY-INT. DTSBE444 02197 DISPLAY ' TAX PAY ' DISPLAY-TAX. DTSBE444 02198 DISPLAY ' PEN PAY ' DISPLAY-PEN. DTSBE444 02199 DISPLAY ' INT PAY ' DISPLAY-INT. DTSBE444 02200 DISPLAY SPACE. DTSBE444 02201 DTSBE444 02202 MOVE WRK-TOT-SI-TAX TO DISPLAY-TAX. DTSBE444 02203 DISPLAY '*** SI TOTAL: ' DISPLAY-TAX. DTSBE444 02204 DISPLAY SPACE. DTSBE444 02205 DISPLAY '*** SELF-INSURED PAYMENTS ***'. DTSBE444 02206 MOVE WRK-MTH-SI-TAX-PAY TO DISPLAY-TAX. DTSBE444 02207 MOVE WRK-MTH-SI-PEN-PAY TO DISPLAY-PEN. DTSBE444 02208 MOVE WRK-MTH-SI-INT-PAY TO DISPLAY-INT. DTSBE444 02209 DISPLAY ' TAX PAY ' DISPLAY-TAX. DTSBE444 02210 DISPLAY ' PEN PAY ' DISPLAY-PEN. DTSBE444 02211 DISPLAY ' INT PAY ' DISPLAY-INT. DTSBE444 02212 DISPLAY SPACE. DTSBE444 02213 DTSBE444 02214 DISPLAY '*** UNKNOWN PAYMENTS ***'. DTSBE444 02215 MOVE WRK-MTH-UNK-TAX-PAY TO DISPLAY-TAX. DTSBE444 02216 MOVE WRK-MTH-UNK-PEN-PAY TO DISPLAY-PEN. DTSBE444 02217 MOVE WRK-MTH-UNK-INT-PAY TO DISPLAY-INT. DTSBE444 02218 DISPLAY ' TAX PAY ' DISPLAY-TAX. DTSBE444 02219 DISPLAY ' PEN PAY ' DISPLAY-PEN. DTSBE444 02220 DISPLAY ' INT PAY ' DISPLAY-INT. DTSBE444 02221 DISPLAY SPACE. DTSBE444 02222 DTSBE444 02223 ******************************************************** DTSBE444 02224 * CREDITS DTSBE444 02225 ******************************************************** DTSBE444 02226 ADD WRK-CREDIT-WRITEOFF-RATED TO WRK-CREDIT-PAID-RATED. DTSBE444 02227 ADD WRK-CREDIT-TOL-RATED TO WRK-CREDIT-PAID-RATED. DTSBE444 02228 COMPUTE WRK-CREDIT-WRITEOFF-RATED = DTSBE444 02229 (WRK-CREDIT-WRITEOFF-RATED * -1). DTSBE444 02230 COMPUTE WRK-CREDIT-TOL-RATED = DTSBE444 02231 (WRK-CREDIT-TOL-RATED * -1). DTSBE444 02232 COMPUTE WRK-CREDIT-AMT = (0 - DTSBE444 02233 WRK-CREDIT-PAID-RATED - WRK-CREDIT-WRITEOFF-RATED DTSBE444 02234 - WRK-CREDIT-TOL-RATED). DTSBE444 02235 DTSBE444 02236 DISPLAY '*** RATED CREDITS ***'. DTSBE444 02237 MOVE WRK-CREDIT-AMT TO DISPLAY-TAX. DTSBE444 02238 DISPLAY ' CREDIT ' DISPLAY-TAX. DTSBE444 02239 MOVE WRK-MTH-RATED-CRED-PAY TO DISPLAY-TAX. DTSBE444 02240 DISPLAY ' CREDIT PAID ' DISPLAY-TAX. DTSBE444 02241 DISPLAY SPACE. DTSBE444 02242 DTSBE444 02243 ADD WRK-CREDIT-WRITEOFF-SI TO WRK-CREDIT-PAID-SI. DTSBE444 02244 ADD WRK-CREDIT-TOL-SI TO WRK-CREDIT-PAID-SI. DTSBE444 02245 COMPUTE WRK-CREDIT-WRITEOFF-SI = DTSBE444 02246 (WRK-CREDIT-WRITEOFF-SI * -1). DTSBE444 02247 COMPUTE WRK-CREDIT-TOL-SI = DTSBE444 02248 (WRK-CREDIT-TOL-SI * -1). DTSBE444 02249 COMPUTE WRK-CREDIT-AMT = (0 - DTSBE444 02250 WRK-CREDIT-PAID-SI - WRK-CREDIT-WRITEOFF-SI DTSBE444 02251 - WRK-CREDIT-TOL-SI). DTSBE444 02252 DTSBE444 02253 DISPLAY '*** SELF-INSURED CREDITS ***'. DTSBE444 02254 MOVE WRK-CREDIT-AMT TO DISPLAY-TAX. DTSBE444 02255 DISPLAY ' CREDIT ' DISPLAY-TAX. DTSBE444 02256 MOVE WRK-MTH-SI-CRED-PAY TO DISPLAY-TAX. DTSBE444 02257 DISPLAY ' CREDIT PAID ' DISPLAY-TAX. DTSBE444 02258 DISPLAY SPACE. DTSBE444 02259 DTSBE444 02260 ADD WRK-CREDIT-WRITEOFF-UNK TO WRK-CREDIT-PAID-UNK. DTSBE444 02261 ADD WRK-CREDIT-TOL-UNK TO WRK-CREDIT-PAID-UNK. DTSBE444 02262 COMPUTE WRK-CREDIT-WRITEOFF-UNK = DTSBE444 02263 (WRK-CREDIT-WRITEOFF-UNK * -1). DTSBE444 02264 COMPUTE WRK-CREDIT-TOL-UNK = DTSBE444 02265 (WRK-CREDIT-TOL-UNK * -1). DTSBE444 02266 COMPUTE WRK-CREDIT-AMT = (0 - DTSBE444 02267 WRK-CREDIT-PAID-UNK - WRK-CREDIT-WRITEOFF-UNK DTSBE444 02268 - WRK-CREDIT-TOL-UNK). DTSBE444 02269 DTSBE444 02270 DISPLAY '*** UNKNOWN CREDITS ***'. DTSBE444 02271 MOVE WRK-CREDIT-AMT TO DISPLAY-TAX. DTSBE444 02272 DISPLAY ' CREDIT ' DISPLAY-TAX. DTSBE444 02273 MOVE WRK-MTH-UNK-CRED-PAY TO DISPLAY-TAX. DTSBE444 02274 DISPLAY ' CREDIT PAID ' DISPLAY-TAX. DTSBE444 02275 DISPLAY SPACE. DTSBE444 02276 DTSBE444 02277 DISPLAY '*** AGING OF EMPLOYER ACCOUNTS RECEIVABLE ***'.DTSBE444 02278 DISPLAY SPACE. DTSBE444 02279 DISPLAY '*** RATED ***'. DTSBE444 02280 MOVE 'RATED ' TO X442-EMPL-TYPE. DTSBE444 02281 DTSBE444 02282 MOVE WRK-QTR-YRQ (1) TO R442-YRQ (1) L004-QTR-5-9. DTSBE444 02283 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE444 02284 IF L004-INVALID-QTR DTSBE444 02285 MOVE 'INVALID YEAR/QTR ' TO ABEND-MSG DTSBE444 02286 PERFORM S999-ABEND THRU S999-EXIT DTSBE444 02287 ELSE DTSBE444 02288 MOVE L004-SLASH-5-QTR TO X442-DESCRIPTION DTSBE444 02289 END-IF. DTSBE444 02290 DTSBE444 02291 MOVE WRK-QTR-RATED-TAX (1) TO DISPLAY-TAX R442-TAX-AMT (1) DTSBE444 02292 X442-TAX. DTSBE444 02293 MOVE WRK-QTR-RATED-PEN (1) TO DISPLAY-PEN R442-PEN-AMT (1) DTSBE444 02294 X442-PENALTY. DTSBE444 02295 MOVE WRK-QTR-RATED-INT (1) TO DISPLAY-INT R442-INT-AMT (1) DTSBE444 02296 X442-INTEREST. DTSBE444 02297 DISPLAY WRK-QTR-YRQ (1) DTSBE444 02298 ' TAX ' DISPLAY-TAX DTSBE444 02299 ' PEN ' DISPLAY-PEN DTSBE444 02300 ' INT ' DISPLAY-INT. DTSBE444 02301 DTSBE444 02302 * WRITE AGING-REC FROM X442-REC. DTSBE444 02303 * ADD +1 TO WRK-AGING-CNT. DTSBE444 02304 DTSBE444 02305 MOVE WRK-QTR-YRQ (2) TO R442-YRQ (2) L004-QTR-5-9. DTSBE444 02306 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE444 02307 IF L004-INVALID-QTR DTSBE444 02308 MOVE 'INVALID YEAR/QTR ' TO ABEND-MSG DTSBE444 02309 PERFORM S999-ABEND THRU S999-EXIT DTSBE444 02310 ELSE DTSBE444 02311 MOVE L004-SLASH-5-QTR TO X442-DESCRIPTION DTSBE444 02312 END-IF. DTSBE444 02313 DTSBE444 02314 MOVE WRK-QTR-RATED-TAX (2) TO DISPLAY-TAX R442-TAX-AMT (2) DTSBE444 02315 X442-TAX. DTSBE444 02316 MOVE WRK-QTR-RATED-PEN (2) TO DISPLAY-PEN R442-PEN-AMT (2) DTSBE444 02317 X442-PENALTY. DTSBE444 02318 MOVE WRK-QTR-RATED-INT (2) TO DISPLAY-INT R442-INT-AMT (2) DTSBE444 02319 X442-INTEREST. DTSBE444 02320 DISPLAY WRK-QTR-YRQ (2) DTSBE444 02321 ' TAX ' DISPLAY-TAX DTSBE444 02322 ' PEN ' DISPLAY-PEN DTSBE444 02323 ' INT ' DISPLAY-INT. DTSBE444 02324 DTSBE444 02325 * WRITE AGING-REC FROM X442-REC. DTSBE444 02326 * ADD +1 TO WRK-AGING-CNT. DTSBE444 02327 DTSBE444 02328 MOVE WRK-QTR-YRQ (3) TO R442-YRQ (3) L004-QTR-5-9. DTSBE444 02329 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE444 02330 IF L004-INVALID-QTR DTSBE444 02331 MOVE 'INVALID YEAR/QTR ' TO ABEND-MSG DTSBE444 02332 PERFORM S999-ABEND THRU S999-EXIT DTSBE444 02333 ELSE DTSBE444 02334 MOVE L004-SLASH-5-QTR TO X442-DESCRIPTION DTSBE444 02335 END-IF. DTSBE444 02336 DTSBE444 02337 MOVE WRK-QTR-RATED-TAX (3) TO DISPLAY-TAX R442-TAX-AMT (3) DTSBE444 02338 X442-TAX. DTSBE444 02339 MOVE WRK-QTR-RATED-PEN (3) TO DISPLAY-PEN R442-PEN-AMT (3) DTSBE444 02340 X442-PENALTY. DTSBE444 02341 MOVE WRK-QTR-RATED-INT (3) TO DISPLAY-INT R442-INT-AMT (3) DTSBE444 02342 X442-INTEREST. DTSBE444 02343 DISPLAY WRK-QTR-YRQ (3) DTSBE444 02344 ' TAX ' DISPLAY-TAX DTSBE444 02345 ' PEN ' DISPLAY-PEN DTSBE444 02346 ' INT ' DISPLAY-INT. DTSBE444 02347 DTSBE444 02348 * WRITE AGING-REC FROM X442-REC. DTSBE444 02349 * ADD +1 TO WRK-AGING-CNT. DTSBE444 02350 DTSBE444 02351 MOVE WRK-QTR-YRQ (4) TO R442-YRQ (4) L004-QTR-5-9. DTSBE444 02352 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE444 02353 IF L004-INVALID-QTR DTSBE444 02354 MOVE 'INVALID YEAR/QTR ' TO ABEND-MSG DTSBE444 02355 PERFORM S999-ABEND THRU S999-EXIT DTSBE444 02356 ELSE DTSBE444 02357 MOVE L004-SLASH-5-QTR TO X442-DESCRIPTION DTSBE444 02358 END-IF. DTSBE444 02359 DTSBE444 02360 MOVE WRK-QTR-RATED-TAX (4) TO DISPLAY-TAX R442-TAX-AMT (4) DTSBE444 02361 X442-TAX. DTSBE444 02362 MOVE WRK-QTR-RATED-PEN (4) TO DISPLAY-PEN R442-PEN-AMT (4) DTSBE444 02363 X442-PENALTY. DTSBE444 02364 MOVE WRK-QTR-RATED-INT (4) TO DISPLAY-INT R442-INT-AMT (4) DTSBE444 02365 X442-INTEREST. DTSBE444 02366 DISPLAY WRK-QTR-YRQ (4) DTSBE444 02367 ' TAX ' DISPLAY-TAX DTSBE444 02368 ' PEN ' DISPLAY-PEN DTSBE444 02369 ' INT ' DISPLAY-INT. DTSBE444 02370 DTSBE444 02371 * WRITE AGING-REC FROM X442-REC. DTSBE444 02372 * ADD +1 TO WRK-AGING-CNT. DTSBE444 02373 DTSBE444 02374 MOVE WRK-QTR-YRQ (5) TO R442-YRQ (5) L004-QTR-5-9. DTSBE444 02375 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE444 02376 IF L004-INVALID-QTR DTSBE444 02377 MOVE 'INVALID YEAR/QTR ' TO ABEND-MSG DTSBE444 02378 PERFORM S999-ABEND THRU S999-EXIT DTSBE444 02379 ELSE DTSBE444 02380 MOVE L004-SLASH-5-QTR TO X442-DESCRIPTION DTSBE444 02381 END-IF. DTSBE444 02382 DTSBE444 02383 MOVE WRK-QTR-RATED-TAX (5) TO DISPLAY-TAX R442-TAX-AMT (5) DTSBE444 02384 X442-TAX. DTSBE444 02385 MOVE WRK-QTR-RATED-PEN (5) TO DISPLAY-PEN R442-PEN-AMT (5) DTSBE444 02386 X442-PENALTY. DTSBE444 02387 MOVE WRK-QTR-RATED-INT (5) TO DISPLAY-INT R442-INT-AMT (5) DTSBE444 02388 X442-INTEREST. DTSBE444 02389 DISPLAY WRK-QTR-YRQ (5) DTSBE444 02390 ' TAX ' DISPLAY-TAX DTSBE444 02391 ' PEN ' DISPLAY-PEN DTSBE444 02392 ' INT ' DISPLAY-INT. DTSBE444 02393 DTSBE444 02394 * WRITE AGING-REC FROM X442-REC. DTSBE444 02395 * ADD +1 TO WRK-AGING-CNT. DTSBE444 02396 DTSBE444 02397 MOVE WRK-QTR-YRQ (6) TO R442-YRQ (6) L004-QTR-5-9. DTSBE444 02398 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE444 02399 IF L004-INVALID-QTR DTSBE444 02400 MOVE 'INVALID YEAR/QTR ' TO ABEND-MSG DTSBE444 02401 PERFORM S999-ABEND THRU S999-EXIT DTSBE444 02402 ELSE DTSBE444 02403 MOVE L004-SLASH-5-QTR TO X442-DESCRIPTION DTSBE444 02404 END-IF. DTSBE444 02405 DTSBE444 02406 MOVE WRK-QTR-RATED-TAX (6) TO DISPLAY-TAX R442-TAX-AMT (6) DTSBE444 02407 X442-TAX. DTSBE444 02408 MOVE WRK-QTR-RATED-PEN (6) TO DISPLAY-PEN R442-PEN-AMT (6) DTSBE444 02409 X442-PENALTY. DTSBE444 02410 MOVE WRK-QTR-RATED-INT (6) TO DISPLAY-INT R442-INT-AMT (6) DTSBE444 02411 X442-INTEREST. DTSBE444 02412 DISPLAY WRK-QTR-YRQ (6) DTSBE444 02413 ' TAX ' DISPLAY-TAX DTSBE444 02414 ' PEN ' DISPLAY-PEN DTSBE444 02415 ' INT ' DISPLAY-INT. DTSBE444 02416 DTSBE444 02417 * WRITE AGING-REC FROM X442-REC. DTSBE444 02418 * ADD +1 TO WRK-AGING-CNT. DTSBE444 02419 DTSBE444 02420 MOVE WRK-QTR-YRQ (7) TO R442-YRQ (7) L004-QTR-5-9. DTSBE444 02421 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE444 02422 IF L004-INVALID-QTR DTSBE444 02423 MOVE 'INVALID YEAR/QTR ' TO ABEND-MSG DTSBE444 02424 PERFORM S999-ABEND THRU S999-EXIT DTSBE444 02425 ELSE DTSBE444 02426 MOVE L004-SLASH-5-QTR TO X442-DESCRIPTION DTSBE444 02427 END-IF. DTSBE444 02428 DTSBE444 02429 MOVE WRK-QTR-RATED-TAX (7) TO DISPLAY-TAX R442-TAX-AMT (7) DTSBE444 02430 X442-TAX. DTSBE444 02431 MOVE WRK-QTR-RATED-PEN (7) TO DISPLAY-PEN R442-PEN-AMT (7) DTSBE444 02432 X442-PENALTY. DTSBE444 02433 MOVE WRK-QTR-RATED-INT (7) TO DISPLAY-INT R442-INT-AMT (7) DTSBE444 02434 X442-INTEREST. DTSBE444 02435 DISPLAY WRK-QTR-YRQ (7) ' AND PRIOR' DTSBE444 02436 DISPLAY ' TAX ' DISPLAY-TAX DTSBE444 02437 ' PEN ' DISPLAY-PEN DTSBE444 02438 ' INT ' DISPLAY-INT. DTSBE444 02439 DTSBE444 02440 * WRITE AGING-REC FROM X442-REC. DTSBE444 02441 * ADD +1 TO WRK-AGING-CNT. DTSBE444 02442 DTSBE444 02443 COMPUTE WRK-TOT-RATED-PEN = DTSBE444 02444 WRK-QTR-RATED-PEN (1) + DTSBE444 02445 WRK-QTR-RATED-PEN (2) + DTSBE444 02446 WRK-QTR-RATED-PEN (3) + DTSBE444 02447 WRK-QTR-RATED-PEN (4) + DTSBE444 02448 WRK-QTR-RATED-PEN (5) + DTSBE444 02449 WRK-QTR-RATED-PEN (6) + DTSBE444 02450 WRK-QTR-RATED-PEN (7). DTSBE444 02451 COMPUTE WRK-TOT-RATED-TAX = DTSBE444 02452 WRK-QTR-RATED-TAX (1) + DTSBE444 02453 WRK-QTR-RATED-TAX (2) + DTSBE444 02454 WRK-QTR-RATED-TAX (3) + DTSBE444 02455 WRK-QTR-RATED-TAX (4) + DTSBE444 02456 WRK-QTR-RATED-TAX (5) + DTSBE444 02457 WRK-QTR-RATED-TAX (6) + DTSBE444 02458 WRK-QTR-RATED-TAX (7). DTSBE444 02459 COMPUTE WRK-TOT-RATED-INT = DTSBE444 02460 WRK-QTR-RATED-INT (1) + DTSBE444 02461 WRK-QTR-RATED-INT (2) + DTSBE444 02462 WRK-QTR-RATED-INT (3) + DTSBE444 02463 WRK-QTR-RATED-INT (4) + DTSBE444 02464 WRK-QTR-RATED-INT (5) + DTSBE444 02465 WRK-QTR-RATED-INT (6) + DTSBE444 02466 WRK-QTR-RATED-INT (7). DTSBE444 02467 DTSBE444 02468 MOVE 'GRAND TOTAL' TO X442-DESCRIPTION. DTSBE444 02469 DTSBE444 02470 MOVE WRK-TOT-RATED-TAX TO DISPLAY-TAX X442-TAX. DTSBE444 02471 MOVE WRK-TOT-RATED-PEN TO DISPLAY-PEN X442-PENALTY. DTSBE444 02472 MOVE WRK-TOT-RATED-INT TO DISPLAY-INT X442-INTEREST. DTSBE444 02473 DISPLAY SPACE. DTSBE444 02474 DISPLAY 'TOTAL' DTSBE444 02475 ' TAX ' DISPLAY-TAX DTSBE444 02476 ' PEN ' DISPLAY-PEN DTSBE444 02477 ' INT ' DISPLAY-INT. DTSBE444 02478 DTSBE444 02479 * WRITE AGING-REC FROM X442-REC. DTSBE444 02480 * ADD +1 TO WRK-AGING-CNT. DTSBE444 02481 DTSBE444 02482 MOVE '3 YEARS OR MORE' TO X442-DESCRIPTION. DTSBE444 02483 DISPLAY SPACE. DTSBE444 02484 DISPLAY '3 YEARS OR MORE ' DTSBE444 02485 MOVE WRK-3-YR-RATED-TAX TO DISPLAY-TAX X442-TAX DTSBE444 02486 R442-3-YR-MORE-TAX-AMT. DTSBE444 02487 MOVE WRK-3-YR-RATED-PEN TO DISPLAY-PEN X442-PENALTY DTSBE444 02488 R442-3-YR-MORE-PEN-AMT. DTSBE444 02489 MOVE WRK-3-YR-RATED-INT TO DISPLAY-INT X442-INTEREST DTSBE444 02490 R442-3-YR-MORE-INT-AMT. DTSBE444 02491 DISPLAY ' ' DTSBE444 02492 ' TAX ' DISPLAY-TAX DTSBE444 02493 ' PEN ' DISPLAY-PEN DTSBE444 02494 ' INT ' DISPLAY-INT. DTSBE444 02495 DTSBE444 02496 * WRITE AGING-REC FROM X442-REC. DTSBE444 02497 * ADD +1 TO WRK-AGING-CNT. DTSBE444 02498 DTSBE444 02499 DISPLAY SPACE. DTSBE444 02500 DISPLAY 'SINCE 1999/4 ' DTSBE444 02501 MOVE WRK-19994-RATED-TAX TO DISPLAY-TAX. DTSBE444 02502 MOVE WRK-19994-RATED-PEN TO DISPLAY-PEN. DTSBE444 02503 MOVE WRK-19994-RATED-INT TO DISPLAY-INT. DTSBE444 02504 DISPLAY ' ' DTSBE444 02505 ' TAX ' DISPLAY-TAX DTSBE444 02506 ' PEN ' DISPLAY-PEN DTSBE444 02507 ' INT ' DISPLAY-INT. DTSBE444 02508 DTSBE444 02509 MOVE 'ACTIVE ' TO X442-DESCRIPTION. DTSBE444 02510 DISPLAY SPACE. DTSBE444 02511 MOVE WRK-ACTIVE-RATED-TAX TO DISPLAY-TAX X442-TAX DTSBE444 02512 R442-ACTIVE-TAX-AMT. DTSBE444 02513 MOVE WRK-ACTIVE-RATED-PEN TO DISPLAY-PEN X442-PENALTY DTSBE444 02514 R442-ACTIVE-PEN-AMT. DTSBE444 02515 MOVE WRK-ACTIVE-RATED-INT TO DISPLAY-INT X442-INTEREST DTSBE444 02516 R442-ACTIVE-INT-AMT. DTSBE444 02517 DISPLAY 'ACTIVE' DTSBE444 02518 ' TAX ' DISPLAY-TAX DTSBE444 02519 ' PEN ' DISPLAY-PEN DTSBE444 02520 ' INT ' DISPLAY-INT. DTSBE444 02521 DTSBE444 02522 * WRITE AGING-REC FROM X442-REC. DTSBE444 02523 * ADD +1 TO WRK-AGING-CNT. DTSBE444 02524 DTSBE444 02525 MOVE 'INACTIVE ' TO X442-DESCRIPTION. DTSBE444 02526 MOVE WRK-INACT-RATED-TAX TO DISPLAY-TAX X442-TAX DTSBE444 02527 R442-INACTIVE-TAX-AMT. DTSBE444 02528 MOVE WRK-INACT-RATED-PEN TO DISPLAY-PEN X442-PENALTY DTSBE444 02529 R442-INACTIVE-PEN-AMT. DTSBE444 02530 MOVE WRK-INACT-RATED-INT TO DISPLAY-INT X442-INTEREST DTSBE444 02531 R442-INACTIVE-INT-AMT. DTSBE444 02532 DISPLAY 'INACTIVE' DTSBE444 02533 ' TAX ' DISPLAY-TAX DTSBE444 02534 ' PEN ' DISPLAY-PEN DTSBE444 02535 ' INT ' DISPLAY-INT. DTSBE444 02536 DTSBE444 02537 * WRITE AGING-REC FROM X442-REC. DTSBE444 02538 * ADD +1 TO WRK-AGING-CNT. DTSBE444 02539 DTSBE444 02540 MOVE 'INACTIVE 3 YEAR' TO X442-DESCRIPTION. DTSBE444 02541 MOVE WRK-INACT-3YR-RATED-TAX TO DISPLAY-TAX X442-TAX DTSBE444 02542 R442-INACT-3-YR-TAX-AMT. DTSBE444 02543 MOVE WRK-INACT-3YR-RATED-PEN TO DISPLAY-PEN X442-PENALTY DTSBE444 02544 R442-INACT-3-YR-PEN-AMT. DTSBE444 02545 MOVE WRK-INACT-3YR-RATED-INT TO DISPLAY-INT X442-INTEREST DTSBE444 02546 R442-INACT-3-YR-INT-AMT. DTSBE444 02547 DISPLAY 'INACTIVE 3 YEARS' DTSBE444 02548 ' TAX ' DISPLAY-TAX DTSBE444 02549 ' PEN ' DISPLAY-PEN DTSBE444 02550 ' INT ' DISPLAY-INT. DTSBE444 02551 DISPLAY SPACE. DTSBE444 02552 DTSBE444 02553 * WRITE AGING-REC FROM X442-REC. DTSBE444 02554 * ADD +1 TO WRK-AGING-CNT. DTSBE444 02555 DTSBE444 02556 MOVE 'TOT IN CHAPTER 7 ' TO X442-DESCRIPTION. DTSBE444 02557 MOVE WRK-CHAPTER-7-RATED-TAX TO DISPLAY-TAX X442-TAX DTSBE444 02558 R442-TOT-CHPT-7-TAX-AMT. DTSBE444 02559 MOVE WRK-CHAPTER-7-RATED-PEN TO DISPLAY-PEN X442-PENALTY DTSBE444 02560 R442-TOT-CHPT-7-PEN-AMT. DTSBE444 02561 MOVE WRK-CHAPTER-7-RATED-INT TO DISPLAY-INT X442-INTEREST DTSBE444 02562 R442-TOT-CHPT-7-INT-AMT. DTSBE444 02563 DISPLAY 'TOTAL IN CHAPTER 7 ' DTSBE444 02564 ' TAX ' DISPLAY-TAX DTSBE444 02565 ' PEN ' DISPLAY-PEN DTSBE444 02566 ' INT ' DISPLAY-INT. DTSBE444 02567 DTSBE444 02568 * WRITE AGING-REC FROM X442-REC. DTSBE444 02569 * ADD +1 TO WRK-AGING-CNT. DTSBE444 02570 DTSBE444 02571 MOVE 'TOT IN CHAPTER 11' TO X442-DESCRIPTION. DTSBE444 02572 MOVE WRK-CHAPTER-11-RATED-TAX TO DISPLAY-TAX X442-TAX DTSBE444 02573 R442-TOT-CHPT-11-TAX-AMT. DTSBE444 02574 MOVE WRK-CHAPTER-11-RATED-PEN TO DISPLAY-PEN X442-PENALTY DTSBE444 02575 R442-TOT-CHPT-11-PEN-AMT. DTSBE444 02576 MOVE WRK-CHAPTER-11-RATED-INT TO DISPLAY-INT X442-INTEREST DTSBE444 02577 R442-TOT-CHPT-11-INT-AMT. DTSBE444 02578 DISPLAY 'TOTAL IN CHAPTER 11 ' DTSBE444 02579 ' TAX ' DISPLAY-TAX DTSBE444 02580 ' PEN ' DISPLAY-PEN DTSBE444 02581 ' INT ' DISPLAY-INT. DTSBE444 02582 DTSBE444 02583 * WRITE AGING-REC FROM X442-REC. DTSBE444 02584 * ADD +1 TO WRK-AGING-CNT. DTSBE444 02585 DTSBE444 02586 SET R442-SORT-CLASS-R-88 TO TRUE. DTSBE444 02587 PERFORM S946-WRITE-R442 THRU S946-EXIT. DTSBE444 02588 DTSBE444 02589 DISPLAY '*** SELF-INS ***'. DTSBE444 02590 MOVE 'SELF INS' TO X442-EMPL-TYPE. DTSBE444 02591 MOVE WRK-QTR-YRQ (1) TO R442-YRQ (1) DTSBE444 02592 L004-QTR-5-9. DTSBE444 02593 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE444 02594 IF L004-INVALID-QTR DTSBE444 02595 MOVE 'INVALID YEAR/QTR ' TO ABEND-MSG DTSBE444 02596 PERFORM S999-ABEND THRU S999-EXIT DTSBE444 02597 ELSE DTSBE444 02598 MOVE L004-SLASH-5-QTR TO X442-DESCRIPTION DTSBE444 02599 END-IF. DTSBE444 02600 DTSBE444 02601 MOVE WRK-QTR-SELF-INS-TAX (1) TO DISPLAY-TAX X442-TAX DTSBE444 02602 R442-TAX-AMT (1). DTSBE444 02603 MOVE WRK-QTR-SELF-INS-PEN (1) TO DISPLAY-PEN X442-PENALTY DTSBE444 02604 R442-PEN-AMT (1). DTSBE444 02605 MOVE WRK-QTR-SELF-INS-INT (1) TO DISPLAY-INT X442-INTEREST DTSBE444 02606 R442-INT-AMT (1). DTSBE444 02607 DISPLAY WRK-QTR-YRQ (1) DTSBE444 02608 ' TAX ' DISPLAY-TAX DTSBE444 02609 ' PEN ' DISPLAY-PEN DTSBE444 02610 ' INT ' DISPLAY-INT. DTSBE444 02611 DTSBE444 02612 * WRITE AGING-REC FROM X442-REC. DTSBE444 02613 * ADD +1 TO WRK-AGING-CNT. DTSBE444 02614 DTSBE444 02615 MOVE WRK-QTR-YRQ (2) TO R442-YRQ (2) DTSBE444 02616 L004-QTR-5-9. DTSBE444 02617 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE444 02618 IF L004-INVALID-QTR DTSBE444 02619 MOVE 'INVALID YEAR/QTR ' TO ABEND-MSG DTSBE444 02620 PERFORM S999-ABEND THRU S999-EXIT DTSBE444 02621 ELSE DTSBE444 02622 MOVE L004-SLASH-5-QTR TO X442-DESCRIPTION DTSBE444 02623 END-IF. DTSBE444 02624 DTSBE444 02625 MOVE WRK-QTR-SELF-INS-TAX (2) TO DISPLAY-TAX X442-TAX DTSBE444 02626 R442-TAX-AMT (2). DTSBE444 02627 MOVE WRK-QTR-SELF-INS-PEN (2) TO DISPLAY-PEN X442-PENALTY DTSBE444 02628 R442-PEN-AMT (2). DTSBE444 02629 MOVE WRK-QTR-SELF-INS-INT (2) TO DISPLAY-INT X442-INTEREST DTSBE444 02630 R442-INT-AMT (2). DTSBE444 02631 DISPLAY WRK-QTR-YRQ (2) DTSBE444 02632 ' TAX ' DISPLAY-TAX DTSBE444 02633 ' PEN ' DISPLAY-PEN DTSBE444 02634 ' INT ' DISPLAY-INT. DTSBE444 02635 DTSBE444 02636 * WRITE AGING-REC FROM X442-REC. DTSBE444 02637 * ADD +1 TO WRK-AGING-CNT. DTSBE444 02638 DTSBE444 02639 MOVE WRK-QTR-YRQ (3) TO R442-YRQ (3) DTSBE444 02640 L004-QTR-5-9. DTSBE444 02641 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE444 02642 IF L004-INVALID-QTR DTSBE444 02643 MOVE 'INVALID YEAR/QTR ' TO ABEND-MSG DTSBE444 02644 PERFORM S999-ABEND THRU S999-EXIT DTSBE444 02645 ELSE DTSBE444 02646 MOVE L004-SLASH-5-QTR TO X442-DESCRIPTION DTSBE444 02647 END-IF. DTSBE444 02648 DTSBE444 02649 MOVE WRK-QTR-SELF-INS-TAX (3) TO DISPLAY-TAX X442-TAX DTSBE444 02650 R442-TAX-AMT (3). DTSBE444 02651 MOVE WRK-QTR-SELF-INS-PEN (3) TO DISPLAY-PEN X442-PENALTY DTSBE444 02652 R442-PEN-AMT (3). DTSBE444 02653 MOVE WRK-QTR-SELF-INS-INT (3) TO DISPLAY-INT X442-INTEREST DTSBE444 02654 R442-INT-AMT (3). DTSBE444 02655 DISPLAY WRK-QTR-YRQ (3) DTSBE444 02656 ' TAX ' DISPLAY-TAX DTSBE444 02657 ' PEN ' DISPLAY-PEN DTSBE444 02658 ' INT ' DISPLAY-INT. DTSBE444 02659 DTSBE444 02660 * WRITE AGING-REC FROM X442-REC. DTSBE444 02661 * ADD +1 TO WRK-AGING-CNT. DTSBE444 02662 DTSBE444 02663 MOVE WRK-QTR-YRQ (4) TO R442-YRQ (4) DTSBE444 02664 L004-QTR-5-9. DTSBE444 02665 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE444 02666 IF L004-INVALID-QTR DTSBE444 02667 MOVE 'INVALID YEAR/QTR ' TO ABEND-MSG DTSBE444 02668 PERFORM S999-ABEND THRU S999-EXIT DTSBE444 02669 ELSE DTSBE444 02670 MOVE L004-SLASH-5-QTR TO X442-DESCRIPTION DTSBE444 02671 END-IF. DTSBE444 02672 DTSBE444 02673 MOVE WRK-QTR-SELF-INS-TAX (4) TO DISPLAY-TAX X442-TAX DTSBE444 02674 R442-TAX-AMT (4). DTSBE444 02675 MOVE WRK-QTR-SELF-INS-PEN (4) TO DISPLAY-PEN X442-PENALTY DTSBE444 02676 R442-PEN-AMT (4). DTSBE444 02677 MOVE WRK-QTR-SELF-INS-INT (4) TO DISPLAY-INT X442-INTEREST DTSBE444 02678 R442-INT-AMT (4). DTSBE444 02679 DISPLAY WRK-QTR-YRQ (4) DTSBE444 02680 ' TAX ' DISPLAY-TAX DTSBE444 02681 ' PEN ' DISPLAY-PEN DTSBE444 02682 ' INT ' DISPLAY-INT. DTSBE444 02683 DTSBE444 02684 * WRITE AGING-REC FROM X442-REC. DTSBE444 02685 * ADD +1 TO WRK-AGING-CNT. DTSBE444 02686 DTSBE444 02687 MOVE WRK-QTR-YRQ (5) TO R442-YRQ (5) DTSBE444 02688 L004-QTR-5-9. DTSBE444 02689 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE444 02690 IF L004-INVALID-QTR DTSBE444 02691 MOVE 'INVALID YEAR/QTR ' TO ABEND-MSG DTSBE444 02692 PERFORM S999-ABEND THRU S999-EXIT DTSBE444 02693 ELSE DTSBE444 02694 MOVE L004-SLASH-5-QTR TO X442-DESCRIPTION DTSBE444 02695 END-IF. DTSBE444 02696 DTSBE444 02697 MOVE WRK-QTR-SELF-INS-TAX (5) TO DISPLAY-TAX X442-TAX DTSBE444 02698 R442-TAX-AMT (5). DTSBE444 02699 MOVE WRK-QTR-SELF-INS-PEN (5) TO DISPLAY-PEN X442-PENALTY DTSBE444 02700 R442-PEN-AMT (5). DTSBE444 02701 MOVE WRK-QTR-SELF-INS-INT (5) TO DISPLAY-INT X442-INTEREST DTSBE444 02702 R442-INT-AMT (5). DTSBE444 02703 DISPLAY WRK-QTR-YRQ (5) DTSBE444 02704 ' TAX ' DISPLAY-TAX DTSBE444 02705 ' PEN ' DISPLAY-PEN DTSBE444 02706 ' INT ' DISPLAY-INT. DTSBE444 02707 DTSBE444 02708 * WRITE AGING-REC FROM X442-REC. DTSBE444 02709 * ADD +1 TO WRK-AGING-CNT. DTSBE444 02710 DTSBE444 02711 MOVE WRK-QTR-YRQ (6) TO R442-YRQ (6) DTSBE444 02712 L004-QTR-5-9. DTSBE444 02713 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE444 02714 IF L004-INVALID-QTR DTSBE444 02715 MOVE 'INVALID YEAR/QTR ' TO ABEND-MSG DTSBE444 02716 PERFORM S999-ABEND THRU S999-EXIT DTSBE444 02717 ELSE DTSBE444 02718 MOVE L004-SLASH-5-QTR TO X442-DESCRIPTION DTSBE444 02719 END-IF. DTSBE444 02720 DTSBE444 02721 MOVE WRK-QTR-SELF-INS-TAX (6) TO DISPLAY-TAX X442-TAX DTSBE444 02722 R442-TAX-AMT (6). DTSBE444 02723 MOVE WRK-QTR-SELF-INS-PEN (6) TO DISPLAY-PEN X442-PENALTY DTSBE444 02724 R442-PEN-AMT (6). DTSBE444 02725 MOVE WRK-QTR-SELF-INS-INT (6) TO DISPLAY-INT X442-INTEREST DTSBE444 02726 R442-INT-AMT (6). DTSBE444 02727 DISPLAY WRK-QTR-YRQ (6) DTSBE444 02728 ' TAX ' DISPLAY-TAX DTSBE444 02729 ' PEN ' DISPLAY-PEN DTSBE444 02730 ' INT ' DISPLAY-INT. DTSBE444 02731 DTSBE444 02732 * WRITE AGING-REC FROM X442-REC. DTSBE444 02733 * ADD +1 TO WRK-AGING-CNT. DTSBE444 02734 DTSBE444 02735 MOVE WRK-QTR-YRQ (7) TO R442-YRQ (7) DTSBE444 02736 L004-QTR-5-9. DTSBE444 02737 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE444 02738 IF L004-INVALID-QTR DTSBE444 02739 MOVE 'INVALID YEAR/QTR ' TO ABEND-MSG DTSBE444 02740 PERFORM S999-ABEND THRU S999-EXIT DTSBE444 02741 ELSE DTSBE444 02742 MOVE L004-SLASH-5-QTR TO X442-DESCRIPTION DTSBE444 02743 END-IF. DTSBE444 02744 DTSBE444 02745 MOVE WRK-QTR-SELF-INS-TAX (7) TO DISPLAY-TAX X442-TAX DTSBE444 02746 R442-TAX-AMT (7). DTSBE444 02747 MOVE WRK-QTR-SELF-INS-PEN (7) TO DISPLAY-PEN X442-PENALTY DTSBE444 02748 R442-PEN-AMT (7). DTSBE444 02749 MOVE WRK-QTR-SELF-INS-INT (7) TO DISPLAY-INT X442-INTEREST DTSBE444 02750 R442-INT-AMT (7). DTSBE444 02751 DISPLAY WRK-QTR-YRQ (7) ' AND PRIOR' DTSBE444 02752 DISPLAY ' TAX ' DISPLAY-TAX DTSBE444 02753 ' PEN ' DISPLAY-PEN DTSBE444 02754 ' INT ' DISPLAY-INT. DTSBE444 02755 DTSBE444 02756 * WRITE AGING-REC FROM X442-REC. DTSBE444 02757 * ADD +1 TO WRK-AGING-CNT. DTSBE444 02758 DTSBE444 02759 COMPUTE WRK-TOT-SELF-INS-PEN = DTSBE444 02760 WRK-QTR-SELF-INS-PEN (1) + DTSBE444 02761 WRK-QTR-SELF-INS-PEN (2) + DTSBE444 02762 WRK-QTR-SELF-INS-PEN (3) + DTSBE444 02763 WRK-QTR-SELF-INS-PEN (4) + DTSBE444 02764 WRK-QTR-SELF-INS-PEN (5) + DTSBE444 02765 WRK-QTR-SELF-INS-PEN (6) + DTSBE444 02766 WRK-QTR-SELF-INS-PEN (7). DTSBE444 02767 COMPUTE WRK-TOT-SELF-INS-TAX = DTSBE444 02768 WRK-QTR-SELF-INS-TAX (1) + DTSBE444 02769 WRK-QTR-SELF-INS-TAX (2) + DTSBE444 02770 WRK-QTR-SELF-INS-TAX (3) + DTSBE444 02771 WRK-QTR-SELF-INS-TAX (4) + DTSBE444 02772 WRK-QTR-SELF-INS-TAX (5) + DTSBE444 02773 WRK-QTR-SELF-INS-TAX (6) + DTSBE444 02774 WRK-QTR-SELF-INS-TAX (7). DTSBE444 02775 COMPUTE WRK-TOT-SELF-INS-INT = DTSBE444 02776 WRK-QTR-SELF-INS-INT (1) + DTSBE444 02777 WRK-QTR-SELF-INS-INT (2) + DTSBE444 02778 WRK-QTR-SELF-INS-INT (3) + DTSBE444 02779 WRK-QTR-SELF-INS-INT (4) + DTSBE444 02780 WRK-QTR-SELF-INS-INT (5) + DTSBE444 02781 WRK-QTR-SELF-INS-INT (6) + DTSBE444 02782 WRK-QTR-SELF-INS-INT (7). DTSBE444 02783 DTSBE444 02784 MOVE 'GRAND TOTAL' TO X442-DESCRIPTION. DTSBE444 02785 MOVE WRK-TOT-SELF-INS-TAX TO DISPLAY-TAX X442-TAX. DTSBE444 02786 MOVE WRK-TOT-SELF-INS-PEN TO DISPLAY-PEN X442-PENALTY. DTSBE444 02787 MOVE WRK-TOT-SELF-INS-INT TO DISPLAY-INT X442-INTEREST. DTSBE444 02788 DISPLAY SPACE. DTSBE444 02789 DISPLAY 'TOTAL' DTSBE444 02790 ' TAX ' DISPLAY-TAX DTSBE444 02791 ' PEN ' DISPLAY-PEN DTSBE444 02792 ' INT ' DISPLAY-INT. DTSBE444 02793 DTSBE444 02794 * WRITE AGING-REC FROM X442-REC. DTSBE444 02795 * ADD +1 TO WRK-AGING-CNT. DTSBE444 02796 DTSBE444 02797 MOVE '3 YEARS OR MORE ' TO X442-DESCRIPTION. DTSBE444 02798 DISPLAY SPACE. DTSBE444 02799 DISPLAY '3 YEARS OR MORE ' DTSBE444 02800 MOVE WRK-3-YR-SELF-INS-TAX TO DISPLAY-TAX X442-TAX DTSBE444 02801 R442-3-YR-MORE-TAX-AMT. DTSBE444 02802 MOVE WRK-3-YR-SELF-INS-PEN TO DISPLAY-PEN X442-PENALTY DTSBE444 02803 R442-3-YR-MORE-PEN-AMT. DTSBE444 02804 MOVE WRK-3-YR-SELF-INS-INT TO DISPLAY-INT X442-INTEREST DTSBE444 02805 R442-3-YR-MORE-INT-AMT. DTSBE444 02806 DISPLAY ' ' DTSBE444 02807 ' TAX ' DISPLAY-TAX DTSBE444 02808 ' PEN ' DISPLAY-PEN DTSBE444 02809 ' INT ' DISPLAY-INT. DTSBE444 02810 DTSBE444 02811 * WRITE AGING-REC FROM X442-REC. DTSBE444 02812 * ADD +1 TO WRK-AGING-CNT. DTSBE444 02813 DTSBE444 02814 DISPLAY SPACE. DTSBE444 02815 DISPLAY 'SINCE 1999/4 ' DTSBE444 02816 MOVE WRK-19994-SELF-INS-TAX TO DISPLAY-TAX. DTSBE444 02817 MOVE WRK-19994-SELF-INS-PEN TO DISPLAY-PEN. DTSBE444 02818 MOVE WRK-19994-SELF-INS-INT TO DISPLAY-INT. DTSBE444 02819 DISPLAY ' ' DTSBE444 02820 ' TAX ' DISPLAY-TAX DTSBE444 02821 ' PEN ' DISPLAY-PEN DTSBE444 02822 ' INT ' DISPLAY-INT. DTSBE444 02823 DTSBE444 02824 MOVE 'ACTIVE ' TO X442-DESCRIPTION. DTSBE444 02825 DISPLAY SPACE. DTSBE444 02826 MOVE WRK-ACTIVE-SELF-INS-TAX TO DISPLAY-TAX X442-TAX DTSBE444 02827 R442-ACTIVE-TAX-AMT. DTSBE444 02828 MOVE WRK-ACTIVE-SELF-INS-PEN TO DISPLAY-PEN X442-PENALTY DTSBE444 02829 R442-ACTIVE-PEN-AMT. DTSBE444 02830 MOVE WRK-ACTIVE-SELF-INS-INT TO DISPLAY-INT X442-INTEREST DTSBE444 02831 R442-ACTIVE-INT-AMT. DTSBE444 02832 DISPLAY 'ACTIVE' DTSBE444 02833 ' TAX ' DISPLAY-TAX DTSBE444 02834 ' PEN ' DISPLAY-PEN DTSBE444 02835 ' INT ' DISPLAY-INT. DTSBE444 02836 DTSBE444 02837 * WRITE AGING-REC FROM X442-REC. DTSBE444 02838 * ADD +1 TO WRK-AGING-CNT. DTSBE444 02839 DTSBE444 02840 MOVE 'INACTIVE ' TO X442-DESCRIPTION. DTSBE444 02841 MOVE WRK-INACT-SELF-INS-TAX TO DISPLAY-TAX X442-TAX DTSBE444 02842 R442-INACTIVE-TAX-AMT. DTSBE444 02843 MOVE WRK-INACT-SELF-INS-PEN TO DISPLAY-PEN X442-PENALTY DTSBE444 02844 R442-INACTIVE-PEN-AMT. DTSBE444 02845 MOVE WRK-INACT-SELF-INS-INT TO DISPLAY-INT X442-INTEREST DTSBE444 02846 R442-INACTIVE-INT-AMT. DTSBE444 02847 DISPLAY 'INACTIVE' DTSBE444 02848 ' TAX ' DISPLAY-TAX DTSBE444 02849 ' PEN ' DISPLAY-PEN DTSBE444 02850 ' INT ' DISPLAY-INT. DTSBE444 02851 DTSBE444 02852 * WRITE AGING-REC FROM X442-REC. DTSBE444 02853 * ADD +1 TO WRK-AGING-CNT. DTSBE444 02854 DTSBE444 02855 MOVE 'INACTIVE 3 YEARS' TO X442-DESCRIPTION. DTSBE444 02856 MOVE WRK-INACT-3YR-SELF-INS-TAX TO DISPLAY-TAX X442-TAX DTSBE444 02857 R442-INACT-3-YR-TAX-AMT. DTSBE444 02858 MOVE WRK-INACT-3YR-SELF-INS-PEN TO DISPLAY-PEN X442-PENALTY DTSBE444 02859 R442-INACT-3-YR-PEN-AMT. DTSBE444 02860 MOVE WRK-INACT-3YR-SELF-INS-INT TO DISPLAY-INT X442-INTEREST DTSBE444 02861 R442-INACT-3-YR-INT-AMT. DTSBE444 02862 DISPLAY 'INACTIVE 3 YEARS' DTSBE444 02863 ' TAX ' DISPLAY-TAX DTSBE444 02864 ' PEN ' DISPLAY-PEN DTSBE444 02865 ' INT ' DISPLAY-INT. DTSBE444 02866 DTSBE444 02867 * WRITE AGING-REC FROM X442-REC. DTSBE444 02868 * ADD +1 TO WRK-AGING-CNT. DTSBE444 02869 DTSBE444 02870 MOVE 'TOT IN CHAPTER 7 ' TO X442-DESCRIPTION. DTSBE444 02871 DISPLAY SPACE. DTSBE444 02872 MOVE WRK-CHAPTER-7-SELF-INS-TAX TO DISPLAY-TAX X442-TAX DTSBE444 02873 R442-TOT-CHPT-7-TAX-AMT. DTSBE444 02874 MOVE WRK-CHAPTER-7-SELF-INS-PEN TO DISPLAY-PEN X442-PENALTY DTSBE444 02875 R442-TOT-CHPT-7-PEN-AMT. DTSBE444 02876 MOVE WRK-CHAPTER-7-SELF-INS-INT TO DISPLAY-INT X442-INTEREST DTSBE444 02877 R442-TOT-CHPT-7-INT-AMT. DTSBE444 02878 DISPLAY 'TOTAL IN CHAPTER 7 ' DTSBE444 02879 ' TAX ' DISPLAY-TAX DTSBE444 02880 ' PEN ' DISPLAY-PEN DTSBE444 02881 ' INT ' DISPLAY-INT. DTSBE444 02882 DTSBE444 02883 * WRITE AGING-REC FROM X442-REC. DTSBE444 02884 * ADD +1 TO WRK-AGING-CNT. DTSBE444 02885 DTSBE444 02886 MOVE 'TOT IN CHAPTER 11' TO X442-DESCRIPTION. DTSBE444 02887 DISPLAY SPACE. DTSBE444 02888 MOVE WRK-CHAPTER-11-SELF-INS-TAX TO DISPLAY-TAX X442-TAX DTSBE444 02889 R442-TOT-CHPT-11-TAX-AMT.DTSBE444 02890 MOVE WRK-CHAPTER-11-SELF-INS-PEN TO DISPLAY-PEN X442-PENALTY DTSBE444 02891 R442-TOT-CHPT-11-PEN-AMT.DTSBE444 02892 MOVE WRK-CHAPTER-11-SELF-INS-INT TO DISPLAY-INT X442-INTERESTDTSBE444 02893 R442-TOT-CHPT-11-INT-AMT.DTSBE444 02894 DISPLAY 'TOTAL IN CHAPTER 11 ' DTSBE444 02895 ' TAX ' DISPLAY-TAX DTSBE444 02896 ' PEN ' DISPLAY-PEN DTSBE444 02897 ' INT ' DISPLAY-INT. DTSBE444 02898 DTSBE444 02899 * WRITE AGING-REC FROM X442-REC. DTSBE444 02900 * ADD +1 TO WRK-AGING-CNT. DTSBE444 02901 DTSBE444 02902 SET R442-SORT-CLASS-S-88 TO TRUE. DTSBE444 02903 PERFORM S946-WRITE-R442 THRU S946-EXIT. DTSBE444 02904 DTSBE444 02905 PERFORM T1100-TEXT-REPORT THRU T1100-EXIT. DTSBE444 02906 DTSBE444 02907 T1000-EXIT. DTSBE444 02908 EXIT. DTSBE444 02909 DTSBE444 02910 DTSBE444 02911 T1100-TEXT-REPORT. DTSBE444 02912 MOVE 'RATED' TO WRK-RPT-EMP-CLASS. DTSBE444 02913 WRITE AGING-REC FROM WRK-RPT-HEADER1. DTSBE444 02914 WRITE AGING-REC FROM WRK-RPT-HEADER2. DTSBE444 02915 WRITE AGING-REC FROM WRK-RPT-HEADER3. DTSBE444 02916 WRITE AGING-REC FROM WRK-RPT-HEADER4. DTSBE444 02917 MOVE SPACES TO AGING-REC. DTSBE444 02918 WRITE AGING-REC. DTSBE444 02919 DTSBE444 02920 PERFORM DTSBE444 02921 VARYING SUB FROM +1 BY +1 DTSBE444 02922 UNTIL SUB > +6 DTSBE444 02923 MOVE WRK-QTR-YRQ (SUB) TO L004-QTR-5-9 DTSBE444 02924 PERFORM S004-FROM-5 THRU S004-EXIT DTSBE444 02925 IF L004-INVALID-QTR DTSBE444 02926 MOVE 'INVALID YEAR/QTR ' TO ABEND-MSG DTSBE444 02927 PERFORM S999-ABEND THRU S999-EXIT DTSBE444 02928 ELSE DTSBE444 02929 MOVE L004-SLASH-5-QTR TO WRK-RPT-DESCRIPTION DTSBE444 02930 END-IF DTSBE444 02931 MOVE WRK-QTR-RATED-TAX (SUB) TO WRK-RPT-TAX DTSBE444 02932 MOVE WRK-QTR-RATED-PEN (SUB) TO WRK-RPT-PEN DTSBE444 02933 MOVE WRK-QTR-RATED-INT (SUB) TO WRK-RPT-INT DTSBE444 02934 WRITE AGING-REC FROM WRK-RPT-DATA-LINE DTSBE444 02935 END-PERFORM. DTSBE444 02936 DTSBE444 02937 MOVE WRK-QTR-YRQ (7) TO L004-QTR-5-9 DTSBE444 02938 PERFORM S004-FROM-5 THRU S004-EXIT DTSBE444 02939 IF L004-INVALID-QTR DTSBE444 02940 MOVE 'INVALID YEAR/QTR ' TO ABEND-MSG DTSBE444 02941 PERFORM S999-ABEND THRU S999-EXIT DTSBE444 02942 ELSE DTSBE444 02943 STRING DTSBE444 02944 L004-SLASH-5-QTR ' AND PRIOR' DTSBE444 02945 DELIMITED BY SIZE DTSBE444 02946 INTO WRK-RPT-DESCRIPTION DTSBE444 02947 END-STRING DTSBE444 02948 END-IF DTSBE444 02949 MOVE WRK-QTR-RATED-TAX (7) TO WRK-RPT-TAX DTSBE444 02950 MOVE WRK-QTR-RATED-PEN (7) TO WRK-RPT-PEN DTSBE444 02951 MOVE WRK-QTR-RATED-INT (7) TO WRK-RPT-INT DTSBE444 02952 WRITE AGING-REC FROM WRK-RPT-DATA-LINE DTSBE444 02953 DTSBE444 02954 MOVE SPACES TO AGING-REC. DTSBE444 02955 WRITE AGING-REC. DTSBE444 02956 DTSBE444 02957 MOVE 'GRAND TOTAL' TO WRK-RPT-DESCRIPTION. DTSBE444 02958 MOVE WRK-TOT-RATED-TAX TO WRK-RPT-TAX. DTSBE444 02959 MOVE WRK-TOT-RATED-PEN TO WRK-RPT-PEN. DTSBE444 02960 MOVE WRK-TOT-RATED-INT TO WRK-RPT-INT. DTSBE444 02961 WRITE AGING-REC FROM WRK-RPT-DATA-LINE DTSBE444 02962 DTSBE444 02963 MOVE SPACES TO AGING-REC. DTSBE444 02964 WRITE AGING-REC. DTSBE444 02965 DTSBE444 02966 MOVE '3 YEARS OR MORE' TO WRK-RPT-DESCRIPTION. DTSBE444 02967 MOVE WRK-3-YR-RATED-TAX TO WRK-RPT-TAX. DTSBE444 02968 MOVE WRK-3-YR-RATED-PEN TO WRK-RPT-PEN. DTSBE444 02969 MOVE WRK-3-YR-RATED-INT TO WRK-RPT-INT. DTSBE444 02970 WRITE AGING-REC FROM WRK-RPT-DATA-LINE DTSBE444 02971 DTSBE444 02972 MOVE 'ACTIVE ' TO WRK-RPT-DESCRIPTION. DTSBE444 02973 MOVE WRK-ACTIVE-RATED-TAX TO WRK-RPT-TAX. DTSBE444 02974 MOVE WRK-ACTIVE-RATED-PEN TO WRK-RPT-PEN. DTSBE444 02975 MOVE WRK-ACTIVE-RATED-INT TO WRK-RPT-INT. DTSBE444 02976 WRITE AGING-REC FROM WRK-RPT-DATA-LINE DTSBE444 02977 DTSBE444 02978 MOVE 'INACTIVE ' TO WRK-RPT-DESCRIPTION. DTSBE444 02979 MOVE WRK-INACT-RATED-TAX TO WRK-RPT-TAX. DTSBE444 02980 MOVE WRK-INACT-RATED-PEN TO WRK-RPT-PEN. DTSBE444 02981 MOVE WRK-INACT-RATED-INT TO WRK-RPT-INT. DTSBE444 02982 WRITE AGING-REC FROM WRK-RPT-DATA-LINE DTSBE444 02983 DTSBE444 02984 MOVE 'INACTIVE 3 YEAR' TO WRK-RPT-DESCRIPTION. DTSBE444 02985 MOVE WRK-INACT-3YR-RATED-TAX TO WRK-RPT-TAX. DTSBE444 02986 MOVE WRK-INACT-3YR-RATED-PEN TO WRK-RPT-PEN. DTSBE444 02987 MOVE WRK-INACT-3YR-RATED-INT TO WRK-RPT-INT. DTSBE444 02988 WRITE AGING-REC FROM WRK-RPT-DATA-LINE DTSBE444 02989 DTSBE444 02990 MOVE 'TOT IN CHAPTER 7 ' TO WRK-RPT-DESCRIPTION. DTSBE444 02991 MOVE WRK-CHAPTER-7-RATED-TAX TO WRK-RPT-TAX. DTSBE444 02992 MOVE WRK-CHAPTER-7-RATED-PEN TO WRK-RPT-PEN. DTSBE444 02993 MOVE WRK-CHAPTER-7-RATED-INT TO WRK-RPT-INT. DTSBE444 02994 WRITE AGING-REC FROM WRK-RPT-DATA-LINE DTSBE444 02995 DTSBE444 02996 MOVE 'TOT IN CHAPTER 11 ' TO WRK-RPT-DESCRIPTION. DTSBE444 02997 MOVE WRK-CHAPTER-11-RATED-TAX TO WRK-RPT-TAX. DTSBE444 02998 MOVE WRK-CHAPTER-11-RATED-PEN TO WRK-RPT-PEN. DTSBE444 02999 MOVE WRK-CHAPTER-11-RATED-INT TO WRK-RPT-INT. DTSBE444 03000 WRITE AGING-REC FROM WRK-RPT-DATA-LINE DTSBE444 03001 DTSBE444 03002 MOVE SPACES TO AGING-REC. DTSBE444 03003 WRITE AGING-REC. DTSBE444 03004 MOVE SPACES TO AGING-REC. DTSBE444 03005 WRITE AGING-REC. DTSBE444 03006 MOVE SPACES TO AGING-REC. DTSBE444 03007 WRITE AGING-REC. DTSBE444 03008 DTSBE444 03009 MOVE 'SELF-INSURED' TO WRK-RPT-EMP-CLASS. DTSBE444 03010 WRITE AGING-REC FROM WRK-RPT-HEADER1. DTSBE444 03011 WRITE AGING-REC FROM WRK-RPT-HEADER2. DTSBE444 03012 WRITE AGING-REC FROM WRK-RPT-HEADER3. DTSBE444 03013 MOVE SPACES TO AGING-REC. DTSBE444 03014 WRITE AGING-REC. DTSBE444 03015 DTSBE444 03016 PERFORM DTSBE444 03017 VARYING SUB FROM +1 BY +1 DTSBE444 03018 UNTIL SUB > +6 DTSBE444 03019 MOVE WRK-QTR-YRQ (SUB) TO L004-QTR-5-9 DTSBE444 03020 PERFORM S004-FROM-5 THRU S004-EXIT DTSBE444 03021 IF L004-INVALID-QTR DTSBE444 03022 MOVE 'INVALID YEAR/QTR ' TO ABEND-MSG DTSBE444 03023 PERFORM S999-ABEND THRU S999-EXIT DTSBE444 03024 ELSE DTSBE444 03025 MOVE L004-SLASH-5-QTR TO WRK-RPT-DESCRIPTION DTSBE444 03026 END-IF DTSBE444 03027 MOVE WRK-QTR-SELF-INS-TAX (SUB) TO WRK-RPT-TAX DTSBE444 03028 MOVE WRK-QTR-SELF-INS-PEN (SUB) TO WRK-RPT-PEN DTSBE444 03029 MOVE WRK-QTR-SELF-INS-INT (SUB) TO WRK-RPT-INT DTSBE444 03030 WRITE AGING-REC FROM WRK-RPT-DATA-LINE DTSBE444 03031 END-PERFORM. DTSBE444 03032 DTSBE444 03033 MOVE WRK-QTR-YRQ (7) TO L004-QTR-5-9 DTSBE444 03034 PERFORM S004-FROM-5 THRU S004-EXIT DTSBE444 03035 IF L004-INVALID-QTR DTSBE444 03036 MOVE 'INVALID YEAR/QTR ' TO ABEND-MSG DTSBE444 03037 PERFORM S999-ABEND THRU S999-EXIT DTSBE444 03038 ELSE DTSBE444 03039 STRING DTSBE444 03040 L004-SLASH-5-QTR ' AND PRIOR' DTSBE444 03041 DELIMITED BY SIZE DTSBE444 03042 INTO WRK-RPT-DESCRIPTION DTSBE444 03043 END-STRING DTSBE444 03044 END-IF DTSBE444 03045 MOVE WRK-QTR-SELF-INS-TAX (7) TO WRK-RPT-TAX DTSBE444 03046 MOVE WRK-QTR-SELF-INS-PEN (7) TO WRK-RPT-PEN DTSBE444 03047 MOVE WRK-QTR-SELF-INS-INT (7) TO WRK-RPT-INT DTSBE444 03048 WRITE AGING-REC FROM WRK-RPT-DATA-LINE DTSBE444 03049 DTSBE444 03050 MOVE SPACES TO AGING-REC. DTSBE444 03051 WRITE AGING-REC. DTSBE444 03052 DTSBE444 03053 MOVE 'GRAND TOTAL' TO WRK-RPT-DESCRIPTION. DTSBE444 03054 MOVE WRK-TOT-SELF-INS-TAX TO WRK-RPT-TAX. DTSBE444 03055 MOVE WRK-TOT-SELF-INS-PEN TO WRK-RPT-PEN. DTSBE444 03056 MOVE WRK-TOT-SELF-INS-INT TO WRK-RPT-INT. DTSBE444 03057 WRITE AGING-REC FROM WRK-RPT-DATA-LINE DTSBE444 03058 DTSBE444 03059 MOVE SPACES TO AGING-REC. DTSBE444 03060 WRITE AGING-REC. DTSBE444 03061 DTSBE444 03062 MOVE '3 YEARS OR MORE' TO WRK-RPT-DESCRIPTION. DTSBE444 03063 MOVE WRK-3-YR-SELF-INS-TAX TO WRK-RPT-TAX. DTSBE444 03064 MOVE WRK-3-YR-SELF-INS-PEN TO WRK-RPT-PEN. DTSBE444 03065 MOVE WRK-3-YR-SELF-INS-INT TO WRK-RPT-INT. DTSBE444 03066 WRITE AGING-REC FROM WRK-RPT-DATA-LINE DTSBE444 03067 DTSBE444 03068 MOVE 'ACTIVE ' TO WRK-RPT-DESCRIPTION. DTSBE444 03069 MOVE WRK-ACTIVE-SELF-INS-TAX TO WRK-RPT-TAX. DTSBE444 03070 MOVE WRK-ACTIVE-SELF-INS-PEN TO WRK-RPT-PEN. DTSBE444 03071 MOVE WRK-ACTIVE-SELF-INS-INT TO WRK-RPT-INT. DTSBE444 03072 WRITE AGING-REC FROM WRK-RPT-DATA-LINE DTSBE444 03073 DTSBE444 03074 MOVE 'INACTIVE ' TO WRK-RPT-DESCRIPTION. DTSBE444 03075 MOVE WRK-INACT-SELF-INS-TAX TO WRK-RPT-TAX. DTSBE444 03076 MOVE WRK-INACT-SELF-INS-PEN TO WRK-RPT-PEN. DTSBE444 03077 MOVE WRK-INACT-SELF-INS-INT TO WRK-RPT-INT. DTSBE444 03078 WRITE AGING-REC FROM WRK-RPT-DATA-LINE DTSBE444 03079 DTSBE444 03080 MOVE 'INACTIVE 3 YEAR' TO WRK-RPT-DESCRIPTION. DTSBE444 03081 MOVE WRK-INACT-3YR-SELF-INS-TAX TO WRK-RPT-TAX. DTSBE444 03082 MOVE WRK-INACT-3YR-SELF-INS-PEN TO WRK-RPT-PEN. DTSBE444 03083 MOVE WRK-INACT-3YR-SELF-INS-INT TO WRK-RPT-INT. DTSBE444 03084 WRITE AGING-REC FROM WRK-RPT-DATA-LINE DTSBE444 03085 DTSBE444 03086 MOVE 'TOT IN CHAPTER 7 ' TO WRK-RPT-DESCRIPTION. DTSBE444 03087 MOVE WRK-CHAPTER-7-SELF-INS-TAX TO WRK-RPT-TAX. DTSBE444 03088 MOVE WRK-CHAPTER-7-SELF-INS-PEN TO WRK-RPT-PEN. DTSBE444 03089 MOVE WRK-CHAPTER-7-SELF-INS-INT TO WRK-RPT-INT. DTSBE444 03090 WRITE AGING-REC FROM WRK-RPT-DATA-LINE DTSBE444 03091 DTSBE444 03092 MOVE 'TOT IN CHAPTER 11 ' TO WRK-RPT-DESCRIPTION. DTSBE444 03093 MOVE WRK-CHAPTER-11-SELF-INS-TAX TO WRK-RPT-TAX. DTSBE444 03094 MOVE WRK-CHAPTER-11-SELF-INS-PEN TO WRK-RPT-PEN. DTSBE444 03095 MOVE WRK-CHAPTER-11-SELF-INS-INT TO WRK-RPT-INT. DTSBE444 03096 WRITE AGING-REC FROM WRK-RPT-DATA-LINE. DTSBE444 03097 DTSBE444 03098 DTSBE444 03099 T1100-EXIT. DTSBE444 03100 EXIT. DTSBE444 03101 S101-PER-MONTH-NO. CL*49 03102 SET L101-PER-MONTH-NO-88 TO TRUE. CL*44 03103 GO TO S101-INT-PEN-COMP. CL*44 03104 CL*44 03105 S101-PER-MONTH-YES. CL*49 03106 SET L101-PER-MONTH-YES-88 TO TRUE. CL*44 03107 GO TO S101-INT-PEN-COMP. CL*44 03108 CL*44 03109 S101-INT-PEN-COMP. CL*49 03110 CALL 'DTSBU101' USING L101-LINK-AREA. CL*44 03111 S101-EXIT. CL*49 03112 EXIT. CL*44 03113 DTSBE444 03114 S001-FROM-FED-8. DTSBE444 03115 SET L001-FROM-FED-8 TO TRUE. DTSBE444 03116 GO TO S001-DATE. DTSBE444 03117 DTSBE444 03118 S001-FROM-ABS-DAY. DTSBE444 03119 SET L001-FROM-ABS-DAY TO TRUE. DTSBE444 03120 GO TO S001-DATE. DTSBE444 03121 DTSBE444 03122 S001-FROM-CAL-6. DTSBE444 03123 SET L001-FROM-CAL-6 TO TRUE. DTSBE444 03124 GO TO S001-DATE. DTSBE444 03125 DTSBE444 03126 S001-DATE. DTSBE444 03127 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBE444 03128 S001-EXIT. DTSBE444 03129 EXIT. DTSBE444 03130 SKIP3 DTSBE444 03131 S004-FROM-5. DTSBE444 03132 SET L004-FROM-5 TO TRUE. DTSBE444 03133 GO TO S004-QTR. DTSBE444 03134 DTSBE444 03135 S004-FROM-ABS. DTSBE444 03136 SET L004-FROM-ABS TO TRUE. DTSBE444 03137 GO TO S004-QTR. DTSBE444 03138 DTSBE444 03139 S004-FROM-3. DTSBE444 03140 SET L004-FROM-3 TO TRUE. DTSBE444 03141 GO TO S004-QTR. DTSBE444 03142 DTSBE444 03143 S004-FROM-DATE. DTSBE444 03144 SET L004-FROM-DATE TO TRUE. DTSBE444 03145 GO TO S004-QTR. DTSBE444 03146 DTSBE444 03147 S004-QTR. DTSBE444 03148 DTSBE444 03149 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBE444 03150 DTSBE444 03151 S004-EXIT. DTSBE444 03152 EXIT. DTSBE444 03153 SKIP3 DTSBE444 03154 S005-FROM-ABSTIME. DTSBE444 03155 SET L005-FROM-ABSTIME TO TRUE. DTSBE444 03156 GO TO S005-ABSTIME. DTSBE444 03157 DTSBE444 03158 S005-FROM-DATE-TIME. DTSBE444 03159 SET L005-FROM-DATE-TIME TO TRUE. DTSBE444 03160 GO TO S005-ABSTIME. DTSBE444 03161 DTSBE444 03162 S005-ABSTIME. DTSBE444 03163 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBE444 03164 S005-EXIT. DTSBE444 03165 EXIT. DTSBE444 03166 SKIP3 DTSBE444 03167 S910-READ. DTSBE444 03168 SET L910-READ-88 TO TRUE. DTSBE444 03169 GO TO S910-MSTR-IO. DTSBE444 03170 DTSBE444 03171 S910-START-BROWSE. DTSBE444 03172 SET L910-START-BROWSE-88 TO TRUE. DTSBE444 03173 GO TO S910-MSTR-IO. DTSBE444 03174 DTSBE444 03175 S910-READ-NEXT. DTSBE444 03176 SET L910-READ-NEXT-88 TO TRUE. DTSBE444 03177 GO TO S910-MSTR-IO. DTSBE444 03178 DTSBE444 03179 *S910-COUNT. DTSBE444 03180 *****SET L910-COUNT-88 TO TRUE. DTSBE444 03181 *****GO TO S910-MSTR-IO. DTSBE444 03182 DTSBE444 03183 DTSBE444 03184 S910-MSTR-IO. DTSBE444 03185 CALL 'DTSBU910' USING L910-LINK-AREA DTSBE444 03186 MSKL-REC. DTSBE444 03187 S910-EXIT. DTSBE444 03188 EXIT. DTSBE444 03189 SKIP3 DTSBE444 03190 S946-WRITE-R442. DTSBE444 03191 CALL 'DTSBU946' USING R442-REC. DTSBE444 03192 GO TO S946-EXIT. DTSBE444 03193 DTSBE444 03194 S946-EXIT. DTSBE444 03195 EXIT. DTSBE444 03196 SKIP3 DTSBE444 03197 S999-ABEND. DTSBE444 03198 DISPLAY '*** DTSBE442 ABENDING. ' DTSBE444 03199 ABEND-MSG. DTSBE444 03200 DTSBE444 03201 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBE444 03202 S999-EXIT. DTSBE444 03203 EXIT. DTSBE444