00001 IDENTIFICATION DIVISION. 05/20/13 00002 PROGRAM-ID. DTSBU424. DTSBU424 00003 AUTHOR. NGC. LV001 00004 DATE-WRITTEN. NOVEMBER 2012. DTSBU424 00005 DATE-COMPILED. DTSBU424 00006 SKIP3 DTSBU424 00007 ***** DTSBU424 00008 * DTSBU424 00009 * FUNCTION: DETERMINE TOTAL AND TAXABLE WAGES FOR AMENDED DTSBU424 00010 * REPORTS. FIND THE WAGES FROM REPORTS ALREADY DTSBU424 00011 * FILED FROM THE WGH. FIND WAGES FOR THE NEW DTSBU424 00012 * REPORT FROM THE WTC FILE. DTSBU424 00013 * DTSBU424 00014 * DTSBU424 00015 * MODIFICATION LOG: DTSBU424 00016 * DTSBU424 00017 * 11/07/2012 INITIAL DEVELOPMENT. DTSBU424 00018 * WORK ORDER: PROGRAMMER: GD DTSBU424 00019 * DTSBU424 00020 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU424 00021 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU424 00022 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBU424 00023 * DTSBU424 00024 * DTSBU424 00025 * DESCRIPTION: DTSBU424 00026 * DTSBU424 00027 * DTSBD371 CALLS THIS PROGRAM WHEN AN ELECTRONIC REPORT DTSBU424 00028 * TRANSACTION HAS PROCESSED SUCCESSFULLY. DTSBU424 00029 * DTSBD374 CALLS THIS PROGRAM WHEN AN ANNUAL REPORT DTSBU424 00030 * TRANSACTION HAS PROCESSED SUCCESSFULLY. DTSBU424 00031 * DTSBU420 THEN FORMATS W4 TRANSACTIONS FROM W001 DTSBU424 00032 * TRANSACTIONS, AND WRITES WWGH WAGE HISTORY RECORDS. DTSBU424 00033 * DTSBU424 00034 * DTSBD180 CALLS THIS PROGRAM WHEN IT DELETES A BATCH DTSBU424 00035 * AFTER ALL TRANSACTIONS HAVE BEEN PROCESSED. DTSBU420 DTSBU424 00036 * THEN DELETES ALL THE W001 TRANSACTIONS ASSOCIATED WITH DTSBU424 00037 * THE BATCH. DTSBU424 00038 * DTSBU424 00039 * GENERAL SPECIFICATIONS: DTSBU424 00040 * DTSBU424 00041 * ALL COMMANDS ARE VALID. DTSBU424 00042 * DTSBU424 00043 * IF AN INVALID COMMAND IS REQUESTED, THEN ABEND THE DTSBU424 00044 * MODULE. DTSBU424 00045 * DTSBU424 00046 * IF A FILE-STATUS OF OTHER THAN '00', '10', OR '23' IS DTSBU424 00047 * ENCOUNTERED, THEN ABEND PROCESSING (TOLERATE A DTSBU424 00048 * FILE-STATUS OF '97' FROM AN OPEN COMMAND). DTSBU424 00049 * DTSBU424 00050 * DTSBU424 00051 * DTSBU424 00052 * COMMAND SPECIFIC SPECIFICATIONS: DTSBU424 00053 * DTSBU424 00054 * OPEN-READ DTSBU424 00055 * OPEN INPUT. DTSBU424 00056 * DTSBU424 00057 * OPEN-UPDATE DTSBU424 00058 * OPEN I-O. DTSBU424 00059 * DTSBU424 00060 * CLOSE DTSBU424 00061 * DTSBU424 00062 * READ DTSBU424 00063 * DTSBU424 00064 * START BROWSE DTSBU424 00065 * IF THE START-BROWSE IS SUCCESSFUL, THEN PERFORM THE DTSBU424 00066 * READ-NEXT LOGIC. A SUCCESSFUL START-BROWSE RETURNS DTSBU424 00067 * A RECORD. DTSBU424 00068 * DTSBU424 00069 * READ NEXT DTSBU424 00070 * DTSBU424 00071 * WRITE DTSBU424 00072 * DTSBU424 00073 * REWRITE DTSBU424 00074 * DTSBU424 00075 * DELETE DTSBU424 00076 * DTSBU424 00077 * DTSBU424 00078 ***** DTSBU424 00079 DTSBU424 00080 ENVIRONMENT DIVISION. DTSBU424 00081 DTSBU424 00082 *INPUT-OUTPUT SECTION. DTSBU424 00083 DTSBU424 00084 *FILE-CONTROL. DTSBU424 00085 DTSBU424 00086 DATA DIVISION. DTSBU424 00087 DTSBU424 00088 *FILE SECTION. DTSBU424 00089 DTSBU424 00090 WORKING-STORAGE SECTION. DTSBU424 000905 77 PAN-VALET PICTURE X(24) VALUE '001DTSBU424 05/20/13'. DTSBU424 00091 77 PAN-VALET PICTURE X(24) VALUE '055DTSBU424 12/04/12'. DTSBU424 00092 77 PAN-VALET PICTURE X(24) VALUE '021DTSBU420 08/07/12'. DTSBU424 00093 SKIP3 DTSBU424 00094 01 WRK-AREA. DTSBU424 00095 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +424. DTSBU424 00096 DTSBU424 00097 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBU424'. DTSBU424 00098 DTSBU424 00099 DTSBU424 00100 05 WRK-SUBJ-YRQ PIC S9(05) COMP-3 DTSBU424 00101 VALUE +0. DTSBU424 00102 05 WRK-CURR-YRQ PIC S9(05) COMP-3 DTSBU424 00103 VALUE +0. DTSBU424 00104 DTSBU424 00105 05 WRK-EARNINGS PIC S9(11)V99 COMP-3 DTSBU424 00106 VALUE +0. DTSBU424 00107 *************** DTSBU424 00108 * THE THE CORRECTED TOTAL WAGES FOR THE QUARTER FOR USE DTSBU424 00109 * IN THE TAXABLE WAGE COMPUTATION. DTSBU424 00110 *************** DTSBU424 00111 05 WRK-TOT-WAGE PIC S9(11)V99 COMP-3 DTSBU424 00112 VALUE +0. DTSBU424 00113 *************** DTSBU424 00114 * THE THE TOTAL WAGE AMOUNT FOR THE AMENDED OR ORIGINAL DTSBU424 00115 * REPORT. DTSBU424 00116 *************** DTSBU424 00117 05 WRK-AMEND-TOT-WAGE PIC S9(11)V99 COMP-3 DTSBU424 00118 VALUE +0. DTSBU424 00119 05 WRK-TAX-WAGE PIC S9(11)V99 COMP-3 DTSBU424 00120 VALUE +0. DTSBU424 00121 05 WRK-TAX-WAGE-OLD PIC S9(11)V99 COMP-3 DTSBU424 00122 VALUE +0. DTSBU424 00123 05 WRK-TAX-WAGE-NEW PIC S9(11)V99 COMP-3 DTSBU424 00124 VALUE +0. DTSBU424 00125 05 W-DIFF PIC S9(11)V99 COMP-3 DTSBU424 00126 VALUE +0. DTSBU424 00127 DTSBU424 00128 05 WRK-TAX-WAGE-BASE PIC S9(07)V99 COMP-3 VALUE +0. DTSBU424 00129 05 WRK-WAGE-BASE-REMAIN PIC S9(07)V99 COMP-3 VALUE +0. DTSBU424 00130 DTSBU424 00131 05 WRK-WAGE-TBL. DTSBU424 00132 10 W-Q1-TOT-WAGE PIC S9(11)V99 COMP-3. DTSBU424 00133 10 W-Q1-TAX-WAGE PIC S9(11)V99 COMP-3. DTSBU424 00134 10 W-Q2-TOT-WAGE PIC S9(11)V99 COMP-3. DTSBU424 00135 10 W-Q2-TAX-WAGE PIC S9(11)V99 COMP-3. DTSBU424 00136 10 W-Q3-TOT-WAGE PIC S9(11)V99 COMP-3. DTSBU424 00137 10 W-Q3-TAX-WAGE PIC S9(11)V99 COMP-3. DTSBU424 00138 10 W-Q4-TOT-WAGE PIC S9(11)V99 COMP-3. DTSBU424 00139 10 W-Q4-TAX-WAGE PIC S9(11)V99 COMP-3. DTSBU424 00140 DTSBU424 00141 05 AMT-DISP1 PIC ----------9.99. DTSBU424 00142 05 AMT-DISP2 PIC ----------9.99. DTSBU424 00143 05 AMT-DISP3 PIC ----------9.99. DTSBU424 00144 05 AMT-DISP4 PIC ----------9.99. DTSBU424 00145 05 AMT-DISP5 PIC ----------9.99. DTSBU424 00146 05 AMT-DISP6 PIC ----------9.99. DTSBU424 00147 05 AMT-DISP7 PIC --,---,---,--9.99. DTSBU424 00148 DTSBU424 00149 01 L931-LINK-AREA. DTSBU424 00150 ++INCLUDE DTSIL931 DTSBU424 00151 SKIP3 DTSBU424 00152 01 FSKL-REC. DTSBU424 00153 ++INCLUDE DTSIFSKL DTSBU424 00154 SKIP3 DTSBU424 00155 01 FCYR-REC. DTSBU424 00156 ++INCLUDE DTSIFCYR DTSBU424 00157 DTSBU424 00158 01 L983-LINK-AREA. DTSBU424 00159 ++INCLUDE DTSIL983 DTSBU424 00160 DTSBU424 00161 01 WSKL-REC. DTSBU424 00162 ++INCLUDE DTSIWSKL DTSBU424 00163 DTSBU424 00164 01 W001-REC. DTSBU424 00165 ++INCLUDE DTSIW001 DTSBU424 00166 DTSBU424 00167 01 L981-LINK-AREA. DTSBU424 00168 ++INCLUDE DTSIL981 DTSBU424 00169 DTSBU424 00170 01 WWGH-REC. DTSBU424 00171 ++INCLUDE DTSIWWGH DTSBU424 00172 DTSBU424 00173 01 L004-LINK-AREA. DTSBU424 00174 ++INCLUDE DTSIL004 DTSBU424 00175 DTSBU424 00176 01 L005-LINK-AREA. DTSBU424 00177 ++INCLUDE DTSIL005 DTSBU424 00178 DTSBU424 00179 01 L423-LINK-AREA. DTSBU424 00180 ++INCLUDE DTSIL423 DTSBU424 00181 DTSBU424 00182 LINKAGE SECTION. DTSBU424 00183 DTSBU424 00184 01 L424-LINK-AREA. DTSBU424 00185 ++INCLUDE DTSIL424 DTSBU424 00186 DTSBU424 00187 PROCEDURE DIVISION USING L424-LINK-AREA. DTSBU424 00188 DTSBU424 00189 EVALUATE TRUE DTSBU424 00190 WHEN L424-CMND-CHK-WG-88 DTSBU424 00191 PERFORM P1000-CHK-WAGE THRU P1000-EXIT DTSBU424 00192 WHEN L424-CMND-PROCESS-88 DTSBU424 00193 PERFORM P2000-PROCESS THRU P2000-EXIT DTSBU424 00194 WHEN OTHER DTSBU424 00195 DISPLAY 'DTSBU424 - INVALID COMMAND ' L424-CMND DTSBU424 00196 PERFORM S999-ABEND THRU S999-EXIT DTSBU424 00197 END-EVALUATE. DTSBU424 00198 DTSBU424 00199 GOBACK. DTSBU424 00200 DTSBU424 00201 P1000-CHK-WAGE. DTSBU424 00202 SET L424-WGH-WAGES-NO-88 TO TRUE. DTSBU424 00203 SET L424-WTC-WAGES-NO-88 TO TRUE. DTSBU424 00204 MOVE +0 TO L424-TOTAL-WAGES DTSBU424 00205 L424-TAX-WAGES DTSBU424 00206 DTSBU424 00207 PERFORM P1100-CHK-WGH THRU P1100-EXIT. DTSBU424 00208 PERFORM P1200-CHK-WTC THRU P1200-EXIT. DTSBU424 00209 DTSBU424 00210 P1000-EXIT. DTSBU424 00211 EXIT. DTSBU424 00212 DTSBU424 00213 P1100-CHK-WGH. DTSBU424 00214 MOVE LOW-VALUE TO WWGH-REC. DTSBU424 00215 MOVE L424-EMP-NO TO WWGH-EMP-NO. DTSBU424 00216 MOVE L424-YRQ TO WWGH-YRQ DTSBU424 00217 DTSBU424 00218 PERFORM S981A-START-BROWSE THRU S981A-EXIT. DTSBU424 00219 IF L981-OK-88 DTSBU424 00220 SET L424-WGH-WAGES-YES-88 TO TRUE DTSBU424 00221 END-IF. DTSBU424 00222 DTSBU424 00223 P1100-EXIT. DTSBU424 00224 EXIT. DTSBU424 00225 DTSBU424 00226 P1200-CHK-WTC. DTSBU424 00227 MOVE L424-BATCH-NO TO WSKL-BATCH-NO. DTSBU424 00228 MOVE L424-ITEM-NO TO WSKL-ITEM-NO. DTSBU424 00229 PERFORM S983-START-BROWSE THRU S983-EXIT. DTSBU424 00230 IF L983-OK-88 DTSBU424 00231 AND WSKL-BATCH-NO = L424-BATCH-NO DTSBU424 00232 AND WSKL-ITEM-NO = L424-ITEM-NO DTSBU424 00233 SET L424-WTC-WAGES-YES-88 TO TRUE DTSBU424 00234 END-IF. DTSBU424 00235 DTSBU424 00236 P1200-EXIT. DTSBU424 00237 EXIT. DTSBU424 00238 DTSBU424 00239 P2000-PROCESS. DTSBU424 00240 DISPLAY 'BU424 P2000 ' L424-EMP-NO ' ' L424-BATCH-NO DTSBU424 00241 ' ' L424-ITEM-NO ' ' L424-YRQ. DTSBU424 00242 DTSBU424 00243 MOVE +0 TO L424-TOTAL-WAGES DTSBU424 00244 L424-TAX-WAGES DTSBU424 00245 WRK-TOT-WAGE DTSBU424 00246 WRK-AMEND-TOT-WAGE DTSBU424 00247 WRK-TAX-WAGE. DTSBU424 00248 DTSBU424 00249 MOVE LOW-VALUE TO WSKL-REC. DTSBU424 00250 MOVE L424-BATCH-NO TO WSKL-BATCH-NO. DTSBU424 00251 MOVE L424-ITEM-NO TO WSKL-ITEM-NO. DTSBU424 00252 PERFORM S983-START-BROWSE THRU S983-EXIT. DTSBU424 00253 IF L983-NO-REC-88 DTSBU424 00254 OR WSKL-BATCH-NO NOT = L424-BATCH-NO DTSBU424 00255 OR WSKL-ITEM-NO NOT = L424-ITEM-NO DTSBU424 00256 SET L424-WTC-NOT-FOUND-88 TO TRUE DTSBU424 00257 GO TO P2000-EXIT DTSBU424 00258 END-IF. DTSBU424 00259 DTSBU424 00260 PERFORM DTSBU424 00261 UNTIL L983-NO-REC-88 DTSBU424 00262 OR WSKL-BATCH-NO NOT = L424-BATCH-NO DTSBU424 00263 OR WSKL-ITEM-NO NOT = L424-ITEM-NO DTSBU424 00264 MOVE WSKL-REC TO W001-REC DTSBU424 00265 PERFORM P2100-GET-WAGES THRU P2100-EXIT DTSBU424 00266 ** PERFORM P2200-CALC-TAX-WAGE THRU P2200-EXIT DTSBU424 00267 PERFORM S983-READ-NEXT THRU S983-EXIT DTSBU424 00268 END-PERFORM. DTSBU424 00269 DTSBU424 00270 DTSBU424 00271 MOVE WRK-TOT-WAGE TO L424-TOTAL-WAGES. DTSBU424 00272 MOVE WRK-TAX-WAGE TO L424-TAX-WAGES. DTSBU424 00273 DTSBU424 00274 MOVE WRK-TAX-WAGE TO AMT-DISP1. DTSBU424 00275 DISPLAY 'WRK TAX WAGE: ' AMT-DISP1. DTSBU424 00276 MOVE WRK-TOT-WAGE TO AMT-DISP2. DTSBU424 00277 DISPLAY 'WRK TOT WAGE: ' AMT-DISP2. DTSBU424 00278 DTSBU424 00279 P2000-EXIT. DTSBU424 00280 EXIT. DTSBU424 00281 DTSBU424 00282 P2100-GET-WAGES. DTSBU424 00283 MOVE W001-WAGE-CHNG TO AMT-DISP1. DTSBU424 00284 DISPLAY 'BU424 P2100 ' W001-EMP-NO ' ' W001-BATCH-NO DTSBU424 00285 ' ' W001-ITEM-NO ' ' W001-YRQ ' ' W001-SSN DTSBU424 00286 ' ' AMT-DISP1. DTSBU424 00287 DTSBU424 00288 MOVE L424-YRQ TO WRK-SUBJ-YRQ DTSBU424 00289 L004-QTR-5-9. DTSBU424 00290 MOVE 1 TO L004-QTR-5-Q. DTSBU424 00291 PERFORM S004-FROM-5 THRU S005-EXIT. DTSBU424 00292 MOVE L004-QTR-5-9 TO WRK-CURR-YRQ. DTSBU424 00293 DTSBU424 00294 PERFORM P2110-INIT-WAGE-AREA THRU P2110-EXIT. DTSBU424 00295 DTSBU424 00296 PERFORM P2120-TAX-WAGE-BASE THRU P2120-EXIT. DTSBU424 00297 MOVE WRK-TAX-WAGE-BASE TO WRK-WAGE-BASE-REMAIN. DTSBU424 00298 DTSBU424 00299 PERFORM UNTIL WRK-CURR-YRQ > L424-YRQ DTSBU424 00300 PERFORM P2130-GET-WGH THRU P2130-EXIT DTSBU424 00301 MOVE WRK-CURR-YRQ TO L004-QTR-5-9 DTSBU424 00302 ADD 1 TO L004-QTR-5-Q DTSBU424 00303 PERFORM S004-FROM-5 THRU S005-EXIT DTSBU424 00304 MOVE L004-QTR-5-9 TO WRK-CURR-YRQ DTSBU424 00305 END-PERFORM. DTSBU424 00306 DTSBU424 00307 DTSBU424 00308 P2100-EXIT. DTSBU424 00309 EXIT. DTSBU424 00310 DTSBU424 00311 P2110-INIT-WAGE-AREA. DTSBU424 00312 MOVE +0 TO W-Q1-TOT-WAGE DTSBU424 00313 W-Q1-TAX-WAGE DTSBU424 00314 W-Q2-TOT-WAGE DTSBU424 00315 W-Q2-TAX-WAGE DTSBU424 00316 W-Q3-TOT-WAGE DTSBU424 00317 W-Q3-TAX-WAGE DTSBU424 00318 W-Q4-TOT-WAGE DTSBU424 00319 W-Q4-TAX-WAGE. DTSBU424 00320 DTSBU424 00321 P2110-EXIT. DTSBU424 00322 EXIT. DTSBU424 00323 DTSBU424 00324 P2120-TAX-WAGE-BASE. DTSBU424 00325 MOVE LOW-VALUES TO FCYR-KEY-AREA. DTSBU424 00326 DTSBU424 00327 MOVE L004-QTR-5-YR TO FCYR-YR. DTSBU424 00328 SET FCYR-CYR-88 TO TRUE. DTSBU424 00329 MOVE FCYR-KEY-AREA TO FSKL-KEY-AREA. DTSBU424 00330 PERFORM S931-READ THRU S931-EXIT. DTSBU424 00331 IF L931-NO-REC-88 DTSBU424 00332 PERFORM S999-ABEND THRU S999-EXIT DTSBU424 00333 ELSE DTSBU424 00334 MOVE FSKL-REC TO FCYR-REC DTSBU424 00335 MOVE FCYR-TAXABLE-WAGE-BASE TO WRK-TAX-WAGE-BASE DTSBU424 00336 END-IF. DTSBU424 00337 DTSBU424 00338 P2120-EXIT. DTSBU424 00339 EXIT. DTSBU424 00340 DTSBU424 00341 P2130-GET-WGH. DTSBU424 00342 MOVE +0 TO WRK-EARNINGS. DTSBU424 00343 DTSBU424 00344 MOVE LOW-VALUE TO WWGH-REC. DTSBU424 00345 MOVE L424-EMP-NO TO WWGH-EMP-NO. DTSBU424 00346 MOVE WRK-CURR-YRQ TO WWGH-YRQ DTSBU424 00347 MOVE W001-SSN TO WWGH-SSN. DTSBU424 00348 DTSBU424 00349 PERFORM S981C-READ THRU S981C-EXIT. DTSBU424 00350 IF L981-OK-88 DTSBU424 00351 IF WRK-CURR-YRQ = WRK-SUBJ-YRQ DTSBU424 00352 MOVE WWGH-EARNINGS TO WRK-EARNINGS DTSBU424 00353 COMPUTE WRK-TOT-WAGE = DTSBU424 00354 (WRK-TOT-WAGE + W001-WAGE-CHNG - WWGH-EARNINGS) DTSBU424 00355 PERFORM P2132-CURR-QTR-TAX THRU P2132-EXIT DTSBU424 00356 ELSE DTSBU424 00357 MOVE WWGH-EARNINGS TO WRK-EARNINGS DTSBU424 00358 PERFORM P2131-PRIOR-QTR-TAX THRU P2131-EXIT DTSBU424 00359 END-IF DTSBU424 00360 ELSE DTSBU424 00361 IF WRK-CURR-YRQ = WRK-SUBJ-YRQ DTSBU424 00362 ADD W001-WAGE-CHNG TO WRK-TOT-WAGE DTSBU424 00363 END-IF DTSBU424 00364 END-IF. DTSBU424 00365 DTSBU424 00366 *& DTSBU424 00367 MOVE WRK-EARNINGS TO AMT-DISP1. DTSBU424 00368 MOVE WRK-TOT-WAGE TO AMT-DISP2. DTSBU424 00369 ** MOVE WRK-AMEND-TOT-WAGE TO AMT-DISP3. DTSBU424 00370 DISPLAY 'BU424 P2130 ' W001-EMP-NO ' ' W001-BATCH-NO DTSBU424 00371 ' ' W001-ITEM-NO ' ' WWGH-YRQ ' ' W001-SSN. DTSBU424 00372 DISPLAY ' NEW ' AMT-DISP1 ' SUM ' AMT-DISP2. DTSBU424 00373 * ' AMEND ' AMT-DISP3. DTSBU424 00374 *& DTSBU424 00375 DTSBU424 00376 ** MOVE WRK-CURR-YRQ TO L004-QTR-5-9 DTSBU424 00377 * EVALUATE L004-QTR-5-Q DTSBU424 00378 * WHEN 1 DTSBU424 00379 * MOVE WRK-EARNINGS TO W-Q1-TOT-WAGE DTSBU424 00380 * WHEN 2 DTSBU424 00381 * MOVE WRK-EARNINGS TO W-Q2-TOT-WAGE DTSBU424 00382 * WHEN 3 DTSBU424 00383 * MOVE WRK-EARNINGS TO W-Q3-TOT-WAGE DTSBU424 00384 * WHEN 4 DTSBU424 00385 * MOVE WRK-EARNINGS TO W-Q4-TOT-WAGE DTSBU424 00386 ** END-EVALUATE. DTSBU424 00387 DTSBU424 00388 P2130-EXIT. DTSBU424 00389 EXIT. DTSBU424 00390 DTSBU424 00391 P2131-PRIOR-QTR-TAX. DTSBU424 00392 IF WRK-EARNINGS > WRK-WAGE-BASE-REMAIN DTSBU424 00393 ** ADD WRK-WAGE-BASE-REMAIN TO WRK-PRIOR-TAX-WAGE DTSBU424 00394 MOVE ZERO TO WRK-WAGE-BASE-REMAIN DTSBU424 00395 ELSE DTSBU424 00396 ** MOVE WRK-EARNINGS TO WRK-PRIOR-TAX-WAGE DTSBU424 00397 SUBTRACT WRK-EARNINGS FROM WRK-WAGE-BASE-REMAIN DTSBU424 00398 END-IF. DTSBU424 00399 DTSBU424 00400 *& DTSBU424 00401 MOVE WRK-EARNINGS TO AMT-DISP1. DTSBU424 00402 MOVE WRK-WAGE-BASE-REMAIN TO AMT-DISP2. DTSBU424 00403 ** MOVE WRK-PRIOR-TAX-WAGE TO AMT-DISP3. DTSBU424 00404 DISPLAY 'BU424 P2131 ' W001-EMP-NO ' ' WRK-CURR-YRQ DTSBU424 00405 ' ' W001-SSN. DTSBU424 00406 DISPLAY ' NEW ' AMT-DISP1 ' BASE ' AMT-DISP2. DTSBU424 00407 *& DTSBU424 00408 P2131-EXIT. DTSBU424 00409 EXIT. DTSBU424 00410 DTSBU424 00411 P2132-CURR-QTR-TAX. DTSBU424 00412 *& DTSBU424 00413 MOVE WRK-WAGE-BASE-REMAIN TO AMT-DISP2. DTSBU424 00414 DISPLAY 'BU424 P2132 1: ' W001-EMP-NO ' ' WRK-CURR-YRQ DTSBU424 00415 ' ' W001-SSN ' REM ' AMT-DISP2. DTSBU424 00416 DTSBU424 00417 IF WRK-EARNINGS > WRK-WAGE-BASE-REMAIN DTSBU424 00418 MOVE WRK-WAGE-BASE-REMAIN TO WRK-TAX-WAGE-OLD DTSBU424 00419 ELSE DTSBU424 00420 MOVE WRK-EARNINGS TO WRK-TAX-WAGE-OLD DTSBU424 00421 END-IF. DTSBU424 00422 DTSBU424 00423 IF W001-WAGE-CHNG > WRK-WAGE-BASE-REMAIN DTSBU424 00424 MOVE WRK-WAGE-BASE-REMAIN TO WRK-TAX-WAGE-NEW DTSBU424 00425 ELSE DTSBU424 00426 MOVE W001-WAGE-CHNG TO WRK-TAX-WAGE-NEW DTSBU424 00427 END-IF. DTSBU424 00428 DTSBU424 00429 DTSBU424 00430 COMPUTE W-DIFF = (WRK-TAX-WAGE-NEW - WRK-TAX-WAGE-OLD). DTSBU424 00431 ADD W-DIFF TO WRK-TAX-WAGE. DTSBU424 00432 DTSBU424 00433 *& DTSBU424 00434 MOVE WRK-EARNINGS TO AMT-DISP1. DTSBU424 00435 MOVE WRK-WAGE-BASE-REMAIN TO AMT-DISP2. DTSBU424 00436 MOVE W001-WAGE-CHNG TO AMT-DISP3. DTSBU424 00437 MOVE WRK-TAX-WAGE-OLD TO AMT-DISP4. DTSBU424 00438 MOVE WRK-TAX-WAGE-NEW TO AMT-DISP5. DTSBU424 00439 MOVE WRK-TAX-WAGE TO AMT-DISP6. DTSBU424 00440 DISPLAY 'BU424 P2132 ' W001-EMP-NO ' ' WRK-CURR-YRQ DTSBU424 00441 ' ' W001-SSN ' REM ' AMT-DISP2. DTSBU424 00442 DISPLAY ' WGH ' AMT-DISP1 ' W001 ' AMT-DISP3 DTSBU424 00443 ' OLD ' AMT-DISP4 ' NEW ' AMT-DISP5 DTSBU424 00444 ' TAX ' AMT-DISP6. DTSBU424 00445 *& DTSBU424 00446 P2132-EXIT. DTSBU424 00447 EXIT. DTSBU424 00448 DTSBU424 00449 P2200-CALC-TAX-WAGE. DTSBU424 00450 MOVE WRK-TAX-WAGE-BASE TO WRK-WAGE-BASE-REMAIN. DTSBU424 00451 DTSBU424 00452 IF W-Q1-TOT-WAGE > WRK-WAGE-BASE-REMAIN DTSBU424 00453 MOVE WRK-WAGE-BASE-REMAIN TO W-Q1-TAX-WAGE DTSBU424 00454 MOVE ZERO TO WRK-WAGE-BASE-REMAIN DTSBU424 00455 ELSE DTSBU424 00456 MOVE W-Q1-TOT-WAGE TO W-Q1-TAX-WAGE DTSBU424 00457 SUBTRACT W-Q1-TOT-WAGE FROM WRK-WAGE-BASE-REMAIN. DTSBU424 00458 DTSBU424 00459 IF W-Q2-TOT-WAGE > WRK-WAGE-BASE-REMAIN DTSBU424 00460 MOVE WRK-WAGE-BASE-REMAIN TO W-Q2-TAX-WAGE DTSBU424 00461 MOVE ZERO TO WRK-WAGE-BASE-REMAIN DTSBU424 00462 ELSE DTSBU424 00463 MOVE W-Q2-TOT-WAGE TO W-Q2-TAX-WAGE DTSBU424 00464 SUBTRACT W-Q2-TOT-WAGE FROM WRK-WAGE-BASE-REMAIN. DTSBU424 00465 DTSBU424 00466 IF W-Q3-TOT-WAGE > WRK-WAGE-BASE-REMAIN DTSBU424 00467 MOVE WRK-WAGE-BASE-REMAIN TO W-Q3-TAX-WAGE DTSBU424 00468 MOVE ZERO TO WRK-WAGE-BASE-REMAIN DTSBU424 00469 ELSE DTSBU424 00470 MOVE W-Q3-TOT-WAGE TO W-Q3-TAX-WAGE DTSBU424 00471 SUBTRACT W-Q3-TOT-WAGE FROM WRK-WAGE-BASE-REMAIN. DTSBU424 00472 DTSBU424 00473 IF W-Q4-TOT-WAGE > WRK-WAGE-BASE-REMAIN DTSBU424 00474 MOVE WRK-WAGE-BASE-REMAIN TO W-Q4-TAX-WAGE DTSBU424 00475 MOVE ZERO TO WRK-WAGE-BASE-REMAIN DTSBU424 00476 ELSE DTSBU424 00477 MOVE W-Q4-TOT-WAGE TO W-Q4-TAX-WAGE DTSBU424 00478 SUBTRACT W-Q4-TOT-WAGE FROM WRK-WAGE-BASE-REMAIN. DTSBU424 00479 DTSBU424 00480 DTSBU424 00481 MOVE WRK-SUBJ-YRQ TO L004-QTR-5-9 DTSBU424 00482 EVALUATE L004-QTR-5-Q DTSBU424 00483 WHEN 1 DTSBU424 00484 ADD W-Q1-TAX-WAGE TO WRK-TAX-WAGE DTSBU424 00485 WHEN 2 DTSBU424 00486 ADD W-Q2-TAX-WAGE TO WRK-TAX-WAGE DTSBU424 00487 WHEN 3 DTSBU424 00488 ADD W-Q3-TAX-WAGE TO WRK-TAX-WAGE DTSBU424 00489 WHEN 4 DTSBU424 00490 ADD W-Q4-TAX-WAGE TO WRK-TAX-WAGE DTSBU424 00491 END-EVALUATE. DTSBU424 00492 DTSBU424 00493 MOVE WRK-TAX-WAGE TO AMT-DISP1. DTSBU424 00494 DISPLAY 'P2200 TAX WAGE: ' AMT-DISP1. DTSBU424 00495 P2200-EXIT. DTSBU424 00496 EXIT. DTSBU424 00497 DTSBU424 00498 DTSBU424 00499 S004-FROM-5. DTSBU424 00500 SET L004-FROM-5 TO TRUE. DTSBU424 00501 GO TO S004-YRQ. DTSBU424 00502 DTSBU424 00503 S004-FROM-DATE. DTSBU424 00504 SET L004-FROM-DATE TO TRUE. DTSBU424 00505 GO TO S004-YRQ. DTSBU424 00506 DTSBU424 00507 S004-FROM-ABS. DTSBU424 00508 SET L004-FROM-ABS TO TRUE. DTSBU424 00509 GO TO S004-YRQ. DTSBU424 00510 DTSBU424 00511 S004-YRQ. DTSBU424 00512 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBU424 00513 DTSBU424 00514 S004-EXIT. DTSBU424 00515 EXIT. DTSBU424 00516 DTSBU424 00517 S005-FROM-SYS. DTSBU424 00518 SET L005-FROM-SYS TO TRUE. DTSBU424 00519 GO S005-ABSTIME. DTSBU424 00520 DTSBU424 00521 S005-FROM-ABS. DTSBU424 00522 SET L005-FROM-ABSTIME TO TRUE. DTSBU424 00523 GO S005-ABSTIME. DTSBU424 00524 DTSBU424 00525 S005-ABSTIME. DTSBU424 00526 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBU424 00527 DTSBU424 00528 S005-EXIT. DTSBU424 00529 EXIT. DTSBU424 00530 DTSBU424 00531 S423-CALC-TAX-WAGES. DTSBU424 00532 CALL 'DTSBU423' USING L423-LINK-AREA. DTSBU424 00533 DTSBU424 00534 S423-EXIT. DTSBU424 00535 EXIT. DTSBU424 00536 DTSBU424 00537 S931-READ. DTSBU424 00538 SET L931-READ-88 TO TRUE. DTSBU424 00539 GO TO S931-REF-I. DTSBU424 00540 DTSBU424 00541 S931-REF-I. DTSBU424 00542 CALL 'DTSBU931' USING L931-LINK-AREA DTSBU424 00543 FSKL-REC. DTSBU424 00544 S931-EXIT. DTSBU424 00545 EXIT. DTSBU424 00546 DTSBU424 00547 S983-START-BROWSE. DTSBU424 00548 SET L983-START-BROWSE-88 TO TRUE. DTSBU424 00549 GO TO S983-WAGE-I. DTSBU424 00550 DTSBU424 00551 S983-READ-NEXT. DTSBU424 00552 SET L983-READ-NEXT-88 TO TRUE. DTSBU424 00553 GO TO S983-WAGE-I. DTSBU424 00554 DTSBU424 00555 S983-DELETE. DTSBU424 00556 SET L983-DELETE-88 TO TRUE. DTSBU424 00557 GO TO S983-WAGE-I. DTSBU424 00558 DTSBU424 00559 S983-WAGE-I. DTSBU424 00560 CALL 'DTSBU983' USING L983-LINK-AREA DTSBU424 00561 WSKL-REC. DTSBU424 00562 S983-EXIT. DTSBU424 00563 EXIT. DTSBU424 00564 DTSBU424 00565 S981A-START-BROWSE. DTSBU424 00566 SET L981-START-BROWSE-88 TO TRUE. DTSBU424 00567 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. DTSBU424 00568 DTSBU424 00569 S981A-EXIT. DTSBU424 00570 EXIT. DTSBU424 00571 DTSBU424 00572 S981B-READ-NEXT. DTSBU424 00573 SET L981-READ-NEXT-88 TO TRUE. DTSBU424 00574 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. DTSBU424 00575 DTSBU424 00576 S981B-EXIT. DTSBU424 00577 EXIT. DTSBU424 00578 DTSBU424 00579 S981C-READ. DTSBU424 00580 SET L981-READ-88 TO TRUE. DTSBU424 00581 PERFORM S981Z-WWGH-IO THRU S981Z-EXIT. DTSBU424 00582 DTSBU424 00583 S981C-EXIT. DTSBU424 00584 EXIT. DTSBU424 00585 DTSBU424 00586 S981Z-WWGH-IO. DTSBU424 00587 CALL 'DTSBU981' USING L981-LINK-AREA DTSBU424 00588 WWGH-REC. DTSBU424 00589 S981Z-EXIT. DTSBU424 00590 EXIT. DTSBU424 00591 DTSBU424 00592 S999-ABEND. DTSBU424 00593 DISPLAY '*** BU424 MODULE ABENDING'. DTSBU424 00594 DTSBU424 00595 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBU424 00596 S999-EXIT. DTSBU424 00597 EXIT. DTSBU424