00001  IDENTIFICATION DIVISION.                                         04/24/17
00002  PROGRAM-ID.             DTSBD591.                                DTSBD591
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV002
00004  DATE-WRITTEN.           DECEMBER 1998.                           DTSBD591
00005  DATE-COMPILED.                                                   DTSBD591
00006      SKIP3                                                        DTSBD591
00007 *****                                                             DTSBD591
00008 *    FUNCTION:  PROCESS FISCAL AGENT BENEFIT CHARGE CLIENT        DTSBD591
00009 *               DATA AND MAINTAIN BENEFIT CHARGE MFAE RECORDS     DTSBD591
00010 *****                                                             DTSBD591
00011      SKIP3                                                        DTSBD591
00012  ENVIRONMENT DIVISION.                                            DTSBD591
00013                                                                   DTSBD591
00014  INPUT-OUTPUT SECTION.                                            DTSBD591
00015  FILE-CONTROL.                                                    DTSBD591
00016      SELECT FISCAL-AGENT-FILE                                     DTSBD591
00017         ASSIGN TO FAFILE                                          DTSBD591
00018         FILE STATUS IS FA-STATUS.                                 DTSBD591
00019                                                                   DTSBD591
00020  DATA DIVISION.                                                   DTSBD591
00021      SKIP3                                                        DTSBD591
00022  FILE SECTION.                                                    DTSBD591
00023  FD  FISCAL-AGENT-FILE                                            DTSBD591
00024      LABEL RECORDS ARE STANDARD                                   DTSBD591
00025      DATA RECORD IS CHGIM006.                                     DTSBD591
00026                                                                   DTSBD591
00027  01  FISCAL-AGENT-REC.                                            DTSBD591
00028  ++INCLUDE CHGIM006                                               DTSBD591
00029                                                                   DTSBD591
00030      EJECT                                                        DTSBD591
00031  WORKING-STORAGE SECTION.                                         DTSBD591
000315 77  PAN-VALET PICTURE X(24) VALUE '002DTSBD591  04/24/17'.       DTSBD591
00032  77  PAN-VALET PICTURE X(24) VALUE '005DTSBD591  10/08/02'.       DTSBD591
00033      SKIP3                                                        DTSBD591
00034  01  WRK-AREA.                                                    DTSBD591
00035      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +591.DTSBD591
00036                                                                   DTSBD591
00037      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBD591'.DTSBD591
00038                                                                   DTSBD591
00039      05  WRK-FA-READ-CNT             PIC S9(07)  COMP-3.          DTSBD591
00040      05  WRK-ERROR-CNT               PIC S9(07)  COMP-3.          DTSBD591
00041      05  WRK-MFAE-ADDED-CNT          PIC S9(07)  COMP-3.          DTSBD591
00042      05  WRK-MFAE-DELETED-CNT        PIC S9(07)  COMP-3.          DTSBD591
00043                                                                   DTSBD591
00044      05  FA-STATUS                   PIC  X(02).                  DTSBD591
00045          88  FA-STAT-OK-88        VALUE '00', '97'.               DTSBD591
00046          88  FA-STAT-EOF-88       VALUE '10'.                     DTSBD591
00047                                                                   DTSBD591
00048      05  WRK-ERROR-IND               PIC  X(01).                  DTSBD591
00049          88 WRK-ERROR-YES-88      VALUE 'Y'.                      DTSBD591
00050          88 WRK-ERROR-NO-88       VALUE 'N'.                      DTSBD591
00051                                                                   DTSBD591
00052      05  WRK-EMP-NO-IND          PIC  X(01).                      DTSBD591
00053          88 WRK-EMP-NO-INVALID-88 VALUE 'N'.                      DTSBD591
00054          88 WRK-EMP-NO-VALID-88   VALUE 'Y'.                      DTSBD591
00055                                                                   DTSBD591
00056      05  WRK-FISC-AGNT-IND           PIC  X(01).                  DTSBD591
00057          88 WRK-FISC-AGNT-VALID-88      VALUE 'Y'.                DTSBD591
00058          88 WRK-FISC-AGNT-INVALID-88    VALUE 'N'.                DTSBD591
00059                                                                   DTSBD591
00060      05  WRK-WRITE-MFAE-IND          PIC  X(01).                  DTSBD591
00061          88 WRK-WRITE-MFAE-YES-88 VALUE 'Y'.                      DTSBD591
00062          88 WRK-WRITE-MFAE-NO-88  VALUE 'N'.                      DTSBD591
00063                                                                   DTSBD591
00064      05  WRK-UPDATE-MPRF-IND         PIC  X(01).                  DTSBD591
00065          88 WRK-UPDATE-MPRF-YES-88 VALUE 'Y'.                     DTSBD591
00066          88 WRK-UPDATE-MPRF-NO-88  VALUE 'N'.                     DTSBD591
00067                                                                   DTSBD591
00068      05  WRK-FISCAL-AGENT-NAME           PIC  X(35).              DTSBD591
00069                                                                   DTSBD591
00070      05  WRK-CURR-EMP-NO                 PIC  X(06).              DTSBD591
00071      05  WRK-CURR-EMP-NO-9 REDEFINES WRK-CURR-EMP-NO              DTSBD591
00072                                          PIC 9(06).               DTSBD591
00073      05  FILLER                          PIC  X(01)  VALUE SPACES.DTSBD591
00074      05  WRK-CURR-EMPLOYER-NAME          PIC  X(39)  VALUE SPACES.DTSBD591
00075      05  WRK-CURR-FISC-AGNT-NAME         PIC  X(35)  VALUE SPACES.DTSBD591
00076      05  WRK-CURR-EMP-DUP-IND        PIC  X(01).                  DTSBD591
00077          88 WRK-CURR-EMP-DUP-YES-88      VALUE 'Y'.               DTSBD591
00078          88 WRK-CURR-EMP-DUP-NO-88       VALUE 'N'.               DTSBD591
00079                                                                   DTSBD591
00080      05  WRK-NEW-EMP-NO                  PIC  X(06).              DTSBD591
00081      05  WRK-NEW-FISC-AGNT-NAME          PIC  X(35).              DTSBD591
00082      05  FILLER                          PIC  X(01)  VALUE SPACES.DTSBD591
00083      05  WRK-NEW-EMPLOYER-NAME           PIC  X(39).              DTSBD591
00084                                                                   DTSBD591
00085      05  WRK-FISCAL-AGENT-CD             PIC  X(03).              DTSBD591
00086                                                                   DTSBD591
00087      05  WRK-TRACE-IND                   PIC  X(01).              DTSBD591
00088                                                                   DTSBD591
00089  01  L910-LINK-AREA.                                              DTSBD591
00090  ++INCLUDE DTSIL910                                               DTSBD591
00091      EJECT                                                        DTSBD591
00092  01  MSKL-REC.                                                    DTSBD591
00093  ++INCLUDE DTSIMSKL                                               DTSBD591
00094      EJECT                                                        DTSBD591
00095  01  MHDR-REC.                                                    DTSBD591
00096  ++INCLUDE DTSIMHDR                                               DTSBD591
00097      EJECT                                                        DTSBD591
00098  01  MPRF-REC.                                                    DTSBD591
00099  ++INCLUDE DTSIMPRF                                               DTSBD591
00100      EJECT                                                        DTSBD591
00101  01  MFAE-REC.                                                    DTSBD591
00102  ++INCLUDE DTSIMFAE                                               DTSBD591
00103      EJECT                                                        DTSBD591
00104  01  R591-REC.                                                    DTSBD591
00105  ++INCLUDE DTSIR591                                               DTSBD591
00106      EJECT                                                        DTSBD591
00107  01  L921-LINK-AREA.                                              DTSBD591
00108  ++INCLUDE DTSIL921                                               DTSBD591
00109      EJECT                                                        DTSBD591
00110  01  ISKL-REC.                                                    DTSBD591
00111  ++INCLUDE DTSIISKL                                               DTSBD591
00112      EJECT                                                        DTSBD591
00113  01  FISCAL-AGENT-TABLE-AREA.                                     DTSBD591
00114  ++INCLUDE CHGIC001                                               DTSBD591
00115      EJECT                                                        DTSBD591
00116  01  L600-LINK-AREA.                                              DTSBD591
00117  ++INCLUDE DTSIL600                                               DTSBD591
00118      EJECT                                                        DTSBD591
00119  PROCEDURE DIVISION.                                              DTSBD591
00120                                                                   DTSBD591
00121  DTSBD591-MAIN.                                                   DTSBD591
00122      PERFORM I0000-INITIATE THRU I0000-EXIT.                      DTSBD591
00123      IF WRK-ERROR-YES-88                                          DTSBD591
00124         GO TO DTSBD591-MAIN-EXIT.                                 DTSBD591
00125                                                                   DTSBD591
00126      PERFORM P0000-PROCESS THRU P0000-EXIT.                       DTSBD591
00127                                                                   DTSBD591
00128      PERFORM T0000-TERMINATE THRU T0000-EXIT.                     DTSBD591
00129                                                                   DTSBD591
00130  DTSBD591-MAIN-EXIT.                                              DTSBD591
00131      GOBACK.                                                      DTSBD591
00132      EJECT                                                        DTSBD591
00133  I0000-INITIATE.                                                  DTSBD591
00134      MOVE +0 TO WRK-FA-READ-CNT                                   DTSBD591
00135                 WRK-ERROR-CNT                                     DTSBD591
00136                 WRK-MFAE-ADDED-CNT                                DTSBD591
00137                 WRK-MFAE-DELETED-CNT.                             DTSBD591
00138                                                                   DTSBD591
00139      SET WRK-ERROR-NO-88 TO TRUE.                                 DTSBD591
00140                                                                   DTSBD591
00141      PERFORM I1000-OPEN-FILES          THRU I1000-EXIT.           DTSBD591
00142      IF WRK-ERROR-YES-88                                          DTSBD591
00143         GO TO I0000-EXIT.                                         DTSBD591
00144                                                                   DTSBD591
00145      PERFORM I2000-READ-MHDR           THRU I2000-EXIT.           DTSBD591
00146                                                                   DTSBD591
00147      PERFORM I3000-DELETE-MFAE         THRU I3000-EXIT.           DTSBD591
00148      MOVE LENGTH OF R591-REC       TO R591-LENGTH.                DTSBD591
00149      MOVE '591'                    TO R591-REC-TYPE.              DTSBD591
00150      SKIP2                                                        DTSBD591
00151  I0000-EXIT.                                                      DTSBD591
00152      EXIT.                                                        DTSBD591
00153  I1000-OPEN-FILES.                                                DTSBD591
00154      PERFORM S950-OPEN-FA-FILE THRU S950-EXIT.                    DTSBD591
00155      IF NOT FA-STAT-OK-88                                         DTSBD591
00156         DISPLAY 'CANNOT OPEN FISCAL AGENT FILE ' FA-STATUS        DTSBD591
00157         SET WRK-ERROR-YES-88 TO TRUE                              DTSBD591
00158         GO TO I1000-EXIT.                                         DTSBD591
00159                                                                   DTSBD591
00160      MOVE WRK-TRACE-IND TO L910-TRACE-IND.                        DTSBD591
00161                                                                   DTSBD591
00162      MOVE WRK-MOD-NAME TO L910-MOD-NAME.                          DTSBD591
00163                                                                   DTSBD591
00164 ***  PERFORM S910-OPEN-READ THRU S910-EXIT.                       DTSBD591
00165      PERFORM S910-OPEN-UPDATE-NO-AIX THRU S910-EXIT.              DTSBD591
00166                                                                   DTSBD591
00167      PERFORM S921-OPEN-READ THRU S921-EXIT.                       DTSBD591
00168                                                                   DTSBD591
00169  I1000-EXIT.                                                      DTSBD591
00170      EXIT.                                                        DTSBD591
00171                                                                   DTSBD591
00172  I2000-READ-MHDR.                                                 DTSBD591
00173       MOVE LOW-VALUES        TO MHDR-KEY-AREA.                    DTSBD591
00174       MOVE +0 TO MHDR-EMP-NO.                                     DTSBD591
00175       SET MHDR-HDR-88 TO TRUE.                                    DTSBD591
00176       MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA.                        DTSBD591
00177       PERFORM S910-READ THRU S910-EXIT.                           DTSBD591
00178                                                                   DTSBD591
00179      IF L910-NO-REC-88                                            DTSBD591
00180         DISPLAY 'MHDR RECORD NOT FOUND'                           DTSBD591
00181         SET WRK-ERROR-YES-88 TO TRUE                              DTSBD591
00182         GO TO I2000-EXIT.                                         DTSBD591
00183                                                                   DTSBD591
00184      MOVE MSKL-REC TO MHDR-REC.                                   DTSBD591
00185                                                                   DTSBD591
00186  I2000-EXIT.                                                      DTSBD591
00187      EXIT.                                                        DTSBD591
00188                                                                   DTSBD591
00189  I3000-DELETE-MFAE.                                               DTSBD591
00190      MOVE LOW-VALUE        TO MSKL-REC.                           DTSBD591
00191      MOVE +0               TO MSKL-EMP-NO.                        DTSBD591
00192      SET MSKL-PRF-88       TO TRUE.                               DTSBD591
00193                                                                   DTSBD591
00194      PERFORM S910-START-BROWSE  THRU S910-EXIT.                   DTSBD591
00195                                                                   DTSBD591
00196      PERFORM I3100-MPRF-SCAN    THRU I3100-EXIT                   DTSBD591
00197         UNTIL L910-NO-REC-88.                                     DTSBD591
00198                                                                   DTSBD591
00199  I3000-EXIT.                                                      DTSBD591
00200      EXIT.                                                        DTSBD591
00201                                                                   DTSBD591
00202  I3100-MPRF-SCAN.                                                 DTSBD591
00203      MOVE MSKL-REC                 TO MPRF-REC.                   DTSBD591
00204                                                                   DTSBD591
00205      MOVE LOW-VALUE                TO MSKL-KEY-AREA.              DTSBD591
00206      MOVE MPRF-EMP-NO              TO MSKL-EMP-NO.                DTSBD591
00207      SET MSKL-FAE-88               TO TRUE.                       DTSBD591
00208                                                                   DTSBD591
00209      PERFORM S910-START-BROWSE     THRU S910-EXIT.                DTSBD591
00210      PERFORM                                                      DTSBD591
00211         UNTIL L910-NO-REC-88                                      DTSBD591
00212            MOVE MSKL-REC           TO MFAE-REC                    DTSBD591
00213            IF MFAE-SERVICE-BEN-CHG-88                             DTSBD591
00214               PERFORM S910-DELETE  THRU S910-EXIT                 DTSBD591
00215               ADD +1               TO WRK-MFAE-DELETED-CNT        DTSBD591
00216            END-IF                                                 DTSBD591
00217            PERFORM S910-READ-NEXT  THRU S910-EXIT                 DTSBD591
00218      END-PERFORM.                                                 DTSBD591
00219                                                                   DTSBD591
00220      MOVE MPRF-REC                 TO MSKL-REC.                   DTSBD591
00221      PERFORM S910-READ-NEXT        THRU S910-EXIT.                DTSBD591
00222                                                                   DTSBD591
00223  I3100-EXIT.                                                      DTSBD591
00224      EXIT.                                                        DTSBD591
00225                                                                   DTSBD591
00226      EJECT                                                        DTSBD591
00227  P0000-PROCESS.                                                   DTSBD591
00228      DISPLAY 'MAINTAIN FISCAL AGENT/EMPLOYER RECORDS FOR'.        DTSBD591
00229      DISPLAY '        BENEFIT CHARGE SERVICES'.                   DTSBD591
00230      DISPLAY SPACE.                                               DTSBD591
00231                                                                   DTSBD591
00232      PERFORM P0100-READ-FIRST          THRU P0100-EXIT.           DTSBD591
00233      IF WRK-ERROR-YES-88                                          DTSBD591
00234         GO TO P0000-EXIT.                                         DTSBD591
00235                                                                   DTSBD591
00236      PERFORM P1000-PROCESS-FA-FILE     THRU P1000-EXIT            DTSBD591
00237         UNTIL NOT FA-STAT-OK-88.                                  DTSBD591
00238                                                                   DTSBD591
00239      PERFORM P3000-CHK-LAST-REC        THRU P3000-EXIT.           DTSBD591
00240                                                                   DTSBD591
00241  P0000-EXIT.                                                      DTSBD591
00242      EXIT.                                                        DTSBD591
00243                                                                   DTSBD591
00244  P0100-READ-FIRST.                                                DTSBD591
00245      PERFORM S951-READ-FA-FILE THRU S951-EXIT.                    DTSBD591
00246      IF NOT FA-STAT-OK-88                                         DTSBD591
00247         DISPLAY 'CANNOT READ FISCAL AGENT FILE ' FA-STATUS        DTSBD591
00248         SET WRK-ERROR-YES-88 TO TRUE                              DTSBD591
00249         GO TO P0100-EXIT                                          DTSBD591
00250      ELSE                                                         DTSBD591
00251         ADD +1 TO WRK-FA-READ-CNT                                 DTSBD591
00252      END-IF.                                                      DTSBD591
00253                                                                   DTSBD591
00254      MOVE CHG6-EMP-NO             TO WRK-CURR-EMP-NO.             DTSBD591
00255      MOVE CHG6-FISCAL-AGENT-NAME  TO WRK-CURR-FISC-AGNT-NAME.     DTSBD591
00256      MOVE CHG6-EMPLOYER-NAME      TO WRK-CURR-EMPLOYER-NAME.      DTSBD591
00257      SET WRK-CURR-EMP-DUP-NO-88   TO TRUE.                        DTSBD591
00258                                                                   DTSBD591
00259  P0100-EXIT.                                                      DTSBD591
00260      EXIT.                                                        DTSBD591
00261                                                                   DTSBD591
00262 **************************************************************    DTSBD591
00263 *  THIS PARAGRAPH READS THROUGH THE INPUT FILE AND CHECKS FOR     DTSBD591
00264 *  DUPLICATES - EMPLOYERS LISTED WITH MORE THAN ONE FISCAL        DTSBD591
00265 *  AGENT.                                                         DTSBD591
00266 *                                                                 DTSBD591
00267 *  THE FIRST READ (P0100) HAS PLACED THE FIRST RECORD             DTSBD591
00268 *  IN THE 'CURRENT' AREA (WRK-CURR-EMP-NO).                       DTSBD591
00269 *                                                                 DTSBD591
00270 *  THE NEXT READ PLACES A NEW RECORD IN THE 'NEW' AREA            DTSBD591
00271 *  (WRK-NEW-EMP-NO).  IF THE CURRENT AND NEW ARE NOT EQUAL        DTSBD591
00272 *                                                                 DTSBD591
00273 *  THE PROCESS COMPLETES EDITS ON THE CURRENT EMPLOYER AND        DTSBD591
00274 *  WRITES THE MFAE RECORD.  THE NEW RECORD THEN BECOMES THE       DTSBD591
00275 *  CURRENT AND THE PROCESS CONTINUES.                             DTSBD591
00276 **************************************************************    DTSBD591
00277  P1000-PROCESS-FA-FILE.                                           DTSBD591
00278      PERFORM P1100-READ-NEW    THRU P1100-EXIT.                   DTSBD591
00279      IF NOT FA-STAT-OK-88                                         DTSBD591
00280         GO TO P1000-EXIT.                                         DTSBD591
00281                                                                   DTSBD591
00282      IF WRK-NEW-EMP-NO NOT = WRK-CURR-EMP-NO                      DTSBD591
00283         IF WRK-CURR-EMP-DUP-YES-88                                DTSBD591
00284            PERFORM P1110-CURR-ERROR    THRU P1110-EXIT            DTSBD591
00285            MOVE WRK-NEW-EMP-NO         TO WRK-CURR-EMP-NO         DTSBD591
00286            MOVE WRK-NEW-FISC-AGNT-NAME TO WRK-CURR-FISC-AGNT-NAME DTSBD591
00287            MOVE WRK-NEW-EMPLOYER-NAME  TO WRK-CURR-EMPLOYER-NAME  DTSBD591
00288            SET WRK-CURR-EMP-DUP-NO-88  TO TRUE                    DTSBD591
00289         ELSE                                                      DTSBD591
00290            PERFORM P2000-PROCESS-CURR  THRU P2000-EXIT            DTSBD591
00291            MOVE WRK-NEW-EMP-NO         TO WRK-CURR-EMP-NO         DTSBD591
00292            MOVE WRK-NEW-FISC-AGNT-NAME TO WRK-CURR-FISC-AGNT-NAME DTSBD591
00293            MOVE WRK-NEW-EMPLOYER-NAME  TO WRK-CURR-EMPLOYER-NAME  DTSBD591
00294            SET WRK-CURR-EMP-DUP-NO-88  TO TRUE                    DTSBD591
00295         END-IF                                                    DTSBD591
00296      ELSE                                                         DTSBD591
00297         PERFORM P1120-NEW-ERROR        THRU P1120-EXIT            DTSBD591
00298         SET WRK-CURR-EMP-DUP-YES-88    TO TRUE                    DTSBD591
00299      END-IF.                                                      DTSBD591
00300                                                                   DTSBD591
00301  P1000-EXIT.                                                      DTSBD591
00302      EXIT.                                                        DTSBD591
00303                                                                   DTSBD591
00304  P1100-READ-NEW.                                                  DTSBD591
00305      PERFORM S951-READ-FA-FILE THRU S951-EXIT.                    DTSBD591
00306      IF FA-STAT-OK-88                                             DTSBD591
00307         ADD +1 TO WRK-FA-READ-CNT                                 DTSBD591
00308         MOVE CHG6-EMP-NO            TO WRK-NEW-EMP-NO             DTSBD591
00309         MOVE CHG6-FISCAL-AGENT-NAME TO WRK-NEW-FISC-AGNT-NAME     DTSBD591
00310         MOVE CHG6-EMPLOYER-NAME     TO WRK-NEW-EMPLOYER-NAME      DTSBD591
00311      ELSE                                                         DTSBD591
00312         IF FA-STAT-EOF-88                                         DTSBD591
00313            DISPLAY 'FA EOF ' FA-STATUS                            DTSBD591
00314         ELSE                                                      DTSBD591
00315            DISPLAY '*** UNEXPECTED FA FILE STATUS '               DTSBD591
00316                     FA-STATUS                                     DTSBD591
00317            GO TO P1100-EXIT                                       DTSBD591
00318         END-IF                                                    DTSBD591
00319      END-IF.                                                      DTSBD591
00320                                                                   DTSBD591
00321  P1100-EXIT.                                                      DTSBD591
00322      EXIT.                                                        DTSBD591
00323                                                                   DTSBD591
00324  P1110-CURR-ERROR.                                                DTSBD591
00325      ADD +1 TO WRK-ERROR-CNT.                                     DTSBD591
00326      MOVE 'DUPLICATE ACCOUNT       ' TO R591-MESSAGE              DTSBD591
00327                                                                   DTSBD591
00328      PERFORM  P4000-WRITE-591-CURR-ERROR THRU P4000-EXIT.         DTSBD591
00329                                                                   DTSBD591
00330  P1110-EXIT.                                                      DTSBD591
00331      EXIT.                                                        DTSBD591
00332                                                                   DTSBD591
00333  P1120-NEW-ERROR.                                                 DTSBD591
00334      ADD +1 TO WRK-ERROR-CNT.                                     DTSBD591
00335      MOVE 'DUPLICATE ACCOUNT      ' TO R591-MESSAGE               DTSBD591
00336                                                                   DTSBD591
00337      PERFORM  P4000-WRITE-591-NEW-ERROR THRU P4000-EXIT.          DTSBD591
00338                                                                   DTSBD591
00339  P1120-EXIT.                                                      DTSBD591
00340      EXIT.                                                        DTSBD591
00341                                                                   DTSBD591
00342  P2000-PROCESS-CURR.                                              DTSBD591
00343      PERFORM P2100-EDIT           THRU P2100-EXIT.                DTSBD591
00344      IF WRK-EMP-NO-VALID-88                                       DTSBD591
00345         PERFORM P2200-BUILD-MFAE  THRU P2200-EXIT.                DTSBD591
00346                                                                   DTSBD591
00347  P2000-EXIT.                                                      DTSBD591
00348      EXIT.                                                        DTSBD591
00349                                                                   DTSBD591
00350  P2100-EDIT.                                                      DTSBD591
00351      SET WRK-EMP-NO-VALID-88    TO TRUE.                          DTSBD591
00352                                                                   DTSBD591
00353      PERFORM P2110-EDIT-EMP-NO           THRU P2110-EXIT.         DTSBD591
00354      IF WRK-EMP-NO-VALID-88                                       DTSBD591
00355         MOVE WRK-CURR-FISC-AGNT-NAME TO WRK-FISCAL-AGENT-NAME     DTSBD591
00356         PERFORM P2120-VALIDATE-FISC-AGNT THRU P2120-EXIT          DTSBD591
00357         IF WRK-FISC-AGNT-VALID-88                                 DTSBD591
00358            PERFORM P2130-EMP-STATUS      THRU P2130-EXIT.         DTSBD591
00359                                                                   DTSBD591
00360  P2100-EXIT.                                                      DTSBD591
00361      EXIT.                                                        DTSBD591
00362                                                                   DTSBD591
00363  P2110-EDIT-EMP-NO.                                               DTSBD591
00364      IF WRK-CURR-EMP-NO NUMERIC                                   DTSBD591
00365         IF WRK-CURR-EMP-NO > ZERO                                 DTSBD591
00366            NEXT SENTENCE                                          DTSBD591
00367         ELSE                                                      DTSBD591
00368            SET WRK-EMP-NO-INVALID-88 TO TRUE                      DTSBD591
00369      ELSE                                                         DTSBD591
00370         SET WRK-EMP-NO-INVALID-88 TO TRUE.                        DTSBD591
00371                                                                   DTSBD591
00372      IF WRK-EMP-NO-INVALID-88                                     DTSBD591
00373         MOVE 'INVALID ACCOUNT NO ' TO R591-MESSAGE                DTSBD591
00374         PERFORM P4000-WRITE-591-CURR-ERROR THRU P4000-EXIT        DTSBD591
00375         ADD +1 TO WRK-ERROR-CNT.                                  DTSBD591
00376                                                                   DTSBD591
00377  P2110-EXIT.                                                      DTSBD591
00378      EXIT.                                                        DTSBD591
00379                                                                   DTSBD591
00380  P2120-VALIDATE-FISC-AGNT.                                        DTSBD591
00381 *&                                                                DTSBD591
00382 *    DISPLAY 'P2120 CURR NAME ' WRK-CURR-FISC-AGNT-NAME.          DTSBD591
00383 *&                                                                DTSBD591
00384      SET WRK-FISC-AGNT-INVALID-88 TO TRUE.                        DTSBD591
00385      MOVE SPACES                  TO WRK-FISCAL-AGENT-CD.         DTSBD591
00386                                                                   DTSBD591
00387      PERFORM                                                      DTSBD591
00388         VARYING FISCAL-AGENT-IDX FROM +1 BY +1                    DTSBD591
00389            UNTIL WRK-FISC-AGNT-VALID-88                           DTSBD591
00390         OR FISCAL-AGENT-IDX > FISCAL-AGENT-CNT                    DTSBD591
00391         OR FISCAL-AGENT-NAME (FISCAL-AGENT-IDX)                   DTSBD591
00392                             = SPACE                               DTSBD591
00393                                                                   DTSBD591
00394 ***        DISPLAY '1-TBL-FA-NAME: ',                             DTSBD591
00395 ***                FISCAL-AGENT-NAME (FISCAL-AGENT-IDX)           DTSBD591
00396 ***        DISPLAY '2-WRK-FA-NAME: ',                             DTSBD591
00397 ***                WRK-FISCAL-AGENT-NAME                          DTSBD591
00398                                                                   DTSBD591
00399            IF WRK-FISCAL-AGENT-NAME =                             DTSBD591
00400                  FISCAL-AGENT-NAME (FISCAL-AGENT-IDX)             DTSBD591
00401               SET WRK-FISC-AGNT-VALID-88 TO TRUE                  DTSBD591
00402               MOVE FISCAL-AGENT-CODE (FISCAL-AGENT-IDX) TO        DTSBD591
00403                  WRK-FISCAL-AGENT-CD                              DTSBD591
00404            END-IF                                                 DTSBD591
00405      END-PERFORM.                                                 DTSBD591
00406                                                                   DTSBD591
00407      IF WRK-FISC-AGNT-INVALID-88                                  DTSBD591
00408         DISPLAY 'INVALID FISCAL AGENT CD  ' WRK-FISCAL-AGENT-NAME DTSBD591
00409         ADD +1 TO WRK-ERROR-CNT.                                  DTSBD591
00410 *&                                                                DTSBD591
00411 *    DISPLAY 'P2120 FA CODE ' WRK-FISCAL-AGENT-CD.                DTSBD591
00412 *&                                                                DTSBD591
00413                                                                   DTSBD591
00414  P2120-EXIT.                                                      DTSBD591
00415      EXIT.                                                        DTSBD591
00416                                                                   DTSBD591
00417  P2130-EMP-STATUS.                                                DTSBD591
00418      MOVE LOW-VALUES         TO MSKL-KEY-AREA.                    DTSBD591
00419      MOVE WRK-CURR-EMP-NO-9  TO MSKL-EMP-NO.                      DTSBD591
00420      SET MSKL-PRF-88         TO TRUE.                             DTSBD591
00421                                                                   DTSBD591
00422      PERFORM S910-READ      THRU S910-EXIT.                       DTSBD591
00423      IF NOT L910-OK-88                                            DTSBD591
00424         ADD +1 TO WRK-ERROR-CNT                                   DTSBD591
00425         MOVE 'ACCOUNT NOT FOUND  ' TO R591-MESSAGE                DTSBD591
00426         PERFORM P4000-WRITE-591-CURR-ERROR THRU P4000-EXIT        DTSBD591
00427         SET WRK-EMP-NO-INVALID-88 TO TRUE                         DTSBD591
00428         GO TO P2130-EXIT                                          DTSBD591
00429      ELSE                                                         DTSBD591
00430         MOVE MSKL-REC TO MPRF-REC                                 DTSBD591
00431         PERFORM P2131-MPRF-EDITS  THRU P2131-EXIT                 DTSBD591
00432         IF WRK-EMP-NO-VALID-88                                    DTSBD591
00433            PERFORM P2132-CHK-SUCCESSOR  THRU P2132-EXIT.          DTSBD591
00434                                                                   DTSBD591
00435  P2130-EXIT.                                                      DTSBD591
00436      EXIT.                                                        DTSBD591
00437                                                                   DTSBD591
00438  P2131-MPRF-EDITS.                                                DTSBD591
00439      IF MPRF-CLASS-SELF-INS-88                                    DTSBD591
00440         ADD +1 TO WRK-ERROR-CNT                                   DTSBD591
00441         MOVE 'SELF-INSURED EMPLOYER ' TO R591-MESSAGE             DTSBD591
00442         PERFORM P4000-WRITE-591-CURR-ERROR THRU P4000-EXIT        DTSBD591
00443         SET WRK-EMP-NO-INVALID-88 TO TRUE                         DTSBD591
00444      ELSE                                                         DTSBD591
00445         IF MPRF-CLASS-CHG-ONLY-88                                 DTSBD591
00446            ADD +1 TO WRK-ERROR-CNT                                DTSBD591
00447            MOVE 'CHARGE ONLY ACCOUNT ' TO R591-MESSAGE            DTSBD591
00448         PERFORM P4000-WRITE-591-CURR-ERROR THRU P4000-EXIT        DTSBD591
00449            SET WRK-EMP-NO-INVALID-88 TO TRUE                      DTSBD591
00450         END-IF                                                    DTSBD591
00451      END-IF.                                                      DTSBD591
00452                                                                   DTSBD591
00453  P2131-EXIT.                                                      DTSBD591
00454      EXIT.                                                        DTSBD591
00455                                                                   DTSBD591
00456  P2132-CHK-SUCCESSOR.                                             DTSBD591
00457      MOVE MPRF-EMP-NO      TO L600-EMP-NO.                        DTSBD591
00458      PERFORM S600-SUCCESSOR THRU S600-EXIT.                       DTSBD591
00459      IF L600-SUCCESSOR-FOUND-88                                   DTSBD591
00460         ADD +1 TO WRK-ERROR-CNT                                   DTSBD591
00461         MOVE 'EMPLOYER HAS BEEN SUCCEEDED ' TO R591-MESSAGE       DTSBD591
00462         PERFORM P4000-WRITE-591-CURR-ERROR THRU P4000-EXIT        DTSBD591
00463         SET WRK-EMP-NO-INVALID-88 TO TRUE                         DTSBD591
00464      END-IF.                                                      DTSBD591
00465                                                                   DTSBD591
00466  P2132-EXIT.                                                      DTSBD591
00467      EXIT.                                                        DTSBD591
00468                                                                   DTSBD591
00469  P2200-BUILD-MFAE.                                                DTSBD591
00470      INITIALIZE MFAE-REC.                                         DTSBD591
00471                                                                   DTSBD591
00472      MOVE WRK-CURR-EMP-NO-9       TO MFAE-EMP-NO.                 DTSBD591
00473      SET MFAE-FAE-88              TO TRUE.                        DTSBD591
00474      SET MFAE-SERVICE-BEN-CHG-88  TO TRUE.                        DTSBD591
00475      MOVE ZERO                    TO MFAE-PURGE-DATE.             DTSBD591
00476      MOVE WRK-FISCAL-AGENT-CD     TO MFAE-FISCAL-AGENT-CD.        DTSBD591
00477      SET MFAE-NOT-CONVERTED-88    TO TRUE.                        DTSBD591
00478      MOVE MHDR-CURR-RUN-DATE      TO MFAE-ESTB-DATE               DTSBD591
00479                                      MFAE-CHNG-DATE.              DTSBD591
00480                                                                   DTSBD591
00481      DISPLAY 'MFAE ' MFAE-REC.                                       CL**2
00482      MOVE MFAE-REC                TO MSKL-REC.                       CL**2
00483 *&                                                                DTSBD591
00484      PERFORM S910-WRITE           THRU S910-EXIT.                 DTSBD591
00485      ADD +1                       TO WRK-MFAE-ADDED-CNT.          DTSBD591
00486                                                                   DTSBD591
00487  P2200-EXIT.                                                      DTSBD591
00488      EXIT.                                                        DTSBD591
00489                                                                   DTSBD591
00490  P3000-CHK-LAST-REC.                                              DTSBD591
00491      IF WRK-CURR-EMP-DUP-YES-88                                   DTSBD591
00492         MOVE 'DUPLICATE ACCOUNT '  TO R591-MESSAGE                DTSBD591
00493         PERFORM P4000-WRITE-591-CURR-ERROR THRU P4000-EXIT        DTSBD591
00494      ELSE                                                         DTSBD591
00495         PERFORM P2100-EDIT           THRU P2100-EXIT              DTSBD591
00496         IF WRK-EMP-NO-VALID-88                                    DTSBD591
00497            PERFORM P2200-BUILD-MFAE  THRU P2200-EXIT              DTSBD591
00498         END-IF                                                    DTSBD591
00499      END-IF.                                                      DTSBD591
00500                                                                   DTSBD591
00501  P3000-EXIT.                                                      DTSBD591
00502      EXIT.                                                        DTSBD591
00503  P4000-WRITE-591-CURR-ERROR.                                      DTSBD591
00504      MOVE WRK-CURR-EMP-NO            TO R591-EMP-NO.              DTSBD591
00505      MOVE WRK-CURR-FISC-AGNT-NAME    TO WRK-FISCAL-AGENT-NAME.    DTSBD591
00506      MOVE WRK-CURR-EMPLOYER-NAME     TO R591-EMPLOYER-NAME.       DTSBD591
00507      GO TO P4000-FISCAL-AGENT.                                    DTSBD591
00508                                                                   DTSBD591
00509  P4000-WRITE-591-NEW-ERROR.                                       DTSBD591
00510      MOVE WRK-NEW-EMP-NO            TO R591-EMP-NO.               DTSBD591
00511      MOVE WRK-NEW-FISC-AGNT-NAME    TO WRK-FISCAL-AGENT-NAME.     DTSBD591
00512      MOVE WRK-NEW-EMPLOYER-NAME     TO R591-EMPLOYER-NAME.        DTSBD591
00513      GO TO P4000-FISCAL-AGENT.                                    DTSBD591
00514                                                                   DTSBD591
00515  P4000-FISCAL-AGENT.                                              DTSBD591
00516      PERFORM P2120-VALIDATE-FISC-AGNT THRU P2120-EXIT.            DTSBD591
00517                                                                   DTSBD591
00518      IF WRK-FISC-AGNT-INVALID-88                                  DTSBD591
00519         GO TO P4000-EXIT.                                         DTSBD591
00520      MOVE SPACES                TO R591-EMP-STATUS-CODE.          DTSBD591
00521      SET R591-ERROR-88          TO TRUE.                          DTSBD591
00522      MOVE WRK-FISCAL-AGENT-CD   TO R591-FISCAL-AGENT-CD.          DTSBD591
00523                                                                   DTSBD591
00524      CALL 'DTSBU946' USING R591-REC.                              DTSBD591
00525                                                                   DTSBD591
00526  P4000-EXIT.                                                      DTSBD591
00527      EXIT.                                                        DTSBD591
00528                                                                   DTSBD591
00529  T0000-TERMINATE.                                                 DTSBD591
00530                                                                   DTSBD591
00531      DISPLAY ' '.                                                 DTSBD591
00532                                                                   DTSBD591
00533      DISPLAY '*** DTSBD591 TERMINATION STATISTICS ***'.           DTSBD591
00534                                                                   DTSBD591
00535      DISPLAY ' '.                                                 DTSBD591
00536                                                                   DTSBD591
00537      DISPLAY 'NUMBER OF MFAE RECORDS DELETED            :        'DTSBD591
00538              WRK-MFAE-DELETED-CNT.                                DTSBD591
00539                                                                   DTSBD591
00540      DISPLAY 'NUMBER OF FISCAL AGENT RECORDS ENCOUNTERED:        'DTSBD591
00541              WRK-FA-READ-CNT.                                     DTSBD591
00542                                                                   DTSBD591
00543      DISPLAY 'NUMBER OF R591 ERRORS WRITTEN        :             'DTSBD591
00544              WRK-ERROR-CNT.                                       DTSBD591
00545                                                                   DTSBD591
00546      DISPLAY 'NUMBER OF MASTER FILE RECORDS UPDATED:             'DTSBD591
00547              WRK-MFAE-ADDED-CNT.                                  DTSBD591
00548                                                                   DTSBD591
00549                                                                   DTSBD591
00550      PERFORM S910-CLOSE THRU S910-EXIT.                           DTSBD591
00551                                                                   DTSBD591
00552      PERFORM S921-CLOSE THRU S921-EXIT.                           DTSBD591
00553                                                                   DTSBD591
00554      PERFORM S952-CLOSE-FA-FILE THRU S952-EXIT.                   DTSBD591
00555                                                                   DTSBD591
00556  T0000-EXIT.                                                      DTSBD591
00557      EXIT.                                                        DTSBD591
00558      EJECT                                                        DTSBD591
00559  S600-SUCCESSOR.                                                  DTSBD591
00560      CALL 'DTSBU600' USING L600-LINK-AREA.                        DTSBD591
00561                                                                   DTSBD591
00562  S600-EXIT.                                                       DTSBD591
00563      EXIT.                                                        DTSBD591
00564                                                                   DTSBD591
00565  S910-OPEN-READ.                                                  DTSBD591
00566      SET L910-OPEN-READ-88 TO TRUE.                               DTSBD591
00567      GO TO S910-MSTR-IO.                                          DTSBD591
00568                                                                   DTSBD591
00569  S910-OPEN-UPDATE-NO-AIX.                                         DTSBD591
00570      SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE.                      DTSBD591
00571      GO TO S910-MSTR-IO.                                          DTSBD591
00572                                                                   DTSBD591
00573  S910-READ.                                                       DTSBD591
00574      SET L910-READ-88 TO TRUE.                                    DTSBD591
00575      GO TO S910-MSTR-IO.                                          DTSBD591
00576                                                                   DTSBD591
00577  S910-START-BROWSE.                                               DTSBD591
00578      SET L910-START-BROWSE-88 TO TRUE.                            DTSBD591
00579      GO TO S910-MSTR-IO.                                          DTSBD591
00580                                                                   DTSBD591
00581  S910-READ-NEXT.                                                  DTSBD591
00582      SET L910-READ-NEXT-88 TO TRUE.                               DTSBD591
00583      GO TO S910-MSTR-IO.                                          DTSBD591
00584                                                                   DTSBD591
00585  S910-COUNT.                                                      DTSBD591
00586      SET L910-COUNT-88 TO TRUE.                                   DTSBD591
00587      GO TO S910-MSTR-IO.                                          DTSBD591
00588                                                                   DTSBD591
00589  S910-WRITE.                                                      DTSBD591
00590      SET L910-WRITE-88 TO TRUE.                                   DTSBD591
00591      GO TO S910-MSTR-IO.                                          DTSBD591
00592                                                                   DTSBD591
00593  S910-REWRITE.                                                    DTSBD591
00594      SET L910-REWRITE-88 TO TRUE.                                 DTSBD591
00595      GO TO S910-MSTR-IO.                                          DTSBD591
00596                                                                   DTSBD591
00597  S910-DELETE.                                                     DTSBD591
00598      SET L910-DELETE-88 TO TRUE.                                  DTSBD591
00599      GO TO S910-MSTR-IO.                                          DTSBD591
00600                                                                   DTSBD591
00601  S910-CLOSE.                                                      DTSBD591
00602      SET L910-CLOSE-88     TO TRUE.                               DTSBD591
00603      GO TO S910-MSTR-IO.                                          DTSBD591
00604                                                                   DTSBD591
00605  S910-MSTR-IO.                                                    DTSBD591
00606      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBD591
00607                            MSKL-REC.                              DTSBD591
00608  S910-EXIT.                                                       DTSBD591
00609      EXIT.                                                        DTSBD591
00610                                                                   DTSBD591
00611  S921-OPEN-READ.                                                  DTSBD591
00612      SET L921-OPEN-READ-88 TO TRUE.                               DTSBD591
00613      GO TO S921-AIX-IO.                                           DTSBD591
00614                                                                   DTSBD591
00615  S921-CLOSE.                                                      DTSBD591
00616      SET L921-CLOSE-88     TO TRUE.                               DTSBD591
00617      GO TO S921-AIX-IO.                                           DTSBD591
00618                                                                   DTSBD591
00619  S921-AIX-IO.                                                     DTSBD591
00620      CALL 'DTSBU921' USING L921-LINK-AREA                         DTSBD591
00621                            ISKL-REC.                              DTSBD591
00622  S921-EXIT.                                                       DTSBD591
00623      EXIT.                                                        DTSBD591
00624                                                                   DTSBD591
00625  S950-OPEN-FA-FILE.                                               DTSBD591
00626      OPEN INPUT FISCAL-AGENT-FILE.                                DTSBD591
00627                                                                   DTSBD591
00628  S950-EXIT.                                                       DTSBD591
00629      EXIT.                                                        DTSBD591
00630                                                                   DTSBD591
00631  S951-READ-FA-FILE.                                               DTSBD591
00632      READ FISCAL-AGENT-FILE.                                      DTSBD591
00633                                                                   DTSBD591
00634  S951-EXIT.                                                       DTSBD591
00635      EXIT.                                                        DTSBD591
00636                                                                   DTSBD591
00637  S952-CLOSE-FA-FILE.                                              DTSBD591
00638      CLOSE FISCAL-AGENT-FILE.                                     DTSBD591
00639                                                                   DTSBD591
00640  S952-EXIT.                                                       DTSBD591
00641      EXIT.                                                        DTSBD591
00642                                                                   DTSBD591
00643      SKIP3                                                        DTSBD591
00644  S999-ABEND.                                                      DTSBD591
00645      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBD591
00646  S999-EXIT.                                                       DTSBD591
00647      EXIT.                                                        DTSBD591
