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
