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