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