00001 IDENTIFICATION DIVISION. 05/20/13 00002 PROGRAM-ID. DTSBD373. DTSBD373 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV033 00004 DATE-WRITTEN. JANUARY 1991. DTSBD373 00005 DATE-COMPILED. DTSBD373 00006 SKIP3 DTSBD373 00007 ***** DTSBD373 00008 * DTSBD373 00009 * FUNCTION: ADJUSTMENT TRANSACTION PROCESSING. DTSBD373 00010 * DTSBD373 00011 * DTSBD373 00012 * MODIFICATION LOG: DTSBD373 00013 * DTSBD373 00014 * 01/25/92 INITIAL DEVELOPMENT. DTSBD373 00015 * WORK ORDER: PROGRAMMER: TCL DTSBD373 00016 * DTSBD373 00017 * 05/25/95 PROJECT PENALTY AND INTEREST BEFORE WRITE OFF. DTSBD373 00018 * WORK ORDER: CR083 PROGRAMMER: RHC DTSBD373 00019 * DTSBD373 00020 * 06/13/95 CHANGE TO CREDIT TOLERANCE LOGIC REMOVES IT FROM DTSBD373 00021 * THIS PROGRAM. DTSBD373 00022 * WORK ORDER: CR094 PROGRAMMER: RHC DTSBD373 00023 * DTSBD373 00024 * 01/05/1999 REVIEWED AND MODIFIED FOR DC. DTSBD373 00025 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSBD373 00026 * DTSBD373 00027 * 02/27/1999 MODIFIED FOR DC SELF INSURED EMPLOYER TAX DUE DTSBD373 00028 * DATE REQUIREMENT. DTSBD373 00029 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSBD373 00030 * DTSBD373 00031 * 03/27/1999 MODIFIED TO WRITE A MEVL RECORD OCCURRENCE DTSBD373 00032 * WHEN SETTING MQTR-WAGE-RPT-NO-88 TO TRUE. DTSBD373 00033 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSBD373 00034 * DTSBD373 00035 * 05/15/1999 PICKUP RELATED EDITS AND PICKUP MQTR DTSBD373 00036 * INITIALIZATION LOGIC ADDED. DTSBD373 00037 * REFERENCE: PICKUP DIR PROGRAMMER: EHH DTSBD373 00038 * DTSBD373 00039 * 08/14/2002 MODIFIED TO REJECT TRANSACTION IF QUARTER DTSBD373 00040 * ADDED BUT RATE IS ESTIMATED. DTSBD373 00041 * REFERENCE: HOUSEHOLD PROGRAMMER: GD DTSBD373 00042 * DTSBD373 00043 * 11/24/2003 UPDATED CALL TO DTSBU520 - INITIALIZE NEW DTSBD373 00044 * LINKAGE DATA ELEMENTS DTSBD373 00045 * REFERENCE: HOUSEHOLD PROGRAMMER: GD DTSBD373 00046 * DTSBD373 00047 * 05/10/2004 MODIFIED P1200-WAIVE-EDIT TO ALLOW WAIVER OF DTSBD373 00048 * UI TAX IF AADJ-CMP-ESTB-ABSTIME > ZERO. DTSBD373 00049 * MODIFIED S9100 TO UPDATE AADJ-CMP-ESTB-ABSTIME. DTSBD373 00050 * REFERENCE: COMPROMISE PROGRAMMER: GD DTSBD373 00051 * DTSBD373 00052 * 10/07/2005 REMOVED CODE IN P4300 THAT WROTE MEVL RECORDS DTSBD373 00053 * BASED ON MQTR-WAGE-RPT-IND. THE MEANING OF THIS DTSBD373 00054 * INDICATOR HAS CHANGED, AND IT NOW SPECIFIES DTSBD373 00055 * WHETHER THE WAGES WERE SUBMITTED ON MAG MEDIA. DTSBD373 00056 * REFERENCE: PROGRAMMER: GD DTSBD373 00057 * DTSBD373 00058 * 02/21/2006 MODIFIED INTEREST CALCULATION - ONLY UI TAX DTSBD373 00059 * BALANCE IS USED. P1122, P1123, P4110, S4110. DTSBD373 00060 * REFERENCE: ADMIN ASSESSMENT PROGRAMMER: GD DTSBD373 00061 * DTSBD373 00062 * 02/21/2006 ADJUSTMENT OF ADMIN ASSESSMENT ALLOWED ONLY DTSBD373 00063 * FOR SELF-INSURED. P1110, P1120. DTSBD373 00064 * REFERENCE: ADMIN ASSESSMENT PROGRAMMER: GD DTSBD373 00065 * DTSBD373 00066 * 01/31/2008 MODIFIED ADMINISTRATIVE ASSESSMENT PROCESS DTSBD373 00067 * TO INCLUDE PENALTY AND INTEREST CALCULATION DTSBD373 00068 * STARTING WITH 2008/1. DTSBD373 00069 * REFERENCE: ADMIN ASSESS PROGRAMMER: RW1 DTSBD373 00070 * DTSBD373 00071 * 08/14/2012 ADDED P4400-FILING-SCHEDULE FOR ADJUSTMENTS DTSBD373 00072 * OF FILING SCHEDULE AND DUE DATES. DTSBD373 00073 * REFERENCE: PROGRAMMER: GD DTSBD373 00074 * DTSBD373 00075 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD373 00076 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD373 00077 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBD373 00078 * DTSBD373 00079 * DTSBD373 00080 * DESCRIPTION: DTSBD373 00081 * DTSBD373 00082 * PROCESS ACCOUNTING ADJUSTMENT TRANSACTIONS. DTSBD373 00083 * DTSBD373 00084 * DTSBD373 00085 * MASTER FILE RECORDS READ: DTSBD373 00086 * DTSBD373 00087 * MQTR DTSBD373 00088 * DTSBD373 00089 * DTSBD373 00090 * MASTER FILE RECORDS UPDATED: DTSBD373 00091 * DTSBD373 00092 * MQTR (WRITE, REWRITE) DTSBD373 00093 * DTSBD373 00094 * DTSBD373 00095 * REPORT RECORDS WRITTEN: DTSBD373 00096 * DTSBD373 00097 * R907 ERROR. DTSBD373 00098 * DTSBD373 00099 * DTSBD373 00100 * MODULES CALLED: DTSBD373 00101 * DTSBD373 00102 * DTSBU101 PROJECT PENALTY AND INTEREST. DTSBD373 00103 * DTSBU511 INITIALIZE A MQTR RECORD. DTSBD373 00104 * DTSBU516 DETERMINE LIABILITY, DUE DATE, AND RATE FOR DTSBD373 00105 * A GIVEN QUARTER. DTSBD373 00106 * DTSBU520 PAYMENT APPLICATION. DTSBD373 00107 * DTSBU522 RETURN A PAID AMOUNT TO UNAPPLIED CREDIT. DTSBD373 00108 * DTSBU541 MODIFY A SPECIFIED CHARGED, WAIVED, TOLERATED DTSBD373 00109 * OR WRITTEN OFF AMOUNT. DTSBD373 00110 * DTSBU590 EMPLOYER CLEANUP. DTSBD373 00111 * DTSBU910 MASTER FILE I/O. DTSBD373 00112 * DTSBU946 VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 1. DTSBD373 00113 * DTSBD373 00114 * DTSBD373 00115 ***** DTSBD373 00116 SKIP3 DTSBD373 00117 ENVIRONMENT DIVISION. DTSBD373 00118 EJECT DTSBD373 00119 DATA DIVISION. DTSBD373 00120 SKIP3 DTSBD373 00121 WORKING-STORAGE SECTION. DTSBD373 001215 77 PAN-VALET PICTURE X(24) VALUE '033DTSBD373 05/20/13'. DTSBD373 00122 77 PAN-VALET PICTURE X(24) VALUE '004DTSBD373 01/11/13'. DTSBD373 00123 SKIP3 DTSBD373 00124 01 WRK-AREA. DTSBD373 00125 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +373.DTSBD373 00126 DTSBD373 00127 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBD373'.DTSBD373 00128 DTSBD373 00129 05 ALL-NINES-DATE PIC S9(09) COMP-3 DTSBD373 00130 VALUE +999999999.DTSBD373 00131 DTSBD373 00132 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBD373 00133 DTSBD373 00134 DTSBD373 00135 05 WRK-NULL-DOC-NO. DTSBD373 00136 10 WRK-NULL-BATCH-NO PIC S9(05) COMP-3. DTSBD373 00137 10 WRK-NULL-ITEM-NO PIC S9(03) COMP-3. DTSBD373 00138 DTSBD373 00139 DTSBD373 00140 05 WRK-CREDIT-AMT PIC S9(09)V9(02) COMP-3. DTSBD373 00141 DTSBD373 00142 05 WRK-CHARGED-AMT PIC S9(09)V9(02) COMP-3. DTSBD373 00143 DTSBD373 00144 05 WRK-WAIVED-AMT PIC S9(09)V9(02) COMP-3. DTSBD373 00145 DTSBD373 00146 05 WRK-TOLER-AMT PIC S9(09)V9(02) COMP-3. DTSBD373 00147 DTSBD373 00148 05 WRK-BALANCE-AMT PIC S9(09)V9(02) COMP-3. DTSBD373 00149 DTSBD373 00150 05 WRK-DELINQUENT-YRQ PIC S9(05) COMP-3. DTSBD373 00151 DTSBD373 00152 05 WRK-RPT-DUE-DATE PIC S9(09) COMP-3. DTSBD373 00153 DTSBD373 00154 05 WRK-CURR-ANN-YRQ PIC 9(05) VALUE ZERO. DTSBD373 00155 05 FILLER REDEFINES WRK-CURR-ANN-YRQ. DTSBD373 00156 10 WRK-CURR-ANN-YR PIC 9(04). DTSBD373 00157 10 FILLER PIC X(01). DTSBD373 00158 DTSBD373 00159 05 WRK-ANNUAL-SCHED-IND PIC X(01). DTSBD373 00160 88 WRK-ANNUAL-SCHED-YES-88 VALUE 'Y'. DTSBD373 00161 88 WRK-ANNUAL-SCHED-NO-88 VALUE 'N'. DTSBD373 00162 DTSBD373 00163 05 WRK-MQTR-EXISTS-IND PIC X(01). DTSBD373 00164 DTSBD373 00165 05 WRK-MDST-EXISTS-IND PIC X(01). DTSBD373 00166 DTSBD373 00167 05 WRK-PURSUED-RPT-IND PIC X(01). DTSBD373 00168 DTSBD373 00169 05 WRK-TRIGGER-DATE PIC S9(09) COMP-3. DTSBD373 00170 DTSBD373 00171 05 WRK-ACCT-IND PIC X(02). DTSBD373 00172 DTSBD373 00173 05 WRK-ACCT-SUB PIC S9(04) COMP. DTSBD373 00174 DTSBD373 00175 05 NEW-TAX-DUE-DATE PIC S9(09) COMP-3. DTSBD373 00176 DTSBD373 00177 05 NEW-RPT-DUE-DATE PIC S9(09) COMP-3. DTSBD373 00178 DTSBD373 00179 05 ACCT-CRUNCH-COMPLETE-IND PIC X(01). DTSBD373 00180 DTSBD373 00181 05 ACCT-SUB PIC S9(04) COMP. DTSBD373 00182 DTSBD373 00183 05 ACCT-SUB1 PIC S9(04) COMP. DTSBD373 00184 DTSBD373 00185 05 ACCT-SUB2 PIC S9(04) COMP. DTSBD373 00186 DTSBD373 00187 *****05 WRK-LATE-PEN-CHARGED-AMT PIC S9(09)V9(02) COMP-3. DTSBD373 00188 DTSBD373 00189 05 WRK-INT-CHARGED-AMT PIC S9(09)V9(02) COMP-3. DTSBD373 00190 DTSBD373 00191 05 EVL-TEXT PIC X(50). DTSBD373 00192 DTSBD373 00193 05 WRK-FIRST-PEN-INT-YRQ PIC S9(05) COMP-3. DTSBD373 00194 DTSBD373 00195 05 WRK-FIRST-ANN-QTR PIC 9(05) DTSBD373 00196 VALUE 20021. DTSBD373 00197 DTSBD373 00198 01 MSG-TABLE. DTSBD373 00199 05 MSG1-INVALID-TRN-CD. DTSBD373 00200 10 MSG1-ID PIC X(11) VALUE 'DTSBD373331'. DTSBD373 00201 10 MSG1-SHORT-TEXT PIC X(20) VALUE 'INVALID ADJ TY'. DTSBD373 00202 10 MSG1-LONG-TEXT. DTSBD373 00203 15 FILLER PIC X(30) DTSBD373 00204 VALUE 'TRANSACTION FAILED - ADJUSTMEN'. DTSBD373 00205 15 FILLER PIC X(30) DTSBD373 00206 VALUE 'T TYPE NOT VALID '. DTSBD373 00207 DTSBD373 00208 05 MSG2-DUPLICATE-TRAN. DTSBD373 00209 10 MSG2-ID PIC X(11) VALUE 'DTSBD373307'. DTSBD373 00210 10 MSG2-SHORT-TEXT PIC X(20) VALUE 'DUPLICATE TRAN'. DTSBD373 00211 10 MSG2-LONG-TEXT. DTSBD373 00212 15 FILLER PIC X(30) DTSBD373 00213 VALUE 'TRANSACTION FAILED - DUPLICATE'. DTSBD373 00214 15 FILLER PIC X(30) DTSBD373 00215 VALUE 'TRANSACTION '. DTSBD373 00216 DTSBD373 00217 05 MSG3-CHARGED-AMT. DTSBD373 00218 10 MSG3-ID PIC X(11) VALUE 'DTSBD373333'. DTSBD373 00219 10 MSG3-SHORT-TEXT PIC X(20) VALUE 'CHRG AMT INVLD'. DTSBD373 00220 10 MSG3-LONG-TEXT. DTSBD373 00221 15 FILLER PIC X(30) DTSBD373 00222 VALUE 'TRANSACTION FAILED - YIELDS IN'. DTSBD373 00223 15 FILLER PIC X(30) DTSBD373 00224 VALUE 'VALID CHARGED AMOUNT '. DTSBD373 00225 DTSBD373 00226 05 MSG4-INCONSISTENT-CHARGE. DTSBD373 00227 10 MSG4-ID PIC X(11) VALUE 'DTSBD373334'. DTSBD373 00228 10 MSG4-SHORT-TEXT PIC X(20) VALUE 'INVALID CHARGE'. DTSBD373 00229 10 MSG4-LONG-TEXT. DTSBD373 00230 15 FILLER PIC X(30) DTSBD373 00231 VALUE 'TRANSACTION FAILED - CHARGE IS'. DTSBD373 00232 15 FILLER PIC X(30) DTSBD373 00233 VALUE 'NOT VALID '. DTSBD373 00234 DTSBD373 00235 05 MSG5-TOLER-AMT. DTSBD373 00236 10 MSG5-ID PIC X(11) VALUE 'DTSBD373335'. DTSBD373 00237 10 MSG5-SHORT-TEXT PIC X(20) VALUE 'TOLR AMT INVLD'. DTSBD373 00238 10 MSG5-LONG-TEXT. DTSBD373 00239 15 FILLER PIC X(30) DTSBD373 00240 VALUE 'TRANSACTION FAILED - YIELDS IN'. DTSBD373 00241 15 FILLER PIC X(30) DTSBD373 00242 VALUE 'VALID TOLERANCE AMOUNT '. DTSBD373 00243 DTSBD373 00244 05 MSG6-INVALID-YRQ. DTSBD373 00245 10 MSG6-ID PIC X(11) VALUE 'DTSBD373336'. DTSBD373 00246 10 MSG6-SHORT-TEXT PIC X(20) VALUE 'INVALID YRQ '. DTSBD373 00247 10 MSG6-LONG-TEXT. DTSBD373 00248 15 FILLER PIC X(30) DTSBD373 00249 VALUE 'TRANSACTION FAILED - YRQ IS NO'. DTSBD373 00250 15 FILLER PIC X(30) DTSBD373 00251 VALUE 'T VALID '. DTSBD373 00252 DTSBD373 00253 05 MSG7-INVALID-PAYMENT. DTSBD373 00254 10 MSG7-ID PIC X(11) VALUE 'DTSBD373337'. DTSBD373 00255 10 MSG7-SHORT-TEXT PIC X(20) VALUE 'INVALID DOC NO'. DTSBD373 00256 10 MSG7-LONG-TEXT. DTSBD373 00257 15 FILLER PIC X(30) DTSBD373 00258 VALUE 'TRANSACTION FAILED - PAYMENT D'. DTSBD373 00259 15 FILLER PIC X(30) DTSBD373 00260 VALUE 'OC NO NOT VALID '. DTSBD373 00261 DTSBD373 00262 05 MSG8-INVALID-APPLIC-IND. DTSBD373 00263 10 MSG8-ID PIC X(11) VALUE 'DTSBD373338'. DTSBD373 00264 10 MSG8-SHORT-TEXT PIC X(20) VALUE 'INVALID APPLIC'. DTSBD373 00265 10 MSG8-LONG-TEXT. DTSBD373 00266 15 FILLER PIC X(30) DTSBD373 00267 VALUE 'TRANSACTION FAILED - INVALID A'. DTSBD373 00268 15 FILLER PIC X(30) DTSBD373 00269 VALUE 'PPLIC INDICATOR '. DTSBD373 00270 DTSBD373 00271 05 MSG9-DOES-NOT-EXIST. DTSBD373 00272 10 MSG9-ID PIC X(11) VALUE 'DTSBD373339'. DTSBD373 00273 10 MSG9-SHORT-TEXT PIC X(20) VALUE 'DOES NOT EXIST'. DTSBD373 00274 10 MSG9-LONG-TEXT. DTSBD373 00275 15 FILLER PIC X(30) DTSBD373 00276 VALUE 'TRANSACTION FAILED - NOTHING F'. DTSBD373 00277 15 FILLER PIC X(30) DTSBD373 00278 VALUE 'OUND TO MODIFY '. DTSBD373 00279 DTSBD373 00280 05 MSG10-INVALID-INT-SPAN-IND. DTSBD373 00281 10 MSG10-ID PIC X(11) VALUE 'DTSBD373341'. DTSBD373 00282 10 MSG10-SHORT-TEXT PIC X(20) VALUE 'INVAID INT SPA'. DTSBD373 00283 10 MSG10-LONG-TEXT. DTSBD373 00284 15 FILLER PIC X(30) DTSBD373 00285 VALUE 'TRANSACTION FAILED - INVALID I'. DTSBD373 00286 15 FILLER PIC X(30) DTSBD373 00287 VALUE 'NTEREST SPAN '. DTSBD373 00288 DTSBD373 00289 05 MSG11-WAIVED-AMT. DTSBD373 00290 10 MSG11-ID PIC X(11) VALUE 'DTSBD373342'. DTSBD373 00291 10 MSG11-SHORT-TEXT PIC X(20) VALUE 'WAIV AMT INVLD'. DTSBD373 00292 10 MSG11-LONG-TEXT. DTSBD373 00293 15 FILLER PIC X(30) DTSBD373 00294 VALUE 'TRANSACTION FAILED - YIELDS IN'. DTSBD373 00295 15 FILLER PIC X(30) DTSBD373 00296 VALUE 'VALID WAIVED AMOUNT '. DTSBD373 00297 DTSBD373 00298 05 MSG12-ALREADY-WRITTEN-OFF. DTSBD373 00299 10 MSG12-ID PIC X(11) VALUE 'DTSBD373343'. DTSBD373 00300 10 MSG12-SHORT-TEXT PIC X(20) VALUE 'ALREADY WR OFF'. DTSBD373 00301 10 MSG12-LONG-TEXT. DTSBD373 00302 15 FILLER PIC X(30) DTSBD373 00303 VALUE 'TRANSACTION FAILED - EMPLOYER '. DTSBD373 00304 15 FILLER PIC X(30) DTSBD373 00305 VALUE 'IS ALREADY WRITTEN OFF '. DTSBD373 00306 DTSBD373 00307 05 MSG13-NO-COLLECTIONS. DTSBD373 00308 10 MSG13-ID PIC X(11) VALUE 'DTSBD373344'. DTSBD373 00309 10 MSG13-SHORT-TEXT PIC X(20) VALUE 'NO DEBIT '. DTSBD373 00310 10 MSG13-LONG-TEXT. DTSBD373 00311 15 FILLER PIC X(30) DTSBD373 00312 VALUE 'TRANSACTION FAILED - NO DEBIT;'. DTSBD373 00313 15 FILLER PIC X(30) DTSBD373 00314 VALUE ' PURSUED RPT; OR CREDIT '. DTSBD373 00315 DTSBD373 00316 05 MSG14-NOT-WRITTEN-OFF. DTSBD373 00317 10 MSG14-ID PIC X(11) VALUE 'DTSBD373345'. DTSBD373 00318 10 MSG14-SHORT-TEXT PIC X(20) VALUE 'NOT WR OFF'. DTSBD373 00319 10 MSG14-LONG-TEXT. DTSBD373 00320 15 FILLER PIC X(30) DTSBD373 00321 VALUE 'TRANSACTION FAILED - EMPLOYER '. DTSBD373 00322 15 FILLER PIC X(30) DTSBD373 00323 VALUE 'NOT WRITTEN OFF '. DTSBD373 00324 DTSBD373 00325 05 MSG15-NOT-SELF-INSURED. DTSBD373 00326 10 MSG15-ID PIC X(11) VALUE 'DTSBD373346'. DTSBD373 00327 10 MSG15-SHORT-TEXT PIC X(20) VALUE 'NOT SELF INS'. DTSBD373 00328 10 MSG15-LONG-TEXT. DTSBD373 00329 15 FILLER PIC X(30) DTSBD373 00330 VALUE 'TRANSACTION FAILED - NOT A SEL'. DTSBD373 00331 15 FILLER PIC X(30) DTSBD373 00332 VALUE 'F INSURED EMPLOYER '. DTSBD373 00333 DTSBD373 00334 05 MSG16-ALREADY-MANUAL. DTSBD373 00335 10 MSG16-ID PIC X(11) VALUE 'DTSBD373347'. DTSBD373 00336 10 MSG16-SHORT-TEXT PIC X(20) VALUE 'ALREADY MANUAL'. DTSBD373 00337 10 MSG16-LONG-TEXT. DTSBD373 00338 15 FILLER PIC X(30) DTSBD373 00339 VALUE 'TRANSACTION FAILED - ALREADY M'. DTSBD373 00340 15 FILLER PIC X(30) DTSBD373 00341 VALUE 'ANUAL '. DTSBD373 00342 DTSBD373 00343 05 MSG17-NOT-MANUAL. DTSBD373 00344 10 MSG17-ID PIC X(11) VALUE 'DTSBD373348'. DTSBD373 00345 10 MSG17-SHORT-TEXT PIC X(20) VALUE 'NOT MANUAL '. DTSBD373 00346 10 MSG17-LONG-TEXT. DTSBD373 00347 15 FILLER PIC X(30) DTSBD373 00348 VALUE 'TRANSACTION FAILED - NOT MANUA'. DTSBD373 00349 15 FILLER PIC X(30) DTSBD373 00350 VALUE 'L '. DTSBD373 00351 DTSBD373 00352 05 MSG18-NOT-TAXABLE. DTSBD373 00353 10 MSG18-ID PIC X(11) VALUE 'DTSBD373349'. DTSBD373 00354 10 MSG18-SHORT-TEXT PIC X(20) VALUE 'NOT TAXABLE '. DTSBD373 00355 10 MSG18-LONG-TEXT. DTSBD373 00356 15 FILLER PIC X(30) DTSBD373 00357 VALUE 'TRANSACTION FAILED - NOT A TAX'. DTSBD373 00358 15 FILLER PIC X(30) DTSBD373 00359 VALUE 'ABLE EMPLOYER '. DTSBD373 00360 DTSBD373 00361 05 MSG19-ACTIVE. DTSBD373 00362 10 MSG19-ID PIC X(11) VALUE 'DTSBD373350'. DTSBD373 00363 10 MSG19-SHORT-TEXT PIC X(20) VALUE 'ACTIVE '. DTSBD373 00364 10 MSG19-LONG-TEXT. DTSBD373 00365 15 FILLER PIC X(30) DTSBD373 00366 VALUE 'TRANSACTION FAILED - EMPLOYER '. DTSBD373 00367 15 FILLER PIC X(30) DTSBD373 00368 VALUE 'IS ACTIVE '. DTSBD373 00369 DTSBD373 00370 05 MSG20-EXTEND-TAX-DUE-DATE. DTSBD373 00371 10 MSG20-ID PIC X(11) VALUE 'DTSBD373351'. DTSBD373 00372 10 MSG20-SHORT-TEXT PIC X(20) VALUE 'EXTEND TAX DUE'. DTSBD373 00373 10 MSG20-LONG-TEXT. DTSBD373 00374 15 FILLER PIC X(30) DTSBD373 00375 VALUE 'TRANSACTION FAILED - TAX DUE M'. DTSBD373 00376 15 FILLER PIC X(30) DTSBD373 00377 VALUE 'AY NOT BE EXTENDED '. DTSBD373 00378 DTSBD373 00379 05 MSG21-INVALID-APPLIC-YRQ. DTSBD373 00380 10 MSG21-ID PIC X(11) VALUE 'DTSBD373352'. DTSBD373 00381 10 MSG21-SHORT-TEXT PIC X(20) DTSBD373 00382 VALUE 'APPLIC YRQ < PICKUP'. DTSBD373 00383 10 MSG21-LONG-TEXT. DTSBD373 00384 15 FILLER PIC X(30) DTSBD373 00385 VALUE 'TRANSACTION FAILED - APPLICABL'. DTSBD373 00386 15 FILLER PIC X(30) DTSBD373 00387 VALUE 'E YRQ < PICKUP YRQ (1992/4) '. DTSBD373 00388 DTSBD373 00389 05 MSG22-ESTIMATED-RATE. DTSBD373 00390 10 MSG22-ID PIC X(11) VALUE 'DTSBD373353'. DTSBD373 00391 10 MSG22-SHORT-TEXT PIC X(20) DTSBD373 00392 VALUE 'ESTIMATED RATE '. DTSBD373 00393 10 MSG22-LONG-TEXT. DTSBD373 00394 15 FILLER PIC X(30) DTSBD373 00395 VALUE 'TRANSACTION FAILED - APPLICABL'. DTSBD373 00396 15 FILLER PIC X(30) DTSBD373 00397 VALUE 'E YRQ HAS ESTIMATED RATE '. DTSBD373 00398 EJECT DTSBD373 00399 01 EVL-TABLE. DTSBD373 00400 05 EVL1-TEXT. DTSBD373 00401 10 FILLER PIC X(45) DTSBD373 00402 VALUE 'REPORT RCVD WITHOUT USEABLE WAGE DATA. YRQ: '. DTSBD373 00403 10 EVL1-SLASH-QTR PIC X(04). DTSBD373 00404 EJECT DTSBD373 00405 01 R907-REC. DTSBD373 00406 ++INCLUDE DTSIR907 DTSBD373 00407 EJECT DTSBD373 00408 01 L910-LINK-AREA. DTSBD373 00409 ++INCLUDE DTSIL910 DTSBD373 00410 SKIP3 DTSBD373 00411 01 MSKL-REC. DTSBD373 00412 ++INCLUDE DTSIMSKL DTSBD373 00413 SKIP3 DTSBD373 00414 01 MQTR-REC. DTSBD373 00415 ++INCLUDE DTSIMQTR DTSBD373 00416 SKIP3 DTSBD373 00417 01 MADJ-REC. DTSBD373 00418 ++INCLUDE DTSIMADJ DTSBD373 00419 SKIP3 DTSBD373 00420 01 MDST-REC. DTSBD373 00421 ++INCLUDE DTSIMDST DTSBD373 00422 SKIP3 DTSBD373 00423 01 MTCK-REC. DTSBD373 00424 ++INCLUDE DTSIMTCK DTSBD373 00425 SKIP3 DTSBD373 00426 01 MEVL-REC. DTSBD373 00427 ++INCLUDE DTSIMEVL DTSBD373 00428 EJECT DTSBD373 00429 01 L001-LINK-AREA. DTSBD373 00430 ++INCLUDE DTSIL001 DTSBD373 00431 SKIP3 DTSBD373 00432 01 L004-LINK-AREA. DTSBD373 00433 ++INCLUDE DTSIL004 DTSBD373 00434 SKIP3 DTSBD373 00435 01 L005-LINK-AREA. DTSBD373 00436 ++INCLUDE DTSIL005 DTSBD373 00437 SKIP3 DTSBD373 00438 01 L101-LINK-AREA. DTSBD373 00439 ++INCLUDE DTSIL101 DTSBD373 00440 SKIP3 DTSBD373 00441 01 L109-LINK-AREA. DTSBD373 00442 ++INCLUDE DTSIL109 DTSBD373 00443 SKIP3 DTSBD373 00444 01 L415-LINK-AREA. DTSBD373 00445 ++INCLUDE DTSIL415 DTSBD373 00446 SKIP3 DTSBD373 00447 01 L516-LINK-AREA. DTSBD373 00448 ++INCLUDE DTSIL516 DTSBD373 00449 SKIP3 DTSBD373 00450 01 L520-LINK-AREA. DTSBD373 00451 ++INCLUDE DTSIL520 DTSBD373 00452 SKIP3 DTSBD373 00453 01 L522-LINK-AREA. DTSBD373 00454 ++INCLUDE DTSIL522 DTSBD373 00455 SKIP3 DTSBD373 00456 01 L530-LINK-AREA. DTSBD373 00457 ++INCLUDE DTSIL530 DTSBD373 00458 SKIP3 DTSBD373 00459 01 L541-LINK-AREA. DTSBD373 00460 ++INCLUDE DTSIL541 DTSBD373 00461 SKIP3 DTSBD373 00462 01 L542-LINK-AREA. DTSBD373 00463 ++INCLUDE DTSIL542 DTSBD373 00464 SKIP3 DTSBD373 00465 01 L590-LINK-AREA. DTSBD373 00466 ++INCLUDE DTSIL590 DTSBD373 00467 EJECT DTSBD373 00468 01 CACT-LITERALS. DTSBD373 00469 ++INCLUDE DTSICACT DTSBD373 00470 SKIP3 DTSBD373 00471 01 MMAX-LITERALS. DTSBD373 00472 ++INCLUDE DTSIMMAX DTSBD373 00473 EJECT DTSBD373 00474 LINKAGE SECTION. DTSBD373 00475 SKIP3 DTSBD373 00476 01 LBCM-LINK-AREA. DTSBD373 00477 ++INCLUDE DTSILBCM DTSBD373 00478 EJECT DTSBD373 00479 01 MPRF-REC. DTSBD373 00480 ++INCLUDE DTSIMPRF DTSBD373 00481 EJECT DTSBD373 00482 01 AADJ-REC. DTSBD373 00483 ++INCLUDE DTSIAADJ DTSBD373 00484 EJECT DTSBD373 00485 PROCEDURE DIVISION USING LBCM-LINK-AREA DTSBD373 00486 MPRF-REC DTSBD373 00487 AADJ-REC. DTSBD373 00488 DTSBD373 00489 DTSBD373 00490 IF FIRST-TIME-IND = 'Y' DTSBD373 00491 PERFORM I0000-FIRST-TIME THRU I0000-EXIT DTSBD373 00492 MOVE 'N' TO FIRST-TIME-IND. DTSBD373 00493 DTSBD373 00494 DTSBD373 00495 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBD373 00496 DTSBD373 00497 DTSBD373 00498 GOBACK. DTSBD373 00499 EJECT DTSBD373 00500 I0000-FIRST-TIME. DTSBD373 00501 MOVE LBCM-TRACE-IND TO L910-TRACE-IND DTSBD373 00502 L516-TRACE-IND. DTSBD373 00503 DTSBD373 00504 MOVE WRK-MOD-NAME TO L910-MOD-NAME DTSBD373 00505 R907-MODULE-NAME. DTSBD373 00506 DTSBD373 00507 MOVE LENGTH OF R907-REC TO R907-LENGTH. DTSBD373 00508 DTSBD373 00509 MOVE +0 TO WRK-NULL-BATCH-NO DTSBD373 00510 WRK-NULL-ITEM-NO DTSBD373 00511 WRK-CURR-ANN-YRQ. DTSBD373 00512 DTSBD373 00513 SET L415-MODE-MOST-RECENT-88 TO TRUE. DTSBD373 00514 PERFORM S415-ANNUAL-DATES THRU S415-EXIT. DTSBD373 00515 DTSBD373 00516 PERFORM S109-FIRST-PEN-INT-YRQ THRU S109-EXIT. DTSBD373 00517 MOVE L109-FIRST-PEN-INT-YRQ TO WRK-FIRST-PEN-INT-YRQ. DTSBD373 00518 DTSBD373 00519 I0000-EXIT. DTSBD373 00520 EXIT. DTSBD373 00521 EJECT DTSBD373 00522 P0000-PROCESS. DTSBD373 00523 MOVE MPRF-EMP-NO TO R907-EMP-NO. DTSBD373 00524 DTSBD373 00525 DTSBD373 00526 PERFORM P1000-EDIT THRU P1000-EXIT. DTSBD373 00527 DTSBD373 00528 IF LBCM-TRN-NOT-OK-88 DTSBD373 00529 GO TO P0000-EXIT. DTSBD373 00530 DTSBD373 00531 DTSBD373 00532 PERFORM P3000-UPDATE THRU P3000-EXIT. DTSBD373 00533 DTSBD373 00534 DTSBD373 00535 SET L520-NO-PREF-88 TO TRUE. DTSBD373 00536 DTSBD373 00537 MOVE WRK-NULL-DOC-NO TO L520-PREF-PAY-DOC-NO. DTSBD373 00538 DTSBD373 00539 MOVE +0 TO L520-PREF-APPLIC-YRQ. DTSBD373 00540 DTSBD373 00541 MOVE SPACES TO L520-PREF-APPLIC-IND. DTSBD373 00542 DTSBD373 00543 SET L520-ANNUAL-RPT-NULL-88 TO TRUE. DTSBD373 00544 DTSBD373 00545 MOVE ZERO TO L520-WITHDRAW-ANN-YRQ. DTSBD373 00546 DTSBD373 00547 SET L520-LAST-ANN-QTR-NULL-88 TO TRUE. DTSBD373 00548 DTSBD373 00549 *** MOVE WRK-FIRST-PEN-INT-YRQ TO L520-FIRST-PEN-INT-YRQ. DTSBD373 00550 DTSBD373 00551 PERFORM S520-APPLY-CREDIT THRU S520-EXIT. DTSBD373 00552 *** DISPLAY 'S520- EMP NO ' MPRF-EMP-NO 'DOC NO ' AADJ-DOC-NO. DTSBD373 00553 P0000-EXIT. DTSBD373 00554 EXIT. DTSBD373 00555 EJECT DTSBD373 00556 P1000-EDIT. DTSBD373 00557 MOVE LOW-VALUES TO MADJ-KEY-AREA. DTSBD373 00558 * DTSBD373 00559 * DISPLAY 'P1000- EMP NO ' MPRF-EMP-NO 'DOC NO ' AADJ-DOC-NO. DTSBD373 00560 * DTSBD373 00561 MOVE MPRF-EMP-NO TO MADJ-EMP-NO. DTSBD373 00562 DTSBD373 00563 SET MADJ-ADJ-88 TO TRUE. DTSBD373 00564 DTSBD373 00565 MOVE AADJ-DOC-NO TO MADJ-DOC-NO. DTSBD373 00566 DTSBD373 00567 MOVE MADJ-KEY-AREA TO MSKL-KEY-AREA. DTSBD373 00568 DTSBD373 00569 PERFORM S910-READ THRU S910-EXIT. DTSBD373 00570 DTSBD373 00571 IF L910-OK-88 DTSBD373 00572 MOVE MSG2-DUPLICATE-TRAN TO LBCM-TRN-MSG-AREA DTSBD373 00573 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 00574 GO TO P1000-EXIT. DTSBD373 00575 DTSBD373 00576 MOVE LBCM-LAST-UC30-DEL-MAIL-YRQ TO WRK-DELINQUENT-YRQ. DTSBD373 00577 SET WRK-ANNUAL-SCHED-NO-88 TO TRUE. DTSBD373 00578 DTSBD373 00579 IF AADJ-APPLIC-YRQ NOT = ZERO DTSBD373 00580 MOVE AADJ-APPLIC-YRQ TO L516-YRQ DTSBD373 00581 PERFORM S516-LIABILITY-INFO THRU S516-EXIT DTSBD373 00582 MOVE L516-DEFAULT-RPT-DUE-DATE TO WRK-RPT-DUE-DATE DTSBD373 00583 IF L516-ANN-SCHED-88 DTSBD373 00584 SET WRK-ANNUAL-SCHED-YES-88 TO TRUE DTSBD373 00585 MOVE L415-UC30H-FIRST-DEL-END-YRQ DTSBD373 00586 TO WRK-DELINQUENT-YRQ. DTSBD373 00587 DTSBD373 00588 IF (AADJ-APPLIC-YRQ > +0) DTSBD373 00589 AND DTSBD373 00590 (AADJ-APPLIC-YRQ < LBCM-PICKUP-YRQ) DTSBD373 00591 MOVE MSG21-INVALID-APPLIC-YRQ TO LBCM-TRN-MSG-AREA DTSBD373 00592 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 00593 GO TO P1000-EXIT. DTSBD373 00594 DTSBD373 00595 DTSBD373 00596 EVALUATE TRUE DTSBD373 00597 WHEN AADJ-CHARGE-88 DTSBD373 00598 PERFORM P1100-CHARGE-EDIT THRU P1100-EXIT DTSBD373 00599 DTSBD373 00600 WHEN AADJ-WAIVE-88 DTSBD373 00601 PERFORM P1200-WAIVE-EDIT THRU P1200-EXIT DTSBD373 00602 DTSBD373 00603 WHEN AADJ-TOLER-88 DTSBD373 00604 PERFORM P1300-TOLER-EDIT THRU P1300-EXIT DTSBD373 00605 DTSBD373 00606 WHEN AADJ-AUTO-88 DTSBD373 00607 PERFORM P1400-AUTO-EDIT THRU P1400-EXIT DTSBD373 00608 DTSBD373 00609 WHEN AADJ-MANUAL-88 DTSBD373 00610 PERFORM P1500-MANUAL-EDIT THRU P1500-EXIT DTSBD373 00611 DTSBD373 00612 WHEN AADJ-DUE-DATE-88 DTSBD373 00613 PERFORM P1600-DUE-DATE-EDIT THRU P1600-EXIT DTSBD373 00614 DTSBD373 00615 WHEN AADJ-WAIVE-DATE-88 DTSBD373 00616 PERFORM P1700-WAIVE-DATE-EDIT THRU P1700-EXIT DTSBD373 00617 DTSBD373 00618 WHEN AADJ-INT-DATE-88 DTSBD373 00619 PERFORM P1800-INT-DATE-EDIT THRU P1800-EXIT DTSBD373 00620 DTSBD373 00621 WHEN AADJ-WRITE-OFF-88 DTSBD373 00622 PERFORM P2100-WRITE-OFF-EDIT THRU P2100-EXIT DTSBD373 00623 DTSBD373 00624 WHEN AADJ-WRITE-OFF-REV-88 DTSBD373 00625 PERFORM P2200-WRITE-OFF-REV-EDIT THRU P2200-EXIT DTSBD373 00626 DTSBD373 00627 WHEN AADJ-WAGE-RPT-88 DTSBD373 00628 PERFORM P2300-WAGE-RPT-EDIT THRU P2300-EXIT DTSBD373 00629 DTSBD373 00630 WHEN AADJ-FILING-SCHED-88 DTSBD373 00631 PERFORM P2400-FILE-SCHED-EDIT THRU P2400-EXIT DTSBD373 00632 DTSBD373 00633 WHEN OTHER DTSBD373 00634 MOVE MSG1-INVALID-TRN-CD TO LBCM-TRN-MSG-AREA DTSBD373 00635 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 00636 END-EVALUATE. DTSBD373 00637 DTSBD373 00638 P1000-EXIT. DTSBD373 00639 EXIT. DTSBD373 00640 EJECT DTSBD373 00641 P1100-CHARGE-EDIT. DTSBD373 00642 PERFORM S1100-READ-AADJ-APPLIC-YRQ THRU S1100-EXIT. DTSBD373 00643 DTSBD373 00644 IF WRK-MQTR-EXISTS-IND = 'N' DTSBD373 00645 PERFORM P1110-NO-MQTR-REC THRU P1110-EXIT DTSBD373 00646 ELSE DTSBD373 00647 PERFORM P1120-MQTR-REC THRU P1120-EXIT. DTSBD373 00648 P1100-EXIT. DTSBD373 00649 EXIT. DTSBD373 00650 SKIP3 DTSBD373 00651 P1110-NO-MQTR-REC. DTSBD373 00652 IF AADJ-AMT > +0 DTSBD373 00653 NEXT SENTENCE DTSBD373 00654 ELSE DTSBD373 00655 MOVE MSG3-CHARGED-AMT TO LBCM-TRN-MSG-AREA DTSBD373 00656 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 00657 GO TO P1110-EXIT. DTSBD373 00658 DTSBD373 00659 IF AADJ-APPLIC-YRQ = LBCM-PICKUP-YRQ DTSBD373 00660 IF AADJ-UI-88 OR AADJ-SUR-88 OR AADJ-INT-88 DTSBD373 00661 OR AADJ-LATE-PEN-88 OR AADJ-MISC-PEN-88 DTSBD373 00662 OR AADJ-NSF-PEN-88 DTSBD373 00663 GO TO P1110-EXIT DTSBD373 00664 ELSE DTSBD373 00665 MOVE MSG4-INCONSISTENT-CHARGE TO LBCM-TRN-MSG-AREA DTSBD373 00666 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 00667 GO TO P1110-EXIT. DTSBD373 00668 DTSBD373 00669 IF AADJ-UI-88 OR AADJ-NSF-PEN-88 OR AADJ-MISC-PEN-88 DTSBD373 00670 OR AADJ-LATE-PEN-88 OR AADJ-SUR-88 DTSBD373 00671 NEXT SENTENCE DTSBD373 00672 ELSE DTSBD373 00673 MOVE MSG4-INCONSISTENT-CHARGE TO LBCM-TRN-MSG-AREA DTSBD373 00674 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 00675 GO TO P1110-EXIT. DTSBD373 00676 DTSBD373 00677 IF AADJ-UI-88 DTSBD373 00678 OR AADJ-SUR-88 DTSBD373 00679 IF MPRF-CLASS-SELF-INS-88 DTSBD373 00680 NEXT SENTENCE DTSBD373 00681 ELSE DTSBD373 00682 MOVE MSG15-NOT-SELF-INSURED TO LBCM-TRN-MSG-AREA DTSBD373 00683 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 00684 GO TO P1110-EXIT. DTSBD373 00685 DTSBD373 00686 MOVE AADJ-APPLIC-YRQ TO L516-YRQ. DTSBD373 00687 PERFORM S516-LIABILITY-INFO THRU S516-EXIT. DTSBD373 00688 IF L516-ESTIMATED-RATE-88 DTSBD373 00689 MOVE MSG22-ESTIMATED-RATE TO LBCM-TRN-MSG-AREA DTSBD373 00690 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 00691 GO TO P1110-EXIT. DTSBD373 00692 DTSBD373 00693 P1110-EXIT. DTSBD373 00694 EXIT. DTSBD373 00695 SKIP3 DTSBD373 00696 P1120-MQTR-REC. DTSBD373 00697 IF ((AADJ-APPLIC-YRQ = LBCM-PICKUP-YRQ) DTSBD373 00698 AND DTSBD373 00699 (AADJ-UI-88 OR AADJ-SUR-88 OR AADJ-INT-88 DTSBD373 00700 OR AADJ-LATE-PEN-88 OR AADJ-NSF-PEN-88 DTSBD373 00701 OR AADJ-MISC-PEN-88)) DTSBD373 00702 OR DTSBD373 00703 (AADJ-UI-88 OR AADJ-INT-88 OR AADJ-LATE-PEN-88 DTSBD373 00704 OR AADJ-NSF-PEN-88 OR AADJ-MISC-PEN-88 OR AADJ-SUR-88) DTSBD373 00705 NEXT SENTENCE DTSBD373 00706 ELSE DTSBD373 00707 MOVE MSG4-INCONSISTENT-CHARGE TO LBCM-TRN-MSG-AREA DTSBD373 00708 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 00709 GO TO P1120-EXIT. DTSBD373 00710 DTSBD373 00711 MOVE AADJ-AMT TO WRK-CHARGED-AMT. DTSBD373 00712 DTSBD373 00713 PERFORM P1121-MQTR-ACCT-SCAN THRU P1121-EXIT DTSBD373 00714 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBD373 00715 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT. DTSBD373 00716 DTSBD373 00717 IF WRK-CHARGED-AMT < +0 DTSBD373 00718 MOVE MSG3-CHARGED-AMT TO LBCM-TRN-MSG-AREA DTSBD373 00719 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 00720 GO TO P1120-EXIT. DTSBD373 00721 DTSBD373 00722 IF MPRF-CLASS-SELF-INS-88 DTSBD373 00723 PERFORM P1122-SELF-INS-EDIT THRU P1122-EXIT DTSBD373 00724 ELSE DTSBD373 00725 PERFORM P1123-TAXED-EDIT THRU P1123-EXIT. DTSBD373 00726 P1120-EXIT. DTSBD373 00727 EXIT. DTSBD373 00728 SKIP3 DTSBD373 00729 P1121-MQTR-ACCT-SCAN. DTSBD373 00730 IF MQTR-ACCT-IND (MQTR-ACCT-IDX) = AADJ-APPLIC-IND DTSBD373 00731 ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSBD373 00732 TO WRK-CHARGED-AMT. DTSBD373 00733 P1121-EXIT. DTSBD373 00734 EXIT. DTSBD373 00735 SKIP3 DTSBD373 00736 P1122-SELF-INS-EDIT. DTSBD373 00737 IF WRK-CHARGED-AMT = +0 DTSBD373 00738 GO TO P1122-EXIT. DTSBD373 00739 DTSBD373 00740 IF AADJ-APPLIC-YRQ = LBCM-PICKUP-YRQ DTSBD373 00741 GO TO P1122-EXIT. DTSBD373 00742 DTSBD373 00743 MOVE +0 TO WRK-CHARGED-AMT. DTSBD373 00744 DTSBD373 00745 **************************************************** DTSBD373 00746 * ONLY UI TAX INCLUDED IN INTEREST CALCULATION DTSBD373 00747 **************************************************** DTSBD373 00748 PERFORM DTSBD373 00749 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBD373 00750 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSBD373 00751 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSBD373 00752 MOVE MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSBD373 00753 TO WRK-CHARGED-AMT DTSBD373 00754 END-IF DTSBD373 00755 END-PERFORM. DTSBD373 00756 DTSBD373 00757 IF WRK-CHARGED-AMT = +0 DTSBD373 00758 IF AADJ-INT-88 DTSBD373 00759 MOVE MSG3-CHARGED-AMT TO LBCM-TRN-MSG-AREA DTSBD373 00760 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 00761 GO TO P1122-EXIT. DTSBD373 00762 P1122-EXIT. DTSBD373 00763 EXIT. DTSBD373 00764 SKIP3 DTSBD373 00765 P1123-TAXED-EDIT. DTSBD373 00766 IF AADJ-APPLIC-YRQ = LBCM-PICKUP-YRQ DTSBD373 00767 GO TO P1123-EXIT. DTSBD373 00768 DTSBD373 00769 IF AADJ-UI-88 DTSBD373 00770 MOVE MSG15-NOT-SELF-INSURED TO LBCM-TRN-MSG-AREA DTSBD373 00771 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 00772 GO TO P1123-EXIT. DTSBD373 00773 DTSBD373 00774 IF WRK-CHARGED-AMT = +0 DTSBD373 00775 GO TO P1123-EXIT. DTSBD373 00776 DTSBD373 00777 MOVE +0 TO WRK-CHARGED-AMT. DTSBD373 00778 DTSBD373 00779 **************************************************** DTSBD373 00780 * ONLY UI TAX INCLUDED IN INTEREST CALCULATION DTSBD373 00781 **************************************************** DTSBD373 00782 PERFORM DTSBD373 00783 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBD373 00784 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSBD373 00785 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSBD373 00786 MOVE MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSBD373 00787 TO WRK-CHARGED-AMT DTSBD373 00788 END-IF DTSBD373 00789 END-PERFORM. DTSBD373 00790 DTSBD373 00791 IF WRK-CHARGED-AMT = +0 DTSBD373 00792 IF AADJ-INT-88 DTSBD373 00793 MOVE MSG3-CHARGED-AMT TO LBCM-TRN-MSG-AREA DTSBD373 00794 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 00795 GO TO P1123-EXIT. DTSBD373 00796 P1123-EXIT. DTSBD373 00797 EXIT. DTSBD373 00798 EJECT DTSBD373 00799 P1200-WAIVE-EDIT. DTSBD373 00800 IF AADJ-INT-88 OR AADJ-LATE-PEN-88 OR AADJ-NSF-PEN-88 DTSBD373 00801 OR AADJ-MISC-PEN-88 OR AADJ-UI-88 DTSBD373 00802 NEXT SENTENCE DTSBD373 00803 ELSE DTSBD373 00804 MOVE MSG11-WAIVED-AMT TO LBCM-TRN-MSG-AREA DTSBD373 00805 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 00806 GO TO P1200-EXIT. DTSBD373 00807 DTSBD373 00808 DTSBD373 00809 PERFORM S1100-READ-AADJ-APPLIC-YRQ THRU S1100-EXIT. DTSBD373 00810 DTSBD373 00811 IF WRK-MQTR-EXISTS-IND = 'N' DTSBD373 00812 MOVE MSG6-INVALID-YRQ TO LBCM-TRN-MSG-AREA DTSBD373 00813 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 00814 GO TO P1200-EXIT. DTSBD373 00815 DTSBD373 00816 DTSBD373 00817 MOVE +0 TO WRK-ACCT-SUB. DTSBD373 00818 DTSBD373 00819 PERFORM P1210-MQTR-ACCT-SCAN THRU P1210-EXIT DTSBD373 00820 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBD373 00821 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT. DTSBD373 00822 DTSBD373 00823 IF WRK-ACCT-SUB = +0 DTSBD373 00824 MOVE MSG9-DOES-NOT-EXIST TO LBCM-TRN-MSG-AREA DTSBD373 00825 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 00826 GO TO P1200-EXIT. DTSBD373 00827 DTSBD373 00828 DTSBD373 00829 COMPUTE WRK-WAIVED-AMT DTSBD373 00830 = MQTR-WAIVED-AMT (WRK-ACCT-SUB) + AADJ-AMT. DTSBD373 00831 DTSBD373 00832 IF (WRK-WAIVED-AMT < +0) DTSBD373 00833 OR DTSBD373 00834 (WRK-WAIVED-AMT > MQTR-CHARGED-AMT (WRK-ACCT-SUB)) DTSBD373 00835 MOVE MSG11-WAIVED-AMT TO LBCM-TRN-MSG-AREA DTSBD373 00836 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 00837 GO TO P1200-EXIT. DTSBD373 00838 P1200-EXIT. DTSBD373 00839 EXIT. DTSBD373 00840 SKIP3 DTSBD373 00841 P1210-MQTR-ACCT-SCAN. DTSBD373 00842 IF MQTR-ACCT-IND (MQTR-ACCT-IDX) = AADJ-APPLIC-IND DTSBD373 00843 SET WRK-ACCT-SUB TO MQTR-ACCT-IDX. DTSBD373 00844 P1210-EXIT. DTSBD373 00845 EXIT. DTSBD373 00846 EJECT DTSBD373 00847 P1300-TOLER-EDIT. DTSBD373 00848 IF AADJ-CREDIT-88 DTSBD373 00849 PERFORM P1310-CREDIT-TOLER THRU P1310-EXIT DTSBD373 00850 ELSE DTSBD373 00851 PERFORM P1320-MQTR-TOLER THRU P1320-EXIT. DTSBD373 00852 P1300-EXIT. DTSBD373 00853 EXIT. DTSBD373 00854 SKIP3 DTSBD373 00855 P1310-CREDIT-TOLER. DTSBD373 00856 PERFORM S1300-READ-AADJ-APPLIC-MDST THRU S1300-EXIT. DTSBD373 00857 DTSBD373 00858 IF WRK-MDST-EXISTS-IND = 'N' DTSBD373 00859 MOVE MSG7-INVALID-PAYMENT TO LBCM-TRN-MSG-AREA DTSBD373 00860 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 00861 GO TO P1310-EXIT. DTSBD373 00862 DTSBD373 00863 DTSBD373 00864 MOVE +0 TO WRK-CREDIT-AMT DTSBD373 00865 WRK-TOLER-AMT. DTSBD373 00866 DTSBD373 00867 PERFORM DTSBD373 00868 VARYING MDST-ACCT-IDX FROM 1 BY 1 DTSBD373 00869 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT DTSBD373 00870 IF MDST-ACCT-CR-AVAIL-88 (MDST-ACCT-IDX) DTSBD373 00871 ADD MDST-AMT (MDST-ACCT-IDX) TO WRK-CREDIT-AMT DTSBD373 00872 END-IF DTSBD373 00873 IF MDST-ACCT-CR-TOL-88 (MDST-ACCT-IDX) DTSBD373 00874 ADD MDST-AMT (MDST-ACCT-IDX) TO WRK-TOLER-AMT DTSBD373 00875 END-IF DTSBD373 00876 END-PERFORM. DTSBD373 00877 DTSBD373 00878 ADD AADJ-AMT TO WRK-TOLER-AMT. DTSBD373 00879 DTSBD373 00880 IF WRK-TOLER-AMT < +0 DTSBD373 00881 MOVE MSG5-TOLER-AMT TO LBCM-TRN-MSG-AREA DTSBD373 00882 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 00883 GO TO P1310-EXIT. DTSBD373 00884 DTSBD373 00885 IF AADJ-AMT > WRK-CREDIT-AMT DTSBD373 00886 MOVE MSG5-TOLER-AMT TO LBCM-TRN-MSG-AREA DTSBD373 00887 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 00888 GO TO P1310-EXIT. DTSBD373 00889 P1310-EXIT. DTSBD373 00890 EXIT. DTSBD373 00891 SKIP3 DTSBD373 00892 P1320-MQTR-TOLER. DTSBD373 00893 PERFORM S1100-READ-AADJ-APPLIC-YRQ THRU S1100-EXIT. DTSBD373 00894 DTSBD373 00895 IF WRK-MQTR-EXISTS-IND = 'N' DTSBD373 00896 MOVE MSG6-INVALID-YRQ TO LBCM-TRN-MSG-AREA DTSBD373 00897 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 00898 GO TO P1320-EXIT. DTSBD373 00899 DTSBD373 00900 DTSBD373 00901 MOVE +0 TO WRK-ACCT-SUB. DTSBD373 00902 DTSBD373 00903 PERFORM DTSBD373 00904 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBD373 00905 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSBD373 00906 IF MQTR-ACCT-IND (MQTR-ACCT-IDX) = AADJ-APPLIC-IND DTSBD373 00907 SET WRK-ACCT-SUB TO MQTR-ACCT-IDX DTSBD373 00908 END-IF DTSBD373 00909 END-PERFORM. DTSBD373 00910 DTSBD373 00911 IF WRK-ACCT-SUB = +0 DTSBD373 00912 MOVE MSG9-DOES-NOT-EXIST TO LBCM-TRN-MSG-AREA DTSBD373 00913 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 00914 GO TO P1320-EXIT. DTSBD373 00915 DTSBD373 00916 DTSBD373 00917 COMPUTE WRK-TOLER-AMT DTSBD373 00918 = MQTR-TOLER-AMT (WRK-ACCT-SUB) + AADJ-AMT. DTSBD373 00919 DTSBD373 00920 IF (WRK-TOLER-AMT < +0) DTSBD373 00921 OR DTSBD373 00922 (WRK-TOLER-AMT > MQTR-CHARGED-AMT (WRK-ACCT-SUB)) DTSBD373 00923 MOVE MSG5-TOLER-AMT TO LBCM-TRN-MSG-AREA DTSBD373 00924 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 00925 GO TO P1320-EXIT. DTSBD373 00926 P1320-EXIT. DTSBD373 00927 EXIT. DTSBD373 00928 EJECT DTSBD373 00929 P1400-AUTO-EDIT. DTSBD373 00930 PERFORM S1100-READ-AADJ-APPLIC-YRQ THRU S1100-EXIT. DTSBD373 00931 DTSBD373 00932 DTSBD373 00933 IF WRK-MQTR-EXISTS-IND = 'N' DTSBD373 00934 MOVE MSG17-NOT-MANUAL TO LBCM-TRN-MSG-AREA DTSBD373 00935 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 00936 GO TO P1400-EXIT. DTSBD373 00937 DTSBD373 00938 DTSBD373 00939 IF AADJ-APPLIC-YRQ = LBCM-PICKUP-YRQ DTSBD373 00940 MOVE MSG6-INVALID-YRQ TO LBCM-TRN-MSG-AREA DTSBD373 00941 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 00942 GO TO P1400-EXIT. DTSBD373 00943 DTSBD373 00944 DTSBD373 00945 IF AADJ-LATE-PEN-88 DTSBD373 00946 IF MQTR-PEN-CHARGE-MANUAL-88 DTSBD373 00947 NEXT SENTENCE DTSBD373 00948 ELSE DTSBD373 00949 MOVE MSG17-NOT-MANUAL TO LBCM-TRN-MSG-AREA DTSBD373 00950 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 00951 GO TO P1400-EXIT DTSBD373 00952 ELSE DTSBD373 00953 IF AADJ-INT-88 DTSBD373 00954 IF MQTR-INT-CHARGE-MANUAL-88 DTSBD373 00955 NEXT SENTENCE DTSBD373 00956 ELSE DTSBD373 00957 MOVE MSG17-NOT-MANUAL TO LBCM-TRN-MSG-AREA DTSBD373 00958 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 00959 GO TO P1400-EXIT DTSBD373 00960 ELSE DTSBD373 00961 IF AADJ-LP-INT-88 DTSBD373 00962 IF MQTR-PEN-CHARGE-MANUAL-88 DTSBD373 00963 AND DTSBD373 00964 MQTR-INT-CHARGE-MANUAL-88 DTSBD373 00965 NEXT SENTENCE DTSBD373 00966 ELSE DTSBD373 00967 MOVE MSG17-NOT-MANUAL TO LBCM-TRN-MSG-AREA DTSBD373 00968 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 00969 GO TO P1400-EXIT DTSBD373 00970 ELSE DTSBD373 00971 MOVE MSG17-NOT-MANUAL TO LBCM-TRN-MSG-AREA DTSBD373 00972 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 00973 GO TO P1400-EXIT. DTSBD373 00974 P1400-EXIT. DTSBD373 00975 EXIT. DTSBD373 00976 EJECT DTSBD373 00977 P1500-MANUAL-EDIT. DTSBD373 00978 PERFORM S1100-READ-AADJ-APPLIC-YRQ THRU S1100-EXIT. DTSBD373 00979 DTSBD373 00980 IF WRK-MQTR-EXISTS-IND = 'N' DTSBD373 00981 PERFORM P1510-NO-MQTR-REC THRU P1510-EXIT DTSBD373 00982 ELSE DTSBD373 00983 PERFORM P1520-MQTR-REC THRU P1520-EXIT. DTSBD373 00984 P1500-EXIT. DTSBD373 00985 EXIT. DTSBD373 00986 SKIP3 DTSBD373 00987 P1510-NO-MQTR-REC. DTSBD373 00988 IF AADJ-INT-88 OR AADJ-LATE-PEN-88 OR AADJ-LP-INT-88 DTSBD373 00989 NEXT SENTENCE DTSBD373 00990 ELSE DTSBD373 00991 MOVE MSG16-ALREADY-MANUAL TO LBCM-TRN-MSG-AREA DTSBD373 00992 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 00993 GO TO P1510-EXIT. DTSBD373 00994 P1510-EXIT. DTSBD373 00995 EXIT. DTSBD373 00996 SKIP3 DTSBD373 00997 P1520-MQTR-REC. DTSBD373 00998 IF AADJ-LATE-PEN-88 DTSBD373 00999 IF MQTR-PEN-CHARGE-AUTO-88 DTSBD373 01000 NEXT SENTENCE DTSBD373 01001 ELSE DTSBD373 01002 MOVE MSG16-ALREADY-MANUAL TO LBCM-TRN-MSG-AREA DTSBD373 01003 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 01004 GO TO P1520-EXIT DTSBD373 01005 ELSE DTSBD373 01006 IF AADJ-INT-88 DTSBD373 01007 IF MQTR-INT-CHARGE-AUTO-88 DTSBD373 01008 NEXT SENTENCE DTSBD373 01009 ELSE DTSBD373 01010 MOVE MSG16-ALREADY-MANUAL TO LBCM-TRN-MSG-AREA DTSBD373 01011 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 01012 GO TO P1520-EXIT DTSBD373 01013 ELSE DTSBD373 01014 IF AADJ-LP-INT-88 DTSBD373 01015 IF MQTR-PEN-CHARGE-AUTO-88 AND MQTR-INT-CHARGE-AUTO-88 DTSBD373 01016 NEXT SENTENCE DTSBD373 01017 ELSE DTSBD373 01018 MOVE MSG16-ALREADY-MANUAL TO LBCM-TRN-MSG-AREA DTSBD373 01019 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 01020 GO TO P1520-EXIT DTSBD373 01021 ELSE DTSBD373 01022 MOVE MSG16-ALREADY-MANUAL TO LBCM-TRN-MSG-AREA DTSBD373 01023 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 01024 GO TO P1520-EXIT. DTSBD373 01025 P1520-EXIT. DTSBD373 01026 EXIT. DTSBD373 01027 EJECT DTSBD373 01028 P1600-DUE-DATE-EDIT. DTSBD373 01029 PERFORM S1100-READ-AADJ-APPLIC-YRQ THRU S1100-EXIT. DTSBD373 01030 DTSBD373 01031 IF AADJ-APPLIC-YRQ = LBCM-PICKUP-YRQ DTSBD373 01032 MOVE MSG6-INVALID-YRQ TO LBCM-TRN-MSG-AREA DTSBD373 01033 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 01034 GO TO P1600-EXIT. DTSBD373 01035 DTSBD373 01036 IF WRK-MQTR-EXISTS-IND = 'N' DTSBD373 01037 PERFORM P1610-NO-MQTR-REC THRU P1610-EXIT DTSBD373 01038 ELSE DTSBD373 01039 NEXT SENTENCE. DTSBD373 01040 DTSBD373 01041 IF AADJ-DATE-2 = +0 OR ALL-NINES-DATE DTSBD373 01042 NEXT SENTENCE DTSBD373 01043 ELSE DTSBD373 01044 PERFORM P1620-TAX-DUE-DATE-EDIT THRU P1620-EXIT. DTSBD373 01045 P1600-EXIT. DTSBD373 01046 EXIT. DTSBD373 01047 SKIP3 DTSBD373 01048 P1610-NO-MQTR-REC. DTSBD373 01049 IF (AADJ-DATE-1 = +0 OR ALL-NINES-DATE) DTSBD373 01050 AND DTSBD373 01051 (AADJ-DATE-2 = +0 OR ALL-NINES-DATE) DTSBD373 01052 MOVE MSG6-INVALID-YRQ TO LBCM-TRN-MSG-AREA DTSBD373 01053 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 01054 GO TO P1610-EXIT. DTSBD373 01055 P1610-EXIT. DTSBD373 01056 EXIT. DTSBD373 01057 SKIP3 DTSBD373 01058 P1620-TAX-DUE-DATE-EDIT. DTSBD373 01059 MOVE AADJ-APPLIC-YRQ TO L516-YRQ. DTSBD373 01060 DTSBD373 01061 PERFORM S516-LIABILITY-INFO THRU S516-EXIT. DTSBD373 01062 DTSBD373 01063 IF AADJ-DATE-2 > L516-DEFAULT-TAX-DUE-DATE DTSBD373 01064 MOVE MSG20-EXTEND-TAX-DUE-DATE TO LBCM-TRN-MSG-AREA DTSBD373 01065 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 01066 GO TO P1620-EXIT. DTSBD373 01067 P1620-EXIT. DTSBD373 01068 EXIT. DTSBD373 01069 EJECT DTSBD373 01070 P1700-WAIVE-DATE-EDIT. DTSBD373 01071 PERFORM S1100-READ-AADJ-APPLIC-YRQ THRU S1100-EXIT. DTSBD373 01072 DTSBD373 01073 IF AADJ-APPLIC-YRQ = LBCM-PICKUP-YRQ DTSBD373 01074 MOVE MSG6-INVALID-YRQ TO LBCM-TRN-MSG-AREA DTSBD373 01075 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 01076 GO TO P1700-EXIT. DTSBD373 01077 DTSBD373 01078 IF WRK-MQTR-EXISTS-IND = 'N' DTSBD373 01079 PERFORM P1710-NO-MQTR-REC THRU P1710-EXIT DTSBD373 01080 ELSE DTSBD373 01081 PERFORM P1720-MQTR-REC THRU P1720-EXIT. DTSBD373 01082 P1700-EXIT. DTSBD373 01083 EXIT. DTSBD373 01084 SKIP3 DTSBD373 01085 P1710-NO-MQTR-REC. DTSBD373 01086 IF AADJ-INT-88 OR AADJ-LATE-PEN-88 OR AADJ-LP-INT-88 DTSBD373 01087 NEXT SENTENCE DTSBD373 01088 ELSE DTSBD373 01089 MOVE MSG8-INVALID-APPLIC-IND TO LBCM-TRN-MSG-AREA DTSBD373 01090 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 01091 GO TO P1710-EXIT. DTSBD373 01092 DTSBD373 01093 IF AADJ-DATE-1 = ALL-NINES-DATE DTSBD373 01094 MOVE MSG6-INVALID-YRQ TO LBCM-TRN-MSG-AREA DTSBD373 01095 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 01096 GO TO P1710-EXIT. DTSBD373 01097 P1710-EXIT. DTSBD373 01098 EXIT. DTSBD373 01099 SKIP3 DTSBD373 01100 P1720-MQTR-REC. DTSBD373 01101 IF AADJ-INT-88 OR AADJ-LATE-PEN-88 OR AADJ-LP-INT-88 DTSBD373 01102 NEXT SENTENCE DTSBD373 01103 ELSE DTSBD373 01104 MOVE MSG8-INVALID-APPLIC-IND TO LBCM-TRN-MSG-AREA DTSBD373 01105 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 01106 GO TO P1720-EXIT. DTSBD373 01107 P1720-EXIT. DTSBD373 01108 EXIT. DTSBD373 01109 EJECT DTSBD373 01110 P1800-INT-DATE-EDIT. DTSBD373 01111 IF AADJ-APPLIC-YRQ = LBCM-PICKUP-YRQ DTSBD373 01112 MOVE MSG6-INVALID-YRQ TO LBCM-TRN-MSG-AREA DTSBD373 01113 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 01114 GO TO P1800-EXIT. DTSBD373 01115 DTSBD373 01116 IF AADJ-INT-88 DTSBD373 01117 NEXT SENTENCE DTSBD373 01118 ELSE DTSBD373 01119 MOVE MSG8-INVALID-APPLIC-IND TO LBCM-TRN-MSG-AREA DTSBD373 01120 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 01121 GO TO P1800-EXIT. DTSBD373 01122 DTSBD373 01123 IF AADJ-INT-SPAN-IND = '1' OR '2' DTSBD373 01124 NEXT SENTENCE DTSBD373 01125 ELSE DTSBD373 01126 MOVE MSG10-INVALID-INT-SPAN-IND TO LBCM-TRN-MSG-AREA DTSBD373 01127 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 01128 GO TO P1800-EXIT. DTSBD373 01129 DTSBD373 01130 PERFORM S1100-READ-AADJ-APPLIC-YRQ THRU S1100-EXIT. DTSBD373 01131 DTSBD373 01132 IF WRK-MQTR-EXISTS-IND = 'N' DTSBD373 01133 PERFORM P1810-NO-MQTR-REC THRU P1810-EXIT DTSBD373 01134 ELSE DTSBD373 01135 NEXT SENTENCE. DTSBD373 01136 P1800-EXIT. DTSBD373 01137 EXIT. DTSBD373 01138 SKIP3 DTSBD373 01139 P1810-NO-MQTR-REC. DTSBD373 01140 IF AADJ-DATE-1 = ALL-NINES-DATE DTSBD373 01141 MOVE MSG6-INVALID-YRQ TO LBCM-TRN-MSG-AREA DTSBD373 01142 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 01143 GO TO P1810-EXIT. DTSBD373 01144 P1810-EXIT. DTSBD373 01145 EXIT. DTSBD373 01146 EJECT DTSBD373 01147 P2100-WRITE-OFF-EDIT. DTSBD373 01148 IF MPRF-NOT-WRITTEN-OFF-88 DTSBD373 01149 NEXT SENTENCE DTSBD373 01150 ELSE DTSBD373 01151 MOVE MSG12-ALREADY-WRITTEN-OFF TO LBCM-TRN-MSG-AREA DTSBD373 01152 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 01153 GO TO P2100-EXIT. DTSBD373 01154 DTSBD373 01155 IF (MPRF-TOT-BALANCE-AMT > +0) DTSBD373 01156 OR DTSBD373 01157 (MPRF-PURSUED-RPT-CNT > +0) DTSBD373 01158 OR DTSBD373 01159 (MPRF-TOT-CREDIT-AMT > +0) DTSBD373 01160 NEXT SENTENCE DTSBD373 01161 ELSE DTSBD373 01162 MOVE MSG13-NO-COLLECTIONS TO LBCM-TRN-MSG-AREA DTSBD373 01163 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 01164 GO TO P2100-EXIT. DTSBD373 01165 DTSBD373 01166 IF MPRF-STATUS-ACT-88 DTSBD373 01167 MOVE MSG19-ACTIVE TO LBCM-TRN-MSG-AREA DTSBD373 01168 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 01169 GO TO P2100-EXIT. DTSBD373 01170 P2100-EXIT. DTSBD373 01171 EXIT. DTSBD373 01172 EJECT DTSBD373 01173 P2200-WRITE-OFF-REV-EDIT. DTSBD373 01174 IF MPRF-NOT-WRITTEN-OFF-88 DTSBD373 01175 MOVE MSG14-NOT-WRITTEN-OFF TO LBCM-TRN-MSG-AREA DTSBD373 01176 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 01177 GO TO P2200-EXIT. DTSBD373 01178 P2200-EXIT. DTSBD373 01179 EXIT. DTSBD373 01180 EJECT DTSBD373 01181 P2300-WAGE-RPT-EDIT. DTSBD373 01182 PERFORM S1100-READ-AADJ-APPLIC-YRQ THRU S1100-EXIT. DTSBD373 01183 DTSBD373 01184 IF AADJ-APPLIC-YRQ = LBCM-PICKUP-YRQ DTSBD373 01185 MOVE MSG6-INVALID-YRQ TO LBCM-TRN-MSG-AREA DTSBD373 01186 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 01187 GO TO P2300-EXIT. DTSBD373 01188 P2300-EXIT. DTSBD373 01189 EXIT. DTSBD373 01190 DTSBD373 01191 P2400-FILE-SCHED-EDIT. DTSBD373 01192 PERFORM S1100-READ-AADJ-APPLIC-YRQ THRU S1100-EXIT. DTSBD373 01193 DTSBD373 01194 IF AADJ-APPLIC-YRQ < WRK-FIRST-ANN-QTR DTSBD373 01195 MOVE MSG6-INVALID-YRQ TO LBCM-TRN-MSG-AREA DTSBD373 01196 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD373 01197 GO TO P2400-EXIT DTSBD373 01198 END-IF. DTSBD373 01199 DTSBD373 01200 IF WRK-MQTR-EXISTS-IND = 'N' DTSBD373 01201 PERFORM P1610-NO-MQTR-REC THRU P1610-EXIT DTSBD373 01202 ELSE DTSBD373 01203 NEXT SENTENCE. DTSBD373 01204 DTSBD373 01205 IF AADJ-DATE-2 = +0 OR ALL-NINES-DATE DTSBD373 01206 NEXT SENTENCE DTSBD373 01207 ELSE DTSBD373 01208 PERFORM P1620-TAX-DUE-DATE-EDIT THRU P1620-EXIT. DTSBD373 01209 P2400-EXIT. DTSBD373 01210 EXIT. DTSBD373 01211 DTSBD373 01212 P3000-UPDATE. DTSBD373 01213 DISPLAY 'P3000- EMP NO ' MPRF-EMP-NO 'DOC NO ' AADJ-DOC-NO. DTSBD373 01214 IF AADJ-CHARGE-88 DTSBD373 01215 PERFORM P3100-CHARGE-UPDATE THRU P3100-EXIT DTSBD373 01216 ELSE DTSBD373 01217 IF AADJ-WAIVE-88 DTSBD373 01218 PERFORM P3200-WAIVE-UPDATE THRU P3200-EXIT DTSBD373 01219 ELSE DTSBD373 01220 IF AADJ-TOLER-88 DTSBD373 01221 PERFORM P3300-TOLER-UPDATE THRU P3300-EXIT DTSBD373 01222 ELSE DTSBD373 01223 IF AADJ-AUTO-88 DTSBD373 01224 PERFORM P3400-AUTO-UPDATE THRU P3400-EXIT DTSBD373 01225 ELSE DTSBD373 01226 IF AADJ-MANUAL-88 DTSBD373 01227 PERFORM P3500-MANUAL-UPDATE THRU P3500-EXIT DTSBD373 01228 ELSE DTSBD373 01229 IF AADJ-DUE-DATE-88 DTSBD373 01230 PERFORM P3600-DUE-DATE-UPDATE THRU P3600-EXIT DTSBD373 01231 ELSE DTSBD373 01232 IF AADJ-WAIVE-DATE-88 DTSBD373 01233 PERFORM P3700-WAIVE-DATE-UPDATE THRU P3700-EXIT DTSBD373 01234 ELSE DTSBD373 01235 IF AADJ-INT-DATE-88 DTSBD373 01236 PERFORM P3800-INT-DATE-UPDATE THRU P3800-EXIT DTSBD373 01237 ELSE DTSBD373 01238 IF AADJ-WRITE-OFF-88 DTSBD373 01239 PERFORM P4100-WRITE-OFF-UPDATE THRU P4100-EXIT DTSBD373 01240 ELSE DTSBD373 01241 IF AADJ-WRITE-OFF-REV-88 DTSBD373 01242 PERFORM P4200-WRITE-OFF-REV-UPDATE THRU P4200-EXIT DTSBD373 01243 ELSE DTSBD373 01244 IF AADJ-WAGE-RPT-88 DTSBD373 01245 PERFORM P4300-WAGE-RPT-UPDATE THRU P4300-EXIT DTSBD373 01246 ELSE DTSBD373 01247 PERFORM S999-ABEND THRU S999-EXIT. DTSBD373 01248 DTSBD373 01249 PERFORM S9100-ESTB-MADJ THRU S9100-EXIT. DTSBD373 01250 P3000-EXIT. DTSBD373 01251 EXIT. DTSBD373 01252 EJECT DTSBD373 01253 P3100-CHARGE-UPDATE. DTSBD373 01254 IF WRK-MQTR-EXISTS-IND = 'N' DTSBD373 01255 PERFORM S9200-INIT-MQTR THRU S9200-EXIT. DTSBD373 01256 DTSBD373 01257 DTSBD373 01258 MOVE AADJ-APPLIC-IND TO WRK-ACCT-IND. DTSBD373 01259 DTSBD373 01260 PERFORM S3100-LOC-OR-ESTB-ACCT-DATA THRU S3100-EXIT. DTSBD373 01261 DTSBD373 01262 DTSBD373 01263 IF (MPRF-CLASS-SELF-INS-88) DTSBD373 01264 IF (MQTR-ACCT-UI-88 (WRK-ACCT-SUB) DTSBD373 01265 OR (MQTR-ACCT-SUR-88 (WRK-ACCT-SUB) DTSBD373 01266 AND MQTR-YRQ >= WRK-FIRST-PEN-INT-YRQ)) DTSBD373 01267 AND DTSBD373 01268 (MQTR-CHARGED-AMT (WRK-ACCT-SUB) = +0) DTSBD373 01269 AND DTSBD373 01270 (AADJ-AMT > +0) DTSBD373 01271 AND DTSBD373 01272 (MQTR-TAX-DUE-DATE-MANUAL-88) DTSBD373 01273 PERFORM P3110-SELF-INS-TAX-DUE-DATE THRU P3110-EXIT. DTSBD373 01274 DTSBD373 01275 DTSBD373 01276 MOVE AADJ-AMT TO L541-AMT. DTSBD373 01277 DTSBD373 01278 MOVE WRK-ACCT-SUB TO L541-ACCT-SUB. DTSBD373 01279 DTSBD373 01280 MOVE CACT-CAT-CHARGED TO L541-CAT-IND. DTSBD373 01281 DTSBD373 01282 PERFORM S541-MODIFY-AMT THRU S541-EXIT. DTSBD373 01283 DTSBD373 01284 PERFORM S3200-REMOVE-MQTR-TOLERANCE THRU S3200-EXIT. DTSBD373 01285 DTSBD373 01286 PERFORM S3300-DECR-PAID-WAIVED THRU S3300-EXIT. DTSBD373 01287 DTSBD373 01288 PERFORM S3900-CRUNCH-ACCT-DATA THRU S3900-EXIT. DTSBD373 01289 DTSBD373 01290 PERFORM S1200-WRITE-OR-REWRITE-MQTR THRU S1200-EXIT. DTSBD373 01291 P3100-EXIT. DTSBD373 01292 EXIT. DTSBD373 01293 SKIP3 DTSBD373 01294 P3110-SELF-INS-TAX-DUE-DATE. DTSBD373 01295 MOVE MQTR-YRQ TO L516-YRQ. DTSBD373 01296 DTSBD373 01297 PERFORM S516-LIABILITY-INFO THRU S516-EXIT. DTSBD373 01298 DTSBD373 01299 IF L516-DEFAULT-TAX-DUE-DATE = MQTR-TAX-DUE-DATE DTSBD373 01300 GO TO P3110-EXIT. DTSBD373 01301 DTSBD373 01302 MOVE L516-DEFAULT-TAX-DUE-DATE TO MQTR-TAX-DUE-DATE. DTSBD373 01303 DTSBD373 01304 IF MQTR-INT-CHARGE-MANUAL-88 DTSBD373 01305 GO TO P3110-EXIT. DTSBD373 01306 DTSBD373 01307 PERFORM S4000-RECOMPUTE-INT THRU S4000-EXIT. DTSBD373 01308 DTSBD373 01309 PERFORM P3621-CHANGE-INT-CHARGE THRU P3621-EXIT. DTSBD373 01310 DTSBD373 01311 MOVE AADJ-APPLIC-IND TO WRK-ACCT-IND. DTSBD373 01312 DTSBD373 01313 PERFORM S3100-LOC-OR-ESTB-ACCT-DATA THRU S3100-EXIT. DTSBD373 01314 P3110-EXIT. DTSBD373 01315 EXIT. DTSBD373 01316 EJECT DTSBD373 01317 P3200-WAIVE-UPDATE. DTSBD373 01318 MOVE AADJ-APPLIC-IND TO WRK-ACCT-IND. DTSBD373 01319 DTSBD373 01320 PERFORM S3100-LOC-OR-ESTB-ACCT-DATA THRU S3100-EXIT. DTSBD373 01321 DTSBD373 01322 MOVE AADJ-AMT TO L541-AMT. DTSBD373 01323 DTSBD373 01324 MOVE WRK-ACCT-SUB TO L541-ACCT-SUB. DTSBD373 01325 DTSBD373 01326 MOVE CACT-CAT-WAIVED TO L541-CAT-IND. DTSBD373 01327 DTSBD373 01328 PERFORM S541-MODIFY-AMT THRU S541-EXIT. DTSBD373 01329 DTSBD373 01330 PERFORM S3200-REMOVE-MQTR-TOLERANCE THRU S3200-EXIT. DTSBD373 01331 DTSBD373 01332 PERFORM S3300-DECR-PAID-WAIVED THRU S3300-EXIT. DTSBD373 01333 DTSBD373 01334 PERFORM S3900-CRUNCH-ACCT-DATA THRU S3900-EXIT. DTSBD373 01335 DTSBD373 01336 PERFORM S1200-WRITE-OR-REWRITE-MQTR THRU S1200-EXIT. DTSBD373 01337 P3200-EXIT. DTSBD373 01338 EXIT. DTSBD373 01339 EJECT DTSBD373 01340 P3300-TOLER-UPDATE. DTSBD373 01341 IF AADJ-CREDIT-88 DTSBD373 01342 PERFORM P3310-CREDIT-TOLER THRU P3310-EXIT DTSBD373 01343 ELSE DTSBD373 01344 PERFORM P3320-MQTR-TOLER THRU P3320-EXIT. DTSBD373 01345 P3300-EXIT. DTSBD373 01346 EXIT. DTSBD373 01347 SKIP3 DTSBD373 01348 P3310-CREDIT-TOLER. DTSBD373 01349 MOVE AADJ-AMT TO L542-AMT. DTSBD373 01350 DTSBD373 01351 MOVE CACT-CR-TOLER TO L542-ACCT-IND. DTSBD373 01352 DTSBD373 01353 PERFORM S542-MDST-MAINTENANCE THRU S542-EXIT. DTSBD373 01354 DTSBD373 01355 COMPUTE L542-AMT = AADJ-AMT * -1. DTSBD373 01356 DTSBD373 01357 MOVE CACT-CR-AVAIL TO L542-ACCT-IND. DTSBD373 01358 DTSBD373 01359 PERFORM S542-MDST-MAINTENANCE THRU S542-EXIT. DTSBD373 01360 DTSBD373 01361 PERFORM S1400-WRITE-OR-REWRITE-MDST THRU S1400-EXIT. DTSBD373 01362 P3310-EXIT. DTSBD373 01363 EXIT. DTSBD373 01364 SKIP3 DTSBD373 01365 P3320-MQTR-TOLER. DTSBD373 01366 MOVE AADJ-APPLIC-IND TO WRK-ACCT-IND. DTSBD373 01367 DTSBD373 01368 PERFORM S3100-LOC-OR-ESTB-ACCT-DATA THRU S3100-EXIT. DTSBD373 01369 DTSBD373 01370 MOVE AADJ-AMT TO L541-AMT. DTSBD373 01371 DTSBD373 01372 MOVE WRK-ACCT-SUB TO L541-ACCT-SUB. DTSBD373 01373 DTSBD373 01374 MOVE CACT-CAT-TOLER TO L541-CAT-IND. DTSBD373 01375 DTSBD373 01376 PERFORM S541-MODIFY-AMT THRU S541-EXIT. DTSBD373 01377 DTSBD373 01378 PERFORM S3300-DECR-PAID-WAIVED THRU S3300-EXIT. DTSBD373 01379 DTSBD373 01380 PERFORM S3900-CRUNCH-ACCT-DATA THRU S3900-EXIT. DTSBD373 01381 DTSBD373 01382 PERFORM S1200-WRITE-OR-REWRITE-MQTR THRU S1200-EXIT. DTSBD373 01383 P3320-EXIT. DTSBD373 01384 EXIT. DTSBD373 01385 EJECT DTSBD373 01386 P3400-AUTO-UPDATE. DTSBD373 01387 IF AADJ-INT-88 DTSBD373 01388 SET MQTR-INT-CHARGE-AUTO-88 TO TRUE DTSBD373 01389 ELSE DTSBD373 01390 IF AADJ-LATE-PEN-88 DTSBD373 01391 SET MQTR-PEN-CHARGE-AUTO-88 TO TRUE DTSBD373 01392 ELSE DTSBD373 01393 SET MQTR-INT-CHARGE-AUTO-88 TO TRUE DTSBD373 01394 SET MQTR-PEN-CHARGE-AUTO-88 TO TRUE. DTSBD373 01395 DTSBD373 01396 IF AADJ-INT-88 OR AADJ-LP-INT-88 DTSBD373 01397 PERFORM S4000-RECOMPUTE-INT THRU S4000-EXIT DTSBD373 01398 PERFORM P3410-ADJUST-INT-CHARGED THRU P3410-EXIT. DTSBD373 01399 DTSBD373 01400 *****IF AADJ-LP-INT-88 DTSBD373 01401 *********PERFORM P3420-LP-AND-INT THRU P3420-EXIT DTSBD373 01402 *****ELSE DTSBD373 01403 *********PERFORM P3410-LP-OR-INT THRU P3410-EXIT. DTSBD373 01404 DTSBD373 01405 PERFORM S3900-CRUNCH-ACCT-DATA THRU S3900-EXIT. DTSBD373 01406 DTSBD373 01407 PERFORM S1200-WRITE-OR-REWRITE-MQTR THRU S1200-EXIT. DTSBD373 01408 P3400-EXIT. DTSBD373 01409 EXIT. DTSBD373 01410 SKIP3 DTSBD373 01411 P3410-ADJUST-INT-CHARGED. DTSBD373 01412 MOVE CACT-ACCT-INT TO WRK-ACCT-IND. DTSBD373 01413 DTSBD373 01414 PERFORM S3100-LOC-OR-ESTB-ACCT-DATA THRU S3100-EXIT. DTSBD373 01415 DTSBD373 01416 COMPUTE L541-AMT DTSBD373 01417 = WRK-INT-CHARGED-AMT DTSBD373 01418 - MQTR-CHARGED-AMT (WRK-ACCT-SUB). DTSBD373 01419 DTSBD373 01420 IF L541-AMT = +0 DTSBD373 01421 NEXT SENTENCE DTSBD373 01422 ELSE DTSBD373 01423 MOVE WRK-ACCT-SUB TO L541-ACCT-SUB DTSBD373 01424 MOVE CACT-CAT-CHARGED TO L541-CAT-IND DTSBD373 01425 PERFORM S541-MODIFY-AMT THRU S541-EXIT DTSBD373 01426 PERFORM S3200-REMOVE-MQTR-TOLERANCE THRU S3200-EXIT DTSBD373 01427 PERFORM S3300-DECR-PAID-WAIVED THRU S3300-EXIT. DTSBD373 01428 P3410-EXIT. DTSBD373 01429 EXIT. DTSBD373 01430 SKIP3 DTSBD373 01431 *P3410-LP-OR-INT. DTSBD373 01432 *****MOVE AADJ-APPLIC-IND TO WRK-ACCT-IND. DTSBD373 01433 DTSBD373 01434 *****PERFORM S3100-LOC-OR-ESTB-ACCT-DATA THRU S3100-EXIT. DTSBD373 01435 DTSBD373 01436 *****IF AADJ-INT-88 DTSBD373 01437 *********COMPUTE L541-AMT DTSBD373 01438 ***********= WRK-INT-CHARGED-AMT DTSBD373 01439 **************- MQTR-CHARGED-AMT (WRK-ACCT-SUB) DTSBD373 01440 *****ELSE DTSBD373 01441 *********COMPUTE L541-AMT DTSBD373 01442 ***********= WRK-LATE-PEN-CHARGED-AMT DTSBD373 01443 **************- MQTR-CHARGED-AMT (WRK-ACCT-SUB). DTSBD373 01444 DTSBD373 01445 *****IF L541-AMT = +0 DTSBD373 01446 *********NEXT SENTENCE DTSBD373 01447 *****ELSE DTSBD373 01448 *********MOVE WRK-ACCT-SUB TO L541-ACCT-SUB DTSBD373 01449 *********MOVE CACT-CAT-CHARGED TO L541-CAT-IND DTSBD373 01450 *********PERFORM S541-MODIFY-AMT THRU S541-EXIT DTSBD373 01451 *********PERFORM S3200-REMOVE-MQTR-TOLERANCE THRU S3200-EXIT DTSBD373 01452 *********PERFORM S3300-DECR-PAID-WAIVED THRU S3300-EXIT. DTSBD373 01453 *P3410-EXIT. DTSBD373 01454 *****EXIT. DTSBD373 01455 SKIP3 DTSBD373 01456 *P3420-LP-AND-INT. DTSBD373 01457 *****MOVE CACT-ACCT-LATE-PEN TO WRK-ACCT-IND. DTSBD373 01458 DTSBD373 01459 *****PERFORM S3100-LOC-OR-ESTB-ACCT-DATA THRU S3100-EXIT. DTSBD373 01460 DTSBD373 01461 *****COMPUTE L541-AMT DTSBD373 01462 *******= WRK-LATE-PEN-CHARGED-AMT DTSBD373 01463 **********- MQTR-CHARGED-AMT (WRK-ACCT-SUB). DTSBD373 01464 DTSBD373 01465 *****IF L541-AMT = +0 DTSBD373 01466 *********NEXT SENTENCE DTSBD373 01467 *****ELSE DTSBD373 01468 *********MOVE WRK-ACCT-SUB TO L541-ACCT-SUB DTSBD373 01469 *********MOVE CACT-CAT-CHARGED TO L541-CAT-IND DTSBD373 01470 *********PERFORM S541-MODIFY-AMT THRU S541-EXIT DTSBD373 01471 *********PERFORM S3200-REMOVE-MQTR-TOLERANCE THRU S3200-EXIT DTSBD373 01472 *********PERFORM S3300-DECR-PAID-WAIVED THRU S3300-EXIT. DTSBD373 01473 DTSBD373 01474 DTSBD373 01475 *****MOVE CACT-ACCT-INT TO WRK-ACCT-IND. DTSBD373 01476 DTSBD373 01477 *****PERFORM S3100-LOC-OR-ESTB-ACCT-DATA THRU S3100-EXIT. DTSBD373 01478 DTSBD373 01479 *****COMPUTE L541-AMT DTSBD373 01480 *******= WRK-INT-CHARGED-AMT DTSBD373 01481 **********- MQTR-CHARGED-AMT (WRK-ACCT-SUB). DTSBD373 01482 DTSBD373 01483 *****IF L541-AMT = +0 DTSBD373 01484 *********NEXT SENTENCE DTSBD373 01485 *****ELSE DTSBD373 01486 *********MOVE WRK-ACCT-SUB TO L541-ACCT-SUB DTSBD373 01487 *********MOVE CACT-CAT-CHARGED TO L541-CAT-IND DTSBD373 01488 *********PERFORM S541-MODIFY-AMT THRU S541-EXIT DTSBD373 01489 *********PERFORM S3200-REMOVE-MQTR-TOLERANCE THRU S3200-EXIT DTSBD373 01490 *********PERFORM S3300-DECR-PAID-WAIVED THRU S3300-EXIT. DTSBD373 01491 *P3420-EXIT. DTSBD373 01492 *****EXIT. DTSBD373 01493 EJECT DTSBD373 01494 P3500-MANUAL-UPDATE. DTSBD373 01495 IF WRK-MQTR-EXISTS-IND = 'N' DTSBD373 01496 PERFORM S9200-INIT-MQTR THRU S9200-EXIT. DTSBD373 01497 DTSBD373 01498 IF AADJ-INT-88 DTSBD373 01499 SET MQTR-INT-CHARGE-MANUAL-88 TO TRUE DTSBD373 01500 ELSE DTSBD373 01501 IF AADJ-LATE-PEN-88 DTSBD373 01502 SET MQTR-PEN-CHARGE-MANUAL-88 TO TRUE DTSBD373 01503 ELSE DTSBD373 01504 SET MQTR-PEN-CHARGE-MANUAL-88 TO TRUE DTSBD373 01505 SET MQTR-INT-CHARGE-MANUAL-88 TO TRUE. DTSBD373 01506 DTSBD373 01507 PERFORM S1200-WRITE-OR-REWRITE-MQTR THRU S1200-EXIT. DTSBD373 01508 P3500-EXIT. DTSBD373 01509 EXIT. DTSBD373 01510 EJECT DTSBD373 01511 P3600-DUE-DATE-UPDATE. DTSBD373 01512 IF WRK-MQTR-EXISTS-IND = 'N' DTSBD373 01513 PERFORM S9200-INIT-MQTR THRU S9200-EXIT. DTSBD373 01514 DTSBD373 01515 DTSBD373 01516 MOVE MQTR-YRQ TO L516-YRQ. DTSBD373 01517 DTSBD373 01518 PERFORM S516-LIABILITY-INFO THRU S516-EXIT. DTSBD373 01519 DTSBD373 01520 IF AADJ-DATE-1 = +0 DTSBD373 01521 NEXT SENTENCE DTSBD373 01522 ELSE DTSBD373 01523 PERFORM P3610-CHANGE-RPT-DUE THRU P3610-EXIT. DTSBD373 01524 DTSBD373 01525 IF AADJ-DATE-2 = +0 DTSBD373 01526 NEXT SENTENCE DTSBD373 01527 ELSE DTSBD373 01528 PERFORM P3620-CHANGE-TAX-DUE THRU P3620-EXIT. DTSBD373 01529 DTSBD373 01530 PERFORM S3900-CRUNCH-ACCT-DATA THRU S3900-EXIT. DTSBD373 01531 DTSBD373 01532 PERFORM S1200-WRITE-OR-REWRITE-MQTR THRU S1200-EXIT. DTSBD373 01533 P3600-EXIT. DTSBD373 01534 EXIT. DTSBD373 01535 SKIP3 DTSBD373 01536 P3610-CHANGE-RPT-DUE. DTSBD373 01537 IF AADJ-DATE-1 = ALL-NINES-DATE DTSBD373 01538 MOVE L516-DEFAULT-RPT-DUE-DATE TO MQTR-RPT-DUE-DATE DTSBD373 01539 SET MQTR-RPT-DUE-DATE-AUTO-88 TO TRUE DTSBD373 01540 ELSE DTSBD373 01541 MOVE AADJ-DATE-1 TO MQTR-RPT-DUE-DATE DTSBD373 01542 SET MQTR-RPT-DUE-DATE-MANUAL-88 TO TRUE. DTSBD373 01543 DTSBD373 01544 PERFORM S2100-SET-CURR-RPT-TYPE THRU S2100-EXIT. DTSBD373 01545 P3610-EXIT. DTSBD373 01546 EXIT. DTSBD373 01547 SKIP3 DTSBD373 01548 P3620-CHANGE-TAX-DUE. DTSBD373 01549 IF AADJ-DATE-2 = ALL-NINES-DATE DTSBD373 01550 MOVE L516-DEFAULT-TAX-DUE-DATE TO MQTR-TAX-DUE-DATE DTSBD373 01551 SET MQTR-TAX-DUE-DATE-AUTO-88 TO TRUE DTSBD373 01552 ELSE DTSBD373 01553 MOVE AADJ-DATE-2 TO MQTR-TAX-DUE-DATE DTSBD373 01554 SET MQTR-TAX-DUE-DATE-MANUAL-88 TO TRUE. DTSBD373 01555 DTSBD373 01556 PERFORM S4000-RECOMPUTE-INT THRU S4000-EXIT. DTSBD373 01557 DTSBD373 01558 IF MQTR-INT-CHARGE-AUTO-88 DTSBD373 01559 PERFORM P3621-CHANGE-INT-CHARGE THRU P3621-EXIT. DTSBD373 01560 DTSBD373 01561 *****IF MQTR-PEN-CHARGE-AUTO-88 DTSBD373 01562 *********PERFORM P3622-CHANGE-PEN-CHARGE THRU P3622-EXIT. DTSBD373 01563 P3620-EXIT. DTSBD373 01564 EXIT. DTSBD373 01565 SKIP3 DTSBD373 01566 P3621-CHANGE-INT-CHARGE. DTSBD373 01567 MOVE CACT-APPLIC-INT TO WRK-ACCT-IND. DTSBD373 01568 DTSBD373 01569 PERFORM S3100-LOC-OR-ESTB-ACCT-DATA THRU S3100-EXIT. DTSBD373 01570 DTSBD373 01571 COMPUTE L541-AMT DTSBD373 01572 = WRK-INT-CHARGED-AMT DTSBD373 01573 - MQTR-CHARGED-AMT (WRK-ACCT-SUB). DTSBD373 01574 DTSBD373 01575 IF L541-AMT = +0 DTSBD373 01576 NEXT SENTENCE DTSBD373 01577 ELSE DTSBD373 01578 MOVE WRK-ACCT-SUB TO L541-ACCT-SUB DTSBD373 01579 MOVE CACT-CAT-CHARGED TO L541-CAT-IND DTSBD373 01580 PERFORM S541-MODIFY-AMT THRU S541-EXIT DTSBD373 01581 PERFORM S3200-REMOVE-MQTR-TOLERANCE THRU S3200-EXIT DTSBD373 01582 PERFORM S3300-DECR-PAID-WAIVED THRU S3300-EXIT. DTSBD373 01583 P3621-EXIT. DTSBD373 01584 EXIT. DTSBD373 01585 SKIP3 DTSBD373 01586 *P3622-CHANGE-PEN-CHARGE. DTSBD373 01587 *****MOVE CACT-APPLIC-PEN TO WRK-ACCT-IND. DTSBD373 01588 DTSBD373 01589 *****PERFORM S3100-LOC-OR-ESTB-ACCT-DATA THRU S3100-EXIT. DTSBD373 01590 DTSBD373 01591 *****COMPUTE L541-AMT DTSBD373 01592 *******= WRK-LATE-PEN-CHARGED-AMT DTSBD373 01593 ***********- MQTR-CHARGED-AMT (WRK-ACCT-SUB). DTSBD373 01594 DTSBD373 01595 *****IF L541-AMT = +0 DTSBD373 01596 *********NEXT SENTENCE DTSBD373 01597 *****ELSE DTSBD373 01598 *********MOVE WRK-ACCT-SUB TO L541-ACCT-SUB DTSBD373 01599 *********MOVE CACT-CAT-CHARGED TO L541-CAT-IND DTSBD373 01600 *********PERFORM S541-MODIFY-AMT THRU S541-EXIT DTSBD373 01601 *********PERFORM S3200-REMOVE-MQTR-TOLERANCE THRU S3200-EXIT DTSBD373 01602 *********PERFORM S3300-DECR-PAID-WAIVED THRU S3300-EXIT. DTSBD373 01603 *P3622-EXIT. DTSBD373 01604 *****EXIT. DTSBD373 01605 EJECT DTSBD373 01606 P3700-WAIVE-DATE-UPDATE. DTSBD373 01607 IF WRK-MQTR-EXISTS-IND = 'N' DTSBD373 01608 PERFORM S9200-INIT-MQTR THRU S9200-EXIT. DTSBD373 01609 DTSBD373 01610 IF AADJ-INT-88 DTSBD373 01611 PERFORM P3710-WAIVE-INT-SPAN THRU P3710-EXIT DTSBD373 01612 ELSE DTSBD373 01613 IF AADJ-LATE-PEN-88 DTSBD373 01614 PERFORM P3720-WAIVE-PEN-SPAN THRU P3720-EXIT DTSBD373 01615 ELSE DTSBD373 01616 PERFORM P3710-WAIVE-INT-SPAN THRU P3710-EXIT DTSBD373 01617 PERFORM P3720-WAIVE-PEN-SPAN THRU P3720-EXIT. DTSBD373 01618 DTSBD373 01619 PERFORM S1200-WRITE-OR-REWRITE-MQTR THRU S1200-EXIT. DTSBD373 01620 P3700-EXIT. DTSBD373 01621 EXIT. DTSBD373 01622 SKIP3 DTSBD373 01623 P3710-WAIVE-INT-SPAN. DTSBD373 01624 IF AADJ-DATE-1 = ALL-NINES-DATE DTSBD373 01625 MOVE +0 TO MQTR-WAIVE-INT-START-DATE DTSBD373 01626 MQTR-WAIVE-INT-END-DATE DTSBD373 01627 ELSE DTSBD373 01628 MOVE AADJ-DATE-1 TO MQTR-WAIVE-INT-START-DATE DTSBD373 01629 MOVE AADJ-DATE-2 TO MQTR-WAIVE-INT-END-DATE. DTSBD373 01630 P3710-EXIT. DTSBD373 01631 EXIT. DTSBD373 01632 SKIP3 DTSBD373 01633 P3720-WAIVE-PEN-SPAN. DTSBD373 01634 IF AADJ-DATE-2 = ALL-NINES-DATE DTSBD373 01635 MOVE +0 TO MQTR-WAIVE-PEN-START-DATE DTSBD373 01636 MQTR-WAIVE-PEN-END-DATE DTSBD373 01637 ELSE DTSBD373 01638 MOVE AADJ-DATE-1 TO MQTR-WAIVE-PEN-START-DATE DTSBD373 01639 MOVE AADJ-DATE-2 TO MQTR-WAIVE-PEN-END-DATE. DTSBD373 01640 P3720-EXIT. DTSBD373 01641 EXIT. DTSBD373 01642 EJECT DTSBD373 01643 P3800-INT-DATE-UPDATE. DTSBD373 01644 IF WRK-MQTR-EXISTS-IND = 'N' DTSBD373 01645 PERFORM S9200-INIT-MQTR THRU S9200-EXIT. DTSBD373 01646 DTSBD373 01647 IF AADJ-INT-SPAN-IND = '1' DTSBD373 01648 PERFORM P3810-INT-SPAN-ONE THRU P3810-EXIT DTSBD373 01649 ELSE DTSBD373 01650 PERFORM P3820-INT-SPAN-TWO THRU P3820-EXIT. DTSBD373 01651 DTSBD373 01652 IF MQTR-INT-CHARGE-MANUAL-88 DTSBD373 01653 GO TO P3800-EXIT. DTSBD373 01654 DTSBD373 01655 PERFORM S4000-RECOMPUTE-INT THRU S4000-EXIT. DTSBD373 01656 DTSBD373 01657 MOVE CACT-ACCT-INT TO WRK-ACCT-IND. DTSBD373 01658 DTSBD373 01659 PERFORM S3100-LOC-OR-ESTB-ACCT-DATA THRU S3100-EXIT. DTSBD373 01660 DTSBD373 01661 COMPUTE L541-AMT DTSBD373 01662 = WRK-INT-CHARGED-AMT DTSBD373 01663 - MQTR-CHARGED-AMT (WRK-ACCT-SUB). DTSBD373 01664 DTSBD373 01665 IF L541-AMT = +0 DTSBD373 01666 NEXT SENTENCE DTSBD373 01667 ELSE DTSBD373 01668 MOVE WRK-ACCT-SUB TO L541-ACCT-SUB DTSBD373 01669 MOVE CACT-CAT-CHARGED TO L541-CAT-IND DTSBD373 01670 PERFORM S541-MODIFY-AMT THRU S541-EXIT DTSBD373 01671 PERFORM S3200-REMOVE-MQTR-TOLERANCE THRU S3200-EXIT DTSBD373 01672 PERFORM S3300-DECR-PAID-WAIVED THRU S3300-EXIT. DTSBD373 01673 DTSBD373 01674 PERFORM S3900-CRUNCH-ACCT-DATA THRU S3900-EXIT. DTSBD373 01675 DTSBD373 01676 PERFORM S1200-WRITE-OR-REWRITE-MQTR THRU S1200-EXIT. DTSBD373 01677 P3800-EXIT. DTSBD373 01678 EXIT. DTSBD373 01679 SKIP3 DTSBD373 01680 P3810-INT-SPAN-ONE. DTSBD373 01681 IF AADJ-DATE-1 = ALL-NINES-DATE DTSBD373 01682 MOVE +0 TO MQTR-INT-START-DATE (1) DTSBD373 01683 MQTR-INT-END-DATE (1) DTSBD373 01684 MQTR-INT-RATE (1) DTSBD373 01685 IF MQTR-INT-CNT = +1 DTSBD373 01686 MOVE +0 TO MQTR-INT-CNT DTSBD373 01687 ELSE DTSBD373 01688 NEXT SENTENCE DTSBD373 01689 ELSE DTSBD373 01690 MOVE AADJ-DATE-1 TO MQTR-INT-START-DATE (1) DTSBD373 01691 MOVE AADJ-DATE-2 TO MQTR-INT-END-DATE (1) DTSBD373 01692 MOVE AADJ-INT-RATE TO MQTR-INT-RATE (1) DTSBD373 01693 IF MQTR-INT-CNT = +0 DTSBD373 01694 MOVE +1 TO MQTR-INT-CNT DTSBD373 01695 ELSE DTSBD373 01696 NEXT SENTENCE. DTSBD373 01697 P3810-EXIT. DTSBD373 01698 EXIT. DTSBD373 01699 SKIP3 DTSBD373 01700 P3820-INT-SPAN-TWO. DTSBD373 01701 IF AADJ-DATE-1 = ALL-NINES-DATE DTSBD373 01702 MOVE +0 TO MQTR-INT-START-DATE (2) DTSBD373 01703 MQTR-INT-END-DATE (2) DTSBD373 01704 MQTR-INT-RATE (2) DTSBD373 01705 IF MQTR-INT-CNT = +1 OR +2 DTSBD373 01706 IF MQTR-INT-START-DATE (+1) = +0 DTSBD373 01707 MOVE +0 TO MQTR-INT-CNT DTSBD373 01708 ELSE DTSBD373 01709 MOVE +1 TO MQTR-INT-CNT DTSBD373 01710 ELSE DTSBD373 01711 NEXT SENTENCE DTSBD373 01712 ELSE DTSBD373 01713 MOVE AADJ-DATE-1 TO MQTR-INT-START-DATE (2) DTSBD373 01714 MOVE AADJ-DATE-2 TO MQTR-INT-END-DATE (2) DTSBD373 01715 MOVE AADJ-INT-RATE TO MQTR-INT-RATE (2) DTSBD373 01716 IF MQTR-INT-CNT = +0 DTSBD373 01717 MOVE +0 TO MQTR-INT-START-DATE (+1) DTSBD373 01718 MQTR-INT-END-DATE (+1) DTSBD373 01719 MQTR-INT-RATE (+1) DTSBD373 01720 MOVE +2 TO MQTR-INT-CNT DTSBD373 01721 ELSE DTSBD373 01722 MOVE +2 TO MQTR-INT-CNT. DTSBD373 01723 P3820-EXIT. DTSBD373 01724 EXIT. DTSBD373 01725 EJECT DTSBD373 01726 P4100-WRITE-OFF-UPDATE. DTSBD373 01727 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBD373 01728 DTSBD373 01729 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBD373 01730 DTSBD373 01731 SET MSKL-QTR-88 TO TRUE. DTSBD373 01732 DTSBD373 01733 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD373 01734 DTSBD373 01735 PERFORM UNTIL L910-NO-REC-88 DTSBD373 01736 MOVE MSKL-REC TO MQTR-REC DTSBD373 01737 PERFORM P4110-PROCESS-MQTR THRU P4110-EXIT DTSBD373 01738 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBD373 01739 END-PERFORM. DTSBD373 01740 DTSBD373 01741 PERFORM S530-WRITE-OFF THRU S530-EXIT. DTSBD373 01742 P4100-EXIT. DTSBD373 01743 EXIT. DTSBD373 01744 SKIP3 DTSBD373 01745 P4110-PROCESS-MQTR. DTSBD373 01746 IF MQTR-INT-CHARGE-MANUAL-88 DTSBD373 01747 *****AND MQTR-PEN-CHARGE-MANUAL-88 DTSBD373 01748 GO TO P4110-EXIT. DTSBD373 01749 DTSBD373 01750 DTSBD373 01751 MOVE +0 TO WRK-BALANCE-AMT DTSBD373 01752 L101-PAID-CHNG. DTSBD373 01753 ****************L101-PEN-CHARGED-AMT. DTSBD373 01754 DTSBD373 01755 **************************************************** DTSBD373 01756 * FOR QTRS >= THE QTR RETURNED FROM DTSBU109, DTSBD373 01757 * INCLUDE ADMIN ASSESS IN THE PENALTY AND INTEREST DTSBD373 01758 * CALCULATION, ALONG WITH UI TAX. DTSBD373 01759 * FOR EARLIER QUARTERS, INCLUDE ONLY UI TAX. DTSBD373 01760 **************************************************** DTSBD373 01761 PERFORM DTSBD373 01762 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBD373 01763 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSBD373 01764 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBD373 01765 TO WRK-BALANCE-AMT DTSBD373 01766 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSBD373 01767 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBD373 01768 TO L101-PAID-CHNG DTSBD373 01769 *************ELSE DTSBD373 01770 *****************IF MQTR-ACCT-PEN-88 (MQTR-ACCT-IDX) DTSBD373 01771 *********************ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSBD373 01772 ***********************TO L101-PEN-CHARGED-AMT DTSBD373 01773 *****************END-IF DTSBD373 01774 END-IF DTSBD373 01775 *RW1 DTSBD373 01776 IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) DTSBD373 01777 IF MQTR-YRQ >= WRK-FIRST-PEN-INT-YRQ DTSBD373 01778 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBD373 01779 TO L101-PAID-CHNG DTSBD373 01780 DISPLAY 'BD373 P4110 SUR BAL ' DTSBD373 01781 MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBD373 01782 END-IF DTSBD373 01783 END-IF DTSBD373 01784 *RW2 DTSBD373 01785 END-PERFORM. DTSBD373 01786 DTSBD373 01787 IF WRK-BALANCE-AMT > +0 DTSBD373 01788 NEXT SENTENCE DTSBD373 01789 ELSE DTSBD373 01790 GO TO P4110-EXIT. DTSBD373 01791 DTSBD373 01792 MOVE AADJ-DATE-1 TO L101-RECEIVED-DATE. DTSBD373 01793 DTSBD373 01794 SET L101-WAIVE-INT-NO-88 TO TRUE. DTSBD373 01795 DTSBD373 01796 *****SET L101-WAIVE-PEN-NO-88 TO TRUE. DTSBD373 01797 DTSBD373 01798 MOVE MQTR-TAX-DUE-DATE TO L101-TAX-DUE-DATE. DTSBD373 01799 DTSBD373 01800 MOVE MQTR-INT-AREA TO L101-INT-AREA. DTSBD373 01801 DTSBD373 01802 PERFORM S101-PER-MONTH-NO THRU S101-EXIT. DTSBD373 01803 DTSBD373 01804 IF MQTR-INT-CHARGE-AUTO-88 DTSBD373 01805 PERFORM P4111-CHANGE-INT THRU P4111-EXIT. DTSBD373 01806 DTSBD373 01807 IF MQTR-PEN-CHARGE-AUTO-88 DTSBD373 01808 *********PERFORM P4112-CHANGE-PEN THRU P4112-EXIT DTSBD373 01809 SET MQTR-PEN-CHARGE-MANUAL-88 TO TRUE. DTSBD373 01810 DTSBD373 01811 PERFORM S3900-CRUNCH-ACCT-DATA THRU S3900-EXIT. DTSBD373 01812 DTSBD373 01813 PERFORM S1200-WRITE-OR-REWRITE-MQTR THRU S1200-EXIT. DTSBD373 01814 P4110-EXIT. DTSBD373 01815 EXIT. DTSBD373 01816 SKIP3 DTSBD373 01817 P4111-CHANGE-INT. DTSBD373 01818 SET MQTR-INT-CHARGE-MANUAL-88 TO TRUE. DTSBD373 01819 DTSBD373 01820 MOVE +0 TO WRK-ACCT-SUB. DTSBD373 01821 DTSBD373 01822 IF L101-INT-CHARGE-CHNG NOT = +0 DTSBD373 01823 MOVE CACT-ACCT-INT TO WRK-ACCT-IND DTSBD373 01824 PERFORM S3100-LOC-OR-ESTB-ACCT-DATA THRU S3100-EXIT DTSBD373 01825 MOVE L101-INT-CHARGE-CHNG TO L541-AMT DTSBD373 01826 MOVE WRK-ACCT-SUB TO L541-ACCT-SUB DTSBD373 01827 MOVE CACT-CAT-CHARGED TO L541-CAT-IND DTSBD373 01828 PERFORM S541-MODIFY-AMT THRU S541-EXIT. DTSBD373 01829 DTSBD373 01830 IF L101-INT-WAIVE-CHNG NOT = +0 DTSBD373 01831 MOVE CACT-ACCT-INT TO WRK-ACCT-IND DTSBD373 01832 PERFORM S3100-LOC-OR-ESTB-ACCT-DATA THRU S3100-EXIT DTSBD373 01833 MOVE L101-INT-WAIVE-CHNG TO L541-AMT DTSBD373 01834 MOVE WRK-ACCT-SUB TO L541-ACCT-SUB DTSBD373 01835 MOVE CACT-CAT-WAIVED TO L541-CAT-IND DTSBD373 01836 PERFORM S541-MODIFY-AMT THRU S541-EXIT. DTSBD373 01837 DTSBD373 01838 IF WRK-ACCT-SUB > +0 DTSBD373 01839 IF MQTR-BALANCE-AMT (WRK-ACCT-SUB) < +0 DTSBD373 01840 PERFORM S3200-REMOVE-MQTR-TOLERANCE THRU S3200-EXIT DTSBD373 01841 PERFORM S3300-DECR-PAID-WAIVED THRU S3300-EXIT. DTSBD373 01842 P4111-EXIT. DTSBD373 01843 EXIT. DTSBD373 01844 SKIP3 DTSBD373 01845 *P4112-CHANGE-PEN. DTSBD373 01846 DTSBD373 01847 *****SET MQTR-PEN-CHARGE-MANUAL-88 TO TRUE. DTSBD373 01848 DTSBD373 01849 *****MOVE +0 TO WRK-ACCT-SUB. DTSBD373 01850 DTSBD373 01851 *****IF L101-PEN-CHARGE-CHNG NOT = +0 DTSBD373 01852 *********MOVE CACT-ACCT-PEN TO WRK-ACCT-IND DTSBD373 01853 *********PERFORM S3100-LOC-OR-ESTB-ACCT-DATA THRU S3100-EXIT DTSBD373 01854 *********MOVE L101-PEN-CHARGE-CHNG TO L541-AMT DTSBD373 01855 *********MOVE WRK-ACCT-SUB TO L541-ACCT-SUB DTSBD373 01856 *********MOVE CACT-CAT-CHARGED TO L541-CAT-IND DTSBD373 01857 *********PERFORM S541-MODIFY-AMT THRU S541-EXIT. DTSBD373 01858 DTSBD373 01859 *****IF L101-PEN-WAIVE-CHNG NOT = +0 DTSBD373 01860 *********MOVE CACT-ACCT-PEN TO WRK-ACCT-IND DTSBD373 01861 *********PERFORM S3100-LOC-OR-ESTB-ACCT-DATA THRU S3100-EXIT DTSBD373 01862 *********MOVE L101-PEN-WAIVE-CHNG TO L541-AMT DTSBD373 01863 *********MOVE WRK-ACCT-SUB TO L541-ACCT-SUB DTSBD373 01864 *********MOVE CACT-CAT-WAIVED TO L541-CAT-IND DTSBD373 01865 *********PERFORM S541-MODIFY-AMT THRU S541-EXIT. DTSBD373 01866 DTSBD373 01867 *****IF WRK-ACCT-SUB > +0 DTSBD373 01868 *********IF MQTR-BALANCE-AMT (WRK-ACCT-SUB) < +0 DTSBD373 01869 *************PERFORM S3200-REMOVE-MQTR-TOLERANCE THRU S3200-EXIT DTSBD373 01870 *************PERFORM S3300-DECR-PAID-WAIVED THRU S3300-EXIT. DTSBD373 01871 *P4112-EXIT. DTSBD373 01872 *****EXIT. DTSBD373 01873 EJECT DTSBD373 01874 P4200-WRITE-OFF-REV-UPDATE. DTSBD373 01875 PERFORM S530-WRITE-OFF-REV THRU S530-EXIT. DTSBD373 01876 P4200-EXIT. DTSBD373 01877 EXIT. DTSBD373 01878 EJECT DTSBD373 01879 P4300-WAGE-RPT-UPDATE. DTSBD373 01880 IF WRK-MQTR-EXISTS-IND = 'N' DTSBD373 01881 PERFORM S9200-INIT-MQTR THRU S9200-EXIT. DTSBD373 01882 DTSBD373 01883 * IF MQTR-WAGE-RPT-NO-88 DTSBD373 01884 * SET MQTR-WAGE-RPT-YES-88 TO TRUE DTSBD373 01885 * ELSE DTSBD373 01886 * MOVE MQTR-YRQ TO L004-QTR-5-9 DTSBD373 01887 * PERFORM S004-FROM-5 THRU S004-EXIT DTSBD373 01888 * MOVE L004-SLASH-QTR TO EVL1-SLASH-QTR DTSBD373 01889 * MOVE EVL1-TEXT TO EVL-TEXT DTSBD373 01890 * PERFORM S5000-WRITE-MEVL THRU S5000-EXIT DTSBD373 01891 * SET MQTR-WAGE-RPT-NO-88 TO TRUE. DTSBD373 01892 DTSBD373 01893 PERFORM S1200-WRITE-OR-REWRITE-MQTR THRU S1200-EXIT. DTSBD373 01894 P4300-EXIT. DTSBD373 01895 EXIT. DTSBD373 01896 EJECT DTSBD373 01897 S1100-READ-AADJ-APPLIC-YRQ. DTSBD373 01898 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBD373 01899 DTSBD373 01900 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBD373 01901 DTSBD373 01902 SET MQTR-QTR-88 TO TRUE. DTSBD373 01903 DTSBD373 01904 MOVE AADJ-APPLIC-YRQ TO MQTR-YRQ. DTSBD373 01905 DTSBD373 01906 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBD373 01907 DTSBD373 01908 PERFORM S910-READ THRU S910-EXIT. DTSBD373 01909 DTSBD373 01910 MOVE MSKL-REC TO MQTR-REC. DTSBD373 01911 DTSBD373 01912 IF L910-OK-88 DTSBD373 01913 MOVE 'Y' TO WRK-MQTR-EXISTS-IND DTSBD373 01914 ELSE DTSBD373 01915 MOVE 'N' TO WRK-MQTR-EXISTS-IND. DTSBD373 01916 S1100-EXIT. DTSBD373 01917 EXIT. DTSBD373 01918 EJECT DTSBD373 01919 S1200-WRITE-OR-REWRITE-MQTR. DTSBD373 01920 MOVE +0 TO WRK-BALANCE-AMT. DTSBD373 01921 DTSBD373 01922 PERFORM S1210-ACCT-SCAN THRU S1210-EXIT DTSBD373 01923 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBD373 01924 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT. DTSBD373 01925 DTSBD373 01926 IF (WRK-BALANCE-AMT = +0) DTSBD373 01927 OR DTSBD373 01928 (WRK-BALANCE-AMT > LBCM-QTR-TOL-MAX) DTSBD373 01929 NEXT SENTENCE DTSBD373 01930 ELSE DTSBD373 01931 MOVE MQTR-YRQ TO L590-YRQ DTSBD373 01932 PERFORM S590-QTR-TOL THRU S590-EXIT. DTSBD373 01933 DTSBD373 01934 DTSBD373 01935 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBD373 01936 DTSBD373 01937 PERFORM S910-READ THRU S910-EXIT. DTSBD373 01938 DTSBD373 01939 MOVE LBCM-CURR-RUN-DATE TO MQTR-CHNG-DATE. DTSBD373 01940 DTSBD373 01941 MOVE MQTR-REC TO MSKL-REC. DTSBD373 01942 DTSBD373 01943 IF L910-OK-88 DTSBD373 01944 PERFORM S910-REWRITE THRU S910-EXIT DTSBD373 01945 ELSE DTSBD373 01946 PERFORM S910-WRITE THRU S910-EXIT. DTSBD373 01947 S1200-EXIT. DTSBD373 01948 EXIT. DTSBD373 01949 SKIP3 DTSBD373 01950 S1210-ACCT-SCAN. DTSBD373 01951 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBD373 01952 TO WRK-BALANCE-AMT. DTSBD373 01953 S1210-EXIT. DTSBD373 01954 EXIT. DTSBD373 01955 EJECT DTSBD373 01956 S1300-READ-AADJ-APPLIC-MDST. DTSBD373 01957 MOVE LOW-VALUES TO MDST-KEY-AREA. DTSBD373 01958 DTSBD373 01959 MOVE MPRF-EMP-NO TO MDST-EMP-NO. DTSBD373 01960 DTSBD373 01961 SET MDST-DST-88 TO TRUE. DTSBD373 01962 DTSBD373 01963 SET MDST-CREDIT-REC-88 TO TRUE. DTSBD373 01964 DTSBD373 01965 MOVE AADJ-APPLIC-DOC-NO TO MDST-DOC-NO. DTSBD373 01966 DTSBD373 01967 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSBD373 01968 DTSBD373 01969 PERFORM S910-READ THRU S910-EXIT. DTSBD373 01970 DTSBD373 01971 MOVE MSKL-REC TO MDST-REC. DTSBD373 01972 DTSBD373 01973 IF L910-OK-88 DTSBD373 01974 MOVE 'Y' TO WRK-MDST-EXISTS-IND DTSBD373 01975 ELSE DTSBD373 01976 MOVE 'N' TO WRK-MDST-EXISTS-IND. DTSBD373 01977 S1300-EXIT. DTSBD373 01978 EXIT. DTSBD373 01979 EJECT DTSBD373 01980 S1400-WRITE-OR-REWRITE-MDST. DTSBD373 01981 *****PERFORM S1410-ACCT-SCAN THRU S1410-EXIT DTSBD373 01982 ******** VARYING MDST-ACCT-IDX FROM 1 BY 1 DTSBD373 01983 *********UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT. DTSBD373 01984 DTSBD373 01985 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSBD373 01986 DTSBD373 01987 PERFORM S910-READ THRU S910-EXIT. DTSBD373 01988 DTSBD373 01989 MOVE LBCM-CURR-RUN-DATE TO MDST-CHNG-DATE. DTSBD373 01990 DTSBD373 01991 MOVE MDST-REC TO MSKL-REC. DTSBD373 01992 DTSBD373 01993 IF L910-OK-88 DTSBD373 01994 IF MDST-ACCT-CNT = +0 DTSBD373 01995 PERFORM S910-DELETE THRU S910-EXIT DTSBD373 01996 ELSE DTSBD373 01997 PERFORM S910-REWRITE THRU S910-EXIT DTSBD373 01998 ELSE DTSBD373 01999 IF MDST-ACCT-CNT = +0 DTSBD373 02000 NEXT SENTENCE DTSBD373 02001 ELSE DTSBD373 02002 PERFORM S910-WRITE THRU S910-EXIT. DTSBD373 02003 S1400-EXIT. DTSBD373 02004 EXIT. DTSBD373 02005 SKIP3 DTSBD373 02006 *S1410-ACCT-SCAN. DTSBD373 02007 *****IF MDST-ACCT-CR-AVAIL-88 (MDST-ACCT-IDX) DTSBD373 02008 *********IF (MDST-AMT (MDST-ACCT-IDX) = +0) DTSBD373 02009 ****************OR DTSBD373 02010 ************(MDST-AMT (MDST-ACCT-IDX) > LBCM-CR-TOL-MAX) DTSBD373 02011 *************NEXT SENTENCE DTSBD373 02012 *********ELSE DTSBD373 02013 *************MOVE MDST-DOC-NO TO L590-PAY-DOC-NO DTSBD373 02014 *************PERFORM S590-CR-TOL THRU S590-EXIT. DTSBD373 02015 *S1410-EXIT. DTSBD373 02016 *****EXIT. DTSBD373 02017 EJECT DTSBD373 02018 S2100-SET-CURR-RPT-TYPE. DTSBD373 02019 *& DTSBD373 02020 DISPLAY 'BD373 S2100 ' MPRF-EMP-NO DTSBD373 02021 ' RPT TYPE ' MQTR-CURR-RPT-TYPE DTSBD373 02022 ' RPT DUE ' MQTR-RPT-DUE-DATE DTSBD373 02023 ' WRK DUE ' WRK-RPT-DUE-DATE DTSBD373 02024 DISPLAY ' DEL DATE ' WRK-DELINQUENT-YRQ DTSBD373 02025 ' RUN DATE ' LBCM-CURR-RUN-DATE. DTSBD373 02026 *& DTSBD373 02027 IF MQTR-CURR-NOT-DUE-88 OR MQTR-CURR-DELINQ-88 DTSBD373 02028 NEXT SENTENCE DTSBD373 02029 ELSE DTSBD373 02030 GO TO S2100-EXIT. DTSBD373 02031 DTSBD373 02032 DTSBD373 02033 IF MQTR-YRQ = LBCM-PICKUP-YRQ DTSBD373 02034 SET MQTR-CURR-PICKUP-88 TO TRUE DTSBD373 02035 GO TO S2100-EXIT. DTSBD373 02036 DTSBD373 02037 DTSBD373 02038 PERFORM S2110-DECR-PURSUED-RPT-CNT THRU S2110-EXIT. DTSBD373 02039 DTSBD373 02040 IF MQTR-RPT-DUE-DATE = WRK-RPT-DUE-DATE DTSBD373 02041 IF MQTR-YRQ > WRK-DELINQUENT-YRQ DTSBD373 02042 SET MQTR-CURR-NOT-DUE-88 TO TRUE DTSBD373 02043 ELSE DTSBD373 02044 SET MQTR-CURR-DELINQ-88 TO TRUE DTSBD373 02045 ELSE DTSBD373 02046 IF MQTR-RPT-DUE-DATE > LBCM-CURR-RUN-DATE DTSBD373 02047 SET MQTR-CURR-NOT-DUE-88 TO TRUE DTSBD373 02048 MOVE MQTR-RPT-DUE-DATE TO WRK-TRIGGER-DATE DTSBD373 02049 PERFORM S2120-GENERATE-LTE-TCK THRU S2120-EXIT DTSBD373 02050 ELSE DTSBD373 02051 SET MQTR-CURR-DELINQ-88 TO TRUE. DTSBD373 02052 DTSBD373 02053 MOVE MQTR-PURSUED-RPT-IND TO WRK-PURSUED-RPT-IND. DTSBD373 02054 DTSBD373 02055 PERFORM S2130-SET-PURSUED-RPT-IND THRU S2130-EXIT. DTSBD373 02056 DTSBD373 02057 PERFORM S2140-INCR-PURSUED-RPT-CNT THRU S2140-EXIT. DTSBD373 02058 S2100-EXIT. DTSBD373 02059 EXIT. DTSBD373 02060 SKIP3 DTSBD373 02061 S2110-DECR-PURSUED-RPT-CNT. DTSBD373 02062 IF MQTR-RPT-IS-PURSUED-88 DTSBD373 02063 IF WRK-ANNUAL-SCHED-YES-88 DTSBD373 02064 MOVE MQTR-YRQ TO L004-QTR-5-9 DTSBD373 02065 IF L004-QTR-5-YR = WRK-CURR-ANN-YR DTSBD373 02066 NEXT SENTENCE DTSBD373 02067 ELSE DTSBD373 02068 SUBTRACT 1 FROM MPRF-PURSUED-RPT-CNT DTSBD373 02069 END-IF DTSBD373 02070 ELSE DTSBD373 02071 SUBTRACT 1 FROM MPRF-PURSUED-RPT-CNT DTSBD373 02072 END-IF DTSBD373 02073 END-IF. DTSBD373 02074 DTSBD373 02075 S2110-EXIT. DTSBD373 02076 EXIT. DTSBD373 02077 SKIP3 DTSBD373 02078 S2120-GENERATE-LTE-TCK. DTSBD373 02079 MOVE LOW-VALUES TO MTCK-REC. DTSBD373 02080 DTSBD373 02081 MOVE MPRF-EMP-NO TO MTCK-EMP-NO. DTSBD373 02082 DTSBD373 02083 SET MTCK-TCK-88 TO TRUE. DTSBD373 02084 DTSBD373 02085 ADD +1 TO LBCM-EMP-ABSTIME. DTSBD373 02086 DTSBD373 02087 MOVE LBCM-EMP-ABSTIME TO MTCK-ESTB-ABSTIME. DTSBD373 02088 DTSBD373 02089 MOVE +0 TO MTCK-PURGE-DATE DTSBD373 02090 MTCK-TEXT-CNT. DTSBD373 02091 DTSBD373 02092 SET MTCK-TYPE-CHK-LATE-88 TO TRUE. DTSBD373 02093 DTSBD373 02094 MOVE WRK-TRIGGER-DATE TO MTCK-TRIGGER-DATE. DTSBD373 02095 DTSBD373 02096 MOVE +0 TO MTCK-ACKNOWLEDGED-DATE. DTSBD373 02097 DTSBD373 02098 SET MTCK-SOURCE-SYSTEM-88 TO TRUE. DTSBD373 02099 DTSBD373 02100 SET MTCK-DEST-SYSTEM-88 TO TRUE. DTSBD373 02101 DTSBD373 02102 MOVE MQTR-YRQ TO MTCK-LTE-YRQ. DTSBD373 02103 DTSBD373 02104 SET MTCK-NOT-CONVERTED-88 TO TRUE. DTSBD373 02105 DTSBD373 02106 MOVE LBCM-CURR-RUN-DATE TO MTCK-ESTB-DATE DTSBD373 02107 MTCK-CHNG-DATE. DTSBD373 02108 DTSBD373 02109 MOVE MTCK-REC TO MSKL-REC. DTSBD373 02110 DTSBD373 02111 PERFORM S910-WRITE THRU S910-EXIT. DTSBD373 02112 S2120-EXIT. DTSBD373 02113 EXIT. DTSBD373 02114 SKIP3 DTSBD373 02115 S2130-SET-PURSUED-RPT-IND. DTSBD373 02116 IF (MPRF-NOT-WRITTEN-OFF-88) DTSBD373 02117 AND DTSBD373 02118 (MQTR-CURR-DELINQ-88 OR MQTR-CURR-ESTIM-88) DTSBD373 02119 AND DTSBD373 02120 (MQTR-YRQ NOT < LBCM-FIRST-PURSUED-RPT-YRQ) DTSBD373 02121 SET MQTR-RPT-IS-PURSUED-88 TO TRUE DTSBD373 02122 ELSE DTSBD373 02123 SET MQTR-RPT-NOT-PURSUED-88 TO TRUE. DTSBD373 02124 DTSBD373 02125 IF WRK-PURSUED-RPT-IND = 'N' DTSBD373 02126 IF MQTR-RPT-IS-PURSUED-88 DTSBD373 02127 PERFORM S590-QTR-PURSUED THRU S590-EXIT. DTSBD373 02128 S2130-EXIT. DTSBD373 02129 EXIT. DTSBD373 02130 SKIP3 DTSBD373 02131 S2140-INCR-PURSUED-RPT-CNT. DTSBD373 02132 IF MQTR-RPT-IS-PURSUED-88 DTSBD373 02133 IF WRK-ANNUAL-SCHED-YES-88 DTSBD373 02134 MOVE MQTR-YRQ TO L004-QTR-5-9 DTSBD373 02135 IF L004-QTR-5-YR = WRK-CURR-ANN-YR DTSBD373 02136 NEXT SENTENCE DTSBD373 02137 ELSE DTSBD373 02138 MOVE MQTR-YRQ TO WRK-CURR-ANN-YRQ DTSBD373 02139 ADD 1 TO MPRF-PURSUED-RPT-CNT DTSBD373 02140 END-IF DTSBD373 02141 ELSE DTSBD373 02142 ADD 1 TO MPRF-PURSUED-RPT-CNT DTSBD373 02143 END-IF DTSBD373 02144 END-IF. DTSBD373 02145 DTSBD373 02146 S2140-EXIT. DTSBD373 02147 EXIT. DTSBD373 02148 EJECT DTSBD373 02149 S3100-LOC-OR-ESTB-ACCT-DATA. DTSBD373 02150 MOVE +0 TO WRK-ACCT-SUB. DTSBD373 02151 DTSBD373 02152 PERFORM DTSBD373 02153 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBD373 02154 UNTIL (MQTR-ACCT-IDX > MQTR-ACCT-CNT) DTSBD373 02155 OR DTSBD373 02156 (WRK-ACCT-SUB NOT = +0) DTSBD373 02157 IF WRK-ACCT-IND = MQTR-ACCT-IND (MQTR-ACCT-IDX) DTSBD373 02158 SET WRK-ACCT-SUB TO MQTR-ACCT-IDX DTSBD373 02159 END-IF DTSBD373 02160 END-PERFORM. DTSBD373 02161 DTSBD373 02162 IF WRK-ACCT-SUB NOT = +0 DTSBD373 02163 GO TO S3100-EXIT. DTSBD373 02164 DTSBD373 02165 IF MQTR-ACCT-CNT NOT < MMAX-QTR-ACCT-MAX DTSBD373 02166 PERFORM S999-ABEND THRU S999-EXIT. DTSBD373 02167 DTSBD373 02168 ADD +1 TO MQTR-ACCT-CNT. DTSBD373 02169 DTSBD373 02170 MOVE WRK-ACCT-IND TO MQTR-ACCT-IND (MQTR-ACCT-CNT). DTSBD373 02171 DTSBD373 02172 MOVE +0 TO MQTR-CHARGED-AMT (MQTR-ACCT-CNT) DTSBD373 02173 MQTR-PAID-AMT (MQTR-ACCT-CNT) DTSBD373 02174 MQTR-WAIVED-AMT (MQTR-ACCT-CNT) DTSBD373 02175 MQTR-WRITTEN-OFF-AMT (MQTR-ACCT-CNT) DTSBD373 02176 MQTR-TOLER-AMT (MQTR-ACCT-CNT) DTSBD373 02177 MQTR-BALANCE-AMT (MQTR-ACCT-CNT). DTSBD373 02178 DTSBD373 02179 MOVE MQTR-ACCT-CNT TO WRK-ACCT-SUB. DTSBD373 02180 S3100-EXIT. DTSBD373 02181 EXIT. DTSBD373 02182 EJECT DTSBD373 02183 S3200-REMOVE-MQTR-TOLERANCE. DTSBD373 02184 COMPUTE L541-AMT = MQTR-TOLER-AMT (WRK-ACCT-SUB) * -1. DTSBD373 02185 DTSBD373 02186 MOVE WRK-ACCT-SUB TO L541-ACCT-SUB. DTSBD373 02187 DTSBD373 02188 MOVE CACT-CAT-TOLER TO L541-CAT-IND. DTSBD373 02189 DTSBD373 02190 PERFORM S541-MODIFY-AMT THRU S541-EXIT. DTSBD373 02191 S3200-EXIT. DTSBD373 02192 EXIT. DTSBD373 02193 EJECT DTSBD373 02194 S3300-DECR-PAID-WAIVED. DTSBD373 02195 MOVE +0 TO L522-AMT. DTSBD373 02196 DTSBD373 02197 IF MQTR-BALANCE-AMT (WRK-ACCT-SUB) < +0 DTSBD373 02198 COMPUTE L522-AMT = MQTR-PAID-AMT (WRK-ACCT-SUB) * -1 DTSBD373 02199 IF L522-AMT < MQTR-BALANCE-AMT (WRK-ACCT-SUB) DTSBD373 02200 MOVE MQTR-BALANCE-AMT (WRK-ACCT-SUB) TO L522-AMT. DTSBD373 02201 DTSBD373 02202 IF L522-AMT NOT = +0 DTSBD373 02203 MOVE WRK-ACCT-SUB TO L522-ACCT-SUB DTSBD373 02204 COMPUTE L522-AMT = L522-AMT * -1 DTSBD373 02205 PERFORM S522-REVERSE-PAID THRU S522-EXIT. DTSBD373 02206 DTSBD373 02207 DTSBD373 02208 MOVE +0 TO L541-AMT. DTSBD373 02209 DTSBD373 02210 IF MQTR-BALANCE-AMT (WRK-ACCT-SUB) < +0 DTSBD373 02211 COMPUTE L541-AMT = MQTR-WAIVED-AMT (WRK-ACCT-SUB) * -1 DTSBD373 02212 IF L541-AMT < MQTR-BALANCE-AMT (WRK-ACCT-SUB) DTSBD373 02213 MOVE MQTR-BALANCE-AMT (WRK-ACCT-SUB) DTSBD373 02214 TO L541-AMT. DTSBD373 02215 DTSBD373 02216 IF L541-AMT NOT = +0 DTSBD373 02217 MOVE WRK-ACCT-SUB TO L541-ACCT-SUB DTSBD373 02218 MOVE CACT-CAT-WAIVED TO L541-CAT-IND DTSBD373 02219 PERFORM S541-MODIFY-AMT THRU S541-EXIT. DTSBD373 02220 DTSBD373 02221 IF MQTR-BALANCE-AMT (WRK-ACCT-SUB) < +0 DTSBD373 02222 PERFORM S999-ABEND THRU S999-EXIT. DTSBD373 02223 S3300-EXIT. DTSBD373 02224 EXIT. DTSBD373 02225 EJECT DTSBD373 02226 S3900-CRUNCH-ACCT-DATA. DTSBD373 02227 MOVE 'N' TO ACCT-CRUNCH-COMPLETE-IND. DTSBD373 02228 DTSBD373 02229 MOVE +1 TO ACCT-SUB. DTSBD373 02230 DTSBD373 02231 PERFORM S3910-CRUNCH-LOOP THRU S3910-EXIT DTSBD373 02232 UNTIL ACCT-CRUNCH-COMPLETE-IND = 'Y'. DTSBD373 02233 S3900-EXIT. DTSBD373 02234 EXIT. DTSBD373 02235 SKIP3 DTSBD373 02236 S3910-CRUNCH-LOOP. DTSBD373 02237 IF ACCT-SUB > MQTR-ACCT-CNT DTSBD373 02238 MOVE 'Y' TO ACCT-CRUNCH-COMPLETE-IND DTSBD373 02239 ELSE DTSBD373 02240 IF (MQTR-CHARGED-AMT (ACCT-SUB) = 0) DTSBD373 02241 AND DTSBD373 02242 (MQTR-PAID-AMT (ACCT-SUB) = 0) DTSBD373 02243 AND DTSBD373 02244 (MQTR-WAIVED-AMT (ACCT-SUB) = 0) DTSBD373 02245 AND DTSBD373 02246 (MQTR-WRITTEN-OFF-AMT (ACCT-SUB) = 0) DTSBD373 02247 AND DTSBD373 02248 (MQTR-TOLER-AMT (ACCT-SUB) = 0) DTSBD373 02249 AND DTSBD373 02250 (MQTR-BALANCE-AMT (ACCT-SUB) = 0) DTSBD373 02251 PERFORM S3911-SHUFFLE THRU S3911-EXIT DTSBD373 02252 VARYING ACCT-SUB1 FROM ACCT-SUB BY 1 DTSBD373 02253 UNTIL ACCT-SUB1 NOT < MQTR-ACCT-CNT DTSBD373 02254 SUBTRACT 1 FROM MQTR-ACCT-CNT DTSBD373 02255 ELSE DTSBD373 02256 ADD +1 TO ACCT-SUB. DTSBD373 02257 S3910-EXIT. DTSBD373 02258 EXIT. DTSBD373 02259 SKIP3 DTSBD373 02260 S3911-SHUFFLE. DTSBD373 02261 COMPUTE ACCT-SUB2 = ACCT-SUB1 + 1. DTSBD373 02262 DTSBD373 02263 MOVE MQTR-ACCT-GROUP (ACCT-SUB2) DTSBD373 02264 TO MQTR-ACCT-GROUP (ACCT-SUB1). DTSBD373 02265 S3911-EXIT. DTSBD373 02266 EXIT. DTSBD373 02267 EJECT DTSBD373 02268 S4000-RECOMPUTE-INT. DTSBD373 02269 SET L101-WAIVE-INT-NO-88 TO TRUE. DTSBD373 02270 DTSBD373 02271 *****SET L101-WAIVE-PEN-NO-88 TO TRUE. DTSBD373 02272 DTSBD373 02273 MOVE MQTR-TAX-DUE-DATE TO L101-TAX-DUE-DATE. DTSBD373 02274 DTSBD373 02275 *****MOVE +0 TO L101-PEN-CHARGED-AMT. DTSBD373 02276 DTSBD373 02277 MOVE MQTR-INT-AREA TO L101-INT-AREA. DTSBD373 02278 DTSBD373 02279 *****MOVE +0 TO L101-SUBJ10-AMT DTSBD373 02280 ****************L101-SUBJ15-AMT. DTSBD373 02281 DTSBD373 02282 *****MOVE +0 TO WRK-LATE-PEN-CHARGED-AMT DTSBD373 02283 DTSBD373 02284 MOVE +0 TO WRK-INT-CHARGED-AMT. DTSBD373 02285 DTSBD373 02286 DTSBD373 02287 MOVE LOW-VALUES TO MDST-KEY-AREA. DTSBD373 02288 DTSBD373 02289 MOVE MPRF-EMP-NO TO MDST-EMP-NO. DTSBD373 02290 DTSBD373 02291 SET MDST-DST-88 TO TRUE. DTSBD373 02292 DTSBD373 02293 MOVE MQTR-YRQ TO MDST-YRQ. DTSBD373 02294 DTSBD373 02295 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSBD373 02296 DTSBD373 02297 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD373 02298 DTSBD373 02299 PERFORM S4100-SCAN-MDST THRU S4100-EXIT DTSBD373 02300 UNTIL L910-NO-REC-88. DTSBD373 02301 DTSBD373 02302 *****MOVE L101-SUBJ10-AMT TO MQTR-TAX-PAID-SUBJ10-AMT. DTSBD373 02303 DTSBD373 02304 *****MOVE L101-SUBJ15-AMT TO MQTR-TAX-PAID-SUBJ15-AMT. DTSBD373 02305 S4000-EXIT. DTSBD373 02306 EXIT. DTSBD373 02307 SKIP3 DTSBD373 02308 S4100-SCAN-MDST. DTSBD373 02309 MOVE MSKL-REC TO MDST-REC. DTSBD373 02310 DTSBD373 02311 IF MDST-YRQ = MQTR-YRQ DTSBD373 02312 NEXT SENTENCE DTSBD373 02313 ELSE DTSBD373 02314 SET L910-NO-REC-88 TO TRUE DTSBD373 02315 GO TO S4100-EXIT. DTSBD373 02316 DTSBD373 02317 PERFORM S4110-SCAN-ACCT THRU S4110-EXIT DTSBD373 02318 VARYING MDST-ACCT-IDX FROM 1 BY 1 DTSBD373 02319 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT. DTSBD373 02320 DTSBD373 02321 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBD373 02322 S4100-EXIT. DTSBD373 02323 EXIT. DTSBD373 02324 SKIP3 DTSBD373 02325 S4110-SCAN-ACCT. DTSBD373 02326 **************************************************** DTSBD373 02327 * PRIOR TO 2008/1, UI TAX ONLY IS SUBJECT TO PENALTY. DTSBD373 02328 * FOR 2008/1 AND FOLLOWING, ADMIN ASSESS IS ALSO INCLUDED. DTSBD373 02329 **************************************************** DTSBD373 02330 IF (MDST-ACCT-UI-88 (MDST-ACCT-IDX) DTSBD373 02331 OR (MQTR-ACCT-SUR-88 (WRK-ACCT-SUB) DTSBD373 02332 AND MQTR-YRQ >= WRK-FIRST-PEN-INT-YRQ)) DTSBD373 02333 NEXT SENTENCE DTSBD373 02334 ELSE DTSBD373 02335 GO TO S4110-EXIT. DTSBD373 02336 DTSBD373 02337 MOVE MDST-AMT (MDST-ACCT-IDX) TO L101-PAID-CHNG. DTSBD373 02338 DTSBD373 02339 MOVE MDST-RECEIVED-DATE TO L101-RECEIVED-DATE. DTSBD373 02340 DTSBD373 02341 PERFORM S101-PER-MONTH-NO THRU S101-EXIT. DTSBD373 02342 DTSBD373 02343 ADD L101-INT-CHARGE-CHNG TO WRK-INT-CHARGED-AMT. DTSBD373 02344 DTSBD373 02345 *****ADD L101-PEN-CHARGE-CHNG TO WRK-LATE-PEN-CHARGED-AMT DTSBD373 02346 *********************************L101-PEN-CHARGED-AMT. DTSBD373 02347 DTSBD373 02348 *****ADD L101-SUBJ10-CHNG TO L101-SUBJ10-AMT. DTSBD373 02349 DTSBD373 02350 *****ADD L101-SUBJ15-CHNG TO L101-SUBJ15-AMT. DTSBD373 02351 S4110-EXIT. DTSBD373 02352 EXIT. DTSBD373 02353 EJECT DTSBD373 02354 S5000-WRITE-MEVL. DTSBD373 02355 ADD +1000 TO LBCM-EMP-ABSTIME. DTSBD373 02356 DTSBD373 02357 MOVE LBCM-EMP-ABSTIME TO L005-ABSTIME. DTSBD373 02358 DTSBD373 02359 PERFORM S005-FROM-ABSTIME THRU S005-EXIT. DTSBD373 02360 DTSBD373 02361 DTSBD373 02362 MOVE LOW-VALUES TO MEVL-REC. DTSBD373 02363 DTSBD373 02364 MOVE MPRF-EMP-NO TO MEVL-EMP-NO. DTSBD373 02365 DTSBD373 02366 SET MEVL-EVL-88 TO TRUE. DTSBD373 02367 DTSBD373 02368 MOVE L005-DATE TO MEVL-DATE. DTSBD373 02369 DTSBD373 02370 MOVE L005-TIME TO MEVL-TIME. DTSBD373 02371 DTSBD373 02372 DTSBD373 02373 MOVE ZEROS TO MEVL-PURGE-DATE. DTSBD373 02374 DTSBD373 02375 DTSBD373 02376 MOVE EVL-TEXT TO MEVL-TEXT. DTSBD373 02377 DTSBD373 02378 SET MEVL-SOURCE-SYSTEM-88 TO TRUE. DTSBD373 02379 DTSBD373 02380 SET MEVL-NOT-CONVERTED-88 TO TRUE. DTSBD373 02381 DTSBD373 02382 MOVE LBCM-CURR-RUN-DATE TO MEVL-ESTB-DATE DTSBD373 02383 MEVL-CHNG-DATE. DTSBD373 02384 DTSBD373 02385 DTSBD373 02386 MOVE MEVL-REC TO MSKL-REC. DTSBD373 02387 DTSBD373 02388 PERFORM S910-WRITE THRU S910-EXIT. DTSBD373 02389 S5000-EXIT. DTSBD373 02390 EXIT. DTSBD373 02391 EJECT DTSBD373 02392 S9100-ESTB-MADJ. DTSBD373 02393 MOVE LOW-VALUES TO MADJ-REC. DTSBD373 02394 DTSBD373 02395 MOVE MPRF-EMP-NO TO MADJ-EMP-NO. DTSBD373 02396 DTSBD373 02397 SET MADJ-ADJ-88 TO TRUE. DTSBD373 02398 DTSBD373 02399 MOVE AADJ-DOC-NO TO MADJ-DOC-NO. DTSBD373 02400 DTSBD373 02401 MOVE +0 TO MADJ-PURGE-DATE. DTSBD373 02402 DTSBD373 02403 MOVE AADJ-ADJ-TYPE TO MADJ-ADJ-TYPE. DTSBD373 02404 DTSBD373 02405 MOVE AADJ-AMT TO MADJ-AMT. DTSBD373 02406 DTSBD373 02407 MOVE AADJ-RECEIVED-DATE TO MADJ-RECEIVED-DATE. DTSBD373 02408 DTSBD373 02409 MOVE AADJ-DEPOSIT-DATE TO MADJ-DEPOSIT-DATE. DTSBD373 02410 DTSBD373 02411 MOVE AADJ-APPLIC-YRQ TO MADJ-APPLIC-YRQ. DTSBD373 02412 DTSBD373 02413 MOVE AADJ-APPLIC-IND TO MADJ-APPLIC-IND. DTSBD373 02414 DTSBD373 02415 MOVE AADJ-APPLIC-DOC-NO TO MADJ-APPLIC-DOC-NO. DTSBD373 02416 DTSBD373 02417 MOVE AADJ-DATE-1 TO MADJ-DATE-1. DTSBD373 02418 DTSBD373 02419 MOVE AADJ-DATE-2 TO MADJ-DATE-2. DTSBD373 02420 DTSBD373 02421 MOVE AADJ-INT-SPAN-IND TO MADJ-INT-SPAN-IND. DTSBD373 02422 DTSBD373 02423 MOVE AADJ-INT-RATE TO MADJ-INT-RATE. DTSBD373 02424 DTSBD373 02425 MOVE AADJ-RESPONSIBLE-ACTIVITY TO MADJ-RESPONSIBLE-ACTIVITY. DTSBD373 02426 DTSBD373 02427 MOVE AADJ-RESPONSIBLE-OP-ID TO MADJ-RESPONSIBLE-OP-ID. DTSBD373 02428 DTSBD373 02429 MOVE AADJ-CMP-ESTB-ABSTIME TO MADJ-CMP-ESTB-ABSTIME. DTSBD373 02430 DTSBD373 02431 SET MADJ-NOT-CONVERTED-88 TO TRUE. DTSBD373 02432 DTSBD373 02433 MOVE LBCM-CURR-RUN-DATE TO MADJ-ESTB-DATE DTSBD373 02434 MADJ-CHNG-DATE. DTSBD373 02435 DTSBD373 02436 MOVE MADJ-REC TO MSKL-REC. DTSBD373 02437 DTSBD373 02438 PERFORM S910-WRITE THRU S910-EXIT. DTSBD373 02439 S9100-EXIT. DTSBD373 02440 EXIT. DTSBD373 02441 EJECT DTSBD373 02442 S9200-INIT-MQTR. DTSBD373 02443 PERFORM S511-MQTR-INIT THRU S511-EXIT. DTSBD373 02444 DTSBD373 02445 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBD373 02446 DTSBD373 02447 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBD373 02448 DTSBD373 02449 SET MQTR-QTR-88 TO TRUE. DTSBD373 02450 DTSBD373 02451 MOVE AADJ-APPLIC-YRQ TO MQTR-YRQ. DTSBD373 02452 DTSBD373 02453 SET MQTR-NOT-CONVERTED-88 TO TRUE. DTSBD373 02454 DTSBD373 02455 MOVE LBCM-CURR-RUN-DATE TO MQTR-ESTB-DATE DTSBD373 02456 MQTR-CHNG-DATE. DTSBD373 02457 DTSBD373 02458 MOVE MQTR-YRQ TO L516-YRQ. DTSBD373 02459 DTSBD373 02460 PERFORM S516-LIABILITY-INFO THRU S516-EXIT. DTSBD373 02461 DTSBD373 02462 IF L516-LIABLE-88 DTSBD373 02463 SET MQTR-CURR-NOT-DUE-88 TO TRUE DTSBD373 02464 ELSE DTSBD373 02465 SET MQTR-CURR-NOT-LIABLE-88 TO TRUE. DTSBD373 02466 DTSBD373 02467 IF MQTR-YRQ > WRK-DELINQUENT-YRQ DTSBD373 02468 SET MQTR-MISS-NOT-YET-RUN-88 TO TRUE DTSBD373 02469 ELSE DTSBD373 02470 SET MQTR-MISS-NOT-LIABLE-88 TO TRUE. DTSBD373 02471 DTSBD373 02472 MOVE L516-UI-RATE TO MQTR-UI-RATE. DTSBD373 02473 DTSBD373 02474 MOVE L516-DEFAULT-TAX-DUE-DATE TO MQTR-TAX-DUE-DATE. DTSBD373 02475 DTSBD373 02476 MOVE L516-DEFAULT-RPT-DUE-DATE TO MQTR-RPT-DUE-DATE. DTSBD373 02477 DTSBD373 02478 PERFORM S2100-SET-CURR-RPT-TYPE THRU S2100-EXIT. DTSBD373 02479 DTSBD373 02480 DTSBD373 02481 IF MQTR-YRQ = LBCM-PICKUP-YRQ DTSBD373 02482 SET MQTR-CURR-PICKUP-88 TO TRUE DTSBD373 02483 SET MQTR-MISS-NOT-LIABLE-88 TO TRUE DTSBD373 02484 SET MQTR-NO-UI-RATE-88 TO TRUE DTSBD373 02485 SET MQTR-INT-CHARGE-MANUAL-88 TO TRUE DTSBD373 02486 SET MQTR-PEN-CHARGE-MANUAL-88 TO TRUE. DTSBD373 02487 S9200-EXIT. DTSBD373 02488 EXIT. DTSBD373 02489 EJECT DTSBD373 02490 S001-FROM-FED-8. DTSBD373 02491 SET L001-FROM-FED-8 TO TRUE. DTSBD373 02492 GO TO S001-DATE. DTSBD373 02493 DTSBD373 02494 S001-FROM-ABS-DAY. DTSBD373 02495 SET L001-FROM-ABS-DAY TO TRUE. DTSBD373 02496 GO TO S001-DATE. DTSBD373 02497 DTSBD373 02498 S001-DATE. DTSBD373 02499 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBD373 02500 S001-EXIT. DTSBD373 02501 EXIT. DTSBD373 02502 SKIP3 DTSBD373 02503 S004-FROM-5. DTSBD373 02504 SET L004-FROM-5 TO TRUE. DTSBD373 02505 GO TO S004-QTR. DTSBD373 02506 DTSBD373 02507 S004-QTR. DTSBD373 02508 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBD373 02509 S004-EXIT. DTSBD373 02510 EXIT. DTSBD373 02511 SKIP3 DTSBD373 02512 S005-FROM-ABSTIME. DTSBD373 02513 SET L005-FROM-ABSTIME TO TRUE. DTSBD373 02514 GO TO S005-ABSTIME. DTSBD373 02515 DTSBD373 02516 S005-ABSTIME. DTSBD373 02517 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBD373 02518 S005-EXIT. DTSBD373 02519 EXIT. DTSBD373 02520 SKIP3 DTSBD373 02521 S101-PER-MONTH-NO. DTSBD373 02522 SET L101-PER-MONTH-NO-88 TO TRUE. DTSBD373 02523 GO TO S101-CALC-INT. DTSBD373 02524 DTSBD373 02525 S101-CALC-INT. DTSBD373 02526 CALL 'DTSBU101' USING L101-LINK-AREA. DTSBD373 02527 S101-EXIT. DTSBD373 02528 EXIT. DTSBD373 02529 SKIP3 DTSBD373 02530 S109-FIRST-PEN-INT-YRQ. DTSBD373 02531 SET L109-CMND-PEN-INT-QTR-88 TO TRUE. DTSBD373 02532 GO TO S109-SUR-RATE. DTSBD373 02533 DTSBD373 02534 S109-LOOKUP-SUR-RATE. DTSBD373 02535 MOVE MPRF-EMP-CLASS TO L109-EMP-CLASS. DTSBD373 02536 MOVE MQTR-YRQ TO L109-YRQ. DTSBD373 02537 GO TO S109-SUR-RATE. DTSBD373 02538 DTSBD373 02539 S109-SUR-RATE. DTSBD373 02540 CALL 'DTSBU109' USING L109-LINK-AREA. DTSBD373 02541 S109-EXIT. DTSBD373 02542 EXIT. DTSBD373 02543 SKIP3 DTSBD373 02544 S415-ANNUAL-DATES. DTSBD373 02545 CALL 'DTSBU415' USING L415-LINK-AREA. DTSBD373 02546 S415-EXIT. DTSBD373 02547 EXIT. DTSBD373 02548 DTSBD373 02549 S511-MQTR-INIT. DTSBD373 02550 CALL 'DTSBU511' USING MQTR-REC. DTSBD373 02551 S511-EXIT. DTSBD373 02552 EXIT. DTSBD373 02553 SKIP3 DTSBD373 02554 S516-LIABILITY-INFO. DTSBD373 02555 CALL 'DTSBU516' USING L516-LINK-AREA DTSBD373 02556 MPRF-REC. DTSBD373 02557 S516-EXIT. DTSBD373 02558 EXIT. DTSBD373 02559 SKIP3 DTSBD373 02560 S520-APPLY-CREDIT. DTSBD373 02561 CALL 'DTSBU520' USING L520-LINK-AREA DTSBD373 02562 LBCM-LINK-AREA DTSBD373 02563 MPRF-REC. DTSBD373 02564 S520-EXIT. DTSBD373 02565 EXIT. DTSBD373 02566 SKIP3 DTSBD373 02567 S522-REVERSE-PAID. DTSBD373 02568 CALL 'DTSBU522' USING L522-LINK-AREA DTSBD373 02569 LBCM-LINK-AREA DTSBD373 02570 MPRF-REC DTSBD373 02571 MQTR-REC. DTSBD373 02572 S522-EXIT. DTSBD373 02573 EXIT. DTSBD373 02574 SKIP3 DTSBD373 02575 S530-WRITE-OFF. DTSBD373 02576 SET L530-WRITE-OFF-88 TO TRUE. DTSBD373 02577 MOVE LBCM-CURR-RUN-DATE TO L530-WRITE-OFF-DATE. DTSBD373 02578 GO TO S530-WRITE-OFF-WRITE-OFF-REV. DTSBD373 02579 DTSBD373 02580 S530-WRITE-OFF-REV. DTSBD373 02581 SET L530-REVERSE-WRITE-OFF-88 TO TRUE. DTSBD373 02582 MOVE LBCM-CURR-RUN-DATE TO L530-WRITE-OFF-DATE. DTSBD373 02583 GO TO S530-WRITE-OFF-WRITE-OFF-REV. DTSBD373 02584 DTSBD373 02585 S530-WRITE-OFF-WRITE-OFF-REV. DTSBD373 02586 CALL 'DTSBU530' USING L530-LINK-AREA DTSBD373 02587 LBCM-LINK-AREA DTSBD373 02588 MPRF-REC. DTSBD373 02589 S530-EXIT. DTSBD373 02590 EXIT. DTSBD373 02591 SKIP3 DTSBD373 02592 S541-MODIFY-AMT. DTSBD373 02593 MOVE AADJ-DOC-NO TO L541-TRN-DOC-NO. DTSBD373 02594 DTSBD373 02595 CALL 'DTSBU541' USING L541-LINK-AREA DTSBD373 02596 MPRF-REC DTSBD373 02597 MQTR-REC. DTSBD373 02598 S541-EXIT. DTSBD373 02599 EXIT. DTSBD373 02600 SKIP3 DTSBD373 02601 S542-MDST-MAINTENANCE. DTSBD373 02602 MOVE 'DTSBD373' TO L542-CALLED-BY. DTSBD373 02603 MOVE AADJ-DOC-NO TO L542-TRN-DOC-NO. DTSBD373 02604 DTSBD373 02605 CALL 'DTSBU542' USING L542-LINK-AREA DTSBD373 02606 MPRF-REC DTSBD373 02607 MDST-REC. DTSBD373 02608 S542-EXIT. DTSBD373 02609 EXIT. DTSBD373 02610 SKIP3 DTSBD373 02611 S590-QTR-TOL. DTSBD373 02612 SET L590-QTR-TOL-88 TO TRUE. DTSBD373 02613 MOVE AADJ-DOC-NO TO L590-TOL-DOC-NO. DTSBD373 02614 MOVE WRK-NULL-DOC-NO TO L590-PAY-DOC-NO. DTSBD373 02615 GO TO S590-EMP-CLEANUP. DTSBD373 02616 DTSBD373 02617 *S590-CR-TOL. DTSBD373 02618 *****SET L590-CR-TOL-88 TO TRUE. DTSBD373 02619 *****MOVE AADJ-DOC-NO TO L590-TOL-DOC-NO. DTSBD373 02620 *****MOVE +0 TO L590-YRQ. DTSBD373 02621 *****GO TO S590-EMP-CLEANUP. DTSBD373 02622 DTSBD373 02623 S590-QTR-PURSUED. DTSBD373 02624 SET L590-QTR-PURSUED-88 TO TRUE. DTSBD373 02625 MOVE MQTR-YRQ TO L590-YRQ. DTSBD373 02626 MOVE WRK-NULL-DOC-NO TO L590-PAY-DOC-NO DTSBD373 02627 L590-TOL-DOC-NO. DTSBD373 02628 GO TO S590-EMP-CLEANUP. DTSBD373 02629 DTSBD373 02630 S590-EMP-CLEANUP. DTSBD373 02631 CALL 'DTSBU590' USING L590-LINK-AREA DTSBD373 02632 LBCM-LINK-AREA DTSBD373 02633 MPRF-REC. DTSBD373 02634 S590-EXIT. DTSBD373 02635 EXIT. DTSBD373 02636 SKIP3 DTSBD373 02637 S910-READ. DTSBD373 02638 SET L910-READ-88 TO TRUE. DTSBD373 02639 GO TO S910-MSTR-IO. DTSBD373 02640 DTSBD373 02641 S910-START-BROWSE. DTSBD373 02642 SET L910-START-BROWSE-88 TO TRUE. DTSBD373 02643 GO TO S910-MSTR-IO. DTSBD373 02644 DTSBD373 02645 S910-READ-NEXT. DTSBD373 02646 SET L910-READ-NEXT-88 TO TRUE. DTSBD373 02647 GO TO S910-MSTR-IO. DTSBD373 02648 DTSBD373 02649 *S910-COUNT. DTSBD373 02650 *****SET L910-COUNT-88 TO TRUE. DTSBD373 02651 *****GO TO S910-MSTR-IO. DTSBD373 02652 DTSBD373 02653 S910-WRITE. DTSBD373 02654 SET LBCM-EMP-UPDATE-YES-88 TO TRUE. DTSBD373 02655 SET L910-WRITE-88 TO TRUE. DTSBD373 02656 GO TO S910-MSTR-IO. DTSBD373 02657 DTSBD373 02658 S910-REWRITE. DTSBD373 02659 SET LBCM-EMP-UPDATE-YES-88 TO TRUE. DTSBD373 02660 SET L910-REWRITE-88 TO TRUE. DTSBD373 02661 GO TO S910-MSTR-IO. DTSBD373 02662 DTSBD373 02663 S910-DELETE. DTSBD373 02664 SET LBCM-EMP-UPDATE-YES-88 TO TRUE. DTSBD373 02665 SET L910-DELETE-88 TO TRUE. DTSBD373 02666 GO TO S910-MSTR-IO. DTSBD373 02667 DTSBD373 02668 S910-MSTR-IO. DTSBD373 02669 CALL 'DTSBU910' USING L910-LINK-AREA DTSBD373 02670 MSKL-REC. DTSBD373 02671 S910-EXIT. DTSBD373 02672 EXIT. DTSBD373 02673 SKIP3 DTSBD373 02674 S946-R907-WRITE. DTSBD373 02675 CALL 'DTSBU946' USING R907-REC. DTSBD373 02676 S946-EXIT. DTSBD373 02677 EXIT. DTSBD373 02678 SKIP3 DTSBD373 02679 S999-ABEND. DTSBD373 02680 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBD373 02681 S999-EXIT. DTSBD373 02682 EXIT. DTSBD373