00001 IDENTIFICATION DIVISION. 07/23/04 00002 PROGRAM-ID. DTSBU421. DTSBU421 00003 AUTHOR. TRW. LV007 00004 DATE-WRITTEN. FEBRUARY 2002. DTSBU421 00005 DATE-COMPILED. DTSBU421 00006 SKIP3 DTSBU421 00007 ***** DTSBU421 00008 * *** ANNUAL REPORT VERSION *** DTSBU421 00009 * DTSBU421 00010 * FUNCTION: DTSBU421 READ THE EMPLOYER-ORIENTED WAGE HISTORY FDTSBU421 00011 * (WGH) FOR A GIVEN EMPLOYER, AND RETURNS THE SSNS ODTSBU421 00012 * ALL WORKERS REPORTED, AND ANY WAGES PREVIOUSLY DTSBU421 00013 * REPORTED FOR THE CURRENT YEAR. DTSBU421 00014 * DTSBU421 00015 * MODIFICATION LOG: DTSBU421 00016 * DTSBU421 00017 * 02/18/2002 INITIAL DEVELOPMENT. DTSBU421 00018 * WORK ORDER: PROGRAMMER: GD DTSBU421 00019 * DTSBU421 00020 * 12/11/2003 CORRECTED PROBLEM IN P1920 - ADDED CODE TO DTSBU421 00021 * CLEAR LINES IN WAGE TABLE WHEN A NEW LINE IS DTSBU421 00022 * INSERTED. DTSBU421 00023 * INITIALIZED TBL-CNT AT BEGINNING OF PROGRAM. DTSBU421 00024 * WORK ORDER: PROGRAMMER: GD DTSBU421 00025 * DTSBU421 00026 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU421 00027 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU421 00028 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBU421 00029 * DTSBU421 00030 * DTSBU421 00031 * DESCRIPTION: DTSBU421 00032 * DTSBU421 00033 * THIS PROGRAM WAS CLONED FROM DTSCU422 FOR THE BATCH DTSBU421 00034 * MODE TO READ THE EMPLOYER-ORIENTED WAGE HISTORY FILE DTSBU421 00035 * (WGH) FOR A GIVEN EMPLOYER, AND RETURNS THE SSNS OF DTSBU421 00036 * ALL WORKERS REPORTED, AND ANY WAGES PREVIOUSLY DTSBU421 00037 * REPORTED FOR THE CURRENT YEAR. DTSBU421 00038 * DTSBU421 00039 * DTSBU421 00040 * GENERAL SPECIFICATIONS: DTSBU421 00041 * DTSBU421 00042 * DTSBU421 00043 * DTSBU421 00044 * DTSBU421 00045 * COMMAND SPECIFIC SPECIFICATIONS: DTSBU421 00046 * DTSBU421 00047 * DTSBU421 00048 * DTSBU421 00049 ***** DTSBU421 00050 SKIP3 DTSBU421 00051 DATA DIVISION. DTSBU421 00052 WORKING-STORAGE SECTION. DTSBU421 000525 77 PAN-VALET PICTURE X(24) VALUE '007DTSBU421 07/23/04'. DTSBU421 00053 SKIP3 DTSBU421 00054 01 WRK-AREA. DTSBU421 00055 DTSBU421 00056 05 WRK-ABEND-CD PIC X(04) VALUE 'U421'. DTSBU421 00057 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBU421'. DTSBU421 00058 05 ABEND-MSG PIC X(60). DTSBU421 00059 DTSBU421 00060 05 TBL-SUB PIC S9(04) COMP. DTSBU421 00061 05 TBL-CNT PIC S9(04) COMP VALUE +0. DTSBU421 00062 05 TBL-MAX PIC S9(04) COMP DTSBU421 00063 VALUE +250. DTSBU421 00064 05 SSN-SUB PIC S9(04) COMP. DTSBU421 00065 05 NXT-SUB PIC S9(04) COMP. DTSBU421 00066 DTSBU421 00067 05 WRK-INDEX-IND PIC X(01). DTSBU421 00068 88 WRK-INDEX-NULL-88 VALUE '0'. DTSBU421 00069 88 WRK-INDEX-POSITION-FOUND-88 VALUE '1'. DTSBU421 00070 88 WRK-INDEX-SSN-FOUND-88 VALUE '2'. DTSBU421 00071 88 WRK-INDEX-FOUND-88 VALUE '1' '2'. DTSBU421 00072 DTSBU421 00073 05 WRK-MAX-SSN PIC S9(09) COMP-3 DTSBU421 00074 VALUE +0. DTSBU421 00075 DTSBU421 00076 EJECT DTSBU421 00077 01 L004-LINK-AREA. DTSBU421 00078 ++INCLUDE DTSIL004 DTSBU421 00079 SKIP3 DTSBU421 00080 01 L981-LINK-AREA. DTSBU421 00081 ++INCLUDE DTSIL981 DTSBU421 00082 SKIP3 DTSBU421 00083 01 WWGH-REC. DTSBU421 00084 ++INCLUDE DTSIWWGH DTSBU421 00085 EJECT DTSBU421 00086 DTSBU421 00087 01 L423-LINK-AREA. DTSBU421 00088 ++INCLUDE DTSIL423 DTSBU421 00089 EJECT DTSBU421 00090 LINKAGE SECTION. DTSBU421 00091 SKIP3 DTSBU421 00092 01 L421-LINK-AREA. DTSBU421 00093 ++INCLUDE DTSIL421 DTSBU421 00094 EJECT DTSBU421 00095 PROCEDURE DIVISION DTSBU421 00096 USING L421-LINK-AREA. DTSBU421 00097 DTSBU421 00098 PERFORM I0000-INIT-TABLE THRU I0000-EXIT. DTSBU421 00099 DTSBU421 00100 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBU421 00101 DTSBU421 00102 GOBACK. DTSBU421 00103 EJECT DTSBU421 00104 I0000-INIT-TABLE. DTSBU421 00105 PERFORM DTSBU421 00106 VARYING SSN-SUB FROM +1 BY +1 DTSBU421 00107 UNTIL SSN-SUB > TBL-MAX DTSBU421 00108 MOVE ZERO TO L421-SSN (SSN-SUB) DTSBU421 00109 L421-QTR1-CURR-WAGE (SSN-SUB) DTSBU421 00110 L421-QTR1-TAX-WAGE (SSN-SUB) DTSBU421 00111 L421-QTR2-CURR-WAGE (SSN-SUB) DTSBU421 00112 L421-QTR2-TAX-WAGE (SSN-SUB) DTSBU421 00113 L421-QTR3-CURR-WAGE (SSN-SUB) DTSBU421 00114 L421-QTR3-TAX-WAGE (SSN-SUB) DTSBU421 00115 L421-QTR4-CURR-WAGE (SSN-SUB) DTSBU421 00116 L421-QTR4-TAX-WAGE (SSN-SUB) DTSBU421 00117 END-PERFORM. DTSBU421 00118 DTSBU421 00119 I0000-EXIT. DTSBU421 00120 EXIT. DTSBU421 00121 DTSBU421 00122 P0000-PROCESS. DTSBU421 00123 DTSBU421 00124 MOVE ZERO TO TBL-SUB DTSBU421 00125 TBL-CNT DTSBU421 00126 WRK-MAX-SSN. DTSBU421 00127 SET L421-ERR-NO-88 TO TRUE. DTSBU421 00128 DTSBU421 00129 MOVE LOW-VALUE TO WWGH-REC. DTSBU421 00130 MOVE L421-EMP-NO TO WWGH-EMP-NO. DTSBU421 00131 MOVE L421-QTR1 TO WWGH-YRQ. DTSBU421 00132 DTSBU421 00133 PERFORM S981D-START-BROWSE THRU S981D-EXIT. DTSBU421 00134 DTSBU421 00135 IF L981-OK-88 DTSBU421 00136 PERFORM P1000-SCAN-WAGE-FILE THRU P1000-EXIT DTSBU421 00137 UNTIL L981-NO-REC-88 DTSBU421 00138 OR L421-ERR-IND NOT = '00'. DTSBU421 00139 DTSBU421 00140 MOVE TBL-CNT TO L421-WAGE-TBL-CNT. DTSBU421 00141 DTSBU421 00142 PERFORM P2000-TAX-WAGE THRU P2000-EXIT. DTSBU421 00143 DTSBU421 00144 DTSBU421 00145 P0000-EXIT. DTSBU421 00146 EXIT. DTSBU421 00147 DTSBU421 00148 P1000-SCAN-WAGE-FILE. DTSBU421 00149 IF WWGH-EMP-NO NOT = L421-EMP-NO DTSBU421 00150 OR WWGH-YRQ > L421-QTR4 DTSBU421 00151 SET L981-NO-REC-88 TO TRUE DTSBU421 00152 GO TO P1000-EXIT DTSBU421 00153 ELSE DTSBU421 00154 IF WWGH-SSN = +0 DTSBU421 00155 NEXT SENTENCE DTSBU421 00156 ELSE DTSBU421 00157 PERFORM P1900-FIND-INDEX THRU P1900-EXIT DTSBU421 00158 IF L421-ERR-NO-88 DTSBU421 00159 PERFORM P1100-MOVE-WAGES THRU P1100-EXIT DTSBU421 00160 ELSE DTSBU421 00161 GO TO P1000-EXIT DTSBU421 00162 END-IF DTSBU421 00163 END-IF DTSBU421 00164 END-IF. DTSBU421 00165 DTSBU421 00166 PERFORM S981E-READ-NEXT THRU S981E-EXIT. DTSBU421 00167 DTSBU421 00168 P1000-EXIT. DTSBU421 00169 EXIT. DTSBU421 00170 DTSBU421 00171 P1100-MOVE-WAGES. DTSBU421 00172 *& DTSBU421 00173 * DISPLAY ' P1100 -1 ' L421-EMP-NO ' ' TBL-SUB. DTSBU421 00174 *& DTSBU421 00175 MOVE WWGH-SSN TO L421-SSN (TBL-SUB). DTSBU421 00176 DTSBU421 00177 EVALUATE TRUE DTSBU421 00178 WHEN WWGH-YRQ = L421-QTR1 DTSBU421 00179 ADD WWGH-EARNINGS TO L421-QTR1-CURR-WAGE (TBL-SUB) DTSBU421 00180 WHEN WWGH-YRQ = L421-QTR2 DTSBU421 00181 ADD WWGH-EARNINGS TO L421-QTR2-CURR-WAGE (TBL-SUB) DTSBU421 00182 WHEN WWGH-YRQ = L421-QTR3 DTSBU421 00183 ADD WWGH-EARNINGS TO L421-QTR3-CURR-WAGE (TBL-SUB) DTSBU421 00184 WHEN WWGH-YRQ = L421-QTR4 DTSBU421 00185 ADD WWGH-EARNINGS TO L421-QTR4-CURR-WAGE (TBL-SUB) DTSBU421 00186 END-EVALUATE. DTSBU421 00187 DTSBU421 00188 P1100-EXIT. DTSBU421 00189 EXIT. DTSBU421 00190 DTSBU421 00191 DTSBU421 00192 P1900-FIND-INDEX. DTSBU421 00193 *& DTSBU421 00194 * IF WWGH-EMP-NO = 050028 DTSBU421 00195 * DISPLAY 'SSN ' WWGH-SSN ' MAX ' WRK-MAX-SSN DTSBU421 00196 * ' CNT ' TBL-CNT DTSBU421 00197 * END-IF. DTSBU421 00198 *& DTSBU421 00199 SET WRK-INDEX-NULL-88 TO TRUE. DTSBU421 00200 DTSBU421 00201 IF WWGH-SSN > WRK-MAX-SSN DTSBU421 00202 IF TBL-CNT < TBL-MAX DTSBU421 00203 ADD +1 TO TBL-CNT DTSBU421 00204 MOVE TBL-CNT TO TBL-SUB DTSBU421 00205 SET WRK-INDEX-POSITION-FOUND-88 TO TRUE DTSBU421 00206 MOVE WWGH-SSN TO WRK-MAX-SSN DTSBU421 00207 ELSE DTSBU421 00208 SET L421-ERR-OVER-250-88 TO TRUE DTSBU421 00209 END-IF DTSBU421 00210 ELSE DTSBU421 00211 PERFORM P1910-SEARCH-TABLE THRU P1910-EXIT DTSBU421 00212 IF WRK-INDEX-POSITION-FOUND-88 DTSBU421 00213 IF TBL-CNT < TBL-MAX DTSBU421 00214 PERFORM P1920-INSERT-SSN THRU P1920-EXIT DTSBU421 00215 ELSE DTSBU421 00216 SET L421-ERR-OVER-250-88 TO TRUE DTSBU421 00217 END-IF DTSBU421 00218 END-IF DTSBU421 00219 END-IF. DTSBU421 00220 DTSBU421 00221 P1900-EXIT. DTSBU421 00222 EXIT. DTSBU421 00223 DTSBU421 00224 P1910-SEARCH-TABLE. DTSBU421 00225 PERFORM DTSBU421 00226 VARYING SSN-SUB FROM +1 BY +1 DTSBU421 00227 UNTIL WRK-INDEX-FOUND-88 DTSBU421 00228 OR SSN-SUB > TBL-CNT DTSBU421 00229 IF L421-SSN (SSN-SUB) = WWGH-SSN DTSBU421 00230 SET WRK-INDEX-SSN-FOUND-88 TO TRUE DTSBU421 00231 MOVE SSN-SUB TO TBL-SUB DTSBU421 00232 ELSE DTSBU421 00233 IF WWGH-SSN < L421-SSN (SSN-SUB) DTSBU421 00234 MOVE SSN-SUB TO TBL-SUB DTSBU421 00235 SET WRK-INDEX-POSITION-FOUND-88 TO TRUE DTSBU421 00236 END-IF DTSBU421 00237 END-IF DTSBU421 00238 END-PERFORM. DTSBU421 00239 DTSBU421 00240 *& DTSBU421 00241 * IF WWGH-EMP-NO = 050028 DTSBU421 00242 * DISPLAY 'P1910 ' WWGH-SSN ' ' TBL-SUB DTSBU421 00243 * END-IF. DTSBU421 00244 *& DTSBU421 00245 P1910-EXIT. DTSBU421 00246 EXIT. DTSBU421 00247 DTSBU421 00248 P1920-INSERT-SSN. DTSBU421 00249 *& DTSBU421 00250 * IF WWGH-EMP-NO = 050028 DTSBU421 00251 * DISPLAY 'P1920 ' WWGH-SSN ' SUB ' TBL-SUB DTSBU421 00252 * ' CNT ' TBL-CNT DTSBU421 00253 * END-IF. DTSBU421 00254 *& DTSBU421 00255 PERFORM DTSBU421 00256 VARYING SSN-SUB FROM TBL-CNT BY -1 DTSBU421 00257 UNTIL SSN-SUB < TBL-SUB DTSBU421 00258 COMPUTE NXT-SUB = SSN-SUB + 1 DTSBU421 00259 MOVE L421-SSN-TBL (SSN-SUB) TO DTSBU421 00260 L421-SSN-TBL (NXT-SUB) DTSBU421 00261 PERFORM P1921-CLEAR-LINE THRU P1921-EXIT DTSBU421 00262 END-PERFORM. DTSBU421 00263 DTSBU421 00264 ADD +1 TO TBL-CNT. DTSBU421 00265 DTSBU421 00266 P1920-EXIT. DTSBU421 00267 EXIT. DTSBU421 00268 DTSBU421 00269 P1921-CLEAR-LINE. DTSBU421 00270 MOVE ZERO TO L421-SSN (SSN-SUB) DTSBU421 00271 L421-QTR1-CURR-WAGE (SSN-SUB) DTSBU421 00272 L421-QTR1-TAX-WAGE (SSN-SUB) DTSBU421 00273 L421-QTR2-CURR-WAGE (SSN-SUB) DTSBU421 00274 L421-QTR2-TAX-WAGE (SSN-SUB) DTSBU421 00275 L421-QTR3-CURR-WAGE (SSN-SUB) DTSBU421 00276 L421-QTR3-TAX-WAGE (SSN-SUB) DTSBU421 00277 L421-QTR4-CURR-WAGE (SSN-SUB) DTSBU421 00278 L421-QTR4-TAX-WAGE (SSN-SUB). DTSBU421 00279 DTSBU421 00280 P1921-EXIT. DTSBU421 00281 EXIT. DTSBU421 00282 DTSBU421 00283 P2000-TAX-WAGE. DTSBU421 00284 PERFORM P2100-CALL-BU423 THRU P2100-EXIT DTSBU421 00285 VARYING TBL-SUB FROM +1 BY +1 DTSBU421 00286 UNTIL TBL-SUB > TBL-CNT. DTSBU421 00287 DTSBU421 00288 P2000-EXIT. DTSBU421 00289 EXIT. DTSBU421 00290 DTSBU421 00291 P2100-CALL-BU423. DTSBU421 00292 MOVE L421-QTR1 TO L423-QTR1. DTSBU421 00293 MOVE L421-QTR1-CURR-WAGE (TBL-SUB) TO L423-QTR1-WAGE-CHNG. DTSBU421 00294 MOVE ZERO TO L423-QTR1-CURR-WAGE. DTSBU421 00295 MOVE L421-QTR2 TO L423-QTR2. DTSBU421 00296 MOVE L421-QTR2-CURR-WAGE (TBL-SUB) TO L423-QTR2-WAGE-CHNG. DTSBU421 00297 MOVE ZERO TO L423-QTR2-CURR-WAGE. DTSBU421 00298 MOVE L421-QTR3 TO L423-QTR3. DTSBU421 00299 MOVE L421-QTR3-CURR-WAGE (TBL-SUB) TO L423-QTR3-WAGE-CHNG. DTSBU421 00300 MOVE ZERO TO L423-QTR3-CURR-WAGE. DTSBU421 00301 MOVE L421-QTR4 TO L423-QTR4. DTSBU421 00302 MOVE L421-QTR4-CURR-WAGE (TBL-SUB) TO L423-QTR4-WAGE-CHNG. DTSBU421 00303 MOVE ZERO TO L423-QTR4-CURR-WAGE. DTSBU421 00304 DTSBU421 00305 PERFORM S423-CALC-TAX-WAGES THRU S423-EXIT. DTSBU421 00306 DTSBU421 00307 MOVE L423-QTR1-TAX-WAGES TO L421-QTR1-TAX-WAGE (TBL-SUB). DTSBU421 00308 MOVE L423-QTR2-TAX-WAGES TO L421-QTR2-TAX-WAGE (TBL-SUB). DTSBU421 00309 MOVE L423-QTR3-TAX-WAGES TO L421-QTR3-TAX-WAGE (TBL-SUB). DTSBU421 00310 MOVE L423-QTR4-TAX-WAGES TO L421-QTR4-TAX-WAGE (TBL-SUB). DTSBU421 00311 DTSBU421 00312 P2100-EXIT. DTSBU421 00313 EXIT. DTSBU421 00314 DTSBU421 00315 DTSBU421 00316 S004-FROM-5. DTSBU421 00317 SET L004-FROM-5 TO TRUE. DTSBU421 00318 GO TO S004-QTR. DTSBU421 00319 DTSBU421 00320 S004-FROM-3. DTSBU421 00321 SET L004-FROM-3 TO TRUE. DTSBU421 00322 GO TO S004-QTR. DTSBU421 00323 DTSBU421 00324 S004-QTR. DTSBU421 00325 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBU421 00326 S004-EXIT. DTSBU421 00327 EXIT. DTSBU421 00328 SKIP3 DTSBU421 00329 DTSBU421 00330 S423-CALC-TAX-WAGES. DTSBU421 00331 CALL 'DTSBU423' USING L423-LINK-AREA. DTSBU421 00332 DTSBU421 00333 S423-EXIT. DTSBU421 00334 EXIT. DTSBU421 00335 DTSBU421 00336 S981A-OPEN-READ. DTSBU421 00337 SET L981-OPEN-READ-88 TO TRUE. DTSBU421 00338 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DTSBU421 00339 DTSBU421 00340 S981A-EXIT. DTSBU421 00341 EXIT. DTSBU421 00342 DTSBU421 00343 S981B-OPEN-UPDATE. DTSBU421 00344 SET L981-OPEN-UPDATE-88 TO TRUE. DTSBU421 00345 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DTSBU421 00346 DTSBU421 00347 S981B-EXIT. DTSBU421 00348 EXIT. DTSBU421 00349 DTSBU421 00350 S981C-CLOSE. DTSBU421 00351 SET L981-CLOSE-88 TO TRUE. DTSBU421 00352 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DTSBU421 00353 DTSBU421 00354 S981C-EXIT. DTSBU421 00355 EXIT. DTSBU421 00356 DTSBU421 00357 S981D-START-BROWSE. DTSBU421 00358 SET L981-START-BROWSE-88 TO TRUE. DTSBU421 00359 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DTSBU421 00360 DTSBU421 00361 S981D-EXIT. DTSBU421 00362 EXIT. DTSBU421 00363 DTSBU421 00364 S981E-READ-NEXT. DTSBU421 00365 SET L981-READ-NEXT-88 TO TRUE. DTSBU421 00366 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DTSBU421 00367 DTSBU421 00368 S981E-EXIT. DTSBU421 00369 EXIT. DTSBU421 00370 DTSBU421 00371 S981Z-WAGE-I. DTSBU421 00372 CALL 'DTSBU981' USING L981-LINK-AREA DTSBU421 00373 WWGH-REC. DTSBU421 00374 S981Z-EXIT. DTSBU421 00375 EXIT. DTSBU421 00376 DTSBU421 00377 S999-ABEND. DTSBU421 00378 DISPLAY '*** DTSBE453 ABENDING. ' DTSBU421 00379 ABEND-MSG. DTSBU421 00380 DTSBU421 00381 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBU421 00382 S999-EXIT. DTSBU421 00383 EXIT. DTSBU421 00384 DTSBU421 00385 DTSBU421