00001  IDENTIFICATION DIVISION.                                         11/11/98
00002  PROGRAM-ID.             DTSBU053.                                DTSBU053
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV008
00004  DATE-WRITTEN.           NOVEMBER 1991.                           DTSBU053
00005  DATE-COMPILED.                                                   DTSBU053
00006      SKIP3                                                        DTSBU053
00007 *****                                                             DTSBU053
00008 *                                                                 DTSBU053
00009 *    FUNCTION:  UI RATE LOOKUP.                                   DTSBU053
00010 *                                                                 DTSBU053
00011 *                                                                 DTSBU053
00012 *    MODIFICATION LOG:                                            DTSBU053
00013 *                                                                 DTSBU053
00014 *    11/25/91  INITIAL DEVELOPMENT.                               DTSBU053
00015 *              WORK ORDER:                      PROGRAMMER: TCL   DTSBU053
00016 *                                                                 DTSBU053
00017 *    02/20/92  WORK ORDER:                      PROGRAMMER: JME   DTSBU053
00018 *                                                                 DTSBU053
00019 *    03/30/94  CONVERT TO MONTANA.                                DTSBU053
00020 *              WORK ORDER:                      PROGRAMMER: RHC   DTSBU053
00021 *                                                                    CL**7
00022 *    09/10/97  1997 HOUSE BILL 115 MODIFIED PENALTY RATE LOGIC.      CL**7
00023 *              FOR RATES EFFECTIVE 1998/1 AND AFTER, PENALTY         CL**7
00024 *              RATE IS EMPLOYERS ASSIGNED CONTRIBUTION RATE          CL**7
00025 *              TIMES 1.5, ROUNDED TO THE NEAREST TENTH OF A          CL**7
00026 *              PERCENT.                                              CL**7
00027 *              WORK ORDER: TCL 211              PROGRAMMER: EHH      CL**7
00028 *                                                                 DTSBU053
00029 *    11/11/1998  REVIEWED AND MODIFIED FOR DC.                       CL**2
00030 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH      CL**2
00031 *                                                                    CL**7
00032 *    11/11/1998  CLONED FROM DTSCU053.                               CL**7
00033 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH      CL**7
00034 *                                                                    CL**2
00035 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX      CL**2
00036 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX      CL**2
00037 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX      CL**2
00038 *                                                                 DTSBU053
00039 *    DESCRIPTION:                                                 DTSBU053
00040 *                                                                 DTSBU053
00041 *    LOOKUP A RATE ON THE REFERENCE FILE.                         DTSBU053
00042 *                                                                 DTSBU053
00043 *                                                                 DTSBU053
00044 *****                                                             DTSBU053
00045      SKIP3                                                        DTSBU053
00046  ENVIRONMENT DIVISION.                                            DTSBU053
00047      SKIP3                                                        DTSBU053
00048  DATA DIVISION.                                                   DTSBU053
00049      SKIP3                                                        DTSBU053
00050  WORKING-STORAGE SECTION.                                         DTSBU053
000505 77  PAN-VALET PICTURE X(24) VALUE '008DTSBU053  11/11/98'.       DTSBU053
00051      SKIP3                                                        DTSBU053
00052  01  WRK-AREA.                                                    DTSBU053
00053      05  WRK-ABEND-CODE              PIC S9(04)  COMP                CL**7
00054                                              VALUE +053.             CL**7
00055                                                                      CL**7
00056      05  WRK-RESP-CODE               PIC S9(08)  COMP.            DTSBU053
00057                                                                      CL**5
00058                                                                      CL**5
00059      05  WRK-NULL-UI-RATE            PIC S9(01)V9(04)  COMP-3        CL**5
00060                                             VALUE -9.9999.           CL**5
00061      EJECT                                                        DTSBU053
00062  01  L931-LINK-AREA.                                                 CL**7
00063  ++INCLUDE DTSIL931                                                  CL**7
00064      SKIP3                                                        DTSBU053
00065  01  FSKL-REC.                                                       CL**7
00066  ++INCLUDE DTSIFSKL                                                  CL**2
00067      SKIP3                                                        DTSBU053
00068  01  FUIR-REC REDEFINES FSKL-REC.                                    CL**7
00069  ++INCLUDE DTSIFUIR                                                  CL**2
00070      EJECT                                                        DTSBU053
00071  LINKAGE SECTION.                                                 DTSBU053
00072      SKIP3                                                        DTSBU053
00073  01  L053-LINK-AREA.                                                 CL**7
00074  ++INCLUDE DTSIL053                                                  CL**2
00075      EJECT                                                        DTSBU053
00076  PROCEDURE DIVISION USING L053-LINK-AREA.                            CL**7
00077                                                                      CL**2
00078                                                                      CL**2
00079      SET L053-RATE-NOT-FOUND TO TRUE.                                CL**3
00080                                                                      CL**3
00081      MOVE +0 TO L053-UI-RATE.                                        CL**3
00082                                                                      CL**3
00083      MOVE SPACES TO L053-MSG-AREA.                                   CL**3
00084                                                                      CL**3
00085                                                                      CL**3
00086      MOVE LOW-VALUES TO FUIR-KEY-AREA.                               CL**7
00087                                                                      CL**2
00088      SET FUIR-UIR-88 TO TRUE.                                     DTSBU053
00089                                                                      CL**3
00090      MOVE L053-EFF-YRQ TO FUIR-EFF-YRQ.                              CL**3
00091                                                                      CL**3
00092      PERFORM S931-READ THRU S931-EXIT.                               CL**7
00093                                                                      CL**3
00094      IF L931-NO-REC-88                                               CL**7
00095          SET L053-RATE-NOT-FOUND TO TRUE                             CL**3
00096      ELSE                                                            CL**3
00097          IF L053-STANDARD-LOOKUP-88                                  CL**3
00098              PERFORM P1000-STANDARD-LOOKUP THRU P1000-EXIT           CL**3
00099          ELSE                                                        CL**3
00100          IF L053-PENALTY-LOOKUP-88                                   CL**3
00101              PERFORM P2000-PENALTY-LOOKUP THRU P2000-EXIT            CL**3
00102          ELSE                                                        CL**3
00103              PERFORM S999-ABEND THRU S999-EXIT.                      CL**7
00104                                                                      CL**3
00105                                                                      CL**3
00106      GOBACK.                                                      DTSBU053
00107      EJECT                                                        DTSBU053
00108  P1000-STANDARD-LOOKUP.                                              CL**3
00109      IF (FUIR-DEFAULT-NEW-EMP-RATE = +0 OR WRK-NULL-UI-RATE)         CL**5
00110              OR                                                      CL**5
00111         (FUIR-RATE-CNT = +0)                                         CL**5
00112          SET L053-RATE-NOT-FOUND TO TRUE                             CL**5
00113          GO TO P1000-EXIT.                                           CL**5
00114                                                                      CL**5
00115                                                                      CL**5
00116      IF L053-NONCLASSIFIED-88                                        CL**6
00117          MOVE FUIR-DEFAULT-NEW-EMP-RATE TO L053-UI-RATE              CL**5
00118          SET L053-RATE-FOUND TO TRUE                                 CL**5
00119          GO TO P1000-EXIT.                                           CL**5
00120                                                                      CL**5
00121                                                                      CL**5
00122      IF L053-CLASSIFIED-88                                           CL**5
00123          CONTINUE                                                    CL**5
00124      ELSE                                                            CL**5
00125          PERFORM S999-ABEND THRU S999-EXIT.                          CL**7
00126                                                                      CL**5
00127                                                                      CL**5
00128      SET L053-RATE-NOT-FOUND TO TRUE.                                CL**5
00129                                                                      CL**5
00130      PERFORM P1100-RATE-AREA-LOOP THRU P1100-EXIT                    CL**5
00131        VARYING FUIR-RATE-IDX FROM 1 BY 1                             CL**5
00132        UNTIL (L053-RATE-FOUND)                                       CL**5
00133                  OR                                                  CL**5
00134              (FUIR-RATE-IDX > FUIR-RATE-CNT).                        CL**5
00135  P1000-EXIT.                                                      DTSBU053
00136      EXIT.                                                        DTSBU053
00137      SKIP3                                                           CL**5
00138  P1100-RATE-AREA-LOOP.                                               CL**5
00139 *****                                                                CL**5
00140 *                                                                    CL**5
00141 *    THE RATHER BIZARRE COMPARISONS IN THIS PARAGRAPH REFLECT        CL**5
00142 *                                                                    CL**5
00143 *    1.  THE CONSTRUCTION OF THE RATE TABLES IN THE DC UI LAW.       CL**5
00144 *                                                                    CL**5
00145 *    2.  COMPUTATION OF THE RESERVE RATIO IN DTS*U054.               CL**5
00146 *                                                                    CL**5
00147 *    3.  STORAGE OF UI RATE TABLES IN FUIR RECORDS (AS               CL**5
00148 *        CONTROLLED BY DTSCS83).                                     CL**6
00149 *                                                                    CL**5
00150 *    WITH ANY LUCK, THE FOLLOWING CODE WILL YIELD CORRECT            CL**5
00151 *    RESULTS.                                                        CL**5
00152 *                                                                    CL**5
00153 *****                                                                CL**5
00154                                                                      CL**5
00155      IF (FUIR-MIN-RATIO (FUIR-RATE-IDX) >= +0)                       CL**5
00156               OR                                                     CL**5
00157         (FUIR-MIN-RATIO (FUIR-RATE-IDX) <= -00.99900)                CL**6
00158          IF (L053-RATIO >= FUIR-MIN-RATIO (FUIR-RATE-IDX))           CL**5
00159                     AND                                              CL**5
00160             (L053-RATIO <= FUIR-MAX-RATIO (FUIR-RATE-IDX))           CL**5
00161              MOVE FUIR-UI-RATE (FUIR-RATE-IDX) TO L053-UI-RATE       CL**5
00162              SET L053-RATE-FOUND TO TRUE                             CL**5
00163          ELSE                                                        CL**5
00164              CONTINUE                                                CL**5
00165      ELSE                                                            CL**5
00166          IF (L053-RATIO > FUIR-MIN-RATIO (FUIR-RATE-IDX))            CL**5
00167                     AND                                              CL**5
00168             (L053-RATIO <= FUIR-MAX-RATIO (FUIR-RATE-IDX))           CL**5
00169              MOVE FUIR-UI-RATE (FUIR-RATE-IDX) TO L053-UI-RATE       CL**5
00170              SET L053-RATE-FOUND TO TRUE                             CL**5
00171          ELSE                                                        CL**5
00172              CONTINUE.                                               CL**5
00173  P1100-EXIT.                                                         CL**5
00174      EXIT.                                                           CL**5
00175      EJECT                                                           CL**3
00176  P2000-PENALTY-LOOKUP.                                               CL**3
00177      IF (FUIR-DEFAULT-NEW-EMP-RATE = +0 OR WRK-NULL-UI-RATE)         CL**5
00178                 OR                                                   CL**5
00179         (FUIR-RATE-CNT = +0)                                         CL**5
00180          SET L053-RATE-NOT-FOUND TO TRUE                             CL**5
00181          GO TO P2000-EXIT.                                           CL**5
00182                                                                      CL**5
00183      MOVE FUIR-DEFAULT-NEW-EMP-RATE TO L053-UI-RATE.                 CL**5
00184                                                                      CL**5
00185      PERFORM                                                         CL**5
00186        VARYING FUIR-RATE-IDX FROM 1 BY 1                             CL**5
00187        UNTIL FUIR-RATE-IDX > FUIR-RATE-CNT                           CL**5
00188          IF FUIR-UI-RATE (FUIR-RATE-IDX) > L053-UI-RATE              CL**5
00189              MOVE FUIR-UI-RATE (FUIR-RATE-IDX) TO L053-UI-RATE       CL**5
00190          END-IF                                                      CL**5
00191      END-PERFORM.                                                    CL**5
00192                                                                      CL**5
00193      SET L053-RATE-FOUND TO TRUE.                                    CL**5
00194  P2000-EXIT.                                                         CL**3
00195      EXIT.                                                           CL**3
00196      EJECT                                                        DTSBU053
00197  S931-READ.                                                          CL**7
00198      SET L931-READ-88 TO TRUE.                                       CL**7
00199      GO TO S931-REF-FILE.                                            CL**7
00200                                                                      CL**3
00201 *S931-START-BROWSE.                                                  CL**7
00202 *****SET L931-START-BROWSE-88 TO TRUE.                               CL**7
00203 *****GO TO S931-REF-FILE.                                            CL**7
00204                                                                      CL**3
00205 *S931-READ-NEXT.                                                     CL**7
00206 *****SET L931-READ-NEXT-88 TO TRUE                                   CL**7
00207 *****GO TO S931-REF-FILE.                                            CL**7
00208                                                                      CL**3
00209 *S931-END-BROWSE.                                                    CL**7
00210 *****SET L931-END-BROWSE-88 TO TRUE.                                 CL**7
00211 *****GO TO S931-REF-FILE.                                            CL**7
00212                                                                      CL**3
00213  S931-REF-FILE.                                                      CL**7
00214      CALL 'DTSBU931' USING L931-LINK-AREA                            CL**7
00215                            FSKL-REC.                                 CL**7
00216  S931-EXIT.                                                          CL**7
00217      EXIT.                                                        DTSBU053
00218      EJECT                                                        DTSBU053
00219  S999-ABEND.                                                         CL**7
00220      CALL 'DTSBU999' USING WRK-ABEND-CODE.                           CL**7
00221  S999-EXIT.                                                          CL**7
00222      EXIT.                                                        DTSBU053
