00001 IDENTIFICATION DIVISION. 05/30/13 00002 PROGRAM-ID. DTSBD374. DTSBD374 00003 AUTHOR. TRW. LV069 00004 DATE-WRITTEN. JANUARY 2002. DTSBD374 00005 DATE-COMPILED. DTSBD374 00006 SKIP3 DTSBD374 00007 ***** DTSBD374 00008 * DTSBD374 00009 * >>> NEW VERSION: CALL BD371 <<< DTSBD374 00010 * DTSBD374 00011 * FUNCTION: ANNUAL REPORT TRANSACTION PROCESSING. DTSBD374 00012 * DTSBD374 00013 * DTSBD374 00014 * MODIFICATION LOG: DTSBD374 00015 * DTSBD374 00016 * 01/29/2002 INITIAL DEVELOPMENT. DTSBD374 00017 * WORK ORDER: HOUSEHOLD PROGRAMMER: GD DTSBD374 00018 * DTSBD374 00019 * 03/31/2003 MODIFIED P0400 - DO NOT CHECK FOR DIFFERENCE DTSBD374 00020 * BETWEEN REPORTED TAX WAGE AND SUM OF TAX WAGE DTSBD374 00021 * AMOUNTS FOR EACH EMPLOYEE WHEN REPORT IS DTSBD374 00022 * WITHDRAWN. DTSBD374 00023 * BYPASS P0411-ADJUST-TAX IF TAX WAGE SUM = 0 DTSBD374 00024 * (POTENTIAL DIVISION BY ZERO ERROR). DTSBD374 00025 * WORK ORDER: HOUSEHOLD PROGRAMMER: GD DTSBD374 00026 * DTSBD374 00027 * 11/18/2003 MODIFIED P0300 - BYPASS IF RPT TYPE = WITHDRAWN DTSBD374 00028 * MODIFIED P1300 - BYPASS TEST: DTSBD374 00029 * (IF NOT MQTR-CURR-RCVD-88 ...) DTSBD374 00030 * WHEN QUARTER IS NOT LIABLE. DTSBD374 00031 * WORK ORDER: HOUSEHOLD PROGRAMMER: GD DTSBD374 00032 * DTSBD374 00033 * 12/16/2003 MODIFIED EDIT PARAGRAPHS TO BYPASS QUARTERS IN DTSBD374 00034 * WHICH THE EMPLOYER IS NOT LIABLE: DTSBD374 00035 * P1100, P1200, P1400. DTSBD374 00036 * WORK ORDER: HOUSEHOLD PROGRAMMER: GD DTSBD374 00037 * DTSBD374 00038 * 12/17/2003 CORRECTED P2520 (MISSING EMPLOYEE COUNT DTSBD374 00039 * LETTER) - CODE NOT CHANGED FROM DTSBD371. DTSBD374 00040 * WORK ORDER: HOUSEHOLD PROGRAMMER: GD DTSBD374 00041 * DTSBD374 00042 * 02/23/2004 CORRECTED TIMING FOR READ OF MQTR RECORDS. DTSBD374 00043 * THE PROGRAM WAS READING ALL 4 QUARTERS AT THE DTSBD374 00044 * START OF PROCESSING FOR EACH EMPLOYER. THIS DTSBD374 00045 * RESULTED IN ERRORS DURING ADJUSTMENT PROCESSING DTSBD374 00046 * BECAUSE CALLED PROGRAMS (DTSBU520, DTSBU521) DTSBD374 00047 * MODIFY MQTR RECORDS. THE READ FOR EACH QUARTER DTSBD374 00048 * HAS BEEN MOVED TO P0000 (IT IS PERFORMED IN DTSBD374 00049 * P0220). DTSBD374 00050 * WORK ORDER: PRODUCTION PROBLEM PROGRAMMER: GD DTSBD374 00051 * DTSBD374 00052 * 03/19/2004 ADDED REFERENCE TO L102-ELECTRONIC-RPT AND DTSBD374 00053 * L420-ABSTIME - BOTH USED IN ELECTRONIC DTSBD374 00054 * REPORTING PROCESS. DTSBD374 00055 * WORK ORDER: EFT PROGRAMMER: GD DTSBD374 00056 * DTSBD374 00057 * 03/22/2004 CORRECTED PROBLEM WITH EMPLOYEE COUNTS. THE FIELDDTSBD374 00058 * IN THE AATX RECORD IS SHORTER THAN THE FIELD IN DTSBD374 00059 * THE MQTR. WHEN AATX-JAN-NO-ENTRY-88 IS SET TO DTSBD374 00060 * TRUE AND THEN MOVED TO THE MQTR RECORD, THE MQTR DTSBD374 00061 * SEES THE VALUE (99,999) AS AN ACTUAL COUNT, AND DTSBD374 00062 * NOT AS A SPECIAL VALUE INDICATING "NO COUNT DTSBD374 00063 * ENTERED." MODIFIED CODE IN P2520. DTSBD374 00064 * WORK ORDER: ES-202 PROGRAMMER: GD DTSBD374 00065 * DTSBD374 00066 * 04/06/2004 CORRECTED PROBLEM WITH P1300 EDITS. IF CURRENT DTSBD374 00067 * REPORT TYPE IS 'NOT DUE,' DO NOT EDIT CURRENT DTSBD374 00068 * REPORT TYPE AGAINST AATX REPORT TYPE. DTSBD374 00069 * WORK ORDER: EFT PROGRAMMER: GD DTSBD374 00070 * DTSBD374 00071 * 04/08/2004 ADDED CODE IN P0210 TO ENFORCE GRACE PERIOD. DTSBD374 00072 * WORK ORDER: PROGRAMMER: GD DTSBD374 00073 * DTSBD374 00074 * 05/21/2004 MOVED P1000 EDITS TO ENSURE ALL QUARTERS PASS DTSBD374 00075 * ALL EDITS BEFORE BEGINNING TO UPDATE QUARTER. DTSBD374 00076 * MOVED TEST FOR YRQ < FIRST ANNUAL YRQ AND DTSBD374 00077 * TEST FOR DUPLICATE TRANSACTION FROM DTSBD374 00078 * P1000 (EXECUTED FOR EACH QUARTER) TO P0100 DTSBD374 00079 * (EXECUTED ONE TIME). DTSBD374 00080 * WORK ORDER: PROGRAMMER: GD DTSBD374 00081 * DTSBD374 00082 * 06/22/2004 MODIFIED P2820. BECAUSE WRK-LAST-LIAB-YRQ IS DTSBD374 00083 * ALWAYS ZERO WHEN PROCESSING A WD TRANSACTION, DTSBD374 00084 * CODE IN P2800 TO DECREMENT PAYMENTS AND WAIVERS DTSBD374 00085 * WAS NOT EXECUTED. COPIED THIS CODE TO P2820. DTSBD374 00086 * WORK ORDER: PRODUCTION PROBLEM PROGRAMMER: GD DTSBD374 00087 * DTSBD374 00088 * 07/22/2004 REMOVED CALL THE P0411 TO ADJUST TAX WAGES. DTSBD374 00089 * TOTAL TAXABLE WAGES MUST ALWAYS EQUAL THE DTSBD374 00090 * AMOUNT CALCULATED FROM THE WAGE ITEMS. DTSBD374 00091 * WORK ORDER: PROGRAMMER: GD DTSBD374 00092 * DTSBD374 00093 * 01/25/2005 INITIALIZE NEW FILED (APAY-NSF-MNTE-ABSTIME). DTSBD374 00094 * WORK ORDER: RETURNED CHECK PROGRAMMER: ZL1 DTSBD374 00095 * DTSBD374 00096 * 04/25/2005 MODIFIED FOR NEW PENALTY PROCESS. DTSBD374 00097 * WORK ORDER: DIR 107 PROGRAMMER: GD DTSBD374 00098 * DTSBD374 00099 * 10/07/2005 MODIFIED P3000 TO INITIALIZE MRPT-WAGE-RPT-IND DTSBD374 00100 * AND MRPT-STATUS-CHNG-IND. DTSBD374 00101 * WORK ORDER: PROGRAMMER: GD DTSBD374 00102 * DTSBD374 00103 * 03/07/2006 PENALTY AND INTEREST CALCULATIONS MODIFIED DTSBD374 00104 * TO EXCLUDE SUR-TAX: P2031A, P2840. DTSBD374 00105 * MODIFIED FOR NEW VERSION OF BU109. DTSBD374 00106 * REFERENCE: ADMIN ASSESS PROGRAMMER: GD DTSBD374 00107 * DTSBD374 00108 * 04/06/2006 MODIFIED P1900 TO CORRECT FOR ERRORS RESULTING DTSBD374 00109 * FROM THE DIFFERENCE BETWEEN WAGE AMOUNTS ON THE DTSBD374 00110 * WAGE FILE (WITH THE PENNIES REMOVED) AND WAGE DTSBD374 00111 * ON THE TAX REPORT (INCLUDING PENNIES). THE DTSBD374 00112 * DIFFERENCE BETWEEN THESE VALUES CAUSED DTSBD374 00113 * TRANSACTIONS TO FAIL WHEN THE CALCULATION DTSBD374 00114 * PRODUCED NEGATIVE NUMBERS. DTSBD374 00115 * REFERENCE: PROGRAMMER: GD DTSBD374 00116 * DTSBD374 00117 * 06/13/2007 MODIFIED P0000 TO PASS MPRF-EMP-NO TO BU420. DTSBD374 00118 * REFERENCE: PROGRAMMER: GD DTSBD374 00119 * DTSBD374 00120 * 09/10/2007 MODIFIED P2830 TO PASS LBCM-CURR-RUN-DATE TO DTSBD374 00121 * NEW FIELD L102-CURR-RUN-DATE DTSBD374 00122 * REFERENCE: PROGRAMMER: ZL1 DTSBD374 00123 * DTSBD374 00124 * 02/06/2008 MODIFIED FOR STATUS CHANGE INDICATOR (P3000). DTSBD374 00125 * REFERENCE: PROGRAMMER: GD DTSBD374 00126 * DTSBD374 00127 *& >>> THE FOLLOWING COMMENTED OUT UNTIL READY FOR TESTING DTSBD374 00128 *& >>> OF NEW PENALTY AND INTEREST RULE. DTSBD374 00129 *& >>> CHANGES MARKED WITH *& IN I0000 AND P2840. DTSBD374 00130 * 02/11/2008 MODIFIED FOR NEW PENALTY AND INTEREST RULE. DTSBD374 00131 * ADMIN ASSESSMENT IS INCLUDED IN THE DTSBD374 00132 * CALCULATION FOR QUARTERS >= 2008/1. DTSBD374 00133 * A CALL TO DTSBU109 RETURNS THE START QUARTER. DTSBD374 00134 * REFERENCE: PROGRAMMER: GD DTSBD374 00135 * DTSBD374 00136 * 06/22/2009 CORRECTED PROBLEM WITH PURSUED REPORT COUNT. DTSBD374 00137 * THE COUNT WAS CORRECTED ANNUAL REPORT BY DTSBD374 00138 * ANNUAL REPORT, SUBTRACTING 1 FOR EACH DTSBD374 00139 * REPORT PROCESSED, OR ADDING 1 FOR EACH DTSBD374 00140 * NEWLY LIABLE REPORT. DTSBD374 00141 * THIS PROCESS DOES NOT WORK WHEN QUARTERS DTSBD374 00142 * ARE CHANGED FROM QUARTERLY TO ANNUAL. DTSBD374 00143 * THE NEW PROCESS READS ALL QUARTERS, AND DTSBD374 00144 * RESETS THE MPRF COUNT BASED ON THE ACTUAL DTSBD374 00145 * SETTINGS OF THE PURSUED REPORT INDICATORS. DTSBD374 00146 * REFERENCE: PROGRAMMER: GD DTSBD374 00147 * DTSBD374 00148 * 07/13/2010 CORRECTED PROBLEM WITH QUARTER STATUS FOR DTSBD374 00149 * WITHDRAWN REPORTS. PROGRAM WAS USING THE DTSBD374 00150 * WRONG DATE FOR THE LAST DELINQUENT YEAR DTSBD374 00151 * IN P2210. DTSBD374 00152 * CORRECTED ERROR WITH PURSUED REPORT COUNT IN DTSBD374 00153 * P0900 - ADDED CODE FOR ANNUAL REPORTS. DTSBD374 00154 * REMOVED CODE IN P2610 TO ADJUST ROUNDING OF DTSBD374 00155 * OF UI TAX AND ADMIN ASSESSMENT. THE DTSBD374 00156 * CORRESPONDING CODE IN DTSBD371 WAS REMOVED DTSBD374 00157 * IN 2007. DTSBD374 00158 * REFERENCE: PROGRAMMER: GD DTSBD374 00159 * DTSBD374 00160 * 11/15/2011 MODIFIED FOR NEW VERSION OF L420 LINKAGE. DTSBD374 00161 * REFERENCE: PROGRAMMER: GD DTSBD374 00162 * DTSBD374 00163 * 03/02/2012 ADDED QUARTER TO L420 LINKAGE. CODE THAT CALLS DTSBD374 00164 * DTSBU420 HAS BEEN MODIFIED TO PASS THE QUARTER. DTSBD374 00165 * REFERENCE: PROGRAMMER: GD DTSBD374 00166 * DTSBD374 00167 * 11/29/2012 MODIFED THE CALL TO BU420 IN P0000. IT WILL SET DTSBD374 00168 * THE QUARTER IN THE L420 LINKAGE. THIS ENSURES DTSBD374 00169 * THAT ANY CHANGE TO THE YEAR IS PASSED TO THE DTSBD374 00170 * WAGES. DTSBD374 00171 * REFERENCE: PROGRAMMER: GD DTSBD374 00172 * DTSBD374 00173 * DTSBD374 00174 * 03/22/2013 MODIFED TO INCLUDE SUR TAX FOR TIMELY PAYMENTS DTSBD374 00175 * REFERENCE: PROGRAMMER: ZL1 DTSBD374 00176 * DTSBD374 00177 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD374 00178 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD374 00179 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBD374 00180 * DTSBD374 00181 * DTSBD374 00182 * DESCRIPTION: DTSBD374 00183 * DTSBD374 00184 * PROCESSES ANNUAL ACCOUNTING REPORT TRANSACTIONS. DTSBD374 00185 * DTSBD374 00186 * DTSBD374 00187 * MASTER FILE RECORDS READ: DTSBD374 00188 * DTSBD374 00189 * MQTR DTSBD374 00190 * MRPT DTSBD374 00191 * MPAY DTSBD374 00192 * MTCK DTSBD374 00193 * DTSBD374 00194 * DTSBD374 00195 * MASTER FILE RECORDS UPDATED: DTSBD374 00196 * DTSBD374 00197 * MQTR (WRITE, REWRITE) DTSBD374 00198 * MRPT (WRITE) DTSBD374 00199 * DTSBD374 00200 * DTSBD374 00201 * REPORT RECORDS WRITTEN: DTSBD374 00202 * DTSBD374 00203 * R726 MISSING EMPLOYEE COUNT LETTER. DTSBD374 00204 * R907 ERROR. DTSBD374 00205 * DTSBD374 00206 * DTSBD374 00207 * MODULES CALLED: DTSBD374 00208 * DTSBD374 00209 * DTSBD372 PAYMENT TRANSACTION PROCESSING. DTSBD374 00210 * DTSBU001 DATE EDIT/CONVERSION. DTSBD374 00211 * DTSBU101 COMPUTE INTEREST CHARGED. DTSBD374 00212 * DTSBU102 COMPUTE LATE PAYMENT PENALTY CHARGED. DTSBD374 00213 * DTSBU511 INITIALIZE A MQTR RECORD. DTSBD374 00214 * DTSBU516 DETERMINE LIABILITY, DUE DATE, AND RATE FOR A DTSBD374 00215 * GIVEN QUARTER. DTSBD374 00216 * DTSBU520 PAYMENT APPLICATION. DTSBD374 00217 * DTSBU522 RETURN A PAID AMOUNT TO UNAPPLIED CREDIT. DTSBD374 00218 * DTSBU541 MODIFY A SPECIFIED CHARGED, WAIVED, TOLERATED DTSBD374 00219 * OR WRITTEN OFF AMOUNT. DTSBD374 00220 * DTSBU549 JOURNALING/BATCH DETAIL LISTING. DTSBD374 00221 * DTSBU590 EMPLOYER CLEANUP. DTSBD374 00222 * DTSBU910 MASTER FILE I/O. DTSBD374 00223 * DTSBU946 VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 1. DTSBD374 00224 * DTSBD374 00225 * DTSBD374 00226 ***** DTSBD374 00227 SKIP3 DTSBD374 00228 ENVIRONMENT DIVISION. DTSBD374 00229 EJECT DTSBD374 00230 DATA DIVISION. DTSBD374 00231 SKIP3 DTSBD374 00232 WORKING-STORAGE SECTION. DTSBD374 002325 77 PAN-VALET PICTURE X(24) VALUE '069DTSBD374 05/30/13'. DTSBD374 00233 77 PAN-VALET PICTURE X(24) VALUE '005DTSBD374 05/29/13'. DTSBD374 00234 77 PAN-VALET PICTURE X(24) VALUE '067DTSBD374 05/20/13'. DTSBD374 00235 77 PAN-VALET PICTURE X(24) VALUE '009DTSBD374 05/15/13'. DTSBD374 00236 77 PAN-VALET PICTURE X(24) VALUE '037DTSBD374 03/27/13'. DTSBD374 00237 77 PAN-VALET PICTURE X(24) VALUE '065DTSBD374 03/12/12'. DTSBD374 00238 SKIP3 DTSBD374 00239 01 WRK-AREA. DTSBD374 00240 05 AMT1-DISP PIC Z(08)9.99-. DTSBD374 00241 05 AMT2-DISP PIC Z(08)9.99-. DTSBD374 00242 05 AMT3-DISP PIC Z(08)9.99-. DTSBD374 00243 05 AMT4-DISP PIC Z(08)9.99-. DTSBD374 00244 DTSBD374 00245 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +374.DTSBD374 00246 DTSBD374 00247 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBD374'.DTSBD374 00248 DTSBD374 00249 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBD374 00250 DTSBD374 00251 05 WRK-NULL-DOC-NO. DTSBD374 00252 10 WRK-NULL-BATCH-NO PIC S9(05) COMP-3. DTSBD374 00253 10 WRK-NULL-ITEM-NO PIC S9(03) COMP-3. DTSBD374 00254 DTSBD374 00255 05 WRK-WAGE-FIRST-TIME-IND PIC X(01). DTSBD374 00256 88 WRK-WAGE-FIRST-TIME-YES-88 VALUE 'Y'. DTSBD374 00257 88 WRK-WAGE-FIRST-TIME-NO-88 VALUE 'N'. DTSBD374 00258 DTSBD374 00259 05 WRK-PMT-FIRST-TIME-IND PIC X(01). DTSBD374 00260 88 WRK-PMT-FIRST-TIME-YES-88 VALUE 'Y'. DTSBD374 00261 88 WRK-PMT-FIRST-TIME-NO-88 VALUE 'N'. DTSBD374 00262 DTSBD374 00263 05 WRK-LBCM-TRN-RESULT-IND PIC X(01). DTSBD374 00264 05 WRK-LBCM-TRN-MSG-AREA PIC X(131). DTSBD374 00265 DTSBD374 00266 05 WRK-GRACE-PERIOD-END PIC S9(09) COMP-3. DTSBD374 00267 05 WRK-WORK-DAY-CNT PIC S9(03) COMP. DTSBD374 00268 DTSBD374 00269 05 WRK-WAGES-FOUND-IND PIC X(01). DTSBD374 00270 88 WRK-WAGES-FOUND-YES-88 VALUE 'Y'. DTSBD374 00271 88 WRK-WAGES-FOUND-NO-88 VALUE 'N'. DTSBD374 00272 DTSBD374 00273 05 WRK-UI-CHARGED-AMT PIC S9(09)V9(02) COMP-3. DTSBD374 00274 DTSBD374 00275 05 WRK-SUR-CHARGED-AMT PIC S9(09)V9(02) COMP-3. DTSBD374 00276 DTSBD374 00277 05 WRK-TAX-CHRG-DIFF-AMT PIC S9(09)V9(02) COMP-3. DTSBD374 00278 DTSBD374 00279 05 UI-TAX-RATE PIC S9(01)V9(04) COMP-3. DTSBD374 00280 05 UI-TAX-RATE-IND PIC X(01). DTSBD374 00281 88 UI-TAX-RATE-YES-88 VALUE '0'. DTSBD374 00282 88 UI-TAX-RATE-NO-88 VALUE '1'. DTSBD374 00283 88 UI-TAX-RATE-ESTIM-88 VALUE '2'. DTSBD374 00284 DTSBD374 00285 05 WRK-REMIT-AMT PIC S9(09)V99 COMP-3. DTSBD374 00286 05 WRK-TOT-CHG-AMT PIC S9(09)V99 COMP-3. DTSBD374 00287 DTSBD374 00288 05 WRK-UC30H-DEL-END-YRQ PIC S9(05) COMP-3. DTSBD374 00289 DTSBD374 00290 05 WRK-FIRST-ANN-YRQ PIC S9(05) COMP-3 DTSBD374 00291 VALUE +20021. DTSBD374 00292 DTSBD374 00293 05 WRK-LAST-LIAB-YRQ PIC S9(05) COMP-3. DTSBD374 00294 DTSBD374 00295 05 WRK-CURR-YEAR PIC 9(04) VALUE ZERO. DTSBD374 00296 DTSBD374 00297 05 WRK-TAX-WAGE-BASE PIC S9(07)V9(02) COMP-3. DTSBD374 00298 05 WRK-TAX-WAGE-REMAIN PIC S9(07)V9(02) COMP-3. DTSBD374 00299 DTSBD374 00300 05 WRK-QTR1 PIC S9(05) COMP-3. DTSBD374 00301 05 WRK-QTR1-LIABLE-IND PIC X(01). DTSBD374 00302 88 WRK-QTR1-LIABLE-88 VALUE '0'. DTSBD374 00303 88 WRK-QTR1-NOT-LIABLE-88 VALUE '1'. DTSBD374 00304 DTSBD374 00305 05 WRK-QTR2 PIC S9(05) COMP-3. DTSBD374 00306 05 WRK-QTR2-LIABLE-IND PIC X(01). DTSBD374 00307 88 WRK-QTR2-LIABLE-88 VALUE '0'. DTSBD374 00308 88 WRK-QTR2-NOT-LIABLE-88 VALUE '1'. DTSBD374 00309 DTSBD374 00310 05 WRK-QTR3 PIC S9(05) COMP-3. DTSBD374 00311 05 WRK-QTR3-LIABLE-IND PIC X(01). DTSBD374 00312 88 WRK-QTR3-LIABLE-88 VALUE '0'. DTSBD374 00313 88 WRK-QTR3-NOT-LIABLE-88 VALUE '1'. DTSBD374 00314 DTSBD374 00315 05 WRK-QTR4 PIC S9(05) COMP-3. DTSBD374 00316 05 WRK-QTR4-LIABLE-IND PIC X(01). DTSBD374 00317 88 WRK-QTR4-LIABLE-88 VALUE '0'. DTSBD374 00318 88 WRK-QTR4-NOT-LIABLE-88 VALUE '1'. DTSBD374 00319 DTSBD374 00320 05 WRK-BATCH-TABLE. DTSBD374 00321 10 WRK-BATCH-MAX PIC S9(04) COMP DTSBD374 00322 VALUE +1000. DTSBD374 00323 10 WRK-BATCH-LAST PIC S9(04) COMP. DTSBD374 00324 10 SUB PIC S9(04) COMP. DTSBD374 00325 10 SUB1 PIC S9(04) COMP. DTSBD374 00326 10 WRK-BATCH-ENTRY OCCURS 1000 TIMES. DTSBD374 00327 15 WRK-BATCH-NO PIC S9(05) COMP-3. DTSBD374 00328 15 WRK-LAST-ITEM-NO PIC S9(03) COMP-3. DTSBD374 00329 DTSBD374 00330 05 WRK-TOT-WAGE PIC S9(11)V9(02) COMP-3. DTSBD374 00331 05 WRK-TAX-WAGE PIC S9(11)V9(02) COMP-3. DTSBD374 00332 05 WRK-REMIT PIC S9(09)V9(02) COMP-3. DTSBD374 00333 DTSBD374 00334 05 WRK-SSN-QTR1-TOT-WAGE PIC S9(11)V9(02) COMP-3. DTSBD374 00335 05 WRK-SSN-QTR2-TOT-WAGE PIC S9(11)V9(02) COMP-3. DTSBD374 00336 05 WRK-SSN-QTR3-TOT-WAGE PIC S9(11)V9(02) COMP-3. DTSBD374 00337 05 WRK-SSN-QTR4-TOT-WAGE PIC S9(11)V9(02) COMP-3. DTSBD374 00338 DTSBD374 00339 05 WRK-QTR1-TOT-WAGE PIC S9(11)V9(02) COMP-3. DTSBD374 00340 05 WRK-QTR2-TOT-WAGE PIC S9(11)V9(02) COMP-3. DTSBD374 00341 05 WRK-QTR3-TOT-WAGE PIC S9(11)V9(02) COMP-3. DTSBD374 00342 05 WRK-QTR4-TOT-WAGE PIC S9(11)V9(02) COMP-3. DTSBD374 00343 DTSBD374 00344 05 WRK-QTR1-TAX-WAGE PIC S9(11)V9(02) COMP-3. DTSBD374 00345 05 WRK-QTR2-TAX-WAGE PIC S9(11)V9(02) COMP-3. DTSBD374 00346 05 WRK-QTR3-TAX-WAGE PIC S9(11)V9(02) COMP-3. DTSBD374 00347 05 WRK-QTR4-TAX-WAGE PIC S9(11)V9(02) COMP-3. DTSBD374 00348 DTSBD374 00349 05 WRK-QTR1-CURR-WAGE PIC S9(11)V9(02) COMP-3. DTSBD374 00350 05 WRK-QTR2-CURR-WAGE PIC S9(11)V9(02) COMP-3. DTSBD374 00351 05 WRK-QTR3-CURR-WAGE PIC S9(11)V9(02) COMP-3. DTSBD374 00352 05 WRK-QTR4-CURR-WAGE PIC S9(11)V9(02) COMP-3. DTSBD374 00353 DTSBD374 00354 05 WRK-QTR1-CALC-REMIT PIC S9(09)V99 COMP-3. DTSBD374 00355 05 WRK-QTR2-CALC-REMIT PIC S9(09)V99 COMP-3. DTSBD374 00356 05 WRK-QTR3-CALC-REMIT PIC S9(09)V99 COMP-3. DTSBD374 00357 05 WRK-QTR4-CALC-REMIT PIC S9(09)V99 COMP-3. DTSBD374 00358 DTSBD374 00359 05 WRK-TAX-WAGE-SUM PIC S9(11)V9(02) COMP-3. DTSBD374 00360 05 WRK-TOT-WAGE-SUM PIC S9(11)V9(02) COMP-3. DTSBD374 00361 DTSBD374 00362 05 WRK-YRQ PIC S9(05) COMP-3. DTSBD374 00363 DTSBD374 00364 05 WRK-SSN PIC S9(09) COMP-3. DTSBD374 00365 DTSBD374 00366 DTSBD374 00367 05 WRK-AMT1 PIC S9(09)V9(02) COMP-3. DTSBD374 00368 05 AMT-DISP1 PIC --,---,---,--9.99. DTSBD374 00369 05 AMT-DISP2 PIC --,---,---,--9.99. DTSBD374 00370 05 AMT-DISP3 PIC --,---,---,--9.99. DTSBD374 00371 DTSBD374 00372 05 EVL-TEXT PIC X(50). DTSBD374 00373 DTSBD374 00374 05 HOLD-LBCM-TRN-AREA PIC X(256). DTSBD374 00375 EJECT DTSBD374 00376 01 MSG-TABLE. DTSBD374 00377 05 MSG0-NOT-PASSED-FULL-EDITS. DTSBD374 00378 10 MSG0-ID PIC X(11) VALUE 'DTSBD374905'. DTSBD374 00379 10 MSG0-SHORT-TEXT PIC X(20) VALUE 'FAILED FULL EDT'. DTSBD374 00380 10 MSG0-LONG-TEXT. DTSBD374 00381 15 FILLER PIC X(30) DTSBD374 00382 VALUE 'TRANSACTION FAILED - DID NOT P'. DTSBD374 00383 15 FILLER PIC X(30) DTSBD374 00384 VALUE 'ASS FULL EDITS ON SCREEN 24 '. DTSBD374 00385 DTSBD374 00386 05 MSG1-INVALID-RPT-TYPE. DTSBD374 00387 10 MSG1-ID PIC X(11) VALUE 'DTSBD374311'. DTSBD374 00388 10 MSG1-SHORT-TEXT PIC X(20) VALUE 'INVALID RPT TY'. DTSBD374 00389 10 MSG1-LONG-TEXT. DTSBD374 00390 15 FILLER PIC X(30) DTSBD374 00391 VALUE 'TRANSACTION FAILED - REPORT TY'. DTSBD374 00392 15 FILLER PIC X(30) DTSBD374 00393 VALUE 'PE NOT VALID '. DTSBD374 00394 DTSBD374 00395 05 MSG2-INCONSISTANT-RPT-TYPE. DTSBD374 00396 10 MSG2-ID PIC X(11) VALUE 'DTSBD374312'. DTSBD374 00397 10 MSG2-SHORT-TEXT PIC X(20) VALUE 'INCONST RPT TY'. DTSBD374 00398 10 MSG2-LONG-TEXT. DTSBD374 00399 15 FILLER PIC X(30) DTSBD374 00400 VALUE 'TRANSACTION FAILED - RPT TYP N'. DTSBD374 00401 15 FILLER PIC X(30) DTSBD374 00402 VALUE 'OT CONSISTANT WITH CURR RPT TY'. DTSBD374 00403 DTSBD374 00404 05 MSG3-NOT-LIABLE. DTSBD374 00405 10 MSG3-ID PIC X(11) VALUE 'DTSBD374313'. DTSBD374 00406 10 MSG3-SHORT-TEXT PIC X(20) VALUE 'EMP NOT LIABLE'. DTSBD374 00407 10 MSG3-LONG-TEXT. DTSBD374 00408 15 FILLER PIC X(30) DTSBD374 00409 VALUE 'TRANSACTION FAILED - EMPLOYER '. DTSBD374 00410 15 FILLER PIC X(30) DTSBD374 00411 VALUE 'NOT LIABLE DURING RPT-YRQ '. DTSBD374 00412 DTSBD374 00413 05 MSG4-NO-RATE. DTSBD374 00414 10 MSG4-ID PIC X(11) VALUE 'DTSBD374314'. DTSBD374 00415 10 MSG4-SHORT-TEXT PIC X(20) VALUE 'NO RATE EXISTS'. DTSBD374 00416 10 MSG4-LONG-TEXT. DTSBD374 00417 15 FILLER PIC X(30) DTSBD374 00418 VALUE 'TRANSACTION FAILED - NO RATE E'. DTSBD374 00419 15 FILLER PIC X(30) DTSBD374 00420 VALUE 'XISTS FOR RPT-YRQ '. DTSBD374 00421 DTSBD374 00422 05 MSG5-NEGATIVE-NUMERIC. DTSBD374 00423 10 MSG5-ID PIC X(11) VALUE 'DTSBD374315'. DTSBD374 00424 10 MSG5-SHORT-TEXT PIC X(20) VALUE 'YIELDS NEGATIV'. DTSBD374 00425 10 MSG5-LONG-TEXT. DTSBD374 00426 15 FILLER PIC X(30) DTSBD374 00427 VALUE 'TRANSACTION FAILED - WOULD RES'. DTSBD374 00428 15 FILLER PIC X(30) DTSBD374 00429 VALUE 'ULT IN NEGATIVE NUMERIC FIELD '. DTSBD374 00430 DTSBD374 00431 05 MSG6-MANUAL-INT-QTR. DTSBD374 00432 10 MSG6-ID. DTSBD374 00433 15 MSG6-ID1 PIC X(08) VALUE 'DTSBD374'. DTSBD374 00434 15 MSG6-ID2 PIC X(03) VALUE '316'. DTSBD374 00435 10 MSG6-SHORT-TEXT PIC X(20) VALUE 'MANUAL INT QTR'. DTSBD374 00436 10 MSG6-LONG-TEXT. DTSBD374 00437 15 FILLER PIC X(30) DTSBD374 00438 VALUE 'QUARTERLY REPORT PROCESSED FOR'. DTSBD374 00439 15 FILLER PIC X(26) DTSBD374 00440 VALUE ' MANUAL INTEREST QUARTER: '. DTSBD374 00441 15 MSG6-YRQ PIC X(04). DTSBD374 00442 DTSBD374 00443 05 MSG7-MANUAL-PEN-QTR. DTSBD374 00444 10 MSG7-ID. DTSBD374 00445 15 MSG7-ID1 PIC X(08) VALUE 'DTSBD374'. DTSBD374 00446 15 MSG7-ID2 PIC X(03) VALUE '317'. DTSBD374 00447 10 MSG7-SHORT-TEXT PIC X(20) VALUE 'MANUAL PEN QTR'. DTSBD374 00448 10 MSG7-LONG-TEXT. DTSBD374 00449 15 FILLER PIC X(30) DTSBD374 00450 VALUE 'QUARTERLY REPORT PROCESSED FOR'. DTSBD374 00451 15 FILLER PIC X(26) DTSBD374 00452 VALUE ' MANUAL PENALTY QUARTER: '. DTSBD374 00453 15 MSG7-YRQ PIC X(04). DTSBD374 00454 DTSBD374 00455 05 MSG8-DUPLICATE-TRAN. DTSBD374 00456 10 MSG8-ID PIC X(11) VALUE 'DTSBD374307'. DTSBD374 00457 10 MSG8-SHORT-TEXT PIC X(20) VALUE 'DUPLICATE TRAN'. DTSBD374 00458 10 MSG8-LONG-TEXT. DTSBD374 00459 15 FILLER PIC X(30) DTSBD374 00460 VALUE 'TRANSACTION FAILED - DUPLICATE'. DTSBD374 00461 15 FILLER PIC X(30) DTSBD374 00462 VALUE ' TRANSACTION '. DTSBD374 00463 DTSBD374 00464 05 MSG9-ESTIM-OVERLAY. DTSBD374 00465 10 MSG9-ID. DTSBD374 00466 15 MSG9-ID1 PIC X(08) VALUE 'DTSBD374'. DTSBD374 00467 15 MSG9-ID2 PIC X(03) VALUE '318'. DTSBD374 00468 10 MSG9-SHORT-TEXT PIC X(20) VALUE 'ESTIMATED OVLY'. DTSBD374 00469 10 MSG9-LONG-TEXT. DTSBD374 00470 15 FILLER PIC X(30) DTSBD374 00471 VALUE 'ESTIMATED REPORT REPLACED BY O'. DTSBD374 00472 15 FILLER PIC X(26) DTSBD374 00473 VALUE 'RIGINAL REPORT. QUARTER: '. DTSBD374 00474 15 MSG9-YRQ PIC X(04). DTSBD374 00475 DTSBD374 00476 05 MSG10-LESS-FIRST-ANNUAL-YEAR. DTSBD374 00477 10 MSG10-ID. DTSBD374 00478 15 MSG10-ID1 PIC X(08) VALUE 'DTSBD374'. DTSBD374 00479 15 MSG10-ID2 PIC X(03) VALUE '319'. DTSBD374 00480 10 MSG10-SHORT-TEXT PIC X(20) VALUE 'YEAR < 2002 '. DTSBD374 00481 10 MSG10-LONG-TEXT. DTSBD374 00482 15 FILLER PIC X(30) DTSBD374 00483 VALUE 'TRANSACTION FAILED - YEAR < FI'. DTSBD374 00484 15 FILLER PIC X(30) DTSBD374 00485 VALUE 'RST ANNUAL YEAR (2002) '. DTSBD374 00486 DTSBD374 00487 05 MSG11-WAGES-ON-NON-LIABLE-YRQ. DTSBD374 00488 10 MSG11-ID. DTSBD374 00489 15 MSG11-ID1 PIC X(08) VALUE 'DTSBD374'. DTSBD374 00490 15 MSG11-ID2 PIC X(03) VALUE '320'. DTSBD374 00491 10 MSG11-SHORT-TEXT PIC X(20) DTSBD374 00492 VALUE 'NON-LIAB-QTR W/WAGES'. DTSBD374 00493 10 MSG11-LONG-TEXT. DTSBD374 00494 15 FILLER PIC X(30) DTSBD374 00495 VALUE 'TRANSACTION FAILED - WAGES REP'. DTSBD374 00496 15 FILLER PIC X(30) DTSBD374 00497 VALUE 'ORTED ON NON-LIABLE QTR '. DTSBD374 00498 DTSBD374 00499 05 MSG12-NOT-ANNUAL. DTSBD374 00500 10 MSG12-ID. DTSBD374 00501 15 MSG12-ID1 PIC X(08) VALUE 'DTSBD374'. DTSBD374 00502 15 MSG12-ID2 PIC X(03) VALUE '321'. DTSBD374 00503 10 MSG12-SHORT-TEXT PIC X(20) DTSBD374 00504 VALUE 'NOT AN ANNUAL FILER '. DTSBD374 00505 10 MSG12-LONG-TEXT. DTSBD374 00506 15 FILLER PIC X(30) DTSBD374 00507 VALUE 'TRANSACTION FAILED - QTR NOT F'. DTSBD374 00508 15 FILLER PIC X(30) DTSBD374 00509 VALUE 'ILED ANNUALLY '. DTSBD374 00510 EJECT DTSBD374 00511 DTSBD374 00512 05 MSG13-INVALID-CURR-WAGE. DTSBD374 00513 10 MSG13-ID. DTSBD374 00514 15 MSG13-ID1 PIC X(08) VALUE 'DTSBD374'. DTSBD374 00515 15 MSG13-ID2 PIC X(03) VALUE '322'. DTSBD374 00516 10 MSG13-SHORT-TEXT PIC X(20) DTSBD374 00517 VALUE 'INVALID CURRENT WAGE'. DTSBD374 00518 10 MSG13-LONG-TEXT. DTSBD374 00519 15 FILLER PIC X(30) DTSBD374 00520 VALUE 'TRANSACTION FAILED - CURRENT W'. DTSBD374 00521 15 FILLER PIC X(30) DTSBD374 00522 VALUE 'AGES HAVE CHANGED '. DTSBD374 00523 DTSBD374 00524 05 MSG14-ESTIMATED-RATE. DTSBD374 00525 10 MSG14-ID. DTSBD374 00526 15 MSG14-ID1 PIC X(08) VALUE 'DTSBD374'. DTSBD374 00527 15 MSG14-ID2 PIC X(03) VALUE '323'. DTSBD374 00528 10 MSG14-SHORT-TEXT PIC X(20) DTSBD374 00529 VALUE 'ESTIMATED RATE '. DTSBD374 00530 10 MSG14-LONG-TEXT. DTSBD374 00531 15 FILLER PIC X(30) DTSBD374 00532 VALUE 'TRANSACTION FAILED - ESTIMATED'. DTSBD374 00533 15 FILLER PIC X(30) DTSBD374 00534 VALUE ' RATE '. DTSBD374 00535 01 EVL-TABLE. DTSBD374 00536 05 EVL1-TEXT. DTSBD374 00537 10 FILLER PIC X(45) DTSBD374 00538 VALUE 'REPORT RCVD WITHOUT USEABLE WAGE DATA. YRQ: '. DTSBD374 00539 10 EVL1-SLASH-QTR PIC X(04). DTSBD374 00540 EJECT DTSBD374 00541 01 APAY-REC. DTSBD374 00542 ++INCLUDE DTSIAPAY DTSBD374 00543 EJECT DTSBD374 00544 01 ARPT-REC. DTSBD374 00545 ++INCLUDE DTSIARPT DTSBD374 00546 EJECT DTSBD374 00547 01 ASKL-REC. DTSBD374 00548 ++INCLUDE DTSIASKL DTSBD374 00549 EJECT DTSBD374 00550 01 R907-REC. DTSBD374 00551 ++INCLUDE DTSIR907 DTSBD374 00552 EJECT DTSBD374 00553 01 L516-LINK-AREA. DTSBD374 00554 ++INCLUDE DTSIL516 DTSBD374 00555 DTSBD374 00556 01 T051-REC. DTSBD374 00557 ++INCLUDE DTSIT051 DTSBD374 00558 DTSBD374 00559 01 L910-LINK-AREA. DTSBD374 00560 ++INCLUDE DTSIL910 DTSBD374 00561 SKIP3 DTSBD374 00562 01 MSKL-REC. DTSBD374 00563 ++INCLUDE DTSIMSKL DTSBD374 00564 SKIP3 DTSBD374 00565 01 MQTR-REC. DTSBD374 00566 ++INCLUDE DTSIMQTR DTSBD374 00567 SKIP3 DTSBD374 00568 01 MRPT-REC. DTSBD374 00569 ++INCLUDE DTSIMRPT DTSBD374 00570 SKIP3 DTSBD374 00571 01 MPAY-REC. DTSBD374 00572 ++INCLUDE DTSIMPAY DTSBD374 00573 SKIP3 DTSBD374 00574 01 MTCK-REC. DTSBD374 00575 ++INCLUDE DTSIMTCK DTSBD374 00576 SKIP3 DTSBD374 00577 01 MDST-REC. DTSBD374 00578 ++INCLUDE DTSIMDST DTSBD374 00579 SKIP3 DTSBD374 00580 01 MEVL-REC. DTSBD374 00581 ++INCLUDE DTSIMEVL DTSBD374 00582 EJECT DTSBD374 00583 01 L931-LINK-AREA. DTSBD374 00584 ++INCLUDE DTSIL931 DTSBD374 00585 SKIP3 DTSBD374 00586 01 FSKL-REC. DTSBD374 00587 ++INCLUDE DTSIFSKL DTSBD374 00588 SKIP3 DTSBD374 00589 01 FCYR-REC. DTSBD374 00590 ++INCLUDE DTSIFCYR DTSBD374 00591 SKIP3 DTSBD374 00592 01 L983-LINK-AREA. DTSBD374 00593 ++INCLUDE DTSIL983 DTSBD374 00594 SKIP3 DTSBD374 00595 01 WSKL-REC. DTSBD374 00596 ++INCLUDE DTSIWSKL DTSBD374 00597 SKIP3 DTSBD374 00598 01 W001-REC. DTSBD374 00599 ++INCLUDE DTSIW001 DTSBD374 00600 SKIP3 DTSBD374 00601 01 L001-LINK-AREA. DTSBD374 00602 ++INCLUDE DTSIL001 DTSBD374 00603 SKIP3 DTSBD374 00604 01 L003-LINK-AREA. DTSBD374 00605 ++INCLUDE DTSIL003 DTSBD374 00606 SKIP3 DTSBD374 00607 01 L004-LINK-AREA. DTSBD374 00608 ++INCLUDE DTSIL004 DTSBD374 00609 SKIP3 DTSBD374 00610 01 L005-LINK-AREA. DTSBD374 00611 ++INCLUDE DTSIL005 DTSBD374 00612 SKIP3 DTSBD374 00613 01 L549-LINK-AREA. DTSBD374 00614 ++INCLUDE DTSIL549 DTSBD374 00615 DTSBD374 00616 01 L109-LINK-AREA. DTSBD374 00617 ++INCLUDE DTSIL109 DTSBD374 00618 DTSBD374 00619 01 MMAX-LITERALS. DTSBD374 00620 ++INCLUDE DTSIMMAX DTSBD374 00621 SKIP3 DTSBD374 00622 01 CACT-LITERALS. DTSBD374 00623 ++INCLUDE DTSICACT DTSBD374 00624 EJECT DTSBD374 00625 LINKAGE SECTION. DTSBD374 00626 SKIP3 DTSBD374 00627 01 LBCM-LINK-AREA. DTSBD374 00628 ++INCLUDE DTSILBCM DTSBD374 00629 EJECT DTSBD374 00630 01 MPRF-REC. DTSBD374 00631 ++INCLUDE DTSIMPRF DTSBD374 00632 EJECT DTSBD374 00633 01 AATX-REC. DTSBD374 00634 ++INCLUDE DTSIAATX DTSBD374 00635 EJECT DTSBD374 00636 PROCEDURE DIVISION USING LBCM-LINK-AREA DTSBD374 00637 MPRF-REC DTSBD374 00638 AATX-REC. DTSBD374 00639 DTSBD374 00640 DTSBD374 00641 IF FIRST-TIME-IND = 'Y' DTSBD374 00642 PERFORM I0000-FIRST-TIME THRU I0000-EXIT DTSBD374 00643 MOVE 'N' TO FIRST-TIME-IND. DTSBD374 00644 DTSBD374 00645 DTSBD374 00646 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBD374 00647 DTSBD374 00648 DTSBD374 00649 GOBACK. DTSBD374 00650 EJECT DTSBD374 00651 I0000-FIRST-TIME. DTSBD374 00652 MOVE LBCM-TRACE-IND TO L910-TRACE-IND. DTSBD374 00653 DTSBD374 00654 MOVE WRK-MOD-NAME TO L910-MOD-NAME DTSBD374 00655 L983-MOD-NAME DTSBD374 00656 R907-MODULE-NAME. DTSBD374 00657 DTSBD374 00658 MOVE LENGTH OF R907-REC TO R907-LENGTH. DTSBD374 00659 DTSBD374 00660 MOVE '907' TO R907-REC-TYPE. DTSBD374 00661 DTSBD374 00662 MOVE +0 TO WRK-NULL-BATCH-NO DTSBD374 00663 WRK-NULL-ITEM-NO. DTSBD374 00664 DTSBD374 00665 PERFORM DTSBD374 00666 VARYING SUB FROM +1 BY +1 DTSBD374 00667 UNTIL SUB > WRK-BATCH-MAX DTSBD374 00668 MOVE +0 TO WRK-BATCH-NO (SUB) DTSBD374 00669 WRK-LAST-ITEM-NO (SUB) DTSBD374 00670 END-PERFORM. DTSBD374 00671 DTSBD374 00672 I0000-EXIT. DTSBD374 00673 EXIT. DTSBD374 00674 DTSBD374 00675 EJECT DTSBD374 00676 P0000-PROCESS. DTSBD374 00677 *& DTSBD374 00678 * DISPLAY 'BD374 ' MPRF-EMP-NO ' ' AATX-RPT-TYPE DTSBD374 00679 * ' TOT ' AATX-TOT-WAGE DTSBD374 00680 * ' TAX ' AATX-TAX-WAGE DTSBD374 00681 * ' EXC ' AATX-EXCESS-WAGE. DTSBD374 00682 *& DTSBD374 00683 IF LBCM-LAST-AATX-ITEM-NO NOT NUMERIC DTSBD374 00684 DISPLAY 'BD374 - NON-NUMERIC LBCM ITEM ' DTSBD374 00685 PERFORM S999-ABEND THRU S999-EXIT DTSBD374 00686 ELSE DTSBD374 00687 IF LBCM-LAST-AATX-ITEM-NO = ZERO DTSBD374 00688 DISPLAY 'BD374 - NO LBCM ITEM ' DTSBD374 00689 PERFORM S999-ABEND THRU S999-EXIT DTSBD374 00690 ELSE DTSBD374 00691 PERFORM P0100-LAST-ITEM THRU P0100-EXIT DTSBD374 00692 END-IF DTSBD374 00693 END-IF. DTSBD374 00694 DTSBD374 00695 MOVE SPACES TO WRK-LBCM-TRN-RESULT-IND DTSBD374 00696 WRK-LBCM-TRN-MSG-AREA. DTSBD374 00697 DTSBD374 00698 PERFORM P0200-SET-QTRS THRU P0200-EXIT. DTSBD374 00699 DTSBD374 00700 PERFORM P0300-LIABILITY THRU P0300-EXIT. DTSBD374 00701 DTSBD374 00702 IF AATX-ESTIM-88 DTSBD374 00703 PERFORM P0420-ESTIM-RPT THRU P0420-EXIT DTSBD374 00704 ELSE DTSBD374 00705 PERFORM P0400-SUM-WAGES THRU P0400-EXIT. DTSBD374 00706 DTSBD374 00707 PERFORM P0500-CALC-REMIT THRU P0500-EXIT. DTSBD374 00708 DTSBD374 00709 MOVE WRK-QTR1 TO WRK-YRQ. DTSBD374 00710 MOVE WRK-QTR1-TOT-WAGE TO WRK-TOT-WAGE. DTSBD374 00711 MOVE WRK-QTR1-TAX-WAGE TO WRK-TAX-WAGE. DTSBD374 00712 MOVE WRK-QTR1-CALC-REMIT TO WRK-REMIT. DTSBD374 00713 PERFORM P1000-PROCESS-QTR THRU P1000-EXIT. DTSBD374 00714 DTSBD374 00715 MOVE WRK-QTR2 TO WRK-YRQ. DTSBD374 00716 MOVE WRK-QTR2-TOT-WAGE TO WRK-TOT-WAGE. DTSBD374 00717 MOVE WRK-QTR2-TAX-WAGE TO WRK-TAX-WAGE. DTSBD374 00718 MOVE WRK-QTR2-CALC-REMIT TO WRK-REMIT. DTSBD374 00719 PERFORM P1000-PROCESS-QTR THRU P1000-EXIT. DTSBD374 00720 DTSBD374 00721 MOVE WRK-QTR3 TO WRK-YRQ. DTSBD374 00722 MOVE WRK-QTR3-TOT-WAGE TO WRK-TOT-WAGE. DTSBD374 00723 MOVE WRK-QTR3-TAX-WAGE TO WRK-TAX-WAGE. DTSBD374 00724 MOVE WRK-QTR3-CALC-REMIT TO WRK-REMIT. DTSBD374 00725 PERFORM P1000-PROCESS-QTR THRU P1000-EXIT. DTSBD374 00726 DTSBD374 00727 MOVE WRK-QTR4 TO WRK-YRQ. DTSBD374 00728 MOVE WRK-QTR4-TOT-WAGE TO WRK-TOT-WAGE. DTSBD374 00729 MOVE WRK-QTR4-TAX-WAGE TO WRK-TAX-WAGE. DTSBD374 00730 MOVE WRK-QTR4-CALC-REMIT TO WRK-REMIT. DTSBD374 00731 PERFORM P1000-PROCESS-QTR THRU P1000-EXIT. DTSBD374 00732 DTSBD374 00733 DTSBD374 00734 P0000-EXIT. DTSBD374 00735 EXIT. DTSBD374 00736 DTSBD374 00737 P0100-LAST-ITEM. DTSBD374 00738 MOVE +0 TO SUB1. DTSBD374 00739 DTSBD374 00740 PERFORM DTSBD374 00741 VARYING SUB FROM +1 BY +1 DTSBD374 00742 UNTIL SUB > WRK-BATCH-LAST DTSBD374 00743 IF WRK-BATCH-NO (SUB) = AATX-BATCH-NO DTSBD374 00744 MOVE SUB TO SUB1 DTSBD374 00745 DISPLAY 'BD374-BATCH FOUND ' AATX-BATCH-NO DTSBD374 00746 ' ' WRK-LAST-ITEM-NO (SUB) ' ' SUB1 DTSBD374 00747 END-IF DTSBD374 00748 END-PERFORM. DTSBD374 00749 DTSBD374 00750 IF SUB1 = ZERO DTSBD374 00751 PERFORM P0110-ADD-BATCH THRU P0110-EXIT DTSBD374 00752 END-IF. DTSBD374 00753 DTSBD374 00754 P0100-EXIT. DTSBD374 00755 EXIT. DTSBD374 00756 DTSBD374 00757 P0110-ADD-BATCH. DTSBD374 00758 IF WRK-BATCH-LAST < WRK-BATCH-MAX DTSBD374 00759 ADD +1 TO WRK-BATCH-LAST DTSBD374 00760 ELSE DTSBD374 00761 DISPLAY 'BATCH TABLE LENGTH EXCEEDED ' AATX-BATCH-NO DTSBD374 00762 PERFORM S999-ABEND THRU S999-EXIT DTSBD374 00763 END-IF. DTSBD374 00764 DTSBD374 00765 MOVE WRK-BATCH-LAST TO SUB1 DTSBD374 00766 MOVE AATX-BATCH-NO TO WRK-BATCH-NO (SUB1) DTSBD374 00767 MOVE LBCM-LAST-AATX-ITEM-NO TO WRK-LAST-ITEM-NO (SUB1) DTSBD374 00768 DISPLAY 'BD374-LAST ITEM ' WRK-BATCH-NO (SUB1) DTSBD374 00769 ' ' WRK-LAST-ITEM-NO (SUB1) ' ' SUB1. DTSBD374 00770 P0110-EXIT. DTSBD374 00771 EXIT. DTSBD374 00772 DTSBD374 00773 P0200-SET-QTRS. DTSBD374 00774 MOVE AATX-YRQ TO L004-QTR-5-9. DTSBD374 00775 DTSBD374 00776 MOVE 1 TO L004-QTR-5-Q. DTSBD374 00777 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD374 00778 MOVE L004-QTR-5-9 TO WRK-QTR1. DTSBD374 00779 MOVE WRK-QTR1 TO L516-YRQ. DTSBD374 00780 PERFORM S516-LIABILITY-INFO THRU S516-EXIT. DTSBD374 00781 MOVE L516-LIABLE-IND TO WRK-QTR1-LIABLE-IND. DTSBD374 00782 DTSBD374 00783 MOVE 2 TO L004-QTR-5-Q. DTSBD374 00784 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD374 00785 MOVE L004-QTR-5-9 TO WRK-QTR2. DTSBD374 00786 MOVE WRK-QTR2 TO L516-YRQ. DTSBD374 00787 PERFORM S516-LIABILITY-INFO THRU S516-EXIT. DTSBD374 00788 MOVE L516-LIABLE-IND TO WRK-QTR2-LIABLE-IND. DTSBD374 00789 DTSBD374 00790 MOVE 3 TO L004-QTR-5-Q. DTSBD374 00791 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD374 00792 MOVE L004-QTR-5-9 TO WRK-QTR3. DTSBD374 00793 MOVE WRK-QTR3 TO L516-YRQ. DTSBD374 00794 PERFORM S516-LIABILITY-INFO THRU S516-EXIT. DTSBD374 00795 MOVE L516-LIABLE-IND TO WRK-QTR3-LIABLE-IND. DTSBD374 00796 DTSBD374 00797 MOVE 4 TO L004-QTR-5-Q. DTSBD374 00798 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD374 00799 MOVE L004-QTR-5-9 TO WRK-QTR4. DTSBD374 00800 MOVE WRK-QTR4 TO L516-YRQ. DTSBD374 00801 PERFORM S516-LIABILITY-INFO THRU S516-EXIT. DTSBD374 00802 MOVE L516-LIABLE-IND TO WRK-QTR4-LIABLE-IND. DTSBD374 00803 DTSBD374 00804 PERFORM P0210-GRACE-PERIOD THRU P0210-EXIT. DTSBD374 00805 DTSBD374 00806 P0200-EXIT. DTSBD374 00807 EXIT. DTSBD374 00808 DTSBD374 00809 P0210-GRACE-PERIOD. DTSBD374 00810 *& DTSBD374 00811 * DISPLAY 'BD374 P0210 ' MPRF-EMP-NO DTSBD374 00812 * ' AATX ' AATX-RECEIVED-DATE DTSBD374 00813 * ' L516 ' L516-DEFAULT-RPT-DUE-DATE. DTSBD374 00814 *& DTSBD374 00815 MOVE WRK-QTR1 TO L516-YRQ. DTSBD374 00816 PERFORM S516-LIABILITY-INFO THRU S516-EXIT. DTSBD374 00817 MOVE L516-RATE-IND TO UI-TAX-RATE-IND. DTSBD374 00818 MOVE L516-UI-RATE TO UI-TAX-RATE. DTSBD374 00819 MOVE L516-DEFAULT-RPT-DUE-DATE TO L001-FED-8-DATE-9. DTSBD374 00820 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBD374 00821 DTSBD374 00822 MOVE +0 TO WRK-WORK-DAY-CNT. DTSBD374 00823 DTSBD374 00824 PERFORM DTSBD374 00825 UNTIL WRK-WORK-DAY-CNT > +4 DTSBD374 00826 ADD +1 TO L001-JUL-ABS-DAY DTSBD374 00827 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT DTSBD374 00828 MOVE L001-FED-8-DATE-9 TO L003-DATE DTSBD374 00829 WRK-GRACE-PERIOD-END DTSBD374 00830 PERFORM S003-AGENCY-DAY THRU S003-EXIT DTSBD374 00831 IF L003-IS-WORK-DAY DTSBD374 00832 ADD +1 TO WRK-WORK-DAY-CNT DTSBD374 00833 END-IF DTSBD374 00834 END-PERFORM. DTSBD374 00835 DTSBD374 00836 IF (AATX-RECEIVED-DATE > WRK-GRACE-PERIOD-END) DTSBD374 00837 OR DTSBD374 00838 (AATX-RECEIVED-DATE <= L516-DEFAULT-RPT-DUE-DATE) DTSBD374 00839 NEXT SENTENCE DTSBD374 00840 ELSE DTSBD374 00841 MOVE L516-DEFAULT-RPT-DUE-DATE TO AATX-RECEIVED-DATE DTSBD374 00842 END-IF. DTSBD374 00843 DTSBD374 00844 *& DTSBD374 00845 * DISPLAY 'BD374 P0210' DTSBD374 00846 * ' GRACE ' WRK-GRACE-PERIOD-END DTSBD374 00847 * ' AATX ' AATX-RECEIVED-DATE. DTSBD374 00848 *& DTSBD374 00849 P0210-EXIT. DTSBD374 00850 EXIT. DTSBD374 00851 DTSBD374 00852 P0300-LIABILITY. DTSBD374 00853 IF AATX-WITHDRW-88 DTSBD374 00854 GO TO P0300-EXIT DTSBD374 00855 END-IF. DTSBD374 00856 DTSBD374 00857 IF WRK-QTR1-LIABLE-88 DTSBD374 00858 OR WRK-QTR2-LIABLE-88 DTSBD374 00859 OR WRK-QTR3-LIABLE-88 DTSBD374 00860 OR WRK-QTR4-LIABLE-88 DTSBD374 00861 NEXT SENTENCE DTSBD374 00862 ELSE DTSBD374 00863 SET LBCM-TRN-NOT-OK-88 TO TRUE DTSBD374 00864 MOVE MSG3-NOT-LIABLE TO LBCM-TRN-MSG-AREA DTSBD374 00865 GO TO P0300-EXIT DTSBD374 00866 END-IF. DTSBD374 00867 DTSBD374 00868 P0300-EXIT. DTSBD374 00869 EXIT. DTSBD374 00870 DTSBD374 00871 P0400-SUM-WAGES. DTSBD374 00872 MOVE ZERO TO WRK-QTR1-TOT-WAGE DTSBD374 00873 WRK-QTR2-TOT-WAGE DTSBD374 00874 WRK-QTR3-TOT-WAGE DTSBD374 00875 WRK-QTR4-TOT-WAGE DTSBD374 00876 WRK-QTR1-TAX-WAGE DTSBD374 00877 WRK-QTR2-TAX-WAGE DTSBD374 00878 WRK-QTR3-TAX-WAGE DTSBD374 00879 WRK-QTR4-TAX-WAGE DTSBD374 00880 WRK-QTR1-CURR-WAGE DTSBD374 00881 WRK-QTR2-CURR-WAGE DTSBD374 00882 WRK-QTR3-CURR-WAGE DTSBD374 00883 WRK-QTR4-CURR-WAGE. DTSBD374 00884 DTSBD374 00885 SET WRK-WAGES-FOUND-NO-88 TO TRUE. DTSBD374 00886 SET WRK-WAGE-FIRST-TIME-YES-88 TO TRUE. DTSBD374 00887 DTSBD374 00888 *& DTSBD374 00889 * IF MPRF-EMP-NO = 014319 DTSBD374 00890 * DISPLAY 'BD374 P0400 ' MPRF-EMP-NO DTSBD374 00891 * ' BATCH ' AATX-BATCH-NO DTSBD374 00892 * ' ' AATX-ITEM-NO. DTSBD374 00893 * DISPLAY ' ' WRK-QTR1 ' ' WRK-QTR2 ' ' WRK-QTR3 DTSBD374 00894 * ' ' WRK-QTR4. DTSBD374 00895 * ELSE DTSBD374 00896 * DISPLAY 'BD374 P0400 ' MPRF-EMP-NO. DTSBD374 00897 * DTSBD374 00898 *& DTSBD374 00899 MOVE LOW-VALUE TO WSKL-REC. DTSBD374 00900 MOVE AATX-BATCH-NO TO WSKL-BATCH-NO. DTSBD374 00901 MOVE AATX-ITEM-NO TO WSKL-ITEM-NO. DTSBD374 00902 PERFORM S983-START-BROWSE THRU S983-EXIT. DTSBD374 00903 IF L983-NO-REC-88 DTSBD374 00904 OR WSKL-BATCH-NO NOT = AATX-BATCH-NO DTSBD374 00905 OR WSKL-ITEM-NO NOT = AATX-ITEM-NO DTSBD374 00906 GO TO P0400-EXIT. DTSBD374 00907 DTSBD374 00908 PERFORM P0410-SCAN-W001 THRU P0410-EXIT DTSBD374 00909 UNTIL L983-NO-REC-88 DTSBD374 00910 OR WSKL-BATCH-NO NOT = AATX-BATCH-NO DTSBD374 00911 OR WSKL-ITEM-NO NOT = AATX-ITEM-NO. DTSBD374 00912 DTSBD374 00913 COMPUTE WRK-TAX-WAGE-SUM = DTSBD374 00914 WRK-QTR1-TAX-WAGE + DTSBD374 00915 WRK-QTR2-TAX-WAGE + DTSBD374 00916 WRK-QTR3-TAX-WAGE + DTSBD374 00917 WRK-QTR4-TAX-WAGE. DTSBD374 00918 DTSBD374 00919 *& DTSBD374 00920 * IF MPRF-EMP-NO = 014319 DTSBD374 00921 * DISPLAY 'BD374 P0400 TAX SUM ' WRK-TAX-WAGE-SUM DTSBD374 00922 * ' AATX TAX ' AATX-TAX-WAGE. DTSBD374 00923 DTSBD374 00924 P0400-EXIT. DTSBD374 00925 EXIT. DTSBD374 00926 DTSBD374 00927 P0410-SCAN-W001. DTSBD374 00928 MOVE WSKL-REC TO W001-REC. DTSBD374 00929 DTSBD374 00930 EVALUATE TRUE DTSBD374 00931 WHEN W001-YRQ = WRK-QTR1 DTSBD374 00932 ADD W001-WAGE-CHNG TO WRK-QTR1-TOT-WAGE DTSBD374 00933 ADD W001-TAX-WAGE TO WRK-QTR1-TAX-WAGE DTSBD374 00934 ADD W001-CURR-WAGE TO WRK-QTR1-CURR-WAGE DTSBD374 00935 WHEN W001-YRQ = WRK-QTR2 DTSBD374 00936 ADD W001-WAGE-CHNG TO WRK-QTR2-TOT-WAGE DTSBD374 00937 ADD W001-TAX-WAGE TO WRK-QTR2-TAX-WAGE DTSBD374 00938 ADD W001-CURR-WAGE TO WRK-QTR2-CURR-WAGE DTSBD374 00939 WHEN W001-YRQ = WRK-QTR3 DTSBD374 00940 ADD W001-WAGE-CHNG TO WRK-QTR3-TOT-WAGE DTSBD374 00941 ADD W001-TAX-WAGE TO WRK-QTR3-TAX-WAGE DTSBD374 00942 ADD W001-CURR-WAGE TO WRK-QTR3-CURR-WAGE DTSBD374 00943 WHEN W001-YRQ = WRK-QTR4 DTSBD374 00944 ADD W001-WAGE-CHNG TO WRK-QTR4-TOT-WAGE DTSBD374 00945 ADD W001-TAX-WAGE TO WRK-QTR4-TAX-WAGE DTSBD374 00946 ADD W001-CURR-WAGE TO WRK-QTR4-CURR-WAGE DTSBD374 00947 END-EVALUATE. DTSBD374 00948 DTSBD374 00949 *& DTSBD374 00950 * IF MPRF-EMP-NO = 136406 DTSBD374 00951 * DISPLAY 'P0410 SCAN W001 ' W001-EMP-NO ' ' W001-SSN DTSBD374 00952 * DISPLAY 'QTR1 ' WRK-QTR1-TOT-WAGE ' ' WRK-QTR1-TAX-WAGE DTSBD374 00953 * ' ' WRK-QTR1-CURR-WAGE DTSBD374 00954 * DISPLAY 'QTR2 ' WRK-QTR2-TOT-WAGE ' ' WRK-QTR2-TAX-WAGE DTSBD374 00955 * ' ' WRK-QTR2-CURR-WAGE DTSBD374 00956 * DISPLAY 'QTR3 ' WRK-QTR3-TOT-WAGE ' ' WRK-QTR3-TAX-WAGE DTSBD374 00957 * ' ' WRK-QTR3-CURR-WAGE DTSBD374 00958 * DISPLAY 'QTR4 ' WRK-QTR4-TOT-WAGE ' ' WRK-QTR4-TAX-WAGE DTSBD374 00959 * ' ' WRK-QTR4-CURR-WAGE DTSBD374 00960 * END-IF. DTSBD374 00961 *& DTSBD374 00962 PERFORM S983-READ-NEXT THRU S983-EXIT. DTSBD374 00963 DTSBD374 00964 P0410-EXIT. DTSBD374 00965 EXIT. DTSBD374 00966 DTSBD374 00967 P0420-ESTIM-RPT. DTSBD374 00968 MOVE ZERO TO WRK-QTR1-TOT-WAGE DTSBD374 00969 WRK-QTR2-TOT-WAGE DTSBD374 00970 WRK-QTR3-TOT-WAGE DTSBD374 00971 WRK-QTR4-TOT-WAGE DTSBD374 00972 WRK-QTR1-TAX-WAGE DTSBD374 00973 WRK-QTR2-TAX-WAGE DTSBD374 00974 WRK-QTR3-TAX-WAGE DTSBD374 00975 WRK-QTR4-TAX-WAGE DTSBD374 00976 WRK-QTR1-CURR-WAGE DTSBD374 00977 WRK-QTR2-CURR-WAGE DTSBD374 00978 WRK-QTR3-CURR-WAGE DTSBD374 00979 WRK-QTR4-CURR-WAGE. DTSBD374 00980 DTSBD374 00981 MOVE AATX-TOT-WAGE TO WRK-QTR1-TOT-WAGE. DTSBD374 00982 MOVE AATX-TAX-WAGE TO WRK-QTR1-TAX-WAGE. DTSBD374 00983 DTSBD374 00984 P0420-EXIT. DTSBD374 00985 EXIT. DTSBD374 00986 DTSBD374 00987 **************************************************************** DTSBD374 00988 * DISTRIBUTE THE REMITTANCE AMOUNT AMONG THE QUARTERS COVERED DTSBD374 00989 * BY THE ANNUAL REPORT. DTSBD374 00990 **************************************************************** DTSBD374 00991 P0500-CALC-REMIT. DTSBD374 00992 MOVE ZERO TO WRK-QTR1-CALC-REMIT DTSBD374 00993 WRK-QTR2-CALC-REMIT DTSBD374 00994 WRK-QTR3-CALC-REMIT DTSBD374 00995 WRK-QTR4-CALC-REMIT DTSBD374 00996 WRK-TOT-CHG-AMT DTSBD374 00997 WRK-UI-CHARGED-AMT DTSBD374 00998 WRK-SUR-CHARGED-AMT. DTSBD374 00999 DTSBD374 01000 *& DTSBD374 01001 MOVE AATX-REMIT-AMT TO AMT-DISP1 DTSBD374 01002 DISPLAY 'BD374 P0500 ATX REMIT ' AMT-DISP1. DTSBD374 01003 *& DTSBD374 01004 IF UI-TAX-RATE-NO-88 DTSBD374 01005 OR AATX-REMIT-AMT = +0 DTSBD374 01006 GO TO P0500-EXIT. DTSBD374 01007 DTSBD374 01008 MOVE MPRF-EMP-CLASS TO L109-EMP-CLASS. DTSBD374 01009 MOVE WRK-QTR1 TO L109-YRQ. DTSBD374 01010 SET L109-CMND-INPUT-QTR-88 TO TRUE. DTSBD374 01011 PERFORM S109-SUR-RATE THRU S109-EXIT. DTSBD374 01012 ADD L109-SUR-RATE TO UI-TAX-RATE. DTSBD374 01013 DTSBD374 01014 MOVE AATX-REMIT-AMT TO WRK-REMIT-AMT. DTSBD374 01015 DTSBD374 01016 COMPUTE WRK-UI-CHARGED-AMT = DTSBD374 01017 WRK-QTR1-TAX-WAGE * UI-TAX-RATE. DTSBD374 01018 ADD WRK-UI-CHARGED-AMT TO WRK-TOT-CHG-AMT. DTSBD374 01019 IF WRK-UI-CHARGED-AMT <= WRK-REMIT-AMT DTSBD374 01020 MOVE WRK-UI-CHARGED-AMT TO WRK-QTR1-CALC-REMIT DTSBD374 01021 ELSE DTSBD374 01022 MOVE WRK-REMIT-AMT TO WRK-QTR1-CALC-REMIT DTSBD374 01023 END-IF. DTSBD374 01024 SUBTRACT WRK-QTR1-CALC-REMIT FROM WRK-REMIT-AMT. DTSBD374 01025 DTSBD374 01026 DTSBD374 01027 *& DTSBD374 01028 * IF MPRF-EMP-NO = 081547 DTSBD374 01029 MOVE WRK-QTR1-CALC-REMIT TO AMT-DISP1 DTSBD374 01030 MOVE WRK-REMIT-AMT TO AMT-DISP2 DTSBD374 01031 DISPLAY 'BD374 P0500 QTR1 REMIT ' AMT-DISP1 DTSBD374 01032 ' W REMIT ' AMT-DISP2. DTSBD374 01033 *& DTSBD374 01034 COMPUTE WRK-UI-CHARGED-AMT = DTSBD374 01035 WRK-QTR2-TAX-WAGE * UI-TAX-RATE. DTSBD374 01036 ADD WRK-UI-CHARGED-AMT TO WRK-TOT-CHG-AMT. DTSBD374 01037 IF WRK-UI-CHARGED-AMT <= WRK-REMIT-AMT DTSBD374 01038 MOVE WRK-UI-CHARGED-AMT TO WRK-QTR2-CALC-REMIT DTSBD374 01039 ELSE DTSBD374 01040 MOVE WRK-REMIT-AMT TO WRK-QTR2-CALC-REMIT DTSBD374 01041 END-IF. DTSBD374 01042 SUBTRACT WRK-QTR2-CALC-REMIT FROM WRK-REMIT-AMT. DTSBD374 01043 DTSBD374 01044 *& DTSBD374 01045 * IF MPRF-EMP-NO = 081547 DTSBD374 01046 MOVE WRK-QTR2-CALC-REMIT TO AMT-DISP1 DTSBD374 01047 MOVE WRK-REMIT-AMT TO AMT-DISP2 DTSBD374 01048 DISPLAY 'BD374 P0500 QTR2 REMIT ' AMT-DISP1 DTSBD374 01049 ' W REMIT ' AMT-DISP2. DTSBD374 01050 *& DTSBD374 01051 COMPUTE WRK-UI-CHARGED-AMT = DTSBD374 01052 WRK-QTR3-TAX-WAGE * UI-TAX-RATE. DTSBD374 01053 ADD WRK-UI-CHARGED-AMT TO WRK-TOT-CHG-AMT. DTSBD374 01054 IF WRK-UI-CHARGED-AMT <= WRK-REMIT-AMT DTSBD374 01055 MOVE WRK-UI-CHARGED-AMT TO WRK-QTR3-CALC-REMIT DTSBD374 01056 ELSE DTSBD374 01057 MOVE WRK-REMIT-AMT TO WRK-QTR3-CALC-REMIT DTSBD374 01058 END-IF. DTSBD374 01059 SUBTRACT WRK-QTR3-CALC-REMIT FROM WRK-REMIT-AMT. DTSBD374 01060 DTSBD374 01061 *& DTSBD374 01062 * IF MPRF-EMP-NO = 081547 DTSBD374 01063 MOVE WRK-QTR3-CALC-REMIT TO AMT-DISP1 DTSBD374 01064 MOVE WRK-REMIT-AMT TO AMT-DISP2 DTSBD374 01065 DISPLAY 'BD374 P0500 QTR3 REMIT ' AMT-DISP1 DTSBD374 01066 * ' W REMIT ' AMT-DISP2. DTSBD374 01067 *& DTSBD374 01068 COMPUTE WRK-UI-CHARGED-AMT = DTSBD374 01069 WRK-QTR4-TAX-WAGE * UI-TAX-RATE. DTSBD374 01070 ADD WRK-UI-CHARGED-AMT TO WRK-TOT-CHG-AMT. DTSBD374 01071 IF WRK-UI-CHARGED-AMT <= WRK-REMIT-AMT DTSBD374 01072 MOVE WRK-UI-CHARGED-AMT TO WRK-QTR4-CALC-REMIT DTSBD374 01073 ELSE DTSBD374 01074 MOVE WRK-REMIT-AMT TO WRK-QTR4-CALC-REMIT DTSBD374 01075 END-IF. DTSBD374 01076 SUBTRACT WRK-QTR4-CALC-REMIT FROM WRK-REMIT-AMT. DTSBD374 01077 DTSBD374 01078 *& DTSBD374 01079 * IF MPRF-EMP-NO = 081547 DTSBD374 01080 MOVE WRK-QTR4-CALC-REMIT TO AMT-DISP1 DTSBD374 01081 MOVE WRK-REMIT-AMT TO AMT-DISP2 DTSBD374 01082 DISPLAY 'BD374 P0500 QTR4 REMIT ' AMT-DISP1 DTSBD374 01083 ' W REMIT ' AMT-DISP2. DTSBD374 01084 *& DTSBD374 01085 IF WRK-REMIT-AMT > ZERO DTSBD374 01086 ADD WRK-REMIT-AMT TO WRK-QTR4-CALC-REMIT. DTSBD374 01087 DTSBD374 01088 *& DTSBD374 01089 * IF MPRF-EMP-NO = 081547 DTSBD374 01090 MOVE WRK-QTR1-CALC-REMIT TO AMT-DISP1 DTSBD374 01091 DISPLAY 'BD374 P0500 Q1 REMIT ' AMT-DISP1. DTSBD374 01092 *& DTSBD374 01093 P0500-EXIT. DTSBD374 01094 EXIT. DTSBD374 01095 DTSBD374 01096 P1000-PROCESS-QTR. DTSBD374 01097 MOVE LOW-VALUES TO ARPT-REC. DTSBD374 01098 DTSBD374 01099 IF WRK-YRQ = WRK-QTR1 DTSBD374 01100 MOVE AATX-KEY-AREA TO ARPT-KEY-AREA DTSBD374 01101 ELSE DTSBD374 01102 MOVE AATX-BATCH-NO TO ARPT-BATCH-NO DTSBD374 01103 ADD +1 TO WRK-LAST-ITEM-NO (SUB1) DTSBD374 01104 MOVE WRK-LAST-ITEM-NO (SUB1) TO ARPT-ITEM-NO DTSBD374 01105 END-IF. DTSBD374 01106 DTSBD374 01107 *********** DTSBD374 01108 * NORMALLY, LBCM-TRN-DOC-NO IS SET BY BD300 AS EACH DTSBD374 01109 * TRANSACTION IS PROCESSED. SINCE NEW ITEMS ARE BEING DTSBD374 01110 * CREATED IN BD374, THE LBCM DOC NUMBER NEEDS TO BE SET DTSBD374 01111 * FOR EACH ONE. DTSBD374 01112 *********** DTSBD374 01113 MOVE ARPT-DOC-NO TO LBCM-TRN-DOC-NO. DTSBD374 01114 DTSBD374 01115 DISPLAY 'BD374 ' AATX-EMP-NO ' ' ARPT-BATCH-NO DTSBD374 01116 ' ' ARPT-ITEM-NO. DTSBD374 01117 DTSBD374 01118 SET ARPT-RPT-88 TO TRUE. DTSBD374 01119 MOVE AATX-NAME-CHECK TO ARPT-NAME-CHECK. DTSBD374 01120 MOVE AATX-EMP-NO TO ARPT-EMP-NO. DTSBD374 01121 MOVE AATX-RPT-TYPE TO ARPT-RPT-TYPE. DTSBD374 01122 MOVE AATX-RPT-TYPE TO ARPT-RPT-TYPE. DTSBD374 01123 MOVE WRK-YRQ TO ARPT-YRQ. DTSBD374 01124 MOVE WRK-TOT-WAGE TO ARPT-TOT-WAGE. DTSBD374 01125 MOVE WRK-TAX-WAGE TO ARPT-TAX-WAGE. DTSBD374 01126 COMPUTE ARPT-EXCESS-WAGE = (WRK-TOT-WAGE - WRK-TAX-WAGE). DTSBD374 01127 *& DTSBD374 01128 * IF MPRF-EMP-NO = 081547 DTSBD374 01129 * MOVE WRK-REMIT TO AMT-DISP1 DTSBD374 01130 * DISPLAY 'BD374 P1000 REMIT ' WRK-YRQ ' ' AMT-DISP1. DTSBD374 01131 *& DTSBD374 01132 MOVE WRK-REMIT TO ARPT-REMIT-AMT. DTSBD374 01133 SET ARPT-WAGE-RPT-YES-88 TO TRUE. DTSBD374 01134 MOVE AATX-WAIVE-BOTH-IND TO ARPT-WAIVE-BOTH-IND. DTSBD374 01135 MOVE AATX-WAIVE-INT-IND TO ARPT-WAIVE-INT-IND. DTSBD374 01136 MOVE AATX-WAIVE-LATE-PEN-IND TO ARPT-WAIVE-LATE-PEN-IND. DTSBD374 01137 MOVE AATX-TOTAL-EMPL-CNT TO ARPT-TOTAL-EMPL-CNT. DTSBD374 01138 PERFORM P1100-EMPL-COUNTS THRU P1100-EXIT. DTSBD374 01139 MOVE AATX-VERIFIED-IND TO ARPT-VERIFIED-IND. DTSBD374 01140 MOVE AATX-RECEIVED-DATE TO ARPT-RECEIVED-DATE. DTSBD374 01141 MOVE AATX-DEPOSIT-DATE TO ARPT-DEPOSIT-DATE. DTSBD374 01142 MOVE AATX-RESPONSIBLE-ACTIVITY TO ARPT-RESPONSIBLE-ACTIVITY. DTSBD374 01143 MOVE AATX-RESPONSIBLE-OP-ID TO ARPT-RESPONSIBLE-OP-ID. DTSBD374 01144 MOVE AATX-DISREGARD-EDITS-IND TO ARPT-DISREGARD-EDITS-IND. DTSBD374 01145 MOVE AATX-PASSED-FULL-EDITS-IND DTSBD374 01146 TO ARPT-PASSED-FULL-EDITS-IND.DTSBD374 01147 MOVE +0 TO ARPT-TRACE-NO DTSBD374 01148 ARPT-PSEUDO-BATCH-NO DTSBD374 01149 ARPT-PSEUDO-ITEM-NO DTSBD374 01150 ARPT-CHECK-SCAN-DT DTSBD374 01151 ARPT-CHECK-SEQUENCE. DTSBD374 01152 MOVE AATX-STATUS-CHANGE-IND TO ARPT-STATUS-CHNG-IND. DTSBD374 01153 MOVE AATX-PROCESSED-DATE TO ARPT-PROCESSED-DATE. DTSBD374 01154 DTSBD374 01155 MOVE ARPT-REC TO ASKL-REC. DTSBD374 01156 DTSBD374 01157 PERFORM P1200-MJRN-TABLE-INIT THRU P1200-EXIT. DTSBD374 01158 DTSBD374 01159 *& DTSBD374 01160 DISPLAY 'BD374 CALL BD371 ' ARPT-EMP-NO ' ' ARPT-YRQ. DTSBD374 01161 *& DTSBD374 01162 DTSBD374 01163 CALL 'DTSBD371' USING LBCM-LINK-AREA DTSBD374 01164 MPRF-REC DTSBD374 01165 ARPT-REC. DTSBD374 01166 *& DTSBD374 01167 DISPLAY 'BD374 P1000 TERM ' LBCM-TRN-RESULT-IND DTSBD374 01168 ' ' LBCM-TRN-MSG-AREA. DTSBD374 01169 *& DTSBD374 01170 IF LBCM-TRN-OK-88 DTSBD374 01171 PERFORM S549-TERM-TRAN-PRIM THRU S549-EXIT DTSBD374 01172 ELSE DTSBD374 01173 PERFORM S549-CANCEL-TRAN THRU S549-EXIT DTSBD374 01174 END-IF. DTSBD374 01175 DTSBD374 01176 P1000-EXIT. DTSBD374 01177 EXIT. DTSBD374 01178 DTSBD374 01179 P1100-EMPL-COUNTS. DTSBD374 01180 MOVE WRK-YRQ TO L004-QTR-5-9. DTSBD374 01181 DTSBD374 01182 EVALUATE L004-QTR-5-Q DTSBD374 01183 WHEN 1 DTSBD374 01184 PERFORM P1110-QTR1 THRU P1110-EXIT DTSBD374 01185 WHEN 2 DTSBD374 01186 PERFORM P1120-QTR2 THRU P1120-EXIT DTSBD374 01187 WHEN 3 DTSBD374 01188 PERFORM P1130-QTR3 THRU P1130-EXIT DTSBD374 01189 WHEN 4 DTSBD374 01190 PERFORM P1140-QTR4 THRU P1140-EXIT DTSBD374 01191 END-EVALUATE. DTSBD374 01192 DTSBD374 01193 P1100-EXIT. DTSBD374 01194 EXIT. DTSBD374 01195 DTSBD374 01196 P1110-QTR1. DTSBD374 01197 MOVE AATX-JAN-EMPL-CNT TO ARPT-1ST-MTH-EMPL-CNT. DTSBD374 01198 MOVE AATX-FEB-EMPL-CNT TO ARPT-2ND-MTH-EMPL-CNT. DTSBD374 01199 MOVE AATX-MAR-EMPL-CNT TO ARPT-3RD-MTH-EMPL-CNT. DTSBD374 01200 DTSBD374 01201 P1110-EXIT. DTSBD374 01202 EXIT. DTSBD374 01203 DTSBD374 01204 P1120-QTR2. DTSBD374 01205 MOVE AATX-APR-EMPL-CNT TO ARPT-1ST-MTH-EMPL-CNT. DTSBD374 01206 MOVE AATX-MAY-EMPL-CNT TO ARPT-2ND-MTH-EMPL-CNT. DTSBD374 01207 MOVE AATX-JUN-EMPL-CNT TO ARPT-3RD-MTH-EMPL-CNT. DTSBD374 01208 DTSBD374 01209 P1120-EXIT. DTSBD374 01210 EXIT. DTSBD374 01211 DTSBD374 01212 P1130-QTR3. DTSBD374 01213 MOVE AATX-JUL-EMPL-CNT TO ARPT-1ST-MTH-EMPL-CNT. DTSBD374 01214 MOVE AATX-AUG-EMPL-CNT TO ARPT-2ND-MTH-EMPL-CNT. DTSBD374 01215 MOVE AATX-SEP-EMPL-CNT TO ARPT-3RD-MTH-EMPL-CNT. DTSBD374 01216 DTSBD374 01217 P1130-EXIT. DTSBD374 01218 EXIT. DTSBD374 01219 DTSBD374 01220 P1140-QTR4. DTSBD374 01221 MOVE AATX-OCT-EMPL-CNT TO ARPT-1ST-MTH-EMPL-CNT. DTSBD374 01222 MOVE AATX-NOV-EMPL-CNT TO ARPT-2ND-MTH-EMPL-CNT. DTSBD374 01223 MOVE AATX-DEC-EMPL-CNT TO ARPT-3RD-MTH-EMPL-CNT. DTSBD374 01224 DTSBD374 01225 P1140-EXIT. DTSBD374 01226 EXIT. DTSBD374 01227 DTSBD374 01228 P1200-MJRN-TABLE-INIT. DTSBD374 01229 MOVE ARPT-DOC-NO TO L549-TRN-DOC-NO. DTSBD374 01230 MOVE LBCM-TRACE-IND TO L549-INIT-TRACE-IND. DTSBD374 01231 MOVE LBCM-CURR-RUN-DATE TO L549-INIT-CURR-RUN-DATE. DTSBD374 01232 MOVE LBCM-EMP-ABSTIME TO L549-INIT-ABSTIME. DTSBD374 01233 MOVE MPRF-EMP-NO TO L549-INIT-EMP-NO. DTSBD374 01234 MOVE MPRF-EMP-CLASS TO L549-INIT-EMP-CLASS. DTSBD374 01235 MOVE MPRF-ELIGIBLE-CD TO L549-INIT-ELIGIBLE-CD. DTSBD374 01236 MOVE ARPT-REC-TYPE TO L549-INIT-REC-TYPE DTSBD374 01237 MOVE ARPT-RPT-TYPE TO L549-INIT-TRANS-TYPE DTSBD374 01238 MOVE ARPT-RECEIVED-DATE TO L549-INIT-RECEIVED-DATE DTSBD374 01239 MOVE ARPT-DEPOSIT-DATE TO L549-INIT-DEPOSIT-DATE DTSBD374 01240 MOVE ARPT-REMIT-AMT TO L549-INIT-REMIT-AMT DTSBD374 01241 IF ARPT-WAIVE-BOTH-YES-88 DTSBD374 01242 MOVE ARPT-WAIVE-BOTH-IND TO ARPT-WAIVE-INT-IND DTSBD374 01243 ARPT-WAIVE-LATE-PEN-IND DTSBD374 01244 SET ARPT-WAIVE-BOTH-NO-88 TO TRUE DTSBD374 01245 END-IF. DTSBD374 01246 MOVE ARPT-WAIVE-INT-IND TO L549-INIT-WAIVE-INT-IND. DTSBD374 01247 MOVE ARPT-WAIVE-LATE-PEN-IND DTSBD374 01248 TO L549-INIT-WAIVE-LATE-PEN-IND. DTSBD374 01249 MOVE ARPT-YRQ TO L549-INIT-APPLIC-YRQ. DTSBD374 01250 MOVE SPACE TO L549-INIT-APPLIC-ACCT-IND. DTSBD374 01251 MOVE +0 TO L549-INIT-APPLIC-BATCH-NO DTSBD374 01252 L549-INIT-APPLIC-ITEM-NO. DTSBD374 01253 MOVE ARPT-RESPONSIBLE-ACTIVITY DTSBD374 01254 TO L549-INIT-RESP-ACTIVITY DTSBD374 01255 MOVE ARPT-RESPONSIBLE-OP-ID TO L549-INIT-RESP-OP-ID. DTSBD374 01256 DTSBD374 01257 *& DTSBD374 01258 DISPLAY 'BD374 P1200 ' L549-INIT-EMP-NO DTSBD374 01259 ' ' ARPT-BATCH-NO ' ' ARPT-ITEM-NO. DTSBD374 01260 *& DTSBD374 01261 PERFORM S549-INIT-TRAN THRU S549-EXIT. DTSBD374 01262 DTSBD374 01263 P1200-EXIT. DTSBD374 01264 EXIT. DTSBD374 01265 DTSBD374 01266 S001-FROM-FED-8. DTSBD374 01267 SET L001-FROM-FED-8 TO TRUE. DTSBD374 01268 GO TO S001-DATE. DTSBD374 01269 DTSBD374 01270 S001-FROM-ABS-DAY. DTSBD374 01271 SET L001-FROM-ABS-DAY TO TRUE. DTSBD374 01272 GO TO S001-DATE. DTSBD374 01273 DTSBD374 01274 S001-DATE. DTSBD374 01275 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBD374 01276 S001-EXIT. DTSBD374 01277 EXIT. DTSBD374 01278 SKIP3 DTSBD374 01279 S004-FROM-5. DTSBD374 01280 SET L004-FROM-5 TO TRUE. DTSBD374 01281 GO TO S004-QTR. DTSBD374 01282 DTSBD374 01283 S003-AGENCY-DAY. DTSBD374 01284 SET L003-AGENCY-DAY TO TRUE. DTSBD374 01285 CALL 'DTSBU003' USING L003-LINK-AREA. DTSBD374 01286 DTSBD374 01287 S003-EXIT. DTSBD374 01288 EXIT. DTSBD374 01289 SKIP3 DTSBD374 01290 S004-QTR. DTSBD374 01291 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBD374 01292 S004-EXIT. DTSBD374 01293 EXIT. DTSBD374 01294 SKIP3 DTSBD374 01295 S005-FROM-ABSTIME. DTSBD374 01296 SET L005-FROM-ABSTIME TO TRUE. DTSBD374 01297 GO TO S005-ABSTIME. DTSBD374 01298 DTSBD374 01299 S005-ABSTIME. DTSBD374 01300 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBD374 01301 S005-EXIT. DTSBD374 01302 EXIT. DTSBD374 01303 SKIP3 DTSBD374 01304 S109-FIRST-PEN-INT-YRQ. DTSBD374 01305 SET L109-CMND-PEN-INT-QTR-88 TO TRUE. DTSBD374 01306 GO TO S109-SUR-RATE. DTSBD374 01307 DTSBD374 01308 S109-SUR-RATE. DTSBD374 01309 CALL 'DTSBU109' USING L109-LINK-AREA. DTSBD374 01310 S109-EXIT. DTSBD374 01311 EXIT. DTSBD374 01312 DTSBD374 01313 S516-LIABILITY-INFO. DTSBD374 01314 CALL 'DTSBU516' USING L516-LINK-AREA DTSBD374 01315 MPRF-REC. DTSBD374 01316 S516-EXIT. DTSBD374 01317 EXIT. DTSBD374 01318 DTSBD374 01319 S549-INIT-TRAN. DTSBD374 01320 SET L549-INIT-TRAN-88 TO TRUE. DTSBD374 01321 GO TO S549-JOURNAL. DTSBD374 01322 DTSBD374 01323 S549-DELTA. DTSBD374 01324 SET L549-DELTA-88 TO TRUE. DTSBD374 01325 GO TO S549-JOURNAL. DTSBD374 01326 DTSBD374 01327 S549-CANCEL-TRAN. DTSBD374 01328 SET L549-CANCEL-TRAN-88 TO TRUE. DTSBD374 01329 GO TO S549-JOURNAL. DTSBD374 01330 DTSBD374 01331 S549-TERM-TRAN-PRIM. DTSBD374 01332 SET L549-TERM-TRAN-PRIM-88 TO TRUE. DTSBD374 01333 GO TO S549-JOURNAL. DTSBD374 01334 DTSBD374 01335 S549-JOURNAL. DTSBD374 01336 MOVE ARPT-DOC-NO TO L549-TRN-DOC-NO. DTSBD374 01337 DTSBD374 01338 CALL 'DTSBU549' USING L549-LINK-AREA. DTSBD374 01339 S549-EXIT. DTSBD374 01340 EXIT. DTSBD374 01341 DTSBD374 01342 S910-READ. DTSBD374 01343 SET L910-READ-88 TO TRUE. DTSBD374 01344 GO TO S910-MSTR-IO. DTSBD374 01345 DTSBD374 01346 S910-START-BROWSE. DTSBD374 01347 SET L910-START-BROWSE-88 TO TRUE. DTSBD374 01348 GO TO S910-MSTR-IO. DTSBD374 01349 DTSBD374 01350 S910-READ-NEXT. DTSBD374 01351 SET L910-READ-NEXT-88 TO TRUE. DTSBD374 01352 GO TO S910-MSTR-IO. DTSBD374 01353 DTSBD374 01354 S910-COUNT. DTSBD374 01355 SET L910-COUNT-88 TO TRUE. DTSBD374 01356 GO TO S910-MSTR-IO. DTSBD374 01357 DTSBD374 01358 S910-WRITE. DTSBD374 01359 SET LBCM-EMP-UPDATE-YES-88 TO TRUE. DTSBD374 01360 SET L910-WRITE-88 TO TRUE. DTSBD374 01361 GO TO S910-MSTR-IO. DTSBD374 01362 DTSBD374 01363 S910-REWRITE. DTSBD374 01364 SET LBCM-EMP-UPDATE-YES-88 TO TRUE. DTSBD374 01365 SET L910-REWRITE-88 TO TRUE. DTSBD374 01366 GO TO S910-MSTR-IO. DTSBD374 01367 DTSBD374 01368 S910-DELETE. DTSBD374 01369 SET LBCM-EMP-UPDATE-YES-88 TO TRUE. DTSBD374 01370 SET L910-DELETE-88 TO TRUE. DTSBD374 01371 GO TO S910-MSTR-IO. DTSBD374 01372 DTSBD374 01373 S910-MSTR-IO. DTSBD374 01374 CALL 'DTSBU910' USING L910-LINK-AREA DTSBD374 01375 MSKL-REC. DTSBD374 01376 S910-EXIT. DTSBD374 01377 EXIT. DTSBD374 01378 SKIP3 DTSBD374 01379 S931-READ. DTSBD374 01380 SET L931-READ-88 TO TRUE. DTSBD374 01381 GO TO S931-REF-I. DTSBD374 01382 DTSBD374 01383 S931-REF-I. DTSBD374 01384 CALL 'DTSBU931' USING L931-LINK-AREA DTSBD374 01385 FSKL-REC. DTSBD374 01386 S931-EXIT. DTSBD374 01387 EXIT. DTSBD374 01388 SKIP3 DTSBD374 01389 S946-R907-WRITE. DTSBD374 01390 CALL 'DTSBU946' USING R907-REC. DTSBD374 01391 GO TO S946-EXIT. DTSBD374 01392 DTSBD374 01393 S946-EXIT. DTSBD374 01394 EXIT. DTSBD374 01395 SKIP3 DTSBD374 01396 S983-START-BROWSE. DTSBD374 01397 SET L983-START-BROWSE-88 TO TRUE. DTSBD374 01398 GO TO S983-WAGE-I. DTSBD374 01399 DTSBD374 01400 S983-READ-NEXT. DTSBD374 01401 SET L983-READ-NEXT-88 TO TRUE. DTSBD374 01402 GO TO S983-WAGE-I. DTSBD374 01403 DTSBD374 01404 S983-WAGE-I. DTSBD374 01405 CALL 'DTSBU983' USING L983-LINK-AREA DTSBD374 01406 WSKL-REC. DTSBD374 01407 S983-EXIT. DTSBD374 01408 EXIT. DTSBD374 01409 SKIP3 DTSBD374 01410 S999-ABEND. DTSBD374 01411 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBD374 01412 S999-EXIT. DTSBD374 01413 EXIT. DTSBD374