00001  IDENTIFICATION DIVISION.                                         07/18/11
00002  PROGRAM-ID.             DTSBD790.                                DTSBD790
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV032
00004  DATE-WRITTEN.           SPETEMBER 1994.                          DTSBD790
00005  DATE-COMPILED.                                                   DTSBD790
00006      SKIP3                                                        DTSBD790
00007 *****                                                             DTSBD790
00008 *                                                                 DTSBD790
00009 *    FUNCTION:  PRODUCE ETA-204 REPORT RECORDS.                   DTSBD790
00010 *                                                                 DTSBD790
00011 *                                                                 DTSBD790
00012 *    MODIFICATION LOG:                                            DTSBD790
00013 *                                                                 DTSBD790
00014 *    12/22/97  MODIFIED TO REFLECT THE 07/30/97 ETA 204 FEDERAL   DTSBD790
00015 *              SPECIFICATION (ET HANDBOOK 401, 2ND EDITION,       DTSBD790
00016 *              CHANGE 13, DATED 07/30/97).                        DTSBD790
00017 *              WORK ORDER: TCL 225              PROGRAMMER: EHH   DTSBD790
00018 *                                                                 DTSBD790
00019 *    04/23/1999  REVIEWIED AND MODIFIED FOR DC.                   DTSBD790
00020 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH   DTSBD790
00021 *                                                                 DTSBD790
00022 *    11/23/1999  P2000-PROCESS-CHARGE MODIFIED FOR CORRECT        DTSBD790
00023 *                HANDLING OF POOL ACCOUNTS.                       DTSBD790
00024 *                REFERENCE:                     PROGRAMMER: GD    DTSBD790
00025 *                                                                 DTSBD790
00026 *    08/05/2002  MODIFIED PGM. TO READ CHGM002 VSAM DIRECTLY      DTSBD790
00027 *                INSTEAD USING BENEFIT TAPE READ-IN PROCESSES     DTSBD790
00028 *                TO SUMMARIZE BENEFIT PAID ON LINE6A, LINE6B,     DTSBD790
00029 *                AND LINE7A ON PARAGRAPH P2000-PROCESS-CHARGE.    DTSBD790
00030 *                REFERENCE: HOUSEHOLD           PROGRAMMER: RW1   DTSBD790
00031 *                                                                 DTSBD790
00032 *    08/11/2006  MODIFIED FOR NEW FORMAT OF DOWNLOAD FILE FOR     DTSBD790
00033 *                SECTION C EXPERIENCE RATING DATA.                DTSBD790
00034 *                REFERENCE: REQUIREMENT         PROGRAMMER: GD    DTSBD790
00035 *                                                                 DTSBD790
00036 *    04/13/2007  CHANGED MEANING OF 'COMPUTATION DATE' AT THE     DTSBD790
00037 *                TOP OF THE REPORT.  IT NOW CONTAINS THE          DTSBD790
00038 *                COMPUTATION DATE FOR THE RATE YEAR - JUNE 30     DTSBD790
00039 *                OF THE YEAR PRIOR TO THE RATING YEAR.            DTSBD790
00040 *                THE CHANGE WAS NEEDED TO COMPLY WITH EDITS       DTSBD790
00041 *                IN THE SOFTWARE USED TO TRANSMIT THE REPORT.     DTSBD790
00042 *                REFERENCE:                     PROGRAMMER: GD    DTSBD790
00043 *                                                                 DTSBD790
00044 *    04/14/2010  RECOMPILE FOR NEW VERSION OF CHGIM030            DTSBD790
00045 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: Z1L   DTSBD790
00046 *                                                                 DTSBD790
00047 *    XX/XX/XXXX  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBD790
00048 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBD790
00049 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSBD790
00050 *                                                                 DTSBD790
00051 *                                                                 DTSBD790
00052 *  DESCRIPTION:                                                   DTSBD790
00053 *                                                                 DTSBD790
00054 *      ASSEMBLES THE INFORMATION NEEDED FOR THE FEDERAL ETA       DTSBD790
00055 *      204 (EXPERIENCE RATING REPORT) REPORT.                     DTSBD790
00056 *                                                                 DTSBD790
00057 *                                                                 DTSBD790
00058 *      PARAMETERS INPUT:                                          DTSBD790
00059 *                                                                 DTSBD790
00060 *        RATE EFFECTIVE QUARTER IS THE QUARTER ASSOCIATED         DTSBD790
00061 *        WITH MHDR-LAST-RATE-END-YRQ (THIS JOB RUNS AFTER         DTSBD790
00062 *        RATES ARE ASSIGNED).                                     DTSBD790
00063 *                                                                 DTSBD790
00064 *        THIS REPORT IS A HORRIBLE MESS.                          DTSBD790
00065 *                                                                 DTSBD790
00066 *        MY BEST ADVICE IS TO PRAY.                               DTSBD790
00067 *                                                                 DTSBD790
00068 *                                                                 DTSBD790
00069 *      TAPES INPUT:                                               DTSBD790
00070 *                                                                 DTSBD790
00071 *        QUARTERLY BENEFIT CHARGES.                               DTSBD790
00072 *                                                                 DTSBD790
00073 *                                                                 DTSBD790
00074 *      MASTER FILE RECORDS READ:                                  DTSBD790
00075 *                                                                 DTSBD790
00076 *        MPRF                                                     DTSBD790
00077 *        MHDR                                                     DTSBD790
00078 *        MSOL                                                     DTSBD790
00079 *        MQTR                                                     DTSBD790
00080 *        MRCT                                                     DTSBD790
00081 *                                                                 DTSBD790
00082 *                                                                 DTSBD790
00083 *      ALTERNATE INDEX FILE RECORDS READ:                         DTSBD790
00084 *                                                                 DTSBD790
00085 *        NONE                                                     DTSBD790
00086 *                                                                 DTSBD790
00087 *                                                                 DTSBD790
00088 *      REFERENCE FILE RECORDS READ:                               DTSBD790
00089 *                                                                 DTSBD790
00090 *        FCYR                                                     DTSBD790
00091 *        FUIR                                                     DTSBD790
00092 *                                                                 DTSBD790
00093 *                                                                 DTSBD790
00094 *      MASTER FILE RECORDS UPDATED:                               DTSBD790
00095 *                                                                 DTSBD790
00096 *        NONE.                                                    DTSBD790
00097 *                                                                 DTSBD790
00098 *                                                                 DTSBD790
00099 *      REPORT RECORDS WRITTEN:                                    DTSBD790
00100 *                                                                 DTSBD790
00101 *        R517  ETA-204 EXTRACT.                                   DTSBD790
00102 *                                                                 DTSBD790
00103 *                                                                 DTSBD790
00104 *      MODULES CALLED:                                            DTSBD790
00105 *                                                                 DTSBD790
00106 *        DTSBU001  DATE EDIT/DESCRIPTION.                         DTSBD790
00107 *        DTSBU004  QUARTER EDIT/CONVERSION.                       DTSBD790
00108 *        DTSBU006  RATING YEAR PERIOD START/END.                  DTSBD790
00109 *        DTSBU055  UI RATE EXPERIENCE PERIOD.                     DTSBD790
00110 *        DTSBU910  MASTER FILE I/O.                               DTSBD790
00111 *        DTSBU931  REFERENCE FILE I/O.                            DTSBD790
00112 *        DTSBU946  VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 1.    DTSBD790
00113 *                                                                 DTSBD790
00114 *                                                                 DTSBD790
00115 *****                                                             DTSBD790
00116      SKIP3                                                        DTSBD790
00117  ENVIRONMENT DIVISION.                                            DTSBD790
00118      SKIP2                                                        DTSBD790
00119  INPUT-OUTPUT SECTION.                                            DTSBD790
00120                                                                   DTSBD790
00121  FILE-CONTROL.                                                    DTSBD790
00122      SELECT BEN-CHG-FILE-IN ASSIGN TO BENCHRGI                    DTSBD790
00123             ORGANIZATION IS INDEXED                               DTSBD790
00124             ACCESS MODE IS DYNAMIC                                DTSBD790
00125             RECORD KEY IS CHG2-KEY-AREA                           DTSBD790
00126             FILE STATUS IS BEN-CHG-STATUS.                        DTSBD790
00127                                                                   DTSBD790
00128      SELECT ETA204-DOWNLOAD ASSIGN TO RPT517R3                    DTSBD790
00129             FILE STATUS IS DWNLD-STATUS.                          DTSBD790
00130                                                                   DTSBD790
00131  DATA DIVISION.                                                   DTSBD790
00132      SKIP3                                                        DTSBD790
00133  FILE SECTION.                                                    DTSBD790
00134      SKIP3                                                        DTSBD790
00135  FD  BEN-CHG-FILE-IN                                              DTSBD790
00136      RECORD CONTAINS 64 CHARACTERS                                DTSBD790
00137      DATA RECORD IS BEN-CHG-REC.                                  DTSBD790
00138  01  BEN-CHG-REC.                                                 DTSBD790
00139  ++INCLUDE CHGIM002                                               DTSBD790
00140                                                                   DTSBD790
00141  FD  ETA204-DOWNLOAD                                              DTSBD790
00142      RECORDING MODE IS F                                          DTSBD790
00143      BLOCK CONTAINS 0 RECORDS                                     DTSBD790
00144      LABEL RECORDS ARE OMITTED.                                   DTSBD790
00145  01  ETA204-DOWNLOAD-REC             PIC  X(80).                  DTSBD790
00146                                                                   DTSBD790
00147  WORKING-STORAGE SECTION.                                         DTSBD790
001475 77  PAN-VALET PICTURE X(24) VALUE '032DTSBD790  07/18/11'.       DTSBD790
00148      SKIP3                                                        DTSBD790
00149  01  WRK-AREA.                                                    DTSBD790
00150 *&                                                                DTSBD790
00151      05  WRK-CHG-AMT                  PIC S9(11)V9(02)  COMP-3.   DTSBD790
00152      05  WRK-NEG6B-TOT                PIC S9(11)V9(02)  COMP-3    DTSBD790
00153                                           VALUE +0.               DTSBD790
00154      05  WRK-POS6B-TOT                PIC S9(11)V9(02)  COMP-3    DTSBD790
00155                                           VALUE +0.               DTSBD790
00156 *&                                                                DTSBD790
00157      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +790.DTSBD790
00158                                                                   DTSBD790
00159      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBD790'.DTSBD790
00160                                                                   DTSBD790
00161      05  WRK-ELG-REG-OCC-MAX         PIC S9(04)  COMP VALUE +70.  DTSBD790
00162                                                                   DTSBD790
00163                                                                   DTSBD790
00164      05  ABEND-MSG                   PIC  X(60).                  DTSBD790
00165                                                                   DTSBD790
00166                                                                   DTSBD790
00167      05  FILE-COMMAND                 PIC  X(10).                 DTSBD790
00168                                                                   DTSBD790
00169      05  BEN-CHG-STATUS               PIC  X(02) VALUE SPACES.    DTSBD790
00170          88  BEN-FILE-OK-88                  VALUE ZERO.          DTSBD790
00171          88  BEN-FILE-EOF-88                 VALUE '10'.          DTSBD790
00172 **       88  BEN-FILE-EOF-88                 VALUE '10' '23'.     DTSBD790
00173                                                                   DTSBD790
00174      05  DWNLD-STATUS                 PIC  X(02) VALUE SPACES.    DTSBD790
00175          88  DWNLD-STATUS-OK-88              VALUE '00'.          DTSBD790
00176                                                                   DTSBD790
00177      05  WRK-BEN-CHG-READ             PIC S9(09)  COMP-3 VALUE +0.DTSBD790
00178                                                                   DTSBD790
00179      05  WRK-CHARGE-CURR-AMT          PIC S9(11)V9(02)  COMP-3.   DTSBD790
00180                                                                   DTSBD790
00181      05  WRK-SELECTED-REC-CNT         PIC S9(09)  COMP-3.         DTSBD790
00182                                                                   DTSBD790
00183      05  WRK-SELECTED-CHARGE-CURR-AMT PIC S9(11)V9(02)  COMP-3.   DTSBD790
00184                                                                   DTSBD790
00185                                                                   DTSBD790
00186      05  DISPLAY-CNT-X                PIC  X(11).                 DTSBD790
00187                                                                   DTSBD790
00188      05  DISPLAY-CNT REDEFINES DISPLAY-CNT-X                      DTSBD790
00189                                       PIC  ZZZ,ZZZ,ZZ9.           DTSBD790
00190                                                                   DTSBD790
00191      05  DISPLAY-AMT-X                PIC  X(17).                 DTSBD790
00192                                                                   DTSBD790
00193      05  DISPLAY-AMT REDEFINES DISPLAY-AMT-X                      DTSBD790
00194                                       PIC ------,---,--9.99.      DTSBD790
00195                                                                   DTSBD790
00196      05  DISPLAY-AMT1-X                PIC  X(17).                DTSBD790
00197                                                                   DTSBD790
00198      05  DISPLAY-AMT1 REDEFINES DISPLAY-AMT1-X                    DTSBD790
00199                                       PIC ------,---,--9.99.      DTSBD790
00200                                                                   DTSBD790
00201                                                                   DTSBD790
00202      05  WRK-RTE-YR-START-YRQ         PIC S9(05)  COMP-3.         DTSBD790
00203                                                                   DTSBD790
00204      05  WRK-RTE-YR-END-YRQ           PIC S9(05)  COMP-3.         DTSBD790
00205                                                                   DTSBD790
00206      05  WRK-RTE-YR-START-DATE        PIC S9(09)  COMP-3.         DTSBD790
00207                                                                   DTSBD790
00208      05  WRK-RTE-YR-END-DATE          PIC S9(09)  COMP-3.         DTSBD790
00209                                                                   DTSBD790
00210      05  WRK-COMPUTATION-DATE         PIC S9(09)  COMP-3.         DTSBD790
00211                                                                   DTSBD790
00212      05  WRK-NUMBER-AS-OF-DATE        PIC S9(09)  COMP-3.         DTSBD790
00213                                                                   DTSBD790
00214      05  WRK-PAYROLL-YEAR-END-DATE    PIC S9(09)  COMP-3.         DTSBD790
00215                                                                   DTSBD790
00216      05  WRK-PAYROLL-START-YRQ        PIC S9(05)  COMP-3.         DTSBD790
00217                                                                   DTSBD790
00218      05  WRK-PAYROLL-END-YRQ          PIC S9(05)  COMP-3.         DTSBD790
00219                                                                   DTSBD790
00220      05  WRK-BEN-CHRG-YEAR-START-DATE PIC S9(09)  COMP-3.         DTSBD790
00221                                                                   DTSBD790
00222      05  WRK-BEN-CHRG-YEAR-END-DATE   PIC S9(09)  COMP-3.         DTSBD790
00223                                                                   DTSBD790
00224      05  SUB                          PIC S9(04)  COMP.           DTSBD790
00225                                                                   DTSBD790
00226      05  ACTIVE-AT-COMPUTATION-DATE-IND PIC X(01).                DTSBD790
00227                                                                   DTSBD790
00228      05  DOWNLOAD-DATA-AREA.                                      DTSBD790
00229          10  DWN-RPT-DATE             PIC 9(08).                  DTSBD790
00230          10  DWN-AVG-RATE-AREA.                                   DTSBD790
00231              15  DWN-AVG-RATE         PIC 9.99.                   DTSBD790
00232              15  DWN-CONTRIB          PIC 9(11).                  DTSBD790
00233              15  DWN-TAX-WAGE         PIC 9(11).                  DTSBD790
00234              15  DWN-AVERAGE          PIC S9(01)V9(04).           DTSBD790
00235          10  DWN-COUNT                PIC 9(11).                  DTSBD790
00236          10  DWN-COUNT-DISP REDEFINES DWN-COUNT                   DTSBD790
00237                                       PIC X(11).                  DTSBD790
00238          10  DWN-TOTAL                PIC S9(11) COMP-3.          DTSBD790
00239          10  DWN-TOTAL-DISP           PIC 9(11).                  DTSBD790
00240          10  DWN-TOTAL-DISP-X REDEFINES DWN-TOTAL-DISP            DTSBD790
00241                                       PIC X(11).                  DTSBD790
00242          10  SUB1                     PIC S9(04) COMP.            DTSBD790
00243          10  SUB2                     PIC S9(04) COMP.            DTSBD790
00244                                                                   DTSBD790
00245      EJECT                                                        DTSBD790
00246 ***INCLUDE ESPRPT04                                               DTSBD790
00247 ***  EJECT                                                        DTSBD790
00248  01  L910-LINK-AREA.                                              DTSBD790
00249  ++INCLUDE DTSIL910                                               DTSBD790
00250      SKIP3                                                        DTSBD790
00251  01  MSKL-REC.                                                    DTSBD790
00252  ++INCLUDE DTSIMSKL                                               DTSBD790
00253      SKIP3                                                        DTSBD790
00254  01  MHDR-REC.                                                    DTSBD790
00255  ++INCLUDE DTSIMHDR                                               DTSBD790
00256      SKIP3                                                        DTSBD790
00257  01  MPRF-REC.                                                    DTSBD790
00258  ++INCLUDE DTSIMPRF                                               DTSBD790
00259      SKIP3                                                        DTSBD790
00260  01  MSOL-REC.                                                    DTSBD790
00261  ++INCLUDE DTSIMSOL                                               DTSBD790
00262      SKIP3                                                        DTSBD790
00263  01  MQTR-REC.                                                    DTSBD790
00264  ++INCLUDE DTSIMQTR                                               DTSBD790
00265      SKIP3                                                        DTSBD790
00266  01  MRCT-REC.                                                    DTSBD790
00267  ++INCLUDE DTSIMRCT                                               DTSBD790
00268      EJECT                                                        DTSBD790
00269  01  L931-LINK-AREA.                                              DTSBD790
00270  ++INCLUDE DTSIL931                                               DTSBD790
00271      SKIP3                                                        DTSBD790
00272  01  L941-LINK-AREA.                                              DTSBD790
00273  ++INCLUDE DTSIL941                                               DTSBD790
00274      SKIP3                                                        DTSBD790
00275  01  RSK3-REC.                                                    DTSBD790
00276  ++INCLUDE DTSIRSK3                                               DTSBD790
00277      SKIP3                                                        DTSBD790
00278  01  FSKL-REC.                                                    DTSBD790
00279  ++INCLUDE DTSIFSKL                                               DTSBD790
00280      SKIP3                                                        DTSBD790
00281  01  FUIR-REC.                                                    DTSBD790
00282  ++INCLUDE DTSIFUIR                                               DTSBD790
00283      SKIP3                                                        DTSBD790
00284  01  FCYR-REC.                                                    DTSBD790
00285  ++INCLUDE DTSIFCYR                                               DTSBD790
00286      EJECT                                                        DTSBD790
00287  01  R517-REC.                                                    DTSBD790
00288  ++INCLUDE DTSIR517                                               DTSBD790
00289      EJECT                                                        DTSBD790
00290  01  R530-REC.                                                    DTSBD790
00291  ++INCLUDE DTSIR530                                               DTSBD790
00292  01  ACCUMULATOR-AREAS.                                           DTSBD790
00293      05  ACCUM-LINE1A-TOT-WAGES          PIC S9(11)V9(02)  COMP-3.DTSBD790
00294      05  ACCUM-LINE1A-TAX-WAGES          PIC S9(11)V9(02)  COMP-3.DTSBD790
00295                                                                   DTSBD790
00296      05  ACCUM-LINE1B-TOT-WAGES          PIC S9(11)V9(02)  COMP-3.DTSBD790
00297      05  ACCUM-LINE1B-TAX-WAGES          PIC S9(11)V9(02)  COMP-3.DTSBD790
00298                                                                   DTSBD790
00299      05  ACCUM-LINE2-TOT-WAGES           PIC S9(11)V9(02)  COMP-3.DTSBD790
00300                                                                   DTSBD790
00301      05  ACCUM-LINE3A-TOT-WAGES          PIC S9(11)V9(02)  COMP-3.DTSBD790
00302      05  ACCUM-LINE3A-TAX-WAGES          PIC S9(11)V9(02)  COMP-3.DTSBD790
00303                                                                   DTSBD790
00304      05  ACCUM-LINE3B-TOT-WAGES          PIC S9(11)V9(02)  COMP-3.DTSBD790
00305      05  ACCUM-LINE3B-TAX-WAGES          PIC S9(11)V9(02)  COMP-3.DTSBD790
00306                                                                   DTSBD790
00307      05  ACCUM-LINE4A-TOT-WAGES          PIC S9(11)V9(02)  COMP-3.DTSBD790
00308      05  ACCUM-LINE4A-TAX-WAGES          PIC S9(11)V9(02)  COMP-3.DTSBD790
00309                                                                   DTSBD790
00310      05  ACCUM-LINE4B-TOT-WAGES          PIC S9(11)V9(02)  COMP-3.DTSBD790
00311      05  ACCUM-LINE4B-TAX-WAGES          PIC S9(11)V9(02)  COMP-3.DTSBD790
00312                                                                   DTSBD790
00313      05  ACCUM-LINE6A-CHARGES            PIC S9(09)V9(02)  COMP-3.DTSBD790
00314      05  ACCUM-LINE6A1-CHARGES           PIC S9(09)V9(02)  COMP-3.DTSBD790
00315      05  ACCUM-LINE6B-CHARGES            PIC S9(09)V9(02)  COMP-3.DTSBD790
00316      05  ACCUM-LINE7A-CHARGES            PIC S9(09)V9(02)  COMP-3.DTSBD790
00317      05  ACCUM-LINE7B-CHARGES            PIC S9(09)V9(02)  COMP-3.DTSBD790
00318      05  W-TOT-MRCT-CHG                  PIC S9(09)V9(02)  COMP-3 DTSBD790
00319                                             VALUE +0.             DTSBD790
00320      05  W-TOT-ACT-MRCT-CHG              PIC S9(09)V9(02)  COMP-3 DTSBD790
00321                                             VALUE +0.             DTSBD790
00322                                                                   DTSBD790
00323      05  ACCUM-ELG-REG-SUB               PIC S9(04)        COMP.  DTSBD790
00324                                                                   DTSBD790
00325      05  ACCUM-ELG-REG-OCC                                        DTSBD790
00326          OCCURS 70 TIMES                                          DTSBD790
00327          INDEXED BY ACCUM-ELG-REG-IDX.                            DTSBD790
00328          10  ACCUM-ELG-REG-MIN-RATIO     PIC S9(02)V9(05)  COMP-3.DTSBD790
00329          10  ACCUM-ELG-REG-MAX-RATIO     PIC S9(02)V9(05)  COMP-3.DTSBD790
00330          10  ACCUM-ELG-REG-EMPLR-CNT     PIC S9(07)        COMP-3.DTSBD790
00331          10  ACCUM-ELG-REG-TOT-WAGE      PIC S9(11)V9(02)  COMP-3.DTSBD790
00332          10  ACCUM-ELG-REG-TAX-WAGE      PIC S9(11)V9(02)  COMP-3.DTSBD790
00333          10  ACCUM-ELG-REG-BEN-CHARGED   PIC S9(09)V9(02)  COMP-3.DTSBD790
00334          10  ACCUM-ELG-REG-EST-UI-PAID   PIC S9(09)V9(02)  COMP-3.DTSBD790
00335                                                                   DTSBD790
00336      05  TOTAL-ELG-REG.                                           DTSBD790
00337          10  TOTAL-ELG-REG-EMPLR-CNT     PIC S9(07)        COMP-3.DTSBD790
00338          10  TOTAL-ELG-REG-TOT-WAGE      PIC S9(11)V9(02)  COMP-3.DTSBD790
00339          10  TOTAL-ELG-REG-TAX-WAGE      PIC S9(11)V9(02)  COMP-3.DTSBD790
00340          10  TOTAL-ELG-REG-BEN-CHARGED   PIC S9(09)V9(02)  COMP-3.DTSBD790
00341          10  TOTAL-ELG-REG-EST-UI-PAID   PIC S9(09)V9(02)  COMP-3.DTSBD790
00342                                                                   DTSBD790
00343      05  ACCUM-ELG-SPECIAL-OCC.                                   DTSBD790
00344          10  ACCUM-ELG-SPECIAL-EMPLR-CNT                          DTSBD790
00345                                          PIC S9(07)        COMP-3.DTSBD790
00346          10  ACCUM-ELG-SPECIAL-TOT-WAGE                           DTSBD790
00347                                          PIC S9(11)V9(02)  COMP-3.DTSBD790
00348          10  ACCUM-ELG-SPECIAL-TAX-WAGE                           DTSBD790
00349                                          PIC S9(11)V9(02)  COMP-3.DTSBD790
00350          10  ACCUM-ELG-SPECIAL-BEN-CHARGED                        DTSBD790
00351                                          PIC S9(09)V9(02)  COMP-3.DTSBD790
00352          10  ACCUM-ELG-SPECIAL-EST-UI-PAID                        DTSBD790
00353                                          PIC S9(09)V9(02)  COMP-3.DTSBD790
00354                                                                   DTSBD790
00355      05  ACCUM-INELG-OCC.                                         DTSBD790
00356          10  ACCUM-INELG-EMPLR-CNT                                DTSBD790
00357                                          PIC S9(07)        COMP-3.DTSBD790
00358          10  ACCUM-INELG-TOT-WAGE                                 DTSBD790
00359                                          PIC S9(11)V9(02)  COMP-3.DTSBD790
00360          10  ACCUM-INELG-TAX-WAGE                                 DTSBD790
00361                                          PIC S9(11)V9(02)  COMP-3.DTSBD790
00362          10  ACCUM-INELG-BEN-CHARGED                              DTSBD790
00363                                          PIC S9(09)V9(02)  COMP-3.DTSBD790
00364          10  ACCUM-INELG-EST-UI-PAID                              DTSBD790
00365                                          PIC S9(09)V9(02)  COMP-3.DTSBD790
00366      EJECT                                                        DTSBD790
00367  01  L001-LINK-AREA.                                              DTSBD790
00368  ++INCLUDE DTSIL001                                               DTSBD790
00369      SKIP3                                                        DTSBD790
00370  01  L004-LINK-AREA.                                              DTSBD790
00371  ++INCLUDE DTSIL004                                               DTSBD790
00372      SKIP3                                                        DTSBD790
00373  01  L006-LINK-AREA.                                              DTSBD790
00374  ++INCLUDE DTSIL006                                               DTSBD790
00375      SKIP3                                                        DTSBD790
00376  01  L054-LINK-AREA.                                              DTSBD790
00377  ++INCLUDE DTSIL054                                               DTSBD790
00378      SKIP3                                                        DTSBD790
00379  01  L055-LINK-AREA.                                              DTSBD790
00380  ++INCLUDE DTSIL055                                               DTSBD790
00381      EJECT                                                        DTSBD790
00382  01  MMAX-LITERALS.                                               DTSBD790
00383  ++INCLUDE DTSIMMAX                                               DTSBD790
00384      EJECT                                                        DTSBD790
00385  LINKAGE SECTION.                                                 DTSBD790
00386      SKIP3                                                        DTSBD790
00387  01  PARM-AREA.                                                   DTSBD790
00388      05  PARM-LENGTH                PIC S9(04)  COMP.             DTSBD790
00389      05  PARM-DATA.                                               DTSBD790
00390          10  PARM-RTE-YR-START-YRQ  PIC  X(03).                   DTSBD790
00391      EJECT                                                        DTSBD790
00392  PROCEDURE DIVISION USING PARM-AREA.                              DTSBD790
00393                                                                   DTSBD790
00394                                                                   DTSBD790
00395      PERFORM I0000-INITIATE THRU I0000-EXIT.                      DTSBD790
00396                                                                   DTSBD790
00397                                                                   DTSBD790
00398      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSBD790
00399                                                                   DTSBD790
00400      MOVE +0 TO MSKL-EMP-NO.                                      DTSBD790
00401                                                                   DTSBD790
00402      SET MSKL-PRF-88 TO TRUE.                                     DTSBD790
00403                                                                   DTSBD790
00404      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBD790
00405                                                                   DTSBD790
00406      PERFORM                                                      DTSBD790
00407          UNTIL L910-NO-REC-88                                     DTSBD790
00408            MOVE MSKL-REC TO MPRF-REC                              DTSBD790
00409            PERFORM P1000-PROCESS-TAX THRU P1000-EXIT              DTSBD790
00410            MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA                    DTSBD790
00411            PERFORM S910-READ-NEXT THRU S910-EXIT                  DTSBD790
00412      END-PERFORM.                                                 DTSBD790
00413                                                                   DTSBD790
00414      PERFORM P2000-PROCESS-CHARGE THRU P2000-EXIT.                DTSBD790
00415                                                                   DTSBD790
00416      PERFORM T0000-TERMINATE THRU T0000-EXIT.                     DTSBD790
00417      SKIP2                                                        DTSBD790
00418      GOBACK.                                                      DTSBD790
00419      EJECT                                                        DTSBD790
00420  I0000-INITIATE.                                                  DTSBD790
00421      PERFORM S910-OPEN-READ THRU S910-EXIT.                       DTSBD790
00422                                                                   DTSBD790
00423      PERFORM S931-OPEN-READ THRU S931-EXIT.                       DTSBD790
00424                                                                   DTSBD790
00425      PERFORM S941-OPEN-READ THRU S941-EXIT.                       DTSBD790
00426                                                                   DTSBD790
00427      PERFORM SBCF-OPEN-INPUT THRU SBCF-EXIT.                      DTSBD790
00428                                                                   DTSBD790
00429      PERFORM SDWN01-OPEN     THRU SDWN01-EXIT.                    DTSBD790
00430                                                                   DTSBD790
00431      MOVE +0 TO WRK-BEN-CHG-READ                                  DTSBD790
00432                 WRK-CHARGE-CURR-AMT                               DTSBD790
00433                 WRK-SELECTED-REC-CNT                              DTSBD790
00434                 WRK-SELECTED-CHARGE-CURR-AMT.                     DTSBD790
00435                                                                   DTSBD790
00436                                                                   DTSBD790
00437      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSBD790
00438                                                                   DTSBD790
00439      MOVE +0 TO MSKL-EMP-NO.                                      DTSBD790
00440                                                                   DTSBD790
00441      SET MSKL-HDR-88 TO TRUE.                                     DTSBD790
00442                                                                   DTSBD790
00443      PERFORM S910-READ THRU S910-EXIT.                            DTSBD790
00444                                                                   DTSBD790
00445      IF L910-NO-REC-88                                            DTSBD790
00446          MOVE 'MHDR RECORD NOT FOUND'                             DTSBD790
00447            TO ABEND-MSG                                           DTSBD790
00448          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD790
00449                                                                   DTSBD790
00450      MOVE MSKL-REC TO MHDR-REC.                                   DTSBD790
00451                                                                   DTSBD790
00452                                                                   DTSBD790
00453      PERFORM I1000-PROCESS-PARMS THRU I1000-EXIT.                 DTSBD790
00454                                                                   DTSBD790
00455                                                                   DTSBD790
00456      PERFORM I2000-SET-WRK-AREAS THRU I2000-EXIT.                 DTSBD790
00457                                                                   DTSBD790
00458                                                                   DTSBD790
00459      PERFORM I3000-INITIALIZE-R517 THRU I3000-EXIT.               DTSBD790
00460                                                                   DTSBD790
00461      PERFORM S941-READ-NEXT THRU S941-EXIT.                       DTSBD790
00462                                                                   DTSBD790
00463       IF L941-NO-REC-88                                           DTSBD790
00464          DISPLAY '**** ERROR ON TAX-RATE-FILE '                   DTSBD790
00465       ELSE                                                        DTSBD790
00466       IF RSK3-REC-TYPE = '530'                                    DTSBD790
00467          MOVE RSK3-REC TO R530-REC                                DTSBD790
00468          MOVE  R530-YR-2-AVG-TAX-RATE TO                          DTSBD790
00469                   R517-YR-2-AVG-TAX-RATE                          DTSBD790
00470          MOVE  R530-YR-2-AVG-TOT-RATE TO                          DTSBD790
00471                   R517-YR-2-AVG-TOT-RATE                          DTSBD790
00472          DISPLAY 'R530 TAX ' R530-YR-2-AVG-TAX-RATE               DTSBD790
00473          DISPLAY 'R517 TAX ' R517-YR-2-AVG-TAX-RATE               DTSBD790
00474          DISPLAY 'R530 TOT ' R530-YR-2-AVG-TOT-RATE               DTSBD790
00475          DISPLAY 'R517 TOT ' R517-YR-2-AVG-TOT-RATE               DTSBD790
00476       ELSE                                                        DTSBD790
00477          DISPLAY 'NO R530 REC - TAX-RATE-FILE ' RSK3-REC.         DTSBD790
00478                                                                   DTSBD790
00479      PERFORM I4000-INITIALIZE-ACCUM THRU I4000-EXIT.              DTSBD790
00480  I0000-EXIT.                                                      DTSBD790
00481      EXIT.                                                        DTSBD790
00482      EJECT                                                        DTSBD790
00483  I1000-PROCESS-PARMS.                                             DTSBD790
00484      IF PARM-LENGTH = +3                                          DTSBD790
00485          NEXT SENTENCE                                            DTSBD790
00486      ELSE                                                         DTSBD790
00487          MOVE 'PARM-LENGTH NOT EQUAL TO 3' TO ABEND-MSG           DTSBD790
00488          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD790
00489                                                                   DTSBD790
00490      IF PARM-RTE-YR-START-YRQ = SPACES OR LOW-VALUES OR ZEROS     DTSBD790
00491          PERFORM I1100-DEFAULT-RTE-YEAR THRU I1100-EXIT           DTSBD790
00492      ELSE                                                         DTSBD790
00493          PERFORM I1200-EDIT-RTE-YEAR THRU I1200-EXIT.             DTSBD790
00494  I1000-EXIT.                                                      DTSBD790
00495      EXIT.                                                        DTSBD790
00496      SKIP3                                                        DTSBD790
00497  I1100-DEFAULT-RTE-YEAR.                                          DTSBD790
00498      MOVE MHDR-LAST-RATE-END-YRQ TO L006-YRQ.                     DTSBD790
00499                                                                   DTSBD790
00500      PERFORM S006-FROM-QTR THRU S006-EXIT.                        DTSBD790
00501                                                                   DTSBD790
00502      MOVE L006-RTE-YR-START-YRQ TO WRK-RTE-YR-START-YRQ.          DTSBD790
00503                                                                   DTSBD790
00504      MOVE L006-RTE-YR-END-YRQ TO WRK-RTE-YR-END-YRQ.              DTSBD790
00505                                                                   DTSBD790
00506      MOVE L006-RTE-YR-START-DATE TO WRK-RTE-YR-START-DATE.        DTSBD790
00507                                                                   DTSBD790
00508      MOVE L006-RTE-YR-END-DATE TO WRK-RTE-YR-END-DATE.            DTSBD790
00509  I1100-EXIT.                                                      DTSBD790
00510      EXIT.                                                        DTSBD790
00511      SKIP3                                                        DTSBD790
00512  I1200-EDIT-RTE-YEAR.                                             DTSBD790
00513      MOVE PARM-RTE-YR-START-YRQ TO L004-QTR-3.                    DTSBD790
00514                                                                   DTSBD790
00515      PERFORM S004-FROM-3 THRU S004-EXIT.                          DTSBD790
00516                                                                   DTSBD790
00517      IF L004-INVALID-QTR                                          DTSBD790
00518          MOVE 'INVALID PARM-RTE-YR-START-YRQ ENCOUNTERED'         DTSBD790
00519            TO ABEND-MSG                                           DTSBD790
00520          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD790
00521                                                                   DTSBD790
00522                                                                   DTSBD790
00523      MOVE L004-QTR-5-9 TO L006-YRQ.                               DTSBD790
00524                                                                   DTSBD790
00525      PERFORM S006-FROM-QTR THRU S006-EXIT.                        DTSBD790
00526                                                                   DTSBD790
00527      IF L006-RTE-YR-START-YRQ = L004-QTR-5-9                      DTSBD790
00528          MOVE L006-RTE-YR-START-YRQ TO WRK-RTE-YR-START-YRQ       DTSBD790
00529          MOVE L006-RTE-YR-END-YRQ TO WRK-RTE-YR-END-YRQ           DTSBD790
00530          MOVE L006-RTE-YR-START-DATE TO WRK-RTE-YR-START-DATE     DTSBD790
00531          MOVE L006-RTE-YR-END-DATE TO WRK-RTE-YR-END-DATE         DTSBD790
00532      ELSE                                                         DTSBD790
00533          MOVE 'PARM-RTE-YR-START-YRQ NOT FIRST QTR OF RATE YEAR'  DTSBD790
00534            TO ABEND-MSG                                           DTSBD790
00535          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD790
00536  I1200-EXIT.                                                      DTSBD790
00537      EXIT.                                                        DTSBD790
00538      SKIP3                                                        DTSBD790
00539  I2000-SET-WRK-AREAS.                                             DTSBD790
00540      MOVE WRK-RTE-YR-START-YRQ TO L055-EFF-YRQ.                   DTSBD790
00541                                                                   DTSBD790
00542      PERFORM S055-FROM-QTR THRU S055-EXIT.                        DTSBD790
00543                                                                   DTSBD790
00544                                                                   DTSBD790
00545      MOVE LOW-VALUES TO FUIR-KEY-AREA.                            DTSBD790
00546                                                                   DTSBD790
00547      SET FUIR-UIR-88 TO TRUE.                                     DTSBD790
00548                                                                   DTSBD790
00549      MOVE WRK-RTE-YR-START-YRQ TO FUIR-EFF-YRQ.                   DTSBD790
00550                                                                   DTSBD790
00551      MOVE FUIR-KEY-AREA TO FSKL-KEY-AREA.                         DTSBD790
00552                                                                   DTSBD790
00553      PERFORM S931-READ THRU S931-EXIT.                            DTSBD790
00554                                                                   DTSBD790
00555      IF L931-NO-REC-88                                            DTSBD790
00556          MOVE 'NO FUIR RECORD OCCURRENCE FOR RATE YEAR'           DTSBD790
00557            TO ABEND-MSG                                           DTSBD790
00558          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD790
00559                                                                   DTSBD790
00560      MOVE FSKL-REC TO FUIR-REC.                                   DTSBD790
00561                                                                   DTSBD790
00562                                                                   DTSBD790
00563 ***  MOVE FUIR-RATE-CUTOFF-DATE TO WRK-COMPUTATION-DATE.          DTSBD790
00564 ***  USE BENEFIT CHARGE END DATE FROM L055 (BELOW).               DTSBD790
00565                                                                   DTSBD790
00566      MOVE FUIR-RATE-CUTOFF-DATE TO WRK-NUMBER-AS-OF-DATE.         DTSBD790
00567                                                                   DTSBD790
00568      MOVE L055-WAGES-THRU-DATE (MMAX-RCT-EXP-MAX)                 DTSBD790
00569        TO WRK-PAYROLL-YEAR-END-DATE.                              DTSBD790
00570                                                                   DTSBD790
00571      MOVE L055-WAGES-FROM-YRQ (MMAX-RCT-EXP-MAX)                  DTSBD790
00572        TO WRK-PAYROLL-START-YRQ.                                  DTSBD790
00573                                                                   DTSBD790
00574      MOVE L055-WAGES-THRU-YRQ (MMAX-RCT-EXP-MAX)                  DTSBD790
00575        TO WRK-PAYROLL-END-YRQ.                                    DTSBD790
00576                                                                   DTSBD790
00577      MOVE L055-UI-BEN-CHGD-FROM-DATE                              DTSBD790
00578        TO WRK-BEN-CHRG-YEAR-START-DATE.                           DTSBD790
00579                                                                   DTSBD790
00580      MOVE L055-UI-BEN-CHGD-THRU-DATE                              DTSBD790
00581        TO WRK-BEN-CHRG-YEAR-END-DATE                              DTSBD790
00582           WRK-COMPUTATION-DATE.                                   DTSBD790
00583  I2000-EXIT.                                                      DTSBD790
00584      EXIT.                                                        DTSBD790
00585      SKIP3                                                        DTSBD790
00586  I3000-INITIALIZE-R517.                                           DTSBD790
00587      MOVE LENGTH OF R517-REC TO R517-LENGTH.                      DTSBD790
00588                                                                   DTSBD790
00589      MOVE '517' TO R517-REC-TYPE.                                 DTSBD790
00590                                                                   DTSBD790
00591                                                                   DTSBD790
00592      INITIALIZE R517-DATA-AREA.                                   DTSBD790
00593                                                                   DTSBD790
00594                                                                   DTSBD790
00595      MOVE MHDR-PRIOR-RUN-DATE TO R517-RUN-DATE.                   DTSBD790
00596                                                                   DTSBD790
00597      MOVE WRK-COMPUTATION-DATE TO R517-COMPUTATION-DATE.          DTSBD790
00598                                                                   DTSBD790
00599      MOVE WRK-RTE-YR-END-DATE TO R517-RATE-YEAR-END-DATE.         DTSBD790
00600                                                                   DTSBD790
00601      MOVE WRK-NUMBER-AS-OF-DATE TO R517-NUMBER-AS-OF-DATE.        DTSBD790
00602                                                                   DTSBD790
00603      MOVE WRK-PAYROLL-YEAR-END-DATE TO R517-PAYROLL-YEAR-END-DATE.DTSBD790
00604                                                                   DTSBD790
00605      MOVE WRK-BEN-CHRG-YEAR-END-DATE                              DTSBD790
00606        TO R517-BEN-CHRG-YEAR-END-DATE.                            DTSBD790
00607                                                                   DTSBD790
00608                                                                   DTSBD790
00609      MOVE LOW-VALUES TO FCYR-KEY-AREA.                            DTSBD790
00610                                                                   DTSBD790
00611      SET FCYR-CYR-88 TO TRUE.                                     DTSBD790
00612                                                                   DTSBD790
00613      MOVE WRK-RTE-YR-START-YRQ TO L004-QTR-5-9.                   DTSBD790
00614                                                                   DTSBD790
00615      MOVE L004-QTR-5-YR TO FCYR-YR.                               DTSBD790
00616                                                                   DTSBD790
00617      MOVE FCYR-KEY-AREA TO FSKL-KEY-AREA.                         DTSBD790
00618                                                                   DTSBD790
00619      PERFORM S931-READ THRU S931-EXIT.                            DTSBD790
00620                                                                   DTSBD790
00621      IF L931-NO-REC-88                                            DTSBD790
00622          MOVE 'RATE YEAR FCYR RECORD MISSING'                     DTSBD790
00623            TO ABEND-MSG                                           DTSBD790
00624          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD790
00625                                                                   DTSBD790
00626      MOVE FSKL-REC TO FCYR-REC.                                   DTSBD790
00627                                                                   DTSBD790
00628      IF FCYR-TAXABLE-WAGE-BASE = +0                               DTSBD790
00629          MOVE 'RATE YEAR FCYR-TAXABLE-WAGE-BASE MISSING'          DTSBD790
00630            TO ABEND-MSG                                           DTSBD790
00631          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD790
00632                                                                   DTSBD790
00633      MOVE FCYR-TAXABLE-WAGE-BASE TO R517-RATE-YEAR-TX-WG-BASE.    DTSBD790
00634                                                                   DTSBD790
00635      MOVE WRK-RTE-YR-START-YRQ TO L004-QTR-5-9.                   DTSBD790
00636                                                                   DTSBD790
00637      PERFORM S004-FROM-5 THRU S004-EXIT.                          DTSBD790
00638                                                                   DTSBD790
00639      IF L004-INVALID-QTR                                          DTSBD790
00640          MOVE 'UNEXPECTED INVALID YRQ ENCOUNTERED  I3000-01'      DTSBD790
00641            TO ABEND-MSG                                           DTSBD790
00642          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD790
00643                                                                   DTSBD790
00644      SUBTRACT 1 FROM L004-ABS-QTR.                                DTSBD790
00645                                                                   DTSBD790
00646      PERFORM S004-FROM-ABS THRU S004-EXIT.                        DTSBD790
00647                                                                   DTSBD790
00648      IF L004-INVALID-QTR                                          DTSBD790
00649          MOVE 'UNEXPECTED INVALID YRQ ENCOUNTERED  I3000-02'      DTSBD790
00650            TO ABEND-MSG                                           DTSBD790
00651          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD790
00652                                                                   DTSBD790
00653      MOVE L004-QTR-5-9 TO L006-YRQ.                               DTSBD790
00654                                                                   DTSBD790
00655      PERFORM S006-FROM-QTR THRU S006-EXIT.                        DTSBD790
00656                                                                   DTSBD790
00657      MOVE L006-RTE-YR-START-DATE TO R517-RY-MINUS-ONE-START-DATE. DTSBD790
00658                                                                   DTSBD790
00659      MOVE L006-RTE-YR-END-DATE TO R517-RY-MINUS-ONE-END-DATE.     DTSBD790
00660                                                                   DTSBD790
00661      MOVE L006-RTE-YR-START-YRQ TO L004-QTR-5-9.                  DTSBD790
00662                                                                   DTSBD790
00663      MOVE L004-QTR-5-YR TO FCYR-YR.                               DTSBD790
00664                                                                   DTSBD790
00665      MOVE FCYR-KEY-AREA TO FSKL-KEY-AREA.                         DTSBD790
00666                                                                   DTSBD790
00667      PERFORM S931-READ THRU S931-EXIT.                            DTSBD790
00668                                                                   DTSBD790
00669      IF L931-NO-REC-88                                            DTSBD790
00670          MOVE 'RATE YEAR MINUS ONE FCYR RECORD MISSING'           DTSBD790
00671            TO ABEND-MSG                                           DTSBD790
00672          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD790
00673                                                                   DTSBD790
00674      MOVE FSKL-REC TO FCYR-REC.                                   DTSBD790
00675                                                                   DTSBD790
00676      IF FCYR-TAXABLE-WAGE-BASE = +0                               DTSBD790
00677       MOVE 'RATE YEAR MINUS ONE FCYR-TAXABLE-WAGE-BASE MISSING'   DTSBD790
00678         TO ABEND-MSG                                              DTSBD790
00679       PERFORM S999-ABEND THRU S999-EXIT.                          DTSBD790
00680                                                                   DTSBD790
00681      MOVE FCYR-TAXABLE-WAGE-BASE TO R517-RY-MINUS-ONE-TX-WG-BASE. DTSBD790
00682                                                                   DTSBD790
00683                                                                   DTSBD790
00684      MOVE L006-RTE-YR-START-YRQ TO L004-QTR-5-9.                  DTSBD790
00685                                                                   DTSBD790
00686      PERFORM S004-FROM-5 THRU S004-EXIT.                          DTSBD790
00687                                                                   DTSBD790
00688      IF L004-INVALID-QTR                                          DTSBD790
00689          MOVE 'UNEXPECTED INVALID YRQ ENCOUNTERED  I3000-03'      DTSBD790
00690            TO ABEND-MSG                                           DTSBD790
00691          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD790
00692                                                                   DTSBD790
00693      SUBTRACT 1 FROM L004-ABS-QTR.                                DTSBD790
00694                                                                   DTSBD790
00695      PERFORM S004-FROM-ABS THRU S004-EXIT.                        DTSBD790
00696                                                                   DTSBD790
00697      IF L004-INVALID-QTR                                          DTSBD790
00698          MOVE 'UNEXPECTED INVALID YRQ ENCOUNTERED  I3000-04'      DTSBD790
00699            TO ABEND-MSG                                           DTSBD790
00700          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD790
00701                                                                   DTSBD790
00702      MOVE L004-QTR-5-9 TO L006-YRQ.                               DTSBD790
00703                                                                   DTSBD790
00704      PERFORM S006-FROM-QTR THRU S006-EXIT.                        DTSBD790
00705                                                                   DTSBD790
00706      MOVE L006-RTE-YR-START-DATE TO R517-RY-MINUS-TWO-START-DATE. DTSBD790
00707                                                                   DTSBD790
00708      MOVE L006-RTE-YR-END-DATE TO R517-RY-MINUS-TWO-END-DATE.     DTSBD790
00709                                                                   DTSBD790
00710      MOVE L006-RTE-YR-START-YRQ TO L004-QTR-5-9.                  DTSBD790
00711                                                                   DTSBD790
00712      MOVE L004-QTR-5-YR TO FCYR-YR.                               DTSBD790
00713                                                                   DTSBD790
00714      MOVE FCYR-KEY-AREA TO FSKL-KEY-AREA.                         DTSBD790
00715                                                                   DTSBD790
00716      PERFORM S931-READ THRU S931-EXIT.                            DTSBD790
00717                                                                   DTSBD790
00718      IF L931-NO-REC-88                                            DTSBD790
00719          MOVE 'RATE YEAR MINUS TWO FCYR RECORD MISSING'           DTSBD790
00720            TO ABEND-MSG                                           DTSBD790
00721          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD790
00722                                                                   DTSBD790
00723      MOVE FSKL-REC TO FCYR-REC.                                   DTSBD790
00724                                                                   DTSBD790
00725      IF FCYR-TAXABLE-WAGE-BASE = +0                               DTSBD790
00726       MOVE 'RATING YEAR MINUS TWO FCYR-TAXABLE-WAGE-BASE MISSING' DTSBD790
00727         TO ABEND-MSG                                              DTSBD790
00728       PERFORM S999-ABEND THRU S999-EXIT.                          DTSBD790
00729                                                                   DTSBD790
00730      MOVE FCYR-TAXABLE-WAGE-BASE TO R517-RY-MINUS-TWO-TX-WG-BASE. DTSBD790
00731  I3000-EXIT.                                                      DTSBD790
00732      EXIT.                                                        DTSBD790
00733      SKIP3                                                        DTSBD790
00734  I4000-INITIALIZE-ACCUM.                                          DTSBD790
00735      INITIALIZE ACCUMULATOR-AREAS.                                DTSBD790
00736                                                                   DTSBD790
00737      MOVE -99.99999 TO ACCUM-ELG-REG-MIN-RATIO (1)                DTSBD790
00738      MOVE -0.80000 TO ACCUM-ELG-REG-MAX-RATIO (1).                DTSBD790
00739                                                                   DTSBD790
00740      MOVE -0.80000 TO ACCUM-ELG-REG-MIN-RATIO (2).                DTSBD790
00741      MOVE -0.60000 TO ACCUM-ELG-REG-MAX-RATIO (2).                DTSBD790
00742                                                                   DTSBD790
00743      MOVE -0.60000 TO ACCUM-ELG-REG-MIN-RATIO (3).                DTSBD790
00744      MOVE -0.40000 TO ACCUM-ELG-REG-MAX-RATIO (3).                DTSBD790
00745                                                                   DTSBD790
00746      MOVE -0.40000 TO ACCUM-ELG-REG-MIN-RATIO (4).                DTSBD790
00747      MOVE -0.20000 TO ACCUM-ELG-REG-MAX-RATIO (4).                DTSBD790
00748                                                                   DTSBD790
00749      MOVE -0.20000 TO ACCUM-ELG-REG-MIN-RATIO (5).                DTSBD790
00750      MOVE -0.19000 TO ACCUM-ELG-REG-MAX-RATIO (5).                DTSBD790
00751                                                                   DTSBD790
00752      MOVE -0.19000 TO ACCUM-ELG-REG-MIN-RATIO (6).                DTSBD790
00753      MOVE -0.18000 TO ACCUM-ELG-REG-MAX-RATIO (6).                DTSBD790
00754                                                                   DTSBD790
00755      MOVE -0.18000 TO ACCUM-ELG-REG-MIN-RATIO (7).                DTSBD790
00756      MOVE -0.17000 TO ACCUM-ELG-REG-MAX-RATIO (7).                DTSBD790
00757                                                                   DTSBD790
00758      MOVE -0.17000 TO ACCUM-ELG-REG-MIN-RATIO (8).                DTSBD790
00759      MOVE -0.16000 TO ACCUM-ELG-REG-MAX-RATIO (8).                DTSBD790
00760                                                                   DTSBD790
00761      MOVE -0.16000 TO ACCUM-ELG-REG-MIN-RATIO (9).                DTSBD790
00762      MOVE -0.15000 TO ACCUM-ELG-REG-MAX-RATIO (9).                DTSBD790
00763                                                                   DTSBD790
00764      MOVE -0.15000 TO ACCUM-ELG-REG-MIN-RATIO (10).               DTSBD790
00765      MOVE -0.14000 TO ACCUM-ELG-REG-MAX-RATIO (10).               DTSBD790
00766                                                                   DTSBD790
00767      MOVE -0.14000 TO ACCUM-ELG-REG-MIN-RATIO (11).               DTSBD790
00768      MOVE -0.13000 TO ACCUM-ELG-REG-MAX-RATIO (11).               DTSBD790
00769                                                                   DTSBD790
00770      MOVE -0.13000 TO ACCUM-ELG-REG-MIN-RATIO (12).               DTSBD790
00771      MOVE -0.12000 TO ACCUM-ELG-REG-MAX-RATIO (12).               DTSBD790
00772                                                                   DTSBD790
00773      MOVE -0.12000 TO ACCUM-ELG-REG-MIN-RATIO (13).               DTSBD790
00774      MOVE -0.11000 TO ACCUM-ELG-REG-MAX-RATIO (13).               DTSBD790
00775                                                                   DTSBD790
00776      MOVE -0.11000 TO ACCUM-ELG-REG-MIN-RATIO (14).               DTSBD790
00777      MOVE -0.10000 TO ACCUM-ELG-REG-MAX-RATIO (14).               DTSBD790
00778                                                                   DTSBD790
00779      MOVE -0.10000 TO ACCUM-ELG-REG-MIN-RATIO (15).               DTSBD790
00780      MOVE -0.09000 TO ACCUM-ELG-REG-MAX-RATIO (15).               DTSBD790
00781                                                                   DTSBD790
00782      MOVE -0.09000 TO ACCUM-ELG-REG-MIN-RATIO (16).               DTSBD790
00783      MOVE -0.08000 TO ACCUM-ELG-REG-MAX-RATIO (16).               DTSBD790
00784                                                                   DTSBD790
00785      MOVE -0.08000 TO ACCUM-ELG-REG-MIN-RATIO (17).               DTSBD790
00786      MOVE -0.07000 TO ACCUM-ELG-REG-MAX-RATIO (17).               DTSBD790
00787                                                                   DTSBD790
00788      MOVE -0.07000 TO ACCUM-ELG-REG-MIN-RATIO (18).               DTSBD790
00789      MOVE -0.06000 TO ACCUM-ELG-REG-MAX-RATIO (18).               DTSBD790
00790                                                                   DTSBD790
00791      MOVE -0.06000 TO ACCUM-ELG-REG-MIN-RATIO (19).               DTSBD790
00792      MOVE -0.05000 TO ACCUM-ELG-REG-MAX-RATIO (19).               DTSBD790
00793                                                                   DTSBD790
00794      MOVE -0.05000 TO ACCUM-ELG-REG-MIN-RATIO (20).               DTSBD790
00795      MOVE -0.04500 TO ACCUM-ELG-REG-MAX-RATIO (20).               DTSBD790
00796                                                                   DTSBD790
00797      MOVE -0.04500 TO ACCUM-ELG-REG-MIN-RATIO (21).               DTSBD790
00798      MOVE -0.04000 TO ACCUM-ELG-REG-MAX-RATIO (21).               DTSBD790
00799                                                                   DTSBD790
00800      MOVE -0.04000 TO ACCUM-ELG-REG-MIN-RATIO (22).               DTSBD790
00801      MOVE -0.03500 TO ACCUM-ELG-REG-MAX-RATIO (22).               DTSBD790
00802                                                                   DTSBD790
00803      MOVE -0.03500 TO ACCUM-ELG-REG-MIN-RATIO (23).               DTSBD790
00804      MOVE -0.03000 TO ACCUM-ELG-REG-MAX-RATIO (23).               DTSBD790
00805                                                                   DTSBD790
00806      MOVE -0.03000 TO ACCUM-ELG-REG-MIN-RATIO (24).               DTSBD790
00807      MOVE -0.02500 TO ACCUM-ELG-REG-MAX-RATIO (24).               DTSBD790
00808                                                                   DTSBD790
00809      MOVE -0.02500 TO ACCUM-ELG-REG-MIN-RATIO (25).               DTSBD790
00810      MOVE -0.02000 TO ACCUM-ELG-REG-MAX-RATIO (25).               DTSBD790
00811                                                                   DTSBD790
00812      MOVE -0.02000 TO ACCUM-ELG-REG-MIN-RATIO (26).               DTSBD790
00813      MOVE -0.01500 TO ACCUM-ELG-REG-MAX-RATIO (26).               DTSBD790
00814                                                                   DTSBD790
00815      MOVE -0.01500 TO ACCUM-ELG-REG-MIN-RATIO (27).               DTSBD790
00816      MOVE -0.01000 TO ACCUM-ELG-REG-MAX-RATIO (27).               DTSBD790
00817                                                                   DTSBD790
00818      MOVE -0.01000 TO ACCUM-ELG-REG-MIN-RATIO (28).               DTSBD790
00819      MOVE -0.00500 TO ACCUM-ELG-REG-MAX-RATIO (28).               DTSBD790
00820                                                                   DTSBD790
00821      MOVE -0.00500 TO ACCUM-ELG-REG-MIN-RATIO (29).               DTSBD790
00822      MOVE  0.00000 TO ACCUM-ELG-REG-MAX-RATIO (29).               DTSBD790
00823                                                                   DTSBD790
00824      MOVE  0.00000 TO ACCUM-ELG-REG-MIN-RATIO (30).               DTSBD790
00825      MOVE  0.00500 TO ACCUM-ELG-REG-MAX-RATIO (30).               DTSBD790
00826                                                                   DTSBD790
00827      MOVE  0.00500 TO ACCUM-ELG-REG-MIN-RATIO (31).               DTSBD790
00828      MOVE  0.01000 TO ACCUM-ELG-REG-MAX-RATIO (31).               DTSBD790
00829                                                                   DTSBD790
00830      MOVE  0.01000 TO ACCUM-ELG-REG-MIN-RATIO (32).               DTSBD790
00831      MOVE  0.01500 TO ACCUM-ELG-REG-MAX-RATIO (32).               DTSBD790
00832                                                                   DTSBD790
00833      MOVE  0.01500 TO ACCUM-ELG-REG-MIN-RATIO (33).               DTSBD790
00834      MOVE  0.02000 TO ACCUM-ELG-REG-MAX-RATIO (33).               DTSBD790
00835                                                                   DTSBD790
00836      MOVE  0.02000 TO ACCUM-ELG-REG-MIN-RATIO (34).               DTSBD790
00837      MOVE  0.02500 TO ACCUM-ELG-REG-MAX-RATIO (34).               DTSBD790
00838                                                                   DTSBD790
00839      MOVE  0.02500 TO ACCUM-ELG-REG-MIN-RATIO (35).               DTSBD790
00840      MOVE  0.03000 TO ACCUM-ELG-REG-MAX-RATIO (35).               DTSBD790
00841                                                                   DTSBD790
00842      MOVE  0.03000 TO ACCUM-ELG-REG-MIN-RATIO (36).               DTSBD790
00843      MOVE  0.03500 TO ACCUM-ELG-REG-MAX-RATIO (36).               DTSBD790
00844                                                                   DTSBD790
00845      MOVE  0.03500 TO ACCUM-ELG-REG-MIN-RATIO (37).               DTSBD790
00846      MOVE  0.04000 TO ACCUM-ELG-REG-MAX-RATIO (37).               DTSBD790
00847                                                                   DTSBD790
00848      MOVE  0.04000 TO ACCUM-ELG-REG-MIN-RATIO (38).               DTSBD790
00849      MOVE  0.04500 TO ACCUM-ELG-REG-MAX-RATIO (38).               DTSBD790
00850                                                                   DTSBD790
00851      MOVE  0.04500 TO ACCUM-ELG-REG-MIN-RATIO (39).               DTSBD790
00852      MOVE  0.05000 TO ACCUM-ELG-REG-MAX-RATIO (39).               DTSBD790
00853                                                                   DTSBD790
00854      MOVE  0.05000 TO ACCUM-ELG-REG-MIN-RATIO (40).               DTSBD790
00855      MOVE  0.05500 TO ACCUM-ELG-REG-MAX-RATIO (40).               DTSBD790
00856                                                                   DTSBD790
00857      MOVE  0.05500 TO ACCUM-ELG-REG-MIN-RATIO (41).               DTSBD790
00858      MOVE  0.06000 TO ACCUM-ELG-REG-MAX-RATIO (41).               DTSBD790
00859                                                                   DTSBD790
00860      MOVE  0.06000 TO ACCUM-ELG-REG-MIN-RATIO (42).               DTSBD790
00861      MOVE  0.06500 TO ACCUM-ELG-REG-MAX-RATIO (42).               DTSBD790
00862                                                                   DTSBD790
00863      MOVE  0.06500 TO ACCUM-ELG-REG-MIN-RATIO (43).               DTSBD790
00864      MOVE  0.07000 TO ACCUM-ELG-REG-MAX-RATIO (43).               DTSBD790
00865                                                                   DTSBD790
00866      MOVE  0.07000 TO ACCUM-ELG-REG-MIN-RATIO (44).               DTSBD790
00867      MOVE  0.07500 TO ACCUM-ELG-REG-MAX-RATIO (44).               DTSBD790
00868                                                                   DTSBD790
00869      MOVE  0.07500 TO ACCUM-ELG-REG-MIN-RATIO (45).               DTSBD790
00870      MOVE  0.08000 TO ACCUM-ELG-REG-MAX-RATIO (45).               DTSBD790
00871                                                                   DTSBD790
00872      MOVE  0.08000 TO ACCUM-ELG-REG-MIN-RATIO (46).               DTSBD790
00873      MOVE  0.08500 TO ACCUM-ELG-REG-MAX-RATIO (46).               DTSBD790
00874                                                                   DTSBD790
00875      MOVE  0.08500 TO ACCUM-ELG-REG-MIN-RATIO (47).               DTSBD790
00876      MOVE  0.09000 TO ACCUM-ELG-REG-MAX-RATIO (47).               DTSBD790
00877                                                                   DTSBD790
00878      MOVE  0.09000 TO ACCUM-ELG-REG-MIN-RATIO (48).               DTSBD790
00879      MOVE  0.09500 TO ACCUM-ELG-REG-MAX-RATIO (48).               DTSBD790
00880                                                                   DTSBD790
00881      MOVE  0.09500 TO ACCUM-ELG-REG-MIN-RATIO (49).               DTSBD790
00882      MOVE  0.10000 TO ACCUM-ELG-REG-MAX-RATIO (49).               DTSBD790
00883                                                                   DTSBD790
00884      MOVE  0.10000 TO ACCUM-ELG-REG-MIN-RATIO (50).               DTSBD790
00885      MOVE  0.10500 TO ACCUM-ELG-REG-MAX-RATIO (50).               DTSBD790
00886                                                                   DTSBD790
00887      MOVE  0.10500 TO ACCUM-ELG-REG-MIN-RATIO (51).               DTSBD790
00888      MOVE  0.11000 TO ACCUM-ELG-REG-MAX-RATIO (51).               DTSBD790
00889                                                                   DTSBD790
00890      MOVE  0.11000 TO ACCUM-ELG-REG-MIN-RATIO (52).               DTSBD790
00891      MOVE  0.11500 TO ACCUM-ELG-REG-MAX-RATIO (52).               DTSBD790
00892                                                                   DTSBD790
00893      MOVE  0.11500 TO ACCUM-ELG-REG-MIN-RATIO (53).               DTSBD790
00894      MOVE  0.12000 TO ACCUM-ELG-REG-MAX-RATIO (53).               DTSBD790
00895                                                                   DTSBD790
00896      MOVE  0.12000 TO ACCUM-ELG-REG-MIN-RATIO (54).               DTSBD790
00897      MOVE  0.12500 TO ACCUM-ELG-REG-MAX-RATIO (54).               DTSBD790
00898                                                                   DTSBD790
00899      MOVE  0.12500 TO ACCUM-ELG-REG-MIN-RATIO (55).               DTSBD790
00900      MOVE  0.13000 TO ACCUM-ELG-REG-MAX-RATIO (55).               DTSBD790
00901                                                                   DTSBD790
00902      MOVE  0.13000 TO ACCUM-ELG-REG-MIN-RATIO (56).               DTSBD790
00903      MOVE  0.13500 TO ACCUM-ELG-REG-MAX-RATIO (56).               DTSBD790
00904                                                                   DTSBD790
00905      MOVE  0.13500 TO ACCUM-ELG-REG-MIN-RATIO (57).               DTSBD790
00906      MOVE  0.14000 TO ACCUM-ELG-REG-MAX-RATIO (57).               DTSBD790
00907                                                                   DTSBD790
00908      MOVE  0.14000 TO ACCUM-ELG-REG-MIN-RATIO (58).               DTSBD790
00909      MOVE  0.14500 TO ACCUM-ELG-REG-MAX-RATIO (58).               DTSBD790
00910                                                                   DTSBD790
00911      MOVE  0.14500 TO ACCUM-ELG-REG-MIN-RATIO (59).               DTSBD790
00912      MOVE  0.15000 TO ACCUM-ELG-REG-MAX-RATIO (59).               DTSBD790
00913                                                                   DTSBD790
00914      MOVE  0.15000 TO ACCUM-ELG-REG-MIN-RATIO (60).               DTSBD790
00915      MOVE  0.16000 TO ACCUM-ELG-REG-MAX-RATIO (60).               DTSBD790
00916                                                                   DTSBD790
00917      MOVE  0.16000 TO ACCUM-ELG-REG-MIN-RATIO (61).               DTSBD790
00918      MOVE  0.17000 TO ACCUM-ELG-REG-MAX-RATIO (61).               DTSBD790
00919                                                                   DTSBD790
00920      MOVE  0.17000 TO ACCUM-ELG-REG-MIN-RATIO (62).               DTSBD790
00921      MOVE  0.18000 TO ACCUM-ELG-REG-MAX-RATIO (62).               DTSBD790
00922                                                                   DTSBD790
00923      MOVE  0.18000 TO ACCUM-ELG-REG-MIN-RATIO (63).               DTSBD790
00924      MOVE  0.19000 TO ACCUM-ELG-REG-MAX-RATIO (63).               DTSBD790
00925                                                                   DTSBD790
00926      MOVE  0.19000 TO ACCUM-ELG-REG-MIN-RATIO (64).               DTSBD790
00927      MOVE  0.20000 TO ACCUM-ELG-REG-MAX-RATIO (64).               DTSBD790
00928                                                                   DTSBD790
00929      MOVE  0.20000 TO ACCUM-ELG-REG-MIN-RATIO (65).               DTSBD790
00930      MOVE  0.25000 TO ACCUM-ELG-REG-MAX-RATIO (65).               DTSBD790
00931                                                                   DTSBD790
00932      MOVE  0.25000 TO ACCUM-ELG-REG-MIN-RATIO (66).               DTSBD790
00933      MOVE  0.30000 TO ACCUM-ELG-REG-MAX-RATIO (66).               DTSBD790
00934                                                                   DTSBD790
00935      MOVE  0.30000 TO ACCUM-ELG-REG-MIN-RATIO (67).               DTSBD790
00936      MOVE  0.35000 TO ACCUM-ELG-REG-MAX-RATIO (67).               DTSBD790
00937                                                                   DTSBD790
00938      MOVE  0.35000 TO ACCUM-ELG-REG-MIN-RATIO (68).               DTSBD790
00939      MOVE  0.40000 TO ACCUM-ELG-REG-MAX-RATIO (68).               DTSBD790
00940                                                                   DTSBD790
00941      MOVE  0.40000 TO ACCUM-ELG-REG-MIN-RATIO (69).               DTSBD790
00942      MOVE  0.45000 TO ACCUM-ELG-REG-MAX-RATIO (69).               DTSBD790
00943                                                                   DTSBD790
00944      MOVE  0.45000 TO ACCUM-ELG-REG-MIN-RATIO (70).               DTSBD790
00945      MOVE  99.99999 TO ACCUM-ELG-REG-MAX-RATIO (70).              DTSBD790
00946  I4000-EXIT.                                                      DTSBD790
00947      EXIT.                                                        DTSBD790
00948      EJECT                                                        DTSBD790
00949  P1000-PROCESS-TAX.                                               DTSBD790
00950      IF MPRF-CLASS-RATED-88                                       DTSBD790
00951          PERFORM P1100-RATED-EMPLOYER THRU P1100-EXIT             DTSBD790
00952      ELSE                                                         DTSBD790
00953      IF MPRF-CLASS-SELF-INS-88                                    DTSBD790
00954          PERFORM P1200-SELF-INS-EMPLOYER THRU P1200-EXIT.         DTSBD790
00955  P1000-EXIT.                                                      DTSBD790
00956      EXIT.                                                        DTSBD790
00957      EJECT                                                        DTSBD790
00958  P1100-RATED-EMPLOYER.                                            DTSBD790
00959      MOVE LOW-VALUES TO MRCT-KEY-AREA.                            DTSBD790
00960                                                                   DTSBD790
00961      MOVE MPRF-EMP-NO TO MRCT-EMP-NO.                             DTSBD790
00962                                                                   DTSBD790
00963      SET MRCT-RCT-88 TO TRUE.                                     DTSBD790
00964                                                                   DTSBD790
00965      MOVE WRK-RTE-YR-START-YRQ TO MRCT-EFF-YRQ.                   DTSBD790
00966                                                                   DTSBD790
00967      MOVE MRCT-KEY-AREA TO MSKL-KEY-AREA.                         DTSBD790
00968                                                                   DTSBD790
00969      PERFORM S910-READ THRU S910-EXIT.                            DTSBD790
00970                                                                   DTSBD790
00971      IF L910-NO-REC-88                                            DTSBD790
00972          GO TO P1100-EXIT.                                        DTSBD790
00973                                                                   DTSBD790
00974                                                                   DTSBD790
00975      MOVE MSKL-REC TO MRCT-REC.                                   DTSBD790
00976                                                                   DTSBD790
00977      ADD MRCT-BENEFITS-CHARGED-AMT TO W-TOT-MRCT-CHG.             DTSBD790
00978      IF MRCT-EMP-ACTIVE-YES-88                                    DTSBD790
00979         ADD MRCT-BENEFITS-CHARGED-AMT TO W-TOT-ACT-MRCT-CHG.      DTSBD790
00980                                                                   DTSBD790
00981      IF MRCT-EMP-ACTIVE-NO-88                                     DTSBD790
00982          GO TO P1100-EXIT.                                        DTSBD790
00983                                                                   DTSBD790
00984                                                                   DTSBD790
00985      IF MRCT-TRANSFERRED-TO-EMP-NO > +0                           DTSBD790
00986          GO TO P1100-EXIT.                                        DTSBD790
00987                                                                   DTSBD790
00988                                                                   DTSBD790
00989      ADD MRCT-BENEFITS-CHARGED-AMT TO ACCUM-LINE6A1-CHARGES.      DTSBD790
00990                                                                   DTSBD790
00991                                                                   DTSBD790
00992      PERFORM S054-DETERMINE-RATE THRU S054-EXIT.                  DTSBD790
00993                                                                   DTSBD790
00994                                                                   DTSBD790
00995      IF L054-NO-FUIR-88                                           DTSBD790
00996          MOVE 'L054-NO-FUIR-88 CONDITION ENCOUNTERED'             DTSBD790
00997            TO ABEND-MSG                                           DTSBD790
00998          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD790
00999                                                                   DTSBD790
01000                                                                   DTSBD790
01001      IF L054-NONCLASSIFIED-88                                     DTSBD790
01002          ADD +1 TO R517-LINE1B-COUNT                              DTSBD790
01003          ADD MRCT-TOT-WAGE (MMAX-RCT-EXP-MAX)                     DTSBD790
01004           TO ACCUM-LINE1B-TOT-WAGES                               DTSBD790
01005          ADD MRCT-TAX-WAGE (MMAX-RCT-EXP-MAX)                     DTSBD790
01006           TO ACCUM-LINE1B-TAX-WAGES                               DTSBD790
01007      ELSE                                                         DTSBD790
01008          ADD +1 TO R517-LINE1A-COUNT                              DTSBD790
01009          ADD MRCT-TOT-WAGE (MMAX-RCT-EXP-MAX)                     DTSBD790
01010           TO ACCUM-LINE1A-TOT-WAGES                               DTSBD790
01011          ADD MRCT-TAX-WAGE (MMAX-RCT-EXP-MAX)                     DTSBD790
01012           TO ACCUM-LINE1A-TAX-WAGES.                              DTSBD790
01013                                                                   DTSBD790
01014      IF L054-CURRENT-RESERVE-AMT < 0.00                           DTSBD790
01015          IF L054-NONCLASSIFIED-88                                 DTSBD790
01016              ADD +1 TO R517-LINE4B-COUNT                          DTSBD790
01017              ADD MRCT-TOT-WAGE (MMAX-RCT-EXP-MAX)                 DTSBD790
01018               TO ACCUM-LINE4B-TOT-WAGES                           DTSBD790
01019              ADD MRCT-TAX-WAGE (MMAX-RCT-EXP-MAX)                 DTSBD790
01020               TO ACCUM-LINE4B-TAX-WAGES                           DTSBD790
01021          ELSE                                                     DTSBD790
01022              ADD +1 TO R517-LINE4A-COUNT                          DTSBD790
01023              ADD MRCT-TOT-WAGE (MMAX-RCT-EXP-MAX)                 DTSBD790
01024               TO ACCUM-LINE4A-TOT-WAGES                           DTSBD790
01025              ADD MRCT-TAX-WAGE (MMAX-RCT-EXP-MAX)                 DTSBD790
01026               TO ACCUM-LINE4A-TAX-WAGES                           DTSBD790
01027      ELSE                                                         DTSBD790
01028          IF L054-NONCLASSIFIED-88                                 DTSBD790
01029              ADD +1 TO R517-LINE3B-COUNT                          DTSBD790
01030              ADD MRCT-TOT-WAGE (MMAX-RCT-EXP-MAX)                 DTSBD790
01031               TO ACCUM-LINE3B-TOT-WAGES                           DTSBD790
01032              ADD MRCT-TAX-WAGE (MMAX-RCT-EXP-MAX)                 DTSBD790
01033               TO ACCUM-LINE3B-TAX-WAGES                           DTSBD790
01034          ELSE                                                     DTSBD790
01035              ADD +1 TO R517-LINE3A-COUNT                          DTSBD790
01036              ADD MRCT-TOT-WAGE (MMAX-RCT-EXP-MAX)                 DTSBD790
01037               TO ACCUM-LINE3A-TOT-WAGES                           DTSBD790
01038              ADD MRCT-TAX-WAGE (MMAX-RCT-EXP-MAX)                 DTSBD790
01039               TO ACCUM-LINE3A-TAX-WAGES.                          DTSBD790
01040                                                                   DTSBD790
01041                                                                   DTSBD790
01042      IF L054-CLASSIFIED-88                                        DTSBD790
01043          IF L054-UI-PEN-RATE-NO-88                                DTSBD790
01044              PERFORM P1110-ELG-REG-SECTION-C THRU P1110-EXIT      DTSBD790
01045          ELSE                                                     DTSBD790
01046              PERFORM P1120-ELG-SPECIAL-SECTION-C THRU P1120-EXIT  DTSBD790
01047      ELSE                                                         DTSBD790
01048      IF L054-NONCLASSIFIED-88                                     DTSBD790
01049          PERFORM P1130-INELG-SECTION-C THRU P1130-EXIT            DTSBD790
01050      ELSE                                                         DTSBD790
01051          MOVE 'UNEXPECTED L054-UI-RATE-CATEGORY VALUE ENCOUNTERED'DTSBD790
01052            TO ABEND-MSG                                           DTSBD790
01053          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD790
01054  P1100-EXIT.                                                      DTSBD790
01055      EXIT.                                                        DTSBD790
01056      SKIP3                                                        DTSBD790
01057  P1110-ELG-REG-SECTION-C.                                         DTSBD790
01058      MOVE +0 TO ACCUM-ELG-REG-SUB.                                DTSBD790
01059                                                                   DTSBD790
01060      PERFORM                                                      DTSBD790
01061        VARYING ACCUM-ELG-REG-IDX FROM 1 BY 1                      DTSBD790
01062        UNTIL (ACCUM-ELG-REG-SUB NOT = +0)                         DTSBD790
01063                  OR                                               DTSBD790
01064              (ACCUM-ELG-REG-IDX > WRK-ELG-REG-OCC-MAX)            DTSBD790
01065          IF (L054-RATIO >= ACCUM-ELG-REG-MIN-RATIO                DTSBD790
01066                             (ACCUM-ELG-REG-IDX))                  DTSBD790
01067                   AND                                             DTSBD790
01068             (L054-RATIO <= ACCUM-ELG-REG-MAX-RATIO                DTSBD790
01069                             (ACCUM-ELG-REG-IDX))                  DTSBD790
01070              SET ACCUM-ELG-REG-SUB TO ACCUM-ELG-REG-IDX           DTSBD790
01071          END-IF                                                   DTSBD790
01072      END-PERFORM.                                                 DTSBD790
01073                                                                   DTSBD790
01074      IF ACCUM-ELG-REG-SUB = +0                                    DTSBD790
01075          MOVE 'UNEXPECTED L054-RATIO VALUE ENCOUNTERED'           DTSBD790
01076            TO ABEND-MSG                                           DTSBD790
01077          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD790
01078                                                                   DTSBD790
01079      ADD +1                                                       DTSBD790
01080       TO ACCUM-ELG-REG-EMPLR-CNT (ACCUM-ELG-REG-SUB).             DTSBD790
01081                                                                   DTSBD790
01082      ADD MRCT-TOT-WAGE (MMAX-RCT-EXP-MAX)                         DTSBD790
01083       TO ACCUM-ELG-REG-TOT-WAGE (ACCUM-ELG-REG-SUB).              DTSBD790
01084                                                                   DTSBD790
01085      ADD MRCT-TAX-WAGE (MMAX-RCT-EXP-MAX)                         DTSBD790
01086       TO ACCUM-ELG-REG-TAX-WAGE (ACCUM-ELG-REG-SUB).              DTSBD790
01087                                                                   DTSBD790
01088      ADD MRCT-BENEFITS-CHARGED-AMT                                DTSBD790
01089       TO ACCUM-ELG-REG-BEN-CHARGED (ACCUM-ELG-REG-SUB).           DTSBD790
01090                                                                   DTSBD790
01091      COMPUTE ACCUM-ELG-REG-EST-UI-PAID                            DTSBD790
01092               (ACCUM-ELG-REG-SUB) ROUNDED                         DTSBD790
01093        = ACCUM-ELG-REG-EST-UI-PAID (ACCUM-ELG-REG-SUB)            DTSBD790
01094           + (MRCT-TAX-WAGE (MMAX-RCT-EXP-MAX)                     DTSBD790
01095                * L054-UI-CALC-RATE).                              DTSBD790
01096  P1110-EXIT.                                                      DTSBD790
01097      EXIT.                                                        DTSBD790
01098      SKIP3                                                        DTSBD790
01099  P1120-ELG-SPECIAL-SECTION-C.                                     DTSBD790
01100      ADD +1                                                       DTSBD790
01101       TO ACCUM-ELG-SPECIAL-EMPLR-CNT.                             DTSBD790
01102                                                                   DTSBD790
01103      ADD MRCT-TOT-WAGE (MMAX-RCT-EXP-MAX)                         DTSBD790
01104       TO ACCUM-ELG-SPECIAL-TOT-WAGE.                              DTSBD790
01105                                                                   DTSBD790
01106      ADD MRCT-TAX-WAGE (MMAX-RCT-EXP-MAX)                         DTSBD790
01107       TO ACCUM-ELG-SPECIAL-TAX-WAGE.                              DTSBD790
01108                                                                   DTSBD790
01109      ADD MRCT-BENEFITS-CHARGED-AMT                                DTSBD790
01110       TO ACCUM-ELG-SPECIAL-BEN-CHARGED.                           DTSBD790
01111                                                                   DTSBD790
01112      IF L054-UI-PEN-RATE-YES-88 OR L054-UI-PEN-RATE-INEFF-88      DTSBD790
01113          COMPUTE ACCUM-ELG-SPECIAL-EST-UI-PAID ROUNDED            DTSBD790
01114            = ACCUM-ELG-SPECIAL-EST-UI-PAID                        DTSBD790
01115                 + (MRCT-TAX-WAGE (MMAX-RCT-EXP-MAX)               DTSBD790
01116                      * L054-UI-PEN-RATE)                          DTSBD790
01117      ELSE                                                         DTSBD790
01118          MOVE                                                     DTSBD790
01119       'UNEXPECTED L054-UI-PEN-RATE-CD VALUE ENCOUNTERED IN P1120' DTSBD790
01120            TO ABEND-MSG                                           DTSBD790
01121          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD790
01122  P1120-EXIT.                                                      DTSBD790
01123      EXIT.                                                        DTSBD790
01124      SKIP3                                                        DTSBD790
01125  P1130-INELG-SECTION-C.                                           DTSBD790
01126      ADD +1                                                       DTSBD790
01127       TO ACCUM-INELG-EMPLR-CNT.                                   DTSBD790
01128                                                                   DTSBD790
01129      ADD MRCT-TOT-WAGE (MMAX-RCT-EXP-MAX)                         DTSBD790
01130       TO ACCUM-INELG-TOT-WAGE.                                    DTSBD790
01131                                                                   DTSBD790
01132      ADD MRCT-TAX-WAGE (MMAX-RCT-EXP-MAX)                         DTSBD790
01133       TO ACCUM-INELG-TAX-WAGE.                                    DTSBD790
01134                                                                   DTSBD790
01135      ADD MRCT-BENEFITS-CHARGED-AMT                                DTSBD790
01136       TO ACCUM-INELG-BEN-CHARGED.                                 DTSBD790
01137                                                                   DTSBD790
01138      IF L054-UI-PEN-RATE-NO-88                                    DTSBD790
01139          COMPUTE ACCUM-INELG-EST-UI-PAID ROUNDED                  DTSBD790
01140            = ACCUM-INELG-EST-UI-PAID                              DTSBD790
01141               + (MRCT-TAX-WAGE (MMAX-RCT-EXP-MAX)                 DTSBD790
01142                   * L054-UI-CALC-RATE)                            DTSBD790
01143      ELSE                                                         DTSBD790
01144      IF L054-UI-PEN-RATE-YES-88 OR L054-UI-PEN-RATE-INEFF-88      DTSBD790
01145          COMPUTE ACCUM-INELG-EST-UI-PAID ROUNDED                  DTSBD790
01146            = ACCUM-INELG-EST-UI-PAID                              DTSBD790
01147               + (MRCT-TAX-WAGE (MMAX-RCT-EXP-MAX)                 DTSBD790
01148                    * L054-UI-PEN-RATE)                            DTSBD790
01149      ELSE                                                         DTSBD790
01150          MOVE                                                     DTSBD790
01151       'UNEXPECTED L054-UI-PEN-RATE-CD VALUE ENCOUNTERED IN P1130' DTSBD790
01152            TO  ABEND-MSG                                          DTSBD790
01153          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD790
01154  P1130-EXIT.                                                      DTSBD790
01155      EXIT.                                                        DTSBD790
01156      EJECT                                                        DTSBD790
01157  P1200-SELF-INS-EMPLOYER.                                         DTSBD790
01158      MOVE 'N' TO ACTIVE-AT-COMPUTATION-DATE-IND.                  DTSBD790
01159                                                                   DTSBD790
01160                                                                   DTSBD790
01161      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSBD790
01162                                                                   DTSBD790
01163      MOVE MPRF-EMP-NO TO MSKL-EMP-NO.                             DTSBD790
01164                                                                   DTSBD790
01165      SET MSKL-SOL-88 TO TRUE.                                     DTSBD790
01166                                                                   DTSBD790
01167      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBD790
01168                                                                   DTSBD790
01169      PERFORM P1210-MSOL-SCAN THRU P1210-EXIT                      DTSBD790
01170          UNTIL L910-NO-REC-88.                                    DTSBD790
01171                                                                   DTSBD790
01172                                                                   DTSBD790
01173      IF ACTIVE-AT-COMPUTATION-DATE-IND = 'N'                      DTSBD790
01174          GO TO P1200-EXIT.                                        DTSBD790
01175                                                                   DTSBD790
01176                                                                   DTSBD790
01177      ADD +1 TO R517-LINE2-COUNT.                                  DTSBD790
01178                                                                   DTSBD790
01179                                                                   DTSBD790
01180      MOVE LOW-VALUES TO MQTR-KEY-AREA.                            DTSBD790
01181                                                                   DTSBD790
01182      MOVE MPRF-EMP-NO TO MQTR-EMP-NO.                             DTSBD790
01183                                                                   DTSBD790
01184      SET MQTR-QTR-88 TO TRUE.                                     DTSBD790
01185                                                                   DTSBD790
01186      MOVE WRK-PAYROLL-START-YRQ TO MQTR-YRQ.                      DTSBD790
01187                                                                   DTSBD790
01188      MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA.                         DTSBD790
01189                                                                   DTSBD790
01190      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBD790
01191                                                                   DTSBD790
01192      PERFORM P1220-MQTR-SCAN THRU P1220-EXIT                      DTSBD790
01193          UNTIL L910-NO-REC-88.                                    DTSBD790
01194  P1200-EXIT.                                                      DTSBD790
01195      EXIT.                                                        DTSBD790
01196      SKIP3                                                        DTSBD790
01197  P1210-MSOL-SCAN.                                                 DTSBD790
01198      MOVE MSKL-REC TO MSOL-REC.                                   DTSBD790
01199                                                                   DTSBD790
01200      IF MSOL-INACT-WITHDRAWN-88                                   DTSBD790
01201          NEXT SENTENCE                                            DTSBD790
01202      ELSE                                                         DTSBD790
01203          IF (MSOL-LIAB-DATE > WRK-COMPUTATION-DATE)               DTSBD790
01204                 OR                                                DTSBD790
01205             (MSOL-INACT-DATE < WRK-COMPUTATION-DATE)              DTSBD790
01206              NEXT SENTENCE                                        DTSBD790
01207          ELSE                                                     DTSBD790
01208              MOVE 'Y' TO ACTIVE-AT-COMPUTATION-DATE-IND           DTSBD790
01209              SET L910-NO-REC-88 TO TRUE                           DTSBD790
01210              GO TO P1210-EXIT.                                    DTSBD790
01211                                                                   DTSBD790
01212      PERFORM S910-READ-NEXT THRU S910-EXIT.                       DTSBD790
01213  P1210-EXIT.                                                      DTSBD790
01214      EXIT.                                                        DTSBD790
01215      SKIP3                                                        DTSBD790
01216  P1220-MQTR-SCAN.                                                 DTSBD790
01217      MOVE MSKL-REC TO MQTR-REC.                                   DTSBD790
01218                                                                   DTSBD790
01219      IF MQTR-YRQ > WRK-PAYROLL-END-YRQ                            DTSBD790
01220          SET L910-NO-REC-88 TO TRUE                               DTSBD790
01221          GO TO P1220-EXIT.                                        DTSBD790
01222                                                                   DTSBD790
01223      ADD MQTR-TOT-WAGE TO ACCUM-LINE2-TOT-WAGES.                  DTSBD790
01224                                                                   DTSBD790
01225      PERFORM S910-READ-NEXT THRU S910-EXIT.                       DTSBD790
01226  P1220-EXIT.                                                      DTSBD790
01227      EXIT.                                                        DTSBD790
01228      EJECT                                                        DTSBD790
01229  P2000-PROCESS-CHARGE.                                            DTSBD790
01230                                                                   DTSBD790
01231 *****                                                             DTSBD790
01232 *                                                                 DTSBD790
01233 *    THE FOLLOWING CODE MUST BE REVIEWED AND, PROBABLY MODIFIED,  DTSBD790
01234 *    FOR DC.                                                      DTSBD790
01235 *                                                                 DTSBD790
01236 *    MEANING OF THE FOUR "ACCUM" DATA ELEMENTS WHICH MUST BE      DTSBD790
01237 *    UPDATED IN THIS PARAGRAPH ARE:                               DTSBD790
01238 *                                                                 DTSBD790
01239 *      ACCUM-LINE6A-CHARGES IS IDENTIFIED ON THE ETA 204 REPORT   DTSBD790
01240 *      AS "SUMMARY OF BENEFITS PAID; TOTAL FOR TAXABLE EMPLOYER   DTSBD790
01241 *      ACCOUNTS; CHARGED".                                        DTSBD790
01242 *                                                                 DTSBD790
01243 *      ACCUM-LINE6B-CHARGES IS IDENTIFIED ON THE ETA 204 REPORT   DTSBD790
01244 *      AS "SUMMARY OF BENEFITS PAID; TOTAL FOR TAXABLE EMPLOYER   DTSBD790
01245 *      ACCOUNTS; NONCHARGED".                                     DTSBD790
01246 *                                                                 DTSBD790
01247 *      ACCUM-LINE7A-CHARGES IS IDENTIFIED ON THE ETA 204 REPORT   DTSBD790
01248 *      AS "SUMMARY OF BENEFITS PAID; REIMBURSABLE EMPLOYER        DTSBD790
01249 *      ACCOUNTS; CHARGED".                                        DTSBD790
01250 *                                                                 DTSBD790
01251 *      ACCUM-LINE7B-CHARGES IS IDENTIFIED ON THE ETA 204 REPORT   DTSBD790
01252 *      AS "SUMMARY OF BENEFITS PAID; REIMBURSABLE EMPLOYER        DTSBD790
01253 *      ACCOUNTS; NONCHARGED".                                     DTSBD790
01254 *                                                                 DTSBD790
01255 *                                                                 DTSBD790
01256 *    WHEN THIS CODE WAS WRITTEN, IT WAS UNCLEAR WHETHER, IN DC,   DTSBD790
01257 *    SELF INSURED EMPLOYER CHARGES CAN BE "NONCHARGED".  IF       DTSBD790
01258 *    SELF INSURED EMPLOYER CHARGES CAN BE "NONCHARGED", THEN      DTSBD790
01259 *    THE CHARGE DETAIL RECORDS ASSOCIATED WITH SELF INSURED       DTSBD790
01260 *    "NONCHARGED" AMOUNTS MUST BE IDENTIFIED AND ACCUM-LINE7B-    DTSBD790
01261 *    CHARGES UPDATED AS APPROPRIATE.                              DTSBD790
01262 *                                                                 DTSBD790
01263 *    11/23/1999: SELF-INSURED EMPLOYERS CANNOT BE RELIEVED OF     DTSBD790
01264 *    CHARGES IN DC. - GD                                          DTSBD790
01265 *    ACCOUNT NUMBERS 999000 - 999008 ARE OVERPAYMENT POOL ACCOUNTSDTSBD790
01266 *    USED WHEN RATED EMPLOYERS ARE RELIEVED OF CHARGES FOR        DTSBD790
01267 *    BENEFITS OVERPAID.                                           DTSBD790
01268 *    EMPLOYER TYPE 05 IS THE 'VOLUNARY QUIT' POOL ACCOUNT.        DTSBD790
01269 *    EMPLOYER TYPE 06 IS THE 'MISCONDUCT' POOL ACCOUNT.           DTSBD790
01270 *    EMPLOYER TYPE 15 IS THE 'CONTINUING EMPLOYMENT' POOL ACCOUNT.DTSBD790
01271 *****                                                             DTSBD790
01272                                                                   DTSBD790
01273 **   MOVE WRK-BEGIN-DATE               TO CHG2-CHARGE-DATE.       DTSBD790
01274      MOVE WRK-BEN-CHRG-YEAR-START-DATE TO CHG2-CHARGE-DATE.       DTSBD790
01275      MOVE +0                           TO CHG2-EMP-NO             DTSBD790
01276                                           CHG2-SSN                DTSBD790
01277                                           CHG2-BYE.               DTSBD790
01278      MOVE 0                            TO CHG2-PROGRAM.           DTSBD790
01279      START BEN-CHG-FILE-IN                                        DTSBD790
01280         KEY IS >= CHG2-KEY-AREA.                                  DTSBD790
01281                                                                   DTSBD790
01282      IF NOT BEN-FILE-OK-88                                        DTSBD790
01283         DISPLAY 'BEN CHG FIRST READ ERROR: ' BEN-CHG-STATUS       DTSBD790
01284         PERFORM S999-ABEND   THRU S999-EXIT.                      DTSBD790
01285                                                                   DTSBD790
01286      PERFORM P2100-ACCUM-CHARGES THRU P2100-EXIT                  DTSBD790
01287          UNTIL BEN-FILE-EOF-88.                                   DTSBD790
01288                                                                   DTSBD790
01289  P2000-EXIT.                                                      DTSBD790
01290      EXIT.                                                        DTSBD790
01291      EJECT                                                        DTSBD790
01292  P2100-ACCUM-CHARGES.                                             DTSBD790
01293      READ BEN-CHG-FILE-IN NEXT.                                   DTSBD790
01294                                                                   DTSBD790
01295      IF BEN-FILE-EOF-88                                           DTSBD790
01296         GO TO P2100-EXIT                                          DTSBD790
01297      ELSE                                                         DTSBD790
01298         IF NOT BEN-FILE-OK-88                                     DTSBD790
01299            DISPLAY 'BEN CHG FILE READ ERROR: ' BEN-CHG-STATUS     DTSBD790
01300            PERFORM S999-ABEND  THRU S999-EXIT.                    DTSBD790
01301                                                                   DTSBD790
01302      IF CHG2-CHARGE-DATE > WRK-BEN-CHRG-YEAR-END-DATE             DTSBD790
01303         SET BEN-FILE-EOF-88    TO TRUE                            DTSBD790
01304         GO TO P2100-EXIT.                                         DTSBD790
01305                                                                   DTSBD790
01306      IF CHG2-PROG-UI                                              DTSBD790
01307         NEXT SENTENCE                                             DTSBD790
01308      ELSE                                                         DTSBD790
01309         GO TO P2100-EXIT.                                         DTSBD790
01310                                                                   DTSBD790
01311      ADD 1 TO WRK-BEN-CHG-READ                                    DTSBD790
01312      COMPUTE WRK-CHARGE-CURR-AMT = WRK-CHARGE-CURR-AMT +          DTSBD790
01313              (CHG2-CURR-BEN-AMT + CHG2-CURR-ADJ-AMT).             DTSBD790
01314                                                                   DTSBD790
01315                                                                   DTSBD790
01316 **************************************************************    DTSBD790
01317 *  NEW                                                            DTSBD790
01318 **************************************************************    DTSBD790
01319      IF CHG2-EMP-TYPE = 00                                        DTSBD790
01320         IF (CHG2-EMP-NO < 999000) OR (CHG2-EMP-NO > 999008)       DTSBD790
01321             COMPUTE ACCUM-LINE6A-CHARGES = ACCUM-LINE6A-CHARGES + DTSBD790
01322               (CHG2-CURR-BEN-AMT + CHG2-CURR-ADJ-AMT)             DTSBD790
01323         ELSE                                                      DTSBD790
01324             COMPUTE ACCUM-LINE6B-CHARGES = ACCUM-LINE6B-CHARGES + DTSBD790
01325               (CHG2-CURR-BEN-AMT + CHG2-CURR-ADJ-AMT)             DTSBD790
01326         END-IF                                                    DTSBD790
01327      ELSE                                                         DTSBD790
01328         IF CHG2-EMP-TYPE =                                        DTSBD790
01329               (05 OR 06 OR 09 OR 13 OR 15 OR 17 OR 18)            DTSBD790
01330             COMPUTE ACCUM-LINE6B-CHARGES = ACCUM-LINE6B-CHARGES + DTSBD790
01331               (CHG2-CURR-BEN-AMT + CHG2-CURR-ADJ-AMT)             DTSBD790
01332         ELSE                                                      DTSBD790
01333            IF CHG2-EMP-TYPE = (04 OR 07 OR 08 OR 10)              DTSBD790
01334               COMPUTE ACCUM-LINE7A-CHARGES = ACCUM-LINE7A-CHARGES DTSBD790
01335               + (CHG2-CURR-BEN-AMT + CHG2-CURR-ADJ-AMT)           DTSBD790
01336            END-IF                                                 DTSBD790
01337         END-IF                                                    DTSBD790
01338      END-IF.                                                      DTSBD790
01339                                                                   DTSBD790
01340 ***************************************************************** DTSBD790
01341 *  ORIGINAL VERSION AS OF 11/24/2008 - START                      DTSBD790
01342 *     *( MARKS CODE INCLUDED.                                     DTSBD790
01343 ***************************************************************** DTSBD790
01344 *(   IF CHG2-EMP-TYPE = 00                                        DTSBD790
01345 *(      IF (CHG2-EMP-NO < 999000) OR (CHG2-EMP-NO > 999008)       DTSBD790
01346 *(          COMPUTE ACCUM-LINE6A-CHARGES = ACCUM-LINE6A-CHARGES + DTSBD790
01347 *(            (CHG2-CURR-BEN-AMT + CHG2-CURR-ADJ-AMT)             DTSBD790
01348 *(      ELSE                                                      DTSBD790
01349 *(          PERFORM P2110-NON-CHARGE  THRU P2110-EXIT             DTSBD790
01350 **          COMPUTE ACCUM-LINE6B-CHARGES = ACCUM-LINE6B-CHARGES + DTSBD790
01351 **            (CHG2-CURR-BEN-AMT + CHG2-CURR-ADJ-AMT)             DTSBD790
01352 *(      END-IF                                                    DTSBD790
01353 *(   ELSE                                                         DTSBD790
01354 *(      IF CHG2-EMP-TYPE = 05 OR 06 OR 15                         DTSBD790
01355 *(          PERFORM P2110-NON-CHARGE  THRU P2110-EXIT             DTSBD790
01356 **          COMPUTE ACCUM-LINE6B-CHARGES = ACCUM-LINE6B-CHARGES + DTSBD790
01357 **            (CHG2-CURR-BEN-AMT + CHG2-CURR-ADJ-AMT)             DTSBD790
01358 *(      ELSE                                                      DTSBD790
01359 ***  CHANGED 7/23/2007 TO INCLUDE SELF-INSURED, DC GOVERNMENT,    DTSBD790
01360 ***  THE STATE SHARE OF EB, AND DC-LIABLE INTERSTATE              DTSBD790
01361 *(        IF CHG2-EMP-TYPE = (04 OR 07 OR 08 OR 10)               DTSBD790
01362 *(           COMPUTE ACCUM-LINE7A-CHARGES = ACCUM-LINE7A-CHARGES  DTSBD790
01363 *(           + (CHG2-CURR-BEN-AMT + CHG2-CURR-ADJ-AMT)            DTSBD790
01364 *&                                                                DTSBD790
01365 *(       COMPUTE WRK-CHG-AMT =                                    DTSBD790
01366 *(         (CHG2-CURR-BEN-AMT + CHG2-CURR-ADJ-AMT)                DTSBD790
01367 *(       IF WRK-CHG-AMT < -1000                                   DTSBD790
01368 *(          ADD WRK-CHG-AMT TO WRK-NEG6B-TOT                      DTSBD790
01369 *(          MOVE CHG2-CURR-BEN-AMT TO DISPLAY-AMT                 DTSBD790
01370 *(          MOVE CHG2-CURR-ADJ-AMT TO DISPLAY-AMT1                DTSBD790
01371 *(          DISPLAY 'NEG LINE 6B ' CHG2-EMP-NO '  SSN ' CHG2-SSN  DTSBD790
01372 *(             '  BYE ' CHG2-BYE '  PROG ' CHG2-PROGRAM           DTSBD790
01373 *(          DISPLAY '   CURR ' DISPLAY-AMT '  ADJ ' DISPLAY-AMT1  DTSBD790
01374 *(             '  TYPE ' CHG2-EMP-TYPE '  DATE ' CHG2-CHARGE-DATE DTSBD790
01375 *(        END-IF                                                  DTSBD790
01376 *&                                                                DTSBD790
01377 *(      END-IF                                                    DTSBD790
01378 *(   END-IF.                                                      DTSBD790
01379 ***************************************************************** DTSBD790
01380 *  ORIGINAL VERSION AS OF 11/24/2008 - END                        DTSBD790
01381 ***************************************************************** DTSBD790
01382                                                                   DTSBD790
01383  P2100-EXIT.                                                      DTSBD790
01384      EXIT.                                                        DTSBD790
01385                                                                   DTSBD790
01386  P2110-NON-CHARGE.                                                DTSBD790
01387      IF (CHG2-BYE = ZERO) OR (CHG2-CHARGE-DATE < 20010101)        DTSBD790
01388          COMPUTE ACCUM-LINE6B-CHARGES = ACCUM-LINE6B-CHARGES +    DTSBD790
01389            (CHG2-CURR-BEN-AMT + CHG2-CURR-ADJ-AMT)                DTSBD790
01390 *&                                                                DTSBD790
01391          COMPUTE WRK-CHG-AMT =                                    DTSBD790
01392            (CHG2-CURR-BEN-AMT + CHG2-CURR-ADJ-AMT)                DTSBD790
01393          IF WRK-CHG-AMT < ZERO                                    DTSBD790
01394             ADD WRK-CHG-AMT TO WRK-NEG6B-TOT                      DTSBD790
01395             MOVE CHG2-CURR-BEN-AMT TO DISPLAY-AMT                 DTSBD790
01396             MOVE CHG2-CURR-ADJ-AMT TO DISPLAY-AMT1                DTSBD790
01397             DISPLAY 'NEG LINE 6B ' CHG2-EMP-NO '  SSN ' CHG2-SSN  DTSBD790
01398                '  BYE ' CHG2-BYE '  PROG ' CHG2-PROGRAM           DTSBD790
01399             DISPLAY '   CURR ' DISPLAY-AMT '  ADJ ' DISPLAY-AMT1  DTSBD790
01400                '  TYPE ' CHG2-EMP-TYPE '  DATE ' CHG2-CHARGE-DATE DTSBD790
01401          ELSE                                                     DTSBD790
01402             ADD WRK-CHG-AMT TO WRK-POS6B-TOT                      DTSBD790
01403          END-IF                                                   DTSBD790
01404 *&                                                                DTSBD790
01405      ELSE                                                         DTSBD790
01406        IF CHG2-BYE < 20010101                                     DTSBD790
01407           NEXT SENTENCE                                           DTSBD790
01408        ELSE                                                       DTSBD790
01409           COMPUTE ACCUM-LINE6B-CHARGES = ACCUM-LINE6B-CHARGES +   DTSBD790
01410             (CHG2-CURR-BEN-AMT + CHG2-CURR-ADJ-AMT)               DTSBD790
01411 *&                                                                DTSBD790
01412          COMPUTE WRK-CHG-AMT =                                    DTSBD790
01413            (CHG2-CURR-BEN-AMT + CHG2-CURR-ADJ-AMT)                DTSBD790
01414          IF WRK-CHG-AMT < ZERO                                    DTSBD790
01415             ADD WRK-CHG-AMT TO WRK-NEG6B-TOT                      DTSBD790
01416             MOVE CHG2-CURR-BEN-AMT TO DISPLAY-AMT                 DTSBD790
01417             MOVE CHG2-CURR-ADJ-AMT TO DISPLAY-AMT1                DTSBD790
01418 *&          DISPLAY 'NEG LINE 6B ' CHG2-EMP-NO '  SSN ' CHG2-SSN  DTSBD790
01419 *              '  BYE ' CHG2-BYE '  PROG ' CHG2-PROGRAM           DTSBD790
01420 *           DISPLAY '   CURR ' DISPLAY-AMT '  ADJ ' DISPLAY-AMT1  DTSBD790
01421 *&             '  TYPE ' CHG2-EMP-TYPE '  DATE ' CHG2-CHARGE-DATE DTSBD790
01422          ELSE                                                     DTSBD790
01423             ADD WRK-CHG-AMT TO WRK-POS6B-TOT                      DTSBD790
01424          END-IF.                                                  DTSBD790
01425 *&                                                                DTSBD790
01426                                                                   DTSBD790
01427  P2110-EXIT.                                                      DTSBD790
01428      EXIT.                                                        DTSBD790
01429                                                                   DTSBD790
01430  T0000-TERMINATE.                                                 DTSBD790
01431      PERFORM T1000-CONSTRUCT-WRITE-R517 THRU T1000-EXIT.          DTSBD790
01432                                                                   DTSBD790
01433      PERFORM T1100-BUILD-DOWNLOAD       THRU T1100-EXIT.          DTSBD790
01434                                                                   DTSBD790
01435      PERFORM T2000-TERMINATION-DISPLAYS THRU T2000-EXIT.          DTSBD790
01436                                                                   DTSBD790
01437      PERFORM SBCF-CLOSE THRU SBCF-EXIT.                           DTSBD790
01438                                                                   DTSBD790
01439      PERFORM S910-CLOSE THRU S910-EXIT.                           DTSBD790
01440                                                                   DTSBD790
01441      PERFORM S931-CLOSE THRU S931-EXIT.                           DTSBD790
01442                                                                   DTSBD790
01443      MOVE -1 TO R517-LENGTH.                                      DTSBD790
01444                                                                   DTSBD790
01445      PERFORM S946-WRITE-R517 THRU S946-EXIT.                      DTSBD790
01446                                                                   DTSBD790
01447                                                                   DTSBD790
01448  T0000-EXIT.                                                      DTSBD790
01449      EXIT.                                                        DTSBD790
01450      SKIP3                                                        DTSBD790
01451  T1000-CONSTRUCT-WRITE-R517.                                      DTSBD790
01452      COMPUTE R517-LINE1A-TOT-WAGES ROUNDED                        DTSBD790
01453        = ACCUM-LINE1A-TOT-WAGES.                                  DTSBD790
01454                                                                   DTSBD790
01455      COMPUTE R517-LINE1A-TAX-WAGES ROUNDED                        DTSBD790
01456        = ACCUM-LINE1A-TAX-WAGES.                                  DTSBD790
01457                                                                   DTSBD790
01458      COMPUTE R517-LINE1B-TOT-WAGES ROUNDED                        DTSBD790
01459        = ACCUM-LINE1B-TOT-WAGES.                                  DTSBD790
01460                                                                   DTSBD790
01461      COMPUTE R517-LINE1B-TAX-WAGES ROUNDED                        DTSBD790
01462        = ACCUM-LINE1B-TAX-WAGES.                                  DTSBD790
01463                                                                   DTSBD790
01464      COMPUTE R517-LINE2-TOT-WAGES ROUNDED                         DTSBD790
01465        = ACCUM-LINE2-TOT-WAGES.                                   DTSBD790
01466                                                                   DTSBD790
01467      COMPUTE R517-LINE3A-TOT-WAGES ROUNDED                        DTSBD790
01468        = ACCUM-LINE3A-TOT-WAGES.                                  DTSBD790
01469                                                                   DTSBD790
01470      COMPUTE R517-LINE3A-TAX-WAGES ROUNDED                        DTSBD790
01471        = ACCUM-LINE3A-TAX-WAGES.                                  DTSBD790
01472                                                                   DTSBD790
01473      COMPUTE R517-LINE3B-TOT-WAGES ROUNDED                        DTSBD790
01474        = ACCUM-LINE3B-TOT-WAGES.                                  DTSBD790
01475                                                                   DTSBD790
01476      COMPUTE R517-LINE3B-TAX-WAGES ROUNDED                        DTSBD790
01477        = ACCUM-LINE3B-TAX-WAGES.                                  DTSBD790
01478                                                                   DTSBD790
01479      COMPUTE R517-LINE4A-TOT-WAGES ROUNDED                        DTSBD790
01480        = ACCUM-LINE4A-TOT-WAGES.                                  DTSBD790
01481                                                                   DTSBD790
01482      COMPUTE R517-LINE4A-TAX-WAGES ROUNDED                        DTSBD790
01483        = ACCUM-LINE4A-TAX-WAGES.                                  DTSBD790
01484                                                                   DTSBD790
01485      COMPUTE R517-LINE4B-TOT-WAGES ROUNDED                        DTSBD790
01486        = ACCUM-LINE4B-TOT-WAGES.                                  DTSBD790
01487                                                                   DTSBD790
01488      COMPUTE R517-LINE4B-TAX-WAGES ROUNDED                        DTSBD790
01489        = ACCUM-LINE4B-TAX-WAGES.                                  DTSBD790
01490                                                                   DTSBD790
01491                                                                   DTSBD790
01492      COMPUTE R517-LINE6A-CHARGES ROUNDED                          DTSBD790
01493        = ACCUM-LINE6A-CHARGES.                                    DTSBD790
01494                                                                   DTSBD790
01495      COMPUTE R517-LINE6A1-CHARGES ROUNDED                         DTSBD790
01496        = ACCUM-LINE6A1-CHARGES.                                   DTSBD790
01497                                                                   DTSBD790
01498      COMPUTE R517-LINE6B-CHARGES ROUNDED                          DTSBD790
01499        = ACCUM-LINE6B-CHARGES.                                    DTSBD790
01500                                                                   DTSBD790
01501      COMPUTE R517-LINE7A-CHARGES ROUNDED                          DTSBD790
01502        = ACCUM-LINE7A-CHARGES.                                    DTSBD790
01503                                                                   DTSBD790
01504      COMPUTE R517-LINE7B-CHARGES ROUNDED                          DTSBD790
01505        = ACCUM-LINE7B-CHARGES.                                    DTSBD790
01506                                                                   DTSBD790
01507                                                                   DTSBD790
01508      MOVE WRK-ELG-REG-OCC-MAX TO R517-ELG-REG-OCC-CNT.            DTSBD790
01509                                                                   DTSBD790
01510                                                                   DTSBD790
01511      PERFORM                                                      DTSBD790
01512        VARYING ACCUM-ELG-REG-SUB FROM 1 BY 1                      DTSBD790
01513        UNTIL ACCUM-ELG-REG-SUB > R517-ELG-REG-OCC-CNT             DTSBD790
01514          COMPUTE R517-ELG-REG-MIN-RATIO (ACCUM-ELG-REG-SUB)       DTSBD790
01515            = ACCUM-ELG-REG-MIN-RATIO (ACCUM-ELG-REG-SUB) * 100    DTSBD790
01516          COMPUTE R517-ELG-REG-MAX-RATIO (ACCUM-ELG-REG-SUB)       DTSBD790
01517            = ACCUM-ELG-REG-MAX-RATIO (ACCUM-ELG-REG-SUB) * 100    DTSBD790
01518          MOVE ACCUM-ELG-REG-EMPLR-CNT (ACCUM-ELG-REG-SUB)         DTSBD790
01519            TO R517-ELG-REG-EMPLR-CNT (ACCUM-ELG-REG-SUB)          DTSBD790
01520          COMPUTE R517-ELG-REG-TOT-WAGE                            DTSBD790
01521                   (ACCUM-ELG-REG-SUB) ROUNDED                     DTSBD790
01522            = ACCUM-ELG-REG-TOT-WAGE (ACCUM-ELG-REG-SUB)           DTSBD790
01523          COMPUTE R517-ELG-REG-TAX-WAGE                            DTSBD790
01524                   (ACCUM-ELG-REG-SUB) ROUNDED                     DTSBD790
01525            = ACCUM-ELG-REG-TAX-WAGE (ACCUM-ELG-REG-SUB)           DTSBD790
01526          COMPUTE R517-ELG-REG-BEN-CHARGED                         DTSBD790
01527                   (ACCUM-ELG-REG-SUB) ROUNDED                     DTSBD790
01528            = ACCUM-ELG-REG-BEN-CHARGED (ACCUM-ELG-REG-SUB)        DTSBD790
01529          COMPUTE R517-ELG-REG-EST-UI-PAID                         DTSBD790
01530                   (ACCUM-ELG-REG-SUB) ROUNDED                     DTSBD790
01531            = ACCUM-ELG-REG-EST-UI-PAID (ACCUM-ELG-REG-SUB)        DTSBD790
01532      END-PERFORM.                                                 DTSBD790
01533                                                                   DTSBD790
01534                                                                   DTSBD790
01535      MOVE ACCUM-ELG-SPECIAL-EMPLR-CNT                             DTSBD790
01536        TO R517-ELG-SPECIAL-EMPLR-CNT.                             DTSBD790
01537                                                                   DTSBD790
01538      COMPUTE R517-ELG-SPECIAL-TOT-WAGE ROUNDED                    DTSBD790
01539        = ACCUM-ELG-SPECIAL-TOT-WAGE.                              DTSBD790
01540                                                                   DTSBD790
01541      COMPUTE R517-ELG-SPECIAL-TAX-WAGE ROUNDED                    DTSBD790
01542        = ACCUM-ELG-SPECIAL-TAX-WAGE.                              DTSBD790
01543                                                                   DTSBD790
01544      COMPUTE R517-ELG-SPECIAL-BEN-CHARGED ROUNDED                 DTSBD790
01545        = ACCUM-ELG-SPECIAL-BEN-CHARGED.                           DTSBD790
01546                                                                   DTSBD790
01547      COMPUTE R517-ELG-SPECIAL-EST-UI-PAID ROUNDED                 DTSBD790
01548        = ACCUM-ELG-SPECIAL-EST-UI-PAID.                           DTSBD790
01549                                                                   DTSBD790
01550                                                                   DTSBD790
01551      MOVE ACCUM-INELG-EMPLR-CNT                                   DTSBD790
01552        TO R517-INELG-EMPLR-CNT.                                   DTSBD790
01553                                                                   DTSBD790
01554      COMPUTE R517-INELG-TOT-WAGE ROUNDED                          DTSBD790
01555        = ACCUM-INELG-TOT-WAGE.                                    DTSBD790
01556                                                                   DTSBD790
01557      COMPUTE R517-INELG-TAX-WAGE ROUNDED                          DTSBD790
01558        = ACCUM-INELG-TAX-WAGE.                                    DTSBD790
01559                                                                   DTSBD790
01560      COMPUTE R517-INELG-BEN-CHARGED ROUNDED                       DTSBD790
01561        = ACCUM-INELG-BEN-CHARGED.                                 DTSBD790
01562                                                                   DTSBD790
01563      COMPUTE R517-INELG-EST-UI-PAID ROUNDED                       DTSBD790
01564        = ACCUM-INELG-EST-UI-PAID.                                 DTSBD790
01565                                                                   DTSBD790
01566                                                                   DTSBD790
01567      PERFORM S946-WRITE-R517 THRU S946-EXIT.                      DTSBD790
01568  T1000-EXIT.                                                      DTSBD790
01569      EXIT.                                                        DTSBD790
01570      SKIP3                                                        DTSBD790
01571  T1100-BUILD-DOWNLOAD.                                            DTSBD790
01572      PERFORM T1110-WRITE-RPT-DATE       THRU T1110-EXIT.          DTSBD790
01573                                                                   DTSBD790
01574 *&                                                                DTSBD790
01575      DISPLAY 'T1100 DWN-TOTAL ' DWN-TOTAL.                        DTSBD790
01576 *&                                                                DTSBD790
01577      PERFORM                                                      DTSBD790
01578        VARYING ACCUM-ELG-REG-SUB FROM 1 BY 1                      DTSBD790
01579        UNTIL ACCUM-ELG-REG-SUB > WRK-ELG-REG-OCC-MAX              DTSBD790
01580          PERFORM T1130-WRITE-AVG-RATE       THRU T1130-EXIT       DTSBD790
01581          MOVE ACCUM-ELG-REG-EMPLR-CNT (ACCUM-ELG-REG-SUB)         DTSBD790
01582            TO DWN-TOTAL                                           DTSBD790
01583          ADD ACCUM-ELG-REG-EMPLR-CNT (ACCUM-ELG-REG-SUB)          DTSBD790
01584             TO TOTAL-ELG-REG-EMPLR-CNT                            DTSBD790
01585          PERFORM T1120-WRITE-TOTAL          THRU T1120-EXIT       DTSBD790
01586          COMPUTE DWN-TOTAL =                                      DTSBD790
01587             ACCUM-ELG-REG-TOT-WAGE (ACCUM-ELG-REG-SUB)            DTSBD790
01588          COMPUTE DWN-TOTAL ROUNDED = (DWN-TOTAL / 1000)           DTSBD790
01589          ADD ACCUM-ELG-REG-TOT-WAGE (ACCUM-ELG-REG-SUB)           DTSBD790
01590             TO TOTAL-ELG-REG-TOT-WAGE                             DTSBD790
01591          PERFORM T1120-WRITE-TOTAL          THRU T1120-EXIT       DTSBD790
01592          COMPUTE DWN-TOTAL =                                      DTSBD790
01593             ACCUM-ELG-REG-TAX-WAGE (ACCUM-ELG-REG-SUB)            DTSBD790
01594          COMPUTE DWN-TOTAL ROUNDED = (DWN-TOTAL / 1000)           DTSBD790
01595          ADD ACCUM-ELG-REG-TAX-WAGE (ACCUM-ELG-REG-SUB)           DTSBD790
01596             TO TOTAL-ELG-REG-TAX-WAGE                             DTSBD790
01597          PERFORM T1120-WRITE-TOTAL          THRU T1120-EXIT       DTSBD790
01598          COMPUTE DWN-TOTAL =                                      DTSBD790
01599             ACCUM-ELG-REG-BEN-CHARGED (ACCUM-ELG-REG-SUB)         DTSBD790
01600          COMPUTE DWN-TOTAL ROUNDED = (DWN-TOTAL / 1000)           DTSBD790
01601          ADD ACCUM-ELG-REG-BEN-CHARGED (ACCUM-ELG-REG-SUB)        DTSBD790
01602             TO TOTAL-ELG-REG-BEN-CHARGED                          DTSBD790
01603          PERFORM T1120-WRITE-TOTAL          THRU T1120-EXIT       DTSBD790
01604          COMPUTE DWN-TOTAL =                                      DTSBD790
01605             ACCUM-ELG-REG-EST-UI-PAID (ACCUM-ELG-REG-SUB)         DTSBD790
01606          COMPUTE DWN-TOTAL ROUNDED = (DWN-TOTAL / 1000)           DTSBD790
01607          ADD ACCUM-ELG-REG-EST-UI-PAID (ACCUM-ELG-REG-SUB)        DTSBD790
01608             TO TOTAL-ELG-REG-EST-UI-PAID                          DTSBD790
01609          PERFORM T1120-WRITE-TOTAL          THRU T1120-EXIT       DTSBD790
01610      END-PERFORM.                                                 DTSBD790
01611                                                                   DTSBD790
01612 ***   REGULAR/ELIGIBLE TOTALS  ***                                DTSBD790
01613      MOVE TOTAL-ELG-REG-EST-UI-PAID         TO DWN-CONTRIB.       DTSBD790
01614      MOVE TOTAL-ELG-REG-TAX-WAGE            TO DWN-TAX-WAGE.      DTSBD790
01615      PERFORM T1140-WRITE-TOTAL-AVG-RATE     THRU T1140-EXIT.      DTSBD790
01616                                                                   DTSBD790
01617      MOVE TOTAL-ELG-REG-EMPLR-CNT           TO DWN-TOTAL.         DTSBD790
01618      PERFORM T1120-WRITE-TOTAL              THRU T1120-EXIT.      DTSBD790
01619                                                                   DTSBD790
01620      COMPUTE DWN-TOTAL = TOTAL-ELG-REG-TOT-WAGE.                  DTSBD790
01621      COMPUTE DWN-TOTAL ROUNDED = (DWN-TOTAL / 1000).              DTSBD790
01622      PERFORM T1120-WRITE-TOTAL              THRU T1120-EXIT.      DTSBD790
01623                                                                   DTSBD790
01624      COMPUTE DWN-TOTAL = TOTAL-ELG-REG-TAX-WAGE.                  DTSBD790
01625      COMPUTE DWN-TOTAL ROUNDED = (DWN-TOTAL / 1000).              DTSBD790
01626      PERFORM T1120-WRITE-TOTAL              THRU T1120-EXIT.      DTSBD790
01627                                                                   DTSBD790
01628      COMPUTE DWN-TOTAL = TOTAL-ELG-REG-BEN-CHARGED.               DTSBD790
01629      COMPUTE DWN-TOTAL ROUNDED = (DWN-TOTAL / 1000).              DTSBD790
01630      PERFORM T1120-WRITE-TOTAL              THRU T1120-EXIT.      DTSBD790
01631                                                                   DTSBD790
01632      COMPUTE DWN-TOTAL  = TOTAL-ELG-REG-EST-UI-PAID.              DTSBD790
01633      COMPUTE DWN-TOTAL ROUNDED = (DWN-TOTAL / 1000).              DTSBD790
01634      PERFORM T1120-WRITE-TOTAL              THRU T1120-EXIT.      DTSBD790
01635                                                                   DTSBD790
01636 ***   SPECIALLY TAXED TOTALS  ***                                 DTSBD790
01637      MOVE 0.00                          TO DWN-AVG-RATE.          DTSBD790
01638      MOVE DWN-AVG-RATE                  TO ETA204-DOWNLOAD-REC.   DTSBD790
01639      PERFORM SDWN02-WRITE               THRU SDWN02-EXIT.         DTSBD790
01640                                                                   DTSBD790
01641      MOVE '0'                      TO ETA204-DOWNLOAD-REC.        DTSBD790
01642      PERFORM SDWN02-WRITE          THRU SDWN02-EXIT.              DTSBD790
01643                                                                   DTSBD790
01644      MOVE '0'                      TO ETA204-DOWNLOAD-REC.        DTSBD790
01645      PERFORM SDWN02-WRITE          THRU SDWN02-EXIT.              DTSBD790
01646                                                                   DTSBD790
01647      MOVE '0'                      TO ETA204-DOWNLOAD-REC.        DTSBD790
01648      PERFORM SDWN02-WRITE          THRU SDWN02-EXIT.              DTSBD790
01649                                                                   DTSBD790
01650      MOVE '0'                      TO ETA204-DOWNLOAD-REC.        DTSBD790
01651      PERFORM SDWN02-WRITE          THRU SDWN02-EXIT.              DTSBD790
01652                                                                   DTSBD790
01653      MOVE '0'                      TO ETA204-DOWNLOAD-REC.        DTSBD790
01654      PERFORM SDWN02-WRITE          THRU SDWN02-EXIT.              DTSBD790
01655                                                                   DTSBD790
01656 ***   REGULAR/ELIGIBLE GRAND TOTALS  ***                          DTSBD790
01657      MOVE TOTAL-ELG-REG-EST-UI-PAID         TO DWN-CONTRIB.       DTSBD790
01658      MOVE TOTAL-ELG-REG-TAX-WAGE            TO DWN-TAX-WAGE.      DTSBD790
01659      PERFORM T1140-WRITE-TOTAL-AVG-RATE     THRU T1140-EXIT.      DTSBD790
01660                                                                   DTSBD790
01661      MOVE TOTAL-ELG-REG-EMPLR-CNT           TO DWN-TOTAL.         DTSBD790
01662      PERFORM T1120-WRITE-TOTAL              THRU T1120-EXIT.      DTSBD790
01663                                                                   DTSBD790
01664      COMPUTE DWN-TOTAL = TOTAL-ELG-REG-TOT-WAGE.                  DTSBD790
01665      COMPUTE DWN-TOTAL ROUNDED = (DWN-TOTAL / 1000).              DTSBD790
01666      PERFORM T1120-WRITE-TOTAL              THRU T1120-EXIT.      DTSBD790
01667                                                                   DTSBD790
01668      COMPUTE DWN-TOTAL = TOTAL-ELG-REG-TAX-WAGE.                  DTSBD790
01669      COMPUTE DWN-TOTAL ROUNDED = (DWN-TOTAL / 1000).              DTSBD790
01670      PERFORM T1120-WRITE-TOTAL              THRU T1120-EXIT.      DTSBD790
01671                                                                   DTSBD790
01672      COMPUTE DWN-TOTAL = TOTAL-ELG-REG-BEN-CHARGED.               DTSBD790
01673      COMPUTE DWN-TOTAL ROUNDED = (DWN-TOTAL / 1000).              DTSBD790
01674      PERFORM T1120-WRITE-TOTAL              THRU T1120-EXIT.      DTSBD790
01675                                                                   DTSBD790
01676      COMPUTE DWN-TOTAL = TOTAL-ELG-REG-EST-UI-PAID.               DTSBD790
01677      COMPUTE DWN-TOTAL ROUNDED = (DWN-TOTAL / 1000).              DTSBD790
01678      PERFORM T1120-WRITE-TOTAL              THRU T1120-EXIT.      DTSBD790
01679                                                                   DTSBD790
01680 ***   REGULAR/INELIGIBLE TOTALS  ***                              DTSBD790
01681      MOVE ACCUM-INELG-EST-UI-PAID           TO DWN-CONTRIB.       DTSBD790
01682      MOVE ACCUM-INELG-TAX-WAGE              TO DWN-TAX-WAGE.      DTSBD790
01683      PERFORM T1140-WRITE-TOTAL-AVG-RATE     THRU T1140-EXIT.      DTSBD790
01684                                                                   DTSBD790
01685      MOVE ACCUM-INELG-EMPLR-CNT             TO DWN-TOTAL.         DTSBD790
01686      PERFORM T1120-WRITE-TOTAL              THRU T1120-EXIT.      DTSBD790
01687                                                                   DTSBD790
01688      COMPUTE DWN-TOTAL = ACCUM-INELG-TOT-WAGE.                    DTSBD790
01689      COMPUTE DWN-TOTAL ROUNDED = (DWN-TOTAL / 1000).              DTSBD790
01690      PERFORM T1120-WRITE-TOTAL              THRU T1120-EXIT.      DTSBD790
01691                                                                   DTSBD790
01692      COMPUTE DWN-TOTAL = ACCUM-INELG-TAX-WAGE.                    DTSBD790
01693      COMPUTE DWN-TOTAL ROUNDED = (DWN-TOTAL / 1000).              DTSBD790
01694      PERFORM T1120-WRITE-TOTAL              THRU T1120-EXIT.      DTSBD790
01695                                                                   DTSBD790
01696      COMPUTE DWN-TOTAL = ACCUM-INELG-BEN-CHARGED.                 DTSBD790
01697      COMPUTE DWN-TOTAL ROUNDED = (DWN-TOTAL / 1000).              DTSBD790
01698      PERFORM T1120-WRITE-TOTAL              THRU T1120-EXIT.      DTSBD790
01699                                                                   DTSBD790
01700      COMPUTE DWN-TOTAL = ACCUM-INELG-EST-UI-PAID.                 DTSBD790
01701      COMPUTE DWN-TOTAL ROUNDED = (DWN-TOTAL / 1000).              DTSBD790
01702      PERFORM T1120-WRITE-TOTAL              THRU T1120-EXIT.      DTSBD790
01703                                                                   DTSBD790
01704 ***   GRAND TOTAL                ***                              DTSBD790
01705      COMPUTE DWN-CONTRIB =                                        DTSBD790
01706        (TOTAL-ELG-REG-EST-UI-PAID + ACCUM-INELG-EST-UI-PAID).     DTSBD790
01707      COMPUTE DWN-TAX-WAGE =                                       DTSBD790
01708        (TOTAL-ELG-REG-TAX-WAGE + ACCUM-INELG-TAX-WAGE).           DTSBD790
01709      PERFORM T1140-WRITE-TOTAL-AVG-RATE     THRU T1140-EXIT.      DTSBD790
01710                                                                   DTSBD790
01711      COMPUTE DWN-TOTAL =                                          DTSBD790
01712        (TOTAL-ELG-REG-EMPLR-CNT + ACCUM-INELG-EMPLR-CNT)          DTSBD790
01713      PERFORM T1120-WRITE-TOTAL              THRU T1120-EXIT.      DTSBD790
01714                                                                   DTSBD790
01715      COMPUTE DWN-TOTAL =                                          DTSBD790
01716        (TOTAL-ELG-REG-TOT-WAGE + ACCUM-INELG-TOT-WAGE).           DTSBD790
01717      COMPUTE DWN-TOTAL ROUNDED = (DWN-TOTAL / 1000).              DTSBD790
01718      PERFORM T1120-WRITE-TOTAL              THRU T1120-EXIT.      DTSBD790
01719                                                                   DTSBD790
01720      COMPUTE DWN-TOTAL =                                          DTSBD790
01721        (TOTAL-ELG-REG-TAX-WAGE + ACCUM-INELG-TAX-WAGE).           DTSBD790
01722      COMPUTE DWN-TOTAL ROUNDED = (DWN-TOTAL / 1000).              DTSBD790
01723      PERFORM T1120-WRITE-TOTAL              THRU T1120-EXIT.      DTSBD790
01724                                                                   DTSBD790
01725      COMPUTE DWN-TOTAL =                                          DTSBD790
01726        (TOTAL-ELG-REG-BEN-CHARGED + ACCUM-INELG-BEN-CHARGED).     DTSBD790
01727      COMPUTE DWN-TOTAL ROUNDED = (DWN-TOTAL / 1000).              DTSBD790
01728      PERFORM T1120-WRITE-TOTAL              THRU T1120-EXIT.      DTSBD790
01729                                                                   DTSBD790
01730      COMPUTE DWN-TOTAL =                                          DTSBD790
01731        (TOTAL-ELG-REG-EST-UI-PAID + ACCUM-INELG-EST-UI-PAID).     DTSBD790
01732      COMPUTE DWN-TOTAL ROUNDED = (DWN-TOTAL / 1000).              DTSBD790
01733      PERFORM T1120-WRITE-TOTAL              THRU T1120-EXIT.      DTSBD790
01734                                                                   DTSBD790
01735  T1100-EXIT.                                                      DTSBD790
01736      EXIT.                                                        DTSBD790
01737      SKIP3                                                        DTSBD790
01738  T1110-WRITE-RPT-DATE.                                            DTSBD790
01739      MOVE WRK-RTE-YR-END-DATE           TO L001-FED-8-DATE-9.     DTSBD790
01740      PERFORM S001-FROM-FED-8            THRU S001-EXIT.           DTSBD790
01741      MOVE L001-CAL-8-DATE-9             TO DWN-RPT-DATE.          DTSBD790
01742      MOVE DWN-RPT-DATE                  TO ETA204-DOWNLOAD-REC.   DTSBD790
01743      PERFORM SDWN02-WRITE               THRU SDWN02-EXIT.         DTSBD790
01744                                                                   DTSBD790
01745  T1110-EXIT.                                                      DTSBD790
01746      EXIT.                                                        DTSBD790
01747      SKIP3                                                        DTSBD790
01748  T1120-WRITE-TOTAL.                                               DTSBD790
01749 *&                                                                DTSBD790
01750      DISPLAY 'T1120 DWN-TOTAL ' DWN-TOTAL.                        DTSBD790
01751 *&                                                                DTSBD790
01752      MOVE DWN-TOTAL                     TO DWN-TOTAL-DISP.        DTSBD790
01753      PERFORM SDWN03-WRITE-TOTAL         THRU SDWN03-EXIT.         DTSBD790
01754                                                                   DTSBD790
01755  T1120-EXIT.                                                      DTSBD790
01756      EXIT.                                                        DTSBD790
01757      SKIP3                                                        DTSBD790
01758  T1130-WRITE-AVG-RATE.                                            DTSBD790
01759 *&                                                                DTSBD790
01760      DISPLAY 'T1130 UI-PAID '                                     DTSBD790
01761         ACCUM-ELG-REG-EST-UI-PAID (ACCUM-ELG-REG-SUB)             DTSBD790
01762         '  ' ACCUM-ELG-REG-SUB.                                   DTSBD790
01763      DISPLAY 'T1130 TAX WAGE '                                    DTSBD790
01764         ACCUM-ELG-REG-TAX-WAGE (ACCUM-ELG-REG-SUB)                DTSBD790
01765         '  ' ACCUM-ELG-REG-SUB.                                   DTSBD790
01766 *&                                                                DTSBD790
01767      MOVE ACCUM-ELG-REG-EST-UI-PAID (ACCUM-ELG-REG-SUB)           DTSBD790
01768        TO DWN-CONTRIB.                                            DTSBD790
01769      MOVE ACCUM-ELG-REG-TAX-WAGE (ACCUM-ELG-REG-SUB)              DTSBD790
01770        TO DWN-TAX-WAGE.                                           DTSBD790
01771      COMPUTE DWN-AVERAGE ROUNDED =                                DTSBD790
01772         (DWN-CONTRIB / DWN-TAX-WAGE) * 100.                       DTSBD790
01773      COMPUTE DWN-AVG-RATE ROUNDED = DWN-AVERAGE.                  DTSBD790
01774      MOVE DWN-AVG-RATE                  TO ETA204-DOWNLOAD-REC.   DTSBD790
01775      PERFORM SDWN02-WRITE               THRU SDWN02-EXIT.         DTSBD790
01776                                                                   DTSBD790
01777  T1130-EXIT.                                                      DTSBD790
01778      EXIT.                                                        DTSBD790
01779      SKIP3                                                        DTSBD790
01780  T1140-WRITE-TOTAL-AVG-RATE.                                      DTSBD790
01781 *&                                                                DTSBD790
01782      DISPLAY 'T1140 UI-PAID '                                     DTSBD790
01783         DWN-CONTRIB.                                              DTSBD790
01784      DISPLAY 'T1140 TAX WAGE '                                    DTSBD790
01785         DWN-TAX-WAGE.                                             DTSBD790
01786 *&                                                                DTSBD790
01787      COMPUTE DWN-AVERAGE ROUNDED =                                DTSBD790
01788         (DWN-CONTRIB / DWN-TAX-WAGE) * 100.                       DTSBD790
01789      COMPUTE DWN-AVG-RATE ROUNDED = DWN-AVERAGE.                  DTSBD790
01790      MOVE DWN-AVG-RATE                  TO ETA204-DOWNLOAD-REC.   DTSBD790
01791      PERFORM SDWN02-WRITE               THRU SDWN02-EXIT.         DTSBD790
01792                                                                   DTSBD790
01793  T1140-EXIT.                                                      DTSBD790
01794      EXIT.                                                        DTSBD790
01795      SKIP3                                                        DTSBD790
01796  T2000-TERMINATION-DISPLAYS.                                      DTSBD790
01797      DISPLAY '***'.                                               DTSBD790
01798                                                                   DTSBD790
01799      DISPLAY '*** '                                               DTSBD790
01800              WRK-MOD-NAME                                         DTSBD790
01801              ' TERMINATION STATISTICS'.                           DTSBD790
01802                                                                   DTSBD790
01803                                                                   DTSBD790
01804      DISPLAY '***'.                                               DTSBD790
01805                                                                   DTSBD790
01806      MOVE W-TOT-MRCT-CHG      TO DISPLAY-AMT.                     DTSBD790
01807      DISPLAY 'TOT MRCT CHG     ' DISPLAY-AMT.                     DTSBD790
01808      MOVE W-TOT-ACT-MRCT-CHG      TO DISPLAY-AMT.                 DTSBD790
01809      DISPLAY 'TOT ACT MRCT CHG ' DISPLAY-AMT.                     DTSBD790
01810                                                                   DTSBD790
01811      MOVE WRK-BEN-CHG-READ TO DISPLAY-CNT.                        DTSBD790
01812                                                                   DTSBD790
01813      DISPLAY '***                          CHARGE RECORDS READ: ' DTSBD790
01814              DISPLAY-CNT-X.                                       DTSBD790
01815                                                                   DTSBD790
01816                                                                   DTSBD790
01817      DISPLAY '***'.                                               DTSBD790
01818                                                                   DTSBD790
01819      MOVE WRK-CHARGE-CURR-AMT TO DISPLAY-AMT.                     DTSBD790
01820                                                                   DTSBD790
01821      DISPLAY '***                         CHARGE-CURR-AMT READ: ' DTSBD790
01822              DISPLAY-AMT-X.                                       DTSBD790
01823                                                                   DTSBD790
01824                                                                   DTSBD790
01825      DISPLAY '***'.                                               DTSBD790
01826                                                                   DTSBD790
01827      MOVE WRK-SELECTED-REC-CNT TO DISPLAY-CNT.                    DTSBD790
01828                                                                   DTSBD790
01829      DISPLAY '***                      CHARGE RECORDS SELECTED: ' DTSBD790
01830              DISPLAY-CNT-X.                                       DTSBD790
01831                                                                   DTSBD790
01832                                                                   DTSBD790
01833      DISPLAY '***'.                                               DTSBD790
01834                                                                   DTSBD790
01835      MOVE WRK-SELECTED-CHARGE-CURR-AMT TO DISPLAY-AMT.            DTSBD790
01836                                                                   DTSBD790
01837      DISPLAY '***                     CHARGE-CURR-AMT SELECTED: ' DTSBD790
01838              DISPLAY-AMT-X.                                       DTSBD790
01839                                                                   DTSBD790
01840                                                                   DTSBD790
01841      MOVE WRK-RTE-YR-START-YRQ TO L004-QTR-5-9.                   DTSBD790
01842                                                                   DTSBD790
01843      PERFORM S004-FROM-5 THRU S004-EXIT.                          DTSBD790
01844                                                                   DTSBD790
01845      DISPLAY '***                      RATE YEAR START QUARTER: ' DTSBD790
01846              L004-SLASH-5-QTR.                                    DTSBD790
01847                                                                   DTSBD790
01848                                                                   DTSBD790
01849      MOVE WRK-RTE-YR-END-YRQ TO L004-QTR-5-9.                     DTSBD790
01850                                                                   DTSBD790
01851      PERFORM S004-FROM-5 THRU S004-EXIT.                          DTSBD790
01852                                                                   DTSBD790
01853      DISPLAY '***                        RATE YEAR END QUARTER: ' DTSBD790
01854              L004-SLASH-5-QTR.                                    DTSBD790
01855                                                                   DTSBD790
01856      DISPLAY '***     '.                                          DTSBD790
01857      MOVE WRK-POS6B-TOT TO DISPLAY-AMT.                           DTSBD790
01858      DISPLAY '***                      POSITIVE LINE 6B CHARGE: ' DTSBD790
01859              DISPLAY-AMT-X.                                       DTSBD790
01860                                                                   DTSBD790
01861      DISPLAY '***      '.                                         DTSBD790
01862      MOVE WRK-NEG6B-TOT TO DISPLAY-AMT.                           DTSBD790
01863      DISPLAY '***                      NEGATIVE LINE 6B CHARGE: ' DTSBD790
01864              DISPLAY-AMT-X.                                       DTSBD790
01865  T2000-EXIT.                                                      DTSBD790
01866      EXIT.                                                        DTSBD790
01867      EJECT                                                        DTSBD790
01868  SBCF-OPEN-INPUT.                                                 DTSBD790
01869      OPEN INPUT BEN-CHG-FILE-IN.                                  DTSBD790
01870                                                                   DTSBD790
01871      IF BEN-FILE-OK-88                                            DTSBD790
01872          GO TO SBCF-EXIT                                          DTSBD790
01873      ELSE                                                         DTSBD790
01874          MOVE 'OPEN' TO FILE-COMMAND                              DTSBD790
01875          PERFORM SBCF-UNEXPECTED-FILE-STATUS                      DTSBD790
01876             THRU SBCF-UNEXPECTED-EXIT                             DTSBD790
01877          GO TO SBCF-EXIT.                                         DTSBD790
01878                                                                   DTSBD790
01879  SBCF-CLOSE.                                                      DTSBD790
01880      CLOSE BEN-CHG-FILE-IN.                                       DTSBD790
01881                                                                   DTSBD790
01882      IF BEN-FILE-OK-88                                            DTSBD790
01883          GO TO SBCF-EXIT                                          DTSBD790
01884      ELSE                                                         DTSBD790
01885          MOVE 'CLOSED' TO FILE-COMMAND                            DTSBD790
01886          PERFORM SBCF-UNEXPECTED-FILE-STATUS                      DTSBD790
01887             THRU SBCF-UNEXPECTED-EXIT                             DTSBD790
01888          GO TO SBCF-EXIT.                                         DTSBD790
01889                                                                   DTSBD790
01890  SBCF-EXIT.                                                       DTSBD790
01891      EXIT.                                                        DTSBD790
01892      SKIP3                                                        DTSBD790
01893  SBCF-UNEXPECTED-FILE-STATUS.                                     DTSBD790
01894      MOVE SPACES TO ABEND-MSG.                                    DTSBD790
01895                                                                   DTSBD790
01896      STRING                                                       DTSBD790
01897          'UNEXPECTED BENEFIT CLAIM FILE STATUS ON '               DTSBD790
01898             DELIMITED BY SIZE                                     DTSBD790
01899          FILE-COMMAND                                             DTSBD790
01900             DELIMITED BY '  '                                     DTSBD790
01901          ': '                                                     DTSBD790
01902             DELIMITED BY SIZE                                     DTSBD790
01903          BEN-CHG-STATUS                                           DTSBD790
01904             DELIMITED BY SIZE                                     DTSBD790
01905        INTO                                                       DTSBD790
01906          ABEND-MSG.                                               DTSBD790
01907                                                                   DTSBD790
01908      PERFORM S999-ABEND THRU S999-EXIT.                           DTSBD790
01909  SBCF-UNEXPECTED-EXIT.                                            DTSBD790
01910      EXIT.                                                        DTSBD790
01911      SKIP3                                                        DTSBD790
01912  SDWN01-OPEN.                                                     DTSBD790
01913      OPEN OUTPUT  ETA204-DOWNLOAD.                                DTSBD790
01914      IF NOT DWNLD-STATUS-OK-88                                    DTSBD790
01915         DISPLAY 'CANNOT OPEN DOWNLOAD FILE ' DWNLD-STATUS         DTSBD790
01916         PERFORM S999-ABEND  THRU S999-EXIT                        DTSBD790
01917      END-IF.                                                      DTSBD790
01918                                                                   DTSBD790
01919  SDWN01-EXIT.                                                     DTSBD790
01920      EXIT.                                                        DTSBD790
01921                                                                   DTSBD790
01922  SDWN02-WRITE.                                                    DTSBD790
01923      WRITE ETA204-DOWNLOAD-REC.                                   DTSBD790
01924      IF NOT DWNLD-STATUS-OK-88                                    DTSBD790
01925         DISPLAY 'CANNOT WRITE DOWNLOAD FILE ' DWNLD-STATUS        DTSBD790
01926         PERFORM S999-ABEND  THRU S999-EXIT                        DTSBD790
01927      END-IF.                                                      DTSBD790
01928                                                                   DTSBD790
01929  SDWN02-EXIT.                                                     DTSBD790
01930      EXIT.                                                        DTSBD790
01931                                                                   DTSBD790
01932  SDWN03-WRITE-TOTAL.                                              DTSBD790
01933      MOVE SPACES                   TO ETA204-DOWNLOAD-REC.        DTSBD790
01934      MOVE +0                       TO SUB2.                       DTSBD790
01935      INSPECT DWN-TOTAL-DISP-X REPLACING LEADING ZEROS BY '*'.     DTSBD790
01936      PERFORM                                                      DTSBD790
01937        VARYING SUB1 FROM +1 BY +1                                 DTSBD790
01938        UNTIL SUB1 > +11                                           DTSBD790
01939          IF (DWN-TOTAL-DISP-X (SUB1:1) >= '0'                     DTSBD790
01940          AND DWN-TOTAL-DISP-X (SUB1:1) <= '9')                    DTSBD790
01941             ADD +1                 TO SUB2                        DTSBD790
01942             MOVE DWN-TOTAL-DISP-X (SUB1:1) TO                     DTSBD790
01943                ETA204-DOWNLOAD-REC (SUB2:1)                       DTSBD790
01944          END-IF                                                   DTSBD790
01945      END-PERFORM.                                                 DTSBD790
01946                                                                   DTSBD790
01947      PERFORM SDWN02-WRITE          THRU SDWN02-EXIT.              DTSBD790
01948                                                                   DTSBD790
01949  SDWN03-EXIT.                                                     DTSBD790
01950      EXIT.                                                        DTSBD790
01951                                                                   DTSBD790
01952  SDWN04-CLOSE.                                                    DTSBD790
01953      CLOSE ETA204-DOWNLOAD.                                       DTSBD790
01954                                                                   DTSBD790
01955  SDWN04-EXIT.                                                     DTSBD790
01956      EXIT.                                                        DTSBD790
01957                                                                   DTSBD790
01958  S001-FROM-FED-8.                                                 DTSBD790
01959      SET L001-FROM-FED-8 TO TRUE.                                 DTSBD790
01960      GO TO S001-DATE.                                             DTSBD790
01961                                                                   DTSBD790
01962  S001-FROM-ABS-DAY.                                               DTSBD790
01963      SET L001-FROM-ABS-DAY TO TRUE.                               DTSBD790
01964      GO TO S001-DATE.                                             DTSBD790
01965                                                                   DTSBD790
01966  S001-FROM-CAL-6.                                                 DTSBD790
01967      SET L001-FROM-CAL-6 TO TRUE.                                 DTSBD790
01968      GO TO S001-DATE.                                             DTSBD790
01969                                                                   DTSBD790
01970  S001-FROM-FED-6.                                                 DTSBD790
01971      SET L001-FROM-FED-6 TO TRUE.                                 DTSBD790
01972      GO TO S001-DATE.                                             DTSBD790
01973                                                                   DTSBD790
01974  S001-DATE.                                                       DTSBD790
01975      CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBD790
01976  S001-EXIT.                                                       DTSBD790
01977      EXIT.                                                        DTSBD790
01978      SKIP3                                                        DTSBD790
01979  S004-FROM-5.                                                     DTSBD790
01980      SET L004-FROM-5 TO TRUE.                                     DTSBD790
01981      GO TO S004-QTR.                                              DTSBD790
01982                                                                   DTSBD790
01983  S004-FROM-ABS.                                                   DTSBD790
01984      SET L004-FROM-ABS TO TRUE.                                   DTSBD790
01985      GO TO S004-QTR.                                              DTSBD790
01986                                                                   DTSBD790
01987  S004-FROM-3.                                                     DTSBD790
01988      SET L004-FROM-3 TO TRUE.                                     DTSBD790
01989      GO TO S004-QTR.                                              DTSBD790
01990                                                                   DTSBD790
01991  S004-QTR.                                                        DTSBD790
01992      CALL 'DTSBU004' USING L004-LINK-AREA.                        DTSBD790
01993  S004-EXIT.                                                       DTSBD790
01994      EXIT.                                                        DTSBD790
01995      SKIP3                                                        DTSBD790
01996  S006-FROM-QTR.                                                   DTSBD790
01997      SET L006-FROM-QTR TO TRUE.                                   DTSBD790
01998      GO TO S006-RATING-YEAR.                                      DTSBD790
01999                                                                   DTSBD790
02000  S006-RATING-YEAR.                                                DTSBD790
02001      CALL 'DTSBU006' USING L006-LINK-AREA.                        DTSBD790
02002  S006-EXIT.                                                       DTSBD790
02003      EXIT.                                                        DTSBD790
02004      SKIP3                                                        DTSBD790
02005  S054-DETERMINE-RATE.                                             DTSBD790
02006      SET L054-RATE-LOOKUP-YES-88 TO TRUE.                         DTSBD790
02007      GO TO S054-RATE-LOOKUP.                                      DTSBD790
02008                                                                   DTSBD790
02009  S054-RATE-LOOKUP.                                                DTSBD790
02010      CALL 'DTSBU054' USING L054-LINK-AREA                         DTSBD790
02011                            MRCT-REC.                              DTSBD790
02012  S054-EXIT.                                                       DTSBD790
02013      EXIT.                                                        DTSBD790
02014      SKIP3                                                        DTSBD790
02015  S055-FROM-QTR.                                                   DTSBD790
02016      SET L055-FROM-EFF-YRQ-88 TO TRUE.                            DTSBD790
02017      GO TO S055-EXPERIENCE-PERIOD.                                DTSBD790
02018                                                                   DTSBD790
02019  S055-EXPERIENCE-PERIOD.                                          DTSBD790
02020      CALL 'DTSBU055' USING L055-LINK-AREA.                        DTSBD790
02021  S055-EXIT.                                                       DTSBD790
02022      EXIT.                                                        DTSBD790
02023      SKIP3                                                        DTSBD790
02024  S910-OPEN-READ.                                                  DTSBD790
02025      SET L910-OPEN-READ-88 TO TRUE.                               DTSBD790
02026      GO TO S910-MSTR-IO.                                          DTSBD790
02027                                                                   DTSBD790
02028  S910-READ.                                                       DTSBD790
02029      SET L910-READ-88 TO TRUE.                                    DTSBD790
02030      GO TO S910-MSTR-IO.                                          DTSBD790
02031                                                                   DTSBD790
02032  S910-START-BROWSE.                                               DTSBD790
02033      SET L910-START-BROWSE-88 TO TRUE.                            DTSBD790
02034      GO TO S910-MSTR-IO.                                          DTSBD790
02035                                                                   DTSBD790
02036  S910-READ-NEXT.                                                  DTSBD790
02037      SET L910-READ-NEXT-88 TO TRUE.                               DTSBD790
02038      GO TO S910-MSTR-IO.                                          DTSBD790
02039                                                                   DTSBD790
02040  S910-COUNT.                                                      DTSBD790
02041      SET L910-COUNT-88 TO TRUE.                                   DTSBD790
02042      GO TO S910-MSTR-IO.                                          DTSBD790
02043                                                                   DTSBD790
02044  S910-CLOSE.                                                      DTSBD790
02045      SET L910-CLOSE-88 TO TRUE.                                   DTSBD790
02046      GO TO S910-MSTR-IO.                                          DTSBD790
02047                                                                   DTSBD790
02048  S910-MSTR-IO.                                                    DTSBD790
02049      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBD790
02050                            MSKL-REC.                              DTSBD790
02051  S910-EXIT.                                                       DTSBD790
02052      EXIT.                                                        DTSBD790
02053      SKIP3                                                        DTSBD790
02054  S931-OPEN-READ.                                                  DTSBD790
02055      SET L931-OPEN-READ-88 TO TRUE.                               DTSBD790
02056      GO TO S931-REF-I.                                            DTSBD790
02057                                                                   DTSBD790
02058  S931-READ.                                                       DTSBD790
02059      SET L931-READ-88 TO TRUE.                                    DTSBD790
02060      GO TO S931-REF-I.                                            DTSBD790
02061                                                                   DTSBD790
02062  S931-START-BROWSE.                                               DTSBD790
02063      SET L931-START-BROWSE-88 TO TRUE.                            DTSBD790
02064      GO TO S931-REF-I.                                            DTSBD790
02065                                                                   DTSBD790
02066  S931-READ-NEXT.                                                  DTSBD790
02067      SET L931-READ-NEXT-88 TO TRUE.                               DTSBD790
02068      GO TO S931-REF-I.                                            DTSBD790
02069                                                                   DTSBD790
02070  S931-CLOSE.                                                      DTSBD790
02071      SET L931-CLOSE-88 TO TRUE.                                   DTSBD790
02072      GO TO S931-REF-I.                                            DTSBD790
02073                                                                   DTSBD790
02074  S931-REF-I.                                                      DTSBD790
02075      CALL 'DTSBU931' USING L931-LINK-AREA                         DTSBD790
02076                            FSKL-REC.                              DTSBD790
02077  S931-EXIT.                                                       DTSBD790
02078      EXIT.                                                        DTSBD790
02079      SKIP3                                                        DTSBD790
02080  S946-WRITE-R517.                                                 DTSBD790
02081      CALL 'DTSBU946' USING R517-REC.                              DTSBD790
02082      GO TO S946-EXIT.                                             DTSBD790
02083                                                                   DTSBD790
02084  S946-EXIT.                                                       DTSBD790
02085      EXIT.                                                        DTSBD790
02086      SKIP3                                                        DTSBD790
02087  S941-OPEN-READ.                                                  DTSBD790
02088                                                                   DTSBD790
02089      SET L941-OPEN-READ-88 TO TRUE                                DTSBD790
02090      GO TO S941-CALL.                                             DTSBD790
02091                                                                   DTSBD790
02092  S941-READ-NEXT.                                                  DTSBD790
02093      SET L941-READ-NEXT-88 TO TRUE                                DTSBD790
02094      GO TO S941-CALL.                                             DTSBD790
02095                                                                   DTSBD790
02096  S941-CLOSE.                                                      DTSBD790
02097      SET L941-CLOSE-88  TO TRUE.                                  DTSBD790
02098      GO TO S941-CALL.                                             DTSBD790
02099  S941-CALL.                                                       DTSBD790
02100                                                                   DTSBD790
02101      CALL 'DTSBU941' USING L941-LINK-AREA,                        DTSBD790
02102                            RSK3-REC.                              DTSBD790
02103  S941-EXIT.                                                       DTSBD790
02104      EXIT.                                                        DTSBD790
02105  S999-ABEND.                                                      DTSBD790
02106      DISPLAY '***'.                                               DTSBD790
02107                                                                   DTSBD790
02108      DISPLAY '*** '                                               DTSBD790
02109              WRK-MOD-NAME                                         DTSBD790
02110              ' IS ABENDING BECAUSE '                              DTSBD790
02111              ABEND-MSG.                                           DTSBD790
02112                                                                   DTSBD790
02113      DISPLAY '***'.                                               DTSBD790
02114                                                                   DTSBD790
02115      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBD790
02116  S999-EXIT.                                                       DTSBD790
02117      EXIT.                                                        DTSBD790
