471 lines
37 KiB
COBOL
471 lines
37 KiB
COBOL
00001 IDENTIFICATION DIVISION. 08/17/06
|
|
00002 PROGRAM-ID. DTSBX450. DTSBX450
|
|
00003 AUTHOR. NCG. LV003
|
|
00004 DATE-WRITTEN. JANUARY 2005. DTSBX450
|
|
00005 DATE-COMPILED. DTSBX450
|
|
00006 SKIP3 DTSBX450
|
|
00007 ***** DTSBX450
|
|
00008 * DTSBX450
|
|
00009 * FUNCTION: MAINTAIN NEW HIRE DATABASE, STEP 1: DTSBX450
|
|
00010 * EXTRACT DATA FROM NEW HIRE WEEKLY FILE DTSBX450
|
|
00011 * AND BUILD TRANSACTION, WORKER AND EMPLOYER DTSBX450
|
|
00012 * FILES. DTSBX450
|
|
00013 * DTSBX450
|
|
00014 ***** DTSBX450
|
|
00015 SKIP3 DTSBX450
|
|
00016 ENVIRONMENT DIVISION. DTSBX450
|
|
00017 CONFIGURATION SECTION. DTSBX450
|
|
00018 INPUT-OUTPUT SECTION. DTSBX450
|
|
00019 FILE-CONTROL. DTSBX450
|
|
00020 DTSBX450
|
|
00021 SELECT NEW-HIRE-FILE ASSIGN TO NEWHIREI DTSBX450
|
|
00022 FILE STATUS IS NH-STATUS. DTSBX450
|
|
00023 SELECT NH-TRAN-FILE ASSIGN TO TRANFLEO DTSBX450
|
|
00024 FILE STATUS IS TRAN-STATUS. DTSBX450
|
|
00025 SELECT NH-WORKER-FILE ASSIGN TO WORKFLEO DTSBX450
|
|
00026 FILE STATUS IS WORKER-STATUS. DTSBX450
|
|
00027 SELECT NH-EMPLER-FILE ASSIGN TO EMPLFLEO DTSBX450
|
|
00028 FILE STATUS IS EMPLER-STATUS. DTSBX450
|
|
00029 DTSBX450
|
|
00030 DATA DIVISION. DTSBX450
|
|
00031 DTSBX450
|
|
00032 FILE SECTION. DTSBX450
|
|
00033 DTSBX450
|
|
00034 FD NEW-HIRE-FILE DTSBX450
|
|
00035 RECORDING MODE IS F DTSBX450
|
|
00036 LABEL RECORDS ARE STANDARD DTSBX450
|
|
00037 RECORD CONTAINS 801 CHARACTERS DTSBX450
|
|
00038 BLOCK CONTAINS 0 RECORDS. DTSBX450
|
|
00039 01 NEW-HIRE-RECORD PIC X(801). DTSBX450
|
|
00040 DTSBX450
|
|
00041 FD NH-TRAN-FILE DTSBX450
|
|
00042 RECORDING MODE IS F DTSBX450
|
|
00043 BLOCK CONTAINS 0 RECORDS DTSBX450
|
|
00044 LABEL RECORDS ARE OMITTED. DTSBX450
|
|
00045 DTSBX450
|
|
00046 01 NH-TRAN-REC PIC X(41). DTSBX450
|
|
00047 DTSBX450
|
|
00048 FD NH-WORKER-FILE DTSBX450
|
|
00049 RECORDING MODE IS F DTSBX450
|
|
00050 BLOCK CONTAINS 0 RECORDS DTSBX450
|
|
00051 LABEL RECORDS ARE OMITTED. DTSBX450
|
|
00052 DTSBX450
|
|
00053 01 NH-WORKER-REC PIC X(136). DTSBX450
|
|
00054 DTSBX450
|
|
00055 FD NH-EMPLER-FILE DTSBX450
|
|
00056 RECORDING MODE IS F DTSBX450
|
|
00057 BLOCK CONTAINS 0 RECORDS DTSBX450
|
|
00058 LABEL RECORDS ARE OMITTED. DTSBX450
|
|
00059 DTSBX450
|
|
00060 01 NH-EMPLER-REC PIC X(135). DTSBX450
|
|
00061 DTSBX450
|
|
00062 WORKING-STORAGE SECTION. DTSBX450
|
|
000625 77 PAN-VALET PICTURE X(24) VALUE '003DTSBX450 08/17/06'. DTSBX450
|
|
00063 DTSBX450
|
|
00064 01 WRK-AREA. DTSBX450
|
|
00065 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +450. DTSBX450
|
|
00066 DTSBX450
|
|
00067 05 WRK-MOD-NAME PIC X(08) VALUE 'DTSBX450'. DTSBX450
|
|
00068 DTSBX450
|
|
00069 05 WRK-CURRENT-DATE PIC S9(09) COMP-3 VALUE +0. DTSBX450
|
|
00070 05 WRK-CURR-DATE-DISP PIC X(10). DTSBX450
|
|
00071 05 WRK-HIRE-DATE-XOR PIC S9(09) COMP-3 VALUE +0. DTSBX450
|
|
00072 05 WRK-HIRE-DATE PIC S9(09) COMP-3 VALUE +0. DTSBX450
|
|
00073 05 WRK-HIRE-DATE-DISP PIC X(10). DTSBX450
|
|
00074 DTSBX450
|
|
00075 05 WRK-NH-REC-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX450
|
|
00076 05 WRK-W4-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX450
|
|
00077 05 WRK-NOT-W4-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX450
|
|
00078 05 WRK-NO-DOH-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX450
|
|
00079 05 WRK-TRAN-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX450
|
|
00080 05 WRK-WORKER-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX450
|
|
00081 05 WRK-EMPLER-CNT PIC S9(07) COMP-3 VALUE +0. DTSBX450
|
|
00082 DTSBX450
|
|
00083 05 NH-STATUS PIC X(02). DTSBX450
|
|
00084 88 NH-STATUS-OK-88 VALUE '00'. DTSBX450
|
|
00085 88 NH-STATUS-EOF-88 VALUE '10'. DTSBX450
|
|
00086 DTSBX450
|
|
00087 05 TRAN-STATUS PIC X(02). DTSBX450
|
|
00088 88 TRAN-STATUS-OK-88 VALUE '00'. DTSBX450
|
|
00089 DTSBX450
|
|
00090 05 WORKER-STATUS PIC X(02). DTSBX450
|
|
00091 88 WORKER-STATUS-OK-88 VALUE '00'. DTSBX450
|
|
00092 DTSBX450
|
|
00093 05 EMPLER-STATUS PIC X(02). DTSBX450
|
|
00094 88 EMPLER-STATUS-OK-88 VALUE '00'. DTSBX450
|
|
00095 DTSBX450
|
|
00096 05 WRK-ERROR-IND PIC X(01). DTSBX450
|
|
00097 88 WRK-ERROR-YES-88 VALUE 'Y'. DTSBX450
|
|
00098 88 WRK-ERROR-NO-88 VALUE 'N'. DTSBX450
|
|
00099 DTSBX450
|
|
00100 05 DATE-HIRED. DTSBX450
|
|
00101 10 DATE-HIRED-CCYY PIC 9(04). DTSBX450
|
|
00102 10 DATE-HIRED-MM PIC 9(02). DTSBX450
|
|
00103 10 DATE-HIRED-DD PIC 9(02). DTSBX450
|
|
00104 05 DATE-HIRED-RE REDEFINES DATE-HIRED PIC 9(08). DTSBX450
|
|
00105 DTSBX450
|
|
00106 05 WS-WORKER-NAME. DTSBX450
|
|
00107 10 WS-WORKER-LAST-NAME PIC X(20). DTSBX450
|
|
00108 10 WS-WORKER-FIRST-NAME PIC X(15). DTSBX450
|
|
00109 10 WS-WORKER-MID-INIT PIC X(01). DTSBX450
|
|
00110 DTSBX450
|
|
00111 05 WS-WORKER-ZIP. DTSBX450
|
|
00112 10 WS-WORKER-ZIP5 PIC X(05). DTSBX450
|
|
00113 10 WS-WORKER-ZIP4 PIC X(04). DTSBX450
|
|
00114 DTSBX450
|
|
00115 05 WS-EMPL-ZIP. DTSBX450
|
|
00116 10 WS-EMPL-ZIP5 PIC X(05). DTSBX450
|
|
00117 10 WS-EMPL-ZIP4 PIC X(04). DTSBX450
|
|
00118 DTSBX450
|
|
00119 05 SUB PIC S9(04) COMP. DTSBX450
|
|
00120 DTSBX450
|
|
00121 01 WRK-TRAN-REC. DTSBX450
|
|
00122 05 TRAN-SSN PIC X(09). DTSBX450
|
|
00123 05 FILLER PIC X(01) VALUE ','. DTSBX450
|
|
00124 05 TRAN-HIRE-DATE PIC X(10). DTSBX450
|
|
00125 05 FILLER PIC X(01) VALUE ','. DTSBX450
|
|
00126 05 TRAN-FEIN PIC X(09). DTSBX450
|
|
00127 05 FILLER PIC X(01) VALUE ','. DTSBX450
|
|
00128 05 TRAN-ENTER-DATE PIC X(10). DTSBX450
|
|
00129 DTSBX450
|
|
00130 01 WRK-WORKER-REC. DTSBX450
|
|
00131 05 WORKER-SSN PIC X(09). DTSBX450
|
|
00132 05 WORKER-HIRE-DATE-XOR PIC S9(09) COMP-3. DTSBX450
|
|
00133 05 WORKER-DOB PIC X(10). DTSBX450
|
|
00134 05 WORKER-NAME. DTSBX450
|
|
00135 10 WORKER-LAST-NAME PIC X(20). DTSBX450
|
|
00136 10 WORKER-FIRST-NAME PIC X(15). DTSBX450
|
|
00137 10 WORKER-MID-INIT PIC X(01). DTSBX450
|
|
00138 05 WORKER-ADDRESS. DTSBX450
|
|
00139 10 WORKER-ADDR-1 PIC X(40). DTSBX450
|
|
00140 10 WORKER-CITY PIC X(25). DTSBX450
|
|
00141 10 WORKER-STATE PIC X(02). DTSBX450
|
|
00142 10 WORKER-ZIP PIC X(09). DTSBX450
|
|
00143 DTSBX450
|
|
00144 01 WRK-EMPLER-REC. DTSBX450
|
|
00145 05 EMPLER-FEIN PIC X(09). DTSBX450
|
|
00146 05 EMPLER-HIRE-DATE-XOR PIC S9(09) COMP-3. DTSBX450
|
|
00147 05 EMPLER-NAME PIC X(45). DTSBX450
|
|
00148 05 EMPLER-ADDRESS. DTSBX450
|
|
00149 10 EMPLER-ADDR-1 PIC X(40). DTSBX450
|
|
00150 10 EMPLER-CITY PIC X(25). DTSBX450
|
|
00151 10 EMPLER-STATE PIC X(02). DTSBX450
|
|
00152 10 EMPLER-ZIP PIC X(09). DTSBX450
|
|
00153 DTSBX450
|
|
00154 01 L001-LINK-AREA. DTSBX450
|
|
00155 ++INCLUDE DTSIL001 DTSBX450
|
|
00156 DTSBX450
|
|
00157 01 L005-LINK-AREA. DTSBX450
|
|
00158 ++INCLUDE DTSIL005 DTSBX450
|
|
00159 DTSBX450
|
|
00160 ++INCLUDE UINIRNWH DTSBX450
|
|
00161 DTSBX450
|
|
00162 PROCEDURE DIVISION. DTSBX450
|
|
00163 DTSBX450
|
|
00164 DTSBZ301-MAIN. DTSBX450
|
|
00165 DTSBX450
|
|
00166 PERFORM I0000-INITIATE THRU I0000-EXIT. DTSBX450
|
|
00167 DTSBX450
|
|
00168 PERFORM P0000-READ-NH-FILE THRU P0000-EXIT UNTIL DTSBX450
|
|
00169 NH-STATUS-EOF-88. DTSBX450
|
|
00170 DTSBX450
|
|
00171 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBX450
|
|
00172 DTSBX450
|
|
00173 DTSBZ301-MAIN-EXIT. DTSBX450
|
|
00174 GOBACK. DTSBX450
|
|
00175 DTSBX450
|
|
00176 I0000-INITIATE. DTSBX450
|
|
00177 PERFORM I1000-DATES THRU I1000-EXIT. DTSBX450
|
|
00178 DTSBX450
|
|
00179 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBX450
|
|
00180 DTSBX450
|
|
00181 I0000-EXIT. DTSBX450
|
|
00182 EXIT. DTSBX450
|
|
00183 DTSBX450
|
|
00184 I1000-DATES. DTSBX450
|
|
00185 SET L005-FROM-SYS TO TRUE. DTSBX450
|
|
00186 PERFORM S005-SYS-DATE THRU S005-EXIT. DTSBX450
|
|
00187 MOVE L005-DATE TO WRK-CURRENT-DATE DTSBX450
|
|
00188 L001-FED-8-DATE-9. DTSBX450
|
|
00189 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSBX450
|
|
00190 MOVE L001-SLASH-8-DATE TO WRK-CURR-DATE-DISP. DTSBX450
|
|
00191 DTSBX450
|
|
00192 I1000-EXIT. DTSBX450
|
|
00193 EXIT. DTSBX450
|
|
00194 DTSBX450
|
|
00195 I2000-OPEN-FILES. DTSBX450
|
|
00196 OPEN INPUT NEW-HIRE-FILE. DTSBX450
|
|
00197 IF NH-STATUS-OK-88 DTSBX450
|
|
00198 NEXT SENTENCE DTSBX450
|
|
00199 ELSE DTSBX450
|
|
00200 DISPLAY 'NEW HIRE INPUT FILE OPEN ERROR ' DTSBX450
|
|
00201 NH-STATUS DTSBX450
|
|
00202 PERFORM S999-ABEND THRU S999-EXIT DTSBX450
|
|
00203 END-IF. DTSBX450
|
|
00204 DTSBX450
|
|
00205 OPEN OUTPUT NH-TRAN-FILE. DTSBX450
|
|
00206 IF TRAN-STATUS-OK-88 DTSBX450
|
|
00207 NEXT SENTENCE DTSBX450
|
|
00208 ELSE DTSBX450
|
|
00209 DISPLAY 'NEW HIRE TRANS OUTPUT FILE OPEN ERROR ' DTSBX450
|
|
00210 TRAN-STATUS DTSBX450
|
|
00211 PERFORM S999-ABEND THRU S999-EXIT DTSBX450
|
|
00212 END-IF. DTSBX450
|
|
00213 DTSBX450
|
|
00214 OPEN OUTPUT NH-WORKER-FILE. DTSBX450
|
|
00215 IF WORKER-STATUS-OK-88 DTSBX450
|
|
00216 NEXT SENTENCE DTSBX450
|
|
00217 ELSE DTSBX450
|
|
00218 DISPLAY 'NEW HIRE WRKER OUTPUT FILE OPEN ERROR' DTSBX450
|
|
00219 PERFORM S999-ABEND THRU S999-EXIT. DTSBX450
|
|
00220 DTSBX450
|
|
00221 OPEN OUTPUT NH-EMPLER-FILE. DTSBX450
|
|
00222 IF EMPLER-STATUS-OK-88 DTSBX450
|
|
00223 NEXT SENTENCE DTSBX450
|
|
00224 ELSE DTSBX450
|
|
00225 DISPLAY 'NEW HIRE EMPLOYER OUTPUT FILE OPEN ERROR ' DTSBX450
|
|
00226 EMPLER-STATUS DTSBX450
|
|
00227 PERFORM S999-ABEND THRU S999-EXIT DTSBX450
|
|
00228 END-IF. DTSBX450
|
|
00229 DTSBX450
|
|
00230 I2000-EXIT. DTSBX450
|
|
00231 EXIT. DTSBX450
|
|
00232 DTSBX450
|
|
00233 P0000-READ-NH-FILE. DTSBX450
|
|
00234 DTSBX450
|
|
00235 READ NEW-HIRE-FILE INTO WS-NEWHIRE-RECORD. DTSBX450
|
|
00236 DTSBX450
|
|
00237 IF NH-STATUS-OK-88 DTSBX450
|
|
00238 ADD +1 TO WRK-NH-REC-CNT DTSBX450
|
|
00239 ELSE DTSBX450
|
|
00240 IF NH-STATUS-EOF-88 DTSBX450
|
|
00241 GO TO P0000-EXIT DTSBX450
|
|
00242 ELSE DTSBX450
|
|
00243 DISPLAY 'BAD NEW HIRE FILE READ ' NH-STATUS DTSBX450
|
|
00244 PERFORM S999-ABEND THRU S999-EXIT. DTSBX450
|
|
00245 DTSBX450
|
|
00246 IF NH-RECORD-ID NOT EQUAL 'W4' DTSBX450
|
|
00247 ADD +1 TO WRK-NOT-W4-CNT DTSBX450
|
|
00248 GO TO P0000-EXIT DTSBX450
|
|
00249 ELSE DTSBX450
|
|
00250 ADD +1 TO WRK-W4-CNT DTSBX450
|
|
00251 PERFORM P1000-WRITE-OUTPUT-FILES THRU P1000-EXIT DTSBX450
|
|
00252 END-IF. DTSBX450
|
|
00253 DTSBX450
|
|
00254 P0000-EXIT. DTSBX450
|
|
00255 EXIT. DTSBX450
|
|
00256 DTSBX450
|
|
00257 P1000-WRITE-OUTPUT-FILES. DTSBX450
|
|
00258 PERFORM P1100-EDIT THRU P1100-EXIT. DTSBX450
|
|
00259 IF WRK-ERROR-NO-88 DTSBX450
|
|
00260 PERFORM P1200-BUILD-TRAN THRU P1200-EXIT DTSBX450
|
|
00261 PERFORM P1300-BUILD-WORKER THRU P1300-EXIT DTSBX450
|
|
00262 PERFORM P1400-BUILD-EMPLOYER THRU P1400-EXIT DTSBX450
|
|
00263 END-IF. DTSBX450
|
|
00264 DTSBX450
|
|
00265 P1000-EXIT. DTSBX450
|
|
00266 EXIT. DTSBX450
|
|
00267 DTSBX450
|
|
00268 P1100-EDIT. DTSBX450
|
|
00269 SET WRK-ERROR-NO-88 TO TRUE. DTSBX450
|
|
00270 PERFORM P1110-HIRE-DATE THRU P1110-EXIT. DTSBX450
|
|
00271 PERFORM P1120-EMPLOYEE-DATA THRU P1120-EXIT. DTSBX450
|
|
00272 PERFORM P1130-EMPLOYER-DATA THRU P1130-EXIT. DTSBX450
|
|
00273 DTSBX450
|
|
00274 P1100-EXIT. DTSBX450
|
|
00275 EXIT. DTSBX450
|
|
00276 DTSBX450
|
|
00277 P1110-HIRE-DATE. DTSBX450
|
|
00278 MOVE NH-EMPLOYEE-DATE-OF-HIRE TO L001-FED-8-DATE-X DTSBX450
|
|
00279 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBX450
|
|
00280 IF L001-VALID-DATE DTSBX450
|
|
00281 MOVE L001-NINES-COMPLEMENT-DATE TO WRK-HIRE-DATE-XOR DTSBX450
|
|
00282 MOVE L001-FED-8-DATE-9 TO WRK-HIRE-DATE DTSBX450
|
|
00283 MOVE L001-SLASH-8-DATE TO WRK-HIRE-DATE-DISP DTSBX450
|
|
00284 ELSE DTSBX450
|
|
00285 SET WRK-ERROR-YES-88 TO TRUE DTSBX450
|
|
00286 END-IF. DTSBX450
|
|
00287 DTSBX450
|
|
00288 P1110-EXIT. DTSBX450
|
|
00289 EXIT. DTSBX450
|
|
00290 DTSBX450
|
|
00291 P1120-EMPLOYEE-DATA. DTSBX450
|
|
00292 PERFORM DTSBX450
|
|
00293 VARYING SUB FROM +1 BY +1 DTSBX450
|
|
00294 UNTIL SUB > +9 DTSBX450
|
|
00295 IF NH-EMPLOYEE-SSN (SUB:1) < '0' DTSBX450
|
|
00296 AND NH-EMPLOYEE-SSN (SUB:1) > '9' DTSBX450
|
|
00297 SET WRK-ERROR-YES-88 TO TRUE DTSBX450
|
|
00298 DISPLAY 'INVALID SSN ' NH-EMPLOYEE-SSN DTSBX450
|
|
00299 END-IF DTSBX450
|
|
00300 END-PERFORM. DTSBX450
|
|
00301 DTSBX450
|
|
00302 IF NH-EMPLOYEE-FIRST-NAME = SPACES OR LOW-VALUES DTSBX450
|
|
00303 OR NH-EMPLOYEE-LAST-NAME = SPACES OR LOW-VALUES DTSBX450
|
|
00304 OR NH-EMPLOYEE-ADDRESS = SPACES OR LOW-VALUES DTSBX450
|
|
00305 OR NH-EMPLOYEE-CITY = SPACES OR LOW-VALUES DTSBX450
|
|
00306 OR NH-EMPLOYEE-STATE = SPACES OR LOW-VALUES DTSBX450
|
|
00307 SET WRK-ERROR-YES-88 TO TRUE DTSBX450
|
|
00308 DISPLAY 'INVALID EMPLOYEE DATA ' DTSBX450
|
|
00309 DISPLAY ' NAME ' NH-EMPLOYEE-FIRST-NAME DTSBX450
|
|
00310 ' ' NH-EMPLOYEE-LAST-NAME DTSBX450
|
|
00311 DISPLAY ' ADDR ' NH-EMPLOYEE-ADDRESS DTSBX450
|
|
00312 DISPLAY ' ' NH-EMPLOYEE-CITY DTSBX450
|
|
00313 ' ' NH-EMPLOYEE-STATE DTSBX450
|
|
00314 END-IF. DTSBX450
|
|
00315 DTSBX450
|
|
00316 P1120-EXIT. DTSBX450
|
|
00317 EXIT. DTSBX450
|
|
00318 DTSBX450
|
|
00319 P1130-EMPLOYER-DATA. DTSBX450
|
|
00320 PERFORM DTSBX450
|
|
00321 VARYING SUB FROM +1 BY +1 DTSBX450
|
|
00322 UNTIL SUB > +9 DTSBX450
|
|
00323 IF NH-FEDERAL-EIN (SUB:1) < '0' DTSBX450
|
|
00324 AND NH-FEDERAL-EIN (SUB:1) > '9' DTSBX450
|
|
00325 SET WRK-ERROR-YES-88 TO TRUE DTSBX450
|
|
00326 DISPLAY 'INVALID FEIN ' NH-FEDERAL-EIN DTSBX450
|
|
00327 END-IF DTSBX450
|
|
00328 END-PERFORM. DTSBX450
|
|
00329 DTSBX450
|
|
00330 IF NH-EMPLOYER-NAME = SPACES OR LOW-VALUES DTSBX450
|
|
00331 OR NH-EMPLOYER-ADDRESS = SPACES OR LOW-VALUES DTSBX450
|
|
00332 OR NH-EMPLOYER-CITY = SPACES OR LOW-VALUES DTSBX450
|
|
00333 OR NH-EMPLOYER-STATE = SPACES OR LOW-VALUES DTSBX450
|
|
00334 SET WRK-ERROR-YES-88 TO TRUE DTSBX450
|
|
00335 DISPLAY 'INVALID EMPLOYER DATA ' DTSBX450
|
|
00336 DISPLAY ' NAME ' NH-EMPLOYER-NAME DTSBX450
|
|
00337 DISPLAY ' ADDR ' NH-EMPLOYER-ADDRESS DTSBX450
|
|
00338 DISPLAY ' ' NH-EMPLOYER-CITY DTSBX450
|
|
00339 ' ' NH-EMPLOYER-STATE DTSBX450
|
|
00340 END-IF. DTSBX450
|
|
00341 DTSBX450
|
|
00342 P1130-EXIT. DTSBX450
|
|
00343 EXIT. DTSBX450
|
|
00344 DTSBX450
|
|
00345 P1200-BUILD-TRAN. DTSBX450
|
|
00346 MOVE NH-EMPLOYEE-SSN TO TRAN-SSN. DTSBX450
|
|
00347 DTSBX450
|
|
00348 MOVE WRK-HIRE-DATE-DISP TO TRAN-HIRE-DATE. DTSBX450
|
|
00349 DTSBX450
|
|
00350 MOVE NH-FEDERAL-EIN TO TRAN-FEIN. DTSBX450
|
|
00351 DTSBX450
|
|
00352 MOVE WRK-CURR-DATE-DISP TO TRAN-ENTER-DATE. DTSBX450
|
|
00353 DTSBX450
|
|
00354 WRITE NH-TRAN-REC FROM WRK-TRAN-REC. DTSBX450
|
|
00355 ADD +1 TO WRK-TRAN-CNT. DTSBX450
|
|
00356 P1200-EXIT. DTSBX450
|
|
00357 EXIT. DTSBX450
|
|
00358 DTSBX450
|
|
00359 P1300-BUILD-WORKER. DTSBX450
|
|
00360 MOVE NH-EMPLOYEE-SSN TO WORKER-SSN. DTSBX450
|
|
00361 DTSBX450
|
|
00362 MOVE WRK-HIRE-DATE-XOR TO WORKER-HIRE-DATE-XOR. DTSBX450
|
|
00363 MOVE NH-EMPLOYEE-DATE-OF-BIRTH TO L001-FED-8-DATE-X. DTSBX450
|
|
00364 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSBX450
|
|
00365 IF L001-VALID-DATE DTSBX450
|
|
00366 MOVE L001-SLASH-8-DATE TO WORKER-DOB DTSBX450
|
|
00367 ELSE DTSBX450
|
|
00368 MOVE SPACES TO WORKER-DOB DTSBX450
|
|
00369 END-IF. DTSBX450
|
|
00370 DTSBX450
|
|
00371 MOVE NH-EMPLOYEE-LAST-NAME TO WORKER-LAST-NAME. DTSBX450
|
|
00372 MOVE NH-EMPLOYEE-FIRST-NAME TO WORKER-FIRST-NAME. DTSBX450
|
|
00373 MOVE NH-EMPLOYEE-MIDDLE-NAME TO WORKER-MID-INIT. DTSBX450
|
|
00374 INSPECT WORKER-NAME REPLACING ALL ',' BY SPACE. DTSBX450
|
|
00375 DTSBX450
|
|
00376 MOVE NH-EMPLOYEE-ADDRESS-1 TO WORKER-ADDR-1. DTSBX450
|
|
00377 MOVE NH-EMPLOYEE-CITY TO WORKER-CITY. DTSBX450
|
|
00378 MOVE NH-EMPLOYEE-STATE TO WORKER-STATE. DTSBX450
|
|
00379 DTSBX450
|
|
00380 MOVE NH-EMPLOYEE-ZIP-CODE-1 TO WS-WORKER-ZIP5. DTSBX450
|
|
00381 MOVE NH-EMPLOYEE-ZIP-CODE-2 TO WS-WORKER-ZIP4. DTSBX450
|
|
00382 MOVE WS-WORKER-ZIP TO WORKER-ZIP. DTSBX450
|
|
00383 INSPECT WORKER-ADDRESS REPLACING ALL ',' BY SPACE. DTSBX450
|
|
00384 DTSBX450
|
|
00385 WRITE NH-WORKER-REC FROM WRK-WORKER-REC. DTSBX450
|
|
00386 ADD +1 TO WRK-WORKER-CNT. DTSBX450
|
|
00387 DTSBX450
|
|
00388 P1300-EXIT. DTSBX450
|
|
00389 EXIT. DTSBX450
|
|
00390 DTSBX450
|
|
00391 P1400-BUILD-EMPLOYER. DTSBX450
|
|
00392 MOVE NH-FEDERAL-EIN TO EMPLER-FEIN. DTSBX450
|
|
00393 MOVE WRK-HIRE-DATE-XOR TO EMPLER-HIRE-DATE-XOR. DTSBX450
|
|
00394 DTSBX450
|
|
00395 INSPECT NH-EMPLOYER-NAME REPLACING ALL ',' BY SPACE. DTSBX450
|
|
00396 MOVE NH-EMPLOYER-NAME TO EMPLER-NAME. DTSBX450
|
|
00397 DTSBX450
|
|
00398 MOVE NH-EMPLOYER-ADDRESS-1 TO EMPLER-ADDR-1. DTSBX450
|
|
00399 MOVE NH-EMPLOYER-CITY TO EMPLER-CITY. DTSBX450
|
|
00400 MOVE NH-EMPLOYER-STATE TO EMPLER-STATE. DTSBX450
|
|
00401 MOVE NH-EMPLOYER-ZIP-CODE-1 TO WS-EMPL-ZIP5. DTSBX450
|
|
00402 MOVE NH-EMPLOYER-ZIP-CODE-2 TO WS-EMPL-ZIP4. DTSBX450
|
|
00403 MOVE WS-EMPL-ZIP TO EMPLER-ZIP. DTSBX450
|
|
00404 INSPECT EMPLER-ADDRESS REPLACING ALL ',' BY SPACE. DTSBX450
|
|
00405 DTSBX450
|
|
00406 WRITE NH-EMPLER-REC FROM WRK-EMPLER-REC. DTSBX450
|
|
00407 ADD +1 TO WRK-EMPLER-CNT. DTSBX450
|
|
00408 DTSBX450
|
|
00409 P1400-EXIT. DTSBX450
|
|
00410 EXIT. DTSBX450
|
|
00411 DTSBX450
|
|
00412 T0000-TERMINATE. DTSBX450
|
|
00413 DTSBX450
|
|
00414 DISPLAY ' '. DTSBX450
|
|
00415 DTSBX450
|
|
00416 DISPLAY '*** DTSBX450 TERMINATION STATISTICS ***'. DTSBX450
|
|
00417 DTSBX450
|
|
00418 DISPLAY ' '. DTSBX450
|
|
00419 DTSBX450
|
|
00420 DISPLAY 'NUMBER OF NEW HIRE FILE INPUT RECORDS CNT : ' DTSBX450
|
|
00421 WRK-NH-REC-CNT. DTSBX450
|
|
00422 DTSBX450
|
|
00423 DISPLAY ' '. DTSBX450
|
|
00424 DTSBX450
|
|
00425 DISPLAY 'NUMBER OF NEW HIRE RECS ID W4 PROCESS CNT : ' DTSBX450
|
|
00426 WRK-W4-CNT. DTSBX450
|
|
00427 DTSBX450
|
|
00428 DISPLAY 'NUMBER OF NEW HIRE RECS ID NOT = W4 COUNT : ' DTSBX450
|
|
00429 WRK-NOT-W4-CNT. DTSBX450
|
|
00430 DTSBX450
|
|
00431 DISPLAY ' '. DTSBX450
|
|
00432 DTSBX450
|
|
00433 DISPLAY ' '. DTSBX450
|
|
00434 DTSBX450
|
|
00435 DISPLAY 'NUMBER OF NEW HIRE TRANS RECORDS WRITTEN : ' DTSBX450
|
|
00436 WRK-TRAN-CNT. DTSBX450
|
|
00437 DTSBX450
|
|
00438 DISPLAY 'NUMBER OF NEW HIRE WORKER RECORDS WRITTEN : ' DTSBX450
|
|
00439 WRK-WORKER-CNT. DTSBX450
|
|
00440 DTSBX450
|
|
00441 DISPLAY 'NUMBER OF NEW HIRE EMPLOYER RECS WRITTEN : ' DTSBX450
|
|
00442 WRK-EMPLER-CNT. DTSBX450
|
|
00443 DTSBX450
|
|
00444 CLOSE NEW-HIRE-FILE NH-TRAN-FILE NH-WORKER-FILE DTSBX450
|
|
00445 NH-EMPLER-FILE. DTSBX450
|
|
00446 DTSBX450
|
|
00447 T0000-EXIT. DTSBX450
|
|
00448 EXIT. DTSBX450
|
|
00449 DTSBX450
|
|
00450 S001-FROM-FED-8. DTSBX450
|
|
00451 SET L001-FROM-FED-8 TO TRUE. DTSBX450
|
|
00452 GO TO S001-DATE. DTSBX450
|
|
00453 DTSBX450
|
|
00454 S001-DATE. DTSBX450
|
|
00455 CALL 'DTSBU001' USING L001-LINK-AREA. DTSBX450
|
|
00456 S001-EXIT. DTSBX450
|
|
00457 EXIT. DTSBX450
|
|
00458 DTSBX450
|
|
00459 S005-SYS-DATE. DTSBX450
|
|
00460 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBX450
|
|
00461 DTSBX450
|
|
00462 S005-EXIT. DTSBX450
|
|
00463 EXIT. DTSBX450
|
|
00464 DTSBX450
|
|
00465 S999-ABEND. DTSBX450
|
|
00466 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBX450
|
|
00467 S999-EXIT. DTSBX450
|
|
00468 EXIT. DTSBX450
|
|
00469 DTSBX450
|