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