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