00001 IDENTIFICATION DIVISION. 07/11/16 00002 PROGRAM-ID. DTSBD327. DTSBD327 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV018 00004 DATE-WRITTEN. AUGUST 1994. DTSBD327 00005 MODIFIED BY TRW JAN. 1999 DTSBD327 00006 DATE-COMPILED. DTSBD327 00007 SKIP3 DTSBD327 00008 ***** DTSBD327 00009 * DTSBD327 00010 * CALLING SEQUENCE: DTSBD320 CALLS DTSBD327 00011 * DTSBD327 WHICH CREATES DTSIR415 RECORDS DTSBD327 00012 * DTSBD327 WHICH CREATES DTSIR416 RECORDS DTSBD327 00013 * DTSBD800 CALLS DTSBD327 00014 * DTSBR415 WHICH READS DTSIR415 RECORDS DTSBD327 00015 * DTSBR416 WHICH READS DTSIR416 RECORDS DTSBD327 00016 * DTSBD327 00017 * FUNCTION: DEBIT STATEMENT EXTRACT (OVERNIGHT). DTSBD327 00018 * DTSBD327 00019 * MODIFICATION LOG: DTSBD327 00020 * DTSBD327 00021 * 09/05/2005 NEW PROGRAM COPIED FROM DTSBE414. PROGRAM WILL DTSBD327 00022 * READ T011 RECORDS FOR STATEMENT OF ACCOUNTS AND DTSBD327 00023 * FROMAT DTSIR415 RECORD TYPES TO PRINT OVERNIGHT DTSBD327 00024 * STATEMENTS OF ACCOUNTS. DTSBD327 00025 * WORK ORDER: SPEC076 PROGRAMMER: ZL1 DTSBD327 00026 * DTSBD327 00027 * 09/26/2005 REMOVED EDIT ON T011-OPID WHICH REQUIRED THAT IT DTSBD327 00028 * BE A VALID USER FOUND IN THE DTSFOPR FILE. DTSBD327 00029 * WORK ORDER: CREDIT/DEBIT PROGRAMMER: GD DTSBD327 00030 * DTSBD327 00031 * 10/26/2005 MODIFIED MEVL WRITE - ADDED T011-RESP-OPID AS DTSBD327 00032 * MEVL-SOURCE INSTEAD OF 'SYSTEM'. DTSBD327 00033 * WORK ORDER: CREDIT/DEBIT PROGRAMMER: GD DTSBD327 00034 * DTSBD327 00035 * 10/22/2007 MODIFIED PROGRAM NOT TO COMPUTE INTREST ON DTSBD327 00036 * ADMIN ASSESSMENT OWED. DTSBD327 00037 * WORK ORDER: SUR TAX PROGRAMMER: ZL1 DTSBD327 00038 * DTSBD327 00039 * 01/31/2008 MODIFIED ADMINISTRATIVE ASSESSMENT PROCESS DTSBD327 00040 * TO INCLUDE PENALTY AND INTEREST CALCULATION DTSBD327 00041 * STARTING WITH 2008/1. DTSBD327 00042 * REFERENCE: ADMIN ASSESS PROGRAMMER: RW1 DTSBD327 00043 * DTSBD327 00044 * 10/31/2008 MODIFIED ADMINISTRATIVE ASSESSMENT PROCESS: DTSBD327 00045 * INCLUDE IN INTEREST CALCULATION ONLY FOR DTSBD327 00046 * RATED EMPLOYERS. DTSBD327 00047 * RATED EMPLOYERS. DTSBD327 00048 * REFERENCE: DIR119 PROGRAMMER: GD DTSBD327 00049 * DTSBD327 00050 * XX/XX/XXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD327 00051 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD327 00052 * WORK ORDER: PROGRAMMER: XXX DTSBD327 00053 * DTSBD327 00054 * DTSBD327 00055 * DESCRIPTION: DTSBD327 00056 * DTSBD327 00057 * DTSBD327 00058 * INITIATION: DTSBD327 00059 * DTSBD327 00060 * SET LECM-MST-OPEN-UPDATE-88 TO TRUE. DTSBD327 00061 * SET LECM-REF-OPEN-READ-88 TO TRUE. DTSBD327 00062 * DTSBD327 00063 * NO PARAMETERS ARE INPUT. DTSBD327 00064 * DTSBD327 00065 * DTSBD327 00066 * PROCESSING: DTSBD327 00067 * DTSBD327 00068 * SEE PRINTED OUTPUTS DESCRIPTION AND LAYOUTS (414R1 AND DTSBD327 00069 * R416R1). DTSBD327 00070 * DTSBD327 00071 * IF A DEBIT STATEMENT IS NOT GENERATED BECAUSE ALL DTSBD327 00072 * OCCURRENCES OF MTAD-DEBIT-MEMO-IND INDICATE DTSBD327 00073 * MTAD-NO-DEBIT-MEMO-88, THEN WRITE A R907 RECORD, DTSBD327 00074 * REPORTING THE SITUATION. DTSBD327 00075 * DTSBD327 00076 * DTSBD327 00077 * TERMINATION: DTSBD327 00078 * DTSBD327 00079 * NONE. DTSBD327 00080 * DTSBD327 00081 * DTSBD327 00082 * RECORDS READ: DTSBD327 00083 * DTSBD327 00084 * MASTER: DTSBD327 00085 * DTSBD327 00086 * MQTR DTSBD327 00087 * MAPL DTSBD327 00088 * MCOL DTSBD327 00089 * MTAD DTSBD327 00090 * MTAA DTSBD327 00091 * MOPO DTSBD327 00092 * DTSBD327 00093 * DTSBD327 00094 * ALTERNATE INDEX: DTSBD327 00095 * DTSBD327 00096 * NONE. DTSBD327 00097 * DTSBD327 00098 * DTSBD327 00099 * REFERENCE: DTSBD327 00100 * DTSBD327 00101 * NONE. DTSBD327 00102 * DTSBD327 00103 * DTSBD327 00104 * RECORDS UPDATED: DTSBD327 00105 * DTSBD327 00106 * MCOL (REWRITE). DTSBD327 00107 * MEVL (WRITE). DTSBD327 00108 * DTSBD327 00109 * DTSBD327 00110 * REPORT RECORDS WRITTEN: DTSBD327 00111 * DTSBD327 00112 * R415 STATEMENT OF ACCOUNT (DEBITS OVERNIGHT). DTSBD327 00113 * R416 STATEMENT OF ACCOUNT (DEBITS) CONTROL REPORT. DTSBD327 00114 * R907 UNUSUAL CONDITIONS ENCOUNTERED REPORT RECORD. DTSBD327 00115 * DTSBD327 00116 * DTSBD327 00117 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBD327 00118 * DTSBD327 00119 * NONE. DTSBD327 00120 * DTSBD327 00121 * DTSBD327 00122 * MODULES CALLED: DTSBD327 00123 * DTSBD327 00124 * DTSBU001 DATE EDIT/CONVERSION. DTSBD327 00125 * DTSBU005 ABSOLUTE TIME CONVERSION/EDIT. DTSBD327 00126 * DTSBU082 OP ID VERIFY/DESCRIPTION. DTSBD327 00127 * DTSBU101 PENALTY AND INTEREST COMPUTATION. DTSBD327 00128 * DTSBU112 ADDRESS FORMAT. DTSBD327 00129 * DTSBU910 MASTER FILE I/O DRIVER. DTSBD327 00130 * DTSBU946 VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1. DTSBD327 00131 * DTSBD327 00132 * DTSBD327 00133 * VERMONT REFERENCE: DTSBD327 00134 * DTSBD327 00135 * TXBE311 DTSBD327 00136 * DTSBD327 00137 ***** DTSBD327 00138 SKIP3 DTSBD327 00139 ENVIRONMENT DIVISION. DTSBD327 00140 EJECT DTSBD327 00141 DATA DIVISION. DTSBD327 00142 SKIP3 DTSBD327 00143 WORKING-STORAGE SECTION. DTSBD327 001435 77 PAN-VALET PICTURE X(24) VALUE '018DTSBD327 07/11/16'. DTSBD327 00144 SKIP3 DTSBD327 00145 01 WRK-AREA. DTSBD327 00146 *& DTSBD327 00147 05 WRK-BYPASS-CNT PIC 9(07) VALUE ZERO. DTSBD327 00148 05 WRK-ASSESS-CNT PIC 9(07) VALUE ZERO. DTSBD327 00149 *& DTSBD327 00150 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +327.DTSBD327 00151 SKIP1 DTSBD327 00152 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBD327'.DTSBD327 00153 SKIP3 DTSBD327 00154 05 ABEND-MSG PIC X(60). DTSBD327 00155 SKIP3 DTSBD327 00156 05 WRK-PARM-INT-COMP-DATE PIC S9(09) COMP-3. DTSBD327 00157 SKIP1 DTSBD327 00158 05 WRK-PARM-REIMB-CUTOFF-DATE PIC S9(09) COMP-3. DTSBD327 00159 SKIP1 DTSBD327 00160 05 WRK-PARM-RESP-OP-ID PIC X(08). DTSBD327 00161 SKIP3 DTSBD327 00162 05 WRK-STMT-DATE PIC S9(09) COMP-3. DTSBD327 00163 SKIP1 DTSBD327 00164 05 WRK-LAST-ACCT-UPDATE-DATE PIC S9(09) COMP-3. DTSBD327 00165 SKIP1 DTSBD327 00166 05 WRK-FIRST-PEN-INT-YRQ PIC S9(05) COMP-3. DTSBD327 00167 SKIP1 DTSBD327 00168 05 WRK-BNK-PETITION-DATE PIC 9(08). DTSBD327 00169 05 FILLER REDEFINES WRK-BNK-PETITION-DATE. DTSBD327 00170 10 WRK-BNK-PETITION-DATE-YYYY PIC 9(04). DTSBD327 00171 10 WRK-BNK-PETITION-DATE-MM PIC 9(02). DTSBD327 00172 10 WRK-BNK-PETITION-DATE-DD PIC 9(02). DTSBD327 00173 05 WRK-BNK-PETITION-YRQ PIC 9(05). DTSBD327 00174 05 FILLER REDEFINES WRK-BNK-PETITION-YRQ. DTSBD327 00175 10 WRK-BNK-PETITION-YRQ-YYYY PIC 9(04). DTSBD327 00176 10 WRK-BNK-PETITION-YRQ-Q PIC 9(01). DTSBD327 00177 SKIP3 DTSBD327 00178 05 WRK-BNK-FIRST-BILL-YRQ PIC S9(05) COMP-3. DTSBD327 00179 SKIP1 DTSBD327 00180 05 WRK-MAPL-YRQ-CNT PIC S9(04) COMP. DTSBD327 00181 05 WRK-MAPL-YRQ OCCURS 400 TIMES DTSBD327 00182 INDEXED BY WRK-MAPL-YRQ-IDX DTSBD327 00183 PIC S9(05) COMP-3. DTSBD327 00184 SKIP3 DTSBD327 00185 05 STMT-TEXT-IND PIC X(01). DTSBD327 00186 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBD327 00187 DTSBD327 00188 05 TAD-FORM-CNT PIC S9(04) COMP. DTSBD327 00189 DTSBD327 00190 05 TAA-FORM-CNT PIC S9(04) COMP. DTSBD327 00191 DTSBD327 00192 05 OPO-FORM-CNT PIC S9(04) COMP. DTSBD327 00193 DTSBD327 00194 05 WRK-SUB PIC S9(04) COMP. DTSBD327 00195 DTSBD327 00196 05 WRK-EMP-TOT-DUE PIC S9(09)V9(02) COMP-3. DTSBD327 00197 05 WRK-YRQ PIC 9(05). DTSBD327 00198 05 FILLER REDEFINES WRK-YRQ. DTSBD327 00199 10 WRK-YRQ-YR PIC 9(04). DTSBD327 00200 10 WRK-YRQ-Q PIC 9(01). DTSBD327 00201 DTSBD327 00202 05 WRK-CURR-ANN-YRQ PIC 9(05). DTSBD327 00203 05 FILLER REDEFINES WRK-CURR-ANN-YRQ. DTSBD327 00204 10 WRK-CURR-ANN-YEAR PIC 9(04). DTSBD327 00205 10 WRK-CURR-ANN-Q PIC 9(01). DTSBD327 00206 DTSBD327 00207 01 WRK-BUCKETS. DTSBD327 00208 DTSBD327 00209 05 WRK-TAX-DUE PIC S9(09)V9(02) COMP-3. DTSBD327 00210 05 WRK-PEN-DUE PIC S9(09)V9(02) COMP-3. DTSBD327 00211 05 WRK-INT-DUE PIC S9(09)V9(02) COMP-3. DTSBD327 00212 05 WRK-SUR-DUE PIC S9(09)V9(02) COMP-3. DTSBD327 00213 05 WRK-TOT-DUE PIC S9(09)V9(02) COMP-3. DTSBD327 00214 DTSBD327 00215 05 WRK-TOLERANCE-AMT PIC S9(09)V9(02) COMP-3 DTSBD327 00216 VALUE +10.00. DTSBD327 00217 DTSBD327 00218 05 HOLD-YRQ PIC S9(05) COMP-3. DTSBD327 00219 DTSBD327 00220 05 AMT-DISP1 PIC --------9.99. DTSBD327 00221 DTSBD327 00222 05 EVL-TEXT. DTSBD327 00223 10 FILLER PIC X(19) DTSBD327 00224 VALUE 'DEBIT STATEMENT TO '. DTSBD327 00225 10 EVL-ADDR-TYPE PIC X(04). DTSBD327 00226 10 EVL-ADDR-ID-NO PIC ZZ9. DTSBD327 00227 10 FILLER PIC X(10) DTSBD327 00228 VALUE '. TOT BAL:'. DTSBD327 00229 10 EVL-TOT-BAL-AMT PIC ZZZ,ZZZ,ZZ9.99. DTSBD327 00230 EJECT DTSBD327 00231 01 MSG-AREA. DTSBD327 00232 05 MSG1-AREA. DTSBD327 00233 10 MSG1-ID PIC X(03) DTSBD327 00234 VALUE '416'. DTSBD327 00235 10 MSG1-TEXT. DTSBD327 00236 15 FILLER PIC X(40) DTSBD327 00237 VALUE 'DEBIT EXISTS BUT ALL MTAD OCCURRENCES IN'. DTSBD327 00238 15 FILLER PIC X(40) DTSBD327 00239 VALUE 'DICATE NO DEBIT MEMO. NO DEBIT STATEME'. DTSBD327 00240 15 FILLER PIC X(20) DTSBD327 00241 VALUE 'NT TO MTAD GENERATED'. DTSBD327 00242 SKIP1 DTSBD327 00243 05 MSG2-AREA. DTSBD327 00244 10 MSG2-ID PIC X(03) DTSBD327 00245 VALUE '417'. DTSBD327 00246 10 MSG2-TEXT. DTSBD327 00247 15 FILLER PIC X(40) DTSBD327 00248 VALUE 'MCOL-STMT-TEXT-TYPE INDICATES CREDIT TEX'. DTSBD327 00249 15 FILLER PIC X(40) DTSBD327 00250 VALUE 'T. NO TEXT PRINTED ON BATCH GENERATED D'. DTSBD327 00251 15 FILLER PIC X(20) DTSBD327 00252 VALUE 'EBIT STATEMENT.'. DTSBD327 00253 SKIP1 DTSBD327 00254 05 MSG3-AREA. DTSBD327 00255 10 MSG3-ID PIC X(03) DTSBD327 00256 VALUE '418'. DTSBD327 00257 10 MSG3-TEXT. DTSBD327 00258 15 FILLER PIC X(40) DTSBD327 00259 VALUE 'NUMBER OF DEBIT STATEMENT QUARTERS EXCEE'. DTSBD327 00260 15 FILLER PIC X(40) DTSBD327 00261 VALUE 'DS 50. DEBIT STATEMENT NOT PRINTED. '. DTSBD327 00262 15 FILLER PIC X(20) DTSBD327 00263 VALUE ' '. DTSBD327 00264 EJECT DTSBD327 00265 01 R415-REC. DTSBD327 00266 ++INCLUDE DTSIR415 DTSBD327 00267 SKIP3 DTSBD327 00268 01 L001-LINK-AREA. DTSBD327 00269 ++INCLUDE DTSIL001 DTSBD327 00270 EJECT DTSBD327 00271 01 L004-LINK-AREA. DTSBD327 00272 ++INCLUDE DTSIL004 DTSBD327 00273 EJECT DTSBD327 00274 01 L005-LINK-AREA. DTSBD327 00275 ++INCLUDE DTSIL005 DTSBD327 00276 EJECT DTSBD327 00277 01 L082-LINK-AREA. DTSBD327 00278 ++INCLUDE DTSIL082 DTSBD327 00279 EJECT DTSBD327 00280 01 L101-LINK-AREA. DTSBD327 00281 ++INCLUDE DTSIL101 DTSBD327 00282 EJECT DTSBD327 00283 01 L109-LINK-AREA. DTSBD327 00284 ++INCLUDE DTSIL109 DTSBD327 00285 EJECT DTSBD327 00286 01 L111-LINK-AREA. DTSBD327 00287 ++INCLUDE DTSIL111 DTSBD327 00288 EJECT DTSBD327 00289 01 L112-LINK-AREA. DTSBD327 00290 ++INCLUDE DTSIL112 DTSBD327 00291 EJECT DTSBD327 00292 01 L910-LINK-AREA. DTSBD327 00293 ++INCLUDE DTSIL910 DTSBD327 00294 SKIP3 DTSBD327 00295 01 L410-LINK-AREA. DTSBD327 00296 ++INCLUDE DTSIL410 DTSBD327 00297 SKIP3 DTSBD327 00298 01 MSKL-REC. DTSBD327 00299 ++INCLUDE DTSIMSKL DTSBD327 00300 SKIP3 DTSBD327 00301 01 MQTR-REC. DTSBD327 00302 ++INCLUDE DTSIMQTR DTSBD327 00303 SKIP3 DTSBD327 00304 01 MAPL-REC. DTSBD327 00305 ++INCLUDE DTSIMAPL DTSBD327 00306 SKIP3 DTSBD327 00307 01 MCOL-REC. DTSBD327 00308 ++INCLUDE DTSIMCOL DTSBD327 00309 SKIP3 DTSBD327 00310 01 MEVL-REC. DTSBD327 00311 ++INCLUDE DTSIMEVL DTSBD327 00312 SKIP3 DTSBD327 00313 01 MTAD-REC. DTSBD327 00314 ++INCLUDE DTSIMTAD DTSBD327 00315 SKIP3 DTSBD327 00316 01 MTAA-REC. DTSBD327 00317 ++INCLUDE DTSIMTAA DTSBD327 00318 SKIP3 DTSBD327 00319 01 MOPO-REC. DTSBD327 00320 ++INCLUDE DTSIMOPO DTSBD327 00321 EJECT DTSBD327 00322 01 R416-REC. DTSBD327 00323 ++INCLUDE DTSIR416 DTSBD327 00324 SKIP3 DTSBD327 00325 01 R907-REC. DTSBD327 00326 ++INCLUDE DTSIR907 DTSBD327 00327 EJECT DTSBD327 00328 LINKAGE SECTION. DTSBD327 00329 SKIP3 DTSBD327 00330 01 LBCM-LINK-AREA. DTSBD327 00331 ++INCLUDE DTSILBCM DTSBD327 00332 01 MPRF-LINK-REC. DTSBD327 00333 ++INCLUDE DTSIMPRF DTSBD327 00334 EJECT DTSBD327 00335 01 T011-REC. DTSBD327 00336 ++INCLUDE DTSIT011 DTSBD327 00337 EJECT DTSBD327 00338 *************************************************************** DTSBD327 00339 * THE PROCEDURE DIVISION FOR DTSBD327 STARTS HERE. DTSBD327 00340 *************************************************************** DTSBD327 00341 DTSBD327 00342 PROCEDURE DIVISION USING LBCM-LINK-AREA DTSBD327 00343 MPRF-LINK-REC DTSBD327 00344 T011-REC. DTSBD327 00345 SKIP2 DTSBD327 00346 IF FIRST-TIME-IND = 'Y' DTSBD327 00347 PERFORM I0000-INITIALIZE THRU I0000-EXIT DTSBD327 00348 MOVE 'N' TO FIRST-TIME-IND. DTSBD327 00349 DTSBD327 00350 IF T011-STMT-OF-ACCT DTSBD327 00351 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBD327 00352 ELSE DTSBD327 00353 MOVE 'INVALID LBCM-CALL-TYPE-IND ENCOUNTERED' DTSBD327 00354 TO ABEND-MSG DTSBD327 00355 PERFORM S999-ABEND THRU S999-EXIT. DTSBD327 00356 SKIP2 DTSBD327 00357 GOBACK. DTSBD327 00358 EJECT DTSBD327 00359 *************************************************************** DTSBD327 00360 * THE PARAGRAPH CONTROLS THE INITIALIZATION PROCESS FOR DTSBD327 00361 * DTSBE414. DTSBD327 00362 *************************************************************** DTSBD327 00363 DTSBD327 00364 I0000-INITIALIZE. DTSBD327 00365 SKIP2 DTSBD327 00366 MOVE LBCM-TRACE-IND TO L910-TRACE-IND. DTSBD327 00367 MOVE WRK-MOD-NAME TO L910-MOD-NAME DTSBD327 00368 R907-MODULE-NAME. DTSBD327 00369 DTSBD327 00370 MOVE LENGTH OF R415-REC TO R415-LENGTH. DTSBD327 00371 MOVE LENGTH OF R416-REC TO R416-LENGTH. DTSBD327 00372 MOVE LENGTH OF R907-REC TO R907-LENGTH. DTSBD327 00373 MOVE 99999 TO WRK-CURR-ANN-YRQ. DTSBD327 00374 MOVE LBCM-CURR-RUN-DATE TO WRK-LAST-ACCT-UPDATE-DATE. DTSBD327 00375 DTSBD327 00376 MOVE LBCM-CURR-MAIL-DATE TO WRK-STMT-DATE. DTSBD327 00377 DTSBD327 00378 PERFORM I1000-EDIT-AND-DEFAULT-PARMS THRU I1000-EXIT. DTSBD327 00379 DTSBD327 00380 PERFORM S2000-INITIALIZE-TABLE THRU S2000-EXIT DTSBD327 00381 VARYING WRK-SUB FROM 1 BY 1 DTSBD327 00382 UNTIL WRK-SUB GREATER THAN 50. DTSBD327 00383 *RW1 DTSBD327 00384 PERFORM S109-FIRST-PEN-INT-YRQ THRU S109-EXIT. DTSBD327 00385 MOVE L109-FIRST-PEN-INT-YRQ TO WRK-FIRST-PEN-INT-YRQ. DTSBD327 00386 *RW2 DTSBD327 00387 * SET LBCM-MST-OPEN-UPDATE-88 TO TRUE. DTSBD327 00388 * SET LBCM-REF-OPEN-READ-88 TO TRUE. DTSBD327 00389 SKIP2 DTSBD327 00390 I0000-EXIT. DTSBD327 00391 EXIT. DTSBD327 00392 SKIP3 DTSBD327 00393 *************************************************************** DTSBD327 00394 * THE PARAGRAPH CONTROLS THE EDITING OF THE PARMS. DTSBD327 00395 *************************************************************** DTSBD327 00396 DTSBD327 00397 I1000-EDIT-AND-DEFAULT-PARMS. DTSBD327 00398 DTSBD327 00399 PERFORM I1100-RESP-OP-ID THRU I1100-EXIT. DTSBD327 00400 DTSBD327 00401 PERFORM I1200-INT-COMP-DATE THRU I1200-EXIT. DTSBD327 00402 DTSBD327 00403 PERFORM I1300-REIMB-CUTOFF-DATE THRU I1300-EXIT. DTSBD327 00404 DTSBD327 00405 I1000-EXIT. DTSBD327 00406 EXIT. DTSBD327 00407 EJECT DTSBD327 00408 *************************************************************** DTSBD327 00409 * THE PARAGRAPH EDITS THE RESPONSIBLE OP ID. DTSBD327 00410 *************************************************************** DTSBD327 00411 DTSBD327 00412 I1100-RESP-OP-ID. DTSBD327 00413 DTSBD327 00414 IF T011-RESP-OP-ID = SPACES DTSBD327 00415 MOVE SPACES TO WRK-PARM-RESP-OP-ID DTSBD327 00416 GO TO I1100-EXIT. DTSBD327 00417 DTSBD327 00418 * MOVE 'RESP-OP-ID MISSING' TO ABEND-MSG DTSBD327 00419 * PERFORM S999-ABEND THRU S999-EXIT. DTSBD327 00420 DTSBD327 00421 MOVE T011-RESP-OP-ID TO L082-OP-ID. DTSBD327 00422 DTSBD327 00423 PERFORM S082-LOOKUP-OP-ID THRU S082-EXIT. DTSBD327 00424 DTSBD327 00425 *& IF L082-NOT-VALID-OP OR L082-INTERNAL-88 DTSBD327 00426 * MOVE 'T011-RESP-OP-ID NOT VALID' DTSBD327 00427 * TO ABEND-MSG DTSBD327 00428 *& PERFORM S999-ABEND THRU S999-EXIT. DTSBD327 00429 MOVE T011-RESP-OP-ID TO WRK-PARM-RESP-OP-ID. DTSBD327 00430 DTSBD327 00431 I1100-EXIT. DTSBD327 00432 EXIT. DTSBD327 00433 EJECT DTSBD327 00434 *************************************************************** DTSBD327 00435 * THE PARAGRAPH EDITS THE INTEREST COMPUTATION DATE DTSBD327 00436 *************************************************************** DTSBD327 00437 DTSBD327 00438 I1200-INT-COMP-DATE. DTSBD327 00439 DTSBD327 00440 MOVE WRK-STMT-DATE TO L001-FED-8-DATE-9 DTSBD327 00441 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBD327 00442 ADD +14 TO L001-JUL-ABS-DAY DTSBD327 00443 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT DTSBD327 00444 MOVE L001-FED-8-DATE-9 DTSBD327 00445 TO WRK-PARM-INT-COMP-DATE. DTSBD327 00446 I1200-EXIT. DTSBD327 00447 EXIT. DTSBD327 00448 EJECT DTSBD327 00449 *************************************************************** DTSBD327 00450 * THE PARAGRAPH EDITS THE REIMBURSABLE CUTOFF DATE. DTSBD327 00451 *************************************************************** DTSBD327 00452 DTSBD327 00453 I1300-REIMB-CUTOFF-DATE. DTSBD327 00454 DTSBD327 00455 MOVE WRK-STMT-DATE TO L001-FED-8-DATE-9 DTSBD327 00456 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBD327 00457 SUBTRACT 30 FROM L001-JUL-ABS-DAY DTSBD327 00458 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT DTSBD327 00459 MOVE L001-FED-8-DATE-9 TO WRK-PARM-REIMB-CUTOFF-DATE. DTSBD327 00460 DTSBD327 00461 IF WRK-PARM-REIMB-CUTOFF-DATE > WRK-LAST-ACCT-UPDATE-DATE DTSBD327 00462 MOVE DTSBD327 00463 'REIMB-CUTOFF-DATE IS GREATER THAN LAST-ACCT-UPDATE-DATE' DTSBD327 00464 TO ABEND-MSG DTSBD327 00465 PERFORM S999-ABEND THRU S999-EXIT. DTSBD327 00466 I1300-EXIT. DTSBD327 00467 EXIT. DTSBD327 00468 DTSBD327 00469 EJECT DTSBD327 00470 DTSBD327 00471 *************************************************************** DTSBD327 00472 * THIS IS THE PROCESS PARAGRAPH FOR DTSBD327. DTSBD327 00473 *************************************************************** DTSBD327 00474 DTSBD327 00475 P0000-PROCESS. DTSBD327 00476 DISPLAY 'BD327 P0000 ' MPRF-EMP-NO. DTSBD327 00477 DTSBD327 00478 MOVE +50 TO R415-QTR-CNT. DTSBD327 00479 MOVE 99999 TO WRK-CURR-ANN-YRQ DTSBD327 00480 IF MPRF-STATUS-NEVERSUB-88 OR DTSBD327 00481 MPRF-STATUS-UNK-88 DTSBD327 00482 GO TO P0000-EXIT. DTSBD327 00483 DTSBD327 00484 IF (MPRF-TOT-BALANCE-AMT > +0) CL*18 00485 OR (MPRF-PURSUED-RPT-CNT > +0) DTSBD327 00486 NEXT SENTENCE DTSBD327 00487 ELSE DTSBD327 00488 GO TO P0000-EXIT. DTSBD327 00489 DTSBD327 00490 IF MPRF-NOT-WRITTEN-OFF-88 DTSBD327 00491 NEXT SENTENCE DTSBD327 00492 ELSE DTSBD327 00493 GO TO P0000-EXIT. DTSBD327 00494 DTSBD327 00495 MOVE +0 TO WRK-MAPL-YRQ-CNT DTSBD327 00496 WRK-BNK-PETITION-DATE DTSBD327 00497 WRK-BNK-PETITION-YRQ DTSBD327 00498 WRK-BNK-FIRST-BILL-YRQ. DTSBD327 00499 DTSBD327 00500 IF MPRF-MAPL-EXISTS-88 DTSBD327 00501 PERFORM P1000-TABLE-MAPL-OPEN-YRQ THRU P1000-EXIT. DTSBD327 00502 DTSBD327 00503 IF MPRF-BANKRP-OPEN-88 DTSBD327 00504 PERFORM P1500-TABLE-OPEN-BNK-YRQ THRU P1500-EXIT. DTSBD327 00505 DTSBD327 00506 MOVE 'N' TO STMT-TEXT-IND. DTSBD327 00507 DTSBD327 00508 PERFORM P2000-CONSTRUCT-R415-MISC THRU P2000-EXIT. DTSBD327 00509 DTSBD327 00510 DTSBD327 00511 PERFORM S2000-INITIALIZE-TABLE THRU S2000-EXIT DTSBD327 00512 VARYING WRK-SUB FROM 1 BY 1 DTSBD327 00513 UNTIL WRK-SUB GREATER THAN R415-QTR-CNT. DTSBD327 00514 DTSBD327 00515 MOVE +0 TO R415-QTR-CNT DTSBD327 00516 WRK-EMP-TOT-DUE. DTSBD327 00517 DTSBD327 00518 PERFORM P3000-CONSTRUCT-R415-QTR THRU P3000-EXIT. DTSBD327 00519 DTSBD327 00520 DISPLAY 'BD327 P0000 - 2 ' MPRF-EMP-NO. DTSBD327 00521 IF R415-QTR-CNT = +0 DTSBD327 00522 GO TO P0000-EXIT. DTSBD327 00523 DTSBD327 00524 IF MPRF-PURSUED-RPT-CNT > +0 DTSBD327 00525 NEXT SENTENCE DTSBD327 00526 ELSE DTSBD327 00527 IF WRK-EMP-TOT-DUE < WRK-TOLERANCE-AMT DTSBD327 00528 MOVE WRK-EMP-TOT-DUE TO AMT-DISP1 DTSBD327 00529 DISPLAY ' TOT DUE < TOL ' DTSBD327 00530 MPRF-EMP-NO ' ' AMT-DISP1 DTSBD327 00531 GO TO P0000-EXIT DTSBD327 00532 END-IF DTSBD327 00533 END-IF. DTSBD327 00534 DTSBD327 00535 DISPLAY 'BD327 P0000 - 3 ' MPRF-EMP-NO. DTSBD327 00536 IF T011-ORIGIN (1:3) = 'WEB' DTSBD327 00537 NEXT SENTENCE DTSBD327 00538 ELSE DTSBD327 00539 IF MPRF-TOT-BALANCE-AMT = +0 DTSBD327 00540 IF R415-QTR-CNT = +1 DTSBD327 00541 IF R415-QTR (1) >= LBCM-LAST-PEN-ASSESSED-YRQ DTSBD327 00542 IF R415-QTR-EST-RPT-NO-88 (1) DTSBD327 00543 ADD 1 TO WRK-BYPASS-CNT DTSBD327 00544 GO TO P0000-EXIT DTSBD327 00545 ELSE DTSBD327 00546 ADD 1 TO WRK-ASSESS-CNT DTSBD327 00547 END-IF DTSBD327 00548 END-IF DTSBD327 00549 END-IF DTSBD327 00550 END-IF DTSBD327 00551 END-IF. DTSBD327 00552 DTSBD327 00553 IF R415-QTR-CNT > +50 DTSBD327 00554 MOVE MSG3-ID TO R907-MSG-ID DTSBD327 00555 MOVE MPRF-EMP-NO TO R907-EMP-NO DTSBD327 00556 MOVE MSG3-TEXT TO R907-MSG-TEXT DTSBD327 00557 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBD327 00558 GO TO P0000-EXIT. DTSBD327 00559 DTSBD327 00560 MOVE +0 TO TAD-FORM-CNT. DTSBD327 00561 DTSBD327 00562 PERFORM P4000-PROCESS-MTAD THRU P4000-EXIT. DTSBD327 00563 DTSBD327 00564 IF TAD-FORM-CNT = +0 DTSBD327 00565 MOVE MSG1-ID TO R907-MSG-ID DTSBD327 00566 MOVE MPRF-EMP-NO TO R907-EMP-NO DTSBD327 00567 MOVE MSG1-TEXT TO R907-MSG-TEXT DTSBD327 00568 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBD327 00569 DTSBD327 00570 MOVE +0 TO OPO-FORM-CNT. DTSBD327 00571 DTSBD327 00572 PERFORM P5000-PROCESS-MOPO THRU P5000-EXIT. DTSBD327 00573 DTSBD327 00574 MOVE +0 TO TAA-FORM-CNT. DTSBD327 00575 DTSBD327 00576 PERFORM P6000-PROCESS-MTAA THRU P6000-EXIT. DTSBD327 00577 DTSBD327 00578 IF STMT-TEXT-IND = 'Y' DTSBD327 00579 IF ((TAD-FORM-CNT > +0) DTSBD327 00580 OR (OPO-FORM-CNT > +0) DTSBD327 00581 OR (TAA-FORM-CNT > +0)) DTSBD327 00582 PERFORM P7000-REWRITE-MCOL THRU P7000-EXIT. DTSBD327 00583 P0000-EXIT. DTSBD327 00584 EXIT. DTSBD327 00585 EJECT DTSBD327 00586 *************************************************************** DTSBD327 00587 * THIS PARAGRAPH STARTS THE BROWSE OF THE MAPL RECORDS. DTSBD327 00588 *************************************************************** DTSBD327 00589 DTSBD327 00590 P1000-TABLE-MAPL-OPEN-YRQ. DTSBD327 00591 DTSBD327 00592 MOVE LOW-VALUES TO MAPL-KEY-AREA. DTSBD327 00593 MOVE MPRF-EMP-NO TO MAPL-EMP-NO. DTSBD327 00594 SET MAPL-APL-88 TO TRUE. DTSBD327 00595 MOVE MAPL-KEY-AREA TO MSKL-KEY-AREA. DTSBD327 00596 DTSBD327 00597 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD327 00598 DTSBD327 00599 PERFORM P1100-SCAN-MAPL THRU P1100-EXIT DTSBD327 00600 UNTIL L910-NO-REC-88. DTSBD327 00601 DTSBD327 00602 P1000-EXIT. DTSBD327 00603 EXIT. DTSBD327 00604 SKIP3 DTSBD327 00605 *************************************************************** DTSBD327 00606 * THIS PARAGRAPH SCANS ALL MAPL RECORDS. DTSBD327 00607 *************************************************************** DTSBD327 00608 DTSBD327 00609 P1100-SCAN-MAPL. DTSBD327 00610 DTSBD327 00611 MOVE MSKL-REC TO MAPL-REC. DTSBD327 00612 DTSBD327 00613 IF MAPL-STATUS-OPEN-88 DTSBD327 00614 PERFORM P1110-SCAN-COVERED-YRQ THRU P1110-EXIT DTSBD327 00615 VARYING MAPL-COV-IDX FROM 1 BY 1 DTSBD327 00616 UNTIL MAPL-COV-IDX GREATER THAN MAPL-COVERED-CNT. DTSBD327 00617 DTSBD327 00618 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBD327 00619 DTSBD327 00620 P1100-EXIT. DTSBD327 00621 EXIT. DTSBD327 00622 EJECT DTSBD327 00623 *************************************************************** DTSBD327 00624 * THIS PARAGRAPH PROCESSES THE QUARTER TABLE IN THE MAPL DTSBD327 00625 * RECORD, AND SETS ALL NEW QUARTERS UP IN THE WORKING DTSBD327 00626 * STORAGE TABLE. DTSBD327 00627 *************************************************************** DTSBD327 00628 DTSBD327 00629 P1110-SCAN-COVERED-YRQ. DTSBD327 00630 DTSBD327 00631 MOVE MAPL-COVERED-YRQ (MAPL-COV-IDX) TO HOLD-YRQ. DTSBD327 00632 DTSBD327 00633 PERFORM P1111-WRK-MAPL-YRQ-LOOP THRU P1111-EXIT DTSBD327 00634 VARYING WRK-MAPL-YRQ-IDX FROM 1 BY 1 DTSBD327 00635 UNTIL (WRK-MAPL-YRQ-IDX > WRK-MAPL-YRQ-CNT) DTSBD327 00636 OR DTSBD327 00637 (HOLD-YRQ = +0). DTSBD327 00638 DTSBD327 00639 IF HOLD-YRQ = +0 DTSBD327 00640 NEXT SENTENCE DTSBD327 00641 ELSE DTSBD327 00642 IF WRK-MAPL-YRQ-CNT < +400 DTSBD327 00643 ADD +1 TO WRK-MAPL-YRQ-CNT DTSBD327 00644 MOVE HOLD-YRQ TO WRK-MAPL-YRQ (WRK-MAPL-YRQ-CNT). DTSBD327 00645 P1110-EXIT. DTSBD327 00646 EXIT. DTSBD327 00647 SKIP3 DTSBD327 00648 *************************************************************** DTSBD327 00649 * THIS PARAGRAPH LOOKS AT EACH OCCURRENCE OF THE QUARTER TABLE DTSBD327 00650 * TO DETERMINE IF THE QUARTER HAS ALREADY BEEN LOADED. DTSBD327 00651 *************************************************************** DTSBD327 00652 DTSBD327 00653 P1111-WRK-MAPL-YRQ-LOOP. DTSBD327 00654 DTSBD327 00655 IF HOLD-YRQ = WRK-MAPL-YRQ (WRK-MAPL-YRQ-IDX) DTSBD327 00656 MOVE +0 TO HOLD-YRQ. DTSBD327 00657 P1111-EXIT. DTSBD327 00658 EXIT. DTSBD327 00659 EJECT DTSBD327 00660 *************************************************************** DTSBD327 00661 * IF THE EMPLOYER HAS AN OPEN BANKRUPTCY, DO NOT INCLUDE ANY DTSBD327 00662 * QUARTER LESS THAN THAT IN WHICH THE PETITION DATE OCCURS DTSBD327 00663 * IN THE DEBIT MEMO. DTSBD327 00664 *************************************************************** DTSBD327 00665 P1500-TABLE-OPEN-BNK-YRQ. DTSBD327 00666 MOVE LOW-VALUES TO MCOL-KEY-AREA. DTSBD327 00667 MOVE MPRF-EMP-NO TO MCOL-EMP-NO. DTSBD327 00668 SET MCOL-COL-88 TO TRUE. DTSBD327 00669 MOVE MCOL-KEY-AREA TO MSKL-KEY-AREA. DTSBD327 00670 DTSBD327 00671 PERFORM S910-READ THRU S910-EXIT. DTSBD327 00672 DTSBD327 00673 IF NOT L910-OK-88 DTSBD327 00674 GO TO P1500-EXIT DTSBD327 00675 ELSE DTSBD327 00676 MOVE MSKL-REC TO MCOL-REC. DTSBD327 00677 DTSBD327 00678 IF MCOL-BNK-PETITION-DATE > +0 DTSBD327 00679 IF (MCOL-BNK-DISCHRG-CLOSE-DATE = +0 DTSBD327 00680 AND MCOL-BNK-DISMISS-DATE = +0) DTSBD327 00681 PERFORM P1510-FIRST-BILL-YRQ THRU P1510-EXIT DTSBD327 00682 ELSE DTSBD327 00683 GO TO P1500-EXIT. DTSBD327 00684 DTSBD327 00685 P1500-EXIT. DTSBD327 00686 EXIT. DTSBD327 00687 DTSBD327 00688 *************************************************************** DTSBD327 00689 * DETERMINE THE QUARTER IN WHICH THE PETITION DATE FALLS. DTSBD327 00690 * THE NEXT QUARTER IS THE FIRST THAT MAY BE INCLUDED IN THE DTSBD327 00691 * DEBIT MEMO. SET WRK-BNK-PETITION-YRQ = DTSBD327 00692 * (THE QUARTER IN WHICH THE PETITION DATE FALLS PLUS 1). DTSBD327 00693 *************************************************************** DTSBD327 00694 P1510-FIRST-BILL-YRQ. DTSBD327 00695 MOVE MCOL-BNK-PETITION-DATE TO WRK-BNK-PETITION-DATE. DTSBD327 00696 MOVE WRK-BNK-PETITION-DATE-YYYY DTSBD327 00697 TO WRK-BNK-PETITION-YRQ-YYYY. DTSBD327 00698 EVALUATE WRK-BNK-PETITION-DATE-MM DTSBD327 00699 WHEN 10 THRU 12 DTSBD327 00700 MOVE 4 TO WRK-BNK-PETITION-YRQ-Q DTSBD327 00701 WHEN 7 THRU 9 DTSBD327 00702 MOVE 3 TO WRK-BNK-PETITION-YRQ-Q DTSBD327 00703 WHEN 4 THRU 6 DTSBD327 00704 MOVE 2 TO WRK-BNK-PETITION-YRQ-Q DTSBD327 00705 WHEN OTHER DTSBD327 00706 MOVE 1 TO WRK-BNK-PETITION-YRQ-Q DTSBD327 00707 END-EVALUATE. DTSBD327 00708 DTSBD327 00709 MOVE WRK-BNK-PETITION-YRQ TO L004-QTR-5-9. DTSBD327 00710 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD327 00711 IF L004-INVALID-QTR DTSBD327 00712 MOVE 'INVALID PETITION YRQ ENCOUNTERED' DTSBD327 00713 TO ABEND-MSG DTSBD327 00714 PERFORM S999-ABEND THRU S999-EXIT. DTSBD327 00715 DTSBD327 00716 ADD +1 TO L004-ABS-QTR. DTSBD327 00717 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBD327 00718 MOVE L004-QTR-5-9 TO WRK-BNK-FIRST-BILL-YRQ. DTSBD327 00719 DTSBD327 00720 P1510-EXIT. DTSBD327 00721 EXIT. DTSBD327 00722 DTSBD327 00723 *************************************************************** DTSBD327 00724 * THIS PARAGRAPH BUILDS THE R415 REPORT EXTRACT RECORD. DTSBD327 00725 *************************************************************** DTSBD327 00726 P2000-CONSTRUCT-R415-MISC. DTSBD327 00727 DTSBD327 00728 MOVE T011-RESP-OP-ID TO R415-OP-ID. DTSBD327 00729 MOVE WRK-STMT-DATE TO R415-STMT-DATE. DTSBD327 00730 MOVE WRK-PARM-INT-COMP-DATE TO R415-COMP-DATE. DTSBD327 00731 MOVE WRK-LAST-ACCT-UPDATE-DATE TO R415-LAST-ACCT-UPDATE-DATE.DTSBD327 00732 DTSBD327 00733 DTSBD327 00734 P2000-EXIT. DTSBD327 00735 EXIT. DTSBD327 00736 EJECT DTSBD327 00737 *************************************************************** DTSBD327 00738 * THIS PARAGRAPH CAUSES ALL THE MQTR RECORDS TO BE READ. DTSBD327 00739 *************************************************************** DTSBD327 00740 DTSBD327 00741 P3000-CONSTRUCT-R415-QTR. DTSBD327 00742 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBD327 00743 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBD327 00744 SET MQTR-QTR-88 TO TRUE. DTSBD327 00745 MOVE T011-START-YRQ TO MQTR-YRQ DTSBD327 00746 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBD327 00747 DTSBD327 00748 DISPLAY 'BD327 P3000 1 ' MPRF-EMP-NO ' ' MQTR-YRQ. DTSBD327 00749 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD327 00750 DTSBD327 00751 PERFORM P3100-SCAN-MQTR THRU P3100-EXIT DTSBD327 00752 UNTIL L910-NO-REC-88 OR DTSBD327 00753 MQTR-YRQ > T011-END-YRQ. DTSBD327 00754 DTSBD327 00755 P3000-EXIT. DTSBD327 00756 EXIT. DTSBD327 00757 EJECT DTSBD327 00758 *************************************************************** DTSBD327 00759 * THIS PARAGRAPH SCANS THE MQTR RECORDS. DTSBD327 00760 *************************************************************** DTSBD327 00761 DTSBD327 00762 P3100-SCAN-MQTR. DTSBD327 00763 DTSBD327 00764 MOVE MSKL-REC TO MQTR-REC. DTSBD327 00765 PERFORM P3110-PROCESS-MQTR THRU P3110-EXIT. DTSBD327 00766 DTSBD327 00767 MOVE MQTR-REC TO MSKL-REC. DTSBD327 00768 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD327 00769 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBD327 00770 DTSBD327 00771 P3100-EXIT. DTSBD327 00772 EXIT. DTSBD327 00773 EJECT DTSBD327 00774 *************************************************************** DTSBD327 00775 * THIS PARAGRAPH PROCESSES THE MQTR RECORDS. DTSBD327 00776 *************************************************************** DTSBD327 00777 DTSBD327 00778 P3110-PROCESS-MQTR. DTSBD327 00779 DISPLAY 'BD327 P3110 1 ' MPRF-EMP-NO ' ' MQTR-YRQ DTSBD327 00780 ' R415 CNT ' R415-QTR-CNT. DTSBD327 00781 DTSBD327 00782 IF MQTR-YRQ < T011-START-YRQ OR DTSBD327 00783 MQTR-YRQ > T011-END-YRQ DTSBD327 00784 GO TO P3110-EXIT DTSBD327 00785 END-IF. DTSBD327 00786 DTSBD327 00787 MOVE ZEROS TO WRK-YRQ. DTSBD327 00788 IF WRK-BNK-FIRST-BILL-YRQ = ZERO DTSBD327 00789 NEXT SENTENCE DTSBD327 00790 ELSE DTSBD327 00791 IF MQTR-YRQ = LBCM-PICKUP-YRQ DTSBD327 00792 GO TO P3110-EXIT DTSBD327 00793 ELSE DTSBD327 00794 IF MQTR-YRQ < WRK-BNK-FIRST-BILL-YRQ DTSBD327 00795 GO TO P3110-EXIT DTSBD327 00796 END-IF DTSBD327 00797 END-IF DTSBD327 00798 END-IF. DTSBD327 00799 DTSBD327 00800 IF MQTR-RPT-IS-PURSUED-88 DTSBD327 00801 NEXT SENTENCE DTSBD327 00802 ELSE DTSBD327 00803 IF MPRF-CLASS-SELF-INS-88 DTSBD327 00804 IF MQTR-TAX-DUE-DATE GREATER THAN DTSBD327 00805 WRK-PARM-REIMB-CUTOFF-DATE DTSBD327 00806 GO TO P3110-EXIT. DTSBD327 00807 DISPLAY 'BD327 P3110 2 ' MPRF-EMP-NO ' ' MQTR-YRQ. DTSBD327 00808 SET L410-MODE-INPUT-YRQ-88 TO TRUE. DTSBD327 00809 MOVE MPRF-EMP-NO TO L410-EMP-NO. DTSBD327 00810 MOVE MQTR-YRQ TO L410-YRQ. DTSBD327 00811 PERFORM S410-FILE-SCHED THRU S410-EXIT. DTSBD327 00812 IF L410-ANN-SCHED-88 DTSBD327 00813 MOVE MQTR-YRQ TO WRK-YRQ DTSBD327 00814 IF WRK-YRQ-YR NOT = WRK-CURR-ANN-YEAR DTSBD327 00815 MOVE ZEROS TO WRK-TAX-DUE DTSBD327 00816 WRK-PEN-DUE DTSBD327 00817 WRK-INT-DUE DTSBD327 00818 WRK-SUR-DUE DTSBD327 00819 WRK-TOT-DUE DTSBD327 00820 END-IF DTSBD327 00821 ELSE DTSBD327 00822 MOVE ZEROS TO WRK-TAX-DUE DTSBD327 00823 WRK-PEN-DUE DTSBD327 00824 WRK-INT-DUE DTSBD327 00825 WRK-SUR-DUE DTSBD327 00826 WRK-TOT-DUE DTSBD327 00827 END-IF. DTSBD327 00828 DTSBD327 00829 PERFORM P3111-PROJECT-INT THRU P3111-EXIT. DTSBD327 00830 DTSBD327 00831 ADD WRK-TAX-DUE DTSBD327 00832 WRK-PEN-DUE DTSBD327 00833 WRK-INT-DUE DTSBD327 00834 WRK-SUR-DUE DTSBD327 00835 GIVING WRK-TOT-DUE. DTSBD327 00836 DTSBD327 00837 DISPLAY 'BD327 P3110 4 ' MPRF-EMP-NO ' ' MQTR-YRQ DTSBD327 00838 ' TOT DUE ' WRK-TOT-DUE ' ' MQTR-PURSUED-RPT-IND. DTSBD327 00839 IF (WRK-TOT-DUE GREATER THAN ZERO) OR DTSBD327 00840 (MQTR-RPT-IS-PURSUED-88) DTSBD327 00841 NEXT SENTENCE DTSBD327 00842 ELSE DTSBD327 00843 GO TO P3110-EXIT. DTSBD327 00844 DTSBD327 00845 DTSBD327 00846 IF WRK-YRQ-YR NOT = WRK-CURR-ANN-YEAR DTSBD327 00847 ADD +1 TO R415-QTR-CNT. DTSBD327 00848 DTSBD327 00849 DISPLAY 'BD327 P3110 5 ' MPRF-EMP-NO ' ' MQTR-YRQ DTSBD327 00850 ' WRK YRQ ' WRK-YRQ ' CURR ANN ' WRK-CURR-ANN-YEAR DTSBD327 00851 DISPLAY ' R415 CNT ' R415-QTR-CNT. DTSBD327 00852 IF R415-QTR-CNT GREATER THAN 50 DTSBD327 00853 GO TO P3110-EXIT. DTSBD327 00854 DTSBD327 00855 IF L410-ANN-SCHED-88 DTSBD327 00856 SET R415-ANN-FILER-YES-88 (R415-QTR-CNT) TO TRUE DTSBD327 00857 MOVE WRK-YRQ-YR TO WRK-CURR-ANN-YEAR DTSBD327 00858 MOVE ZERO TO WRK-CURR-ANN-Q DTSBD327 00859 MOVE WRK-CURR-ANN-YRQ TO R415-QTR (R415-QTR-CNT) DTSBD327 00860 ELSE DTSBD327 00861 SET R415-ANN-FILER-NO-88 (R415-QTR-CNT) TO TRUE DTSBD327 00862 MOVE MQTR-YRQ TO R415-QTR (R415-QTR-CNT) DTSBD327 00863 END-IF. DTSBD327 00864 DTSBD327 00865 IF MQTR-CURR-ESTIM-88 DTSBD327 00866 SET R415-QTR-EST-RPT-YES-88 (R415-QTR-CNT) TO TRUE DTSBD327 00867 ELSE DTSBD327 00868 SET R415-QTR-EST-RPT-NO-88 (R415-QTR-CNT) TO TRUE. DTSBD327 00869 DTSBD327 00870 SET R415-QTR-APPEAL-NO-88 (R415-QTR-CNT) TO TRUE. DTSBD327 00871 DTSBD327 00872 PERFORM P3112-CHECK-APPEAL THRU P3112-EXIT DTSBD327 00873 VARYING WRK-MAPL-YRQ-IDX FROM 1 BY 1 DTSBD327 00874 UNTIL WRK-MAPL-YRQ-IDX GREATER THAN WRK-MAPL-YRQ-CNT OR DTSBD327 00875 R415-QTR-APPEAL-YES-88 (R415-QTR-CNT). DTSBD327 00876 DTSBD327 00877 PERFORM P3113-QTR-STATUS THRU P3113-EXIT. DTSBD327 00878 DTSBD327 00879 MOVE WRK-PEN-DUE TO R415-PENALTY-AMT (R415-QTR-CNT). DTSBD327 00880 MOVE WRK-TAX-DUE TO R415-CONTRIB-AMT (R415-QTR-CNT). DTSBD327 00881 MOVE WRK-INT-DUE TO R415-INTEREST-AMT (R415-QTR-CNT). DTSBD327 00882 MOVE WRK-TOT-DUE TO R415-BALANCE-AMT (R415-QTR-CNT). DTSBD327 00883 MOVE WRK-SUR-DUE TO R415-SURCHRG-AMT (R415-QTR-CNT). DTSBD327 00884 DTSBD327 00885 ADD WRK-TOT-DUE TO WRK-EMP-TOT-DUE. DTSBD327 00886 DTSBD327 00887 P3110-EXIT. DTSBD327 00888 EXIT. DTSBD327 00889 EJECT DTSBD327 00890 *************************************************************** DTSBD327 00891 * THIS PARAGRAPH PROJECTS THE INTEREST DUE. DTSBD327 00892 *************************************************************** DTSBD327 00893 DTSBD327 00894 P3111-PROJECT-INT. DTSBD327 00895 DTSBD327 00896 MOVE ZERO TO L101-PAID-CHNG. DTSBD327 00897 DTSBD327 00898 PERFORM DTSBD327 00899 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBD327 00900 UNTIL MQTR-ACCT-IDX GREATER THAN MQTR-ACCT-CNT DTSBD327 00901 DTSBD327 00902 PERFORM P3111-1-ACCUM THRU P3111-1-EXIT DTSBD327 00903 DTSBD327 00904 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSBD327 00905 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBD327 00906 TO L101-PAID-CHNG DTSBD327 00907 ELSE DTSBD327 00908 IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) DTSBD327 00909 IF MPRF-CLASS-RATED-88 DTSBD327 00910 AND MQTR-YRQ >= WRK-FIRST-PEN-INT-YRQ DTSBD327 00911 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBD327 00912 TO L101-PAID-CHNG DTSBD327 00913 END-IF DTSBD327 00914 END-IF DTSBD327 00915 END-IF DTSBD327 00916 DTSBD327 00917 END-PERFORM. DTSBD327 00918 DTSBD327 00919 IF L101-PAID-CHNG GREATER THAN ZERO DTSBD327 00920 NEXT SENTENCE DTSBD327 00921 ELSE DTSBD327 00922 GO TO P3111-EXIT. DTSBD327 00923 DTSBD327 00924 MOVE WRK-PARM-INT-COMP-DATE TO L101-RECEIVED-DATE. DTSBD327 00925 SET L101-WAIVE-INT-NO-88 TO TRUE. DTSBD327 00926 MOVE MQTR-TAX-DUE-DATE TO L101-TAX-DUE-DATE. DTSBD327 00927 MOVE MQTR-INT-AREA TO L101-INT-AREA. DTSBD327 00928 DTSBD327 00929 PERFORM S101-PER-MONTH-NO THRU S101-EXIT. DTSBD327 00930 DTSBD327 00931 ADD L101-INT-CHARGE-CHNG TO WRK-INT-DUE. DTSBD327 00932 DTSBD327 00933 SUBTRACT L101-INT-WAIVE-CHNG FROM WRK-INT-DUE. DTSBD327 00934 DTSBD327 00935 P3111-EXIT. DTSBD327 00936 EXIT. DTSBD327 00937 EJECT DTSBD327 00938 *************************************************************** DTSBD327 00939 * THIS PARAGRAPH ACCUMULATES THE TOTAL TAXES, PENALTY AND DTSBD327 00940 * INTEREST DUE AND PAID IN THE QUARTER RECORD. DTSBD327 00941 *************************************************************** DTSBD327 00942 DTSBD327 00943 P3111-1-ACCUM. DTSBD327 00944 DTSBD327 00945 IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) DTSBD327 00946 * ADD MQTR-PAID-AMT (MQTR-ACCT-IDX) TO WRK-TAX-PD DTSBD327 00947 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) TO WRK-SUR-DUE DTSBD327 00948 ELSE DTSBD327 00949 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSBD327 00950 * ADD MQTR-PAID-AMT (MQTR-ACCT-IDX) TO WRK-TAX-PD DTSBD327 00951 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) TO WRK-TAX-DUE DTSBD327 00952 ELSE DTSBD327 00953 IF MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX) OR DTSBD327 00954 MQTR-ACCT-NSF-PEN-88 (MQTR-ACCT-IDX) OR DTSBD327 00955 MQTR-ACCT-MISC-PEN-88 (MQTR-ACCT-IDX) DTSBD327 00956 * ADD MQTR-PAID-AMT (MQTR-ACCT-IDX) TO WRK-PEN-PD DTSBD327 00957 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) TO WRK-PEN-DUE DTSBD327 00958 ELSE DTSBD327 00959 IF MQTR-ACCT-INT-88 (MQTR-ACCT-IDX) DTSBD327 00960 * ADD MQTR-PAID-AMT (MQTR-ACCT-IDX) TO WRK-INT-PD DTSBD327 00961 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) TO WRK-INT-DUE. DTSBD327 00962 DTSBD327 00963 P3111-1-EXIT. DTSBD327 00964 EXIT. DTSBD327 00965 EJECT DTSBD327 00966 *************************************************************** DTSBD327 00967 * THIS PARAGRAPH CHECKS TO SEE IF THE QUARTER IS BEING DTSBD327 00968 * APPEALED. DTSBD327 00969 *************************************************************** DTSBD327 00970 DTSBD327 00971 P3112-CHECK-APPEAL. DTSBD327 00972 DTSBD327 00973 IF WRK-MAPL-YRQ (WRK-MAPL-YRQ-IDX) EQUAL MQTR-YRQ DTSBD327 00974 SET R415-QTR-APPEAL-YES-88 (R415-QTR-CNT) TO TRUE. DTSBD327 00975 DTSBD327 00976 P3112-EXIT. DTSBD327 00977 EXIT. DTSBD327 00978 EJECT DTSBD327 00979 *************************************************************** DTSBD327 00980 * THIS PARAGRAPH CHECKS THE STATUS OF THE QUARTER. DTSBD327 00981 *************************************************************** DTSBD327 00982 DTSBD327 00983 P3113-QTR-STATUS. DTSBD327 00984 DTSBD327 00985 SET R415-RPT-MISSING-NO-88 (R415-QTR-CNT) TO TRUE. DTSBD327 00986 DTSBD327 00987 IF MQTR-RPT-IS-PURSUED-88 DTSBD327 00988 SET R415-RPT-MISSING-YES-88 (R415-QTR-CNT) TO TRUE DTSBD327 00989 GO TO P3113-EXIT. DTSBD327 00990 DTSBD327 00991 P3113-EXIT. DTSBD327 00992 EXIT. DTSBD327 00993 EJECT DTSBD327 00994 *************************************************************** DTSBD327 00995 * THIS PARAGRAPH CAUSES THE MTAD RECORDS TO BE PROCESSED. DTSBD327 00996 *************************************************************** DTSBD327 00997 DTSBD327 00998 P4000-PROCESS-MTAD. DTSBD327 00999 DTSBD327 01000 MOVE LOW-VALUES TO MTAD-KEY-AREA. DTSBD327 01001 MOVE MPRF-EMP-NO TO MTAD-EMP-NO. DTSBD327 01002 SET MTAD-TAD-88 TO TRUE. DTSBD327 01003 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSBD327 01004 DTSBD327 01005 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD327 01006 DTSBD327 01007 PERFORM P4100-SCAN-MTAD THRU P4100-EXIT DTSBD327 01008 UNTIL L910-NO-REC-88. DTSBD327 01009 DTSBD327 01010 P4000-EXIT. DTSBD327 01011 EXIT. DTSBD327 01012 EJECT DTSBD327 01013 *************************************************************** DTSBD327 01014 * THIS PARAGRAPH SCANS THE MTAD RECORDS. DTSBD327 01015 *************************************************************** DTSBD327 01016 DTSBD327 01017 P4100-SCAN-MTAD. DTSBD327 01018 DTSBD327 01019 MOVE MSKL-REC TO MTAD-REC. DTSBD327 01020 DTSBD327 01021 PERFORM P4110-WRITE-MTAD-REC THRU P4110-EXIT. DTSBD327 01022 DTSBD327 01023 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBD327 01024 DTSBD327 01025 P4100-EXIT. DTSBD327 01026 EXIT. DTSBD327 01027 EJECT DTSBD327 01028 *************************************************************** DTSBD327 01029 * THIS PARAGRAPH FORMATS AND WRITES THE EXTRACT RECORDS DTSBD327 01030 * FOR THE MTAD RECORDS. DTSBD327 01031 *************************************************************** DTSBD327 01032 DTSBD327 01033 P4110-WRITE-MTAD-REC. DTSBD327 01034 DTSBD327 01035 DISPLAY 'BD327 P4100 - 1 ' MPRF-EMP-NO. DTSBD327 01036 IF MTAD-UC223-NO-88 DTSBD327 01037 GO TO P4110-EXIT. DTSBD327 01038 DTSBD327 01039 ADD +1 TO TAD-FORM-CNT. DTSBD327 01040 DTSBD327 01041 MOVE LOW-VALUES TO L111-RETURN-AREA. DTSBD327 01042 MOVE MPRF-EMP-NO TO L111-EMP-NO. DTSBD327 01043 SET L111-LOOKUP-TAD-88 TO TRUE. DTSBD327 01044 MOVE MTAD-ID-NO TO L111-ID-NO. DTSBD327 01045 DTSBD327 01046 PERFORM S111-LOOKUP-ADDR THRU S111-EXIT. DTSBD327 01047 DTSBD327 01048 IF L111-ADDR-FOUND-88 DTSBD327 01049 SET L112-TAD-ADDR-88 TO TRUE DTSBD327 01050 MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA DTSBD327 01051 PERFORM P4111-FORMAT-ADDR THRU P4111-EXIT DTSBD327 01052 ELSE DTSBD327 01053 MOVE ALL '?' TO R415-FMT-ADDR DTSBD327 01054 R415-ZIP DTSBD327 01055 R415-ADVANCED-BARCODE. DTSBD327 01056 DTSBD327 01057 MOVE 'TAD' TO EVL-ADDR-TYPE. DTSBD327 01058 MOVE MTAD-ID-NO TO EVL-ADDR-ID-NO. DTSBD327 01059 MOVE WRK-EMP-TOT-DUE TO EVL-TOT-BAL-AMT. DTSBD327 01060 DTSBD327 01061 DISPLAY 'BD327 P4100 - 2 ' MPRF-EMP-NO. DTSBD327 01062 PERFORM S1000-WRITE-RECS THRU S1000-EXIT. DTSBD327 01063 DTSBD327 01064 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSBD327 01065 PERFORM S910-READ THRU S910-EXIT. DTSBD327 01066 IF L910-NO-REC-88 DTSBD327 01067 PERFORM S999-ABEND THRU S999-EXIT. DTSBD327 01068 DTSBD327 01069 P4110-EXIT. DTSBD327 01070 EXIT. DTSBD327 01071 EJECT DTSBD327 01072 *************************************************************** DTSBD327 01073 * THIS PARAGRAPH FORMATS THE ADDRESS. DTSBD327 01074 *************************************************************** DTSBD327 01075 DTSBD327 01076 P4111-FORMAT-ADDR. DTSBD327 01077 DTSBD327 01078 SET L112-ANCHOR-FIRST-88 TO TRUE. DTSBD327 01079 MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME. DTSBD327 01080 DTSBD327 01081 PERFORM S112-FORMAT-ADDR THRU S112-EXIT. DTSBD327 01082 DTSBD327 01083 MOVE L112-MAILING-ADDRESS TO R415-FMT-ADDR. DTSBD327 01084 MOVE L112-ZIP TO R415-ZIP. DTSBD327 01085 MOVE L112-ADVANCED-BARCODE TO R415-ADVANCED-BARCODE. DTSBD327 01086 DTSBD327 01087 P4111-EXIT. DTSBD327 01088 EXIT. DTSBD327 01089 EJECT DTSBD327 01090 *************************************************************** DTSBD327 01091 * THIS PARAGRAPH CAUSES THE MOPO RECORDS TO BE PROCESSED. DTSBD327 01092 *************************************************************** DTSBD327 01093 DTSBD327 01094 P5000-PROCESS-MOPO. DTSBD327 01095 DTSBD327 01096 MOVE LOW-VALUES TO MOPO-KEY-AREA. DTSBD327 01097 MOVE MPRF-EMP-NO TO MOPO-EMP-NO. DTSBD327 01098 SET MOPO-OPO-88 TO TRUE. DTSBD327 01099 MOVE MOPO-KEY-AREA TO MSKL-KEY-AREA. DTSBD327 01100 DTSBD327 01101 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD327 01102 DTSBD327 01103 PERFORM P5100-SCAN-MOPO THRU P5100-EXIT DTSBD327 01104 UNTIL L910-NO-REC-88. DTSBD327 01105 DTSBD327 01106 P5000-EXIT. DTSBD327 01107 EXIT. DTSBD327 01108 EJECT DTSBD327 01109 *************************************************************** DTSBD327 01110 * THIS PARAGRAPH SCANS THE MOPO RECORDS. DTSBD327 01111 *************************************************************** DTSBD327 01112 DTSBD327 01113 P5100-SCAN-MOPO. DTSBD327 01114 DTSBD327 01115 MOVE MSKL-REC TO MOPO-REC. DTSBD327 01116 DTSBD327 01117 PERFORM P5110-WRITE-MOPO-REC THRU P5110-EXIT. DTSBD327 01118 DTSBD327 01119 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBD327 01120 DTSBD327 01121 P5100-EXIT. DTSBD327 01122 EXIT. DTSBD327 01123 EJECT DTSBD327 01124 *************************************************************** DTSBD327 01125 * THIS PARAGRAPH WRITES THE EXTRACT RECORDS FOR MOPO RECORDS. DTSBD327 01126 *************************************************************** DTSBD327 01127 DTSBD327 01128 P5110-WRITE-MOPO-REC. DTSBD327 01129 DTSBD327 01130 IF MOPO-UC223-NO-88 DTSBD327 01131 GO TO P5110-EXIT. DTSBD327 01132 DTSBD327 01133 ADD +1 TO OPO-FORM-CNT. DTSBD327 01134 DTSBD327 01135 MOVE LOW-VALUES TO L112-NAME-ADDRESS-AREA. DTSBD327 01136 SET L112-OPO-ADDR-88 TO TRUE. DTSBD327 01137 MOVE MOPO-NAME TO L112-NAME. DTSBD327 01138 MOVE MOPO-TITLE TO L112-TITLE. DTSBD327 01139 MOVE MOPO-ADDRESS TO L112-ADDRESS. DTSBD327 01140 DTSBD327 01141 PERFORM P4111-FORMAT-ADDR THRU P4111-EXIT. DTSBD327 01142 DTSBD327 01143 MOVE 'OPO' TO EVL-ADDR-TYPE DTSBD327 01144 MOVE MOPO-ID-NO TO EVL-ADDR-ID-NO. DTSBD327 01145 MOVE WRK-EMP-TOT-DUE TO EVL-TOT-BAL-AMT. DTSBD327 01146 DTSBD327 01147 PERFORM S1000-WRITE-RECS THRU S1000-EXIT. DTSBD327 01148 DTSBD327 01149 MOVE MOPO-KEY-AREA TO MSKL-KEY-AREA. DTSBD327 01150 PERFORM S910-READ THRU S910-EXIT. DTSBD327 01151 IF L910-NO-REC-88 DTSBD327 01152 PERFORM S999-ABEND THRU S999-EXIT. DTSBD327 01153 DTSBD327 01154 P5110-EXIT. DTSBD327 01155 EXIT. DTSBD327 01156 EJECT DTSBD327 01157 *************************************************************** DTSBD327 01158 * THIS PARAGRAPH CAUSES THE MTAA RECORDS TO BE PROCESSED. DTSBD327 01159 *************************************************************** DTSBD327 01160 DTSBD327 01161 P6000-PROCESS-MTAA. DTSBD327 01162 DTSBD327 01163 MOVE LOW-VALUES TO MTAA-KEY-AREA. DTSBD327 01164 MOVE MPRF-EMP-NO TO MTAA-EMP-NO. DTSBD327 01165 SET MTAA-TAA-88 TO TRUE. DTSBD327 01166 MOVE MTAA-KEY-AREA TO MSKL-KEY-AREA. DTSBD327 01167 DTSBD327 01168 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD327 01169 DTSBD327 01170 PERFORM P6100-SCAN-MTAA THRU P6100-EXIT DTSBD327 01171 UNTIL L910-NO-REC-88. DTSBD327 01172 DTSBD327 01173 P6000-EXIT. DTSBD327 01174 EXIT. DTSBD327 01175 EJECT DTSBD327 01176 *************************************************************** DTSBD327 01177 * THIS PARAGRAPH SCANS THE MTAA RECORDS. DTSBD327 01178 *************************************************************** DTSBD327 01179 DTSBD327 01180 P6100-SCAN-MTAA. DTSBD327 01181 DTSBD327 01182 MOVE MSKL-REC TO MTAA-REC. DTSBD327 01183 DTSBD327 01184 PERFORM P6110-WRITE-MTAA-REC THRU P6110-EXIT. DTSBD327 01185 DTSBD327 01186 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBD327 01187 DTSBD327 01188 P6100-EXIT. DTSBD327 01189 EXIT. DTSBD327 01190 EJECT DTSBD327 01191 *************************************************************** DTSBD327 01192 * THIS PARAGRAPH WRITES THE EXTRACT RECORDS FOR MTAA RECORDS. DTSBD327 01193 *************************************************************** DTSBD327 01194 DTSBD327 01195 P6110-WRITE-MTAA-REC. DTSBD327 01196 DTSBD327 01197 IF MTAA-UC223-NO-88 DTSBD327 01198 GO TO P6110-EXIT. DTSBD327 01199 DTSBD327 01200 ADD +1 TO TAA-FORM-CNT. DTSBD327 01201 DTSBD327 01202 MOVE LOW-VALUES TO L112-NAME-ADDRESS-AREA. DTSBD327 01203 SET L112-TAA-ADDR-88 TO TRUE. DTSBD327 01204 IF MTAA-NAME = SPACES DTSBD327 01205 MOVE MPRF-PRIMARY-NAME TO L112-NAME DTSBD327 01206 ELSE DTSBD327 01207 MOVE MTAA-NAME TO L112-NAME. DTSBD327 01208 MOVE MTAA-ADDRESS TO L112-ADDRESS. DTSBD327 01209 DTSBD327 01210 PERFORM P4111-FORMAT-ADDR THRU P4111-EXIT. DTSBD327 01211 DTSBD327 01212 MOVE 'TAA' TO EVL-ADDR-TYPE DTSBD327 01213 MOVE MTAA-ID-NO TO EVL-ADDR-ID-NO. DTSBD327 01214 MOVE WRK-EMP-TOT-DUE TO EVL-TOT-BAL-AMT. DTSBD327 01215 DTSBD327 01216 PERFORM S1000-WRITE-RECS THRU S1000-EXIT. DTSBD327 01217 DTSBD327 01218 MOVE MTAA-KEY-AREA TO MSKL-KEY-AREA. DTSBD327 01219 PERFORM S910-READ THRU S910-EXIT. DTSBD327 01220 IF L910-NO-REC-88 DTSBD327 01221 PERFORM S999-ABEND THRU S999-EXIT. DTSBD327 01222 DTSBD327 01223 P6110-EXIT. DTSBD327 01224 EXIT. DTSBD327 01225 EJECT DTSBD327 01226 *************************************************************** DTSBD327 01227 * THIS PARAGRAPH REWRITES THE MCOL RECORD IF THE TEXT WAS DTSBD327 01228 * ONLY TEMPORARY. DTSBD327 01229 *************************************************************** DTSBD327 01230 DTSBD327 01231 P7000-REWRITE-MCOL. DTSBD327 01232 DTSBD327 01233 IF MCOL-STMT-TEXT-PERM-YES-88 DTSBD327 01234 GO TO P7000-EXIT. DTSBD327 01235 DTSBD327 01236 SET MCOL-STMT-TEXT-TYPE-NONE-88 TO TRUE. DTSBD327 01237 SET MCOL-STMT-TEXT-PERM-NONE-88 TO TRUE. DTSBD327 01238 MOVE +0 TO MCOL-STMT-TEXT-CNT. DTSBD327 01239 MOVE LBCM-CURR-RUN-DATE TO MCOL-CHNG-DATE. DTSBD327 01240 MOVE MCOL-REC TO MSKL-REC. DTSBD327 01241 DTSBD327 01242 PERFORM S910-REWRITE THRU S910-EXIT. DTSBD327 01243 DTSBD327 01244 P7000-EXIT. DTSBD327 01245 EXIT. DTSBD327 01246 EJECT DTSBD327 01247 *************************************************************** DTSBD327 01248 * THIS PARAGRAPH WRITES THE R415 REPORT EXTRACT RECORDS. DTSBD327 01249 * IT ALSO WRITES A MEVL RECORD. DTSBD327 01250 *************************************************************** DTSBD327 01251 DTSBD327 01252 S1000-WRITE-RECS. DTSBD327 01253 DTSBD327 01254 MOVE LOW-VALUES TO R415-SORT-AREA. DTSBD327 01255 MOVE '415' TO R415-REC-TYPE. DTSBD327 01256 MOVE R415-ZIP TO R415-SORT-ZIP. DTSBD327 01257 MOVE MPRF-EMP-NO TO R415-EMP-NO. DTSBD327 01258 MOVE MPRF-FEIN TO R415-EMP-FEIN. DTSBD327 01259 PERFORM S946-WRITE-R415 THRU S946-EXIT. DTSBD327 01260 DTSBD327 01261 MOVE '416' TO R416-REC-TYPE. DTSBD327 01262 MOVE MPRF-EMP-NO TO R416-EMP-NO. DTSBD327 01263 MOVE WRK-PARM-INT-COMP-DATE TO R416-COMP-DATE. DTSBD327 01264 PERFORM S946-WRITE-R416 THRU S946-EXIT. DTSBD327 01265 DTSBD327 01266 ADD +1000 TO LBCM-EMP-ABSTIME. DTSBD327 01267 DTSBD327 01268 MOVE LBCM-EMP-ABSTIME TO L005-ABSTIME. DTSBD327 01269 PERFORM S005-FROM-ABSTIME THRU S005-EXIT. DTSBD327 01270 DTSBD327 01271 MOVE LOW-VALUES TO MEVL-REC. DTSBD327 01272 DTSBD327 01273 MOVE MPRF-EMP-NO TO MEVL-EMP-NO. DTSBD327 01274 SET MEVL-EVL-88 TO TRUE. DTSBD327 01275 MOVE L005-DATE TO MEVL-DATE. DTSBD327 01276 MOVE L005-TIME TO MEVL-TIME. DTSBD327 01277 MOVE +0 TO MEVL-PURGE-DATE. DTSBD327 01278 MOVE EVL-TEXT TO MEVL-TEXT. DTSBD327 01279 *** SET MEVL-SOURCE-SYSTEM-88 TO TRUE. DTSBD327 01280 MOVE T011-RESP-OP-ID TO MEVL-SOURCE. DTSBD327 01281 SET MEVL-NOT-CONVERTED-88 TO TRUE. DTSBD327 01282 MOVE LBCM-CURR-RUN-DATE TO MEVL-ESTB-DATE DTSBD327 01283 MEVL-CHNG-DATE. DTSBD327 01284 MOVE MEVL-REC TO MSKL-REC. DTSBD327 01285 DTSBD327 01286 PERFORM S910-WRITE THRU S910-EXIT. DTSBD327 01287 DTSBD327 01288 S1000-EXIT. DTSBD327 01289 EXIT. DTSBD327 01290 EJECT DTSBD327 01291 *************************************************************** DTSBD327 01292 * THIS PARAGRAPH INITIALIZES THE TABLE IN THE EXTRACT RECORD. DTSBD327 01293 *************************************************************** DTSBD327 01294 DTSBD327 01295 S2000-INITIALIZE-TABLE. DTSBD327 01296 DTSBD327 01297 MOVE LOW-VALUES TO R415-QTR-OCCURS (WRK-SUB). DTSBD327 01298 DTSBD327 01299 S2000-EXIT. DTSBD327 01300 EXIT. DTSBD327 01301 EJECT DTSBD327 01302 T0000-TERMINATE. DTSBD327 01303 DISPLAY ' T0000'. DTSBD327 01304 DISPLAY SPACE. DTSBD327 01305 DISPLAY '*** BD414 TERMINATION ***'. DTSBD327 01306 DISPLAY '*** EMPLOYERS BYPASSED: ' DTSBD327 01307 DISPLAY '*** CURR QTR ONLY DELINQUENT ' DTSBD327 01308 WRK-BYPASS-CNT. DTSBD327 01309 DISPLAY '*** EMPLOYERS WITH ASSESSMENTS ' DTSBD327 01310 WRK-ASSESS-CNT. DTSBD327 01311 SKIP2 DTSBD327 01312 T0000-EXIT. DTSBD327 01313 EXIT. DTSBD327 01314 EJECT DTSBD327 01315 S001-FROM-FED-8. DTSBD327 01316 SET L001-FROM-FED-8 TO TRUE. DTSBD327 01317 GO TO S001-DATE. DTSBD327 01318 SKIP1 DTSBD327 01319 S001-FROM-ABS-DAY. DTSBD327 01320 SET L001-FROM-ABS-DAY TO TRUE. DTSBD327 01321 GO TO S001-DATE. DTSBD327 01322 SKIP1 DTSBD327 01323 S001-FROM-CAL-6. DTSBD327 01324 SET L001-FROM-CAL-6 TO TRUE. DTSBD327 01325 GO TO S001-DATE. DTSBD327 01326 SKIP1 DTSBD327 01327 S001-DATE. DTSBD327 01328 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBD327 01329 S001-EXIT. DTSBD327 01330 EXIT. DTSBD327 01331 SKIP3 DTSBD327 01332 S004-FROM-5. DTSBD327 01333 SET L004-FROM-5 TO TRUE. DTSBD327 01334 GO TO S004-QTR. DTSBD327 01335 SKIP1 DTSBD327 01336 S004-FROM-ABS. DTSBD327 01337 SET L004-FROM-ABS TO TRUE. DTSBD327 01338 GO TO S004-QTR. DTSBD327 01339 SKIP1 DTSBD327 01340 S004-QTR. DTSBD327 01341 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBD327 01342 S004-EXIT. DTSBD327 01343 EXIT. DTSBD327 01344 SKIP3 DTSBD327 01345 S005-FROM-ABSTIME. DTSBD327 01346 SET L005-FROM-ABSTIME TO TRUE. DTSBD327 01347 GO TO S005-ABSTIME. DTSBD327 01348 SKIP1 DTSBD327 01349 S005-ABSTIME. DTSBD327 01350 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBD327 01351 S005-EXIT. DTSBD327 01352 EXIT. DTSBD327 01353 SKIP3 DTSBD327 01354 S082-LOOKUP-OP-ID. DTSBD327 01355 CALL 'DTSBU082' USING L082-LINK-AREA. DTSBD327 01356 S082-EXIT. DTSBD327 01357 EXIT. DTSBD327 01358 SKIP3 DTSBD327 01359 S101-PER-MONTH-NO. DTSBD327 01360 SET L101-PER-MONTH-NO-88 TO TRUE. DTSBD327 01361 GO TO S101-INT-CHARGE. DTSBD327 01362 DTSBD327 01363 S101-INT-CHARGE. DTSBD327 01364 CALL 'DTSBU101' USING L101-LINK-AREA. DTSBD327 01365 S101-EXIT. DTSBD327 01366 EXIT. DTSBD327 01367 SKIP3 DTSBD327 01368 S109-FIRST-PEN-INT-YRQ. DTSBD327 01369 SET L109-CMND-PEN-INT-QTR-88 TO TRUE. DTSBD327 01370 GO TO S109-SUR-RATE. DTSBD327 01371 DTSBD327 01372 S109-SUR-RATE. DTSBD327 01373 CALL 'DTSBU109' USING L109-LINK-AREA. DTSBD327 01374 S109-EXIT. DTSBD327 01375 EXIT. DTSBD327 01376 SKIP3 DTSBD327 01377 S111-LOOKUP-ADDR. DTSBD327 01378 CALL 'DTSBU111' USING L111-LINK-AREA. DTSBD327 01379 S111-EXIT. DTSBD327 01380 EXIT. DTSBD327 01381 SKIP3 DTSBD327 01382 S112-FORMAT-ADDR. DTSBD327 01383 CALL 'DTSBU112' USING L112-LINK-AREA. DTSBD327 01384 S112-EXIT. DTSBD327 01385 EXIT. DTSBD327 01386 SKIP3 DTSBD327 01387 S410-FILE-SCHED. DTSBD327 01388 CALL 'DTSBU410' USING L410-LINK-AREA. DTSBD327 01389 S410-EXIT. DTSBD327 01390 EXIT. DTSBD327 01391 SKIP3 DTSBD327 01392 S910-READ. DTSBD327 01393 SET L910-READ-88 TO TRUE. DTSBD327 01394 GO TO S910-MSTR-IO. DTSBD327 01395 SKIP1 DTSBD327 01396 S910-START-BROWSE. DTSBD327 01397 SET L910-START-BROWSE-88 TO TRUE. DTSBD327 01398 GO TO S910-MSTR-IO. DTSBD327 01399 SKIP1 DTSBD327 01400 S910-READ-NEXT. DTSBD327 01401 SET L910-READ-NEXT-88 TO TRUE. DTSBD327 01402 GO TO S910-MSTR-IO. DTSBD327 01403 SKIP1 DTSBD327 01404 S910-COUNT. DTSBD327 01405 SET L910-COUNT-88 TO TRUE. DTSBD327 01406 GO TO S910-MSTR-IO. DTSBD327 01407 SKIP1 DTSBD327 01408 S910-WRITE. DTSBD327 01409 SET L910-WRITE-88 TO TRUE. DTSBD327 01410 GO TO S910-MSTR-IO. DTSBD327 01411 SKIP1 DTSBD327 01412 S910-REWRITE. DTSBD327 01413 SET L910-REWRITE-88 TO TRUE. DTSBD327 01414 GO TO S910-MSTR-IO. DTSBD327 01415 SKIP1 DTSBD327 01416 S910-DELETE. DTSBD327 01417 SET L910-DELETE-88 TO TRUE. DTSBD327 01418 GO TO S910-MSTR-IO. DTSBD327 01419 SKIP1 DTSBD327 01420 S910-MSTR-IO. DTSBD327 01421 CALL 'DTSBU910' USING L910-LINK-AREA DTSBD327 01422 MSKL-REC. DTSBD327 01423 S910-EXIT. DTSBD327 01424 EXIT. DTSBD327 01425 SKIP3 DTSBD327 01426 S946-WRITE-R415. DTSBD327 01427 CALL 'DTSBU946' USING R415-REC. DTSBD327 01428 GO TO S946-EXIT. DTSBD327 01429 SKIP1 DTSBD327 01430 S946-WRITE-R416. DTSBD327 01431 CALL 'DTSBU946' USING R416-REC. DTSBD327 01432 GO TO S946-EXIT. DTSBD327 01433 SKIP1 DTSBD327 01434 S946-WRITE-R907. DTSBD327 01435 MOVE '907' TO R907-REC-TYPE. DTSBD327 01436 CALL 'DTSBU946' USING R907-REC. DTSBD327 01437 GO TO S946-EXIT. DTSBD327 01438 SKIP1 DTSBD327 01439 S946-EXIT. DTSBD327 01440 EXIT. DTSBD327 01441 SKIP3 DTSBD327 01442 S999-ABEND. DTSBD327 01443 DISPLAY '*** DTSBD327 ABENDING. ' DTSBD327 01444 ABEND-MSG. DTSBD327 01445 SKIP1 DTSBD327 01446 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBD327 01447 S999-EXIT. DTSBD327 01448 EXIT. DTSBD327