00001 IDENTIFICATION DIVISION. 09/25/13 00002 PROGRAM-ID. DTSBX442. DTSBX442 00003 AUTHOR. NGC. LV005 00004 DATE-WRITTEN. MARCH 2012. DTSBX442 00005 DATE-COMPILED. DTSBX442 00006 SKIP3 DTSBX442 00007 ***** DTSBX442 00008 * DTSBX442 00009 * FUNCTION: CREATE AMENDED REPORT TRANSACTIONS FROM DTSBX442 00010 * DATA PASSED FROM WEB AUDIT APPLICATION. DTSBX442 00011 * DTSBX442 00012 * MODIFICATION HISTORY: DTSBX442 00013 * DTSBX442 00014 * 03-13-2012 INITIAL DEVELOPMENT DTSBX442 00015 * REFERENCE RFP: WEB REPORTING DTSBX442 00016 * DTSBX442 00017 * 08-19-2013 MODIFY P4400 - BUILD T028 RECORD. MOVE ZERO DTSBX442 00018 * TO REMITTANCE AMOUNT AFTER IT IS APPLIED TO DTSBX442 00019 * THE FIRST QUARTER TO ENSURE IT IS USED ONLY DTSBX442 00020 * ONCE. DTSBX442 00021 * REFERENCE: TICKET 2023 GD DTSBX442 00022 * DTSBX442 00023 * DTSBX442 00024 ***** DTSBX442 00025 SKIP3 DTSBX442 00026 ENVIRONMENT DIVISION. DTSBX442 00027 SKIP2 DTSBX442 00028 INPUT-OUTPUT SECTION. DTSBX442 00029 DTSBX442 00030 FILE-CONTROL. DTSBX442 00031 DTSBX442 00032 SELECT AUDIT-FILE ASSIGN TO DTSFAUD DTSBX442 00033 FILE STATUS IS AUDIT-STATUS. DTSBX442 00034 DTSBX442 00035 SELECT AUDIT-QTR-FILE ASSIGN TO DTSFAUQ DTSBX442 00036 FILE STATUS IS AUDIT-QTR-STATUS. DTSBX442 00037 DTSBX442 00038 SELECT CURR-BATCH-FILE ASSIGN TO CURRBTCH DTSBX442 00039 FILE STATUS IS BATCH-STATUS. DTSBX442 00040 DTSBX442 00041 SELECT WAGE-FILE-TEMP ASSIGN TO DTSFWTMP DTSBX442 00042 FILE STATUS IS WAGE-TEMP-STATUS. DTSBX442 00043 DTSBX442 00044 SELECT WAGE-FILE-OUT ASSIGN TO DTSFWOUT DTSBX442 00045 FILE STATUS IS WAGE-OUT-STATUS. DTSBX442 00046 DTSBX442 00047 DATA DIVISION. DTSBX442 00048 DTSBX442 00049 FILE SECTION. DTSBX442 00050 DTSBX442 00051 FD AUDIT-FILE DTSBX442 00052 RECORDING MODE IS F DTSBX442 00053 BLOCK CONTAINS 0 RECORDS DTSBX442 00054 LABEL RECORDS ARE OMITTED. DTSBX442 00055 DTSBX442 00056 01 AUDIT-REC. DTSBX442 00057 05 AUDIT-REC-TYPE PIC X(03). DTSBX442 00058 88 REC-TYPE-AUDIT-WAGE-88 VALUE '144'. DTSBX442 00059 05 AUDIT-REC-FILLER PIC X(253). DTSBX442 00060 DTSBX442 00061 FD AUDIT-QTR-FILE DTSBX442 00062 RECORDING MODE IS F DTSBX442 00063 BLOCK CONTAINS 0 RECORDS DTSBX442 00064 LABEL RECORDS ARE OMITTED. DTSBX442 00065 DTSBX442 00066 01 AUDIT-QTR-REC. DTSBX442 00067 05 AUDIT-QTR-REC-TYPE PIC X(03). DTSBX442 00068 88 REC-TYPE-AUDIT-163-88 VALUE '163'. DTSBX442 00069 88 REC-TYPE-AUDIT-164-88 VALUE '164'. DTSBX442 00070 05 FILLER PIC X(01). DTSBX442 00071 05 AUDIT-QTR-EMP PIC 9(06). DTSBX442 00072 05 AUDIT-QTR-REC-FILLER PIC X(246). DTSBX442 00073 DTSBX442 00074 FD CURR-BATCH-FILE DTSBX442 00075 RECORDING MODE IS F DTSBX442 00076 BLOCK CONTAINS 0 RECORDS DTSBX442 00077 LABEL RECORDS ARE OMITTED. DTSBX442 00078 DTSBX442 00079 01 CURR-BATCH-REC. DTSBX442 00080 05 CURRENT-BATCH-NO PIC 9(05). DTSBX442 00081 05 CURRENT-ITEM-NO PIC 9(03). DTSBX442 00082 05 FILLER PIC X(01). DTSBX442 00083 05 CURRENT-ARCHIVE-YEAR PIC 9(04). DTSBX442 00084 05 FILLER PIC X(01). DTSBX442 00085 05 FIRST-ARCHIVE-YEAR PIC 9(04). DTSBX442 00086 05 FILLER PIC X(62). DTSBX442 00087 DTSBX442 00088 FD WAGE-FILE-TEMP DTSBX442 00089 RECORDING MODE IS F DTSBX442 00090 BLOCK CONTAINS 0 RECORDS DTSBX442 00091 LABEL RECORDS ARE OMITTED. DTSBX442 00092 DTSBX442 00093 01 WAGE-TEMP-REC PIC X(128). DTSBX442 00094 DTSBX442 00095 FD WAGE-FILE-OUT DTSBX442 00096 RECORDING MODE IS F DTSBX442 00097 BLOCK CONTAINS 0 RECORDS DTSBX442 00098 LABEL RECORDS ARE OMITTED. DTSBX442 00099 DTSBX442 00100 01 WAGE-OUT-REC PIC X(128). DTSBX442 00101 DTSBX442 00102 DTSBX442 00103 WORKING-STORAGE SECTION. DTSBX442 001035 77 PAN-VALET PICTURE X(24) VALUE '005DTSBX442 09/25/13'. DTSBX442 00104 77 PAN-VALET PICTURE X(24) VALUE '016DTSBX442 08/22/13'. DTSBX442 00105 77 PAN-VALET PICTURE X(24) VALUE '003DTSBX442 06/26/13'. DTSBX442 00106 77 PAN-VALET PICTURE X(24) VALUE '004DTSBX442 06/26/13'. DTSBX442 00107 77 PAN-VALET PICTURE X(24) VALUE '001DTSBX442 08/08/12'. DTSBX442 00108 SKIP3 DTSBX442 00109 01 WRK-AREA. DTSBX442 00110 05 W-ABEND-CD PIC S9(04) COMP VALUE 442. DTSBX442 00111 05 W-MOD-NAME PIC X(08) VALUE 'DTSBX442'.DTSBX442 00112 DTSBX442 00113 05 AUDIT-STATUS PIC X(02). DTSBX442 00114 88 AUDIT-STATUS-OK-88 VALUE '00'. DTSBX442 00115 88 AUDIT-STATUS-EOF-88 VALUE '10'. DTSBX442 00116 DTSBX442 00117 05 AUDIT-QTR-STATUS PIC X(02). DTSBX442 00118 88 AUDIT-QTR-STATUS-OK-88 VALUE '00'. DTSBX442 00119 88 AUDIT-QTR-STATUS-EOF-88 VALUE '10'. DTSBX442 00120 DTSBX442 00121 05 BATCH-STATUS PIC X(02). DTSBX442 00122 88 BATCH-STATUS-OK-88 VALUE '00'. DTSBX442 00123 DTSBX442 00124 05 WAGE-TEMP-STATUS PIC X(02). DTSBX442 00125 88 WAGE-TEMP-STATUS-OK-88 VALUE '00'. DTSBX442 00126 88 WAGE-TEMP-STATUS-EOF-88 VALUE '10'. DTSBX442 00127 DTSBX442 00128 05 WAGE-OUT-STATUS PIC X(02). DTSBX442 00129 88 WAGE-OUT-STATUS-OK-88 VALUE '00'. DTSBX442 00130 88 WAGE-OUT-STATUS-EOF-88 VALUE '10'. DTSBX442 00131 DTSBX442 00132 05 W-ERROR-IND PIC X(01) VALUE 'N'. DTSBX442 00133 88 W-ERROR-YES-88 VALUE 'Y'. DTSBX442 00134 88 W-ERROR-NO-88 VALUE 'N'. DTSBX442 00135 DTSBX442 00136 05 W-FATAL-ERROR-IND PIC X(01) VALUE 'N'. DTSBX442 00137 88 W-FATAL-ERROR-YES-88 VALUE 'Y'. DTSBX442 00138 88 W-FATAL-ERROR-NO-88 VALUE 'N'. DTSBX442 00139 DTSBX442 00140 05 W-QUARTER-AREA. DTSBX442 00141 10 QSUB PIC S9(04) COMP. DTSBX442 00142 10 QMAX PIC S9(04) COMP VALUE +4. DTSBX442 00143 10 W-AUDIT-EMP PIC 9(06) VALUE ZERO. DTSBX442 00144 10 W-QTR-AMOUNTS OCCURS 4 TIMES. DTSBX442 00145 15 Q-GROSS-PAYROLL PIC 9(11)V99 COMP-3. DTSBX442 00146 15 Q-UNDER-TOT-WAGE PIC 9(11)V99 COMP-3. DTSBX442 00147 15 Q-UNDER-TAX-WAGE PIC 9(11)V99 COMP-3. DTSBX442 00148 15 Q-UNDER-CONTRIB PIC 9(11)V99 COMP-3. DTSBX442 00149 15 Q-OVER-TOT-WAGE PIC 9(11)V99 COMP-3. DTSBX442 00150 15 Q-OVER-TAX-WAGE PIC 9(11)V99 COMP-3. DTSBX442 00151 15 Q-OVER-CONTRIB PIC 9(11)V99 COMP-3. DTSBX442 00152 DTSBX442 00153 05 W-EMP-NO PIC 9(07) VALUE ZERO. DTSBX442 00154 05 W-EMP-NAME PIC X(40). DTSBX442 00155 05 W-CURR-EMP PIC 9(07) VALUE ZERO. DTSBX442 00156 05 W-CURR-QUARTER PIC 9(05) VALUE ZERO. DTSBX442 00157 05 FILLER REDEFINES W-CURR-QUARTER. DTSBX442 00158 10 W-CURR-QUARTER-YYYY PIC 9(04). DTSBX442 00159 10 W-CURR-QUARTER-Q PIC 9(01). DTSBX442 00160 DTSBX442 00161 05 W-SSN PIC 9(09) VALUE ZERO. DTSBX442 00162 * 05 W-CURR-RUN-DATE PIC S9(09) COMP-3. DTSBX442 00163 * 05 W-LAST-RATE-YEAR PIC 9(04). DTSBX442 00164 * 05 W-CURR-WAGE-QTR PIC S9(05) COMP-3 VALUE +0. DTSBX442 00165 05 W-WAGE-QTR PIC S9(05) COMP-3 VALUE +0. DTSBX442 00166 05 W-WRKR-TOT-WAGE PIC S9(11)V99 VALUE +0. DTSBX442 00167 05 W-WRKR-TAX-WAGE PIC S9(11)V99 VALUE +0. DTSBX442 00168 05 W-WRKR-CNT PIC S9(07) VALUE +0. DTSBX442 00169 05 W-TOT-WAGE-SUM PIC S9(09)V99 VALUE +0. DTSBX442 00170 05 W-TAX-WAGE-SUM PIC S9(09)V99 VALUE +0. DTSBX442 00171 05 W-WAGE-CHANGE PIC S9(09)V99 VALUE +0. DTSBX442 00172 05 W-QTR-WAGE-CHANGE PIC S9(09)V99 VALUE +0. DTSBX442 00173 05 W-REMITTANCE PIC S9(09)V99 VALUE +0. DTSBX442 00174 05 W-SEQ-NO PIC 9(07) VALUE 0. DTSBX442 00175 05 W-EARNINGS-X PIC X(12). DTSBX442 00176 05 W-EARNINGS-9 REDEFINES W-EARNINGS-X DTSBX442 00177 PIC 9(09).99. DTSBX442 00178 05 W-EARNINGS PIC S9(09)V99. DTSBX442 00179 DTSBX442 00180 05 W-PSEUDO-BATCH-NO PIC 9(05) VALUE ZERO. DTSBX442 00181 05 W-PSEUDO-ITEM-NO PIC 9(03) VALUE ZERO. DTSBX442 00182 05 W-START-BATCH PIC 9(05) VALUE ZERO. DTSBX442 00183 05 W-END-BATCH PIC 9(05) VALUE ZERO. DTSBX442 00184 DTSBX442 00185 05 W-SLASH-DATE PIC X(10). DTSBX442 00186 05 FILLER REDEFINES W-SLASH-DATE. DTSBX442 00187 10 W-SLASH-DT-MM PIC X(02). DTSBX442 00188 10 FILLER PIC X(01). DTSBX442 00189 10 W-SLASH-DT-DD PIC X(02). DTSBX442 00190 10 FILLER PIC X(01). DTSBX442 00191 10 W-SLASH-DT-CCYY PIC X(04). DTSBX442 00192 DTSBX442 00193 05 W-SLASH-QTR PIC X(06). DTSBX442 00194 05 FILLER REDEFINES W-SLASH-QTR. DTSBX442 00195 10 W-SLASH-QTR-CCYY PIC X(04). DTSBX442 00196 10 FILLER PIC X(01). DTSBX442 00197 10 W-SLASH-QTR-Q PIC X(01). DTSBX442 00198 DTSBX442 00199 05 SUB PIC S9(04) COMP. DTSBX442 00200 DTSBX442 00201 05 W-INT-9 PIC 9(13). DTSBX442 00202 05 W-INT-X REDEFINES W-INT-9 DTSBX442 00203 PIC X(13). DTSBX442 00204 05 W-INTEGER PIC S9(11) COMP-3. DTSBX442 00205 05 W-FRACTION PIC SV9(11) COMP-3. DTSBX442 00206 05 W-NUMBER PIC S9(11)V9(05) COMP-3. DTSBX442 00207 DTSBX442 00208 DTSBX442 00209 05 W-AUDIT-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX442 00210 05 W-AUDIT-QTR-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX442 00211 05 W-EMP-WAGE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX442 00212 05 W-RPT-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX442 00213 05 W-T025-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX442 00214 05 W-T028-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX442 00215 05 W-ZERO-WAGE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX442 00216 05 W-LOOP-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX442 00217 DTSBX442 00218 05 W-AMT-DISP1 PIC ----------9.99. DTSBX442 00219 05 W-AMT-DISP2 PIC ----------9.99. DTSBX442 00220 05 W-AMT-DISP4 PIC ----------9.99. DTSBX442 00221 05 W-AMT-DISP3 PIC ----------9.99. DTSBX442 00222 05 W-AMT-DISP5 PIC ----------9.99. DTSBX442 00223 DTSBX442 00224 * WAGES DTSBX442 00225 01 X158-REC. DTSBX442 00226 ++INCLUDE DTSIX158 DTSBX442 00227 DTSBX442 00228 * AUDIT - EMPLOYER DTSBX442 00229 01 X163-REC. DTSBX442 00230 ++INCLUDE DTSIX163 DTSBX442 00231 DTSBX442 00232 * AUDIT - QUARTER DTSBX442 00233 01 X164-REC. DTSBX442 00234 ++INCLUDE DTSIX164 DTSBX442 00235 DTSBX442 00236 01 T025-REC. DTSBX442 00237 ++INCLUDE DTSIT025 DTSBX442 00238 DTSBX442 00239 01 T028-REC. DTSBX442 00240 ++INCLUDE DTSIT028 DTSBX442 00241 DTSBX442 00242 01 W001-REC. DTSBX442 00243 ++INCLUDE DTSIW001 DTSBX442 00244 DTSBX442 00245 01 R140-REC. DTSBX442 00246 ++INCLUDE DTSIR140 DTSBX442 00247 DTSBX442 00248 01 L001-LINK-AREA. DTSBX442 00249 ++INCLUDE DTSIL001 DTSBX442 00250 DTSBX442 00251 01 L003-LINK-AREA. DTSBX442 00252 ++INCLUDE DTSIL003 DTSBX442 00253 DTSBX442 00254 01 L004-LINK-AREA. DTSBX442 00255 ++INCLUDE DTSIL004 DTSBX442 00256 DTSBX442 00257 01 L005-LINK-AREA. DTSBX442 00258 ++INCLUDE DTSIL005 DTSBX442 00259 DTSBX442 00260 01 L062-LINK-AREA. DTSBX442 00261 ++INCLUDE DTSIL062 DTSBX442 00262 DTSBX442 00263 01 L205-LINK-AREA. DTSBX442 00264 ++INCLUDE DTSIL205 DTSBX442 00265 DTSBX442 00266 01 L516-LINK-AREA. DTSBX442 00267 ++INCLUDE DTSIL516 DTSBX442 00268 DTSBX442 00269 01 L910-LINK-AREA. DTSBX442 00270 ++INCLUDE DTSIL910 DTSBX442 00271 01 MSKL-REC. DTSBX442 00272 ++INCLUDE DTSIMSKL DTSBX442 00273 DTSBX442 00274 01 MHDR-REC. DTSBX442 00275 ++INCLUDE DTSIMHDR DTSBX442 00276 DTSBX442 00277 01 MPRF-REC. DTSBX442 00278 ++INCLUDE DTSIMPRF DTSBX442 00279 DTSBX442 00280 01 MSOL-REC. DTSBX442 00281 ++INCLUDE DTSIMSOL DTSBX442 00282 DTSBX442 00283 01 MQTR-REC. DTSBX442 00284 ++INCLUDE DTSIMQTR DTSBX442 00285 DTSBX442 00286 01 MOPO-REC. DTSBX442 00287 ++INCLUDE DTSIMOPO DTSBX442 00288 DTSBX442 00289 01 MTAD-REC. DTSBX442 00290 ++INCLUDE DTSIMTAD DTSBX442 00291 DTSBX442 00292 01 MNTE-REC. DTSBX442 00293 ++INCLUDE DTSIMNTE DTSBX442 00294 DTSBX442 00295 01 L921-LINK-AREA. DTSBX442 00296 ++INCLUDE DTSIL921 DTSBX442 00297 SKIP3 DTSBX442 00298 01 ISKL-REC. DTSBX442 00299 ++INCLUDE DTSIISKL DTSBX442 00300 SKIP3 DTSBX442 00301 01 IEIN-REC. DTSBX442 00302 ++INCLUDE DTSIIEIN DTSBX442 00303 DTSBX442 00304 01 L923-LINK-AREA. DTSBX442 00305 ++INCLUDE DTSIL923 DTSBX442 00306 EJECT DTSBX442 00307 01 ASKL-REC. DTSBX442 00308 ++INCLUDE DTSIASKL DTSBX442 00309 EJECT DTSBX442 00310 01 AHDR-REC. DTSBX442 00311 ++INCLUDE DTSIAHDR DTSBX442 00312 DTSBX442 00313 01 ARPT-REC. DTSBX442 00314 ++INCLUDE DTSIARPT DTSBX442 00315 DTSBX442 00316 01 APAY-REC. DTSBX442 00317 ++INCLUDE DTSIAPAY DTSBX442 00318 DTSBX442 00319 DTSBX442 00320 01 L927-LINK-AREA. DTSBX442 00321 ++INCLUDE DTSIL927 DTSBX442 00322 DTSBX442 00323 01 TSKL-REC. DTSBX442 00324 ++INCLUDE DTSITSKL DTSBX442 00325 DTSBX442 00326 01 L931-LINK-AREA. DTSBX442 00327 ++INCLUDE DTSIL931 DTSBX442 00328 DTSBX442 00329 01 FSKL-REC. DTSBX442 00330 ++INCLUDE DTSIFSKL DTSBX442 00331 DTSBX442 00332 01 L981-LINK-AREA. DTSBX442 00333 ++INCLUDE DTSIL981 DTSBX442 00334 SKIP3 DTSBX442 00335 01 WWGH-REC. DTSBX442 00336 ++INCLUDE DTSIWWGH DTSBX442 00337 DTSBX442 00338 PROCEDURE DIVISION. DTSBX442 00339 DTSBX442 00340 DTSBX442-MAIN. DTSBX442 00341 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBX442 00342 IF W-FATAL-ERROR-YES-88 DTSBX442 00343 MOVE +2 TO RETURN-CODE DTSBX442 00344 GO TO DTSBX442-MAIN-EXIT DTSBX442 00345 END-IF. DTSBX442 00346 DTSBX442 00347 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBX442 00348 DTSBX442 00349 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBX442 00350 DTSBX442 00351 IF W-ERROR-YES-88 DTSBX442 00352 MOVE +2 TO RETURN-CODE DTSBX442 00353 END-IF. DTSBX442 00354 DTSBX442 00355 DTSBX442-MAIN-EXIT. DTSBX442 00356 GOBACK. DTSBX442 00357 DTSBX442 00358 I0000-INITIATE. DTSBX442 00359 SET W-ERROR-NO-88 TO TRUE. DTSBX442 00360 SET W-FATAL-ERROR-NO-88 TO TRUE. DTSBX442 00361 DTSBX442 00362 MOVE LENGTH OF R140-REC TO R140-LENGTH. DTSBX442 00363 MOVE '140' TO R140-REC-TYPE. DTSBX442 00364 DTSBX442 00365 PERFORM S005-FROM-SYS THRU S005-EXIT. DTSBX442 00366 DTSBX442 00367 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBX442 00368 IF W-FATAL-ERROR-YES-88 DTSBX442 00369 GO TO I0000-EXIT DTSBX442 00370 END-IF. DTSBX442 00371 DTSBX442 00372 PERFORM I3000-CURR-BATCH THRU I3000-EXIT. DTSBX442 00373 IF W-FATAL-ERROR-YES-88 DTSBX442 00374 GO TO I0000-EXIT DTSBX442 00375 END-IF. DTSBX442 00376 DTSBX442 00377 DTSBX442 00378 I0000-EXIT. DTSBX442 00379 EXIT. DTSBX442 00380 DTSBX442 00381 I2000-OPEN-FILES. DTSBX442 00382 PERFORM S1000-OPEN-AUDIT THRU S1000-EXIT. DTSBX442 00383 IF W-FATAL-ERROR-YES-88 DTSBX442 00384 DISPLAY 'CANNOT OPEN AUDIT FILE ' DTSBX442 00385 AUDIT-STATUS DTSBX442 00386 GO TO I2000-EXIT DTSBX442 00387 END-IF. DTSBX442 00388 DTSBX442 00389 PERFORM S1100-OPEN-WAGE-TEMP-OUT THRU S1100-EXIT. DTSBX442 00390 IF W-FATAL-ERROR-YES-88 DTSBX442 00391 DISPLAY 'CANNOT OPEN WAGE TEMP FILE ' DTSBX442 00392 WAGE-TEMP-STATUS DTSBX442 00393 GO TO I2000-EXIT DTSBX442 00394 END-IF. DTSBX442 00395 DTSBX442 00396 PERFORM S1300-OPEN-WAGE-OUT THRU S1300-EXIT. DTSBX442 00397 IF W-FATAL-ERROR-YES-88 DTSBX442 00398 DISPLAY 'CANNOT OPEN WAGE OUT FILE ' DTSBX442 00399 WAGE-OUT-STATUS DTSBX442 00400 GO TO I2000-EXIT DTSBX442 00401 END-IF. DTSBX442 00402 DTSBX442 00403 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBX442 00404 DTSBX442 00405 PERFORM S931-OPEN-READ THRU S931-EXIT. DTSBX442 00406 DTSBX442 00407 PERFORM S981A-OPEN-READ THRU S981A-EXIT. DTSBX442 00408 DTSBX442 00409 MOVE 'N' TO L927-TRACE-IND. DTSBX442 00410 MOVE W-MOD-NAME TO L927-MOD-NAME. DTSBX442 00411 PERFORM S927A-OPEN THRU S927A-EXIT. DTSBX442 00412 DTSBX442 00413 I2000-EXIT. DTSBX442 00414 EXIT. DTSBX442 00415 DTSBX442 00416 I3000-CURR-BATCH. DTSBX442 00417 OPEN I-O CURR-BATCH-FILE. DTSBX442 00418 IF BATCH-STATUS-OK-88 DTSBX442 00419 READ CURR-BATCH-FILE DTSBX442 00420 IF BATCH-STATUS-OK-88 DTSBX442 00421 COMPUTE W-PSEUDO-BATCH-NO = (CURRENT-BATCH-NO + 1) DTSBX442 00422 MOVE W-PSEUDO-BATCH-NO TO W-START-BATCH DTSBX442 00423 MOVE ZERO TO W-PSEUDO-ITEM-NO DTSBX442 00424 DISPLAY 'CURRENT BATCH ' W-PSEUDO-BATCH-NO DTSBX442 00425 DISPLAY 'CURRENT ITEM ' W-PSEUDO-ITEM-NO DTSBX442 00426 ELSE DTSBX442 00427 SET W-ERROR-YES-88 TO TRUE DTSBX442 00428 DISPLAY 'CANNOT OPEN CURR BATCH NUMBER FILE ' DTSBX442 00429 BATCH-STATUS DTSBX442 00430 GO TO I3000-EXIT DTSBX442 00431 END-IF DTSBX442 00432 ELSE DTSBX442 00433 SET W-ERROR-YES-88 TO TRUE DTSBX442 00434 DISPLAY 'CANNOT OPEN CURR BATCH NUMBER FILE ' DTSBX442 00435 BATCH-STATUS DTSBX442 00436 GO TO I3000-EXIT DTSBX442 00437 END-IF. DTSBX442 00438 DTSBX442 00439 I3000-EXIT. DTSBX442 00440 EXIT. DTSBX442 00441 DTSBX442 00442 DTSBX442 00443 P0000-PROCESS. DTSBX442 00444 DISPLAY 'AUDIT IMPORT'. DTSBX442 00445 DISPLAY SPACE. DTSBX442 00446 DTSBX442 00447 SET W-ERROR-NO-88 TO TRUE. DTSBX442 00448 DTSBX442 00449 PERFORM S1010-READ-AUDIT THRU S1010-EXIT. DTSBX442 00450 PERFORM UNTIL AUDIT-STATUS-EOF-88 DTSBX442 00451 OR W-FATAL-ERROR-YES-88 DTSBX442 00452 OR W-ERROR-YES-88 DTSBX442 00453 IF REC-TYPE-AUDIT-WAGE-88 DTSBX442 00454 PERFORM P1000-PARSE-WAGE THRU P1000-EXIT DTSBX442 00455 PERFORM P2000-EDIT THRU P2000-EXIT DTSBX442 00456 IF W-ERROR-NO-88 DTSBX442 00457 IF W-CURR-EMP = W-EMP-NO DTSBX442 00458 AND W-CURR-QUARTER = W-WAGE-QTR DTSBX442 00459 PERFORM P3000-WRITE-TEMP THRU P3000-EXIT DTSBX442 00460 ELSE DTSBX442 00461 PERFORM P4000-WRITE-RPT THRU P4000-EXIT DTSBX442 00462 PERFORM P3000-WRITE-TEMP THRU P3000-EXIT DTSBX442 00463 END-IF DTSBX442 00464 END-IF DTSBX442 00465 IF W-FATAL-ERROR-NO-88 DTSBX442 00466 PERFORM S1010-READ-AUDIT THRU S1010-EXIT DTSBX442 00467 END-IF DTSBX442 00468 ELSE DTSBX442 00469 PERFORM S1010-READ-AUDIT THRU S1010-EXIT DTSBX442 00470 END-IF DTSBX442 00471 END-PERFORM. DTSBX442 00472 DTSBX442 00473 DISPLAY 'END OF FILE'. DTSBX442 00474 PERFORM P4000-WRITE-RPT THRU P4000-EXIT. DTSBX442 00475 DTSBX442 00476 P0000-EXIT. DTSBX442 00477 EXIT. DTSBX442 00478 DTSBX442 00479 DTSBX442 00480 P1000-PARSE-WAGE. DTSBX442 00481 ** DISPLAY 'P1000: ' AUDIT-REC(1:28). DTSBX442 00482 PERFORM DTSBX442 00483 VARYING SUB FROM +1 BY +1 DTSBX442 00484 UNTIL SUB > +100 DTSBX442 00485 MOVE +0 TO L205-FIELD-LENGTH (SUB) DTSBX442 00486 L205-INTEGER (SUB) DTSBX442 00487 L205-FRACTION (SUB) DTSBX442 00488 MOVE SPACES TO L205-TEXT (SUB) DTSBX442 00489 L205-DATE (SUB) DTSBX442 00490 SET L205-TYPE-TEXT-88 (SUB) TO TRUE DTSBX442 00491 END-PERFORM. DTSBX442 00492 DTSBX442 00493 IF REC-TYPE-AUDIT-WAGE-88 DTSBX442 00494 PERFORM P1100-WAGE THRU P1100-EXIT DTSBX442 00495 END-IF. DTSBX442 00496 DTSBX442 00497 DTSBX442 00498 P1000-EXIT. DTSBX442 00499 EXIT. DTSBX442 00500 DTSBX442 00501 P1100-WAGE. DTSBX442 00502 PERFORM P1110-PARSE THRU P1110-EXIT. DTSBX442 00503 DTSBX442 00504 PERFORM P1120-BUILD-X158 THRU P1120-EXIT. DTSBX442 00505 DTSBX442 00506 P1100-EXIT. DTSBX442 00507 EXIT. DTSBX442 00508 DTSBX442 00509 P1110-PARSE. DTSBX442 00510 INITIALIZE X158-REC DTSBX442 00511 MOVE +10 TO L205-LAST-FIELD DTSBX442 00512 MOVE +1 TO L205-LAST-FIELD-LEN DTSBX442 00513 DTSBX442 00514 *** RECORD TYPE DTSBX442 00515 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX442 00516 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX442 00517 DTSBX442 00518 *** EMPLOYER NUMBER DTSBX442 00519 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX442 00520 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX442 00521 DTSBX442 00522 *** QUARTER DTSBX442 00523 MOVE +6 TO L205-FIELD-LENGTH (3). DTSBX442 00524 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX442 00525 DTSBX442 00526 *** SSN DTSBX442 00527 MOVE +9 TO L205-FIELD-LENGTH (4). DTSBX442 00528 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSBX442 00529 DTSBX442 00530 *** SOURCE DTSBX442 00531 MOVE +1 TO L205-FIELD-LENGTH (5). DTSBX442 00532 SET L205-TYPE-TEXT-88 (5) TO TRUE. DTSBX442 00533 DTSBX442 00534 *** EARNINGS DTSBX442 00535 MOVE +12 TO L205-FIELD-LENGTH (6). DTSBX442 00536 SET L205-TYPE-NUMBER-88 (6) TO TRUE. DTSBX442 00537 DTSBX442 00538 *** TAX WAGE DTSBX442 00539 MOVE +12 TO L205-FIELD-LENGTH (7). DTSBX442 00540 SET L205-TYPE-NUMBER-88 (7) TO TRUE. DTSBX442 00541 DTSBX442 00542 *** LAST NAME DTSBX442 00543 MOVE +20 TO L205-FIELD-LENGTH (8). DTSBX442 00544 SET L205-TYPE-TEXT-88 (8) TO TRUE. DTSBX442 00545 DTSBX442 00546 *** FIRST NAME DTSBX442 00547 MOVE +15 TO L205-FIELD-LENGTH (9). DTSBX442 00548 SET L205-TYPE-TEXT-88 (9) TO TRUE. DTSBX442 00549 DTSBX442 00550 *** MIDDLE INITIAL DTSBX442 00551 MOVE +1 TO L205-FIELD-LENGTH (10). DTSBX442 00552 SET L205-TYPE-TEXT-88 (10) TO TRUE. DTSBX442 00553 DTSBX442 00554 MOVE AUDIT-REC TO L205-INPUT-DATA. DTSBX442 00555 CALL 'DTSBU205' USING L205-LINK-AREA. DTSBX442 00556 DTSBX442 00557 P1110-EXIT. DTSBX442 00558 EXIT. DTSBX442 00559 DTSBX442 00560 P1120-BUILD-X158. DTSBX442 00561 MOVE L205-TEXT (1) (1:03) TO X158-REC-TYPE. DTSBX442 00562 DTSBX442 00563 MOVE L205-TEXT (2) (1:06) TO X158-EMP-NO. DTSBX442 00564 DTSBX442 00565 MOVE L205-TEXT (3) (1:06) TO X158-QUARTER. DTSBX442 00566 DTSBX442 00567 MOVE L205-TEXT (4) (1:09) TO X158-SSN. DTSBX442 00568 DTSBX442 00569 MOVE L205-TEXT (5) (1:01) TO X158-WAGE-STATUS. DTSBX442 00570 DTSBX442 00571 MOVE L205-INTEGER (6) TO W-INTEGER. DTSBX442 00572 MOVE L205-FRACTION (6) TO W-FRACTION. DTSBX442 00573 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. DTSBX442 00574 MOVE W-NUMBER TO X158-EARNINGS. DTSBX442 00575 DTSBX442 00576 MOVE L205-INTEGER (7) TO W-INTEGER. DTSBX442 00577 MOVE L205-FRACTION (7) TO W-FRACTION. DTSBX442 00578 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. DTSBX442 00579 MOVE W-NUMBER TO X158-TAXABLE-WAGES. DTSBX442 00580 DTSBX442 00581 MOVE L205-TEXT (8) (1:20) TO X158-LAST-NAME. DTSBX442 00582 DTSBX442 00583 MOVE L205-TEXT (9) (1:15) TO X158-FIRST-NAME. DTSBX442 00584 DTSBX442 00585 MOVE L205-TEXT (10) (1:01) TO X158-MID-INIT. DTSBX442 00586 DTSBX442 00587 DISPLAY 'P1120: ' X158-EMP-NO ' ' X158-QUARTER DTSBX442 00588 ' ' X158-SSN ' ' X158-EARNINGS DTSBX442 00589 ' ' X158-TAXABLE-WAGES. DTSBX442 00590 P1120-EXIT. DTSBX442 00591 EXIT. DTSBX442 00592 DTSBX442 00593 P2000-EDIT. DTSBX442 00594 IF X158-EMP-NO NOT NUMERIC DTSBX442 00595 PERFORM P2001-EMP-ERR THRU P2001-EXIT DTSBX442 00596 ELSE DTSBX442 00597 MOVE X158-EMP-NO TO W-EMP-NO DTSBX442 00598 END-IF. DTSBX442 00599 DTSBX442 00600 MOVE X158-QUARTER TO W-SLASH-QTR. DTSBX442 00601 MOVE W-SLASH-QTR-CCYY TO L004-QTR-5-YR. DTSBX442 00602 MOVE W-SLASH-QTR-Q TO L004-QTR-5-Q. DTSBX442 00603 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBX442 00604 IF NOT L004-VALID-QTR DTSBX442 00605 PERFORM P2002-QTR-ERR THRU P2002-EXIT DTSBX442 00606 ELSE DTSBX442 00607 MOVE L004-QTR-5-9 TO W-WAGE-QTR DTSBX442 00608 END-IF. DTSBX442 00609 DTSBX442 00610 IF X158-SSN NOT NUMERIC DTSBX442 00611 PERFORM P2003-SSN-ERR THRU P2003-EXIT DTSBX442 00612 ELSE DTSBX442 00613 MOVE X158-SSN TO W-SSN DTSBX442 00614 END-IF. DTSBX442 00615 DTSBX442 00616 MOVE X158-EARNINGS TO W-EARNINGS-X. DTSBX442 00617 MOVE W-EARNINGS-9 TO W-EARNINGS. DTSBX442 00618 MOVE W-EARNINGS TO W-WRKR-TOT-WAGE. DTSBX442 00619 DTSBX442 00620 ** MOVE W-WRKR-TOT-WAGE TO W-AMT-DISP1. DTSBX442 00621 * MOVE W-TOT-WAGE-SUM TO W-AMT-DISP2. DTSBX442 00622 * DISPLAY 'P2000: ' W-WAGE-QTR ' ' W-SSN DTSBX442 00623 ** ' ' W-AMT-DISP1 ' ' W-AMT-DISP2. DTSBX442 00624 DTSBX442 00625 MOVE X158-TAXABLE-WAGES TO W-EARNINGS-X. DTSBX442 00626 MOVE W-EARNINGS-9 TO W-EARNINGS. DTSBX442 00627 MOVE W-EARNINGS TO W-WRKR-TAX-WAGE. DTSBX442 00628 DTSBX442 00629 P2000-EXIT. DTSBX442 00630 EXIT. DTSBX442 00631 DTSBX442 00632 P2001-EMP-ERR. DTSBX442 00633 SET W-ERROR-YES-88 TO TRUE. DTSBX442 00634 MOVE SPACES TO R140-MESSAGE. DTSBX442 00635 MOVE W-EMP-NO TO R140-EMP-NO. DTSBX442 00636 STRING DTSBX442 00637 'WAGE: NON-NUMERIC EMP NO ' X158-EMP-NO DTSBX442 00638 DELIMITED BY SIZE DTSBX442 00639 INTO R140-MESSAGE DTSBX442 00640 END-STRING. DTSBX442 00641 PERFORM S946-WRITE-R140 THRU S946-EXIT. DTSBX442 00642 DISPLAY R140-MESSAGE. DTSBX442 00643 DTSBX442 00644 P2001-EXIT. DTSBX442 00645 EXIT. DTSBX442 00646 DTSBX442 00647 P2002-QTR-ERR. DTSBX442 00648 SET W-ERROR-YES-88 TO TRUE. DTSBX442 00649 MOVE SPACES TO R140-MESSAGE. DTSBX442 00650 MOVE W-EMP-NO TO R140-EMP-NO. DTSBX442 00651 STRING DTSBX442 00652 'WAGE: INVALID QUARTER ' X158-QUARTER DTSBX442 00653 DELIMITED BY SIZE DTSBX442 00654 INTO R140-MESSAGE DTSBX442 00655 END-STRING. DTSBX442 00656 PERFORM S946-WRITE-R140 THRU S946-EXIT. DTSBX442 00657 DISPLAY R140-MESSAGE. DTSBX442 00658 DTSBX442 00659 P2002-EXIT. DTSBX442 00660 EXIT. DTSBX442 00661 DTSBX442 00662 P2003-SSN-ERR. DTSBX442 00663 SET W-ERROR-YES-88 TO TRUE. DTSBX442 00664 MOVE SPACES TO R140-MESSAGE. DTSBX442 00665 MOVE W-EMP-NO TO R140-EMP-NO. DTSBX442 00666 STRING DTSBX442 00667 'WAGE: NON-NUMERIC SSN ' X158-SSN DTSBX442 00668 DELIMITED BY SIZE DTSBX442 00669 INTO R140-MESSAGE DTSBX442 00670 END-STRING. DTSBX442 00671 PERFORM S946-WRITE-R140 THRU S946-EXIT. DTSBX442 00672 DISPLAY R140-MESSAGE. DTSBX442 00673 DTSBX442 00674 P2003-EXIT. DTSBX442 00675 EXIT. DTSBX442 00676 DTSBX442 00677 P3000-WRITE-TEMP. DTSBX442 00678 ADD W-WRKR-TOT-WAGE TO W-TOT-WAGE-SUM. DTSBX442 00679 ADD W-WRKR-TAX-WAGE TO W-TAX-WAGE-SUM. DTSBX442 00680 DTSBX442 00681 MOVE ZERO TO W001-BATCH-NO DTSBX442 00682 W001-ITEM-NO DTSBX442 00683 W001-SEQ-NO. DTSBX442 00684 MOVE W-EMP-NO TO W001-EMP-NO. DTSBX442 00685 MOVE W-SSN TO W001-SSN. DTSBX442 00686 SET W001-SSN-VALID-88 TO TRUE. DTSBX442 00687 DTSBX442 00688 MOVE X158-FIRST-NAME TO W001-FIRST-NAME. DTSBX442 00689 MOVE X158-MID-INIT TO W001-MID-INIT. DTSBX442 00690 MOVE X158-LAST-NAME TO W001-LAST-NAME. DTSBX442 00691 SET W001-NAME-VALID-88 TO TRUE. DTSBX442 00692 DTSBX442 00693 MOVE W-WAGE-QTR TO W001-YRQ. DTSBX442 00694 MOVE W-WRKR-TOT-WAGE TO W001-WAGE-CHNG. DTSBX442 00695 MOVE W-WRKR-TAX-WAGE TO W001-TAX-WAGE. DTSBX442 00696 SET W001-WAGE-VALID-88 TO TRUE. DTSBX442 00697 MOVE ZERO TO W001-CURR-WAGE DTSBX442 00698 W001-PRIOR-WAGE. DTSBX442 00699 MOVE L005-DATE TO W001-RECEIVED-DATE. DTSBX442 00700 MOVE L005-TIME TO W001-RECEIVED-TIME. DTSBX442 00701 MOVE 'AUDIT ' TO W001-RESPONSIBLE-OP-ID. DTSBX442 00702 SET W001-AMEND-RPT-88 TO TRUE. DTSBX442 00703 DTSBX442 00704 PERFORM S1120-WRITE-WAGE-TEMP THRU S1120-EXIT. DTSBX442 00705 ADD +1 TO W-EMP-WAGE-CNT. DTSBX442 00706 DTSBX442 00707 P3000-EXIT. DTSBX442 00708 EXIT. DTSBX442 00709 DTSBX442 00710 P4000-WRITE-RPT. DTSBX442 00711 ** FIRST TIME: DTSBX442 00712 IF W-CURR-EMP = ZERO DTSBX442 00713 MOVE W-EMP-NO TO W-CURR-EMP DTSBX442 00714 MOVE W-WAGE-QTR TO W-CURR-QUARTER DTSBX442 00715 PERFORM P4300-READ-AUDIT-QTR THRU P4300-EXIT DTSBX442 00716 GO TO P4000-EXIT DTSBX442 00717 END-IF. DTSBX442 00718 DTSBX442 00719 ******************************************** DTSBX442 00720 ** ON BREAK IN EMPLOYER, IF THE REMITTANCE HAS NOT BEEN DTSBX442 00721 ** USED (NO AUDIT RECORDS WRITTEN), FORMAT A PAYMENT DTSBX442 00722 ** TRANSACTION. DTSBX442 00723 ******************************************** DTSBX442 00724 IF W-EMP-NO NOT = W-CURR-EMP DTSBX442 00725 IF W-REMITTANCE > 0 DTSBX442 00726 PERFORM P4500-FORMAT-PAY THRU P4500-EXIT DTSBX442 00727 END-IF DTSBX442 00728 END-IF. DTSBX442 00729 DTSBX442 00730 IF W-AUDIT-EMP NOT = W-CURR-EMP DTSBX442 00731 PERFORM P4300-READ-AUDIT-QTR THRU P4300-EXIT DTSBX442 00732 END-IF. DTSBX442 00733 DTSBX442 00734 IF W-ERROR-YES-88 DTSBX442 00735 DISPLAY 'P4000 ERRORS' DTSBX442 00736 GO TO P4000-EXIT DTSBX442 00737 END-IF. DTSBX442 00738 DTSBX442 00739 DISPLAY SPACE. DTSBX442 00740 MOVE W-TOT-WAGE-SUM TO W-AMT-DISP1. DTSBX442 00741 MOVE W-TAX-WAGE-SUM TO W-AMT-DISP2. DTSBX442 00742 DISPLAY 'P4000: ' W-CURR-EMP ' ' W-CURR-QUARTER DTSBX442 00743 ' ' W-AMT-DISP1 ' ' W-AMT-DISP2. DTSBX442 00744 DTSBX442 00745 IF W-PSEUDO-ITEM-NO < 999 DTSBX442 00746 ADD 1 TO W-PSEUDO-ITEM-NO DTSBX442 00747 ELSE DTSBX442 00748 ADD 1 TO W-PSEUDO-BATCH-NO DTSBX442 00749 MOVE 1 TO W-PSEUDO-ITEM-NO DTSBX442 00750 END-IF. DTSBX442 00751 DTSBX442 00752 DTSBX442 00753 MOVE +0 TO W-WAGE-CHANGE DTSBX442 00754 W-QTR-WAGE-CHANGE. DTSBX442 00755 PERFORM S1110-CLOSE-WAGE-TEMP THRU S1110-EXIT. DTSBX442 00756 PERFORM S1130-OPEN-WAGE-TEMP-IN THRU S1130-EXIT. DTSBX442 00757 DTSBX442 00758 PERFORM S1140-READ-WAGE-TEMP THRU S1140-EXIT. DTSBX442 00759 IF WAGE-TEMP-STATUS-EOF-88 DTSBX442 00760 DISPLAY 'WAGE TEMP FILE EMPTY' DTSBX442 00761 GO TO P4000-EXIT DTSBX442 00762 END-IF. DTSBX442 00763 DTSBX442 00764 *& DTSBX442 00765 DISPLAY 'P4000 WAGE TEMP FIRST READ ' DTSBX442 00766 W001-SSN ' ' W001-YRQ ' ' W001-EMP-NO. DTSBX442 00767 *& DTSBX442 00768 MOVE +0 TO W-WRKR-CNT. DTSBX442 00769 DTSBX442 00770 MOVE W-CURR-EMP TO WWGH-EMP-NO. DTSBX442 00771 MOVE W-CURR-QUARTER TO WWGH-YRQ. DTSBX442 00772 MOVE +0 TO WWGH-SSN. DTSBX442 00773 PERFORM S981D-START-BROWSE THRU S981D-EXIT. DTSBX442 00774 DTSBX442 00775 *& DTSBX442 00776 MOVE +0 TO W-LOOP-CNT. DTSBX442 00777 DTSBX442 00778 PERFORM UNTIL WAGE-TEMP-STATUS-EOF-88 DTSBX442 00779 PERFORM P4100-WAGE-CHANGE THRU P4100-EXIT DTSBX442 00780 END-PERFORM. DTSBX442 00781 DTSBX442 00782 PERFORM P4400-WRITE-RPT THRU P4400-EXIT. DTSBX442 00783 DTSBX442 00784 PERFORM S1110-CLOSE-WAGE-TEMP THRU S1110-EXIT. DTSBX442 00785 PERFORM S1100-OPEN-WAGE-TEMP-OUT THRU S1100-EXIT. DTSBX442 00786 DTSBX442 00787 MOVE W-QTR-WAGE-CHANGE TO W-AMT-DISP1. DTSBX442 00788 DISPLAY 'TOTAL CHANGE: ' W-AMT-DISP1. DTSBX442 00789 DISPLAY SPACE. DTSBX442 00790 DTSBX442 00791 ADD +1 TO W-RPT-CNT. DTSBX442 00792 MOVE W-EMP-NO TO W-CURR-EMP. DTSBX442 00793 MOVE W-WAGE-QTR TO W-CURR-QUARTER. DTSBX442 00794 MOVE +0 TO W-TOT-WAGE-SUM DTSBX442 00795 W-TAX-WAGE-SUM. DTSBX442 00796 DTSBX442 00797 P4000-EXIT. DTSBX442 00798 EXIT. DTSBX442 00799 DTSBX442 00800 P4100-WAGE-CHANGE. DTSBX442 00801 *& DTSBX442 00802 ADD +1 TO W-LOOP-CNT. DTSBX442 00803 IF W-LOOP-CNT < 1000 DTSBX442 00804 MOVE WWGH-EARNINGS TO W-AMT-DISP1 DTSBX442 00805 DISPLAY 'P4100 - 1 WGH ' WWGH-SSN ' ' WWGH-EMP-NO DTSBX442 00806 ' ' WWGH-YRQ ' ' W-AMT-DISP1 DTSBX442 00807 MOVE W001-WAGE-CHNG TO W-AMT-DISP1 DTSBX442 00808 DISPLAY ' W001 ' DTSBX442 00809 W001-SSN ' ' W001-EMP-NO ' ' W001-YRQ DTSBX442 00810 ' ' W-AMT-DISP1 DTSBX442 00811 END-IF. DTSBX442 00812 *& DTSBX442 00813 IF WWGH-EMP-NO = W-CURR-EMP DTSBX442 00814 AND WWGH-YRQ = W-CURR-QUARTER DTSBX442 00815 NEXT SENTENCE DTSBX442 00816 ELSE DTSBX442 00817 SET L981-NO-REC-88 TO TRUE DTSBX442 00818 END-IF. DTSBX442 00819 DTSBX442 00820 IF L981-NO-REC-88 DTSBX442 00821 PERFORM P4110-ADD-NEW THRU P4110-EXIT DTSBX442 00822 PERFORM S1140-READ-WAGE-TEMP THRU S1140-EXIT DTSBX442 00823 GO TO P4100-EXIT DTSBX442 00824 END-IF. DTSBX442 00825 DTSBX442 00826 EVALUATE TRUE DTSBX442 00827 WHEN W001-SSN < WWGH-SSN DTSBX442 00828 PERFORM P4110-ADD-NEW THRU P4110-EXIT DTSBX442 00829 PERFORM S1140-READ-WAGE-TEMP THRU S1140-EXIT DTSBX442 00830 DTSBX442 00831 WHEN W001-SSN = WWGH-SSN DTSBX442 00832 PERFORM P4120-COMPARE-WAGES THRU P4120-EXIT DTSBX442 00833 PERFORM S1140-READ-WAGE-TEMP THRU S1140-EXIT DTSBX442 00834 PERFORM S981E-READ-NEXT THRU S981E-EXIT DTSBX442 00835 DTSBX442 00836 WHEN W001-SSN > WWGH-SSN DTSBX442 00837 PERFORM S981E-READ-NEXT THRU S981E-EXIT DTSBX442 00838 DTSBX442 00839 END-EVALUATE. DTSBX442 00840 DTSBX442 00841 DTSBX442 00842 P4100-EXIT. DTSBX442 00843 EXIT. DTSBX442 00844 DTSBX442 00845 P4110-ADD-NEW. DTSBX442 00846 IF W001-WAGE-CHNG = ZERO DTSBX442 00847 ADD +1 TO W-ZERO-WAGE-CNT DTSBX442 00848 GO TO P4110-EXIT DTSBX442 00849 ELSE DTSBX442 00850 MOVE W001-WAGE-CHNG TO W-WAGE-CHANGE DTSBX442 00851 ADD W001-WAGE-CHNG TO W-QTR-WAGE-CHANGE DTSBX442 00852 PERFORM P4200-WAGE-OUT THRU P4200-EXIT DTSBX442 00853 DTSBX442 00854 MOVE W001-WAGE-CHNG TO W-AMT-DISP1 DTSBX442 00855 DISPLAY 'ADD NEW: ' W001-SSN ' ' W-AMT-DISP1 DTSBX442 00856 END-IF. DTSBX442 00857 DTSBX442 00858 P4110-EXIT. DTSBX442 00859 EXIT. DTSBX442 00860 DTSBX442 00861 P4120-COMPARE-WAGES. DTSBX442 00862 IF W001-WAGE-CHNG < ZERO DTSBX442 00863 PERFORM P4121-DELETE THRU P4121-EXIT DTSBX442 00864 GO TO P4120-EXIT DTSBX442 00865 ** ELSE DTSBX442 00866 * IF W001-WAGE-CHNG = ZERO DTSBX442 00867 * ADD +1 TO W-ZERO-WAGE-CNT DTSBX442 00868 * GO TO P4120-EXIT DTSBX442 00869 ** END-IF DTSBX442 00870 END-IF. DTSBX442 00871 DTSBX442 00872 COMPUTE W-WAGE-CHANGE = (W001-WAGE-CHNG - WWGH-EARNINGS). DTSBX442 00873 PERFORM P4200-WAGE-OUT THRU P4200-EXIT DTSBX442 00874 DTSBX442 00875 IF W-WAGE-CHANGE NOT = ZERO DTSBX442 00876 COMPUTE W-QTR-WAGE-CHANGE = W-QTR-WAGE-CHANGE + DTSBX442 00877 (W001-WAGE-CHNG - WWGH-EARNINGS) DTSBX442 00878 MOVE W001-WAGE-CHNG TO W-AMT-DISP1 DTSBX442 00879 MOVE WWGH-EARNINGS TO W-AMT-DISP2 DTSBX442 00880 MOVE W-WAGE-CHANGE TO W-AMT-DISP5 DTSBX442 00881 DISPLAY 'WAGE CHANGE ' W001-SSN ' NEW ' W-AMT-DISP1 DTSBX442 00882 ' OLD ' W-AMT-DISP2 DTSBX442 00883 ' CHANGE ' W-AMT-DISP5 DTSBX442 00884 END-IF. DTSBX442 00885 DTSBX442 00886 P4120-EXIT. DTSBX442 00887 EXIT. DTSBX442 00888 DTSBX442 00889 P4121-DELETE. DTSBX442 00890 P4121-EXIT. DTSBX442 00891 EXIT. DTSBX442 00892 DTSBX442 00893 P4200-WAGE-OUT. DTSBX442 00894 ADD +1 TO W-WRKR-CNT. DTSBX442 00895 MOVE W-PSEUDO-BATCH-NO TO W001-BATCH-NO. DTSBX442 00896 MOVE W-PSEUDO-ITEM-NO TO W001-ITEM-NO. DTSBX442 00897 ADD 1 TO W-SEQ-NO. DTSBX442 00898 MOVE W-SEQ-NO TO W001-SEQ-NO. DTSBX442 00899 DTSBX442 00900 PERFORM S1320-WRITE-WAGE-OUT THRU S1320-EXIT. DTSBX442 00901 DTSBX442 00902 P4200-EXIT. DTSBX442 00903 EXIT. DTSBX442 00904 DTSBX442 00905 P4300-READ-AUDIT-QTR. DTSBX442 00906 PERFORM DTSBX442 00907 VARYING QSUB FROM +1 BY +1 DTSBX442 00908 UNTIL QSUB > QMAX DTSBX442 00909 MOVE +0 TO Q-GROSS-PAYROLL (QSUB) DTSBX442 00910 Q-UNDER-TOT-WAGE (QSUB) DTSBX442 00911 Q-UNDER-TAX-WAGE (QSUB) DTSBX442 00912 Q-UNDER-CONTRIB (QSUB) DTSBX442 00913 Q-OVER-TOT-WAGE (QSUB) DTSBX442 00914 Q-OVER-TAX-WAGE (QSUB) DTSBX442 00915 Q-OVER-CONTRIB (QSUB) DTSBX442 00916 END-PERFORM. DTSBX442 00917 DTSBX442 00918 PERFORM S1200-OPEN-AUDIT-QTR THRU S1200-EXIT. DTSBX442 00919 IF W-FATAL-ERROR-YES-88 DTSBX442 00920 DISPLAY 'CANNOT OPEN AUDIT QTR FILE ' DTSBX442 00921 AUDIT-QTR-STATUS DTSBX442 00922 GO TO P4300-EXIT DTSBX442 00923 END-IF. DTSBX442 00924 DTSBX442 00925 PERFORM S1210-READ-AUDIT-QTR THRU S1210-EXIT. DTSBX442 00926 PERFORM UNTIL AUDIT-QTR-STATUS-EOF-88 DTSBX442 00927 OR W-ERROR-YES-88 DTSBX442 00928 IF AUDIT-QTR-EMP = W-CURR-EMP DTSBX442 00929 EVALUATE TRUE DTSBX442 00930 WHEN REC-TYPE-AUDIT-163-88 DTSBX442 00931 PERFORM P4310-PARSE-X163 THRU P4310-EXIT DTSBX442 00932 DTSBX442 00933 WHEN REC-TYPE-AUDIT-164-88 DTSBX442 00934 PERFORM P4320-PARSE-X164 THRU P4320-EXIT DTSBX442 00935 DTSBX442 00936 END-EVALUATE DTSBX442 00937 IF W-AUDIT-EMP NOT = W-CURR-EMP DTSBX442 00938 MOVE W-CURR-EMP TO W-AUDIT-EMP DTSBX442 00939 END-IF DTSBX442 00940 END-IF DTSBX442 00941 PERFORM S1210-READ-AUDIT-QTR THRU S1210-EXIT DTSBX442 00942 END-PERFORM. DTSBX442 00943 DTSBX442 00944 PERFORM S1220-CLOSE-AUDIT-QTR THRU S1220-EXIT. DTSBX442 00945 DTSBX442 00946 PERFORM P4330-READ-MPRF THRU P4330-EXIT. DTSBX442 00947 DTSBX442 00948 P4300-EXIT. DTSBX442 00949 EXIT. DTSBX442 00950 DTSBX442 00951 P4310-PARSE-X163. DTSBX442 00952 PERFORM DTSBX442 00953 VARYING SUB FROM +1 BY +1 DTSBX442 00954 UNTIL SUB > +100 DTSBX442 00955 MOVE +0 TO L205-FIELD-LENGTH (SUB) DTSBX442 00956 L205-INTEGER (SUB) DTSBX442 00957 L205-FRACTION (SUB) DTSBX442 00958 MOVE SPACES TO L205-TEXT (SUB) DTSBX442 00959 L205-DATE (SUB) DTSBX442 00960 SET L205-TYPE-TEXT-88 (SUB) TO TRUE DTSBX442 00961 END-PERFORM. DTSBX442 00962 DTSBX442 00963 PERFORM P4311-PARSE THRU P4311-EXIT. DTSBX442 00964 PERFORM P4312-BUILD-X163 THRU P4312-EXIT. DTSBX442 00965 DTSBX442 00966 MOVE X163-EMP-NO TO W-AUDIT-EMP. DTSBX442 00967 MOVE X163-MONEY-COLLECT-AMT TO W-REMITTANCE. DTSBX442 00968 DTSBX442 00969 P4310-EXIT. DTSBX442 00970 EXIT. DTSBX442 00971 DTSBX442 00972 P4311-PARSE. DTSBX442 00973 INITIALIZE X163-REC. DTSBX442 00974 MOVE +23 TO L205-LAST-FIELD DTSBX442 00975 MOVE +5 TO L205-LAST-FIELD-LEN DTSBX442 00976 DTSBX442 00977 *** RECORD TYPE DTSBX442 00978 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX442 00979 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX442 00980 DTSBX442 00981 *** EMPLOYER NUMBER DTSBX442 00982 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX442 00983 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX442 00984 DTSBX442 00985 *** ASSIGN NUMBER DTSBX442 00986 *& MOVE +8 TO L205-FIELD-LENGTH (3). DTSBX442 00987 *& SET L205-TYPE-NUMBER-88 (3) TO TRUE. DTSBX442 00988 MOVE +8 TO L205-FIELD-LENGTH (3). DTSBX442 00989 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX442 00990 DTSBX442 00991 *** COMPLETED DATE DTSBX442 00992 MOVE +10 TO L205-FIELD-LENGTH (4). DTSBX442 00993 SET L205-TYPE-DATE-88 (4) TO TRUE. DTSBX442 00994 DTSBX442 00995 *** PROCESSED DATE DTSBX442 00996 MOVE +10 TO L205-FIELD-LENGTH (5). DTSBX442 00997 SET L205-TYPE-DATE-88 (5) TO TRUE. DTSBX442 00998 DTSBX442 00999 *** FIELD REP ID DTSBX442 01000 MOVE +2 TO L205-FIELD-LENGTH (6). DTSBX442 01001 SET L205-TYPE-TEXT-88 (6) TO TRUE. DTSBX442 01002 DTSBX442 01003 *** START QUARTER DTSBX442 01004 MOVE +6 TO L205-FIELD-LENGTH (7). DTSBX442 01005 SET L205-TYPE-TEXT-88 (7) TO TRUE. DTSBX442 01006 DTSBX442 01007 *** END QUARTER DTSBX442 01008 MOVE +6 TO L205-FIELD-LENGTH (8). DTSBX442 01009 SET L205-TYPE-TEXT-88 (8) TO TRUE. DTSBX442 01010 DTSBX442 01011 *** QUARTERS AUDITED DTSBX442 01012 MOVE +3 TO L205-FIELD-LENGTH (9). DTSBX442 01013 SET L205-TYPE-NUMBER-88 (9) TO TRUE. DTSBX442 01014 DTSBX442 01015 *** EMP SIZE DTSBX442 01016 MOVE +1 TO L205-FIELD-LENGTH (10). DTSBX442 01017 SET L205-TYPE-TEXT-88 (10) TO TRUE. DTSBX442 01018 DTSBX442 01019 *** ERROR 1 DTSBX442 01020 MOVE +2 TO L205-FIELD-LENGTH (11). DTSBX442 01021 SET L205-TYPE-TEXT-88 (11) TO TRUE. DTSBX442 01022 DTSBX442 01023 *** ERROR 2 DTSBX442 01024 MOVE +2 TO L205-FIELD-LENGTH (12). DTSBX442 01025 SET L205-TYPE-TEXT-88 (12) TO TRUE. DTSBX442 01026 DTSBX442 01027 *** ERROR 3 DTSBX442 01028 MOVE +2 TO L205-FIELD-LENGTH (13). DTSBX442 01029 SET L205-TYPE-TEXT-88 (13) TO TRUE. DTSBX442 01030 DTSBX442 01031 *** ERROR 4 DTSBX442 01032 MOVE +2 TO L205-FIELD-LENGTH (14). DTSBX442 01033 SET L205-TYPE-TEXT-88 (14) TO TRUE. DTSBX442 01034 DTSBX442 01035 *** ERROR 5 DTSBX442 01036 MOVE +2 TO L205-FIELD-LENGTH (15). DTSBX442 01037 SET L205-TYPE-TEXT-88 (15) TO TRUE. DTSBX442 01038 DTSBX442 01039 *** MONEY DUE AMT DTSBX442 01040 MOVE +12 TO L205-FIELD-LENGTH (16). DTSBX442 01041 SET L205-TYPE-NUMBER-88 (16) TO TRUE. DTSBX442 01042 DTSBX442 01043 *** MONEY COLLECTED DTSBX442 01044 MOVE +12 TO L205-FIELD-LENGTH (17). DTSBX442 01045 SET L205-TYPE-NUMBER-88 (17) TO TRUE. DTSBX442 01046 DTSBX442 01047 *** REASON CODE DTSBX442 01048 MOVE +1 TO L205-FIELD-LENGTH (18). DTSBX442 01049 SET L205-TYPE-TEXT-88 (18) TO TRUE. DTSBX442 01050 DTSBX442 01051 *** WAIVE PENALTY DTSBX442 01052 MOVE +1 TO L205-FIELD-LENGTH (19). DTSBX442 01053 SET L205-TYPE-TEXT-88 (19) TO TRUE. DTSBX442 01054 DTSBX442 01055 *** WAIVE INTEREST DTSBX442 01056 MOVE +1 TO L205-FIELD-LENGTH (20). DTSBX442 01057 SET L205-TYPE-TEXT-88 (20) TO TRUE. DTSBX442 01058 DTSBX442 01059 *** AUDIT HOURS DTSBX442 01060 MOVE +6 TO L205-FIELD-LENGTH (21). DTSBX442 01061 SET L205-TYPE-NUMBER-88 (21) TO TRUE. DTSBX442 01062 DTSBX442 01063 *** NEW EMPLOYEE COUNT DTSBX442 01064 MOVE +5 TO L205-FIELD-LENGTH (22). DTSBX442 01065 SET L205-TYPE-NUMBER-88 (22) TO TRUE. DTSBX442 01066 DTSBX442 01067 *** IND CONTRACTOR DTSBX442 01068 MOVE +5 TO L205-FIELD-LENGTH (23). DTSBX442 01069 SET L205-TYPE-NUMBER-88 (23) TO TRUE. DTSBX442 01070 DTSBX442 01071 MOVE AUDIT-QTR-REC TO L205-INPUT-DATA. DTSBX442 01072 CALL 'DTSBU205' USING L205-LINK-AREA. DTSBX442 01073 DTSBX442 01074 P4311-EXIT. DTSBX442 01075 EXIT. DTSBX442 01076 DTSBX442 01077 P4312-BUILD-X163. DTSBX442 01078 ** IF L205-VALID-NO-88 (2) DTSBX442 01079 * OR L205-VALID-NO-88 (12) DTSBX442 01080 * OR L205-VALID-NO-88 (17) DTSBX442 01081 * OR L205-VALID-NO-88 (22) DTSBX442 01082 * OR L205-VALID-NO-88 (23) DTSBX442 01083 * SET W-ERROR-YES-88 TO TRUE DTSBX442 01084 * DISPLAY 'X163 ERRORS' DTSBX442 01085 * GO TO P4312-EXIT DTSBX442 01086 ** END-IF. DTSBX442 01087 DTSBX442 01088 IF L205-VALID-NO-88 (9) DTSBX442 01089 DISPLAY 'X163 ERR 9 QTRS AUDITED ' DTSBX442 01090 END-IF. DTSBX442 01091 DTSBX442 01092 IF L205-VALID-NO-88 (11) DTSBX442 01093 DISPLAY 'X163 ERR 11 ERR 1 ' DTSBX442 01094 END-IF. DTSBX442 01095 DTSBX442 01096 IF L205-VALID-NO-88 (12) DTSBX442 01097 DISPLAY 'X163 ERR 12 ERR 2 ' DTSBX442 01098 END-IF. DTSBX442 01099 DTSBX442 01100 IF L205-VALID-NO-88 (13) DTSBX442 01101 DISPLAY 'X163 ERR 13 ERR 3 ' DTSBX442 01102 END-IF. DTSBX442 01103 DTSBX442 01104 IF L205-VALID-NO-88 (14) DTSBX442 01105 DISPLAY 'X163 ERR 14 ERR 4 ' DTSBX442 01106 END-IF. DTSBX442 01107 DTSBX442 01108 IF L205-VALID-NO-88 (15) DTSBX442 01109 DISPLAY 'X163 ERR 15 ERR 5 ' DTSBX442 01110 END-IF. DTSBX442 01111 DTSBX442 01112 IF L205-VALID-NO-88 (16) DTSBX442 01113 DISPLAY 'X163 ERR 16 MONEY DUE' DTSBX442 01114 END-IF. DTSBX442 01115 DTSBX442 01116 IF L205-VALID-NO-88 (17) DTSBX442 01117 DISPLAY 'X163 ERR 17 MONEY COLLECTED' DTSBX442 01118 END-IF. DTSBX442 01119 DTSBX442 01120 IF L205-VALID-NO-88 (21) DTSBX442 01121 DISPLAY 'X163 ERR 21 AUDIT HOURS' DTSBX442 01122 END-IF. DTSBX442 01123 DTSBX442 01124 IF L205-VALID-NO-88 (22) DTSBX442 01125 DISPLAY 'X163 ERR 22 NEW EMPLOYEE' DTSBX442 01126 END-IF. DTSBX442 01127 DTSBX442 01128 IF L205-VALID-NO-88 (23) DTSBX442 01129 DISPLAY 'X163 ERR 23 IND CON' DTSBX442 01130 END-IF. DTSBX442 01131 DTSBX442 01132 IF L205-VALID-NO-88 (2) DTSBX442 01133 OR L205-VALID-NO-88 (12) DTSBX442 01134 OR L205-VALID-NO-88 (17) DTSBX442 01135 OR L205-VALID-NO-88 (22) DTSBX442 01136 OR L205-VALID-NO-88 (23) DTSBX442 01137 SET W-ERROR-YES-88 TO TRUE DTSBX442 01138 DISPLAY 'X163 ERRORS' DTSBX442 01139 GO TO P4312-EXIT DTSBX442 01140 END-IF. DTSBX442 01141 DTSBX442 01142 MOVE L205-TEXT (1) (1:03) TO X163-REC-TYPE. DTSBX442 01143 DTSBX442 01144 MOVE L205-TEXT (2) (1:06) TO X163-EMP-NO. DTSBX442 01145 DTSBX442 01146 ** MOVE L205-INTEGER (3) TO W-INTEGER. DTSBX442 01147 MOVE L205-TEXT (3) (1:8) TO X163-ASSIGN-NO. DTSBX442 01148 DTSBX442 01149 MOVE L205-DATE (4) TO X163-COMPLETED-DT. DTSBX442 01150 DTSBX442 01151 MOVE L205-DATE (5) TO X163-PROCESSED-DT. DTSBX442 01152 DTSBX442 01153 MOVE L205-TEXT (6) (1:02) TO X163-FLD-REP-ID. DTSBX442 01154 DTSBX442 01155 MOVE L205-TEXT (7) (1:06) TO X163-FIRST-YRQ. DTSBX442 01156 DTSBX442 01157 MOVE L205-TEXT (8) (1:06) TO X163-LAST-YRQ. DTSBX442 01158 DTSBX442 01159 MOVE L205-INTEGER (9) TO W-INTEGER. DTSBX442 01160 MOVE W-INTEGER TO X163-QTRS-AUDITED-CNT. DTSBX442 01161 DTSBX442 01162 MOVE L205-TEXT (10) (1:01) TO X163-EMP-SIZE-IND. DTSBX442 01163 DTSBX442 01164 MOVE L205-INTEGER (11) TO W-INTEGER. DTSBX442 01165 MOVE W-INTEGER TO X163-ERR-TYPE1. DTSBX442 01166 DTSBX442 01167 MOVE L205-INTEGER (12) TO W-INTEGER. DTSBX442 01168 MOVE W-INTEGER TO X163-ERR-TYPE2. DTSBX442 01169 DTSBX442 01170 MOVE L205-INTEGER (13) TO W-INTEGER. DTSBX442 01171 MOVE W-INTEGER TO X163-ERR-TYPE3. DTSBX442 01172 DTSBX442 01173 MOVE L205-INTEGER (14) TO W-INTEGER. DTSBX442 01174 MOVE W-INTEGER TO X163-ERR-TYPE4. DTSBX442 01175 DTSBX442 01176 MOVE L205-INTEGER (15) TO W-INTEGER. DTSBX442 01177 MOVE W-INTEGER TO X163-ERR-TYPE5. DTSBX442 01178 DTSBX442 01179 MOVE L205-INTEGER (16) TO W-INTEGER. DTSBX442 01180 MOVE L205-FRACTION (16) TO W-FRACTION. DTSBX442 01181 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. DTSBX442 01182 MOVE W-NUMBER TO X163-MONEY-DUE-AMT. DTSBX442 01183 DTSBX442 01184 DISPLAY 'MONEY COLLECTED ' . DTSBX442 01185 DTSBX442 01186 MOVE L205-INTEGER (17) TO W-INTEGER. DTSBX442 01187 MOVE L205-FRACTION (17) TO W-FRACTION. DTSBX442 01188 DTSBX442 01189 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. DTSBX442 01190 DTSBX442 01191 MOVE W-NUMBER TO X163-MONEY-COLLECT-AMT. DTSBX442 01192 DISPLAY 'P4320 MONEY COLLECTED ' X163-MONEY-COLLECT-AMT. DTSBX442 01193 DTSBX442 01194 MOVE L205-TEXT (18) (1:01) TO X163-MONEY-REASON-CD. DTSBX442 01195 DTSBX442 01196 MOVE L205-TEXT (19) (1:01) TO X163-PEN-WAIVE-IND. DTSBX442 01197 DTSBX442 01198 MOVE L205-TEXT (20) (1:01) TO X163-INT-WAIVE-IND. DTSBX442 01199 DTSBX442 01200 MOVE L205-INTEGER (21) TO W-INTEGER. DTSBX442 01201 MOVE L205-FRACTION (21) TO W-FRACTION. DTSBX442 01202 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. DTSBX442 01203 MOVE W-NUMBER TO X163-AUDIT-HRS. DTSBX442 01204 DTSBX442 01205 MOVE L205-INTEGER (22) TO W-INTEGER. DTSBX442 01206 MOVE W-INTEGER TO X163-NEW-EMPLOYEE-CNT. DTSBX442 01207 DTSBX442 01208 MOVE L205-INTEGER (23) TO W-INTEGER. DTSBX442 01209 MOVE W-INTEGER TO X163-INDCON-TO-EMPL-CNT. DTSBX442 01210 DTSBX442 01211 DISPLAY 'P4312'. DTSBX442 01212 DISPLAY X163-PROCESSED-DT ' ' X163-MONEY-COLLECT-AMT. DTSBX442 01213 P4312-EXIT. DTSBX442 01214 EXIT. DTSBX442 01215 DTSBX442 01216 P4320-PARSE-X164. DTSBX442 01217 PERFORM DTSBX442 01218 VARYING SUB FROM +1 BY +1 DTSBX442 01219 UNTIL SUB > +100 DTSBX442 01220 MOVE +0 TO L205-FIELD-LENGTH (SUB) DTSBX442 01221 L205-INTEGER (SUB) DTSBX442 01222 L205-FRACTION (SUB) DTSBX442 01223 MOVE SPACES TO L205-TEXT (SUB) DTSBX442 01224 L205-DATE (SUB) DTSBX442 01225 SET L205-TYPE-TEXT-88 (SUB) TO TRUE DTSBX442 01226 END-PERFORM. DTSBX442 01227 DTSBX442 01228 PERFORM P4321-PARSE THRU P4321-EXIT. DTSBX442 01229 PERFORM P4322-BUILD-X164 THRU P4322-EXIT. DTSBX442 01230 DTSBX442 01231 DISPLAY 'P4320 ' X164-QUARTER. DTSBX442 01232 MOVE X164-QUARTER TO L004-QTR-5-9. DTSBX442 01233 MOVE L004-QTR-5-Q TO QSUB. DTSBX442 01234 DTSBX442 01235 MOVE X164-QTR-GROSS-PAYROLL TO Q-GROSS-PAYROLL (QSUB). DTSBX442 01236 MOVE X164-QTR-UNDER-TOT-WAGE TO Q-UNDER-TOT-WAGE (QSUB). DTSBX442 01237 MOVE X164-QTR-UNDER-TAX-WAGE TO Q-UNDER-TAX-WAGE (QSUB). DTSBX442 01238 MOVE X164-QTR-UNDER-CONTRIB TO Q-UNDER-CONTRIB (QSUB). DTSBX442 01239 MOVE X164-QTR-OVER-TOT-WAGE TO Q-OVER-TOT-WAGE (QSUB). DTSBX442 01240 MOVE X164-QTR-OVER-TAX-WAGE TO Q-OVER-TAX-WAGE (QSUB). DTSBX442 01241 MOVE X164-QTR-OVER-CONTRIB TO Q-OVER-CONTRIB (QSUB). DTSBX442 01242 DTSBX442 01243 DISPLAY 'QTR ' X164-QUARTER DTSBX442 01244 ' UNDER TOT: ' Q-UNDER-TOT-WAGE (QSUB) DTSBX442 01245 ' UNDER TAX: ' Q-UNDER-TAX-WAGE (QSUB) DTSBX442 01246 ' UNDER CONTRIB: ' Q-UNDER-CONTRIB (QSUB) DTSBX442 01247 ' OVER TOT: ' Q-OVER-TOT-WAGE (QSUB) DTSBX442 01248 ' OVER TAX: ' Q-OVER-TAX-WAGE (QSUB) DTSBX442 01249 ' OVER CONTRIB: ' Q-OVER-CONTRIB (QSUB). DTSBX442 01250 DTSBX442 01251 P4320-EXIT. DTSBX442 01252 EXIT. DTSBX442 01253 DTSBX442 01254 P4321-PARSE. DTSBX442 01255 DISPLAY 'X164 ' AUDIT-QTR-REC(1:30). DTSBX442 01256 INITIALIZE X164-REC. DTSBX442 01257 MOVE +12 TO L205-LAST-FIELD DTSBX442 01258 MOVE +12 TO L205-LAST-FIELD-LEN DTSBX442 01259 DTSBX442 01260 *** RECORD TYPE DTSBX442 01261 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBX442 01262 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBX442 01263 DTSBX442 01264 *** EMPLOYER NUMBER DTSBX442 01265 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBX442 01266 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBX442 01267 DTSBX442 01268 *** ASSIGN NUMBER DTSBX442 01269 *& MOVE +8 TO L205-FIELD-LENGTH (3). DTSBX442 01270 *& SET L205-TYPE-NUMBER-88 (3) TO TRUE. DTSBX442 01271 MOVE +8 TO L205-FIELD-LENGTH (3). DTSBX442 01272 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBX442 01273 DTSBX442 01274 *** QUARTER DTSBX442 01275 MOVE +6 TO L205-FIELD-LENGTH (4). DTSBX442 01276 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSBX442 01277 DTSBX442 01278 *** QUARTER AUDITED INT DTSBX442 01279 MOVE +1 TO L205-FIELD-LENGTH (5). DTSBX442 01280 SET L205-TYPE-TEXT-88 (5) TO TRUE. DTSBX442 01281 DTSBX442 01282 *** GROSS PAYROLL DTSBX442 01283 MOVE +12 TO L205-FIELD-LENGTH (6). DTSBX442 01284 SET L205-TYPE-NUMBER-88 (6) TO TRUE. DTSBX442 01285 DTSBX442 01286 *** TOT WAGE UNDER DTSBX442 01287 MOVE +12 TO L205-FIELD-LENGTH (7). DTSBX442 01288 SET L205-TYPE-NUMBER-88 (7) TO TRUE. DTSBX442 01289 DTSBX442 01290 *** TAX WAGE UNDER DTSBX442 01291 MOVE +12 TO L205-FIELD-LENGTH (8). DTSBX442 01292 SET L205-TYPE-NUMBER-88 (8) TO TRUE. DTSBX442 01293 DTSBX442 01294 *** CONTRIBUTIONS UNDER DTSBX442 01295 MOVE +12 TO L205-FIELD-LENGTH (9). DTSBX442 01296 SET L205-TYPE-NUMBER-88 (9) TO TRUE. DTSBX442 01297 DTSBX442 01298 *** TOT WAGE OVER DTSBX442 01299 MOVE +12 TO L205-FIELD-LENGTH (10). DTSBX442 01300 SET L205-TYPE-NUMBER-88 (10) TO TRUE. DTSBX442 01301 DTSBX442 01302 *** TAX WAGE OVER DTSBX442 01303 MOVE +12 TO L205-FIELD-LENGTH (11). DTSBX442 01304 SET L205-TYPE-NUMBER-88 (11) TO TRUE. DTSBX442 01305 DTSBX442 01306 *** CONTRIBUTIONS OVER DTSBX442 01307 MOVE +12 TO L205-FIELD-LENGTH (12). DTSBX442 01308 SET L205-TYPE-NUMBER-88 (12) TO TRUE. DTSBX442 01309 DTSBX442 01310 MOVE AUDIT-QTR-REC TO L205-INPUT-DATA. DTSBX442 01311 CALL 'DTSBU205' USING L205-LINK-AREA. DTSBX442 01312 DTSBX442 01313 P4321-EXIT. DTSBX442 01314 EXIT. DTSBX442 01315 DTSBX442 01316 P4322-BUILD-X164. DTSBX442 01317 ** IF L205-VALID-NO-88 (6) DTSBX442 01318 * OR L205-VALID-NO-88 (7) DTSBX442 01319 * OR L205-VALID-NO-88 (8) DTSBX442 01320 * OR L205-VALID-NO-88 (9) DTSBX442 01321 * OR L205-VALID-NO-88 (10) DTSBX442 01322 * OR L205-VALID-NO-88 (11) DTSBX442 01323 * OR L205-VALID-NO-88 (12) DTSBX442 01324 * SET W-ERROR-YES-88 TO TRUE DTSBX442 01325 * DISPLAY 'X164 ERRORS' DTSBX442 01326 * GO TO P4322-EXIT DTSBX442 01327 ** END-IF. DTSBX442 01328 DTSBX442 01329 IF L205-VALID-NO-88 (4) DTSBX442 01330 DISPLAY 'X164 ERR 4 QTR ' L205-TEXT (4) (1:06) DTSBX442 01331 END-IF. DTSBX442 01332 DTSBX442 01333 IF L205-VALID-NO-88 (6) DTSBX442 01334 DISPLAY 'X164 ERR 6 GROSS PAYROLL' DTSBX442 01335 END-IF. DTSBX442 01336 DTSBX442 01337 IF L205-VALID-NO-88 (7) DTSBX442 01338 DISPLAY 'X164 ERR 7 UNDER TOT' DTSBX442 01339 END-IF. DTSBX442 01340 DTSBX442 01341 IF L205-VALID-NO-88 (8) DTSBX442 01342 DISPLAY 'X164 ERR 8 UNDER TAX' DTSBX442 01343 END-IF. DTSBX442 01344 DTSBX442 01345 IF L205-VALID-NO-88 (9) DTSBX442 01346 DISPLAY 'X164 ERR 9 UNDER CONTRIB' DTSBX442 01347 END-IF. DTSBX442 01348 DTSBX442 01349 IF L205-VALID-NO-88 (10) DTSBX442 01350 DISPLAY 'X164 ERR 10 OVER TOT' DTSBX442 01351 END-IF. DTSBX442 01352 DTSBX442 01353 IF L205-VALID-NO-88 (11) DTSBX442 01354 DISPLAY 'X164 ERR 11 OVER TAX' DTSBX442 01355 END-IF. DTSBX442 01356 DTSBX442 01357 IF L205-VALID-NO-88 (12) DTSBX442 01358 DISPLAY 'X164 ERR 12 OVER CONTRIB' DTSBX442 01359 END-IF. DTSBX442 01360 DTSBX442 01361 MOVE L205-TEXT (1) (1:03) TO X164-REC-TYPE. DTSBX442 01362 DTSBX442 01363 MOVE L205-TEXT (2) (1:06) TO X164-EMP-NO. DTSBX442 01364 DTSBX442 01365 ** MOVE L205-INTEGER (3) TO W-INTEGER. DTSBX442 01366 MOVE L205-TEXT (3) (1:8) TO X164-ASSIGN-NO. DTSBX442 01367 DTSBX442 01368 MOVE L205-TEXT (4) (1:06) TO X164-QUARTER. DTSBX442 01369 DISPLAY 'X164 QTR: ' L205-TEXT (4) (1:06). DTSBX442 01370 DTSBX442 01371 MOVE L205-TEXT (5) (1:01) TO X164-QTR-AUDITED-IND. DTSBX442 01372 DTSBX442 01373 MOVE L205-INTEGER (6) TO W-INTEGER. DTSBX442 01374 MOVE L205-FRACTION (6) TO W-FRACTION. DTSBX442 01375 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. DTSBX442 01376 MOVE W-NUMBER TO X164-QTR-GROSS-PAYROLL. DTSBX442 01377 DTSBX442 01378 MOVE L205-INTEGER (7) TO W-INTEGER. DTSBX442 01379 MOVE L205-FRACTION (7) TO W-FRACTION. DTSBX442 01380 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. DTSBX442 01381 MOVE W-NUMBER TO X164-QTR-UNDER-TOT-WAGE. DTSBX442 01382 DTSBX442 01383 MOVE L205-INTEGER (8) TO W-INTEGER. DTSBX442 01384 MOVE L205-FRACTION (8) TO W-FRACTION. DTSBX442 01385 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. DTSBX442 01386 MOVE W-NUMBER TO X164-QTR-UNDER-TAX-WAGE. DTSBX442 01387 DTSBX442 01388 MOVE L205-INTEGER (9) TO W-INTEGER. DTSBX442 01389 MOVE L205-FRACTION (9) TO W-FRACTION. DTSBX442 01390 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. DTSBX442 01391 MOVE W-NUMBER TO X164-QTR-UNDER-CONTRIB. DTSBX442 01392 DTSBX442 01393 MOVE L205-INTEGER (10) TO W-INTEGER. DTSBX442 01394 MOVE L205-FRACTION (10) TO W-FRACTION. DTSBX442 01395 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. DTSBX442 01396 MOVE W-NUMBER TO X164-QTR-OVER-TOT-WAGE. DTSBX442 01397 DTSBX442 01398 MOVE L205-INTEGER (11) TO W-INTEGER. DTSBX442 01399 MOVE L205-FRACTION (11) TO W-FRACTION. DTSBX442 01400 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. DTSBX442 01401 MOVE W-NUMBER TO X164-QTR-OVER-TAX-WAGE. DTSBX442 01402 DTSBX442 01403 MOVE L205-INTEGER (12) TO W-INTEGER. DTSBX442 01404 MOVE L205-FRACTION (12) TO W-FRACTION. DTSBX442 01405 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. DTSBX442 01406 MOVE W-NUMBER TO X164-QTR-OVER-CONTRIB. DTSBX442 01407 DTSBX442 01408 P4322-EXIT. DTSBX442 01409 EXIT. DTSBX442 01410 DTSBX442 01411 P4330-READ-MPRF. DTSBX442 01412 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBX442 01413 MOVE W-CURR-EMP TO MSKL-EMP-NO. DTSBX442 01414 SET MSKL-PRF-88 TO TRUE. DTSBX442 01415 DTSBX442 01416 PERFORM S910-READ THRU S910-EXIT. DTSBX442 01417 IF L910-NO-REC-88 DTSBX442 01418 DISPLAY 'P4430 - EMPLOYER NOT FOUND ' W-CURR-EMP DTSBX442 01419 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX442 01420 ELSE DTSBX442 01421 MOVE MSKL-REC TO MPRF-REC DTSBX442 01422 MOVE MPRF-PRIMARY-NAME TO W-EMP-NAME DTSBX442 01423 MOVE W-CURR-QUARTER TO L516-YRQ DTSBX442 01424 PERFORM S516-LIABILITY-INFO THRU S516-EXIT DTSBX442 01425 IF L516-NOT-LIABLE-88 DTSBX442 01426 DISPLAY 'P4430 - NOT LIABLE ' W-CURR-EMP DTSBX442 01427 ' ' W-CURR-QUARTER DTSBX442 01428 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX442 01429 END-IF DTSBX442 01430 END-IF. DTSBX442 01431 DTSBX442 01432 P4330-EXIT. DTSBX442 01433 EXIT. DTSBX442 01434 DTSBX442 01435 P4400-WRITE-RPT. DTSBX442 01436 MOVE W-CURR-QUARTER-Q TO QSUB. DTSBX442 01437 IF Q-OVER-TOT-WAGE (QSUB) = ZERO DTSBX442 01438 AND Q-UNDER-TOT-WAGE (QSUB) = ZERO DTSBX442 01439 AND Q-OVER-TAX-WAGE (QSUB) = ZERO DTSBX442 01440 AND Q-UNDER-TAX-WAGE (QSUB) = ZERO DTSBX442 01441 AND Q-UNDER-CONTRIB (QSUB) = ZERO DTSBX442 01442 AND Q-OVER-CONTRIB (QSUB) = ZERO DTSBX442 01443 DISPLAY 'P4400 NO WAGE CHANGE - EXITING ' W-CURR-EMP DTSBX442 01444 ' ' W-CURR-QUARTER DTSBX442 01445 GO TO P4400-EXIT DTSBX442 01446 END-IF. DTSBX442 01447 DTSBX442 01448 PERFORM P4420-READ-MQTR THRU P4420-EXIT. DTSBX442 01449 DTSBX442 01450 MOVE LENGTH OF T028-REC TO T028-LENGTH DTSBX442 01451 MOVE '028' TO T028-REC-TYPE. DTSBX442 01452 MOVE W-CURR-EMP TO T028-EMP-NO. DTSBX442 01453 MOVE 'AUDIT ' TO T028-ORIGIN. DTSBX442 01454 MOVE L005-DATE TO T028-SYS-DATE. DTSBX442 01455 MOVE L005-TIME TO T028-SYS-TIME. DTSBX442 01456 SET T028-AMEND-RPT-88 TO TRUE. DTSBX442 01457 IF MQTR-CURR-RCVD-88 DTSBX442 01458 SET T028-AUDIT-88 TO TRUE DTSBX442 01459 ELSE DTSBX442 01460 SET T028-ORIG-88 TO TRUE DTSBX442 01461 END-IF. DTSBX442 01462 DTSBX442 01463 MOVE W-PSEUDO-BATCH-NO TO T028-PSEUDO-BATCH-NO. DTSBX442 01464 MOVE W-PSEUDO-ITEM-NO TO T028-PSEUDO-ITEM-NO. DTSBX442 01465 DTSBX442 01466 MOVE W-EMP-NAME (1:4) TO T028-NAME-CHECK. DTSBX442 01467 MOVE W-CURR-QUARTER TO T028-YRQ. DTSBX442 01468 DTSBX442 01469 MOVE W-CURR-QUARTER-Q TO QSUB. DTSBX442 01470 IF Q-UNDER-TOT-WAGE (QSUB) > ZERO DTSBX442 01471 MOVE Q-UNDER-TOT-WAGE (QSUB) TO T028-TOT-WAGE DTSBX442 01472 ELSE DTSBX442 01473 IF Q-OVER-TOT-WAGE (QSUB) > ZERO DTSBX442 01474 COMPUTE T028-TOT-WAGE = DTSBX442 01475 Q-OVER-TOT-WAGE (QSUB) * -1 DTSBX442 01476 ELSE DTSBX442 01477 MOVE ZERO TO T028-TOT-WAGE DTSBX442 01478 END-IF DTSBX442 01479 END-IF. DTSBX442 01480 DTSBX442 01481 IF Q-UNDER-TAX-WAGE (QSUB) > ZERO DTSBX442 01482 MOVE Q-UNDER-TAX-WAGE (QSUB) TO T028-TAX-WAGE DTSBX442 01483 ELSE DTSBX442 01484 IF Q-OVER-TAX-WAGE (QSUB) > ZERO DTSBX442 01485 COMPUTE T028-TAX-WAGE = DTSBX442 01486 Q-OVER-TAX-WAGE (QSUB) * -1 DTSBX442 01487 ELSE DTSBX442 01488 MOVE ZERO TO T028-TAX-WAGE DTSBX442 01489 END-IF DTSBX442 01490 END-IF. DTSBX442 01491 DTSBX442 01492 COMPUTE T028-EXCESS-WAGE = DTSBX442 01493 (T028-TOT-WAGE - T028-TAX-WAGE). DTSBX442 01494 ** COMPUTE T028-EXCESS-WAGE = DTSBX442 01495 ** (W-TOT-WAGE-SUM - W-TAX-WAGE-SUM). DTSBX442 01496 ******************************************** DTSBX442 01497 * APPLY REMITTANCE TO FIRST QUARTER, THEN MOVE ZERO DTSBX442 01498 * TO REMITTANCE AMOUNT TO PREVENT THE MONEY FROM BEING DTSBX442 01499 * APPLIED MORE THAN ONCE. DTSBX442 01500 ******************************************** DTSBX442 01501 MOVE W-REMITTANCE TO T028-REMIT-AMT. DTSBX442 01502 MOVE +0 TO W-REMITTANCE. DTSBX442 01503 DTSBX442 01504 SET T028-WAIVE-BOTH-NO-88 TO TRUE. DTSBX442 01505 SET T028-WAIVE-INT-NO-88 TO TRUE. DTSBX442 01506 SET T028-WAIVE-LATE-PEN-NO-88 TO TRUE. DTSBX442 01507 * MOVE X163-PEN-WAIVE-IND TO T028-WAIVE-LATE-PEN-IND. DTSBX442 01508 * MOVE X163-INT-WAIVE-IND TO T028-WAIVE-INT-IND. DTSBX442 01509 IF T028-AUDIT-88 DTSBX442 01510 SET T028-TOTAL-NO-ENTRY-88 TO TRUE DTSBX442 01511 SET T028-1ST-MTH-NO-ENTRY-88 TO TRUE DTSBX442 01512 SET T028-2ND-MTH-NO-ENTRY-88 TO TRUE DTSBX442 01513 SET T028-3RD-MTH-NO-ENTRY-88 TO TRUE DTSBX442 01514 ELSE DTSBX442 01515 MOVE W-WRKR-CNT TO T028-1ST-MTH-EMPL-CNT DTSBX442 01516 T028-2ND-MTH-EMPL-CNT DTSBX442 01517 T028-3RD-MTH-EMPL-CNT DTSBX442 01518 T028-TOTAL-EMPL-CNT DTSBX442 01519 END-IF. DTSBX442 01520 DTSBX442 01521 MOVE L005-DATE TO T028-RECEIVED-DATE DTSBX442 01522 L001-FED-8-DATE-9. DTSBX442 01523 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX442 01524 DTSBX442 01525 SET L003-NOT-WORK-DAY TO TRUE. DTSBX442 01526 PERFORM P4410-WORK-DAY-LOOP THRU P4410-EXIT DTSBX442 01527 UNTIL L003-IS-WORK-DAY. DTSBX442 01528 MOVE L001-FED-8-DATE-9 TO T028-DEPOSIT-DATE. DTSBX442 01529 DTSBX442 01530 MOVE ZERO TO T028-TRACE-NO. DTSBX442 01531 DTSBX442 01532 MOVE 'VIS' TO T028-RESPONSIBLE-ACTIVITY. DTSBX442 01533 MOVE X163-FLD-REP-ID TO L062-FLD-REP-ID. DTSBX442 01534 PERFORM S062-FLD-REP THRU S062-EXIT. DTSBX442 01535 MOVE L062-OP-ID TO T028-RESPONSIBLE-OP-ID. DTSBX442 01536 SET T028-PASSED-FULL-EDITS-YES-88 TO TRUE. DTSBX442 01537 DTSBX442 01538 MOVE ZERO TO T028-LOG-NBR. DTSBX442 01539 DTSBX442 01540 MOVE T028-REC TO TSKL-REC. DTSBX442 01541 PERFORM S927B-WRITE THRU S927B-EXIT. DTSBX442 01542 ADD +1 TO W-T028-WRITE-CNT. DTSBX442 01543 DTSBX442 01544 MOVE T028-TOT-WAGE TO W-AMT-DISP1. DTSBX442 01545 MOVE T028-TAX-WAGE TO W-AMT-DISP2. DTSBX442 01546 MOVE T028-EXCESS-WAGE TO W-AMT-DISP3. DTSBX442 01547 MOVE T028-REMIT-AMT TO W-AMT-DISP4. DTSBX442 01548 DISPLAY 'P4400 ' T028-EMP-NO ' ' T028-YRQ DTSBX442 01549 ' ' T028-RPT-TYPE DTSBX442 01550 ' TOT ' W-AMT-DISP1 ' TAX ' W-AMT-DISP2 DTSBX442 01551 ' EXC ' W-AMT-DISP3 ' REMIT ' W-AMT-DISP4. DTSBX442 01552 P4400-EXIT. DTSBX442 01553 EXIT. DTSBX442 01554 DTSBX442 01555 P4410-WORK-DAY-LOOP. DTSBX442 01556 ADD +1 TO L001-JUL-ABS-DAY. DTSBX442 01557 DTSBX442 01558 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. DTSBX442 01559 DTSBX442 01560 MOVE L001-FED-8-DATE-9 TO L003-DATE. DTSBX442 01561 DTSBX442 01562 PERFORM S003-AGENCY-DAY THRU S003-EXIT. DTSBX442 01563 DTSBX442 01564 P4410-EXIT. DTSBX442 01565 EXIT. DTSBX442 01566 DTSBX442 01567 P4420-READ-MQTR. DTSBX442 01568 MOVE LOW-VALUE TO MQTR-KEY-AREA. DTSBX442 01569 MOVE W-CURR-EMP TO MQTR-EMP-NO. DTSBX442 01570 SET MQTR-QTR-88 TO TRUE. DTSBX442 01571 MOVE W-CURR-QUARTER TO MQTR-YRQ. DTSBX442 01572 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBX442 01573 DTSBX442 01574 PERFORM S910-READ THRU S910-EXIT. DTSBX442 01575 IF L910-NO-REC-88 DTSBX442 01576 DISPLAY 'P4420 - QUARTER NOT FOUND ' W-CURR-EMP DTSBX442 01577 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX442 01578 ELSE DTSBX442 01579 MOVE MSKL-REC TO MQTR-REC DTSBX442 01580 DISPLAY 'P4420 ' MQTR-EMP-NO ' ' MQTR-YRQ DTSBX442 01581 ' ' MQTR-CURR-RPT-TYPE DTSBX442 01582 END-IF. DTSBX442 01583 DTSBX442 01584 P4420-EXIT. DTSBX442 01585 EXIT. DTSBX442 01586 DTSBX442 01587 P4500-FORMAT-PAY. DTSBX442 01588 MOVE LENGTH OF T025-REC TO T025-LENGTH. DTSBX442 01589 MOVE W-CURR-EMP TO T025-EMP-NO. DTSBX442 01590 MOVE 'AUDIT' TO T025-ORIGIN. DTSBX442 01591 MOVE L005-DATE TO T025-SYS-DATE. DTSBX442 01592 MOVE L005-TIME TO T025-SYS-TIME. DTSBX442 01593 SET T025-PA-PAY-88 TO TRUE. DTSBX442 01594 MOVE MPRF-PRIMARY-NAME (1:4) TO T025-NAME-CHECK. DTSBX442 01595 MOVE W-REMITTANCE TO T025-REMIT-AMT. DTSBX442 01596 MOVE +0 TO W-REMITTANCE. DTSBX442 01597 MOVE ZEROS TO T025-TRACE-NO. DTSBX442 01598 MOVE ZEROS TO T025-APPLIC-YRQ. DTSBX442 01599 MOVE SPACES TO T025-APPLIC-IND. DTSBX442 01600 MOVE ZERO TO T025-APPLIC-BATCH-NO DTSBX442 01601 T025-APPLIC-ITEM-NO. DTSBX442 01602 MOVE L005-DATE TO T025-RECEIVED-DATE DTSBX442 01603 L001-FED-8-DATE-9. DTSBX442 01604 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX442 01605 DTSBX442 01606 SET L003-NOT-WORK-DAY TO TRUE. DTSBX442 01607 PERFORM P4410-WORK-DAY-LOOP THRU P4410-EXIT DTSBX442 01608 UNTIL L003-IS-WORK-DAY. DTSBX442 01609 MOVE L001-FED-8-DATE-9 TO T025-DEPOSIT-DATE. DTSBX442 01610 DTSBX442 01611 MOVE 'VIS' TO T025-RESPONSIBLE-ACTIVITY. DTSBX442 01612 DTSBX442 01613 MOVE X163-FLD-REP-ID TO L062-FLD-REP-ID. DTSBX442 01614 PERFORM S062-FLD-REP THRU S062-EXIT. DTSBX442 01615 MOVE L062-OP-ID TO T025-RESPONSIBLE-OP-ID. DTSBX442 01616 DTSBX442 01617 MOVE T025-REC TO TSKL-REC. DTSBX442 01618 PERFORM S927B-WRITE THRU S927B-EXIT. DTSBX442 01619 ADD +1 TO W-T025-WRITE-CNT. DTSBX442 01620 DTSBX442 01621 MOVE T025-REMIT-AMT TO W-AMT-DISP4. DTSBX442 01622 DISPLAY 'P4500 ' T025-EMP-NO ' ' DTSBX442 01623 ' ' T025-PAY-TYPE DTSBX442 01624 ' REMIT ' W-AMT-DISP4. DTSBX442 01625 P4500-EXIT. DTSBX442 01626 EXIT. DTSBX442 01627 DTSBX442 01628 T0000-TERMINATE. DTSBX442 01629 IF W-ERROR-YES-88 DTSBX442 01630 DISPLAY 'DTSBX442 TERMINATION: ERRORS' DTSBX442 01631 PERFORM T1000-CLOSE-FILES THRU T1000-EXIT DTSBX442 01632 GO TO T0000-EXIT DTSBX442 01633 END-IF. DTSBX442 01634 DTSBX442 01635 PERFORM T1100-UPDATE-CURR-BATCH THRU T1100-EXIT. DTSBX442 01636 DTSBX442 01637 DISPLAY ' '. DTSBX442 01638 DTSBX442 01639 DISPLAY '*** DTSBX442 TERMINATION STATISTICS ***'. DTSBX442 01640 DTSBX442 01641 DISPLAY ' '. DTSBX442 01642 DTSBX442 01643 DISPLAY '*** AUDIT AMENDED REPORTS ***'. DTSBX442 01644 DTSBX442 01645 DISPLAY ' '. DTSBX442 01646 DTSBX442 01647 DISPLAY 'INPUT RECORDS READ: ' DTSBX442 01648 W-AUDIT-CNT. DTSBX442 01649 DTSBX442 01650 DISPLAY ' '. DTSBX442 01651 DISPLAY 'WAGES PROCESSED: ' DTSBX442 01652 W-EMP-WAGE-CNT. DTSBX442 01653 DTSBX442 01654 DISPLAY ' '. DTSBX442 01655 DISPLAY 'ZERO WAGE RECS BYPASSED: ' DTSBX442 01656 W-ZERO-WAGE-CNT. DTSBX442 01657 DTSBX442 01658 DISPLAY ' '. DTSBX442 01659 DISPLAY 'REPORTS WRITTEN: ' DTSBX442 01660 W-RPT-CNT. DTSBX442 01661 DTSBX442 01662 DISPLAY ' '. DTSBX442 01663 DTSBX442 01664 DISPLAY '***************************************'. DTSBX442 01665 DTSBX442 01666 T0000-EXIT. DTSBX442 01667 EXIT. DTSBX442 01668 DTSBX442 01669 T1000-CLOSE-FILES. DTSBX442 01670 CLOSE AUDIT-FILE DTSBX442 01671 CURR-BATCH-FILE. DTSBX442 01672 DTSBX442 01673 PERFORM S1110-CLOSE-WAGE-TEMP THRU S1110-EXIT. DTSBX442 01674 PERFORM S1310-CLOSE-WAGE-OUT THRU S1310-EXIT. DTSBX442 01675 DTSBX442 01676 PERFORM S981C-CLOSE THRU S981C-EXIT. DTSBX442 01677 PERFORM S910-CLOSE THRU S910-EXIT. DTSBX442 01678 PERFORM S931-CLOSE THRU S931-EXIT. DTSBX442 01679 PERFORM S927C-CLOSE THRU S927C-EXIT. DTSBX442 01680 DTSBX442 01681 T1000-EXIT. DTSBX442 01682 EXIT. DTSBX442 01683 DTSBX442 01684 T1100-UPDATE-CURR-BATCH. DTSBX442 01685 MOVE W-PSEUDO-BATCH-NO TO CURRENT-BATCH-NO DTSBX442 01686 W-END-BATCH. DTSBX442 01687 MOVE W-PSEUDO-ITEM-NO TO CURRENT-ITEM-NO. DTSBX442 01688 DISPLAY 'REWRITING CURRENT BATCH ' DTSBX442 01689 W-PSEUDO-BATCH-NO '/' W-PSEUDO-ITEM-NO DTSBX442 01690 REWRITE CURR-BATCH-REC. DTSBX442 01691 IF BATCH-STATUS-OK-88 DTSBX442 01692 NEXT SENTENCE DTSBX442 01693 ELSE DTSBX442 01694 DISPLAY 'T1100 - CANNOT REWRITE BATCH NUMBER FILE ' DTSBX442 01695 BATCH-STATUS DTSBX442 01696 END-IF. DTSBX442 01697 DTSBX442 01698 T1100-EXIT. DTSBX442 01699 EXIT. DTSBX442 01700 DTSBX442 01701 S001-FROM-FED-8. DTSBX442 01702 SET L001-FROM-FED-8 TO TRUE. DTSBX442 01703 GO TO S001-DATE. DTSBX442 01704 DTSBX442 01705 S001-FROM-CAL-8. DTSBX442 01706 SET L001-FROM-CAL-8 TO TRUE. DTSBX442 01707 GO TO S001-DATE. DTSBX442 01708 DTSBX442 01709 S001-FROM-ABS-DAY. DTSBX442 01710 SET L001-FROM-ABS-DAY TO TRUE. DTSBX442 01711 GO TO S001-DATE. DTSBX442 01712 DTSBX442 01713 S001-DATE. DTSBX442 01714 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX442 01715 S001-EXIT. DTSBX442 01716 EXIT. DTSBX442 01717 DTSBX442 01718 S003-AGENCY-DAY. DTSBX442 01719 SET L003-AGENCY-DAY TO TRUE. DTSBX442 01720 GO TO S003-WORK-DAY. DTSBX442 01721 DTSBX442 01722 S003-WORK-DAY. DTSBX442 01723 CALL 'DTSBU003' USING L003-LINK-AREA. DTSBX442 01724 S003-EXIT. DTSBX442 01725 EXIT. DTSBX442 01726 DTSBX442 01727 S004-FROM-5. DTSBX442 01728 SET L004-FROM-5 TO TRUE. DTSBX442 01729 GO TO S004-YRQ. DTSBX442 01730 DTSBX442 01731 S004-FROM-DATE. DTSBX442 01732 SET L004-FROM-DATE TO TRUE. DTSBX442 01733 GO TO S004-YRQ. DTSBX442 01734 DTSBX442 01735 S004-FROM-ABS. DTSBX442 01736 SET L004-FROM-ABS TO TRUE. DTSBX442 01737 GO TO S004-YRQ. DTSBX442 01738 DTSBX442 01739 S004-YRQ. DTSBX442 01740 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBX442 01741 DTSBX442 01742 S004-EXIT. DTSBX442 01743 EXIT. DTSBX442 01744 DTSBX442 01745 S005-FROM-SYS. DTSBX442 01746 SET L005-FROM-SYS TO TRUE. DTSBX442 01747 GO TO S005-ABSTIME. DTSBX442 01748 DTSBX442 01749 S005-ABSTIME. DTSBX442 01750 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBX442 01751 S005-EXIT. DTSBX442 01752 EXIT. DTSBX442 01753 DTSBX442 01754 S062-FLD-REP. DTSBX442 01755 CALL 'DTSBU062' USING L062-LINK-AREA. DTSBX442 01756 DTSBX442 01757 S062-EXIT. DTSBX442 01758 EXIT. DTSBX442 01759 DTSBX442 01760 S516-LIABILITY-INFO. DTSBX442 01761 CALL 'DTSBU516' USING L516-LINK-AREA DTSBX442 01762 MPRF-REC. DTSBX442 01763 S516-EXIT. DTSBX442 01764 EXIT. DTSBX442 01765 DTSBX442 01766 S910-OPEN-READ. DTSBX442 01767 SET L910-OPEN-READ-88 TO TRUE. DTSBX442 01768 GO TO S910-MSTR-IO. DTSBX442 01769 DTSBX442 01770 S910-OPEN-UPDATE. DTSBX442 01771 SET L910-OPEN-UPDATE-88 TO TRUE. DTSBX442 01772 GO TO S910-MSTR-IO. DTSBX442 01773 DTSBX442 01774 S910-READ. DTSBX442 01775 SET L910-READ-88 TO TRUE. DTSBX442 01776 GO TO S910-MSTR-IO. DTSBX442 01777 DTSBX442 01778 S910-START-BROWSE. DTSBX442 01779 SET L910-START-BROWSE-88 TO TRUE. DTSBX442 01780 GO TO S910-MSTR-IO. DTSBX442 01781 DTSBX442 01782 S910-READ-NEXT. DTSBX442 01783 SET L910-READ-NEXT-88 TO TRUE. DTSBX442 01784 GO TO S910-MSTR-IO. DTSBX442 01785 DTSBX442 01786 S910-CLOSE. DTSBX442 01787 SET L910-CLOSE-88 TO TRUE. DTSBX442 01788 GO TO S910-MSTR-IO. DTSBX442 01789 DTSBX442 01790 S910-MSTR-IO. DTSBX442 01791 CALL 'DTSBU910' USING L910-LINK-AREA DTSBX442 01792 MSKL-REC. DTSBX442 01793 S910-EXIT. DTSBX442 01794 EXIT. DTSBX442 01795 DTSBX442 01796 S921-OPEN-READ. DTSBX442 01797 SET L921-OPEN-READ-88 TO TRUE. DTSBX442 01798 GO TO S921-AIX-IO. DTSBX442 01799 DTSBX442 01800 S921-READ. DTSBX442 01801 SET L921-READ-88 TO TRUE. DTSBX442 01802 GO TO S921-AIX-IO. DTSBX442 01803 DTSBX442 01804 S921-START-BROWSE. DTSBX442 01805 SET L921-START-BROWSE-88 TO TRUE. DTSBX442 01806 GO TO S921-AIX-IO. DTSBX442 01807 DTSBX442 01808 S921-READ-NEXT. DTSBX442 01809 SET L921-READ-NEXT-88 TO TRUE. DTSBX442 01810 GO TO S921-AIX-IO. DTSBX442 01811 DTSBX442 01812 S921-CLOSE. DTSBX442 01813 SET L921-CLOSE-88 TO TRUE. DTSBX442 01814 GO TO S921-AIX-IO. DTSBX442 01815 DTSBX442 01816 S921-AIX-IO. DTSBX442 01817 CALL 'DTSBU921' USING L921-LINK-AREA DTSBX442 01818 ISKL-REC. DTSBX442 01819 S921-EXIT. DTSBX442 01820 EXIT. DTSBX442 01821 DTSBX442 01822 S923-OPEN-UPDATE. DTSBX442 01823 SET L923-OPEN-UPDATE-88 TO TRUE. DTSBX442 01824 GO TO S923-ATC-CALL. DTSBX442 01825 DTSBX442 01826 S923-WRITE. DTSBX442 01827 SET L923-WRITE-88 TO TRUE. DTSBX442 01828 GO TO S923-ATC-CALL. DTSBX442 01829 DTSBX442 01830 S923-CLOSE. DTSBX442 01831 SET L923-CLOSE-88 TO TRUE. DTSBX442 01832 GO TO S923-ATC-CALL. DTSBX442 01833 DTSBX442 01834 S923-ATC-CALL. DTSBX442 01835 CALL 'DTSBU923' USING L923-LINK-AREA DTSBX442 01836 ASKL-REC. DTSBX442 01837 S923-EXIT. DTSBX442 01838 EXIT. DTSBX442 01839 DTSBX442 01840 S927A-OPEN. DTSBX442 01841 SET L927-OPEN-UPDATE-88 TO TRUE. DTSBX442 01842 PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX442 01843 DTSBX442 01844 S927A-EXIT. DTSBX442 01845 EXIT. DTSBX442 01846 DTSBX442 01847 S927B-WRITE. DTSBX442 01848 SET L927-WRITE-88 TO TRUE. DTSBX442 01849 PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX442 01850 DTSBX442 01851 S927B-EXIT. DTSBX442 01852 EXIT. DTSBX442 01853 DTSBX442 01854 S927C-CLOSE. DTSBX442 01855 SET L927-CLOSE-88 TO TRUE. DTSBX442 01856 PERFORM S927Z-IO THRU S927Z-EXIT. DTSBX442 01857 DTSBX442 01858 S927C-EXIT. DTSBX442 01859 EXIT. DTSBX442 01860 DTSBX442 01861 S927Z-IO. DTSBX442 01862 CALL 'DTSBU927' USING L927-LINK-AREA DTSBX442 01863 TSKL-REC. DTSBX442 01864 S927Z-EXIT. DTSBX442 01865 EXIT. DTSBX442 01866 DTSBX442 01867 S931-OPEN-READ. DTSBX442 01868 SET L931-OPEN-READ-88 TO TRUE. DTSBX442 01869 GO TO S931-REF-IO. DTSBX442 01870 DTSBX442 01871 S931-CLOSE. DTSBX442 01872 SET L931-CLOSE-88 TO TRUE. DTSBX442 01873 GO TO S931-REF-IO. DTSBX442 01874 DTSBX442 01875 S931-REF-IO. DTSBX442 01876 CALL 'DTSBU931' USING L931-LINK-AREA DTSBX442 01877 FSKL-REC. DTSBX442 01878 S931-EXIT. DTSBX442 01879 EXIT. DTSBX442 01880 DTSBX442 01881 S946-WRITE-R140. DTSBX442 01882 CALL 'DTSBU946' USING R140-REC. DTSBX442 01883 DTSBX442 01884 S946-EXIT. DTSBX442 01885 EXIT. DTSBX442 01886 DTSBX442 01887 S981A-OPEN-READ. DTSBX442 01888 SET L981-OPEN-READ-88 TO TRUE. DTSBX442 01889 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DTSBX442 01890 DTSBX442 01891 S981A-EXIT. DTSBX442 01892 EXIT. DTSBX442 01893 DTSBX442 01894 S981C-CLOSE. DTSBX442 01895 SET L981-CLOSE-88 TO TRUE. DTSBX442 01896 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DTSBX442 01897 DTSBX442 01898 S981C-EXIT. DTSBX442 01899 EXIT. DTSBX442 01900 DTSBX442 01901 S981D-START-BROWSE. DTSBX442 01902 SET L981-START-BROWSE-88 TO TRUE. DTSBX442 01903 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DTSBX442 01904 DTSBX442 01905 S981D-EXIT. DTSBX442 01906 EXIT. DTSBX442 01907 DTSBX442 01908 S981E-READ-NEXT. DTSBX442 01909 SET L981-READ-NEXT-88 TO TRUE. DTSBX442 01910 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DTSBX442 01911 DTSBX442 01912 S981E-EXIT. DTSBX442 01913 EXIT. DTSBX442 01914 DTSBX442 01915 S981F-READ. DTSBX442 01916 SET L981-READ-88 TO TRUE. DTSBX442 01917 PERFORM S981Z-WAGE-I THRU S981Z-EXIT. DTSBX442 01918 DTSBX442 01919 S981F-EXIT. DTSBX442 01920 EXIT. DTSBX442 01921 DTSBX442 01922 S981Z-WAGE-I. DTSBX442 01923 CALL 'DTSBU981' USING L981-LINK-AREA DTSBX442 01924 WWGH-REC. DTSBX442 01925 S981Z-EXIT. DTSBX442 01926 EXIT. DTSBX442 01927 DTSBX442 01928 S1000-OPEN-AUDIT. DTSBX442 01929 OPEN INPUT AUDIT-FILE. DTSBX442 01930 IF NOT AUDIT-STATUS-OK-88 DTSBX442 01931 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX442 01932 DISPLAY 'CANNOT OPEN AUDIT FILE ' DTSBX442 01933 AUDIT-STATUS DTSBX442 01934 END-IF. DTSBX442 01935 DTSBX442 01936 DTSBX442 01937 S1000-EXIT. DTSBX442 01938 EXIT. DTSBX442 01939 DTSBX442 01940 S1010-READ-AUDIT. DTSBX442 01941 READ AUDIT-FILE. DTSBX442 01942 IF AUDIT-STATUS-OK-88 DTSBX442 01943 ADD +1 TO W-AUDIT-CNT DTSBX442 01944 ELSE DTSBX442 01945 IF AUDIT-STATUS-EOF-88 DTSBX442 01946 NEXT SENTENCE DTSBX442 01947 ELSE DTSBX442 01948 DISPLAY 'CANNOT READ AUDIT-FILE ' AUDIT-STATUS DTSBX442 01949 SET W-ERROR-YES-88 TO TRUE DTSBX442 01950 END-IF DTSBX442 01951 END-IF. DTSBX442 01952 DTSBX442 01953 S1010-EXIT. DTSBX442 01954 EXIT. DTSBX442 01955 DTSBX442 01956 S1020-CLOSE-AUDIT. DTSBX442 01957 CLOSE AUDIT-FILE. DTSBX442 01958 DTSBX442 01959 S1020-EXIT. DTSBX442 01960 EXIT. DTSBX442 01961 DTSBX442 01962 S1100-OPEN-WAGE-TEMP-OUT. DTSBX442 01963 OPEN OUTPUT WAGE-FILE-TEMP. DTSBX442 01964 IF NOT WAGE-TEMP-STATUS-OK-88 DTSBX442 01965 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX442 01966 DISPLAY 'CANNOT OPEN WAGE TEMP FILE OUTPUT: ' DTSBX442 01967 WAGE-TEMP-STATUS DTSBX442 01968 END-IF. DTSBX442 01969 DTSBX442 01970 S1100-EXIT. DTSBX442 01971 EXIT. DTSBX442 01972 DTSBX442 01973 S1110-CLOSE-WAGE-TEMP. DTSBX442 01974 CLOSE WAGE-FILE-TEMP. DTSBX442 01975 IF NOT WAGE-TEMP-STATUS-OK-88 DTSBX442 01976 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX442 01977 DISPLAY 'CANNOT CLOSE WAGE TEMP FILE: ' DTSBX442 01978 WAGE-TEMP-STATUS DTSBX442 01979 END-IF. DTSBX442 01980 DTSBX442 01981 S1110-EXIT. DTSBX442 01982 EXIT. DTSBX442 01983 DTSBX442 01984 S1120-WRITE-WAGE-TEMP. DTSBX442 01985 WRITE WAGE-TEMP-REC FROM W001-REC. DTSBX442 01986 IF NOT WAGE-TEMP-STATUS-OK-88 DTSBX442 01987 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX442 01988 DISPLAY 'CANNOT WRITE WAGE TEMP FILE: ' DTSBX442 01989 WAGE-TEMP-STATUS DTSBX442 01990 END-IF. DTSBX442 01991 DTSBX442 01992 S1120-EXIT. DTSBX442 01993 EXIT. DTSBX442 01994 DTSBX442 01995 S1130-OPEN-WAGE-TEMP-IN. DTSBX442 01996 OPEN INPUT WAGE-FILE-TEMP. DTSBX442 01997 IF NOT WAGE-TEMP-STATUS-OK-88 DTSBX442 01998 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX442 01999 DISPLAY 'CANNOT OPEN WAGE TEMP FILE INPUT: ' DTSBX442 02000 WAGE-TEMP-STATUS DTSBX442 02001 END-IF. DTSBX442 02002 DTSBX442 02003 S1130-EXIT. DTSBX442 02004 EXIT. DTSBX442 02005 DTSBX442 02006 S1140-READ-WAGE-TEMP. DTSBX442 02007 READ WAGE-FILE-TEMP INTO W001-REC. DTSBX442 02008 IF WAGE-TEMP-STATUS-EOF-88 DTSBX442 02009 NEXT SENTENCE DTSBX442 02010 ELSE DTSBX442 02011 IF NOT WAGE-TEMP-STATUS-OK-88 DTSBX442 02012 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX442 02013 DISPLAY 'READ ERROR ON WAGE TEMP FILE: ' DTSBX442 02014 WAGE-TEMP-STATUS DTSBX442 02015 END-IF DTSBX442 02016 END-IF. DTSBX442 02017 DTSBX442 02018 S1140-EXIT. DTSBX442 02019 EXIT. DTSBX442 02020 DTSBX442 02021 S1200-OPEN-AUDIT-QTR. DTSBX442 02022 OPEN INPUT AUDIT-QTR-FILE. DTSBX442 02023 IF NOT AUDIT-QTR-STATUS-OK-88 DTSBX442 02024 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX442 02025 DISPLAY 'CANNOT OPEN AUDIT QTR FILE ' DTSBX442 02026 AUDIT-QTR-STATUS DTSBX442 02027 END-IF. DTSBX442 02028 DTSBX442 02029 DTSBX442 02030 S1200-EXIT. DTSBX442 02031 EXIT. DTSBX442 02032 DTSBX442 02033 S1210-READ-AUDIT-QTR. DTSBX442 02034 READ AUDIT-QTR-FILE. DTSBX442 02035 IF AUDIT-QTR-STATUS-OK-88 DTSBX442 02036 ADD +1 TO W-AUDIT-QTR-CNT DTSBX442 02037 ELSE DTSBX442 02038 IF AUDIT-QTR-STATUS-EOF-88 DTSBX442 02039 NEXT SENTENCE DTSBX442 02040 ELSE DTSBX442 02041 DISPLAY 'CANNOT READ AUDIT-QTR-FILE ' DTSBX442 02042 AUDIT-QTR-STATUS DTSBX442 02043 SET W-ERROR-YES-88 TO TRUE DTSBX442 02044 END-IF DTSBX442 02045 END-IF. DTSBX442 02046 DTSBX442 02047 S1210-EXIT. DTSBX442 02048 EXIT. DTSBX442 02049 DTSBX442 02050 S1220-CLOSE-AUDIT-QTR. DTSBX442 02051 CLOSE AUDIT-QTR-FILE. DTSBX442 02052 DTSBX442 02053 S1220-EXIT. DTSBX442 02054 EXIT. DTSBX442 02055 DTSBX442 02056 S1300-OPEN-WAGE-OUT. DTSBX442 02057 OPEN OUTPUT WAGE-FILE-OUT. DTSBX442 02058 IF NOT WAGE-OUT-STATUS-OK-88 DTSBX442 02059 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX442 02060 DISPLAY 'CANNOT OPEN WAGE OUT FILE: ' DTSBX442 02061 WAGE-OUT-STATUS DTSBX442 02062 END-IF. DTSBX442 02063 DTSBX442 02064 S1300-EXIT. DTSBX442 02065 EXIT. DTSBX442 02066 DTSBX442 02067 S1310-CLOSE-WAGE-OUT. DTSBX442 02068 CLOSE WAGE-FILE-OUT. DTSBX442 02069 IF NOT WAGE-OUT-STATUS-OK-88 DTSBX442 02070 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX442 02071 DISPLAY 'CANNOT CLOSE WAGE OUT FILE: ' DTSBX442 02072 WAGE-OUT-STATUS DTSBX442 02073 END-IF. DTSBX442 02074 DTSBX442 02075 S1310-EXIT. DTSBX442 02076 EXIT. DTSBX442 02077 DTSBX442 02078 S1320-WRITE-WAGE-OUT. DTSBX442 02079 WRITE WAGE-OUT-REC FROM W001-REC. DTSBX442 02080 IF NOT WAGE-OUT-STATUS-OK-88 DTSBX442 02081 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBX442 02082 DISPLAY 'CANNOT WRITE WAGE OUT FILE: ' DTSBX442 02083 WAGE-OUT-STATUS DTSBX442 02084 END-IF. DTSBX442 02085 DTSBX442 02086 S1320-EXIT. DTSBX442 02087 EXIT. DTSBX442 02088 DTSBX442 02089 S999-ABEND. DTSBX442 02090 CALL 'DTSBU999' USING W-ABEND-CD. DTSBX442 02091 S999-EXIT. DTSBX442 02092 EXIT. DTSBX442 02093 DTSBX442