giteaadmin/DUTAS
4
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
Dutas-Dev-Update
DUTAS/Batch/DTSBD640.cob
Neeraj Kumar ca3572c5df DUTAS re-platformed to Raincode - Initial Source Code
2025-07-21 11:20:11 -04:00

1205 lines
95 KiB
COBOL
Raw Permalink Blame History

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
Reference in New Issue View Git Blame Copy Permalink