00001 IDENTIFICATION DIVISION. 10/08/24 00002 PROGRAM-ID. DTSBE414. DTSBE414 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV177 00004 DATE-WRITTEN. AUGUST 1994. DTSBE414 00005 MODIFIED BY TRW JAN. 1999 DTSBE414 00006 DATE-COMPILED. DTSBE414 00007 SKIP3 DTSBE414 00008 ****** DTSBE414 00009 * DTSBE414 00010 * CALLING SEQUENCE: DTSBD400 CALLS DTSBE414 00011 * DTSBE414 WHICH CREATES DTSIR414 RECORDS DTSBE414 00012 * DTSBE414 WHICH CREATES DTSIR416 RECORDS DTSBE414 00013 * DTSBD800 CALLS DTSBE414 00014 * DTSBR414 WHICH READS DTSIR414 RECORDS DTSBE414 00015 * DTSBR416 WHICH READS DTSIR416 RECORDS DTSBE414 00016 * DTSBE414 00017 * FUNCTION: DEBIT STATEMENT EXTRACT. DTSBE414 00018 * DTSBE414 00019 * MODIFICATION LOG: DTSBE414 00020 * DTSBE414 00021 * 05/15/95 HAVING AN OPEN BANKRUPTCY NO LONGER EXCLUDES THE DTSBE414 00022 * EMPLOYER. DTSBE414 00023 * WORK ORDER: CR086 PROGRAMMER: RHC DTSBE414 00024 * DTSBE414 00025 * 10/29/1999 REMOVED REQUIREMENT FOR RESPONSIBLE OPERATOR ID DTSBE414 00026 * PARM. NAME IS NOT PRINTED ON DC STATMENTS. DTSBE414 00027 * WORK ORDER: PROGRAMMER: GD DTSBE414 00028 * DTSBE414 00029 * 09/25/2000 EXCLUDE QUARTERS PRIOR TO THE PETITION DATE OF DTSBE414 00030 * AN OPEN BANKRUPTCHY. DTSBE414 00031 * WORK ORDER: DIR00080 PROGRAMMER: GD DTSBE414 00032 * DTSBE414 00033 * 03/12/2001 EXCLUDE EMPLOYERS WHO HAVE NOT FILED A REPORT FORDTSBE414 00034 * THE MOST RECENT DELINQUENT QUARTER IF THEY HAVE DTSBE414 00035 * NO OTHER MISSING REPORTS AND NO BALANCE DUE. DTSBE414 00036 * THE MISSING REPORT WILL BE RESOLVED THROUGH THE DTSBE414 00037 * NORMAL DELINQUENCY PROCESS. DTSBE414 00038 * BEGIN SENDING BILLS TO SUCH EMPLOYERS ONCE THE DTSBE414 00039 * QUARTER HAS BEEN ESTIMATED. DTSBE414 00040 * WORK ORDER: DIR00087 PROGRAMMER: GD DTSBE414 00041 * DTSBE414 00042 * 08/30/2002 MODIFY PROGRAM TO PRINT ONE LINE ON BILL FOR DTSBE414 00043 * ANNUAL FILERS. THE QUARTER WILL BE SET TO ZERO.DTSBE414 00044 * WORK ORDER: HOUSEHOLD PROGRAMMER: ZL1 DTSBE414 00045 * DTSBE414 00046 * 02/17/2003 MODIFY PROGRAM TO INCLUDE FEIN ON BILLS. DTSBE414 00047 * WORK ORDER: HOUSEHOLD PROGRAMMER: ZL1 DTSBE414 00048 * DTSBE414 00049 * 10/26/2005 MODIFY PROGRAM DO NOT SEND BILL WITHIN 30 DAYS DTSBE414 00050 * PERIOD WHEN A STATEMENT OF ACCOUNT HAS BEEN SENT DTSBE414 00051 * TO EMPLOYER THRU THE WEB CREDIT/DEBIT APPLICATIONDTSBE414 00052 * WORK ORDER: WEB PAGE DEVELOPMENT PROGRAMMER: RW1 DTSBE414 00053 * DTSBE414 00054 * 12/19/05 ADD MPRF-RETURN-MAIL-IND.IF MPRF-RETURN-MAIL-YES-88DTSBE414 00055 * ON MPRF-EMP-NO, BY PASS THAT ACCOUNT EXTRACT INFO- DTSBE414 00056 * MATION AND SEND NO DEBIT STATEMENT REPORT TO THOSE DTSBE414 00057 * EMPLOYER. DTSBE414 00058 * WORK ORDER: PROGRAMMER: RW1 DTSBE414 00059 * DTSBE414 00060 * 03/08/2006 MODIFY PROGRAM TO SEPERATE SUR CHARGES FROM UI DTSBE414 00061 * CHARGES. SUR CHARGES WILL BE REPORTED ON A DTSBE414 00062 * SEPERATE COLUMN ON THE MONTHLY BILL. DTSBE414 00063 * MODIFIED P3111 TO USE ONLY UI TAX TO COMPUTE DTSBE414 00064 * INTEREST. DTSBE414 00065 * WORK ORDER: DC ADMIN ASSESSMENT PROGRAMMER: ZL1 DTSBE414 00066 * DTSBE414 00067 * 03/20/2006 MODIFIED P0100 TO EXCLUDE ADMIN ASSESSMENT DTSBE414 00068 * BALANCE DUE FROM BILL IF IT WAS ESTABLISHED DTSBE414 00069 * DURING THE SUBJECT MONTH. DTSBE414 00070 * WORK ORDER: DC ADMIN ASSESSMENT PROGRAMMER: GD1 DTSBE414 00071 * DTSBE414 00072 * 11/15/2006 MODIFIED TO EXCLUDE ADMIN ASSESSMENT DTSBE414 00073 * BALANCE DUE FROM BILL IF IT IS LESS THAN $1.00 DTSBE414 00074 * DURING THE SUBJECT MONTH. DTSBE414 00075 * WORK ORDER: DC ADMIN ASSESSMENT PROGRAMMER: ZL1 DTSBE414 00076 * DTSBE414 00077 * 01/31/2008 MODIFIED ADMINISTRATIVE ASSESSMENT PROCESS DTSBE414 00078 * TO INCLUDE PENALTY AND INTEREST CALCULATION DTSBE414 00079 * STARTING WITH 2008/1. DTSBE414 00080 * REFERENCE: ADMIN ASSESS PROGRAMMER: RW1 DTSBE414 00081 * DTSBE414 00082 * 09/23/2008 MINOR CLEANUP OF THE PROCESS TO ENSURE THAT DTSBE414 00083 * EVERYTHING IS CONSISTENT WITH DIR 117: DTSBE414 00084 * - SEND BILL ONLY IF TOTAL BALANCE DUE IS DTSBE414 00085 * MORE THAN $15.00 DTSBE414 00086 * - DO NOT SEND BILL IF EITHER A DEBIT MEMO DTSBE414 00087 * OR A SELF-INSURED BILL HAVE BEEN SENT DTSBE414 00088 * DURING THE CURRENT MONTH. DTSBE414 00089 * REFERENCE: DIR 117 PROGRAMMER: GD DTSBE414 00090 * DTSBE414 00091 * 10/08/2008 REMOVE ADMINISTRATIVE ASSESSMENT FROM INTEREST DTSBE414 00092 * CALCULATION FOR SELF-INSURED EMPLOYERS. DTSBE414 00093 * REFERENCE: DIR 117 PROGRAMMER: GD DTSBE414 00094 * DTSBE414 00095 * 10/22/2008 UPDATED P3110 - QUARTER TOTAL (WRK-TOT-DUE) DTSBE414 00096 * IS NOT ADDED TO EMP TOTAL (WRK-EMP-TOT-DUE) DTSBE414 00097 * IF THE QUARTER HAS NOT BEEN UPDATED IN MORE DTSBE414 00098 * THAN 2 YEARS. IN THIS CASE, THE QUARTER DTSBE414 00099 * WILL NOT BE LISTED BY DTSBR414 ON THE BILL. DTSBE414 00100 * ALL TESTS ON THE TOTAL AMOUNT OWED NEED TO DTSBE414 00101 * EXCLUDE QUARTERS THAT WILL NOT APPEAR ON THE DTSBE414 00102 * BILL. DTSBE414 00103 * WRK-EMP-TOT-DUE SHOULD NOT INCLUDE THE DTSBE414 00104 * BALANCE FROM QUARTERS BYPASSED IN ORDER TO DTSBE414 00105 * CORRECTLY DETERMINE IF THE TOTAL BALANCE IS DTSBE414 00106 * GREATER THAN THE THRESHOLD. DTSBE414 00107 * INCLUDE EMPLOYERS WITH MISSING REPORTS DTSBE414 00108 * REGARDLESS OF AMOUNT DUE ONLY IF THE MISSING DTSBE414 00109 * REPORTS ARE WITHIN THE LAST TWO YEARS. DTSBE414 00110 * EXCLUDE BALANCES DUE LESS THAN .03. DTSBE414 00111 * REFERENCE: PROGRAMMER: GD DTSBE414 00112 * DTSBE414 00113 * DTSBE414 00114 * 08/12/200 REMOVED OR CHANGED RULES FOR SELECTING EMPLYRS CL117 00115 * AND QUARTERS ON BILLS. DTSBE414 00116 * - SEND BILL ONLY IF TOTAL BALANCE DUE IS DTSBE414 00117 * MORE THAN $15.00 DTSBE414 00118 * REFERENCE: RULE CHANGES PROGRAMMER: ZL1 DTSBE414 00119 * DTSBE414 00120 * 06/17/2014 MODIFIED THE PROCESS TO CREATE BILL FOR ANY DTSBE414 00121 * EMPLOYER WHO IS DELINQUENT. CREATING ALL BILLS DTSBE414 00122 * ELIMINATES THE REPORT TITLED EMPLOYERS WITH DTSBE414 00123 * GREATER THAN FOUR DELINQUENT QUARTERS DTSBE414 00124 * REFERENCE: P. HOLMES REQ PROGRAMMER: NH1 DTSBE414 00125 * DTSBE414 00126 * DTSBE414 00127 * 09/27/2015 REMOVED TOLERANCE AMT FOR CREATING SOA ALL DTSBE414 00128 * AMOUNT WILL BE BILLED AS OF 10/01/15. DTSBE414 00129 * REFERENCE: TOLERANCE PROGRAMMER: ZL1 DTSBE414 00130 * DTSBE414 00131 * CL145 00132 * 03/11/2024 REMOVED TOLERANCE OF .03 BALANCE DUE NOT TO CL145 00133 * COUNTED CL145 00134 * REFERENCE: TOLERANCE PROGRAMMER: ZL1 CL145 00135 * CL145 00136 * XX/XX/XXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE414 00137 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE414 00138 * WORK ORDER: PROGRAMMER: XXX DTSBE414 00139 * DTSBE414 00140 * DTSBE414 00141 * DESCRIPTION: DTSBE414 00142 * DTSBE414 00143 * DTSBE414 00144 * INITIATION: DTSBE414 00145 * DTSBE414 00146 * SET LECM-MST-OPEN-UPDATE-88 TO TRUE. DTSBE414 00147 * SET LECM-REF-OPEN-READ-88 TO TRUE. DTSBE414 00148 * DTSBE414 00149 * NO PARAMETERS ARE INPUT. DTSBE414 00150 * DTSBE414 00151 * DTSBE414 00152 * PROCESSING: DTSBE414 00153 * DTSBE414 00154 * SEE PRINTED OUTPUTS DESCRIPTION AND LAYOUTS (414R1 AND DTSBE414 00155 * R416R1). DTSBE414 00156 * DTSBE414 00157 * IF A DEBIT STATEMENT IS NOT GENERATED BECAUSE ALL DTSBE414 00158 * OCCURRENCES OF MTAD-DEBIT-MEMO-IND INDICATE DTSBE414 00159 * MTAD-NO-DEBIT-MEMO-88, THEN WRITE A R907 RECORD, DTSBE414 00160 * REPORTING THE SITUATION. DTSBE414 00161 * DTSBE414 00162 * DTSBE414 00163 * TERMINATION: DTSBE414 00164 * DTSBE414 00165 * NONE. DTSBE414 00166 * DTSBE414 00167 * DTSBE414 00168 * RECORDS READ: DTSBE414 00169 * DTSBE414 00170 * MASTER: DTSBE414 00171 * DTSBE414 00172 * MQTR DTSBE414 00173 * MAPL DTSBE414 00174 * MCOL DTSBE414 00175 * MTAD DTSBE414 00176 * MTAA DTSBE414 00177 * MOPO DTSBE414 00178 * DTSBE414 00179 * DTSBE414 00180 * ALTERNATE INDEX: DTSBE414 00181 * DTSBE414 00182 * NONE. DTSBE414 00183 * DTSBE414 00184 * DTSBE414 00185 * REFERENCE: DTSBE414 00186 * DTSBE414 00187 * NONE. DTSBE414 00188 * DTSBE414 00189 * DTSBE414 00190 * RECORDS UPDATED: DTSBE414 00191 * DTSBE414 00192 * MCOL (REWRITE). DTSBE414 00193 * MEVL (WRITE). DTSBE414 00194 * DTSBE414 00195 * DTSBE414 00196 * REPORT RECORDS WRITTEN: DTSBE414 00197 * DTSBE414 00198 * R414R1 STATEMENT OF ACCOUNT (DEBITS). DTSBE414 00199 * R414R2 LISTING FOR ACCOUNTS WITH MORE THAN FOUR DTSBE414 00200 * DELINGUENT QUARTERS. DTSBE414 00201 * R416 STATEMENT OF ACCOUNT (DEBITS) CONTROL REPORT. DTSBE414 00202 * R907 UNUSUAL CONDITIONS ENCOUNTERED REPORT RECORD. DTSBE414 00203 * DTSBE414 00204 * DTSBE414 00205 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBE414 00206 * DTSBE414 00207 * NONE. DTSBE414 00208 * DTSBE414 00209 * DTSBE414 00210 * MODULES CALLED: DTSBE414 00211 * DTSBE414 00212 * DTSBU001 DATE EDIT/CONVERSION. DTSBE414 00213 * DTSBU005 ABSOLUTE TIME CONVERSION/EDIT. DTSBE414 00214 * DTSBU061 FIELD REP ACCOUNT DTSBE414 00215 * DTSBU082 OP ID VERIFY/DESCRIPTION. DTSBE414 00216 * DTSBU101 PENALTY AND INTEREST COMPUTATION. DTSBE414 00217 * DTSBU112 ADDRESS FORMAT. DTSBE414 00218 * DTSBU910 MASTER FILE I/O DRIVER. DTSBE414 00219 * DTSBU946 VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1. DTSBE414 00220 * DTSBE414 00221 * DTSBE414 00222 * VERMONT REFERENCE: DTSBE414 00223 * DTSBE414 00224 * TXBE311 DTSBE414 00225 * DTSBE414 00226 ****** DTSBE414 00227 SKIP3 DTSBE414 00228 ENVIRONMENT DIVISION. DTSBE414 00229 CONFIGURATION SECTION. DTSBE414 00230 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DTSBE414 00231 SKIP1 DTSBE414 00232 INPUT-OUTPUT SECTION. DTSBE414 00233 SKIP1 DTSBE414 00234 FILE-CONTROL. DTSBE414 00235 DTSBE414 00236 SELECT EMP-RPT-FILE ASSIGN TO DTSBX212. DTSBE414 00237 SKIP3 DTSBE414 00238 DATA DIVISION. DTSBE414 00239 SKIP3 DTSBE414 00240 FILE SECTION. DTSBE414 00241 EJECT DTSBE414 00242 FD EMP-RPT-FILE DTSBE414 00243 RECORDING MODE IS F DTSBE414 00244 BLOCK CONTAINS 0 RECORDS DTSBE414 00245 LABEL RECORDS ARE OMITTED. DTSBE414 00246 DTSBE414 00247 01 EMP-RPT-REC PIC X(106). DTSBE414 00248 DTSBE414 00249 DTSBE414 00250 SKIP3 DTSBE414 00251 WORKING-STORAGE SECTION. DTSBE414 002515 77 PAN-VALET PICTURE X(24) VALUE '177DTSBE414 10/08/24'. DTSBE414 00252 77 PAN-VALET PICTURE X(24) VALUE '004DTSBE414 10/01/15'. DTSBE414 00253 77 PAN-VALET PICTURE X(24) VALUE '057DTSBE414 06/26/14'. DTSBE414 00254 77 PAN-VALET PICTURE X(24) VALUE '013DTSBE414 06/17/14'. DTSBE414 00255 SKIP3 DTSBE414 00256 01 WRK-AREA. DTSBE414 00257 *& DTSBE414 00258 05 ERROR-CNT PIC 9(07) VALUE ZERO. DTSBE414 00259 05 WRK-BYPASS-TBL PIC 9(07) VALUE ZERO. DTSBE414 00260 05 WRK-BYPASS-CNT PIC 9(07) VALUE ZERO. DTSBE414 00261 05 WRK-ASSESS-CNT PIC 9(07) VALUE ZERO. DTSBE414 00262 *& DTSBE414 00263 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +414.DTSBE414 00264 SKIP1 DTSBE414 00265 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBE414'.DTSBE414 00266 SKIP3 DTSBE414 00267 05 ABEND-MSG PIC X(60). DTSBE414 00268 SKIP3 DTSBE414 00269 05 WRK-PARM-INT-COMP-DATE PIC S9(09) COMP-3. DTSBE414 00270 SKIP1 DTSBE414 00271 05 WRK-PARM-REIMB-CUTOFF-DATE PIC S9(09) COMP-3. DTSBE414 00272 SKIP1 DTSBE414 00273 05 WRK-PARM-RESP-OP-ID PIC X(08). DTSBE414 00274 SKIP3 DTSBE414 00275 05 WRK-STMT-DATE PIC S9(09) COMP-3. DTSBE414 00276 SKIP1 DTSBE414 00277 05 WRK-LAST-ACCT-UPDATE-DATE PIC S9(09) COMP-3. DTSBE414 00278 DTSBE414 00279 05 WRK-FIRST-PEN-INT-YRQ PIC S9(05) COMP-3. DTSBE414 00280 *RW1 DTSBE414 00281 05 WRK-MEVL-READ-CNT PIC 9(07) VALUE ZERO. DTSBE414 00282 05 WRK-MEVL-REC-NOT-FIND-CNT PIC 9(07) VALUE ZERO. DTSBE414 00283 05 WRK-WEB-STMT-ACCT-SEND-CNT PIC 9(07) VALUE ZERO. DTSBE414 00284 05 WRK-MEVL-DATE-1-CNT PIC 9(07) VALUE ZERO. DTSBE414 00285 05 WRK-MEVL-DATE-2-CNT PIC 9(07) VALUE ZERO. DTSBE414 00286 05 WRK-EMPL-MAIL-CNT PIC 9(07) VALUE ZERO. DTSBE414 00287 05 WRK-EMPL-CNT-6 PIC 9(07) VALUE ZERO. DTSBE414 00288 05 WRK-EMPL-CNT-50 PIC 9(07) VALUE ZERO. DTSBE414 00289 DTSBE414 00290 05 WRK-CMPL-MONTH-BEGIN-DATE PIC S9(09) COMP-3 VALUE +0. DTSBE414 00291 05 WRK-CMPL-MONTH PIC 9(08) VALUE 0. CL165 00292 05 WRK-CMPL-MONTHZ REDEFINES WRK-CMPL-MONTH. CL163 00293 10 WRK-CMPL-MONTHZYY PIC 9999. CL163 00294 10 WRK-CMPL-MONTHZMM PIC 99. CL163 00295 10 WRK-CMPL-MONTHZDD PIC 99. CL163 00296 CL165 00297 05 WRK-FILLER PIC X(10) VALUE SPACES. CL163 00298 05 WRK-MEVL-DATE-1 PIC S9(09) COMP-3 CL163 00299 VALUE +020051024. DTSBE414 00300 05 WRK-MEVL-DATE-2 PIC S9(09) COMP-3 DTSBE414 00301 VALUE +020051025. DTSBE414 00302 05 DISP-DATE PIC X(10). DTSBE414 00303 05 DISP-DEBIT PIC X(05). DTSBE414 00304 05 DISP-MEVL-DATE PIC X(10). DTSBE414 00305 05 DISP-MEVL-DATE-1 PIC X(10). DTSBE414 00306 05 DISP-MEVL-DATE-2 PIC X(10). DTSBE414 00307 05 WRK-ONLINE-BILL-IND PIC X(01). DTSBE414 00308 88 WRK-ONLINE-BILL-YES-88 VALUE 'Y'. DTSBE414 00309 88 WRK-ONLINE-BILL-NO-88 VALUE 'N'. DTSBE414 00310 05 WRK-ADMIN-SENT-IND PIC X(01). CL163 00311 88 WRK-ADMIN-SENT-YES-88 VALUE 'Y'. CL163 00312 88 WRK-ADMIN-SENT-NO-88 VALUE 'N'. CL163 00313 *RW2 DTSBE414 00314 05 WRK-BNK-PETITION-DATE PIC 9(08). DTSBE414 00315 05 FILLER REDEFINES WRK-BNK-PETITION-DATE. DTSBE414 00316 10 WRK-BNK-PETITION-DATE-YYYY PIC 9(04). DTSBE414 00317 10 WRK-BNK-PETITION-DATE-MM PIC 9(02). DTSBE414 00318 10 WRK-BNK-PETITION-DATE-DD PIC 9(02). DTSBE414 00319 05 WRK-BNK-PETITION-YRQ PIC 9(05). DTSBE414 00320 05 FILLER REDEFINES WRK-BNK-PETITION-YRQ. DTSBE414 00321 10 WRK-BNK-PETITION-YRQ-YYYY PIC 9(04). DTSBE414 00322 10 WRK-BNK-PETITION-YRQ-Q PIC 9(01). DTSBE414 00323 SKIP3 DTSBE414 00324 05 WRK-BNK-FIRST-BILL-YRQ PIC S9(05) COMP-3. DTSBE414 00325 SKIP1 DTSBE414 00326 05 WRK-MAPL-YRQ-CNT PIC S9(04) COMP. DTSBE414 00327 05 WRK-MAPL-YRQ OCCURS 400 TIMES DTSBE414 00328 INDEXED BY WRK-MAPL-YRQ-IDX DTSBE414 00329 PIC S9(05) COMP-3. DTSBE414 00330 SKIP3 DTSBE414 00331 05 STMT-TEXT-IND PIC X(01). DTSBE414 00332 DTSBE414 00333 05 TAD-FORM-CNT PIC S9(04) COMP. DTSBE414 00334 DTSBE414 00335 05 TAA-FORM-CNT PIC S9(04) COMP. DTSBE414 00336 05 WRK-GT2YR-CUTOFF-DATE PIC S9(09) COMP-3 VALUE 0. DTSBE414 00337 05 WRK-CUTOFF-YRQ PIC S9(05) COMP-3 VALUE 0. DTSBE414 00338 05 WRK-MISSING-RPT-CNT PIC S9(03) COMP-3 VALUE 0. DTSBE414 00339 05 WRK-ESTIMAT-RPT-CNT PIC S9(03) COMP-3 VALUE 0. CL100 00340 DTSBE414 00341 05 WRK-MLIN-IND PIC X(01). CL114 00342 88 WRK-MLIN-OK VALUE 'Y'. CL114 00343 88 WRK-MLIN-NO-REC VALUE 'N'. CL114 00344 CL114 00345 05 OPO-FORM-CNT PIC S9(04) COMP. DTSBE414 00346 DTSBE414 00347 05 WRK-SUB PIC S9(04) COMP. DTSBE414 00348 DTSBE414 00349 05 WRK-EMP-TOT-DUE PIC S9(09)V9(02) COMP-3. DTSBE414 00350 05 WRK-TOT-SUR-DUE PIC S9(09)V9(02) COMP-3. DTSBE414 00351 05 AMT-DISP1 PIC ZZZZZZZZ9.99. DTSBE414 00352 05 AMT-DISP2 PIC ZZZZZZZZ9.99. DTSBE414 00353 05 WRK-YRQ PIC 9(05). DTSBE414 00354 05 FILLER REDEFINES WRK-YRQ. DTSBE414 00355 10 WRK-YRQ-YR PIC 9(04). DTSBE414 00356 10 WRK-YRQ-Q PIC 9(01). DTSBE414 00357 DTSBE414 00358 05 WRK-CURR-ANN-YRQ PIC 9(05). DTSBE414 00359 05 FILLER REDEFINES WRK-CURR-ANN-YRQ. DTSBE414 00360 10 WRK-CURR-ANN-YEAR PIC 9(04). DTSBE414 00361 10 WRK-CURR-ANN-Q PIC 9(01). DTSBE414 00362 DTSBE414 00363 01 WRK-BUCKETS. DTSBE414 00364 DTSBE414 00365 05 WRK-TAX-DUE PIC S9(09)V9(02) COMP-3. DTSBE414 00366 05 WRK-PEN-DUE PIC S9(09)V9(02) COMP-3. DTSBE414 00367 05 WRK-INT-DUE PIC S9(09)V9(02) COMP-3. DTSBE414 00368 05 WRK-SUR-DUE PIC S9(09)V9(02) COMP-3. DTSBE414 00369 05 WRK-TOT-DUE PIC S9(09)V9(02) COMP-3. DTSBE414 00370 DTSBE414 00371 05 WRK-TOLERANCE-AMT PIC S9(09)V9(02) COMP-3 DTSBE414 00372 VALUE +5.00. CL*63 00373 05 HOLD-YRQ PIC S9(05) COMP-3. DTSBE414 00374 DTSBE414 00375 05 EVL-TEXT. DTSBE414 00376 10 FILLER PIC X(19) DTSBE414 00377 VALUE 'DEBIT STATEMENT TO '. DTSBE414 00378 10 EVL-ADDR-TYPE PIC X(04). DTSBE414 00379 10 EVL-ADDR-ID-NO PIC ZZ9. DTSBE414 00380 10 FILLER PIC X(10) DTSBE414 00381 VALUE '. TOT BAL:'. DTSBE414 00382 10 EVL-TOT-BAL-AMT PIC ZZZ,ZZZ,ZZ9.99. DTSBE414 00383 EJECT DTSBE414 00384 01 MSG-AREA. DTSBE414 00385 05 MSG1-AREA. DTSBE414 00386 10 MSG1-ID PIC X(03) DTSBE414 00387 VALUE '416'. DTSBE414 00388 10 MSG1-TEXT. DTSBE414 00389 15 FILLER PIC X(40) DTSBE414 00390 VALUE 'DEBIT EXISTS BUT ALL MTAD OCCURRENCES IN'. DTSBE414 00391 15 FILLER PIC X(40) DTSBE414 00392 VALUE 'DICATE NO DEBIT MEMO. NO DEBIT STATEME'. DTSBE414 00393 15 FILLER PIC X(20) DTSBE414 00394 VALUE 'NT TO MTAD GENERATED'. DTSBE414 00395 SKIP1 DTSBE414 00396 05 MSG2-AREA. DTSBE414 00397 10 MSG2-ID PIC X(03) DTSBE414 00398 VALUE '417'. DTSBE414 00399 10 MSG2-TEXT. DTSBE414 00400 15 FILLER PIC X(40) DTSBE414 00401 VALUE 'MCOL-STMT-TEXT-TYPE INDICATES CREDIT TEX'. DTSBE414 00402 15 FILLER PIC X(40) DTSBE414 00403 VALUE 'T. NO TEXT PRINTED ON BATCH GENERATED D'. DTSBE414 00404 15 FILLER PIC X(20) DTSBE414 00405 VALUE 'EBIT STATEMENT.'. DTSBE414 00406 SKIP1 DTSBE414 00407 05 MSG3-AREA. DTSBE414 00408 10 MSG3-ID PIC X(03) DTSBE414 00409 VALUE '418'. DTSBE414 00410 10 MSG3-TEXT. DTSBE414 00411 15 FILLER PIC X(40) DTSBE414 00412 VALUE 'NUMBER OF DEBIT STATEMENT QUARTERS EXCEE'. DTSBE414 00413 15 FILLER PIC X(40) DTSBE414 00414 VALUE 'DS 50. DEBIT STATEMENT NOT PRINTED. '. DTSBE414 00415 15 FILLER PIC X(20) DTSBE414 00416 VALUE ' '. DTSBE414 00417 EJECT DTSBE414 00418 01 WRK-TABLES. DTSBE414 00419 05 WRK-EMP-NO PIC 9(06) VALUE ZEROS. DTSBE414 00420 05 TF-SUB PIC S9(07) COMP-3. DTSBE414 00421 05 TF-MAX PIC S9(07) COMP-3 DTSBE414 00422 VALUE +999999. DTSBE414 00423 05 TRANS-FILE-RPTS OCCURS 999999 TIMES. DTSBE414 00424 10 TRANS-FILE-RPT-IND PIC X(01). DTSBE414 00425 88 TF-RPT-FOUND-YES-88 VALUE 'Y'. DTSBE414 00426 88 TF-RPT-FOUND-NO-88 VALUE 'N'. DTSBE414 00427 10 TRANS-BYPASSED-IND PIC X(01). DTSBE414 00428 88 TF-BYPASSED-YES-88 VALUE 'Y'. DTSBE414 00429 88 TF-BYPASSED-NO-88 VALUE 'N'. DTSBE414 00430 EJECT DTSBE414 00431 SKIP3 DTSBE414 00432 01 W-EMP-RPT-REC. DTSBE414 00433 ++INCLUDE DTSIX212 DTSBE414 00434 01 R414-REC. DTSBE414 00435 ++INCLUDE DTSIR414 DTSBE414 00436 SKIP3 DTSBE414 00437 01 L001-LINK-AREA. DTSBE414 00438 ++INCLUDE DTSIL001 DTSBE414 00439 EJECT DTSBE414 00440 01 L004-LINK-AREA. DTSBE414 00441 ++INCLUDE DTSIL004 DTSBE414 00442 EJECT DTSBE414 00443 01 L005-LINK-AREA. DTSBE414 00444 ++INCLUDE DTSIL005 DTSBE414 00445 EJECT DTSBE414 00446 01 L082-LINK-AREA. DTSBE414 00447 ++INCLUDE DTSIL082 DTSBE414 00448 EJECT DTSBE414 00449 01 L061-LINK-AREA. DTSBE414 00450 ++INCLUDE DTSIL061 DTSBE414 00451 EJECT DTSBE414 00452 01 L101-LINK-AREA. DTSBE414 00453 ++INCLUDE DTSIL101 DTSBE414 00454 EJECT DTSBE414 00455 01 L109-LINK-AREA. DTSBE414 00456 ++INCLUDE DTSIL109 DTSBE414 00457 EJECT DTSBE414 00458 01 L111-LINK-AREA. DTSBE414 00459 ++INCLUDE DTSIL111 DTSBE414 00460 EJECT DTSBE414 00461 01 L112-LINK-AREA. DTSBE414 00462 ++INCLUDE DTSIL112 DTSBE414 00463 EJECT DTSBE414 00464 01 L910-LINK-AREA. DTSBE414 00465 ++INCLUDE DTSIL910 DTSBE414 00466 SKIP3 DTSBE414 00467 01 L410-LINK-AREA. DTSBE414 00468 ++INCLUDE DTSIL410 DTSBE414 00469 SKIP3 DTSBE414 00470 01 MSKL-REC. DTSBE414 00471 ++INCLUDE DTSIMSKL DTSBE414 00472 SKIP3 DTSBE414 00473 01 MHDR-REC. DTSBE414 00474 ++INCLUDE DTSIMHDR DTSBE414 00475 SKIP3 DTSBE414 00476 01 MQTR-REC. DTSBE414 00477 ++INCLUDE DTSIMQTR DTSBE414 00478 SKIP3 DTSBE414 00479 01 MLIN-REC. CL110 00480 ++INCLUDE DTSIMLIN CL110 00481 SKIP3 CL110 00482 01 MAPL-REC. DTSBE414 00483 ++INCLUDE DTSIMAPL DTSBE414 00484 SKIP3 DTSBE414 00485 01 MCOL-REC. DTSBE414 00486 ++INCLUDE DTSIMCOL DTSBE414 00487 SKIP3 DTSBE414 00488 01 MEVL-REC. DTSBE414 00489 ++INCLUDE DTSIMEVL DTSBE414 00490 SKIP3 DTSBE414 00491 01 MTAD-REC. DTSBE414 00492 ++INCLUDE DTSIMTAD DTSBE414 00493 SKIP3 DTSBE414 00494 01 MTAA-REC. DTSBE414 00495 ++INCLUDE DTSIMTAA DTSBE414 00496 SKIP3 DTSBE414 00497 01 MOPO-REC. DTSBE414 00498 ++INCLUDE DTSIMOPO DTSBE414 00499 EJECT DTSBE414 00500 01 R416-REC. DTSBE414 00501 ++INCLUDE DTSIR416 DTSBE414 00502 SKIP3 DTSBE414 00503 01 R907-REC. DTSBE414 00504 ++INCLUDE DTSIR907 DTSBE414 00505 EJECT DTSBE414 00506 LINKAGE SECTION. DTSBE414 00507 SKIP3 DTSBE414 00508 01 LECM-LINK-AREA. DTSBE414 00509 ++INCLUDE DTSILECM DTSBE414 00510 SKIP3 DTSBE414 00511 10 FILLER REDEFINES LECM-EXTRACT-PARMS. DTSBE414 00512 15 LECM-PARM-RESP-OP-ID PIC X(08). DTSBE414 00513 15 FILLER PIC X(01). DTSBE414 00514 15 LECM-PARM-INT-COMP-DATE PIC X(06). DTSBE414 00515 15 FILLER PIC X(01). DTSBE414 00516 15 LECM-PARM-REIMB-CUTOFF-DATE PIC X(06). DTSBE414 00517 15 FILLER PIC X(46). DTSBE414 00518 EJECT DTSBE414 00519 01 MPRF-LINK-REC. DTSBE414 00520 ++INCLUDE DTSIMPRF DTSBE414 00521 EJECT DTSBE414 00522 *************************************************************** DTSBE414 00523 * THE PROCEDURE DIVISION FOR DTSBE414 STARTS HERE. DTSBE414 00524 *************************************************************** DTSBE414 00525 DTSBE414 00526 PROCEDURE DIVISION USING LECM-LINK-AREA DTSBE414 00527 MPRF-LINK-REC. DTSBE414 00528 SKIP2 DTSBE414 00529 IF LECM-PROCESS-88 DTSBE414 00530 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBE414 00531 ELSE DTSBE414 00532 IF LECM-INITIALIZE-88 DTSBE414 00533 PERFORM I0000-INITIALIZE THRU I0000-EXIT DTSBE414 00534 ELSE DTSBE414 00535 IF LECM-TERMINATE-88 DTSBE414 00536 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBE414 00537 ELSE DTSBE414 00538 MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED' DTSBE414 00539 TO ABEND-MSG DTSBE414 00540 PERFORM S999-ABEND THRU S999-EXIT. DTSBE414 00541 SKIP2 DTSBE414 00542 GOBACK. DTSBE414 00543 EJECT DTSBE414 00544 *************************************************************** DTSBE414 00545 * THE PARAGRAPH CONTROLS THE INITIALIZATION PROCESS FOR DTSBE414 00546 * DTSBE414. DTSBE414 00547 *************************************************************** DTSBE414 00548 DTSBE414 00549 I0000-INITIALIZE. DTSBE414 00550 SKIP2 DTSBE414 00551 *& DTSBE414 00552 * MOVE ZERO TO WRK-YRQ-EXCLUDED-CNT DTSBE414 00553 * WRK-BNK-EMP-EXCLUDED-CNT DTSBE414 00554 * WRK-BNK-EXCLUDED-AMT DTSBE414 00555 * WRK-PKUP-EXCLUDED-AMT. DTSBE414 00556 *& DTSBE414 00557 MOVE LECM-TRACE-IND TO L910-TRACE-IND. DTSBE414 00558 MOVE WRK-MOD-NAME TO L910-MOD-NAME DTSBE414 00559 R907-MODULE-NAME. DTSBE414 00560 DTSBE414 00561 MOVE LENGTH OF R414-REC TO R414-LENGTH. DTSBE414 00562 MOVE LENGTH OF R416-REC TO R416-LENGTH. DTSBE414 00563 MOVE LENGTH OF R907-REC TO R907-LENGTH. DTSBE414 00564 MOVE 99999 TO WRK-CURR-ANN-YRQ. DTSBE414 00565 MOVE LECM-PRIOR-RUN-DATE TO WRK-LAST-ACCT-UPDATE-DATE. DTSBE414 00566 DTSBE414 00567 MOVE LECM-PRIOR-MAIL-DATE TO WRK-STMT-DATE. DTSBE414 00568 DTSBE414 00569 PERFORM I1000-EDIT-AND-DEFAULT-PARMS THRU I1000-EXIT. DTSBE414 00570 DTSBE414 00571 PERFORM I2000-READ-MHDR THRU I2000-EXIT. DTSBE414 00572 DTSBE414 00573 PERFORM S2000-INITIALIZE-TABLE THRU S2000-EXIT DTSBE414 00574 VARYING WRK-SUB FROM 1 BY 1 DTSBE414 00575 UNTIL WRK-SUB GREATER THAN 99. DTSBE414 00576 ****NH UNTIL WRK-SUB GREATER THAN 50. DTSBE414 00577 DTSBE414 00578 SET LECM-MST-OPEN-UPDATE-88 TO TRUE. DTSBE414 00579 SET LECM-REF-OPEN-READ-88 TO TRUE. DTSBE414 00580 SKIP2 DTSBE414 00581 MOVE WRK-STMT-DATE TO L001-FED-8-DATE-9 DTSBE414 00582 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBE414 00583 SUBTRACT 730 FROM L001-JUL-ABS-DAY DTSBE414 00584 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT DTSBE414 00585 MOVE L001-FED-8-DATE-9 TO WRK-GT2YR-CUTOFF-DATE. DTSBE414 00586 DISPLAY '2 YEAR CUTOFF ' L001-SLASH-8-DATE. DTSBE414 00587 DTSBE414 00588 MOVE L001-FED-8-DATE-9 TO L004-DATE. DTSBE414 00589 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSBE414 00590 MOVE L004-QTR-5-9 TO WRK-CUTOFF-YRQ. DTSBE414 00591 DISPLAY 'QTR CUTOFF ' L004-SLASH-5-QTR. DTSBE414 00592 DTSBE414 00593 PERFORM S109-FIRST-PEN-INT-YRQ THRU S109-EXIT. DTSBE414 00594 MOVE L109-FIRST-PEN-INT-YRQ TO WRK-FIRST-PEN-INT-YRQ. DTSBE414 00595 DISPLAY 'FIRST-PEN-INT-YRQ ' WRK-FIRST-PEN-INT-YRQ. CL160 00596 DTSBE414 00597 I0000-EXIT. DTSBE414 00598 EXIT. DTSBE414 00599 SKIP3 DTSBE414 00600 *************************************************************** DTSBE414 00601 * THE PARAGRAPH CONTROLS THE EDITING OF THE PARMS. DTSBE414 00602 *************************************************************** DTSBE414 00603 DTSBE414 00604 I1000-EDIT-AND-DEFAULT-PARMS. DTSBE414 00605 DTSBE414 00606 PERFORM I1100-RESP-OP-ID THRU I1100-EXIT. DTSBE414 00607 DTSBE414 00608 PERFORM I1200-INT-COMP-DATE THRU I1200-EXIT. DTSBE414 00609 DTSBE414 00610 PERFORM I1300-REIMB-CUTOFF-DATE THRU I1300-EXIT. DTSBE414 00611 OPEN INPUT EMP-RPT-FILE. DTSBE414 00612 DTSBE414 00613 PERFORM I4000-TRANS-ICESA THRU I4000-EXIT. DTSBE414 00614 DTSBE414 00615 DTSBE414 00616 I1000-EXIT. DTSBE414 00617 EXIT. DTSBE414 00618 EJECT DTSBE414 00619 *************************************************************** DTSBE414 00620 * THE PARAGRAPH EDITS THE RESPONSIBLE OP ID. DTSBE414 00621 *************************************************************** DTSBE414 00622 DTSBE414 00623 I1100-RESP-OP-ID. DTSBE414 00624 DTSBE414 00625 IF LECM-PARM-RESP-OP-ID = SPACES DTSBE414 00626 MOVE SPACES TO WRK-PARM-RESP-OP-ID DTSBE414 00627 GO TO I1100-EXIT. DTSBE414 00628 DTSBE414 00629 * MOVE 'RESP-OP-ID MISSING' TO ABEND-MSG DTSBE414 00630 * PERFORM S999-ABEND THRU S999-EXIT. DTSBE414 00631 DTSBE414 00632 MOVE LECM-PARM-RESP-OP-ID TO L082-OP-ID. DTSBE414 00633 DTSBE414 00634 PERFORM S082-LOOKUP-OP-ID THRU S082-EXIT. DTSBE414 00635 DTSBE414 00636 IF L082-NOT-VALID-OP OR L082-INTERNAL-88 DTSBE414 00637 MOVE 'LECM-PARM-RESP-OP-ID NOT VALID' DTSBE414 00638 TO ABEND-MSG DTSBE414 00639 PERFORM S999-ABEND THRU S999-EXIT. DTSBE414 00640 MOVE LECM-PARM-RESP-OP-ID TO WRK-PARM-RESP-OP-ID. DTSBE414 00641 DTSBE414 00642 I1100-EXIT. DTSBE414 00643 EXIT. DTSBE414 00644 EJECT DTSBE414 00645 *************************************************************** DTSBE414 00646 * THE PARAGRAPH EDITS THE INTEREST COMPUTATION DATE DTSBE414 00647 *************************************************************** DTSBE414 00648 DTSBE414 00649 I1200-INT-COMP-DATE. DTSBE414 00650 DTSBE414 00651 IF LECM-PARM-INT-COMP-DATE = SPACES DTSBE414 00652 MOVE WRK-STMT-DATE TO L001-FED-8-DATE-9 DTSBE414 00653 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBE414 00654 ADD +14 TO L001-JUL-ABS-DAY DTSBE414 00655 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT DTSBE414 00656 MOVE L001-FED-8-DATE-9 DTSBE414 00657 TO WRK-PARM-INT-COMP-DATE DTSBE414 00658 ELSE DTSBE414 00659 MOVE LECM-PARM-INT-COMP-DATE DTSBE414 00660 TO L001-CAL-6-DATE-X DTSBE414 00661 PERFORM S001-FROM-CAL-6 THRU S001-EXIT DTSBE414 00662 IF L001-VALID-DATE DTSBE414 00663 MOVE L001-FED-8-DATE-9 DTSBE414 00664 TO WRK-PARM-INT-COMP-DATE DTSBE414 00665 ELSE DTSBE414 00666 MOVE 'INT-COMP-DATE NOT VALID' DTSBE414 00667 TO ABEND-MSG DTSBE414 00668 PERFORM S999-ABEND THRU S999-EXIT. DTSBE414 00669 DTSBE414 00670 IF WRK-PARM-INT-COMP-DATE < WRK-STMT-DATE DTSBE414 00671 MOVE 'INT-COMP-DATE IS LESS THAN STMT-DATE' DTSBE414 00672 TO ABEND-MSG DTSBE414 00673 PERFORM S999-ABEND THRU S999-EXIT. DTSBE414 00674 DISPLAY ' INTEREST COMP DATE ' WRK-PARM-INT-COMP-DATE. CL171 00675 I1200-EXIT. DTSBE414 00676 EXIT. DTSBE414 00677 EJECT DTSBE414 00678 *************************************************************** DTSBE414 00679 * THE PARAGRAPH EDITS THE REIMBURSABLE CUTOFF DATE. DTSBE414 00680 *************************************************************** DTSBE414 00681 DTSBE414 00682 I1300-REIMB-CUTOFF-DATE. DTSBE414 00683 DTSBE414 00684 IF LECM-PARM-REIMB-CUTOFF-DATE = SPACES DTSBE414 00685 MOVE WRK-STMT-DATE TO L001-FED-8-DATE-9 DTSBE414 00686 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBE414 00687 SUBTRACT 30 FROM L001-JUL-ABS-DAY DTSBE414 00688 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT DTSBE414 00689 MOVE L001-FED-8-DATE-9 TO WRK-PARM-REIMB-CUTOFF-DATE DTSBE414 00690 ELSE DTSBE414 00691 MOVE LECM-PARM-REIMB-CUTOFF-DATE TO L001-CAL-6-DATE-X DTSBE414 00692 PERFORM S001-FROM-CAL-6 THRU S001-EXIT DTSBE414 00693 IF L001-VALID-DATE DTSBE414 00694 MOVE L001-FED-8-DATE-9 TO WRK-PARM-REIMB-CUTOFF-DATE DTSBE414 00695 ELSE DTSBE414 00696 MOVE 'REIMB-CUTOFF-DATE NOT VALID' DTSBE414 00697 TO ABEND-MSG DTSBE414 00698 PERFORM S999-ABEND THRU S999-EXIT. DTSBE414 00699 DTSBE414 00700 DISPLAY 'REIMB-CUTOFF-DATE ' WRK-PARM-REIMB-CUTOFF-DATE. CL159 00701 CL159 00702 IF WRK-PARM-REIMB-CUTOFF-DATE > WRK-LAST-ACCT-UPDATE-DATE DTSBE414 00703 MOVE DTSBE414 00704 'REIMB-CUTOFF-DATE IS GREATER THAN LAST-ACCT-UPDATE-DATE' DTSBE414 00705 TO ABEND-MSG DTSBE414 00706 PERFORM S999-ABEND THRU S999-EXIT. DTSBE414 00707 I1300-EXIT. DTSBE414 00708 EXIT. DTSBE414 00709 EJECT DTSBE414 00710 DTSBE414 00711 I2000-READ-MHDR. DTSBE414 00712 DTSBE414 00713 MOVE LOW-VALUES TO MHDR-KEY-AREA. DTSBE414 00714 DTSBE414 00715 MOVE +0 TO MHDR-EMP-NO. DTSBE414 00716 DTSBE414 00717 SET MHDR-HDR-88 TO TRUE. DTSBE414 00718 DTSBE414 00719 MOVE MHDR-REC TO MSKL-REC. DTSBE414 00720 DTSBE414 00721 PERFORM S910-READ THRU S910-EXIT. DTSBE414 00722 DTSBE414 00723 IF L910-NO-REC-88 DTSBE414 00724 MOVE 'MHDR RECORD NOT FOUND' TO ABEND-MSG DTSBE414 00725 PERFORM S999-ABEND THRU S999-EXIT. DTSBE414 00726 DTSBE414 00727 MOVE MSKL-REC TO MHDR-REC. DTSBE414 00728 DTSBE414 00729 MOVE MHDR-CMPL-MONTH-BEGIN-DATE TO WRK-CMPL-MONTH-BEGIN-DATE CL143 00730 WRK-CMPL-MONTH CL163 00731 DISP-DATE. CL163 00732 DTSBE414 00733 DISPLAY ' LAST COMPLETED MONTH ' WRK-CMPL-MONTH. CL163 00734 * ADD 10 TO L001-JUL-ABS-DAY CL149 00735 * PERFORM S001-FROM-ABS-DAY THRU S001-EXIT CL149 00736 * MOVE L001-FED-8-DATE-9 TO WRK-CMPL-MONTH-BEGIN-DATE. CL149 00737 CL144 00738 DISPLAY ' LAST BILL DATE ' WRK-CMPL-MONTH-BEGIN-DATE CL144 00739 CL*84 00740 DISPLAY ' '. DTSBE414 00741 DISPLAY 'MHDR-CMPL-MONTH-BEGIN-DATE = ' DISP-DATE. DTSBE414 00742 DTSBE414 00743 I2000-EXIT. DTSBE414 00744 EXIT. DTSBE414 00745 I4000-TRANS-ICESA. DTSBE414 00746 READ EMP-RPT-FILE INTO W-EMP-RPT-REC AT END DTSBE414 00747 GO TO I4000-EXIT. DTSBE414 00748 MOVE X212-EMP-NBR TO WRK-EMP-NO DTSBE414 00749 * MOVE X212-QTR TO WRK-ICESA-YRQ DTSBE414 00750 * MOVE '2014/4' TO WRK-ICESA-YRQ DTSBE414 00751 * MOVE WRK-ICESA-CCYY TO WRK-RPT-CCYY DTSBE414 00752 * MOVE WRK-ICESA-QTR TO WRK-RPT-QTR DTSBE414 00753 DTSBE414 00754 * MOVE WRK-RPT-WS TO WRK-RPT-YRQ. DTSBE414 00755 DTSBE414 00756 * IF WRK-RPT-YRQ = WRK-PARM-SUBJECT-YRQ DTSBE414 00757 SET TF-RPT-FOUND-YES-88 (WRK-EMP-NO) TO TRUE. DTSBE414 00758 * ADD +1 TO WRK-TF-TABLE-CNT DTSBE414 00759 DISPLAY 'EMP-LOADED IN TABLE: ' WRK-EMP-NO. DTSBE414 00760 DTSBE414 00761 GO TO I4000-TRANS-ICESA. DTSBE414 00762 I4000-EXIT. DTSBE414 00763 EXIT. DTSBE414 00764 DTSBE414 00765 *************************************************************** DTSBE414 00766 * THIS IS THE PROCESS PARAGRAPH FOR DTSBE414. DTSBE414 00767 *************************************************************** DTSBE414 00768 DTSBE414 00769 P0000-PROCESS. DTSBE414 00770 * IF MPRF-EMP-NO > 013017 CL156 00771 * DISPLAY 'TESTING ' CL156 00772 * SET LECM-TERMINATE-88 TO TRUE CL156 00773 * GO TO P0000-EXIT CL156 00774 * END-IF. CL156 00775 MOVE MPRF-EMP-NO TO WRK-EMP-NO DTSBE414 00776 IF TF-RPT-FOUND-YES-88 (WRK-EMP-NO) DTSBE414 00777 SET TF-BYPASSED-YES-88 (WRK-EMP-NO) TO TRUE DTSBE414 00778 DISPLAY 'TBL EMP BYPASSED: ' WRK-EMP-NO DTSBE414 00779 * ADD +1 TO WRK-BYPASS-TBL DTSBE414 00780 GO TO P0000-EXIT. DTSBE414 00781 DTSBE414 00782 MOVE MPRF-EMP-STATUS TO R414-STATUS. CL*61 00783 MOVE MPRF-EMP-CLASS TO R414-CLASS. CL*61 00784 IF MPRF-MLIN-EXISTS-88 CL*93 00785 ** PERFORM P7000-SCAN-LIN THRU P7001-EXIT CL116 00786 MOVE 'Y' TO R414-LIEN CL116 00787 ELSE CL*93 00788 MOVE 'N' TO R414-LIEN CL*95 00789 END-IF. CL*93 00790 CL*94 00791 MOVE +50 TO R414-QTR-CNT. DTSBE414 00792 MOVE 99999 TO WRK-CURR-ANN-YRQ DTSBE414 00793 IF MPRF-STATUS-NEVERSUB-88 OR DTSBE414 00794 MPRF-STATUS-UNK-88 DTSBE414 00795 GO TO P0000-EXIT. DTSBE414 00796 DTSBE414 00797 IF (MPRF-TOT-BALANCE-AMT > +5.00) CL*65 00798 OR (MPRF-PURSUED-RPT-CNT > +0) DTSBE414 00799 NEXT SENTENCE DTSBE414 00800 ELSE DTSBE414 00801 GO TO P0000-EXIT. DTSBE414 00802 IF MPRF-NOT-WRITTEN-OFF-88 DTSBE414 00803 NEXT SENTENCE DTSBE414 00804 ELSE DTSBE414 00805 GO TO P0000-EXIT. DTSBE414 00806 DTSBE414 00807 DISPLAY 'MAIL ' MPRF-EMP-NO ' ' MPRF-RETURN-MAIL-IND CL171 00808 ' ' MPRF-EMP-CLASS. CL171 00809 CL154 00810 IF MPRF-RETURN-MAIL-YES-88 DTSBE414 00811 ADD 1 TO WRK-EMPL-MAIL-CNT DTSBE414 00812 GO TO P0000-EXIT. DTSBE414 00813 DTSBE414 00814 PERFORM P0100-FIND-MEVL THRU P0100-EXIT. DTSBE414 00815 DTSBE414 00816 IF WRK-ONLINE-BILL-YES-88 DTSBE414 00817 DISPLAY 'SKIP MONTHLY BILL- ONLINE BILL SNT ' MPRF-EMP-NO CL140 00818 GO TO P0000-EXIT DTSBE414 00819 END-IF. DTSBE414 00820 CL151 00821 * IF MPRF-EMP-NO = 010171 CL171 00822 * DISPLAY 'TESTING OBILL ' WRK-ONLINE-BILL-IND. CL171 00823 DTSBE414 00824 MOVE +0 TO WRK-MAPL-YRQ-CNT DTSBE414 00825 WRK-BNK-PETITION-DATE DTSBE414 00826 WRK-BNK-PETITION-YRQ DTSBE414 00827 WRK-BNK-FIRST-BILL-YRQ DTSBE414 00828 WRK-ESTIMAT-RPT-CNT CL102 00829 WRK-MISSING-RPT-CNT. CL102 00830 DTSBE414 00831 IF MPRF-MAPL-EXISTS-88 DTSBE414 00832 PERFORM P1000-TABLE-MAPL-OPEN-YRQ THRU P1000-EXIT. DTSBE414 00833 DTSBE414 00834 IF MPRF-BANKRP-OPEN-88 DTSBE414 00835 PERFORM P1500-TABLE-OPEN-BNK-YRQ THRU P1500-EXIT. DTSBE414 00836 DTSBE414 00837 MOVE 'N' TO STMT-TEXT-IND. DTSBE414 00838 DTSBE414 00839 PERFORM P2000-CONSTRUCT-R414-MISC THRU P2000-EXIT. DTSBE414 00840 DTSBE414 00841 DTSBE414 00842 PERFORM S2000-INITIALIZE-TABLE THRU S2000-EXIT DTSBE414 00843 VARYING WRK-SUB FROM 1 BY 1 DTSBE414 00844 UNTIL WRK-SUB GREATER THAN R414-QTR-CNT. DTSBE414 00845 DTSBE414 00846 MOVE +0 TO R414-QTR-CNT DTSBE414 00847 WRK-TOT-SUR-DUE DTSBE414 00848 WRK-EMP-TOT-DUE. DTSBE414 00849 DTSBE414 00850 * IF MPRF-EMP-NO = 010171 CL171 00851 * DISPLAY 'SI OK P3000 ' MPRF-EMP-NO CL171 00852 * END-IF. CL171 00853 DTSBE414 00854 PERFORM P3000-CONSTRUCT-R414-QTR THRU P3000-EXIT. DTSBE414 00855 * IF MPRF-EMP-NO = 353165 CL151 00856 * DISPLAY 'OUT OF P3000 ' MPRF-EMP-NO CL151 00857 * END-IF. CL151 00858 DTSBE414 00859 DTSBE414 00860 * IF MPRF-EMP-NO = 010171 CL171 00861 * DISPLAY '1ESTING OBILL ' WRK-ONLINE-BILL-IND. CL171 00862 CL151 00863 IF R414-QTR-CNT = +0 DTSBE414 00864 DISPLAY '%%%%% DOES NOT OWE BILL ' MPRF-EMP-NO CL171 00865 GO TO P0000-EXIT DTSBE414 00866 END-IF. DTSBE414 00867 DTSBE414 00868 CL151 00869 * IF MPRF-EMP-NO = 010171 CL171 00870 * DISPLAY '2ESTING OBILL ' WRK-ONLINE-BILL-IND. CL171 00871 CL151 00872 ** IF MPRF-PURSUED-RPT-CNT > +0 DTSBE414 00873 IF WRK-MISSING-RPT-CNT > 0 DTSBE414 00874 NEXT SENTENCE DTSBE414 00875 ELSE DTSBE414 00876 IF WRK-EMP-TOT-DUE < WRK-TOLERANCE-AMT DTSBE414 00877 ** MOVE WRK-EMP-TOT-DUE TO AMT-DISP1 DTSBE414 00878 * DISPLAY ' TOT DUE < TOL ' DTSBE414 00879 ** MPRF-EMP-NO ' ' AMT-DISP1 DTSBE414 00880 GO TO P0000-EXIT DTSBE414 00881 END-IF DTSBE414 00882 END-IF. DTSBE414 00883 CL174 00884 IF MPRF-STATUS-INACT-88 AND CL175 00885 MPRF-TOT-BALANCE-AMT = +0.00 AND CL174 00886 WRK-MISSING-RPT-CNT < 2 CL174 00887 DISPLAY ' EMP INA AND 1 MISS RPT ' MPRF-EMP-NO CL174 00888 GO TO P0000-EXIT. CL174 00889 CL174 00890 DTSBE414 00891 IF MPRF-TOT-BALANCE-AMT > +5 CL*65 00892 IF R414-QTR-CNT = +1 DTSBE414 00893 IF R414-QTR (1) >= LECM-LAST-PEN-ASSESSED-YRQ DTSBE414 00894 IF R414-QTR-EST-RPT-NO-88 (1) DTSBE414 00895 ADD 1 TO WRK-BYPASS-CNT CL177 00896 * GO TO P0000-EXIT CL176 00897 ELSE DTSBE414 00898 ADD 1 TO WRK-ASSESS-CNT. DTSBE414 00899 DTSBE414 00900 IF R414-QTR-CNT > +60 CL*65 00901 ADD 1 TO WRK-EMPL-CNT-50 DTSBE414 00902 MOVE MSG3-ID TO R907-MSG-ID DTSBE414 00903 MOVE MPRF-EMP-NO TO R907-EMP-NO DTSBE414 00904 MOVE MSG3-TEXT TO R907-MSG-TEXT DTSBE414 00905 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE414 00906 ** TESTING PROCESS FOR ALL BILLS TO BE CREATED PER PATRICK DTSBE414 00907 ** GO TO P0000-EXIT. DTSBE414 00908 DTSBE414 00909 CL151 00910 * IF MPRF-EMP-NO = 010171 CL171 00911 * DISPLAY '3ESTING OBILL ' WRK-ONLINE-BILL-IND. CL171 00912 CL151 00913 MOVE ZEROS TO ERROR-CNT. DTSBE414 00914 IF R414-QTR-CNT > +6 DTSBE414 00915 ADD 1 TO WRK-EMPL-CNT-6 DTSBE414 00916 PERFORM S3000-WRITE-R414 THRU S3000-EXIT. DTSBE414 00917 ** TESTING PROCESS FOR ALL BILLS TO BE CREATED PER PATRICK DTSBE414 00918 ** GO TO P0000-EXIT. DTSBE414 00919 DTSBE414 00920 MOVE +0 TO TAD-FORM-CNT. DTSBE414 00921 DTSBE414 00922 PERFORM P4000-PROCESS-MTAD THRU P4000-EXIT. DTSBE414 00923 DTSBE414 00924 IF TAD-FORM-CNT = +0 DTSBE414 00925 MOVE MSG1-ID TO R907-MSG-ID DTSBE414 00926 MOVE MPRF-EMP-NO TO R907-EMP-NO DTSBE414 00927 MOVE MSG1-TEXT TO R907-MSG-TEXT DTSBE414 00928 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBE414 00929 DTSBE414 00930 MOVE +0 TO OPO-FORM-CNT. DTSBE414 00931 DTSBE414 00932 PERFORM P5000-PROCESS-MOPO THRU P5000-EXIT. DTSBE414 00933 DTSBE414 00934 MOVE +0 TO TAA-FORM-CNT. DTSBE414 00935 DTSBE414 00936 * IF MPRF-EMP-NO = 013017 CL171 00937 * DISPLAY '6ESTING OBILL ' WRK-ONLINE-BILL-IND. CL171 00938 CL151 00939 DTSBE414 00940 IF STMT-TEXT-IND = 'Y' DTSBE414 00941 IF ((TAD-FORM-CNT > +0) DTSBE414 00942 OR (OPO-FORM-CNT > +0) DTSBE414 00943 OR (TAA-FORM-CNT > +0)) DTSBE414 00944 PERFORM P7000-REWRITE-MCOL THRU P7000-EXIT. DTSBE414 00945 P0000-EXIT. DTSBE414 00946 EXIT. DTSBE414 00947 EJECT DTSBE414 00948 DTSBE414 00949 *P7000-SCAN-LIN. CL116 00950 * CL116 00951 * MOVE 'Y' TO WRK-MLIN-IND. CL116 00952 * MOVE LOW-VALUES TO MLIN-KEY-AREA. CL116 00953 * MOVE MPRF-EMP-NO TO MLIN-EMP-NO. CL116 00954 * SET MLIN-LIN-88 TO TRUE. CL116 00955 * MOVE MLIN-KEY-AREA TO MSKL-KEY-AREA. CL116 00956 CL103 00957 * PERFORM S910-START-BROWSE THRU S910-EXIT. CL116 00958 * IF L910-NO-REC-88 CL116 00959 * GO TO P7001-EXIT CL116 00960 * ELSE CL116 00961 * PERFORM P7100-SCAN-MLIN THRU P7100-EXIT CL116 00962 * UNTIL WRK-MLIN-NO-REC. CL116 00963 CL103 00964 *P7001-EXIT. CL116 00965 * EXIT. CL116 00966 *P7100-SCAN-MLIN. CL118 00967 CL104 00968 CL104 00969 * MOVE MSKL-REC TO MLIN-REC. CL118 00970 CL104 00971 * IF MLIN-STATUS-ACTIVE-88 CL118 00972 * MOVE 'Y' TO R414-LIEN CL118 00973 * GO TO P7100-EXIT. CL118 00974 CL107 00975 * PERFORM S910-READ-NEXT THRU S910-EXIT. CL118 00976 CL107 00977 * IF L910-NO-REC-88 CL118 00978 * MOVE 'N' TO R414-LIEN CL118 00979 * SET WRK-MLIN-NO-REC TO TRUE. CL118 00980 CL104 00981 *P7100-EXIT. CL118 00982 * EXIT. CL118 00983 CL107 00984 P0100-FIND-MEVL. DTSBE414 00985 DTSBE414 00986 SET WRK-ADMIN-SENT-NO-88 TO TRUE CL163 00987 SET WRK-ONLINE-BILL-NO-88 TO TRUE DTSBE414 00988 MOVE ZEROS TO WRK-MEVL-READ-CNT. DTSBE414 00989 DTSBE414 00990 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBE414 00991 MOVE MPRF-EMP-NO TO MSKL-EMP-NO. DTSBE414 00992 SET MSKL-EVL-88 TO TRUE. DTSBE414 00993 DTSBE414 00994 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE414 00995 IF L910-NO-REC-88 DTSBE414 00996 ADD 1 TO WRK-MEVL-REC-NOT-FIND-CNT DTSBE414 00997 * DISPLAY ' ' DTSBE414 00998 * DISPLAY '1ST BROWSE MEVL FIND NO REC, ACCT = ' DTSBE414 00999 * MPRF-EMP-NO DTSBE414 01000 GO TO P0100-EXIT DTSBE414 01001 ELSE DTSBE414 01002 ADD 1 TO WRK-MEVL-READ-CNT DTSBE414 01003 PERFORM P0110-MEVL-SCAN THRU P0110-EXIT DTSBE414 01004 UNTIL L910-NO-REC-88 OR WRK-ONLINE-BILL-YES-88. DTSBE414 01005 DTSBE414 01006 P0100-EXIT. DTSBE414 01007 EXIT. DTSBE414 01008 DTSBE414 01009 P0110-MEVL-SCAN. DTSBE414 01010 DTSBE414 01011 MOVE MSKL-REC TO MEVL-REC. DTSBE414 01012 DTSBE414 01013 IF MEVL-EMP-NO = 013017 CL151 01014 DISPLAY 'MTEXT = ' MEVL-TEXT(1:41) 'SS' MPRF-EMP-NO CL154 01015 'MDATE ' MEVL-DATE CL151 01016 'BEGIN ' WRK-CMPL-MONTH-BEGIN-DATE. CL151 01017 CL151 01018 IF (MEVL-TEXT (1:5) = 'DEBIT' CL173 01019 * IF (MEVL-TEXT (1:15) = 'SI ADMIN ASSESS' CL154 01020 * IF (MEVL-TEXT(1:41) = CL173 01021 * 'SI ADMIN ASSESS BILL SENT: 0.00' CL173 01022 AND MEVL-DATE >= WRK-CMPL-MONTH-BEGIN-DATE) CL146 01023 * AND (MEVL-DATE >= WRK-CMPL-MONTH-BEGIN-DATE) DTSBE414 01024 * AND (MEVL-SOURCE NOT = 'SYSTEM') DTSBE414 01025 * SET WRK-ONLINE-BILL-YES-88 TO TRUE CL155 01026 SET L910-NO-REC-88 TO TRUE CL158 01027 ADD 1 TO WRK-WEB-STMT-ACCT-SEND-CNT DTSBE414 01028 * DISPLAY ' ' DTSBE414 01029 MOVE MEVL-TEXT TO DISP-DEBIT DTSBE414 01030 DISPLAY 'MTEXT = ' MEVL-TEXT(1:41) 'QQ' MPRF-EMP-NO CL154 01031 'MDATE ' MEVL-DATE CL147 01032 MOVE MEVL-DATE TO DISP-MEVL-DATE DTSBE414 01033 * DISPLAY 'MEVL-DATE = ' DISP-MEVL-DATE CL*81 01034 GO TO P0110-EXIT DTSBE414 01035 END-IF. DTSBE414 01036 IF (MEVL-TEXT (1:15) = 'SI ADMIN ASSESS' CL155 01037 AND MEVL-DATE >= WRK-CMPL-MONTH-BEGIN-DATE) CL155 01038 * AND (MEVL-DATE >= WRK-CMPL-MONTH-BEGIN-DATE) CL155 01039 * AND (MEVL-SOURCE NOT = 'SYSTEM') CL155 01040 SET L910-NO-REC-88 TO TRUE CL163 01041 SET WRK-ADMIN-SENT-YES-88 TO TRUE CL163 01042 * SET WRK-ONLINE-BILL-YES-88 TO TRUE CL163 01043 ADD 1 TO WRK-WEB-STMT-ACCT-SEND-CNT CL155 01044 * DISPLAY ' ' CL155 01045 MOVE MEVL-TEXT TO DISP-DEBIT CL155 01046 DISPLAY 'MTEXT = ' MEVL-TEXT(1:41) 'QQ' MPRF-EMP-NO CL155 01047 'MDATE ' MEVL-DATE CL155 01048 MOVE MEVL-DATE TO DISP-MEVL-DATE CL155 01049 * DISPLAY 'MEVL-DATE = ' DISP-MEVL-DATE CL155 01050 GO TO P0110-EXIT CL155 01051 END-IF. CL155 01052 IF MEVL-EMP-NO = 013017 CL151 01053 DISPLAY 'MTEXT = ' MEVL-TEXT(1:15) ' ' MPRF-EMP-NO CL148 01054 'MDATE ' MEVL-DATE CL148 01055 'BEGIN ' WRK-CMPL-MONTH-BEGIN-DATE CL151 01056 'OBILL ' WRK-ONLINE-BILL-IND. CL153 01057 CL148 01058 *** SPECIAL CODE FOR OCTOBER 2005 RUN DTSBE414 01059 * IF ((MEVL-DATE = WRK-MEVL-DATE-1 DTSBE414 01060 * OR MEVL-DATE = WRK-MEVL-DATE-2) DTSBE414 01061 * AND MEVL-TEXT (1:5) = 'DEBIT' DTSBE414 01062 * AND MEVL-SOURCE = 'SYSTEM') DTSBE414 01063 * SET WRK-ONLINE-BILL-YES-88 TO TRUE DTSBE414 01064 * ADD 1 TO WRK-MEVL-DATE-1-CNT DTSBE414 01065 * MOVE MEVL-DATE TO DISP-MEVL-DATE-1 DTSBE414 01066 * DISPLAY ' ' DTSBE414 01067 * DISPLAY 'DATE = ' DISP-MEVL-DATE-1 DTSBE414 01068 * ' ' MPRF-EMP-NO DTSBE414 01069 * GO TO P0110-EXIT DTSBE414 01070 *** END-IF. DTSBE414 01071 DTSBE414 01072 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE414 01073 IF L910-OK-88 DTSBE414 01074 ADD 1 TO WRK-MEVL-READ-CNT. DTSBE414 01075 DTSBE414 01076 P0110-EXIT. DTSBE414 01077 EXIT. DTSBE414 01078 EJECT DTSBE414 01079 DTSBE414 01080 *************************************************************** DTSBE414 01081 * THIS PARAGRAPH STARTS THE BROWSE OF THE MAPL RECORDS. DTSBE414 01082 *************************************************************** DTSBE414 01083 DTSBE414 01084 P1000-TABLE-MAPL-OPEN-YRQ. DTSBE414 01085 DTSBE414 01086 MOVE LOW-VALUES TO MAPL-KEY-AREA. DTSBE414 01087 MOVE MPRF-EMP-NO TO MAPL-EMP-NO. DTSBE414 01088 SET MAPL-APL-88 TO TRUE. DTSBE414 01089 MOVE MAPL-KEY-AREA TO MSKL-KEY-AREA. DTSBE414 01090 DTSBE414 01091 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE414 01092 DTSBE414 01093 PERFORM P1100-SCAN-MAPL THRU P1100-EXIT DTSBE414 01094 UNTIL L910-NO-REC-88. DTSBE414 01095 DTSBE414 01096 P1000-EXIT. DTSBE414 01097 EXIT. DTSBE414 01098 SKIP3 DTSBE414 01099 *************************************************************** DTSBE414 01100 * THIS PARAGRAPH SCANS ALL MAPL RECORDS. DTSBE414 01101 *************************************************************** DTSBE414 01102 DTSBE414 01103 P1100-SCAN-MAPL. DTSBE414 01104 DTSBE414 01105 MOVE MSKL-REC TO MAPL-REC. DTSBE414 01106 DTSBE414 01107 IF MAPL-STATUS-OPEN-88 DTSBE414 01108 PERFORM P1110-SCAN-COVERED-YRQ THRU P1110-EXIT DTSBE414 01109 VARYING MAPL-COV-IDX FROM 1 BY 1 DTSBE414 01110 UNTIL MAPL-COV-IDX GREATER THAN MAPL-COVERED-CNT. DTSBE414 01111 DTSBE414 01112 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE414 01113 DTSBE414 01114 P1100-EXIT. DTSBE414 01115 EXIT. DTSBE414 01116 EJECT DTSBE414 01117 *************************************************************** DTSBE414 01118 * THIS PARAGRAPH PROCESSES THE QUARTER TABLE IN THE MAPL DTSBE414 01119 * RECORD, AND SETS ALL NEW QUARTERS UP IN THE WORKING DTSBE414 01120 * STORAGE TABLE. DTSBE414 01121 *************************************************************** DTSBE414 01122 DTSBE414 01123 P1110-SCAN-COVERED-YRQ. DTSBE414 01124 DTSBE414 01125 MOVE MAPL-COVERED-YRQ (MAPL-COV-IDX) TO HOLD-YRQ. DTSBE414 01126 DTSBE414 01127 PERFORM P1111-WRK-MAPL-YRQ-LOOP THRU P1111-EXIT DTSBE414 01128 VARYING WRK-MAPL-YRQ-IDX FROM 1 BY 1 DTSBE414 01129 UNTIL (WRK-MAPL-YRQ-IDX > WRK-MAPL-YRQ-CNT) DTSBE414 01130 OR DTSBE414 01131 (HOLD-YRQ = +0). DTSBE414 01132 DTSBE414 01133 IF HOLD-YRQ = +0 DTSBE414 01134 NEXT SENTENCE DTSBE414 01135 ELSE DTSBE414 01136 IF WRK-MAPL-YRQ-CNT < +400 DTSBE414 01137 ADD +1 TO WRK-MAPL-YRQ-CNT DTSBE414 01138 MOVE HOLD-YRQ TO WRK-MAPL-YRQ (WRK-MAPL-YRQ-CNT). DTSBE414 01139 P1110-EXIT. DTSBE414 01140 EXIT. DTSBE414 01141 SKIP3 DTSBE414 01142 *************************************************************** DTSBE414 01143 * THIS PARAGRAPH LOOKS AT EACH OCCURRENCE OF THE QUARTER TABLE DTSBE414 01144 * TO DETERMINE IF THE QUARTER HAS ALREADY BEEN LOADED. DTSBE414 01145 *************************************************************** DTSBE414 01146 DTSBE414 01147 P1111-WRK-MAPL-YRQ-LOOP. DTSBE414 01148 DTSBE414 01149 IF HOLD-YRQ = WRK-MAPL-YRQ (WRK-MAPL-YRQ-IDX) DTSBE414 01150 MOVE +0 TO HOLD-YRQ. DTSBE414 01151 P1111-EXIT. DTSBE414 01152 EXIT. DTSBE414 01153 EJECT DTSBE414 01154 *************************************************************** DTSBE414 01155 * IF THE EMPLOYER HAS AN OPEN BANKRUPTCY, DO NOT INCLUDE ANY DTSBE414 01156 * QUARTER LESS THAN THAT IN WHICH THE PETITION DATE OCCURS DTSBE414 01157 * IN THE DEBIT MEMO. DTSBE414 01158 *************************************************************** DTSBE414 01159 P1500-TABLE-OPEN-BNK-YRQ. DTSBE414 01160 MOVE LOW-VALUES TO MCOL-KEY-AREA. DTSBE414 01161 MOVE MPRF-EMP-NO TO MCOL-EMP-NO. DTSBE414 01162 SET MCOL-COL-88 TO TRUE. DTSBE414 01163 MOVE MCOL-KEY-AREA TO MSKL-KEY-AREA. DTSBE414 01164 DTSBE414 01165 PERFORM S910-READ THRU S910-EXIT. DTSBE414 01166 DTSBE414 01167 IF NOT L910-OK-88 DTSBE414 01168 GO TO P1500-EXIT DTSBE414 01169 ELSE DTSBE414 01170 MOVE MSKL-REC TO MCOL-REC. DTSBE414 01171 DTSBE414 01172 IF MCOL-BNK-PETITION-DATE > +0 DTSBE414 01173 IF (MCOL-BNK-DISCHRG-CLOSE-DATE = +0 DTSBE414 01174 AND MCOL-BNK-DISMISS-DATE = +0) DTSBE414 01175 PERFORM P1510-FIRST-BILL-YRQ THRU P1510-EXIT DTSBE414 01176 ELSE DTSBE414 01177 GO TO P1500-EXIT. DTSBE414 01178 DTSBE414 01179 P1500-EXIT. DTSBE414 01180 EXIT. DTSBE414 01181 DTSBE414 01182 *************************************************************** DTSBE414 01183 * DETERMINE THE QUARTER IN WHICH THE PETITION DATE FALLS. DTSBE414 01184 * THE NEXT QUARTER IS THE FIRST THAT MAY BE INCLUDED IN THE DTSBE414 01185 * DEBIT MEMO. SET WRK-BNK-PETITION-YRQ = DTSBE414 01186 * (THE QUARTER IN WHICH THE PETITION DATE FALLS PLUS 1). DTSBE414 01187 *************************************************************** DTSBE414 01188 P1510-FIRST-BILL-YRQ. DTSBE414 01189 MOVE MCOL-BNK-PETITION-DATE TO WRK-BNK-PETITION-DATE. DTSBE414 01190 MOVE WRK-BNK-PETITION-DATE-YYYY DTSBE414 01191 TO WRK-BNK-PETITION-YRQ-YYYY. DTSBE414 01192 EVALUATE WRK-BNK-PETITION-DATE-MM DTSBE414 01193 WHEN 10 THRU 12 DTSBE414 01194 MOVE 4 TO WRK-BNK-PETITION-YRQ-Q DTSBE414 01195 WHEN 7 THRU 9 DTSBE414 01196 MOVE 3 TO WRK-BNK-PETITION-YRQ-Q DTSBE414 01197 WHEN 4 THRU 6 DTSBE414 01198 MOVE 2 TO WRK-BNK-PETITION-YRQ-Q DTSBE414 01199 WHEN OTHER DTSBE414 01200 MOVE 1 TO WRK-BNK-PETITION-YRQ-Q DTSBE414 01201 END-EVALUATE. DTSBE414 01202 DTSBE414 01203 MOVE WRK-BNK-PETITION-YRQ TO L004-QTR-5-9. DTSBE414 01204 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE414 01205 IF L004-INVALID-QTR DTSBE414 01206 MOVE 'INVALID PETITION YRQ ENCOUNTERED' DTSBE414 01207 TO ABEND-MSG DTSBE414 01208 PERFORM S999-ABEND THRU S999-EXIT. DTSBE414 01209 DTSBE414 01210 ADD +1 TO L004-ABS-QTR. DTSBE414 01211 PERFORM S004-FROM-ABS THRU S004-EXIT. DTSBE414 01212 MOVE L004-QTR-5-9 TO WRK-BNK-FIRST-BILL-YRQ. DTSBE414 01213 DTSBE414 01214 P1510-EXIT. DTSBE414 01215 EXIT. DTSBE414 01216 DTSBE414 01217 *************************************************************** DTSBE414 01218 * THIS PARAGRAPH BUILDS THE R414 REPORT EXTRACT RECORD. DTSBE414 01219 *************************************************************** DTSBE414 01220 P2000-CONSTRUCT-R414-MISC. DTSBE414 01221 MOVE SPACES TO R414-FMT-LINE(1) R414-FMT-LINE(2) DTSBE414 01222 R414-FMT-LINE(3) R414-FMT-LINE(4) DTSBE414 01223 R414-FMT-LINE(5). DTSBE414 01224 MOVE WRK-PARM-RESP-OP-ID TO R414-OP-ID. DTSBE414 01225 MOVE WRK-STMT-DATE TO R414-STMT-DATE. DTSBE414 01226 MOVE WRK-PARM-INT-COMP-DATE TO R414-COMP-DATE. DTSBE414 01227 MOVE WRK-LAST-ACCT-UPDATE-DATE TO R414-LAST-ACCT-UPDATE-DATE.DTSBE414 01228 PERFORM S061-DETERMINE-FLD-REP THRU S061-EXIT. DTSBE414 01229 MOVE L061-FLD-REP-ID TO R414-FLD-REP-ID CL*90 01230 R414-FIELD-REP. CL*90 01231 P2000-EXIT. DTSBE414 01232 EXIT. DTSBE414 01233 EJECT DTSBE414 01234 *************************************************************** DTSBE414 01235 * THIS PARAGRAPH CAUSES ALL THE MQTR RECORDS TO BE READ. DTSBE414 01236 *************************************************************** DTSBE414 01237 DTSBE414 01238 P3000-CONSTRUCT-R414-QTR. DTSBE414 01239 IF MPRF-EMP-NO = 010171 CL168 01240 DISPLAY 'P3 ' MPRF-EMP-NO DTSBE414 01241 END-IF. DTSBE414 01242 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBE414 01243 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBE414 01244 SET MQTR-QTR-88 TO TRUE. DTSBE414 01245 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBE414 01246 DTSBE414 01247 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE414 01248 DTSBE414 01249 PERFORM P3100-SCAN-MQTR THRU P3100-EXIT DTSBE414 01250 UNTIL L910-NO-REC-88. DTSBE414 01251 DTSBE414 01252 P3000-EXIT. DTSBE414 01253 EXIT. DTSBE414 01254 EJECT DTSBE414 01255 *************************************************************** DTSBE414 01256 * THIS PARAGRAPH SCANS THE MQTR RECORDS. DTSBE414 01257 *************************************************************** DTSBE414 01258 DTSBE414 01259 P3100-SCAN-MQTR. DTSBE414 01260 DTSBE414 01261 MOVE MSKL-REC TO MQTR-REC. DTSBE414 01262 PERFORM P3110-PROCESS-MQTR THRU P3110-EXIT. DTSBE414 01263 DTSBE414 01264 MOVE MQTR-REC TO MSKL-REC. DTSBE414 01265 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE414 01266 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE414 01267 DTSBE414 01268 P3100-EXIT. DTSBE414 01269 EXIT. DTSBE414 01270 EJECT DTSBE414 01271 *************************************************************** DTSBE414 01272 * THIS PARAGRAPH PROCESSES THE MQTR RECORDS. DTSBE414 01273 *************************************************************** DTSBE414 01274 DTSBE414 01275 P3110-PROCESS-MQTR. DTSBE414 01276 MOVE ZEROS TO WRK-YRQ. DTSBE414 01277 IF WRK-BNK-FIRST-BILL-YRQ = ZERO DTSBE414 01278 NEXT SENTENCE DTSBE414 01279 ELSE DTSBE414 01280 IF MQTR-YRQ = LECM-PICKUP-YRQ DTSBE414 01281 GO TO P3110-EXIT DTSBE414 01282 ELSE DTSBE414 01283 IF MQTR-YRQ < WRK-BNK-FIRST-BILL-YRQ DTSBE414 01284 GO TO P3110-EXIT DTSBE414 01285 END-IF DTSBE414 01286 END-IF DTSBE414 01287 END-IF. DTSBE414 01288 ***OLD CODE ZL1 CL159 01289 IF MQTR-RPT-IS-PURSUED-88 CL172 01290 NEXT SENTENCE CL172 01291 ELSE CL172 01292 IF MPRF-CLASS-SELF-INS-88 CL172 01293 IF MQTR-TAX-DUE-DATE GREATER THAN CL172 01294 WRK-PARM-REIMB-CUTOFF-DATE CL172 01295 GO TO P3110-EXIT CL172 01296 END-IF CL172 01297 END-IF CL172 01298 END-IF. CL172 01299 ****NEW CODE ZL1 CL159 01300 * CL172 01301 * IF MQTR-RPT-IS-PURSUED-88 CL172 01302 * NEXT SENTENCE CL172 01303 * ELSE CL172 01304 * IF MPRF-CLASS-SELF-INS-88 AND CL172 01305 * WRK-ADMIN-SENT-YES-88 CL172 01306 * IF MQTR-TAX-DUE-DATE = 20240207 CL172 01307 * IF MQTR-TAX-DUE-DATE GREATER THAN CL167 01308 * WRK-PARM-REIMB-CUTOFF-DATE CL164 01309 * GO TO P3110-EXIT CL172 01310 * END-IF CL172 01311 * END-IF CL172 01312 * END-IF. CL172 01313 IF MPRF-EMP-NO = 010171 CL169 01314 DISPLAY ' P3110 ' MPRF-EMP-NO ' ' WRK-TOT-DUE ' ' MQTR-YRQ CL169 01315 END-IF. CL169 01316 DTSBE414 01317 P3110-PROCESS-MQTR-PURSUED. CL159 01318 CL159 01319 IF MQTR-RPT-IS-PURSUED-88 DTSBE414 01320 * IF MQTR-YRQ >= WRK-CUTOFF-YRQ DTSBE414 01321 ADD +1 TO WRK-MISSING-RPT-CNT DTSBE414 01322 * END-IF DTSBE414 01323 END-IF. DTSBE414 01324 DTSBE414 01325 SET L410-MODE-INPUT-YRQ-88 TO TRUE. DTSBE414 01326 MOVE MPRF-EMP-NO TO L410-EMP-NO. DTSBE414 01327 MOVE MQTR-YRQ TO L410-YRQ. DTSBE414 01328 PERFORM S410-FILE-SCHED THRU S410-EXIT. DTSBE414 01329 IF L410-ANN-SCHED-88 DTSBE414 01330 MOVE MQTR-YRQ TO WRK-YRQ DTSBE414 01331 IF WRK-YRQ-YR NOT = WRK-CURR-ANN-YEAR DTSBE414 01332 *** DISPLAY 'ANNUAL ' MPRF-EMP-NO ' ' MQTR-YRQ DTSBE414 01333 MOVE ZEROS TO WRK-TAX-DUE DTSBE414 01334 WRK-PEN-DUE DTSBE414 01335 WRK-INT-DUE DTSBE414 01336 WRK-SUR-DUE DTSBE414 01337 WRK-TOT-DUE DTSBE414 01338 END-IF DTSBE414 01339 ELSE DTSBE414 01340 MOVE ZEROS TO WRK-TAX-DUE DTSBE414 01341 WRK-PEN-DUE DTSBE414 01342 WRK-INT-DUE DTSBE414 01343 WRK-SUR-DUE DTSBE414 01344 WRK-TOT-DUE DTSBE414 01345 END-IF. DTSBE414 01346 DTSBE414 01347 PERFORM P3111-PROJECT-INT THRU P3111-EXIT. DTSBE414 01348 DTSBE414 01349 ADD WRK-TAX-DUE DTSBE414 01350 WRK-PEN-DUE DTSBE414 01351 WRK-INT-DUE DTSBE414 01352 WRK-SUR-DUE DTSBE414 01353 GIVING WRK-TOT-DUE. DTSBE414 01354 DTSBE414 01355 IF (WRK-TOT-DUE GREATER THAN ZERO) OR DTSBE414 01356 (MQTR-RPT-IS-PURSUED-88) DTSBE414 01357 NEXT SENTENCE DTSBE414 01358 ELSE DTSBE414 01359 GO TO P3110-EXIT. DTSBE414 01360 DTSBE414 01361 IF MPRF-EMP-NO = 010171 CL170 01362 DISPLAY ' AFTER ' MPRF-EMP-NO ' ' WRK-TOT-DUE ' ' MQTR-YRQ CL170 01363 END-IF. CL170 01364 ** ADD WRK-SUR-DUE TO WRK-TOT-SUR-DUE. DTSBE414 01365 DTSBE414 01366 IF WRK-YRQ-YR NOT = WRK-CURR-ANN-YEAR DTSBE414 01367 ADD +1 TO R414-QTR-CNT. DTSBE414 01368 DTSBE414 01369 **NH IF R414-QTR-CNT GREATER THAN 50 DTSBE414 01370 IF R414-QTR-CNT GREATER THAN 60 DTSBE414 01371 DISPLAY '#### EMP HAS MORE THAN 60 QTRS ' MQTR-EMP-NO CL163 01372 GO TO P3110-EXIT. CL163 01373 DTSBE414 01374 IF L410-ANN-SCHED-88 DTSBE414 01375 SET R414-ANN-FILER-YES-88 (R414-QTR-CNT) TO TRUE DTSBE414 01376 MOVE WRK-YRQ-YR TO WRK-CURR-ANN-YEAR DTSBE414 01377 MOVE ZERO TO WRK-CURR-ANN-Q DTSBE414 01378 MOVE WRK-CURR-ANN-YRQ TO R414-QTR (R414-QTR-CNT) DTSBE414 01379 ELSE DTSBE414 01380 SET R414-ANN-FILER-NO-88 (R414-QTR-CNT) TO TRUE DTSBE414 01381 MOVE MQTR-YRQ TO R414-QTR (R414-QTR-CNT). DTSBE414 01382 DTSBE414 01383 IF MQTR-CURR-ESTIM-88 DTSBE414 01384 SET R414-QTR-EST-RPT-YES-88 (R414-QTR-CNT) TO TRUE DTSBE414 01385 ADD +1 TO WRK-ESTIMAT-RPT-CNT CL*99 01386 ELSE CL*99 01387 SET R414-QTR-EST-RPT-NO-88 (R414-QTR-CNT) TO TRUE. DTSBE414 01388 DTSBE414 01389 SET R414-QTR-APPEAL-NO-88 (R414-QTR-CNT) TO TRUE. DTSBE414 01390 DTSBE414 01391 PERFORM P3112-CHECK-APPEAL THRU P3112-EXIT DTSBE414 01392 VARYING WRK-MAPL-YRQ-IDX FROM 1 BY 1 DTSBE414 01393 UNTIL WRK-MAPL-YRQ-IDX GREATER THAN WRK-MAPL-YRQ-CNT OR DTSBE414 01394 R414-QTR-APPEAL-YES-88 (R414-QTR-CNT). DTSBE414 01395 DTSBE414 01396 PERFORM P3113-QTR-STATUS THRU P3113-EXIT. DTSBE414 01397 DTSBE414 01398 MOVE WRK-PEN-DUE TO R414-PENALTY-AMT (R414-QTR-CNT). DTSBE414 01399 MOVE WRK-TAX-DUE TO R414-CONTRIB-AMT (R414-QTR-CNT). DTSBE414 01400 MOVE WRK-INT-DUE TO R414-INTEREST-AMT (R414-QTR-CNT). DTSBE414 01401 MOVE WRK-SUR-DUE TO R414-SURCHARG-AMT (R414-QTR-CNT). DTSBE414 01402 MOVE WRK-TOT-DUE TO R414-BALANCE-AMT (R414-QTR-CNT). DTSBE414 01403 * DISPLAY ' QTR CHG DATE ' MQTR-CHNG-DATE DTSBE414 01404 * DISPLAY ' CUTOFF DATE ' WRK-GT2YR-CUTOFF-DATE. DTSBE414 01405 * IF MQTR-CHNG-DATE < WRK-GT2YR-CUTOFF-DATE DTSBE414 01406 * SET R414-CHNG-GT2YR-YES-88(R414-QTR-CNT) TO TRUE DTSBE414 01407 * ELSE DTSBE414 01408 ADD WRK-TOT-DUE TO WRK-EMP-TOT-DUE. DTSBE414 01409 * SET R414-CHNG-GT2YR-NO-88(R414-QTR-CNT) TO TRUE. DTSBE414 01410 DTSBE414 01411 IF MPRF-EMP-NO = 026483 CL172 01412 DISPLAY 'EMP ' MPRF-EMP-NO ' QTR ' MQTR-YRQ CL139 01413 DISPLAY 'PEN ' WRK-PEN-DUE CL139 01414 DISPLAY 'TAX ' WRK-TAX-DUE CL139 01415 DISPLAY 'INT ' WRK-INT-DUE CL139 01416 DISPLAY 'SUR ' WRK-SUR-DUE CL139 01417 DISPLAY 'TOT ' WRK-TOT-DUE CL139 01418 END-IF. CL139 01419 P3110-EXIT. DTSBE414 01420 EXIT. DTSBE414 01421 EJECT DTSBE414 01422 *************************************************************** DTSBE414 01423 * THIS PARAGRAPH PROJECTS THE INTEREST DUE. DTSBE414 01424 *************************************************************** DTSBE414 01425 DTSBE414 01426 P3111-PROJECT-INT. DTSBE414 01427 IF MPRF-EMP-NO = 022647 DTSBE414 01428 DISPLAY 'P3111 ' MPRF-EMP-NO DTSBE414 01429 END-IF. DTSBE414 01430 DTSBE414 01431 MOVE ZERO TO L101-PAID-CHNG. DTSBE414 01432 DTSBE414 01433 PERFORM DTSBE414 01434 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBE414 01435 UNTIL MQTR-ACCT-IDX GREATER THAN MQTR-ACCT-CNT DTSBE414 01436 DTSBE414 01437 PERFORM P3111-1-ACCUM THRU P3111-1-EXIT DTSBE414 01438 DTSBE414 01439 IF MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSBE414 01440 IF MQTR-BALANCE-AMT (MQTR-ACCT-IDX) > .00 CL159 01441 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBE414 01442 TO L101-PAID-CHNG DTSBE414 01443 END-IF DTSBE414 01444 END-IF DTSBE414 01445 DTSBE414 01446 IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) DTSBE414 01447 * IF MPRF-CLASS-RATED-88 CL161 01448 AND MQTR-YRQ >= WRK-FIRST-PEN-INT-YRQ DTSBE414 01449 IF MQTR-BALANCE-AMT (MQTR-ACCT-IDX) > .00 CL159 01450 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBE414 01451 TO L101-PAID-CHNG DTSBE414 01452 ** DISPLAY 'BE414 P3111 SUR BAL ' DTSBE414 01453 ** MQTR-BALANCE-AMT (MQTR-ACCT-IDX) DTSBE414 01454 END-IF DTSBE414 01455 * END-IF CL162 01456 END-IF DTSBE414 01457 DTSBE414 01458 END-PERFORM. DTSBE414 01459 DTSBE414 01460 IF L101-PAID-CHNG GREATER THAN ZERO DTSBE414 01461 NEXT SENTENCE DTSBE414 01462 ELSE DTSBE414 01463 GO TO P3111-EXIT. DTSBE414 01464 DTSBE414 01465 MOVE WRK-PARM-INT-COMP-DATE TO L101-RECEIVED-DATE. DTSBE414 01466 SET L101-WAIVE-INT-NO-88 TO TRUE. DTSBE414 01467 MOVE MQTR-TAX-DUE-DATE TO L101-TAX-DUE-DATE. DTSBE414 01468 MOVE MQTR-INT-AREA TO L101-INT-AREA. DTSBE414 01469 DTSBE414 01470 PERFORM S101-PER-MONTH-NO THRU S101-EXIT. DTSBE414 01471 DTSBE414 01472 ADD L101-INT-CHARGE-CHNG TO WRK-INT-DUE. DTSBE414 01473 DTSBE414 01474 SUBTRACT L101-INT-WAIVE-CHNG FROM WRK-INT-DUE. DTSBE414 01475 DTSBE414 01476 P3111-EXIT. DTSBE414 01477 EXIT. DTSBE414 01478 EJECT DTSBE414 01479 *************************************************************** DTSBE414 01480 * THIS PARAGRAPH ACCUMULATES THE TOTAL TAXES, PENALTY AND DTSBE414 01481 * INTEREST DUE AND PAID IN THE QUARTER RECORD. DTSBE414 01482 *************************************************************** DTSBE414 01483 DTSBE414 01484 P3111-1-ACCUM. DTSBE414 01485 DTSBE414 01486 EVALUATE TRUE DTSBE414 01487 WHEN MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) DTSBE414 01488 IF MQTR-BALANCE-AMT (MQTR-ACCT-IDX) > +0 CL145 01489 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) TO WRK-SUR-DUE DTSBE414 01490 END-IF DTSBE414 01491 DTSBE414 01492 WHEN MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) DTSBE414 01493 IF MQTR-BALANCE-AMT (MQTR-ACCT-IDX) > +0 CL145 01494 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) TO WRK-TAX-DUE DTSBE414 01495 END-IF DTSBE414 01496 DTSBE414 01497 WHEN MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX) DTSBE414 01498 OR MQTR-ACCT-NSF-PEN-88 (MQTR-ACCT-IDX) DTSBE414 01499 OR MQTR-ACCT-MISC-PEN-88 (MQTR-ACCT-IDX) DTSBE414 01500 IF MQTR-BALANCE-AMT (MQTR-ACCT-IDX) > +0 CL145 01501 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) TO WRK-PEN-DUE DTSBE414 01502 END-IF DTSBE414 01503 DTSBE414 01504 WHEN MQTR-ACCT-INT-88 (MQTR-ACCT-IDX) DTSBE414 01505 IF MQTR-BALANCE-AMT (MQTR-ACCT-IDX) > +0 CL145 01506 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) TO WRK-INT-DUE DTSBE414 01507 END-IF DTSBE414 01508 END-EVALUATE. DTSBE414 01509 DTSBE414 01510 P3111-1-EXIT. DTSBE414 01511 EXIT. DTSBE414 01512 EJECT DTSBE414 01513 *************************************************************** DTSBE414 01514 * THIS PARAGRAPH CHECKS TO SEE IF THE QUARTER IS BEING DTSBE414 01515 * APPEALED. DTSBE414 01516 *************************************************************** DTSBE414 01517 DTSBE414 01518 P3112-CHECK-APPEAL. DTSBE414 01519 DTSBE414 01520 IF WRK-MAPL-YRQ (WRK-MAPL-YRQ-IDX) EQUAL MQTR-YRQ DTSBE414 01521 SET R414-QTR-APPEAL-YES-88 (R414-QTR-CNT) TO TRUE. DTSBE414 01522 DTSBE414 01523 P3112-EXIT. DTSBE414 01524 EXIT. DTSBE414 01525 EJECT DTSBE414 01526 *************************************************************** DTSBE414 01527 * THIS PARAGRAPH CHECKS THE STATUS OF THE QUARTER. DTSBE414 01528 *************************************************************** DTSBE414 01529 DTSBE414 01530 P3113-QTR-STATUS. DTSBE414 01531 DTSBE414 01532 SET R414-RPT-MISSING-NO-88 (R414-QTR-CNT) TO TRUE. DTSBE414 01533 DTSBE414 01534 IF MQTR-RPT-IS-PURSUED-88 DTSBE414 01535 SET R414-RPT-MISSING-YES-88 (R414-QTR-CNT) TO TRUE DTSBE414 01536 GO TO P3113-EXIT. DTSBE414 01537 DTSBE414 01538 P3113-EXIT. DTSBE414 01539 EXIT. DTSBE414 01540 EJECT DTSBE414 01541 *************************************************************** DTSBE414 01542 * THIS PARAGRAPH CAUSES THE MTAD RECORDS TO BE PROCESSED. DTSBE414 01543 *************************************************************** DTSBE414 01544 DTSBE414 01545 P4000-PROCESS-MTAD. DTSBE414 01546 IF MPRF-EMP-NO = 022647 DTSBE414 01547 DISPLAY 'P4 ' MPRF-EMP-NO DTSBE414 01548 END-IF. DTSBE414 01549 DTSBE414 01550 MOVE LOW-VALUES TO MTAD-KEY-AREA. DTSBE414 01551 MOVE MPRF-EMP-NO TO MTAD-EMP-NO. DTSBE414 01552 SET MTAD-TAD-88 TO TRUE. DTSBE414 01553 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSBE414 01554 DTSBE414 01555 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE414 01556 DTSBE414 01557 PERFORM P4100-SCAN-MTAD THRU P4100-EXIT DTSBE414 01558 UNTIL L910-NO-REC-88. DTSBE414 01559 DTSBE414 01560 P4000-EXIT. DTSBE414 01561 EXIT. DTSBE414 01562 EJECT DTSBE414 01563 *************************************************************** DTSBE414 01564 * THIS PARAGRAPH SCANS THE MTAD RECORDS. DTSBE414 01565 *************************************************************** DTSBE414 01566 DTSBE414 01567 P4100-SCAN-MTAD. DTSBE414 01568 DTSBE414 01569 MOVE MSKL-REC TO MTAD-REC. DTSBE414 01570 DTSBE414 01571 PERFORM P4110-WRITE-MTAD-REC THRU P4110-EXIT. DTSBE414 01572 DTSBE414 01573 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE414 01574 DTSBE414 01575 P4100-EXIT. DTSBE414 01576 EXIT. DTSBE414 01577 EJECT DTSBE414 01578 *************************************************************** DTSBE414 01579 * THIS PARAGRAPH FORMATS AND WRITES THE EXTRACT RECORDS DTSBE414 01580 * FOR THE MTAD RECORDS. DTSBE414 01581 *************************************************************** DTSBE414 01582 DTSBE414 01583 P4110-WRITE-MTAD-REC. DTSBE414 01584 DTSBE414 01585 IF MTAD-UC223-NO-88 DTSBE414 01586 GO TO P4110-EXIT. DTSBE414 01587 DTSBE414 01588 ADD +1 TO TAD-FORM-CNT. DTSBE414 01589 DTSBE414 01590 MOVE LOW-VALUES TO L111-RETURN-AREA. DTSBE414 01591 MOVE MPRF-EMP-NO TO L111-EMP-NO. DTSBE414 01592 SET L111-LOOKUP-TAD-88 TO TRUE. DTSBE414 01593 MOVE MTAD-ID-NO TO L111-ID-NO. DTSBE414 01594 DTSBE414 01595 PERFORM S111-LOOKUP-ADDR THRU S111-EXIT. DTSBE414 01596 DTSBE414 01597 IF L111-ADDR-FOUND-88 DTSBE414 01598 SET L112-TAD-ADDR-88 TO TRUE DTSBE414 01599 MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA DTSBE414 01600 PERFORM P4111-FORMAT-ADDR THRU P4111-EXIT DTSBE414 01601 ELSE DTSBE414 01602 MOVE ALL '?' TO R414-FMT-ADDR DTSBE414 01603 R414-ZIP DTSBE414 01604 R414-ADVANCED-BARCODE. DTSBE414 01605 DTSBE414 01606 MOVE 'TAD' TO EVL-ADDR-TYPE. DTSBE414 01607 MOVE MTAD-ID-NO TO EVL-ADDR-ID-NO. DTSBE414 01608 MOVE WRK-EMP-TOT-DUE TO EVL-TOT-BAL-AMT. DTSBE414 01609 DTSBE414 01610 PERFORM S1000-WRITE-RECS THRU S1000-EXIT. DTSBE414 01611 DTSBE414 01612 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSBE414 01613 PERFORM S910-READ THRU S910-EXIT. DTSBE414 01614 IF L910-NO-REC-88 DTSBE414 01615 PERFORM S999-ABEND THRU S999-EXIT. DTSBE414 01616 DTSBE414 01617 P4110-EXIT. DTSBE414 01618 EXIT. DTSBE414 01619 EJECT DTSBE414 01620 *************************************************************** DTSBE414 01621 * THIS PARAGRAPH FORMATS THE ADDRESS. DTSBE414 01622 *************************************************************** DTSBE414 01623 DTSBE414 01624 P4111-FORMAT-ADDR. DTSBE414 01625 DTSBE414 01626 SET L112-ANCHOR-FIRST-88 TO TRUE. DTSBE414 01627 MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME. DTSBE414 01628 DTSBE414 01629 PERFORM S112-FORMAT-ADDR THRU S112-EXIT. DTSBE414 01630 DTSBE414 01631 MOVE L112-MAILING-ADDRESS TO R414-FMT-ADDR. DTSBE414 01632 MOVE L112-ZIP TO R414-ZIP. DTSBE414 01633 MOVE L112-ADVANCED-BARCODE TO R414-ADVANCED-BARCODE. DTSBE414 01634 DTSBE414 01635 P4111-EXIT. DTSBE414 01636 EXIT. DTSBE414 01637 EJECT DTSBE414 01638 *************************************************************** DTSBE414 01639 * THIS PARAGRAPH CAUSES THE MOPO RECORDS TO BE PROCESSED. DTSBE414 01640 *************************************************************** DTSBE414 01641 DTSBE414 01642 P5000-PROCESS-MOPO. DTSBE414 01643 DTSBE414 01644 MOVE LOW-VALUES TO MOPO-KEY-AREA. DTSBE414 01645 MOVE MPRF-EMP-NO TO MOPO-EMP-NO. DTSBE414 01646 SET MOPO-OPO-88 TO TRUE. DTSBE414 01647 MOVE MOPO-KEY-AREA TO MSKL-KEY-AREA. DTSBE414 01648 DTSBE414 01649 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE414 01650 DTSBE414 01651 PERFORM P5100-SCAN-MOPO THRU P5100-EXIT DTSBE414 01652 UNTIL L910-NO-REC-88. DTSBE414 01653 DTSBE414 01654 P5000-EXIT. DTSBE414 01655 EXIT. DTSBE414 01656 EJECT DTSBE414 01657 *************************************************************** DTSBE414 01658 * THIS PARAGRAPH SCANS THE MOPO RECORDS. DTSBE414 01659 *************************************************************** DTSBE414 01660 DTSBE414 01661 P5100-SCAN-MOPO. DTSBE414 01662 DTSBE414 01663 MOVE MSKL-REC TO MOPO-REC. DTSBE414 01664 DTSBE414 01665 PERFORM P5110-WRITE-MOPO-REC THRU P5110-EXIT. DTSBE414 01666 DTSBE414 01667 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE414 01668 DTSBE414 01669 P5100-EXIT. DTSBE414 01670 EXIT. DTSBE414 01671 EJECT DTSBE414 01672 *************************************************************** DTSBE414 01673 * THIS PARAGRAPH WRITES THE EXTRACT RECORDS FOR MOPO RECORDS. DTSBE414 01674 *************************************************************** DTSBE414 01675 DTSBE414 01676 P5110-WRITE-MOPO-REC. DTSBE414 01677 DTSBE414 01678 IF MOPO-UC223-NO-88 DTSBE414 01679 GO TO P5110-EXIT. DTSBE414 01680 DTSBE414 01681 ADD +1 TO OPO-FORM-CNT. DTSBE414 01682 DTSBE414 01683 MOVE LOW-VALUES TO L112-NAME-ADDRESS-AREA. DTSBE414 01684 SET L112-OPO-ADDR-88 TO TRUE. DTSBE414 01685 MOVE MOPO-NAME TO L112-NAME. DTSBE414 01686 MOVE MOPO-TITLE TO L112-TITLE. DTSBE414 01687 MOVE MOPO-ADDRESS TO L112-ADDRESS. DTSBE414 01688 DTSBE414 01689 PERFORM P4111-FORMAT-ADDR THRU P4111-EXIT. DTSBE414 01690 DTSBE414 01691 MOVE 'OPO' TO EVL-ADDR-TYPE DTSBE414 01692 MOVE MOPO-ID-NO TO EVL-ADDR-ID-NO. DTSBE414 01693 MOVE WRK-EMP-TOT-DUE TO EVL-TOT-BAL-AMT. DTSBE414 01694 DTSBE414 01695 PERFORM S1000-WRITE-RECS THRU S1000-EXIT. DTSBE414 01696 DTSBE414 01697 MOVE MOPO-KEY-AREA TO MSKL-KEY-AREA. DTSBE414 01698 PERFORM S910-READ THRU S910-EXIT. DTSBE414 01699 IF L910-NO-REC-88 DTSBE414 01700 PERFORM S999-ABEND THRU S999-EXIT. DTSBE414 01701 DTSBE414 01702 P5110-EXIT. DTSBE414 01703 EXIT. DTSBE414 01704 EJECT DTSBE414 01705 *************************************************************** DTSBE414 01706 * THIS PARAGRAPH CAUSES THE MTAA RECORDS TO BE PROCESSED. DTSBE414 01707 *************************************************************** DTSBE414 01708 DTSBE414 01709 P6000-PROCESS-MTAA. DTSBE414 01710 DTSBE414 01711 MOVE LOW-VALUES TO MTAA-KEY-AREA. DTSBE414 01712 MOVE MPRF-EMP-NO TO MTAA-EMP-NO. DTSBE414 01713 SET MTAA-TAA-88 TO TRUE. DTSBE414 01714 MOVE MTAA-KEY-AREA TO MSKL-KEY-AREA. DTSBE414 01715 DTSBE414 01716 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE414 01717 DTSBE414 01718 PERFORM P6100-SCAN-MTAA THRU P6100-EXIT DTSBE414 01719 UNTIL L910-NO-REC-88. DTSBE414 01720 DTSBE414 01721 P6000-EXIT. DTSBE414 01722 EXIT. DTSBE414 01723 EJECT DTSBE414 01724 *************************************************************** DTSBE414 01725 * THIS PARAGRAPH SCANS THE MTAA RECORDS. DTSBE414 01726 *************************************************************** DTSBE414 01727 DTSBE414 01728 P6100-SCAN-MTAA. DTSBE414 01729 DTSBE414 01730 MOVE MSKL-REC TO MTAA-REC. DTSBE414 01731 DTSBE414 01732 PERFORM P6110-WRITE-MTAA-REC THRU P6110-EXIT. DTSBE414 01733 DTSBE414 01734 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE414 01735 DTSBE414 01736 P6100-EXIT. DTSBE414 01737 EXIT. DTSBE414 01738 EJECT DTSBE414 01739 *************************************************************** DTSBE414 01740 * THIS PARAGRAPH WRITES THE EXTRACT RECORDS FOR MTAA RECORDS. DTSBE414 01741 *************************************************************** DTSBE414 01742 DTSBE414 01743 P6110-WRITE-MTAA-REC. DTSBE414 01744 DTSBE414 01745 IF MTAA-UC223-NO-88 DTSBE414 01746 GO TO P6110-EXIT. DTSBE414 01747 DTSBE414 01748 ADD +1 TO TAA-FORM-CNT. DTSBE414 01749 DTSBE414 01750 MOVE LOW-VALUES TO L112-NAME-ADDRESS-AREA. DTSBE414 01751 SET L112-TAA-ADDR-88 TO TRUE. DTSBE414 01752 IF MTAA-NAME = SPACES DTSBE414 01753 MOVE MPRF-PRIMARY-NAME TO L112-NAME DTSBE414 01754 ELSE DTSBE414 01755 MOVE MTAA-NAME TO L112-NAME. DTSBE414 01756 MOVE MTAA-ADDRESS TO L112-ADDRESS. DTSBE414 01757 DTSBE414 01758 PERFORM P4111-FORMAT-ADDR THRU P4111-EXIT. DTSBE414 01759 DTSBE414 01760 MOVE 'TAA' TO EVL-ADDR-TYPE DTSBE414 01761 MOVE MTAA-ID-NO TO EVL-ADDR-ID-NO. DTSBE414 01762 MOVE WRK-EMP-TOT-DUE TO EVL-TOT-BAL-AMT. DTSBE414 01763 DTSBE414 01764 PERFORM S1000-WRITE-RECS THRU S1000-EXIT. DTSBE414 01765 DTSBE414 01766 MOVE MTAA-KEY-AREA TO MSKL-KEY-AREA. DTSBE414 01767 PERFORM S910-READ THRU S910-EXIT. DTSBE414 01768 IF L910-NO-REC-88 DTSBE414 01769 PERFORM S999-ABEND THRU S999-EXIT. DTSBE414 01770 DTSBE414 01771 P6110-EXIT. DTSBE414 01772 EXIT. DTSBE414 01773 EJECT DTSBE414 01774 *************************************************************** DTSBE414 01775 * THIS PARAGRAPH REWRITES THE MCOL RECORD IF THE TEXT WAS DTSBE414 01776 * ONLY TEMPORARY. DTSBE414 01777 *************************************************************** DTSBE414 01778 DTSBE414 01779 P7000-REWRITE-MCOL. DTSBE414 01780 DTSBE414 01781 IF MCOL-STMT-TEXT-PERM-YES-88 DTSBE414 01782 GO TO P7000-EXIT. DTSBE414 01783 DTSBE414 01784 SET MCOL-STMT-TEXT-TYPE-NONE-88 TO TRUE. DTSBE414 01785 SET MCOL-STMT-TEXT-PERM-NONE-88 TO TRUE. DTSBE414 01786 MOVE +0 TO MCOL-STMT-TEXT-CNT. DTSBE414 01787 MOVE LECM-CURR-RUN-DATE TO MCOL-CHNG-DATE. DTSBE414 01788 MOVE MCOL-REC TO MSKL-REC. DTSBE414 01789 DTSBE414 01790 PERFORM S910-REWRITE THRU S910-EXIT. DTSBE414 01791 DTSBE414 01792 P7000-EXIT. DTSBE414 01793 EXIT. DTSBE414 01794 EJECT DTSBE414 01795 *************************************************************** DTSBE414 01796 * THIS PARAGRAPH WRITES THE R414 REPORT EXTRACT RECORDS. DTSBE414 01797 * IT ALSO WRITES A MEVL RECORD. DTSBE414 01798 *************************************************************** DTSBE414 01799 DTSBE414 01800 S1000-WRITE-RECS. DTSBE414 01801 DTSBE414 01802 MOVE LOW-VALUES TO R414-SORT-AREA. DTSBE414 01803 MOVE '414' TO R414-REC-TYPE. DTSBE414 01804 MOVE L061-FLD-REP-ID TO R414-FLD-REP-ID. DTSBE414 01805 MOVE R414-ZIP TO R414-SORT-ZIP. DTSBE414 01806 MOVE MPRF-EMP-NO TO R414-EMP-NO. DTSBE414 01807 MOVE MPRF-FEIN TO R414-EMP-FEIN. DTSBE414 01808 MOVE WRK-ESTIMAT-RPT-CNT TO R414-PURSUED. CL101 01809 PERFORM S946-WRITE-R414 THRU S946-EXIT. DTSBE414 01810 DTSBE414 01811 MOVE '416' TO R416-REC-TYPE. DTSBE414 01812 MOVE MPRF-EMP-NO TO R416-EMP-NO. DTSBE414 01813 MOVE WRK-PARM-INT-COMP-DATE TO R416-COMP-DATE. DTSBE414 01814 PERFORM S946-WRITE-R416 THRU S946-EXIT. DTSBE414 01815 **NH PRINTING ALL BILLS DTSBE414 01816 ** IF R414-QTR-CNT > +5 DTSBE414 01817 ** GO TO S1000-EXIT. DTSBE414 01818 DTSBE414 01819 ADD +1000 TO LECM-EMP-ABSTIME. DTSBE414 01820 DTSBE414 01821 MOVE LECM-EMP-ABSTIME TO L005-ABSTIME. DTSBE414 01822 PERFORM S005-FROM-ABSTIME THRU S005-EXIT. DTSBE414 01823 DTSBE414 01824 MOVE LOW-VALUES TO MEVL-REC. DTSBE414 01825 DTSBE414 01826 MOVE MPRF-EMP-NO TO MEVL-EMP-NO. DTSBE414 01827 SET MEVL-EVL-88 TO TRUE. DTSBE414 01828 MOVE L005-DATE TO MEVL-DATE. DTSBE414 01829 MOVE L005-TIME TO MEVL-TIME. DTSBE414 01830 MOVE +0 TO MEVL-PURGE-DATE. DTSBE414 01831 MOVE EVL-TEXT TO MEVL-TEXT. DTSBE414 01832 SET MEVL-SOURCE-SYSTEM-88 TO TRUE. DTSBE414 01833 SET MEVL-NOT-CONVERTED-88 TO TRUE. DTSBE414 01834 MOVE LECM-CURR-RUN-DATE TO MEVL-ESTB-DATE DTSBE414 01835 MEVL-CHNG-DATE. DTSBE414 01836 MOVE MEVL-REC TO MSKL-REC. DTSBE414 01837 DTSBE414 01838 PERFORM S910-WRITE THRU S910-EXIT. DTSBE414 01839 DTSBE414 01840 S1000-EXIT. DTSBE414 01841 EXIT. DTSBE414 01842 EJECT DTSBE414 01843 *************************************************************** DTSBE414 01844 * THIS PARAGRAPH INITIALIZES THE TABLE IN THE EXTRACT RECORD. DTSBE414 01845 *************************************************************** DTSBE414 01846 DTSBE414 01847 S2000-INITIALIZE-TABLE. DTSBE414 01848 DTSBE414 01849 MOVE ZEROS TO R414-QTR (WRK-SUB) DTSBE414 01850 R414-CONTRIB-AMT (WRK-SUB) DTSBE414 01851 R414-INTEREST-AMT (WRK-SUB) DTSBE414 01852 R414-PENALTY-AMT (WRK-SUB) DTSBE414 01853 R414-BALANCE-AMT (WRK-SUB) DTSBE414 01854 R414-SURCHARG-AMT (WRK-SUB). DTSBE414 01855 MOVE SPACES TO R414-QTR-APPEAL-IND (WRK-SUB) DTSBE414 01856 R414-QTR-EST-RPT-IND (WRK-SUB) DTSBE414 01857 R414-RPT-MISSING-IND (WRK-SUB) DTSBE414 01858 R414-ANNUAL-FILER-IND (WRK-SUB) DTSBE414 01859 R414-LAST-CHNG-IND (WRK-SUB). DTSBE414 01860 DTSBE414 01861 S2000-EXIT. DTSBE414 01862 EXIT. DTSBE414 01863 EJECT DTSBE414 01864 S3000-WRITE-R414. DTSBE414 01865 ***NH PRINTING ALL BILLS DTSBE414 01866 ** IF ERROR-CNT = 1 DTSBE414 01867 MOVE MPRF-PRIMARY-NAME TO R414-FMT-LINE(1) DTSBE414 01868 R414-FMT-LINE(2). DTSBE414 01869 DTSBE414 01870 MOVE LOW-VALUES TO R414-SORT-AREA. DTSBE414 01871 MOVE '414' TO R414-REC-TYPE. DTSBE414 01872 MOVE L061-FLD-REP-ID TO R414-FLD-REP-ID. DTSBE414 01873 MOVE R414-ZIP TO R414-SORT-ZIP. DTSBE414 01874 MOVE MPRF-EMP-NO TO R414-EMP-NO. DTSBE414 01875 MOVE MPRF-FEIN TO R414-EMP-FEIN. DTSBE414 01876 **NH PERFORM S946-WRITE-R414 THRU S946-EXIT. DTSBE414 01877 DTSBE414 01878 MOVE '416' TO R416-REC-TYPE. DTSBE414 01879 MOVE MPRF-EMP-NO TO R416-EMP-NO. DTSBE414 01880 MOVE WRK-PARM-INT-COMP-DATE TO R416-COMP-DATE. DTSBE414 01881 PERFORM S946-WRITE-R416 THRU S946-EXIT. DTSBE414 01882 DTSBE414 01883 S3000-EXIT. DTSBE414 01884 EXIT. DTSBE414 01885 T0000-TERMINATE. DTSBE414 01886 DISPLAY ' T0000'. DTSBE414 01887 DISPLAY SPACE. DTSBE414 01888 DISPLAY '*** BD414 TERMINATION ***'. DTSBE414 01889 DISPLAY '*** EMPLOYERS BYPASSED: ' DTSBE414 01890 DISPLAY '*** CURR QTR ONLY DELINQUENT ' DTSBE414 01891 WRK-BYPASS-CNT. DTSBE414 01892 DISPLAY '*** EMPLOYERS SKIPPED - FOUND IN TBL: ' DTSBE414 01893 WRK-BYPASS-TBL. DTSBE414 01894 DISPLAY ' '. DTSBE414 01895 DISPLAY '*** 1ST BROWSE, MEVL FIND NO REC ' DTSBE414 01896 WRK-MEVL-REC-NOT-FIND-CNT. DTSBE414 01897 * DISPLAY ' '. DTSBE414 01898 DISPLAY '*** STMT ACCT GENERATED BY THE WEB ' DTSBE414 01899 WRK-WEB-STMT-ACCT-SEND-CNT. DTSBE414 01900 DISPLAY ' '. DTSBE414 01901 DISPLAY '*** STMT ACCT GEN 10/24,25 BY WEB ' DTSBE414 01902 WRK-MEVL-DATE-1-CNT. DTSBE414 01903 DISPLAY '*** MAIL RETURN IND - YES ' DTSBE414 01904 WRK-EMPL-MAIL-CNT. DTSBE414 01905 DISPLAY '*** EMPL HAS MORE THAN 50 QTRS OUTS ' DTSBE414 01906 WRK-EMPL-CNT-50. DTSBE414 01907 DISPLAY '*** EMPL HAS MORE THAN 6 QTRS DUE ' DTSBE414 01908 WRK-EMPL-CNT-6. DTSBE414 01909 CLOSE EMP-RPT-FILE. DTSBE414 01910 DTSBE414 01911 T0000-EXIT. DTSBE414 01912 EXIT. DTSBE414 01913 EJECT DTSBE414 01914 S001-FROM-FED-8. DTSBE414 01915 SET L001-FROM-FED-8 TO TRUE. DTSBE414 01916 GO TO S001-DATE. DTSBE414 01917 SKIP1 DTSBE414 01918 S001-FROM-ABS-DAY. DTSBE414 01919 SET L001-FROM-ABS-DAY TO TRUE. DTSBE414 01920 GO TO S001-DATE. DTSBE414 01921 SKIP1 DTSBE414 01922 S001-FROM-CAL-6. DTSBE414 01923 SET L001-FROM-CAL-6 TO TRUE. DTSBE414 01924 GO TO S001-DATE. DTSBE414 01925 SKIP1 DTSBE414 01926 S001-DATE. DTSBE414 01927 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBE414 01928 S001-EXIT. DTSBE414 01929 EXIT. DTSBE414 01930 SKIP3 DTSBE414 01931 S004-FROM-5. DTSBE414 01932 SET L004-FROM-5 TO TRUE. DTSBE414 01933 GO TO S004-QTR. DTSBE414 01934 SKIP1 DTSBE414 01935 S004-FROM-ABS. DTSBE414 01936 SET L004-FROM-ABS TO TRUE. DTSBE414 01937 GO TO S004-QTR. DTSBE414 01938 SKIP1 DTSBE414 01939 S004-FROM-DATE. DTSBE414 01940 SET L004-FROM-DATE TO TRUE. DTSBE414 01941 GO TO S004-QTR. DTSBE414 01942 SKIP1 DTSBE414 01943 S004-QTR. DTSBE414 01944 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBE414 01945 S004-EXIT. DTSBE414 01946 EXIT. DTSBE414 01947 SKIP3 DTSBE414 01948 S005-FROM-ABSTIME. DTSBE414 01949 SET L005-FROM-ABSTIME TO TRUE. DTSBE414 01950 GO TO S005-ABSTIME. DTSBE414 01951 SKIP1 DTSBE414 01952 S005-ABSTIME. DTSBE414 01953 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBE414 01954 S005-EXIT. DTSBE414 01955 EXIT. DTSBE414 01956 SKIP3 DTSBE414 01957 S082-LOOKUP-OP-ID. DTSBE414 01958 CALL 'DTSBU082' USING L082-LINK-AREA. DTSBE414 01959 S082-EXIT. DTSBE414 01960 EXIT. DTSBE414 01961 SKIP3 DTSBE414 01962 S061-DETERMINE-FLD-REP. DTSBE414 01963 MOVE MPRF-FLD-ZIP TO L061-FLD-ZIP. DTSBE414 01964 * MOVE MPRF-FLD-ZIP-ST TO L061-FLD-ZIP-ST. DTSBE414 01965 MOVE MPRF-EMP-NO TO L061-EMP-NO. DTSBE414 01966 CALL 'DTSBU061' USING L061-LINK-AREA. DTSBE414 01967 * DISPLAY 'L061-FLD-REP ' L061-FLD-REP-ID. DTSBE414 01968 DTSBE414 01969 S061-EXIT. DTSBE414 01970 EXIT. DTSBE414 01971 SKIP3 DTSBE414 01972 S101-PER-MONTH-NO. DTSBE414 01973 SET L101-PER-MONTH-NO-88 TO TRUE. DTSBE414 01974 GO TO S101-INT-CHARGE. DTSBE414 01975 DTSBE414 01976 S101-INT-CHARGE. DTSBE414 01977 CALL 'DTSBU101' USING L101-LINK-AREA. DTSBE414 01978 S101-EXIT. DTSBE414 01979 EXIT. DTSBE414 01980 SKIP3 DTSBE414 01981 S109-FIRST-PEN-INT-YRQ. DTSBE414 01982 SET L109-CMND-PEN-INT-QTR-88 TO TRUE. DTSBE414 01983 GO TO S109-SUR-RATE. DTSBE414 01984 DTSBE414 01985 S109-LOOKUP-SUR-RATE. DTSBE414 01986 MOVE MPRF-EMP-CLASS TO L109-EMP-CLASS. DTSBE414 01987 MOVE MQTR-YRQ TO L109-YRQ. DTSBE414 01988 SET L109-CMND-INPUT-QTR-88 TO TRUE. DTSBE414 01989 GO TO S109-SUR-RATE. DTSBE414 01990 DTSBE414 01991 S109-SUR-RATE. DTSBE414 01992 CALL 'DTSBU109' USING L109-LINK-AREA. DTSBE414 01993 S109-EXIT. DTSBE414 01994 EXIT. DTSBE414 01995 SKIP3 DTSBE414 01996 S111-LOOKUP-ADDR. DTSBE414 01997 CALL 'DTSBU111' USING L111-LINK-AREA. DTSBE414 01998 S111-EXIT. DTSBE414 01999 EXIT. DTSBE414 02000 SKIP3 DTSBE414 02001 S112-FORMAT-ADDR. DTSBE414 02002 CALL 'DTSBU112' USING L112-LINK-AREA. DTSBE414 02003 S112-EXIT. DTSBE414 02004 EXIT. DTSBE414 02005 SKIP3 DTSBE414 02006 S410-FILE-SCHED. DTSBE414 02007 CALL 'DTSBU410' USING L410-LINK-AREA. DTSBE414 02008 S410-EXIT. DTSBE414 02009 EXIT. DTSBE414 02010 SKIP3 DTSBE414 02011 S910-READ. DTSBE414 02012 SET L910-READ-88 TO TRUE. DTSBE414 02013 GO TO S910-MSTR-IO. DTSBE414 02014 SKIP1 DTSBE414 02015 S910-START-BROWSE. DTSBE414 02016 SET L910-START-BROWSE-88 TO TRUE. DTSBE414 02017 GO TO S910-MSTR-IO. DTSBE414 02018 SKIP1 DTSBE414 02019 S910-READ-NEXT. DTSBE414 02020 SET L910-READ-NEXT-88 TO TRUE. DTSBE414 02021 GO TO S910-MSTR-IO. DTSBE414 02022 SKIP1 DTSBE414 02023 S910-COUNT. DTSBE414 02024 SET L910-COUNT-88 TO TRUE. DTSBE414 02025 GO TO S910-MSTR-IO. DTSBE414 02026 SKIP1 DTSBE414 02027 S910-WRITE. DTSBE414 02028 SET L910-WRITE-88 TO TRUE. DTSBE414 02029 SET LECM-EMP-UPDATED-YES-88 TO TRUE. DTSBE414 02030 GO TO S910-MSTR-IO. DTSBE414 02031 SKIP1 DTSBE414 02032 S910-REWRITE. DTSBE414 02033 SET L910-REWRITE-88 TO TRUE. DTSBE414 02034 SET LECM-EMP-UPDATED-YES-88 TO TRUE. DTSBE414 02035 GO TO S910-MSTR-IO. DTSBE414 02036 SKIP1 DTSBE414 02037 S910-DELETE. DTSBE414 02038 SET L910-DELETE-88 TO TRUE. DTSBE414 02039 SET LECM-EMP-UPDATED-YES-88 TO TRUE. DTSBE414 02040 GO TO S910-MSTR-IO. DTSBE414 02041 SKIP1 DTSBE414 02042 S910-MSTR-IO. DTSBE414 02043 CALL 'DTSBU910' USING L910-LINK-AREA DTSBE414 02044 MSKL-REC. DTSBE414 02045 S910-EXIT. DTSBE414 02046 EXIT. DTSBE414 02047 SKIP3 DTSBE414 02048 S946-WRITE-R414. DTSBE414 02049 CALL 'DTSBU946' USING R414-REC. DTSBE414 02050 GO TO S946-EXIT. DTSBE414 02051 SKIP1 DTSBE414 02052 S946-WRITE-R416. DTSBE414 02053 CALL 'DTSBU946' USING R416-REC. DTSBE414 02054 GO TO S946-EXIT. DTSBE414 02055 SKIP1 DTSBE414 02056 S946-WRITE-R907. DTSBE414 02057 MOVE '907' TO R907-REC-TYPE. DTSBE414 02058 CALL 'DTSBU946' USING R907-REC. DTSBE414 02059 GO TO S946-EXIT. DTSBE414 02060 SKIP1 DTSBE414 02061 S946-EXIT. DTSBE414 02062 EXIT. DTSBE414 02063 SKIP3 DTSBE414 02064 S999-ABEND. DTSBE414 02065 DISPLAY '*** DTSBE414 ABENDING. ' DTSBE414 02066 ABEND-MSG. DTSBE414 02067 SKIP1 DTSBE414 02068 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBE414 02069 S999-EXIT. DTSBE414 02070 EXIT. DTSBE414