00001 IDENTIFICATION DIVISION. 06/30/99 00002 PROGRAM-ID. DTSBR723. DTSBR723 00003 AUTHOR. MT DEPT OF LABOR/UI PROGRAMMING SECTION LV017 00004 DATE-WRITTEN. DECEMBER 1994. DTSBR723 00005 DATE-COMPILED. DTSBR723 00006 SKIP3 DTSBR723 00007 ***** DTSBR723 00008 * DTSBR723 00009 * FUNCTION: RQC EXPERIENCE RATING UNIVERSE RECORD BUILD. DTSBR723 00010 * DTSBR723 00011 * DTSBR723 00012 * MODIFICATION HISTORY: DTSBR723 00013 * DTSBR723 00014 * 12-11-94 INITIAL DEVELOPMENT DTSBR723 00015 * REFERENCE RFP #RAP AUTHOR OF CHANGE - SFW DTSBR723 00016 * DTSBR723 00017 * 04-07-95 RECOMPILED FOR R991-UNIT-DSCR PER CHANGE REQUEST 064 DTSBR723 00018 * REFERENCE RFP #RAP AUTHOR OF CHANGE - SFW DTSBR723 00019 * DTSBR723 00020 * 06-30-99 MODIFIED TO MEET DUTAS PROGRAMMING SPECIFICATIONS CL**2 00021 * REFERENCE RFP #**** AUTHOR OF CHANGE - DVS CL**2 00022 * DTSBR723 00023 * DTSBR723 00024 * DESCRIPTION: DTSBR723 00025 * DTSBR723 00026 * THIS MODULE CREATES A FILE OF RQC EXPERIENCE RATING DTSBR723 00027 * TRANSACTION RECORDS FOR EXPORT TO THE DEPARTMENTAL RQC DTSBR723 00028 * SYSTEM. DTSBR723 00029 * DTSBR723 00030 * THIS IS AN "AT LEAST ONCE" MODULE. DTSBR723 00031 * DTSBR723 00032 * DTSBR723 00033 * RECORDS READ: DTSBR723 00034 * DTSBR723 00035 * NONE. DTSBR723 00036 * DTSBR723 00037 * DTSBR723 00038 * PRINTED OUTPUTS: DTSBR723 00039 * DTSBR723 00040 * NONE. DTSBR723 00041 * DTSBR723 00042 * DTSBR723 00043 * RECORDS WRITTEN: DTSBR723 00044 * DTSBR723 00045 * 723R1 RQC EXPERIENCE RATING UNIVERSE RECORDS. DTSBR723 00046 * DTSBR723 00047 * DTSBR723 00048 * MODULES CALLED: DTSBR723 00049 * DTSBR723 00050 * DTSBR991 EXPORT CONTROL REPORT MODULE CL**2 00051 * DTSBR723 00052 * DTSBR723 00053 ***** DTSBR723 00054 EJECT DTSBR723 00055 ENVIRONMENT DIVISION. DTSBR723 00056 SKIP2 DTSBR723 00057 INPUT-OUTPUT SECTION. DTSBR723 00058 SKIP1 DTSBR723 00059 FILE-CONTROL. DTSBR723 00060 SELECT EXPORT-FILE ASSIGN TO RPT723R1 DTSBR723 00061 FILE STATUS IS WS-FILE-STATUS. DTSBR723 00062 SKIP3 DTSBR723 00063 DATA DIVISION. DTSBR723 00064 SKIP3 DTSBR723 00065 FILE SECTION. DTSBR723 00066 SKIP2 DTSBR723 00067 FD EXPORT-FILE DTSBR723 00068 RECORDING MODE IS F DTSBR723 00069 BLOCK CONTAINS 0 RECORDS. DTSBR723 00070 01 EXPORT-REC PIC X(161). DTSBR723 00071 EJECT DTSBR723 00072 WORKING-STORAGE SECTION. DTSBR723 000725 77 PAN-VALET PICTURE X(24) VALUE '017DTSBR723 06/30/99'. DTSBR723 00073 SKIP3 DTSBR723 00074 01 WRK-AREA. DTSBR723 00075 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +723.DTSBR723 00076 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBR723 00077 05 WS-FILE-STATUS PIC X(02). DTSBR723 00078 88 FILE-OK-88 VALUE '00'. DTSBR723 00079 SKIP3 DTSBR723 00080 01 WS-GETSER-PARAMETERS. DTSBR723 00081 05 WS-GETSER-VOL-SER PIC X(30). DTSBR723 00082 05 WS-GETSER-DATASET-NAME PIC X(44). DTSBR723 00083 05 WS-GETSER-VOLUME-COUNT PIC 9(03). DTSBR723 00084 05 WS-GETSER-DD-NAME PIC X(08). DTSBR723 00085 05 WS-GETSER-STEP-NAME PIC X(08). DTSBR723 00086 SKIP3 DTSBR723 00087 01 WS-EXPORT-REC. DTSBR723 00088 05 WS-DATE-CREATED PIC S9(08). DTSBR723 00089 05 WS-EFF-YRQ PIC S9(05). DTSBR723 00090 05 WS-EMP-NO PIC S9(06). DTSBR723 00091 05 WS-PRIMARY-NAME PIC X(40). CL**2 00092 05 WS-YEAR-1 PIC S9(04). DTSBR723 00093 05 WS-TAX-WAGE-YEAR-1 PIC S9(11). DTSBR723 00094 05 WS-YEAR-2 PIC S9(04). DTSBR723 00095 05 WS-TAX-WAGE-YEAR-2 PIC S9(11). DTSBR723 00096 05 WS-YEAR-3 PIC S9(04). DTSBR723 00097 05 WS-TAX-WAGE-YEAR-3 PIC S9(11). DTSBR723 00098 05 WS-AVG-TAX-WAGE PIC S9(11). DTSBR723 00099 05 WS-COMPUTED-RATE PIC S9(01)V9(04). DTSBR723 00100 05 WS-PENALTY-RATE PIC S9(01)V9(04). DTSBR723 00101 05 WS-UI-PAID PIC S9(09). DTSBR723 00102 05 WS-BEN-CHARGED PIC S9(09). DTSBR723 00103 05 WS-RESERVE PIC S9(09). DTSBR723 00104 05 WS-RESERVE-RATIO PIC S9(03)V9(06). DTSBR723 00105 EJECT DTSBR723 00106 01 L001-LINK-AREA. DTSBR723 00107 ++INCLUDE DTSIL001 CL*12 00108 EJECT DTSBR723 00109 01 L055-LINK-AREA. CL*12 00110 ++INCLUDE DTSIL055 CL*12 00111 EJECT CL*12 00112 01 R991-REC. DTSBR723 00113 ++INCLUDE DTSIR991 CL*12 00114 EJECT DTSBR723 00115 LINKAGE SECTION. DTSBR723 00116 SKIP3 DTSBR723 00117 01 LRCM-LINK-AREA. DTSBR723 00118 ++INCLUDE DTSILRCM CL*12 00119 EJECT DTSBR723 00120 01 R723-REC. DTSBR723 00121 ++INCLUDE DTSIR723 CL*12 00122 EJECT DTSBR723 00123 PROCEDURE DIVISION USING LRCM-LINK-AREA DTSBR723 00124 R723-REC. DTSBR723 00125 SKIP2 DTSBR723 00126 IF FIRST-TIME-IND = 'Y' DTSBR723 00127 PERFORM I1000-INITIATE THRU I1000-EXIT DTSBR723 00128 MOVE 'N' TO FIRST-TIME-IND. DTSBR723 00129 SKIP1 DTSBR723 00130 IF LRCM-EOR-88 DTSBR723 00131 PERFORM T1000-TERMINATE THRU T1000-EXIT DTSBR723 00132 ELSE DTSBR723 00133 PERFORM P1000-PROCESS THRU P1000-EXIT. DTSBR723 00134 SKIP2 DTSBR723 00135 GOBACK. DTSBR723 00136 EJECT DTSBR723 00137 I1000-INITIATE. DTSBR723 00138 SKIP1 DTSBR723 00139 OPEN OUTPUT EXPORT-FILE. DTSBR723 00140 MOVE '723' TO R991-MOD. DTSBR723 00141 MOVE 'TPS DESK' TO R991-ROUTE1. CL**3 00142 MOVE 'ENFORCEMENT UNIT ' TO R991-ROUTE2. CL*17 00143 MOVE 'EXPERIENCE RATING UNIVERSE RECORDS' DTSBR723 00144 TO R991-DATA-TYPE. DTSBR723 00145 MOVE 'RECORDS' TO R991-UNIT-DSCR. DTSBR723 00146 MOVE +0 TO R991-UNIT-COUNT. DTSBR723 00147 SKIP1 DTSBR723 00148 ACCEPT L001-FED-6-DATE-9 FROM DATE. DTSBR723 00149 SET L001-FROM-FED-6 TO TRUE. DTSBR723 00150 PERFORM S001-DATE THRU S001-EXIT. DTSBR723 00151 MOVE L001-FED-8-DATE-9 TO WS-DATE-CREATED. DTSBR723 00152 SKIP2 DTSBR723 00153 I1000-EXIT. DTSBR723 00154 EXIT. DTSBR723 00155 EJECT DTSBR723 00156 P1000-PROCESS. DTSBR723 00157 SKIP1 DTSBR723 00158 MOVE R723-EFF-YRQ TO WS-EFF-YRQ L055-EFF-YRQ. CL**4 00159 PERFORM S055-FROM-EFF-YRQ THRU S055-EXIT. CL**4 00160 PERFORM P1010-SET-WAGES THRU P1010-EXIT CL**4 00161 VARYING R723-WAGES-IDX FROM 1 BY 1 CL**4 00162 UNTIL R723-WAGES-IDX GREATER 3. CL**4 00163 CL**4 00164 MOVE R723-EMP-NO TO WS-EMP-NO. DTSBR723 00165 MOVE R723-PRIMARY-NAME TO WS-PRIMARY-NAME. CL**2 00166 MOVE R723-AVG-TAX-WAGE TO WS-AVG-TAX-WAGE CL*16 00167 MOVE R723-COMPUTED-RATE TO WS-COMPUTED-RATE. DTSBR723 00168 MOVE R723-PENALTY-RATE TO WS-PENALTY-RATE. CL*13 00169 MOVE R723-UI-TAX-PAID-AMT TO WS-UI-PAID. CL*13 00170 MOVE R723-BENEFITS-CHARGED-AMT CL*13 00171 TO WS-BEN-CHARGED. CL*13 00172 MOVE R723-CURRENT-RESERVE-AMT TO WS-RESERVE. CL**9 00173 MOVE R723-RESERVE-RATIO TO WS-RESERVE-RATIO. DTSBR723 00174 ADD +1 TO R991-UNIT-COUNT. DTSBR723 00175 WRITE EXPORT-REC FROM WS-EXPORT-REC. DTSBR723 00176 IF FILE-OK-88 DTSBR723 00177 NEXT SENTENCE DTSBR723 00178 ELSE DTSBR723 00179 PERFORM S999-ABEND THRU S999-EXIT. DTSBR723 00180 SKIP2 DTSBR723 00181 P1000-EXIT. DTSBR723 00182 EXIT. DTSBR723 00183 EJECT DTSBR723 00184 P1010-SET-WAGES. CL**3 00185 SET L055-WAGES-IDX TO R723-WAGES-IDX. CL*14 00186 EVALUATE TRUE CL**7 00187 WHEN R723-WAGES-IDX = 1 CL**4 00188 MOVE R723-TAX-WAGE (R723-WAGES-IDX) TO CL**4 00189 WS-TAX-WAGE-YEAR-1 CL**6 00190 MOVE L055-WAGES-FROM-YRQ (L055-WAGES-IDX) TO WS-YEAR-1 CL**5 00191 DISPLAY 'YEAR 1 ' WS-YEAR-1 CL**8 00192 WHEN R723-WAGES-IDX = 2 CL**5 00193 MOVE R723-TAX-WAGE (R723-WAGES-IDX) TO CL**5 00194 WS-TAX-WAGE-YEAR-2 CL**6 00195 MOVE L055-WAGES-FROM-YRQ (L055-WAGES-IDX) TO WS-YEAR-2 CL**5 00196 DISPLAY 'YEAR 2 ' WS-YEAR-2 CL**8 00197 WHEN R723-WAGES-IDX = 3 CL**5 00198 MOVE R723-TAX-WAGE (R723-WAGES-IDX) TO CL**5 00199 WS-TAX-WAGE-YEAR-3 CL**6 00200 MOVE L055-WAGES-FROM-YRQ (L055-WAGES-IDX) TO WS-YEAR-3 CL**5 00201 DISPLAY 'YEAR 3 ' WS-YEAR-3 CL**8 00202 END-EVALUATE. CL*11 00203 P1010-EXIT. CL**3 00204 EXIT. CL**3 00205 T1000-TERMINATE. DTSBR723 00206 SKIP1 DTSBR723 00207 IF R991-UNIT-COUNT = +0 DTSBR723 00208 MOVE SPACES TO R991-DATASET-NAME. CL**3 00209 PERFORM R991-EXPORT-CONTROL-REPORT THRU R991-EXIT. DTSBR723 00210 CLOSE EXPORT-FILE. DTSBR723 00211 SKIP2 DTSBR723 00212 T1000-EXIT. DTSBR723 00213 EXIT. DTSBR723 00214 EJECT DTSBR723 00215 R991-EXPORT-CONTROL-REPORT. DTSBR723 00216 SKIP1 DTSBR723 00217 CALL 'DTSBR991' USING LRCM-LINK-AREA CL**2 00218 R991-REC. DTSBR723 00219 SKIP2 DTSBR723 00220 R991-EXIT. DTSBR723 00221 EXIT. DTSBR723 00222 SKIP3 DTSBR723 00223 S001-DATE. DTSBR723 00224 SKIP1 DTSBR723 00225 CALL 'DTSBU001' USING L001-LINK-AREA. CL**2 00226 SKIP2 DTSBR723 00227 S001-EXIT. DTSBR723 00228 EXIT. DTSBR723 00229 SKIP3 DTSBR723 00230 S055-FROM-EFF-YRQ. CL**4 00231 SET L055-FROM-EFF-YRQ-88 TO TRUE. CL**4 00232 GO TO S055-EXP-PERIOD. CL**4 00233 CL**4 00234 S055-EXP-PERIOD. CL**4 00235 CALL 'DTSBU055' USING L055-LINK-AREA. CL**4 00236 S055-EXIT. CL**4 00237 EXIT. CL**4 00238 SKIP3 CL**4 00239 S999-ABEND. DTSBR723 00240 SKIP1 DTSBR723 00241 CALL 'DTSBU999' USING WRK-ABEND-CD. CL**2 00242 SKIP2 DTSBR723 00243 S999-EXIT. DTSBR723 00244 EXIT. DTSBR723