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