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