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