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