00001  IDENTIFICATION DIVISION.                                         12/03/09
00002  PROGRAM-ID.             DTSBR590.                                DTSBR590
00003  AUTHOR.                 TRW.                                        LV015
00004  DATE-WRITTEN.           FEBRUARY 2000.                           DTSBR590
00005  DATE-COMPILED.                                                   DTSBR590
00006      SKIP3                                                        DTSBR590
00007 *****                                                             DTSBR590
00008 *    FUNCTION:  CREATE FISCAL AGENT  RATE REPORT                  DTSBR590
00009 *****                                                             DTSBR590
00010      SKIP3                                                        DTSBR590
00011  ENVIRONMENT DIVISION.                                            DTSBR590
00012  INPUT-OUTPUT SECTION.                                            DTSBR590
00013  FILE-CONTROL.                                                    DTSBR590
00014                                                                   DTSBR590
00015      SELECT DTS-RATE-OUT ASSIGN TO RPT590R1                       DTSBR590
00016         FILE STATUS IS WRK-COL-STATUS.                            DTSBR590
00017                                                                   DTSBR590
00018      SELECT DTS-TAPE-OUT ASSIGN TO RPT590R2                       DTSBR590
00019         FILE STATUS IS WRK-COL-STATUS.                            DTSBR590
00020                                                                   DTSBR590
00021      SELECT DTS-EROR-OUT ASSIGN TO RPT590R3                       DTSBR590
00022         FILE STATUS IS WRK-COL-STATUS.                            DTSBR590
00023                                                                   DTSBR590
00024      SELECT DTS-FEIN-OUT ASSIGN TO RPT590R4                       DTSBR590
00025         FILE STATUS IS WRK-COL-STATUS.                            DTSBR590
00026                                                                   DTSBR590
00027                                                                   DTSBR590
00028      SKIP2                                                        DTSBR590
00029  DATA DIVISION.                                                   DTSBR590
00030  FILE SECTION.                                                    DTSBR590
00031                                                                   DTSBR590
00032  FD  DTS-TAPE-OUT                                                 DTSBR590
00033      LABEL RECORDS ARE STANDARD.                                  DTSBR590
00034  01  DTS-TAPE-OUTREC                 PIC X(100).                  DTSBR590
00035                                                                   DTSBR590
00036  FD  DTS-RATE-OUT                                                 DTSBR590
00037      LABEL RECORDS ARE STANDARD.                                  DTSBR590
00038                                                                   DTSBR590
00039  01  PRT-REC1                        PIC X(133).                  DTSBR590
00040                                                                   DTSBR590
00041  FD  DTS-EROR-OUT                                                 DTSBR590
00042      LABEL RECORDS ARE STANDARD.                                  DTSBR590
00043                                                                   DTSBR590
00044  01  PRT-REC2                        PIC X(133).                  DTSBR590
00045                                                                   DTSBR590
00046  FD  DTS-FEIN-OUT                                                 DTSBR590
00047      LABEL RECORDS ARE STANDARD.                                  DTSBR590
00048                                                                   DTSBR590
00049  01  PRT-REC3                        PIC X(133).                  DTSBR590
00050                                                                   DTSBR590
00051  WORKING-STORAGE SECTION.                                         DTSBR590
000515 77  PAN-VALET PICTURE X(24) VALUE '015DTSBR590  12/03/09'.       DTSBR590
00052      SKIP3                                                        DTSBR590
00053  01  WRK-AREA.                                                    DTSBR590
00054      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +590.DTSBR590
00055                                                                   DTSBR590
00056      05  WRK-FISCAL-AGENT-CD         PIC  X(03)  VALUE SPACES.    DTSBR590
00057                                                                   DTSBR590
00058      05  WRK-EMP-PHA                 PIC  X(10)  VALUE SPACES.    DTSBR590
00059      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBR590'.DTSBR590
00060      05  FIRST-TIME-IND              PIC  X(01)  VALUE 'Y'.       DTSBR590
00061                                                                   DTSBR590
00062      05  WRK-RATE-CNT                PIC S9(07)  COMP-3 VALUE 0.  DTSBR590
00063      05  WRK-TAPE-CNT                PIC S9(07)  COMP-3 VALUE 0.  DTSBR590
00064      05  WRK-EROR-CNT                PIC S9(07)  COMP-3 VALUE 0.  DTSBR590
00065      05  WRK-FEIN-CNT                PIC S9(07)  COMP-3 VALUE 0.  DTSBR590
00066                                                                   DTSBR590
00067      05  WS-NUMBER-ONE               PIC S9(07)  COMP-3 VALUE +0. DTSBR590
00068      05  WS-NUMBER-TWO               PIC S9(07)  COMP-3 VALUE +0. DTSBR590
00069      05  WS-NUMBER-THREE             PIC S9(07)  COMP-3 VALUE +0. DTSBR590
00070                                                                   DTSBR590
00071      05  WRK-COL-CNT                 PIC S9(07)  COMP-3.          DTSBR590
00072                                                                   DTSBR590
00073      05  WRK-COL-STATUS              PIC  X(02).                  DTSBR590
00074          88 WRK-COL-STAT-OK       VALUE '00'.                     DTSBR590
00075      05  WRK-MPRF-IND                PIC  X(01).                  DTSBR590
00076          88 WRK-MPRF-OK           VALUE 'Y'.                      DTSBR590
00077          88 WRK-MPRF-NO-REC       VALUE 'N'.                      DTSBR590
00078                                                                   DTSBR590
00079      05  WRK-ERROR-IND               PIC  X(01)  VALUE SPACES.    DTSBR590
00080          88 WRK-ERROR-YES         VALUE 'Y'.                      DTSBR590
00081          88 WRK-ERROR-NO          VALUE 'N'.                      DTSBR590
00082                                                                   DTSBR590
00083      05  WRK-FISC-AGNT-CODE          PIC  X(01).                  DTSBR590
00084          88 WRK-FISC-AGNT-VALID-88   VALUE 'Y'.                   DTSBR590
00085          88 WRK-FISC-AGNT-INVALID-88 VALUE 'N'.                   DTSBR590
00086                                                                   DTSBR590
00087      05  RPT01-LINE-CNT                  PIC  S9(05) VALUE +65.   DTSBR590
00088      05  RPT01-PAGE-CNT                  PIC  9(05) VALUE ZEROS.  DTSBR590
00089                                                                   DTSBR590
00090      05  RPT02-LINE-CNT                  PIC  S9(05) VALUE +65.   DTSBR590
00091      05  RPT02-PAGE-CNT                  PIC  9(05) VALUE ZEROS.  DTSBR590
00092                                                                   DTSBR590
00093      05  RPT03-LINE-CNT                  PIC  S9(05) VALUE +65.   DTSBR590
00094      05  RPT03-PAGE-CNT                  PIC  9(05) VALUE ZEROS.  DTSBR590
00095                                                                   DTSBR590
00096      05  WRK-DATE                        PIC  9(06) VALUE ZEROS.  DTSBR590
00097      05  WRK-DATE-9 REDEFINES WRK-DATE.                           DTSBR590
00098          10  WRK-DATE-YY                 PIC  9(02).              DTSBR590
00099          10  WRK-DATE-MM                 PIC  9(02).              DTSBR590
00100          10  WRK-DATE-DD                 PIC  9(02).              DTSBR590
00101      05  WRK-TRACE-IND                   PIC  X(01).              DTSBR590
00102                                                                   DTSBR590
00103      05  WS-REC                          PIC  X(133) VALUE SPACES.DTSBR590
00104      EJECT                                                        DTSBR590
00105  01  RPT01DET.                                                    DTSBR590
00106      05  FILLER                      PIC X(2) VALUE SPACES.       DTSBR590
00107      05  EMP-NO-OUT                  PIC X(6) VALUE SPACES.       DTSBR590
00108      05  FILLER                      PIC X(4) VALUE SPACES.       DTSBR590
00109      05  EMP-FEIN-OUT                PIC X(9) VALUE SPACES.       DTSBR590
00110      05  EMP-FEIN-SEA-OUT            PIC X(1) VALUE SPACES.       DTSBR590
00111      05  FILLER                      PIC X(4) VALUE SPACES.       DTSBR590
00112      05  EMP-RATE-OUT                PIC ZZ9.9 VALUE ZEROS.       DTSBR590
00113      05  FILLER                      PIC X(6) VALUE SPACES.       DTSBR590
00114      05  EMP-SICC-OUT                PIC X(4) VALUE SPACES.       DTSBR590
00115      05  FILLER                      PIC X(4) VALUE SPACES.       DTSBR590
00116      05  EMP-NAME-OUT                PIC X(40) VALUE SPACES.      DTSBR590
00117      05  FILLER                      PIC X(3) VALUE SPACES.       DTSBR590
00118      05  EMP-NAMEA-OUT               PIC X(40) VALUE SPACES.      DTSBR590
00119      05  FILLER                      PIC X(06) VALUE SPACES.      DTSBR590
00120      EJECT                                                        DTSBR590
00121                                                                   DTSBR590
00122  01  RPT02DET.                                                    DTSBR590
00123      05  FILLER                      PIC X(2) VALUE SPACES.       DTSBR590
00124      05  ERR-NO-OUT                  PIC X(6) VALUE SPACES.       DTSBR590
00125      05  FILLER                      PIC X(4) VALUE SPACES.       DTSBR590
00126      05  ERR-FEIN-OUT                PIC X(9) VALUE SPACES.       DTSBR590
00127      05  FILLER                      PIC X(6) VALUE SPACES.       DTSBR590
00128      05  ERR-STATUS-OUT              PIC X    VALUE SPACES.       DTSBR590
00129      05  FILLER                      PIC X(6) VALUE SPACES.       DTSBR590
00130      05  ERR-NAME-OUT                PIC X(40) VALUE SPACES.      DTSBR590
00131      05  FILLER                      PIC X(6) VALUE SPACES.       DTSBR590
00132      05  ERR-MSG-OUT                 PIC X(40) VALUE SPACES.      DTSBR590
00133      05  FILLER                      PIC X(06) VALUE SPACES.      DTSBR590
00134      EJECT                                                        DTSBR590
00135  01  RPT03DET.                                                    DTSBR590
00136      05  FILLER                      PIC X(2) VALUE SPACES.       DTSBR590
00137      05  FEIN-NO-OUT                 PIC X(6) VALUE SPACES.       DTSBR590
00138      05  FILLER                      PIC X(4) VALUE SPACES.       DTSBR590
00139      05  FEIN-FEIN-OUT               PIC X(9) VALUE SPACES.       DTSBR590
00140      05  FILLER                      PIC X(6) VALUE SPACES.       DTSBR590
00141      05  FEIN-STATUS-OUT             PIC X    VALUE SPACES.       DTSBR590
00142      05  FILLER                      PIC X(6) VALUE SPACES.       DTSBR590
00143      05  FEIN-NAME-OUT               PIC X(40) VALUE SPACES.      DTSBR590
00144      05  FILLER                      PIC X(6) VALUE SPACES.       DTSBR590
00145      05  FEIN-MSG-OUT                PIC X(40) VALUE SPACES.      DTSBR590
00146      05  FILLER                      PIC X(06) VALUE SPACES.      DTSBR590
00147      EJECT                                                        DTSBR590
00148  01  REPORT-LINE-AREA.                                            DTSBR590
00149      05  HEAD01.                                                  DTSBR590
00150          10  FILLER                  PIC  X(05)  VALUE SPACE.     DTSBR590
00151          10  HEAD01-RPT-NAME         PIC  X(05)  VALUE '590R1'.   DTSBR590
00152          10  FILLER                  PIC  X(47)  VALUE SPACES.    DTSBR590
00153          10  HEAD01-PROGRAM-NAME     PIC  X(52).                  DTSBR590
00154          10  FILLER                  PIC  X(04)  VALUE SPACES.    DTSBR590
00155          10  FILLER                  PIC  X(06)  VALUE 'DATE: '.  DTSBR590
00156          10  HEAD01-SYS-DATE.                                     DTSBR590
00157             15  HEAD01-SYS-MM        PIC  99.                     DTSBR590
00158             15  FILLER               PIC  X(01)  VALUE '/'.       DTSBR590
00159             15  HEAD01-SYS-DD        PIC  99.                     DTSBR590
00160             15  FILLER               PIC  X(01)  VALUE '/'.       DTSBR590
00161             15  HEAD01-SYS-CEN       PIC  99     VALUE 20.        DTSBR590
00162             15  HEAD01-SYS-YY        PIC  99.                     DTSBR590
00163                                                                   DTSBR590
00164      05  HEAD02.                                                  DTSBR590
00165          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR590
00166          10  FILLER                  PIC  X(50)  VALUE SPACES.    DTSBR590
00167          10  HEAD02-AGY-NAME         PIC  X(60).                  DTSBR590
00168          10  HEAD02-SYS-TIME         PIC  X(10)  VALUE SPACES.    DTSBR590
00169                                                                   DTSBR590
00170      05  HEAD03.                                                  DTSBR590
00171          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR590
00172          10  FILLER                  PIC  X(20)                   DTSBR590
00173                VALUE 'FISCAL AGENT NAME:'.                        DTSBR590
00174          10  HEAD03-FA-NAME          PIC  X(30)  VALUE SPACES.    DTSBR590
00175          10  FILLER                  PIC  X(10)  VALUE SPACES.    DTSBR590
00176          10  HEAD03-AGY-MAIL1        PIC  X(52).                  DTSBR590
00177          10  FILLER                  PIC  X(06)  VALUE 'PAGE: '.  DTSBR590
00178          10  HEAD03-PAGE-CNT         PIC  ZZZ9.                   DTSBR590
00179                                                                   DTSBR590
00180      05  HEAD04.                                                  DTSBR590
00181          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR590
00182          10  FILLER                  PIC  X(50)  VALUE SPACES.    DTSBR590
00183          10  HEAD04-TITLE            PIC  X(36)                   DTSBR590
00184                VALUE 'FISCAL AGENT RATE TAPE REPORT '.            DTSBR590
00185          10  FILLER                  PIC  X(50)  VALUE SPACES.    DTSBR590
00186                                                                   DTSBR590
00187      05  HEAD05.                                                  DTSBR590
00188          10  FILLER                  PIC  X(02)  VALUE SPACE.     DTSBR590
00189          10  FILLER                  PIC  X(43)  VALUE            DTSBR590
00190              'ACCOUNT     FEDERAL      CONTRIB   SIC    '.        DTSBR590
00191          10  FILLER                  PIC  X(49)  VALUE            DTSBR590
00192              'TRADE                                      ENTITY'. DTSBR590
00193          10  FILLER                  PIC  X(41)  VALUE SPACE.     DTSBR590
00194      05  HEAD06.                                                  DTSBR590
00195          10  FILLER                  PIC  X(02)  VALUE SPACE.     DTSBR590
00196          10  FILLER                  PIC  X(43)  VALUE            DTSBR590
00197              'NUMBER      ACCOUNT       RATE     CODE    '.       DTSBR590
00198          10  FILLER                  PIC  X(49)  VALUE            DTSBR590
00199              'NAME                                       NAME  '. DTSBR590
00200          10  FILLER                  PIC  X(41)  VALUE SPACES.    DTSBR590
00201                                                                   DTSBR590
00202      05  HEAD07.                                                  DTSBR590
00203          10  FILLER                  PIC  X(02)  VALUE SPACE.     DTSBR590
00204          10  FILLER                  PIC  X(40)  VALUE            DTSBR590
00205              'ACCOUNT     FEDERAL    STATUS          '.           DTSBR590
00206          10  FILLER                  PIC  X(90)  VALUE SPACE.     DTSBR590
00207      05  HEAD08.                                                  DTSBR590
00208          10  FILLER                  PIC  X(02)  VALUE SPACE.     DTSBR590
00209          10  FILLER                  PIC  X(45)  VALUE            DTSBR590
00210              'NUMBER      ACCOUNT    CODE     EMPLOYER NAME'.     DTSBR590
00211          10  FILLER                  PIC  X(18)  VALUE SPACES.    DTSBR590
00212          10  FILLER                  PIC  X(26)  VALUE            DTSBR590
00213              '                  MESSAGE '.                        DTSBR590
00214          10  FILLER                  PIC  X(39)  VALUE SPACES.    DTSBR590
00215      EJECT                                                        DTSBR590
00216                                                                   DTSBR590
00217  01  FOOTING-LINE-1                  PIC  X(133) VALUE SPACES.    DTSBR590
00218  01  FOOTING-LINE-2                  PIC  X(133) VALUE SPACES.    DTSBR590
00219  01  FOOTING-LINE-3.                                              DTSBR590
00220      05  FILLER                      PIC  X(25)  VALUE SPACES.    DTSBR590
00221      05  WS-FOOTING-CNT              PIC  ZZ,ZZ9.                 DTSBR590
00222      05  FILLER                      PIC  X(02)  VALUE SPACES.    DTSBR590
00223      05  WS-REPORT                   PIC  X(57)  VALUE SPACES.    DTSBR590
00224      05  FILLER                      PIC  X(34)  VALUE SPACES.    DTSBR590
00225  01  FOOTING-LINE-3-DUP.                                          DTSBR590
00226      05  FILLER                      PIC  X(33)  VALUE SPACES.    DTSBR590
00227      05  FILLER                      PIC  X(57)  VALUE            DTSBR590
00228       '(DUPLICATE RECORDS FROM A SINGLE FISCAL AGENT ARE ELIMINA'.DTSBR590
00229      05  FILLER                      PIC  X(43)  VALUE            DTSBR590
00230       'TED BEFORE PROCESSING)                     '.              DTSBR590
00231  01  FOOTING-LINE-4                  PIC  X(133) VALUE SPACES.    DTSBR590
00232  01  FOOTING-LINE-5                  PIC  X(133) VALUE SPACES.    DTSBR590
00233  01  FOOTING-LINE-6.                                              DTSBR590
00234      05  FILLER                      PIC  X(25)  VALUE SPACES.    DTSBR590
00235      05  FILLER                      PIC  X(17) VALUE             DTSBR590
00236                       '*** END OF REPORT'.                        DTSBR590
00237                                                                   DTSBR590
00238  01  DTS-RATE-REC.                                                DTSBR590
00239  ++INCLUDE DTSIXFAR                                               DTSBR590
00240      EJECT                                                        DTSBR590
00241                                                                   DTSBR590
00242  01  DTS-TAPE-REC.                                                DTSBR590
00243  ++INCLUDE DTSIXFAT                                               DTSBR590
00244      EJECT                                                        DTSBR590
00245                                                                   DTSBR590
00246  01  L119-LINK-AREA.                                              DTSBR590
00247  ++INCLUDE DTSIL119                                               DTSBR590
00248      EJECT                                                        DTSBR590
00249  01  FISCAL-AGENT-TABLE-AREA.                                     DTSBR590
00250  ++INCLUDE CHGIC001                                               DTSBR590
00251      EJECT                                                        DTSBR590
00252  LINKAGE SECTION.                                                 DTSBR590
00253      SKIP3                                                        DTSBR590
00254  01  LRCM-LINK-AREA.                                              DTSBR590
00255  ++INCLUDE DTSILRCM                                               DTSBR590
00256                                                                   DTSBR590
00257  01  R590-REC.                                                    DTSBR590
00258  ++INCLUDE DTSIR590                                               DTSBR590
00259      EJECT                                                        DTSBR590
00260  PROCEDURE DIVISION USING LRCM-LINK-AREA                          DTSBR590
00261                           R590-REC.                               DTSBR590
00262                                                                   DTSBR590
00263      IF FIRST-TIME-IND = 'Y'                                      DTSBR590
00264          PERFORM I1000-INITIATE THRU I1000-EXIT                   DTSBR590
00265          MOVE 'N' TO FIRST-TIME-IND.                              DTSBR590
00266                                                                   DTSBR590
00267      IF WRK-ERROR-YES                                             DTSBR590
00268         PERFORM S999-ABEND THRU S999-EXIT                         DTSBR590
00269      ELSE                                                         DTSBR590
00270        IF LRCM-EOR-88                                             DTSBR590
00271          PERFORM T0000-TERMINATE THRU T0000-EXIT                  DTSBR590
00272        ELSE                                                       DTSBR590
00273          PERFORM P0000-PROCESS THRU P0000-EXIT.                   DTSBR590
00274      SKIP2                                                        DTSBR590
00275      GOBACK.                                                      DTSBR590
00276      EJECT                                                        DTSBR590
00277  I1000-INITIATE.                                                  DTSBR590
00278      SKIP2                                                        DTSBR590
00279      MOVE 'N' TO WRK-TRACE-IND.                                   DTSBR590
00280      SET WRK-ERROR-NO TO TRUE.                                    DTSBR590
00281                                                                   DTSBR590
00282      PERFORM I2000-OPEN-FILES          THRU I2000-EXIT.           DTSBR590
00283                                                                   DTSBR590
00284      SKIP2                                                        DTSBR590
00285  I1000-EXIT.                                                      DTSBR590
00286      EXIT.                                                        DTSBR590
00287  I2000-OPEN-FILES.                                                DTSBR590
00288                                                                   DTSBR590
00289      OPEN OUTPUT DTS-TAPE-OUT.                                    DTSBR590
00290      IF NOT WRK-COL-STAT-OK                                       DTSBR590
00291         DISPLAY 'CANNOT OP TAPE OUTP FILE ' WRK-COL-STATUS        DTSBR590
00292         SET WRK-ERROR-YES TO TRUE.                                DTSBR590
00293                                                                   DTSBR590
00294      OPEN OUTPUT DTS-RATE-OUT.                                    DTSBR590
00295      IF NOT WRK-COL-STAT-OK                                       DTSBR590
00296         DISPLAY 'CANNOT OP RATE OUTP FILE ' WRK-COL-STATUS        DTSBR590
00297         SET WRK-ERROR-YES TO TRUE.                                DTSBR590
00298                                                                   DTSBR590
00299      OPEN OUTPUT DTS-EROR-OUT.                                    DTSBR590
00300      IF NOT WRK-COL-STAT-OK                                       DTSBR590
00301         DISPLAY 'CANNOT OP EROR OUTP FILE ' WRK-COL-STATUS        DTSBR590
00302         SET WRK-ERROR-YES TO TRUE.                                DTSBR590
00303                                                                   DTSBR590
00304      OPEN OUTPUT DTS-FEIN-OUT.                                    DTSBR590
00305      IF NOT WRK-COL-STAT-OK                                       DTSBR590
00306         DISPLAY 'CANNOT OP EROR FEIN FILE ' WRK-COL-STATUS        DTSBR590
00307         SET WRK-ERROR-YES TO TRUE.                                DTSBR590
00308                                                                   DTSBR590
00309      ACCEPT WRK-DATE FROM DATE.                                   DTSBR590
00310      MOVE WRK-DATE-DD     TO  HEAD01-SYS-DD.                      DTSBR590
00311      MOVE WRK-DATE-MM     TO  HEAD01-SYS-MM.                      DTSBR590
00312      MOVE WRK-DATE-YY     TO  HEAD01-SYS-YY.                      DTSBR590
00313      PERFORM S119-AGENCY-FACTS THRU S119-EXIT.                    DTSBR590
00314                                                                   DTSBR590
00315      MOVE L119-AGY-NAMEB1   TO HEAD01-PROGRAM-NAME.               DTSBR590
00316                                                                   DTSBR590
00317      MOVE SPACES TO HEAD02-AGY-NAME.                              DTSBR590
00318      STRING L119-AGY-NAMEB2        DELIMITED BY '  '              DTSBR590
00319          INTO HEAD02-AGY-NAME.                                    DTSBR590
00320                                                                   DTSBR590
00321      MOVE SPACES TO HEAD03-AGY-MAIL1.                             DTSBR590
00322      STRING L119-TAX-DIV-NAME      DELIMITED BY '  '              DTSBR590
00323          INTO HEAD03-AGY-MAIL1.                                   DTSBR590
00324                                                                   DTSBR590
00325  I2000-EXIT.                                                      DTSBR590
00326      EXIT.                                                        DTSBR590
00327      EJECT                                                        DTSBR590
00328  P0000-PROCESS.                                                   DTSBR590
00329                                                                   DTSBR590
00330                                                                   DTSBR590
00331      IF R590-UPDATE-88                                            DTSBR590
00332         PERFORM P1000-WRITE-RATE-RPT  THRU P1000-EXIT             DTSBR590
00333         PERFORM P2000-WRITE-RATE-TAPE THRU P2000-EXIT             DTSBR590
00334      ELSE                                                         DTSBR590
00335        IF R590-ERROR-88                                           DTSBR590
00336           PERFORM P3000-WRITE-ERROR-RPT THRU P3000-EXIT           DTSBR590
00337        ELSE                                                       DTSBR590
00338           PERFORM P6000-WRITE-FEIN-RPT THRU P6000-EXIT            DTSBR590
00339        END-IF                                                     DTSBR590
00340      END-IF.                                                      DTSBR590
00341                                                                   DTSBR590
00342  P0000-EXIT.                                                      DTSBR590
00343      EXIT.                                                        DTSBR590
00344      EJECT                                                        DTSBR590
00345  P1000-WRITE-RATE-RPT.                                            DTSBR590
00346                                                                   DTSBR590
00347      ADD +1 TO WRK-RATE-CNT.                                      DTSBR590
00348      MOVE R590-EMP-NO         TO EMP-NO-OUT.                      DTSBR590
00349      MOVE R590-EMP-FEIN       TO EMP-FEIN-OUT.                    DTSBR590
00350      MOVE R590-EMP-CONTR-RATE TO EMP-RATE-OUT.                    DTSBR590
00351      MOVE R590-SIC-CODE       TO EMP-SICC-OUT.                    DTSBR590
00352      MOVE R590-EMP-NAME       TO EMP-NAME-OUT.                    DTSBR590
00353      MOVE R590-EMP-NAME-A     TO EMP-NAMEA-OUT.                   DTSBR590
00354                                                                   DTSBR590
00355      PERFORM P1100-WRITE-RATE-REPORT THRU P1100-EXIT.             DTSBR590
00356  P1000-EXIT.                                                      DTSBR590
00357      EXIT.                                                        DTSBR590
00358  P1100-WRITE-RATE-REPORT.                                         DTSBR590
00359                                                                   DTSBR590
00360      MOVE SPACES       TO WS-REC.                                 DTSBR590
00361        IF RPT01-LINE-CNT > 56                                     DTSBR590
00362           PERFORM P4000-RATE-HEADINGS THRU P4000-EXIT.            DTSBR590
00363                                                                   DTSBR590
00364      MOVE RPT01DET     TO WS-REC.                                 DTSBR590
00365      WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 1 LINE.           DTSBR590
00366      ADD 1 TO RPT01-LINE-CNT.                                     DTSBR590
00367      ADD 1 TO WS-NUMBER-ONE.                                      DTSBR590
00368                                                                   DTSBR590
00369  P1100-EXIT.                                                      DTSBR590
00370      EXIT.                                                        DTSBR590
00371                                                                   DTSBR590
00372  P2000-WRITE-RATE-TAPE.                                           DTSBR590
00373      ADD +1 TO WRK-TAPE-CNT.                                      DTSBR590
00374      MOVE R590-EMP-NO          TO XFAT-EMP-NO.                    DTSBR590
00375      MOVE R590-EMP-FEIN        TO XFAT-EMP-FEIN.                  DTSBR590
00376      MOVE R590-EMP-CONTR-RATE  TO XFAT-EMP-CONTR-RATE.            DTSBR590
00377      MOVE R590-SIC-CODE        TO XFAT-SIC-CODE.                  DTSBR590
00378      MOVE R590-EMP-NAME        TO XFAT-EMP-NAME.                  DTSBR590
00379      MOVE R590-EMP-NAME-A      TO XFAT-EMP-NAME-A.                DTSBR590
00380      MOVE R590-EMP-STATUS-CODE TO XFAT-EMP-STATUS-CODE.           DTSBR590
00381                                                                   DTSBR590
00382      WRITE DTS-TAPE-OUTREC FROM DTS-TAPE-REC.                     DTSBR590
00383  P2000-EXIT.                                                      DTSBR590
00384      EXIT.                                                        DTSBR590
00385                                                                   DTSBR590
00386  P3000-WRITE-ERROR-RPT.                                           DTSBR590
00387                                                                   DTSBR590
00388      ADD +1 TO WRK-EROR-CNT.                                      DTSBR590
00389      MOVE R590-EMP-NO          TO ERR-NO-OUT.                     DTSBR590
00390      MOVE R590-EMP-FEIN        TO ERR-FEIN-OUT.                   DTSBR590
00391      MOVE R590-EMP-STATUS-CODE TO ERR-STATUS-OUT.                 DTSBR590
00392      MOVE R590-EMP-NAME        TO ERR-NAME-OUT.                   DTSBR590
00393      MOVE R590-MESSAGE         TO ERR-MSG-OUT.                    DTSBR590
00394      PERFORM P3100-WRITE-EROR-REPORT THRU P3100-EXIT.             DTSBR590
00395                                                                   DTSBR590
00396  P3000-EXIT.                                                      DTSBR590
00397      EXIT.                                                        DTSBR590
00398      EJECT                                                        DTSBR590
00399  P3100-WRITE-EROR-REPORT.                                         DTSBR590
00400                                                                   DTSBR590
00401      MOVE SPACES       TO WS-REC.                                 DTSBR590
00402        IF RPT02-LINE-CNT > 56                                     DTSBR590
00403           PERFORM P4500-EROR-HEADINGS THRU P4500-EXIT.            DTSBR590
00404                                                                   DTSBR590
00405      MOVE RPT02DET     TO WS-REC.                                 DTSBR590
00406      WRITE PRT-REC2 FROM WS-REC AFTER ADVANCING 1 LINE.           DTSBR590
00407      ADD 1 TO RPT02-LINE-CNT.                                     DTSBR590
00408      ADD 1 TO WS-NUMBER-TWO.                                      DTSBR590
00409  P3100-EXIT.                                                      DTSBR590
00410      EXIT.                                                        DTSBR590
00411  P4000-RATE-HEADINGS.                                             DTSBR590
00412      PERFORM P5000-FISCAL-AGENT      THRU P5000-EXIT.             DTSBR590
00413         ADD  1 TO RPT01-PAGE-CNT.                                 DTSBR590
00414         MOVE RPT01-PAGE-CNT TO HEAD03-PAGE-CNT.                   DTSBR590
00415         MOVE HEAD01 TO WS-REC                                     DTSBR590
00416         WRITE PRT-REC1  FROM WS-REC  AFTER ADVANCING PAGE         DTSBR590
00417         MOVE HEAD02 TO WS-REC                                     DTSBR590
00418         WRITE PRT-REC1  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR590
00419         MOVE HEAD03 TO WS-REC                                     DTSBR590
00420         WRITE PRT-REC1  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR590
00421         MOVE SPACES TO WS-REC                                     DTSBR590
00422         WRITE PRT-REC1  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR590
00423         MOVE HEAD04 TO WS-REC                                     DTSBR590
00424         WRITE PRT-REC1  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR590
00425         MOVE SPACES TO WS-REC                                     DTSBR590
00426         WRITE PRT-REC1  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR590
00427         MOVE HEAD05 TO WS-REC                                     DTSBR590
00428         WRITE PRT-REC1  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR590
00429         MOVE HEAD06 TO WS-REC                                     DTSBR590
00430         WRITE PRT-REC1  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR590
00431         MOVE SPACES TO WS-REC                                     DTSBR590
00432         WRITE PRT-REC1  FROM WS-REC  AFTER ADVANCING 1 LINE.      DTSBR590
00433         MOVE 10 TO RPT01-LINE-CNT.                                DTSBR590
00434  P4000-EXIT.                                                      DTSBR590
00435      EXIT.                                                        DTSBR590
00436      EJECT                                                        DTSBR590
00437  P4500-EROR-HEADINGS.                                             DTSBR590
00438                                                                   DTSBR590
00439 *?      MOVE +62     TO RPT02-LINE-CNT.                           DTSBR590
00440         MOVE '590R3' TO HEAD01-RPT-NAME.                          DTSBR590
00441         MOVE 'FISCAL AGENT RATE TAPE ERROR REPORT' TO HEAD04-TITLEDTSBR590
00442                                                                   DTSBR590
00443         PERFORM P5000-FISCAL-AGENT      THRU P5000-EXIT.          DTSBR590
00444                                                                   DTSBR590
00445         ADD  1 TO RPT02-PAGE-CNT.                                 DTSBR590
00446         MOVE RPT02-PAGE-CNT TO HEAD03-PAGE-CNT.                   DTSBR590
00447         MOVE HEAD01 TO WS-REC                                     DTSBR590
00448         WRITE PRT-REC2  FROM WS-REC  AFTER ADVANCING PAGE         DTSBR590
00449         MOVE HEAD02 TO WS-REC                                     DTSBR590
00450         WRITE PRT-REC2  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR590
00451         MOVE HEAD03 TO WS-REC                                     DTSBR590
00452         WRITE PRT-REC2  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR590
00453         MOVE SPACES TO WS-REC                                     DTSBR590
00454         WRITE PRT-REC2  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR590
00455         MOVE HEAD04 TO WS-REC                                     DTSBR590
00456         WRITE PRT-REC2  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR590
00457         MOVE SPACES TO WS-REC                                     DTSBR590
00458         WRITE PRT-REC2  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR590
00459         MOVE HEAD07 TO WS-REC                                     DTSBR590
00460         WRITE PRT-REC2  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR590
00461         MOVE HEAD08 TO WS-REC                                     DTSBR590
00462         WRITE PRT-REC2  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR590
00463         MOVE SPACES TO WS-REC                                     DTSBR590
00464         WRITE PRT-REC2  FROM WS-REC  AFTER ADVANCING 1 LINE.      DTSBR590
00465         MOVE 10 TO RPT02-LINE-CNT.                                DTSBR590
00466  P4500-EXIT.                                                      DTSBR590
00467      EXIT.                                                        DTSBR590
00468  P4700-FEIN-HEADINGS.                                             DTSBR590
00469                                                                   DTSBR590
00470 *?      MOVE +62     TO RPT03-LINE-CNT.                           DTSBR590
00471         MOVE '590R4' TO HEAD01-RPT-NAME.                          DTSBR590
00472         MOVE 'ACCOUNT NUMBERS/FEIN NUMBERS FOUND ' TO HEAD04-TITLEDTSBR590
00473                                                                   DTSBR590
00474         PERFORM P5000-FISCAL-AGENT      THRU P5000-EXIT.          DTSBR590
00475                                                                   DTSBR590
00476         ADD  1 TO RPT03-PAGE-CNT.                                 DTSBR590
00477         MOVE RPT03-PAGE-CNT TO HEAD03-PAGE-CNT.                   DTSBR590
00478         MOVE HEAD01 TO WS-REC                                     DTSBR590
00479         WRITE PRT-REC3  FROM WS-REC  AFTER ADVANCING PAGE         DTSBR590
00480         MOVE HEAD02 TO WS-REC                                     DTSBR590
00481         WRITE PRT-REC3  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR590
00482         MOVE HEAD03 TO WS-REC                                     DTSBR590
00483         WRITE PRT-REC3  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR590
00484         MOVE SPACES TO WS-REC                                     DTSBR590
00485         WRITE PRT-REC3  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR590
00486         MOVE HEAD04 TO WS-REC                                     DTSBR590
00487         WRITE PRT-REC3  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR590
00488         MOVE SPACES TO WS-REC                                     DTSBR590
00489         WRITE PRT-REC3  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR590
00490         MOVE HEAD07 TO WS-REC                                     DTSBR590
00491         WRITE PRT-REC3  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR590
00492         MOVE HEAD08 TO WS-REC                                     DTSBR590
00493         WRITE PRT-REC3  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR590
00494         MOVE SPACES TO WS-REC                                     DTSBR590
00495         WRITE PRT-REC3  FROM WS-REC  AFTER ADVANCING 1 LINE.      DTSBR590
00496         MOVE 10 TO RPT03-LINE-CNT.                                DTSBR590
00497  P4700-EXIT.                                                      DTSBR590
00498      EXIT.                                                        DTSBR590
00499      EJECT                                                        DTSBR590
00500  P5000-FISCAL-AGENT.                                              DTSBR590
00501         IF R590-FISCAL-AGENT-CD = WRK-FISCAL-AGENT-CD             DTSBR590
00502            GO TO P5000-EXIT.                                      DTSBR590
00503      SET WRK-FISC-AGNT-INVALID-88 TO TRUE                         DTSBR590
00504                                                                   DTSBR590
00505      PERFORM VARYING FISCAL-AGENT-IDX FROM 1 BY 1                 DTSBR590
00506         UNTIL WRK-FISC-AGNT-VALID-88                              DTSBR590
00507            OR FISCAL-AGENT-IDX > FISCAL-AGENT-CNT                 DTSBR590
00508            OR FISCAL-AGENT-CODE (FISCAL-AGENT-IDX)                DTSBR590
00509                                = SPACE                            DTSBR590
00510              IF R590-FISCAL-AGENT-CD =                            DTSBR590
00511                      FISCAL-AGENT-CODE (FISCAL-AGENT-IDX)         DTSBR590
00512                 SET WRK-FISC-AGNT-VALID-88 TO TRUE                DTSBR590
00513                 MOVE FISCAL-AGENT-CODE (FISCAL-AGENT-IDX)         DTSBR590
00514                   TO WRK-FISCAL-AGENT-CD                          DTSBR590
00515                 MOVE FISCAL-AGENT-NAME (FISCAL-AGENT-IDX)         DTSBR590
00516                   TO HEAD03-FA-NAME                               DTSBR590
00517              END-IF                                               DTSBR590
00518      END-PERFORM.                                                 DTSBR590
00519                                                                   DTSBR590
00520      IF WRK-FISC-AGNT-INVALID-88                                  DTSBR590
00521         MOVE 'INVALID FISCAL AGENT' TO HEAD03-FA-NAME             DTSBR590
00522         GO TO P5000-EXIT.                                         DTSBR590
00523  P5000-EXIT.                                                      DTSBR590
00524      EXIT.                                                        DTSBR590
00525  P6000-WRITE-FEIN-RPT.                                            DTSBR590
00526                                                                   DTSBR590
00527      ADD +1 TO WRK-FEIN-CNT.                                      DTSBR590
00528      MOVE R590-EMP-NO          TO FEIN-NO-OUT.                    DTSBR590
00529      MOVE R590-EMP-FEIN        TO FEIN-FEIN-OUT.                  DTSBR590
00530      MOVE R590-EMP-STATUS-CODE TO FEIN-STATUS-OUT.                DTSBR590
00531      MOVE R590-EMP-NAME        TO FEIN-NAME-OUT.                  DTSBR590
00532      MOVE R590-MESSAGE         TO FEIN-MSG-OUT.                   DTSBR590
00533      PERFORM P6100-WRITE-FEIN-REPORT THRU P6100-EXIT.             DTSBR590
00534                                                                   DTSBR590
00535  P6000-EXIT.                                                      DTSBR590
00536      EXIT.                                                        DTSBR590
00537      EJECT                                                        DTSBR590
00538  P6100-WRITE-FEIN-REPORT.                                         DTSBR590
00539                                                                   DTSBR590
00540      MOVE SPACES       TO WS-REC.                                 DTSBR590
00541        IF RPT03-LINE-CNT > 56                                     DTSBR590
00542           PERFORM P4700-FEIN-HEADINGS THRU P4700-EXIT.            DTSBR590
00543                                                                   DTSBR590
00544      MOVE RPT03DET     TO WS-REC.                                 DTSBR590
00545      WRITE PRT-REC3 FROM WS-REC AFTER ADVANCING 1 LINE.           DTSBR590
00546      ADD 1 TO RPT03-LINE-CNT.                                     DTSBR590
00547      ADD 1 TO WS-NUMBER-THREE.                                    DTSBR590
00548  P6100-EXIT.                                                      DTSBR590
00549      EXIT.                                                        DTSBR590
00550  T0000-TERMINATE.                                                 DTSBR590
00551                                                                   DTSBR590
00552      DISPLAY ' '.                                                 DTSBR590
00553                                                                   DTSBR590
00554      DISPLAY '*** DTSBR590 TERMINATION STATISTICS ***'.           DTSBR590
00555                                                                   DTSBR590
00556      DISPLAY ' '.                                                 DTSBR590
00557                                                                   DTSBR590
00558      DISPLAY 'NUMBER OF INPUT  RATE RECORDS READ               : 'DTSBR590
00559              WRK-RATE-CNT.                                        DTSBR590
00560      DISPLAY 'NUMBER OF INPUT ERROR RECORDS READ               : 'DTSBR590
00561              WRK-EROR-CNT.                                        DTSBR590
00562      DISPLAY 'NUMBER OF INPUT FEIN OR EMPLOYER ACCOUNT READ    : 'DTSBR590
00563              WRK-FEIN-CNT.                                        DTSBR590
00564 *RW1                                                              DTSBR590
00565      IF RPT01-LINE-CNT > 52 OR WS-NUMBER-ONE = ZERO               DTSBR590
00566         MOVE '590R1' TO HEAD01-RPT-NAME                           DTSBR590
00567         MOVE 'FISCAL AGENT RATE TAPE REPORT' TO HEAD04-TITLE      DTSBR590
00568         ADD  1 TO RPT01-PAGE-CNT                                  DTSBR590
00569         MOVE RPT01-PAGE-CNT TO HEAD03-PAGE-CNT                    DTSBR590
00570         MOVE HEAD01 TO WS-REC                                     DTSBR590
00571         WRITE PRT-REC1  FROM WS-REC  AFTER ADVANCING PAGE         DTSBR590
00572         MOVE HEAD02 TO WS-REC                                     DTSBR590
00573         WRITE PRT-REC1  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR590
00574         MOVE HEAD03 TO WS-REC                                     DTSBR590
00575         WRITE PRT-REC1  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR590
00576         MOVE SPACES TO WS-REC                                     DTSBR590
00577         WRITE PRT-REC1  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR590
00578         MOVE HEAD04 TO WS-REC                                     DTSBR590
00579         WRITE PRT-REC1  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR590
00580         MOVE SPACES TO WS-REC                                     DTSBR590
00581         WRITE PRT-REC1  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR590
00582         MOVE HEAD05 TO WS-REC                                     DTSBR590
00583         WRITE PRT-REC1  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR590
00584         MOVE HEAD06 TO WS-REC                                     DTSBR590
00585         WRITE PRT-REC1  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR590
00586         MOVE SPACES TO WS-REC.                                    DTSBR590
00587                                                                   DTSBR590
00588      MOVE WS-NUMBER-ONE TO WS-FOOTING-CNT.                        DTSBR590
00589      MOVE 'FISCAL AGENT RATE REPORT RECORDS WRITTEN' TO WS-REPORT.DTSBR590
00590      WRITE PRT-REC1   FROM FOOTING-LINE-1 AFTER 1.                DTSBR590
00591      WRITE PRT-REC1   FROM FOOTING-LINE-2 AFTER 1.                DTSBR590
00592      WRITE PRT-REC1   FROM FOOTING-LINE-3 AFTER 1.                DTSBR590
00593      WRITE PRT-REC1   FROM FOOTING-LINE-4 AFTER 1.                DTSBR590
00594      WRITE PRT-REC1   FROM FOOTING-LINE-5 AFTER 1.                DTSBR590
00595      WRITE PRT-REC1   FROM FOOTING-LINE-6 AFTER 1.                DTSBR590
00596                                                                   DTSBR590
00597      IF RPT02-LINE-CNT > 52 OR WS-NUMBER-TWO = ZERO               DTSBR590
00598         MOVE '590R3' TO HEAD01-RPT-NAME                           DTSBR590
00599         MOVE 'FISCAL AGENT RATE TAPE ERROR REPORT' TO HEAD04-TITLEDTSBR590
00600         ADD  1 TO RPT02-PAGE-CNT                                  DTSBR590
00601         MOVE RPT02-PAGE-CNT TO HEAD03-PAGE-CNT                    DTSBR590
00602         MOVE HEAD01 TO WS-REC                                     DTSBR590
00603         WRITE PRT-REC2  FROM WS-REC  AFTER ADVANCING PAGE         DTSBR590
00604         MOVE HEAD02 TO WS-REC                                     DTSBR590
00605         WRITE PRT-REC2  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR590
00606         MOVE HEAD03 TO WS-REC                                     DTSBR590
00607         WRITE PRT-REC2  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR590
00608         MOVE SPACES TO WS-REC                                     DTSBR590
00609         WRITE PRT-REC2  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR590
00610         MOVE HEAD04 TO WS-REC                                     DTSBR590
00611         WRITE PRT-REC2  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR590
00612         MOVE SPACES TO WS-REC                                     DTSBR590
00613         WRITE PRT-REC2  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR590
00614         MOVE HEAD07 TO WS-REC                                     DTSBR590
00615         WRITE PRT-REC2  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR590
00616         MOVE HEAD08 TO WS-REC                                     DTSBR590
00617         WRITE PRT-REC2  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR590
00618         MOVE SPACES TO WS-REC                                     DTSBR590
00619         WRITE PRT-REC2  FROM WS-REC  AFTER ADVANCING 1 LINE.      DTSBR590
00620                                                                   DTSBR590
00621      MOVE WS-NUMBER-TWO TO WS-FOOTING-CNT.                        DTSBR590
00622      MOVE 'FISCAL AGENT ERRORS RECORDS WRITTEN' TO WS-REPORT.     DTSBR590
00623      WRITE PRT-REC2   FROM FOOTING-LINE-1 AFTER 1.                DTSBR590
00624      WRITE PRT-REC2   FROM FOOTING-LINE-2 AFTER 1.                DTSBR590
00625      WRITE PRT-REC2   FROM FOOTING-LINE-3 AFTER 1.                DTSBR590
00626      WRITE PRT-REC2   FROM FOOTING-LINE-3-DUP AFTER 1.            DTSBR590
00627      WRITE PRT-REC2   FROM FOOTING-LINE-4 AFTER 1.                DTSBR590
00628      WRITE PRT-REC2   FROM FOOTING-LINE-5 AFTER 1.                DTSBR590
00629      WRITE PRT-REC2   FROM FOOTING-LINE-6 AFTER 1.                DTSBR590
00630                                                                   DTSBR590
00631      IF RPT03-LINE-CNT > 52 OR WS-NUMBER-THREE = ZERO             DTSBR590
00632         MOVE '590R4' TO HEAD01-RPT-NAME                           DTSBR590
00633         MOVE 'ACCOUNT NUMBERS/FEIN NUMBERS FOUND ' TO HEAD04-TITLEDTSBR590
00634         ADD  1 TO RPT03-PAGE-CNT                                  DTSBR590
00635         MOVE RPT03-PAGE-CNT TO HEAD03-PAGE-CNT                    DTSBR590
00636         MOVE HEAD01 TO WS-REC                                     DTSBR590
00637         WRITE PRT-REC3  FROM WS-REC  AFTER ADVANCING PAGE         DTSBR590
00638         MOVE HEAD02 TO WS-REC                                     DTSBR590
00639         WRITE PRT-REC3  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR590
00640         MOVE HEAD03 TO WS-REC                                     DTSBR590
00641         WRITE PRT-REC3  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR590
00642         MOVE SPACES TO WS-REC                                     DTSBR590
00643         WRITE PRT-REC3  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR590
00644         MOVE HEAD04 TO WS-REC                                     DTSBR590
00645         WRITE PRT-REC3  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR590
00646         MOVE SPACES TO WS-REC                                     DTSBR590
00647         WRITE PRT-REC3  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR590
00648         MOVE HEAD07 TO WS-REC                                     DTSBR590
00649         WRITE PRT-REC3  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR590
00650         MOVE HEAD08 TO WS-REC                                     DTSBR590
00651         WRITE PRT-REC3  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR590
00652         MOVE SPACES TO WS-REC                                     DTSBR590
00653         WRITE PRT-REC3  FROM WS-REC  AFTER ADVANCING 1 LINE.      DTSBR590
00654                                                                   DTSBR590
00655      MOVE WS-NUMBER-THREE TO WS-FOOTING-CNT.                      DTSBR590
00656      MOVE 'FEIN/EMP-ACCT RECORDS FOUND WRITTEN' TO WS-REPORT.     DTSBR590
00657      WRITE PRT-REC3   FROM FOOTING-LINE-1 AFTER 1.                DTSBR590
00658      WRITE PRT-REC3   FROM FOOTING-LINE-2 AFTER 1.                DTSBR590
00659      WRITE PRT-REC3   FROM FOOTING-LINE-3 AFTER 1.                DTSBR590
00660      WRITE PRT-REC3   FROM FOOTING-LINE-4 AFTER 1.                DTSBR590
00661      WRITE PRT-REC3   FROM FOOTING-LINE-5 AFTER 1.                DTSBR590
00662      WRITE PRT-REC3   FROM FOOTING-LINE-6 AFTER 1.                DTSBR590
00663                                                                   DTSBR590
00664 *RW2                                                              DTSBR590
00665      CLOSE DTS-RATE-OUT                                           DTSBR590
00666            DTS-TAPE-OUT                                           DTSBR590
00667            DTS-FEIN-OUT                                           DTSBR590
00668            DTS-EROR-OUT.                                          DTSBR590
00669                                                                   DTSBR590
00670  T0000-EXIT.                                                      DTSBR590
00671      EXIT.                                                        DTSBR590
00672      EJECT                                                        DTSBR590
00673      SKIP3                                                        DTSBR590
00674  S119-AGENCY-FACTS.                                               DTSBR590
00675      SET L119-REQ-CAPS-88 TO TRUE.                                DTSBR590
00676      SET L119-REQ-COLLECTIONS-88 TO TRUE.                         DTSBR590
00677                                                                   DTSBR590
00678      CALL 'DTSBU119' USING L119-LINK-AREA.                        DTSBR590
00679  S119-EXIT.                                                       DTSBR590
00680      EXIT.                                                        DTSBR590
00681      SKIP3                                                        DTSBR590
00682  S999-ABEND.                                                      DTSBR590
00683      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBR590
00684  S999-EXIT.                                                       DTSBR590
00685      EXIT.                                                        DTSBR590
