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