00001 IDENTIFICATION DIVISION. 06/08/12 00002 PROGRAM-ID. DTSBD555. DTSBD555 00003 AUTHOR. NGC. LV005 00004 DATE-WRITTEN. APRIL 2012. DTSBD555 00005 DATE-COMPILED. DTSBD555 00006 SKIP3 DTSBD555 00007 ***** DTSBD555 00008 * DTSBD555 00009 * FUNCTION: PROCESS WAGE-ONLY FILES UPLOADED FROM SERVER. DTSBD555 00010 * DTSBD555 00011 * MODIFICATION HISTORY: DTSBD555 00012 * DTSBD555 00013 * 04-05-2012 INITIAL DEVELOPMENT DTSBD555 00014 * REFERENCE RFP: DTSBD555 00015 * DTSBD555 00016 * 05-24-2012 CORRECTED WAGE EDIT: CANCEL PROCESSING IF ERRORS DTSBD555 00017 * ARE FOUND. DTSBD555 00018 * REFERENCE RFP: DTSBD555 00019 * DTSBD555 00020 * DTSBD555 00021 * DTSBD555 00022 ***** DTSBD555 00023 SKIP3 DTSBD555 00024 ENVIRONMENT DIVISION. DTSBD555 00025 SKIP2 DTSBD555 00026 INPUT-OUTPUT SECTION. DTSBD555 00027 DTSBD555 00028 FILE-CONTROL. DTSBD555 00029 DTSBD555 00030 SELECT REPORT-FILE-IN ASSIGN TO DTSFRPIN DTSBD555 00031 FILE STATUS IS RPT-IN-STATUS. DTSBD555 00032 DTSBD555 00033 SELECT WAGE-FILE-IN ASSIGN TO DTSFWGIN DTSBD555 00034 FILE STATUS IS WAGE-IN-STATUS. DTSBD555 00035 DTSBD555 00036 SELECT TEMP-BTC-FILE ASSIGN TO BD555BTC DTSBD555 00037 FILE STATUS IS TEMP-BTC-STATUS. DTSBD555 00038 DTSBD555 00039 SELECT WAGE-FILE-TEMP ASSIGN TO WAGETEMP DTSBD555 00040 FILE STATUS IS WAGE-TEMP-STATUS. DTSBD555 00041 DTSBD555 00042 SELECT WAGE-FILE-OUT ASSIGN TO WAGEOUT DTSBD555 00043 FILE STATUS IS WAGE-OUT-STATUS. DTSBD555 00044 DTSBD555 00045 SELECT CURR-BATCH-NO ASSIGN TO CURRBTCH DTSBD555 00046 FILE STATUS IS BATCH-STATUS. DTSBD555 00047 DTSBD555 00048 DATA DIVISION. DTSBD555 00049 DTSBD555 00050 FILE SECTION. DTSBD555 00051 FD REPORT-FILE-IN DTSBD555 00052 RECORDING MODE IS F DTSBD555 00053 BLOCK CONTAINS 0 RECORDS DTSBD555 00054 LABEL RECORDS ARE OMITTED. DTSBD555 00055 DTSBD555 00056 01 REPORT-IN-REC PIC X(134). DTSBD555 00057 DTSBD555 00058 FD WAGE-FILE-IN DTSBD555 00059 RECORDING MODE IS F DTSBD555 00060 BLOCK CONTAINS 0 RECORDS DTSBD555 00061 LABEL RECORDS ARE OMITTED. DTSBD555 00062 DTSBD555 00063 01 WAGE-IN-REC PIC X(128). DTSBD555 00064 DTSBD555 00065 DTSBD555 00066 FD TEMP-BTC-FILE DTSBD555 00067 RECORDING MODE IS V DTSBD555 00068 BLOCK CONTAINS 0 RECORDS. DTSBD555 00069 DTSBD555 00070 01 TEMP-BTC-REC. DTSBD555 00071 ++INCLUDE DTSIRVAR DTSBD555 00072 DTSBD555 00073 01 TSKL-REC. DTSBD555 00074 ++INCLUDE DTSITSKL DTSBD555 00075 DTSBD555 00076 FD WAGE-FILE-TEMP DTSBD555 00077 RECORDING MODE IS F DTSBD555 00078 BLOCK CONTAINS 0 RECORDS DTSBD555 00079 LABEL RECORDS ARE OMITTED. DTSBD555 00080 DTSBD555 00081 01 WAGE-TEMP-REC PIC X(128). DTSBD555 00082 DTSBD555 00083 FD WAGE-FILE-OUT DTSBD555 00084 RECORDING MODE IS F DTSBD555 00085 BLOCK CONTAINS 0 RECORDS DTSBD555 00086 LABEL RECORDS ARE OMITTED. DTSBD555 00087 DTSBD555 00088 01 WAGE-OUT-REC PIC X(128). DTSBD555 00089 DTSBD555 00090 FD CURR-BATCH-NO DTSBD555 00091 RECORDING MODE IS F DTSBD555 00092 BLOCK CONTAINS 0 RECORDS DTSBD555 00093 LABEL RECORDS ARE OMITTED. DTSBD555 00094 DTSBD555 00095 01 CURR-BATCH-NO-REC. DTSBD555 00096 05 CURRENT-BATCH-NO PIC 9(05). DTSBD555 00097 05 CURRENT-ITEM-NO PIC 9(03). DTSBD555 00098 05 FILLER PIC X(01). DTSBD555 00099 05 CURRENT-ARCHIVE-YEAR PIC 9(04). DTSBD555 00100 05 FILLER PIC X(01). DTSBD555 00101 05 FIRST-ARCHIVE-YEAR PIC 9(04). DTSBD555 00102 05 FILLER PIC X(62). DTSBD555 00103 DTSBD555 00104 WORKING-STORAGE SECTION. DTSBD555 001045 77 PAN-VALET PICTURE X(24) VALUE '005DTSBD555 06/08/12'. DTSBD555 00105 SKIP3 DTSBD555 00106 01 WRK-AREA. DTSBD555 00107 05 W-ABEND-CD PIC S9(04) COMP VALUE 555. DTSBD555 00108 05 W-MOD-NAME PIC X(08) VALUE 'DTSBD555'.DTSBD555 00109 DTSBD555 00110 05 RPT-IN-STATUS PIC X(02). DTSBD555 00111 88 RPT-IN-OK-88 VALUE '00'. DTSBD555 00112 88 RPT-IN-EOF-88 VALUE '10'. DTSBD555 00113 DTSBD555 00114 05 WAGE-IN-STATUS PIC X(02). DTSBD555 00115 88 WAGE-IN-OK-88 VALUE '00'. DTSBD555 00116 88 WAGE-IN-EOF-88 VALUE '10'. DTSBD555 00117 DTSBD555 00118 05 TEMP-BTC-STATUS PIC X(02). DTSBD555 00119 88 TEMP-BTC-STATUS-OK-88 VALUE '00'. DTSBD555 00120 88 TEMP-BTC-STATUS-EOF-88 VALUE '10'. DTSBD555 00121 DTSBD555 00122 05 WAGE-TEMP-STATUS PIC X(02). DTSBD555 00123 88 WAGE-TEMP-STATUS-OK-88 VALUE '00'. DTSBD555 00124 88 WAGE-TEMP-STATUS-EOF-88 VALUE '10'. DTSBD555 00125 DTSBD555 00126 05 WAGE-OUT-STATUS PIC X(02). DTSBD555 00127 88 WAGE-OUT-STATUS-OK-88 VALUE '00'. DTSBD555 00128 DTSBD555 00129 05 BATCH-XREF-STATUS PIC X(02). DTSBD555 00130 88 BATCH-XREF-OK-88 VALUE '00'. DTSBD555 00131 DTSBD555 00132 05 BATCH-STATUS PIC X(02). DTSBD555 00133 88 BATCH-STATUS-OK-88 VALUE '00'. DTSBD555 00134 88 BATCH-STATUS-EOF-88 VALUE '10'. DTSBD555 00135 DTSBD555 00136 05 VAR-CHAR-CNT PIC S9(04) COMP. DTSBD555 00137 05 SUB PIC S9(04) COMP. DTSBD555 00138 DTSBD555 00139 05 W-ERROR-IND PIC X(01) VALUE 'N'. DTSBD555 00140 88 W-ERROR-YES-88 VALUE 'Y'. DTSBD555 00141 88 W-ERROR-NO-88 VALUE 'N'. DTSBD555 00142 DTSBD555 00143 05 W-FATAL-ERROR-IND PIC X(01) VALUE 'N'. DTSBD555 00144 88 W-FATAL-ERROR-YES-88 VALUE 'Y'. DTSBD555 00145 88 W-FATAL-ERROR-NO-88 VALUE 'N'. DTSBD555 00146 DTSBD555 00147 05 W-EMP-ERROR-IND PIC X(01) VALUE 'N'. DTSBD555 00148 88 W-EMP-ERROR-YES-88 VALUE 'Y'. DTSBD555 00149 88 W-EMP-ERROR-NO-88 VALUE 'N'. DTSBD555 00150 DTSBD555 00151 05 W-EMP-FOUND-IND PIC X(01) VALUE 'N'. DTSBD555 00152 88 W-EMP-FOUND-YES-88 VALUE 'Y'. DTSBD555 00153 88 W-EMP-FOUND-NO-88 VALUE 'N'. DTSBD555 00154 DTSBD555 00155 05 W-SSN-ERROR-IND PIC X(01) VALUE 'N'. DTSBD555 00156 88 W-SSN-ERROR-YES-88 VALUE 'Y'. DTSBD555 00157 88 W-SSN-ERROR-NO-88 VALUE 'N'. DTSBD555 00158 DTSBD555 00159 05 W-WAGE-COMPLETE-IND PIC X(01) VALUE 'N'. DTSBD555 00160 88 W-WAGE-COMPLETE-YES-88 VALUE 'Y'. DTSBD555 00161 88 W-WAGE-COMPLETE-NO-88 VALUE 'N'. DTSBD555 00162 DTSBD555 00163 05 W-EMP-NO PIC S9(07) COMP-3. DTSBD555 00164 05 W-EMP-NO-9 PIC 9(06). DTSBD555 00165 05 W-EMP-NO-X REDEFINES W-EMP-NO-9 DTSBD555 00166 PIC X(06). DTSBD555 00167 05 W-SSN PIC S9(09) COMP-3. DTSBD555 00168 05 W-SSN-9 PIC 9(09). DTSBD555 00169 05 W-SSN-X REDEFINES W-SSN-9 DTSBD555 00170 PIC X(09). DTSBD555 00171 05 W-REMIT-AMT PIC S9(09)V99 COMP-3 VALUE +0. DTSBD555 00172 05 W-REPORT-QTR PIC S9(05) COMP-3. DTSBD555 00173 05 W-TOT-WAGE PIC S9(11)V99 VALUE +0. DTSBD555 00174 05 W-TAX-WAGE PIC S9(11)V99. DTSBD555 00175 05 W-REMITTANCE PIC S9(09)V99. DTSBD555 00176 05 W-RECEIVED-DATE PIC S9(09) COMP-3. DTSBD555 00177 05 W-ENTERED-DATE PIC S9(09) COMP-3. DTSBD555 00178 05 W-DEPOSIT-DATE PIC S9(09) COMP-3. DTSBD555 00179 05 W-1ST-MNTH-CNT PIC S9(07) COMP-3. DTSBD555 00180 05 W-2ND-MNTH-CNT PIC S9(07) COMP-3. DTSBD555 00181 05 W-3RD-MNTH-CNT PIC S9(07) COMP-3. DTSBD555 00182 05 W-LOG-NO PIC S9(09) COMP-3. DTSBD555 00183 05 W-EARNINGS PIC S9(09)V99 COMP-3. DTSBD555 00184 05 W-WORKER-TAX-WAGE PIC S9(09)V99 COMP-3. DTSBD555 00185 05 W-WORKER-NAME. DTSBD555 00186 10 W-WRKR-FIRST-NAME PIC X(15). DTSBD555 00187 10 W-WRKR-MID-INIT PIC X(01). DTSBD555 00188 10 W-WRKR-LAST-NAME PIC X(20). DTSBD555 00189 DTSBD555 00190 05 W-INTEGER PIC S9(11) COMP-3. DTSBD555 00191 05 W-FRACTION PIC SV9(11) COMP-3. DTSBD555 00192 05 W-NUMBER PIC S9(11)V9(05) COMP-3. DTSBD555 00193 DTSBD555 00194 05 W-PSEUDO-BATCH-NO PIC 9(05) VALUE ZERO. DTSBD555 00195 DTSBD555 00196 05 W-START-BATCH PIC 9(05) VALUE ZERO. DTSBD555 00197 05 W-END-BATCH PIC 9(05) VALUE ZERO. DTSBD555 00198 DTSBD555 00199 05 W-PSEUDO-ITEM-NO PIC 9(03) VALUE 0. DTSBD555 00200 DTSBD555 00201 05 W-SEQ-NO PIC 9(07) VALUE 0. DTSBD555 00202 DTSBD555 00203 05 W-MNTE-SUBJECT PIC X(40). DTSBD555 00204 88 W-MNTE-NOT-LIAB-88 VALUE DTSBD555 00205 'REASON FOR NOT-LIABLE DETERMINATION '. DTSBD555 00206 88 W-MNTE-KEY-WORD-88 VALUE DTSBD555 00207 'FR-500 INDUSTRY DESCRIPTION - KEY WORD '. DTSBD555 00208 88 W-MNTE-DATA-ENTRY-88 VALUE DTSBD555 00209 'FR-500 INDUSTRY DESCRIPTION - DATA ENTRY'. DTSBD555 00210 88 W-MNTE-RELATIONSHIP-88 VALUE DTSBD555 00211 'WEB REGISTRATION RELATED EMPLOYER '. DTSBD555 00212 DTSBD555 00213 05 W-MNTE-COMPLETE-IND PIC X(01) VALUE 'N'. DTSBD555 00214 88 W-MNTE-COMPLETE-YES-88 VALUE 'Y'. DTSBD555 00215 88 W-MNTE-COMPLETE-NO-88 VALUE 'N'. DTSBD555 00216 DTSBD555 00217 05 TSUB1 PIC S9(04) COMP. DTSBD555 00218 05 TSUB2 PIC S9(04) COMP. DTSBD555 00219 05 W-LAST-SPACE PIC S9(04) COMP. DTSBD555 00220 DTSBD555 00221 05 W-MNTE-LINE PIC X(72). DTSBD555 00222 DTSBD555 00223 05 W-SLASH-DATE PIC X(10). DTSBD555 00224 05 FILLER REDEFINES W-SLASH-DATE. DTSBD555 00225 10 W-SLASH-DT-MM PIC X(02). DTSBD555 00226 10 FILLER PIC X(01). DTSBD555 00227 10 W-SLASH-DT-DD PIC X(02). DTSBD555 00228 10 FILLER PIC X(01). DTSBD555 00229 10 W-SLASH-DT-CCYY PIC X(04). DTSBD555 00230 DTSBD555 00231 05 W-SLASH-QTR PIC X(06). DTSBD555 00232 05 FILLER REDEFINES W-SLASH-QTR. DTSBD555 00233 10 W-SLASH-QTR-CCYY PIC X(04). DTSBD555 00234 10 FILLER PIC X(01). DTSBD555 00235 10 W-SLASH-QTR-Q PIC X(01). DTSBD555 00236 DTSBD555 00237 05 W-TEMP-WAGE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD555 00238 05 W-TEMP-T028-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD555 00239 * REPORT DTSBD555 00240 05 W-RPT-IN-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD555 00241 * EMPLOYEE WAGES DTSBD555 00242 05 W-WAGE-IN-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD555 00243 DTSBD555 00244 05 W-T028-WRITE-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD555 00245 05 W-WAGE-OUT-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD555 00246 DTSBD555 00247 05 W-X140-LENGTH PIC S9(04) COMP. DTSBD555 00248 DTSBD555 00249 05 W-AMT-DISP1 PIC ----------9.99. DTSBD555 00250 05 W-AMT-DISP2 PIC ----------9.99. DTSBD555 00251 DTSBD555 00252 05 WRK-R140-CNT PIC S9(07) COMP-3 VALUE +0. DTSBD555 00253 05 DISPLAY-CNT PIC Z(06)9. DTSBD555 00254 05 WRK-MPRF-EMP-NO PIC 9(06). DTSBD555 00255 DTSBD555 00256 01 MESSAGE-AREA. DTSBD555 00257 *** FATAL ERRORS MSG-A DTSBD555 00258 05 MSG-A1. DTSBD555 00259 10 FILLER PIC X(32) DTSBD555 00260 VALUE 'TYPE A REC NOT FIRST IN FILE: '. DTSBD555 00261 10 MSG-A1-PREV-REC-TYPE PIC X(01). DTSBD555 00262 DTSBD555 00263 01 T003-REC. DTSBD555 00264 ++INCLUDE DTSIT003 DTSBD555 00265 DTSBD555 00266 01 T025-REC. DTSBD555 00267 ++INCLUDE DTSIT025 DTSBD555 00268 DTSBD555 00269 01 T028-REC. DTSBD555 00270 ++INCLUDE DTSIT028 DTSBD555 00271 DTSBD555 00272 01 W001-REC. DTSBD555 00273 ++INCLUDE DTSIW001 DTSBD555 00274 DTSBD555 00275 * REPORT DTSBD555 00276 01 X157-REC. DTSBD555 00277 ++INCLUDE DTSIX157 DTSBD555 00278 DTSBD555 00279 * EMPLOYEE WAGES DTSBD555 00280 01 X144-REC. DTSBD555 00281 ++INCLUDE DTSIX144 DTSBD555 00282 DTSBD555 00283 * PARSE CSV FILE DTSBD555 00284 01 L205-LINK-AREA. DTSBD555 00285 ++INCLUDE DTSIL205 DTSBD555 00286 DTSBD555 00287 * BATCH - PSEUDO-BATCH XREF DTSBD555 00288 01 X214-REC. DTSBD555 00289 ++INCLUDE DTSIX214 DTSBD555 00290 DTSBD555 00291 * ERRORS DTSBD555 00292 *01 X907-REC. DTSBD555 00293 ***INCLUDE DTSIX907 DTSBD555 00294 DTSBD555 00295 01 L001-LINK-AREA. DTSBD555 00296 ++INCLUDE DTSIL001 DTSBD555 00297 DTSBD555 00298 01 L003-LINK-AREA. DTSBD555 00299 ++INCLUDE DTSIL003 DTSBD555 00300 DTSBD555 00301 01 L004-LINK-AREA. DTSBD555 00302 ++INCLUDE DTSIL004 DTSBD555 00303 DTSBD555 00304 01 L005-LINK-AREA. DTSBD555 00305 ++INCLUDE DTSIL005 DTSBD555 00306 DTSBD555 00307 01 L032-LINK-AREA. DTSBD555 00308 ++INCLUDE DTSIL032 DTSBD555 00309 DTSBD555 00310 01 L516-LINK-AREA. DTSBD555 00311 ++INCLUDE DTSIL516 DTSBD555 00312 DTSBD555 00313 01 L910-LINK-AREA. DTSBD555 00314 ++INCLUDE DTSIL910 DTSBD555 00315 01 MSKL-REC. DTSBD555 00316 ++INCLUDE DTSIMSKL DTSBD555 00317 DTSBD555 00318 01 MHDR-REC. DTSBD555 00319 ++INCLUDE DTSIMHDR DTSBD555 00320 DTSBD555 00321 01 MPRF-REC. DTSBD555 00322 ++INCLUDE DTSIMPRF DTSBD555 00323 DTSBD555 00324 01 MSOL-REC. DTSBD555 00325 ++INCLUDE DTSIMSOL DTSBD555 00326 DTSBD555 00327 01 MQTR-REC. DTSBD555 00328 ++INCLUDE DTSIMQTR DTSBD555 00329 DTSBD555 00330 01 MRPT-REC. DTSBD555 00331 ++INCLUDE DTSIMRPT DTSBD555 00332 DTSBD555 00333 01 MTAD-REC. DTSBD555 00334 ++INCLUDE DTSIMTAD DTSBD555 00335 DTSBD555 00336 01 MNTE-REC. DTSBD555 00337 ++INCLUDE DTSIMNTE DTSBD555 00338 DTSBD555 00339 01 L921-LINK-AREA. DTSBD555 00340 ++INCLUDE DTSIL921 DTSBD555 00341 SKIP3 DTSBD555 00342 01 ISKL-REC. DTSBD555 00343 ++INCLUDE DTSIISKL DTSBD555 00344 SKIP3 DTSBD555 00345 01 IEIN-REC. DTSBD555 00346 ++INCLUDE DTSIIEIN DTSBD555 00347 DTSBD555 00348 01 L923-LINK-AREA. DTSBD555 00349 ++INCLUDE DTSIL923 DTSBD555 00350 EJECT DTSBD555 00351 01 ASKL-REC. DTSBD555 00352 ++INCLUDE DTSIASKL DTSBD555 00353 EJECT DTSBD555 00354 01 AHDR-REC. DTSBD555 00355 ++INCLUDE DTSIAHDR DTSBD555 00356 EJECT DTSBD555 00357 01 ARPT-REC. DTSBD555 00358 ++INCLUDE DTSIARPT DTSBD555 00359 EJECT DTSBD555 00360 01 APAY-REC. DTSBD555 00361 ++INCLUDE DTSIAPAY DTSBD555 00362 DTSBD555 00363 01 L927-LINK-AREA. DTSBD555 00364 ++INCLUDE DTSIL927 DTSBD555 00365 DTSBD555 00366 01 L931-LINK-AREA. DTSBD555 00367 ++INCLUDE DTSIL931 DTSBD555 00368 DTSBD555 00369 01 FSKL-REC. DTSBD555 00370 ++INCLUDE DTSIFSKL DTSBD555 00371 DTSBD555 00372 01 R140-REC. DTSBD555 00373 ++INCLUDE DTSIR140 DTSBD555 00374 DTSBD555 00375 PROCEDURE DIVISION. DTSBD555 00376 DTSBD555 00377 DTSBX422-MAIN. DTSBD555 00378 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBD555 00379 DTSBD555 00380 PERFORM P0000-PROCESS THRU P0000-EXIT. DTSBD555 00381 DTSBD555 00382 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBD555 00383 DTSBD555 00384 DTSBD555 00385 DTSBX422-MAIN-EXIT. DTSBD555 00386 GOBACK. DTSBD555 00387 DTSBD555 00388 I0000-INITIATE. DTSBD555 00389 SET W-ERROR-NO-88 TO TRUE. DTSBD555 00390 SET W-FATAL-ERROR-NO-88 TO TRUE. DTSBD555 00391 DTSBD555 00392 * FOR VARIABLE REPORT FILE. DTSBD555 00393 MOVE LENGTH OF R140-REC TO R140-LENGTH. DTSBD555 00394 MOVE '140' TO R140-REC-TYPE. DTSBD555 00395 DTSBD555 00396 PERFORM S005-FROM-SYS THRU S005-EXIT. DTSBD555 00397 DTSBD555 00398 PERFORM I2000-OPEN-FILES THRU I2000-EXIT DTSBD555 00399 IF W-FATAL-ERROR-YES-88 DTSBD555 00400 GO TO I0000-EXIT DTSBD555 00401 END-IF. DTSBD555 00402 DTSBD555 00403 I0000-EXIT. DTSBD555 00404 EXIT. DTSBD555 00405 DTSBD555 00406 I2000-OPEN-FILES. DTSBD555 00407 PERFORM S1000-OPEN-REPORT-IN THRU S1000-EXIT. DTSBD555 00408 IF W-FATAL-ERROR-YES-88 DTSBD555 00409 GO TO I2000-EXIT DTSBD555 00410 END-IF. DTSBD555 00411 DTSBD555 00412 PERFORM S1020-OPEN-WAGE-IN THRU S1020-EXIT. DTSBD555 00413 IF W-FATAL-ERROR-YES-88 DTSBD555 00414 GO TO I2000-EXIT DTSBD555 00415 END-IF. DTSBD555 00416 DTSBD555 00417 PERFORM S1040-OPEN-TEMP-BTC-OUT THRU S1040-EXIT. DTSBD555 00418 IF W-FATAL-ERROR-YES-88 DTSBD555 00419 GO TO I2000-EXIT DTSBD555 00420 END-IF. DTSBD555 00421 DTSBD555 00422 PERFORM S1100-OPEN-WAGE-TEMP-OUT THRU S1100-EXIT. DTSBD555 00423 IF W-FATAL-ERROR-YES-88 DTSBD555 00424 GO TO I2000-EXIT DTSBD555 00425 END-IF. DTSBD555 00426 DTSBD555 00427 OPEN I-O CURR-BATCH-NO. DTSBD555 00428 IF BATCH-STATUS-OK-88 DTSBD555 00429 READ CURR-BATCH-NO DTSBD555 00430 IF BATCH-STATUS-OK-88 DTSBD555 00431 COMPUTE W-PSEUDO-BATCH-NO = (CURRENT-BATCH-NO + 1) DTSBD555 00432 MOVE W-PSEUDO-BATCH-NO TO W-START-BATCH DTSBD555 00433 MOVE ZERO TO W-PSEUDO-ITEM-NO DTSBD555 00434 DISPLAY 'CURRENT BATCH ' W-PSEUDO-BATCH-NO DTSBD555 00435 DISPLAY 'CURRENT ITEM ' W-PSEUDO-ITEM-NO DTSBD555 00436 ELSE DTSBD555 00437 SET W-ERROR-YES-88 TO TRUE DTSBD555 00438 DISPLAY 'CANNOT OPEN CURR BATCH NUMBER FILE ' DTSBD555 00439 BATCH-STATUS DTSBD555 00440 GO TO I2000-EXIT DTSBD555 00441 END-IF DTSBD555 00442 ELSE DTSBD555 00443 SET W-ERROR-YES-88 TO TRUE DTSBD555 00444 DISPLAY 'CANNOT OPEN CURR BATCH NUMBER FILE ' DTSBD555 00445 BATCH-STATUS DTSBD555 00446 GO TO I2000-EXIT DTSBD555 00447 END-IF. DTSBD555 00448 DTSBD555 00449 PERFORM S910-OPEN-READ THRU S910-EXIT. DTSBD555 00450 PERFORM S931-OPEN-READ THRU S931-EXIT. DTSBD555 00451 DTSBD555 00452 I2000-EXIT. DTSBD555 00453 EXIT. DTSBD555 00454 DTSBD555 00455 P0000-PROCESS. DTSBD555 00456 PERFORM S1005-READ-REPORT-IN THRU S1005-EXIT. DTSBD555 00457 PERFORM S1025-READ-WAGE-IN THRU S1025-EXIT. DTSBD555 00458 DTSBD555 00459 DISPLAY 'FIRST READ' DTSBD555 00460 DISPLAY ' RPT: ' REPORT-IN-REC (1:30). DTSBD555 00461 DISPLAY ' WAGE: ' WAGE-IN-REC (1:30). DTSBD555 00462 DTSBD555 00463 PERFORM UNTIL RPT-IN-EOF-88 OR W-ERROR-YES-88 DTSBD555 00464 PERFORM P1000-REPORT THRU P1000-EXIT DTSBD555 00465 PERFORM P2000-WAGE THRU P2000-EXIT DTSBD555 00466 PERFORM S1005-READ-REPORT-IN THRU S1005-EXIT DTSBD555 00467 END-PERFORM. DTSBD555 00468 DTSBD555 00469 P0000-EXIT. DTSBD555 00470 EXIT. DTSBD555 00471 DTSBD555 00472 P1000-REPORT. DTSBD555 00473 MOVE ZERO TO W-TOT-WAGE DTSBD555 00474 W-TAX-WAGE DTSBD555 00475 W-REMITTANCE. DTSBD555 00476 DTSBD555 00477 PERFORM P1100-PARSE-REPORT THRU P1100-EXIT. DTSBD555 00478 IF W-ERROR-NO-88 DTSBD555 00479 PERFORM P1200-EDIT-REPORT THRU P1200-EXIT DTSBD555 00480 IF W-ERROR-NO-88 DTSBD555 00481 PERFORM P1300-SAVE-REPORT THRU P1300-EXIT DTSBD555 00482 END-IF DTSBD555 00483 END-IF. DTSBD555 00484 DTSBD555 00485 P1000-EXIT. DTSBD555 00486 EXIT. DTSBD555 00487 DTSBD555 00488 P1100-PARSE-REPORT. DTSBD555 00489 PERFORM P1110-PARSE THRU P1110-EXIT. DTSBD555 00490 IF W-ERROR-NO-88 DTSBD555 00491 PERFORM P1120-SAVE-DATA THRU P1120-EXIT DTSBD555 00492 END-IF. DTSBD555 00493 DTSBD555 00494 P1100-EXIT. DTSBD555 00495 EXIT. DTSBD555 00496 DTSBD555 00497 P1110-PARSE. DTSBD555 00498 PERFORM DTSBD555 00499 VARYING SUB FROM +1 BY +1 DTSBD555 00500 UNTIL SUB > +100 DTSBD555 00501 MOVE +0 TO L205-FIELD-LENGTH (SUB) DTSBD555 00502 L205-INTEGER (SUB) DTSBD555 00503 L205-FRACTION (SUB) DTSBD555 00504 MOVE SPACES TO L205-TEXT (SUB) DTSBD555 00505 L205-DATE (SUB) DTSBD555 00506 SET L205-TYPE-TEXT-88 (SUB) TO TRUE DTSBD555 00507 END-PERFORM. DTSBD555 00508 DTSBD555 00509 INITIALIZE X157-REC. DTSBD555 00510 MOVE +17 TO L205-LAST-FIELD. DTSBD555 00511 MOVE +10 TO L205-LAST-FIELD-LEN. DTSBD555 00512 DTSBD555 00513 ** RECORD TYPE DTSBD555 00514 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBD555 00515 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBD555 00516 DTSBD555 00517 *** EMPLOYER NUMBER DTSBD555 00518 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBD555 00519 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBD555 00520 DTSBD555 00521 *** QUARTER DTSBD555 00522 MOVE +6 TO L205-FIELD-LENGTH (3). DTSBD555 00523 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBD555 00524 DTSBD555 00525 ** RECEIVED DATE DTSBD555 00526 MOVE +10 TO L205-FIELD-LENGTH (4). DTSBD555 00527 SET L205-TYPE-DATE-88 (4) TO TRUE. DTSBD555 00528 DTSBD555 00529 *** SOURCE DTSBD555 00530 MOVE +1 TO L205-FIELD-LENGTH (5). DTSBD555 00531 SET L205-TYPE-TEXT-88 (5) TO TRUE. DTSBD555 00532 DTSBD555 00533 ** REPORT TYPE DTSBD555 00534 MOVE +2 TO L205-FIELD-LENGTH (6). DTSBD555 00535 SET L205-TYPE-TEXT-88 (6) TO TRUE. DTSBD555 00536 DTSBD555 00537 *** TOTAL WAGES DTSBD555 00538 MOVE +14 TO L205-FIELD-LENGTH (7). DTSBD555 00539 SET L205-TYPE-NUMBER-88 (7) TO TRUE. DTSBD555 00540 DTSBD555 00541 *** TAX WAGES DTSBD555 00542 MOVE +14 TO L205-FIELD-LENGTH (8). DTSBD555 00543 SET L205-TYPE-NUMBER-88 (8) TO TRUE. DTSBD555 00544 DTSBD555 00545 *** REMITTANCE DTSBD555 00546 MOVE +12 TO L205-FIELD-LENGTH (9). DTSBD555 00547 SET L205-TYPE-NUMBER-88 (9) TO TRUE. DTSBD555 00548 DTSBD555 00549 *** WORKER COUNT 1 DTSBD555 00550 MOVE +7 TO L205-FIELD-LENGTH (10). DTSBD555 00551 SET L205-TYPE-NUMBER-88 (10) TO TRUE. DTSBD555 00552 DTSBD555 00553 *** WORKER COUNT 2 DTSBD555 00554 MOVE +7 TO L205-FIELD-LENGTH (11). DTSBD555 00555 SET L205-TYPE-NUMBER-88 (11) TO TRUE. DTSBD555 00556 DTSBD555 00557 *** WORKER COUNT 3 DTSBD555 00558 MOVE +7 TO L205-FIELD-LENGTH (12). DTSBD555 00559 SET L205-TYPE-NUMBER-88 (12) TO TRUE. DTSBD555 00560 DTSBD555 00561 *** WAIVE INTEREST DTSBD555 00562 MOVE +1 TO L205-FIELD-LENGTH (13). DTSBD555 00563 SET L205-TYPE-TEXT-88 (13) TO TRUE. DTSBD555 00564 DTSBD555 00565 *** WAIVE PENALTY DTSBD555 00566 MOVE +1 TO L205-FIELD-LENGTH (14). DTSBD555 00567 SET L205-TYPE-TEXT-88 (14) TO TRUE. DTSBD555 00568 DTSBD555 00569 *** MF OPID DTSBD555 00570 MOVE +8 TO L205-FIELD-LENGTH (15). DTSBD555 00571 SET L205-TYPE-TEXT-88 (15) TO TRUE. DTSBD555 00572 DTSBD555 00573 *** LOG NUMBER DTSBD555 00574 MOVE +9 TO L205-FIELD-LENGTH (16). DTSBD555 00575 SET L205-TYPE-NUMBER-88 (16) TO TRUE. DTSBD555 00576 DTSBD555 00577 ** ENTERED DATE DTSBD555 00578 MOVE +10 TO L205-FIELD-LENGTH (17). DTSBD555 00579 SET L205-TYPE-DATE-88 (17) TO TRUE. DTSBD555 00580 DTSBD555 00581 MOVE REPORT-IN-REC TO L205-INPUT-DATA. DTSBD555 00582 CALL 'DTSBU205' USING L205-LINK-AREA. DTSBD555 00583 DTSBD555 00584 IF L205-VALID-NO-88 (7) DTSBD555 00585 DISPLAY 'P1100 INVALID TOT WAGE: ' X157-TOTAL-WAGES DTSBD555 00586 SET W-ERROR-YES-88 TO TRUE DTSBD555 00587 END-IF. DTSBD555 00588 DTSBD555 00589 IF L205-VALID-NO-88 (8) DTSBD555 00590 DISPLAY 'P1100 INVALID TAX WAGE: ' X157-TAX-WAGES DTSBD555 00591 SET W-ERROR-YES-88 TO TRUE DTSBD555 00592 END-IF. DTSBD555 00593 DTSBD555 00594 IF L205-VALID-NO-88 (9) DTSBD555 00595 DISPLAY 'P1100 INVALID REMIT: ' X157-REMITTANCE DTSBD555 00596 SET W-ERROR-YES-88 TO TRUE DTSBD555 00597 END-IF. DTSBD555 00598 DTSBD555 00599 IF L205-VALID-NO-88 (10) DTSBD555 00600 DISPLAY 'P1100 INVALID WRKR CNT 1: ' DTSBD555 00601 X157-WRKR-CNT-1ST-MNTH DTSBD555 00602 SET W-ERROR-YES-88 TO TRUE DTSBD555 00603 END-IF. DTSBD555 00604 DTSBD555 00605 IF L205-VALID-NO-88 (11) DTSBD555 00606 DISPLAY 'P1100 INVALID WRKR CNT 2: ' DTSBD555 00607 X157-WRKR-CNT-2ND-MNTH DTSBD555 00608 SET W-ERROR-YES-88 TO TRUE DTSBD555 00609 END-IF. DTSBD555 00610 DTSBD555 00611 IF L205-VALID-NO-88 (12) DTSBD555 00612 DISPLAY 'P1100 INVALID WRKR CNT 3: ' DTSBD555 00613 X157-WRKR-CNT-3RD-MNTH DTSBD555 00614 SET W-ERROR-YES-88 TO TRUE DTSBD555 00615 END-IF. DTSBD555 00616 DTSBD555 00617 IF L205-VALID-NO-88 (16) DTSBD555 00618 DISPLAY 'P1100 INVALID LOG NBR: ' DTSBD555 00619 X157-LOG-NO DTSBD555 00620 SET W-ERROR-YES-88 TO TRUE DTSBD555 00621 END-IF. DTSBD555 00622 DTSBD555 00623 P1110-EXIT. DTSBD555 00624 EXIT. DTSBD555 00625 DTSBD555 00626 P1120-SAVE-DATA. DTSBD555 00627 MOVE L205-TEXT (2) (1:06) TO X157-EMP-NO. DTSBD555 00628 DTSBD555 00629 MOVE L205-TEXT (3) (1:06) TO X157-QUARTER. DTSBD555 00630 DTSBD555 00631 MOVE L205-DATE (4) TO X157-RECEIVED-DATE. DTSBD555 00632 DTSBD555 00633 MOVE L205-TEXT (5) (1:01) TO X157-SOURCE. DTSBD555 00634 DTSBD555 00635 MOVE L205-TEXT (6) (1:02) TO X157-REPORT-TYPE. DTSBD555 00636 DTSBD555 00637 MOVE L205-INTEGER (7) TO W-INTEGER. DTSBD555 00638 MOVE L205-FRACTION (7) TO W-FRACTION. DTSBD555 00639 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. DTSBD555 00640 MOVE W-NUMBER TO W-TOT-WAGE. DTSBD555 00641 DTSBD555 00642 MOVE L205-INTEGER (8) TO W-INTEGER. DTSBD555 00643 MOVE L205-FRACTION (8) TO W-FRACTION. DTSBD555 00644 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. DTSBD555 00645 MOVE W-NUMBER TO W-TAX-WAGE. DTSBD555 00646 DTSBD555 00647 MOVE L205-INTEGER (9) TO W-INTEGER. DTSBD555 00648 MOVE L205-FRACTION (9) TO W-FRACTION. DTSBD555 00649 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. DTSBD555 00650 MOVE W-NUMBER TO W-REMITTANCE. DTSBD555 00651 DTSBD555 00652 MOVE L205-INTEGER (10) TO W-INTEGER. DTSBD555 00653 MOVE W-INTEGER TO W-1ST-MNTH-CNT. DTSBD555 00654 DTSBD555 00655 MOVE L205-INTEGER (11) TO W-INTEGER. DTSBD555 00656 MOVE W-INTEGER TO W-2ND-MNTH-CNT. DTSBD555 00657 DTSBD555 00658 MOVE L205-INTEGER (12) TO W-INTEGER. DTSBD555 00659 MOVE W-INTEGER TO W-3RD-MNTH-CNT. DTSBD555 00660 DTSBD555 00661 MOVE L205-TEXT (13) (1:01) TO X157-WAIVE-INTEREST. DTSBD555 00662 DTSBD555 00663 MOVE L205-TEXT (14) (1:01) TO X157-WAIVE-PENALTY. DTSBD555 00664 DTSBD555 00665 MOVE L205-TEXT (15) (1:08) TO X157-MF-OPID. DTSBD555 00666 DTSBD555 00667 MOVE L205-INTEGER (16) TO W-INTEGER. DTSBD555 00668 MOVE W-INTEGER TO W-LOG-NO. DTSBD555 00669 DTSBD555 00670 MOVE L205-DATE (17) TO X157-ENTERED-DATE. DTSBD555 00671 DTSBD555 00672 P1120-EXIT. DTSBD555 00673 EXIT. DTSBD555 00674 DTSBD555 00675 P1200-EDIT-REPORT. DTSBD555 00676 PERFORM P1210-EDIT-DATA THRU P1210-EXIT. DTSBD555 00677 IF W-ERROR-NO-88 DTSBD555 00678 PERFORM P1220-CHECK-DATABASE THRU P1220-EXIT DTSBD555 00679 END-IF. DTSBD555 00680 DTSBD555 00681 *& DTSBD555 00682 DISPLAY 'P1210: ' W-EMP-NO ' ' W-TOT-WAGE DTSBD555 00683 ' ' W-TAX-WAGE ' ' W-LOG-NO. DTSBD555 00684 DISPLAY SPACE. DTSBD555 00685 *& DTSBD555 00686 DTSBD555 00687 P1200-EXIT. DTSBD555 00688 EXIT. DTSBD555 00689 DTSBD555 00690 P1210-EDIT-DATA. DTSBD555 00691 MOVE X157-EMP-NO TO W-EMP-NO-9. DTSBD555 00692 SET W-EMP-ERROR-NO-88 TO TRUE. DTSBD555 00693 PERFORM DTSBD555 00694 VARYING SUB FROM +1 BY +1 DTSBD555 00695 UNTIL SUB > +6 DTSBD555 00696 IF W-EMP-NO-X (SUB:1) < '0' OR > '9' DTSBD555 00697 SET W-ERROR-YES-88 TO TRUE DTSBD555 00698 SET W-EMP-ERROR-YES-88 TO TRUE DTSBD555 00699 MOVE SPACES TO R140-MESSAGE DTSBD555 00700 MOVE W-EMP-NO TO R140-EMP-NO DTSBD555 00701 STRING DTSBD555 00702 'REPORT: INVALID EMPLOYER NUMBER: ' DTSBD555 00703 X157-EMP-NO DTSBD555 00704 DELIMITED BY SIZE DTSBD555 00705 INTO R140-MESSAGE DTSBD555 00706 END-STRING DTSBD555 00707 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBD555 00708 DISPLAY R140-MESSAGE DTSBD555 00709 END-IF DTSBD555 00710 END-PERFORM. DTSBD555 00711 IF W-EMP-ERROR-NO-88 DTSBD555 00712 MOVE W-EMP-NO-9 TO W-EMP-NO DTSBD555 00713 ELSE DTSBD555 00714 MOVE ZERO TO W-EMP-NO DTSBD555 00715 END-IF. DTSBD555 00716 DTSBD555 00717 MOVE X157-QUARTER TO W-SLASH-QTR. DTSBD555 00718 MOVE W-SLASH-QTR-CCYY TO L004-QTR-5-YR. DTSBD555 00719 MOVE W-SLASH-QTR-Q TO L004-QTR-5-Q. DTSBD555 00720 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD555 00721 IF NOT L004-VALID-QTR DTSBD555 00722 SET W-ERROR-YES-88 TO TRUE DTSBD555 00723 MOVE SPACES TO R140-MESSAGE DTSBD555 00724 MOVE W-EMP-NO TO R140-EMP-NO DTSBD555 00725 STRING DTSBD555 00726 'REPORT: INVALID QUARTER: ' DTSBD555 00727 X157-QUARTER DTSBD555 00728 DELIMITED BY SIZE DTSBD555 00729 INTO R140-MESSAGE DTSBD555 00730 END-STRING DTSBD555 00731 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBD555 00732 DISPLAY R140-MESSAGE DTSBD555 00733 ELSE DTSBD555 00734 MOVE L004-QTR-5-9 TO W-REPORT-QTR DTSBD555 00735 END-IF. DTSBD555 00736 DTSBD555 00737 *& DTSBD555 00738 * MOVE X157-ENTERED-DATE TO X157-RECEIVED-DATE. DTSBD555 00739 *& DTSBD555 00740 MOVE X157-RECEIVED-DATE TO W-SLASH-DATE. DTSBD555 00741 MOVE W-SLASH-DT-MM TO L001-FED-8-MO. DTSBD555 00742 MOVE W-SLASH-DT-DD TO L001-FED-8-DA. DTSBD555 00743 MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR. DTSBD555 00744 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBD555 00745 IF NOT L001-VALID-DATE DTSBD555 00746 SET W-ERROR-YES-88 TO TRUE DTSBD555 00747 MOVE SPACES TO R140-MESSAGE DTSBD555 00748 MOVE W-EMP-NO TO R140-EMP-NO DTSBD555 00749 STRING DTSBD555 00750 'REPORT: INVALID RECEIVED DATE: ' DTSBD555 00751 X157-RECEIVED-DATE DTSBD555 00752 DELIMITED BY SIZE DTSBD555 00753 INTO R140-MESSAGE DTSBD555 00754 END-STRING DTSBD555 00755 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBD555 00756 DISPLAY R140-MESSAGE DTSBD555 00757 ELSE DTSBD555 00758 MOVE L001-FED-8-DATE-9 TO W-RECEIVED-DATE DTSBD555 00759 END-IF. DTSBD555 00760 DTSBD555 00761 MOVE X157-REPORT-TYPE TO L032-CD-2. DTSBD555 00762 PERFORM S032-RPT-TYPE THRU S032-EXIT. DTSBD555 00763 IF NOT L032-VALID DTSBD555 00764 SET W-ERROR-YES-88 TO TRUE DTSBD555 00765 MOVE SPACES TO R140-MESSAGE DTSBD555 00766 MOVE W-EMP-NO TO R140-EMP-NO DTSBD555 00767 STRING DTSBD555 00768 'REPORT: INVALID RPT TYPE: ' DTSBD555 00769 X157-REPORT-TYPE DTSBD555 00770 DELIMITED BY SIZE DTSBD555 00771 INTO R140-MESSAGE DTSBD555 00772 END-STRING DTSBD555 00773 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBD555 00774 DISPLAY R140-MESSAGE DTSBD555 00775 END-IF. DTSBD555 00776 DTSBD555 00777 MOVE X157-ENTERED-DATE TO W-SLASH-DATE. DTSBD555 00778 MOVE W-SLASH-DT-MM TO L001-FED-8-MO. DTSBD555 00779 MOVE W-SLASH-DT-DD TO L001-FED-8-DA. DTSBD555 00780 MOVE W-SLASH-DT-CCYY TO L001-FED-8-YR. DTSBD555 00781 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBD555 00782 IF NOT L001-VALID-DATE DTSBD555 00783 SET W-ERROR-YES-88 TO TRUE DTSBD555 00784 MOVE SPACES TO R140-MESSAGE DTSBD555 00785 MOVE W-EMP-NO TO R140-EMP-NO DTSBD555 00786 STRING DTSBD555 00787 'REPORT: INVALID ENTERED DATE: ' DTSBD555 00788 X157-ENTERED-DATE DTSBD555 00789 DELIMITED BY SIZE DTSBD555 00790 INTO R140-MESSAGE DTSBD555 00791 END-STRING DTSBD555 00792 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBD555 00793 DISPLAY R140-MESSAGE DTSBD555 00794 ELSE DTSBD555 00795 MOVE L001-FED-8-DATE-9 TO W-ENTERED-DATE DTSBD555 00796 END-IF. DTSBD555 00797 DTSBD555 00798 P1210-EXIT. DTSBD555 00799 EXIT. DTSBD555 00800 DTSBD555 00801 P1220-CHECK-DATABASE. DTSBD555 00802 MOVE LOW-VALUE TO MPRF-KEY-AREA. DTSBD555 00803 MOVE W-EMP-NO TO MPRF-EMP-NO. DTSBD555 00804 SET MPRF-PRF-88 TO TRUE. DTSBD555 00805 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSBD555 00806 DTSBD555 00807 PERFORM S910-READ THRU S910-EXIT. DTSBD555 00808 IF L910-NO-REC-88 DTSBD555 00809 SET W-EMP-FOUND-NO-88 TO TRUE DTSBD555 00810 DISPLAY 'EMPLOYER NOT ON FILE ' X157-EMP-NO DTSBD555 00811 ELSE DTSBD555 00812 MOVE MSKL-REC TO MPRF-REC DTSBD555 00813 SET W-EMP-FOUND-YES-88 TO TRUE DTSBD555 00814 MOVE W-REPORT-QTR TO L516-YRQ DTSBD555 00815 PERFORM S516-LIABILITY-INFO THRU S516-EXIT DTSBD555 00816 END-IF. DTSBD555 00817 DTSBD555 00818 IF W-EMP-FOUND-YES-88 DTSBD555 00819 PERFORM P1221-CHECK-QTR THRU P1221-EXIT DTSBD555 00820 END-IF. DTSBD555 00821 DTSBD555 00822 P1220-EXIT. DTSBD555 00823 EXIT. DTSBD555 00824 DTSBD555 00825 P1221-CHECK-QTR. DTSBD555 00826 MOVE LOW-VALUE TO MQTR-KEY-AREA. DTSBD555 00827 MOVE W-EMP-NO TO MQTR-EMP-NO. DTSBD555 00828 MOVE W-REPORT-QTR TO MQTR-YRQ DTSBD555 00829 SET MQTR-QTR-88 TO TRUE. DTSBD555 00830 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSBD555 00831 DTSBD555 00832 PERFORM S910-READ THRU S910-EXIT. DTSBD555 00833 IF L910-OK-88 DTSBD555 00834 IF MQTR-CURR-RCVD-88 DTSBD555 00835 SET W-ERROR-YES-88 TO TRUE DTSBD555 00836 DISPLAY 'REPORT ON FILE: ' W-EMP-NO DTSBD555 00837 ' ' W-REPORT-QTR DTSBD555 00838 END-IF DTSBD555 00839 END-IF. DTSBD555 00840 DTSBD555 00841 P1221-EXIT. DTSBD555 00842 EXIT. DTSBD555 00843 DTSBD555 00844 P1300-SAVE-REPORT. DTSBD555 00845 IF W-PSEUDO-ITEM-NO < 999 DTSBD555 00846 ADD 1 TO W-PSEUDO-ITEM-NO DTSBD555 00847 ELSE DTSBD555 00848 ADD 1 TO W-PSEUDO-BATCH-NO DTSBD555 00849 MOVE 1 TO W-PSEUDO-ITEM-NO DTSBD555 00850 END-IF. DTSBD555 00851 MOVE LENGTH OF T028-REC TO T028-LENGTH DTSBD555 00852 MOVE '028' TO T028-REC-TYPE. DTSBD555 00853 DTSBD555 00854 MOVE W-LOG-NO TO T028-LOG-NBR. DTSBD555 00855 MOVE W-EMP-NO TO T028-EMP-NO. DTSBD555 00856 MOVE 'WAGEONLY' TO T028-ORIGIN. DTSBD555 00857 MOVE L005-DATE TO T028-SYS-DATE. DTSBD555 00858 MOVE L005-TIME TO T028-SYS-TIME. DTSBD555 00859 SET T028-WAGE-ONLY-DISK-88 TO TRUE. DTSBD555 00860 DTSBD555 00861 MOVE W-PSEUDO-BATCH-NO TO T028-PSEUDO-BATCH-NO. DTSBD555 00862 MOVE W-PSEUDO-ITEM-NO TO T028-PSEUDO-ITEM-NO. DTSBD555 00863 DTSBD555 00864 MOVE W-REPORT-QTR TO T028-YRQ. DTSBD555 00865 IF W-EMP-FOUND-YES-88 DTSBD555 00866 MOVE MPRF-PRIMARY-NAME (1:4) DTSBD555 00867 TO T028-NAME-CHECK DTSBD555 00868 ELSE DTSBD555 00869 MOVE SPACES TO T028-NAME-CHECK DTSBD555 00870 END-IF. DTSBD555 00871 DTSBD555 00872 MOVE X157-REPORT-TYPE TO T028-RPT-TYPE. DTSBD555 00873 DTSBD555 00874 SET T028-WAIVE-BOTH-NO-88 TO TRUE. DTSBD555 00875 SET T028-WAIVE-INT-NO-88 TO TRUE. DTSBD555 00876 SET T028-WAIVE-LATE-PEN-NO-88 TO TRUE. DTSBD555 00877 MOVE W-RECEIVED-DATE TO T028-RECEIVED-DATE DTSBD555 00878 T028-DEPOSIT-DATE. DTSBD555 00879 DTSBD555 00880 MOVE W-TOT-WAGE TO T028-TOT-WAGE. DTSBD555 00881 DTSBD555 00882 IF W-EMP-FOUND-NO-88 DTSBD555 00883 MOVE W-TAX-WAGE TO T028-TAX-WAGE DTSBD555 00884 COMPUTE T028-EXCESS-WAGE = DTSBD555 00885 (T028-TOT-WAGE - T028-TAX-WAGE) DTSBD555 00886 ELSE DTSBD555 00887 IF MPRF-CLASS-SELF-INS-88 DTSBD555 00888 MOVE ZERO TO T028-TAX-WAGE DTSBD555 00889 T028-EXCESS-WAGE DTSBD555 00890 ELSE DTSBD555 00891 MOVE W-TAX-WAGE TO T028-TAX-WAGE DTSBD555 00892 COMPUTE T028-EXCESS-WAGE = DTSBD555 00893 (T028-TOT-WAGE - T028-TAX-WAGE) DTSBD555 00894 END-IF DTSBD555 00895 END-IF. DTSBD555 00896 DTSBD555 00897 MOVE ZERO TO T028-TOTAL-EMPL-CNT. DTSBD555 00898 MOVE W-1ST-MNTH-CNT TO T028-1ST-MTH-EMPL-CNT. DTSBD555 00899 MOVE W-2ND-MNTH-CNT TO T028-2ND-MTH-EMPL-CNT. DTSBD555 00900 MOVE W-3RD-MNTH-CNT TO T028-3RD-MTH-EMPL-CNT. DTSBD555 00901 DTSBD555 00902 MOVE W-REMITTANCE TO T028-REMIT-AMT. DTSBD555 00903 DTSBD555 00904 IF W-EMP-FOUND-NO-88 DTSBD555 00905 OR L516-NOT-LIABLE-88 DTSBD555 00906 SET T028-PASSED-FULL-EDITS-NO-88 TO TRUE DTSBD555 00907 ELSE DTSBD555 00908 SET T028-PASSED-FULL-EDITS-YES-88 TO TRUE DTSBD555 00909 END-IF. DTSBD555 00910 DTSBD555 00911 MOVE ZERO TO T028-TRACE-NO. DTSBD555 00912 DTSBD555 00913 MOVE 'VOL' TO T028-RESPONSIBLE-ACTIVITY. DTSBD555 00914 MOVE X157-MF-OPID TO T028-RESPONSIBLE-OP-ID. DTSBD555 00915 DTSBD555 00916 PERFORM S1032-WRITE-TEMP-T028 THRU S1032-EXIT. DTSBD555 00917 DTSBD555 00918 P1300-EXIT. DTSBD555 00919 EXIT. DTSBD555 00920 DTSBD555 00921 DTSBD555 00922 P2000-WAGE. DTSBD555 00923 SET W-WAGE-COMPLETE-NO-88 TO TRUE. DTSBD555 00924 DTSBD555 00925 IF W-TOT-WAGE = ZERO DTSBD555 00926 IF X144-EMP-NO = X157-EMP-NO DTSBD555 00927 AND X144-QUARTER = X157-QUARTER DTSBD555 00928 SET W-ERROR-YES-88 TO TRUE DTSBD555 00929 DISPLAY 'WAGES FOUND WHEN TOT WAGE = 0: ' DTSBD555 00930 W-EMP-NO ' ' W-REPORT-QTR DTSBD555 00931 GO TO P2000-EXIT DTSBD555 00932 ELSE DTSBD555 00933 GO TO P2000-EXIT DTSBD555 00934 END-IF DTSBD555 00935 END-IF. DTSBD555 00936 DTSBD555 00937 PERFORM UNTIL W-WAGE-COMPLETE-YES-88 DTSBD555 00938 PERFORM P2100-PARSE-WAGES THRU P2100-EXIT DTSBD555 00939 IF X144-EMP-NO NOT = X157-EMP-NO DTSBD555 00940 OR X144-QUARTER NOT = X157-QUARTER DTSBD555 00941 SET W-WAGE-COMPLETE-YES-88 TO TRUE DTSBD555 00942 ELSE DTSBD555 00943 IF W-ERROR-NO-88 DTSBD555 00944 PERFORM P2200-EDIT-WAGES THRU P2200-EXIT DTSBD555 00945 IF W-ERROR-NO-88 DTSBD555 00946 PERFORM P2300-SAVE-WAGES THRU P2300-EXIT DTSBD555 00947 END-IF DTSBD555 00948 END-IF DTSBD555 00949 END-IF DTSBD555 00950 IF W-WAGE-COMPLETE-NO-88 DTSBD555 00951 PERFORM S1025-READ-WAGE-IN THRU S1025-EXIT DTSBD555 00952 END-IF DTSBD555 00953 END-PERFORM. DTSBD555 00954 DTSBD555 00955 P2000-EXIT. DTSBD555 00956 EXIT. DTSBD555 00957 DTSBD555 00958 P2100-PARSE-WAGES. DTSBD555 00959 PERFORM P2110-PARSE THRU P2110-EXIT. DTSBD555 00960 IF W-ERROR-NO-88 DTSBD555 00961 PERFORM P2120-SAVE-DATA THRU P2120-EXIT DTSBD555 00962 END-IF. DTSBD555 00963 DTSBD555 00964 P2100-EXIT. DTSBD555 00965 EXIT. DTSBD555 00966 DTSBD555 00967 P2110-PARSE. DTSBD555 00968 PERFORM DTSBD555 00969 VARYING SUB FROM +1 BY +1 DTSBD555 00970 UNTIL SUB > +100 DTSBD555 00971 MOVE +0 TO L205-FIELD-LENGTH (SUB) DTSBD555 00972 L205-INTEGER (SUB) DTSBD555 00973 L205-FRACTION (SUB) DTSBD555 00974 MOVE SPACES TO L205-TEXT (SUB) DTSBD555 00975 L205-DATE (SUB) DTSBD555 00976 SET L205-TYPE-TEXT-88 (SUB) TO TRUE DTSBD555 00977 END-PERFORM. DTSBD555 00978 DTSBD555 00979 INITIALIZE X144-REC DTSBD555 00980 MOVE +9 TO L205-LAST-FIELD DTSBD555 00981 MOVE +1 TO L205-LAST-FIELD-LEN DTSBD555 00982 DTSBD555 00983 ** RECORD TYPE DTSBD555 00984 MOVE +3 TO L205-FIELD-LENGTH (1). DTSBD555 00985 SET L205-TYPE-TEXT-88 (1) TO TRUE. DTSBD555 00986 DTSBD555 00987 ** EMPLOYER NUMBER DTSBD555 00988 MOVE +6 TO L205-FIELD-LENGTH (2). DTSBD555 00989 SET L205-TYPE-TEXT-88 (2) TO TRUE. DTSBD555 00990 DTSBD555 00991 ** QUARTER DTSBD555 00992 MOVE +6 TO L205-FIELD-LENGTH (3). DTSBD555 00993 SET L205-TYPE-TEXT-88 (3) TO TRUE. DTSBD555 00994 DTSBD555 00995 ** SSN DTSBD555 00996 MOVE +9 TO L205-FIELD-LENGTH (4). DTSBD555 00997 SET L205-TYPE-TEXT-88 (4) TO TRUE. DTSBD555 00998 DTSBD555 00999 ** SOURCE DTSBD555 01000 MOVE +1 TO L205-FIELD-LENGTH (5). DTSBD555 01001 SET L205-TYPE-TEXT-88 (5) TO TRUE. DTSBD555 01002 DTSBD555 01003 ** EARNINGS DTSBD555 01004 MOVE +12 TO L205-FIELD-LENGTH (6). DTSBD555 01005 SET L205-TYPE-NUMBER-88 (6) TO TRUE. DTSBD555 01006 DTSBD555 01007 ** TAX WAGE DTSBD555 01008 ** MOVE +12 TO L205-FIELD-LENGTH (7). DTSBD555 01009 ** SET L205-TYPE-NUMBER-88 (7) TO TRUE. DTSBD555 01010 DTSBD555 01011 ** LAST NAME DTSBD555 01012 MOVE +20 TO L205-FIELD-LENGTH (7). DTSBD555 01013 SET L205-TYPE-TEXT-88 (7) TO TRUE. DTSBD555 01014 DTSBD555 01015 ** FIRST NAME DTSBD555 01016 MOVE +15 TO L205-FIELD-LENGTH (8). DTSBD555 01017 SET L205-TYPE-TEXT-88 (8) TO TRUE. DTSBD555 01018 DTSBD555 01019 ** MIDDLE INITIAL DTSBD555 01020 MOVE +1 TO L205-FIELD-LENGTH (09). DTSBD555 01021 SET L205-TYPE-TEXT-88 (09) TO TRUE. DTSBD555 01022 DTSBD555 01023 MOVE WAGE-IN-REC TO L205-INPUT-DATA. DTSBD555 01024 CALL 'DTSBU205' USING L205-LINK-AREA. DTSBD555 01025 DTSBD555 01026 IF L205-VALID-NO-88 (6) DTSBD555 01027 DISPLAY 'P2110 INVALID EARNINGS: ' DTSBD555 01028 X144-EARNINGS DTSBD555 01029 SET W-ERROR-YES-88 TO TRUE DTSBD555 01030 END-IF. DTSBD555 01031 DTSBD555 01032 *** IF L205-VALID-NO-88 (7) DTSBD555 01033 ** DISPLAY 'P2110 INVALID TAX WAGE: ' DTSBD555 01034 ** X144-TAXABLE-WAGES DTSBD555 01035 ** SET W-ERROR-YES-88 TO TRUE DTSBD555 01036 *** END-IF. DTSBD555 01037 DTSBD555 01038 P2110-EXIT. DTSBD555 01039 EXIT. DTSBD555 01040 DTSBD555 01041 P2120-SAVE-DATA. DTSBD555 01042 *& MOVE L205-TEXT (1) (1:03) TO X144-REC-TYPE. DTSBD555 01043 DTSBD555 01044 MOVE L205-TEXT (2) (1:06) TO X144-EMP-NO. DTSBD555 01045 DTSBD555 01046 MOVE L205-TEXT (3) (1:06) TO X144-QUARTER. DTSBD555 01047 DTSBD555 01048 MOVE L205-TEXT (4) (1:09) TO X144-SSN. DTSBD555 01049 DTSBD555 01050 MOVE L205-TEXT (5) (1:01) TO X144-WAGE-STATUS. DTSBD555 01051 DTSBD555 01052 MOVE L205-INTEGER (6) TO W-INTEGER. DTSBD555 01053 MOVE L205-FRACTION (6) TO W-FRACTION. DTSBD555 01054 COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. DTSBD555 01055 MOVE W-NUMBER TO W-EARNINGS. DTSBD555 01056 DTSBD555 01057 ** MOVE L205-INTEGER (7) TO W-INTEGER. DTSBD555 01058 * MOVE L205-FRACTION (7) TO W-FRACTION. DTSBD555 01059 * COMPUTE W-NUMBER = W-INTEGER + W-FRACTION. DTSBD555 01060 * MOVE W-NUMBER TO W-WORKER-TAX-WAGES. DTSBD555 01061 * DTSBD555 01062 * MOVE L205-TEXT (8) (1:20) TO W-LAST-NAME. DTSBD555 01063 * DTSBD555 01064 * MOVE L205-TEXT (9) (1:15) TO W-FIRST-NAME. DTSBD555 01065 * DTSBD555 01066 ** MOVE L205-TEXT (10) (1:01) TO W-MID-INIT. DTSBD555 01067 DTSBD555 01068 P2120-EXIT. DTSBD555 01069 EXIT. DTSBD555 01070 DTSBD555 01071 P2200-EDIT-WAGES. DTSBD555 01072 IF X144-EMP-NO = X157-EMP-NO DTSBD555 01073 AND X144-QUARTER = X157-QUARTER DTSBD555 01074 NEXT SENTENCE DTSBD555 01075 ELSE DTSBD555 01076 DISPLAY 'WAGE DATA DOES NOT MATCH REPORT' DTSBD555 01077 DISPLAY ' REPORT: ' X157-EMP-NO ' ' X157-QUARTER DTSBD555 01078 ' WAGE: ' X144-EMP-NO ' ' X144-QUARTER DTSBD555 01079 SET W-ERROR-YES-88 TO TRUE DTSBD555 01080 GO TO P2200-EXIT DTSBD555 01081 END-IF. DTSBD555 01082 DTSBD555 01083 MOVE X144-QUARTER TO W-SLASH-QTR. DTSBD555 01084 MOVE W-SLASH-QTR-CCYY TO L004-QTR-5-YR. DTSBD555 01085 MOVE W-SLASH-QTR-Q TO L004-QTR-5-Q. DTSBD555 01086 PERFORM S004-FROM-5 THRU S004-EXIT. DTSBD555 01087 IF NOT L004-VALID-QTR DTSBD555 01088 SET W-ERROR-YES-88 TO TRUE DTSBD555 01089 MOVE SPACES TO R140-MESSAGE DTSBD555 01090 MOVE W-EMP-NO TO R140-EMP-NO DTSBD555 01091 STRING DTSBD555 01092 'WAGE: INVALID QUARTER ' DTSBD555 01093 X144-QUARTER DTSBD555 01094 DELIMITED BY SIZE DTSBD555 01095 INTO R140-MESSAGE DTSBD555 01096 END-STRING DTSBD555 01097 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBD555 01098 DISPLAY R140-MESSAGE DTSBD555 01099 ELSE DTSBD555 01100 IF L004-QTR-5-9 NOT = W-REPORT-QTR DTSBD555 01101 SET W-ERROR-YES-88 TO TRUE DTSBD555 01102 MOVE SPACES TO R140-MESSAGE DTSBD555 01103 MOVE W-EMP-NO TO R140-EMP-NO DTSBD555 01104 STRING DTSBD555 01105 'WAGE WAGE QTR NOT = RPT QTR ' DTSBD555 01106 X144-QUARTER DTSBD555 01107 DELIMITED BY SIZE DTSBD555 01108 INTO R140-MESSAGE DTSBD555 01109 END-STRING DTSBD555 01110 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBD555 01111 DISPLAY R140-MESSAGE DTSBD555 01112 END-IF DTSBD555 01113 END-IF. DTSBD555 01114 DTSBD555 01115 MOVE X144-SSN TO W-SSN-X. DTSBD555 01116 SET W-SSN-ERROR-NO-88 TO TRUE. DTSBD555 01117 PERFORM DTSBD555 01118 VARYING SUB FROM +1 BY +1 DTSBD555 01119 UNTIL SUB > +9 DTSBD555 01120 IF W-SSN-X (SUB:1) < '0' OR > '9' DTSBD555 01121 SET W-ERROR-YES-88 TO TRUE DTSBD555 01122 DISPLAY 'P2200 SSN ERR: ' SUB DTSBD555 01123 ' ' W-SSN-X (SUB:1) DTSBD555 01124 MOVE SPACES TO R140-MESSAGE DTSBD555 01125 MOVE X144-SSN TO R140-EMP-NO DTSBD555 01126 STRING DTSBD555 01127 'WAGE: NON-NUMERIC SSN: ' DTSBD555 01128 X144-SSN DTSBD555 01129 DELIMITED BY SIZE DTSBD555 01130 INTO R140-MESSAGE DTSBD555 01131 END-STRING DTSBD555 01132 PERFORM S946-WRITE-R140 THRU S946-EXIT DTSBD555 01133 DISPLAY R140-MESSAGE DTSBD555 01134 END-IF DTSBD555 01135 END-PERFORM DTSBD555 01136 IF W-SSN-ERROR-NO-88 DTSBD555 01137 MOVE X144-SSN TO W-SSN DTSBD555 01138 END-IF. DTSBD555 01139 DTSBD555 01140 MOVE X144-LAST-NAME TO W-WRKR-LAST-NAME. DTSBD555 01141 MOVE X144-FIRST-NAME TO W-WRKR-FIRST-NAME. DTSBD555 01142 MOVE X144-MID-INIT TO W-WRKR-MID-INIT. DTSBD555 01143 DTSBD555 01144 P2200-EXIT. DTSBD555 01145 EXIT. DTSBD555 01146 DTSBD555 01147 P2300-SAVE-WAGES. DTSBD555 01148 ** DISPLAY 'WRITE WAGES: ' W-EMP-NO ' ' W-REPORT-QTR DTSBD555 01149 ** ' ' X144-SSN ' ' X144-EARNINGS. DTSBD555 01150 MOVE W-PSEUDO-BATCH-NO TO W001-BATCH-NO. DTSBD555 01151 MOVE W-PSEUDO-ITEM-NO TO W001-ITEM-NO. DTSBD555 01152 ADD 1 TO W-SEQ-NO. DTSBD555 01153 MOVE W-SEQ-NO TO W001-SEQ-NO. DTSBD555 01154 MOVE W-EMP-NO TO W001-EMP-NO. DTSBD555 01155 MOVE W-SSN TO W001-SSN. DTSBD555 01156 SET W001-SSN-VALID-88 TO TRUE. DTSBD555 01157 DTSBD555 01158 * MOVE W-WRKR-FIRST-NAME TO W001-FIRST-NAME. DTSBD555 01159 * MOVE W-WRKR-MID-INIT TO W001-MID-INIT. DTSBD555 01160 * MOVE W-WRKR-LAST-NAME TO W001-LAST-NAME. DTSBD555 01161 MOVE SPACES TO W001-FIRST-NAME DTSBD555 01162 W001-MID-INIT DTSBD555 01163 W001-LAST-NAME. DTSBD555 01164 SET W001-NAME-VALID-88 TO TRUE. DTSBD555 01165 DTSBD555 01166 MOVE W-REPORT-QTR TO W001-YRQ. DTSBD555 01167 MOVE W-EARNINGS TO W001-WAGE-CHNG. DTSBD555 01168 MOVE ZERO TO W001-TAX-WAGE. DTSBD555 01169 SET W001-WAGE-VALID-88 TO TRUE. DTSBD555 01170 MOVE ZERO TO W001-CURR-WAGE DTSBD555 01171 W001-PRIOR-WAGE. DTSBD555 01172 MOVE L005-DATE TO W001-RECEIVED-DATE. DTSBD555 01173 MOVE L005-TIME TO W001-RECEIVED-TIME. DTSBD555 01174 MOVE X157-MF-OPID TO W001-RESPONSIBLE-OP-ID. DTSBD555 01175 SET W001-WAGE-ONLY-DISK-88 TO TRUE. DTSBD555 01176 DTSBD555 01177 PERFORM S1120-WRITE-WAGE-TEMP THRU S1120-EXIT. DTSBD555 01178 DTSBD555 01179 P2300-EXIT. DTSBD555 01180 EXIT. DTSBD555 01181 DTSBD555 01182 DTSBD555 01183 T0000-TERMINATE. DTSBD555 01184 DTSBD555 01185 IF W-ERROR-NO-88 DTSBD555 01186 PERFORM T1000-WRITE-REPORT THRU T1000-EXIT DTSBD555 01187 PERFORM T2000-WRITE-WAGES THRU T2000-EXIT DTSBD555 01188 PERFORM T3000-UPDATE-CURR-BATCH THRU T3000-EXIT DTSBD555 01189 ELSE DTSBD555 01190 DISPLAY '>>> DTSBD555: ERRORS FOUND <<<' DTSBD555 01191 DISPLAY '>>> NO OUTPUT FILE WRITTEN <<<' DTSBD555 01192 END-IF. DTSBD555 01193 DTSBD555 01194 DISPLAY ' '. DTSBD555 01195 DTSBD555 01196 DISPLAY '*** DTSBD555 TERMINATION STATISTICS ***'. DTSBD555 01197 DTSBD555 01198 DISPLAY ' '. DTSBD555 01199 DTSBD555 01200 DISPLAY 'REPORT RECORDS INPUT: ' DTSBD555 01201 W-RPT-IN-CNT. DTSBD555 01202 DTSBD555 01203 DISPLAY 'WAGE RECORDS INPUT: ' DTSBD555 01204 W-WAGE-IN-CNT. DTSBD555 01205 DTSBD555 01206 DISPLAY 'TEMP RPT RECS WRITTEN: ' DTSBD555 01207 W-TEMP-T028-CNT. DTSBD555 01208 DTSBD555 01209 DISPLAY 'TEMP WAGE RECS WRITTEN: ' DTSBD555 01210 W-TEMP-WAGE-CNT. DTSBD555 01211 DTSBD555 01212 DISPLAY 'REPORT RECORDS WRITTEN: ' DTSBD555 01213 W-T028-WRITE-CNT. DTSBD555 01214 DTSBD555 01215 DISPLAY 'WAGE RECORDS WRITTEN: ' DTSBD555 01216 W-WAGE-OUT-CNT. DTSBD555 01217 DTSBD555 01218 DISPLAY ' '. DTSBD555 01219 DTSBD555 01220 DTSBD555 01221 DISPLAY '***************************************'. DTSBD555 01222 DTSBD555 01223 PERFORM S1010-CLOSE-REPORT-IN THRU S1010-EXIT. DTSBD555 01224 PERFORM S1030-CLOSE-WAGE-IN THRU S1030-EXIT. DTSBD555 01225 CLOSE CURR-BATCH-NO. DTSBD555 01226 PERFORM S910-CLOSE THRU S910-EXIT. DTSBD555 01227 PERFORM S931-CLOSE THRU S931-EXIT. DTSBD555 01228 DTSBD555 01229 T0000-EXIT. DTSBD555 01230 EXIT. DTSBD555 01231 DTSBD555 01232 T1000-WRITE-REPORT. DTSBD555 01233 PERFORM S1060-CLOSE-TEMP-BTC THRU S1060-EXIT. DTSBD555 01234 IF W-FATAL-ERROR-NO-88 DTSBD555 01235 PERFORM T1100-COPY-TO-BTC THRU T1100-EXIT DTSBD555 01236 ELSE DTSBD555 01237 DISPLAY 'T1000 FATAL ERR ON CLOSE' DTSBD555 01238 GO TO T1000-EXIT DTSBD555 01239 END-IF. DTSBD555 01240 DTSBD555 01241 T1000-EXIT. DTSBD555 01242 EXIT. DTSBD555 01243 DTSBD555 01244 T1100-COPY-TO-BTC. DTSBD555 01245 PERFORM S1050-OPEN-TEMP-BTC-IN THRU S1050-EXIT DTSBD555 01246 IF W-FATAL-ERROR-YES-88 DTSBD555 01247 GO TO T1100-EXIT DTSBD555 01248 END-IF. DTSBD555 01249 PERFORM S927A-OPEN THRU S927A-EXIT. DTSBD555 01250 DTSBD555 01251 PERFORM S1070-READ-TEMP-BTC THRU S1070-EXIT. DTSBD555 01252 DTSBD555 01253 PERFORM DTSBD555 01254 UNTIL TEMP-BTC-STATUS-EOF-88 DTSBD555 01255 OR W-FATAL-ERROR-YES-88 DTSBD555 01256 PERFORM S927B-WRITE THRU S927B-EXIT DTSBD555 01257 ADD +1 TO W-T028-WRITE-CNT DTSBD555 01258 PERFORM S1070-READ-TEMP-BTC THRU S1070-EXIT DTSBD555 01259 END-PERFORM. DTSBD555 01260 DTSBD555 01261 PERFORM S1060-CLOSE-TEMP-BTC THRU S1060-EXIT. DTSBD555 01262 PERFORM S927C-CLOSE THRU S927C-EXIT. DTSBD555 01263 DTSBD555 01264 T1100-EXIT. DTSBD555 01265 EXIT. DTSBD555 01266 DTSBD555 01267 T2000-WRITE-WAGES. DTSBD555 01268 PERFORM S1110-CLOSE-WAGE-TEMP THRU S1110-EXIT. DTSBD555 01269 IF W-FATAL-ERROR-NO-88 DTSBD555 01270 PERFORM T2100-COPY THRU T2100-EXIT DTSBD555 01271 ELSE DTSBD555 01272 DISPLAY 'T2000 FATAL ERR ON CLOSE' DTSBD555 01273 GO TO T2000-EXIT DTSBD555 01274 END-IF. DTSBD555 01275 DTSBD555 01276 T2000-EXIT. DTSBD555 01277 EXIT. DTSBD555 01278 DTSBD555 01279 T2100-COPY. DTSBD555 01280 PERFORM S1130-OPEN-WAGE-TEMP-IN THRU S1130-EXIT DTSBD555 01281 IF W-FATAL-ERROR-YES-88 DTSBD555 01282 GO TO T2100-EXIT DTSBD555 01283 END-IF. DTSBD555 01284 DTSBD555 01285 PERFORM S1150-OPEN-WAGE-FILE-OUT THRU S1150-EXIT. DTSBD555 01286 IF W-FATAL-ERROR-YES-88 DTSBD555 01287 GO TO T2100-EXIT DTSBD555 01288 END-IF. DTSBD555 01289 DTSBD555 01290 PERFORM S1140-READ-WAGE-TEMP THRU S1140-EXIT. DTSBD555 01291 DTSBD555 01292 PERFORM DTSBD555 01293 UNTIL WAGE-TEMP-STATUS-EOF-88 DTSBD555 01294 OR W-FATAL-ERROR-YES-88 DTSBD555 01295 PERFORM S1170-WRITE-WAGE-OUT THRU S1170-EXIT DTSBD555 01296 PERFORM S1140-READ-WAGE-TEMP THRU S1140-EXIT DTSBD555 01297 END-PERFORM. DTSBD555 01298 DTSBD555 01299 PERFORM S1110-CLOSE-WAGE-TEMP THRU S1110-EXIT. DTSBD555 01300 PERFORM S1160-CLOSE-WAGE-OUT THRU S1160-EXIT. DTSBD555 01301 DTSBD555 01302 T2100-EXIT. DTSBD555 01303 EXIT. DTSBD555 01304 DTSBD555 01305 DTSBD555 01306 T3000-UPDATE-CURR-BATCH. DTSBD555 01307 MOVE W-PSEUDO-BATCH-NO TO CURRENT-BATCH-NO DTSBD555 01308 W-END-BATCH. DTSBD555 01309 MOVE W-PSEUDO-ITEM-NO TO CURRENT-ITEM-NO. DTSBD555 01310 REWRITE CURR-BATCH-NO-REC. DTSBD555 01311 IF BATCH-STATUS-OK-88 DTSBD555 01312 NEXT SENTENCE DTSBD555 01313 ELSE DTSBD555 01314 DISPLAY 'T3000 - CANNOT REWRITE BATCH NUMBER FILE ' DTSBD555 01315 BATCH-STATUS DTSBD555 01316 END-IF. DTSBD555 01317 DTSBD555 01318 T3000-EXIT. DTSBD555 01319 EXIT. DTSBD555 01320 DTSBD555 01321 S001-FROM-FED-8. DTSBD555 01322 SET L001-FROM-FED-8 TO TRUE. DTSBD555 01323 GO TO S001-DATE. DTSBD555 01324 DTSBD555 01325 S001-FROM-CAL-8. DTSBD555 01326 SET L001-FROM-CAL-8 TO TRUE. DTSBD555 01327 GO TO S001-DATE. DTSBD555 01328 DTSBD555 01329 S001-FROM-ABS-DAY. DTSBD555 01330 SET L001-FROM-ABS-DAY TO TRUE. DTSBD555 01331 GO TO S001-DATE. DTSBD555 01332 DTSBD555 01333 S001-DATE. DTSBD555 01334 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBD555 01335 S001-EXIT. DTSBD555 01336 EXIT. DTSBD555 01337 DTSBD555 01338 S003-AGENCY-DAY. DTSBD555 01339 SET L003-AGENCY-DAY TO TRUE. DTSBD555 01340 GO TO S003-WORK-DAY. DTSBD555 01341 DTSBD555 01342 S003-WORK-DAY. DTSBD555 01343 CALL 'DTSBU003' USING L003-LINK-AREA. DTSBD555 01344 S003-EXIT. DTSBD555 01345 EXIT. DTSBD555 01346 DTSBD555 01347 S004-FROM-5. DTSBD555 01348 SET L004-FROM-5 TO TRUE. DTSBD555 01349 GO TO S004-YRQ. DTSBD555 01350 DTSBD555 01351 S004-FROM-DATE. DTSBD555 01352 SET L004-FROM-DATE TO TRUE. DTSBD555 01353 GO TO S004-YRQ. DTSBD555 01354 DTSBD555 01355 S004-FROM-ABS. DTSBD555 01356 SET L004-FROM-ABS TO TRUE. DTSBD555 01357 GO TO S004-YRQ. DTSBD555 01358 DTSBD555 01359 S004-YRQ. DTSBD555 01360 CALL 'DTSBU004' USING L004-LINK-AREA. DTSBD555 01361 DTSBD555 01362 S004-EXIT. DTSBD555 01363 EXIT. DTSBD555 01364 DTSBD555 01365 S005-FROM-SYS. DTSBD555 01366 SET L005-FROM-SYS TO TRUE. DTSBD555 01367 GO TO S005-ABSTIME. DTSBD555 01368 DTSBD555 01369 S005-ABSTIME. DTSBD555 01370 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBD555 01371 S005-EXIT. DTSBD555 01372 EXIT. DTSBD555 01373 DTSBD555 01374 S032-RPT-TYPE. DTSBD555 01375 SET L032-MRPT-RPT-TYPE TO TRUE. DTSBD555 01376 CALL 'DTSBU032' USING L032-LINK-AREA. DTSBD555 01377 DTSBD555 01378 S032-EXIT. DTSBD555 01379 EXIT. DTSBD555 01380 DTSBD555 01381 S516-LIABILITY-INFO. DTSBD555 01382 CALL 'DTSBU516' USING L516-LINK-AREA DTSBD555 01383 MPRF-REC. DTSBD555 01384 S516-EXIT. DTSBD555 01385 EXIT. DTSBD555 01386 DTSBD555 01387 S910-OPEN-READ. DTSBD555 01388 SET L910-OPEN-READ-88 TO TRUE. DTSBD555 01389 GO TO S910-MSTR-IO. DTSBD555 01390 DTSBD555 01391 S910-READ. DTSBD555 01392 SET L910-READ-88 TO TRUE. DTSBD555 01393 GO TO S910-MSTR-IO. DTSBD555 01394 DTSBD555 01395 S910-START-BROWSE. DTSBD555 01396 SET L910-START-BROWSE-88 TO TRUE. DTSBD555 01397 GO TO S910-MSTR-IO. DTSBD555 01398 DTSBD555 01399 S910-READ-NEXT. DTSBD555 01400 SET L910-READ-NEXT-88 TO TRUE. DTSBD555 01401 GO TO S910-MSTR-IO. DTSBD555 01402 DTSBD555 01403 S910-CLOSE. DTSBD555 01404 SET L910-CLOSE-88 TO TRUE. DTSBD555 01405 GO TO S910-MSTR-IO. DTSBD555 01406 DTSBD555 01407 S910-MSTR-IO. DTSBD555 01408 CALL 'DTSBU910' USING L910-LINK-AREA DTSBD555 01409 MSKL-REC. DTSBD555 01410 S910-EXIT. DTSBD555 01411 EXIT. DTSBD555 01412 DTSBD555 01413 S921-OPEN-READ. DTSBD555 01414 SET L921-OPEN-READ-88 TO TRUE. DTSBD555 01415 GO TO S921-AIX-IO. DTSBD555 01416 DTSBD555 01417 S921-READ. DTSBD555 01418 SET L921-READ-88 TO TRUE. DTSBD555 01419 GO TO S921-AIX-IO. DTSBD555 01420 DTSBD555 01421 S921-START-BROWSE. DTSBD555 01422 SET L921-START-BROWSE-88 TO TRUE. DTSBD555 01423 GO TO S921-AIX-IO. DTSBD555 01424 DTSBD555 01425 S921-READ-NEXT. DTSBD555 01426 SET L921-READ-NEXT-88 TO TRUE. DTSBD555 01427 GO TO S921-AIX-IO. DTSBD555 01428 DTSBD555 01429 S921-CLOSE. DTSBD555 01430 SET L921-CLOSE-88 TO TRUE. DTSBD555 01431 GO TO S921-AIX-IO. DTSBD555 01432 DTSBD555 01433 S921-AIX-IO. DTSBD555 01434 CALL 'DTSBU921' USING L921-LINK-AREA DTSBD555 01435 ISKL-REC. DTSBD555 01436 S921-EXIT. DTSBD555 01437 EXIT. DTSBD555 01438 DTSBD555 01439 S923-OPEN-UPDATE. DTSBD555 01440 SET L923-OPEN-UPDATE-88 TO TRUE. DTSBD555 01441 GO TO S923-ATC-CALL. DTSBD555 01442 DTSBD555 01443 S923-WRITE. DTSBD555 01444 SET L923-WRITE-88 TO TRUE. DTSBD555 01445 GO TO S923-ATC-CALL. DTSBD555 01446 DTSBD555 01447 S923-CLOSE. DTSBD555 01448 SET L923-CLOSE-88 TO TRUE. DTSBD555 01449 GO TO S923-ATC-CALL. DTSBD555 01450 DTSBD555 01451 S923-ATC-CALL. DTSBD555 01452 CALL 'DTSBU923' USING L923-LINK-AREA DTSBD555 01453 ASKL-REC. DTSBD555 01454 S923-EXIT. DTSBD555 01455 EXIT. DTSBD555 01456 DTSBD555 01457 S927A-OPEN. DTSBD555 01458 SET L927-OPEN-UPDATE-88 TO TRUE. DTSBD555 01459 PERFORM S927Z-IO THRU S927Z-EXIT. DTSBD555 01460 DTSBD555 01461 S927A-EXIT. DTSBD555 01462 EXIT. DTSBD555 01463 DTSBD555 01464 S927B-WRITE. DTSBD555 01465 SET L927-WRITE-88 TO TRUE. DTSBD555 01466 PERFORM S927Z-IO THRU S927Z-EXIT. DTSBD555 01467 DTSBD555 01468 S927B-EXIT. DTSBD555 01469 EXIT. DTSBD555 01470 DTSBD555 01471 S927C-CLOSE. DTSBD555 01472 SET L927-CLOSE-88 TO TRUE. DTSBD555 01473 PERFORM S927Z-IO THRU S927Z-EXIT. DTSBD555 01474 DTSBD555 01475 S927C-EXIT. DTSBD555 01476 EXIT. DTSBD555 01477 DTSBD555 01478 S927Z-IO. DTSBD555 01479 CALL 'DTSBU927' USING L927-LINK-AREA DTSBD555 01480 TSKL-REC. DTSBD555 01481 S927Z-EXIT. DTSBD555 01482 EXIT. DTSBD555 01483 DTSBD555 01484 S931-OPEN-READ. DTSBD555 01485 SET L931-OPEN-READ-88 TO TRUE. DTSBD555 01486 GO TO S931-REF-IO. DTSBD555 01487 DTSBD555 01488 S931-CLOSE. DTSBD555 01489 SET L931-CLOSE-88 TO TRUE. DTSBD555 01490 GO TO S931-REF-IO. DTSBD555 01491 DTSBD555 01492 S931-REF-IO. DTSBD555 01493 CALL 'DTSBU931' USING L931-LINK-AREA DTSBD555 01494 FSKL-REC. DTSBD555 01495 S931-EXIT. DTSBD555 01496 EXIT. DTSBD555 01497 DTSBD555 01498 S1000-OPEN-REPORT-IN. DTSBD555 01499 OPEN INPUT REPORT-FILE-IN. DTSBD555 01500 IF RPT-IN-OK-88 DTSBD555 01501 NEXT SENTENCE DTSBD555 01502 ELSE DTSBD555 01503 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBD555 01504 DISPLAY 'CANNOT OPEN REPORT FILE IN: ' DTSBD555 01505 RPT-IN-STATUS DTSBD555 01506 END-IF. DTSBD555 01507 DTSBD555 01508 S1000-EXIT. DTSBD555 01509 EXIT. DTSBD555 01510 DTSBD555 01511 S1005-READ-REPORT-IN. DTSBD555 01512 READ REPORT-FILE-IN. DTSBD555 01513 IF RPT-IN-OK-88 DTSBD555 01514 ADD +1 TO W-RPT-IN-CNT DTSBD555 01515 ELSE DTSBD555 01516 IF RPT-IN-EOF-88 DTSBD555 01517 NEXT SENTENCE DTSBD555 01518 ELSE DTSBD555 01519 DISPLAY 'CANNOT READ REPORT FILE ' DTSBD555 01520 RPT-IN-STATUS DTSBD555 01521 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBD555 01522 END-IF DTSBD555 01523 END-IF. DTSBD555 01524 DTSBD555 01525 S1005-EXIT. DTSBD555 01526 EXIT. DTSBD555 01527 DTSBD555 01528 S1010-CLOSE-REPORT-IN. DTSBD555 01529 CLOSE REPORT-FILE-IN. DTSBD555 01530 DTSBD555 01531 S1010-EXIT. DTSBD555 01532 EXIT. DTSBD555 01533 DTSBD555 01534 S1020-OPEN-WAGE-IN. DTSBD555 01535 OPEN INPUT WAGE-FILE-IN. DTSBD555 01536 IF WAGE-IN-OK-88 DTSBD555 01537 NEXT SENTENCE DTSBD555 01538 ELSE DTSBD555 01539 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBD555 01540 DISPLAY 'CANNOT OPEN WAGE FILE IN: ' DTSBD555 01541 WAGE-IN-STATUS DTSBD555 01542 END-IF. DTSBD555 01543 DTSBD555 01544 S1020-EXIT. DTSBD555 01545 EXIT. DTSBD555 01546 DTSBD555 01547 S1025-READ-WAGE-IN. DTSBD555 01548 READ WAGE-FILE-IN. DTSBD555 01549 IF WAGE-IN-OK-88 DTSBD555 01550 ADD +1 TO W-WAGE-IN-CNT DTSBD555 01551 ELSE DTSBD555 01552 IF WAGE-IN-EOF-88 DTSBD555 01553 SET W-WAGE-COMPLETE-YES-88 TO TRUE DTSBD555 01554 ELSE DTSBD555 01555 DISPLAY 'CANNOT READ WAGE FILE ' DTSBD555 01556 WAGE-IN-STATUS DTSBD555 01557 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBD555 01558 END-IF DTSBD555 01559 END-IF. DTSBD555 01560 DTSBD555 01561 S1025-EXIT. DTSBD555 01562 EXIT. DTSBD555 01563 DTSBD555 01564 S1030-CLOSE-WAGE-IN. DTSBD555 01565 CLOSE WAGE-FILE-IN. DTSBD555 01566 DTSBD555 01567 S1030-EXIT. DTSBD555 01568 EXIT. DTSBD555 01569 DTSBD555 01570 S1032-WRITE-TEMP-T028. DTSBD555 01571 MOVE T028-LENGTH TO VAR-CHAR-CNT. DTSBD555 01572 MOVE T028-REC TO TEMP-BTC-REC. DTSBD555 01573 WRITE TEMP-BTC-REC. DTSBD555 01574 IF TEMP-BTC-STATUS-OK-88 DTSBD555 01575 ADD +1 TO W-TEMP-T028-CNT DTSBD555 01576 ELSE DTSBD555 01577 SET W-ERROR-YES-88 TO TRUE DTSBD555 01578 DISPLAY 'CANNOT WRITE TEMP T028: ' DTSBD555 01579 TEMP-BTC-STATUS DTSBD555 01580 END-IF. DTSBD555 01581 DTSBD555 01582 S1032-EXIT. DTSBD555 01583 EXIT. DTSBD555 01584 DTSBD555 01585 S1040-OPEN-TEMP-BTC-OUT. DTSBD555 01586 OPEN OUTPUT TEMP-BTC-FILE. DTSBD555 01587 IF TEMP-BTC-STATUS-OK-88 DTSBD555 01588 NEXT SENTENCE DTSBD555 01589 ELSE DTSBD555 01590 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBD555 01591 DISPLAY 'CANNOT OPEN TEMP BTC FILE OUTPUT: ' DTSBD555 01592 TEMP-BTC-STATUS DTSBD555 01593 END-IF. DTSBD555 01594 DTSBD555 01595 S1040-EXIT. DTSBD555 01596 EXIT. DTSBD555 01597 DTSBD555 01598 S1050-OPEN-TEMP-BTC-IN. DTSBD555 01599 OPEN INPUT TEMP-BTC-FILE. DTSBD555 01600 IF TEMP-BTC-STATUS-OK-88 DTSBD555 01601 NEXT SENTENCE DTSBD555 01602 ELSE DTSBD555 01603 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBD555 01604 DISPLAY 'CANNOT OPEN TEMP BTC FILE INPUT: ' DTSBD555 01605 TEMP-BTC-STATUS DTSBD555 01606 END-IF. DTSBD555 01607 DTSBD555 01608 S1050-EXIT. DTSBD555 01609 EXIT. DTSBD555 01610 DTSBD555 01611 S1060-CLOSE-TEMP-BTC. DTSBD555 01612 CLOSE TEMP-BTC-FILE. DTSBD555 01613 IF TEMP-BTC-STATUS-OK-88 DTSBD555 01614 NEXT SENTENCE DTSBD555 01615 ELSE DTSBD555 01616 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBD555 01617 DISPLAY 'CANNOT CLOSE TEMP BTC FILE: ' DTSBD555 01618 TEMP-BTC-STATUS DTSBD555 01619 END-IF. DTSBD555 01620 DTSBD555 01621 S1060-EXIT. DTSBD555 01622 EXIT. DTSBD555 01623 DTSBD555 01624 S1070-READ-TEMP-BTC. DTSBD555 01625 READ TEMP-BTC-FILE. DTSBD555 01626 IF TEMP-BTC-STATUS-OK-88 DTSBD555 01627 COMPUTE VAR-CHAR-CNT = (RVAR-LENGTH - 2) DTSBD555 01628 ELSE DTSBD555 01629 IF TEMP-BTC-STATUS-EOF-88 DTSBD555 01630 NEXT SENTENCE DTSBD555 01631 ELSE DTSBD555 01632 DISPLAY 'CANNOT READ TEMP-BTC FILE ' DTSBD555 01633 TEMP-BTC-STATUS DTSBD555 01634 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBD555 01635 END-IF DTSBD555 01636 END-IF. DTSBD555 01637 DTSBD555 01638 S1070-EXIT. DTSBD555 01639 EXIT. DTSBD555 01640 DTSBD555 01641 S1100-OPEN-WAGE-TEMP-OUT. DTSBD555 01642 OPEN OUTPUT WAGE-FILE-TEMP. DTSBD555 01643 IF NOT WAGE-TEMP-STATUS-OK-88 DTSBD555 01644 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBD555 01645 DISPLAY 'CANNOT OPEN WAGE TEMP FILE OUTPUT: ' DTSBD555 01646 WAGE-TEMP-STATUS DTSBD555 01647 END-IF. DTSBD555 01648 DTSBD555 01649 S1100-EXIT. DTSBD555 01650 EXIT. DTSBD555 01651 DTSBD555 01652 S1110-CLOSE-WAGE-TEMP. DTSBD555 01653 CLOSE WAGE-FILE-TEMP. DTSBD555 01654 IF NOT WAGE-TEMP-STATUS-OK-88 DTSBD555 01655 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBD555 01656 DISPLAY 'CANNOT CLOSE WAGE TEMP FILE: ' DTSBD555 01657 WAGE-TEMP-STATUS DTSBD555 01658 END-IF. DTSBD555 01659 DTSBD555 01660 S1110-EXIT. DTSBD555 01661 EXIT. DTSBD555 01662 DTSBD555 01663 S1120-WRITE-WAGE-TEMP. DTSBD555 01664 WRITE WAGE-TEMP-REC FROM W001-REC. DTSBD555 01665 IF NOT WAGE-TEMP-STATUS-OK-88 DTSBD555 01666 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBD555 01667 DISPLAY 'CANNOT WRITE WAGE TEMP FILE: ' DTSBD555 01668 WAGE-TEMP-STATUS DTSBD555 01669 ELSE DTSBD555 01670 ADD +1 TO W-TEMP-WAGE-CNT DTSBD555 01671 END-IF. DTSBD555 01672 DTSBD555 01673 S1120-EXIT. DTSBD555 01674 EXIT. DTSBD555 01675 DTSBD555 01676 S1130-OPEN-WAGE-TEMP-IN. DTSBD555 01677 OPEN INPUT WAGE-FILE-TEMP. DTSBD555 01678 IF NOT WAGE-TEMP-STATUS-OK-88 DTSBD555 01679 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBD555 01680 DISPLAY 'CANNOT OPEN WAGE TEMP FILE INPUT: ' DTSBD555 01681 WAGE-TEMP-STATUS DTSBD555 01682 END-IF. DTSBD555 01683 DTSBD555 01684 S1130-EXIT. DTSBD555 01685 EXIT. DTSBD555 01686 DTSBD555 01687 S1140-READ-WAGE-TEMP. DTSBD555 01688 READ WAGE-FILE-TEMP INTO W001-REC. DTSBD555 01689 IF WAGE-TEMP-STATUS-EOF-88 DTSBD555 01690 NEXT SENTENCE DTSBD555 01691 ELSE DTSBD555 01692 IF NOT WAGE-TEMP-STATUS-OK-88 DTSBD555 01693 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBD555 01694 DISPLAY 'READ ERROR ON WAGE TEMP FILE: ' DTSBD555 01695 WAGE-TEMP-STATUS DTSBD555 01696 END-IF DTSBD555 01697 END-IF. DTSBD555 01698 DTSBD555 01699 S1140-EXIT. DTSBD555 01700 EXIT. DTSBD555 01701 DTSBD555 01702 S1150-OPEN-WAGE-FILE-OUT. DTSBD555 01703 OPEN OUTPUT WAGE-FILE-OUT. DTSBD555 01704 IF NOT WAGE-OUT-STATUS-OK-88 DTSBD555 01705 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBD555 01706 DISPLAY 'CANNOT OPEN WAGE FILE OUTPUT: ' DTSBD555 01707 WAGE-OUT-STATUS DTSBD555 01708 END-IF. DTSBD555 01709 DTSBD555 01710 S1150-EXIT. DTSBD555 01711 EXIT. DTSBD555 01712 DTSBD555 01713 S1160-CLOSE-WAGE-OUT. DTSBD555 01714 CLOSE WAGE-FILE-OUT. DTSBD555 01715 IF NOT WAGE-OUT-STATUS-OK-88 DTSBD555 01716 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBD555 01717 DISPLAY 'CANNOT CLOSE WAGE FILE: ' DTSBD555 01718 WAGE-OUT-STATUS DTSBD555 01719 END-IF. DTSBD555 01720 DTSBD555 01721 S1160-EXIT. DTSBD555 01722 EXIT. DTSBD555 01723 DTSBD555 01724 S1170-WRITE-WAGE-OUT. DTSBD555 01725 WRITE WAGE-OUT-REC FROM WAGE-TEMP-REC. DTSBD555 01726 IF NOT WAGE-OUT-STATUS-OK-88 DTSBD555 01727 SET W-FATAL-ERROR-YES-88 TO TRUE DTSBD555 01728 DISPLAY 'CANNOT WRITE WAGE OUT FILE: ' DTSBD555 01729 WAGE-OUT-STATUS DTSBD555 01730 ELSE DTSBD555 01731 ADD +1 TO W-WAGE-OUT-CNT DTSBD555 01732 END-IF. DTSBD555 01733 DTSBD555 01734 S1170-EXIT. DTSBD555 01735 EXIT. DTSBD555 01736 DTSBD555 01737 S946-WRITE-R140. DTSBD555 01738 CALL 'DTSBU946' USING R140-REC. DTSBD555 01739 DTSBD555 01740 S946-EXIT. DTSBD555 01741 EXIT. DTSBD555 01742 DTSBD555 01743 S999-ABEND. DTSBD555 01744 CALL 'DTSBU999' USING W-ABEND-CD. DTSBD555 01745 S999-EXIT. DTSBD555 01746 EXIT. DTSBD555 01747 DTSBD555