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