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
