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