giteaadmin/DUTAS
4
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
c99f490664479f7d28c575be3d5068507007c38d
DUTAS/Batch/DTSBX442.cob
Neeraj Kumar ca3572c5df DUTAS re-platformed to Raincode - Initial Source Code
2025-07-21 11:20:11 -04:00

2095 lines
166 KiB
COBOL
Raw Blame History

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
Reference in New Issue View Git Blame Copy Permalink