00001  IDENTIFICATION DIVISION.                                         10/08/02
00002  PROGRAM-ID.             DTSBR591.                                DTSBR591
00003  AUTHOR.                 TRW.                                        LV008
00004  DATE-WRITTEN.           FEBRUARY 2000.                           DTSBR591
00005  DATE-COMPILED.                                                   DTSBR591
00006      SKIP3                                                        DTSBR591
00007 *****                                                             DTSBR591
00008 *                                                                 DTSBR591
00009 *    FUNCTION:  CREATE FISCAL AGENT  BENEFIT CHARGE ERROR         DTSBR591
00010 *               REPORT.                                           DTSBR591
00011 *****                                                             DTSBR591
00012      SKIP3                                                        DTSBR591
00013  ENVIRONMENT DIVISION.                                            DTSBR591
00014  INPUT-OUTPUT SECTION.                                            DTSBR591
00015  FILE-CONTROL.                                                    DTSBR591
00016                                                                   DTSBR591
00017      SELECT DTS-EROR-OUT ASSIGN TO RPT591R1                       DTSBR591
00018         FILE STATUS IS WRK-COL-STATUS.                            DTSBR591
00019                                                                   DTSBR591
00020                                                                   DTSBR591
00021      SKIP2                                                        DTSBR591
00022  DATA DIVISION.                                                   DTSBR591
00023  FILE SECTION.                                                    DTSBR591
00024                                                                   DTSBR591
00025  FD  DTS-EROR-OUT                                                 DTSBR591
00026      LABEL RECORDS ARE STANDARD.                                  DTSBR591
00027                                                                   DTSBR591
00028  01  PRT-REC1                        PIC X(133).                  DTSBR591
00029                                                                   DTSBR591
00030  WORKING-STORAGE SECTION.                                         DTSBR591
000305 77  PAN-VALET PICTURE X(24) VALUE '008DTSBR591  10/08/02'.       DTSBR591
00031      SKIP3                                                        DTSBR591
00032  01  WRK-AREA.                                                    DTSBR591
00033      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +591.DTSBR591
00034                                                                   DTSBR591
00035      05  WRK-FISCAL-AGENT-CD         PIC  X(03)  VALUE SPACES.    DTSBR591
00036      05  WRK-EMP-NAME.                                            DTSBR591
00037          10  WRK-EMP-NAMEA           PIC  X(01)  VALUE SPACES.    DTSBR591
00038          10  WRK-EMP-NAMEB           PIC  X(39)  VALUE SPACES.    DTSBR591
00039                                                                   DTSBR591
00040      05  WRK-EMP-PHA                 PIC  X(10)  VALUE SPACES.    DTSBR591
00041      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBR591'.DTSBR591
00042      05  FIRST-TIME-IND              PIC  X(01)  VALUE 'Y'.       DTSBR591
00043                                                                   DTSBR591
00044      05  WRK-RATE-CNT                PIC S9(07)  COMP-3 VALUE 0.  DTSBR591
00045      05  WRK-TAPE-CNT                PIC S9(07)  COMP-3 VALUE 0.  DTSBR591
00046      05  WRK-EROR-CNT                PIC S9(07)  COMP-3 VALUE 0.  DTSBR591
00047                                                                   DTSBR591
00048      05  WRK-COL-CNT                 PIC S9(07)  COMP-3.          DTSBR591
00049                                                                   DTSBR591
00050      05  WRK-COL-STATUS              PIC  X(02).                  DTSBR591
00051          88 WRK-COL-STAT-OK       VALUE '00'.                     DTSBR591
00052      05  WRK-MPRF-IND                PIC  X(01).                  DTSBR591
00053          88 WRK-MPRF-OK           VALUE 'Y'.                      DTSBR591
00054          88 WRK-MPRF-NO-REC       VALUE 'N'.                      DTSBR591
00055                                                                   DTSBR591
00056      05  WRK-ERROR-IND               PIC  X(01)  VALUE SPACES.    DTSBR591
00057          88 WRK-ERROR-YES         VALUE 'Y'.                      DTSBR591
00058          88 WRK-ERROR-NO          VALUE 'N'.                      DTSBR591
00059                                                                   DTSBR591
00060      05  WRK-FISC-AGNT-CODE          PIC  X(01).                  DTSBR591
00061          88 WRK-FISC-AGNT-VALID-88   VALUE 'Y'.                   DTSBR591
00062          88 WRK-FISC-AGNT-INVALID-88 VALUE 'N'.                   DTSBR591
00063                                                                   DTSBR591
00064      05  RPT01-LINE-CNT                  PIC  S9(05) VALUE +65.   DTSBR591
00065      05  RPT01-PAGE-CNT                  PIC  S9(05) VALUE +0.    DTSBR591
00066                                                                   DTSBR591
00067      05  WRK-DATE                        PIC  9(06) VALUE ZEROS.  DTSBR591
00068      05  WRK-DATE-9 REDEFINES WRK-DATE.                           DTSBR591
00069          10  WRK-DATE-YY                 PIC  9(02).              DTSBR591
00070          10  WRK-DATE-MM                 PIC  9(02).              DTSBR591
00071          10  WRK-DATE-DD                 PIC  9(02).              DTSBR591
00072      05  WRK-TRACE-IND                   PIC  X(01).              DTSBR591
00073                                                                   DTSBR591
00074      05  WS-REC                          PIC  X(133) VALUE SPACES.DTSBR591
00075      EJECT                                                        DTSBR591
00076  01  RPT01DET.                                                    DTSBR591
00077      05  FILLER                      PIC X(2)  VALUE SPACES.      DTSBR591
00078      05  R591-EMP-NO-OUT             PIC X(6)  VALUE SPACES.      DTSBR591
00079      05  FILLER                      PIC X(4)  VALUE SPACES.      DTSBR591
00080      05  R591-EMP-NAME-OUT           PIC X(40) VALUE SPACES.      DTSBR591
00081      05  FILLER                      PIC X(4)  VALUE SPACES.      DTSBR591
00082      05  R591-MESSAGE-OUT            PIC X(40) VALUE SPACES.      DTSBR591
00083      05  FILLER                      PIC X(3)  VALUE SPACES.      DTSBR591
00084      EJECT                                                        DTSBR591
00085                                                                   DTSBR591
00086  01  REPORT-LINE-AREA.                                            DTSBR591
00087      05  HEAD01.                                                  DTSBR591
00088          10  FILLER                  PIC  X(05)  VALUE SPACE.     DTSBR591
00089          10  HEAD01-RPT-NAME         PIC  X(05)  VALUE '591R1'.   DTSBR591
00090          10  FILLER                  PIC  X(47)  VALUE SPACES.    DTSBR591
00091          10  HEAD01-PROGRAM-NAME     PIC  X(52).                  DTSBR591
00092          10  FILLER                  PIC  X(04)  VALUE SPACES.    DTSBR591
00093          10  FILLER                  PIC  X(06)  VALUE 'DATE: '.  DTSBR591
00094          10  HEAD01-SYS-DATE.                                     DTSBR591
00095             15  HEAD01-SYS-MM        PIC  99.                     DTSBR591
00096             15  FILLER               PIC  X(01)  VALUE '/'.       DTSBR591
00097             15  HEAD01-SYS-DD        PIC  99.                     DTSBR591
00098             15  FILLER               PIC  X(01)  VALUE '/'.       DTSBR591
00099             15  HEAD01-SYS-CEN       PIC  99     VALUE 20.        DTSBR591
00100             15  HEAD01-SYS-YY        PIC  99.                     DTSBR591
00101                                                                   DTSBR591
00102      05  HEAD02.                                                  DTSBR591
00103          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR591
00104          10  FILLER                  PIC  X(50)  VALUE SPACES.    DTSBR591
00105          10  HEAD02-AGY-NAME         PIC  X(60).                  DTSBR591
00106          10  HEAD02-SYS-TIME         PIC  X(10)  VALUE SPACES.    DTSBR591
00107                                                                   DTSBR591
00108      05  HEAD03.                                                  DTSBR591
00109          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR591
00110          10  FILLER                  PIC  X(20)                   DTSBR591
00111                VALUE 'FISCAL AGENT NAME:'.                        DTSBR591
00112          10  HEAD03-FA-NAME          PIC  X(35)  VALUE SPACES.    DTSBR591
00113          10  FILLER                  PIC  X(05)  VALUE SPACES.    DTSBR591
00114          10  HEAD03-AGY-MAIL1        PIC  X(52).                  DTSBR591
00115          10  FILLER                  PIC  X(06)  VALUE 'PAGE: '.  DTSBR591
00116          10  HEAD03-PAGE-CNT         PIC  ZZZ9.                   DTSBR591
00117                                                                   DTSBR591
00118      05  HEAD04.                                                  DTSBR591
00119          10  FILLER                  PIC  X(01)  VALUE SPACE.     DTSBR591
00120          10  FILLER                  PIC  X(50)  VALUE SPACES.    DTSBR591
00121          10  HEAD04-TITLE            PIC  X(39)                   DTSBR591
00122                VALUE 'FISCAL AGENT CHARGE TAPE ERROR REPORT'.     DTSBR591
00123          10  FILLER                  PIC  X(42)  VALUE SPACES.    DTSBR591
00124                                                                   DTSBR591
00125      05  HEAD05.                                                  DTSBR591
00126          10  FILLER                  PIC  X(02)  VALUE SPACE.     DTSBR591
00127          10  FILLER                  PIC  X(43)  VALUE            DTSBR591
00128              'ACCOUNT    EMPLOYER                      '.         DTSBR591
00129          10  FILLER                  PIC  X(32)  VALUE            DTSBR591
00130              '           MESSAGE              '.                  DTSBR591
00131          10  FILLER                  PIC  X(58)  VALUE SPACE.     DTSBR591
00132      05  HEAD06.                                                  DTSBR591
00133          10  FILLER                  PIC  X(02)  VALUE SPACE.     DTSBR591
00134          10  FILLER                  PIC  X(43)  VALUE            DTSBR591
00135              'NUMBER     NAME                            '.       DTSBR591
00136          10  FILLER                  PIC  X(58)  VALUE SPACES.    DTSBR591
00137                                                                   DTSBR591
00138      EJECT                                                        DTSBR591
00139                                                                   DTSBR591
00140      EJECT                                                        DTSBR591
00141                                                                   DTSBR591
00142  01  L119-LINK-AREA.                                              DTSBR591
00143  ++INCLUDE DTSIL119                                               DTSBR591
00144      EJECT                                                        DTSBR591
00145  01  FISCAL-AGENT-TABLE-AREA.                                     DTSBR591
00146  ++INCLUDE CHGIC001                                               DTSBR591
00147      EJECT                                                        DTSBR591
00148  LINKAGE SECTION.                                                 DTSBR591
00149      SKIP3                                                        DTSBR591
00150  01  LRCM-LINK-AREA.                                              DTSBR591
00151  ++INCLUDE DTSILRCM                                               DTSBR591
00152                                                                   DTSBR591
00153  01  R591-REC.                                                    DTSBR591
00154  ++INCLUDE DTSIR591                                               DTSBR591
00155      EJECT                                                        DTSBR591
00156  PROCEDURE DIVISION USING LRCM-LINK-AREA                          DTSBR591
00157                           R591-REC.                               DTSBR591
00158                                                                   DTSBR591
00159      IF FIRST-TIME-IND = 'Y'                                      DTSBR591
00160          PERFORM I1000-INITIATE THRU I1000-EXIT                   DTSBR591
00161          MOVE 'N' TO FIRST-TIME-IND.                              DTSBR591
00162                                                                   DTSBR591
00163      IF WRK-ERROR-YES                                             DTSBR591
00164         PERFORM S999-ABEND THRU S999-EXIT                         DTSBR591
00165      ELSE                                                         DTSBR591
00166        IF LRCM-EOR-88                                             DTSBR591
00167          PERFORM T0000-TERMINATE THRU T0000-EXIT                  DTSBR591
00168        ELSE                                                       DTSBR591
00169          PERFORM P0000-PROCESS THRU P0000-EXIT.                   DTSBR591
00170      SKIP2                                                        DTSBR591
00171      GOBACK.                                                      DTSBR591
00172      EJECT                                                        DTSBR591
00173  I1000-INITIATE.                                                  DTSBR591
00174      SKIP2                                                        DTSBR591
00175      MOVE 'N' TO WRK-TRACE-IND.                                   DTSBR591
00176      SET WRK-ERROR-NO TO TRUE.                                    DTSBR591
00177                                                                   DTSBR591
00178      PERFORM I2000-OPEN-FILES          THRU I2000-EXIT.           DTSBR591
00179                                                                   DTSBR591
00180      SKIP2                                                        DTSBR591
00181  I1000-EXIT.                                                      DTSBR591
00182      EXIT.                                                        DTSBR591
00183  I2000-OPEN-FILES.                                                DTSBR591
00184                                                                   DTSBR591
00185      OPEN OUTPUT DTS-EROR-OUT.                                    DTSBR591
00186      IF NOT WRK-COL-STAT-OK                                       DTSBR591
00187         DISPLAY 'CANNOT OP EROR OUTP FILE ' WRK-COL-STATUS        DTSBR591
00188         SET WRK-ERROR-YES TO TRUE.                                DTSBR591
00189                                                                   DTSBR591
00190      ACCEPT WRK-DATE FROM DATE.                                   DTSBR591
00191      MOVE WRK-DATE-DD     TO  HEAD01-SYS-DD.                      DTSBR591
00192      MOVE WRK-DATE-MM     TO  HEAD01-SYS-MM.                      DTSBR591
00193      MOVE WRK-DATE-YY     TO  HEAD01-SYS-YY.                      DTSBR591
00194      PERFORM S119-AGENCY-FACTS THRU S119-EXIT.                    DTSBR591
00195                                                                   DTSBR591
00196      MOVE L119-AGY-NAMEB1   TO HEAD01-PROGRAM-NAME.               DTSBR591
00197                                                                   DTSBR591
00198      MOVE SPACES TO HEAD02-AGY-NAME.                              DTSBR591
00199      STRING L119-AGY-NAMEB2        DELIMITED BY '  '              DTSBR591
00200          INTO HEAD02-AGY-NAME.                                    DTSBR591
00201                                                                   DTSBR591
00202      MOVE SPACES TO HEAD03-AGY-MAIL1.                             DTSBR591
00203      STRING L119-TAX-DIV-NAME      DELIMITED BY '  '              DTSBR591
00204          INTO HEAD03-AGY-MAIL1.                                   DTSBR591
00205                                                                   DTSBR591
00206  I2000-EXIT.                                                      DTSBR591
00207      EXIT.                                                        DTSBR591
00208      EJECT                                                        DTSBR591
00209  P0000-PROCESS.                                                   DTSBR591
00210                                                                   DTSBR591
00211                                                                   DTSBR591
00212      IF R591-ERROR-88                                             DTSBR591
00213         PERFORM P1000-WRITE-ERROR-RPT THRU P1000-EXIT.            DTSBR591
00214                                                                   DTSBR591
00215                                                                   DTSBR591
00216  P0000-EXIT.                                                      DTSBR591
00217      EXIT.                                                        DTSBR591
00218      EJECT                                                        DTSBR591
00219  P1000-WRITE-ERROR-RPT.                                           DTSBR591
00220                                                                   DTSBR591
00221      ADD +1 TO WRK-EROR-CNT.                                      DTSBR591
00222      MOVE R591-EMP-NO            TO R591-EMP-NO-OUT.              DTSBR591
00223      MOVE R591-EMPLOYER-NAME     TO R591-EMP-NAME-OUT.            DTSBR591
00224      MOVE R591-MESSAGE           TO R591-MESSAGE-OUT.             DTSBR591
00225      PERFORM P1100-WRITE-EROR-REPORT THRU P1100-EXIT.             DTSBR591
00226                                                                   DTSBR591
00227  P1000-EXIT.                                                      DTSBR591
00228      EXIT.                                                        DTSBR591
00229      EJECT                                                        DTSBR591
00230  P1100-WRITE-EROR-REPORT.                                         DTSBR591
00231                                                                   DTSBR591
00232      MOVE SPACES       TO WS-REC.                                 DTSBR591
00233        IF RPT01-LINE-CNT > 60  OR                                 DTSBR591
00234           R591-FISCAL-AGENT-CD NOT = WRK-FISCAL-AGENT-CD          DTSBR591
00235           PERFORM P2000-EROR-HEADINGS THRU P2000-EXIT.            DTSBR591
00236                                                                   DTSBR591
00237      MOVE RPT01DET     TO WS-REC.                                 DTSBR591
00238      WRITE PRT-REC1 FROM WS-REC AFTER ADVANCING 1 LINE.           DTSBR591
00239      ADD 1 TO RPT01-LINE-CNT.                                     DTSBR591
00240  P1100-EXIT.                                                      DTSBR591
00241      EXIT.                                                        DTSBR591
00242  P2000-EROR-HEADINGS.                                             DTSBR591
00243      PERFORM P3000-FISCAL-AGENT      THRU P3000-EXIT.             DTSBR591
00244         ADD  1 TO RPT01-PAGE-CNT.                                 DTSBR591
00245         MOVE RPT01-PAGE-CNT TO HEAD03-PAGE-CNT.                   DTSBR591
00246         MOVE HEAD01 TO WS-REC                                     DTSBR591
00247         WRITE PRT-REC1  FROM WS-REC  AFTER ADVANCING PAGE         DTSBR591
00248         MOVE HEAD02 TO WS-REC                                     DTSBR591
00249         WRITE PRT-REC1  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR591
00250         MOVE HEAD03 TO WS-REC                                     DTSBR591
00251         WRITE PRT-REC1  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR591
00252         MOVE SPACES TO WS-REC                                     DTSBR591
00253         WRITE PRT-REC1  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR591
00254         MOVE HEAD04 TO WS-REC                                     DTSBR591
00255         WRITE PRT-REC1  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR591
00256         MOVE SPACES TO WS-REC                                     DTSBR591
00257         WRITE PRT-REC1  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR591
00258         MOVE HEAD05 TO WS-REC                                     DTSBR591
00259         WRITE PRT-REC1  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR591
00260         MOVE HEAD06 TO WS-REC                                     DTSBR591
00261         WRITE PRT-REC1  FROM WS-REC  AFTER ADVANCING 1 LINE       DTSBR591
00262         MOVE SPACES TO WS-REC                                     DTSBR591
00263         WRITE PRT-REC1  FROM WS-REC  AFTER ADVANCING 1 LINE.      DTSBR591
00264         MOVE 10 TO RPT01-LINE-CNT.                                DTSBR591
00265  P2000-EXIT.                                                      DTSBR591
00266      EXIT.                                                        DTSBR591
00267      EJECT                                                        DTSBR591
00268  P3000-FISCAL-AGENT.                                              DTSBR591
00269         IF R591-FISCAL-AGENT-CD = WRK-FISCAL-AGENT-CD             DTSBR591
00270            GO TO P3000-EXIT.                                      DTSBR591
00271      SET WRK-FISC-AGNT-INVALID-88 TO TRUE                         DTSBR591
00272                                                                   DTSBR591
00273      PERFORM VARYING FISCAL-AGENT-IDX FROM 1 BY 1                 DTSBR591
00274         UNTIL WRK-FISC-AGNT-VALID-88                              DTSBR591
00275            OR FISCAL-AGENT-IDX > FISCAL-AGENT-CNT                 DTSBR591
00276            OR FISCAL-AGENT-CODE (FISCAL-AGENT-IDX)                DTSBR591
00277                                = SPACE                            DTSBR591
00278              IF R591-FISCAL-AGENT-CD =                            DTSBR591
00279                  FISCAL-AGENT-CODE (FISCAL-AGENT-IDX)             DTSBR591
00280                 SET WRK-FISC-AGNT-VALID-88 TO TRUE                DTSBR591
00281                 MOVE FISCAL-AGENT-CODE(FISCAL-AGENT-IDX) TO       DTSBR591
00282                  WRK-FISCAL-AGENT-CD                              DTSBR591
00283                 MOVE FISCAL-AGENT-NAME(FISCAL-AGENT-IDX) TO       DTSBR591
00284                  HEAD03-FA-NAME                                   DTSBR591
00285              END-IF                                               DTSBR591
00286      END-PERFORM.                                                 DTSBR591
00287                                                                   DTSBR591
00288      IF WRK-FISC-AGNT-INVALID-88                                  DTSBR591
00289         MOVE 'INVALID FISCAL AGENT' TO HEAD03-FA-NAME             DTSBR591
00290         GO TO P3000-EXIT.                                         DTSBR591
00291  P3000-EXIT.                                                      DTSBR591
00292      EXIT.                                                        DTSBR591
00293  T0000-TERMINATE.                                                 DTSBR591
00294                                                                   DTSBR591
00295      DISPLAY ' '.                                                 DTSBR591
00296                                                                   DTSBR591
00297      DISPLAY '*** DTSBR591 TERMINATION STATISTICS ***'.           DTSBR591
00298                                                                   DTSBR591
00299      DISPLAY ' '.                                                 DTSBR591
00300                                                                   DTSBR591
00301      DISPLAY 'NUMBER OF ERROR  RECORDS READ                    : 'DTSBR591
00302              WRK-EROR-CNT.                                        DTSBR591
00303                                                                   DTSBR591
00304                                                                   DTSBR591
00305                                                                   DTSBR591
00306      CLOSE DTS-EROR-OUT.                                          DTSBR591
00307                                                                   DTSBR591
00308  T0000-EXIT.                                                      DTSBR591
00309      EXIT.                                                        DTSBR591
00310      EJECT                                                        DTSBR591
00311      SKIP3                                                        DTSBR591
00312  S119-AGENCY-FACTS.                                               DTSBR591
00313      SET L119-REQ-CAPS-88 TO TRUE.                                DTSBR591
00314      SET L119-REQ-COLLECTIONS-88 TO TRUE.                         DTSBR591
00315                                                                   DTSBR591
00316      CALL 'DTSBU119' USING L119-LINK-AREA.                        DTSBR591
00317  S119-EXIT.                                                       DTSBR591
00318      EXIT.                                                        DTSBR591
00319      SKIP3                                                        DTSBR591
00320  S999-ABEND.                                                      DTSBR591
00321      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBR591
00322  S999-EXIT.                                                       DTSBR591
00323      EXIT.                                                        DTSBR591
