1036 lines
82 KiB
COBOL
1036 lines
82 KiB
COBOL
00001 IDENTIFICATION DIVISION. 12/31/02
|
|
00002 PROGRAM-ID. DTSBD530. DTSBD530
|
|
00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV009
|
|
00004 DATE-WRITTEN. APRIL 1995. DTSBD530
|
|
00005 DATE-COMPILED. DTSBD530
|
|
00006 SKIP2 DTSBD530
|
|
00007 ***** DTSBD530
|
|
00008 * DTSBD530
|
|
00009 * FUNCTION: DTSBD530
|
|
00010 * DTSBD530
|
|
00011 * REPORT RECORD GENERATION STEP OF THE WAGE FILE / TAX FILE DTSBD530
|
|
00012 * COMPARISON PROCESS. DTSBD530
|
|
00013 * DTSBD530
|
|
00014 * DTSBD530
|
|
00015 * MODIFICATION HISTORY: DTSBD530
|
|
00016 * DTSBD530
|
|
00017 * 04/10/95 MODULE WRITTEN. DTSBD530
|
|
00018 * RFP: CR048 PROGRAMMER: EHH DTSBD530
|
|
00019 * DTSBD530
|
|
00020 * 02/13/1999 REVIEWED AND MODIFIED FOR DC. DTSBD530
|
|
00021 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSBD530
|
|
00022 * DTSBD530
|
|
00023 * 05/20/1999 PICKUP MODIFICATIONS. LIMIT PARAMETER SPECIFIED DTSBD530
|
|
00024 * YRQ TO >= 19924. DTSBD530
|
|
00025 * REFERENCE: PICKUP DIR PROGRAMMER: EHH DTSBD530
|
|
00026 * DTSBD530
|
|
00027 * 08/14/2002 RECOMPILED TO USE NEW VERSION OF DTSIL516. THIS DTSBD530
|
|
00028 * MODULE WILL INDICATE WHETHER A UI RATE IS DTSBD530
|
|
00029 * ESTIMATED OR NOT. DTSBD530 WILL ** NOT ** TEST DTSBD530
|
|
00030 * THE RATE TYPE. IT WILL REPORT THE RATE, DTSBD530
|
|
00031 * REGARDLESS OF TYPE. DTSBD530
|
|
00032 * REFERENCE: HOUSEHOLD PROGRAMMER: GD DTSBD530
|
|
00033 * DTSBD530
|
|
00034 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD530
|
|
00035 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD530
|
|
00036 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBD530
|
|
00037 * DTSBD530
|
|
00038 * DTSBD530
|
|
00039 * DTSBD530
|
|
00040 * DESCRIPTION: DTSBD530
|
|
00041 * DTSBD530
|
|
00042 * DTSBD530
|
|
00043 * DTSBD530
|
|
00044 * DTSBD530
|
|
00045 * DTSBD530
|
|
00046 * DTSBD530
|
|
00047 * DTSBD530
|
|
00048 * RECORDS READ: DTSBD530
|
|
00049 * DTSBD530
|
|
00050 * MPRF DTSBD530
|
|
00051 * MQTR DTSBD530
|
|
00052 * MRPT DTSBD530
|
|
00053 * MTAD DTSBD530
|
|
00054 * DTSBD530
|
|
00055 * DTSBD530
|
|
00056 * PRINTED OUTPUTS: DTSBD530
|
|
00057 * DTSBD530
|
|
00058 * NONE DTSBD530
|
|
00059 * DTSBD530
|
|
00060 * DTSBD530
|
|
00061 * RECORDS READ: DTSBD530
|
|
00062 * DTSBD530
|
|
00063 * X737 WAGE FILE / TAX FILE COMPARISON EXTRACT DTSBD530
|
|
00064 * RECORD. DTSBD530
|
|
00065 * DTSBD530
|
|
00066 * DTSBD530
|
|
00067 * RECORDS WRITTEN: DTSBD530
|
|
00068 * DTSBD530
|
|
00069 * R737 WAGE FILE / TAX FILE COMPARISON REPORT DTSBD530
|
|
00070 * RECORD. DTSBD530
|
|
00071 * DTSBD530
|
|
00072 * DTSBD530
|
|
00073 * MODULES CALLED: DTSBD530
|
|
00074 * DTSBD530
|
|
00075 * DTSBU001 DATE CONVERSION MODULE DTSBD530
|
|
00076 * DTSBU004 YEAR/QUARTER CONVERSION MODULE DTSBD530
|
|
00077 * DTSBU910 TAX FILE ACCESS MODULE DTSBD530
|
|
00078 * DTSBD530
|
|
00079 ***** DTSBD530
|
|
00080 SKIP3 DTSBD530
|
|
00081 ENVIRONMENT DIVISION. DTSBD530
|
|
00082 SKIP3 DTSBD530
|
|
00083 INPUT-OUTPUT SECTION. DTSBD530
|
|
00084 SKIP2 DTSBD530
|
|
00085 FILE-CONTROL. DTSBD530
|
|
00086 SELECT EXTRACT-FILE ASSIGN TO EXTFILE DTSBD530
|
|
00087 FILE STATUS IS EXT-FILE-STATUS. DTSBD530
|
|
00088 SKIP2 DTSBD530
|
|
00089 DATA DIVISION. DTSBD530
|
|
00090 SKIP3 DTSBD530
|
|
00091 FILE SECTION. DTSBD530
|
|
00092 EJECT DTSBD530
|
|
00093 FD EXTRACT-FILE DTSBD530
|
|
00094 LABEL RECORDS ARE STANDARD DTSBD530
|
|
00095 RECORDING MODE IS F DTSBD530
|
|
00096 BLOCK CONTAINS 0 RECORDS. DTSBD530
|
|
00097 DTSBD530
|
|
00098 01 EXTRACT-REC. DTSBD530
|
|
00099 ++INCLUDE DTSIX737 DTSBD530
|
|
00100 EJECT DTSBD530
|
|
00101 WORKING-STORAGE SECTION. DTSBD530
|
|
001015 77 PAN-VALET PICTURE X(24) VALUE '009DTSBD530 12/31/02'. DTSBD530
|
|
00102 SKIP3 DTSBD530
|
|
00103 01 WRK-AREA. DTSBD530
|
|
00104 05 ABEND-CODE PIC S9(04) COMP VALUE +530. DTSBD530
|
|
00105 DTSBD530
|
|
00106 05 MOD-NAME PIC X(08) VALUE 'DTSBD530'.DTSBD530
|
|
00107 DTSBD530
|
|
00108 05 ALL-NINES-EMP-NO PIC S9(07) COMP-3 DTSBD530
|
|
00109 VALUE +9999999. DTSBD530
|
|
00110 DTSBD530
|
|
00111 05 WRK-PICKUP-YRQ PIC S9(05) COMP-3 DTSBD530
|
|
00112 VALUE +19924. DTSBD530
|
|
00113 DTSBD530
|
|
00114 05 ABEND-MSG PIC X(60). DTSBD530
|
|
00115 DTSBD530
|
|
00116 DTSBD530
|
|
00117 05 EXT-FILE-STATUS PIC X(02). DTSBD530
|
|
00118 88 EXT-FILE-OK-88 VALUE '00'. DTSBD530
|
|
00119 88 EXT-FILE-EOF-88 VALUE '10' '23'. DTSBD530
|
|
00120 DTSBD530
|
|
00121 05 FILE-COMMAND PIC X(10). DTSBD530
|
|
00122 DTSBD530
|
|
00123 05 IN-EXT-CNT PIC S9(09) COMP-3. DTSBD530
|
|
00124 DTSBD530
|
|
00125 05 DISPLAY-REC-CNT-X PIC X(11). DTSBD530
|
|
00126 05 DISPLAY-REC-CNT REDEFINES DISPLAY-REC-CNT-X DTSBD530
|
|
00127 PIC ZZZ,ZZZ,ZZ9. DTSBD530
|
|
00128 DTSBD530
|
|
00129 05 EXT-FILE-EMP-NO PIC S9(07) COMP-3. DTSBD530
|
|
00130 DTSBD530
|
|
00131 DTSBD530
|
|
00132 05 WRK-START-YRQ PIC S9(05) COMP-3. DTSBD530
|
|
00133 DTSBD530
|
|
00134 05 WRK-END-YRQ PIC S9(05) COMP-3. DTSBD530
|
|
00135 DTSBD530
|
|
00136 05 WRK-YRQ-CNT PIC S9(04) COMP. DTSBD530
|
|
00137 DTSBD530
|
|
00138 05 WRK-YRQ OCCURS 4 TIMES DTSBD530
|
|
00139 INDEXED BY WRK-YRQ-IDX PIC S9(05) COMP-3. DTSBD530
|
|
00140 DTSBD530
|
|
00141 DTSBD530
|
|
00142 05 WRK-TOL-MAX-CNT PIC S9(04) COMP VALUE +3. DTSBD530
|
|
00143 DTSBD530
|
|
00144 05 WRK-TOL-SUB1 PIC S9(04) COMP. DTSBD530
|
|
00145 DTSBD530
|
|
00146 05 WRK-TOL-SUB2 PIC S9(04) COMP. DTSBD530
|
|
00147 DTSBD530
|
|
00148 05 WRK-TOL-CNT PIC S9(04) COMP. DTSBD530
|
|
00149 DTSBD530
|
|
00150 05 WRK-TOL-AREA OCCURS 3 TIMES DTSBD530
|
|
00151 INDEXED BY WRK-TOL-IDX. DTSBD530
|
|
00152 10 WRK-TOL-MIN-AMT PIC S9(11)V9(02) COMP-3.DTSBD530
|
|
00153 10 WRK-TOL-MAX-AMT PIC S9(11)V9(02) COMP-3.DTSBD530
|
|
00154 DTSBD530
|
|
00155 05 WRK-TAXABLE-WAGE-BASE PIC S9(07)V9(02) COMP-3.DTSBD530
|
|
00156 DTSBD530
|
|
00157 05 WRK-YTD-BASE-WAGES PIC S9(11)V9(02) COMP-3.DTSBD530
|
|
00158 DTSBD530
|
|
00159 05 WRK-MAX-TAXABLE-WAGES PIC S9(11)V9(02) COMP-3.DTSBD530
|
|
00160 DTSBD530
|
|
00161 05 WRK-DIFF PIC S9(11)V9(02) COMP-3.DTSBD530
|
|
00162 DTSBD530
|
|
00163 05 WRK-RPT-DATE PIC S9(09) COMP-3.DTSBD530
|
|
00164 DTSBD530
|
|
00165 05 WRK-DIFF-IND. DTSBD530
|
|
00166 10 WRK-DIFF-IND-1 PIC X(01). DTSBD530
|
|
00167 88 WRK-DIFF-IND-1-NO VALUE 'N'. DTSBD530
|
|
00168 88 WRK-DIFF-IND-1-YES VALUE 'Y'. DTSBD530
|
|
00169 DTSBD530
|
|
00170 10 WRK-DIFF-IND-2 PIC X(01). DTSBD530
|
|
00171 88 WRK-DIFF-IND-2-NO VALUE 'N'. DTSBD530
|
|
00172 88 WRK-DIFF-IND-2-YES VALUE 'Y'. DTSBD530
|
|
00173 DTSBD530
|
|
00174 10 WRK-DIFF-IND-3 PIC X(01). DTSBD530
|
|
00175 88 WRK-DIFF-IND-3-NO VALUE 'N'. DTSBD530
|
|
00176 88 WRK-DIFF-IND-3-YES VALUE 'Y'. DTSBD530
|
|
00177 EJECT DTSBD530
|
|
00178 01 MSG-TABLE. DTSBD530
|
|
00179 05 MSG01-AREA. DTSBD530
|
|
00180 10 MSG01-ID PIC X(03) VALUE '737'. DTSBD530
|
|
00181 10 MSG01-TEXT. DTSBD530
|
|
00182 15 FILLER PIC X(40) DTSBD530
|
|
00183 VALUE 'WAGE FILE EMP NO DOES NOT EXIST ON TAX F'. DTSBD530
|
|
00184 15 FILLER PIC X(11) DTSBD530
|
|
00185 VALUE 'ILE. SSN: '. DTSBD530
|
|
00186 15 MSG01-SSN PIC XXXBXXBXXXX. DTSBD530
|
|
00187 EJECT DTSBD530
|
|
00188 01 L001-LINK-AREA. DTSBD530
|
|
00189 ++INCLUDE DTSIL001 DTSBD530
|
|
00190 SKIP3 DTSBD530
|
|
00191 01 L004-LINK-AREA. DTSBD530
|
|
00192 ++INCLUDE DTSIL004 DTSBD530
|
|
00193 SKIP3 DTSBD530
|
|
00194 01 L516-LINK-AREA. DTSBD530
|
|
00195 ++INCLUDE DTSIL516 DTSBD530
|
|
00196 EJECT DTSBD530
|
|
00197 01 L910-LINK-AREA. DTSBD530
|
|
00198 ++INCLUDE DTSIL910 DTSBD530
|
|
00199 EJECT DTSBD530
|
|
00200 01 MSKL-REC. DTSBD530
|
|
00201 ++INCLUDE DTSIMSKL DTSBD530
|
|
00202 EJECT DTSBD530
|
|
00203 01 MPRF-REC. DTSBD530
|
|
00204 ++INCLUDE DTSIMPRF DTSBD530
|
|
00205 SKIP3 DTSBD530
|
|
00206 01 MQTR-REC. DTSBD530
|
|
00207 ++INCLUDE DTSIMQTR DTSBD530
|
|
00208 SKIP3 DTSBD530
|
|
00209 01 MRPT-REC. DTSBD530
|
|
00210 ++INCLUDE DTSIMRPT DTSBD530
|
|
00211 SKIP3 DTSBD530
|
|
00212 01 MTAD-REC. DTSBD530
|
|
00213 ++INCLUDE DTSIMTAD DTSBD530
|
|
00214 EJECT DTSBD530
|
|
00215 01 L931-LINK-AREA. DTSBD530
|
|
00216 ++INCLUDE DTSIL931 DTSBD530
|
|
00217 EJECT DTSBD530
|
|
00218 01 FSKL-REC. DTSBD530
|
|
00219 ++INCLUDE DTSIFSKL DTSBD530
|
|
00220 EJECT DTSBD530
|
|
00221 01 FCYR-REC. DTSBD530
|
|
00222 ++INCLUDE DTSIFCYR DTSBD530
|
|
00223 EJECT DTSBD530
|
|
00224 01 R737-REC. DTSBD530
|
|
00225 ++INCLUDE DTSIR737 DTSBD530
|
|
00226 SKIP3 DTSBD530
|
|
00227 01 R907-REC. DTSBD530
|
|
00228 ++INCLUDE DTSIR907 DTSBD530
|
|
00229 EJECT DTSBD530
|
|
00230 LINKAGE SECTION. DTSBD530
|
|
00231 SKIP3 DTSBD530
|
|
00232 01 PARM-AREA. DTSBD530
|
|
00233 05 PARM-LENGTH PIC S9(04) COMP. DTSBD530
|
|
00234 DTSBD530
|
|
00235 05 PARM-DATA. DTSBD530
|
|
00236 10 PARM-YRQ-X PIC X(03). DTSBD530
|
|
00237 10 PARM-TOL-AREA OCCURS 3 TIMES DTSBD530
|
|
00238 INDEXED BY PARM-TOL-IDX. DTSBD530
|
|
00239 15 FILLER PIC X(01). DTSBD530
|
|
00240 15 PARM-TOL-MIN-AMT-X PIC X(05). DTSBD530
|
|
00241 15 PARM-TOL-MIN-AMT REDEFINES PARM-TOL-MIN-AMT-X DTSBD530
|
|
00242 PIC 9(05). DTSBD530
|
|
00243 EJECT DTSBD530
|
|
00244 PROCEDURE DIVISION USING PARM-AREA. DTSBD530
|
|
00245 DTSBD530
|
|
00246 DTSBD530
|
|
00247 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBD530
|
|
00248 DTSBD530
|
|
00249 DTSBD530
|
|
00250 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBD530
|
|
00251 DTSBD530
|
|
00252 MOVE +0 TO MSKL-EMP-NO. DTSBD530
|
|
00253 DTSBD530
|
|
00254 SET MSKL-PRF-88 TO TRUE. DTSBD530
|
|
00255 DTSBD530
|
|
00256 PERFORM S910-START-BROWSE THRU S910-EXIT. DTSBD530
|
|
00257 DTSBD530
|
|
00258 IF L910-OK-88 DTSBD530
|
|
00259 MOVE MSKL-REC TO MPRF-REC. DTSBD530
|
|
00260 DTSBD530
|
|
00261 DTSBD530
|
|
00262 PERFORM SEXT-READ THRU SEXT-EXIT. DTSBD530
|
|
00263 DTSBD530
|
|
00264 DTSBD530
|
|
00265 PERFORM P0000-PROCESS THRU P0000-EXIT DTSBD530
|
|
00266 UNTIL (MPRF-EMP-NO = ALL-NINES-EMP-NO) DTSBD530
|
|
00267 AND DTSBD530
|
|
00268 (EXT-FILE-EMP-NO = ALL-NINES-EMP-NO). DTSBD530
|
|
00269 DTSBD530
|
|
00270 DTSBD530
|
|
00271 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBD530
|
|
00272 DTSBD530
|
|
00273 DTSBD530
|
|
00274 GOBACK. DTSBD530
|
|
00275 EJECT DTSBD530
|
|
00276 I0000-INITIATE. DTSBD530
|
|
00277 MOVE MOD-NAME TO L910-MOD-NAME DTSBD530
|
|
00278 L931-MOD-NAME DTSBD530
|
|
00279 R907-MODULE-NAME. DTSBD530
|
|
00280 DTSBD530
|
|
00281 MOVE 'N' TO L910-TRACE-IND DTSBD530
|
|
00282 L931-TRACE-IND DTSBD530
|
|
00283 L516-TRACE-IND. DTSBD530
|
|
00284 DTSBD530
|
|
00285 MOVE +0 TO IN-EXT-CNT. DTSBD530
|
|
00286 DTSBD530
|
|
00287 MOVE LENGTH OF R737-REC TO R737-LENGTH. DTSBD530
|
|
00288 DTSBD530
|
|
00289 MOVE LENGTH OF R907-REC TO R907-LENGTH. DTSBD530
|
|
00290 DTSBD530
|
|
00291 MOVE '737' TO R737-REC-TYPE. DTSBD530
|
|
00292 DTSBD530
|
|
00293 MOVE '907' TO R907-REC-TYPE. DTSBD530
|
|
00294 DTSBD530
|
|
00295 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBD530
|
|
00296 DTSBD530
|
|
00297 PERFORM S931-OPEN-READ THRU S931-EXIT. DTSBD530
|
|
00298 DTSBD530
|
|
00299 PERFORM SEXT-OPEN-INPUT THRU SEXT-EXIT. DTSBD530
|
|
00300 DTSBD530
|
|
00301 PERFORM I1000-PARMS THRU I1000-EXIT. DTSBD530
|
|
00302 DTSBD530
|
|
00303 PERFORM I2000-TAXABLE-WAGE-BASE THRU I2000-EXIT. DTSBD530
|
|
00304 I0000-EXIT. DTSBD530
|
|
00305 EXIT. DTSBD530
|
|
00306 SKIP3 DTSBD530
|
|
00307 I1000-PARMS. DTSBD530
|
|
00308 IF PARM-LENGTH = +21 DTSBD530
|
|
00309 NEXT SENTENCE DTSBD530
|
|
00310 ELSE DTSBD530
|
|
00311 MOVE 'PARM-LENGTH NOT EQUAL TO 21' DTSBD530
|
|
00312 TO ABEND-MSG DTSBD530
|
|
00313 PERFORM S999-ABEND THRU S999-EXIT. DTSBD530
|
|
00314 DTSBD530
|
|
00315 DISPLAY '***'. DTSBD530
|
|
00316 DTSBD530
|
|
00317 DISPLAY '*** ' DTSBD530
|
|
00318 MOD-NAME DTSBD530
|
|
00319 ' PARAMETERS: ' DTSBD530
|
|
00320 PARM-DATA. DTSBD530
|
|
00321 DTSBD530
|
|
00322 DISPLAY '***'. DTSBD530
|
|
00323 DTSBD530
|
|
00324 DTSBD530
|
|
00325 MOVE PARM-YRQ-X TO L004-QTR-3. DTSBD530
|
|
00326 DTSBD530
|
|
00327 PERFORM S004-FROM-3 THRU S004-EXIT. DTSBD530
|
|
00328 DTSBD530
|
|
00329 IF (L004-INVALID-QTR) DTSBD530
|
|
00330 OR DTSBD530
|
|
00331 (L004-QTR-5-9 <= WRK-PICKUP-YRQ) DTSBD530
|
|
00332 MOVE 'PARM-YRQ-X NOT VALID' DTSBD530
|
|
00333 TO ABEND-MSG DTSBD530
|
|
00334 PERFORM S999-ABEND THRU S999-EXIT. DTSBD530
|
|
00335 DTSBD530
|
|
00336 MOVE L004-QTR-5-Q TO WRK-YRQ-CNT. DTSBD530
|
|
00337 DTSBD530
|
|
00338 MOVE L004-QTR-5-9 TO WRK-END-YRQ. DTSBD530
|
|
00339 DTSBD530
|
|
00340 MOVE 1 TO L004-QTR-5-Q. DTSBD530
|
|
00341 DTSBD530
|
|
00342 MOVE L004-QTR-5-9 TO WRK-START-YRQ. DTSBD530
|
|
00343 DTSBD530
|
|
00344 PERFORM DTSBD530
|
|
00345 VARYING L004-QTR-5-Q FROM 1 BY 1 DTSBD530
|
|
00346 UNTIL L004-QTR-5-Q > WRK-YRQ-CNT DTSBD530
|
|
00347 MOVE L004-QTR-5-9 TO WRK-YRQ (L004-QTR-5-Q) DTSBD530
|
|
00348 END-PERFORM. DTSBD530
|
|
00349 DTSBD530
|
|
00350 MOVE +0 TO WRK-TOL-CNT. DTSBD530
|
|
00351 DTSBD530
|
|
00352 PERFORM I1100-TOL-MIN-AMT THRU I1100-EXIT DTSBD530
|
|
00353 VARYING PARM-TOL-IDX FROM 1 BY 1 DTSBD530
|
|
00354 UNTIL PARM-TOL-IDX > WRK-TOL-MAX-CNT. DTSBD530
|
|
00355 DTSBD530
|
|
00356 PERFORM DTSBD530
|
|
00357 VARYING WRK-TOL-SUB2 FROM 2 BY 1 DTSBD530
|
|
00358 UNTIL WRK-TOL-SUB2 > WRK-TOL-CNT DTSBD530
|
|
00359 COMPUTE WRK-TOL-SUB1 = WRK-TOL-SUB2 - 1 DTSBD530
|
|
00360 IF WRK-TOL-MIN-AMT (WRK-TOL-SUB2) DTSBD530
|
|
00361 <= WRK-TOL-MIN-AMT (WRK-TOL-SUB1) DTSBD530
|
|
00362 MOVE 'PARM-TOL-MIN-AMT NOT IN ASCENDING SEQUENCE' DTSBD530
|
|
00363 TO ABEND-MSG DTSBD530
|
|
00364 PERFORM S999-ABEND THRU S999-EXIT DTSBD530
|
|
00365 END-IF DTSBD530
|
|
00366 END-PERFORM. DTSBD530
|
|
00367 DTSBD530
|
|
00368 PERFORM DTSBD530
|
|
00369 VARYING WRK-TOL-SUB2 FROM 2 BY 1 DTSBD530
|
|
00370 UNTIL WRK-TOL-SUB2 > WRK-TOL-CNT DTSBD530
|
|
00371 COMPUTE WRK-TOL-SUB1 = WRK-TOL-SUB2 - 1 DTSBD530
|
|
00372 COMPUTE WRK-TOL-MAX-AMT (WRK-TOL-SUB1) DTSBD530
|
|
00373 = WRK-TOL-MIN-AMT (WRK-TOL-SUB2) - 0.01 DTSBD530
|
|
00374 END-PERFORM. DTSBD530
|
|
00375 DTSBD530
|
|
00376 SET R737-TOL-MAX-BLANK-88 TO TRUE. DTSBD530
|
|
00377 DTSBD530
|
|
00378 MOVE R737-TOL-MAX-AMT TO WRK-TOL-MAX-AMT (WRK-TOL-CNT). DTSBD530
|
|
00379 I1000-EXIT. DTSBD530
|
|
00380 EXIT. DTSBD530
|
|
00381 SKIP3 DTSBD530
|
|
00382 I1100-TOL-MIN-AMT. DTSBD530
|
|
00383 IF PARM-TOL-MIN-AMT-X (PARM-TOL-IDX) NOT NUMERIC DTSBD530
|
|
00384 MOVE 'PARM-TOL-MIN-AMT NOT NUMERIC' DTSBD530
|
|
00385 TO ABEND-MSG DTSBD530
|
|
00386 PERFORM S999-ABEND THRU S999-EXIT. DTSBD530
|
|
00387 DTSBD530
|
|
00388 IF PARM-TOL-MIN-AMT (PARM-TOL-IDX) = 0 DTSBD530
|
|
00389 MOVE 'PARM-TOL-MIN-AMT EQUAL TO ZERO' DTSBD530
|
|
00390 TO ABEND-MSG DTSBD530
|
|
00391 PERFORM S999-ABEND THRU S999-EXIT. DTSBD530
|
|
00392 DTSBD530
|
|
00393 ADD +1 TO WRK-TOL-CNT. DTSBD530
|
|
00394 DTSBD530
|
|
00395 MOVE PARM-TOL-MIN-AMT (PARM-TOL-IDX) DTSBD530
|
|
00396 TO WRK-TOL-MIN-AMT (WRK-TOL-CNT). DTSBD530
|
|
00397 I1100-EXIT. DTSBD530
|
|
00398 EXIT. DTSBD530
|
|
00399 SKIP3 DTSBD530
|
|
00400 I2000-TAXABLE-WAGE-BASE. DTSBD530
|
|
00401 MOVE WRK-START-YRQ TO L004-QTR-5-9. DTSBD530
|
|
00402 DTSBD530
|
|
00403 MOVE LOW-VALUES TO FCYR-KEY-AREA. DTSBD530
|
|
00404 DTSBD530
|
|
00405 SET FCYR-CYR-88 TO TRUE. DTSBD530
|
|
00406 DTSBD530
|
|
00407 MOVE L004-QTR-5-YR TO FCYR-YR. DTSBD530
|
|
00408 DTSBD530
|
|
00409 MOVE FCYR-KEY-AREA TO FSKL-KEY-AREA. DTSBD530
|
|
00410 DTSBD530
|
|
00411 PERFORM S931-READ THRU S931-EXIT. DTSBD530
|
|
00412 DTSBD530
|
|
00413 IF L931-NO-REC-88 DTSBD530
|
|
00414 MOVE 'TAXABLE WAGE BASE NOT FOUND' DTSBD530
|
|
00415 TO ABEND-MSG DTSBD530
|
|
00416 PERFORM S999-ABEND THRU S999-EXIT. DTSBD530
|
|
00417 DTSBD530
|
|
00418 MOVE FSKL-REC TO FCYR-REC. DTSBD530
|
|
00419 DTSBD530
|
|
00420 MOVE FCYR-TAXABLE-WAGE-BASE TO WRK-TAXABLE-WAGE-BASE. DTSBD530
|
|
00421 I2000-EXIT. DTSBD530
|
|
00422 EXIT. DTSBD530
|
|
00423 EJECT DTSBD530
|
|
00424 P0000-PROCESS. DTSBD530
|
|
00425 IF MPRF-EMP-NO < EXT-FILE-EMP-NO DTSBD530
|
|
00426 PERFORM P1000-MST-ONLY THRU P1000-EXIT DTSBD530
|
|
00427 PERFORM P0100-NEXT-MPRF THRU P0100-EXIT DTSBD530
|
|
00428 ELSE DTSBD530
|
|
00429 IF EXT-FILE-EMP-NO < MPRF-EMP-NO DTSBD530
|
|
00430 PERFORM P2000-EXT-ONLY THRU P2000-EXIT DTSBD530
|
|
00431 ELSE DTSBD530
|
|
00432 PERFORM P3000-MST-AND-EXT THRU P3000-EXIT DTSBD530
|
|
00433 PERFORM P0100-NEXT-MPRF THRU P0100-EXIT. DTSBD530
|
|
00434 P0000-EXIT. DTSBD530
|
|
00435 EXIT. DTSBD530
|
|
00436 SKIP3 DTSBD530
|
|
00437 P0100-NEXT-MPRF. DTSBD530
|
|
00438 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSBD530
|
|
00439 DTSBD530
|
|
00440 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBD530
|
|
00441 DTSBD530
|
|
00442 IF L910-OK-88 DTSBD530
|
|
00443 MOVE MSKL-REC TO MPRF-REC. DTSBD530
|
|
00444 P0100-EXIT. DTSBD530
|
|
00445 EXIT. DTSBD530
|
|
00446 EJECT DTSBD530
|
|
00447 P1000-MST-ONLY. DTSBD530
|
|
00448 IF MPRF-STATUS-ACT-88 DTSBD530
|
|
00449 NEXT SENTENCE DTSBD530
|
|
00450 ELSE DTSBD530
|
|
00451 GO TO P1000-EXIT. DTSBD530
|
|
00452 DTSBD530
|
|
00453 IF MPRF-CLASS-RATED-88 DTSBD530
|
|
00454 NEXT SENTENCE DTSBD530
|
|
00455 ELSE DTSBD530
|
|
00456 GO TO P1000-EXIT. DTSBD530
|
|
00457 DTSBD530
|
|
00458 PERFORM S1000-INITIALIZE-R737 THRU S1000-EXIT. DTSBD530
|
|
00459 DTSBD530
|
|
00460 PERFORM S2000-MQTR-TO-R737 THRU S2000-EXIT. DTSBD530
|
|
00461 DTSBD530
|
|
00462 PERFORM S8000-R737-TOL-GROUP-IND THRU S8000-EXIT. DTSBD530
|
|
00463 DTSBD530
|
|
00464 IF R737-TOL-GROUP-IND-NUM > 0 DTSBD530
|
|
00465 PERFORM S9000-R737-ADDRESS THRU S9000-EXIT DTSBD530
|
|
00466 PERFORM S946-WRITE-R737 THRU S946-EXIT. DTSBD530
|
|
00467 P1000-EXIT. DTSBD530
|
|
00468 EXIT. DTSBD530
|
|
00469 EJECT DTSBD530
|
|
00470 P2000-EXT-ONLY. DTSBD530
|
|
00471 MOVE X737-SSN TO MSG01-SSN. DTSBD530
|
|
00472 DTSBD530
|
|
00473 MOVE MSG01-ID TO R907-MSG-ID. DTSBD530
|
|
00474 DTSBD530
|
|
00475 MOVE X737-EMP-NO TO R907-EMP-NO. DTSBD530
|
|
00476 DTSBD530
|
|
00477 MOVE MSG01-TEXT TO R907-MSG-TEXT. DTSBD530
|
|
00478 DTSBD530
|
|
00479 PERFORM S946-WRITE-R907 THRU S946-EXIT. DTSBD530
|
|
00480 DTSBD530
|
|
00481 PERFORM SEXT-READ THRU SEXT-EXIT. DTSBD530
|
|
00482 P2000-EXIT. DTSBD530
|
|
00483 EXIT. DTSBD530
|
|
00484 EJECT DTSBD530
|
|
00485 P3000-MST-AND-EXT. DTSBD530
|
|
00486 IF MPRF-STATUS-ACT-88 DTSBD530
|
|
00487 NEXT SENTENCE DTSBD530
|
|
00488 ELSE DTSBD530
|
|
00489 PERFORM SEXT-READ THRU SEXT-EXIT DTSBD530
|
|
00490 UNTIL EXT-FILE-EMP-NO NOT = MPRF-EMP-NO DTSBD530
|
|
00491 GO TO P3000-EXIT. DTSBD530
|
|
00492 DTSBD530
|
|
00493 IF MPRF-CLASS-RATED-88 DTSBD530
|
|
00494 NEXT SENTENCE DTSBD530
|
|
00495 ELSE DTSBD530
|
|
00496 PERFORM SEXT-READ THRU SEXT-EXIT DTSBD530
|
|
00497 UNTIL EXT-FILE-EMP-NO NOT = MPRF-EMP-NO DTSBD530
|
|
00498 GO TO P3000-EXIT. DTSBD530
|
|
00499 DTSBD530
|
|
00500 PERFORM S1000-INITIALIZE-R737 THRU S1000-EXIT. DTSBD530
|
|
00501 DTSBD530
|
|
00502 PERFORM S2000-MQTR-TO-R737 THRU S2000-EXIT. DTSBD530
|
|
00503 DTSBD530
|
|
00504 PERFORM DTSBD530
|
|
00505 UNTIL EXT-FILE-EMP-NO NOT = MPRF-EMP-NO DTSBD530
|
|
00506 PERFORM S3000-EXT-TO-R737 THRU S3000-EXIT DTSBD530
|
|
00507 PERFORM SEXT-READ THRU SEXT-EXIT DTSBD530
|
|
00508 END-PERFORM. DTSBD530
|
|
00509 DTSBD530
|
|
00510 PERFORM S8000-R737-TOL-GROUP-IND THRU S8000-EXIT. DTSBD530
|
|
00511 DTSBD530
|
|
00512 IF R737-TOL-GROUP-IND-NUM > 0 DTSBD530
|
|
00513 PERFORM S9000-R737-ADDRESS THRU S9000-EXIT DTSBD530
|
|
00514 PERFORM S946-WRITE-R737 THRU S946-EXIT. DTSBD530
|
|
00515 P3000-EXIT. DTSBD530
|
|
00516 EXIT. DTSBD530
|
|
00517 EJECT DTSBD530
|
|
00518 *************************************************************** DTSBD530
|
|
00519 * THIS PARAGRAPH INITIALIZES THE R737 DATA FIELDS. DTSBD530
|
|
00520 *************************************************************** DTSBD530
|
|
00521 DTSBD530
|
|
00522 S1000-INITIALIZE-R737. DTSBD530
|
|
00523 DTSBD530
|
|
00524 MOVE 0 TO R737-TOL-GROUP-IND-NUM. DTSBD530
|
|
00525 DTSBD530
|
|
00526 MOVE MPRF-EMP-NO TO R737-EMP-NO. DTSBD530
|
|
00527 DTSBD530
|
|
00528 MOVE 0 TO R737-TOL-MIN-AMT DTSBD530
|
|
00529 R737-TOL-MAX-AMT. DTSBD530
|
|
00530 DTSBD530
|
|
00531 MOVE MPRF-PRIMARY-NAME TO R737-PRIMARY-NAME. DTSBD530
|
|
00532 DTSBD530
|
|
00533 MOVE SPACES TO R737-ADDRESS. DTSBD530
|
|
00534 DTSBD530
|
|
00535 MOVE +0 TO R737-YRQ-CNT. DTSBD530
|
|
00536 DTSBD530
|
|
00537 PERFORM DTSBD530
|
|
00538 VARYING WRK-YRQ-IDX FROM 1 BY 1 DTSBD530
|
|
00539 UNTIL WRK-YRQ-IDX > WRK-YRQ-CNT DTSBD530
|
|
00540 ADD +1 TO R737-YRQ-CNT DTSBD530
|
|
00541 MOVE WRK-YRQ (WRK-YRQ-IDX) DTSBD530
|
|
00542 TO R737-YRQ (R737-YRQ-CNT) DTSBD530
|
|
00543 MOVE +0 TO R737-TOT-FROM-DTS (R737-YRQ-CNT) DTSBD530
|
|
00544 R737-TOT-FROM-WAGE (R737-YRQ-CNT) DTSBD530
|
|
00545 R737-TAX-FROM-DTS (R737-YRQ-CNT) DTSBD530
|
|
00546 R737-TAX-FROM-WAGE (R737-YRQ-CNT) DTSBD530
|
|
00547 R737-BATCH-NO (R737-YRQ-CNT) DTSBD530
|
|
00548 MOVE SPACE TO R737-TOT-DIFFERENCE-IND (R737-YRQ-CNT) DTSBD530
|
|
00549 R737-TAX-DIFFERENCE-IND (R737-YRQ-CNT) DTSBD530
|
|
00550 SET MQTR-NO-UI-RATE-88 TO TRUE DTSBD530
|
|
00551 MOVE MQTR-UI-RATE TO R737-UI-RATE (R737-YRQ-CNT) DTSBD530
|
|
00552 END-PERFORM. DTSBD530
|
|
00553 S1000-EXIT. DTSBD530
|
|
00554 EXIT. DTSBD530
|
|
00555 EJECT DTSBD530
|
|
00556 ************************************************************ DTSBD530
|
|
00557 * THIS PARAGRAPH CAUSES THE MQTR RECORDS TO BE READ IN DTSBD530
|
|
00558 * ORDER TO FIND THE DATA FOR R737-TOT-FROM-DTS, DTSBD530
|
|
00559 * R737-TAX-FROM-DTS AND R737-UI-RATE. DTSBD530
|
|
00560 ************************************************************ DTSBD530
|
|
00561 DTSBD530
|
|
00562 S2000-MQTR-TO-R737. DTSBD530
|
|
00563 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSBD530
|
|
00564 DTSBD530
|
|
00565 SET MQTR-QTR-88 TO TRUE. DTSBD530
|
|
00566 DTSBD530
|
|
00567 MOVE MPRF-EMP-NO TO MQTR-EMP-NO. DTSBD530
|
|
00568 DTSBD530
|
|
00569 PERFORM S2100-READ-MQTR THRU S2100-EXIT DTSBD530
|
|
00570 VARYING WRK-YRQ-IDX FROM 1 BY 1 DTSBD530
|
|
00571 UNTIL WRK-YRQ-IDX GREATER THAN WRK-YRQ-CNT. DTSBD530
|
|
00572 S2000-EXIT. DTSBD530
|
|
00573 EXIT. DTSBD530
|
|
00574 EJECT DTSBD530
|
|
00575 ************************************************************ DTSBD530
|
|
00576 * THIS PARAGRAPH MOVES THE DATA TO THE R737-TOT-FROM-DTS, DTSBD530
|
|
00577 * R737-TAX-FROM-DTS, AND R737-UI-RATE. IF THE MQTR IS DTSBD530
|
|
00578 * MQTR-CURR-RCVD-88, THE MPRT RECORDS ARE SCANNED FOR THE DTSBD530
|
|
00579 * MOST RECENT RECEIVED DATE FOR THE ORIGINAL REPORT. DTSBD530
|
|
00580 * ESTIMATED REPORTS HAVE THE ABOVE FIELDS SET TO ZERO. DTSBD530
|
|
00581 ************************************************************ DTSBD530
|
|
00582 DTSBD530
|
|
00583 S2100-READ-MQTR. DTSBD530
|
|
00584 SET R737-YRQ-IDX TO WRK-YRQ-IDX. DTSBD530
|
|
00585 DTSBD530
|
|
00586 MOVE WRK-YRQ (WRK-YRQ-IDX) TO MQTR-YRQ. DTSBD530
|
|
00587 DTSBD530
|
|
00588 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBD530
|
|
00589 DTSBD530
|
|
00590 PERFORM S910-READ THRU S910-EXIT. DTSBD530
|
|
00591 DTSBD530
|
|
00592 IF L910-OK-88 DTSBD530
|
|
00593 NEXT SENTENCE DTSBD530
|
|
00594 ELSE DTSBD530
|
|
00595 PERFORM S2110-RATE THRU S2110-EXIT DTSBD530
|
|
00596 GO TO S2100-EXIT. DTSBD530
|
|
00597 DTSBD530
|
|
00598 MOVE MSKL-REC TO MQTR-REC. DTSBD530
|
|
00599 DTSBD530
|
|
00600 MOVE MQTR-YRQ TO R737-YRQ (R737-YRQ-IDX). DTSBD530
|
|
00601 DTSBD530
|
|
00602 IF MQTR-CURR-RCVD-88 DTSBD530
|
|
00603 MOVE MQTR-TOT-WAGE TO R737-TOT-FROM-DTS (R737-YRQ-IDX) DTSBD530
|
|
00604 MOVE MQTR-TAX-WAGE TO R737-TAX-FROM-DTS (R737-YRQ-IDX). DTSBD530
|
|
00605 DTSBD530
|
|
00606 MOVE MQTR-UI-RATE TO R737-UI-RATE (R737-YRQ-IDX). DTSBD530
|
|
00607 DTSBD530
|
|
00608 IF MQTR-CURR-RCVD-88 DTSBD530
|
|
00609 MOVE LOW-VALUES TO MRPT-KEY-AREA DTSBD530
|
|
00610 MOVE ZEROS TO WRK-RPT-DATE DTSBD530
|
|
00611 MOVE MPRF-EMP-NO TO MRPT-EMP-NO DTSBD530
|
|
00612 SET MRPT-RPT-88 TO TRUE DTSBD530
|
|
00613 MOVE MQTR-YRQ TO MRPT-YRQ DTSBD530
|
|
00614 MOVE MRPT-KEY-AREA TO MSKL-KEY-AREA DTSBD530
|
|
00615 DTSBD530
|
|
00616 PERFORM S910-START-BROWSE THRU S910-EXIT DTSBD530
|
|
00617 DTSBD530
|
|
00618 PERFORM S2120-SCAN-MRPT THRU S2120-EXIT DTSBD530
|
|
00619 UNTIL L910-NO-REC-88. DTSBD530
|
|
00620 S2100-EXIT. DTSBD530
|
|
00621 EXIT. DTSBD530
|
|
00622 SKIP3 DTSBD530
|
|
00623 S2110-RATE. DTSBD530
|
|
00624 MOVE MQTR-YRQ TO L516-YRQ. DTSBD530
|
|
00625 DTSBD530
|
|
00626 PERFORM S516-LIAB-RATE THRU S516-EXIT. DTSBD530
|
|
00627 DTSBD530
|
|
00628 MOVE L516-UI-RATE TO R737-UI-RATE (R737-YRQ-IDX). DTSBD530
|
|
00629 S2110-EXIT. DTSBD530
|
|
00630 EXIT. DTSBD530
|
|
00631 EJECT DTSBD530
|
|
00632 ************************************************************ DTSBD530
|
|
00633 * THIS PARAGRAPH SCANS THE MRPT RECORDS TO FIND THE DTSBD530
|
|
00634 * BATCH NUMBER OF THE MOST RECENT ORIGINAL REPORT FOR DTSBD530
|
|
00635 * THE QUARTER. DTSBD530
|
|
00636 ************************************************************ DTSBD530
|
|
00637 DTSBD530
|
|
00638 S2120-SCAN-MRPT. DTSBD530
|
|
00639 MOVE MSKL-REC TO MRPT-REC. DTSBD530
|
|
00640 DTSBD530
|
|
00641 IF MRPT-YRQ = MQTR-YRQ DTSBD530
|
|
00642 NEXT SENTENCE DTSBD530
|
|
00643 ELSE DTSBD530
|
|
00644 SET L910-NO-REC-88 TO TRUE DTSBD530
|
|
00645 GO TO S2120-EXIT. DTSBD530
|
|
00646 DTSBD530
|
|
00647 IF MRPT-ORIG-88 DTSBD530
|
|
00648 IF MRPT-RECEIVED-DATE GREATER THAN WRK-RPT-DATE DTSBD530
|
|
00649 MOVE MRPT-RECEIVED-DATE TO WRK-RPT-DATE DTSBD530
|
|
00650 MOVE MRPT-BATCH-NO TO R737-BATCH-NO (R737-YRQ-IDX). DTSBD530
|
|
00651 DTSBD530
|
|
00652 PERFORM S910-READ-NEXT THRU S910-EXIT. DTSBD530
|
|
00653 S2120-EXIT. DTSBD530
|
|
00654 EXIT. DTSBD530
|
|
00655 EJECT DTSBD530
|
|
00656 *************************************************************** DTSBD530
|
|
00657 * THIS PARAGRAPH ACCUMULATES R737-TAX-FROM-WAGE AND R737-TOT- DTSBD530
|
|
00658 * FROM-WAGE FROM THE X737 RECORD. THERE WILL BE ONLY ONE DTSBD530
|
|
00659 * X737 RECORD FOR A GIVEN X737-EMP-NO+X737-SSN COMBINATION. DTSBD530
|
|
00660 *************************************************************** DTSBD530
|
|
00661 DTSBD530
|
|
00662 S3000-EXT-TO-R737. DTSBD530
|
|
00663 IF X737-YRQ-CNT EQUAL R737-YRQ-CNT DTSBD530
|
|
00664 NEXT SENTENCE DTSBD530
|
|
00665 ELSE DTSBD530
|
|
00666 MOVE 'LOGIC ERROR S3000-1' TO ABEND-MSG DTSBD530
|
|
00667 PERFORM S999-ABEND THRU S999-EXIT. DTSBD530
|
|
00668 DTSBD530
|
|
00669 MOVE +0 TO WRK-YTD-BASE-WAGES. DTSBD530
|
|
00670 DTSBD530
|
|
00671 PERFORM S3100-YRQ-LOOP THRU S3100-EXIT DTSBD530
|
|
00672 VARYING X737-YRQ-IDX FROM 1 BY 1 DTSBD530
|
|
00673 UNTIL X737-YRQ-IDX GREATER THAN X737-YRQ-CNT. DTSBD530
|
|
00674 S3000-EXIT. DTSBD530
|
|
00675 EXIT. DTSBD530
|
|
00676 SKIP3 DTSBD530
|
|
00677 S3100-YRQ-LOOP. DTSBD530
|
|
00678 SET R737-YRQ-IDX TO X737-YRQ-IDX. DTSBD530
|
|
00679 DTSBD530
|
|
00680 IF R737-YRQ (R737-YRQ-IDX) EQUAL X737-YRQ (X737-YRQ-IDX) DTSBD530
|
|
00681 NEXT SENTENCE DTSBD530
|
|
00682 ELSE DTSBD530
|
|
00683 MOVE 'LOGIC ERROR S3100-1' TO ABEND-MSG DTSBD530
|
|
00684 PERFORM S999-ABEND THRU S999-EXIT. DTSBD530
|
|
00685 DTSBD530
|
|
00686 ADD X737-EMP-WAGES (X737-YRQ-IDX) DTSBD530
|
|
00687 TO R737-TOT-FROM-WAGE (R737-YRQ-IDX). DTSBD530
|
|
00688 DTSBD530
|
|
00689 ADD X737-PRED-WAGES (X737-YRQ-IDX) TO WRK-YTD-BASE-WAGES. DTSBD530
|
|
00690 DTSBD530
|
|
00691 COMPUTE WRK-MAX-TAXABLE-WAGES DTSBD530
|
|
00692 = WRK-TAXABLE-WAGE-BASE - WRK-YTD-BASE-WAGES. DTSBD530
|
|
00693 DTSBD530
|
|
00694 IF WRK-MAX-TAXABLE-WAGES < +0 DTSBD530
|
|
00695 MOVE +0 TO WRK-MAX-TAXABLE-WAGES. DTSBD530
|
|
00696 DTSBD530
|
|
00697 IF WRK-MAX-TAXABLE-WAGES DTSBD530
|
|
00698 < X737-EMP-WAGES (X737-YRQ-IDX) DTSBD530
|
|
00699 ADD WRK-MAX-TAXABLE-WAGES DTSBD530
|
|
00700 TO R737-TAX-FROM-WAGE (R737-YRQ-IDX) DTSBD530
|
|
00701 ELSE DTSBD530
|
|
00702 ADD X737-EMP-WAGES (X737-YRQ-IDX) DTSBD530
|
|
00703 TO R737-TAX-FROM-WAGE (R737-YRQ-IDX). DTSBD530
|
|
00704 DTSBD530
|
|
00705 ADD X737-EMP-WAGES (X737-YRQ-IDX) DTSBD530
|
|
00706 TO WRK-YTD-BASE-WAGES. DTSBD530
|
|
00707 S3100-EXIT. DTSBD530
|
|
00708 EXIT. DTSBD530
|
|
00709 EJECT DTSBD530
|
|
00710 ***************************************************************** DTSBD530
|
|
00711 * THIS PARAGRAPH USES THE R737-*-FROM* VALUES AND WORK-TOL-AREA DTSBD530
|
|
00712 * TO DETERMINE THE R737-*-DIFFERENCE-IND, R737-TOL-GROU-IND, DTSBD530
|
|
00713 * R737-TOL-MIN-AMT AND R737-TOL-MAX-AMT. DTSBD530
|
|
00714 ***************************************************************** DTSBD530
|
|
00715 DTSBD530
|
|
00716 S8000-R737-TOL-GROUP-IND. DTSBD530
|
|
00717 SET WRK-DIFF-IND-1-NO TO TRUE. DTSBD530
|
|
00718 DTSBD530
|
|
00719 SET WRK-DIFF-IND-2-NO TO TRUE. DTSBD530
|
|
00720 DTSBD530
|
|
00721 SET WRK-DIFF-IND-3-NO TO TRUE. DTSBD530
|
|
00722 DTSBD530
|
|
00723 DTSBD530
|
|
00724 PERFORM S8100-SCAN-QTR THRU S8100-EXIT DTSBD530
|
|
00725 VARYING R737-YRQ-IDX FROM 1 BY 1 DTSBD530
|
|
00726 UNTIL R737-YRQ-IDX GREATER THAN R737-YRQ-CNT. DTSBD530
|
|
00727 DTSBD530
|
|
00728 IF WRK-DIFF-IND-3-YES DTSBD530
|
|
00729 MOVE '3' TO R737-TOL-GROUP-IND DTSBD530
|
|
00730 ELSE DTSBD530
|
|
00731 IF WRK-DIFF-IND-2-YES DTSBD530
|
|
00732 MOVE '2' TO R737-TOL-GROUP-IND DTSBD530
|
|
00733 ELSE DTSBD530
|
|
00734 IF WRK-DIFF-IND-1-YES DTSBD530
|
|
00735 MOVE '1' TO R737-TOL-GROUP-IND. DTSBD530
|
|
00736 DTSBD530
|
|
00737 IF R737-TOL-GROUP-IND-NUM > +0 DTSBD530
|
|
00738 MOVE WRK-TOL-MIN-AMT (R737-TOL-GROUP-IND-NUM) DTSBD530
|
|
00739 TO R737-TOL-MIN-AMT DTSBD530
|
|
00740 MOVE WRK-TOL-MAX-AMT (R737-TOL-GROUP-IND-NUM) DTSBD530
|
|
00741 TO R737-TOL-MAX-AMT. DTSBD530
|
|
00742 S8000-EXIT. DTSBD530
|
|
00743 EXIT. DTSBD530
|
|
00744 SKIP3 DTSBD530
|
|
00745 S8100-SCAN-QTR. DTSBD530
|
|
00746 COMPUTE WRK-DIFF DTSBD530
|
|
00747 = R737-TOT-FROM-DTS (R737-YRQ-IDX) DTSBD530
|
|
00748 - R737-TOT-FROM-WAGE (R737-YRQ-IDX). DTSBD530
|
|
00749 DTSBD530
|
|
00750 IF WRK-DIFF < +0 DTSBD530
|
|
00751 COMPUTE WRK-DIFF = WRK-DIFF * -1. DTSBD530
|
|
00752 DTSBD530
|
|
00753 IF WRK-DIFF >= WRK-TOL-MIN-AMT (1) DTSBD530
|
|
00754 MOVE '**' TO R737-TOT-DIFFERENCE-IND (R737-YRQ-IDX). DTSBD530
|
|
00755 DTSBD530
|
|
00756 PERFORM S8110-SET-DIFF-IND THRU S8110-EXIT. DTSBD530
|
|
00757 DTSBD530
|
|
00758 COMPUTE WRK-DIFF DTSBD530
|
|
00759 = R737-TAX-FROM-DTS (R737-YRQ-IDX) DTSBD530
|
|
00760 - R737-TAX-FROM-WAGE (R737-YRQ-IDX). DTSBD530
|
|
00761 DTSBD530
|
|
00762 IF WRK-DIFF < +0 DTSBD530
|
|
00763 COMPUTE WRK-DIFF = WRK-DIFF * -1. DTSBD530
|
|
00764 DTSBD530
|
|
00765 IF WRK-DIFF >= WRK-TOL-MIN-AMT (1) DTSBD530
|
|
00766 MOVE '**' TO R737-TAX-DIFFERENCE-IND (R737-YRQ-IDX). DTSBD530
|
|
00767 DTSBD530
|
|
00768 PERFORM S8110-SET-DIFF-IND THRU S8110-EXIT. DTSBD530
|
|
00769 S8100-EXIT. DTSBD530
|
|
00770 EXIT. DTSBD530
|
|
00771 EJECT DTSBD530
|
|
00772 ************************************************************* DTSBD530
|
|
00773 * THIS PARGARPH WILL SET THE MAXIMUM DIFFERENCE FOR THE DTSBD530
|
|
00774 * OCCURRENCE. DTSBD530
|
|
00775 ************************************************************* DTSBD530
|
|
00776 DTSBD530
|
|
00777 S8110-SET-DIFF-IND. DTSBD530
|
|
00778 IF WRK-DIFF >= WRK-TOL-MIN-AMT (3) DTSBD530
|
|
00779 SET WRK-DIFF-IND-3-YES TO TRUE DTSBD530
|
|
00780 GO TO S8110-EXIT DTSBD530
|
|
00781 ELSE DTSBD530
|
|
00782 IF WRK-DIFF >= WRK-TOL-MIN-AMT (2) DTSBD530
|
|
00783 SET WRK-DIFF-IND-2-YES TO TRUE DTSBD530
|
|
00784 GO TO S8110-EXIT DTSBD530
|
|
00785 ELSE DTSBD530
|
|
00786 IF WRK-DIFF >= WRK-TOL-MIN-AMT (1) DTSBD530
|
|
00787 SET WRK-DIFF-IND-1-YES TO TRUE DTSBD530
|
|
00788 GO TO S8110-EXIT. DTSBD530
|
|
00789 S8110-EXIT. DTSBD530
|
|
00790 EXIT. DTSBD530
|
|
00791 EJECT DTSBD530
|
|
00792 ************************************************************* DTSBD530
|
|
00793 * THIS PARAGRAPH READS THE MTAD RECORD WITH MTAD-ID-NO DTSBD530
|
|
00794 * EQUAL TO MTAD-ID-TAX-MAILING-ADDR-88. IF FOUND, MOVE MTAD DTSBD530
|
|
00795 * ADDRESS TO R737-ADDRESS; IF NOT, IT MOVES ALL '?' TO THE DTSBD530
|
|
00796 * R737-ADDRESS. DTSBD530
|
|
00797 ************************************************************* DTSBD530
|
|
00798 DTSBD530
|
|
00799 S9000-R737-ADDRESS. DTSBD530
|
|
00800 MOVE LOW-VALUES TO MTAD-KEY-AREA. DTSBD530
|
|
00801 DTSBD530
|
|
00802 MOVE MPRF-EMP-NO TO MTAD-EMP-NO. DTSBD530
|
|
00803 DTSBD530
|
|
00804 SET MTAD-TAD-88 TO TRUE. DTSBD530
|
|
00805 DTSBD530
|
|
00806 SET MTAD-ID-TAX-MAILING-ADDR-88 TO TRUE. DTSBD530
|
|
00807 DTSBD530
|
|
00808 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSBD530
|
|
00809 DTSBD530
|
|
00810 PERFORM S910-READ THRU S910-EXIT. DTSBD530
|
|
00811 DTSBD530
|
|
00812 IF L910-OK-88 DTSBD530
|
|
00813 MOVE MSKL-REC TO MTAD-REC DTSBD530
|
|
00814 MOVE MTAD-ADDRESS TO R737-ADDRESS DTSBD530
|
|
00815 ELSE DTSBD530
|
|
00816 MOVE ALL '?' TO R737-ADDRESS. DTSBD530
|
|
00817 DTSBD530
|
|
00818 S9000-EXIT. DTSBD530
|
|
00819 EXIT. DTSBD530
|
|
00820 EJECT DTSBD530
|
|
00821 T0000-TERMINATE. DTSBD530
|
|
00822 PERFORM S910-CLOSE THRU S910-EXIT. DTSBD530
|
|
00823 DTSBD530
|
|
00824 PERFORM S931-CLOSE THRU S931-EXIT. DTSBD530
|
|
00825 DTSBD530
|
|
00826 MOVE -1 TO R737-LENGTH. DTSBD530
|
|
00827 DTSBD530
|
|
00828 PERFORM S946-WRITE-R737 THRU S946-EXIT. DTSBD530
|
|
00829 DTSBD530
|
|
00830 PERFORM SEXT-CLOSE THRU SEXT-EXIT. DTSBD530
|
|
00831 DTSBD530
|
|
00832 DISPLAY '***'. DTSBD530
|
|
00833 DTSBD530
|
|
00834 DISPLAY '*** ' DTSBD530
|
|
00835 MOD-NAME DTSBD530
|
|
00836 ' TERMINATION STATISTICS'. DTSBD530
|
|
00837 DTSBD530
|
|
00838 DISPLAY '***'. DTSBD530
|
|
00839 DTSBD530
|
|
00840 MOVE WRK-START-YRQ TO L004-QTR-5-9. DTSBD530
|
|
00841 DTSBD530
|
|
00842 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD530
|
|
00843 DTSBD530
|
|
00844 DISPLAY '*** FIRST QUARTER ANALYZED: ' DTSBD530
|
|
00845 L004-SLASH-QTR. DTSBD530
|
|
00846 DTSBD530
|
|
00847 DISPLAY '***'. DTSBD530
|
|
00848 DTSBD530
|
|
00849 MOVE WRK-END-YRQ TO L004-QTR-5-9. DTSBD530
|
|
00850 DTSBD530
|
|
00851 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD530
|
|
00852 DTSBD530
|
|
00853 DISPLAY '*** LAST QUARTER ANALYZED: ' DTSBD530
|
|
00854 L004-SLASH-QTR. DTSBD530
|
|
00855 DTSBD530
|
|
00856 DISPLAY '***'. DTSBD530
|
|
00857 DTSBD530
|
|
00858 MOVE IN-EXT-CNT TO DISPLAY-REC-CNT. DTSBD530
|
|
00859 DTSBD530
|
|
00860 DISPLAY '*** EXTRACT RECORDS READ: ' DTSBD530
|
|
00861 DISPLAY-REC-CNT-X. DTSBD530
|
|
00862 T0000-EXIT. DTSBD530
|
|
00863 EXIT. DTSBD530
|
|
00864 EJECT DTSBD530
|
|
00865 S001-FROM-FED-8. DTSBD530
|
|
00866 SET L001-FROM-FED-8 TO TRUE. DTSBD530
|
|
00867 GO TO S001-DATE. DTSBD530
|
|
00868 DTSBD530
|
|
00869 S001-FROM-ABS-DAY. DTSBD530
|
|
00870 SET L001-FROM-ABS-DAY TO TRUE. DTSBD530
|
|
00871 GO TO S001-DATE. DTSBD530
|
|
00872 DTSBD530
|
|
00873 S001-DATE. DTSBD530
|
|
00874 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBD530
|
|
00875 S001-EXIT. DTSBD530
|
|
00876 EXIT. DTSBD530
|
|
00877 SKIP3 DTSBD530
|
|
00878 S004-FROM-3. DTSBD530
|
|
00879 SET L004-FROM-3 TO TRUE. DTSBD530
|
|
00880 GO TO S004-YRQ. DTSBD530
|
|
00881 DTSBD530
|
|
00882 S004-FROM-5. DTSBD530
|
|
00883 SET L004-FROM-5 TO TRUE. DTSBD530
|
|
00884 GO TO S004-YRQ. DTSBD530
|
|
00885 DTSBD530
|
|
00886 S004-YRQ. DTSBD530
|
|
00887 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBD530
|
|
00888 S004-EXIT. DTSBD530
|
|
00889 EXIT. DTSBD530
|
|
00890 SKIP3 DTSBD530
|
|
00891 S516-LIAB-RATE. DTSBD530
|
|
00892 CALL 'DTSBU516' USING L516-LINK-AREA DTSBD530
|
|
00893 MPRF-REC. DTSBD530
|
|
00894 S516-EXIT. DTSBD530
|
|
00895 EXIT. DTSBD530
|
|
00896 SKIP3 DTSBD530
|
|
00897 S910-OPEN-READ. DTSBD530
|
|
00898 SET L910-OPEN-READ-88 TO TRUE. DTSBD530
|
|
00899 GO TO S910-MSTR-I. DTSBD530
|
|
00900 DTSBD530
|
|
00901 S910-READ. DTSBD530
|
|
00902 SET L910-READ-88 TO TRUE. DTSBD530
|
|
00903 GO TO S910-MSTR-I. DTSBD530
|
|
00904 DTSBD530
|
|
00905 S910-READ-NEXT. DTSBD530
|
|
00906 SET L910-READ-NEXT-88 TO TRUE. DTSBD530
|
|
00907 GO TO S910-MSTR-I. DTSBD530
|
|
00908 DTSBD530
|
|
00909 S910-START-BROWSE. DTSBD530
|
|
00910 SET L910-START-BROWSE-88 TO TRUE. DTSBD530
|
|
00911 GO TO S910-MSTR-I. DTSBD530
|
|
00912 DTSBD530
|
|
00913 S910-CLOSE. DTSBD530
|
|
00914 SET L910-CLOSE-88 TO TRUE. DTSBD530
|
|
00915 GO TO S910-MSTR-I. DTSBD530
|
|
00916 DTSBD530
|
|
00917 S910-MSTR-I. DTSBD530
|
|
00918 CALL 'DTSBU910' USING L910-LINK-AREA DTSBD530
|
|
00919 MSKL-REC. DTSBD530
|
|
00920 DTSBD530
|
|
00921 IF (L910-START-BROWSE-88) DTSBD530
|
|
00922 OR DTSBD530
|
|
00923 (L910-READ-NEXT-88) DTSBD530
|
|
00924 IF MSKL-PRF-88 DTSBD530
|
|
00925 IF L910-OK-88 DTSBD530
|
|
00926 NEXT SENTENCE DTSBD530
|
|
00927 ELSE DTSBD530
|
|
00928 MOVE ALL-NINES-EMP-NO TO MPRF-EMP-NO. DTSBD530
|
|
00929 S910-EXIT. DTSBD530
|
|
00930 EXIT. DTSBD530
|
|
00931 SKIP3 DTSBD530
|
|
00932 S931-OPEN-READ. DTSBD530
|
|
00933 SET L931-OPEN-READ-88 TO TRUE. DTSBD530
|
|
00934 GO TO S931-REF-I. DTSBD530
|
|
00935 DTSBD530
|
|
00936 S931-READ. DTSBD530
|
|
00937 SET L931-READ-88 TO TRUE. DTSBD530
|
|
00938 GO TO S931-REF-I. DTSBD530
|
|
00939 DTSBD530
|
|
00940 S931-CLOSE. DTSBD530
|
|
00941 SET L931-CLOSE-88 TO TRUE. DTSBD530
|
|
00942 GO TO S931-REF-I. DTSBD530
|
|
00943 DTSBD530
|
|
00944 S931-REF-I. DTSBD530
|
|
00945 CALL 'DTSBU931' USING L931-LINK-AREA DTSBD530
|
|
00946 FSKL-REC. DTSBD530
|
|
00947 S931-EXIT. DTSBD530
|
|
00948 EXIT. DTSBD530
|
|
00949 SKIP3 DTSBD530
|
|
00950 S946-WRITE-R737. DTSBD530
|
|
00951 CALL 'DTSBU946' USING R737-REC. DTSBD530
|
|
00952 GO TO S946-EXIT. DTSBD530
|
|
00953 DTSBD530
|
|
00954 S946-WRITE-R907. DTSBD530
|
|
00955 CALL 'DTSBU946' USING R907-REC. DTSBD530
|
|
00956 GO TO S946-EXIT. DTSBD530
|
|
00957 DTSBD530
|
|
00958 S946-EXIT. DTSBD530
|
|
00959 EXIT. DTSBD530
|
|
00960 SKIP3 DTSBD530
|
|
00961 SEXT-OPEN-INPUT. DTSBD530
|
|
00962 OPEN INPUT EXTRACT-FILE. DTSBD530
|
|
00963 DTSBD530
|
|
00964 IF EXT-FILE-OK-88 DTSBD530
|
|
00965 GO TO SEXT-EXIT DTSBD530
|
|
00966 ELSE DTSBD530
|
|
00967 MOVE 'OPEN' TO FILE-COMMAND DTSBD530
|
|
00968 PERFORM SEXT-UNEXPECTED-FILE-STATUS DTSBD530
|
|
00969 THRU SEXT-UNEXPECTED-EXIT DTSBD530
|
|
00970 GO TO SEXT-EXIT. DTSBD530
|
|
00971 DTSBD530
|
|
00972 SEXT-READ. DTSBD530
|
|
00973 READ EXTRACT-FILE. DTSBD530
|
|
00974 DTSBD530
|
|
00975 IF EXT-FILE-OK-88 DTSBD530
|
|
00976 ADD +1 TO IN-EXT-CNT DTSBD530
|
|
00977 MOVE X737-EMP-NO TO EXT-FILE-EMP-NO DTSBD530
|
|
00978 GO TO SEXT-EXIT DTSBD530
|
|
00979 ELSE DTSBD530
|
|
00980 IF EXT-FILE-EOF-88 DTSBD530
|
|
00981 MOVE ALL-NINES-EMP-NO TO EXT-FILE-EMP-NO DTSBD530
|
|
00982 GO TO SEXT-EXIT DTSBD530
|
|
00983 ELSE DTSBD530
|
|
00984 MOVE 'READ' TO FILE-COMMAND DTSBD530
|
|
00985 PERFORM SEXT-UNEXPECTED-FILE-STATUS DTSBD530
|
|
00986 THRU SEXT-UNEXPECTED-EXIT DTSBD530
|
|
00987 GO TO SEXT-EXIT. DTSBD530
|
|
00988 DTSBD530
|
|
00989 SEXT-CLOSE. DTSBD530
|
|
00990 CLOSE EXTRACT-FILE. DTSBD530
|
|
00991 DTSBD530
|
|
00992 IF EXT-FILE-OK-88 DTSBD530
|
|
00993 GO TO SEXT-EXIT DTSBD530
|
|
00994 ELSE DTSBD530
|
|
00995 MOVE 'CLOSE' TO FILE-COMMAND DTSBD530
|
|
00996 PERFORM SEXT-UNEXPECTED-FILE-STATUS DTSBD530
|
|
00997 THRU SEXT-UNEXPECTED-EXIT DTSBD530
|
|
00998 GO TO SEXT-EXIT. DTSBD530
|
|
00999 DTSBD530
|
|
01000 SEXT-EXIT. DTSBD530
|
|
01001 EXIT. DTSBD530
|
|
01002 DTSBD530
|
|
01003 SEXT-UNEXPECTED-FILE-STATUS. DTSBD530
|
|
01004 MOVE SPACES TO ABEND-MSG. DTSBD530
|
|
01005 DTSBD530
|
|
01006 STRING DTSBD530
|
|
01007 'UNEXPECTED EXTRACT FILE STATUS ON ' DTSBD530
|
|
01008 DELIMITED BY SIZE DTSBD530
|
|
01009 FILE-COMMAND DTSBD530
|
|
01010 DELIMITED BY ' ' DTSBD530
|
|
01011 ': ' DTSBD530
|
|
01012 DELIMITED BY SIZE DTSBD530
|
|
01013 EXT-FILE-STATUS DTSBD530
|
|
01014 DELIMITED BY SIZE DTSBD530
|
|
01015 INTO DTSBD530
|
|
01016 ABEND-MSG. DTSBD530
|
|
01017 DTSBD530
|
|
01018 PERFORM S999-ABEND THRU S999-EXIT. DTSBD530
|
|
01019 SEXT-UNEXPECTED-EXIT. DTSBD530
|
|
01020 EXIT. DTSBD530
|
|
01021 SKIP3 DTSBD530
|
|
01022 S999-ABEND. DTSBD530
|
|
01023 DISPLAY '***'. DTSBD530
|
|
01024 DTSBD530
|
|
01025 DISPLAY '*** ' DTSBD530
|
|
01026 MOD-NAME DTSBD530
|
|
01027 ' IS ABENDING BECAUSE ' DTSBD530
|
|
01028 ABEND-MSG. DTSBD530
|
|
01029 DTSBD530
|
|
01030 DISPLAY '***'. DTSBD530
|
|
01031 DTSBD530
|
|
01032 CALL 'DTSBU999' USING ABEND-CODE. DTSBD530
|
|
01033 S999-EXIT. DTSBD530
|
|
01034 EXIT. DTSBD530
|