2072 lines
164 KiB
COBOL
2072 lines
164 KiB
COBOL
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
|