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