00001 IDENTIFICATION DIVISION. 05/05/22 00002 PROGRAM-ID. DTSBR793. DTSBR793 00003 AUTHOR. D.SHEPPERSON LV003 00004 DATE-WRITTEN. JULY 1999. DTSBR793 00005 DATE-COMPILED. DTSBR793 00006 SKIP3 DTSBR793 00007 ***** DTSBR793 00008 * DTSBR793 00009 * CALLING SEQUENCE: DTSBD640 CREATES DTSIR793 RECORDS. DTSBR793 00010 * DTSBD800 CALLS DTSBR793 DTSBR793 00011 * WHICH PRODUCES THE FEDERAL ID LETTER. DTSBR793 00012 * DTSBR793 00013 * FUNCTION: REQUEST FOR FEDERAL ID LETTER DTSBR793 00014 * DTSBR793 00015 * DTSBR793 00016 * MODIFICATION HISTORY: DTSBR793 00017 * DTSBR793 00018 * 07-28-1999 INITIAL DEVELOPMENT DTSBR793 00019 * REFERENCE RFP #RAP AUTHOR OF CHANGE - SFW DTSBR793 00020 * DTSBR793 00021 * 04-04-2006 MODIFIED PROGRAM TO PRODUCE A DETAIL REPORT. DTSBR793 00022 * REFERENCE RFP AUTHOR OF CHANGE - ZL1 DTSBR793 00023 * DTSBR793 00024 * 05-05-2022 MODIFIED PROGRAM TO PRINT FEIN ON LETTER CL**3 00025 * REFERENCE PROGRAM AUTHOR OF CHANGE - ZL1 CL**3 00026 * CL**3 00027 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR793 00028 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBR793 00029 * REFERENCE RFP #**** AUTHOR OF CHANGE - XXX DTSBR793 00030 * DTSBR793 00031 * DTSBR793 00032 * DESCRIPTION: DTSBR793 00033 * DTSBR793 00034 * THIS MODULE GENERATES LETTERS TO BE SENT TO EMPLOYERS DTSBR793 00035 * BASED ON FUTA QUARTER FILE FROM IRS. POTENTIAL EMPLOYER CL**3 00036 * TO DC UI PROGRAM. CL**3 00037 * DTSBR793 00038 * RECORDS READ: DTSBR793 00039 * DTSBR793 00040 * NONE. DTSBR793 00041 * DTSBR793 00042 * DTSBR793 00043 * PRINTED OUTPUTS: DTSBR793 00044 * DTSBR793 00045 * 793R1 REQUEST FOR FEDERAL ID LETTER DTSBR793 00046 * DTSBR793 00047 * DTSBR793 00048 * RECORDS WRITTEN: DTSBR793 00049 * DTSBR793 00050 * NONE. DTSBR793 00051 * DTSBR793 00052 * DTSBR793 00053 * MODULES CALLED: DTSBR793 00054 * DTSBR793 00055 * DTSBR793 00056 * DTSBR793 00057 ***** DTSBR793 00058 EJECT DTSBR793 00059 ENVIRONMENT DIVISION. DTSBR793 00060 SKIP2 DTSBR793 00061 CONFIGURATION SECTION. DTSBR793 00062 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. DTSBR793 00063 INPUT-OUTPUT SECTION. DTSBR793 00064 SKIP1 DTSBR793 00065 FILE-CONTROL. DTSBR793 00066 SELECT FEIN-FILE ASSIGN TO RPT793R1. DTSBR793 00067 SELECT FEIN-FILE2 ASSIGN TO RPT793R2. DTSBR793 00068 SELECT FEIN-FILE3 ASSIGN TO RPT793R3. DTSBR793 00069 SKIP3 DTSBR793 00070 DATA DIVISION. DTSBR793 00071 SKIP3 DTSBR793 00072 FILE SECTION. DTSBR793 00073 SKIP2 DTSBR793 00074 FD FEIN-FILE DTSBR793 00075 LABEL RECORDS ARE OMITTED DTSBR793 00076 DATA RECORD IS FEIN-LETTER. DTSBR793 00077 01 FEIN-LETTER PIC X(133). DTSBR793 00078 DTSBR793 00079 FD FEIN-FILE2 DTSBR793 00080 LABEL RECORDS ARE OMITTED DTSBR793 00081 DATA RECORD IS FEIN-REPORT. DTSBR793 00082 01 FEIN-REPORT PIC X(200). DTSBR793 00083 DTSBR793 00084 FD FEIN-FILE3 DTSBR793 00085 LABEL RECORDS ARE OMITTED DTSBR793 00086 DATA RECORD IS FEIN-REPORT. DTSBR793 00087 01 FEIN-REPORT3 PIC X(133). DTSBR793 00088 DTSBR793 00089 EJECT DTSBR793 00090 WORKING-STORAGE SECTION. DTSBR793 000905 77 PAN-VALET PICTURE X(24) VALUE '003DTSBR793 05/05/22'. DTSBR793 00091 77 PAN-VALET PICTURE X(24) VALUE '052DTSBR793 10/16/19'. DTSBR793 00092 77 PAN-VALET PICTURE X(24) VALUE '045DTSBR793 09/17/19'. DTSBR793 00093 77 PAN-VALET PICTURE X(24) VALUE '050DTSBR793 01/15/14'. DTSBR793 00094 77 PAN-VALET PICTURE X(24) VALUE '002DTSBR793 01/15/14'. DTSBR793 00095 77 PAN-VALET PICTURE X(24) VALUE '048DTSBR793 01/09/07'. DTSBR793 00096 SKIP3 DTSBR793 00097 01 WRK-AREA. DTSBR793 00098 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +793.DTSBR793 00099 05 FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBR793 00100 SKIP1 DTSBR793 00101 05 WS-EMP-NO PIC 999B999. DTSBR793 00102 05 WS-EMP-NO-DISPLAY REDEFINES DTSBR793 00103 WS-EMP-NO PIC X(7). DTSBR793 00104 05 WS-FEIN-NO PIC 99B9999999. DTSBR793 00105 05 WS-FEIN-NO-DISPLAY REDEFINES DTSBR793 00106 WS-FEIN-NO PIC X(10). DTSBR793 00107 05 WS-PAGE-CNT PIC 9(02) VALUE ZERO. DTSBR793 00108 05 WS-LINE-CNT PIC S9(02) VALUE +55. DTSBR793 00109 05 WS-PAGE-CNT3 PIC 9(02) VALUE ZERO. DTSBR793 00110 05 WS-LINE-CNT3 PIC S9(02) VALUE +55. DTSBR793 00111 EJECT DTSBR793 00112 01 R793-LETTER-DATE. DTSBR793 00113 05 FILLER PIC X(50) VALUE SPACES. DTSBR793 00114 05 LETTER-DATE PIC X(10). DTSBR793 00115 DTSBR793 00116 01 R793-LETTER-FEIN. DTSBR793 00117 05 FILLER PIC X(72) VALUE SPACES. CL**3 00118 05 FILLER PIC X(07) VALUE 'FEIN: '. CL**3 00119 05 LTR-FEIN-NO PIC 99B9999999. DTSBR793 00120 01 R793-REPORT. DTSBR793 00121 * 05 FILLER PIC X(03) VALUE SPACES. DTSBR793 00122 05 RPT-FEIN-NO PIC 99B9999999. DTSBR793 00123 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 00124 05 RPT-ADDR1 PIC X(35). DTSBR793 00125 * 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 00126 * 05 RPT-ADDR2 PIC X(35). DTSBR793 00127 * 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 00128 * 05 RPT-ADDR3 PIC X(35). DTSBR793 00129 05 FILLER PIC X(01) VALUE SPACES. DTSBR793 00130 05 RPT-ADDR4 PIC X(35). DTSBR793 00131 05 FILLER PIC X(01) VALUE SPACES. DTSBR793 00132 05 RPT-STREET PIC X(35). DTSBR793 00133 05 FILLER PIC X(01) VALUE SPACES. DTSBR793 00134 05 RPT-CITY PIC X(10). DTSBR793 00135 05 FILLER PIC X(01) VALUE SPACES. DTSBR793 00136 05 RPT-STATE PIC X(02). DTSBR793 00137 05 FILLER PIC X(01) VALUE SPACES. DTSBR793 00138 05 RPT-ZIP PIC X(05). DTSBR793 00139 05 FILLER PIC X(01) VALUE SPACES. DTSBR793 00140 05 RPT-ZIP4 PIC X(04). DTSBR793 00141 DTSBR793 00142 01 R793-REPORT3. DTSBR793 00143 05 FILLER PIC X(03) VALUE SPACES. DTSBR793 00144 05 RPT-FEIN-NO3 PIC 99B9999999. DTSBR793 00145 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 00146 05 RPT-EMP-NO3 PIC 9(06). DTSBR793 00147 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 00148 05 RPT-EMP-NAME3 PIC X(30). DTSBR793 00149 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 00150 * 05 RPT-ADDR2 PIC X(15). DTSBR793 00151 * 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 00152 * 05 RPT-ADDR3 PIC X(25). DTSBR793 00153 * 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 00154 05 RPT-EMP-DATE3 PIC X(10). DTSBR793 00155 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 00156 05 RPT-EMP-CLASS3 PIC X(03). DTSBR793 00157 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 00158 05 RPT-EMP-STATUS3 PIC X(02). DTSBR793 00159 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 00160 05 RPT-EMP-ORG-TYPE3 PIC X(05). DTSBR793 00161 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 00162 05 RPT-RTN-MAIL3 PIC X(05). DTSBR793 00163 05 FILLER PIC X(07) VALUE SPACES. DTSBR793 00164 05 RPT-NEW-ACCT-IND PIC X(01). DTSBR793 00165 05 FILLER PIC X(08) VALUE SPACES. DTSBR793 00166 05 RPT-FEIN-CHNG-IND PIC X(01). DTSBR793 00167 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 00168 05 RPT-NAME-CHNG-IND PIC X(01). DTSBR793 00169 05 FILLER PIC X(05) VALUE SPACES. DTSBR793 00170 05 RPT-TRAN-DATE PIC X(10). DTSBR793 00171 01 HEADER1. DTSBR793 00172 05 FILLER PIC X(03) VALUE SPACES. DTSBR793 00173 05 HDR1-RPT PIC X(05). DTSBR793 00174 05 FILLER PIC X(44) VALUE SPACES. DTSBR793 00175 05 FILLER PIC X(60) VALUE DTSBR793 00176 'DISTRICT OF COLUMBIA'. DTSBR793 00177 05 FILLER PIC X(06) VALUE 'DATE:'. DTSBR793 00178 05 HDR1-DATE PIC X(08). DTSBR793 00179 01 HEADER2. DTSBR793 00180 05 FILLER PIC X(56) VALUE SPACES. DTSBR793 00181 05 FILLER PIC X(56) VALUE DTSBR793 00182 'TAX DIVISION'. DTSBR793 00183 05 FILLER PIC X(06) VALUE 'TIME:'. DTSBR793 00184 05 HDR2-TIME PIC X(08). DTSBR793 00185 DTSBR793 00186 01 HEADER3. DTSBR793 00187 05 FILLER PIC X(01) VALUE SPACES. DTSBR793 00188 05 FILLER PIC X(45) VALUE DTSBR793 00189 'EMPLOYERS NOT IN DUTAS '. DTSBR793 00190 05 FILLER PIC X(46) VALUE DTSBR793 00191 'IRS (940) FUTA QUARTERLY - LETTER MAILED '. DTSBR793 00192 05 FILLER PIC X(20) VALUE SPACES. DTSBR793 00193 05 FILLER PIC X(06) VALUE 'PAGE:'. DTSBR793 00194 05 HDR3-PAGE PIC ZZ,ZZ9. DTSBR793 00195 DTSBR793 00196 DTSBR793 00197 01 HEADER4. DTSBR793 00198 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 00199 05 FILLER PIC X(07) VALUE DTSBR793 00200 'FEIN NO'. DTSBR793 00201 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 00202 05 FILLER PIC X(25) VALUE DTSBR793 00203 ' EMP-NAME '. DTSBR793 00204 05 FILLER PIC X(07) VALUE SPACES. DTSBR793 00205 05 FILLER PIC X(25) VALUE DTSBR793 00206 ' ATTENTION '. DTSBR793 00207 05 FILLER PIC X(15) VALUE SPACES. DTSBR793 00208 05 FILLER PIC X(25) VALUE DTSBR793 00209 ' ADDR-LINE1 '. DTSBR793 00210 05 FILLER PIC X(01) VALUE SPACES. DTSBR793 00211 05 FILLER PIC X(22) VALUE DTSBR793 00212 ' CITY '. DTSBR793 00213 05 FILLER PIC X(11) VALUE DTSBR793 00214 'ST ZIP'. DTSBR793 00215 01 HEADER31. DTSBR793 00216 05 FILLER PIC X(01) VALUE SPACES. DTSBR793 00217 05 FILLER PIC X(45) VALUE DTSBR793 00218 'EMPLOYERS FOUND -DUTAS '. DTSBR793 00219 05 FILLER PIC X(46) VALUE DTSBR793 00220 'IRS (940) FUTA QUARTERLY - CROSS MATCH '. DTSBR793 00221 05 FILLER PIC X(20) VALUE SPACES. DTSBR793 00222 05 FILLER PIC X(06) VALUE 'PAGE:'. DTSBR793 00223 05 HDR31-PAGE PIC ZZ,ZZ9. DTSBR793 00224 DTSBR793 00225 DTSBR793 00226 01 HEADER41. DTSBR793 00227 05 FILLER PIC X(03) VALUE SPACES. DTSBR793 00228 05 FILLER PIC X(07) VALUE DTSBR793 00229 'FEIN NO'. DTSBR793 00230 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 00231 05 FILLER PIC X(25) VALUE DTSBR793 00232 ' EMP-NO NAME '. DTSBR793 00233 05 FILLER PIC X(02) VALUE SPACES. DTSBR793 00234 05 FILLER PIC X(32) VALUE DTSBR793 00235 ' DATE REG CLS '. DTSBR793 00236 * 05 FILLER PIC X(10) VALUE SPACES. DTSBR793 00237 05 FILLER PIC X(26) VALUE DTSBR793 00238 'STA ORG RTN-MAIL NEW-A'. DTSBR793 00239 05 FILLER PIC X(23) VALUE DTSBR793 00240 'CCT FEIN/NAME IRS-TRAN'. DTSBR793 00241 05 FILLER PIC X(05) VALUE DTSBR793 00242 '-DATE'. DTSBR793 00243 01 L005-LINK-AREA. DTSBR793 00244 ++INCLUDE DTSIL005 DTSBR793 00245 EJECT DTSBR793 00246 01 L009-LINK-AREA. DTSBR793 00247 ++INCLUDE DTSIL009 DTSBR793 00248 EJECT DTSBR793 00249 01 L071-LINK-AREA. DTSBR793 00250 ++INCLUDE DTSIL071 DTSBR793 00251 EJECT DTSBR793 00252 01 L082-LINK-AREA. DTSBR793 00253 ++INCLUDE DTSIL082 DTSBR793 00254 EJECT DTSBR793 00255 ++INCLUDE DTSXL793 DTSBR793 00256 EJECT DTSBR793 00257 LINKAGE SECTION. DTSBR793 00258 SKIP3 DTSBR793 00259 01 LRCM-LINK-AREA. DTSBR793 00260 ++INCLUDE DTSILRCM DTSBR793 00261 EJECT DTSBR793 00262 01 R793-REC. DTSBR793 00263 ++INCLUDE DTSIR793 DTSBR793 00264 EJECT DTSBR793 00265 PROCEDURE DIVISION USING LRCM-LINK-AREA DTSBR793 00266 R793-REC. DTSBR793 00267 SKIP2 DTSBR793 00268 IF FIRST-TIME-IND = 'Y' DTSBR793 00269 PERFORM I1000-INITIATE THRU I1000-EXIT DTSBR793 00270 MOVE 'N' TO FIRST-TIME-IND. DTSBR793 00271 SKIP1 DTSBR793 00272 IF LRCM-EOR-88 DTSBR793 00273 PERFORM T1000-TERMINATE THRU T1000-EXIT DTSBR793 00274 ELSE DTSBR793 00275 PERFORM P1000-PROCESS THRU P1000-EXIT. DTSBR793 00276 SKIP2 DTSBR793 00277 GOBACK. DTSBR793 00278 EJECT DTSBR793 00279 I1000-INITIATE. DTSBR793 00280 SKIP1 DTSBR793 00281 OPEN OUTPUT FEIN-FILE FEIN-FILE2 FEIN-FILE3. DTSBR793 00282 WRITE FEIN-LETTER FROM XF-CA-CNTL-LIN0 AFTER DTSBR793 00283 ADVANCING TOP-OF-PAGE. DTSBR793 00284 WRITE FEIN-LETTER FROM XF-CA-CNTL-LINE. DTSBR793 00285 SKIP2 DTSBR793 00286 PERFORM S005-SYS-DATE THRU S005-EXIT. DTSBR793 00287 MOVE L005-SLASH-DATE TO HDR1-DATE LETTER-DATE. DTSBR793 00288 MOVE L005-DISPLAY-TIME TO HDR2-TIME. DTSBR793 00289 DTSBR793 00290 I1000-EXIT. DTSBR793 00291 EXIT. DTSBR793 00292 EJECT DTSBR793 00293 P1000-PROCESS. DTSBR793 00294 SKIP1 DTSBR793 00295 MOVE SPACES TO R793-REPORT. DTSBR793 00296 DTSBR793 00297 MOVE R793-FEIN TO WS-FEIN-NO DTSBR793 00298 MOVE WS-FEIN-NO TO RPT-FEIN-NO. DTSBR793 00299 DTSBR793 00300 IF R793-RPT-TYPE = '02' DTSBR793 00301 PERFORM P2300-GENERATE-DUTA-REPORT THRU P2300-EXIT DTSBR793 00302 ELSE DTSBR793 00303 PERFORM P2100-GENERATE-FEIN-LETTER THRU P2100-EXIT DTSBR793 00304 PERFORM P2200-GENERATE-FEIN-REPORT THRU P2200-EXIT. DTSBR793 00305 SKIP2 DTSBR793 00306 P1000-EXIT. DTSBR793 00307 EXIT. DTSBR793 00308 EJECT DTSBR793 00309 P2000-FORMAT-OPR-NAME. DTSBR793 00310 SKIP1 DTSBR793 00311 * MOVE R793-OP-ID TO L082-OP-ID. DTSBR793 00312 * PERFORM S082-OP-ID-INFO THRU S082-EXIT. DTSBR793 00313 * MOVE L082-NAME TO L071-NAM. DTSBR793 00314 * MOVE 2 TO L071-NAME-FORMAT. DTSBR793 00315 * PERFORM S071-DESLASH-NAME THRU S071-EXIT. DTSBR793 00316 * MOVE L071-NAM TO L009-DATA. DTSBR793 00317 * PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT. DTSBR793 00318 * MOVE L009-DATA TO WS-OPR-NAME. DTSBR793 00319 * MOVE L082-UNIT-NAME TO L009-DATA. DTSBR793 00320 * PERFORM S009-CONVERT-TO-CAPS THRU S009-EXIT. DTSBR793 00321 * MOVE L009-DATA TO WS-OPR-UNIT-NAME. DTSBR793 00322 SKIP2 DTSBR793 00323 P2000-EXIT. DTSBR793 00324 EXIT. DTSBR793 00325 EJECT DTSBR793 00326 P2100-GENERATE-FEIN-LETTER. DTSBR793 00327 * MOVE SPACES TO PRT-REC. DTSBR793 00328 * ADD 1 TO WS-PAGE-NO. DTSBR793 00329 * MOVE LRCM-SYS-8-DATE TO FILA. DTSBR793 00330 * MOVE WS-PAGE-NO TO FILD. DTSBR793 00331 * WRITE PRT-REC FROM HEAD AFTER ADVANCING TOP-OF-PAGE. DTSBR793 00332 * WRITE PRT-REC FROM HEADA AFTER ADVANCING 2 LINES. DTSBR793 00333 * ADD 3 TO WS-LINE-CNT. DTSBR793 00334 * MOVE R792-EMP-NO TO E-NUM. DTSBR793 00335 * MOVE WS-FEIN-NO TO ID-NUM. DTSBR793 00336 * MOVE R793-STATE-CODE TO CDE. DTSBR793 00337 * MOVE R793-NAME-LINE-1 TO ADDR. DTSBR793 00338 * WRITE PRT-REC FROM DETAIL1 AFTER ADVANCING 2 LINES. DTSBR793 00339 * ADD 2 TO WS-LINE-CNT. DTSBR793 00340 * MOVE R793-NAME-LINE-2 TO ADDR1 DTSBR793 00341 * WRITE PRT-REC FROM DETAIL2 AFTER ADVANCING 1 LINES. DTSBR793 00342 * MOVE R793-NAME-LINE-3 TO ADDR2 DTSBR793 00343 * WRITE PRT-REC FROM DETAIL3 AFTER ADVANCING 1 LINES. DTSBR793 00344 * MOVE R793-NAME-LINE-4 TO ADDR3 DTSBR793 00345 * WRITE PRT-REC FROM DETAIL4 AFTER ADVANCING 1 LINES. DTSBR793 00346 * MOVE R793-STREET-ADDRESS TO ADDR4. DTSBR793 00347 * WRITE PRT-REC FROM DETAIL5 AFTER ADVANCING 1 LINES. DTSBR793 00348 * MOVE R793-CITY TO ADDR-CITY OF DETAIL6 DTSBR793 00349 * MOVE R793-STATE-CODE TO ADDR-STATE OF DETAIL6 DTSBR793 00350 * MOVE R793-ZIP-CODE TO ADDR-ZIP OF DETAIL6 DTSBR793 00351 * WRITE PRT-REC FROM DETAIL6 AFTER 1. DTSBR793 00352 DTSBR793 00353 **> DTSBR793 00354 * WRITE FEIN-LETTER FROM X1-CA-CNTL-LINE. DTSBR793 00355 WRITE FEIN-LETTER FROM X2-CA-CNTL-LINE. DTSBR793 00356 WRITE FEIN-LETTER FROM X3-CA-CNTL-LINE. DTSBR793 00357 DTSBR793 00358 MOVE SPACES TO FEIN-LETTER VSCA-DATA. DTSBR793 00359 MOVE R793-CITY TO FEIN-CITY DTSBR793 00360 MOVE R793-STATE-CODE TO FEIN-STATE DTSBR793 00361 * MOVE R793-ZIP-CODE TO FEIN-ZIP DTSBR793 00362 MOVE R793-ZIP-1-5 TO FEIN-ZIP-1-5 DTSBR793 00363 MOVE R793-ZIP-6-9 TO FEIN-ZIP-6-9. DTSBR793 00364 * MOVE R793-ZIP-10-12 TO FEIN-ZIP-10-12. DTSBR793 00365 MOVE SPACES TO FEIN-ZIP-10-12. DTSBR793 00366 WRITE FEIN-LETTER FROM VSCA-ADDR-LINE AFTER TOP-OF-PAGE. DTSBR793 00367 MOVE SPACES TO VSCA-DATA. DTSBR793 00368 WRITE FEIN-LETTER FROM VSCA-ADDR-LINE DTSBR793 00369 AFTER ADVANCING 7 LINES DTSBR793 00370 MOVE SPACES TO VSCA-DATA. DTSBR793 00371 MOVE WS-FEIN-NO-DISPLAY TO PRTB. DTSBR793 00372 * MOVE WS-FEIN-NO TO PRTB. DTSBR793 00373 * PERFORM S060-FORM THRU S060-EXIT 27 TIMES. DTSBR793 00374 * MOVE SPACES TO PRT1 PRT1-A. DTSBR793 00375 DTSBR793 00376 WRITE FEIN-LETTER FROM R793-LETTER-DATE AFTER 2 DTSBR793 00377 * MOVE WS-FEIN-NO-DISPLAY TO LTR-FEIN-NO. DTSBR793 00378 MOVE WS-FEIN-NO TO LTR-FEIN-NO. DTSBR793 00379 WRITE FEIN-LETTER FROM R793-LETTER-FEIN AFTER 2 CL**2 00380 DTSBR793 00381 MOVE R793-NAME-LINE-1 TO PRT1 DTSBR793 00382 PERFORM S060-FORM THRU S060-EXIT. DTSBR793 00383 DTSBR793 00384 * IF R793-NAME-LINE-2 NOT = SPACES DTSBR793 00385 * MOVE R793-NAME-LINE-2 TO PRT1 DTSBR793 00386 * PERFORM S060-FORM THRU S060-EXIT. DTSBR793 00387 DTSBR793 00388 IF R793-NAME-LINE-3 NOT = SPACES DTSBR793 00389 MOVE R793-NAME-LINE-3 TO PRT1 DTSBR793 00390 PERFORM S060-FORM THRU S060-EXIT. DTSBR793 00391 DTSBR793 00392 IF R793-NAME-LINE-4 NOT = SPACES DTSBR793 00393 MOVE R793-NAME-LINE-4 TO PRT1 DTSBR793 00394 PERFORM S060-FORM THRU S060-EXIT. DTSBR793 00395 DTSBR793 00396 MOVE R793-STREET-ADDRESS TO PRT1. DTSBR793 00397 PERFORM S060-FORM THRU S060-EXIT. DTSBR793 00398 DTSBR793 00399 MOVE FEIN-DET7 TO PRT1. DTSBR793 00400 PERFORM S060-FORM THRU S060-EXIT. DTSBR793 00401 ******************************************************************DTSBR793 00402 * THIS AREA WILL MOVE THE ADDRESS FOR LETTER DTSBR793 00403 ******************************************************************DTSBR793 00404 WRITE FEIN-LETTER FROM VSCA-ADDR-LINE AFTER TOP-OF-PAGE. DTSBR793 00405 PERFORM S060-FORM THRU S060-EXIT 17 TIMES. DTSBR793 00406 MOVE R793-NAME-LINE-1 TO PRT2. DTSBR793 00407 PERFORM S060-FORM THRU S060-EXIT. DTSBR793 00408 DTSBR793 00409 IF R793-NAME-LINE-2 NOT = SPACES DTSBR793 00410 MOVE R793-NAME-LINE-2 TO PRT2 DTSBR793 00411 PERFORM S060-FORM THRU S060-EXIT. DTSBR793 00412 DTSBR793 00413 IF R793-NAME-LINE-3 NOT = SPACES DTSBR793 00414 MOVE R793-NAME-LINE-3 TO PRT2 DTSBR793 00415 PERFORM S060-FORM THRU S060-EXIT. DTSBR793 00416 DTSBR793 00417 IF R793-NAME-LINE-4 NOT = SPACES DTSBR793 00418 MOVE R793-NAME-LINE-4 TO PRT2 DTSBR793 00419 PERFORM S060-FORM THRU S060-EXIT. DTSBR793 00420 DTSBR793 00421 MOVE R793-STREET-ADDRESS TO PRT2. DTSBR793 00422 PERFORM S060-FORM THRU S060-EXIT. DTSBR793 00423 DTSBR793 00424 MOVE FEIN-DET7 TO PRT2. DTSBR793 00425 PERFORM S060-FORM THRU S060-EXIT. DTSBR793 00426 P2100-EXIT. DTSBR793 00427 EXIT. DTSBR793 00428 P2200-GENERATE-FEIN-REPORT. DTSBR793 00429 ADD 1 TO WS-LINE-CNT. DTSBR793 00430 IF WS-LINE-CNT > 50 DTSBR793 00431 ADD 1 TO WS-PAGE-CNT DTSBR793 00432 MOVE WS-PAGE-CNT TO HDR3-PAGE DTSBR793 00433 MOVE '793R1' TO HDR1-RPT DTSBR793 00434 WRITE FEIN-REPORT FROM HEADER1 DTSBR793 00435 AFTER ADVANCING TOP-OF-PAGE DTSBR793 00436 WRITE FEIN-REPORT FROM HEADER2 AFTER ADVANCING 1 DTSBR793 00437 WRITE FEIN-REPORT FROM HEADER3 AFTER ADVANCING 1 DTSBR793 00438 WRITE FEIN-REPORT FROM HEADER4 AFTER ADVANCING 1 DTSBR793 00439 MOVE 1 TO WS-LINE-CNT. DTSBR793 00440 DTSBR793 00441 * MOVE SPACES TO FEIN-REPORT. DTSBR793 00442 MOVE R793-FEIN TO RPT-FEIN-NO DTSBR793 00443 MOVE R793-CITY TO RPT-CITY. DTSBR793 00444 MOVE R793-STATE-CODE TO RPT-STATE DTSBR793 00445 MOVE R793-ZIP-1-5 TO RPT-ZIP. DTSBR793 00446 MOVE R793-ZIP-6-9 TO RPT-ZIP4. DTSBR793 00447 MOVE R793-NAME-LINE-1 TO RPT-ADDR1. DTSBR793 00448 * MOVE R793-NAME-LINE-2 TO RPT-ADDR2 DTSBR793 00449 IF R793-NAME-LINE-3 > SPACES DTSBR793 00450 MOVE R793-NAME-LINE-3 TO RPT-ADDR4 DTSBR793 00451 ELSE DTSBR793 00452 MOVE R793-NAME-LINE-4 TO RPT-ADDR4. DTSBR793 00453 MOVE R793-STREET-ADDRESS TO RPT-STREET. DTSBR793 00454 DTSBR793 00455 WRITE FEIN-REPORT FROM R793-REPORT AFTER ADVANCING 1. DTSBR793 00456 P2200-EXIT. DTSBR793 00457 EXIT. DTSBR793 00458 P2300-GENERATE-DUTA-REPORT. DTSBR793 00459 ADD 1 TO WS-LINE-CNT3. DTSBR793 00460 IF WS-LINE-CNT3 > 50 DTSBR793 00461 ADD 1 TO WS-PAGE-CNT3 DTSBR793 00462 MOVE WS-PAGE-CNT3 TO HDR31-PAGE DTSBR793 00463 MOVE '793R2' TO HDR1-RPT DTSBR793 00464 WRITE FEIN-REPORT3 FROM HEADER1 DTSBR793 00465 AFTER ADVANCING TOP-OF-PAGE DTSBR793 00466 WRITE FEIN-REPORT3 FROM HEADER2 AFTER ADVANCING 1 DTSBR793 00467 WRITE FEIN-REPORT3 FROM HEADER31 AFTER ADVANCING 1 DTSBR793 00468 WRITE FEIN-REPORT3 FROM HEADER41 AFTER ADVANCING 1 DTSBR793 00469 MOVE 1 TO WS-LINE-CNT3. DTSBR793 00470 DTSBR793 00471 * MOVE SPACES TO FEIN-REPORT. DTSBR793 00472 MOVE R793-FEIN TO RPT-FEIN-NO3 DTSBR793 00473 MOVE R793-EMP-NO TO RPT-EMP-NO3 DTSBR793 00474 MOVE R793-EMP-NAME TO RPT-EMP-NAME3 DTSBR793 00475 MOVE R793-EMP-DATE TO RPT-EMP-DATE3 DTSBR793 00476 MOVE R793-EMP-CLASS TO RPT-EMP-CLASS3 DTSBR793 00477 MOVE R793-EMP-STATUS TO RPT-EMP-STATUS3 DTSBR793 00478 MOVE R793-ORG-TYPE TO RPT-EMP-ORG-TYPE3 DTSBR793 00479 MOVE R793-RTN-MAIL TO RPT-RTN-MAIL3 DTSBR793 00480 MOVE R793-NEW-ACCT-IND TO RPT-NEW-ACCT-IND DTSBR793 00481 MOVE R793-FEIN-CHNG-IND TO RPT-FEIN-CHNG-IND DTSBR793 00482 MOVE R793-NAME-CHNG-IND TO RPT-NAME-CHNG-IND DTSBR793 00483 MOVE R793-TRAN-DATE TO RPT-TRAN-DATE DTSBR793 00484 DTSBR793 00485 WRITE FEIN-REPORT3 FROM R793-REPORT3 AFTER ADVANCING 1. DTSBR793 00486 P2300-EXIT. DTSBR793 00487 EXIT. DTSBR793 00488 EJECT DTSBR793 00489 T1000-TERMINATE. DTSBR793 00490 SKIP1 DTSBR793 00491 WRITE FEIN-LETTER FROM X4-CA-END-LINE. DTSBR793 00492 CLOSE FEIN-FILE FEIN-FILE2 FEIN-FILE3. DTSBR793 00493 SKIP2 DTSBR793 00494 T1000-EXIT. DTSBR793 00495 EXIT. DTSBR793 00496 EJECT DTSBR793 00497 S060-FORM. DTSBR793 00498 WRITE FEIN-LETTER FROM VSCA-ADDR-LINE AFTER 1. DTSBR793 00499 MOVE SPACES TO VSCA-DATA. DTSBR793 00500 S060-EXIT. DTSBR793 00501 EXIT. DTSBR793 00502 S009-CONVERT-TO-CAPS. DTSBR793 00503 SKIP1 DTSBR793 00504 CALL 'DTSBU009' USING L009-LINK-AREA. DTSBR793 00505 SKIP2 DTSBR793 00506 S009-EXIT. DTSBR793 00507 EXIT. DTSBR793 00508 SKIP3 DTSBR793 00509 S005-SYS-DATE. DTSBR793 00510 SKIP1 DTSBR793 00511 SET L005-FROM-SYS TO TRUE. DTSBR793 00512 CALL 'DTSBU005' USING L005-LINK-AREA. DTSBR793 00513 SKIP2 DTSBR793 00514 S005-EXIT. DTSBR793 00515 EXIT. DTSBR793 00516 S071-DESLASH-NAME. DTSBR793 00517 SKIP1 DTSBR793 00518 CALL 'DTSBU071' USING L071-LINK-AREA. DTSBR793 00519 SKIP2 DTSBR793 00520 S071-EXIT. DTSBR793 00521 EXIT. DTSBR793 00522 SKIP3 DTSBR793 00523 S082-OP-ID-INFO. DTSBR793 00524 SKIP1 DTSBR793 00525 CALL 'DTSBU082' USING L082-LINK-AREA. DTSBR793 00526 SKIP2 DTSBR793 00527 S082-EXIT. DTSBR793 00528 EXIT. DTSBR793 00529 SKIP3 DTSBR793 00530 S999-ABEND. DTSBR793 00531 SKIP1 DTSBR793 00532 CALL 'DTSBU999' USING WRK-ABEND-CD. DTSBR793 00533 SKIP2 DTSBR793 00534 S999-EXIT. DTSBR793 00535 EXIT. DTSBR793