00001 IDENTIFICATION DIVISION. 10/10/17 00002 PROGRAM-ID. DTSBE328. DTSBE328 00003 AUTHOR. NGC LV018 00004 DATE-WRITTEN. SEPTEMBER 2006. DTSBE328 00005 DATE-COMPILED. DTSBE328 00006 SKIP3 DTSBE328 00007 ***** DTSBE328 00008 * COMPUTES ONLY ONE QUARTER OF ASSESSMENTS FOR NOW. DTSBE328 00009 * BE328 WILL COMPUTE ANY SI CHARGES THAT WERE NOT COMPUTED CL**2 00010 * PREVIOUSLY. CL**2 00011 * FUNCTION: COMPUTE ADMINISTRATIVE TAX (SUR CHARGE) FOR DTSBE328 00012 * SELF INSURED EMPLOYERS. DTSBE328 00013 ***** DTSBE328 00014 SKIP3 DTSBE328 00015 ENVIRONMENT DIVISION. DTSBE328 00016 SKIP2 DTSBE328 00017 CONFIGURATION SECTION. DTSBE328 00018 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DTSBE328 00019 INPUT-OUTPUT SECTION. DTSBE328 00020 DTSBE328 00021 FILE-CONTROL. DTSBE328 00022 SELECT DOWNLOAD-FILE ASSIGN TO DTSF328 CL**2 00023 FILE STATUS IS DWN-STATUS. DTSBE328 00024 DTSBE328 00025 SELECT WESQ-FILE ASSIGN TO DTSWESQ DTSBE328 00026 ORGANIZATION IS INDEXED DTSBE328 00027 RECORD KEY IS WESQ-KEY-AREA DTSBE328 00028 FILE STATUS IS WESQ-FILE-STATUS DTSBE328 00029 ACCESS IS SEQUENTIAL. DTSBE328 00030 DTSBE328 00031 DATA DIVISION. DTSBE328 00032 DTSBE328 00033 FILE SECTION. DTSBE328 00034 FD DOWNLOAD-FILE DTSBE328 00035 RECORDING MODE IS F. DTSBE328 00036 01 DOWNLOAD-REC PIC X(114). DTSBE328 00037 DTSBE328 00038 FD WESQ-FILE. DTSBE328 00039 01 WESQ-REC. DTSBE328 00040 ++INCLUDE DTSIWESQ DTSBE328 00041 DTSBE328 00042 DTSBE328 00043 WORKING-STORAGE SECTION. DTSBE328 000435 77 PAN-VALET PICTURE X(24) VALUE '018DTSBE328 10/10/17'. DTSBE328 00044 77 PAN-VALET PICTURE X(24) VALUE '003DTSBE327 06/19/13'. DTSBE328 00045 77 PAN-VALET PICTURE X(24) VALUE '003DTSBE327 06/19/13'. DTSBE328 00046 77 PAN-VALET PICTURE X(24) VALUE '001DTSBE327 06/18/13'. DTSBE328 00047 77 PAN-VALET PICTURE X(24) VALUE '004DTSBE327 06/17/13'. DTSBE328 00048 77 PAN-VALET PICTURE X(24) VALUE '020DTSBE325 03/19/13'. DTSBE328 00049 SKIP3 DTSBE328 00050 01 WRK-AREA. DTSBE328 00051 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +328. CL**2 00052 DTSBE328 00053 05 ABEND-MSG PIC X(60). DTSBE328 00054 DTSBE328 00055 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBE328'. CL**2 00056 DTSBE328 00057 05 WRK-CONSTANTS. DTSBE328 00058 10 WRK-MAX-PCT PIC S9V9(04) COMP-3 DTSBE328 00059 VALUE +0.1. CL*10 00060 * VALUE +0.0. CL*10 00061 10 WRK-MAX-WAGE-DIFF PIC S9(11)V9(02) COMP-3 DTSBE328 00062 VALUE +100000. CL*10 00063 * VALUE +200000. CL*10 00064 05 WESQ-FILE-STATUS PIC X(02). DTSBE328 00065 88 WESQ-FILE-OK-88 VALUE '00'. DTSBE328 00066 88 WESQ-FILE-NO-REC-88 VALUE '10' '23'. DTSBE328 00067 88 WESQ-FILE-VERIFY-88 VALUE '97'. DTSBE328 00068 DTSBE328 00069 05 RPT-STATUS PIC X(02). DTSBE328 00070 88 RPT-STATUS-OK-88 VALUE '00'. DTSBE328 00071 05 DWN-STATUS PIC X(02). DTSBE328 00072 88 DWN-STATUS-OK-88 VALUE '00'. DTSBE328 00073 05 WRK-QTR-FOUND-IND PIC X(01). DTSBE328 00074 88 WRK-QTR-FOUND-YES-88 VALUE 'Y'. DTSBE328 00075 88 WRK-QTR-FOUND-NO-88 VALUE 'N'. DTSBE328 00076 05 WRK-ERROR-IND PIC X(01). DTSBE328 00077 88 WRK-ERROR-YES-88 VALUE 'Y'. DTSBE328 00078 88 WRK-ERROR-NO-88 VALUE 'N'. DTSBE328 00079 DTSBE328 00080 *********************************************************** DTSBE328 00081 * THE FOLLOWING INDICATOR SHOWS THE DIFFERENCE BETWEEN DTSBE328 00082 * THE UC-30 REPORTED WAGES AND THE WAGE FILE WAGES. DTSBE328 00083 * EXACT: NO DIFFERENCE. DTSBE328 00084 * TOL: WITHIN TOLERANCE ($0.99 * EMPLOYEE COUNT) DTSBE328 00085 * UNDER MAX: DIFFERENCE < 10% AND UNDER $100,000.00 DTSBE328 00086 * NO ASSESS: DIFFERENCE IS TOO GREAT - NO ASSESSMENT DTSBE328 00087 * CHARGED. DTSBE328 00088 * DTSBE328 00089 * IF THE COMPUTED AMOUNT FROM ACTUAL EARNINGS IS DTSBE328 00090 * GREATER THAN THE AMOUNT REPORTED ON THE UC-30, DTSBE328 00091 * THE COMPUTED AMOUNT WILL BE USED. DTSBE328 00092 *********************************************************** DTSBE328 00093 05 WRK-ASSESS-STATUS PIC X(01). DTSBE328 00094 88 WRK-ASSESS-EXACT-88 VALUE '0'. DTSBE328 00095 88 WRK-ASSESS-TOL-88 VALUE '1'. DTSBE328 00096 88 WRK-ASSESS-UNDER-MAX-88 VALUE '2'. DTSBE328 00097 88 WRK-ASSESS-OVER-MAX-88 VALUE '3'. DTSBE328 00098 88 WRK-NO-WAGES-88 VALUE '4'. DTSBE328 00099 88 WRK-NO-ASSESS-88 VALUE '4'. CL*10 00100 88 WRK-CHARGE-ASSESS-88 VALUE '0' '1' '2' '3'. CL*10 00101 * 88 WRK-NO-ASSESS-88 VALUE '3' '4'. CL*10 00102 * 88 WRK-CHARGE-ASSESS-88 VALUE '0' '1' '2'. CL*10 00103 DTSBE328 00104 05 WRK-STATUS-CNTS. DTSBE328 00105 10 WRK-EXACT-CNT PIC S9(07) COMP-3 VALUE 0. DTSBE328 00106 10 WRK-TOL-CNT PIC S9(07) COMP-3 VALUE 0. DTSBE328 00107 10 WRK-UNDER-MAX-CNT PIC S9(07) COMP-3 VALUE 0. DTSBE328 00108 10 WRK-OVER-MAX-CNT PIC S9(07) COMP-3 VALUE 0. DTSBE328 00109 10 WRK-NO-WAGES-CNT PIC S9(07) COMP-3 VALUE 0. DTSBE328 00110 10 WRK-INACT-CNT PIC S9(07) COMP-3 VALUE 0. DTSBE328 00111 DTSBE328 00112 05 WRK-T026-CNT PIC S9(07) COMP-3 DTSBE328 00113 VALUE +0. DTSBE328 00114 05 WRK-MPRF-CNT PIC S9(07) COMP-3 DTSBE328 00115 VALUE +0. DTSBE328 00116 05 WRK-PREV-CNT PIC S9(07) COMP-3 CL**2 00117 VALUE +0. CL**2 00118 DTSBE328 00119 05 WRK-SUR-RATE PIC S9V9(04) COMP-3. DTSBE328 00120 05 WRK-START-YRQ PIC S9(05) COMP-3 VALUE 0. DTSBE328 00121 05 WRK-END-YRQ PIC S9(05) COMP-3 VALUE 0. DTSBE328 00122 05 WRK-CURR-YRQ PIC S9(05) COMP-3 VALUE 0. DTSBE328 00123 05 WRK-CURR-ASSESS PIC S9(11)V9(02) COMP-3 VALUE 0. CL**6 00124 05 WRK-ASSESS-CHNG PIC S9(11)V9(02) COMP-3 VALUE 0. CL**6 00125 05 WRK-EMP-TOT-WAGE PIC S9(11)V9(02) COMP-3 VALUE 0. CL**6 00126 05 WRK-EMP-TAX-WAGE PIC S9(11)V9(02) COMP-3 VALUE 0. CL**6 00127 05 WRK-TAX-REMAIN PIC S9(11)V9(02) COMP-3 VALUE 0. CL**6 00128 05 WRK-TAX-WAGE PIC S9(11)V9(02) COMP-3 VALUE 0. CL**6 00129 DTSBE328 00130 05 WRK-PCT PIC S9V9(04) COMP-3. DTSBE328 00131 05 SUB PIC S9(04) COMP. DTSBE328 00132 05 WRK-QTR-TABLE-MAX PIC S9(04) COMP VALUE +9. DTSBE328 00133 05 WRK-QTR-TABLE OCCURS 9 TIMES. DTSBE328 00134 10 WRK-QTR-YRQ PIC S9(05) COMP-3. DTSBE328 00135 10 WRK-QTR-RATE PIC S9V9(04) COMP-3. DTSBE328 00136 10 WRK-QTR-OLD-TOT-WAGE PIC S9(11)V9(02) COMP-3. DTSBE328 00137 10 WRK-QTR-OLD-ASSESSMT PIC S9(11)V9(02) COMP-3. DTSBE328 00138 10 WRK-QTR-NEW-TOT-WAGE PIC S9(11)V9(02) COMP-3. DTSBE328 00139 10 WRK-QTR-NEW-TAX-WAGE PIC S9(11)V9(02) COMP-3. DTSBE328 00140 10 WRK-QTR-NEW-ASSESSMT PIC S9(11)V9(02) COMP-3. DTSBE328 00141 10 WRK-QTR-EMP-CNT PIC S9(07) COMP-3. DTSBE328 00142 DTSBE328 00143 05 WRK-WAGE-TOLERANCE PIC S9(11)V9(02) COMP-3. DTSBE328 00144 05 WRK-WAGE-DIFF PIC S9(11)V9(02) COMP-3. DTSBE328 00145 DTSBE328 00146 05 WRK-TAX-WAGES PIC S9(11)V9(02) COMP-3. DTSBE328 00147 05 WRK-TAX-REMAINING PIC S9(11)V9(02) COMP-3. DTSBE328 00148 05 WRK-TAX-AMT PIC S9(09)V9(02) COMP-3. DTSBE328 00149 05 WRK-TOT-TAX-CHG PIC S9(09)V9(02) COMP-3. DTSBE328 00150 DTSBE328 00151 DTSBE328 00152 05 WRK-DOWNLOAD-REC. DTSBE328 00153 10 WRK-DWN-EMP PIC 9(06). DTSBE328 00154 10 FILLER PIC X(01) VALUE ','. DTSBE328 00155 10 WRK-DWN-NAME PIC X(40). DTSBE328 00156 10 FILLER PIC X(01) VALUE ','. DTSBE328 00157 10 WRK-DWN-YRQ PIC X(06). DTSBE328 00158 10 FILLER PIC X(01) VALUE ','. DTSBE328 00159 10 WRK-DWN-TAX-WAGE PIC ----------9.99. DTSBE328 00160 10 FILLER PIC X(01) VALUE ','. DTSBE328 00161 10 WRK-DWN-OLD-ASSESS PIC ----------9.99. DTSBE328 00162 10 FILLER PIC X(01) VALUE ','. DTSBE328 00163 10 WRK-DWN-NEW-ASSESS PIC ----------9.99. DTSBE328 00164 10 FILLER PIC X(01) VALUE ','. DTSBE328 00165 10 WRK-DWN-ASSESS-CHNG PIC ----------9.99. DTSBE328 00166 DTSBE328 00167 05 WRK-TAX-WAGE-BASE PIC S9(07)V99 COMP-3. DTSBE328 00168 DTSBE328 00169 05 PARM-REC-CNT PIC S9(07) COMP-3. DTSBE328 00170 DTSBE328 00171 05 WRK-TRACE-IND PIC X(01). DTSBE328 00172 DTSBE328 00173 05 WRK-ABEND-MSG PIC X(60) VALUE SPACES. DTSBE328 00174 DTSBE328 00175 05 AMT-DISP1 PIC -,---,---,--9.99. DTSBE328 00176 05 AMT-DISP2 PIC -,---,---,--9.99. DTSBE328 00177 05 AMT-DISP3 PIC -,---,---,--9.99. DTSBE328 00178 05 AMT-DISP4 PIC -,---,---,--9.99. DTSBE328 00179 05 DISP-RATE PIC 9.9999. DTSBE328 00180 05 DISP-DATE1 PIC X(10). DTSBE328 00181 05 DISP-DATE2 PIC X(10). DTSBE328 00182 DTSBE328 00183 DTSBE328 00184 01 L001-LINK-AREA. DTSBE328 00185 ++INCLUDE DTSIL001 DTSBE328 00186 EJECT DTSBE328 00187 01 L005-LINK-AREA. DTSBE328 00188 ++INCLUDE DTSIL005 DTSBE328 00189 EJECT DTSBE328 00190 01 L109-LINK-AREA. DTSBE328 00191 ++INCLUDE DTSIL109 DTSBE328 00192 EJECT DTSBE328 00193 01 L111-LINK-AREA. DTSBE328 00194 ++INCLUDE DTSIL111 DTSBE328 00195 EJECT DTSBE328 00196 01 L112-LINK-AREA. DTSBE328 00197 ++INCLUDE DTSIL112 DTSBE328 00198 EJECT DTSBE328 00199 01 L910-LINK-AREA. DTSBE328 00200 ++INCLUDE DTSIL910 DTSBE328 00201 EJECT DTSBE328 00202 01 L981-LINK-AREA. DTSBE328 00203 ++INCLUDE DTSIL981 DTSBE328 00204 EJECT DTSBE328 00205 01 MSKL-REC. DTSBE328 00206 ++INCLUDE DTSIMSKL DTSBE328 00207 EJECT DTSBE328 00208 01 MHDR-REC. DTSBE328 00209 ++INCLUDE DTSIMHDR DTSBE328 00210 EJECT DTSBE328 00211 01 MQTR-REC. DTSBE328 00212 ++INCLUDE DTSIMQTR DTSBE328 00213 EJECT DTSBE328 00214 01 MRPT-REC. DTSBE328 00215 ++INCLUDE DTSIMRPT DTSBE328 00216 EJECT DTSBE328 00217 01 MEVL-REC. DTSBE328 00218 ++INCLUDE DTSIMEVL DTSBE328 00219 EJECT DTSBE328 00220 01 L921-LINK-AREA. DTSBE328 00221 ++INCLUDE DTSIL921 DTSBE328 00222 EJECT DTSBE328 00223 01 ISKL-REC. DTSBE328 00224 ++INCLUDE DTSIISKL DTSBE328 00225 EJECT DTSBE328 00226 01 L931-LINK-AREA. DTSBE328 00227 ++INCLUDE DTSIL931 DTSBE328 00228 EJECT DTSBE328 00229 01 FSKL-REC. DTSBE328 00230 ++INCLUDE DTSIFSKL DTSBE328 00231 EJECT DTSBE328 00232 EJECT DTSBE328 00233 01 FQTR-REC. DTSBE328 00234 ++INCLUDE DTSIFQTR DTSBE328 00235 EJECT DTSBE328 00236 01 WWGH-REC. DTSBE328 00237 ++INCLUDE DTSIWWGH DTSBE328 00238 EJECT DTSBE328 00239 01 R325-REC. DTSBE328 00240 ++INCLUDE DTSIR325 DTSBE328 00241 EJECT DTSBE328 00242 01 T026-REC. DTSBE328 00243 ++INCLUDE DTSIT026 DTSBE328 00244 EJECT DTSBE328 00245 DTSBE328 00246 01 L004-COMM-AREA. DTSBE328 00247 ++INCLUDE DTSIL004 DTSBE328 00248 EJECT DTSBE328 00249 01 L927-LINK-AREA. DTSBE328 00250 ++INCLUDE DTSIL927 DTSBE328 00251 EJECT DTSBE328 00252 LINKAGE SECTION. DTSBE328 00253 SKIP3 DTSBE328 00254 01 LECM-LINK-AREA. DTSBE328 00255 ++INCLUDE DTSILECM DTSBE328 00256 DTSBE328 00257 01 MPRF-LINK-REC. DTSBE328 00258 ++INCLUDE DTSIMPRF DTSBE328 00259 DTSBE328 00260 PROCEDURE DIVISION USING LECM-LINK-AREA DTSBE328 00261 MPRF-LINK-REC. DTSBE328 00262 EVALUATE TRUE DTSBE328 00263 WHEN LECM-INITIALIZE-88 DTSBE328 00264 PERFORM I0000-INITIATE THRU I0000-EXIT DTSBE328 00265 DTSBE328 00266 WHEN LECM-PROCESS-88 DTSBE328 00267 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBE328 00268 DTSBE328 00269 WHEN LECM-TERMINATE-88 DTSBE328 00270 PERFORM T0000-TERMINATE THRU T0000-EXIT DTSBE328 00271 DTSBE328 00272 WHEN OTHER DTSBE328 00273 MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED' DTSBE328 00274 TO ABEND-MSG DTSBE328 00275 PERFORM S999-ABEND THRU S999-EXIT DTSBE328 00276 END-EVALUATE. DTSBE328 00277 DTSBE328 00278 GOBACK. DTSBE328 00279 DTSBE328 00280 I0000-INITIATE. DTSBE328 00281 SET WRK-ERROR-NO-88 TO TRUE. DTSBE328 00282 DTSBE328 00283 PERFORM I2000-OPEN-FILES-1 THRU I2000-EXIT. DTSBE328 00284 DTSBE328 00285 PERFORM I3000-SUR-TAX-INFO THRU I3000-EXIT. DTSBE328 00286 DTSBE328 00287 PERFORM I4000-INIT-T026 THRU I4000-EXIT. DTSBE328 00288 DTSBE328 00289 PERFORM I5000-INIT-WORK THRU I5000-EXIT. DTSBE328 00290 DTSBE328 00291 I0000-EXIT. DTSBE328 00292 EXIT. DTSBE328 00293 DTSBE328 00294 I2000-OPEN-FILES-1. DTSBE328 00295 OPEN OUTPUT DOWNLOAD-FILE DTSBE328 00296 IF NOT DWN-STATUS-OK-88 DTSBE328 00297 DISPLAY 'CANNOT OPEN DOWNLOAD FILE' DWN-STATUS DTSBE328 00298 SET WRK-ERROR-YES-88 TO TRUE DTSBE328 00299 GO TO I2000-EXIT DTSBE328 00300 END-IF. DTSBE328 00301 DTSBE328 00302 OPEN INPUT WESQ-FILE. DTSBE328 00303 IF WESQ-FILE-OK-88 OR WESQ-FILE-VERIFY-88 DTSBE328 00304 NEXT SENTENCE DTSBE328 00305 ELSE DTSBE328 00306 DISPLAY 'CANNOT OPEN WESQ-FILE ' WESQ-FILE-STATUS DTSBE328 00307 SET WRK-ERROR-YES-88 TO TRUE DTSBE328 00308 GO TO I2000-EXIT DTSBE328 00309 END-IF. DTSBE328 00310 DTSBE328 00311 DTSBE328 00312 MOVE LECM-TRACE-IND TO L910-TRACE-IND. DTSBE328 00313 MOVE WRK-MOD-NAME TO L910-MOD-NAME. DTSBE328 00314 DTSBE328 00315 SET LECM-MST-OPEN-READ-88 TO TRUE. DTSBE328 00316 SET LECM-REF-OPEN-READ-88 TO TRUE. DTSBE328 00317 DTSBE328 00318 I2000-EXIT. DTSBE328 00319 EXIT. DTSBE328 00320 DTSBE328 00321 I3000-SUR-TAX-INFO. DTSBE328 00322 PERFORM I3100-READ-MHDR THRU I3100-EXIT. DTSBE328 00323 PERFORM S005-SYS-DATE THRU S005-EXIT. DTSBE328 00324 DTSBE328 00325 PERFORM S109-SUR-RATE-FIRST-QTR THRU S109-FIRST-EXIT. DTSBE328 00326 MOVE L109-TAX-WAGE-BASE TO WRK-TAX-WAGE-BASE. DTSBE328 00327 DTSBE328 00328 * MOVE MHDR-CURR-RUN-DATE TO L004-DATE. CL*18 00329 * PERFORM S004-FROM-DATE THRU S004-EXIT. CL*18 00330 * IF MHDR-CURR-RUN-DATE < L004-QTR-END-DATE CL*18 00331 * SUBTRACT +1 FROM L004-ABS-QTR CL*18 00332 * PERFORM S004-FROM-ABS THRU S004-EXIT CL*18 00333 * END-IF. CL*18 00334 * MOVE L004-QTR-5-9 TO WRK-END-YRQ. CL*18 00335 DTSBE328 00336 * MOVE L004-DATE TO L001-FED-8-DATE-9. DTSBE328 00337 * SUBTRACT 1 FROM L001-FED-8-YR. DTSBE328 00338 * MOVE L001-FED-8-DATE-9 TO L004-DATE. DTSBE328 00339 * PERFORM S004-FROM-DATE THRU S004-EXIT. DTSBE328 00340 DTSBE328 00341 * SUBTRACT +1 FROM L004-ABS-QTR. CL*18 00342 * PERFORM S004-FROM-ABS THRU S004-EXIT CL*18 00343 * IF L004-QTR-5-9 < L109-YRQ CL*18 00344 * MOVE L109-YRQ TO WRK-START-YRQ CL*18 00345 * ELSE CL*18 00346 * MOVE L004-QTR-5-9 TO WRK-START-YRQ CL*18 00347 * END-IF. CL*18 00348 DTSBE328 00349 * DISPLAY 'DEFAULT START QUARTER ' WRK-START-YRQ. CL*18 00350 MOVE MHDR-LAST-PEN-ASSESSED-YRQ TO WRK-START-YRQ CL*18 00351 WRK-END-YRQ. CL*18 00352 * MOVE 20131 TO WRK-START-YRQ. DTSBE328 00353 * MOVE 20131 TO WRK-END-YRQ. DTSBE328 00354 DTSBE328 00355 * MOVE WRK-END-YRQ TO WRK-START-YRQ. CL*18 00356 MOVE WRK-START-YRQ TO L004-QTR-5-9. DTSBE328 00357 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE328 00358 DISPLAY 'DTSBE328 START QUARTER ' L004-SLASH-5-QTR. CL**2 00359 DTSBE328 00360 MOVE WRK-END-YRQ TO L004-QTR-5-9. DTSBE328 00361 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE328 00362 DISPLAY 'DTSBE328 END QUARTER ' L004-SLASH-5-QTR. CL**2 00363 DTSBE328 00364 MOVE MHDR-CURR-RUN-DATE TO L001-FED-8-DATE-9. DTSBE328 00365 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBE328 00366 DISPLAY 'DTSBE328 CURR RUN DATE ' L001-SLASH-8-DATE. CL**2 00367 DTSBE328 00368 PERFORM I3200-TAX-RATES THRU I3200-EXIT. DTSBE328 00369 DTSBE328 00370 I3000-EXIT. DTSBE328 00371 EXIT. DTSBE328 00372 DTSBE328 00373 I3100-READ-MHDR. DTSBE328 00374 MOVE LOW-VALUES TO MSKL-REC. DTSBE328 00375 MOVE +0 TO MSKL-EMP-NO. DTSBE328 00376 SET MSKL-HDR-88 TO TRUE. DTSBE328 00377 DTSBE328 00378 PERFORM S910-READ THRU S910-EXIT. DTSBE328 00379 IF L910-NO-REC-88 DTSBE328 00380 DISPLAY 'DTSBE328: MHDR RECORD IS MISSING' CL**2 00381 SET WRK-ERROR-YES-88 TO TRUE DTSBE328 00382 GO TO I3100-EXIT DTSBE328 00383 ELSE DTSBE328 00384 MOVE MSKL-REC TO MHDR-REC DTSBE328 00385 END-IF. DTSBE328 00386 DTSBE328 00387 DTSBE328 00388 I3100-EXIT. DTSBE328 00389 EXIT. DTSBE328 00390 DTSBE328 00391 I3200-TAX-RATES. DTSBE328 00392 MOVE WRK-START-YRQ TO L004-QTR-5-9. DTSBE328 00393 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE328 00394 DISPLAY SPACE. DTSBE328 00395 DISPLAY 'ASSESSMENT RATES: '. DTSBE328 00396 DISPLAY SPACE. DTSBE328 00397 DTSBE328 00398 PERFORM DTSBE328 00399 VARYING SUB FROM +1 BY +1 DTSBE328 00400 UNTIL SUB > WRK-QTR-TABLE-MAX DTSBE328 00401 MOVE L004-QTR-5-9 TO L109-YRQ DTSBE328 00402 WRK-QTR-YRQ (SUB) DTSBE328 00403 PERFORM S109-SUR-BY-QTR THRU S109-QTR-EXIT DTSBE328 00404 MOVE L109-SUR-RATE TO WRK-QTR-RATE (SUB) DTSBE328 00405 DISP-RATE DTSBE328 00406 DISPLAY ' ' L004-SLASH-5-QTR ' : ' DISP-RATE DTSBE328 00407 ' ' L109-SUR-RATE DTSBE328 00408 ADD +1 TO L004-ABS-QTR DTSBE328 00409 PERFORM S004-FROM-ABS THRU S004-EXIT DTSBE328 00410 END-PERFORM. DTSBE328 00411 DTSBE328 00412 I3200-EXIT. DTSBE328 00413 EXIT. DTSBE328 00414 DTSBE328 00415 I4000-INIT-T026. DTSBE328 00416 MOVE LENGTH OF T026-REC TO T026-LENGTH. DTSBE328 00417 MOVE '026' TO T026-REC-TYPE. DTSBE328 00418 MOVE 'DTSBE328' TO T026-ORIGIN. CL**2 00419 MOVE L005-DATE TO T026-SYS-DATE. DTSBE328 00420 MOVE L005-TIME TO T026-SYS-TIME. DTSBE328 00421 MOVE LOW-VALUES TO T026-DATA-AREA. DTSBE328 00422 DTSBE328 00423 I4000-EXIT. DTSBE328 00424 EXIT. DTSBE328 00425 DTSBE328 00426 I5000-INIT-WORK. DTSBE328 00427 PERFORM DTSBE328 00428 VARYING SUB FROM +1 BY +1 DTSBE328 00429 UNTIL SUB > WRK-QTR-TABLE-MAX DTSBE328 00430 MOVE ZERO TO WRK-QTR-OLD-TOT-WAGE (SUB) DTSBE328 00431 WRK-QTR-OLD-ASSESSMT (SUB) DTSBE328 00432 WRK-QTR-EMP-CNT (SUB) DTSBE328 00433 WRK-QTR-NEW-TOT-WAGE (SUB) DTSBE328 00434 WRK-QTR-NEW-TAX-WAGE (SUB) DTSBE328 00435 WRK-QTR-NEW-ASSESSMT (SUB) DTSBE328 00436 END-PERFORM. DTSBE328 00437 DTSBE328 00438 I5000-EXIT. DTSBE328 00439 EXIT. DTSBE328 00440 DTSBE328 00441 P0000-PROCESS. DTSBE328 00442 IF WRK-ERROR-YES-88 DTSBE328 00443 GO TO P0000-EXIT DTSBE328 00444 END-IF. DTSBE328 00445 DTSBE328 00446 PERFORM I5000-INIT-WORK THRU I5000-EXIT. DTSBE328 00447 DTSBE328 00448 IF MPRF-CLASS-SELF-INS-88 CL**4 00449 NEXT SENTENCE CL**4 00450 ELSE CL**4 00451 GO TO P0000-EXIT. CL**2 00452 CL**2 00453 ADD +1 TO WRK-MPRF-CNT DTSBE328 00454 PERFORM P1200-CURR-ASSESSMENT THRU P1200-EXIT DTSBE328 00455 CL**2 00456 IF WRK-CURR-ASSESS > 0 CL**2 00457 ADD +1 TO WRK-PREV-CNT CL**2 00458 DISPLAY 'SI CHRG PREV: ' MQTR-EMP-NO ' ' WRK-CURR-ASSESS CL**2 00459 GO TO P0000-EXIT. CL**2 00460 CL**2 00461 PERFORM P1300-NEW-ASSESSMENT THRU P1300-EXIT. CL**3 00462 PERFORM P2000-CHECK-FOR-UPDATE THRU P2000-EXIT. CL**3 00463 DTSBE328 00464 P0000-EXIT. DTSBE328 00465 EXIT. DTSBE328 00466 DTSBE328 00467 P1200-CURR-ASSESSMENT. DTSBE328 00468 IF MPRF-STATUS-ACT-88 DTSBE328 00469 ADD +1 TO WRK-INACT-CNT. DTSBE328 00470 MOVE ZERO TO WRK-CURR-ASSESS CL**8 00471 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBE328 00472 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBE328 00473 MOVE WRK-START-YRQ TO MQTR-YRQ. DTSBE328 00474 SET MQTR-QTR-88 TO TRUE DTSBE328 00475 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBE328 00476 DTSBE328 00477 * DISPLAY ' *****EMP NO ' MPRF-EMP-NO. CL**7 00478 * DISPLAY ' WRK START YRQ ' WRK-START-YRQ. CL**7 00479 * DISPLAY ' WRK QTR YRQ ' WRK-QTR-YRQ (SUB). CL**7 00480 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBE328 00481 PERFORM UNTIL L910-NO-REC-88 DTSBE328 00482 MOVE MSKL-REC TO MQTR-REC DTSBE328 00483 * DISPLAY 'MQTR-YRQ ' MQTR-YRQ ' END-YRQ ' WRK-END-YRQ CL**7 00484 IF MQTR-YRQ > WRK-END-YRQ DTSBE328 00485 SET L910-NO-REC-88 TO TRUE DTSBE328 00486 ELSE DTSBE328 00487 PERFORM DTSBE328 00488 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSBE328 00489 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSBE328 00490 IF MQTR-ACCT-SUR-88 (MQTR-ACCT-IDX) DTSBE328 00491 ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSBE328 00492 TO WRK-CURR-ASSESS DTSBE328 00493 END-IF DTSBE328 00494 END-PERFORM DTSBE328 00495 PERFORM P1210-QTR-SUM THRU P1210-EXIT DTSBE328 00496 PERFORM S910-READ-NEXT THRU S910-EXIT DTSBE328 00497 END-IF DTSBE328 00498 END-PERFORM. DTSBE328 00499 DTSBE328 00500 P1200-EXIT. DTSBE328 00501 EXIT. DTSBE328 00502 DTSBE328 00503 P1210-QTR-SUM. DTSBE328 00504 SET WRK-QTR-FOUND-NO-88 TO TRUE. DTSBE328 00505 PERFORM DTSBE328 00506 VARYING SUB FROM +1 BY +1 DTSBE328 00507 UNTIL WRK-QTR-FOUND-YES-88 DTSBE328 00508 * DISPLAY ' SUB ' SUB CL**7 00509 * DISPLAY 'MQTR YRQ ' MQTR-YRQ CL**7 00510 * DISPLAY 'WRK QTR YRQ ' WRK-QTR-YRQ(SUB) CL**7 00511 * DISPLAY ' ' CL**7 00512 IF MQTR-YRQ = WRK-QTR-YRQ (SUB) DTSBE328 00513 MOVE MQTR-TOT-WAGE TO WRK-QTR-OLD-TOT-WAGE (SUB) DTSBE328 00514 MOVE WRK-CURR-ASSESS TO WRK-QTR-OLD-ASSESSMT (SUB) DTSBE328 00515 SET WRK-QTR-FOUND-YES-88 TO TRUE DTSBE328 00516 END-IF DTSBE328 00517 END-PERFORM. DTSBE328 00518 DTSBE328 00519 P1210-EXIT. DTSBE328 00520 EXIT. DTSBE328 00521 DTSBE328 00522 P1300-NEW-ASSESSMENT. DTSBE328 00523 *** DISPLAY 'P1300 ' MPRF-EMP-NO. DTSBE328 00524 DTSBE328 00525 MOVE LOW-VALUES TO WESQ-REC. DTSBE328 00526 MOVE MPRF-EMP-NO TO WESQ-EMP-NO. DTSBE328 00527 MOVE WRK-START-YRQ TO WESQ-YRQ. DTSBE328 00528 START WESQ-FILE KEY IS >= WESQ-KEY-AREA. DTSBE328 00529 READ WESQ-FILE NEXT. DTSBE328 00530 PERFORM UNTIL NOT WESQ-FILE-OK-88 DTSBE328 00531 MOVE ZERO TO WRK-TAX-WAGE DTSBE328 00532 IF WESQ-EMP-NO = MPRF-EMP-NO DTSBE328 00533 AND WESQ-YRQ <= WRK-END-YRQ DTSBE328 00534 PERFORM P1310-TAX-WAGE THRU P1310-EXIT DTSBE328 00535 PERFORM P1320-QTR-SUM THRU P1320-EXIT DTSBE328 00536 READ WESQ-FILE NEXT DTSBE328 00537 ELSE DTSBE328 00538 SET WESQ-FILE-NO-REC-88 TO TRUE DTSBE328 00539 END-IF DTSBE328 00540 END-PERFORM. DTSBE328 00541 DTSBE328 00542 PERFORM P1330-COMPUTE-ASSESS THRU P1330-EXIT. DTSBE328 00543 DTSBE328 00544 P1300-EXIT. DTSBE328 00545 EXIT. DTSBE328 00546 DTSBE328 00547 P1310-TAX-WAGE. DTSBE328 00548 * IF WESQ-EMP-NO = 813380 DTSBE328 00549 * MOVE WESQ-EARNINGS TO AMT-DISP1 DTSBE328 00550 * MOVE WESQ-YTD-EARNINGS TO AMT-DISP2 DTSBE328 00551 * DISPLAY 'P1300 ' WESQ-SSN ' ' AMT-DISP1 DTSBE328 00552 * ' ' WESQ-YRQ ' YTD ' AMT-DISP2 DTSBE328 00553 * END-IF. DTSBE328 00554 DTSBE328 00555 IF WESQ-YTD-EARNINGS >= 9000 DTSBE328 00556 MOVE ZERO TO WRK-TAX-WAGE DTSBE328 00557 ELSE DTSBE328 00558 COMPUTE WRK-TAX-REMAIN = (9000 - WESQ-YTD-EARNINGS) DTSBE328 00559 IF WRK-TAX-REMAIN > WESQ-EARNINGS DTSBE328 00560 MOVE WESQ-EARNINGS TO WRK-TAX-WAGE DTSBE328 00561 ELSE DTSBE328 00562 MOVE WRK-TAX-REMAIN TO WRK-TAX-WAGE DTSBE328 00563 END-IF DTSBE328 00564 END-IF. DTSBE328 00565 DTSBE328 00566 P1310-EXIT. DTSBE328 00567 EXIT. DTSBE328 00568 DTSBE328 00569 P1320-QTR-SUM. DTSBE328 00570 * IF MPRF-EMP-NO = 813380 DTSBE328 00571 * MOVE WESQ-EARNINGS TO AMT-DISP1 DTSBE328 00572 * MOVE WRK-TAX-WAGE TO AMT-DISP2 DTSBE328 00573 * DISPLAY 'P1320 WESQ ' WESQ-SSN ' ' AMT-DISP1 DTSBE328 00574 * ' TAX ' AMT-DISP2 DTSBE328 00575 * ' ' WESQ-YRQ DTSBE328 00576 * END-IF. DTSBE328 00577 SET WRK-QTR-FOUND-NO-88 TO TRUE. DTSBE328 00578 PERFORM DTSBE328 00579 VARYING SUB FROM +1 BY +1 DTSBE328 00580 UNTIL WRK-QTR-FOUND-YES-88 DTSBE328 00581 IF WESQ-YRQ = WRK-QTR-YRQ (SUB) DTSBE328 00582 ADD WESQ-EARNINGS TO WRK-QTR-NEW-TOT-WAGE (SUB) DTSBE328 00583 ADD WRK-TAX-WAGE TO WRK-QTR-NEW-TAX-WAGE (SUB) DTSBE328 00584 ADD +1 TO WRK-QTR-EMP-CNT (SUB) DTSBE328 00585 SET WRK-QTR-FOUND-YES-88 TO TRUE DTSBE328 00586 END-IF DTSBE328 00587 END-PERFORM. DTSBE328 00588 DTSBE328 00589 P1320-EXIT. DTSBE328 00590 EXIT. DTSBE328 00591 DTSBE328 00592 P1330-COMPUTE-ASSESS. DTSBE328 00593 PERFORM DTSBE328 00594 VARYING SUB FROM +1 BY +1 DTSBE328 00595 UNTIL SUB > WRK-QTR-TABLE-MAX DTSBE328 00596 COMPUTE WRK-QTR-NEW-ASSESSMT (SUB) ROUNDED = DTSBE328 00597 (WRK-QTR-NEW-TAX-WAGE (SUB) * DTSBE328 00598 WRK-QTR-RATE (SUB)) DTSBE328 00599 END-PERFORM. DTSBE328 00600 DTSBE328 00601 P1330-EXIT. DTSBE328 00602 EXIT. DTSBE328 00603 DTSBE328 00604 P2000-CHECK-FOR-UPDATE. DTSBE328 00605 PERFORM DTSBE328 00606 VARYING SUB FROM +1 BY +1 DTSBE328 00607 UNTIL SUB > WRK-QTR-TABLE-MAX DTSBE328 00608 *& DTSBE328 00609 * IF MPRF-EMP-NO = 150337 CL**7 00610 * MOVE WRK-QTR-NEW-ASSESSMT (SUB) TO AMT-DISP1 CL**7 00611 * MOVE WRK-QTR-OLD-ASSESSMT (SUB) TO AMT-DISP2 CL**7 00612 * DISPLAY 'P2000 OLD ' AMT-DISP2 ' NEW ' AMT-DISP1 CL**7 00613 * ' ' WRK-QTR-YRQ (SUB) CL**7 00614 * END-IF CL**7 00615 *& DTSBE328 00616 IF WRK-QTR-YRQ (SUB) < WRK-START-YRQ OR DTSBE328 00617 WRK-QTR-YRQ (SUB) > WRK-END-YRQ DTSBE328 00618 NEXT SENTENCE DTSBE328 00619 ELSE DTSBE328 00620 * IF WRK-QTR-OLD-ASSESSMT (SUB) NOT = DTSBE328 00621 * WRK-QTR-NEW-ASSESSMT (SUB) DTSBE328 00622 PERFORM P2100-REPORT THRU P2100-EXIT DTSBE328 00623 END-IF DTSBE328 00624 END-PERFORM. DTSBE328 00625 DTSBE328 00626 DTSBE328 00627 P2000-EXIT. DTSBE328 00628 EXIT. DTSBE328 00629 DTSBE328 00630 P2100-REPORT. DTSBE328 00631 COMPUTE WRK-WAGE-TOLERANCE = DTSBE328 00632 (WRK-QTR-EMP-CNT (SUB) * .99) DTSBE328 00633 DTSBE328 00634 COMPUTE WRK-WAGE-DIFF = DTSBE328 00635 (WRK-QTR-OLD-TOT-WAGE (SUB) - DTSBE328 00636 WRK-QTR-NEW-TOT-WAGE (SUB)). DTSBE328 00637 DTSBE328 00638 ********************************************************** DTSBE328 00639 * ALLOW THE SYSTEM TO CHARGE THE ASSESSMENT IF THE WAGES DTSBE328 00640 * ON THE WAGE FILE ARE GREATER THAN THOSE REPORTED ON DTSBE328 00641 * THE UC-30. (WRK-WAGE-DIFF WILL BE < 0 IN THIS CASE.) DTSBE328 00642 ********************************************************** DTSBE328 00643 MOVE 0 TO WRK-PCT. DTSBE328 00644 IF WRK-WAGE-DIFF > ZERO DTSBE328 00645 IF WRK-QTR-OLD-TOT-WAGE (SUB) > 0 DTSBE328 00646 COMPUTE WRK-PCT = DTSBE328 00647 (WRK-WAGE-DIFF / WRK-QTR-OLD-TOT-WAGE (SUB)) DTSBE328 00648 END-IF DTSBE328 00649 END-IF. DTSBE328 00650 DTSBE328 00651 COMPUTE WRK-ASSESS-CHNG = DTSBE328 00652 (WRK-QTR-NEW-ASSESSMT (SUB) - DTSBE328 00653 WRK-QTR-OLD-ASSESSMT (SUB)). DTSBE328 00654 DTSBE328 00655 EVALUATE TRUE DTSBE328 00656 WHEN WRK-QTR-NEW-TOT-WAGE (SUB) = ZERO DTSBE328 00657 SET WRK-NO-WAGES-88 TO TRUE DTSBE328 00658 ADD +1 TO WRK-NO-WAGES-CNT DTSBE328 00659 * DISPLAY 'NO WAGE ' MPRF-EMP-NO ' ' MPRF-EMP-STATUS CL**8 00660 DTSBE328 00661 WHEN (WRK-PCT > WRK-MAX-PCT DTSBE328 00662 OR WRK-WAGE-DIFF > WRK-MAX-WAGE-DIFF) DTSBE328 00663 SET WRK-ASSESS-OVER-MAX-88 TO TRUE DTSBE328 00664 ADD +1 TO WRK-OVER-MAX-CNT DTSBE328 00665 DTSBE328 00666 WHEN WRK-WAGE-DIFF > WRK-WAGE-TOLERANCE DTSBE328 00667 SET WRK-ASSESS-UNDER-MAX-88 TO TRUE DTSBE328 00668 ADD +1 TO WRK-UNDER-MAX-CNT DTSBE328 00669 DTSBE328 00670 WHEN WRK-WAGE-DIFF = 0 DTSBE328 00671 SET WRK-ASSESS-EXACT-88 TO TRUE CL*14 00672 * SET WRK-NO-WAGES-88 TO TRUE CL*14 00673 ADD +1 TO WRK-EXACT-CNT DTSBE328 00674 DTSBE328 00675 WHEN OTHER DTSBE328 00676 SET WRK-ASSESS-TOL-88 TO TRUE DTSBE328 00677 ADD +1 TO WRK-TOL-CNT DTSBE328 00678 END-EVALUATE. DTSBE328 00679 DTSBE328 00680 IF WRK-CHARGE-ASSESS-88 DTSBE328 00681 IF WRK-ASSESS-CHNG > 0.99 CL*17 00682 PERFORM P2110-WRITE-T026 THRU P2110-EXIT DTSBE328 00683 PERFORM P2130-WRITE-DOWNLOAD THRU P2130-EXIT DTSBE328 00684 END-IF CL*17 00685 END-IF. DTSBE328 00686 DTSBE328 00687 IF WRK-NO-WAGES-88 AND MPRF-EMP-STATUS NOT = 'A' DTSBE328 00688 NEXT SENTENCE DTSBE328 00689 ELSE DTSBE328 00690 PERFORM P2120-WRITE-R325 THRU P2120-EXIT. DTSBE328 00691 DTSBE328 00692 P2100-EXIT. DTSBE328 00693 EXIT. DTSBE328 00694 DTSBE328 00695 P2110-WRITE-T026. DTSBE328 00696 IF WRK-QTR-YRQ (SUB) < WRK-START-YRQ OR DTSBE328 00697 WRK-QTR-YRQ (SUB) > WRK-END-YRQ OR CL*14 00698 WRK-ASSESS-CHNG < 1.00 CL*15 00699 GO TO P2110-EXIT. DTSBE328 00700 ADD 1 TO WRK-T026-CNT. DTSBE328 00701 MOVE MPRF-EMP-NO TO T026-EMP-NO. DTSBE328 00702 MOVE WRK-ASSESS-CHNG TO T026-AMT. DTSBE328 00703 MOVE WRK-QTR-YRQ (SUB) TO T026-APPLIC-YRQ. DTSBE328 00704 MOVE +0 TO T026-RECEIVED-DATE. DTSBE328 00705 MOVE SPACES TO T026-NAME-CHECK DTSBE328 00706 T026-INT-SPAN-IND. DTSBE328 00707 MOVE 'SU' TO T026-APPLIC-IND. DTSBE328 00708 SET T026-ADM-ASSESSMNT TO TRUE. DTSBE328 00709 MOVE +0 TO T026-APPLIC-BATCH-NO DTSBE328 00710 T026-APPLIC-ITEM-NO DTSBE328 00711 T026-DATE-1 DTSBE328 00712 T026-DATE-2. DTSBE328 00713 DTSBE328 00714 MOVE SPACES TO T026-RESPONSIBLE-ACTIVITY. DTSBE328 00715 MOVE 'DTSBE328' TO T026-RESPONSIBLE-OP-ID. CL**2 00716 DTSBE328 00717 PERFORM S927-WRITE THRU S927-EXIT. DTSBE328 00718 DTSBE328 00719 P2110-EXIT. DTSBE328 00720 EXIT. DTSBE328 00721 DTSBE328 00722 P2120-WRITE-R325. DTSBE328 00723 IF WRK-QTR-YRQ (SUB) < WRK-START-YRQ OR DTSBE328 00724 WRK-QTR-YRQ (SUB) > WRK-END-YRQ OR CL*16 00725 WRK-ASSESS-CHNG < 1.00 CL*15 00726 GO TO P2120-EXIT. DTSBE328 00727 DTSBE328 00728 MOVE LOW-VALUES TO R325-SORT-AREA. DTSBE328 00729 MOVE LENGTH OF R325-REC TO R325-LENGTH. DTSBE328 00730 MOVE '325' TO R325-REC-TYPE. DTSBE328 00731 MOVE WRK-ASSESS-STATUS TO R325-RPT-TYPE. DTSBE328 00732 MOVE MPRF-EMP-NO TO R325-EMP-NO. DTSBE328 00733 MOVE MPRF-FEIN TO R325-EMP-FEIN. DTSBE328 00734 MOVE MHDR-CURR-RUN-DATE TO R325-STMT-DATE. DTSBE328 00735 MOVE SPACES TO R325-OP-ID DTSBE328 00736 MOVE WRK-QTR-RATE (SUB) TO R325-ASSESSMENT-RATE. DTSBE328 00737 MOVE WRK-QTR-YRQ (SUB) TO R325-QTR. DTSBE328 00738 MOVE WRK-QTR-OLD-TOT-WAGE (SUB) DTSBE328 00739 TO R325-UC30-WAGES. DTSBE328 00740 MOVE WRK-QTR-NEW-TOT-WAGE (SUB) DTSBE328 00741 TO R325-WAGE-FILE-WAGES. DTSBE328 00742 MOVE WRK-QTR-NEW-TAX-WAGE (SUB) DTSBE328 00743 TO R325-ASSESSMENT-WAGES. DTSBE328 00744 MOVE WRK-ASSESS-CHNG TO R325-CALC-ASSESS-DUE DTSBE328 00745 R325-FINAL-ASSESS-DUE. DTSBE328 00746 PERFORM P2121-GET-ADDR THRU P2121-EXIT. DTSBE328 00747 PERFORM S946-WRITE-R325 THRU S946-EXIT. DTSBE328 00748 DTSBE328 00749 MOVE WRK-QTR-NEW-TOT-WAGE (SUB) TO AMT-DISP1. DTSBE328 00750 MOVE WRK-QTR-OLD-TOT-WAGE (SUB) TO AMT-DISP2. DTSBE328 00751 *** MOVE WRK-QTR-NEW-TAX-WAGE (SUB) TO AMT-DISP2. DTSBE328 00752 MOVE WRK-QTR-OLD-ASSESSMT (SUB) TO AMT-DISP3. DTSBE328 00753 MOVE WRK-QTR-NEW-ASSESSMT (SUB) TO AMT-DISP4. DTSBE328 00754 DTSBE328 00755 DISPLAY SPACE. DTSBE328 00756 IF WRK-ASSESS-EXACT-88 DTSBE328 00757 DISPLAY 'EX ' MPRF-EMP-NO ' ' WRK-QTR-YRQ (SUB) DTSBE328 00758 ' ' MPRF-PRIMARY-NAME ' ' WRK-QTR-EMP-CNT (SUB) DTSBE328 00759 ELSE DTSBE328 00760 IF WRK-ASSESS-TOL-88 DTSBE328 00761 DISPLAY 'TL ' MPRF-EMP-NO ' ' WRK-QTR-YRQ (SUB) DTSBE328 00762 ' ' MPRF-PRIMARY-NAME ' ' WRK-QTR-EMP-CNT (SUB) DTSBE328 00763 ELSE DTSBE328 00764 IF WRK-ASSESS-UNDER-MAX-88 DTSBE328 00765 DISPLAY 'MX ' MPRF-EMP-NO ' ' WRK-QTR-YRQ (SUB) DTSBE328 00766 ' ' MPRF-PRIMARY-NAME ' ' WRK-QTR-EMP-CNT (SUB) DTSBE328 00767 ELSE DTSBE328 00768 DISPLAY 'ERR ' MPRF-EMP-NO ' ' WRK-QTR-YRQ (SUB) DTSBE328 00769 ' ' MPRF-PRIMARY-NAME ' ' WRK-QTR-EMP-CNT (SUB) DTSBE328 00770 END-IF DTSBE328 00771 END-IF DTSBE328 00772 END-IF. DTSBE328 00773 DISPLAY ' OLD ' AMT-DISP2 ' NEW ' AMT-DISP1. DTSBE328 00774 DISPLAY ' OLD ' AMT-DISP3 ' NEW ' AMT-DISP4. DTSBE328 00775 MOVE WRK-QTR-OLD-TOT-WAGE (SUB) TO AMT-DISP1. DTSBE328 00776 ** DISPLAY ' TAX ' AMT-DISP2 DTSBE328 00777 ** DISPLAY ' OLD ' AMT-DISP3 ' NEW ' AMT-DISP4. DTSBE328 00778 DTSBE328 00779 P2120-EXIT. DTSBE328 00780 EXIT. DTSBE328 00781 DTSBE328 00782 P2121-GET-ADDR. DTSBE328 00783 MOVE LOW-VALUES TO L111-RETURN-AREA. DTSBE328 00784 MOVE MPRF-EMP-NO TO L111-EMP-NO. DTSBE328 00785 SET L111-LOOKUP-TAD-88 TO TRUE. DTSBE328 00786 MOVE +001 TO L111-ID-NO. DTSBE328 00787 DTSBE328 00788 PERFORM S111-LOOKUP-ADDR THRU S111-EXIT. DTSBE328 00789 DTSBE328 00790 IF L111-ADDR-FOUND-88 DTSBE328 00791 SET L112-TAD-ADDR-88 TO TRUE DTSBE328 00792 MOVE L111-RETURN-AREA TO L112-NAME-ADDRESS-AREA DTSBE328 00793 PERFORM P2122-FORMAT-ADDR THRU P2122-EXIT DTSBE328 00794 ELSE DTSBE328 00795 MOVE ALL '?' TO R325-FMT-ADDR DTSBE328 00796 R325-ZIP DTSBE328 00797 R325-ADVANCED-BARCODE. DTSBE328 00798 P2121-EXIT. DTSBE328 00799 EXIT. DTSBE328 00800 P2122-FORMAT-ADDR. DTSBE328 00801 SET L112-ANCHOR-FIRST-88 TO TRUE. DTSBE328 00802 MOVE MPRF-PRIMARY-NAME TO L112-PRIMARY-NAME. DTSBE328 00803 DTSBE328 00804 PERFORM S112-FORMAT-ADDR THRU S112-EXIT. DTSBE328 00805 DTSBE328 00806 MOVE L112-MAILING-ADDRESS TO R325-FMT-ADDR. DTSBE328 00807 MOVE L112-ZIP TO R325-ZIP. DTSBE328 00808 MOVE R325-ZIP TO R325-SORT-ZIP. DTSBE328 00809 MOVE L112-ADVANCED-BARCODE TO R325-ADVANCED-BARCODE. DTSBE328 00810 DTSBE328 00811 P2122-EXIT. DTSBE328 00812 EXIT. DTSBE328 00813 DTSBE328 00814 P2130-WRITE-DOWNLOAD. DTSBE328 00815 MOVE MPRF-EMP-NO TO WRK-DWN-EMP. DTSBE328 00816 MOVE MPRF-PRIMARY-NAME TO WRK-DWN-NAME. DTSBE328 00817 MOVE WRK-QTR-YRQ (SUB) TO L004-QTR-5-9. DTSBE328 00818 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBE328 00819 MOVE L004-SLASH-5-QTR TO WRK-DWN-YRQ. DTSBE328 00820 MOVE WRK-QTR-NEW-TAX-WAGE (SUB) DTSBE328 00821 TO WRK-DWN-TAX-WAGE. DTSBE328 00822 MOVE WRK-QTR-OLD-ASSESSMT (SUB) DTSBE328 00823 TO WRK-DWN-OLD-ASSESS. DTSBE328 00824 MOVE WRK-QTR-NEW-ASSESSMT (SUB) DTSBE328 00825 TO WRK-DWN-NEW-ASSESS. DTSBE328 00826 MOVE WRK-ASSESS-CHNG TO WRK-DWN-ASSESS-CHNG. DTSBE328 00827 DTSBE328 00828 WRITE DOWNLOAD-REC FROM WRK-DOWNLOAD-REC. DTSBE328 00829 DTSBE328 00830 P2130-EXIT. DTSBE328 00831 EXIT. DTSBE328 00832 DTSBE328 00833 P2300-WRITE-MEVL. DTSBE328 00834 MOVE LOW-VALUES TO MEVL-REC. DTSBE328 00835 MOVE L005-DATE TO MEVL-ESTB-DATE DTSBE328 00836 MEVL-CHNG-DATE DTSBE328 00837 MEVL-DATE. DTSBE328 00838 DTSBE328 00839 ADD +1000 TO L005-ABSTIME. DTSBE328 00840 PERFORM S005-FROM-ABSTIME THRU S005-EXIT. DTSBE328 00841 DTSBE328 00842 MOVE MPRF-EMP-NO TO MEVL-EMP-NO. DTSBE328 00843 SET MEVL-EVL-88 TO TRUE. DTSBE328 00844 MOVE +0 TO MEVL-PURGE-DATE. DTSBE328 00845 MOVE 'SI ADMIN ASSESS BILL SENT' TO MEVL-TEXT. DTSBE328 00846 MOVE 'DTSBE328' TO MEVL-SOURCE. CL**2 00847 SET MEVL-NOT-CONVERTED-88 TO TRUE. DTSBE328 00848 MOVE L005-TIME TO MEVL-TIME. DTSBE328 00849 MOVE MEVL-REC TO MSKL-REC. DTSBE328 00850 PERFORM S910-WRITE THRU S910-EXIT. DTSBE328 00851 DTSBE328 00852 P2300-EXIT. DTSBE328 00853 EXIT. DTSBE328 00854 DTSBE328 00855 DTSBE328 00856 T0000-TERMINATE. DTSBE328 00857 IF WRK-ERROR-YES-88 DTSBE328 00858 GO TO T0000-EXIT DTSBE328 00859 END-IF. DTSBE328 00860 DTSBE328 00861 DISPLAY ' '. DTSBE328 00862 DTSBE328 00863 DISPLAY '*** DTSBE328 TERMINATION STATISTICS ***'. CL**2 00864 DTSBE328 00865 DISPLAY ' '. DTSBE328 00866 DTSBE328 00867 DISPLAY 'TOTAL SELF INS READ : ' WRK-MPRF-CNT. DTSBE328 00868 DISPLAY SPACE. DTSBE328 00869 DISPLAY 'TOTAL SI ALREADY COMPUTED : ' WRK-PREV-CNT. CL**2 00870 DISPLAY SPACE. CL**2 00871 DISPLAY 'ASSESSED COUNTS : ' DTSBE328 00872 DISPLAY ' WAGES EXACT : ' WRK-EXACT-CNT. DTSBE328 00873 DISPLAY ' TOLERATED : ' WRK-TOL-CNT. DTSBE328 00874 DISPLAY ' UNDER MAX : ' WRK-UNDER-MAX-CNT. DTSBE328 00875 DISPLAY 'T026 TRANSACTIONS CREATED : ' WRK-T026-CNT. DTSBE328 00876 DISPLAY SPACE. DTSBE328 00877 DISPLAY 'NO ASSESSMENT COUNTS : ' DTSBE328 00878 DISPLAY ' OVER MAX : ' WRK-OVER-MAX-CNT. DTSBE328 00879 DISPLAY ' NO WAGES : ' WRK-NO-WAGES-CNT. DTSBE328 00880 DISPLAY ' INACTIVE SI EMPLS : ' WRK-INACT-CNT. DTSBE328 00881 DTSBE328 00882 CLOSE DOWNLOAD-FILE DTSBE328 00883 WESQ-FILE. DTSBE328 00884 DTSBE328 00885 DTSBE328 00886 T0000-EXIT. DTSBE328 00887 EXIT. DTSBE328 00888 DTSBE328 00889 S001-FROM-FED-8. DTSBE328 00890 SET L001-FROM-FED-8 TO TRUE. DTSBE328 00891 GO TO S001-DATE. DTSBE328 00892 DTSBE328 00893 S001-FROM-ABS-DAY. DTSBE328 00894 SET L001-FROM-ABS-DAY TO TRUE. DTSBE328 00895 GO TO S001-DATE. DTSBE328 00896 DTSBE328 00897 S001-DATE. DTSBE328 00898 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBE328 00899 DTSBE328 00900 S001-EXIT. DTSBE328 00901 EXIT. DTSBE328 00902 SKIP3 DTSBE328 00903 S004-FROM-5. DTSBE328 00904 SET L004-FROM-5 TO TRUE. DTSBE328 00905 GO TO S004-EDIT-QTR. DTSBE328 00906 DTSBE328 00907 S004-FROM-DATE. DTSBE328 00908 SET L004-FROM-DATE TO TRUE. DTSBE328 00909 GO TO S004-EDIT-QTR. DTSBE328 00910 DTSBE328 00911 S004-FROM-ABS. DTSBE328 00912 SET L004-FROM-ABS TO TRUE. DTSBE328 00913 GO TO S004-EDIT-QTR. DTSBE328 00914 DTSBE328 00915 S004-EDIT-QTR. DTSBE328 00916 CALL 'DTSBU004' USING L004-COMM-AREA. DTSBE328 00917 DTSBE328 00918 S004-EXIT. DTSBE328 00919 EXIT. DTSBE328 00920 SKIP3 DTSBE328 00921 S005-SYS-DATE. DTSBE328 00922 SET L005-FROM-SYS TO TRUE DTSBE328 00923 GO TO S005-ABSTIME. DTSBE328 00924 S005-FROM-ABSTIME. DTSBE328 00925 SET L005-FROM-ABSTIME TO TRUE. DTSBE328 00926 GO TO S005-ABSTIME. DTSBE328 00927 S005-ABSTIME. DTSBE328 00928 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBE328 00929 S005-EXIT. DTSBE328 00930 EXIT. DTSBE328 00931 SKIP3 DTSBE328 00932 S109-SUR-RATE-FIRST-QTR. DTSBE328 00933 SET L109-CMND-FIRST-QTR-88 TO TRUE. DTSBE328 00934 CALL 'DTSBU109' USING L109-LINK-AREA. DTSBE328 00935 DTSBE328 00936 S109-FIRST-EXIT. DTSBE328 00937 EXIT. DTSBE328 00938 S109-SUR-BY-QTR. DTSBE328 00939 SET L109-CLASS-SELF-INS-88 TO TRUE. DTSBE328 00940 SET L109-CMND-INPUT-QTR-88 TO TRUE. DTSBE328 00941 CALL 'DTSBU109' USING L109-LINK-AREA. DTSBE328 00942 DTSBE328 00943 S109-QTR-EXIT. DTSBE328 00944 EXIT. DTSBE328 00945 SKIP3 DTSBE328 00946 SKIP3 DTSBE328 00947 S111-LOOKUP-ADDR. DTSBE328 00948 CALL 'DTSBU111' USING L111-LINK-AREA. DTSBE328 00949 S111-EXIT. DTSBE328 00950 EXIT. DTSBE328 00951 SKIP3 DTSBE328 00952 S112-FORMAT-ADDR. DTSBE328 00953 CALL 'DTSBU112' USING L112-LINK-AREA. DTSBE328 00954 S112-EXIT. DTSBE328 00955 EXIT. DTSBE328 00956 SKIP3 DTSBE328 00957 DTSBE328 00958 *S910-OPEN-READ. DTSBE328 00959 * SET L910-OPEN-READ-88 TO TRUE. DTSBE328 00960 * GO TO S910-MSTR-IO. DTSBE328 00961 * DTSBE328 00962 *S910-OPEN-UPDATE-NO-AIX. DTSBE328 00963 * SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE. DTSBE328 00964 * GO TO S910-MSTR-IO. DTSBE328 00965 DTSBE328 00966 S910-READ. DTSBE328 00967 SET L910-READ-88 TO TRUE. DTSBE328 00968 GO TO S910-MSTR-IO. DTSBE328 00969 DTSBE328 00970 S910-START-BROWSE. DTSBE328 00971 SET L910-START-BROWSE-88 TO TRUE. DTSBE328 00972 GO TO S910-MSTR-IO. DTSBE328 00973 DTSBE328 00974 S910-READ-NEXT. DTSBE328 00975 SET L910-READ-NEXT-88 TO TRUE. DTSBE328 00976 GO TO S910-MSTR-IO. DTSBE328 00977 DTSBE328 00978 S910-COUNT. DTSBE328 00979 SET L910-COUNT-88 TO TRUE. DTSBE328 00980 GO TO S910-MSTR-IO. DTSBE328 00981 DTSBE328 00982 S910-REWRITE. DTSBE328 00983 SET L910-REWRITE-88 TO TRUE. DTSBE328 00984 GO TO S910-MSTR-IO. DTSBE328 00985 DTSBE328 00986 S910-WRITE. DTSBE328 00987 SET L910-WRITE-88 TO TRUE. DTSBE328 00988 GO TO S910-MSTR-IO. DTSBE328 00989 DTSBE328 00990 *S910-CLOSE. DTSBE328 00991 * SET L910-CLOSE-88 TO TRUE. DTSBE328 00992 * GO TO S910-MSTR-IO. DTSBE328 00993 DTSBE328 00994 S910-MSTR-IO. DTSBE328 00995 CALL 'DTSBU910' USING L910-LINK-AREA DTSBE328 00996 MSKL-REC. DTSBE328 00997 S910-EXIT. DTSBE328 00998 EXIT. DTSBE328 00999 SKIP3 DTSBE328 01000 S927-OPEN-UPDATE. DTSBE328 01001 SET L927-OPEN-UPDATE-88 TO TRUE. DTSBE328 01002 GO TO S927-IO. DTSBE328 01003 S927-WRITE. DTSBE328 01004 SET L927-WRITE-88 TO TRUE. DTSBE328 01005 GO TO S927-IO. DTSBE328 01006 S927-CLOSE. DTSBE328 01007 SET L927-CLOSE-88 TO TRUE. DTSBE328 01008 GO TO S927-IO. DTSBE328 01009 S927-IO. DTSBE328 01010 CALL 'DTSBU927' USING L927-LINK-AREA DTSBE328 01011 T026-REC. DTSBE328 01012 S927-EXIT. DTSBE328 01013 EXIT. DTSBE328 01014 DTSBE328 01015 S946-WRITE-R325. DTSBE328 01016 CALL 'DTSBU946' USING R325-REC. DTSBE328 01017 S946-EXIT. DTSBE328 01018 EXIT. DTSBE328 01019 DTSBE328 01020 S981-OPEN-READ. DTSBE328 01021 SET L981-OPEN-READ-88 TO TRUE. DTSBE328 01022 GO TO S981-MSTR-IO. DTSBE328 01023 DTSBE328 01024 S981-READ. DTSBE328 01025 SET L981-READ-88 TO TRUE. DTSBE328 01026 GO TO S981-MSTR-IO. DTSBE328 01027 DTSBE328 01028 S981-START-BROWSE. DTSBE328 01029 SET L981-START-BROWSE-88 TO TRUE. DTSBE328 01030 GO TO S981-MSTR-IO. DTSBE328 01031 DTSBE328 01032 S981-READ-NEXT. DTSBE328 01033 SET L981-READ-NEXT-88 TO TRUE. DTSBE328 01034 GO TO S981-MSTR-IO. DTSBE328 01035 DTSBE328 01036 S981-CLOSE. DTSBE328 01037 SET L981-CLOSE-88 TO TRUE. DTSBE328 01038 GO TO S981-MSTR-IO. DTSBE328 01039 DTSBE328 01040 S981-MSTR-IO. DTSBE328 01041 CALL 'DTSBU981' USING L981-LINK-AREA DTSBE328 01042 WWGH-REC. DTSBE328 01043 S981-EXIT. DTSBE328 01044 EXIT. DTSBE328 01045 SKIP3 DTSBE328 01046 DTSBE328 01047 S999-ABEND. DTSBE328 01048 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBE328 01049 S999-EXIT. DTSBE328 01050 EXIT. DTSBE328