00001  IDENTIFICATION DIVISION.                                         01/13/23
00002  PROGRAM-ID.             DTSBD720.                                DTSBD720
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV034
00004  DATE-WRITTEN.           APRIL 1999.                              DTSBD720
00005  DATE-COMPILED.                                                   DTSBD720
00006      SKIP3                                                        DTSBD720
00007 *****                                                             DTSBD720
00008 ******                                                            DTSBD720
00009 *                                                                 DTSBD720
00010 *    FUNCTION:  TRANSFER RATING EXPERIENCE AND DELETE UNNEEDED    DTSBD720
00011 *               MRCT RECORD OCCURRENCES.                          DTSBD720
00012 *                                                                 DTSBD720
00013 *                                                                 DTSBD720
00014 *    MODIFICATION LOG:                                            DTSBD720
00015 *                                                                 DTSBD720
00016 *    04/06/1999  WRITTEN FOR DC.                                  DTSBD720
00017 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH   DTSBD720
00018 *                                                                 DTSBD720
00019 *    09/25/2007  MODIFIED FOR PARTIAL TRANSFERS OF EXPERIENCE.    DTSBD720
00020 *                REFERENCE:                     PROGRAMMER: GD    DTSBD720
00021 *                                                                 DTSBD720
00022 *    10/14/2009  MODIFIED PROCESS THAT DETERMINES SUCCESSOR'S     DTSBD720
00023 *                EARLIEST LIABILITY DATE.                         DTSBD720
00024 *                REFERENCE:                     PROGRAMMER: GD    DTSBD720
00025 *                                                                 DTSBD720
00026 *    10/24/2013  CORRECTION FOR MANUAL TRANSFERS OF EXPERIENCE.   DTSBD720
00027 *                                                                 DTSBD720
00028 *                REFERENCE:                     PROGRAMMER: GD    DTSBD720
00029                                                                   DTSBD720
00030 *                                                                    CL*24
00031 *    11/24/2019  MODIFIED PROGRAM TO CORRECT ISSUES WITH PRED/       CL*24
00032 *                SUCC ELD VEIFICATION                                CL*24
00033 *                REFERENCE:                     PROGRAMMER: ZL1      CL*24
00034                                                                      CL*24
00035 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBD720
00036 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBD720
00037 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSBD720
00038 *                                                                 DTSBD720
00039 *                                                                 DTSBD720
00040 *  DESCRIPTION:                                                   DTSBD720
00041 *                                                                 DTSBD720
00042 *      DTSBD720 PERFORMS THE FUNCTIONS DESCRIBED IN SECTIONS      DTSBD720
00043 *      5.4.3 AND 5.4.4 OF THE DC UI TAX REQUIREMENTS DOCUMENT.    DTSBD720
00044 *                                                                 DTSBD720
00045 *                                                                 DTSBD720
00046 *****                                                             DTSBD720
00047      SKIP3                                                        DTSBD720
00048  ENVIRONMENT DIVISION.                                            DTSBD720
00049      EJECT                                                        DTSBD720
00050  INPUT-OUTPUT SECTION.                                            DTSBD720
00051      SKIP3                                                        DTSBD720
00052  FILE-CONTROL.                                                    DTSBD720
00053                                                                   DTSBD720
00054      SELECT RELATIONSHIP-FILE    ASSIGN TO DTSFIPES               DTSBD720
00055         FILE STATUS IS REL-STATUS.                                DTSBD720
00056                                                                   DTSBD720
00057      SELECT CHARGE-FILE       ASSIGN TO DTSFCHG5                  DTSBD720
00058             ORGANIZATION IS INDEXED                               DTSBD720
00059             ACCESS MODE IS DYNAMIC                                DTSBD720
00060             RECORD KEY IS CHG5-SORT-KEY-AREA                      DTSBD720
00061             FILE STATUS IS CHARGE-STATUS.                         DTSBD720
00062                                                                   DTSBD720
00063       SELECT BYPASS-FILE          ASSIGN TO DTSFPASS              DTSBD720
00064          FILE STATUS IS BYPASS-STATUS.                            DTSBD720
00065                                                                   DTSBD720
00066  DATA DIVISION.                                                   DTSBD720
00067  FILE SECTION.                                                    DTSBD720
00068                                                                   DTSBD720
00069  FD  RELATIONSHIP-FILE                                            DTSBD720
00070      RECORD CONTAINS 16 CHARACTERS                                DTSBD720
00071      DATA RECORD IS REL-REC.                                      DTSBD720
00072  01  REL-REC.                                                     DTSBD720
00073      05  REL-EFF-DT                 PIC S9(09)    COMP-3.         DTSBD720
00074      05  REL-PRED                   PIC S9(07)    COMP-3.         DTSBD720
00075      05  REL-SUCC                   PIC S9(07)    COMP-3.         DTSBD720
00076      05  REL-PCT                    PIC S9V9(04)  COMP-3.         DTSBD720
00077                                                                   DTSBD720
00078  FD  CHARGE-FILE                                                  DTSBD720
00079      RECORD CONTAINS 41 CHARACTERS                                DTSBD720
00080      DATA RECORD IS CHARGE-REC.                                   DTSBD720
00081  01  CHARGE-REC.                                                  DTSBD720
00082  ++INCLUDE CHGIM005                                               DTSBD720
00083                                                                   DTSBD720
00084  FD  BYPASS-FILE                                                  DTSBD720
00085      RECORD CONTAINS 46 CHARACTERS                                DTSBD720
00086      DATA RECORD IS BYPASS-REC.                                   DTSBD720
00087  01  BYPASS-REC                      PIC  X(46).                  DTSBD720
00088                                                                   DTSBD720
00089  WORKING-STORAGE SECTION.                                         DTSBD720
000895 77  PAN-VALET PICTURE X(24) VALUE '034DTSBD720  01/13/23'.       DTSBD720
00090  77  PAN-VALET PICTURE X(24) VALUE '055DTSBD720  12/02/13'.       DTSBD720
00091  77  PAN-VALET PICTURE X(24) VALUE '005DTSBD720  11/13/13'.       DTSBD720
00092  77  PAN-VALET PICTURE X(24) VALUE '053DTSBD720  12/03/10'.       DTSBD720
00093                                                                   DTSBD720
00094                                                                   DTSBD720
00095  01  WRK-AREA.                                                    DTSBD720
00096      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +720.DTSBD720
00097                                                                   DTSBD720
00098      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBD720'.DTSBD720
00099                                                                   DTSBD720
00100      05  ABEND-MSG                   PIC  X(60).                  DTSBD720
00101                                                                   DTSBD720
00102                                                                   DTSBD720
00103      05  WRK-SYS-ABSTIME             PIC S9(15)  COMP-3.          DTSBD720
00104                                                                   DTSBD720
00105      05  WRK-SYS-DATE                PIC S9(09)  COMP-3.          DTSBD720
00106                                                                   DTSBD720
00107      05  WRK-SYS-TIME                PIC S9(07)  COMP-3.          DTSBD720
00108                                                                   DTSBD720
00109      05  REL-STATUS                  PIC  X(02) VALUE SPACES.     DTSBD720
00110          88  REL-FILE-OK-88      VALUE '00'.                      DTSBD720
00111          88  REL-FILE-EOF-88     VALUE '10'.                      DTSBD720
00112                                                                   DTSBD720
00113      05  CHARGE-STATUS               PIC  X(02) VALUE SPACES.     DTSBD720
00114          88  CHARGE-FILE-OK-88   VALUE '00'.                      DTSBD720
00115          88  CHARGE-FILE-EOF-88  VALUE '10'.                      DTSBD720
00116                                                                   DTSBD720
00117      05  BYPASS-STATUS               PIC  X(02) VALUE SPACES.     DTSBD720
00118          88  BYPASS-FILE-OK-88   VALUE '00'.                      DTSBD720
00119                                                                   DTSBD720
00120      05  WRK-ERROR-IND               PIC  X(01).                  DTSBD720
00121          88  WRK-ERROR-YES-88    VALUE 'Y'.                       DTSBD720
00122          88  WRK-ERROR-NO-88     VALUE 'N'.                       DTSBD720
00123                                                                   DTSBD720
00124      05  WRK-TRANSFER-IND            PIC  X(01).                  DTSBD720
00125          88  WRK-TRANSFER-YES-88 VALUE 'Y'.                       DTSBD720
00126          88  WRK-TRANSFER-NO-88  VALUE 'N'.                       DTSBD720
00127                                                                   DTSBD720
00128      05  REL-TABLE  OCCURS 100 TIMES.                             DTSBD720
00129          10  RT-EFF-DATE             PIC S9(09)    COMP-3.        DTSBD720
00130          10  RT-PRED                 PIC S9(07)    COMP-3.        DTSBD720
00131          10  RT-SUCC                 PIC S9(07)    COMP-3.        DTSBD720
00132          10  RT-PERCENT              PIC S9V9(04)  COMP-3.        DTSBD720
00133      05  RSUB                        PIC S9(04)    COMP.          DTSBD720
00134      05  RT-MAX                      PIC S9(04)    COMP           DTSBD720
00135                                       VALUE +100.                 DTSBD720
00136      05  RT-LAST                     PIC S9(04)    COMP.          DTSBD720
00137      05  WRK-CURR-EFF-DT             PIC S9(09)    COMP-3.        DTSBD720
00138      05  WRK-CURR-PRED               PIC S9(07)    COMP-3.        DTSBD720
00139      05  WRK-CURR-SUCC               PIC S9(07)    COMP-3.        DTSBD720
00140      05  WRK-CURR-PCT                PIC S9V9(04)  COMP-3.        DTSBD720
00141                                                                   DTSBD720
00142      05  WRK-MRRA-ID                 PIC S9(03)  COMP-3.          DTSBD720
00143                                                                   DTSBD720
00144      05  WRK-RTE-YR-START-YRQ        PIC S9(05)  COMP-3.          DTSBD720
00145                                                                   DTSBD720
00146      05  WRK-RTE-YR-END-YRQ          PIC S9(05)  COMP-3.          DTSBD720
00147                                                                   DTSBD720
00148      05  WRK-RTE-YR-START-DATE       PIC S9(09)  COMP-3.          DTSBD720
00149                                                                   DTSBD720
00150      05  WRK-RTE-YR-END-DATE         PIC S9(09)  COMP-3.          DTSBD720
00151                                                                   DTSBD720
00152      05  WRK-PRIOR-RTE-YEAR-YRQ      PIC S9(05)  COMP-3.          DTSBD720
00153                                                                   DTSBD720
00154      05  WRK-EXP-CUTOFF-DATE         PIC S9(09)  COMP-3.          DTSBD720
00155                                                                   DTSBD720
00156      05  WRK-SUC-EARLIEST-LIAB-DATE  PIC S9(09)  COMP-3              CL**4
00157                                        VALUE +0.                     CL**4
00158      05  WRK-PRED-EARLIEST-LIAB-DATE  PIC S9(09)  COMP-3          DTSBD720
00159                                        VALUE +999999999.          DTSBD720
00160      05  WRK-ALL-NINES-DATE           PIC S9(09)  COMP-3          DTSBD720
00161                                        VALUE +999999999.          DTSBD720
00162      05  WRK-SUC-PRIOR-EARLIEST-LIAB PIC S9(09)  COMP-3              CL**4
00163                                        VALUE +0.                     CL**4
00164                                                                   DTSBD720
00165      05  WRK-EMP-NO                  PIC S9(07)  COMP-3.          DTSBD720
00166                                                                   DTSBD720
00167      05  XFER-BENEFITS-AMT           PIC S9(09)V99  COMP-3.       DTSBD720
00168      05  XFER-UI-TAX-AMT             PIC S9(09)V99  COMP-3.       DTSBD720
00169      05  XFER-PRIOR-RESERVE          PIC S9(09)V99  COMP-3.       DTSBD720
00170      05  TOT-XFER-BENEFITS-AMT       PIC S9(09)V99  COMP-3.       DTSBD720
00171      05  TOT-XFER-UI-TAX-AMT         PIC S9(09)V99  COMP-3.       DTSBD720
00172      05  TOT-XFER-PRIOR-RESERVE      PIC S9(09)V99  COMP-3.       DTSBD720
00173                                                                   DTSBD720
00174      05  XW-SUB                      PIC S9(04) COMP.             DTSBD720
00175      05  XFER-WAGE-AREA OCCURS 3 TIMES.                           DTSBD720
00176          10  XFER-TOT-WAGE           PIC S9(11)V99  COMP-3.       DTSBD720
00177          10  XFER-TAX-WAGE           PIC S9(11)V99  COMP-3.       DTSBD720
00178          10  TOT-XFER-TOT-WAGE       PIC S9(11)V99  COMP-3.       DTSBD720
00179          10  TOT-XFER-TAX-WAGE       PIC S9(11)V99  COMP-3.       DTSBD720
00180                                                                   DTSBD720
00181 *    05  WRK-BENEFIT-CHARGE          PIC S9(09)V99  COMP-3.       DTSBD720
00182 *    05  WRK-CHG-EMP                 PIC S9(07)     COMP-3.       DTSBD720
00183 *    05  WRK-CHG-TYPE                PIC  9(01).                  DTSBD720
00184 *        88  WRK-TYPE-ORIG-88         VALUE 1.                    DTSBD720
00185 *        88  WRK-TYPE-PRED-88         VALUE 2.                    DTSBD720
00186 *        88  WRK-TYPE-SUCC-88         VALUE 3.                    DTSBD720
00187                                                                   DTSBD720
00188      05  WRK-CHG-REL-DT              PIC S9(09)     COMP-3.       DTSBD720
00189                                                                   DTSBD720
00190      05  RCT-REC-DELETE-CNT          PIC S9(07)  COMP-3           DTSBD720
00191                                        VALUE +0.                  DTSBD720
00192      05  RCT-LIAB-DT-CHNG-CNT        PIC S9(07)  COMP-3           DTSBD720
00193                                        VALUE +0.                  DTSBD720
00194      05  RRA-REC-WRITE-CNT           PIC S9(07)  COMP-3           DTSBD720
00195                                        VALUE +0.                  DTSBD720
00196                                                                   DTSBD720
00197      05  WRK-PCT                   PIC S9(03)V99 COMP-3.          DTSBD720
00198      05  WRK-PCT-DISP              PIC --9.99.                    DTSBD720
00199                                                                   DTSBD720
00200      05  WRK-DATA-TO-TRANSFER-IND    PIC  X(01).                  DTSBD720
00201          88  WRK-DATA-TO-TRANSFER-NO-88      VALUE 'N'.           DTSBD720
00202          88  WRK-DATA-TO-TRANSFER-YES-88     VALUE 'Y'.           DTSBD720
00203                                                                   DTSBD720
00204                                                                   DTSBD720
00205      05  WRK-LIAB-IN-RTE-YR-IND      PIC  X(01).                  DTSBD720
00206          88  WRK-LIAB-IN-RTE-YR-NO-88        VALUE 'N'.           DTSBD720
00207          88  WRK-LIAB-IN-RTE-YR-YES-88       VALUE 'Y'.           DTSBD720
00208                                                                   DTSBD720
00209      05  WRK-PREDECESSOR-IND         PIC  X(01).                  DTSBD720
00210          88  WRK-PREDECESSOR-YES-88          VALUE 'Y'.           DTSBD720
00211          88  WRK-PREDECESSOR-NO-88           VALUE 'N'.           DTSBD720
00212                                                                   DTSBD720
00213      05  WRK-BYPASS-REC.                                          DTSBD720
00214          10  BYPASS-PRED                 PIC  9(06).              DTSBD720
00215          10  FILLER                      PIC  X(01) VALUE ','.    DTSBD720
00216          10  BYPASS-SUCC                 PIC  9(06).              DTSBD720
00217          10  FILLER                      PIC  X(01) VALUE ','.    DTSBD720
00218          10  BYPASS-EFF-DT               PIC  X(10).              DTSBD720
00219          10  FILLER                      PIC  X(01) VALUE ','.    DTSBD720
00220          10  BYPASS-MRCT-ESTB            PIC  X(10).              DTSBD720
00221          10  FILLER                      PIC  X(01) VALUE ','.    DTSBD720
00222          10  BYPASS-MRCT-CHNG            PIC  X(10).              DTSBD720
00223                                                                   DTSBD720
00224      05  WRK-DISPLAY-CNT-X           PIC  X(11).                  DTSBD720
00225      05  WRK-DISPLAY-CNT-9 REDEFINES WRK-DISPLAY-CNT-X            DTSBD720
00226                                      PIC  ZZZ,ZZZ,ZZ9.            DTSBD720
00227                                                                   DTSBD720
00228      05  WRK-DISPLAY-AMT-X           PIC  X(17).                  DTSBD720
00229      05  WRK-DISPLAY-AMT-9 REDEFINES WRK-DISPLAY-AMT-X            DTSBD720
00230                                      PIC  ZZZZZ,ZZZ,ZZ9.99-.      DTSBD720
00231      EJECT                                                        DTSBD720
00232  01  MSG-TABLE.                                                   DTSBD720
00233      05  MSG01-AREA.                                              DTSBD720
00234          10  MSG01-MSG-IDENTIFIER    PIC  X(04)  VALUE '2001'.    DTSBD720
00235          10  MSG01-MSG-TEXT.                                      DTSBD720
00236              15  FILLER              PIC  X(27)                   DTSBD720
00237                VALUE 'RATING SUCCESSOR EMPLOYER '.                DTSBD720
00238              15  FILLER              PIC  X(40)                   DTSBD720
00239                VALUE ' NOT ON EMPLOYER MASTER FILE.  EXPERIENC'.  DTSBD720
00240              15  FILLER              PIC  X(20)                   DTSBD720
00241                VALUE 'E NOT TRANSFERRED   '.                      DTSBD720
00242                                                                   DTSBD720
00243      05  MSG02-AREA.                                              DTSBD720
00244          10  MSG02-MSG-IDENTIFIER    PIC  X(04)  VALUE '2002'.    DTSBD720
00245          10  MSG02-MSG-TEXT.                                      DTSBD720
00246              15  FILLER              PIC  X(40)                   DTSBD720
00247                VALUE 'RATING PREDECESSOR EMPLOYER NOT ON MASTE'.  DTSBD720
00248              15  FILLER              PIC  X(40)                   DTSBD720
00249                VALUE 'ER FILE. EXPERIENCE NOT TRANSFERRED     '.  DTSBD720
00250                                                                   DTSBD720
00251      05  MSG03-AREA.                                              DTSBD720
00252          10  MSG03-MSG-IDENTIFIER    PIC  X(04)  VALUE '2003'.    DTSBD720
00253          10  MSG03-MSG-TEXT.                                      DTSBD720
00254              15  FILLER              PIC  X(40)                   DTSBD720
00255                VALUE 'MORE THAN ONE RATING SUCCESSOR ENCOUNTER'.  DTSBD720
00256              15  FILLER              PIC  X(40)                   DTSBD720
00257                VALUE 'ED - EXPERIENCE NOT TRANSFERRED TO SPECI'.  DTSBD720
00258              15  FILLER              PIC  X(20)                   DTSBD720
00259                VALUE 'FIED SUCCESSOR.     '.                      DTSBD720
00260                                                                   DTSBD720
00261      05  MSG04-AREA.                                              DTSBD720
00262          10  MSG04-MSG-IDENTIFIER    PIC  X(04)  VALUE '2004'.    DTSBD720
00263          10  MSG04-MSG-TEXT.                                      DTSBD720
00264              15  FILLER              PIC  X(40)                   DTSBD720
00265                VALUE 'RATING PREDECESSOR ACTIVE - EXPERIENCE N'.  DTSBD720
00266              15  FILLER              PIC  X(40)                   DTSBD720
00267                VALUE 'OT TRANSFERRED.                         '.  DTSBD720
00268                                                                   DTSBD720
00269      05  MSG05-AREA.                                              DTSBD720
00270          10  MSG05-MSG-IDENTIFIER    PIC  X(04)  VALUE '2005'.    DTSBD720
00271          10  MSG05-MSG-TEXT.                                      DTSBD720
00272              15  FILLER              PIC  X(40)                   DTSBD720
00273                VALUE 'EXPERIENCE TRANSFER STRING LOOPS BACK ON'.  DTSBD720
00274              15  FILLER              PIC  X(40)                   DTSBD720
00275                VALUE ' ITSELF - EXPERIENCE NOT TRANSFERRED.   '.  DTSBD720
00276                                                                   DTSBD720
00277      05  MSG06-AREA.                                              DTSBD720
00278          10  MSG06-MSG-IDENTIFIER    PIC  X(04)  VALUE '2006'.    DTSBD720
00279          10  MSG06-MSG-TEXT.                                      DTSBD720
00280              15  FILLER              PIC  X(40)                   DTSBD720
00281                VALUE 'RATING SUCCESSOR IS NOT A "RATED" EMPLOY'.  DTSBD720
00282              15  FILLER              PIC  X(40)                   DTSBD720
00283                VALUE 'ER - EXPERIENCE NOT TRANSFERRED.        '.  DTSBD720
00284                                                                   DTSBD720
00285      05  MSG07-AREA.                                              DTSBD720
00286          10  MSG07-MSG-IDENTIFIER    PIC  X(04)  VALUE '2007'.    DTSBD720
00287          10  MSG07-MSG-TEXT.                                      DTSBD720
00288              15  FILLER              PIC  X(40)                   DTSBD720
00289                VALUE 'NO MRCT RECORD OCCURRENCE ATTACHED TO SU'.  DTSBD720
00290              15  FILLER              PIC  X(40)                   DTSBD720
00291                VALUE 'CCESSOR EMPLOYER - EXPERIENCE NOT TRANSF'.  DTSBD720
00292              15  FILLER              PIC  X(20)                   DTSBD720
00293                VALUE 'ERRED.              '.                      DTSBD720
00294                                                                   DTSBD720
00295      05  MSG08-AREA.                                              DTSBD720
00296          10  MSG08-MSG-IDENTIFIER    PIC  X(04)  VALUE '2008'.    DTSBD720
00297          10  MSG08-MSG-TEXT.                                      DTSBD720
00298              15  FILLER              PIC  X(40)                   DTSBD720
00299                VALUE 'MREL-PORTION-EXP-TRNSF NOT 100%.  100% T'.  DTSBD720
00300              15  FILLER              PIC  X(40)                   DTSBD720
00301                VALUE 'RANSFER OF EXPERIENCE ASSUMED.          '.  DTSBD720
00302                                                                   DTSBD720
00303      05  MSG99-AREA.                                              DTSBD720
00304          10  MSG99-MSG-IDENTIFIER    PIC  X(04)  VALUE '2099'.    DTSBD720
00305          10  MSG99-MSG-TEXT.                                      DTSBD720
00306              15  FILLER              PIC  X(40)                   DTSBD720
00307                VALUE 'DESPITE BEING LOCKED AGAINST UPDATE, AN '.  DTSBD720
00308              15  FILLER              PIC  X(40)                   DTSBD720
00309                VALUE 'ANNUAL RATING BATCH PROCESS UPDATED A MR'.  DTSBD720
00310              15  FILLER              PIC  X(20)                   DTSBD720
00311                VALUE 'CT RECORD OCCURRENCE'.                      DTSBD720
00312      EJECT                                                        DTSBD720
00313  01  L910-LINK-AREA.                                              DTSBD720
00314  ++INCLUDE DTSIL910                                               DTSBD720
00315      SKIP3                                                        DTSBD720
00316  01  MSKL-REC.                                                    DTSBD720
00317  ++INCLUDE DTSIMSKL                                               DTSBD720
00318      SKIP3                                                        DTSBD720
00319  01  MHDR-REC.                                                    DTSBD720
00320  ++INCLUDE DTSIMHDR                                               DTSBD720
00321      SKIP3                                                        DTSBD720
00322  01  MPRF-REC.                                                    DTSBD720
00323  ++INCLUDE DTSIMPRF                                               DTSBD720
00324      SKIP3                                                        DTSBD720
00325  01  MRCT-REC.                                                    DTSBD720
00326  ++INCLUDE DTSIMRCT                                               DTSBD720
00327      SKIP3                                                        DTSBD720
00328  01  MREL-REC.                                                    DTSBD720
00329  ++INCLUDE DTSIMREL                                               DTSBD720
00330      SKIP3                                                        DTSBD720
00331  01  MSOL-REC.                                                    DTSBD720
00332  ++INCLUDE DTSIMSOL                                               DTSBD720
00333      EJECT                                                        DTSBD720
00334  01  MRRA-REC.                                                    DTSBD720
00335  ++INCLUDE DTSIMRRA                                               DTSBD720
00336      EJECT                                                        DTSBD720
00337  01  MRWA-REC.                                                    DTSBD720
00338  ++INCLUDE DTSIMRWA                                               DTSBD720
00339      EJECT                                                        DTSBD720
00340  01  L921-LINK-AREA.                                              DTSBD720
00341  ++INCLUDE DTSIL921                                               DTSBD720
00342      SKIP3                                                        DTSBD720
00343  01  ISKL-REC.                                                    DTSBD720
00344  ++INCLUDE DTSIISKL                                               DTSBD720
00345      SKIP3                                                        DTSBD720
00346  01  IPES-REC.                                                    DTSBD720
00347  ++INCLUDE DTSIIPES                                               DTSBD720
00348      EJECT                                                        DTSBD720
00349  01  L931-LINK-AREA.                                              DTSBD720
00350  ++INCLUDE DTSIL931                                               DTSBD720
00351      SKIP3                                                        DTSBD720
00352  01  FSKL-REC.                                                    DTSBD720
00353  ++INCLUDE DTSIFSKL                                               DTSBD720
00354      SKIP3                                                        DTSBD720
00355  01  FUIR-REC.                                                    DTSBD720
00356  ++INCLUDE DTSIFUIR                                               DTSBD720
00357      EJECT                                                        DTSBD720
00358  01  R506-REC.                                                    DTSBD720
00359  ++INCLUDE DTSIR506                                               DTSBD720
00360      SKIP3                                                        DTSBD720
00361  01  R507-REC.                                                    DTSBD720
00362  ++INCLUDE DTSIR507                                               DTSBD720
00363      EJECT                                                        DTSBD720
00364  01  L001-LINK-AREA.                                              DTSBD720
00365  ++INCLUDE DTSIL001                                               DTSBD720
00366      SKIP3                                                        DTSBD720
00367  01  L004-LINK-AREA.                                              DTSBD720
00368  ++INCLUDE DTSIL004                                               DTSBD720
00369      SKIP3                                                        DTSBD720
00370  01  L005-LINK-AREA.                                              DTSBD720
00371  ++INCLUDE DTSIL005                                               DTSBD720
00372      SKIP3                                                        DTSBD720
00373  01  L006-LINK-AREA.                                              DTSBD720
00374  ++INCLUDE DTSIL006                                               DTSBD720
00375      SKIP3                                                        DTSBD720
00376  01  L055-LINK-AREA.                                              DTSBD720
00377  ++INCLUDE DTSIL055                                               DTSBD720
00378      EJECT                                                        DTSBD720
00379  01  MMAX-LITERALS.                                               DTSBD720
00380  ++INCLUDE DTSIMMAX                                               DTSBD720
00381      EJECT                                                        DTSBD720
00382  LINKAGE SECTION.                                                 DTSBD720
00383      SKIP3                                                        DTSBD720
00384  01  PARM-AREA.                                                   DTSBD720
00385      05  PARM-LENGTH                PIC S9(04)  COMP.             DTSBD720
00386      05  PARM-DATA.                                               DTSBD720
00387          10  PARM-RTE-YR-START-YRQ-X                              DTSBD720
00388                                     PIC  X(03).                   DTSBD720
00389          10  PARM-RTE-YR-START-YRQ                                DTSBD720
00390              REDEFINES PARM-RTE-YR-START-YRQ-X                    DTSBD720
00391                                     PIC  9(03).                   DTSBD720
00392      EJECT                                                        DTSBD720
00393  PROCEDURE DIVISION USING PARM-AREA.                              DTSBD720
00394                                                                   DTSBD720
00395      PERFORM I0000-INITIATE THRU I0000-EXIT.                      DTSBD720
00396                                                                   DTSBD720
00397      PERFORM P0000-PROCESS  THRU P0000-EXIT.                      DTSBD720
00398                                                                   DTSBD720
00399      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSBD720
00400                                                                   DTSBD720
00401      MOVE +0 TO MSKL-EMP-NO.                                      DTSBD720
00402                                                                   DTSBD720
00403      SET MSKL-PRF-88 TO TRUE.                                     DTSBD720
00404                                                                   DTSBD720
00405      PERFORM S910-START-BROWSE THRU  S910-EXIT.                   DTSBD720
00406                                                                   DTSBD720
00407      PERFORM                                                      DTSBD720
00408        UNTIL L910-NO-REC-88                                       DTSBD720
00409          MOVE MSKL-REC TO MPRF-REC                                DTSBD720
00410          PERFORM P9000-CLEANUP-MRCT THRU P9000-EXIT               DTSBD720
00411          MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA                      DTSBD720
00412          PERFORM S910-READ-NEXT THRU S910-EXIT                    DTSBD720
00413      END-PERFORM.                                                 DTSBD720
00414                                                                   DTSBD720
00415                                                                   DTSBD720
00416      PERFORM T0000-TERMINATE THRU T0000-EXIT.                     DTSBD720
00417                                                                   DTSBD720
00418                                                                   DTSBD720
00419      GOBACK.                                                      DTSBD720
00420      EJECT                                                        DTSBD720
00421  I0000-INITIATE.                                                  DTSBD720
00422      SET WRK-ERROR-NO-88        TO TRUE.                          DTSBD720
00423                                                                   DTSBD720
00424      PERFORM S910-OPEN-UPDATE THRU S910-EXIT.                     DTSBD720
00425                                                                   DTSBD720
00426      PERFORM S921-OPEN-READ THRU S921-EXIT.                       DTSBD720
00427                                                                   DTSBD720
00428      PERFORM S931-OPEN-READ THRU S931-EXIT.                       DTSBD720
00429                                                                   DTSBD720
00430      OPEN INPUT RELATIONSHIP-FILE.                                DTSBD720
00431      IF NOT REL-FILE-OK-88                                        DTSBD720
00432         DISPLAY 'REL FILE OPEN ERROR: ' REL-STATUS                DTSBD720
00433         PERFORM S999-ABEND THRU S999-EXIT                         DTSBD720
00434      END-IF.                                                      DTSBD720
00435                                                                   DTSBD720
00436      OPEN INPUT CHARGE-FILE.                                      DTSBD720
00437      IF NOT CHARGE-FILE-OK-88                                     DTSBD720
00438         DISPLAY 'INPUT CHARGE FILE OPEN ERROR: ' CHARGE-STATUS    DTSBD720
00439         SET WRK-ERROR-YES-88      TO TRUE                         DTSBD720
00440         GO TO I0000-EXIT                                          DTSBD720
00441      END-IF.                                                      DTSBD720
00442                                                                   DTSBD720
00443      OPEN OUTPUT BYPASS-FILE.                                     DTSBD720
00444      IF NOT BYPASS-FILE-OK-88                                     DTSBD720
00445         DISPLAY 'BYPASS FILE OPEN ERROR: ' BYPASS-STATUS          DTSBD720
00446         SET WRK-ERROR-YES-88      TO TRUE                         DTSBD720
00447         GO TO I0000-EXIT                                          DTSBD720
00448      END-IF.                                                      DTSBD720
00449                                                                   DTSBD720
00450      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSBD720
00451                                                                   DTSBD720
00452      MOVE +0 TO MSKL-EMP-NO.                                      DTSBD720
00453                                                                   DTSBD720
00454      SET MSKL-HDR-88 TO TRUE.                                     DTSBD720
00455                                                                   DTSBD720
00456      PERFORM S910-READ THRU S910-EXIT.                            DTSBD720
00457                                                                   DTSBD720
00458      IF L910-NO-REC-88                                            DTSBD720
00459          MOVE 'MHDR RECORD IS MISSING'                            DTSBD720
00460            TO ABEND-MSG                                           DTSBD720
00461          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD720
00462                                                                   DTSBD720
00463      MOVE MSKL-REC TO MHDR-REC.                                   DTSBD720
00464                                                                   DTSBD720
00465                                                                   DTSBD720
00466      PERFORM I1000-PROCESS-PARMS THRU I1000-EXIT.                 DTSBD720
00467                                                                   DTSBD720
00468                                                                   DTSBD720
00469      PERFORM I2000-FIND-RATE-PERIOD THRU I2000-EXIT.              DTSBD720
00470                                                                   DTSBD720
00471                                                                   DTSBD720
00472      PERFORM I3000-INITIALIZE-REC-CNTS THRU I3000-EXIT.           DTSBD720
00473                                                                   DTSBD720
00474                                                                   DTSBD720
00475      MOVE LENGTH OF R506-REC TO R506-LENGTH.                      DTSBD720
00476                                                                   DTSBD720
00477      MOVE '506' TO R506-REC-TYPE.                                 DTSBD720
00478                                                                   DTSBD720
00479      MOVE WRK-EXP-CUTOFF-DATE TO R506-EXP-CUTOFF-DATE.            DTSBD720
00480                                                                   DTSBD720
00481      MOVE WRK-RTE-YR-START-YRQ TO R506-EFF-QTR.                   DTSBD720
00482                                                                   DTSBD720
00483                                                                   DTSBD720
00484      MOVE LENGTH OF R507-REC TO R507-LENGTH.                      DTSBD720
00485                                                                   DTSBD720
00486      MOVE '507' TO R507-REC-TYPE.                                 DTSBD720
00487                                                                   DTSBD720
00488      MOVE WRK-EXP-CUTOFF-DATE TO R507-EXP-CUTOFF-DATE.            DTSBD720
00489                                                                   DTSBD720
00490      MOVE WRK-RTE-YR-START-YRQ TO R507-EFF-QTR.                   DTSBD720
00491                                                                   DTSBD720
00492                                                                   DTSBD720
00493      PERFORM S005-FROM-SYS THRU S005-EXIT.                        DTSBD720
00494                                                                   DTSBD720
00495      MOVE L005-ABSTIME TO WRK-SYS-ABSTIME.                        DTSBD720
00496                                                                   DTSBD720
00497      MOVE L005-DATE TO WRK-SYS-DATE.                              DTSBD720
00498                                                                   DTSBD720
00499      MOVE L005-TIME TO WRK-SYS-TIME.                              DTSBD720
00500                                                                   DTSBD720
00501      PERFORM I4000-INITIALIZE-REL-TBL  THRU I4000-EXIT.           DTSBD720
00502                                                                   DTSBD720
00503      READ RELATIONSHIP-FILE.                                      DTSBD720
00504                                                                   DTSBD720
00505      IF REL-FILE-EOF-88                                           DTSBD720
00506         DISPLAY 'REL FILE EMPTY: ' REL-STATUS                     DTSBD720
00507         SET WRK-ERROR-YES-88 TO TRUE                              DTSBD720
00508         GO TO I0000-EXIT                                          DTSBD720
00509      ELSE                                                         DTSBD720
00510         MOVE REL-EFF-DT    TO WRK-CURR-EFF-DT                     DTSBD720
00511         MOVE REL-PRED      TO WRK-CURR-PRED                       DTSBD720
00512         ADD +1             TO RT-LAST                             DTSBD720
00513         MOVE REL-REC       TO REL-TABLE (RT-LAST)                 DTSBD720
00514      END-IF.                                                      DTSBD720
00515                                                                   DTSBD720
00516  I0000-EXIT.                                                      DTSBD720
00517      EXIT.                                                        DTSBD720
00518      EJECT                                                        DTSBD720
00519  I1000-PROCESS-PARMS.                                             DTSBD720
00520      IF PARM-LENGTH = +3                                          DTSBD720
00521          NEXT SENTENCE                                            DTSBD720
00522      ELSE                                                         DTSBD720
00523          MOVE 'PARM-LENGTH NOT EQUAL TO 3'                        DTSBD720
00524            TO ABEND-MSG                                           DTSBD720
00525          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD720
00526                                                                   DTSBD720
00527                                                                   DTSBD720
00528      DISPLAY '***'.                                               DTSBD720
00529                                                                   DTSBD720
00530      DISPLAY '*** '                                               DTSBD720
00531              WRK-MOD-NAME                                         DTSBD720
00532              ' PARAMETERS: '                                      DTSBD720
00533              PARM-DATA.                                           DTSBD720
00534                                                                   DTSBD720
00535      DISPLAY '***'.                                               DTSBD720
00536                                                                   DTSBD720
00537                                                                   DTSBD720
00538      IF PARM-RTE-YR-START-YRQ-X = SPACES OR LOW-VALUES OR '000'   DTSBD720
00539          PERFORM I1100-DEFAULT-START-YRQ THRU I1100-EXIT          DTSBD720
00540      ELSE                                                         DTSBD720
00541          PERFORM I1200-EDIT-START-YRQ THRU I1200-EXIT.            DTSBD720
00542  I1000-EXIT.                                                      DTSBD720
00543      EXIT.                                                        DTSBD720
00544      SKIP3                                                        DTSBD720
00545  I1100-DEFAULT-START-YRQ.                                         DTSBD720
00546      MOVE MHDR-LAST-RATE-END-YRQ TO L004-QTR-5-9.                 DTSBD720
00547                                                                   DTSBD720
00548      PERFORM S004-FROM-5 THRU S004-EXIT.                          DTSBD720
00549                                                                   DTSBD720
00550      IF L004-INVALID-QTR                                          DTSBD720
00551          MOVE 'LOGIC ERROR I1100-1'                               DTSBD720
00552            TO ABEND-MSG                                           DTSBD720
00553          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD720
00554                                                                   DTSBD720
00555                                                                   DTSBD720
00556      ADD +1 TO L004-ABS-QTR.                                      DTSBD720
00557                                                                   DTSBD720
00558      PERFORM S004-FROM-ABS THRU S004-EXIT.                        DTSBD720
00559                                                                   DTSBD720
00560      MOVE L004-QTR-5-9 TO L006-YRQ.                               DTSBD720
00561                                                                   DTSBD720
00562      PERFORM S006-FROM-QTR THRU S006-EXIT.                        DTSBD720
00563                                                                   DTSBD720
00564      IF L004-QTR-5-9 = L006-RTE-YR-START-YRQ                      DTSBD720
00565          MOVE L006-RTE-YR-START-YRQ TO WRK-RTE-YR-START-YRQ       DTSBD720
00566          MOVE L006-RTE-YR-END-YRQ TO WRK-RTE-YR-END-YRQ           DTSBD720
00567          MOVE L006-RTE-YR-START-DATE TO WRK-RTE-YR-START-DATE     DTSBD720
00568          MOVE L006-RTE-YR-END-DATE TO WRK-RTE-YR-END-DATE         DTSBD720
00569      ELSE                                                         DTSBD720
00570          MOVE 'INVALID MHDR-LAST-RATE-YRQ ENCOUNTERED'            DTSBD720
00571            TO ABEND-MSG                                           DTSBD720
00572          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD720
00573  I1100-EXIT.                                                      DTSBD720
00574      EXIT.                                                        DTSBD720
00575      SKIP3                                                        DTSBD720
00576  I1200-EDIT-START-YRQ.                                            DTSBD720
00577      MOVE PARM-RTE-YR-START-YRQ-X TO L004-QTR-3.                  DTSBD720
00578                                                                   DTSBD720
00579      PERFORM S004-FROM-3 THRU S004-EXIT.                          DTSBD720
00580                                                                   DTSBD720
00581      IF L004-INVALID-QTR                                          DTSBD720
00582          MOVE 'INVALID PARM-RTE-YR-START-YRQ-X ENCOUNTERED'       DTSBD720
00583            TO ABEND-MSG                                           DTSBD720
00584          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD720
00585                                                                   DTSBD720
00586      MOVE L004-QTR-5-9 TO L006-YRQ.                               DTSBD720
00587                                                                   DTSBD720
00588      PERFORM S006-FROM-QTR THRU S006-EXIT.                        DTSBD720
00589                                                                   DTSBD720
00590      IF L004-QTR-5-9 = L006-RTE-YR-START-YRQ                      DTSBD720
00591          MOVE L006-RTE-YR-START-YRQ TO WRK-RTE-YR-START-YRQ       DTSBD720
00592          MOVE L006-RTE-YR-END-YRQ TO WRK-RTE-YR-END-YRQ           DTSBD720
00593          MOVE L006-RTE-YR-START-DATE TO WRK-RTE-YR-START-DATE     DTSBD720
00594          MOVE L006-RTE-YR-END-DATE TO WRK-RTE-YR-END-DATE         DTSBD720
00595      ELSE                                                         DTSBD720
00596          MOVE 'PARM-RTE-YR-START-YRQ NOT FIRST QTR IN RATE YEAR'  DTSBD720
00597            TO ABEND-MSG                                           DTSBD720
00598          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD720
00599  I1200-EXIT.                                                      DTSBD720
00600      EXIT.                                                        DTSBD720
00601      SKIP3                                                        DTSBD720
00602  I2000-FIND-RATE-PERIOD.                                          DTSBD720
00603      MOVE WRK-RTE-YR-START-YRQ TO L055-EFF-YRQ.                   DTSBD720
00604                                                                   DTSBD720
00605      PERFORM S055-FROM-QTR THRU S055-EXIT.                        DTSBD720
00606                                                                   DTSBD720
00607      MOVE LOW-VALUES TO FUIR-KEY-AREA.                            DTSBD720
00608                                                                   DTSBD720
00609      SET FUIR-UIR-88 TO TRUE.                                     DTSBD720
00610                                                                   DTSBD720
00611      MOVE WRK-RTE-YR-START-YRQ TO FUIR-EFF-YRQ.                   DTSBD720
00612                                                                   DTSBD720
00613      MOVE FUIR-KEY-AREA TO FSKL-KEY-AREA.                         DTSBD720
00614                                                                   DTSBD720
00615      PERFORM S931-READ THRU S931-EXIT.                            DTSBD720
00616                                                                   DTSBD720
00617      IF L931-NO-REC-88                                            DTSBD720
00618          MOVE 'FUIR RECORD NOT FOUND'                             DTSBD720
00619            TO ABEND-MSG                                           DTSBD720
00620          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD720
00621                                                                   DTSBD720
00622      MOVE FSKL-REC TO FUIR-REC.                                   DTSBD720
00623                                                                   DTSBD720
00624      IF FUIR-RATE-CUTOFF-DATE = ZERO                              DTSBD720
00625          MOVE 'FUIR-RATE-CUTOFF-DATE EQUAL TO ZERO ENCOUNTERED'   DTSBD720
00626            TO ABEND-MSG                                           DTSBD720
00627          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD720
00628                                                                   DTSBD720
00629      MOVE FUIR-RATE-CUTOFF-DATE TO WRK-EXP-CUTOFF-DATE.           DTSBD720
00630                                                                   DTSBD720
00631      MOVE WRK-RTE-YR-START-YRQ     TO L004-QTR-5-9.               DTSBD720
00632      SUBTRACT 1                    FROM L004-QTR-5-YR.            DTSBD720
00633      PERFORM S004-FROM-5           THRU S004-EXIT.                DTSBD720
00634      MOVE L004-QTR-5-9             TO WRK-PRIOR-RTE-YEAR-YRQ.     DTSBD720
00635      DISPLAY 'PRIOR RATE YR ' WRK-PRIOR-RTE-YEAR-YRQ.             DTSBD720
00636                                                                   DTSBD720
00637  I2000-EXIT.                                                      DTSBD720
00638      EXIT.                                                        DTSBD720
00639      SKIP3                                                        DTSBD720
00640  I3000-INITIALIZE-REC-CNTS.                                       DTSBD720
00641      MOVE +0 TO RCT-REC-DELETE-CNT                                DTSBD720
00642                 RRA-REC-WRITE-CNT.                                DTSBD720
00643 *&                                                                DTSBD720
00644 ***             WRK-MPRF-CNT.                                     DTSBD720
00645 *&                                                                DTSBD720
00646  I3000-EXIT.                                                      DTSBD720
00647      EXIT.                                                        DTSBD720
00648                                                                   DTSBD720
00649  I4000-INITIALIZE-REL-TBL.                                        DTSBD720
00650      MOVE +0            TO RT-LAST.                               DTSBD720
00651                                                                   DTSBD720
00652      PERFORM                                                      DTSBD720
00653        VARYING RSUB FROM +1 BY +1                                 DTSBD720
00654        UNTIL RSUB > RT-MAX                                        DTSBD720
00655          MOVE +0        TO RT-EFF-DATE (RSUB)                     DTSBD720
00656                            RT-PRED (RSUB)                         DTSBD720
00657                            RT-SUCC (RSUB)                         DTSBD720
00658                            RT-PERCENT (RSUB)                      DTSBD720
00659      END-PERFORM.                                                 DTSBD720
00660                                                                   DTSBD720
00661      MOVE ZERO           TO TOT-XFER-PRIOR-RESERVE                DTSBD720
00662                             TOT-XFER-UI-TAX-AMT.                  DTSBD720
00663 **                          TOT-XFER-BENEFITS-AMT.                DTSBD720
00664                                                                   DTSBD720
00665      PERFORM                                                      DTSBD720
00666        VARYING XW-SUB FROM +1 BY +1                               DTSBD720
00667        UNTIL XW-SUB > +3                                          DTSBD720
00668           MOVE ZERO      TO TOT-XFER-TOT-WAGE (XW-SUB)            DTSBD720
00669                             TOT-XFER-TAX-WAGE (XW-SUB)            DTSBD720
00670      END-PERFORM.                                                 DTSBD720
00671  I4000-EXIT.                                                      DTSBD720
00672      EXIT.                                                        DTSBD720
00673                                                                   DTSBD720
00674  P0000-PROCESS.                                                   DTSBD720
00675      READ RELATIONSHIP-FILE.                                      DTSBD720
00676                                                                   DTSBD720
00677      IF REL-FILE-EOF-88                                           DTSBD720
00678         PERFORM P0200-PROCESS-TABLE               THRU P0200-EXIT DTSBD720
00679         GO TO P0000-EXIT                                          DTSBD720
00680      ELSE                                                         DTSBD720
00681         PERFORM                                                   DTSBD720
00682          UNTIL REL-FILE-EOF-88                                    DTSBD720
00683          OR    WRK-ERROR-YES-88                                   DTSBD720
00684            IF REL-EFF-DT   = WRK-CURR-EFF-DT                      DTSBD720
00685            AND REL-PRED    = WRK-CURR-PRED                        DTSBD720
00686               PERFORM P0100-ADD-TO-TABLE          THRU P0100-EXIT DTSBD720
00687            ELSE                                                   DTSBD720
00688               PERFORM P0200-PROCESS-TABLE         THRU P0200-EXIT DTSBD720
00689            END-IF                                                 DTSBD720
00690            READ RELATIONSHIP-FILE                                 DTSBD720
00691         END-PERFORM                                               DTSBD720
00692      END-IF.                                                      DTSBD720
00693                                                                   DTSBD720
00694      IF RT-LAST > +0                                              DTSBD720
00695         PERFORM P0200-PROCESS-TABLE         THRU P0200-EXIT       DTSBD720
00696      END-IF.                                                      DTSBD720
00697                                                                   DTSBD720
00698  P0000-EXIT.                                                      DTSBD720
00699      EXIT.                                                        DTSBD720
00700                                                                   DTSBD720
00701  P0100-ADD-TO-TABLE.                                              DTSBD720
00702      ADD +1                           TO RT-LAST.                 DTSBD720
00703      MOVE REL-REC                     TO REL-TABLE (RT-LAST).     DTSBD720
00704                                                                   DTSBD720
00705  P0100-EXIT.                                                      DTSBD720
00706      EXIT.                                                        DTSBD720
00707                                                                   DTSBD720
00708  P0200-PROCESS-TABLE.                                             DTSBD720
00709      PERFORM                                                      DTSBD720
00710        VARYING RSUB FROM +1 BY +1                                 DTSBD720
00711        UNTIL RSUB > RT-LAST                                       DTSBD720
00712           MOVE RT-SUCC (RSUB)             TO WRK-CURR-SUCC        DTSBD720
00713           MOVE RT-PERCENT (RSUB)          TO WRK-CURR-PCT         DTSBD720
00714           PERFORM P1000-CHK-EMPLOYERS     THRU P1000-EXIT         DTSBD720
00715           IF WRK-TRANSFER-YES-88                                  DTSBD720
00716              PERFORM P2000-TRANSFER-EXP   THRU P2000-EXIT         DTSBD720
00717           ELSE                                                    DTSBD720
00718              PERFORM P4000-LIABILITY-DT   THRU P4000-EXIT         DTSBD720
00719           END-IF                                                  DTSBD720
00720      END-PERFORM.                                                 DTSBD720
00721                                                                   DTSBD720
00722      IF WRK-TRANSFER-YES-88                                       DTSBD720
00723         PERFORM P3000-UPD-PRED-MRCT       THRU P3000-EXIT         DTSBD720
00724      END-IF.                                                      DTSBD720
00725                                                                   DTSBD720
00726      PERFORM I4000-INITIALIZE-REL-TBL     THRU I4000-EXIT.        DTSBD720
00727      MOVE REL-EFF-DT                      TO WRK-CURR-EFF-DT.     DTSBD720
00728      MOVE REL-PRED                        TO WRK-CURR-PRED.       DTSBD720
00729      ADD +1                               TO RT-LAST.             DTSBD720
00730      MOVE REL-REC                         TO REL-TABLE (RT-LAST). DTSBD720
00731      MOVE WRK-ALL-NINES-DATE       TO WRK-PRED-EARLIEST-LIAB-DATE.DTSBD720
00732      MOVE +0                       TO WRK-SUC-PRIOR-EARLIEST-LIAB.   CL**6
00733                                                                   DTSBD720
00734  P0200-EXIT.                                                      DTSBD720
00735      EXIT.                                                        DTSBD720
00736                                                                   DTSBD720
00737  P1000-CHK-EMPLOYERS.                                             DTSBD720
00738      SET WRK-TRANSFER-YES-88    TO TRUE.                          DTSBD720
00739      MOVE ZERO                  TO XFER-PRIOR-RESERVE             DTSBD720
00740                                    XFER-UI-TAX-AMT.               DTSBD720
00741 **                                 XFER-BENEFITS-AMT.             DTSBD720
00742                                                                   DTSBD720
00743      PERFORM                                                      DTSBD720
00744        VARYING XW-SUB FROM +1 BY +1                               DTSBD720
00745        UNTIL XW-SUB > +3                                          DTSBD720
00746           MOVE ZERO             TO XFER-TOT-WAGE (XW-SUB)         DTSBD720
00747                                    XFER-TAX-WAGE (XW-SUB)         DTSBD720
00748      END-PERFORM.                                                 DTSBD720
00749                                                                   DTSBD720
00750      PERFORM P1100-CHK-PREV-TRANSFER       THRU P1100-EXIT           CL**7
00751      PERFORM P1200-CHK-SUCCESSOR           THRU P1200-EXIT           CL**7
00752 *    IF WRK-TRANSFER-YES-88                                          CL*11
00753         PERFORM P1300-CHK-PREDECESSOR      THRU P1300-EXIT.          CL*11
00754 *    END-IF.                                                         CL*11
00755                                                                      CL**7
00756 *& 2203                                                              CL**7
00757 *    PERFORM P1100-CHK-PREV-TRANSFER       THRU P1100-EXIT           CL**7
00758 *    IF WRK-TRANSFER-YES-88                                          CL**7
00759 *       PERFORM P1200-CHK-SUCCESSOR        THRU P1200-EXIT           CL**7
00760 *       IF WRK-TRANSFER-YES-88                                       CL**7
00761 *          PERFORM P1300-CHK-PREDECESSOR   THRU P1300-EXIT           CL**7
00762 *       END-IF                                                       CL**7
00763 *    END-IF.                                                         CL**7
00764 *&                                                                   CL**7
00765                                                                   DTSBD720
00766  P1000-EXIT.                                                      DTSBD720
00767      EXIT.                                                        DTSBD720
00768                                                                   DTSBD720
00769  P1100-CHK-PREV-TRANSFER.                                         DTSBD720
00770 **************************************************************    DTSBD720
00771 *  CHECK WHETHER THE RELATIONSHIP HAS ALREADY BEEN PROCESSED.     DTSBD720
00772 *  IF RELATIONSHIP WAS ESTABLISHED PRIOR TO 1/23/2007             DTSBD720
00773 *  THE EXPERIENCE HAS ALREADY BEEN TRANSFERRED - BEFORE           DTSBD720
00774 *  THE IMPLEMENTATION OF PARTILAL EXPERIENCE TRANSFERS.           DTSBD720
00775 *                                                                 DTSBD720
00776 *  IF THERE IS A MATCHING MRRA REC, THE EXPERIENCE HAS            DTSBD720
00777 *  ALREADY BEEN TRANSFERRED.                                      DTSBD720
00778 **************************************************************    DTSBD720
00779      PERFORM P1110-MREL               THRU P1110-EXIT.            DTSBD720
00780      IF WRK-TRANSFER-YES-88                                       DTSBD720
00781         PERFORM P1120-MRRA            THRU P1120-EXIT             DTSBD720
00782      END-IF.                                                      DTSBD720
00783                                                                   DTSBD720
00784  P1100-EXIT.                                                      DTSBD720
00785      EXIT.                                                        DTSBD720
00786                                                                   DTSBD720
00787  P1110-MREL.                                                      DTSBD720
00788      MOVE LOW-VALUES                    TO MREL-KEY-AREA.         DTSBD720
00789      MOVE WRK-CURR-SUCC                 TO MREL-EMP-NO.           DTSBD720
00790      SET MREL-REL-88                    TO TRUE.                  DTSBD720
00791      MOVE WRK-CURR-EFF-DT               TO MREL-EFF-DATE.         DTSBD720
00792      MOVE WRK-CURR-PRED                 TO MREL-PRED-EMP-NO.      DTSBD720
00793                                                                   DTSBD720
00794      MOVE MREL-KEY-AREA                 TO MSKL-KEY-AREA.         DTSBD720
00795                                                                   DTSBD720
00796      PERFORM S910-READ                  THRU S910-EXIT.           DTSBD720
00797      IF L910-OK-88                                                DTSBD720
00798         MOVE MSKL-REC                   TO MREL-REC               DTSBD720
00799         IF MREL-ESTB-DATE <= 20070123                             DTSBD720
00800            SET WRK-TRANSFER-NO-88       TO TRUE                   DTSBD720
00801            DISPLAY 'P1110 - EXP ALREADY TRANSFERD: ' MREL-EMP-NO     CL*21
00802         END-IF                                                    DTSBD720
00803      ELSE                                                         DTSBD720
00804         DISPLAY 'CANNOT FIND MREL ' MREL-EMP-NO                   DTSBD720
00805           '  ' MREL-EFF-DATE '  ' MREL-PRED-EMP-NO                DTSBD720
00806         SET WRK-TRANSFER-NO-88       TO TRUE                      DTSBD720
00807      END-IF.                                                      DTSBD720
00808                                                                   DTSBD720
00809  P1110-EXIT.                                                      DTSBD720
00810      EXIT.                                                        DTSBD720
00811                                                                   DTSBD720
00812  P1120-MRRA.                                                      DTSBD720
00813 *& CHANGE FOR 2010 ONLY ***                                       DTSBD720
00814 *    IF MREL-ESTB-DATE    > 20081211                              DTSBD720
00815 *       GO TO P1120-EXIT                                          DTSBD720
00816 *    END-IF.                                                      DTSBD720
00817 *& CHANGE FOR 2010 ONLY ***                                       DTSBD720
00818                                                                   DTSBD720
00819      MOVE LOW-VALUES                  TO MRRA-KEY-AREA.           DTSBD720
00820      MOVE WRK-CURR-PRED               TO MRRA-EMP-NO.             DTSBD720
00821      SET MRRA-RRA-88                  TO TRUE.                    DTSBD720
00822      MOVE MRRA-KEY-AREA               TO MSKL-KEY-AREA.           DTSBD720
00823      PERFORM S910-START-BROWSE        THRU S910-EXIT.             DTSBD720
00824      IF L910-OK-88                                                DTSBD720
00825         PERFORM UNTIL L910-NO-REC-88                              DTSBD720
00826            MOVE MSKL-REC              TO MRRA-REC                 DTSBD720
00827            IF MRRA-REL-EFF-DATE = WRK-CURR-EFF-DT                 DTSBD720
00828            AND MRRA-SUCC-EMP-NO = WRK-CURR-SUCC                   DTSBD720
00829               SET WRK-TRANSFER-NO-88  TO TRUE                     DTSBD720
00830               DISPLAY 'P1120 ALREADY TRANSFERRED '                   CL*18
00831                  WRK-CURR-PRED '  ' WRK-CURR-EFF-DT               DTSBD720
00832                  '  ' WRK-CURR-SUCC                               DTSBD720
00833            END-IF                                                 DTSBD720
00834            PERFORM S910-READ-NEXT     THRU S910-EXIT              DTSBD720
00835         END-PERFORM                                               DTSBD720
00836      END-IF.                                                      DTSBD720
00837                                                                   DTSBD720
00838  P1120-EXIT.                                                      DTSBD720
00839      EXIT.                                                        DTSBD720
00840                                                                   DTSBD720
00841  P1200-CHK-SUCCESSOR.                                             DTSBD720
00842      MOVE LOW-VALUES                    TO MPRF-KEY-AREA.         DTSBD720
00843      MOVE WRK-CURR-SUCC                 TO MPRF-EMP-NO.           DTSBD720
00844      SET MPRF-PRF-88 TO TRUE.                                     DTSBD720
00845      MOVE MPRF-KEY-AREA                 TO MSKL-KEY-AREA.         DTSBD720
00846                                                                   DTSBD720
00847      PERFORM S910-READ                  THRU S910-EXIT.           DTSBD720
00848      IF L910-OK-88                                                DTSBD720
00849         MOVE MSKL-REC                   TO MPRF-REC               DTSBD720
00850         IF NOT MPRF-CLASS-RATED-88                                DTSBD720
00851            SET WRK-TRANSFER-NO-88       TO TRUE                   DTSBD720
00852            MOVE MSG06-MSG-IDENTIFIER    TO R507-MSG-IDENTIFIER    DTSBD720
00853            MOVE WRK-CURR-SUCC           TO R507-SUCC-EMP-NO       DTSBD720
00854            MOVE WRK-CURR-PRED           TO R507-PRED-EMP-NO       DTSBD720
00855            MOVE MSG06-MSG-TEXT          TO R507-MSG-TEXT          DTSBD720
00856            PERFORM S1000-COMPLETE-R507  THRU S1000-EXIT           DTSBD720
00857            GO TO P1200-EXIT                                       DTSBD720
00858         END-IF                                                    DTSBD720
00859      ELSE                                                         DTSBD720
00860         SET WRK-TRANSFER-NO-88          TO TRUE                   DTSBD720
00861         MOVE MSG01-MSG-IDENTIFIER       TO R507-MSG-IDENTIFIER    DTSBD720
00862         MOVE WRK-CURR-SUCC              TO R507-SUCC-EMP-NO       DTSBD720
00863         MOVE WRK-CURR-PRED              TO R507-PRED-EMP-NO       DTSBD720
00864         MOVE MSG01-MSG-TEXT             TO R507-MSG-TEXT          DTSBD720
00865         PERFORM S1000-COMPLETE-R507     THRU S1000-EXIT           DTSBD720
00866         GO TO P1200-EXIT                                          DTSBD720
00867      END-IF.                                                      DTSBD720
00868                                                                   DTSBD720
00869 ********************************************************          DTSBD720
00870 * CHECK SUCCESSOR MRCT                                            DTSBD720
00871 ********************************************************          DTSBD720
00872      MOVE LOW-VALUES                 TO MRCT-KEY-AREA.            DTSBD720
00873      MOVE WRK-CURR-SUCC              TO MRCT-EMP-NO.              DTSBD720
00874      SET MRCT-RCT-88 TO TRUE.                                     DTSBD720
00875      MOVE WRK-RTE-YR-START-YRQ       TO MRCT-EFF-YRQ.             DTSBD720
00876      MOVE MRCT-KEY-AREA              TO MSKL-KEY-AREA.            DTSBD720
00877                                                                   DTSBD720
00878      PERFORM S910-READ               THRU S910-EXIT.              DTSBD720
00879      IF L910-OK-88                                                DTSBD720
00880         NEXT SENTENCE                                             DTSBD720
00881      ELSE                                                         DTSBD720
00882         DISPLAY 'P1200 SUCC -NO MRCT ' WRK-CURR-SUCC                 CL*22
00883         SET WRK-TRANSFER-NO-88    TO TRUE                            CL**9
00884         MOVE MSG01-MSG-IDENTIFIER    TO R507-MSG-IDENTIFIER       DTSBD720
00885         MOVE WRK-CURR-SUCC           TO R507-SUCC-EMP-NO          DTSBD720
00886         MOVE WRK-CURR-PRED           TO R507-PRED-EMP-NO          DTSBD720
00887         MOVE MSG01-MSG-TEXT          TO R507-MSG-TEXT             DTSBD720
00888         PERFORM S1000-COMPLETE-R507  THRU S1000-EXIT              DTSBD720
00889         GO TO P1200-EXIT                                          DTSBD720
00890      END-IF.                                                      DTSBD720
00891                                                                   DTSBD720
00892 ********************************************************          DTSBD720
00893 *  CHECK PRIOR RATE YEAR SUCCESSOR MRCT                           DTSBD720
00894 *  DO NOT TRANSFER IF PRIOR YEAR MRCT WAS UPDATED MANUALLY.       DTSBD720
00895 ********************************************************          DTSBD720
00896      MOVE LOW-VALUES                 TO MRCT-KEY-AREA.            DTSBD720
00897      MOVE WRK-CURR-SUCC              TO MRCT-EMP-NO.              DTSBD720
00898      SET MRCT-RCT-88 TO TRUE.                                     DTSBD720
00899      MOVE WRK-PRIOR-RTE-YEAR-YRQ     TO MRCT-EFF-YRQ.             DTSBD720
00900      MOVE MRCT-KEY-AREA              TO MSKL-KEY-AREA.            DTSBD720
00901                                                                   DTSBD720
00902      PERFORM S910-READ               THRU S910-EXIT.              DTSBD720
00903      IF L910-OK-88                                                DTSBD720
00904         MOVE MSKL-REC                TO MRCT-REC                  DTSBD720
00905 *& 2203                                                              CL**2
00906         MOVE MRCT-EARLIEST-LIAB-DATE TO                              CL**2
00907            WRK-SUC-PRIOR-EARLIEST-LIAB                               CL**2
00908 *&                                                                   CL**2
00909         DISPLAY 'P1200 SUCC PRIOR EARLIEST LIAB DATE: '              CL*10
00910               WRK-CURR-SUCC '  ' WRK-SUC-PRIOR-EARLIEST-LIAB         CL*10
00911               '  ' WRK-CURR-PRED                                     CL*19
00912 *             '  ' MRCT-ESTB-DATE '  ' MRCT-CHNG-DATE                CL*18
00913 *&                                                                   CL*10
00914         IF MRCT-CHNG-DATE > MRCT-ESTB-DATE                        DTSBD720
00915            PERFORM P1210-BYPASS      THRU P1210-EXIT              DTSBD720
00916            SET WRK-TRANSFER-NO-88    TO TRUE                      DTSBD720
00917            DISPLAY 'P1200 SUCC -ALREADY TRANSFERRED '                CL*22
00918               WRK-CURR-SUCC '  ' WRK-CURR-EFF-DT                     CL*22
00919               '  ' WRK-CURR-PRED                                     CL*22
00920               '  ' MRCT-ESTB-DATE '  ' MRCT-CHNG-DATE             DTSBD720
00921         ELSE                                                      DTSBD720
00922            IF NOT MRCT-CHNG-SYSTEM-88                             DTSBD720
00923               PERFORM P1210-BYPASS      THRU P1210-EXIT           DTSBD720
00924               SET WRK-TRANSFER-NO-88    TO TRUE                   DTSBD720
00925               DISPLAY 'P1200 SUCC -CREATED BY STAFF '                CL*22
00926                  WRK-CURR-SUCC '  ' WRK-CURR-EFF-DT                  CL*22
00927                  '  ' WRK-CURR-PRED                                  CL*22
00928                  '  ' MRCT-ESTB-DATE '  ' MRCT-CHNG-DATE          DTSBD720
00929                  '  ' MRCT-CHNG-OP-ID                             DTSBD720
00930            END-IF                                                 DTSBD720
00931          END-IF                                                      CL*19
00932         ELSE                                                         CL*20
00933         DISPLAY 'P1200 SUCC PRIOR NOT FOUND ;;;;;;;;: '              CL*20
00934               WRK-CURR-SUCC '  '                                     CL*20
00935         END-IF.                                                      CL*19
00936                                                                   DTSBD720
00937  P1200-EXIT.                                                      DTSBD720
00938      EXIT.                                                        DTSBD720
00939                                                                   DTSBD720
00940  P1210-BYPASS.                                                    DTSBD720
00941      SET WRK-TRANSFER-NO-88  TO TRUE                              DTSBD720
00942                                                                   DTSBD720
00943      DISPLAY 'P1200 TRANSFERRED MANUALLY '                        DTSBD720
00944         WRK-CURR-SUCC '  ' WRK-CURR-PRED                             CL*22
00945          '  ' WRK-CURR-EFF-DT.                                    DTSBD720
00946                                                                   DTSBD720
00947      MOVE WRK-CURR-PRED               TO BYPASS-PRED.             DTSBD720
00948      MOVE WRK-CURR-SUCC               TO BYPASS-SUCC.             DTSBD720
00949                                                                   DTSBD720
00950      MOVE WRK-CURR-EFF-DT             TO L001-FED-8-DATE-9.       DTSBD720
00951      PERFORM S001-FROM-FED-8          THRU S001-EXIT.             DTSBD720
00952      MOVE L001-SLASH-8-DATE           TO BYPASS-EFF-DT.           DTSBD720
00953                                                                   DTSBD720
00954      MOVE MRCT-ESTB-DATE              TO L001-FED-8-DATE-9.       DTSBD720
00955      PERFORM S001-FROM-FED-8          THRU S001-EXIT.             DTSBD720
00956      MOVE L001-SLASH-8-DATE           TO BYPASS-MRCT-ESTB.        DTSBD720
00957                                                                   DTSBD720
00958      MOVE MRCT-CHNG-DATE              TO L001-FED-8-DATE-9.       DTSBD720
00959      PERFORM S001-FROM-FED-8          THRU S001-EXIT.             DTSBD720
00960      MOVE L001-SLASH-8-DATE           TO BYPASS-MRCT-CHNG.        DTSBD720
00961                                                                   DTSBD720
00962      WRITE BYPASS-REC                 FROM WRK-BYPASS-REC.        DTSBD720
00963      IF NOT BYPASS-FILE-OK-88                                     DTSBD720
00964         DISPLAY 'CANNOT WRITE BYPASS REC ' BYPASS-STATUS          DTSBD720
00965      END-IF.                                                      DTSBD720
00966                                                                   DTSBD720
00967  P1210-EXIT.                                                      DTSBD720
00968      EXIT.                                                        DTSBD720
00969                                                                   DTSBD720
00970  P1300-CHK-PREDECESSOR.                                           DTSBD720
00971 ********************************************************          DTSBD720
00972 * CHECK PREDECESSOR MPRF                                          DTSBD720
00973 ********************************************************          DTSBD720
00974      MOVE LOW-VALUES                    TO MPRF-KEY-AREA.         DTSBD720
00975      MOVE WRK-CURR-PRED                 TO MPRF-EMP-NO.           DTSBD720
00976      SET MPRF-PRF-88 TO TRUE.                                     DTSBD720
00977      MOVE MPRF-KEY-AREA                 TO MSKL-KEY-AREA.         DTSBD720
00978                                                                   DTSBD720
00979      PERFORM S910-READ                  THRU S910-EXIT.           DTSBD720
00980      IF L910-OK-88                                                DTSBD720
00981         MOVE MSKL-REC                   TO MPRF-REC               DTSBD720
00982      ELSE                                                         DTSBD720
00983         IF WRK-TRANSFER-YES-88                                    DTSBD720
00984            SET WRK-TRANSFER-NO-88       TO TRUE                   DTSBD720
00985            MOVE MSG02-MSG-IDENTIFIER    TO R507-MSG-IDENTIFIER    DTSBD720
00986            MOVE WRK-CURR-SUCC           TO R507-SUCC-EMP-NO       DTSBD720
00987            MOVE WRK-CURR-PRED           TO R507-PRED-EMP-NO       DTSBD720
00988            MOVE MSG02-MSG-TEXT          TO R507-MSG-TEXT          DTSBD720
00989            PERFORM S1000-COMPLETE-R507  THRU S1000-EXIT           DTSBD720
00990            GO TO P1300-EXIT                                       DTSBD720
00991         END-IF                                                    DTSBD720
00992      END-IF.                                                      DTSBD720
00993                                                                   DTSBD720
00994 ********************************************************          DTSBD720
00995 * GET PREDECESSOR MRCT                                            DTSBD720
00996 ********************************************************          DTSBD720
00997      MOVE LOW-VALUES                 TO MRCT-KEY-AREA.            DTSBD720
00998      MOVE WRK-CURR-PRED              TO MRCT-EMP-NO.              DTSBD720
00999      SET MRCT-RCT-88 TO TRUE.                                     DTSBD720
01000      MOVE WRK-RTE-YR-START-YRQ       TO MRCT-EFF-YRQ.             DTSBD720
01001      MOVE MRCT-KEY-AREA              TO MSKL-KEY-AREA.            DTSBD720
01002                                                                   DTSBD720
01003      PERFORM S910-READ               THRU S910-EXIT.              DTSBD720
01004      IF L910-OK-88                                                DTSBD720
01005         MOVE MSKL-REC                TO MRCT-REC                  DTSBD720
01006         DISPLAY 'P1301 PRED MRCT EARLIEST LIAB DATE: '               CL*22
01007               WRK-CURR-PRED ' MRCT  ' MRCT-EARLIEST-LIAB-DATE        CL*22
01008                             ' WORK  ' WRK-PRED-EARLIEST-LIAB-DATE    CL*22
01009         IF MRCT-EARLIEST-LIAB-DATE <                              DTSBD720
01010            WRK-PRED-EARLIEST-LIAB-DATE                            DTSBD720
01011              MOVE MRCT-EARLIEST-LIAB-DATE TO                      DTSBD720
01012                WRK-PRED-EARLIEST-LIAB-DATE                        DTSBD720
01013         END-IF                                                    DTSBD720
01014      ELSE                                                         DTSBD720
01015         IF WRK-TRANSFER-YES-88                                    DTSBD720
01016            SET WRK-TRANSFER-NO-88       TO TRUE                   DTSBD720
01017            MOVE MSG02-MSG-IDENTIFIER    TO R507-MSG-IDENTIFIER    DTSBD720
01018            MOVE WRK-CURR-SUCC           TO R507-SUCC-EMP-NO       DTSBD720
01019            MOVE WRK-CURR-PRED           TO R507-PRED-EMP-NO       DTSBD720
01020            MOVE MSG02-MSG-TEXT          TO R507-MSG-TEXT          DTSBD720
01021            PERFORM S1000-COMPLETE-R507  THRU S1000-EXIT           DTSBD720
01022         END-IF                                                    DTSBD720
01023      END-IF.                                                      DTSBD720
01024                                                                      CL*17
01025         DISPLAY 'P1302 PRED EARLIEST LIAB DATE: '                    CL*22
01026               WRK-CURR-PRED '  ' WRK-PRED-EARLIEST-LIAB-DATE         CL*17
01027               '  ' WRK-CURR-SUCC                                     CL*17
01028               '  ' MRCT-ESTB-DATE '  ' MRCT-CHNG-DATE.               CL*17
01029 *&                                                                   CL*17
01030                                                                   DTSBD720
01031  P1300-EXIT.                                                      DTSBD720
01032      EXIT.                                                        DTSBD720
01033                                                                   DTSBD720
01034  P2000-TRANSFER-EXP.                                              DTSBD720
01035      SET WRK-DATA-TO-TRANSFER-YES-88 TO TRUE.                     DTSBD720
01036      PERFORM P2100-GET-AMOUNTS       THRU P2100-EXIT.             DTSBD720
01037      IF WRK-DATA-TO-TRANSFER-YES-88                               DTSBD720
01038         PERFORM P2200-UPD-PRED       THRU P2200-EXIT              DTSBD720
01039         PERFORM P2300-UPD-SUCC       THRU P2300-EXIT              DTSBD720
01040         PERFORM P2500-WRITE-R506     THRU P2500-EXIT              DTSBD720
01041      ELSE                                                            CL**9
01042         PERFORM P5000-UPD-SUCC-ELD   THRU P5000-EXIT                 CL**9
01043         DISPLAY 'P2000 NOTHING TO TRANSFER PRED '                    CL**9
01044         WRK-CURR-PRED 'SUCC ' WRK-CURR-SUCC                          CL**9
01045          '  ' WRK-CURR-EFF-DT                                        CL**9
01046                                                                      CL**9
01047      END-IF.                                                      DTSBD720
01048                                                                   DTSBD720
01049  P2000-EXIT.                                                      DTSBD720
01050      EXIT.                                                        DTSBD720
01051                                                                   DTSBD720
01052  P2100-GET-AMOUNTS.                                               DTSBD720
01053 *    MOVE ZERO                  TO XFER-PRIOR-RESERVE             DTSBD720
01054 *                                  XFER-UI-TAX-AMT.               DTSBD720
01055 **                                 XFER-BENEFITS-AMT.             DTSBD720
01056 *                                                                 DTSBD720
01057 *    PERFORM                                                      DTSBD720
01058 *      VARYING XW-SUB FROM +1 BY +1                               DTSBD720
01059 *      UNTIL XW-SUB > +3                                          DTSBD720
01060 *         MOVE ZERO             TO XFER-TOT-WAGE (XW-SUB)         DTSBD720
01061 *                                  XFER-TAX-WAGE (XW-SUB)         DTSBD720
01062 *    END-PERFORM.                                                 DTSBD720
01063                                                                   DTSBD720
01064 **   MOVE WRK-CURR-PRED              TO WRK-CHG-EMP.              DTSBD720
01065 *    SET WRK-TYPE-PRED-88            TO TRUE.                     DTSBD720
01066 *    MOVE WRK-CURR-EFF-DT            TO WRK-REL-EFF-DT.           DTSBD720
01067 *    PERFORM S2000-BENEFIT-CHARGE    THRU S2000-EXIT.             DTSBD720
01068 **   MOVE WRK-BENEFIT-CHARGE         TO XFER-BENEFITS-AMT.        DTSBD720
01069                                                                   DTSBD720
01070      COMPUTE XFER-PRIOR-RESERVE ROUNDED =                         DTSBD720
01071         (MRCT-PRIOR-RESERVE-AMT * WRK-CURR-PCT).                  DTSBD720
01072      COMPUTE XFER-UI-TAX-AMT ROUNDED =                            DTSBD720
01073         (MRCT-UI-TAX-PAID-AMT * WRK-CURR-PCT).                    DTSBD720
01074 **   COMPUTE XFER-BENEFITS-AMT ROUNDED =                          DTSBD720
01075 **      (MRCT-BENEFITS-CHARGED-AMT * WRK-CURR-PCT).               DTSBD720
01076                                                                   DTSBD720
01077 **   IF MRCT-EMP-NO = 025207 OR 813049                            DTSBD720
01078 *       DISPLAY 'P2100 ' MRCT-EMP-NO                              DTSBD720
01079 *          '  ' XFER-BENEFITS-AMT '  ' WRK-CURR-PCT               DTSBD720
01080 *          '  ' MRCT-BENEFITS-CHARGED-AMT                         DTSBD720
01081 **   END-IF.                                                      DTSBD720
01082                                                                   DTSBD720
01083      PERFORM                                                      DTSBD720
01084        VARYING MRCT-WAGES-IDX FROM 1 BY 1                         DTSBD720
01085        UNTIL MRCT-WAGES-IDX > MMAX-RCT-EXP-MAX                    DTSBD720
01086           SET XW-SUB        TO MRCT-WAGES-IDX                     DTSBD720
01087           COMPUTE XFER-TOT-WAGE (XW-SUB) =                        DTSBD720
01088              (MRCT-TOT-WAGE (MRCT-WAGES-IDX) * WRK-CURR-PCT)      DTSBD720
01089           COMPUTE XFER-TAX-WAGE (XW-SUB) =                        DTSBD720
01090              (MRCT-TAX-WAGE (MRCT-WAGES-IDX) * WRK-CURR-PCT)      DTSBD720
01091      END-PERFORM.                                                 DTSBD720
01092                                                                   DTSBD720
01093      IF XFER-PRIOR-RESERVE     = ZERO                             DTSBD720
01094      AND XFER-UI-TAX-AMT       = ZERO                             DTSBD720
01095 **   AND XFER-BENEFITS-AMT     = ZERO                             DTSBD720
01096      AND XFER-TOT-WAGE (1)     = ZERO                             DTSBD720
01097      AND XFER-TOT-WAGE (2)     = ZERO                             DTSBD720
01098      AND XFER-TOT-WAGE (3)     = ZERO                             DTSBD720
01099         SET WRK-DATA-TO-TRANSFER-NO-88 TO TRUE                    DTSBD720
01100         SET WRK-TRANSFER-NO-88       TO TRUE                         CL*13
01101      ELSE                                                         DTSBD720
01102         ADD XFER-UI-TAX-AMT     TO TOT-XFER-UI-TAX-AMT            DTSBD720
01103 **      ADD XFER-BENEFITS-AMT   TO TOT-XFER-BENEFITS-AMT          DTSBD720
01104         ADD XFER-TOT-WAGE (1)   TO TOT-XFER-TOT-WAGE (1)          DTSBD720
01105         ADD XFER-TOT-WAGE (2)   TO TOT-XFER-TOT-WAGE (2)          DTSBD720
01106         ADD XFER-TOT-WAGE (3)   TO TOT-XFER-TOT-WAGE (3)          DTSBD720
01107         ADD XFER-TAX-WAGE (1)   TO TOT-XFER-TAX-WAGE (1)          DTSBD720
01108         ADD XFER-TAX-WAGE (2)   TO TOT-XFER-TAX-WAGE (2)          DTSBD720
01109         ADD XFER-TAX-WAGE (3)   TO TOT-XFER-TAX-WAGE (3)          DTSBD720
01110      END-IF.                                                      DTSBD720
01111                                                                   DTSBD720
01112 *    IF MRCT-EMP-NO = 025207 OR 813049                            DTSBD720
01113 *       DISPLAY 'P2100 - 2 ' MRCT-EMP-NO '  '                     DTSBD720
01114 *          XFER-BENEFITS-AMT '  ' TOT-XFER-BENEFITS-AMT           DTSBD720
01115 *    END-IF.                                                      DTSBD720
01116 *    IF WRK-DATA-TO-TRANSFER-YES-88                               DTSBD720
01117 *       COMPUTE WRK-PCT = WRK-CURR-PCT * 100                      DTSBD720
01118 *       MOVE WRK-PCT TO WRK-PCT-DISP                              DTSBD720
01119 *       DISPLAY 'P2100 PRED ' WRK-CURR-PRED                       DTSBD720
01120 *         '  SUCC ' WRK-CURR-SUCC '  PCT ' WRK-PCT-DISP           DTSBD720
01121 *    END-IF.                                                      DTSBD720
01122  P2100-EXIT.                                                      DTSBD720
01123      EXIT.                                                        DTSBD720
01124                                                                   DTSBD720
01125  P2200-UPD-PRED.                                                  DTSBD720
01126 ***  PERFORM P2210-UPDATE-MRCT       THRU P2210-EXIT.             DTSBD720
01127                                                                   DTSBD720
01128      PERFORM P2220-UPDATE-MRRA       THRU P2220-EXIT.             DTSBD720
01129                                                                   DTSBD720
01130  P2200-EXIT.                                                      DTSBD720
01131      EXIT.                                                        DTSBD720
01132                                                                   DTSBD720
01133 *P2210-UPDATE-MRCT.                                               DTSBD720
01134 *    SUBTRACT XFER-PRIOR-RESERVE                                  DTSBD720
01135 *       FROM MRCT-PRIOR-RESERVE-AMT.                              DTSBD720
01136 *                                                                 DTSBD720
01137 *    SUBTRACT XFER-UI-TAX-AMT                                     DTSBD720
01138 *       FROM MRCT-UI-TAX-PAID-AMT.                                DTSBD720
01139 *                                                                 DTSBD720
01140 *    SUBTRACT XFER-BENEFITS-AMT                                   DTSBD720
01141 *       FROM MRCT-BENEFITS-CHARGED-AMT.                           DTSBD720
01142 *                                                                 DTSBD720
01143 *    PERFORM                                                      DTSBD720
01144 *      VARYING XW-SUB FROM +1 BY +1                               DTSBD720
01145 *      UNTIL XW-SUB > +3                                          DTSBD720
01146 *         SUBTRACT XFER-TOT-WAGE (XW-SUB)                         DTSBD720
01147 *            FROM MRCT-TOT-WAGE (XW-SUB)                          DTSBD720
01148 *         SUBTRACT XFER-TAX-WAGE (XW-SUB)                         DTSBD720
01149 *            FROM MRCT-TAX-WAGE (XW-SUB)                          DTSBD720
01150 *    END-PERFORM.                                                 DTSBD720
01151 *                                                                 DTSBD720
01152 *    SET MRCT-CHNG-SYSTEM-88 TO TRUE.                             DTSBD720
01153 *                                                                 DTSBD720
01154 *    MOVE MHDR-CURR-RUN-DATE TO MRCT-CHNG-DATE.                   DTSBD720
01155 *                                                                 DTSBD720
01156 *    MOVE MRCT-REC TO MSKL-REC.                                   DTSBD720
01157 *                                                                 DTSBD720
01158 *    PERFORM S910-REWRITE THRU S910-EXIT.                         DTSBD720
01159 *                                                                 DTSBD720
01160 *P2210-EXIT.                                                      DTSBD720
01161 *    EXIT.                                                        DTSBD720
01162                                                                   DTSBD720
01163  P2220-UPDATE-MRRA.                                               DTSBD720
01164      MOVE WRK-CURR-PRED         TO WRK-EMP-NO.                    DTSBD720
01165      PERFORM P2900-LAST-ID      THRU P2900-EXIT.                  DTSBD720
01166                                                                   DTSBD720
01167      MOVE LOW-VALUES            TO MRRA-REC.                      DTSBD720
01168      MOVE WRK-CURR-PRED         TO MRRA-EMP-NO.                   DTSBD720
01169      SET MRRA-RRA-88            TO TRUE.                          DTSBD720
01170      MOVE WRK-RTE-YR-START-YRQ  TO MRRA-RATE-EFF-YRQ.             DTSBD720
01171      MOVE WRK-CURR-EFF-DT       TO MRRA-REL-EFF-DATE.             DTSBD720
01172      ADD +1                     TO WRK-MRRA-ID.                   DTSBD720
01173      MOVE WRK-MRRA-ID           TO MRRA-ID-NO.                    DTSBD720
01174                                                                   DTSBD720
01175      SET MRRA-SUB-FROM-PRED-88  TO TRUE.                          DTSBD720
01176      MOVE WRK-CURR-PRED         TO MRRA-PRED-EMP-NO               DTSBD720
01177      MOVE WRK-CURR-SUCC         TO MRRA-SUCC-EMP-NO               DTSBD720
01178                                                                   DTSBD720
01179      COMPUTE MRRA-PRIOR-RESERVE ROUNDED =                         DTSBD720
01180        (XFER-PRIOR-RESERVE * -1).                                 DTSBD720
01181                                                                   DTSBD720
01182      COMPUTE MRRA-UI-TAX ROUNDED =                                DTSBD720
01183         (XFER-UI-TAX-AMT * -1).                                   DTSBD720
01184                                                                   DTSBD720
01185      MOVE ZERO TO MRRA-BENEFITS.                                  DTSBD720
01186 *&   COMPUTE MRRA-BENEFITS ROUNDED =                              DTSBD720
01187 *       (XFER-BENEFITS-AMT * -1).                                 DTSBD720
01188                                                                   DTSBD720
01189      MOVE ZERO                  TO MRRA-INTEREST.                 DTSBD720
01190                                                                   DTSBD720
01191      PERFORM                                                      DTSBD720
01192        VARYING XW-SUB FROM +1 BY +1                               DTSBD720
01193        UNTIL XW-SUB > +3                                          DTSBD720
01194           COMPUTE MRRA-TOT-WAGE (XW-SUB) =                        DTSBD720
01195              (XFER-TOT-WAGE (XW-SUB) * -1)                        DTSBD720
01196           COMPUTE MRRA-TAX-WAGE (XW-SUB) =                        DTSBD720
01197              (XFER-TAX-WAGE (XW-SUB) * -1)                        DTSBD720
01198      END-PERFORM.                                                 DTSBD720
01199                                                                   DTSBD720
01200      MOVE WRK-SYS-DATE          TO MRRA-ESTB-DATE.                DTSBD720
01201                                                                   DTSBD720
01202      MOVE MRRA-REC              TO MSKL-REC.                      DTSBD720
01203      PERFORM S910-WRITE         THRU S910-EXIT.                   DTSBD720
01204      ADD 1                      TO RRA-REC-WRITE-CNT.             DTSBD720
01205                                                                   DTSBD720
01206  P2220-EXIT.                                                      DTSBD720
01207      EXIT.                                                        DTSBD720
01208                                                                   DTSBD720
01209  P2300-UPD-SUCC.                                                  DTSBD720
01210      PERFORM P2310-READ-MPRF-MRCT  THRU P2310-EXIT.               DTSBD720
01211                                                                   DTSBD720
01212      PERFORM P2320-UPDATE-MRCT     THRU P2320-EXIT.               DTSBD720
01213                                                                   DTSBD720
01214      PERFORM P2330-UPDATE-MRRA     THRU P2330-EXIT.               DTSBD720
01215                                                                   DTSBD720
01216  P2300-EXIT.                                                      DTSBD720
01217      EXIT.                                                        DTSBD720
01218                                                                   DTSBD720
01219  P2310-READ-MPRF-MRCT.                                            DTSBD720
01220      MOVE LOW-VALUES                    TO MPRF-KEY-AREA.         DTSBD720
01221      MOVE WRK-CURR-SUCC                 TO MPRF-EMP-NO.           DTSBD720
01222      SET MPRF-PRF-88 TO TRUE.                                     DTSBD720
01223      MOVE MPRF-KEY-AREA                 TO MSKL-KEY-AREA.         DTSBD720
01224                                                                   DTSBD720
01225      PERFORM S910-READ                  THRU S910-EXIT.           DTSBD720
01226      IF L910-OK-88                                                DTSBD720
01227         MOVE MSKL-REC                   TO MPRF-REC               DTSBD720
01228      ELSE                                                         DTSBD720
01229         MOVE 'P2310-01 UNEXPECTED NO REC FOUND ON MPRF READ '     DTSBD720
01230            TO ABEND-MSG                                           DTSBD720
01231         PERFORM S999-ABEND THRU S999-EXIT                         DTSBD720
01232      END-IF.                                                      DTSBD720
01233                                                                   DTSBD720
01234      MOVE LOW-VALUES                 TO MRCT-KEY-AREA.            DTSBD720
01235      MOVE WRK-CURR-SUCC              TO MRCT-EMP-NO.              DTSBD720
01236      SET MRCT-RCT-88 TO TRUE.                                     DTSBD720
01237      MOVE WRK-RTE-YR-START-YRQ       TO MRCT-EFF-YRQ.             DTSBD720
01238      MOVE MRCT-KEY-AREA              TO MSKL-KEY-AREA.            DTSBD720
01239                                                                   DTSBD720
01240      PERFORM S910-READ               THRU S910-EXIT.              DTSBD720
01241      IF L910-OK-88                                                DTSBD720
01242         MOVE MSKL-REC                TO MRCT-REC                  DTSBD720
01243         MOVE MRCT-EARLIEST-LIAB-DATE                              DTSBD720
01244                                   TO WRK-SUC-EARLIEST-LIAB-DATE   DTSBD720
01245      ELSE                                                         DTSBD720
01246         MOVE 'P2310-02 UNEXPECTED NO REC FOUND ON MRCT READ '     DTSBD720
01247            TO ABEND-MSG                                           DTSBD720
01248         PERFORM S999-ABEND THRU S999-EXIT                         DTSBD720
01249      END-IF.                                                      DTSBD720
01250                                                                   DTSBD720
01251  P2310-EXIT.                                                      DTSBD720
01252      EXIT.                                                        DTSBD720
01253                                                                   DTSBD720
01254  P2320-UPDATE-MRCT.                                               DTSBD720
01255      ADD XFER-PRIOR-RESERVE                                       DTSBD720
01256         TO MRCT-PRIOR-RESERVE-AMT.                                DTSBD720
01257                                                                   DTSBD720
01258      ADD XFER-UI-TAX-AMT                                          DTSBD720
01259         TO MRCT-UI-TAX-PAID-AMT.                                  DTSBD720
01260                                                                   DTSBD720
01261 **   ADD XFER-BENEFITS-AMT                                        DTSBD720
01262 **      TO MRCT-BENEFITS-CHARGED-AMT.                             DTSBD720
01263                                                                   DTSBD720
01264 *    IF MRCT-EMP-NO = 025207 OR 813049                            DTSBD720
01265 *       DISPLAY 'P2320 ' MRCT-EMP-NO                              DTSBD720
01266 *          '  ' MRCT-BENEFITS-CHARGED-AMT                         DTSBD720
01267 *    END-IF.                                                      DTSBD720
01268                                                                   DTSBD720
01269      PERFORM                                                      DTSBD720
01270        VARYING XW-SUB FROM +1 BY +1                               DTSBD720
01271        UNTIL XW-SUB > +3                                          DTSBD720
01272           ADD XFER-TOT-WAGE (XW-SUB)                              DTSBD720
01273              TO MRCT-TOT-WAGE (XW-SUB)                            DTSBD720
01274           ADD XFER-TAX-WAGE (XW-SUB)                              DTSBD720
01275              TO MRCT-TAX-WAGE (XW-SUB)                            DTSBD720
01276      END-PERFORM.                                                 DTSBD720
01277                                                                   DTSBD720
01278      IF MRCT-EARLIEST-LIAB-DATE >                                 DTSBD720
01279            WRK-PRED-EARLIEST-LIAB-DATE                            DTSBD720
01280         MOVE WRK-PRED-EARLIEST-LIAB-DATE  TO                      DTSBD720
01281            MRCT-EARLIEST-LIAB-DATE                                DTSBD720
01282      END-IF.                                                      DTSBD720
01283                                                                   DTSBD720
01284      SET MRCT-CHNG-SYSTEM-88 TO TRUE.                             DTSBD720
01285                                                                   DTSBD720
01286      MOVE MHDR-CURR-RUN-DATE TO MRCT-CHNG-DATE.                   DTSBD720
01287                                                                   DTSBD720
01288      MOVE MRCT-REC TO MSKL-REC.                                   DTSBD720
01289                                                                   DTSBD720
01290      PERFORM S910-REWRITE THRU S910-EXIT.                         DTSBD720
01291                                                                   DTSBD720
01292  P2320-EXIT.                                                      DTSBD720
01293      EXIT.                                                        DTSBD720
01294                                                                   DTSBD720
01295  P2330-UPDATE-MRRA.                                               DTSBD720
01296      MOVE WRK-CURR-SUCC         TO WRK-EMP-NO.                    DTSBD720
01297      PERFORM P2900-LAST-ID      THRU P2900-EXIT.                  DTSBD720
01298                                                                   DTSBD720
01299      MOVE LOW-VALUES            TO MRRA-REC.                      DTSBD720
01300      MOVE WRK-CURR-SUCC         TO MRRA-EMP-NO.                   DTSBD720
01301      SET MRRA-RRA-88            TO TRUE.                          DTSBD720
01302      MOVE WRK-RTE-YR-START-YRQ  TO MRRA-RATE-EFF-YRQ.             DTSBD720
01303      MOVE WRK-CURR-EFF-DT       TO MRRA-REL-EFF-DATE.             DTSBD720
01304      ADD +1                     TO WRK-MRRA-ID.                   DTSBD720
01305      MOVE WRK-MRRA-ID           TO MRRA-ID-NO.                    DTSBD720
01306                                                                   DTSBD720
01307      SET MRRA-SUB-FROM-PRED-88  TO TRUE.                          DTSBD720
01308      MOVE WRK-CURR-PRED         TO MRRA-PRED-EMP-NO               DTSBD720
01309      MOVE WRK-CURR-SUCC         TO MRRA-SUCC-EMP-NO               DTSBD720
01310                                                                   DTSBD720
01311      COMPUTE MRRA-PRIOR-RESERVE ROUNDED =                         DTSBD720
01312        XFER-PRIOR-RESERVE.                                        DTSBD720
01313                                                                   DTSBD720
01314      COMPUTE MRRA-UI-TAX ROUNDED =                                DTSBD720
01315         XFER-UI-TAX-AMT.                                          DTSBD720
01316                                                                   DTSBD720
01317      MOVE ZERO TO  MRRA-BENEFITS.                                 DTSBD720
01318 *&   COMPUTE MRRA-BENEFITS ROUNDED =                              DTSBD720
01319 *       XFER-BENEFITS-AMT.                                        DTSBD720
01320                                                                   DTSBD720
01321      MOVE ZERO                  TO MRRA-INTEREST.                 DTSBD720
01322                                                                   DTSBD720
01323      PERFORM                                                      DTSBD720
01324        VARYING XW-SUB FROM +1 BY +1                               DTSBD720
01325        UNTIL XW-SUB > +3                                          DTSBD720
01326           MOVE XFER-TOT-WAGE (XW-SUB) TO                          DTSBD720
01327              MRRA-TOT-WAGE (XW-SUB)                               DTSBD720
01328           MOVE XFER-TAX-WAGE (XW-SUB) TO                          DTSBD720
01329              MRRA-TAX-WAGE (XW-SUB)                               DTSBD720
01330           IF MRRA-EMP-NO = 010021                                 DTSBD720
01331              DISPLAY 'P2330 ' XFER-TOT-WAGE (XW-SUB)              DTSBD720
01332                 '  ' MRRA-TOT-WAGE (XW-SUB)                       DTSBD720
01333           END-IF                                                  DTSBD720
01334      END-PERFORM.                                                 DTSBD720
01335                                                                   DTSBD720
01336      MOVE MRRA-REC              TO MSKL-REC.                      DTSBD720
01337      PERFORM S910-WRITE         THRU S910-EXIT.                   DTSBD720
01338      ADD 1                      TO RRA-REC-WRITE-CNT.             DTSBD720
01339                                                                   DTSBD720
01340  P2330-EXIT.                                                      DTSBD720
01341      EXIT.                                                        DTSBD720
01342                                                                   DTSBD720
01343  P2500-WRITE-R506.                                                DTSBD720
01344      PERFORM P2510-BENEFITS             THRU P2510-EXIT.          DTSBD720
01345      PERFORM P2520-R506                 THRU P2520-EXIT.          DTSBD720
01346                                                                   DTSBD720
01347  P2500-EXIT.                                                      DTSBD720
01348      EXIT.                                                        DTSBD720
01349                                                                   DTSBD720
01350  P2510-BENEFITS.                                                  DTSBD720
01351      MOVE ZERO                 TO XFER-BENEFITS-AMT.              DTSBD720
01352      MOVE LOW-VALUES           TO CHG5-SORT-KEY-AREA.             DTSBD720
01353      MOVE WRK-CURR-SUCC        TO CHG5-EMP-NO.                    DTSBD720
01354                                                                   DTSBD720
01355      START CHARGE-FILE                                            DTSBD720
01356         KEY IS >= CHG5-SORT-KEY-AREA.                             DTSBD720
01357                                                                   DTSBD720
01358      IF NOT CHARGE-FILE-OK-88                                     DTSBD720
01359         GO TO P2510-EXIT                                          DTSBD720
01360      ELSE                                                         DTSBD720
01361         READ CHARGE-FILE NEXT                                     DTSBD720
01362         PERFORM                                                   DTSBD720
01363           UNTIL CHARGE-FILE-EOF-88                                DTSBD720
01364           OR    CHG5-EMP-NO NOT = WRK-CURR-SUCC                   DTSBD720
01365           OR    WRK-ERROR-YES-88                                  DTSBD720
01366              IF CHG5-TYPE-SUCC-88                                 DTSBD720
01367              AND CHG5-PRED-EMP-NO = WRK-CURR-PRED                 DTSBD720
01368              AND CHG5-REL-EFF-DT = WRK-CURR-EFF-DT                DTSBD720
01369                 ADD CHG5-TOT-CHG-AMT   TO XFER-BENEFITS-AMT       DTSBD720
01370                 IF CHG5-EMP-NO = 022752 OR 048450 OR              DTSBD720
01371                                  025207 OR 813049 OR              DTSBD720
01372                                  061615 OR 620538                 DTSBD720
01373                    MOVE CHG5-TOT-CHG-AMT TO                       DTSBD720
01374                       WRK-DISPLAY-AMT-9                           DTSBD720
01375                    DISPLAY 'P2510 ' CHG5-EMP-NO                   DTSBD720
01376                       '  ' CHG5-SSN '  ' CHG5-TYPE                DTSBD720
01377                       '  ' CHG5-PRED-EMP-NO                       DTSBD720
01378                       '  ' CHG5-SUCC-EMP-NO                       DTSBD720
01379                       '  ' WRK-DISPLAY-AMT-9                      DTSBD720
01380                 END-IF                                            DTSBD720
01381              END-IF                                               DTSBD720
01382              READ CHARGE-FILE NEXT                                DTSBD720
01383         END-PERFORM                                               DTSBD720
01384      END-IF.                                                      DTSBD720
01385                                                                   DTSBD720
01386  P2510-EXIT.                                                      DTSBD720
01387      EXIT.                                                        DTSBD720
01388                                                                   DTSBD720
01389 *P2510-BENEFITS.                                                  DTSBD720
01390 *    MOVE LOW-VALUES            TO MRRA-REC.                      DTSBD720
01391 *    MOVE WRK-CURR-SUCC         TO MRRA-EMP-NO.                   DTSBD720
01392 *    SET MRRA-RRA-88            TO TRUE.                          DTSBD720
01393 *    MOVE WRK-RTE-YR-START-YRQ  TO MRRA-RATE-EFF-YRQ.             DTSBD720
01394 *    MOVE MRRA-KEY-AREA         TO MSKL-KEY-AREA.                 DTSBD720
01395 *    PERFORM S910-START-BROWSE  THRU S910-EXIT                    DTSBD720
01396 *    IF L910-OK-88                                                DTSBD720
01397 *       PERFORM UNTIL L910-NO-REC-88                              DTSBD720
01398 *          MOVE MSKL-REC        TO MRRA-REC                       DTSBD720
01399 *          IF MRRA-RATE-EFF-YRQ = WRK-RTE-YR-START-YRQ            DTSBD720
01400 *             IF MRRA-ADD-TO-SUCC-88                              DTSBD720
01401 *                IF MRRA-BENEFITS-88                              DTSBD720
01402 *                   ADD MRRA-AMOUNT        TO XFER-BENEFITS-AMT   DTSBD720
01403 *                END-IF                                           DTSBD720
01404 *             END-IF                                              DTSBD720
01405 *             PERFORM S910-READ-NEXT       THRU S910-EXIT         DTSBD720
01406 *          ELSE                                                   DTSBD720
01407 *             SET L910-NO-REC-88           TO TRUE                DTSBD720
01408 *          END-IF                                                 DTSBD720
01409 *       END-PERFORM                                               DTSBD720
01410 *    END-IF.                                                      DTSBD720
01411 *                                                                 DTSBD720
01412 *P2510-EXIT.                                                      DTSBD720
01413 *    EXIT.                                                        DTSBD720
01414                                                                   DTSBD720
01415  P2520-R506.                                                      DTSBD720
01416      MOVE WRK-CURR-SUCC  TO R506-SUCC-EMP-NO.                     DTSBD720
01417                                                                   DTSBD720
01418      MOVE WRK-CURR-PRED    TO R506-PRED-EMP-NO.                   DTSBD720
01419                                                                   DTSBD720
01420      MOVE WRK-CURR-EFF-DT   TO R506-REL-EFF-DATE.                 DTSBD720
01421                                                                   DTSBD720
01422      MOVE XFER-PRIOR-RESERVE TO R506-PRIOR-RESERVE-AMT.           DTSBD720
01423                                                                   DTSBD720
01424      MOVE XFER-UI-TAX-AMT TO R506-UI-TAX-PAID-AMT.                DTSBD720
01425                                                                   DTSBD720
01426 **   MOVE MRCT-TRUST-FUND-INTEREST-AMT                            DTSBD720
01427 **     TO R506-TRUST-FUND-INTEREST-AMT.                           DTSBD720
01428                                                                   DTSBD720
01429      MOVE XFER-BENEFITS-AMT                                       DTSBD720
01430        TO R506-BENEFITS-CHARGED-AMT.                              DTSBD720
01431 *&                                                                DTSBD720
01432      IF XFER-BENEFITS-AMT NOT = ZERO                              DTSBD720
01433         MOVE XFER-BENEFITS-AMT TO WRK-DISPLAY-AMT-9               DTSBD720
01434         DISPLAY 'BD720 BENEFITS SUCC ' R506-SUCC-EMP-NO           DTSBD720
01435            '  PRED ' R506-PRED-EMP-NO                             DTSBD720
01436            '  '  WRK-DISPLAY-AMT-9                                DTSBD720
01437      END-IF.                                                      DTSBD720
01438 *&                                                                DTSBD720
01439      PERFORM                                                      DTSBD720
01440        VARYING R506-WAGES-IDX FROM 1 BY 1                         DTSBD720
01441        UNTIL R506-WAGES-IDX > MMAX-RCT-EXP-MAX                    DTSBD720
01442          SET L055-WAGES-IDX TO R506-WAGES-IDX                     DTSBD720
01443          MOVE L055-WAGES-FROM-YRQ (L055-WAGES-IDX)                DTSBD720
01444            TO R506-WAGES-FROM-YRQ (R506-WAGES-IDX)                DTSBD720
01445          MOVE L055-WAGES-THRU-YRQ (L055-WAGES-IDX)                DTSBD720
01446            TO R506-WAGES-THRU-YRQ (R506-WAGES-IDX)                DTSBD720
01447          SET XW-SUB         TO R506-WAGES-IDX                     DTSBD720
01448          MOVE XFER-TOT-WAGE (XW-SUB)                              DTSBD720
01449            TO R506-TOT-WAGE (R506-WAGES-IDX)                      DTSBD720
01450          MOVE XFER-TAX-WAGE (XW-SUB)                              DTSBD720
01451            TO R506-TAX-WAGE (R506-WAGES-IDX)                      DTSBD720
01452      END-PERFORM.                                                 DTSBD720
01453                                                                   DTSBD720
01454      MOVE MRCT-EARLIEST-LIAB-DATE                                 DTSBD720
01455            TO R506-EARLIEST-LIAB-DATE.                            DTSBD720
01456                                                                   DTSBD720
01457      MOVE MRCT-MISS-RPT-CNT TO R506-MISS-RPT-CNT.                 DTSBD720
01458                                                                   DTSBD720
01459      MOVE MRCT-TOT-UI-TAX-BALANCE-AMT                             DTSBD720
01460        TO R506-TOT-UI-TAX-BALANCE-AMT.                            DTSBD720
01461                                                                   DTSBD720
01462      PERFORM S946-WRITE-R506 THRU S946-EXIT.                      DTSBD720
01463                                                                   DTSBD720
01464  P2520-EXIT.                                                      DTSBD720
01465      EXIT.                                                        DTSBD720
01466                                                                   DTSBD720
01467  P2900-LAST-ID.                                                   DTSBD720
01468      MOVE +0                    TO WRK-MRRA-ID.                   DTSBD720
01469                                                                   DTSBD720
01470      MOVE LOW-VALUES            TO MRRA-REC.                      DTSBD720
01471      MOVE WRK-EMP-NO            TO MRRA-EMP-NO.                   DTSBD720
01472      SET MRRA-RRA-88            TO TRUE.                          DTSBD720
01473      MOVE WRK-RTE-YR-START-YRQ  TO MRRA-RATE-EFF-YRQ.             DTSBD720
01474      MOVE ZERO                  TO MRRA-REL-EFF-DATE.             DTSBD720
01475      MOVE MRRA-KEY-AREA         TO MSKL-KEY-AREA.                 DTSBD720
01476                                                                   DTSBD720
01477      PERFORM S910-START-BROWSE      THRU S910-EXIT.               DTSBD720
01478      IF L910-OK-88                                                DTSBD720
01479         PERFORM                                                   DTSBD720
01480           UNTIL L910-NO-REC-88                                    DTSBD720
01481             MOVE MSKL-REC              TO MRRA-REC                DTSBD720
01482             IF MRRA-RATE-EFF-YRQ = WRK-RTE-YR-START-YRQ           DTSBD720
01483                IF MRRA-REL-EFF-DATE = WRK-CURR-EFF-DT             DTSBD720
01484                   IF MRRA-ID-NO > WRK-MRRA-ID                     DTSBD720
01485                      MOVE MRRA-ID-NO   TO WRK-MRRA-ID             DTSBD720
01486                   END-IF                                          DTSBD720
01487                END-IF                                             DTSBD720
01488                PERFORM S910-READ-NEXT  THRU S910-EXIT             DTSBD720
01489             ELSE                                                  DTSBD720
01490                SET L910-NO-REC-88      TO TRUE                    DTSBD720
01491             END-IF                                                DTSBD720
01492         END-PERFORM                                               DTSBD720
01493      END-IF.                                                      DTSBD720
01494                                                                   DTSBD720
01495  P2900-EXIT.                                                      DTSBD720
01496      EXIT.                                                        DTSBD720
01497                                                                   DTSBD720
01498  P3000-UPD-PRED-MRCT.                                             DTSBD720
01499 ********************************************************          DTSBD720
01500 * GET PREDECESSOR MRCT                                            DTSBD720
01501 ********************************************************          DTSBD720
01502      MOVE LOW-VALUES                 TO MRCT-KEY-AREA.            DTSBD720
01503      MOVE WRK-CURR-PRED              TO MRCT-EMP-NO.              DTSBD720
01504      SET MRCT-RCT-88 TO TRUE.                                     DTSBD720
01505      MOVE WRK-RTE-YR-START-YRQ       TO MRCT-EFF-YRQ.             DTSBD720
01506      MOVE MRCT-KEY-AREA              TO MSKL-KEY-AREA.            DTSBD720
01507                                                                   DTSBD720
01508      PERFORM S910-READ               THRU S910-EXIT.              DTSBD720
01509      IF L910-OK-88                                                DTSBD720
01510         MOVE MSKL-REC                TO MRCT-REC                  DTSBD720
01511      ELSE                                                         DTSBD720
01512         GO TO P3000-EXIT                                          DTSBD720
01513      END-IF.                                                      DTSBD720
01514                                                                   DTSBD720
01515      SUBTRACT TOT-XFER-PRIOR-RESERVE                              DTSBD720
01516         FROM MRCT-PRIOR-RESERVE-AMT.                              DTSBD720
01517                                                                   DTSBD720
01518      SUBTRACT TOT-XFER-UI-TAX-AMT                                 DTSBD720
01519         FROM MRCT-UI-TAX-PAID-AMT.                                DTSBD720
01520                                                                   DTSBD720
01521 **   SUBTRACT TOT-XFER-BENEFITS-AMT                               DTSBD720
01522 **      FROM MRCT-BENEFITS-CHARGED-AMT.                           DTSBD720
01523                                                                   DTSBD720
01524      IF MRCT-EMP-NO = 025207 OR 813049                            DTSBD720
01525         DISPLAY 'P3000 ' MRCT-EMP-NO                              DTSBD720
01526            '  ' MRCT-BENEFITS-CHARGED-AMT                         DTSBD720
01527      END-IF.                                                      DTSBD720
01528                                                                   DTSBD720
01529      PERFORM                                                      DTSBD720
01530        VARYING XW-SUB FROM +1 BY +1                               DTSBD720
01531        UNTIL XW-SUB > +3                                          DTSBD720
01532           SUBTRACT TOT-XFER-TOT-WAGE (XW-SUB)                     DTSBD720
01533              FROM MRCT-TOT-WAGE (XW-SUB)                          DTSBD720
01534           SUBTRACT TOT-XFER-TAX-WAGE (XW-SUB)                     DTSBD720
01535              FROM MRCT-TAX-WAGE (XW-SUB)                          DTSBD720
01536      END-PERFORM.                                                 DTSBD720
01537                                                                   DTSBD720
01538      SET MRCT-CHNG-SYSTEM-88 TO TRUE.                             DTSBD720
01539                                                                   DTSBD720
01540      MOVE MHDR-CURR-RUN-DATE TO MRCT-CHNG-DATE.                   DTSBD720
01541                                                                   DTSBD720
01542      MOVE MRCT-REC TO MSKL-REC.                                   DTSBD720
01543                                                                   DTSBD720
01544      PERFORM S910-REWRITE THRU S910-EXIT.                         DTSBD720
01545                                                                   DTSBD720
01546  P3000-EXIT.                                                      DTSBD720
01547      EXIT.                                                        DTSBD720
01548                                                                   DTSBD720
01549  P4000-LIABILITY-DT.                                              DTSBD720
01550      PERFORM P4100-READ-MPRF-MRCT  THRU P4100-EXIT.               DTSBD720
01551                                                                   DTSBD720
01552      IF MPRF-CLASS-RATED-88                                       DTSBD720
01553         PERFORM P4200-UPDATE-MRCT     THRU P4200-EXIT             DTSBD720
01554      ELSE                                                            CL*17
01555         DISPLAY 'P4000 NON RATED EMPLYR - CANNOT UPD MRCT DATE: '    CL*17
01556               WRK-CURR-SUCC '  ' MRCT-EARLIEST-LIAB-DATE             CL*17
01557      END-IF.                                                         CL*17
01558 *&                                                                   CL*17
01559                                                                   DTSBD720
01560  P4000-EXIT.                                                      DTSBD720
01561      EXIT.                                                        DTSBD720
01562                                                                   DTSBD720
01563  P4100-READ-MPRF-MRCT.                                            DTSBD720
01564      MOVE LOW-VALUES                    TO MPRF-KEY-AREA.         DTSBD720
01565      MOVE WRK-CURR-SUCC                 TO MPRF-EMP-NO.           DTSBD720
01566      SET MPRF-PRF-88 TO TRUE.                                     DTSBD720
01567      MOVE MPRF-KEY-AREA                 TO MSKL-KEY-AREA.         DTSBD720
01568                                                                   DTSBD720
01569      PERFORM S910-READ                  THRU S910-EXIT.           DTSBD720
01570      IF L910-OK-88                                                DTSBD720
01571         MOVE MSKL-REC                   TO MPRF-REC               DTSBD720
01572      ELSE                                                         DTSBD720
01573         DISPLAY 'P4100-01 UNEXPECTED NO REC FOUND ON MPRF READ '  DTSBD720
01574            WRK-CURR-SUCC                                          DTSBD720
01575         MOVE 'P4100-01 UNEXPECTED NO REC FOUND ON MPRF READ '     DTSBD720
01576            TO ABEND-MSG                                           DTSBD720
01577         PERFORM S999-ABEND THRU S999-EXIT                         DTSBD720
01578      END-IF.                                                      DTSBD720
01579                                                                   DTSBD720
01580      IF NOT MPRF-CLASS-RATED-88                                   DTSBD720
01581         GO TO P4100-EXIT                                          DTSBD720
01582      END-IF.                                                      DTSBD720
01583                                                                   DTSBD720
01584      MOVE LOW-VALUES                 TO MRCT-KEY-AREA.            DTSBD720
01585      MOVE WRK-CURR-SUCC              TO MRCT-EMP-NO.              DTSBD720
01586      SET MRCT-RCT-88 TO TRUE.                                     DTSBD720
01587      MOVE WRK-RTE-YR-START-YRQ       TO MRCT-EFF-YRQ.                CL**2
01588      MOVE MRCT-KEY-AREA              TO MSKL-KEY-AREA.            DTSBD720
01589                                                                   DTSBD720
01590      PERFORM S910-READ               THRU S910-EXIT.              DTSBD720
01591      IF L910-OK-88                                                DTSBD720
01592         MOVE MSKL-REC                TO MRCT-REC                  DTSBD720
01593         MOVE MRCT-EARLIEST-LIAB-DATE                              DTSBD720
01594                                   TO WRK-SUC-EARLIEST-LIAB-DATE   DTSBD720
01595      ELSE                                                         DTSBD720
01596         DISPLAY 'P4100-02 UNEXPECTED NO REC FOUND ON MRCT READ '  DTSBD720
01597            WRK-CURR-SUCC                                          DTSBD720
01598         MOVE 'P4100-02 UNEXPECTED NO REC FOUND ON MRCT READ '     DTSBD720
01599            TO ABEND-MSG                                           DTSBD720
01600         PERFORM S999-ABEND THRU S999-EXIT                         DTSBD720
01601      END-IF.                                                      DTSBD720
01602                                                                   DTSBD720
01603  P4100-EXIT.                                                      DTSBD720
01604      EXIT.                                                        DTSBD720
01605                                                                   DTSBD720
01606  P4200-UPDATE-MRCT.                                               DTSBD720
01607 *& 2203                                                              CL**2
01608 **   IF WRK-TRANSFER-YES-88                                          CL**7
01609         PERFORM P4210-PRED-DATE              THRU P4210-EXIT.        CL*10
01610 **   ELSE                                                            CL**7
01611 *       IF WRK-SUC-PRIOR-EARLIEST-LIAB = ZERO                        CL*10
01612 *          NEXT SENTENCE                                             CL*10
01613 *       ELSE                                                         CL*10
01614 *          IF MRCT-EARLIEST-LIAB-DATE >                              CL*10
01615 *                  WRK-SUC-PRIOR-EARLIEST-LIAB                       CL*10
01616 *             PERFORM P4220-SUC-PRIOR-DATE   THRU P4220-EXIT         CL*10
01617 *          END-IF                                                    CL*10
01618 *       END-IF.                                                      CL*10
01619 **   END-IF.                                                         CL**7
01620                                                                   DTSBD720
01621  P4200-EXIT.                                                      DTSBD720
01622      EXIT.                                                        DTSBD720
01623                                                                   DTSBD720
01624  P4210-PRED-DATE.                                                    CL**5
01625        IF MRCT-EARLIEST-LIAB-DATE >                                  CL*12
01626           WRK-PRED-EARLIEST-LIAB-DATE                                CL*12
01627         MOVE WRK-PRED-EARLIEST-LIAB-DATE                             CL**5
01628              TO MRCT-EARLIEST-LIAB-DATE                              CL**5
01629        ELSE                                                          CL*14
01630        IF MRCT-EARLIEST-LIAB-DATE >                                  CL*14
01631           WRK-SUC-PRIOR-EARLIEST-LIAB                                CL*14
01632          MOVE WRK-SUC-PRIOR-EARLIEST-LIAB                            CL*14
01633              TO MRCT-EARLIEST-LIAB-DATE                              CL*16
01634      END-IF.                                                         CL*16
01635                                                                      CL*23
01636      IF MRCT-EMP-NO = 333074                                         CL*23
01637         MOVE 20020101 TO MRCT-EARLIEST-LIAB-DATE                     CL*23
01638      ELSE                                                            CL*23
01639      IF MRCT-EMP-NO = 184590                                         CL*23
01640         MOVE 20140801 TO MRCT-EARLIEST-LIAB-DATE                     CL*23
01641      ELSE                                                            CL*23
01642      IF MRCT-EMP-NO = 070929                                         CL*23
01643         MOVE 19950101 TO MRCT-EARLIEST-LIAB-DATE                     CL*23
01644      ELSE                                                            CL*23
01645      IF MRCT-EMP-NO = 155262                                         CL*23
01646         MOVE 20030725 TO MRCT-EARLIEST-LIAB-DATE                     CL*23
01647      ELSE                                                            CL*23
01648      IF MRCT-EMP-NO = 172865                                         CL*23
01649         MOVE 20110701 TO MRCT-EARLIEST-LIAB-DATE                     CL*23
01650      ELSE                                                            CL*23
01651      IF MRCT-EMP-NO = 325355                                         CL*23
01652         MOVE 19881001 TO MRCT-EARLIEST-LIAB-DATE.                    CL*23
01653                                                                      CL*23
01654      IF MRCT-EMP-NO = 068108                                         CL*25
01655         MOVE 19981001 TO MRCT-EARLIEST-LIAB-DATE                     CL*27
01656      ELSE                                                            CL*25
01657      IF MRCT-EMP-NO = 164531                                         CL*25
01658         MOVE 20090831 TO MRCT-EARLIEST-LIAB-DATE                     CL*29
01659      ELSE                                                            CL*25
01660      IF MRCT-EMP-NO = 315668                                         CL*25
01661         MOVE 20210101 TO MRCT-EARLIEST-LIAB-DATE                     CL*27
01662      ELSE                                                            CL*25
01663      IF MRCT-EMP-NO = 338561                                         CL*25
01664         MOVE 20200101 TO MRCT-EARLIEST-LIAB-DATE                     CL*27
01665      ELSE                                                            CL*25
01666      IF MRCT-EMP-NO = 343946                                         CL*25
01667         MOVE 20210101 TO MRCT-EARLIEST-LIAB-DATE                     CL*26
01668      ELSE                                                            CL*25
01669      IF MRCT-EMP-NO = 347106                                         CL*25
01670         MOVE 20210101 TO MRCT-EARLIEST-LIAB-DATE.                    CL*32
01671                                                                      CL*32
01672      IF MRCT-EMP-NO = 350784                                         CL*25
01673         MOVE 20220701 TO MRCT-EARLIEST-LIAB-DATE                     CL*32
01674      ELSE                                                            CL*32
01675      IF MRCT-EMP-NO = 182665                                         CL*27
01676         MOVE 19970115 TO MRCT-EARLIEST-LIAB-DATE                     CL*31
01677      ELSE                                                            CL*31
01678      IF MRCT-EMP-NO = 086215                                         CL*31
01679         MOVE 19980101 TO MRCT-EARLIEST-LIAB-DATE                     CL*33
01680      ELSE                                                            CL*33
01681      IF MRCT-EMP-NO = 343956                                         CL*33
01682         MOVE 20160515 TO MRCT-EARLIEST-LIAB-DATE.                    CL*33
01683                                                                      CL*31
01684                                                                      CL*28
01685      IF MRCT-EARLIEST-LIAB-DATE = ZEROS                              CL*23
01686       MOVE WRK-SUC-PRIOR-EARLIEST-LIAB TO MRCT-EARLIEST-LIAB-DATE.   CL*23
01687                                                                      CL*16
01688         SET MRCT-CHNG-SYSTEM-88              TO TRUE                 CL**5
01689         MOVE MHDR-CURR-RUN-DATE              TO MRCT-CHNG-DATE       CL**5
01690         MOVE MRCT-REC                        TO MSKL-REC             CL**5
01691         PERFORM S910-REWRITE                 THRU S910-EXIT.         CL*16
01692                                                                      CL*10
01693      DISPLAY 'P4210 EARLIEST LIAB DATE ' WRK-CURR-SUCC               CL*10
01694         ' MRCT-SUCC: ' MRCT-EARLIEST-LIAB-DATE                       CL*10
01695         '  ' WRK-CURR-PRED                                           CL*10
01696         ' MRCT-PRED: ' WRK-PRED-EARLIEST-LIAB-DATE                   CL*10
01697         ' SUCC-PRIO: ' WRK-SUC-PRIOR-EARLIEST-LIAB.                  CL*14
01698                                                                      CL*10
01699      IF MRCT-EMP-NO = 086215 OR 182665                               CL*32
01700         DISPLAY ' MRCT ELD ' MRCT-EARLIEST-LIAB-DATE.                CL*32
01701                                                                      CL*32
01702                                                                      CL**5
01703  P4210-EXIT.                                                         CL**5
01704      EXIT.                                                           CL**5
01705                                                                      CL**5
01706  P4220-SUC-PRIOR-DATE.                                               CL**5
01707      DISPLAY 'P4200  ' WRK-CURR-SUCC                                 CL**5
01708         '  ' WRK-CURR-PRED '  ' WRK-CURR-EFF-DT                      CL**5
01709         '  RCT ' MRCT-EARLIEST-LIAB-DATE                             CL**5
01710         '  PRIOR ' WRK-SUC-PRIOR-EARLIEST-LIAB.                      CL**5
01711                                                                      CL**5
01712      MOVE WRK-SUC-PRIOR-EARLIEST-LIAB                                CL**5
01713           TO MRCT-EARLIEST-LIAB-DATE.                                CL**5
01714                                                                      CL*34
01715      IF MRCT-EMP-NO = 086215                                         CL*34
01716         MOVE 19980101 TO MRCT-EARLIEST-LIAB-DATE.                    CL*34
01717                                                                      CL*34
01718      SET MRCT-CHNG-SYSTEM-88                 TO TRUE.                CL**5
01719      MOVE MHDR-CURR-RUN-DATE                 TO MRCT-CHNG-DATE.      CL**5
01720      MOVE MRCT-REC                           TO MSKL-REC.            CL**5
01721      PERFORM S910-REWRITE                    THRU S910-EXIT.         CL**5
01722                                                                      CL**5
01723  P4220-EXIT.                                                         CL**5
01724      EXIT.                                                           CL**5
01725                                                                      CL**5
01726                                                                      CL**9
01727  P5000-UPD-SUCC-ELD.                                                 CL**9
01728      PERFORM P4100-READ-MPRF-MRCT  THRU P4100-EXIT.                  CL**9
01729                                                                      CL**9
01730      IF MPRF-CLASS-RATED-88                                          CL**9
01731         PERFORM P4210-PRED-DATE       THRU P4210-EXIT                CL**9
01732      END-IF.                                                         CL**9
01733                                                                      CL**9
01734  P5000-EXIT.                                                         CL**9
01735      EXIT.                                                           CL**9
01736                                                                      CL**9
01737                                                                   DTSBD720
01738  P9000-CLEANUP-MRCT.                                              DTSBD720
01739 *****IF (MPRF-EMP-NO < 360101)                                    DTSBD720
01740 ************OR                                                    DTSBD720
01741 ********(MPRF-EMP-NO > 360126)                                    DTSBD720
01742 *********GO TO P9000-EXIT                                         DTSBD720
01743                                                                   DTSBD720
01744                                                                   DTSBD720
01745      IF MPRF-CLASS-RATED-88                                       DTSBD720
01746          NEXT SENTENCE                                            DTSBD720
01747      ELSE                                                         DTSBD720
01748          GO TO P9000-EXIT.                                        DTSBD720
01749                                                                   DTSBD720
01750      MOVE LOW-VALUES TO MRCT-KEY-AREA.                            DTSBD720
01751                                                                   DTSBD720
01752      MOVE MPRF-EMP-NO TO MRCT-EMP-NO.                             DTSBD720
01753                                                                   DTSBD720
01754      SET MRCT-RCT-88 TO TRUE.                                     DTSBD720
01755                                                                   DTSBD720
01756      MOVE WRK-RTE-YR-START-YRQ TO MRCT-EFF-YRQ.                   DTSBD720
01757                                                                   DTSBD720
01758      MOVE MRCT-KEY-AREA TO MSKL-KEY-AREA.                         DTSBD720
01759                                                                   DTSBD720
01760      PERFORM S910-READ THRU S910-EXIT.                            DTSBD720
01761                                                                   DTSBD720
01762      IF L910-NO-REC-88                                            DTSBD720
01763          GO TO P9000-EXIT.                                        DTSBD720
01764                                                                   DTSBD720
01765      MOVE MSKL-REC TO MRCT-REC.                                   DTSBD720
01766                                                                   DTSBD720
01767      SET WRK-PREDECESSOR-NO-88         TO TRUE.                   DTSBD720
01768                                                                   DTSBD720
01769 ***  PERFORM P9100-CHECK-MRRA          THRU P9100-EXIT.           DTSBD720
01770 *                                                                 DTSBD720
01771 *    PERFORM P9200-CHECK-MRWA          THRU P9200-EXIT.           DTSBD720
01772 *                                                                 DTSBD720
01773 *    IF XFER-BENEFITS-AMT = ZERO                                  DTSBD720
01774 *    AND XFER-UI-TAX-AMT = ZERO                                   DTSBD720
01775 *    AND XFER-PRIOR-RESERVE = ZERO                                DTSBD720
01776 *    AND XFER-TOT-WAGE (1) = ZERO                                 DTSBD720
01777 *    AND XFER-TAX-WAGE (1) = ZERO                                 DTSBD720
01778 *    AND XFER-TOT-WAGE (2) = ZERO                                 DTSBD720
01779 *    AND XFER-TAX-WAGE (2) = ZERO                                 DTSBD720
01780 *    AND XFER-TOT-WAGE (3) = ZERO                                 DTSBD720
01781 *    AND XFER-TAX-WAGE (3) = ZERO                                 DTSBD720
01782 *        GO TO P9000-EXIT                                         DTSBD720
01783 *    END-IF.                                                      DTSBD720
01784                                                                   DTSBD720
01785      SET WRK-LIAB-IN-RTE-YR-NO-88 TO TRUE.                        DTSBD720
01786                                                                   DTSBD720
01787      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSBD720
01788                                                                   DTSBD720
01789      MOVE MPRF-EMP-NO TO MSKL-EMP-NO.                             DTSBD720
01790                                                                   DTSBD720
01791      SET MSKL-SOL-88 TO TRUE.                                     DTSBD720
01792                                                                   DTSBD720
01793      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBD720
01794                                                                   DTSBD720
01795      PERFORM                                                      DTSBD720
01796        UNTIL L910-NO-REC-88                                       DTSBD720
01797          MOVE MSKL-REC TO MSOL-REC                                DTSBD720
01798          PERFORM P9300-CHECK-MSOL THRU P9300-EXIT                 DTSBD720
01799          PERFORM S910-READ-NEXT THRU S910-EXIT                    DTSBD720
01800      END-PERFORM.                                                 DTSBD720
01801                                                                   DTSBD720
01802      IF WRK-LIAB-IN-RTE-YR-YES-88                                 DTSBD720
01803         NEXT SENTENCE                                             DTSBD720
01804 ***     PERFORM P9400-UPDATE-MRCT   THRU P9400-EXIT               DTSBD720
01805      ELSE                                                         DTSBD720
01806         MOVE MRCT-KEY-AREA TO MSKL-KEY-AREA                       DTSBD720
01807         PERFORM S910-DELETE THRU S910-EXIT                        DTSBD720
01808         ADD +1 TO RCT-REC-DELETE-CNT                              DTSBD720
01809 ***     PERFORM S9000-EMPLOYER-UPDATED THRU S9000-EXIT            DTSBD720
01810      END-IF.                                                      DTSBD720
01811                                                                   DTSBD720
01812  P9000-EXIT.                                                      DTSBD720
01813      EXIT.                                                        DTSBD720
01814      SKIP3                                                        DTSBD720
01815 *P9100-CHECK-MRRA.                                                DTSBD720
01816 *    MOVE ZERO                  TO XFER-PRIOR-RESERVE             DTSBD720
01817 *                                  XFER-UI-TAX-AMT                DTSBD720
01818 *                                  XFER-BENEFITS-AMT.             DTSBD720
01819 *                                                                 DTSBD720
01820 *    MOVE LOW-VALUES            TO MRRA-REC.                      DTSBD720
01821 *    MOVE MRCT-EMP-NO           TO MRRA-EMP-NO.                   DTSBD720
01822 *    SET MRRA-RRA-88            TO TRUE.                          DTSBD720
01823 *    MOVE WRK-RTE-YR-START-YRQ  TO MRRA-RATE-EFF-YRQ.             DTSBD720
01824 *    MOVE MRRA-KEY-AREA         TO MSKL-KEY-AREA.                 DTSBD720
01825 *    PERFORM S910-START-BROWSE  THRU S910-EXIT                    DTSBD720
01826 *    IF L910-OK-88                                                DTSBD720
01827 *       PERFORM UNTIL L910-NO-REC-88                              DTSBD720
01828 *          MOVE MSKL-REC        TO MRRA-REC                       DTSBD720
01829 *          IF MRRA-RATE-EFF-YRQ = WRK-RTE-YR-START-YRQ            DTSBD720
01830 *             IF NOT MRRA-ESTB-RESERVE-88                         DTSBD720
01831 *                PERFORM P9110-SUM-AMOUNTS THRU P9110-EXIT        DTSBD720
01832 *             END-IF                                              DTSBD720
01833 *             PERFORM S910-READ-NEXT       THRU S910-EXIT         DTSBD720
01834 *          ELSE                                                   DTSBD720
01835 *             SET L910-NO-REC-88           TO TRUE                DTSBD720
01836 *          END-IF                                                 DTSBD720
01837 *       END-PERFORM                                               DTSBD720
01838 *    END-IF.                                                      DTSBD720
01839 *                                                                 DTSBD720
01840 *P9100-EXIT.                                                      DTSBD720
01841 *    EXIT.                                                        DTSBD720
01842 *                                                                 DTSBD720
01843 *P9110-SUM-AMOUNTS.                                               DTSBD720
01844 *    IF MRRA-SUB-FROM-PRED-88                                     DTSBD720
01845 *       SET WRK-PREDECESSOR-YES-88         TO TRUE                DTSBD720
01846 *    END-IF.                                                      DTSBD720
01847 *                                                                 DTSBD720
01848 *    EVALUATE TRUE                                                DTSBD720
01849 *      WHEN MRRA-PRIOR-RESERVE-88                                 DTSBD720
01850 *        ADD MRRA-AMOUNT       TO XFER-PRIOR-RESERVE              DTSBD720
01851 *                                                                 DTSBD720
01852 *      WHEN MRRA-UI-TAX-88                                        DTSBD720
01853 *        ADD MRRA-AMOUNT       TO XFER-UI-TAX-AMT                 DTSBD720
01854 *                                                                 DTSBD720
01855 *      WHEN MRRA-BENEFITS-88                                      DTSBD720
01856 *        ADD MRRA-AMOUNT       TO XFER-BENEFITS-AMT               DTSBD720
01857 *                                                                 DTSBD720
01858 *    END-EVALUATE.                                                DTSBD720
01859 *                                                                 DTSBD720
01860 *P9110-EXIT.                                                      DTSBD720
01861 *    EXIT.                                                        DTSBD720
01862 *                                                                 DTSBD720
01863 *P9200-CHECK-MRWA.                                                DTSBD720
01864 *    PERFORM                                                      DTSBD720
01865 *      VARYING XW-SUB FROM +1 BY +1                               DTSBD720
01866 *      UNTIL XW-SUB > +3                                          DTSBD720
01867 *         MOVE ZERO             TO XFER-TOT-WAGE (XW-SUB)         DTSBD720
01868 *                                  XFER-TAX-WAGE (XW-SUB)         DTSBD720
01869 *    END-PERFORM.                                                 DTSBD720
01870 *                                                                 DTSBD720
01871 *    MOVE LOW-VALUES            TO MRWA-REC.                      DTSBD720
01872 *    MOVE MRCT-EMP-NO           TO MRWA-EMP-NO.                   DTSBD720
01873 *    SET MRWA-RWA-88            TO TRUE.                          DTSBD720
01874 *    MOVE WRK-RTE-YR-START-YRQ  TO MRWA-RATE-EFF-YRQ.             DTSBD720
01875 *    MOVE MRWA-KEY-AREA         TO MSKL-KEY-AREA.                 DTSBD720
01876 *    PERFORM S910-START-BROWSE  THRU S910-EXIT                    DTSBD720
01877 *    IF L910-OK-88                                                DTSBD720
01878 *       PERFORM UNTIL L910-NO-REC-88                              DTSBD720
01879 *          MOVE MSKL-REC        TO MRWA-REC                       DTSBD720
01880 *          IF MRWA-RATE-EFF-YRQ = WRK-RTE-YR-START-YRQ            DTSBD720
01881 *             IF NOT MRWA-ESTB-RESERVE-88                         DTSBD720
01882 *                PERFORM P9210-SUM-WAGES   THRU P9210-EXIT        DTSBD720
01883 *             END-IF                                              DTSBD720
01884 *             PERFORM S910-READ-NEXT       THRU S910-EXIT         DTSBD720
01885 *          ELSE                                                   DTSBD720
01886 *             SET L910-NO-REC-88           TO TRUE                DTSBD720
01887 *          END-IF                                                 DTSBD720
01888 *       END-PERFORM                                               DTSBD720
01889 *    END-IF.                                                      DTSBD720
01890 *                                                                 DTSBD720
01891 *P9200-EXIT.                                                      DTSBD720
01892 *    EXIT.                                                        DTSBD720
01893 *                                                                 DTSBD720
01894 *P9210-SUM-WAGES.                                                 DTSBD720
01895 *    IF MRWA-TO-SUCC-88                                           DTSBD720
01896 *       SET WRK-PREDECESSOR-YES-88         TO TRUE                DTSBD720
01897 *    END-IF.                                                      DTSBD720
01898 *                                                                 DTSBD720
01899 *    PERFORM                                                      DTSBD720
01900 *      VARYING XW-SUB FROM +1 BY +1                               DTSBD720
01901 *      UNTIL XW-SUB > +3                                          DTSBD720
01902 *         ADD MRWA-TOT-WAGE (XW-SUB)                              DTSBD720
01903 *                                TO XFER-TOT-WAGE (XW-SUB)        DTSBD720
01904 *         ADD MRWA-TAX-WAGE (XW-SUB)                              DTSBD720
01905 *                                TO XFER-TAX-WAGE (XW-SUB)        DTSBD720
01906 *    END-PERFORM.                                                 DTSBD720
01907 *                                                                 DTSBD720
01908 *P9210-EXIT.                                                      DTSBD720
01909 *    EXIT.                                                        DTSBD720
01910                                                                   DTSBD720
01911  P9300-CHECK-MSOL.                                                DTSBD720
01912      IF MSOL-INACT-WITHDRAWN-88                                   DTSBD720
01913          GO TO P9300-EXIT.                                        DTSBD720
01914                                                                   DTSBD720
01915      IF MSOL-FIRST-LIAB-YRQ > WRK-RTE-YR-END-YRQ                  DTSBD720
01916          GO TO P9300-EXIT.                                        DTSBD720
01917                                                                   DTSBD720
01918      IF MSOL-LAST-LIAB-YRQ < WRK-RTE-YR-START-YRQ                 DTSBD720
01919          GO TO P9300-EXIT.                                        DTSBD720
01920                                                                   DTSBD720
01921      SET WRK-LIAB-IN-RTE-YR-YES-88 TO TRUE.                       DTSBD720
01922  P9300-EXIT.                                                      DTSBD720
01923      EXIT.                                                        DTSBD720
01924                                                                   DTSBD720
01925 *P9400-UPDATE-MRCT.                                               DTSBD720
01926 *    ADD XFER-PRIOR-RESERVE TO MRCT-PRIOR-RESERVE-AMT.            DTSBD720
01927 *    ADD XFER-UI-TAX-AMT        TO MRCT-UI-TAX-PAID-AMT.          DTSBD720
01928 *    ADD XFER-BENEFITS-AMT      TO MRCT-BENEFITS-CHARGED-AMT.     DTSBD720
01929 *                                                                 DTSBD720
01930 *    PERFORM                                                      DTSBD720
01931 *      VARYING XW-SUB FROM +1 BY +1                               DTSBD720
01932 *      UNTIL XW-SUB > +3                                          DTSBD720
01933 *         ADD XFER-TOT-WAGE (XW-SUB)                              DTSBD720
01934 *                                TO MRCT-TOT-WAGE (XW-SUB)        DTSBD720
01935 *         ADD XFER-TAX-WAGE (XW-SUB)                              DTSBD720
01936 *                                TO MRCT-TAX-WAGE (XW-SUB)        DTSBD720
01937 *    END-PERFORM.                                                 DTSBD720
01938 *                                                                 DTSBD720
01939 *    SET MRCT-CHNG-SYSTEM-88 TO TRUE.                             DTSBD720
01940 *                                                                 DTSBD720
01941 *    MOVE MHDR-CURR-RUN-DATE TO MRCT-CHNG-DATE.                   DTSBD720
01942 *                                                                 DTSBD720
01943 *    MOVE MRCT-REC TO MSKL-REC.                                   DTSBD720
01944 *                                                                 DTSBD720
01945 *    PERFORM S910-REWRITE THRU S910-EXIT.                         DTSBD720
01946 *                                                                 DTSBD720
01947 *    PERFORM S9000-EMPLOYER-UPDATED THRU S9000-EXIT.              DTSBD720
01948 *                                                                 DTSBD720
01949 *P9400-EXIT.                                                      DTSBD720
01950 *    EXIT.                                                        DTSBD720
01951 *                                                                 DTSBD720
01952                                                                   DTSBD720
01953  T0000-TERMINATE.                                                 DTSBD720
01954      PERFORM S910-CLOSE THRU S910-EXIT.                           DTSBD720
01955                                                                   DTSBD720
01956      PERFORM S921-CLOSE THRU S921-EXIT.                           DTSBD720
01957                                                                   DTSBD720
01958      PERFORM S931-CLOSE THRU S931-EXIT.                           DTSBD720
01959                                                                   DTSBD720
01960      MOVE -1 TO R506-LENGTH.                                      DTSBD720
01961                                                                   DTSBD720
01962      PERFORM S946-WRITE-R506 THRU S946-EXIT.                      DTSBD720
01963                                                                   DTSBD720
01964      CLOSE RELATIONSHIP-FILE                                      DTSBD720
01965            CHARGE-FILE                                            DTSBD720
01966            BYPASS-FILE.                                           DTSBD720
01967                                                                   DTSBD720
01968      DISPLAY '***'.                                               DTSBD720
01969                                                                   DTSBD720
01970      DISPLAY '*** '                                               DTSBD720
01971              WRK-MOD-NAME                                         DTSBD720
01972              ' TERMINATION DISPLAYS'.                             DTSBD720
01973                                                                   DTSBD720
01974                                                                   DTSBD720
01975      MOVE WRK-RTE-YR-START-YRQ TO L004-QTR-5-9.                   DTSBD720
01976                                                                   DTSBD720
01977      PERFORM S004-FROM-5 THRU S004-EXIT.                          DTSBD720
01978                                                                   DTSBD720
01979      DISPLAY '***                RATE YEAR START QUARTER: '       DTSBD720
01980              L004-SLASH-5-QTR.                                    DTSBD720
01981                                                                   DTSBD720
01982                                                                   DTSBD720
01983      DISPLAY '***'.                                               DTSBD720
01984                                                                   DTSBD720
01985      MOVE WRK-RTE-YR-END-YRQ TO L004-QTR-5-9.                     DTSBD720
01986                                                                   DTSBD720
01987      PERFORM S004-FROM-5 THRU S004-EXIT.                          DTSBD720
01988                                                                   DTSBD720
01989      DISPLAY '***                  RATE YEAR END QUARTER: '       DTSBD720
01990              L004-SLASH-5-QTR.                                    DTSBD720
01991                                                                   DTSBD720
01992                                                                   DTSBD720
01993      DISPLAY '***'.                                               DTSBD720
01994                                                                   DTSBD720
01995      MOVE WRK-RTE-YR-START-DATE TO L001-FED-8-DATE-9.             DTSBD720
01996                                                                   DTSBD720
01997      PERFORM S001-FROM-FED-8 THRU S001-EXIT.                      DTSBD720
01998                                                                   DTSBD720
01999      DISPLAY '***                   RATE YEAR START DATE: '       DTSBD720
02000              L001-SLASH-8-DATE.                                   DTSBD720
02001                                                                   DTSBD720
02002                                                                   DTSBD720
02003      DISPLAY '***'.                                               DTSBD720
02004                                                                   DTSBD720
02005      MOVE WRK-RTE-YR-END-DATE TO L001-FED-8-DATE-9.               DTSBD720
02006                                                                   DTSBD720
02007      PERFORM S001-FROM-FED-8 THRU S001-EXIT.                      DTSBD720
02008                                                                   DTSBD720
02009      DISPLAY '***                     RATE YEAR END DATE: '       DTSBD720
02010              L001-SLASH-8-DATE.                                   DTSBD720
02011                                                                   DTSBD720
02012                                                                   DTSBD720
02013      DISPLAY '***'.                                               DTSBD720
02014                                                                   DTSBD720
02015      MOVE WRK-EXP-CUTOFF-DATE TO L001-FED-8-DATE-9.               DTSBD720
02016                                                                   DTSBD720
02017      PERFORM S001-FROM-FED-8 THRU S001-EXIT.                      DTSBD720
02018                                                                   DTSBD720
02019      DISPLAY '***          RATING EXPERIENCE CUTOFF DATE: '       DTSBD720
02020              L001-SLASH-8-DATE.                                   DTSBD720
02021                                                                   DTSBD720
02022                                                                   DTSBD720
02023      DISPLAY '***'.                                               DTSBD720
02024                                                                   DTSBD720
02025      MOVE RCT-REC-DELETE-CNT TO WRK-DISPLAY-CNT-9.                DTSBD720
02026                                                                   DTSBD720
02027      DISPLAY '***         NUMBER OF MRCT RECORDS DELETED: '       DTSBD720
02028              WRK-DISPLAY-CNT-X.                                   DTSBD720
02029                                                                   DTSBD720
02030      DISPLAY '***'.                                               DTSBD720
02031                                                                   DTSBD720
02032      MOVE RRA-REC-WRITE-CNT TO WRK-DISPLAY-CNT-9.                 DTSBD720
02033                                                                   DTSBD720
02034      DISPLAY '***         NUMBER OF MRRA RECORDS WRITTEN: '       DTSBD720
02035              WRK-DISPLAY-CNT-X.                                   DTSBD720
02036                                                                   DTSBD720
02037                                                                   DTSBD720
02038      DISPLAY '***'.                                               DTSBD720
02039                                                                   DTSBD720
02040  T0000-EXIT.                                                      DTSBD720
02041      EXIT.                                                        DTSBD720
02042      EJECT                                                        DTSBD720
02043  S1000-COMPLETE-R507.                                             DTSBD720
02044      IF R507-SUCC-EMP-NO = +0                                     DTSBD720
02045          MOVE SPACES TO R507-SUCC-PRIMARY-NAME                    DTSBD720
02046      ELSE                                                         DTSBD720
02047          MOVE LOW-VALUES TO MSKL-KEY-AREA                         DTSBD720
02048          MOVE R507-SUCC-EMP-NO TO MSKL-EMP-NO                     DTSBD720
02049          SET MSKL-PRF-88 TO TRUE                                  DTSBD720
02050          PERFORM S910-READ THRU S910-EXIT                         DTSBD720
02051          IF L910-NO-REC-88                                        DTSBD720
02052              MOVE 'NOT FOUND ON EMPLOYER MASTER FILE'             DTSBD720
02053                TO R507-SUCC-PRIMARY-NAME                          DTSBD720
02054          ELSE                                                     DTSBD720
02055              MOVE MSKL-REC TO MPRF-REC                            DTSBD720
02056              MOVE MPRF-PRIMARY-NAME TO R507-SUCC-PRIMARY-NAME.    DTSBD720
02057                                                                   DTSBD720
02058      IF R507-PRED-EMP-NO = +0                                     DTSBD720
02059          MOVE SPACES TO R507-PRED-PRIMARY-NAME                    DTSBD720
02060      ELSE                                                         DTSBD720
02061          MOVE LOW-VALUES TO MSKL-KEY-AREA                         DTSBD720
02062          MOVE R507-PRED-EMP-NO TO MSKL-EMP-NO                     DTSBD720
02063          SET MSKL-PRF-88 TO TRUE                                  DTSBD720
02064          PERFORM S910-READ THRU S910-EXIT                         DTSBD720
02065          IF L910-NO-REC-88                                        DTSBD720
02066              MOVE 'NOT FOUND ON EMPLOYER MASTER FILE'             DTSBD720
02067                TO R507-PRED-PRIMARY-NAME                          DTSBD720
02068          ELSE                                                     DTSBD720
02069              MOVE MSKL-REC TO MPRF-REC                            DTSBD720
02070              MOVE MPRF-PRIMARY-NAME TO R507-PRED-PRIMARY-NAME.    DTSBD720
02071                                                                   DTSBD720
02072      PERFORM S946-WRITE-R507 THRU S946-EXIT.                      DTSBD720
02073  S1000-EXIT.                                                      DTSBD720
02074      EXIT.                                                        DTSBD720
02075                                                                   DTSBD720
02076  S9000-EMPLOYER-UPDATED.                                          DTSBD720
02077      IF MPRF-UPDATE-ACTIVE-88                                     DTSBD720
02078          MOVE MSG99-MSG-IDENTIFIER TO R507-MSG-IDENTIFIER         DTSBD720
02079          MOVE MPRF-EMP-NO TO R507-SUCC-EMP-NO                     DTSBD720
02080          MOVE MPRF-PRIMARY-NAME TO R507-SUCC-PRIMARY-NAME         DTSBD720
02081          MOVE +0 TO R507-PRED-EMP-NO                              DTSBD720
02082          MOVE SPACES TO R507-PRED-PRIMARY-NAME                    DTSBD720
02083          MOVE MSG99-MSG-TEXT TO R507-MSG-TEXT                     DTSBD720
02084          PERFORM S946-WRITE-R507 THRU S946-EXIT                   DTSBD720
02085      ELSE                                                         DTSBD720
02086          MOVE WRK-SYS-ABSTIME TO MPRF-UPDATE-END-ABSTIME          DTSBD720
02087          MOVE +0 TO MPRF-UPDATE-TASK-ID                           DTSBD720
02088          MOVE 'BATCH' TO MPRF-UPDATE-OP-ID                        DTSBD720
02089          MOVE SPACES TO MPRF-UPDATE-TERMID                        DTSBD720
02090                         MPRF-UPDATE-NETNAME                       DTSBD720
02091          MOVE WRK-SYS-DATE TO MPRF-UPDATE-START-DATE              DTSBD720
02092          MOVE WRK-SYS-TIME TO MPRF-UPDATE-START-TIME              DTSBD720
02093          MOVE SPACES TO MPRF-UPDATE-SCR-ID                        DTSBD720
02094                         MPRF-UPDATE-FUNCTION                      DTSBD720
02095          MOVE MHDR-CURR-RUN-DATE TO MPRF-CHNG-DATE                DTSBD720
02096          MOVE MPRF-REC TO MSKL-REC                                DTSBD720
02097          PERFORM S910-REWRITE THRU S910-EXIT.                     DTSBD720
02098  S9000-EXIT.                                                      DTSBD720
02099      EXIT.                                                        DTSBD720
02100      EJECT                                                        DTSBD720
02101  S001-FROM-FED-8.                                                 DTSBD720
02102      SET L001-FROM-FED-8 TO TRUE.                                 DTSBD720
02103      GO TO S001-DATE.                                             DTSBD720
02104                                                                   DTSBD720
02105  S001-FROM-ABS-DAY.                                               DTSBD720
02106      SET L001-FROM-ABS-DAY TO TRUE.                               DTSBD720
02107      GO TO S001-DATE.                                             DTSBD720
02108                                                                   DTSBD720
02109  S001-DATE.                                                       DTSBD720
02110      CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBD720
02111  S001-EXIT.                                                       DTSBD720
02112      EXIT.                                                        DTSBD720
02113      SKIP3                                                        DTSBD720
02114  S004-FROM-5.                                                     DTSBD720
02115      SET L004-FROM-5 TO TRUE.                                     DTSBD720
02116      GO TO S004-QTR.                                              DTSBD720
02117                                                                   DTSBD720
02118  S004-FROM-ABS.                                                   DTSBD720
02119      SET L004-FROM-ABS TO TRUE.                                   DTSBD720
02120      GO TO S004-QTR.                                              DTSBD720
02121                                                                   DTSBD720
02122  S004-FROM-3.                                                     DTSBD720
02123      SET L004-FROM-3 TO TRUE.                                     DTSBD720
02124      GO TO S004-QTR.                                              DTSBD720
02125                                                                   DTSBD720
02126  S004-QTR.                                                        DTSBD720
02127      CALL 'DTSBU004' USING L004-LINK-AREA.                        DTSBD720
02128  S004-EXIT.                                                       DTSBD720
02129      EXIT.                                                        DTSBD720
02130      SKIP3                                                        DTSBD720
02131  S005-FROM-SYS.                                                   DTSBD720
02132      SET L005-FROM-SYS TO TRUE.                                   DTSBD720
02133      GO TO S005-ABSTIME.                                          DTSBD720
02134                                                                   DTSBD720
02135  S005-ABSTIME.                                                    DTSBD720
02136      CALL 'DTSBU005' USING L005-LINK-AREA.                        DTSBD720
02137  S005-EXIT.                                                       DTSBD720
02138      EXIT.                                                        DTSBD720
02139      SKIP3                                                        DTSBD720
02140  S006-FROM-QTR.                                                   DTSBD720
02141      SET L006-FROM-QTR TO TRUE.                                   DTSBD720
02142      GO TO S006-UI-RATE-YEAR.                                     DTSBD720
02143                                                                   DTSBD720
02144  S006-UI-RATE-YEAR.                                               DTSBD720
02145      CALL 'DTSBU006' USING L006-LINK-AREA.                        DTSBD720
02146  S006-EXIT.                                                       DTSBD720
02147      EXIT.                                                        DTSBD720
02148      SKIP3                                                        DTSBD720
02149  S055-FROM-QTR.                                                   DTSBD720
02150      SET L055-FROM-EFF-YRQ-88 TO TRUE.                            DTSBD720
02151      GO TO S055-EXP-PERIOD.                                       DTSBD720
02152                                                                   DTSBD720
02153  S055-EXP-PERIOD.                                                 DTSBD720
02154      CALL 'DTSBU055' USING L055-LINK-AREA.                        DTSBD720
02155  S055-EXIT.                                                       DTSBD720
02156      EXIT.                                                        DTSBD720
02157      SKIP3                                                        DTSBD720
02158  S910-OPEN-UPDATE.                                                DTSBD720
02159      SET L910-OPEN-UPDATE-88 TO TRUE.                             DTSBD720
02160      GO TO S910-MSTR-IO.                                          DTSBD720
02161                                                                   DTSBD720
02162  S910-READ.                                                       DTSBD720
02163      SET L910-READ-88 TO TRUE.                                    DTSBD720
02164      GO TO S910-MSTR-IO.                                          DTSBD720
02165                                                                   DTSBD720
02166  S910-START-BROWSE.                                               DTSBD720
02167      SET L910-START-BROWSE-88 TO TRUE.                            DTSBD720
02168      GO TO S910-MSTR-IO.                                          DTSBD720
02169                                                                   DTSBD720
02170  S910-READ-NEXT.                                                  DTSBD720
02171      SET L910-READ-NEXT-88 TO TRUE.                               DTSBD720
02172      GO TO S910-MSTR-IO.                                          DTSBD720
02173                                                                   DTSBD720
02174  S910-DELETE.                                                     DTSBD720
02175      SET L910-DELETE-88 TO TRUE.                                  DTSBD720
02176      GO TO S910-MSTR-IO.                                          DTSBD720
02177                                                                   DTSBD720
02178  S910-REWRITE.                                                    DTSBD720
02179      SET L910-REWRITE-88 TO TRUE.                                 DTSBD720
02180      GO TO S910-MSTR-IO.                                          DTSBD720
02181                                                                   DTSBD720
02182  S910-WRITE.                                                      DTSBD720
02183      SET L910-WRITE-88 TO TRUE.                                   DTSBD720
02184      GO TO S910-MSTR-IO.                                          DTSBD720
02185                                                                   DTSBD720
02186  S910-CLOSE.                                                      DTSBD720
02187      SET L910-CLOSE-88 TO TRUE.                                   DTSBD720
02188      GO TO S910-MSTR-IO.                                          DTSBD720
02189                                                                   DTSBD720
02190  S910-MSTR-IO.                                                    DTSBD720
02191      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBD720
02192 **   CALL 'DTSBU912' USING L910-LINK-AREA                         DTSBD720
02193                            MSKL-REC.                              DTSBD720
02194  S910-EXIT.                                                       DTSBD720
02195      EXIT.                                                        DTSBD720
02196      SKIP3                                                        DTSBD720
02197  S921-OPEN-READ.                                                  DTSBD720
02198      SET L921-OPEN-READ-88 TO TRUE.                               DTSBD720
02199      GO TO S921-AIX-I.                                            DTSBD720
02200                                                                   DTSBD720
02201  S921-READ.                                                       DTSBD720
02202      SET L921-READ-88 TO TRUE.                                    DTSBD720
02203      GO TO S921-AIX-I.                                            DTSBD720
02204                                                                   DTSBD720
02205  S921-START-BROWSE.                                               DTSBD720
02206      SET L921-START-BROWSE-88 TO TRUE.                            DTSBD720
02207      GO TO S921-AIX-I.                                            DTSBD720
02208                                                                   DTSBD720
02209  S921-READ-NEXT.                                                  DTSBD720
02210      SET L921-READ-NEXT-88 TO TRUE.                               DTSBD720
02211      GO TO S921-AIX-I.                                            DTSBD720
02212                                                                   DTSBD720
02213  S921-CLOSE.                                                      DTSBD720
02214      SET L921-CLOSE-88 TO TRUE.                                   DTSBD720
02215      GO TO S921-AIX-I.                                            DTSBD720
02216                                                                   DTSBD720
02217  S921-AIX-I.                                                      DTSBD720
02218      CALL 'DTSBU921' USING L921-LINK-AREA                         DTSBD720
02219                            ISKL-REC.                              DTSBD720
02220  S921-EXIT.                                                       DTSBD720
02221      EXIT.                                                        DTSBD720
02222      SKIP3                                                        DTSBD720
02223  S931-OPEN-READ.                                                  DTSBD720
02224      SET L931-OPEN-READ-88 TO TRUE.                               DTSBD720
02225      GO TO S931-REF-I.                                            DTSBD720
02226                                                                   DTSBD720
02227  S931-READ.                                                       DTSBD720
02228      SET L931-READ-88 TO TRUE.                                    DTSBD720
02229      GO TO S931-REF-I.                                            DTSBD720
02230                                                                   DTSBD720
02231  S931-CLOSE.                                                      DTSBD720
02232      SET L931-CLOSE-88 TO TRUE.                                   DTSBD720
02233      GO TO S931-REF-I.                                            DTSBD720
02234                                                                   DTSBD720
02235  S931-REF-I.                                                      DTSBD720
02236      CALL 'DTSBU931' USING L931-LINK-AREA                         DTSBD720
02237                            FSKL-REC.                              DTSBD720
02238  S931-EXIT.                                                       DTSBD720
02239      EXIT.                                                        DTSBD720
02240      SKIP3                                                        DTSBD720
02241  S946-WRITE-R506.                                                 DTSBD720
02242      CALL 'DTSBU946' USING R506-REC.                              DTSBD720
02243      GO TO S946-EXIT.                                             DTSBD720
02244                                                                   DTSBD720
02245  S946-WRITE-R507.                                                 DTSBD720
02246      CALL 'DTSBU946' USING R507-REC.                              DTSBD720
02247      GO TO S946-EXIT.                                             DTSBD720
02248                                                                   DTSBD720
02249  S946-EXIT.                                                       DTSBD720
02250      EXIT.                                                        DTSBD720
02251      SKIP3                                                        DTSBD720
02252  S999-ABEND.                                                      DTSBD720
02253      DISPLAY '***'.                                               DTSBD720
02254                                                                   DTSBD720
02255      DISPLAY '*** '                                               DTSBD720
02256              WRK-MOD-NAME                                         DTSBD720
02257              ' IS ABENDING BECAUSE '                              DTSBD720
02258              ABEND-MSG.                                           DTSBD720
02259                                                                   DTSBD720
02260      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBD720
02261  S999-EXIT.                                                       DTSBD720
02262      EXIT.                                                        DTSBD720
