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