1625 lines
128 KiB
COBOL
1625 lines
128 KiB
COBOL
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
|