00001  IDENTIFICATION DIVISION.                                         12/03/09
00002  PROGRAM-ID.             DTSBU620.                                DTSBU620
00003  AUTHOR.                 TRW/TDI OUTSOURCE.                          LV007
00004  DATE-WRITTEN.           APRIL 2000.                              DTSBU620
00005  DATE-COMPILED.                                                   DTSBU620
00006      SKIP3                                                        DTSBU620
00007 *****                                                             DTSBU620
00008 *                                                                 DTSBU620
00009 *    FUNCTION:  FISCAL AGENT UC-30 FILE CONVERSION TO             DTSBU620
00010 *               NEW FORMAT.                                       DTSBU620
00011 *                                                                 DTSBU620
00012 *                                                                 DTSBU620
00013 *****                                                             DTSBU620
00014      SKIP3                                                        DTSBU620
00015  ENVIRONMENT DIVISION.                                            DTSBU620
00016      SKIP2                                                        DTSBU620
00017  INPUT-OUTPUT SECTION.                                            DTSBU620
00018  FILE-CONTROL.                                                    DTSBU620
00019                                                                   DTSBU620
00020      SELECT FISCAL-AGENT-FILE1                                    DTSBU620
00021         ASSIGN TO FAFILEI                                         DTSBU620
00022         FILE STATUS IS FA-STATUS.                                 DTSBU620
00023                                                                   DTSBU620
00024      SELECT FISCAL-AGENT-FILE2                                    DTSBU620
00025         ASSIGN TO FAFILEO                                         DTSBU620
00026         FILE STATUS IS FA2-STATUS.                                DTSBU620
00027                                                                   DTSBU620
00028      SELECT PARM-FILE ASSIGN TO SYSIN                             DTSBU620
00029         FILE STATUS IS PARM-STATUS.                               DTSBU620
00030                                                                   DTSBU620
00031  DATA DIVISION.                                                   DTSBU620
00032      SKIP3                                                        DTSBU620
00033  FILE SECTION.                                                    DTSBU620
00034                                                                   DTSBU620
00035  FD  FISCAL-AGENT-FILE1                                           DTSBU620
00036      LABEL RECORDS ARE STANDARD                                   DTSBU620
00037      DATA RECORD IS FISCAL-AGET-INREC.                            DTSBU620
00038                                                                   DTSBU620
00039  01  FISCAL-AGENT-INREC.                                          DTSBU620
00040      05  XFARI-EMP-NO                 PIC X(06).                  DTSBU620
00041      05  XFARI-EMP-FEIN               PIC X(09).                  DTSBU620
00042      05  XFARI-FILLER                 PIC X(65).                  DTSBU620
00043                                                                   DTSBU620
00044  FD  FISCAL-AGENT-FILE2                                           DTSBU620
00045      LABEL RECORDS ARE STANDARD                                   DTSBU620
00046      DATA RECORD IS DTSIXFAQ.                                     DTSBU620
00047                                                                   DTSBU620
00048  01  FISCAL-AGENT-REC2.                                           DTSBU620
00049  ++INCLUDE DTSIXFAQ                                               DTSBU620
00050                                                                   DTSBU620
00051  FD  PARM-FILE                                                    DTSBU620
00052      RECORDING MODE IS F                                          DTSBU620
00053      BLOCK CONTAINS 0 CHARACTERS                                  DTSBU620
00054      DATA RECORD IS PARM-REC.                                     DTSBU620
00055                                                                   DTSBU620
00056  01  PARM-REC.                                                    DTSBU620
00057      05  PARM-RUN-FISCAL-AGENT-CD    PIC  X(03).                  DTSBU620
00058      05  FILLER                      PIC  X(77).                  DTSBU620
00059                                                                   DTSBU620
00060      EJECT                                                        DTSBU620
00061  WORKING-STORAGE SECTION.                                         DTSBU620
000615 77  PAN-VALET PICTURE X(24) VALUE '007DTSBU620  12/03/09'.       DTSBU620
00062      SKIP3                                                        DTSBU620
00063  01  WRK-FISCAL-AGENT-REC2.                                       DTSBU620
00064          10  WRK-XFAQ-KEY-AREA.                                   DTSBU620
00065              15  WRK-XFAQ-REC-TYPE         PIC  X(06).            DTSBU620
00066                  88 FISCAL-AGENT-UC30           VALUE 'UC30  '.   DTSBU620
00067              15  WRK-XFAQ-FISCAL-AGENT-CD  PIC  X(03).            DTSBU620
00068              15  WRK-XFAQ-EMP-NO           PIC  X(06) VALUE SPACE.DTSBU620
00069              15  WRK-XFAQ-EMP-NO-9 REDEFINES WRK-XFAQ-EMP-NO      DTSBU620
00070                                            PIC  9(06).            DTSBU620
00071              15  WRK-XFAQ-EMP-FEIN         PIC  X(09) VALUE SPACE.DTSBU620
00072              15  WRK-XFAQ-EMP-FEIN-9 REDEFINES WRK-XFAQ-EMP-FEIN  DTSBU620
00073                                            PIC  9(09).            DTSBU620
00074                                                                   DTSBU620
00075          10  WRK-XFAQ-DATA-AREA.                                  DTSBU620
00076              15  WRK-XFAQ-FILLLER        PIC X(56)  VALUE SPACES. DTSBU620
00077                                                                   DTSBU620
00078  01  WRK-AREA.                                                    DTSBU620
00079      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +30. DTSBU620
00080                                                                   DTSBU620
00081      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBU620'.DTSBU620
00082                                                                   DTSBU620
00083      05  WRK-FA-READ-CNT             PIC S9(07)  COMP-3 VALUE +0. DTSBU620
00084      05  WRK-FA-WRITE-CNT            PIC S9(07)  COMP-3 VALUE +0. DTSBU620
00085      05  WRK-ERROR-CNT               PIC S9(07)  COMP-3 VALUE +0. DTSBU620
00086                                                                   DTSBU620
00087      05  FA-STATUS                   PIC  X(02).                  DTSBU620
00088          88  FA-STAT-OK-88        VALUE '00', '97'.               DTSBU620
00089          88  FA-STAT-EOF-88       VALUE '10'.                     DTSBU620
00090                                                                   DTSBU620
00091      05  FA2-STATUS                  PIC  X(02).                  DTSBU620
00092          88  FA2-STAT-OK-88        VALUE '00', '97'.              DTSBU620
00093          88  FA2-STAT-EOF-88       VALUE '10'.                    DTSBU620
00094                                                                   DTSBU620
00095      05  PARM-STATUS                 PIC  X(02) VALUE SPACES.     DTSBU620
00096          88   PARM-FILE-OK-88    VALUE ZEROS.                     DTSBU620
00097          88   PARM-FILE-EOF-88   VALUE '10'.                      DTSBU620
00098                                                                   DTSBU620
00099      05  WRK-ERROR-IND               PIC  X(01).                  DTSBU620
00100          88 WRK-ERROR-YES-88      VALUE 'Y'.                      DTSBU620
00101          88 WRK-ERROR-NO-88       VALUE 'N'.                      DTSBU620
00102                                                                   DTSBU620
00103      05  WRK-EMP-NO-IND          PIC  X(01).                      DTSBU620
00104          88 WRK-EMP-NO-INVALID-88 VALUE 'N'.                      DTSBU620
00105          88 WRK-EMP-NO-VALID-88   VALUE 'Y'.                      DTSBU620
00106                                                                   DTSBU620
00107      05  WRK-FISC-AGNT-IND           PIC  X(01).                  DTSBU620
00108          88 WRK-FISC-AGNT-VALID-88      VALUE 'Y'.                DTSBU620
00109          88 WRK-FISC-AGNT-INVALID-88    VALUE 'N'.                DTSBU620
00110                                                                   DTSBU620
00111      05  WRK-CURR-EMP-NO                 PIC  X(06) VALUE SPACES. DTSBU620
00112      05  WRK-CURR-EMP-NO-9 REDEFINES WRK-CURR-EMP-NO              DTSBU620
00113                                          PIC 9(06).               DTSBU620
00114      05  WRK-CURR-FISC-AGNT-NAME         PIC  X(35) VALUE SPACES. DTSBU620
00115                                                                   DTSBU620
00116      05  WRK-NEW-EMP-NO                  PIC  X(06) VALUE SPACES. DTSBU620
00117      05  WRK-NEW-FISC-AGNT-NAME          PIC  X(35) VALUE SPACES. DTSBU620
00118                                                                   DTSBU620
00119      05  WRK-FISCAL-AGENT-CD             PIC  X(03) VALUE SPACES. DTSBU620
00120                                                                   DTSBU620
00121      EJECT                                                        DTSBU620
00122                                                                   DTSBU620
00123  PROCEDURE DIVISION.                                              DTSBU620
00124                                                                   DTSBU620
00125  DTSBD591-MAIN.                                                   DTSBU620
00126      PERFORM I0000-INITIATE THRU I0000-EXIT.                      DTSBU620
00127      IF WRK-ERROR-YES-88                                          DTSBU620
00128         GO TO DTSBD591-MAIN-EXIT.                                 DTSBU620
00129                                                                   DTSBU620
00130      PERFORM P0000-PROCESS THRU P0000-EXIT.                       DTSBU620
00131                                                                   DTSBU620
00132      PERFORM T0000-TERMINATE THRU T0000-EXIT.                     DTSBU620
00133                                                                   DTSBU620
00134  DTSBD591-MAIN-EXIT.                                              DTSBU620
00135      GOBACK.                                                      DTSBU620
00136      EJECT                                                        DTSBU620
00137                                                                   DTSBU620
00138  I0000-INITIATE.                                                  DTSBU620
00139      MOVE +0 TO WRK-FA-READ-CNT                                   DTSBU620
00140                 WRK-ERROR-CNT.                                    DTSBU620
00141                                                                   DTSBU620
00142      SET WRK-ERROR-NO-88 TO TRUE.                                 DTSBU620
00143                                                                   DTSBU620
00144      PERFORM I1000-OPEN-FILES          THRU I1000-EXIT.           DTSBU620
00145      IF WRK-ERROR-YES-88                                          DTSBU620
00146         GO TO I0000-EXIT.                                         DTSBU620
00147                                                                   DTSBU620
00148  I0000-EXIT.                                                      DTSBU620
00149      EXIT.                                                        DTSBU620
00150                                                                   DTSBU620
00151  I1000-OPEN-FILES.                                                DTSBU620
00152      PERFORM S950-OPEN-FA-FILE THRU S950-EXIT.                    DTSBU620
00153      IF NOT FA-STAT-OK-88                                         DTSBU620
00154         DISPLAY 'CANNOT OPEN FISCAL AGENT FILE ' FA-STATUS        DTSBU620
00155         SET WRK-ERROR-YES-88 TO TRUE                              DTSBU620
00156         GO TO I1000-EXIT.                                         DTSBU620
00157                                                                   DTSBU620
00158      PERFORM S960-OPEN-OUTPUT-FA-FILE THRU S960-EXIT.             DTSBU620
00159      IF NOT FA2-STAT-OK-88                                        DTSBU620
00160         DISPLAY 'CANNOT OPEN OUTPUT FISCAL AGENT FILE ' FA2-STATUSDTSBU620
00161         SET WRK-ERROR-YES-88 TO TRUE                              DTSBU620
00162         GO TO I1000-EXIT.                                         DTSBU620
00163                                                                   DTSBU620
00164      OPEN INPUT PARM-FILE.                                        DTSBU620
00165      IF NOT PARM-FILE-OK-88                                       DTSBU620
00166         DISPLAY 'PARM FILE OPEN ERROR: ' PARM-STATUS              DTSBU620
00167         SET WRK-ERROR-YES-88 TO TRUE                              DTSBU620
00168         GO TO I1000-EXIT.                                         DTSBU620
00169                                                                   DTSBU620
00170      READ PARM-FILE.                                              DTSBU620
00171      IF NOT PARM-FILE-OK-88                                       DTSBU620
00172         DISPLAY 'PARM FILE READ ERROR: ' PARM-STATUS              DTSBU620
00173         SET WRK-ERROR-YES-88 TO TRUE                              DTSBU620
00174         GO TO I1000-EXIT.                                         DTSBU620
00175                                                                   DTSBU620
00176      DISPLAY '***** DTSBU620 PARM RECORD *****'.                  DTSBU620
00177      DISPLAY PARM-REC.                                            DTSBU620
00178      DISPLAY SPACE.                                               DTSBU620
00179      DISPLAY '***** DTSBU620 EDITED PARMS ****'.                  DTSBU620
00180      DISPLAY SPACE.                                               DTSBU620
00181                                                                   DTSBU620
00182      PERFORM I1100-EDIT-PARM-RUN-AGENT-CD THRU I1100-EXIT.        DTSBU620
00183      CLOSE PARM-FILE.                                             DTSBU620
00184                                                                   DTSBU620
00185  I1000-EXIT.                                                      DTSBU620
00186      EXIT.                                                        DTSBU620
00187                                                                   DTSBU620
00188  I1100-EDIT-PARM-RUN-AGENT-CD.                                    DTSBU620
00189      IF PARM-RUN-FISCAL-AGENT-CD = 'ADP'                          DTSBU620
00190         MOVE 'ADP' TO WRK-FISCAL-AGENT-CD                         DTSBU620
00191      ELSE                                                         DTSBU620
00192      IF PARM-RUN-FISCAL-AGENT-CD = 'CER'                          DTSBU620
00193         MOVE 'CER' TO WRK-FISCAL-AGENT-CD                         DTSBU620
00194      ELSE                                                         DTSBU620
00195      IF PARM-RUN-FISCAL-AGENT-CD = 'PB '                          DTSBU620
00196         MOVE 'PB ' TO WRK-FISCAL-AGENT-CD                         DTSBU620
00197      ELSE                                                         DTSBU620
00198      IF PARM-RUN-FISCAL-AGENT-CD = 'PAI'                          DTSBU620
00199         MOVE 'PAI' TO WRK-FISCAL-AGENT-CD                         DTSBU620
00200      ELSE                                                         DTSBU620
00201      IF PARM-RUN-FISCAL-AGENT-CD = 'PC '                          DTSBU620
00202         MOVE 'PC ' TO WRK-FISCAL-AGENT-CD                         DTSBU620
00203      ELSE                                                         DTSBU620
00204      IF PARM-RUN-FISCAL-AGENT-CD = 'ADA'                          DTSBU620
00205         MOVE 'ADA' TO WRK-FISCAL-AGENT-CD                         DTSBU620
00206      ELSE                                                         DTSBU620
00207      IF PARM-RUN-FISCAL-AGENT-CD = 'PER'                          DTSBU620
00208         MOVE 'PER' TO WRK-FISCAL-AGENT-CD                         DTSBU620
00209      ELSE                                                         DTSBU620
00210      IF PARM-RUN-FISCAL-AGENT-CD = 'PP '                          DTSBU620
00211         MOVE 'PP ' TO WRK-FISCAL-AGENT-CD                         DTSBU620
00212      ELSE                                                         DTSBU620
00213         DISPLAY 'INVALID PARM RUN FISCAL AGENT CD'                DTSBU620
00214         PERFORM S999-ABEND THRU S999-EXIT                         DTSBU620
00215         GO TO I1100-EXIT.                                         DTSBU620
00216                                                                   DTSBU620
00217  I1100-EXIT.                                                      DTSBU620
00218      EXIT.                                                        DTSBU620
00219                                                                   DTSBU620
00220  P0000-PROCESS.                                                   DTSBU620
00221      DISPLAY 'MAINTAIN FISCAL AGENT/EMPLOYER RECORDS'.            DTSBU620
00222      DISPLAY SPACE.                                               DTSBU620
00223                                                                   DTSBU620
00224      PERFORM P1000-PROCESS-FA-FILE     THRU P1000-EXIT            DTSBU620
00225         UNTIL NOT FA-STAT-OK-88.                                  DTSBU620
00226                                                                   DTSBU620
00227  P0000-EXIT.                                                      DTSBU620
00228      EXIT.                                                        DTSBU620
00229                                                                   DTSBU620
00230  P1000-PROCESS-FA-FILE.                                           DTSBU620
00231      PERFORM S951-READ-FA-FILE THRU S951-EXIT.                    DTSBU620
00232      IF FA-STAT-OK-88                                             DTSBU620
00233         ADD +1 TO WRK-FA-READ-CNT                                 DTSBU620
00234      ELSE                                                         DTSBU620
00235         IF FA-STAT-EOF-88                                         DTSBU620
00236            DISPLAY 'FA EOF ' FA-STATUS                            DTSBU620
00237            GO TO P1000-EXIT                                       DTSBU620
00238         ELSE                                                      DTSBU620
00239            DISPLAY 'UNEXPECTED FA INPUT FILE STATUS ' FA-STATUS   DTSBU620
00240            GO TO P1000-EXIT                                       DTSBU620
00241         END-IF                                                    DTSBU620
00242      END-IF.                                                      DTSBU620
00243                                                                   DTSBU620
00244      PERFORM P1200-OUTPUT-RECORDS      THRU P1200-EXIT.           DTSBU620
00245                                                                   DTSBU620
00246  P1000-EXIT.                                                      DTSBU620
00247      EXIT.                                                        DTSBU620
00248                                                                   DTSBU620
00249  P1200-OUTPUT-RECORDS.                                            DTSBU620
00250                                                                   DTSBU620
00251      SET WRK-EMP-NO-INVALID-88    TO TRUE.                        DTSBU620
00252                                                                   DTSBU620
00253      MOVE 'UC30  '               TO WRK-XFAQ-REC-TYPE.            DTSBU620
00254      MOVE XFARI-EMP-NO           TO WRK-XFAQ-EMP-NO.              DTSBU620
00255      MOVE XFARI-EMP-FEIN         TO WRK-XFAQ-EMP-FEIN.            DTSBU620
00256      MOVE WRK-FISCAL-AGENT-CD    TO WRK-XFAQ-FISCAL-AGENT-CD.     DTSBU620
00257      PERFORM S961-WRITE-FA-FILE THRU S961-EXIT                    DTSBU620
00258                                                                   DTSBU620
00259      IF FA2-STAT-OK-88                                            DTSBU620
00260           NEXT SENTENCE                                           DTSBU620
00261      ELSE                                                         DTSBU620
00262         DISPLAY 'UNEXPECTED FA OUTPUT FILE STATUS ' FA2-STATUS    DTSBU620
00263         PERFORM S999-ABEND THRU S999-EXIT                         DTSBU620
00264      END-IF.                                                      DTSBU620
00265                                                                   DTSBU620
00266  P1200-EXIT.                                                      DTSBU620
00267      EXIT.                                                        DTSBU620
00268                                                                   DTSBU620
00269  T0000-TERMINATE.                                                 DTSBU620
00270                                                                   DTSBU620
00271      DISPLAY ' '.                                                 DTSBU620
00272                                                                   DTSBU620
00273      DISPLAY '*** DTSBU620 TERMINATION STATISTICS ***'.           DTSBU620
00274                                                                   DTSBU620
00275      DISPLAY ' '.                                                 DTSBU620
00276                                                                   DTSBU620
00277      DISPLAY 'NUMBER OF FISCAL AGENT INPUT RECORDS READ:         'DTSBU620
00278              WRK-FA-READ-CNT.                                     DTSBU620
00279                                                                   DTSBU620
00280      DISPLAY 'NUMBER OF UC30 FA OUTPUT  RECORDS WRITTEN:         'DTSBU620
00281              WRK-FA-WRITE-CNT.                                    DTSBU620
00282                                                                   DTSBU620
00283      DISPLAY 'NUMBER OF INPUT ERRORS:                            'DTSBU620
00284              WRK-ERROR-CNT.                                       DTSBU620
00285                                                                   DTSBU620
00286      PERFORM S952-CLOSE-FA-FILE THRU S952-EXIT.                   DTSBU620
00287      PERFORM S962-CLOSE-FA-FILE THRU S962-EXIT.                   DTSBU620
00288                                                                   DTSBU620
00289  T0000-EXIT.                                                      DTSBU620
00290      EXIT.                                                        DTSBU620
00291      EJECT                                                        DTSBU620
00292                                                                   DTSBU620
00293  S950-OPEN-FA-FILE.                                               DTSBU620
00294      OPEN INPUT FISCAL-AGENT-FILE1.                               DTSBU620
00295                                                                   DTSBU620
00296  S950-EXIT.                                                       DTSBU620
00297      EXIT.                                                        DTSBU620
00298                                                                   DTSBU620
00299  S951-READ-FA-FILE.                                               DTSBU620
00300      READ FISCAL-AGENT-FILE1  AT END                              DTSBU620
00301             SET FA-STAT-EOF-88 TO TRUE.                           DTSBU620
00302                                                                   DTSBU620
00303  S951-EXIT.                                                       DTSBU620
00304      EXIT.                                                        DTSBU620
00305                                                                   DTSBU620
00306  S952-CLOSE-FA-FILE.                                              DTSBU620
00307      CLOSE FISCAL-AGENT-FILE1.                                    DTSBU620
00308                                                                   DTSBU620
00309  S952-EXIT.                                                       DTSBU620
00310      EXIT.                                                        DTSBU620
00311                                                                   DTSBU620
00312  S960-OPEN-OUTPUT-FA-FILE.                                        DTSBU620
00313      OPEN OUTPUT FISCAL-AGENT-FILE2.                              DTSBU620
00314                                                                   DTSBU620
00315  S960-EXIT.                                                       DTSBU620
00316      EXIT.                                                        DTSBU620
00317                                                                   DTSBU620
00318  S961-WRITE-FA-FILE.                                              DTSBU620
00319      WRITE FISCAL-AGENT-REC2  FROM                                DTSBU620
00320        WRK-FISCAL-AGENT-REC2.                                     DTSBU620
00321      ADD 1 TO WRK-FA-WRITE-CNT.                                   DTSBU620
00322                                                                   DTSBU620
00323  S961-EXIT.                                                       DTSBU620
00324      EXIT.                                                        DTSBU620
00325                                                                   DTSBU620
00326  S962-CLOSE-FA-FILE.                                              DTSBU620
00327      CLOSE FISCAL-AGENT-FILE2.                                    DTSBU620
00328                                                                   DTSBU620
00329  S962-EXIT.                                                       DTSBU620
00330      EXIT.                                                        DTSBU620
00331                                                                   DTSBU620
00332  S999-ABEND.                                                      DTSBU620
00333      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBU620
00334  S999-EXIT.                                                       DTSBU620
00335      EXIT.                                                        DTSBU620
