537 lines
42 KiB
COBOL
537 lines
42 KiB
COBOL
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
|