Files
DUTAS/Batch/DTSBU424.cob
2025-07-21 11:20:11 -04:00

599 lines
47 KiB
COBOL

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