1313 lines
104 KiB
COBOL
1313 lines
104 KiB
COBOL
00001 IDENTIFICATION DIVISION. 06/11/21
|
|
00002 PROGRAM-ID. DTSBE439. DTSBE439
|
|
00003 AUTHOR. TRW. LV059
|
|
00004 DATE-WRITTEN. FEB 2006. DTSBE439
|
|
00005 DATE-COMPILED. DTSBE439
|
|
00006 DTSBE439
|
|
00007 ***** DTSBE439
|
|
00008 * DTSBE439
|
|
00009 * CALLING SEQUENCE: DTSBD400 CALL DTSBE439 TO CREATE DTSBE439
|
|
00010 * DTSIR439 RECORDS. DTSBE439
|
|
00011 * DTSBD800 CALLS DTSBR439 USING DTSIR439 DTSBE439
|
|
00012 * TO PRODUCES THE REPORT. DTSBE439
|
|
00013 * DTSBE439
|
|
00014 * FUNCTION: WRITE OFF CANDIDATE LIST - REPORTS. DTSBE439
|
|
00015 * DTSBE439
|
|
00016 * DTSBE439
|
|
00017 * MODIFICATION LOG: DTSBE439
|
|
00018 * DTSBE439
|
|
00019 * 11/28/2007 INITIAL DEVELOPMENT DTSBE439
|
|
00020 * WORK ORDER: PROGRAMMER: GD DTSBE439
|
|
00021 * DTSBE439
|
|
00022 * CL*19
|
|
00023 * 12/28/2015 MODIFY PROGRAM TO CALL NEW BATCH NO UTILITY CL*19
|
|
00024 * TO GET NEXT AVAIL BATCH NUMBER CL*19
|
|
00025 * WORK ORDER: PROGRAMMER: ZL1 CL*19
|
|
00026 * CL*19
|
|
00027 * XX/XX/XXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE439
|
|
00028 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBE439
|
|
00029 * WORK ORDER: PROGRAMMER: XXX DTSBE439
|
|
00030 * DTSBE439
|
|
00031 * DTSBE439
|
|
00032 * DESCRIPTION: DTSBE439
|
|
00033 * DTSBE439
|
|
00034 * DTSBE439
|
|
00035 * INITIATION: DTSBE439
|
|
00036 * DTSBE439
|
|
00037 * SET LECM-MST-OPEN-READ-88 TO TRUE. DTSBE439
|
|
00038 * SET LECM-REF-OPEN-READ-88 TO TRUE. DTSBE439
|
|
00039 * DTSBE439
|
|
00040 * CHECK AND DEFAULT PARAMETERS. DTSBE439
|
|
00041 * DTSBE439
|
|
00042 * DTSBE439
|
|
00043 * PROCESSING: DTSBE439
|
|
00044 * DTSBE439
|
|
00045 * SEE PRINTED OUTPUTS DESCRIPTION AND LAYOUTS (430R1). DTSBE439
|
|
00046 * DTSBE439
|
|
00047 * DTSBE439
|
|
00048 * TERMINATION: DTSBE439
|
|
00049 * DTSBE439
|
|
00050 * NO PROCESSING. DTSBE439
|
|
00051 * DTSBE439
|
|
00052 * DTSBE439
|
|
00053 * RECORDS READ: DTSBE439
|
|
00054 * DTSBE439
|
|
00055 * MASTER: DTSBE439
|
|
00056 * DTSBE439
|
|
00057 * MSOL DTSBE439
|
|
00058 * DTSBE439
|
|
00059 * DTSBE439
|
|
00060 * ALTERNATE INDEX: DTSBE439
|
|
00061 * DTSBE439
|
|
00062 * NONE. DTSBE439
|
|
00063 * DTSBE439
|
|
00064 * DTSBE439
|
|
00065 * REFERENCE: DTSBE439
|
|
00066 * DTSBE439
|
|
00067 * NONE. DTSBE439
|
|
00068 * DTSBE439
|
|
00069 * DTSBE439
|
|
00070 * RECORDS UPDATED: DTSBE439
|
|
00071 * DTSBE439
|
|
00072 * NONE. DTSBE439
|
|
00073 * DTSBE439
|
|
00074 * DTSBE439
|
|
00075 * REPORT RECORDS WRITTEN: DTSBE439
|
|
00076 * DTSBE439
|
|
00077 * R430 WRITE OFF-CANDIDATE LIST. DTSBE439
|
|
00078 * DTSBE439
|
|
00079 * DTSBE439
|
|
00080 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DTSBE439
|
|
00081 * DTSBE439
|
|
00082 * NONE. DTSBE439
|
|
00083 * DTSBE439
|
|
00084 * DTSBE439
|
|
00085 * MODULES CALLED: DTSBE439
|
|
00086 * DTSBE439
|
|
00087 * DTSBU001 DATE CONVERSION/EDIT. DTSBE439
|
|
00088 * DTSBU004 QUARTER CONVERSION/EDIT. DTSBE439
|
|
00089 * DTSBU061 FIELD ZIP / FIELD REP ID. DTSBE439
|
|
00090 * DTSBU600 FIND EMPLOYER SUCCESSOR DTSBE439
|
|
00091 * DTSBU910 MASTER FILE I/O. DTSBE439
|
|
00092 * DTSBU946 VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1. DTSBE439
|
|
00093 * DTSBU985 GET NEXT BATCH NUMBER. CL*19
|
|
00094 * DTSBE439
|
|
00095 * DTSBE439
|
|
00096 * VERMONT REFERENCE: DTSBE439
|
|
00097 * DTSBE439
|
|
00098 * TXBE344. DTSBE439
|
|
00099 * DTSBE439
|
|
00100 ***** DTSBE439
|
|
00101 DTSBE439
|
|
00102 ENVIRONMENT DIVISION. DTSBE439
|
|
00103 INPUT-OUTPUT SECTION. DTSBE439
|
|
00104 FILE-CONTROL. DTSBE439
|
|
00105 SELECT DEBIT-WRITEOFFS ASSIGN TO DTSF439D DTSBE439
|
|
00106 FILE STATUS IS DEBIT-STATUS. DTSBE439
|
|
00107 DTSBE439
|
|
00108 SELECT CREDIT-WRITEOFFS ASSIGN TO DTSF439C DTSBE439
|
|
00109 FILE STATUS IS CREDIT-STATUS. DTSBE439
|
|
00110 DTSBE439
|
|
00111 DATA DIVISION. DTSBE439
|
|
00112 FILE SECTION. DTSBE439
|
|
00113 FD DEBIT-WRITEOFFS DTSBE439
|
|
00114 RECORDING MODE IS F DTSBE439
|
|
00115 LABEL RECORDS ARE STANDARD DTSBE439
|
|
00116 BLOCK CONTAINS 0 CHARACTERS. DTSBE439
|
|
00117 DTSBE439
|
|
00118 01 DEBIT-REC PIC X(151). CL*37
|
|
00119 DTSBE439
|
|
00120 FD CREDIT-WRITEOFFS DTSBE439
|
|
00121 RECORDING MODE IS F DTSBE439
|
|
00122 LABEL RECORDS ARE STANDARD DTSBE439
|
|
00123 BLOCK CONTAINS 0 CHARACTERS. DTSBE439
|
|
00124 DTSBE439
|
|
00125 01 CREDIT-REC PIC X(151). CL*37
|
|
00126 DTSBE439
|
|
00127 WORKING-STORAGE SECTION. DTSBE439
|
|
001275 77 PAN-VALET PICTURE X(24) VALUE '059DTSBE439 06/11/21'. DTSBE439
|
|
00128 DTSBE439
|
|
00129 01 WRK-AREA. DTSBE439
|
|
00130 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +439.DTSBE439
|
|
00131 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBE439'.DTSBE439
|
|
00132 05 ABEND-MSG PIC X(60). DTSBE439
|
|
00133 DTSBE439
|
|
00134 05 DEBIT-STATUS PIC X(02). DTSBE439
|
|
00135 88 DEBIT-STATUS-OK-88 VALUE '00'. DTSBE439
|
|
00136 05 CREDIT-STATUS PIC X(02). DTSBE439
|
|
00137 88 CREDIT-STATUS-OK-88 VALUE '00'. DTSBE439
|
|
00138 DTSBE439
|
|
00139 05 WRK-EMPL-READ-CNT PIC S9(07) COMP-3 VALUE +0. DTSBE439
|
|
00140 05 WRK-EMPL-INACT-CNT PIC S9(07) COMP-3 VALUE +0. DTSBE439
|
|
00141 05 WRK-EMPL-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBE439
|
|
00142 05 WRK-TOT-WRITEOFF-AMT PIC S9(11)V99 COMP-3 DTSBE439
|
|
00143 VALUE +0. DTSBE439
|
|
00144 05 WRK-EVL-BAL9 PIC 9(06)V99 VALUE ZEROS. CL*44
|
|
00145 05 WRK-EVL-BAL REDEFINES WRK-EVL-BAL9 PIC Z(06).99. CL*56
|
|
00146 05 GWRK-EMP-BAL PIC S9(11)V99 COMP-3 CL*22
|
|
00147 VALUE +0. CL*22
|
|
00148 05 WRK-EMP-BAL PIC S9(11)V99 COMP-3 CL*22
|
|
00149 VALUE +0. CL*22
|
|
00150 05 WRK-EMP-BAL-ESTIM PIC S9(11)V99 COMP-3 CL*22
|
|
00151 VALUE +0. CL*22
|
|
00152 05 WRK-UI-BAL PIC S9(11)V99 COMP-3 CL*22
|
|
00153 VALUE +0. CL*22
|
|
00154 05 WRK-SU-BAL PIC S9(11)V99 COMP-3 CL*22
|
|
00155 VALUE +0. CL*22
|
|
00156 05 WRK-INT-BAL PIC S9(11)V99 COMP-3 CL*22
|
|
00157 VALUE +0. CL*22
|
|
00158 05 WRK-PEN-BAL PIC S9(11)V99 COMP-3 CL*22
|
|
00159 VALUE +0. CL*22
|
|
00160 05 TOT-UI-BAL PIC S9(11)V99 COMP-3 CL*22
|
|
00161 VALUE +0. CL*22
|
|
00162 05 TOT-SU-BAL PIC S9(11)V99 COMP-3 CL*22
|
|
00163 VALUE +0. CL*22
|
|
00164 05 TOT-INT-BAL PIC S9(11)V99 COMP-3 CL*22
|
|
00165 VALUE +0. CL*22
|
|
00166 05 TOT-PEN-BAL PIC S9(11)V99 COMP-3 CL*22
|
|
00167 VALUE +0. CL*22
|
|
00168 05 GTOT-UI-BAL PIC S9(11)V99 COMP-3 CL*22
|
|
00169 VALUE +0. CL*22
|
|
00170 05 GTOT-SU-BAL PIC S9(11)V99 COMP-3 CL*22
|
|
00171 VALUE +0. CL*22
|
|
00172 05 GTOT-INT-BAL PIC S9(11)V99 COMP-3 CL*22
|
|
00173 VALUE +0. CL*22
|
|
00174 05 GTOT-PEN-BAL PIC S9(11)V99 COMP-3 CL*22
|
|
00175 VALUE +0. CL*22
|
|
00176 05 GTOT-CREDIT-BAL PIC S9(11)V99 COMP-3 CL*22
|
|
00177 VALUE +0. CL*22
|
|
00178 05 TOT-UI-BAL-ESTIM PIC S9(11)V99 COMP-3 CL*22
|
|
00179 VALUE +0. CL*22
|
|
00180 05 TOT-SU-BAL-ESTIM PIC S9(11)V99 COMP-3 CL*22
|
|
00181 VALUE +0. CL*22
|
|
00182 05 TOT-INT-BAL-ESTIM PIC S9(11)V99 COMP-3 CL*22
|
|
00183 VALUE +0. CL*22
|
|
00184 05 TOT-PEN-BAL-ESTIM PIC S9(11)V99 COMP-3 CL*22
|
|
00185 VALUE +0. CL*22
|
|
00186 CL*22
|
|
00187 05 WRK-AMT-DISP PIC 9(10)9.99-. DTSBE439
|
|
00188 05 WRK-QTR-BEGIN-DATE PIC S9(09) COMP-3. DTSBE439
|
|
00189 DTSBE439
|
|
00190 05 WRK-QTR-BEGIN-DATE-DISP PIC 9(08). DTSBE439
|
|
00191 05 FILLER REDEFINES WRK-QTR-BEGIN-DATE-DISP. DTSBE439
|
|
00192 10 WRK-QTR-BEGIN-YR PIC 9(04). DTSBE439
|
|
00193 10 WRK-QTR-BEGIN-MO PIC 9(02). DTSBE439
|
|
00194 10 WRK-QTR-BEGIN-DA PIC 9(02). DTSBE439
|
|
00195 DTSBE439
|
|
00196 05 WRK-INACT-CUTOFF-YRQ PIC S9(05) COMP-3. DTSBE439
|
|
00197 DTSBE439
|
|
00198 05 WRK-INACT-DATE PIC S9(09) COMP-3. DTSBE439
|
|
00199 DTSBE439
|
|
00200 05 WRK-LAST-LIAB-YRQ PIC S9(05) COMP-3. DTSBE439
|
|
00201 DTSBE439
|
|
00202 05 WRK-EXP-TRN-EFF-DATE PIC S9(09) COMP-3 DTSBE439
|
|
00203 VALUE +999999999. DTSBE439
|
|
00204 05 WRK-SUCCESSOR PIC 9(06). DTSBE439
|
|
00205 DTSBE439
|
|
00206 05 WRK-LAST-ACTIVITY-DT PIC S9(09) COMP-3. DTSBE439
|
|
00207 05 WRK-ALL-NINES-DT PIC S9(09) COMP-3 DTSBE439
|
|
00208 VALUE +999999999. DTSBE439
|
|
00209 05 WRK-AHDR-ITEM-NO PIC S9(3) COMP-3 VALUE 0. CL*26
|
|
00210 DTSBE439
|
|
00211 05 HOLD-FIRST-BATCH-NO PIC S9(05) COMP-3. DTSBE439
|
|
00212 05 HOLD-LAST-USED-BATCH-NO PIC S9(05) COMP-3. DTSBE439
|
|
00213 DTSBE439
|
|
00214 05 WRK-EDIT-STATUS-IND PIC X(01). DTSBE439
|
|
00215 88 WRK-EDIT-PASSED-88 VALUE 'Y'. DTSBE439
|
|
00216 88 WRK-EDIT-FAILED-88 VALUE 'N'. DTSBE439
|
|
00217 DTSBE439
|
|
00218 05 WRK-PARM-INDICATORS. DTSBE439
|
|
00219 10 FILLER PIC X(04) DTSBE439
|
|
00220 VALUE '*** '. DTSBE439
|
|
00221 10 FILLER PIC X(03) DTSBE439
|
|
00222 VALUE '439'. DTSBE439
|
|
00223 10 FILLER PIC X VALUE ','. DTSBE439
|
|
00224 10 WRK-PARM-DEFF-PAY-CNTR-IND PIC X(01). DTSBE439
|
|
00225 88 WRK-PARM-DEFF-PAY-CNTR-YES-88 VALUE 'Y'. DTSBE439
|
|
00226 88 WRK-PARM-DEFF-PAY-CNTR-NO-88 VALUE 'N'. DTSBE439
|
|
00227 10 FILLER PIC X VALUE ','. DTSBE439
|
|
00228 10 WRK-PARM-EMPL-WITH-LIEN-IND PIC X(01). DTSBE439
|
|
00229 88 WRK-PARM-EMPL-W-LIEN-YES-88 VALUE 'Y'. DTSBE439
|
|
00230 88 WRK-PARM-EMPL-W-LIEN-NO-88 VALUE 'N'. DTSBE439
|
|
00231 10 FILLER PIC X VALUE ','. DTSBE439
|
|
00232 10 WRK-PARM-SELF-INS-EMPL-IND PIC X(01). DTSBE439
|
|
00233 88 WRK-PARM-SELF-INS-EMPL-YES-88 VALUE 'Y'. DTSBE439
|
|
00234 88 WRK-PARM-SELF-INS-EMPL-NO-88 VALUE 'N'. DTSBE439
|
|
00235 DTSBE439
|
|
00236 05 WRK-DOWNLOAD-REC. DTSBE439
|
|
00237 10 DWN-EMP-NO PIC 9(06). CL*37
|
|
00238 10 FILLER PIC X(01) VALUE ','. CL*37
|
|
00239 10 DWN-EMP-NAME PIC X(36). CL*37
|
|
00240 10 FILLER PIC X(01) VALUE ','. CL*37
|
|
00241 10 DWN-EMP-STAT PIC X(03). CL*37
|
|
00242 10 FILLER PIC X(01) VALUE ','. CL*37
|
|
00243 10 DWN-FIELD-CODE PIC X(02). CL*37
|
|
00244 10 FILLER PIC X(01) VALUE ','. CL*37
|
|
00245 10 DWN-TOT-BAL-MPRF PIC --------9.99. CL*37
|
|
00246 10 FILLER PIC X(01) VALUE ','. CL*37
|
|
00247 10 DWN-UI-BAL PIC --------9.99. CL*37
|
|
00248 10 FILLER PIC X(01) VALUE ','. CL*37
|
|
00249 10 DWN-SU-BAL PIC --------9.99. CL*37
|
|
00250 10 FILLER PIC X(01) VALUE ','. CL*37
|
|
00251 10 DWN-PEN-BAL PIC --------9.99. CL*37
|
|
00252 10 FILLER PIC X(01) VALUE ','. CL*37
|
|
00253 10 DWN-INT-BAL PIC --------9.99. CL*37
|
|
00254 10 FILLER PIC X(01) VALUE ','. CL*37
|
|
00255 10 DWN-TOT-BAL PIC --------9.99. CL*37
|
|
00256 10 FILLER PIC X(01) VALUE ','. CL*37
|
|
00257 * 10 DWN-UI-BAL-ESTIM PIC ----------9.99. CL*37
|
|
00258 * 10 FILLER PIC X(01) VALUE ','. CL*37
|
|
00259 * 10 DWN-SU-BAL-ESTIM PIC ----------9.99. CL*37
|
|
00260 * 10 FILLER PIC X(01) VALUE ','. CL*37
|
|
00261 * 10 DWN-PEN-BAL-ESTIM PIC ----------9.99. CL*37
|
|
00262 * 10 FILLER PIC X(01) VALUE ','. CL*37
|
|
00263 * 10 DWN-INT-BAL-ESTIM PIC ----------9.99. CL*37
|
|
00264 * 10 FILLER PIC X(01) VALUE ','. CL*37
|
|
00265 10 DWN-MISSING-RPTS PIC 9(03). CL*37
|
|
00266 10 FILLER PIC X(01) VALUE ','. CL*37
|
|
00267 10 DWN-DPC PIC X(01). CL*37
|
|
00268 10 FILLER PIC X(01) VALUE ','. CL*37
|
|
00269 10 DWN-LIEN PIC X(01). CL*37
|
|
00270 10 FILLER PIC X(01) VALUE ','. CL*37
|
|
00271 10 DWN-LAST-LIAB-YRQ PIC X(06). CL*37
|
|
00272 10 FILLER PIC X(01) VALUE ','. CL*37
|
|
00273 10 DWN-LAST-ACT-DATE PIC X(10). CL*37
|
|
00274 05 EVL-TEXT. CL*40
|
|
00275 10 FILLER PIC X(30) CL*57
|
|
00276 VALUE 'ACCOUNT BALANCE WRITTEN OFF: '. CL*57
|
|
00277 10 FILLER PIC X(10) VALUE SPACES. CL*57
|
|
00278 10 EVL-BAL PIC ZZZ,ZZ9.99. CL*59
|
|
00279 EJECT CL*40
|
|
00280 DTSBE439
|
|
00281 EJECT DTSBE439
|
|
00282 01 L001-LINK-AREA. DTSBE439
|
|
00283 ++INCLUDE DTSIL001 DTSBE439
|
|
00284 CL*42
|
|
00285 01 L005-LINK-AREA. CL*42
|
|
00286 ++INCLUDE DTSIL005 CL*42
|
|
00287 EJECT DTSBE439
|
|
00288 01 L004-LINK-AREA. DTSBE439
|
|
00289 ++INCLUDE DTSIL004 DTSBE439
|
|
00290 EJECT DTSBE439
|
|
00291 01 L061-LINK-AREA. DTSBE439
|
|
00292 ++INCLUDE DTSIL061 DTSBE439
|
|
00293 01 L101-LINK-AREA. CL*23
|
|
00294 ++INCLUDE DTSIL101 CL*23
|
|
00295 EJECT DTSBE439
|
|
00296 01 L600-LINK-AREA. DTSBE439
|
|
00297 ++INCLUDE DTSIL600 DTSBE439
|
|
00298 EJECT DTSBE439
|
|
00299 01 L910-LINK-AREA. DTSBE439
|
|
00300 ++INCLUDE DTSIL910 DTSBE439
|
|
00301 SKIP3 DTSBE439
|
|
00302 01 MSKL-REC. DTSBE439
|
|
00303 ++INCLUDE DTSIMSKL DTSBE439
|
|
00304 SKIP3 DTSBE439
|
|
00305 01 MHDR-REC. DTSBE439
|
|
00306 ++INCLUDE DTSIMHDR DTSBE439
|
|
00307 01 MQTR-REC. CL*23
|
|
00308 ++INCLUDE DTSIMQTR CL*23
|
|
00309 SKIP3 DTSBE439
|
|
00310 01 MEVL-REC. CL*40
|
|
00311 ++INCLUDE DTSIMEVL CL*40
|
|
00312 01 MSOL-REC. CL*40
|
|
00313 ++INCLUDE DTSIMSOL CL*40
|
|
00314 01 MLIN-REC. CL*23
|
|
00315 ++INCLUDE DTSIMLIN CL*23
|
|
00316 01 MDPC-REC. CL*23
|
|
00317 ++INCLUDE DTSIMDPC CL*23
|
|
00318 EJECT DTSBE439
|
|
00319 01 MLOG-REC. DTSBE439
|
|
00320 ++INCLUDE DTSIMLOG DTSBE439
|
|
00321 EJECT DTSBE439
|
|
00322 01 MJRN-REC. DTSBE439
|
|
00323 ++INCLUDE DTSIMJRN DTSBE439
|
|
00324 EJECT DTSBE439
|
|
00325 01 MRPT-REC. DTSBE439
|
|
00326 ++INCLUDE DTSIMRPT DTSBE439
|
|
00327 EJECT DTSBE439
|
|
00328 01 L923-LINK-AREA. DTSBE439
|
|
00329 ++INCLUDE DTSIL923 DTSBE439
|
|
00330 EJECT DTSBE439
|
|
00331 01 ASKL-REC. DTSBE439
|
|
00332 ++INCLUDE DTSIASKL DTSBE439
|
|
00333 EJECT DTSBE439
|
|
00334 01 AHDR-REC. DTSBE439
|
|
00335 ++INCLUDE DTSIAHDR DTSBE439
|
|
00336 EJECT DTSBE439
|
|
00337 01 AADJ-REC. DTSBE439
|
|
00338 ++INCLUDE DTSIAADJ DTSBE439
|
|
00339 DTSBE439
|
|
00340 01 R439-REC. DTSBE439
|
|
00341 ++INCLUDE DTSIR439 DTSBE439
|
|
00342 EJECT DTSBE439
|
|
00343 DTSBE439
|
|
00344 01 L985-LINK-AREA. CL*18
|
|
00345 ++INCLUDE DTSIL985 CL*18
|
|
00346 01 LINK-REC. CL*18
|
|
00347 ++INCLUDE DTSIWBAT CL*18
|
|
00348 CL*18
|
|
00349 LINKAGE SECTION. CL*27
|
|
00350 01 LECM-LINK-AREA. DTSBE439
|
|
00351 ++INCLUDE DTSILECM DTSBE439
|
|
00352 DTSBE439
|
|
00353 10 FILLER REDEFINES LECM-EXTRACT-PARMS. DTSBE439
|
|
00354 15 LECM-PARM-DEFF-PAY-CNTR-IND PIC X(01). DTSBE439
|
|
00355 88 LECM-PARM-DEFF-PAY-CNTR-YES-88 VALUE 'Y'. DTSBE439
|
|
00356 88 LECM-PARM-DEFF-PAY-CNTR-NO-88 VALUE 'N'. DTSBE439
|
|
00357 15 FILLER PIC X(01). DTSBE439
|
|
00358 15 LECM-PARM-EMPL-WITH-LIEN-IND PIC X(01). DTSBE439
|
|
00359 88 LECM-PARM-EMPL-W-LIEN-YES-88 VALUE 'Y'. DTSBE439
|
|
00360 88 LECM-PARM-EMPL-W-LIEN-NO-88 VALUE 'N'. DTSBE439
|
|
00361 15 FILLER PIC X(01). DTSBE439
|
|
00362 15 LECM-PARM-SELF-INS-EMPL-IND PIC X(01). DTSBE439
|
|
00363 88 LECM-PARM-SELF-INS-EMPL-YES-88 VALUE 'Y'. DTSBE439
|
|
00364 88 LECM-PARM-SELF-INS-EMPL-NO-88 VALUE 'N'. DTSBE439
|
|
00365 15 FILLER PIC X(63). DTSBE439
|
|
00366 EJECT DTSBE439
|
|
00367 01 MPRF-LINK-REC. CL*28
|
|
00368 ++INCLUDE DTSIMPRF CL*28
|
|
00369 CL*28
|
|
00370 EJECT DTSBE439
|
|
00371 PROCEDURE DIVISION USING LECM-LINK-AREA CL*28
|
|
00372 MPRF-LINK-REC. CL*29
|
|
00373 EVALUATE TRUE DTSBE439
|
|
00374 DTSBE439
|
|
00375 WHEN LECM-PROCESS-88 DTSBE439
|
|
00376 SET WRK-EDIT-PASSED-88 TO TRUE DTSBE439
|
|
00377 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBE439
|
|
00378 DTSBE439
|
|
00379 WHEN LECM-INITIALIZE-88 DTSBE439
|
|
00380 PERFORM I0000-INITIALIZE THRU I0000-EXIT DTSBE439
|
|
00381 IF WRK-EDIT-FAILED-88 DTSBE439
|
|
00382 PERFORM S999-ABEND THRU S999-EXIT DTSBE439
|
|
00383 END-IF DTSBE439
|
|
00384 WHEN LECM-TERMINATE-88 DTSBE439
|
|
00385 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBE439
|
|
00386 DTSBE439
|
|
00387 WHEN OTHER DTSBE439
|
|
00388 MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED' DTSBE439
|
|
00389 TO ABEND-MSG DTSBE439
|
|
00390 PERFORM S999-ABEND THRU S999-EXIT. DTSBE439
|
|
00391 DTSBE439
|
|
00392 GOBACK. DTSBE439
|
|
00393 EJECT DTSBE439
|
|
00394 I0000-INITIALIZE. DTSBE439
|
|
00395 DTSBE439
|
|
00396 MOVE LENGTH OF R439-REC TO R439-LENGTH. DTSBE439
|
|
00397 MOVE '439' TO R439-REC-TYPE. DTSBE439
|
|
00398 MOVE LECM-TRACE-IND TO L910-TRACE-IND. DTSBE439
|
|
00399 MOVE WRK-MOD-NAME TO L910-MOD-NAME. DTSBE439
|
|
00400 DTSBE439
|
|
00401 MOVE ZERO TO WRK-QTR-BEGIN-DATE. DTSBE439
|
|
00402 PERFORM I1000-MHDR-QTR-BEGIN-DATE THRU I1000-EXIT. DTSBE439
|
|
00403 PERFORM I2000-EDIT-DEFAULT-PARM THRU I2000-EXIT. DTSBE439
|
|
00404 PERFORM I3000-OPEN-FILES THRU I3000-EXIT. DTSBE439
|
|
00405 DTSBE439
|
|
00406 PERFORM I4000-BATCH-HEADER THRU I4000-EXIT. CL*25
|
|
00407 DTSBE439
|
|
00408 SET LECM-MST-OPEN-UPDATE-88 TO TRUE. CL*54
|
|
00409 SET LECM-REF-OPEN-UPDATE-88 TO TRUE. CL*54
|
|
00410 DTSBE439
|
|
00411 I0000-EXIT. DTSBE439
|
|
00412 EXIT. DTSBE439
|
|
00413 DTSBE439
|
|
00414 I1000-MHDR-QTR-BEGIN-DATE. DTSBE439
|
|
00415 DTSBE439
|
|
00416 MOVE LOW-VALUES TO MHDR-KEY-AREA. DTSBE439
|
|
00417 MOVE +0 TO MHDR-EMP-NO. DTSBE439
|
|
00418 SET MHDR-HDR-88 TO TRUE. DTSBE439
|
|
00419 MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA. DTSBE439
|
|
00420 DTSBE439
|
|
00421 PERFORM S910-READ THRU S910-EXIT. DTSBE439
|
|
00422 IF L910-NO-REC-88 DTSBE439
|
|
00423 MOVE 'MHDR RECORD NOT FOUND' TO ABEND-MSG DTSBE439
|
|
00424 PERFORM S999-ABEND THRU S999-EXIT. DTSBE439
|
|
00425 DTSBE439
|
|
00426 MOVE MSKL-REC TO MHDR-REC. DTSBE439
|
|
00427 DTSBE439
|
|
00428 CL*18
|
|
00429 MOVE MHDR-CMPL-QTR-BEGIN-DATE TO L004-DATE. DTSBE439
|
|
00430 PERFORM S004-FROM-DATE THRU S004-EXIT. DTSBE439
|
|
00431 DISPLAY 'LAST COMPLETED QTR : ' L004-SLASH-5-QTR. DTSBE439
|
|
00432 DTSBE439
|
|
00433 SUBTRACT 3 FROM L004-QTR-5-YR. DTSBE439
|
|
00434 PERFORM S004-FROM-FIVE THRU S004-EXIT. DTSBE439
|
|
00435 MOVE L004-QTR-5-9 TO WRK-INACT-CUTOFF-YRQ. DTSBE439
|
|
00436 DISPLAY 'INACT CUTOFF QTR : ' L004-SLASH-5-QTR. DTSBE439
|
|
00437 MOVE 20124 TO WRK-INACT-CUTOFF-YRQ. CL*25
|
|
00438 DISPLAY 'WROFF CUTOFF QTR : ' WRK-INACT-CUTOFF-YRQ. CL*27
|
|
00439 DTSBE439
|
|
00440 I1000-EXIT. DTSBE439
|
|
00441 EXIT. DTSBE439
|
|
00442 DTSBE439
|
|
00443 CL*25
|
|
00444 I2000-EDIT-DEFAULT-PARM. DTSBE439
|
|
00445 DTSBE439
|
|
00446 IF LECM-PARM-DEFF-PAY-CNTR-IND = SPACE DTSBE439
|
|
00447 MOVE 'Y' TO WRK-PARM-DEFF-PAY-CNTR-IND DTSBE439
|
|
00448 ELSE DTSBE439
|
|
00449 IF LECM-PARM-DEFF-PAY-CNTR-IND = 'Y' OR 'N' DTSBE439
|
|
00450 MOVE LECM-PARM-DEFF-PAY-CNTR-IND TO DTSBE439
|
|
00451 WRK-PARM-DEFF-PAY-CNTR-IND DTSBE439
|
|
00452 ELSE DTSBE439
|
|
00453 MOVE 'PARM-DEFF-PAY-CNTR-IND NOT = Y OR N ' TO DTSBE439
|
|
00454 ABEND-MSG DTSBE439
|
|
00455 PERFORM S999-ABEND THRU S999-EXIT DTSBE439
|
|
00456 END-IF DTSBE439
|
|
00457 END-IF. DTSBE439
|
|
00458 DTSBE439
|
|
00459 IF LECM-PARM-EMPL-WITH-LIEN-IND = SPACE DTSBE439
|
|
00460 MOVE 'Y' TO WRK-PARM-EMPL-WITH-LIEN-IND DTSBE439
|
|
00461 ELSE DTSBE439
|
|
00462 IF LECM-PARM-EMPL-WITH-LIEN-IND = 'Y' OR 'N' DTSBE439
|
|
00463 MOVE LECM-PARM-EMPL-WITH-LIEN-IND TO DTSBE439
|
|
00464 WRK-PARM-EMPL-WITH-LIEN-IND DTSBE439
|
|
00465 ELSE DTSBE439
|
|
00466 MOVE 'PARM-EMPL-WITH-LIEN-IND NOT = Y OR N ' TO DTSBE439
|
|
00467 ABEND-MSG DTSBE439
|
|
00468 PERFORM S999-ABEND THRU S999-EXIT DTSBE439
|
|
00469 END-IF DTSBE439
|
|
00470 END-IF. DTSBE439
|
|
00471 DTSBE439
|
|
00472 IF LECM-PARM-SELF-INS-EMPL-IND = SPACE DTSBE439
|
|
00473 MOVE 'Y' TO WRK-PARM-SELF-INS-EMPL-IND DTSBE439
|
|
00474 ELSE DTSBE439
|
|
00475 IF LECM-PARM-SELF-INS-EMPL-IND = 'Y' OR 'N' DTSBE439
|
|
00476 MOVE LECM-PARM-SELF-INS-EMPL-IND TO DTSBE439
|
|
00477 WRK-PARM-SELF-INS-EMPL-IND DTSBE439
|
|
00478 ELSE DTSBE439
|
|
00479 MOVE 'PARM-SELF-INS-EMPL-IND NOT = Y OR N ' TO DTSBE439
|
|
00480 ABEND-MSG DTSBE439
|
|
00481 PERFORM S999-ABEND THRU S999-EXIT DTSBE439
|
|
00482 END-IF DTSBE439
|
|
00483 END-IF. DTSBE439
|
|
00484 DTSBE439
|
|
00485 DISPLAY 'EDIT PARM OR DEFAULT IS : ' WRK-PARM-INDICATORS. DTSBE439
|
|
00486 DTSBE439
|
|
00487 I2000-EXIT. DTSBE439
|
|
00488 EXIT. DTSBE439
|
|
00489 DTSBE439
|
|
00490 I3000-OPEN-FILES. DTSBE439
|
|
00491 OPEN OUTPUT DEBIT-WRITEOFFS. DTSBE439
|
|
00492 IF NOT DEBIT-STATUS-OK-88 DTSBE439
|
|
00493 DISPLAY 'DEBIT FILE OPEN ERROR: ' DEBIT-STATUS DTSBE439
|
|
00494 MOVE 'DEBIT FILE OPEN ERROR' DTSBE439
|
|
00495 TO ABEND-MSG DTSBE439
|
|
00496 PERFORM S999-ABEND THRU S999-EXIT DTSBE439
|
|
00497 END-IF. DTSBE439
|
|
00498 DTSBE439
|
|
00499 OPEN OUTPUT CREDIT-WRITEOFFS. DTSBE439
|
|
00500 IF NOT CREDIT-STATUS-OK-88 DTSBE439
|
|
00501 DISPLAY 'CREDIT FILE OPEN ERROR: ' CREDIT-STATUS DTSBE439
|
|
00502 MOVE 'CREDIT FILE OPEN ERROR' DTSBE439
|
|
00503 TO ABEND-MSG DTSBE439
|
|
00504 PERFORM S999-ABEND THRU S999-EXIT DTSBE439
|
|
00505 END-IF. DTSBE439
|
|
00506 DTSBE439
|
|
00507 * PERFORM S910-OPEN-UPDATE-NO-AIX THRU S910-EXIT. CL*51
|
|
00508 SET LECM-MST-OPEN-UPDATE-88 TO TRUE. CL*51
|
|
00509 PERFORM S923-OPEN-UPDATE THRU S923-EXIT. CL*27
|
|
00510 ** PERFORM S923-OPEN THRU S923-EXIT. CL*16
|
|
00511 DTSBE439
|
|
00512 CL*19
|
|
00513 I3000-EXIT. DTSBE439
|
|
00514 EXIT. DTSBE439
|
|
00515 I4000-BATCH-HEADER. CL*25
|
|
00516 MOVE LOW-VALUES TO MHDR-KEY-AREA. CL*25
|
|
00517 MOVE +0 TO MHDR-EMP-NO. CL*25
|
|
00518 MOVE +0 TO WRK-AHDR-ITEM-NO. CL*25
|
|
00519 SET MHDR-HDR-88 TO TRUE. CL*25
|
|
00520 MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA. CL*25
|
|
00521 PERFORM S910-READ THRU S910-EXIT. CL*25
|
|
00522 CL*25
|
|
00523 IF L910-NO-REC-88 CL*25
|
|
00524 MOVE 'MHDR RECORD NOT FOUND (I0000)' CL*25
|
|
00525 TO ABEND-MSG CL*25
|
|
00526 PERFORM S999-ABEND THRU S999-EXIT. CL*25
|
|
00527 CL*25
|
|
00528 MOVE MSKL-REC TO MHDR-REC. CL*25
|
|
00529 PERFORM S985-OPEN THRU S985-EXIT. CL*25
|
|
00530 CL*25
|
|
00531 PERFORM S1000-INITIATE-AHDR THRU S1000-EXIT. CL*25
|
|
00532 MOVE AHDR-BATCH-NO TO HOLD-FIRST-BATCH-NO. CL*35
|
|
00533 DISPLAY 'FIRST BATCH: ' HOLD-FIRST-BATCH-NO. CL*35
|
|
00534 CL*25
|
|
00535 DTSBE439
|
|
00536 I4000-EXIT. CL*25
|
|
00537 EXIT. CL*25
|
|
00538 CL*25
|
|
00539 P0000-PROCESS. DTSBE439
|
|
00540 CL*27
|
|
00541 ADD +1 TO WRK-EMPL-READ-CNT. DTSBE439
|
|
00542 DTSBE439
|
|
00543 IF MPRF-STATUS-INACT-88 DTSBE439
|
|
00544 ADD +1 TO WRK-EMPL-INACT-CNT DTSBE439
|
|
00545 ELSE DTSBE439
|
|
00546 GO TO P0000-EXIT. CL*28
|
|
00547 CL*21
|
|
00548 IF MPRF-CLASS-RATED-88 CL*21
|
|
00549 ADD +1 TO WRK-EMPL-INACT-CNT CL*21
|
|
00550 ELSE CL*21
|
|
00551 GO TO P0000-EXIT. CL*28
|
|
00552 CL*27
|
|
00553 IF MPRF-WRITE-OFF-DATE > +0 CL*27
|
|
00554 GO TO P0000-EXIT. CL*28
|
|
00555 DTSBE439
|
|
00556 IF MPRF-TOT-BALANCE-AMT > +0 CL*21
|
|
00557 * OR MPRF-TOT-CREDIT-AMT > 0 CL*21
|
|
00558 * IF MPRF-TOT-CREDIT-AMT > 0 CL*21
|
|
00559 NEXT SENTENCE DTSBE439
|
|
00560 ELSE DTSBE439
|
|
00561 GO TO P0000-EXIT. CL*28
|
|
00562 DTSBE439
|
|
00563 IF MPRF-NOT-WRITTEN-OFF-88 DTSBE439
|
|
00564 NEXT SENTENCE DTSBE439
|
|
00565 ELSE DTSBE439
|
|
00566 GO TO P0000-EXIT. CL*28
|
|
00567 DTSBE439
|
|
00568 IF MPRF-BANKRP-NOT-OPEN-88 DTSBE439
|
|
00569 NEXT SENTENCE DTSBE439
|
|
00570 ELSE DTSBE439
|
|
00571 GO TO P0000-EXIT. CL*28
|
|
00572 DTSBE439
|
|
00573 * IF MPRF-CLASS-SELF-INS-88 CL*21
|
|
00574 * IF WRK-PARM-SELF-INS-EMPL-NO-88 CL*21
|
|
00575 * GO TO P0000-EXIT. CL*21
|
|
00576 DTSBE439
|
|
00577 IF MPRF-MLIN-EXISTS-88 CL*21
|
|
00578 PERFORM P7000-SCAN-LIN THRU P7000-EXIT CL*21
|
|
00579 IF R439-MLIN-IND = 'Y' CL*21
|
|
00580 GO TO P0000-EXIT. CL*28
|
|
00581 CL*21
|
|
00582 IF MPRF-MDPC-EXISTS-88 CL*21
|
|
00583 PERFORM P7200-SCAN-DPC THRU P7200-EXIT CL*21
|
|
00584 IF R439-MDPC-IND = 'Y' CL*21
|
|
00585 GO TO P0000-EXIT. CL*28
|
|
00586 CL*21
|
|
00587 DTSBE439
|
|
00588 MOVE +0 TO WRK-LAST-LIAB-YRQ. DTSBE439
|
|
00589 DTSBE439
|
|
00590 MOVE LOW-VALUES TO MSOL-KEY-AREA. DTSBE439
|
|
00591 MOVE MPRF-EMP-NO TO MSOL-EMP-NO. DTSBE439
|
|
00592 SET MSOL-SOL-88 TO TRUE. DTSBE439
|
|
00593 MOVE MSOL-KEY-AREA TO MSKL-KEY-AREA. DTSBE439
|
|
00594 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE439
|
|
00595 PERFORM P1000-SCAN-MSOL THRU P1000-EXIT DTSBE439
|
|
00596 UNTIL L910-NO-REC-88. DTSBE439
|
|
00597 DTSBE439
|
|
00598 IF WRK-LAST-LIAB-YRQ = ZERO DTSBE439
|
|
00599 GO TO P0000-EXIT CL*28
|
|
00600 ELSE DTSBE439
|
|
00601 * IF WRK-LAST-LIAB-YRQ <= WRK-INACT-CUTOFF-YRQ CL*45
|
|
00602 IF WRK-LAST-LIAB-YRQ > WRK-INACT-CUTOFF-YRQ CL*45
|
|
00603 GO TO P0000-EXIT CL*28
|
|
00604 END-IF DTSBE439
|
|
00605 END-IF. DTSBE439
|
|
00606 DTSBE439
|
|
00607 MOVE MPRF-EMP-NO TO R439-EMP-NO. DTSBE439
|
|
00608 DTSBE439
|
|
00609 MOVE WRK-INACT-CUTOFF-YRQ TO R439-CUTOFF-YRQ. DTSBE439
|
|
00610 DTSBE439
|
|
00611 MOVE MPRF-PRIMARY-NAME TO R439-PRIMARY-NAME. DTSBE439
|
|
00612 DTSBE439
|
|
00613 PERFORM S061-DETERMINE-FLD-REP THRU S061-EXIT. DTSBE439
|
|
00614 MOVE L061-FLD-REP-ID TO R439-FLD-REP-ID. DTSBE439
|
|
00615 DTSBE439
|
|
00616 MOVE MPRF-TOT-BALANCE-AMT TO R439-TOT-BALANCE-AMT CL*21
|
|
00617 MOVE MPRF-TOT-BALANCE-AMT TO WRK-EVL-BAL9. CL*44
|
|
00618 MOVE WRK-EVL-BAL TO EVL-BAL. CL*44
|
|
00619 MOVE MPRF-PURSUED-RPT-CNT TO R439-PURSUED-RPT-CNT. DTSBE439
|
|
00620 DTSBE439
|
|
00621 PERFORM P2000-SUCCESSOR THRU P2000-EXIT. DTSBE439
|
|
00622 DTSBE439
|
|
00623 IF WRK-SUCCESSOR = ZERO DTSBE439
|
|
00624 PERFORM P2900-BAL-BY-QTR THRU P2900-EXIT CL*22
|
|
00625 ADD +1 TO WRK-EMPL-WRITE-CNT DTSBE439
|
|
00626 PERFORM P3000-WRITE-AADJ THRU P3000-EXIT CL*12
|
|
00627 PERFORM P4000-DOWNLOAD THRU P4000-EXIT DTSBE439
|
|
00628 PERFORM S946-WRITE-R439 THRU S946-EXIT CL*25
|
|
00629 PERFORM P7500-WRITE-MEVL THRU P7500-EXIT CL*40
|
|
00630 ELSE CL*21
|
|
00631 DISPLAY 'SUCC EMP ' WRK-SUCCESSOR CL*21
|
|
00632 END-IF. CL*21
|
|
00633 DTSBE439
|
|
00634 P0000-EXIT. CL*28
|
|
00635 EXIT. DTSBE439
|
|
00636 DTSBE439
|
|
00637 P1000-SCAN-MSOL. DTSBE439
|
|
00638 MOVE MSKL-REC TO MSOL-REC. DTSBE439
|
|
00639 DTSBE439
|
|
00640 IF NOT MSOL-INACT-WITHDRAWN-88 DTSBE439
|
|
00641 IF MSOL-INACT-INACTIVE-88 DTSBE439
|
|
00642 IF MSOL-LAST-LIAB-YRQ > WRK-LAST-LIAB-YRQ DTSBE439
|
|
00643 MOVE MSOL-LAST-LIAB-YRQ TO WRK-LAST-LIAB-YRQ DTSBE439
|
|
00644 END-IF DTSBE439
|
|
00645 END-IF DTSBE439
|
|
00646 END-IF. DTSBE439
|
|
00647 DTSBE439
|
|
00648 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBE439
|
|
00649 P1000-EXIT. DTSBE439
|
|
00650 EXIT. DTSBE439
|
|
00651 DTSBE439
|
|
00652 P2000-SUCCESSOR. DTSBE439
|
|
00653 MOVE ZERO TO WRK-SUCCESSOR. DTSBE439
|
|
00654 MOVE MPRF-EMP-NO TO L600-EMP-NO. DTSBE439
|
|
00655 MOVE WRK-EXP-TRN-EFF-DATE TO L600-EXP-TRN-EFF-DATE. DTSBE439
|
|
00656 PERFORM S0600-CALL-BU600 THRU S0600-EXIT. DTSBE439
|
|
00657 IF L600-SUCCESSOR-FOUND-88 DTSBE439
|
|
00658 MOVE L600-ULTIMATE-SUCCESSOR TO WRK-SUCCESSOR. DTSBE439
|
|
00659 DTSBE439
|
|
00660 P2000-EXIT. DTSBE439
|
|
00661 EXIT. DTSBE439
|
|
00662 DTSBE439
|
|
00663 P3000-WRITE-AADJ. DTSBE439
|
|
00664 MOVE LOW-VALUES TO AADJ-REC. DTSBE439
|
|
00665 DTSBE439
|
|
00666 IF AHDR-ATC-FILE-TRAN-CNT < +495 CL*55
|
|
00667 NEXT SENTENCE DTSBE439
|
|
00668 ELSE DTSBE439
|
|
00669 PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT DTSBE439
|
|
00670 PERFORM S1000-INITIATE-AHDR THRU S1000-EXIT DTSBE439
|
|
00671 END-IF. DTSBE439
|
|
00672 DTSBE439
|
|
00673 MOVE AHDR-BATCH-NO TO AADJ-BATCH-NO. DTSBE439
|
|
00674 ADD +1 TO AHDR-ATC-FILE-TRAN-CNT CL*26
|
|
00675 WRK-AHDR-ITEM-NO. CL*26
|
|
00676 MOVE WRK-AHDR-ITEM-NO TO AADJ-ITEM-NO. CL*26
|
|
00677 SET AADJ-ADJ-88 TO TRUE. DTSBE439
|
|
00678 DTSBE439
|
|
00679 DISPLAY 'STA BTCH-ITM: ' AADJ-BATCH-NO ' ' WRK-AHDR-ITEM-NO. CL*33
|
|
00680 MOVE MPRF-PRIMARY-NAME TO AADJ-NAME-CHECK. DTSBE439
|
|
00681 MOVE MPRF-EMP-NO TO AADJ-EMP-NO. DTSBE439
|
|
00682 DTSBE439
|
|
00683 SET AADJ-WRITE-OFF-88 TO TRUE. DTSBE439
|
|
00684 MOVE MPRF-TOT-BALANCE-AMT TO AADJ-AMT. CL*21
|
|
00685 MOVE LECM-CURR-RUN-DATE TO AADJ-RECEIVED-DATE DTSBE439
|
|
00686 AADJ-DEPOSIT-DATE. DTSBE439
|
|
00687 MOVE ZERO TO AADJ-APPLIC-YRQ. DTSBE439
|
|
00688 MOVE SPACES TO AADJ-APPLIC-IND. DTSBE439
|
|
00689 MOVE ZERO TO AADJ-APPLIC-BATCH-NO DTSBE439
|
|
00690 AADJ-APPLIC-ITEM-NO. DTSBE439
|
|
00691 MOVE LECM-CURR-RUN-DATE TO AADJ-DATE-1. DTSBE439
|
|
00692 MOVE ZERO TO AADJ-DATE-2. DTSBE439
|
|
00693 MOVE SPACE TO AADJ-INT-SPAN-IND. DTSBE439
|
|
00694 MOVE -9.9999 TO AADJ-INT-RATE. CL*31
|
|
00695 MOVE 'Y' TO AADJ-DISREGARD-EDITS-IND. CL*31
|
|
00696 MOVE 'SYS' TO AADJ-RESPONSIBLE-ACTIVITY. DTSBE439
|
|
00697 MOVE 'SYSTEM' TO AADJ-RESPONSIBLE-OP-ID. DTSBE439
|
|
00698 MOVE ZERO TO AADJ-CMP-ESTB-ABSTIME. DTSBE439
|
|
00699 SET AADJ-NOT-PROCESSED-88 TO TRUE. DTSBE439
|
|
00700 DTSBE439
|
|
00701 MOVE AADJ-REC TO ASKL-REC. DTSBE439
|
|
00702 DTSBE439
|
|
00703 PERFORM S923-WRITE THRU S923-EXIT. DTSBE439
|
|
00704 IF NOT L923-OK-88 CL*47
|
|
00705 MOVE 'AADJ RECORD NOT ADDED (P3000)' CL*47
|
|
00706 TO ABEND-MSG CL*47
|
|
00707 PERFORM S999-ABEND THRU S999-EXIT. CL*47
|
|
00708 DTSBE439
|
|
00709 P3000-EXIT. DTSBE439
|
|
00710 EXIT. DTSBE439
|
|
00711 P2900-BAL-BY-QTR. CL*22
|
|
00712 MOVE +0 TO TOT-UI-BAL CL*22
|
|
00713 TOT-SU-BAL CL*22
|
|
00714 TOT-INT-BAL CL*22
|
|
00715 TOT-PEN-BAL CL*22
|
|
00716 TOT-UI-BAL-ESTIM CL*22
|
|
00717 TOT-SU-BAL-ESTIM CL*22
|
|
00718 TOT-INT-BAL-ESTIM CL*22
|
|
00719 TOT-PEN-BAL-ESTIM CL*22
|
|
00720 L101-PAID-CHNG. CL*22
|
|
00721 CL*22
|
|
00722 MOVE LOW-VALUES TO MQTR-KEY-AREA. CL*22
|
|
00723 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. CL*22
|
|
00724 SET MQTR-QTR-88 TO TRUE. CL*22
|
|
00725 MOVE +0 TO MQTR-YRQ. CL*22
|
|
00726 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. CL*22
|
|
00727 PERFORM S910-START-BROWSE THRU S910-EXIT. CL*22
|
|
00728 PERFORM UNTIL L910-NO-REC-88 CL*22
|
|
00729 MOVE MSKL-REC TO MQTR-REC CL*22
|
|
00730 PERFORM P3100-GET-BALANCES THRU P3100-EXIT CL*22
|
|
00731 PERFORM P3200-CALC-TOTALS THRU P3200-EXIT CL*22
|
|
00732 PERFORM S910-READ-NEXT THRU S910-EXIT CL*22
|
|
00733 END-PERFORM. CL*22
|
|
00734 CL*22
|
|
00735 COMPUTE WRK-EMP-BAL = CL*22
|
|
00736 (TOT-UI-BAL + CL*22
|
|
00737 TOT-SU-BAL + CL*22
|
|
00738 TOT-PEN-BAL + CL*22
|
|
00739 TOT-INT-BAL). CL*22
|
|
00740 CL*22
|
|
00741 ADD WRK-EMP-BAL TO GWRK-EMP-BAL CL*22
|
|
00742 ADD TOT-UI-BAL TO GTOT-UI-BAL CL*22
|
|
00743 ADD TOT-SU-BAL TO GTOT-SU-BAL CL*22
|
|
00744 ADD TOT-PEN-BAL TO GTOT-PEN-BAL CL*22
|
|
00745 ADD TOT-INT-BAL TO GTOT-INT-BAL. CL*22
|
|
00746 CL*22
|
|
00747 P2900-EXIT. CL*22
|
|
00748 EXIT. CL*22
|
|
00749 P3100-GET-BALANCES. CL*22
|
|
00750 MOVE +0 TO WRK-UI-BAL CL*22
|
|
00751 WRK-SU-BAL CL*22
|
|
00752 WRK-INT-BAL CL*22
|
|
00753 WRK-PEN-BAL CL*22
|
|
00754 L101-PAID-CHNG. CL*22
|
|
00755 CL*22
|
|
00756 PERFORM CL*22
|
|
00757 VARYING MQTR-ACCT-IDX FROM +1 BY +1 CL*22
|
|
00758 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT CL*22
|
|
00759 EVALUATE TRUE CL*22
|
|
00760 WHEN MQTR-ACCT-UI-88 (MQTR-ACCT-IDX) CL*22
|
|
00761 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) CL*22
|
|
00762 TO WRK-UI-BAL CL*22
|
|
00763 L101-PAID-CHNG CL*22
|
|
00764 CL*22
|
|
00765 WHEN MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) CL*22
|
|
00766 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) CL*22
|
|
00767 TO WRK-SU-BAL CL*22
|
|
00768 CL*22
|
|
00769 WHEN MQTR-ACCT-INT-88 (MQTR-ACCT-IDX) CL*22
|
|
00770 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) CL*22
|
|
00771 TO WRK-INT-BAL CL*22
|
|
00772 CL*22
|
|
00773 WHEN MQTR-ACCT-LATE-PEN-88 (MQTR-ACCT-IDX) CL*22
|
|
00774 OR MQTR-ACCT-NSF-PEN-88 (MQTR-ACCT-IDX) CL*22
|
|
00775 OR MQTR-ACCT-MISC-PEN-88 (MQTR-ACCT-IDX) CL*22
|
|
00776 ADD MQTR-BALANCE-AMT (MQTR-ACCT-IDX) CL*22
|
|
00777 TO WRK-PEN-BAL CL*22
|
|
00778 CL*22
|
|
00779 END-EVALUATE CL*22
|
|
00780 END-PERFORM. CL*24
|
|
00781 CL*22
|
|
00782 P3100-EXIT. CL*24
|
|
00783 EXIT. CL*24
|
|
00784 CL*24
|
|
00785 P3200-CALC-TOTALS. CL*24
|
|
00786 * IF MQTR-CURR-ESTIM-88 CL*22
|
|
00787 * ADD WRK-UI-BAL TO TOT-UI-BAL-ESTIM CL*22
|
|
00788 * ADD WRK-SU-BAL TO TOT-SU-BAL-ESTIM CL*22
|
|
00789 * ADD WRK-INT-BAL TO TOT-INT-BAL-ESTIM CL*22
|
|
00790 * ADD WRK-PEN-BAL TO TOT-PEN-BAL-ESTIM CL*22
|
|
00791 * ELSE CL*22
|
|
00792 ADD WRK-UI-BAL TO TOT-UI-BAL CL*22
|
|
00793 ADD WRK-SU-BAL TO TOT-SU-BAL CL*22
|
|
00794 ADD WRK-INT-BAL TO TOT-INT-BAL CL*22
|
|
00795 ADD WRK-PEN-BAL TO TOT-PEN-BAL. CL*22
|
|
00796 * END-IF. CL*22
|
|
00797 CL*22
|
|
00798 P3200-EXIT. CL*22
|
|
00799 EXIT. CL*22
|
|
00800 P3310-PROJECT-PEN-INT. CL*22
|
|
00801 MOVE LECM-CURR-RUN-DATE TO L101-RECEIVED-DATE. CL*22
|
|
00802 CL*22
|
|
00803 SET L101-WAIVE-INT-NO-88 TO TRUE. CL*22
|
|
00804 CL*22
|
|
00805 MOVE MQTR-TAX-DUE-DATE TO L101-TAX-DUE-DATE. CL*22
|
|
00806 CL*22
|
|
00807 MOVE MQTR-INT-AREA TO L101-INT-AREA. CL*22
|
|
00808 CL*22
|
|
00809 PERFORM S101-PER-MONTH-NO THRU S101-EXIT. CL*22
|
|
00810 CL*22
|
|
00811 ADD L101-INT-CHARGE-CHNG TO WRK-INT-BAL. CL*22
|
|
00812 CL*22
|
|
00813 P3310-EXIT. CL*22
|
|
00814 EXIT. CL*22
|
|
00815 CL*22
|
|
00816 P4000-DOWNLOAD. DTSBE439
|
|
00817 PERFORM P4100-LAST-ACTIVITY THRU P4100-EXIT. DTSBE439
|
|
00818 PERFORM P4200-BUILD-REC THRU P4200-EXIT. DTSBE439
|
|
00819 DTSBE439
|
|
00820 P4000-EXIT. DTSBE439
|
|
00821 EXIT. DTSBE439
|
|
00822 DTSBE439
|
|
00823 P4100-LAST-ACTIVITY. DTSBE439
|
|
00824 MOVE ZERO TO WRK-LAST-ACTIVITY-DT. DTSBE439
|
|
00825 MOVE LOW-VALUES TO MLOG-REC. DTSBE439
|
|
00826 MOVE MPRF-EMP-NO TO MLOG-EMP-NO. DTSBE439
|
|
00827 SET MLOG-LOG-88 TO TRUE. DTSBE439
|
|
00828 MOVE MLOG-KEY-AREA TO MSKL-KEY-AREA. DTSBE439
|
|
00829 PERFORM S910-COUNT THRU S910-EXIT. DTSBE439
|
|
00830 IF L910-OK-88 DTSBE439
|
|
00831 IF L910-RECORD-CNT > ZERO DTSBE439
|
|
00832 PERFORM S910-READ THRU S910-EXIT DTSBE439
|
|
00833 MOVE MSKL-REC TO MLOG-REC DTSBE439
|
|
00834 IF MLOG-ESTB-DATE > WRK-LAST-ACTIVITY-DT DTSBE439
|
|
00835 MOVE MLOG-ESTB-DATE TO WRK-LAST-ACTIVITY-DT DTSBE439
|
|
00836 END-IF DTSBE439
|
|
00837 END-IF DTSBE439
|
|
00838 END-IF. DTSBE439
|
|
00839 DTSBE439
|
|
00840 MOVE LOW-VALUES TO MJRN-REC. DTSBE439
|
|
00841 MOVE MPRF-EMP-NO TO MJRN-EMP-NO. DTSBE439
|
|
00842 SET MJRN-JRN-88 TO TRUE. DTSBE439
|
|
00843 MOVE MJRN-KEY-AREA TO MSKL-KEY-AREA. DTSBE439
|
|
00844 PERFORM S910-COUNT THRU S910-EXIT. DTSBE439
|
|
00845 IF L910-OK-88 DTSBE439
|
|
00846 IF L910-RECORD-CNT > ZERO DTSBE439
|
|
00847 PERFORM S910-READ THRU S910-EXIT DTSBE439
|
|
00848 MOVE MSKL-REC TO MJRN-REC DTSBE439
|
|
00849 IF MJRN-ESTB-DATE > WRK-LAST-ACTIVITY-DT DTSBE439
|
|
00850 MOVE MJRN-ESTB-DATE TO WRK-LAST-ACTIVITY-DT DTSBE439
|
|
00851 END-IF DTSBE439
|
|
00852 END-IF DTSBE439
|
|
00853 END-IF. DTSBE439
|
|
00854 DTSBE439
|
|
00855 MOVE LOW-VALUES TO MRPT-REC. DTSBE439
|
|
00856 MOVE MPRF-EMP-NO TO MRPT-EMP-NO. DTSBE439
|
|
00857 SET MRPT-RPT-88 TO TRUE. DTSBE439
|
|
00858 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA. DTSBE439
|
|
00859 PERFORM S910-COUNT THRU S910-EXIT. DTSBE439
|
|
00860 IF L910-OK-88 DTSBE439
|
|
00861 IF L910-RECORD-CNT > ZERO DTSBE439
|
|
00862 PERFORM S910-READ THRU S910-EXIT DTSBE439
|
|
00863 MOVE MSKL-REC TO MRPT-REC DTSBE439
|
|
00864 IF MRPT-ESTB-DATE > WRK-LAST-ACTIVITY-DT DTSBE439
|
|
00865 MOVE MRPT-ESTB-DATE TO WRK-LAST-ACTIVITY-DT DTSBE439
|
|
00866 END-IF DTSBE439
|
|
00867 END-IF DTSBE439
|
|
00868 END-IF. DTSBE439
|
|
00869 DTSBE439
|
|
00870 P4100-EXIT. DTSBE439
|
|
00871 EXIT. DTSBE439
|
|
00872 DTSBE439
|
|
00873 P4200-BUILD-REC. DTSBE439
|
|
00874 MOVE R439-EMP-NO TO DWN-EMP-NO. DTSBE439
|
|
00875 MOVE R439-PRIMARY-NAME TO DWN-EMP-NAME. DTSBE439
|
|
00876 INSPECT DWN-EMP-NAME REPLACING ALL ',' BY SPACE. DTSBE439
|
|
00877 MOVE R439-FLD-REP-ID TO DWN-FIELD-CODE. DTSBE439
|
|
00878 MOVE R439-PURSUED-RPT-CNT TO DWN-MISSING-RPTS. DTSBE439
|
|
00879 MOVE MPRF-MDPC-IND TO DWN-DPC. DTSBE439
|
|
00880 MOVE MPRF-MLIN-IND TO DWN-LIEN. DTSBE439
|
|
00881 MOVE WRK-EMP-BAL TO DWN-TOT-BAL CL*36
|
|
00882 R439-TOT-MJRN-AMT CL*36
|
|
00883 MOVE MPRF-TOT-BALANCE-AMT TO R439-TOT-BALANCE-AMT CL*36
|
|
00884 DWN-TOT-BAL-MPRF. CL*36
|
|
00885 CL*36
|
|
00886 MOVE TOT-UI-BAL TO DWN-UI-BAL. CL*36
|
|
00887 MOVE TOT-SU-BAL TO DWN-SU-BAL. CL*36
|
|
00888 MOVE TOT-PEN-BAL TO DWN-PEN-BAL. CL*36
|
|
00889 MOVE TOT-INT-BAL TO DWN-INT-BAL. CL*36
|
|
00890 MOVE WRK-LAST-LIAB-YRQ TO L004-QTR-5-9. DTSBE439
|
|
00891 PERFORM S004-FROM-FIVE THRU S004-EXIT. DTSBE439
|
|
00892 MOVE L004-SLASH-5-QTR TO DWN-LAST-LIAB-YRQ. DTSBE439
|
|
00893 DTSBE439
|
|
00894 MOVE WRK-LAST-ACTIVITY-DT TO L001-FED-8-DATE-9. DTSBE439
|
|
00895 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBE439
|
|
00896 MOVE L001-SLASH-8-DATE TO DWN-LAST-ACT-DATE. DTSBE439
|
|
00897 SET R439-DEBIT-RPT-88 TO TRUE CL*36
|
|
00898 WRITE DEBIT-REC FROM WRK-DOWNLOAD-REC. CL*21
|
|
00899 DTSBE439
|
|
00900 P4200-EXIT. DTSBE439
|
|
00901 EXIT. DTSBE439
|
|
00902 P7000-SCAN-LIN. CL*21
|
|
00903 MOVE LOW-VALUES TO MLIN-KEY-AREA. CL*21
|
|
00904 MOVE MPRF-EMP-NO TO MLIN-EMP-NO. CL*21
|
|
00905 SET MLIN-LIN-88 TO TRUE. CL*21
|
|
00906 MOVE +0 TO MLIN-ESTB-ABSTIME. CL*21
|
|
00907 MOVE MLIN-KEY-AREA TO MSKL-KEY-AREA. CL*21
|
|
00908 CL*21
|
|
00909 PERFORM S910-START-BROWSE THRU S910-EXIT. CL*21
|
|
00910 PERFORM P7100-SCAN-MLIN THRU P7100-EXIT CL*21
|
|
00911 UNTIL L910-NO-REC-88. CL*21
|
|
00912 CL*21
|
|
00913 P7000-EXIT. CL*21
|
|
00914 EXIT. CL*21
|
|
00915 P7100-SCAN-MLIN. CL*21
|
|
00916 MOVE MSKL-REC TO MLIN-REC. CL*21
|
|
00917 IF MLIN-STATUS-ACTIVE-88 CL*21
|
|
00918 MOVE 'Y' TO R439-MLIN-IND. CL*21
|
|
00919 CL*21
|
|
00920 MOVE MLIN-REC TO MSKL-REC. CL*21
|
|
00921 PERFORM S910-READ-NEXT THRU S910-EXIT. CL*21
|
|
00922 CL*21
|
|
00923 P7100-EXIT. CL*21
|
|
00924 EXIT. CL*21
|
|
00925 CL*21
|
|
00926 P7200-SCAN-DPC. CL*21
|
|
00927 MOVE LOW-VALUES TO MDPC-KEY-AREA. CL*21
|
|
00928 MOVE MPRF-EMP-NO TO MDPC-EMP-NO. CL*21
|
|
00929 SET MDPC-DPC-88 TO TRUE. CL*21
|
|
00930 MOVE MDPC-KEY-AREA TO MSKL-KEY-AREA. CL*21
|
|
00931 PERFORM S910-START-BROWSE THRU S910-EXIT. CL*21
|
|
00932 PERFORM P7300-SCAN-MDPC THRU P7300-EXIT CL*21
|
|
00933 UNTIL L910-NO-REC-88. CL*21
|
|
00934 CL*21
|
|
00935 P7200-EXIT. CL*21
|
|
00936 EXIT. CL*21
|
|
00937 CL*21
|
|
00938 P7300-SCAN-MDPC. CL*21
|
|
00939 MOVE MSKL-REC TO MDPC-REC. CL*21
|
|
00940 IF MDPC-STATUS-ACTIVE-88 CL*21
|
|
00941 MOVE 'Y' TO R439-MDPC-IND. CL*21
|
|
00942 CL*21
|
|
00943 MOVE MDPC-REC TO MSKL-REC. CL*21
|
|
00944 PERFORM S910-READ-NEXT THRU S910-EXIT. CL*21
|
|
00945 CL*21
|
|
00946 P7300-EXIT. EXIT. CL*40
|
|
00947 CL*21
|
|
00948 P7500-WRITE-MEVL. CL*40
|
|
00949 ADD +5000 TO LECM-EMP-ABSTIME. CL*53
|
|
00950 CL*40
|
|
00951 MOVE LECM-EMP-ABSTIME TO L005-ABSTIME. CL*40
|
|
00952 CL*40
|
|
00953 PERFORM S005-FROM-ABSTIME THRU S005-EXIT. CL*40
|
|
00954 CL*40
|
|
00955 MOVE LOW-VALUES TO MEVL-REC. CL*40
|
|
00956 MOVE LOW-VALUES TO MSKL-REC. CL*53
|
|
00957 CL*40
|
|
00958 MOVE MPRF-EMP-NO TO MEVL-EMP-NO. CL*40
|
|
00959 CL*40
|
|
00960 SET MEVL-EVL-88 TO TRUE. CL*40
|
|
00961 CL*40
|
|
00962 MOVE L005-DATE TO MEVL-DATE. CL*40
|
|
00963 CL*40
|
|
00964 MOVE L005-TIME TO MEVL-TIME. CL*40
|
|
00965 MOVE ZERO TO MEVL-PURGE-DATE. CL*40
|
|
00966 CL*40
|
|
00967 MOVE EVL-TEXT TO MEVL-TEXT. CL*40
|
|
00968 CL*40
|
|
00969 SET MEVL-SOURCE-SYSTEM-88 TO TRUE. CL*40
|
|
00970 CL*40
|
|
00971 SET MEVL-NOT-CONVERTED-88 TO TRUE. CL*40
|
|
00972 CL*40
|
|
00973 MOVE LECM-CURR-RUN-DATE TO MEVL-ESTB-DATE CL*40
|
|
00974 MEVL-CHNG-DATE. CL*40
|
|
00975 CL*40
|
|
00976 CL*40
|
|
00977 MOVE MEVL-REC TO MSKL-REC. CL*40
|
|
00978 CL*40
|
|
00979 PERFORM S910-WRITE THRU S910-EXIT. CL*40
|
|
00980 * IF NOT L910-OK-88 CL*52
|
|
00981 * MOVE 'MEVL RECORD NOT ADDED (P3000)' CL*52
|
|
00982 * TO ABEND-MSG CL*52
|
|
00983 * PERFORM S999-ABEND THRU S999-EXIT. CL*52
|
|
00984 CL*40
|
|
00985 P7500-EXIT. EXIT. CL*40
|
|
00986 CL*40
|
|
00987 CL*21
|
|
00988 DTSBE439
|
|
00989 T0000-TERMINATE. DTSBE439
|
|
00990 PERFORM S2000-TERMINATE-AHDR THRU S2000-EXIT. DTSBE439
|
|
00991 DTSBE439
|
|
00992 CLOSE DEBIT-WRITEOFFS DTSBE439
|
|
00993 CREDIT-WRITEOFFS. DTSBE439
|
|
00994 PERFORM S923-CLOSE THRU S923-EXIT. DTSBE439
|
|
00995 PERFORM S985-CLOSE THRU S985-EXIT. CL*18
|
|
00996 DTSBE439
|
|
00997 MOVE MHDR-LAST-USED-BATCH-NO TO HOLD-LAST-USED-BATCH-NO. DTSBE439
|
|
00998 DTSBE439
|
|
00999 MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA. DTSBE439
|
|
01000 DTSBE439
|
|
01001 PERFORM S910-READ THRU S910-EXIT. DTSBE439
|
|
01002 IF L910-NO-REC-88 DTSBE439
|
|
01003 MOVE 'MHDR RECORD NOT FOUND (T0000)' DTSBE439
|
|
01004 TO ABEND-MSG DTSBE439
|
|
01005 PERFORM S999-ABEND THRU S999-EXIT DTSBE439
|
|
01006 END-IF. DTSBE439
|
|
01007 DTSBE439
|
|
01008 MOVE MSKL-REC TO MHDR-REC. DTSBE439
|
|
01009 MOVE HOLD-LAST-USED-BATCH-NO TO MHDR-LAST-USED-BATCH-NO. DTSBE439
|
|
01010 MOVE MHDR-CURR-RUN-DATE TO MHDR-CHNG-DATE. DTSBE439
|
|
01011 MOVE MHDR-REC TO MSKL-REC. DTSBE439
|
|
01012 DTSBE439
|
|
01013 PERFORM S910-REWRITE THRU S910-EXIT. DTSBE439
|
|
01014 DTSBE439
|
|
01015 DISPLAY ' '. DTSBE439
|
|
01016 DISPLAY '***** DEBITSS WRITEOFFS ONLY ********* '. CL*22
|
|
01017 DTSBE439
|
|
01018 DISPLAY '*** DTSBE439 TERMINATION STATISTICS ***'. DTSBE439
|
|
01019 DTSBE439
|
|
01020 DISPLAY ' '. DTSBE439
|
|
01021 DISPLAY 'MPRF MASTER FILE READ COUNT : ' DTSBE439
|
|
01022 WRK-EMPL-READ-CNT. DTSBE439
|
|
01023 DTSBE439
|
|
01024 DISPLAY ' '. DTSBE439
|
|
01025 DISPLAY 'INACTIVE EMPLOYERS READ COUNT : ' DTSBE439
|
|
01026 WRK-EMPL-INACT-CNT. DTSBE439
|
|
01027 DTSBE439
|
|
01028 DISPLAY ' '. DTSBE439
|
|
01029 DISPLAY 'EMPLOYERS WRITE-OFF RECS WRITE COUNT : ' DTSBE439
|
|
01030 WRK-EMPL-WRITE-CNT. DTSBE439
|
|
01031 CL*22
|
|
01032 DISPLAY ' '. CL*22
|
|
01033 MOVE GTOT-UI-BAL TO WRK-AMT-DISP CL*22
|
|
01034 DISPLAY ' TOTAL UI WRITEOFF AMOUNT : ' CL*22
|
|
01035 WRK-AMT-DISP. CL*22
|
|
01036 MOVE GTOT-SU-BAL TO WRK-AMT-DISP CL*22
|
|
01037 DISPLAY ' TOTAL SU WRITEOFF AMOUNT : ' CL*22
|
|
01038 WRK-AMT-DISP. CL*22
|
|
01039 MOVE GTOT-PEN-BAL TO WRK-AMT-DISP CL*22
|
|
01040 DISPLAY ' TOTAL PEN WRITEOFF AMOUNT : ' CL*22
|
|
01041 WRK-AMT-DISP. CL*22
|
|
01042 MOVE GTOT-INT-BAL TO WRK-AMT-DISP CL*22
|
|
01043 DISPLAY ' TOTAL INT WRITEOFF AMOUNT : ' CL*22
|
|
01044 WRK-AMT-DISP. CL*22
|
|
01045 CL*22
|
|
01046 DTSBE439
|
|
01047 MOVE WRK-TOT-WRITEOFF-AMT TO WRK-AMT-DISP. DTSBE439
|
|
01048 DISPLAY ' '. DTSBE439
|
|
01049 DISPLAY 'TOTAL POTENTIAL WRITEOFF AMOUNT : ' DTSBE439
|
|
01050 WRK-AMT-DISP. DTSBE439
|
|
01051 DTSBE439
|
|
01052 DISPLAY ' '. DTSBE439
|
|
01053 DISPLAY 'FIRST BATCH NUMBER : ' DTSBE439
|
|
01054 HOLD-FIRST-BATCH-NO. DTSBE439
|
|
01055 DTSBE439
|
|
01056 DISPLAY ' '. DTSBE439
|
|
01057 DISPLAY 'LAST BATCH NUMBER : ' DTSBE439
|
|
01058 HOLD-LAST-USED-BATCH-NO. DTSBE439
|
|
01059 DTSBE439
|
|
01060 T0000-EXIT. DTSBE439
|
|
01061 EXIT. DTSBE439
|
|
01062 DTSBE439
|
|
01063 S1000-INITIATE-AHDR. DTSBE439
|
|
01064 MOVE LOW-VALUES TO AHDR-REC. DTSBE439
|
|
01065 DTSBE439
|
|
01066 DISPLAY 'MHDR LAST BATCH NO: ' MHDR-LAST-USED-BATCH-NO. CL*19
|
|
01067 CL*19
|
|
01068 IF MHDR-LAST-USED-BATCH-NO < +99999 CL*19
|
|
01069 MOVE MHDR-LAST-USED-BATCH-NO TO WBAT-BATCH-NO CL*19
|
|
01070 PERFORM S985-START-BROWSE THRU S985-EXIT CL*19
|
|
01071 MOVE WBAT-BATCH-NO TO AHDR-BATCH-NO CL*19
|
|
01072 * ADD +3 TO AHDR-BATCH-NO CL*33
|
|
01073 END-IF. CL*19
|
|
01074 CL*19
|
|
01075 DISPLAY 'NEW MHDR-LAST BATCH NO: ' AHDR-BATCH-NO. CL*19
|
|
01076 DTSBE439
|
|
01077 MOVE +0 TO AHDR-ITEM-NO. CL*26
|
|
01078 MOVE +500 TO WRK-AHDR-ITEM-NO. CL*55
|
|
01079 SET AHDR-HDR-88 TO TRUE. DTSBE439
|
|
01080 SET AHDR-BATCH-BALANCED-YES-88 TO TRUE. DTSBE439
|
|
01081 SET AHDR-BATCH-HELD-NO-88 TO TRUE. DTSBE439
|
|
01082 *& SET AHDR-BATCH-HELD-YES-88 TO TRUE. DTSBE439
|
|
01083 SET AHDR-ESTB-SYSTEM-88 TO TRUE. DTSBE439
|
|
01084 MOVE 'DTSBE439' TO AHDR-CHNG-OP-ID. CL*25
|
|
01085 DTSBE439
|
|
01086 MOVE +0 TO AHDR-CHNG-DATE. DTSBE439
|
|
01087 MOVE MHDR-CURR-RUN-DATE TO AHDR-ESTB-DATE DTSBE439
|
|
01088 AHDR-RECEIVED-DATE DTSBE439
|
|
01089 AHDR-DEPOSIT-DATE. DTSBE439
|
|
01090 MOVE +0 TO AHDR-LAST-USED-ITEM-NO DTSBE439
|
|
01091 AHDR-CONTROL-TRAN-CNT DTSBE439
|
|
01092 AHDR-ATC-FILE-TRAN-CNT DTSBE439
|
|
01093 AHDR-PROC-TRAN-CNT DTSBE439
|
|
01094 AHDR-CONTROL-REMIT-AMT DTSBE439
|
|
01095 AHDR-ATC-FILE-REMIT-AMT DTSBE439
|
|
01096 AHDR-PROC-REMIT-AMT DTSBE439
|
|
01097 AHDR-BANK-BATCH-NO. DTSBE439
|
|
01098 DTSBE439
|
|
01099 S1000-EXIT. DTSBE439
|
|
01100 EXIT. DTSBE439
|
|
01101 DTSBE439
|
|
01102 S2000-TERMINATE-AHDR. DTSBE439
|
|
01103 IF AHDR-ATC-FILE-TRAN-CNT = +0 DTSBE439
|
|
01104 GO TO S2000-EXIT DTSBE439
|
|
01105 END-IF. DTSBE439
|
|
01106 DTSBE439
|
|
01107 MOVE AHDR-BATCH-NO TO MHDR-LAST-USED-BATCH-NO. DTSBE439
|
|
01108 MOVE WRK-AHDR-ITEM-NO TO AHDR-LAST-USED-ITEM-NO. CL*26
|
|
01109 MOVE AHDR-ATC-FILE-TRAN-CNT TO AHDR-CONTROL-TRAN-CNT. DTSBE439
|
|
01110 MOVE AHDR-ATC-FILE-REMIT-AMT TO AHDR-CONTROL-REMIT-AMT. DTSBE439
|
|
01111 MOVE AHDR-REC TO ASKL-REC. DTSBE439
|
|
01112 DTSBE439
|
|
01113 PERFORM S923-WRITE THRU S923-EXIT. DTSBE439
|
|
01114 DTSBE439
|
|
01115 S2000-EXIT. DTSBE439
|
|
01116 EXIT. DTSBE439
|
|
01117 DTSBE439
|
|
01118 S001-FROM-FED-8. DTSBE439
|
|
01119 SET L001-FROM-FED-8 TO TRUE. DTSBE439
|
|
01120 GO TO S001-DATE. DTSBE439
|
|
01121 DTSBE439
|
|
01122 S001-FROM-CAL-6. DTSBE439
|
|
01123 SET L001-FROM-CAL-6 TO TRUE. DTSBE439
|
|
01124 GO TO S001-DATE. DTSBE439
|
|
01125 DTSBE439
|
|
01126 S001-FROM-ABS-DAY. DTSBE439
|
|
01127 SET L001-FROM-ABS-DAY TO TRUE. DTSBE439
|
|
01128 GO TO S001-DATE. DTSBE439
|
|
01129 DTSBE439
|
|
01130 S001-DATE. DTSBE439
|
|
01131 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBE439
|
|
01132 S001-EXIT. DTSBE439
|
|
01133 EXIT. DTSBE439
|
|
01134 DTSBE439
|
|
01135 S004-FROM-DATE. DTSBE439
|
|
01136 SET L004-FROM-DATE TO TRUE. DTSBE439
|
|
01137 GO TO S004-YRQ. DTSBE439
|
|
01138 DTSBE439
|
|
01139 S004-FROM-FIVE. DTSBE439
|
|
01140 SET L004-FROM-5 TO TRUE. DTSBE439
|
|
01141 GO TO S004-YRQ. DTSBE439
|
|
01142 DTSBE439
|
|
01143 S004-YRQ. DTSBE439
|
|
01144 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBE439
|
|
01145 S004-EXIT. DTSBE439
|
|
01146 EXIT. DTSBE439
|
|
01147 DTSBE439
|
|
01148 S061-DETERMINE-FLD-REP. DTSBE439
|
|
01149 MOVE MPRF-FLD-ZIP TO L061-FLD-ZIP. DTSBE439
|
|
01150 MOVE MPRF-EMP-NO TO L061-EMP-NO. DTSBE439
|
|
01151 DTSBE439
|
|
01152 CALL 'DTSBU061' USING L061-LINK-AREA. DTSBE439
|
|
01153 S061-EXIT. DTSBE439
|
|
01154 EXIT. DTSBE439
|
|
01155 S101-PER-MONTH-NO. CL*24
|
|
01156 SET L101-PER-MONTH-NO-88 TO TRUE. CL*24
|
|
01157 GO TO S101-INT-COMP. CL*24
|
|
01158 CL*24
|
|
01159 S101-INT-COMP. CL*24
|
|
01160 CALL 'DTSBU101' USING L101-LINK-AREA. CL*24
|
|
01161 S101-EXIT. CL*24
|
|
01162 EXIT. CL*24
|
|
01163 SKIP3 CL*24
|
|
01164 S005-FROM-ABSTIME. CL*42
|
|
01165 SET L005-FROM-ABSTIME TO TRUE. CL*42
|
|
01166 GO TO S005-ABSTIME. CL*42
|
|
01167 CL*42
|
|
01168 S005-ABSTIME. CL*42
|
|
01169 CALL 'DTSBU005' USING L005-LINK-AREA. CL*42
|
|
01170 S005-EXIT. CL*42
|
|
01171 EXIT. CL*42
|
|
01172 SKIP3 CL*42
|
|
01173 CL*24
|
|
01174 DTSBE439
|
|
01175 S0600-CALL-BU600. DTSBE439
|
|
01176 CALL 'DTSBU600' USING L600-LINK-AREA. DTSBE439
|
|
01177 DTSBE439
|
|
01178 S0600-EXIT. DTSBE439
|
|
01179 EXIT. DTSBE439
|
|
01180 DTSBE439
|
|
01181 S910-READ. DTSBE439
|
|
01182 SET L910-READ-88 TO TRUE. DTSBE439
|
|
01183 GO TO S910-MSTR-IO. DTSBE439
|
|
01184 DTSBE439
|
|
01185 S910-OPEN-UPDATE-NO-AIX. CL*49
|
|
01186 SET L910-OPEN-UPDATE-88 TO TRUE. CL*50
|
|
01187 GO TO S910-MSTR-IO. CL*49
|
|
01188 CL*49
|
|
01189 S910-START-BROWSE. DTSBE439
|
|
01190 SET L910-START-BROWSE-88 TO TRUE. DTSBE439
|
|
01191 GO TO S910-MSTR-IO. DTSBE439
|
|
01192 DTSBE439
|
|
01193 S910-READ-NEXT. DTSBE439
|
|
01194 SET L910-READ-NEXT-88 TO TRUE. DTSBE439
|
|
01195 GO TO S910-MSTR-IO. DTSBE439
|
|
01196 DTSBE439
|
|
01197 S910-REWRITE. DTSBE439
|
|
01198 SET L910-REWRITE-88 TO TRUE. DTSBE439
|
|
01199 GO TO S910-MSTR-IO. DTSBE439
|
|
01200 DTSBE439
|
|
01201 S910-WRITE. CL*40
|
|
01202 SET L910-WRITE-88 TO TRUE. CL*40
|
|
01203 GO TO S910-MSTR-IO. CL*40
|
|
01204 CL*40
|
|
01205 S910-CLOSE. CL*32
|
|
01206 SET L910-CLOSE-88 TO TRUE. CL*32
|
|
01207 GO TO S910-MSTR-IO. CL*32
|
|
01208 CL*32
|
|
01209 S910-COUNT. DTSBE439
|
|
01210 SET L910-COUNT-88 TO TRUE. DTSBE439
|
|
01211 GO TO S910-MSTR-IO. DTSBE439
|
|
01212 DTSBE439
|
|
01213 S910-MSTR-IO. DTSBE439
|
|
01214 CALL 'DTSBU910' USING L910-LINK-AREA DTSBE439
|
|
01215 MSKL-REC. DTSBE439
|
|
01216 S910-EXIT. DTSBE439
|
|
01217 EXIT. DTSBE439
|
|
01218 DTSBE439
|
|
01219 S923-OPEN-UPDATE. DTSBE439
|
|
01220 SET L923-OPEN-UPDATE-88 TO TRUE. DTSBE439
|
|
01221 GO TO S923-ATC-IO. DTSBE439
|
|
01222 DTSBE439
|
|
01223 S923-OPEN. CL**6
|
|
01224 SET L923-OPEN-READ-88 TO TRUE. CL*10
|
|
01225 GO TO S923-ATC-IO. CL**6
|
|
01226 S923-READ. DTSBE439
|
|
01227 SET L923-READ-88 TO TRUE. DTSBE439
|
|
01228 GO TO S923-ATC-IO. DTSBE439
|
|
01229 DTSBE439
|
|
01230 S923-START-BROWSE. DTSBE439
|
|
01231 SET L923-START-BROWSE-88 TO TRUE. DTSBE439
|
|
01232 GO TO S923-ATC-IO. DTSBE439
|
|
01233 DTSBE439
|
|
01234 S923-READ-NEXT. DTSBE439
|
|
01235 SET L923-READ-NEXT-88 TO TRUE. DTSBE439
|
|
01236 GO TO S923-ATC-IO. DTSBE439
|
|
01237 DTSBE439
|
|
01238 S923-WRITE. DTSBE439
|
|
01239 SET L923-WRITE-88 TO TRUE. DTSBE439
|
|
01240 GO TO S923-ATC-IO. DTSBE439
|
|
01241 DTSBE439
|
|
01242 S923-REWRITE. DTSBE439
|
|
01243 SET L923-REWRITE-88 TO TRUE. DTSBE439
|
|
01244 GO TO S923-ATC-IO. DTSBE439
|
|
01245 DTSBE439
|
|
01246 S923-DELETE. DTSBE439
|
|
01247 SET L923-DELETE-88 TO TRUE. DTSBE439
|
|
01248 GO TO S923-ATC-IO. DTSBE439
|
|
01249 DTSBE439
|
|
01250 S923-CLOSE. DTSBE439
|
|
01251 SET L923-CLOSE-88 TO TRUE. DTSBE439
|
|
01252 GO TO S923-ATC-IO. DTSBE439
|
|
01253 DTSBE439
|
|
01254 S923-ATC-IO. DTSBE439
|
|
01255 CALL 'DTSBU923' USING L923-LINK-AREA DTSBE439
|
|
01256 ASKL-REC. DTSBE439
|
|
01257 S923-EXIT. DTSBE439
|
|
01258 EXIT. DTSBE439
|
|
01259 DTSBE439
|
|
01260 S946-WRITE-R439. DTSBE439
|
|
01261 CALL 'DTSBU946' USING R439-REC. DTSBE439
|
|
01262 GO TO S946-EXIT. DTSBE439
|
|
01263 DTSBE439
|
|
01264 S946-EXIT. DTSBE439
|
|
01265 EXIT. DTSBE439
|
|
01266 DTSBE439
|
|
01267 CL*18
|
|
01268 S985-OPEN. CL*18
|
|
01269 SET L985-OPEN-READ-88 TO TRUE. CL*18
|
|
01270 GO TO S985-BAT-IO. CL*18
|
|
01271 S985-READ. CL*18
|
|
01272 SET L985-READ-88 TO TRUE. CL*18
|
|
01273 GO TO S985-BAT-IO. CL*18
|
|
01274 CL*18
|
|
01275 S985-START-BROWSE. CL*18
|
|
01276 SET L985-START-BROWSE-88 TO TRUE. CL*18
|
|
01277 GO TO S985-BAT-IO. CL*18
|
|
01278 CL*18
|
|
01279 S985-READ-NEXT. CL*18
|
|
01280 SET L985-READ-NEXT-88 TO TRUE. CL*18
|
|
01281 GO TO S985-BAT-IO. CL*18
|
|
01282 CL*18
|
|
01283 S985-WRITE. CL*18
|
|
01284 SET L985-WRITE-88 TO TRUE. CL*18
|
|
01285 GO TO S985-BAT-IO. CL*18
|
|
01286 CL*18
|
|
01287 S985-REWRITE. CL*18
|
|
01288 SET L985-REWRITE-88 TO TRUE. CL*18
|
|
01289 GO TO S985-BAT-IO. CL*18
|
|
01290 CL*18
|
|
01291 S985-DELETE. CL*18
|
|
01292 SET L985-DELETE-88 TO TRUE. CL*18
|
|
01293 GO TO S985-BAT-IO. CL*18
|
|
01294 CL*18
|
|
01295 S985-CLOSE. CL*18
|
|
01296 SET L985-CLOSE-88 TO TRUE. CL*18
|
|
01297 GO TO S985-BAT-IO. CL*18
|
|
01298 CL*18
|
|
01299 S985-BAT-IO. CL*18
|
|
01300 CALL 'DTSBU985' USING L985-LINK-AREA CL*18
|
|
01301 LINK-REC. CL*18
|
|
01302 S985-EXIT. CL*18
|
|
01303 EXIT. CL*18
|
|
01304 S999-ABEND. DTSBE439
|
|
01305 DISPLAY '*** DTSBE439 ABENDING. ' DTSBE439
|
|
01306 ABEND-MSG. DTSBE439
|
|
01307 DTSBE439
|
|
01308 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBE439
|
|
01309 S999-EXIT. DTSBE439
|
|
01310 EXIT. DTSBE439
|
|
01311 DTSBE439
|