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