00001 IDENTIFICATION DIVISION. 10/29/19 00002 PROGRAM-ID. DTSBD640. DTSBD640 00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV003 00004 DATE-WRITTEN. DECEMBER 1991. DTSBD640 00005 DATE-COMPILED. DTSBD640 00006 SKIP3 DTSBD640 00007 ***** DTSBD640 00008 * DTSBD640 00009 * FUNCTION: PROCESS FUTA QUARTERLY ENTITY UPDATE TAPE. DTSBD640 00010 * DTSBD640 00011 * DTSBD640 00012 * MODIFICATION LOG: DTSBD640 00013 * DTSBD640 00014 * 02/17/1999 WRITTEN FOR DC. DTSBD640 00015 * REFERENCE: DC DEVELOPMENT PROGRAMMER: EHH DTSBD640 00016 * DTSBD640 00017 * 10/07/2013 UPDATED TO CREATE POTENTIAL EMPLOYERS FROM DTSBD640 00018 * QUARTERLY IRS EIN FILE. DTSBD640 00019 * REFERENCE: TICKET 2021 PROGRAMMER: GD DTSBD640 00020 * DTSBD640 00021 * 09/01/2019 UPDATED TO ADD NEW ELEMENTS FROM IRS QTRLY FUTA FILDTSBD640 00022 * REFERENCE: TICKET ???? PROGRAMMER: ZL1 DTSBD640 00023 * DTSBD640 00024 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD640 00025 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBD640 00026 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBD640 00027 * DTSBD640 00028 * DTSBD640 00029 * DESCRIPTION: DTSBD640 00030 * DTSBD640 00031 * DTSBD640 DOES THE QUARTERLY ENTITY UPDATE TAPE PROCESSING. DTSBD640 00032 * SEE IRS DOCUMENT 6581 ("SPECIFICATIONS FOR THE NATIONWIDE DTSBD640 00033 * SYSTEM FOR COMPUTERIZED CERTIFICATION OF STATE FUTA DTSBD640 00034 * CREDITS") - SECTION 11. DTSBD640 00035 * DTSBD640 00036 * READ THE IRS FUTA QUARTERLY ENTITY UPDATE TAPE. DTSBD640 00037 * DTSBD640 00038 * FOR EACH RECORD ON THE IRS FUTA QUARTERLY ENTITY UPDATE DTSBD640 00039 * TAPE, IF NO DC UI TAX SYSTEM EMPLOYER WITH MPRF-FEIN DTSBD640 00040 * EQUAL TO QEUP-FEIN EXISTS, THEN WRITE A R793 RECORD. DTSBD640 00041 * DTSBD640 00042 * DTSBD640 00043 * DTSBD640 00044 * PARAMETERS INPUT: DTSBD640 00045 * DTSBD640 00046 * NONE. DTSBD640 00047 * DTSBD640 00048 * DTSBD640 00049 * TAPES INPUT: DTSBD640 00050 * DTSBD640 00051 * IRS FUTA QUARTERLY ENTITY UPDATE TAPE. DTSBD640 00052 * DTSBD640 00053 * DTSBD640 00054 * MASTER FILE RECORDS READ: DTSBD640 00055 * DTSBD640 00056 * MPRF DTSBD640 00057 * DTSBD640 00058 * DTSBD640 00059 * ALTERNATE INDEX FILE RECORDS READ: DTSBD640 00060 * DTSBD640 00061 * IEIN DTSBD640 00062 * DTSBD640 00063 * DTSBD640 00064 * MASTER FILE RECORDS UPDATED: DTSBD640 00065 * DTSBD640 00066 * NONE. DTSBD640 00067 * DTSBD640 00068 * DTSBD640 00069 * REPORT RECORDS WRITTEN: DTSBD640 00070 * DTSBD640 00071 * R793 FUTA QUARTERLY FEIN CHANGES. DTSBD640 00072 * R907 UNUSUAL CONDITIONS ENCOUNTERED. DTSBD640 00073 * DTSBD640 00074 * DTSBD640 00075 * TAPES WRITTEN: DTSBD640 00076 * DTSBD640 00077 * NONE DTSBD640 00078 * DTSBD640 00079 * DTSBD640 00080 * DISK DATASETS WRITTEN: DTSBD640 00081 * DTSBD640 00082 * NONE DTSBD640 00083 * DTSBD640 00084 * DTSBD640 00085 * MODULES CALLED: DTSBD640 00086 * DTSBD640 00087 * DTSBU910 MASTER FILE I/O DRIVER. DTSBD640 00088 * DTSBU921 ALTERNATE INDEX FILE I/O. DTSBD640 00089 * DTSBU946 VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 1. DTSBD640 00090 * DTSBD640 00091 ***** DTSBD640 00092 SKIP3 DTSBD640 00093 ENVIRONMENT DIVISION. DTSBD640 00094 SKIP2 DTSBD640 00095 INPUT-OUTPUT SECTION. DTSBD640 00096 DTSBD640 00097 FILE-CONTROL. DTSBD640 00098 SELECT QUARTERLY-ENTITY-UPDATE-FILE ASSIGN TO DTSFQEUP DTSBD640 00099 FILE STATUS IS QEUP-FILE-STATUS. DTSBD640 00100 DTSBD640 00101 SELECT QUARTERLY-ENTITY-BYPASS-FILE ASSIGN TO DTSFBPAS DTSBD640 00102 FILE STATUS IS QEUP-FILE-STATUS. DTSBD640 00103 DTSBD640 00104 DATA DIVISION. DTSBD640 00105 SKIP3 DTSBD640 00106 FILE SECTION. DTSBD640 00107 SKIP2 DTSBD640 00108 FD QUARTERLY-ENTITY-UPDATE-FILE. DTSBD640 00109 01 X793-REC. DTSBD640 00110 ++INCLUDE DTSIX793 DTSBD640 00111 DTSBD640 00112 FD QUARTERLY-ENTITY-BYPASS-FILE DTSBD640 00113 RECORDING MODE IS F DTSBD640 00114 BLOCK CONTAINS 0 RECORDS DTSBD640 00115 LABEL RECORDS ARE STANDARD. DTSBD640 00116 DTSBD640 00117 01 QUARTERLY-ENTITY-BYPASS-REC. DTSBD640 00118 05 BPASS-FEIN-NO PIC 9(09). DTSBD640 00119 05 FILLER PIC X(71). DTSBD640 00120 WORKING-STORAGE SECTION. DTSBD640 001205 77 PAN-VALET PICTURE X(24) VALUE '003DTSBD640 10/29/19'. DTSBD640 00121 77 PAN-VALET PICTURE X(24) VALUE '022DTSBD640 10/16/19'. DTSBD640 00122 77 PAN-VALET PICTURE X(24) VALUE '015DTSBD640 10/04/19'. DTSBD640 00123 77 PAN-VALET PICTURE X(24) VALUE '020DTSBD640 01/09/14'. DTSBD640 00124 77 PAN-VALET PICTURE X(24) VALUE '012DTSBD640 11/26/13'. DTSBD640 00125 77 PAN-VALET PICTURE X(24) VALUE '018DTSBD640 11/18/13'. DTSBD640 00126 77 PAN-VALET PICTURE X(24) VALUE '047DTSBD640 11/18/13'. DTSBD640 00127 77 PAN-VALET PICTURE X(24) VALUE '016DTSBD640 02/18/99'. DTSBD640 00128 SKIP3 DTSBD640 00129 01 WRK-AREA. DTSBD640 00130 05 W-ABEND-CD PIC S9(04) COMP VALUE +640.DTSBD640 00131 DTSBD640 00132 05 W-MOD-NAME PIC X(08) VALUE 'DTSBD640'.DTSBD640 00133 DTSBD640 00134 05 QEUP-FILE-STATUS PIC X(02). DTSBD640 00135 88 QEUP-STATUS-OK-88 VALUE '00'. DTSBD640 00136 88 QEUP-STATUS-EOF-88 VALUE '10'. DTSBD640 00137 DTSBD640 00138 05 W-ERROR-IND PIC X(01). DTSBD640 00139 88 W-ERROR-YES-88 VALUE 'Y'. DTSBD640 00140 88 W-ERROR-NO-88 VALUE 'N'. DTSBD640 00141 DTSBD640 00142 05 WRK-FEIN PIC 9(09) VALUE 0. DTSBD640 00143 DTSBD640 00144 05 W-LAST-FEIN PIC S9(09) COMP-3 DTSBD640 00145 VALUE +0. DTSBD640 00146 DTSBD640 00147 05 W-FEIN-EMP-NO PIC S9(07) COMP-3. DTSBD640 00148 DTSBD640 00149 05 WRK-T001-ADD-CNT PIC 9(05) VALUE 0. DTSBD640 00150 05 WRK-BPASS-FEIN PIC 9(09). DTSBD640 00151 05 WRK-BYPASS-EMP PIC 9(01) VALUE 0. DTSBD640 00152 DTSBD640 00153 05 SUB1 PIC S9(04) COMP. DTSBD640 00154 05 SUB2 PIC S9(04) COMP. DTSBD640 00155 05 SUB3 PIC S9(04) COMP. DTSBD640 00156 05 W-MNTE-IDX PIC S9(04) COMP. DTSBD640 00157 DTSBD640 00158 05 W-SELECT-IND PIC X(01). DTSBD640 00159 88 W-SELECT-YES-88 VALUE 'Y'. DTSBD640 00160 88 W-SELECT-NO-88 VALUE 'N'. DTSBD640 00161 DTSBD640 00162 05 W-EMP-NO-UNUSED-IND PIC X(01). DTSBD640 00163 88 W-EMP-NO-UNUSED-NO-88 VALUE 'N'. DTSBD640 00164 88 W-EMP-NO-UNUSED-YES-88 VALUE 'Y'. DTSBD640 00165 DTSBD640 00166 05 W-END-FOUND-IND PIC X(01). DTSBD640 00167 88 W-END-FOUND-YES-88 VALUE 'Y'. DTSBD640 00168 88 W-END-FOUND-NO-88 VALUE 'N'. DTSBD640 00169 DTSBD640 00170 05 W-NOT-LIAB-EMP-NO PIC S9(07) COMP-3. DTSBD640 00171 05 W-EMP-STATUS PIC X(01). DTSBD640 00172 DTSBD640 00173 05 W-IRS-FORM-IND PIC X(10). DTSBD640 00174 88 W-IRS-FORM-940-88 VALUE '940'. DTSBD640 00175 88 W-IRS-FORM-940EZ-88 VALUE '940-EZ'. DTSBD640 00176 88 W-IRS-FORM-941-88 VALUE '941'. DTSBD640 00177 88 W-IRS-FORM-942-88 VALUE '942'. DTSBD640 00178 88 W-IRS-FORM-943-88 VALUE '943'. DTSBD640 00179 88 W-IRS-FORM-NULL-88 VALUE 'XXX'. DTSBD640 00180 DTSBD640 00181 05 W-TRANS-CODE PIC X(20). DTSBD640 00182 88 W-TRANS-CODE-NEW-88 VALUE 'NEW ACCOUNT'. DTSBD640 00183 88 W-TRANS-CODE-FEIN-88 VALUE 'FEIN CHANGE'. DTSBD640 00184 88 W-TRANS-CODE-NAME-88 VALUE 'NAME CHANGE'. DTSBD640 00185 88 W-TRANS-CODE-NULL-88 VALUE 'XXX'. DTSBD640 00186 DTSBD640 00187 05 QEUP-INPUT-REC-CNT PIC S9(07) COMP-3 DTSBD640 00188 VALUE +0. DTSBD640 00189 05 QEUP-ERROR-REC-CNT PIC S9(07) COMP-3 DTSBD640 00190 VALUE +0. DTSBD640 00191 05 QEUP-MATCHED-REC-CNT PIC S9(07) COMP-3 DTSBD640 00192 VALUE +0. DTSBD640 00193 05 MATCHED-NOT-LIAB-CNT PIC S9(07) COMP-3 DTSBD640 00194 VALUE +0. DTSBD640 00195 05 QEUP-UNMATCHED-REC-CNT PIC S9(07) COMP-3 DTSBD640 00196 VALUE +0. DTSBD640 00197 05 W-PROFILE-CNT PIC S9(07) COMP-3 DTSBD640 00198 VALUE +0. DTSBD640 00199 05 W-ADDRESS-CNT PIC S9(07) COMP-3 DTSBD640 00200 VALUE +0. DTSBD640 00201 05 W-MNTE-CNT PIC S9(07) COMP-3 DTSBD640 00202 VALUE +0. DTSBD640 00203 DTSBD640 00204 01 MSG-AREA. DTSBD640 00205 05 MSG01-STATE-CODE-NOT-DC. DTSBD640 00206 10 MSG01-ID PIC X(03) VALUE '793'. DTSBD640 00207 10 MSG01-TEXT. DTSBD640 00208 15 FILLER PIC X(40) DTSBD640 00209 VALUE 'STATE CODE NOT EQUAL TO DC ENCOUNTERED O'. DTSBD640 00210 15 FILLER PIC X(40) DTSBD640 00211 VALUE 'N QUARTERLY ENTITY UPDATE FROM IRS : '. DTSBD640 00212 15 MSG01-STATE-CODE PIC X(02). DTSBD640 00213 15 FILLER PIC X(05) VALUE SPACES.DTSBD640 00214 15 MSG01-FEIN-X PIC X(09). DTSBD640 00215 DTSBD640 00216 05 MSG02-NON-NUMERIC-FEIN. DTSBD640 00217 10 MSG02-ID PIC X(03) VALUE '793'. DTSBD640 00218 10 MSG02-TEXT. DTSBD640 00219 15 FILLER PIC X(40) DTSBD640 00220 VALUE 'NON NUMERIC FEIN VALUE ENCOUNTERED ON QU'. DTSBD640 00221 15 FILLER PIC X(40) DTSBD640 00222 VALUE 'ARTERLY ENTITY UPDATE FROM IRS : '. DTSBD640 00223 15 MSG02-FEIN-X PIC X(09). DTSBD640 00224 DTSBD640 00225 05 MSG03-DUPLICATE-FEIN. DTSBD640 00226 10 MSG03-ID PIC X(03) VALUE '793'. DTSBD640 00227 10 MSG03-TEXT. DTSBD640 00228 15 FILLER PIC X(40) DTSBD640 00229 VALUE 'DUPLICATE FEIN VALUE ENCOUNTERED ON QUAR'. DTSBD640 00230 15 FILLER PIC X(40) DTSBD640 00231 VALUE 'TERLY ENTITY UPDATE FROM IRS : '. DTSBD640 00232 15 MSG03-FEIN-X PIC X(09). DTSBD640 00233 DTSBD640 00234 01 T002-REC. DTSBD640 00235 ++INCLUDE DTSIT002 DTSBD640 00236 DTSBD640 00237 ************************* DTSBD640 00238 * PROFILE RECORD DTSBD640 00239 ************************* DTSBD640 00240 01 Y104-REC. DTSBD640 00241 ++INCLUDE DTSIY104 DTSBD640 00242 DTSBD640 00243 ************************* DTSBD640 00244 * NAME RECORD DTSBD640 00245 ************************* DTSBD640 00246 01 Y106-REC. DTSBD640 00247 ++INCLUDE DTSIY106 DTSBD640 00248 DTSBD640 00249 ************************* DTSBD640 00250 * ADDRESS RECORD DTSBD640 00251 ************************* DTSBD640 00252 01 Y110-REC. DTSBD640 00253 ++INCLUDE DTSIY110 DTSBD640 00254 DTSBD640 00255 01 T003-REC. DTSBD640 00256 ++INCLUDE DTSIT003 DTSBD640 00257 DTSBD640 00258 01 T001-REC. DTSBD640 00259 ++INCLUDE DTSIT001 DTSBD640 00260 DTSBD640 00261 01 CENO-LITERALS. DTSBD640 00262 ++INCLUDE DTSICENO DTSBD640 00263 DTSBD640 00264 01 L910-LINK-AREA. DTSBD640 00265 ++INCLUDE DTSIL910 DTSBD640 00266 DTSBD640 00267 01 MSKL-REC. DTSBD640 00268 ++INCLUDE DTSIMSKL DTSBD640 00269 SKIP3 DTSBD640 00270 01 MHDR-REC. DTSBD640 00271 ++INCLUDE DTSIMHDR DTSBD640 00272 DTSBD640 00273 01 MPRF-REC. DTSBD640 00274 ++INCLUDE DTSIMPRF DTSBD640 00275 DTSBD640 00276 01 MNTE-REC. DTSBD640 00277 ++INCLUDE DTSIMNTE DTSBD640 00278 DTSBD640 00279 01 MERA-REC. DTSBD640 00280 ++INCLUDE DTSIMERA DTSBD640 00281 DTSBD640 00282 01 L921-LINK-AREA. DTSBD640 00283 ++INCLUDE DTSIL921 DTSBD640 00284 DTSBD640 00285 01 ISKL-REC. DTSBD640 00286 ++INCLUDE DTSIISKL DTSBD640 00287 DTSBD640 00288 01 IEIN-REC. DTSBD640 00289 ++INCLUDE DTSIIEIN DTSBD640 00290 DTSBD640 00291 01 L005-COMM-AREA. DTSBD640 00292 ++INCLUDE DTSIL005 DTSBD640 00293 DTSBD640 00294 01 R793-REC. DTSBD640 00295 ++INCLUDE DTSIR793 DTSBD640 00296 SKIP3 DTSBD640 00297 01 R907-REC. DTSBD640 00298 ++INCLUDE DTSIR907 DTSBD640 00299 DTSBD640 00300 01 L142-LINK-AREA. DTSBD640 00301 ++INCLUDE DTSIL142 DTSBD640 00302 DTSBD640 00303 01 L927-LINK-AREA. DTSBD640 00304 ++INCLUDE DTSIL927 DTSBD640 00305 DTSBD640 00306 01 TSKL-REC. DTSBD640 00307 ++INCLUDE DTSITSKL DTSBD640 00308 DTSBD640 00309 PROCEDURE DIVISION. DTSBD640 00310 DTSBD640 00311 DTSBD640 00312 PERFORM I0000-INITIALIZATION THRU I0000-EXIT. DTSBD640 00313 DTSBD640 00314 PERFORM P0000-PROCESS-QEUP THRU P0000-EXIT. DTSBD640 00315 DTSBD640 00316 PERFORM T0000-TERMINATE THRU T0000-EXIT. DTSBD640 00317 DTSBD640 00318 DTSBD640 00319 GOBACK. DTSBD640 00320 DTSBD640 00321 I0000-INITIALIZATION. DTSBD640 00322 SET W-ERROR-NO-88 TO TRUE. DTSBD640 00323 DTSBD640 00324 MOVE 'N' TO L910-TRACE-IND DTSBD640 00325 L921-TRACE-IND DTSBD640 00326 L927-TRACE-IND. DTSBD640 00327 DTSBD640 00328 MOVE W-MOD-NAME TO L910-MOD-NAME DTSBD640 00329 L921-MOD-NAME DTSBD640 00330 L927-MOD-NAME. DTSBD640 00331 DTSBD640 00332 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DTSBD640 00333 DTSBD640 00334 PERFORM I3000-READ-HDR THRU I3000-EXIT. DTSBD640 00335 DTSBD640 00336 * SET L142-INITIATE-88 TO TRUE. DTSBD640 00337 * MOVE MHDR-CURR-RUN-DATE TO L142-CURR-RUN-DATE. DTSBD640 00338 * PERFORM S142-NEW-EMP THRU S142-EXIT. DTSBD640 00339 DTSBD640 00340 MOVE LENGTH OF R793-REC TO R793-LENGTH. DTSBD640 00341 DTSBD640 00342 MOVE LENGTH OF R907-REC TO R907-LENGTH. DTSBD640 00343 MOVE +0 TO R907-EMP-NO. DTSBD640 00344 MOVE W-MOD-NAME TO R907-MODULE-NAME. DTSBD640 00345 DTSBD640 00346 DTSBD640 00347 SET L005-FROM-SYS TO TRUE. DTSBD640 00348 PERFORM S005-SYS-DATE THRU S005-EXIT. DTSBD640 00349 DTSBD640 00350 I0000-EXIT. DTSBD640 00351 EXIT. DTSBD640 00352 DTSBD640 00353 I2000-OPEN-FILES. DTSBD640 00354 PERFORM S910-OPEN-READ THRU S910-EXIT. CL**2 00355 ** PERFORM S910-OPEN-UPDATE THRU S910-EXIT. CL**2 00356 DTSBD640 00357 PERFORM S921-OPEN-READ THRU S921-EXIT. CL**2 00358 ** PERFORM S921-OPEN-UPDATE THRU S921-EXIT. CL**2 00359 DTSBD640 00360 PERFORM S927A-OPEN THRU S927A-EXIT. DTSBD640 00361 DTSBD640 00362 OPEN INPUT QUARTERLY-ENTITY-UPDATE-FILE. DTSBD640 00363 IF NOT QEUP-STATUS-OK-88 DTSBD640 00364 DISPLAY 'CANNOT OPEN QEUP FILE ' QEUP-FILE-STATUS DTSBD640 00365 PERFORM S999-ABEND THRU S999-EXIT DTSBD640 00366 END-IF. DTSBD640 00367 DTSBD640 00368 DTSBD640 00369 I2000-EXIT. DTSBD640 00370 EXIT. DTSBD640 00371 DTSBD640 00372 I3000-READ-HDR. DTSBD640 00373 MOVE LOW-VALUES TO MHDR-KEY-AREA. DTSBD640 00374 MOVE +0 TO MHDR-EMP-NO. DTSBD640 00375 SET MHDR-HDR-88 TO TRUE. DTSBD640 00376 MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA. DTSBD640 00377 DTSBD640 00378 PERFORM S910-READ THRU S910-EXIT. DTSBD640 00379 IF L910-OK-88 DTSBD640 00380 MOVE MSKL-REC TO MHDR-REC DTSBD640 00381 ELSE DTSBD640 00382 DISPLAY 'CANNOT READ MHDR ' DTSBD640 00383 PERFORM S999-ABEND THRU S999-EXIT DTSBD640 00384 END-IF. DTSBD640 00385 DTSBD640 00386 I3000-EXIT. DTSBD640 00387 EXIT. DTSBD640 00388 DTSBD640 00389 P0000-PROCESS-QEUP. DTSBD640 00390 READ QUARTERLY-ENTITY-UPDATE-FILE. DTSBD640 00391 PERFORM UNTIL NOT QEUP-STATUS-OK-88 DTSBD640 00392 ADD +1 TO QEUP-INPUT-REC-CNT DTSBD640 00393 * SET W-ERROR-NO-88 TO TRUE DTSBD640 00394 * PERFORM P1000-EDIT-REC THRU P1000-EXIT DTSBD640 00395 * IF W-ERROR-NO-88 DTSBD640 00396 PERFORM P0900-CHECK-FEIN THRU P0900-EXIT DTSBD640 00397 * PERFORM P2000-CHECK-FEIN THRU P2000-EXIT DTSBD640 00398 * IF W-SELECT-YES-88 DTSBD640 00399 * PERFORM P3000-ADD-T002 THRU P3000-EXIT DTSBD640 00400 * PERFORM P4000-ADD-MNTE THRU P4000-EXIT DTSBD640 00401 * END-IF DTSBD640 00402 * END-IF DTSBD640 00403 READ QUARTERLY-ENTITY-UPDATE-FILE DTSBD640 00404 END-PERFORM. DTSBD640 00405 DTSBD640 00406 DTSBD640 00407 P0000-EXIT. DTSBD640 00408 EXIT. DTSBD640 00409 DTSBD640 00410 DTSBD640 00411 P0900-CHECK-FEIN. DTSBD640 00412 DTSBD640 00413 MOVE LOW-VALUES TO IEIN-KEY-AREA. DTSBD640 00414 DTSBD640 00415 SET IEIN-EIN-88 TO TRUE. DTSBD640 00416 DTSBD640 00417 MOVE QEUP-FEIN TO IEIN-FEIN. DTSBD640 00418 DTSBD640 00419 MOVE IEIN-KEY-AREA TO ISKL-KEY-AREA. DTSBD640 00420 DTSBD640 00421 PERFORM S921-START-BROWSE THRU S921-EXIT. DTSBD640 00422 DTSBD640 00423 IF L921-NO-REC-88 DTSBD640 00424 SET R793-POT-EMP-ADDED-88 TO TRUE DTSBD640 00425 PERFORM P7000-GENERATE-R793 THRU P7000-EXIT DTSBD640 00426 GO TO P0900-EXIT. DTSBD640 00427 DTSBD640 00428 MOVE ISKL-REC TO IEIN-REC DTSBD640 00429 MOVE IEIN-FEIN TO WRK-FEIN. DTSBD640 00430 DTSBD640 00431 IF WRK-FEIN NOT = QEUP-FEIN DTSBD640 00432 * DISPLAY 'IRS FEIN: ' QEUP-FEIN DTSBD640 00433 * 'DTS FEIN: ' WRK-FEIN DTSBD640 00434 SET R793-POT-EMP-ADDED-88 TO TRUE DTSBD640 00435 PERFORM P7000-GENERATE-R793 THRU P7000-EXIT DTSBD640 00436 ADD 1 TO QEUP-UNMATCHED-REC-CNT DTSBD640 00437 GO TO P0900-EXIT. DTSBD640 00438 DTSBD640 00439 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSBD640 00440 DTSBD640 00441 MOVE IEIN-EMP-NO TO MSKL-EMP-NO. DTSBD640 00442 DTSBD640 00443 SET MSKL-PRF-88 TO TRUE. DTSBD640 00444 DTSBD640 00445 PERFORM S910-READ THRU S910-EXIT. DTSBD640 00446 DTSBD640 00447 IF L910-NO-REC-88 DTSBD640 00448 SET R793-POT-EMP-ADDED-88 TO TRUE DTSBD640 00449 PERFORM P7000-GENERATE-R793 THRU P7000-EXIT DTSBD640 00450 ADD 1 TO QEUP-UNMATCHED-REC-CNT DTSBD640 00451 GO TO P0900-EXIT. DTSBD640 00452 DTSBD640 00453 MOVE MSKL-REC TO MPRF-REC. DTSBD640 00454 DISPLAY 'FUTA EMP: ' MPRF-EMP-NO ' ' WRK-FEIN DTSBD640 00455 ' ' MPRF-PRIMARY-NAME. DTSBD640 00456 DTSBD640 00457 SET R793-POT-EMP-FOUND-88 TO TRUE DTSBD640 00458 PERFORM P7000-GENERATE-R793 THRU P7000-EXIT DTSBD640 00459 ADD +1 TO QEUP-MATCHED-REC-CNT. DTSBD640 00460 P0900-EXIT. EXIT. DTSBD640 00461 DTSBD640 00462 P1000-EDIT-REC. DTSBD640 00463 IF QEUP-STATE-CODE = 'DC' DTSBD640 00464 NEXT SENTENCE DTSBD640 00465 ELSE DTSBD640 00466 SET W-ERROR-YES-88 TO TRUE DTSBD640 00467 MOVE QEUP-STATE-CODE TO MSG01-STATE-CODE DTSBD640 00468 MOVE QEUP-FEIN-X TO MSG01-FEIN-X DTSBD640 00469 MOVE MSG01-TEXT TO R907-MSG-TEXT DTSBD640 00470 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBD640 00471 DISPLAY 'ERR ' MSG01-STATE-CODE-NOT-DC DTSBD640 00472 ADD +1 TO QEUP-ERROR-REC-CNT DTSBD640 00473 GO TO P1000-EXIT DTSBD640 00474 END-IF. DTSBD640 00475 DTSBD640 00476 IF QEUP-FEIN NUMERIC DTSBD640 00477 NEXT SENTENCE DTSBD640 00478 ELSE DTSBD640 00479 SET W-ERROR-YES-88 TO TRUE DTSBD640 00480 MOVE QEUP-FEIN-X TO MSG02-FEIN-X DTSBD640 00481 MOVE MSG02-TEXT TO R907-MSG-TEXT DTSBD640 00482 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBD640 00483 DISPLAY 'ERR ' MSG02-NON-NUMERIC-FEIN DTSBD640 00484 ADD +1 TO QEUP-ERROR-REC-CNT DTSBD640 00485 GO TO P1000-EXIT DTSBD640 00486 END-IF. DTSBD640 00487 DISPLAY 'P1000 ' QEUP-FEIN ' ' W-LAST-FEIN. DTSBD640 00488 IF QEUP-FEIN NOT = W-LAST-FEIN DTSBD640 00489 MOVE QEUP-FEIN TO W-LAST-FEIN DTSBD640 00490 ELSE DTSBD640 00491 IF QEUP-FEIN = W-LAST-FEIN DTSBD640 00492 SET W-ERROR-YES-88 TO TRUE DTSBD640 00493 MOVE QEUP-FEIN-X TO MSG03-FEIN-X DTSBD640 00494 MOVE MSG03-TEXT TO R907-MSG-TEXT DTSBD640 00495 PERFORM S946-WRITE-R907 THRU S946-EXIT DTSBD640 00496 DISPLAY 'ERR ' MSG03-DUPLICATE-FEIN DTSBD640 00497 ADD +1 TO QEUP-ERROR-REC-CNT DTSBD640 00498 GO TO P1000-EXIT DTSBD640 00499 END-IF DTSBD640 00500 END-IF. DTSBD640 00501 DTSBD640 00502 MOVE ZERO TO WRK-BYPASS-EMP. DTSBD640 00503 PERFORM P1050-BYPASS-EMP THRU P1050-EXIT. DTSBD640 00504 CLOSE QUARTERLY-ENTITY-BYPASS-FILE. DTSBD640 00505 DTSBD640 00506 P1000-EXIT. DTSBD640 00507 EXIT. DTSBD640 00508 DTSBD640 00509 P1050-BYPASS-EMP. DTSBD640 00510 OPEN INPUT QUARTERLY-ENTITY-BYPASS-FILE. DTSBD640 00511 IF NOT QEUP-STATUS-OK-88 DTSBD640 00512 DISPLAY 'CANNOT OPEN BYPASS FILE ' QEUP-FILE-STATUS DTSBD640 00513 PERFORM S999-ABEND THRU S999-EXIT DTSBD640 00514 END-IF. DTSBD640 00515 PERFORM P1060-VERIFY-BYPASS-EMP THRU P1060-EXIT UNTIL DTSBD640 00516 WRK-BYPASS-EMP = 1. DTSBD640 00517 P1050-EXIT. DTSBD640 00518 EXIT. DTSBD640 00519 DTSBD640 00520 P1060-VERIFY-BYPASS-EMP. DTSBD640 00521 READ QUARTERLY-ENTITY-BYPASS-FILE DTSBD640 00522 AT END MOVE 1 TO WRK-BYPASS-EMP. DTSBD640 00523 DTSBD640 00524 MOVE BPASS-FEIN-NO TO WRK-BPASS-FEIN DTSBD640 00525 DTSBD640 00526 IF WRK-BPASS-FEIN < QEUP-FEIN DTSBD640 00527 GO TO P1060-EXIT DTSBD640 00528 ELSE DTSBD640 00529 IF WRK-BPASS-FEIN > QEUP-FEIN DTSBD640 00530 * DISPLAY 'NOT FND ON PASS FILE ' WRK-BPASS-FEIN ' ' QEUP-FEIN DTSBD640 00531 MOVE 1 TO WRK-BYPASS-EMP DTSBD640 00532 ELSE DTSBD640 00533 IF WRK-BPASS-FEIN = QEUP-FEIN DTSBD640 00534 DISPLAY 'EMP RESPONSED -BYPASS EMP ' QEUP-FEIN DTSBD640 00535 MOVE 1 TO WRK-BYPASS-EMP DTSBD640 00536 SET W-ERROR-YES-88 TO TRUE DTSBD640 00537 ELSE DTSBD640 00538 DISPLAY 'BAD FEIN ON FILE ' QEUP-FEIN ' ' WRK-BPASS-FEIN DTSBD640 00539 PERFORM S999-ABEND THRU S999-EXIT. DTSBD640 00540 P1060-EXIT. DTSBD640 00541 EXIT. DTSBD640 00542 DTSBD640 00543 P2000-CHECK-FEIN. DTSBD640 00544 SET W-SELECT-NO-88 TO TRUE. DTSBD640 00545 MOVE ZERO TO W-FEIN-EMP-NO DTSBD640 00546 W-NOT-LIAB-EMP-NO. DTSBD640 00547 MOVE SPACES TO W-EMP-STATUS. DTSBD640 00548 DTSBD640 00549 MOVE LOW-VALUE TO IEIN-KEY-AREA DTSBD640 00550 SET IEIN-EIN-88 TO TRUE DTSBD640 00551 MOVE QEUP-FEIN TO IEIN-FEIN DTSBD640 00552 MOVE +0 TO IEIN-EMP-NO DTSBD640 00553 MOVE IEIN-KEY-AREA TO ISKL-KEY-AREA DTSBD640 00554 PERFORM S921-START-BROWSE THRU S921-EXIT DTSBD640 00555 MOVE ISKL-REC TO IEIN-REC DTSBD640 00556 PERFORM DTSBD640 00557 UNTIL L921-NO-REC-88 DTSBD640 00558 OR W-FEIN-EMP-NO > ZERO DTSBD640 00559 IF IEIN-FEIN = QEUP-FEIN DTSBD640 00560 PERFORM P2100-FIND-MPRF THRU P2100-EXIT DTSBD640 00561 IF W-FEIN-EMP-NO = ZERO DTSBD640 00562 PERFORM S921-READ-NEXT THRU S921-EXIT DTSBD640 00563 MOVE ISKL-REC TO IEIN-REC DTSBD640 00564 END-IF DTSBD640 00565 ELSE DTSBD640 00566 SET L921-NO-REC-88 TO TRUE DTSBD640 00567 END-IF DTSBD640 00568 END-PERFORM. DTSBD640 00569 DTSBD640 00570 IF W-FEIN-EMP-NO = ZERO DTSBD640 00571 IF W-EMP-STATUS = 'N' OR 'U' DTSBD640 00572 DISPLAY 'UNKNOWN LIAB ' QEUP-FEIN DTSBD640 00573 ' ' QEUP-NAME-LINE-1 DTSBD640 00574 ADD +1 TO MATCHED-NOT-LIAB-CNT DTSBD640 00575 ELSE DTSBD640 00576 SET W-SELECT-YES-88 TO TRUE DTSBD640 00577 ADD +1 TO QEUP-UNMATCHED-REC-CNT DTSBD640 00578 SET W-EMP-NO-UNUSED-NO-88 TO TRUE DTSBD640 00579 PERFORM P2200-NEXT-EMP-NO THRU P2200-EXIT DTSBD640 00580 UNTIL W-EMP-NO-UNUSED-YES-88 DTSBD640 00581 DISPLAY 'UNMATCHED ' QEUP-FEIN ' ' QEUP-NAME-LINE-1 DTSBD640 00582 SET R793-POT-EMP-ADDED-88 TO TRUE DTSBD640 00583 PERFORM P7000-GENERATE-R793 THRU P7000-EXIT DTSBD640 00584 END-IF DTSBD640 00585 ELSE DTSBD640 00586 DISPLAY 'Z' QEUP-FEIN ' ' MPRF-EMP-NO ' ' MPRF-PRIMARY-NAME DTSBD640 00587 ADD +1 TO QEUP-MATCHED-REC-CNT DTSBD640 00588 SET R793-POT-EMP-FOUND-88 TO TRUE DTSBD640 00589 PERFORM P7000-GENERATE-R793 THRU P7000-EXIT DTSBD640 00590 END-IF. DTSBD640 00591 DTSBD640 00592 P2000-EXIT. DTSBD640 00593 EXIT. DTSBD640 00594 DTSBD640 00595 P2100-FIND-MPRF. DTSBD640 00596 MOVE LOW-VALUE TO MSKL-KEY-AREA. DTSBD640 00597 MOVE IEIN-EMP-NO TO MSKL-EMP-NO. DTSBD640 00598 SET MSKL-PRF-88 TO TRUE. DTSBD640 00599 DTSBD640 00600 PERFORM S910-READ THRU S910-EXIT. DTSBD640 00601 IF L910-NO-REC-88 DTSBD640 00602 NEXT SENTENCE DTSBD640 00603 ELSE DTSBD640 00604 MOVE MSKL-REC TO MPRF-REC DTSBD640 00605 IF NOT MPRF-CLASS-SUB-88 DTSBD640 00606 MOVE MPRF-EMP-NO TO W-NOT-LIAB-EMP-NO DTSBD640 00607 MOVE MPRF-EMP-STATUS TO W-EMP-STATUS DTSBD640 00608 ELSE DTSBD640 00609 MOVE MPRF-EMP-STATUS TO W-EMP-STATUS DTSBD640 00610 MOVE MPRF-EMP-NO TO W-FEIN-EMP-NO DTSBD640 00611 END-IF DTSBD640 00612 END-IF. DTSBD640 00613 DTSBD640 00614 IF QEUP-FEIN = 203380822 DTSBD640 00615 DISPLAY '* ' QEUP-FEIN ' ' MPRF-EMP-NO ' ' DTSBD640 00616 W-NOT-LIAB-EMP-NO ' ' W-EMP-STATUS DTSBD640 00617 ' ' W-FEIN-EMP-NO DTSBD640 00618 END-IF. DTSBD640 00619 DTSBD640 00620 P2100-EXIT. DTSBD640 00621 EXIT. DTSBD640 00622 DTSBD640 00623 P2200-NEXT-EMP-NO. DTSBD640 00624 IF MHDR-LAST-USED-EMP-NO < 999999 DTSBD640 00625 NEXT SENTENCE DTSBD640 00626 ELSE DTSBD640 00627 PERFORM S999-ABEND THRU S999-EXIT DTSBD640 00628 END-IF. DTSBD640 00629 DTSBD640 00630 SET W-EMP-NO-UNUSED-NO-88 TO TRUE. DTSBD640 00631 DTSBD640 00632 ADD +1 TO MHDR-LAST-USED-EMP-NO. DTSBD640 00633 DTSBD640 00634 PERFORM DTSBD640 00635 VARYING SUB1 FROM +1 BY +1 DTSBD640 00636 UNTIL (SUB1 > CENO-AVAILABLE-RANGE-CNT) DTSBD640 00637 OR (W-EMP-NO-UNUSED-YES-88) DTSBD640 00638 IF (MHDR-LAST-USED-EMP-NO DTSBD640 00639 >= CENO-AVAILABLE-START-EMP-NO (SUB1)) DTSBD640 00640 AND (MHDR-LAST-USED-EMP-NO DTSBD640 00641 <= CENO-AVAILABLE-END-EMP-NO (SUB1)) DTSBD640 00642 SET W-EMP-NO-UNUSED-YES-88 TO TRUE DTSBD640 00643 END-IF DTSBD640 00644 END-PERFORM. DTSBD640 00645 DTSBD640 00646 P2200-EXIT. DTSBD640 00647 EXIT. DTSBD640 00648 DTSBD640 00649 P3000-ADD-T002. DTSBD640 00650 PERFORM P3100-PROFILE THRU P3100-EXIT. DTSBD640 00651 PERFORM P3200-ADDRESS THRU P3200-EXIT. DTSBD640 00652 PERFORM P3400-T001 THRU P3400-EXIT. DTSBD640 00653 ** PERFORM P3300-NAME THRU P3300-EXIT. DTSBD640 00654 DTSBD640 00655 P3000-EXIT. DTSBD640 00656 EXIT. DTSBD640 00657 DTSBD640 00658 P3100-PROFILE. DTSBD640 00659 MOVE LOW-VALUES TO T002-REC. DTSBD640 00660 DTSBD640 00661 SET T002-LENGTH-DETERM-88 TO TRUE. DTSBD640 00662 MOVE '002' TO T002-REC-TYPE. DTSBD640 00663 MOVE MHDR-LAST-USED-EMP-NO TO T002-EMP-NO. DTSBD640 00664 MOVE 'FUTA EIN ' TO T002-ORIGIN. DTSBD640 00665 MOVE MHDR-CURR-RUN-DATE TO T002-SYS-DATE. DTSBD640 00666 ADD +1000 TO L005-TIME. DTSBD640 00667 MOVE L005-TIME TO T002-SYS-TIME. DTSBD640 00668 DTSBD640 00669 MOVE QEUP-FEIN TO Y104-FEIN. DTSBD640 00670 DTSBD640 00671 PERFORM P3110-NAME THRU P3110-EXIT. DTSBD640 00672 SET Y104-STAFF-REVIEW-YES-88 TO TRUE. DTSBD640 00673 SET Y104-SOURCE-FEIN-LIST-88 TO TRUE. DTSBD640 00674 MOVE SPACES TO Y104-LIAB-CD DTSBD640 00675 Y104-ELIG-CD. DTSBD640 00676 MOVE 999999 TO Y104-NAICS. DTSBD640 00677 MOVE SPACES TO Y104-OWN-CD. DTSBD640 00678 SET MPRF-ORG-UNK-88 TO TRUE. DTSBD640 00679 MOVE SPACES TO Y104-HOUSEHOLD-FILING. DTSBD640 00680 MOVE SPACES TO Y104-CORP-STATE. DTSBD640 00681 MOVE ZEROS TO Y104-CORP-DATE DTSBD640 00682 Y104-FIRST-WAGE-DT DTSBD640 00683 Y104-FIRST-500-QTR DTSBD640 00684 Y104-LAST-WAGE-DT. DTSBD640 00685 SET Y104-ACQUIRE-NO-88 TO TRUE. DTSBD640 00686 SET Y104-MERGE-SPLIT-NO-88 TO TRUE. DTSBD640 00687 SET Y104-REORG-NO-88 TO TRUE. DTSBD640 00688 SET Y104-COMMON-OWN-NO-88 TO TRUE. DTSBD640 00689 MOVE SPACES TO Y104-SALE-TRANSFER-IND. DTSBD640 00690 STRING DTSBD640 00691 QEUP-ZIP-1-5 '-' QEUP-ZIP-6-9 DTSBD640 00692 DELIMITED BY SIZE DTSBD640 00693 INTO Y104-FIELD-ZIP DTSBD640 00694 END-STRING. DTSBD640 00695 MOVE QEUP-STATE-CODE TO Y104-FIELD-STATE. DTSBD640 00696 SET Y104-NOT-LIAB-NULL-88 TO TRUE. DTSBD640 00697 DTSBD640 00698 MOVE Y104-REC TO T002-DATA-AREA. DTSBD640 00699 SET T002-DETERM-88 TO TRUE. DTSBD640 00700 ** MOVE T002-REC TO TSKL-REC. DTSBD640 00701 ** PERFORM S927B-WRITE THRU S927B-EXIT. DTSBD640 00702 ADD +1 TO W-PROFILE-CNT. DTSBD640 00703 DTSBD640 00704 SET L142-PROCESS-88 TO TRUE. DTSBD640 00705 PERFORM S142-NEW-EMP THRU S142-EXIT. DTSBD640 00706 DTSBD640 00707 P3100-EXIT. DTSBD640 00708 EXIT. DTSBD640 00709 DTSBD640 00710 DTSBD640 00711 P3110-NAME. DTSBD640 00712 SET W-END-FOUND-NO-88 TO TRUE. DTSBD640 00713 MOVE 0 TO SUB2. DTSBD640 00714 DTSBD640 00715 PERFORM DTSBD640 00716 VARYING SUB1 FROM +35 BY -1 DTSBD640 00717 UNTIL SUB1 < 1 OR W-END-FOUND-YES-88 DTSBD640 00718 IF QEUP-NAME-LINE-1 (SUB1:1) > SPACE DTSBD640 00719 MOVE SUB1 TO SUB2 DTSBD640 00720 SET W-END-FOUND-YES-88 TO TRUE DTSBD640 00721 END-IF DTSBD640 00722 END-PERFORM. DTSBD640 00723 DTSBD640 00724 ** DISPLAY 'P3110 ' QEUP-NAME-LINE-1 ' ' SUB1 ' ' SUB2 DTSBD640 00725 COMPUTE SUB3 = 35 - SUB2. DTSBD640 00726 IF SUB3 > +0 DTSBD640 00727 STRING DTSBD640 00728 QEUP-NAME-LINE-1 (1:SUB2) DTSBD640 00729 QEUP-NAME-LINE-2 (1:SUB3) DTSBD640 00730 QEUP-NAME-LINE-2 ((SUB3 + 1):5) DTSBD640 00731 DELIMITED BY SIZE DTSBD640 00732 INTO Y104-ENTITY-NAME DTSBD640 00733 END-STRING DTSBD640 00734 ELSE DTSBD640 00735 STRING DTSBD640 00736 QEUP-NAME-LINE-1 DTSBD640 00737 QEUP-NAME-LINE-2 (1:5) DTSBD640 00738 DELIMITED BY SIZE DTSBD640 00739 INTO Y104-ENTITY-NAME DTSBD640 00740 END-STRING DTSBD640 00741 END-IF. DTSBD640 00742 ** DISPLAY Y104-ENTITY-NAME. DTSBD640 00743 MOVE SPACES TO Y104-TRADE-NAME. DTSBD640 00744 DTSBD640 00745 P3110-EXIT. DTSBD640 00746 EXIT. DTSBD640 00747 DTSBD640 00748 P3200-ADDRESS. DTSBD640 00749 MOVE LOW-VALUES TO T002-REC. DTSBD640 00750 DTSBD640 00751 SET T002-LENGTH-EMP-ADDR-88 TO TRUE. DTSBD640 00752 MOVE '002' TO T002-REC-TYPE. DTSBD640 00753 MOVE MHDR-LAST-USED-EMP-NO TO T002-EMP-NO. DTSBD640 00754 MOVE 'FUTA EIN ' TO T002-ORIGIN. DTSBD640 00755 MOVE MHDR-CURR-RUN-DATE TO T002-SYS-DATE. DTSBD640 00756 ADD +1000 TO L005-TIME. DTSBD640 00757 MOVE L005-TIME TO T002-SYS-TIME. DTSBD640 00758 DTSBD640 00759 SET Y110-EMP-ADDR-TYPE-MAIL-88 TO TRUE. DTSBD640 00760 IF QEUP-NAME-LINE-4 (1:1) = '%' DTSBD640 00761 MOVE QEUP-NAME-LINE-4 TO Y110-EMP-ATTN DTSBD640 00762 ELSE DTSBD640 00763 MOVE SPACES TO Y110-EMP-ATTN DTSBD640 00764 END-IF. DTSBD640 00765 DTSBD640 00766 MOVE SPACES TO Y110-EMP-DELV1. DTSBD640 00767 MOVE QEUP-STREET-ADDRESS TO Y110-EMP-DELV2. DTSBD640 00768 MOVE QEUP-CITY TO Y110-EMP-CITY. DTSBD640 00769 MOVE QEUP-STATE-CODE TO Y110-EMP-STATE. DTSBD640 00770 STRING DTSBD640 00771 QEUP-ZIP-1-5 '-' QEUP-ZIP-6-9 DTSBD640 00772 DELIMITED BY SIZE DTSBD640 00773 INTO Y110-EMP-ZIP DTSBD640 00774 END-STRING. DTSBD640 00775 DTSBD640 00776 MOVE SPACES TO Y110-EMP-VOICE DTSBD640 00777 Y110-EMP-FAX DTSBD640 00778 Y110-EMP-EMAIL. DTSBD640 00779 DTSBD640 00780 MOVE Y110-REC TO T002-DATA-AREA. DTSBD640 00781 SET T002-EMP-ADDR-88 TO TRUE. DTSBD640 00782 MOVE T002-REC TO TSKL-REC. DTSBD640 00783 PERFORM S927B-WRITE THRU S927B-EXIT. DTSBD640 00784 ADD +1 TO W-ADDRESS-CNT. DTSBD640 00785 DTSBD640 00786 P3200-EXIT. DTSBD640 00787 EXIT. DTSBD640 00788 DTSBD640 00789 *P3300-NAME. DTSBD640 00790 * MOVE LOW-VALUES TO T002-REC. DTSBD640 00791 * DTSBD640 00792 * SET T002-LENGTH-DETERM-88 TO TRUE. DTSBD640 00793 * MOVE '002' TO T002-REC-TYPE. DTSBD640 00794 * MOVE MHDR-LAST-USED-EMP-NO TO T002-EMP-NO. DTSBD640 00795 * MOVE 'FUTA EIN ' TO T002-ORIGIN. DTSBD640 00796 * MOVE MHDR-CURR-RUN-DATE TO T002-SYS-DATE. DTSBD640 00797 * ADD +1000 TO L005-TIME. DTSBD640 00798 * MOVE L005-TIME TO T002-SYS-TIME. DTSBD640 00799 * DTSBD640 00800 *P3300-EXIT. DTSBD640 00801 * EXIT. DTSBD640 00802 DTSBD640 00803 P3400-T001. DTSBD640 00804 MOVE LOW-VALUES TO T001-REC. DTSBD640 00805 DTSBD640 00806 MOVE LENGTH OF T001-REC TO T001-LENGTH. DTSBD640 00807 MOVE '001' TO T001-REC-TYPE. DTSBD640 00808 MOVE MHDR-LAST-USED-EMP-NO TO T001-EMP-NO. DTSBD640 00809 MOVE 'FUTA EIN ' TO T001-ORIGIN. DTSBD640 00810 MOVE L005-DATE TO T001-SYS-DATE. DTSBD640 00811 ADD +1000 TO L005-TIME. DTSBD640 00812 MOVE L005-TIME TO T001-SYS-TIME. DTSBD640 00813 DTSBD640 00814 SET T001-ERA-CYCLE TO TRUE. DTSBD640 00815 DTSBD640 00816 MOVE T001-REC TO TSKL-REC. DTSBD640 00817 DTSBD640 00818 PERFORM S927B-WRITE THRU S927B-EXIT. DTSBD640 00819 ADD 1 TO WRK-T001-ADD-CNT. DTSBD640 00820 P3400-EXIT. DTSBD640 00821 EXIT. DTSBD640 00822 DTSBD640 00823 P4000-ADD-MNTE. DTSBD640 00824 MOVE LOW-VALUES TO MNTE-REC. DTSBD640 00825 MOVE MHDR-LAST-USED-EMP-NO TO MNTE-EMP-NO. DTSBD640 00826 SET MNTE-NTE-88 TO TRUE. DTSBD640 00827 MOVE +0 TO MNTE-PURGE-DATE. DTSBD640 00828 SET MNTE-NOT-CONVERTED-88 TO TRUE. DTSBD640 00829 DTSBD640 00830 MOVE MHDR-CURR-RUN-DATE TO MNTE-ESTB-DATE DTSBD640 00831 MNTE-CHNG-DATE. DTSBD640 00832 MOVE ZERO TO MNTE-KEY-ESTB-ABSTIME DTSBD640 00833 MNTE-DATA-ESTB-ABSTIME DTSBD640 00834 MNTE-CHNG-ABSTIME. DTSBD640 00835 MOVE 'FUTA EIN' TO MNTE-ESTB-OP-ID DTSBD640 00836 MNTE-CHNG-OP-ID. DTSBD640 00837 DTSBD640 00838 MOVE 'ADDED FROM FUTA EIN' TO MNTE-SUBJECT. DTSBD640 00839 DTSBD640 00840 * PERFORM DTSBD640 00841 * VARYING W-MNTE-IDX FROM +1 BY +1 DTSBD640 00842 * UNTIL W-MNTE-IDX > +16 DTSBD640 00843 * MOVE SPACES TO MNTE-TEXT (W-MNTE-IDX) DTSBD640 00844 * END-PERFORM. DTSBD640 00845 DTSBD640 00846 MOVE +0 TO MNTE-TEXT-CNT. DTSBD640 00847 DTSBD640 00848 IF QEUP-NAME-LINE-3 > SPACES DTSBD640 00849 ADD +1 TO MNTE-TEXT-CNT DTSBD640 00850 STRING DTSBD640 00851 'ADDITIONAL NAME: ' QEUP-NAME-LINE-3 DTSBD640 00852 DELIMITED BY SIZE DTSBD640 00853 INTO MNTE-TEXT (MNTE-TEXT-CNT) DTSBD640 00854 END-STRING DTSBD640 00855 END-IF. DTSBD640 00856 DTSBD640 00857 IF QEUP-XREF-FEIN > ZERO DTSBD640 00858 ADD +1 TO MNTE-TEXT-CNT DTSBD640 00859 STRING DTSBD640 00860 'PREVIOUS FEIN: ' QEUP-XREF-FEIN DTSBD640 00861 DELIMITED BY SIZE DTSBD640 00862 INTO MNTE-TEXT (MNTE-TEXT-CNT) DTSBD640 00863 END-STRING DTSBD640 00864 END-IF. DTSBD640 00865 DTSBD640 00866 EVALUATE TRUE DTSBD640 00867 WHEN QEUP-FORM-940-YES-88 DTSBD640 00868 SET W-IRS-FORM-940-88 TO TRUE DTSBD640 00869 DTSBD640 00870 WHEN QEUP-FORM-940EZ-YES-88 DTSBD640 00871 SET W-IRS-FORM-940EZ-88 TO TRUE DTSBD640 00872 DTSBD640 00873 WHEN QEUP-FORM-941-YES-88 DTSBD640 00874 SET W-IRS-FORM-941-88 TO TRUE DTSBD640 00875 DTSBD640 00876 WHEN QEUP-FORM-942-YES-88 DTSBD640 00877 SET W-IRS-FORM-942-88 TO TRUE DTSBD640 00878 DTSBD640 00879 WHEN QEUP-FORM-943-YES-88 DTSBD640 00880 SET W-IRS-FORM-943-88 TO TRUE DTSBD640 00881 DTSBD640 00882 WHEN OTHER DTSBD640 00883 SET W-IRS-FORM-NULL-88 TO TRUE DTSBD640 00884 END-EVALUATE. DTSBD640 00885 DTSBD640 00886 IF NOT W-IRS-FORM-NULL-88 DTSBD640 00887 ADD +1 TO MNTE-TEXT-CNT DTSBD640 00888 STRING DTSBD640 00889 'IRS FORM: ' W-IRS-FORM-IND DTSBD640 00890 DELIMITED BY SIZE DTSBD640 00891 INTO MNTE-TEXT (MNTE-TEXT-CNT) DTSBD640 00892 END-STRING DTSBD640 00893 END-IF. DTSBD640 00894 DTSBD640 00895 EVALUATE TRUE DTSBD640 00896 WHEN QEUP-TRAN-NEW-ACCOUNT-YES-88 DTSBD640 00897 SET W-TRANS-CODE-NEW-88 TO TRUE DTSBD640 00898 DTSBD640 00899 WHEN QEUP-TRAN-FEIN-CHANGE-YES-88 DTSBD640 00900 SET W-TRANS-CODE-FEIN-88 TO TRUE DTSBD640 00901 DTSBD640 00902 WHEN QEUP-TRAN-NAME-CHANGE-YES-88 DTSBD640 00903 SET W-TRANS-CODE-NAME-88 TO TRUE DTSBD640 00904 DTSBD640 00905 WHEN OTHER DTSBD640 00906 SET W-TRANS-CODE-NULL-88 TO TRUE DTSBD640 00907 DTSBD640 00908 END-EVALUATE. DTSBD640 00909 DTSBD640 00910 IF NOT W-TRANS-CODE-NULL-88 DTSBD640 00911 ADD +1 TO MNTE-TEXT-CNT DTSBD640 00912 STRING DTSBD640 00913 'REASON: ' W-TRANS-CODE DTSBD640 00914 DELIMITED BY SIZE DTSBD640 00915 INTO MNTE-TEXT (MNTE-TEXT-CNT) DTSBD640 00916 END-STRING DTSBD640 00917 END-IF. DTSBD640 00918 DTSBD640 00919 MOVE LENGTH OF T003-REC TO T003-LENGTH DTSBD640 00920 MOVE '003' TO T003-REC-TYPE. DTSBD640 00921 MOVE MHDR-LAST-USED-EMP-NO TO T003-EMP-NO. DTSBD640 00922 MOVE 'FUTA EIN ' TO T003-ORIGIN. DTSBD640 00923 MOVE L005-DATE TO T003-SYS-DATE. DTSBD640 00924 ADD +1000 TO L005-TIME. DTSBD640 00925 MOVE L005-TIME TO T003-SYS-TIME. DTSBD640 00926 SET T003-ADD-MNTE-88 TO TRUE. DTSBD640 00927 MOVE MNTE-REC TO T003-MNTE-REC. DTSBD640 00928 DTSBD640 00929 MOVE T003-REC TO TSKL-REC. DTSBD640 00930 PERFORM S927B-WRITE THRU S927B-EXIT. DTSBD640 00931 ADD +1 TO W-MNTE-CNT. DTSBD640 00932 DTSBD640 00933 IF MNTE-TEXT-CNT > +0 DTSBD640 00934 DISPLAY 'NOTE ' QEUP-FEIN ' ' DTSBD640 00935 MHDR-LAST-USED-EMP-NO DTSBD640 00936 PERFORM DTSBD640 00937 VARYING SUB1 FROM +1 BY +1 DTSBD640 00938 UNTIL SUB1 > MNTE-TEXT-CNT DTSBD640 00939 DISPLAY MNTE-TEXT (SUB1) DTSBD640 00940 END-PERFORM DTSBD640 00941 END-IF. DTSBD640 00942 DTSBD640 00943 P4000-EXIT. DTSBD640 00944 * EXIT. DTSBD640 00945 DTSBD640 00946 P7000-GENERATE-R793. DTSBD640 00947 MOVE QEUP-FEIN TO R793-FEIN. DTSBD640 00948 DTSBD640 00949 MOVE QEUP-ZIP-CODE TO R793-ZIP-CODE. DTSBD640 00950 DTSBD640 00951 MOVE QEUP-STATE-CODE TO R793-STATE-CODE. DTSBD640 00952 DTSBD640 00953 MOVE QEUP-CITY TO R793-CITY. DTSBD640 00954 DTSBD640 00955 MOVE QEUP-STREET-ADDRESS TO R793-STREET-ADDRESS. DTSBD640 00956 DTSBD640 00957 MOVE QEUP-NAME-LINE-1 TO R793-NAME-LINE-1. DTSBD640 00958 DTSBD640 00959 MOVE QEUP-NAME-LINE-2 TO R793-NAME-LINE-2. DTSBD640 00960 DTSBD640 00961 MOVE QEUP-NAME-LINE-3 TO R793-NAME-LINE-3. DTSBD640 00962 DTSBD640 00963 MOVE QEUP-NAME-LINE-4 TO R793-NAME-LINE-4. DTSBD640 00964 MOVE QEUP-TRAN-NEW-ACCOUNT-IND TO R793-NEW-ACCT-IND DTSBD640 00965 MOVE QEUP-TRAN-FEIN-CHANGE-IND TO R793-FEIN-CHNG-IND DTSBD640 00966 MOVE QEUP-TRAN-NAME-CHANGE-IND TO R793-NAME-CHNG-IND DTSBD640 00967 MOVE QEUP-TRANSACTION-DATE TO R793-TRAN-DATE DTSBD640 00968 * MOVE ZEROS TO R793-EMP-NO DTSBD640 00969 * MOVE SPACES TO R793-EMP-NAME DTSBD640 00970 * MOVE ZEROS TO R793-EMP-DATE DTSBD640 00971 * MOVE SPACES TO R793-EMP-CLASS DTSBD640 00972 * MOVE SPACES TO R793-EMP-STATUS DTSBD640 00973 * MOVE SPACES TO R793-ORG-TYPE DTSBD640 00974 * MOVE SPACES TO R793-RTN-MAIL DTSBD640 00975 DTSBD640 00976 * IF R793-POT-EMP-FOUND-88 DTSBD640 00977 MOVE MPRF-EMP-NO TO R793-EMP-NO DTSBD640 00978 MOVE MPRF-PRIMARY-NAME TO R793-EMP-NAME DTSBD640 00979 MOVE MPRF-ESTB-DATE TO R793-EMP-DATE DTSBD640 00980 MOVE MPRF-EMP-CLASS TO R793-EMP-CLASS DTSBD640 00981 MOVE MPRF-EMP-STATUS TO R793-EMP-STATUS DTSBD640 00982 MOVE MPRF-ORG-TYPE TO R793-ORG-TYPE DTSBD640 00983 MOVE MPRF-RETURN-MAIL-IND TO R793-RTN-MAIL. DTSBD640 00984 DTSBD640 00985 PERFORM S946-WRITE-R793 THRU S946-EXIT. DTSBD640 00986 DTSBD640 00987 P7000-EXIT. DTSBD640 00988 EXIT. DTSBD640 00989 DTSBD640 00990 T0000-TERMINATE. DTSBD640 00991 DISPLAY ' '. DTSBD640 00992 DTSBD640 00993 DISPLAY '*** DTSBD640 TERMINATION STATISTICS'. DTSBD640 00994 DTSBD640 00995 DISPLAY ' '. DTSBD640 00996 DTSBD640 00997 DISPLAY '*** ' DTSBD640 00998 QEUP-INPUT-REC-CNT DTSBD640 00999 ' QUARTERLY ENTITY UPDATE RECORDS RECEIVED FROM IRS'.DTSBD640 01000 DTSBD640 01001 DISPLAY '*** '. DTSBD640 01002 DTSBD640 01003 DISPLAY '*** ' DTSBD640 01004 QEUP-ERROR-REC-CNT DTSBD640 01005 ' RECORDS NOT PROCESSED - ERRORS DETECTED'. DTSBD640 01006 DTSBD640 01007 DISPLAY '*** '. DTSBD640 01008 DTSBD640 01009 DISPLAY '*** ' DTSBD640 01010 QEUP-MATCHED-REC-CNT DTSBD640 01011 ' RECORDS MATCHED TO UI TAX EMPLOYERS -' DTSBD640 01012 ' NO ACTION TAKEN'. DTSBD640 01013 *** ' NO LETTER GENERATED'. DTSBD640 01014 DTSBD640 01015 DISPLAY '*** '. DTSBD640 01016 DTSBD640 01017 DISPLAY '*** ' DTSBD640 01018 QEUP-UNMATCHED-REC-CNT DTSBD640 01019 ' RECORDS NOT MATCHED TO UI TAX EMPLOYERS -' DTSBD640 01020 ' POTENTIAL EMPLOYER CREATED'. DTSBD640 01021 *** ' LETTER GENERATED'. DTSBD640 01022 DTSBD640 01023 DISPLAY '*** ' DTSBD640 01024 WRK-T001-ADD-CNT DTSBD640 01025 ' TOTAL CYCLE A LETTERS PRODUCED '. DTSBD640 01026 * ' POTENTIAL EMPLOYER CREATED'. DTSBD640 01027 *** ' LETTER GENERATED'. DTSBD640 01028 DTSBD640 01029 DISPLAY '*** '. DTSBD640 01030 DTSBD640 01031 DISPLAY '*** ' DTSBD640 01032 MATCHED-NOT-LIAB-CNT DTSBD640 01033 ' RECORDS MATCHED TO NON-LIABLE ACCOUNT -' DTSBD640 01034 ' NO ACTION TAKEN'. DTSBD640 01035 *** ' LETTER GENERATED'. DTSBD640 01036 DTSBD640 01037 DISPLAY '*** '. DTSBD640 01038 DTSBD640 01039 CLOSE QUARTERLY-ENTITY-UPDATE-FILE. DTSBD640 01040 DTSBD640 01041 SET L142-TERMINATE-88 TO TRUE. DTSBD640 01042 PERFORM S142-NEW-EMP THRU S142-EXIT. DTSBD640 01043 DTSBD640 01044 * PERFORM T1000-UPDATE-HDR THRU T1000-EXIT. CL**3 01045 DTSBD640 01046 PERFORM S910-CLOSE THRU S910-EXIT. DTSBD640 01047 DTSBD640 01048 PERFORM S921-CLOSE THRU S921-EXIT. DTSBD640 01049 DTSBD640 01050 PERFORM S927C-CLOSE THRU S927C-EXIT. DTSBD640 01051 DTSBD640 01052 MOVE -1 TO R793-LENGTH. DTSBD640 01053 DTSBD640 01054 PERFORM S946-WRITE-R793 THRU S946-EXIT. DTSBD640 01055 T0000-EXIT. DTSBD640 01056 EXIT. DTSBD640 01057 DTSBD640 01058 T1000-UPDATE-HDR. DTSBD640 01059 * MOVE LOW-VALUES TO MHDR-KEY-AREA. DTSBD640 01060 * MOVE +0 TO MHDR-EMP-NO. DTSBD640 01061 * SET MHDR-HDR-88 TO TRUE. DTSBD640 01062 * MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA. DTSBD640 01063 DTSBD640 01064 * PERFORM S910-READ THRU S910-EXIT. DTSBD640 01065 DTSBD640 01066 * IF L910-NO-REC-88 DTSBD640 01067 * MOVE 'MHDR RECORD NOT FOUND (T0000)' DTSBD640 01068 * TO ABEND-MSG DTSBD640 01069 * PERFORM S999-ABEND THRU S999-EXIT. DTSBD640 01070 DTSBD640 01071 * MOVE MSKL-REC TO MHDR-REC. DTSBD640 01072 DTSBD640 01073 * MOVE WRK-ASSIGN-NO TO MHDR-LAST-USED-ASSIGN-NO. DTSBD640 01074 DTSBD640 01075 DTSBD640 01076 MOVE MHDR-CURR-RUN-DATE TO MHDR-CHNG-DATE. DTSBD640 01077 MOVE MHDR-REC TO MSKL-REC. DTSBD640 01078 DTSBD640 01079 PERFORM S910-REWRITE THRU S910-EXIT. DTSBD640 01080 DTSBD640 01081 T1000-EXIT. DTSBD640 01082 EXIT. DTSBD640 01083 DTSBD640 01084 S142-NEW-EMP. DTSBD640 01085 CALL 'DTSBD142' USING L142-LINK-AREA DTSBD640 01086 T002-REC. DTSBD640 01087 DTSBD640 01088 S142-EXIT. DTSBD640 01089 EXIT. DTSBD640 01090 DTSBD640 01091 S005-SYS-DATE. DTSBD640 01092 CALL 'DTSBU005' USING L005-COMM-AREA. DTSBD640 01093 DTSBD640 01094 S005-EXIT. DTSBD640 01095 EXIT. DTSBD640 01096 DTSBD640 01097 S910-OPEN-READ. DTSBD640 01098 SET L910-OPEN-READ-88 TO TRUE. DTSBD640 01099 GO TO S910-MSTR-IO. DTSBD640 01100 DTSBD640 01101 S910-OPEN-UPDATE. DTSBD640 01102 SET L910-OPEN-UPDATE-88 TO TRUE. DTSBD640 01103 GO TO S910-MSTR-IO. DTSBD640 01104 DTSBD640 01105 S910-READ. DTSBD640 01106 SET L910-READ-88 TO TRUE. DTSBD640 01107 GO TO S910-MSTR-IO. DTSBD640 01108 DTSBD640 01109 S910-REWRITE. DTSBD640 01110 SET L910-REWRITE-88 TO TRUE. DTSBD640 01111 GO TO S910-MSTR-IO. DTSBD640 01112 DTSBD640 01113 *S910-READ-NEXT. DTSBD640 01114 *****SET L910-READ-NEXT-88 TO TRUE. DTSBD640 01115 *****GO TO S910-MSTR-IO. DTSBD640 01116 DTSBD640 01117 *S910-COUNT. DTSBD640 01118 *****SET L910-COUNT-88 TO TRUE. DTSBD640 01119 *****GO TO S910-MSTR-IO. DTSBD640 01120 DTSBD640 01121 S910-CLOSE. DTSBD640 01122 SET L910-CLOSE-88 TO TRUE. DTSBD640 01123 GO TO S910-MSTR-IO. DTSBD640 01124 DTSBD640 01125 S910-MSTR-IO. DTSBD640 01126 CALL 'DTSBU910' USING L910-LINK-AREA DTSBD640 01127 MSKL-REC. DTSBD640 01128 S910-EXIT. DTSBD640 01129 EXIT. DTSBD640 01130 DTSBD640 01131 S921-OPEN-READ. DTSBD640 01132 SET L921-OPEN-READ-88 TO TRUE. DTSBD640 01133 GO TO S921-AIX-IO. DTSBD640 01134 DTSBD640 01135 S921-OPEN-UPDATE. DTSBD640 01136 SET L921-OPEN-UPDATE-88 TO TRUE. DTSBD640 01137 GO TO S921-AIX-IO. DTSBD640 01138 DTSBD640 01139 *S921-READ. DTSBD640 01140 *****SET L921-READ-88 TO TRUE. DTSBD640 01141 *****GO TO S921-AIX-IO. DTSBD640 01142 DTSBD640 01143 S921-START-BROWSE. DTSBD640 01144 SET L921-START-BROWSE-88 TO TRUE. DTSBD640 01145 GO TO S921-AIX-IO. DTSBD640 01146 DTSBD640 01147 S921-READ-NEXT. DTSBD640 01148 SET L921-READ-NEXT-88 TO TRUE. DTSBD640 01149 GO TO S921-AIX-IO. DTSBD640 01150 DTSBD640 01151 S921-CLOSE. DTSBD640 01152 SET L921-CLOSE-88 TO TRUE. DTSBD640 01153 GO TO S921-AIX-IO. DTSBD640 01154 DTSBD640 01155 S921-AIX-IO. DTSBD640 01156 CALL 'DTSBU921' USING L921-LINK-AREA DTSBD640 01157 ISKL-REC. DTSBD640 01158 S921-EXIT. DTSBD640 01159 EXIT. DTSBD640 01160 DTSBD640 01161 S927A-OPEN. DTSBD640 01162 SET L927-OPEN-UPDATE-88 TO TRUE. DTSBD640 01163 PERFORM S927Z-IO THRU S927Z-EXIT. DTSBD640 01164 DTSBD640 01165 S927A-EXIT. DTSBD640 01166 EXIT. DTSBD640 01167 DTSBD640 01168 S927B-WRITE. DTSBD640 01169 SET L927-WRITE-88 TO TRUE. DTSBD640 01170 PERFORM S927Z-IO THRU S927Z-EXIT. DTSBD640 01171 DTSBD640 01172 S927B-EXIT. DTSBD640 01173 EXIT. DTSBD640 01174 DTSBD640 01175 S927C-CLOSE. DTSBD640 01176 SET L927-CLOSE-88 TO TRUE. DTSBD640 01177 PERFORM S927Z-IO THRU S927Z-EXIT. DTSBD640 01178 DTSBD640 01179 S927C-EXIT. DTSBD640 01180 EXIT. DTSBD640 01181 DTSBD640 01182 DTSBD640 01183 S927Z-IO. DTSBD640 01184 CALL 'DTSBU927' USING L927-LINK-AREA DTSBD640 01185 TSKL-REC. DTSBD640 01186 S927Z-EXIT. DTSBD640 01187 EXIT. DTSBD640 01188 DTSBD640 01189 S946-WRITE-R793. DTSBD640 01190 CALL 'DTSBU946' USING R793-REC. DTSBD640 01191 GO TO S946-EXIT. DTSBD640 01192 DTSBD640 01193 S946-WRITE-R907. DTSBD640 01194 CALL 'DTSBU946' USING R907-REC. DTSBD640 01195 GO TO S946-EXIT. DTSBD640 01196 DTSBD640 01197 S946-EXIT. DTSBD640 01198 EXIT. DTSBD640 01199 DTSBD640 01200 S999-ABEND. DTSBD640 01201 CALL 'DTSBU999' USING W-ABEND-CD. DTSBD640 01202 S999-EXIT. DTSBD640 01203 *****EXIT. DTSBD640