00001  IDENTIFICATION DIVISION.                                         12/03/09
00002  PROGRAM-ID.             DTSBD590.                                DTSBD590
00003  AUTHOR.                 TRW/BDM.                                    LV021
00004  DATE-WRITTEN.           FEBRUARY 2000.                           DTSBD590
00005  DATE-COMPILED.                                                   DTSBD590
00006      SKIP3                                                        DTSBD590
00007 *****                                                             DTSBD590
00008 *                                                                 DTSBD590
00009 *    FUNCTION:  PROCESS FISCAL AGENT UC30 CLIENTS DATA AND        DTSBD590
00010 *               MAINTAIN UC30 MFAE RECORDS.                       DTSBD590
00011 *                                                                 DTSBD590
00012 *                                                                 DTSBD590
00013 *  MODIFICATION LOG:                                              DTSBD590
00014 *                                                                 DTSBD590
00015 *    08/14/2002  RECOMPILED FOR NEW VERSION OF MRTE RECORD.       DTSBD590
00016 *                THE PROGRAM WILL DISPLAY THE ACCOUNT NUMBERS     DTSBD590
00017 *                OF ANY EMPLOYERS WITH ESTIMATED RATES, AND       DTSBD590
00018 *                WILL DISPLAY A COUNT OF THE NUMBER OF            DTSBD590
00019 *                ESTIMATED RATES FOUND AT THE END OF THE RUN.     DTSBD590
00020 *                IF THERE ARE ANY ESTIMATED RATES, THE OUTPUT     DTSBD590
00021 *                OF THE JOB SHOULD BE DISCARDED AND THE RATES     DTSBD590
00022 *                CORRECTED BEFORE RERUNNING.                      DTSBD590
00023 *                REFERENCE: HOUSEHOLD            PROGRAMMER: GD   DTSBD590
00024 *                                                                 DTSBD590
00025 *    12/31/2003  USING THE INPUT DATA SET YEAR QUARTER FROM JCL   DTSBD590
00026 *                TO SET THE PARM INPUT TO DETERMINE WHETHER THE   DTSBD590
00027 *                EMPLOYER IS LIABLE. IT ALSO DELETED THE FUIR     DTSBD590
00028 *                AND MRTE RECORDS FOR DETERMINING THR EMPLOYER'S  DTSBD590
00029 *       GB       RATE. SINCE BU516 WILL FIND THE EMPLOYER'RATE    DTSBD590
00030 *                DIRECTLY. IT IS NOT NECESSARY TO READ THE FUIR   DTSBD590
00031 *                AND MRTE RECORDS SEPARATELY.                     DTSBD590
00032 *                REFERENCE: HOUSEHOLD            PROGRAMMER: RW1  DTSBD590
00033 *                                                                 DTSBD590
00034 *    01/10/2006 ADDED .002 SURTAX TO COMPUTE WRK-UI-RATE          DTSBD590
00035 *                IN P3100-EDIT-MPRF PARAGRAPH                     DTSBD590
00036 *                                                                 DTSBD590
00037 *    FISCAL AGENT PRIME PAY (PP) IS PASSED THE REGULAR UI RATE ONLDTSBD590
00038 **   PER A REQUEST FROM THEIR REPRESENTATIVE ELISA LYONS          DTSBD590
00039 **   ALL OTHERS ARE PASSED REGULAR RATE + .002 SURTAX             DTSBD590
00040 **   PROGRAMMER: G. BROWN                                         DTSBD590
00041 *****                                                             DTSBD590
00042 *                                                                 DTSBD590
00043 *    FISCAL AGENT PAYCHEX (PC) IS PASSED THE REGULAR UI RATE ONLY DTSBD590
00044 **   PER A REQUEST FROM THEIR REPRESENTATIVE JENINE CAMELIO       DTSBD590
00045 **   ALL OTHERS ARE PASSED REGULAR RATE + .002 SURTAX             DTSBD590
00046 **   PROGRAMMER: G. BROWN                                         DTSBD590
00047 *****                                                             DTSBD590
00048 *****                                                             DTSBD590
00049      SKIP3                                                        DTSBD590
00050  ENVIRONMENT DIVISION.                                            DTSBD590
00051      SKIP2                                                        DTSBD590
00052  INPUT-OUTPUT SECTION.                                            DTSBD590
00053  FILE-CONTROL.                                                    DTSBD590
00054      SELECT FISCAL-AGENT-IFILE                                    DTSBD590
00055         ASSIGN TO FAIFILE                                         DTSBD590
00056         FILE STATUS IS XFAQ-STATUS.                               DTSBD590
00057                                                                   DTSBD590
00058  DATA DIVISION.                                                   DTSBD590
00059      SKIP3                                                        DTSBD590
00060  FILE SECTION.                                                    DTSBD590
00061                                                                   DTSBD590
00062  FD  FISCAL-AGENT-IFILE                                           DTSBD590
00063      LABEL RECORDS ARE STANDARD.                                  DTSBD590
00064  01  FISCAL-AGENT-REC                PIC X(080).                  DTSBD590
00065      EJECT                                                        DTSBD590
00066  WORKING-STORAGE SECTION.                                         DTSBD590
000665 77  PAN-VALET PICTURE X(24) VALUE '021DTSBD590  12/03/09'.       DTSBD590
00067      SKIP3                                                        DTSBD590
00068  01  WRK-AREA.                                                    DTSBD590
00069      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +590.DTSBD590
00070                                                                   DTSBD590
00071      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBD590'.DTSBD590
00072                                                                   DTSBD590
00073      05  WRK-ESTIM-RATE-CNT          PIC S9(07)  COMP-3 VALUE 0.  DTSBD590
00074      05  WRK-FA-ACCT-CNT             PIC S9(07)  COMP-3 VALUE 0.  DTSBD590
00075      05  WRK-FA-DUP-CNT              PIC S9(07)  COMP-3 VALUE 0.  DTSBD590
00076      05  WRK-FA-FEIN-CNT             PIC S9(07)  COMP-3 VALUE 0.  DTSBD590
00077      05  WRK-FN-FEIN-CNT             PIC S9(07)  COMP-3 VALUE 0.  DTSBD590
00078      05  WRK-FA-READ-CNT             PIC S9(07)  COMP-3 VALUE 0.  DTSBD590
00079      05  WRK-FA-WRITE-CNT            PIC S9(07)  COMP-3 VALUE 0.  DTSBD590
00080      05  WRK-FN-WRITE-CNT            PIC S9(07)  COMP-3 VALUE 0.  DTSBD590
00081      05  WRK-FE-WRITE-CNT            PIC S9(07)  COMP-3 VALUE 0.  DTSBD590
00082      05  WRK-MFAE-ADDED-CNT          PIC S9(07)  COMP-3 VALUE 0.  DTSBD590
00083      05  WRK-MFAE-DUPL-CNT           PIC S9(07)  COMP-3 VALUE 0.  DTSBD590
00084      05  WRK-MFAE-DELETED-CNT        PIC S9(07)  COMP-3 VALUE 0.  DTSBD590
00085                                                                   DTSBD590
00086      05  XFAQ-STATUS                 PIC  X(02).                  DTSBD590
00087          88  XFAQ-STAT-OK-88        VALUE '00', '97'.             DTSBD590
00088          88  XFAQ-STAT-EOF-88       VALUE '10'.                   DTSBD590
00089                                                                   DTSBD590
00090      05  WRK-ERROR-IND               PIC  X(01).                  DTSBD590
00091          88 WRK-ERROR-YES-88        VALUE 'Y'.                    DTSBD590
00092          88 WRK-ERROR-NO-88         VALUE 'N'.                    DTSBD590
00093                                                                   DTSBD590
00094      05  WRK-EMP-NO                      PIC  9(06)  VALUE 0.     DTSBD590
00095          88 WRK-EMP-NO-INVALID-88   VALUE ZERO.                   DTSBD590
00096                                                                   DTSBD590
00097      05  WRK-FEIN-NO                     PIC  9(09)  VALUE 0.     DTSBD590
00098          88 WRK-FEIN-NO-INVALID-88  VALUE ZERO.                   DTSBD590
00099                                                                   DTSBD590
00100      05  WRK-MESSAGE                     PIC  X(40)  VALUE SPACES.DTSBD590
00101      05  WRK-FISC-AGNT-IND               PIC  X(01).              DTSBD590
00102          88 WRK-FISC-AGNT-VALID-88    VALUE 'Y'.                  DTSBD590
00103          88 WRK-FISC-AGNT-INVALID-88  VALUE 'N'.                  DTSBD590
00104                                                                   DTSBD590
00105      05  WRK-FAE-DUP-IND                 PIC  X(01).              DTSBD590
00106          88 WRK-FAE-YES-DUP-88        VALUE 'Y'.                  DTSBD590
00107          88 WRK-FAE-NO-DUP-88         VALUE 'N'.                  DTSBD590
00108                                                                   DTSBD590
00109      05  WRK-FA-DUP-REC-IND              PIC  X(01).              DTSBD590
00110          88 WRK-FA-DUP-REC-YES-88     VALUE 'Y'.                  DTSBD590
00111          88 WRK-FA-DUP-REC-NO-88      VALUE 'N'.                  DTSBD590
00112                                                                   DTSBD590
00113      05  DEFAULT-RATE-QTR                PIC  9(01) VALUE 1.      DTSBD590
00114                                                                   DTSBD590
00115      05  WRK-YRQ                         PIC  9(05).              DTSBD590
00116      05  FILLER REDEFINES WRK-YRQ.                                DTSBD590
00117          10  WRK-RATE-YYYY               PIC  9(04).              DTSBD590
00118          10  WRK-RATE-Q                  PIC  9(01).              DTSBD590
00119                                                                   DTSBD590
00120      05  WRK-CURR-DATE                   PIC  9(08).              DTSBD590
00121      05  FILLER REDEFINES WRK-CURR-DATE.                          DTSBD590
00122          10  WRK-CURR-YYYY               PIC  9(04).              DTSBD590
00123          10  FILLER                      PIC  X(04).              DTSBD590
00124      05  WRK-UI-RATE-IND                 PIC  X(01).              DTSBD590
00125          88 WRK-UI-RATE-OK-88         VALUE 'Y'.                  DTSBD590
00126          88 WRK-UI-RATE-NOT-OK-88     VALUE 'N'.                  DTSBD590
00127      05  WRK-UI-RATE                     PIC S9(03)V9(4) VALUE 0. DTSBD590
00128                                                                   DTSBD590
00129      05  CURR-XFAQ-KEY-AREA.                                      DTSBD590
00130          10  CURR-FA-REC-TYPE            PIC  X(06)  VALUE SPACE. DTSBD590
00131          10  CURR-FA-CD                  PIC  X(03)  VALUE SPACE. DTSBD590
00132          10  CURR-FA-EMP-NO              PIC  9(06)  VALUE 0.     DTSBD590
00133          10  CURR-FA-FEIN-NO             PIC  9(09)  VALUE 0.     DTSBD590
00134                                                                   DTSBD590
00135      05  WRK-XFAQ-KEY-AREA.                                       DTSBD590
00136          10  WRK-FA-REC-TYPE             PIC  X(06)  VALUE SPACE. DTSBD590
00137          10  WRK-FA-CD                   PIC  X(03)  VALUE SPACE. DTSBD590
00138          10  WRK-FA-EMP-NO               PIC  9(06)  VALUE 0.     DTSBD590
00139          10  WRK-FA-FEIN-NO              PIC  9(09)  VALUE 0.     DTSBD590
00140                                                                   DTSBD590
00141      05  WRK-MPRF-FEIN-NO                PIC  9(09)  VALUE 0.     DTSBD590
00142      05  WRK-XFAQ-EMP-FEIN               PIC  9(09)  VALUE 0.     DTSBD590
00143                                                                   DTSBD590
00144      05  WRK-IEIN-EMP-NO                 PIC  9(06)  VALUE 0.     DTSBD590
00145      05  WRK-LIAB-EMP-NO                 PIC  9(06)  VALUE 0.     DTSBD590
00146                                                                   DTSBD590
00147      05  WRK-LIAB-DATE                   PIC  S9(09) VALUE 0.     DTSBD590
00148                                                                   DTSBD590
00149      05  WRK-TRACE-IND                   PIC  X(01)  VALUE SPACES.DTSBD590
00150      05  WRK-FISCAL-AGENT-CD             PIC  X(03)  VALUE SPACES.DTSBD590
00151      05  WRK-FISC-AGNT-NAME              PIC  X(35)  VALUE SPACES.DTSBD590
00152                                                                   DTSBD590
00153  01  FISCAL-AGENT-INREC.                                          DTSBD590
00154  ++INCLUDE DTSIXFAQ                                               DTSBD590
00155                                                                   DTSBD590
00156  01  R590-REC.                                                    DTSBD590
00157  ++INCLUDE DTSIR590                                               DTSBD590
00158                                                                   DTSBD590
00159  01  L004-LINK-AREA.                                              DTSBD590
00160  ++INCLUDE DTSIL004                                               DTSBD590
00161      EJECT                                                        DTSBD590
00162  01  L006-LINK-AREA.                                              DTSBD590
00163  ++INCLUDE DTSIL006                                               DTSBD590
00164      EJECT                                                        DTSBD590
00165  01  L516-LINK-AREA.                                              DTSBD590
00166  ++INCLUDE DTSIL516                                               DTSBD590
00167      EJECT                                                        DTSBD590
00168  01  L600-LINK-AREA.                                              DTSBD590
00169  ++INCLUDE DTSIL600                                               DTSBD590
00170      EJECT                                                        DTSBD590
00171  01  L910-LINK-AREA.                                              DTSBD590
00172  ++INCLUDE DTSIL910                                               DTSBD590
00173      EJECT                                                        DTSBD590
00174  01  MSKL-REC.                                                    DTSBD590
00175  ++INCLUDE DTSIMSKL                                               DTSBD590
00176      EJECT                                                        DTSBD590
00177  01  MHDR-REC.                                                    DTSBD590
00178  ++INCLUDE DTSIMHDR                                               DTSBD590
00179      EJECT                                                        DTSBD590
00180  01  MPRF-REC.                                                    DTSBD590
00181  ++INCLUDE DTSIMPRF                                               DTSBD590
00182      EJECT                                                        DTSBD590
00183  01  MFAE-REC.                                                    DTSBD590
00184  ++INCLUDE DTSIMFAE                                               DTSBD590
00185      EJECT                                                        DTSBD590
00186  01  MSOL-REC.                                                    DTSBD590
00187  ++INCLUDE DTSIMSOL                                               DTSBD590
00188      EJECT                                                        DTSBD590
00189 *01  MRTE-REC.                                                    DTSBD590
00190 ***INCLUDE DTSIMRTE                                               DTSBD590
00191 *    EJECT                                                        DTSBD590
00192  01  L921-LINK-AREA.                                              DTSBD590
00193  ++INCLUDE DTSIL921                                               DTSBD590
00194      EJECT                                                        DTSBD590
00195  01  ISKL-REC.                                                    DTSBD590
00196  ++INCLUDE DTSIISKL                                               DTSBD590
00197      EJECT                                                        DTSBD590
00198  01  IEIN-REC.                                                    DTSBD590
00199  ++INCLUDE DTSIIEIN                                               DTSBD590
00200      EJECT                                                        DTSBD590
00201  01  L931-LINK-AREA.                                              DTSBD590
00202  ++INCLUDE DTSIL931                                               DTSBD590
00203      EJECT                                                        DTSBD590
00204  01  FSKL-REC.                                                    DTSBD590
00205  ++INCLUDE DTSIFSKL                                               DTSBD590
00206      EJECT                                                        DTSBD590
00207 *01  FUIR-REC.                                                    DTSBD590
00208 ***INCLUDE DTSIFUIR                                               DTSBD590
00209 *    EJECT                                                        DTSBD590
00210  01  FISCAL-AGENT-TABLE-AREA.                                     DTSBD590
00211  ++INCLUDE CHGIC001                                               DTSBD590
00212      EJECT                                                        DTSBD590
00213  LINKAGE SECTION.                                                 DTSBD590
00214  01  PARM-AREA.                                                   DTSBD590
00215      05  PARM-LENGTH                PIC S9(04) COMP.              DTSBD590
00216      05  PARM-RATE-YRQ              PIC  9(05).                   DTSBD590
00217      05  PARM-RATE-YRQ-X                                          DTSBD590
00218             REDEFINES PARM-RATE-YRQ PIC  X(05).                   DTSBD590
00219      EJECT                                                        DTSBD590
00220  PROCEDURE DIVISION USING PARM-AREA.                              DTSBD590
00221                                                                   DTSBD590
00222  DTSBD590-MAIN.                                                   DTSBD590
00223      PERFORM I0000-INITIATE THRU I0000-EXIT.                      DTSBD590
00224      IF WRK-ERROR-YES-88                                          DTSBD590
00225         GO TO DTSBD590-MAIN-EXIT.                                 DTSBD590
00226                                                                   DTSBD590
00227      PERFORM P0000-PROCESS THRU P0000-EXIT                        DTSBD590
00228          UNTIL NOT XFAQ-STAT-OK-88.                               DTSBD590
00229                                                                   DTSBD590
00230      PERFORM T0000-TERMINATE THRU T0000-EXIT.                     DTSBD590
00231                                                                   DTSBD590
00232  DTSBD590-MAIN-EXIT.                                              DTSBD590
00233      GOBACK.                                                      DTSBD590
00234      EJECT                                                        DTSBD590
00235  I0000-INITIATE.                                                  DTSBD590
00236      MOVE +0 TO WRK-FA-READ-CNT                                   DTSBD590
00237                 WRK-MFAE-DELETED-CNT                              DTSBD590
00238                 WRK-MFAE-ADDED-CNT                                DTSBD590
00239                 WRK-YRQ.                                          DTSBD590
00240                                                                   DTSBD590
00241      SET WRK-ERROR-NO-88 TO TRUE.                                 DTSBD590
00242      SET WRK-FA-DUP-REC-NO-88  TO TRUE.                           DTSBD590
00243                                                                   DTSBD590
00244                                                                   DTSBD590
00245      PERFORM I1000-OPEN-FILES          THRU I1000-EXIT.           DTSBD590
00246                                                                   DTSBD590
00247      PERFORM I2000-READ-MHDR           THRU I2000-EXIT.           DTSBD590
00248                                                                   DTSBD590
00249      PERFORM I3000-EDIT-PARM           THRU I3000-EXIT.           DTSBD590
00250                                                                   DTSBD590
00251      PERFORM I4000-DELETE-MFAE         THRU I4000-EXIT.           DTSBD590
00252                                                                   DTSBD590
00253      MOVE LENGTH OF R590-REC TO R590-LENGTH.                      DTSBD590
00254      MOVE '590'              TO R590-REC-TYPE.                    DTSBD590
00255                                                                   DTSBD590
00256                                                                   DTSBD590
00257      SKIP2                                                        DTSBD590
00258  I0000-EXIT.                                                      DTSBD590
00259      EXIT.                                                        DTSBD590
00260  I1000-OPEN-FILES.                                                DTSBD590
00261      PERFORM S950-OPEN-FA-FILE THRU S950-EXIT.                    DTSBD590
00262      IF NOT XFAQ-STAT-OK-88                                       DTSBD590
00263         DISPLAY 'CANNOT OPEN FISCAL AGENT FILE ' XFAQ-STATUS      DTSBD590
00264         SET WRK-ERROR-YES-88 TO TRUE                              DTSBD590
00265         GO TO I1000-EXIT.                                         DTSBD590
00266                                                                   DTSBD590
00267      MOVE WRK-TRACE-IND TO L910-TRACE-IND.                        DTSBD590
00268                                                                   DTSBD590
00269      MOVE WRK-MOD-NAME TO L910-MOD-NAME.                          DTSBD590
00270                                                                   DTSBD590
00271 *    PERFORM S910-OPEN-READ THRU S910-EXIT.                       DTSBD590
00272      PERFORM S921-OPEN-READ THRU S921-EXIT.                       DTSBD590
00273      PERFORM S931-OPEN-READ THRU S931-EXIT.                       DTSBD590
00274      PERFORM S910-OPEN-UPDATE-NO-AIX THRU S910-EXIT.              DTSBD590
00275                                                                   DTSBD590
00276  I1000-EXIT.                                                      DTSBD590
00277      EXIT.                                                        DTSBD590
00278                                                                   DTSBD590
00279  I2000-READ-MHDR.                                                 DTSBD590
00280      MOVE LOW-VALUE TO MHDR-KEY-AREA.                             DTSBD590
00281                                                                   DTSBD590
00282      MOVE +0        TO MHDR-EMP-NO.                               DTSBD590
00283                                                                   DTSBD590
00284      SET MHDR-HDR-88 TO TRUE.                                     DTSBD590
00285      MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA.                         DTSBD590
00286      PERFORM S910-READ THRU S910-EXIT.                            DTSBD590
00287                                                                   DTSBD590
00288      IF L910-NO-REC-88                                            DTSBD590
00289         DISPLAY ' NO HEADER REC FOUND'                            DTSBD590
00290         SET WRK-ERROR-YES-88 TO TRUE                              DTSBD590
00291         GO TO I2000-EXIT.                                         DTSBD590
00292                                                                   DTSBD590
00293      MOVE MSKL-REC TO MHDR-REC.                                   DTSBD590
00294                                                                   DTSBD590
00295  I2000-EXIT.                                                      DTSBD590
00296      EXIT.                                                        DTSBD590
00297                                                                   DTSBD590
00298  I3000-EDIT-PARM.                                                 DTSBD590
00299                                                                   DTSBD590
00300      DISPLAY 'DTSBD590 PARM LENGTH ' PARM-LENGTH.                 DTSBD590
00301      DISPLAY 'DTSBD590 PARM        ' PARM-RATE-YRQ-X.             DTSBD590
00302                                                                   DTSBD590
00303      IF PARM-RATE-YRQ-X = SPACES OR LOW-VALUES OR ZEROS           DTSBD590
00304         PERFORM I3100-DEFAULT-RATE-YRQ THRU I3100-EXIT            DTSBD590
00305      ELSE                                                         DTSBD590
00306         PERFORM I3200-PARM-RATE-YRQ THRU I3200-EXIT.              DTSBD590
00307                                                                   DTSBD590
00308  I3000-EXIT.                                                      DTSBD590
00309      EXIT.                                                        DTSBD590
00310                                                                   DTSBD590
00311  I3100-DEFAULT-RATE-YRQ.                                          DTSBD590
00312                                                                   DTSBD590
00313      MOVE MHDR-CMPL-QTR-BEGIN-DATE TO L004-DATE.                  DTSBD590
00314      PERFORM S004-FROM-DATE        THRU S004-EXIT.                DTSBD590
00315      MOVE L004-QTR-5-9             TO WRK-YRQ.                    DTSBD590
00316                                                                   DTSBD590
00317      DISPLAY 'DTSBD590 DEFAULT YEAR QTR  ' WRK-YRQ.               DTSBD590
00318                                                                   DTSBD590
00319  I3100-EXIT.                                                      DTSBD590
00320      EXIT.                                                        DTSBD590
00321                                                                   DTSBD590
00322  I3200-PARM-RATE-YRQ.                                             DTSBD590
00323      MOVE PARM-RATE-YRQ    TO L004-QTR-5-X.                       DTSBD590
00324      PERFORM S004-FROM-5   THRU S004-EXIT.                        DTSBD590
00325      IF L004-VALID-QTR                                            DTSBD590
00326         IF L004-QTR-5-9 <= MHDR-LAST-RATE-END-YRQ                 DTSBD590
00327            NEXT SENTENCE                                          DTSBD590
00328         ELSE                                                      DTSBD590
00329            DISPLAY '**** >>> DTSBD590 ABENDING <<< ****'          DTSBD590
00330            DISPLAY 'PARM-YRQ > MOST RECENT RATE YEAR: '           DTSBD590
00331                       PARM-RATE-YRQ-X                             DTSBD590
00332            PERFORM S999-ABEND THRU S999-EXIT                      DTSBD590
00333         END-IF                                                    DTSBD590
00334      ELSE                                                         DTSBD590
00335         DISPLAY '**** >>> DTSBD590 ABENDING <<< ****'             DTSBD590
00336         DISPLAY 'PARM-YRQ IS INVALID: ' PARM-RATE-YRQ-X           DTSBD590
00337         PERFORM S999-ABEND THRU S999-EXIT                         DTSBD590
00338      END-IF.                                                      DTSBD590
00339                                                                   DTSBD590
00340      MOVE L004-QTR-5-9             TO WRK-YRQ.                    DTSBD590
00341      DISPLAY 'DTSBD590 PARM INPUT YEAR QTR  ' WRK-YRQ.            DTSBD590
00342                                                                   DTSBD590
00343  I3200-EXIT.                                                      DTSBD590
00344      EXIT.                                                        DTSBD590
00345                                                                   DTSBD590
00346 *I3210-FIND-RATE-TABLE.                                           DTSBD590
00347 *    MOVE LOW-VALUE              TO FUIR-KEY-AREA.                DTSBD590
00348 *    SET FUIR-UIR-88 TO TRUE.                                     DTSBD590
00349 *    MOVE L006-RTE-YR-START-YRQ  TO FUIR-EFF-YRQ.                 DTSBD590
00350 *    MOVE FUIR-REC               TO FSKL-REC.                     DTSBD590
00351 *                                                                 DTSBD590
00352 *    PERFORM S931-READ           THRU S931-EXIT.                  DTSBD590
00353 *    IF L931-OK-88                                                DTSBD590
00354 *       MOVE L006-RTE-YR-START-YRQ  TO WRK-YRQ.                   DTSBD590
00355 *                                                                 DTSBD590
00356 *I3210-EXIT.                                                      DTSBD590
00357 *    EXIT.                                                        DTSBD590
00358                                                                   DTSBD590
00359  I4000-DELETE-MFAE.                                               DTSBD590
00360      MOVE LOW-VALUE        TO MSKL-REC.                           DTSBD590
00361      MOVE +0               TO MSKL-EMP-NO.                        DTSBD590
00362      SET MSKL-PRF-88       TO TRUE.                               DTSBD590
00363                                                                   DTSBD590
00364      PERFORM S910-START-BROWSE  THRU S910-EXIT.                   DTSBD590
00365                                                                   DTSBD590
00366      PERFORM I4100-MPRF-SCAN    THRU I4100-EXIT                   DTSBD590
00367         UNTIL L910-NO-REC-88.                                     DTSBD590
00368                                                                   DTSBD590
00369  I4000-EXIT.                                                      DTSBD590
00370      EXIT.                                                        DTSBD590
00371                                                                   DTSBD590
00372  I4100-MPRF-SCAN.                                                 DTSBD590
00373      MOVE MSKL-REC                 TO MPRF-REC.                   DTSBD590
00374                                                                   DTSBD590
00375      MOVE LOW-VALUE                TO MSKL-KEY-AREA.              DTSBD590
00376      MOVE MPRF-EMP-NO              TO MSKL-EMP-NO.                DTSBD590
00377      SET MSKL-FAE-88               TO TRUE.                       DTSBD590
00378                                                                   DTSBD590
00379      PERFORM S910-START-BROWSE     THRU S910-EXIT.                DTSBD590
00380      PERFORM                                                      DTSBD590
00381         UNTIL L910-NO-REC-88                                      DTSBD590
00382            MOVE MSKL-REC           TO MFAE-REC                    DTSBD590
00383            IF MFAE-SERVICE-UC30-88                                DTSBD590
00384               PERFORM S910-DELETE  THRU S910-EXIT                 DTSBD590
00385               ADD +1               TO WRK-MFAE-DELETED-CNT        DTSBD590
00386            END-IF                                                 DTSBD590
00387            PERFORM S910-READ-NEXT  THRU S910-EXIT                 DTSBD590
00388      END-PERFORM.                                                 DTSBD590
00389      MOVE MPRF-REC                 TO MSKL-REC.                   DTSBD590
00390      PERFORM S910-READ-NEXT        THRU S910-EXIT.                DTSBD590
00391                                                                   DTSBD590
00392  I4100-EXIT.                                                      DTSBD590
00393      EXIT.                                                        DTSBD590
00394                                                                   DTSBD590
00395  P0000-PROCESS.                                                   DTSBD590
00396      SET WRK-EMP-NO-INVALID-88 TO TRUE.                           DTSBD590
00397                                                                   DTSBD590
00398      PERFORM S951-READ-FA-FILE THRU S951-EXIT.                    DTSBD590
00399                                                                   DTSBD590
00400      IF NOT XFAQ-STAT-OK-88                                       DTSBD590
00401         GO TO P0000-PROCESS-CONTINUE.                             DTSBD590
00402                                                                   DTSBD590
00403      ADD +1 TO WRK-FA-READ-CNT.                                   DTSBD590
00404                                                                   DTSBD590
00405      IF WRK-FA-READ-CNT = 1                                       DTSBD590
00406         MOVE XFAQ-KEY-AREA TO WRK-XFAQ-KEY-AREA                   DTSBD590
00407         GO TO P0000-EXIT.                                         DTSBD590
00408                                                                   DTSBD590
00409      MOVE XFAQ-KEY-AREA TO CURR-XFAQ-KEY-AREA.                    DTSBD590
00410                                                                   DTSBD590
00411      IF XFAQ-EMP-FEIN = WRK-FA-FEIN-NO AND XFAQ-EMP-FEIN > ZEROS  DTSBD590
00412       IF XFAQ-FISCAL-AGENT-CD    NOT = WRK-FA-CD                  DTSBD590
00413 *         MOVE WRK-XFAQ-KEY-AREA  TO XFAQ-KEY-AREA                DTSBD590
00414           MOVE 'DUPLICATE FEIN WITH OTHER FISCAL AGENT' TO        DTSBD590
00415                   WRK-MESSAGE                                     DTSBD590
00416           PERFORM P4000-FAERROR-OUTPUT THRU P4000-EXIT            DTSBD590
00417           MOVE CURR-XFAQ-KEY-AREA TO WRK-XFAQ-KEY-AREA            DTSBD590
00418           ADD 1 TO WRK-FA-DUP-CNT                                 DTSBD590
00419           SET WRK-FA-DUP-REC-YES-88 TO TRUE                       DTSBD590
00420           GO TO P0000-EXIT                                        DTSBD590
00421        END-IF                                                     DTSBD590
00422      END-IF.                                                      DTSBD590
00423                                                                   DTSBD590
00424      IF XFAQ-EMP-NO = WRK-FA-EMP-NO AND XFAQ-EMP-NO > ZEROS       DTSBD590
00425       IF XFAQ-FISCAL-AGENT-CD   NOT = WRK-FA-CD                   DTSBD590
00426 *        MOVE WRK-XFAQ-KEY-AREA           TO XFAQ-KEY-AREA        DTSBD590
00427          MOVE 'DUPLICATE EMP-NO WITH OTHER FISCAL AGENT' TO       DTSBD590
00428                  WRK-MESSAGE                                      DTSBD590
00429          PERFORM P4000-FAERROR-OUTPUT     THRU P4000-EXIT         DTSBD590
00430          MOVE CURR-XFAQ-KEY-AREA          TO WRK-XFAQ-KEY-AREA    DTSBD590
00431          ADD 1 TO WRK-FA-DUP-CNT                                  DTSBD590
00432          SET WRK-FA-DUP-REC-YES-88 TO TRUE                        DTSBD590
00433          GO TO P0000-EXIT                                         DTSBD590
00434        END-IF                                                     DTSBD590
00435      END-IF.                                                      DTSBD590
00436                                                                   DTSBD590
00437  P0000-PROCESS-CONTINUE.                                          DTSBD590
00438                                                                   DTSBD590
00439      IF WRK-FA-DUP-REC-YES-88                                     DTSBD590
00440         MOVE 'DUPLICATE INPUT REC WITH OTHER FISC-AGNT' TO        DTSBD590
00441                 WRK-MESSAGE                                       DTSBD590
00442         PERFORM P4000-FAERROR-OUTPUT THRU P4000-EXIT              DTSBD590
00443         MOVE CURR-XFAQ-KEY-AREA TO WRK-XFAQ-KEY-AREA              DTSBD590
00444         ADD 1 TO WRK-FA-DUP-CNT                                   DTSBD590
00445         SET WRK-FA-DUP-REC-NO-88 TO TRUE                          DTSBD590
00446         GO TO P0000-EXIT.                                         DTSBD590
00447                                                                   DTSBD590
00448      PERFORM P1000-FIND-ACCT-NUM THRU P1000-EXIT.                 DTSBD590
00449      IF WRK-EMP-NO NOT = ZERO                                     DTSBD590
00450         ADD +1 TO WRK-FA-ACCT-CNT                                 DTSBD590
00451         PERFORM P3000-BUILD-OUTPUT THRU P3000-EXIT                DTSBD590
00452      ELSE                                                         DTSBD590
00453         PERFORM P2000-FIND-FEIN-NUM THRU P2000-EXIT               DTSBD590
00454         IF WRK-EMP-NO NOT = ZERO                                  DTSBD590
00455            ADD +1 TO WRK-FA-FEIN-CNT                              DTSBD590
00456            PERFORM P3000-BUILD-OUTPUT THRU P3000-EXIT             DTSBD590
00457 *RW1                                                              DTSBD590
00458            MOVE 'PLEASE UPDATE YOUR ACCOUNT # USING FEIN'         DTSBD590
00459                  TO WRK-MESSAGE                                   DTSBD590
00460 *RW2                                                              DTSBD590
00461            PERFORM P4070-FEIN-ACCT    THRU P4070-EXIT             DTSBD590
00462         ELSE                                                      DTSBD590
00463            MOVE 'EMPLOYER NOT ON FILE' TO WRK-MESSAGE             DTSBD590
00464            PERFORM P4000-FAERROR-OUTPUT THRU P4000-EXIT           DTSBD590
00465         END-IF                                                    DTSBD590
00466      END-IF.                                                      DTSBD590
00467                                                                   DTSBD590
00468         MOVE CURR-XFAQ-KEY-AREA TO WRK-XFAQ-KEY-AREA.             DTSBD590
00469                                                                   DTSBD590
00470  P0000-EXIT.                                                      DTSBD590
00471      EXIT.                                                        DTSBD590
00472      EJECT                                                        DTSBD590
00473  P1000-FIND-ACCT-NUM.                                             DTSBD590
00474      PERFORM P1100-EDIT-EMP-NO THRU P1100-EXIT.                   DTSBD590
00475                                                                   DTSBD590
00476      IF WRK-EMP-NO-INVALID-88                                     DTSBD590
00477         GO TO P1000-EXIT.                                         DTSBD590
00478                                                                   DTSBD590
00479      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSBD590
00480      MOVE WRK-EMP-NO TO MSKL-EMP-NO.                              DTSBD590
00481      SET MSKL-PRF-88 TO TRUE.                                     DTSBD590
00482                                                                   DTSBD590
00483      PERFORM S910-READ      THRU S910-EXIT.                       DTSBD590
00484      IF NOT L910-OK-88                                            DTSBD590
00485         SET WRK-EMP-NO-INVALID-88 TO TRUE                         DTSBD590
00486         GO TO P1000-EXIT.                                         DTSBD590
00487                                                                   DTSBD590
00488      MOVE MSKL-REC TO MPRF-REC.                                   DTSBD590
00489                                                                   DTSBD590
00490      MOVE MPRF-EMP-NO  TO WRK-EMP-NO.                             DTSBD590
00491                                                                   DTSBD590
00492  P1000-EXIT.                                                      DTSBD590
00493      EXIT.                                                        DTSBD590
00494                                                                   DTSBD590
00495  P1100-EDIT-EMP-NO.                                               DTSBD590
00496        SET WRK-EMP-NO-INVALID-88 TO TRUE.                         DTSBD590
00497                                                                   DTSBD590
00498      IF WRK-FA-EMP-NO NUMERIC                                     DTSBD590
00499         IF WRK-FA-EMP-NO > ZERO                                   DTSBD590
00500            MOVE WRK-FA-EMP-NO TO WRK-EMP-NO                       DTSBD590
00501         ELSE                                                      DTSBD590
00502            SET WRK-EMP-NO-INVALID-88 TO TRUE                      DTSBD590
00503      ELSE                                                         DTSBD590
00504         SET WRK-EMP-NO-INVALID-88 TO TRUE.                        DTSBD590
00505                                                                   DTSBD590
00506  P1100-EXIT.                                                      DTSBD590
00507      EXIT.                                                        DTSBD590
00508                                                                   DTSBD590
00509  P2000-FIND-FEIN-NUM.                                             DTSBD590
00510      PERFORM P2100-EDIT-FEIN-NO THRU P2100-EXIT.                  DTSBD590
00511                                                                   DTSBD590
00512      IF  WRK-FEIN-NO-INVALID-88                                   DTSBD590
00513          SET WRK-EMP-NO-INVALID-88 TO TRUE                        DTSBD590
00514         GO TO P2000-EXIT.                                         DTSBD590
00515                                                                   DTSBD590
00516                                                                   DTSBD590
00517      MOVE ZEROS TO WRK-LIAB-DATE                                  DTSBD590
00518                    WRK-LIAB-EMP-NO                                DTSBD590
00519                    WRK-IEIN-EMP-NO.                               DTSBD590
00520                                                                   DTSBD590
00521      MOVE LOW-VALUE   TO IEIN-KEY-AREA.                           DTSBD590
00522      SET IEIN-EIN-88  TO TRUE.                                    DTSBD590
00523      MOVE WRK-FEIN-NO TO IEIN-FEIN.                               DTSBD590
00524      MOVE +0 TO IEIN-EMP-NO.                                      DTSBD590
00525      MOVE IEIN-KEY-AREA TO ISKL-KEY-AREA.                         DTSBD590
00526      PERFORM S921-START-BROWSE THRU S921-EXIT.                    DTSBD590
00527                                                                   DTSBD590
00528      MOVE ISKL-REC TO IEIN-REC.                                   DTSBD590
00529      IF L921-NO-REC-88 OR                                         DTSBD590
00530         IEIN-FEIN NOT = WRK-FEIN-NO                               DTSBD590
00531         MOVE ZEROS    TO WRK-FEIN-NO                              DTSBD590
00532         SET WRK-FEIN-NO-INVALID-88 TO TRUE                        DTSBD590
00533         SET WRK-EMP-NO-INVALID-88  TO TRUE                        DTSBD590
00534      ELSE                                                         DTSBD590
00535        PERFORM P2200-FEIN-BROWSE THRU P2200-EXIT                  DTSBD590
00536                  UNTIL L921-NO-REC-88 OR                          DTSBD590
00537                  IEIN-FEIN NOT = WRK-FEIN-NO OR                   DTSBD590
00538                 WRK-EMP-NO NOT = ZERO.                            DTSBD590
00539                                                                   DTSBD590
00540  P2000-EXIT.                                                      DTSBD590
00541      EXIT.                                                        DTSBD590
00542                                                                   DTSBD590
00543  P2100-EDIT-FEIN-NO.                                              DTSBD590
00544      MOVE ZEROS  TO WRK-FEIN-NO.                                  DTSBD590
00545                                                                   DTSBD590
00546      IF WRK-FA-FEIN-NO NUMERIC                                    DTSBD590
00547         IF WRK-FA-FEIN-NO > ZERO                                  DTSBD590
00548            MOVE WRK-FA-FEIN-NO TO WRK-FEIN-NO                     DTSBD590
00549         ELSE                                                      DTSBD590
00550           SET WRK-FEIN-NO-INVALID-88 TO TRUE                      DTSBD590
00551      ELSE                                                         DTSBD590
00552         SET WRK-FEIN-NO-INVALID-88 TO TRUE.                       DTSBD590
00553                                                                   DTSBD590
00554  P2100-EXIT.                                                      DTSBD590
00555      EXIT.                                                        DTSBD590
00556                                                                   DTSBD590
00557  P2200-FEIN-BROWSE.                                               DTSBD590
00558      MOVE ZEROS  TO WRK-EMP-NO.                                   DTSBD590
00559      MOVE IEIN-EMP-NO TO WRK-IEIN-EMP-NO.                         DTSBD590
00560      PERFORM P2210-READ-MPRF THRU P2210-EXIT.                     DTSBD590
00561                                                                   DTSBD590
00562      IF WRK-EMP-NO NOT = ZERO                                     DTSBD590
00563          GO TO P2200-EXIT.                                        DTSBD590
00564                                                                   DTSBD590
00565      PERFORM S921-READ-NEXT THRU S921-EXIT.                       DTSBD590
00566                                                                   DTSBD590
00567      IF L910-NO-REC-88                                            DTSBD590
00568          GO TO P2200-EXIT.                                        DTSBD590
00569                                                                   DTSBD590
00570      MOVE ISKL-REC TO IEIN-REC.                                   DTSBD590
00571  P2200-EXIT.                                                      DTSBD590
00572      EXIT.                                                        DTSBD590
00573      EJECT                                                        DTSBD590
00574                                                                   DTSBD590
00575  P2210-READ-MPRF.                                                 DTSBD590
00576      MOVE LOW-VALUE TO MSKL-KEY-AREA.                             DTSBD590
00577                                                                   DTSBD590
00578      MOVE WRK-IEIN-EMP-NO TO MSKL-EMP-NO.                         DTSBD590
00579                                                                   DTSBD590
00580      SET MSKL-PRF-88 TO TRUE.                                     DTSBD590
00581                                                                   DTSBD590
00582      PERFORM S910-READ THRU S910-EXIT.                            DTSBD590
00583                                                                   DTSBD590
00584      IF L910-NO-REC-88                                            DTSBD590
00585          GO TO P2210-EXIT.                                        DTSBD590
00586                                                                   DTSBD590
00587      MOVE MSKL-REC TO MPRF-REC.                                   DTSBD590
00588                                                                   DTSBD590
00589 ***  END THE SEARCH WITH THE FIRST IEIN RECORD WHERE THE          DTSBD590
00590 ***  EMPLOYER IS ACTIVE.  THERE IS ONLY ONE ACTIVE ACCOUNT        DTSBD590
00591 ***  FOR A GIVEN FEIN.                                            DTSBD590
00592                                                                   DTSBD590
00593      IF MPRF-STATUS-ACT-88                                        DTSBD590
00594         MOVE MPRF-EMP-NO  TO WRK-EMP-NO                           DTSBD590
00595      ELSE                                                         DTSBD590
00596         SET WRK-EMP-NO-INVALID-88 TO TRUE.                        DTSBD590
00597                                                                   DTSBD590
00598                                                                   DTSBD590
00599  P2210-EXIT.                                                      DTSBD590
00600      EXIT.                                                        DTSBD590
00601                                                                   DTSBD590
00602  P3000-BUILD-OUTPUT.                                              DTSBD590
00603      PERFORM P3100-EDIT-MPRF THRU P3100-EXIT.                     DTSBD590
00604      IF WRK-EMP-NO-INVALID-88                                     DTSBD590
00605         GO TO P3000-EXIT.                                         DTSBD590
00606                                                                   DTSBD590
00607      MOVE MPRF-FEIN        TO WRK-MPRF-FEIN-NO.                   DTSBD590
00608                                                                   DTSBD590
00609      IF WRK-MPRF-FEIN-NO > 0  AND WRK-FA-FEIN-NO > 0              DTSBD590
00610         IF WRK-MPRF-FEIN-NO NOT = WRK-FA-FEIN-NO                  DTSBD590
00611 *RW1                                                              DTSBD590
00612            MOVE 'PLEASE UPDATE YOUR FEIN USING ACCOUNT #'         DTSBD590
00613                  TO WRK-MESSAGE                                   DTSBD590
00614            PERFORM P4070-FEIN-ACCT      THRU P4070-EXIT           DTSBD590
00615 *RW2                                                              DTSBD590
00616         END-IF                                                    DTSBD590
00617      ELSE                                                         DTSBD590
00618        IF WRK-EMP-NO > 0  AND WRK-FA-EMP-NO > 0                   DTSBD590
00619           IF WRK-EMP-NO NOT = WRK-FA-EMP-NO                       DTSBD590
00620              MOVE 'ACCT# NOT ON FILE  ' TO WRK-MESSAGE            DTSBD590
00621              PERFORM P4050-DCERROR-OUTPUT THRU P4050-EXIT         DTSBD590
00622           END-IF                                                  DTSBD590
00623        END-IF                                                     DTSBD590
00624      END-IF.                                                      DTSBD590
00625                                                                   DTSBD590
00626      PERFORM P3210-VALIDATE-FISC-AGENT  THRU P3210-EXIT.          DTSBD590
00627                                                                   DTSBD590
00628      PERFORM P3300-FORMAT-OUTPUT        THRU P3300-EXIT.          DTSBD590
00629                                                                   DTSBD590
00630      PERFORM P3310-BUILD-MFAE           THRU P3310-EXIT.          DTSBD590
00631                                                                   DTSBD590
00632      PERFORM S952-WRITE-590-FILE        THRU S952-EXIT.           DTSBD590
00633        ADD +1 TO WRK-FA-WRITE-CNT.                                DTSBD590
00634                                                                   DTSBD590
00635  P3000-EXIT.                                                      DTSBD590
00636      EXIT.                                                        DTSBD590
00637                                                                   DTSBD590
00638  P3100-EDIT-MPRF.                                                 DTSBD590
00639      MOVE LOW-VALUE TO MSKL-KEY-AREA.                             DTSBD590
00640                                                                   DTSBD590
00641      MOVE WRK-EMP-NO TO MSKL-EMP-NO.                              DTSBD590
00642                                                                   DTSBD590
00643      SET MSKL-PRF-88 TO TRUE.                                     DTSBD590
00644                                                                   DTSBD590
00645      PERFORM S910-READ THRU S910-EXIT.                            DTSBD590
00646                                                                   DTSBD590
00647      IF L910-NO-REC-88                                            DTSBD590
00648         SET WRK-EMP-NO-INVALID-88 TO TRUE                         DTSBD590
00649         GO TO P3100-EXIT                                          DTSBD590
00650      END-IF.                                                      DTSBD590
00651                                                                   DTSBD590
00652      MOVE MSKL-REC TO MPRF-REC.                                   DTSBD590
00653                                                                   DTSBD590
00654      IF MPRF-CLASS-SELF-INS-88                                    DTSBD590
00655         MOVE '  ***  SELF INSURED ACCT   ' TO WRK-MESSAGE         DTSBD590
00656         PERFORM P4050-DCERROR-OUTPUT THRU P4050-EXIT              DTSBD590
00657         SET WRK-EMP-NO-INVALID-88 TO TRUE                         DTSBD590
00658         GO TO P3100-EXIT                                          DTSBD590
00659      END-IF.                                                      DTSBD590
00660                                                                   DTSBD590
00661      IF MPRF-STATUS-NEVERSUB-88                                   DTSBD590
00662         MOVE 'ACCT IS NEVER SUBJECT  ' TO WRK-MESSAGE             DTSBD590
00663         PERFORM P4050-DCERROR-OUTPUT THRU P4050-EXIT              DTSBD590
00664         SET WRK-EMP-NO-INVALID-88 TO TRUE                         DTSBD590
00665         GO TO P3100-EXIT                                          DTSBD590
00666      END-IF.                                                      DTSBD590
00667                                                                   DTSBD590
00668      MOVE MPRF-EMP-NO      TO L600-EMP-NO.                        DTSBD590
00669      PERFORM S600-SUCCESSOR THRU S600-EXIT.                       DTSBD590
00670      IF L600-SUCCESSOR-FOUND-88                                   DTSBD590
00671         MOVE 'ACCT SUCCEEDED    ' TO WRK-MESSAGE                  DTSBD590
00672         PERFORM P4050-DCERROR-OUTPUT THRU P4050-EXIT              DTSBD590
00673         SET WRK-EMP-NO-INVALID-88 TO TRUE                         DTSBD590
00674         GO TO P3100-EXIT                                          DTSBD590
00675      END-IF.                                                      DTSBD590
00676                                                                   DTSBD590
00677      IF MPRF-STATUS-INACT-88                                      DTSBD590
00678         MOVE 'ACCT IS INACTIVE       ' TO WRK-MESSAGE             DTSBD590
00679         PERFORM P4050-DCERROR-OUTPUT THRU P4050-EXIT              DTSBD590
00680         SET WRK-EMP-NO-INVALID-88 TO TRUE                         DTSBD590
00681         GO TO P3100-EXIT                                          DTSBD590
00682      END-IF.                                                      DTSBD590
00683                                                                   DTSBD590
00684 *    MOVE WRK-RATE-YRQ     TO L516-YRQ.                           DTSBD590
00685      MOVE WRK-YRQ          TO L516-YRQ.                           DTSBD590
00686      PERFORM S516-DETERMINE-LIABILITY THRU S516-EXIT.             DTSBD590
00687      IF L516-NOT-LIABLE-88                                        DTSBD590
00688         MOVE 'ACCT NOT LIABLE     ' TO WRK-MESSAGE                DTSBD590
00689         PERFORM P4050-DCERROR-OUTPUT THRU P4050-EXIT              DTSBD590
00690         SET WRK-EMP-NO-INVALID-88 TO TRUE                         DTSBD590
00691         GO TO P3100-EXIT                                          DTSBD590
00692      ELSE                                                         DTSBD590
00693         IF L516-ESTIMATED-RATE-88                                 DTSBD590
00694            ADD +1 TO WRK-ESTIM-RATE-CNT                           DTSBD590
00695            DISPLAY '*** >> ESTIMATED RATE FOUND: ' MPRF-EMP-NO    DTSBD590
00696            MOVE 'ESTIMATED RATE ' TO WRK-MESSAGE                  DTSBD590
00697            PERFORM P4050-DCERROR-OUTPUT THRU P4050-EXIT           DTSBD590
00698            SET WRK-EMP-NO-INVALID-88 TO TRUE                      DTSBD590
00699            GO TO P3100-EXIT                                       DTSBD590
00700         ELSE                                                      DTSBD590
00701            IF L516-NO-RATE-88                                     DTSBD590
00702               MOVE 'NO RATE ASSIGNED ' TO WRK-MESSAGE             DTSBD590
00703               PERFORM P4050-DCERROR-OUTPUT THRU P4050-EXIT        DTSBD590
00704               SET WRK-EMP-NO-INVALID-88 TO TRUE                   DTSBD590
00705               GO TO P3100-EXIT                                    DTSBD590
00706            END-IF                                                 DTSBD590
00707         END-IF                                                    DTSBD590
00708      END-IF.                                                      DTSBD590
00709                                                                   DTSBD590
00710 ******************************************************            DTSBD590
00711 **   SURTAX OF .002 ADDED TO COMPUTE STATEMENT ON 1/10/06 GB      DTSBD590
00712 **   SURTAX OF .002 NOT ADDED FOR PAYCHEX      ON 1/10/06 GB      DTSBD590
00713                                                                   DTSBD590
00714      DISPLAY ' FISCAL-AGENT-CD ' XFAQ-FISCAL-AGENT-CD             DTSBD590
00715                                                                   DTSBD590
00716      IF XFAQ-FISCAL-AGENT-CD = 'PC '                              DTSBD590
00717         COMPUTE WRK-UI-RATE = L516-UI-RATE * 100                  DTSBD590
00718      DISPLAY '7031PAY FISCAL-AGENT-CD ' XFAQ-FISCAL-AGENT-CD      DTSBD590
00719      GO TO P3100-EXIT.                                            DTSBD590
00720                                                                   DTSBD590
00721      IF XFAQ-FISCAL-AGENT-CD = 'PP '                              DTSBD590
00722         COMPUTE WRK-UI-RATE = L516-UI-RATE * 100                  DTSBD590
00723      DISPLAY '7031PAY FISCAL-AGENT-CD ' XFAQ-FISCAL-AGENT-CD      DTSBD590
00724      GO TO P3100-EXIT.                                            DTSBD590
00725                                                                   DTSBD590
00726      DISPLAY '7035 FISCAL-AGENT-CD ' XFAQ-FISCAL-AGENT-CD         DTSBD590
00727      COMPUTE WRK-UI-RATE = (L516-UI-RATE + .002) * 100.           DTSBD590
00728                                                                   DTSBD590
00729  P3100-EXIT.                                                      DTSBD590
00730      EXIT.                                                        DTSBD590
00731                                                                   DTSBD590
00732 *P3200-FIND-MRTE.                                                 DTSBD590
00733 *    MOVE ZERO        TO WRK-UI-RATE.                             DTSBD590
00734 *                                                                 DTSBD590
00735 *    MOVE LOW-VALUES  TO MRTE-KEY-AREA.                           DTSBD590
00736 *    MOVE MPRF-EMP-NO TO MRTE-EMP-NO.                             DTSBD590
00737 *    SET MRTE-RTE-88   TO TRUE.                                   DTSBD590
00738 *    MOVE WRK-RATE-YRQ TO MRTE-EFF-YRQ.                           DTSBD590
00739 *                                                                 DTSBD590
00740 *    MOVE MRTE-KEY-AREA TO MSKL-KEY-AREA.                         DTSBD590
00741 *    PERFORM S910-READ         THRU S910-EXIT.                    DTSBD590
00742 *                                                                 DTSBD590
00743 *    IF L910-NO-REC-88                                            DTSBD590
00744 *       SET WRK-UI-RATE-NOT-OK-88   TO TRUE                       DTSBD590
00745 *       MOVE 'NO RATE ASSIGNED    ' TO WRK-MESSAGE                DTSBD590
00746 *       PERFORM P4050-DCERROR-OUTPUT THRU P4050-EXIT              DTSBD590
00747 *       GO TO P3200-EXIT.                                         DTSBD590
00748 *                                                                 DTSBD590
00749 *    MOVE MSKL-REC TO MRTE-REC.                                   DTSBD590
00750 *                                                                 DTSBD590
00751 *    IF  MRTE-RATE-TYPE-ESTIM-88                                  DTSBD590
00752 *       ADD +1 TO WRK-ESTIM-RATE-CNT                              DTSBD590
00753 *       DISPLAY '*** >> ESTIMATED RATE FOUND: ' MPRF-EMP-NO.      DTSBD590
00754 *                                                                 DTSBD590
00755 *    IF  MRTE-UI-RATE > 0                                         DTSBD590
00756 *      COMPUTE WRK-UI-RATE = (MRTE-UI-RATE + .002) * 100          DTSBD590
00757 *    ELSE                                                         DTSBD590
00758 *       SET WRK-UI-RATE-NOT-OK-88   TO TRUE                       DTSBD590
00759 *       MOVE 'NO RATE ASSIGNED    ' TO WRK-MESSAGE                DTSBD590
00760 *       PERFORM P4050-DCERROR-OUTPUT THRU P4050-EXIT              DTSBD590
00761 *       GO TO P3200-EXIT.                                         DTSBD590
00762 *                                                                 DTSBD590
00763 *P3200-EXIT.                                                      DTSBD590
00764 *    EXIT.                                                        DTSBD590
00765                                                                   DTSBD590
00766  P3210-VALIDATE-FISC-AGENT.                                       DTSBD590
00767                                                                   DTSBD590
00768      SET WRK-FISC-AGNT-INVALID-88 TO TRUE                         DTSBD590
00769                                                                   DTSBD590
00770      PERFORM VARYING FISCAL-AGENT-IDX FROM 1 BY 1                 DTSBD590
00771         UNTIL WRK-FISC-AGNT-VALID-88                              DTSBD590
00772            OR FISCAL-AGENT-IDX > FISCAL-AGENT-CNT                 DTSBD590
00773            OR FISCAL-AGENT-CODE (FISCAL-AGENT-IDX)                DTSBD590
00774                                = SPACE                            DTSBD590
00775              IF WRK-FA-CD = FISCAL-AGENT-CODE (FISCAL-AGENT-IDX)  DTSBD590
00776                 SET WRK-FISC-AGNT-VALID-88 TO TRUE                DTSBD590
00777                 MOVE FISCAL-AGENT-CODE (FISCAL-AGENT-IDX)         DTSBD590
00778                   TO WRK-FISCAL-AGENT-CD                          DTSBD590
00779              END-IF                                               DTSBD590
00780      END-PERFORM.                                                 DTSBD590
00781                                                                   DTSBD590
00782      IF WRK-FISC-AGNT-INVALID-88                                  DTSBD590
00783         MOVE 'INVALID FISCAL AGENT' TO WRK-MESSAGE                DTSBD590
00784         PERFORM P4050-DCERROR-OUTPUT THRU P4050-EXIT              DTSBD590
00785         SET WRK-EMP-NO-INVALID-88 TO TRUE                         DTSBD590
00786         GO TO P3210-EXIT.                                         DTSBD590
00787                                                                   DTSBD590
00788  P3210-EXIT.                                                      DTSBD590
00789        EXIT.                                                      DTSBD590
00790                                                                   DTSBD590
00791  P3300-FORMAT-OUTPUT.                                             DTSBD590
00792      SET R590-UPDATE-88        TO TRUE.                           DTSBD590
00793      MOVE MPRF-EMP-NO          TO R590-EMP-NO.                    DTSBD590
00794                                                                   DTSBD590
00795      IF MPRF-FEIN = ZEROS                                         DTSBD590
00796         MOVE WRK-FA-FEIN-NO    TO R590-EMP-FEIN                   DTSBD590
00797      ELSE                                                         DTSBD590
00798         MOVE MPRF-FEIN         TO R590-EMP-FEIN.                  DTSBD590
00799                                                                   DTSBD590
00800      MOVE MPRF-PRIMARY-NAME    TO R590-EMP-NAME.                  DTSBD590
00801      MOVE MPRF-ENTITY-NAME     TO R590-EMP-NAME-A.                DTSBD590
00802      MOVE MPRF-SIC-CD          TO R590-SIC-CODE.                  DTSBD590
00803      MOVE MPRF-EMP-STATUS      TO R590-EMP-STATUS-CODE.           DTSBD590
00804                                                                   DTSBD590
00805      DISPLAY 'MPRF-EMP-NO '   MPRF-EMP-NO.                        DTSBD590
00806      DISPLAY 'AGENT CODE  '   XFAQ-FISCAL-AGENT-CD                DTSBD590
00807      DISPLAY 'L516-UI-RATE'   L516-UI-RATE.                       DTSBD590
00808      DISPLAY 'WRK-UI-RATE '   WRK-UI-RATE.                        DTSBD590
00809                                                                   DTSBD590
00810      MOVE WRK-UI-RATE          TO R590-EMP-CONTR-RATE.            DTSBD590
00811                                                                   DTSBD590
00812      MOVE WRK-FISCAL-AGENT-CD  TO R590-FISCAL-AGENT-CD.           DTSBD590
00813      MOVE SPACES               TO WRK-MESSAGE.                    DTSBD590
00814      MOVE WRK-MESSAGE          TO R590-MESSAGE.                   DTSBD590
00815  P3300-EXIT.                                                      DTSBD590
00816      EXIT.                                                        DTSBD590
00817                                                                   DTSBD590
00818  P3310-BUILD-MFAE.                                                DTSBD590
00819                                                                   DTSBD590
00820      PERFORM P3320-DUP-MFAE-CHECK THRU P3320-EXIT.                DTSBD590
00821                                                                   DTSBD590
00822      IF WRK-FAE-YES-DUP-88                                        DTSBD590
00823         GO TO P3310-EXIT.                                         DTSBD590
00824                                                                   DTSBD590
00825      INITIALIZE MFAE-REC.                                         DTSBD590
00826                                                                   DTSBD590
00827      MOVE MPRF-EMP-NO          TO MFAE-EMP-NO.                    DTSBD590
00828      SET  MFAE-FAE-88          TO TRUE.                           DTSBD590
00829      SET  MFAE-SERVICE-UC30-88 TO TRUE.                           DTSBD590
00830      MOVE ZEROS                TO MFAE-PURGE-DATE.                DTSBD590
00831      MOVE WRK-FISCAL-AGENT-CD  TO MFAE-FISCAL-AGENT-CD.           DTSBD590
00832      SET  MFAE-NOT-CONVERTED-88 TO TRUE.                          DTSBD590
00833      MOVE MHDR-CURR-RUN-DATE   TO MFAE-ESTB-DATE                  DTSBD590
00834                                   MFAE-CHNG-DATE.                 DTSBD590
00835      MOVE MFAE-REC             TO MSKL-REC.                       DTSBD590
00836                                                                   DTSBD590
00837                                                                   DTSBD590
00838      PERFORM S910-WRITE     THRU S910-EXIT.                       DTSBD590
00839                                                                   DTSBD590
00840      ADD +1 TO WRK-MFAE-ADDED-CNT.                                DTSBD590
00841                                                                   DTSBD590
00842  P3310-EXIT.                                                      DTSBD590
00843      EXIT.                                                        DTSBD590
00844                                                                   DTSBD590
00845  P3320-DUP-MFAE-CHECK.                                            DTSBD590
00846                                                                   DTSBD590
00847      SET WRK-FAE-NO-DUP-88 TO TRUE.                               DTSBD590
00848                                                                   DTSBD590
00849      MOVE LOW-VALUES  TO MFAE-KEY-AREA.                           DTSBD590
00850      MOVE MPRF-EMP-NO TO MFAE-EMP-NO.                             DTSBD590
00851      SET MFAE-FAE-88  TO TRUE.                                    DTSBD590
00852      SET  MFAE-SERVICE-UC30-88 TO TRUE.                           DTSBD590
00853      MOVE MFAE-KEY-AREA TO MSKL-KEY-AREA.                         DTSBD590
00854                                                                   DTSBD590
00855      PERFORM S910-START-BROWSE THRU S910-EXIT.                    DTSBD590
00856                                                                   DTSBD590
00857      IF L910-NO-REC-88                                            DTSBD590
00858         GO TO P3320-EXIT                                          DTSBD590
00859      END-IF.                                                      DTSBD590
00860                                                                   DTSBD590
00861      MOVE MSKL-REC  TO MFAE-REC.                                  DTSBD590
00862                                                                   DTSBD590
00863      IF MFAE-SERVICE-UC30-88                                      DTSBD590
00864         SET WRK-FAE-YES-DUP-88 TO TRUE                            DTSBD590
00865      END-IF.                                                      DTSBD590
00866                                                                   DTSBD590
00867  P3320-EXIT.                                                      DTSBD590
00868      EXIT.                                                        DTSBD590
00869                                                                   DTSBD590
00870  P4000-FAERROR-OUTPUT.                                            DTSBD590
00871                                                                   DTSBD590
00872       SET R590-ERROR-88      TO TRUE.                             DTSBD590
00873       MOVE WRK-FA-CD         TO R590-FISCAL-AGENT-CD.             DTSBD590
00874       MOVE SPACES            TO R590-FIL1.                        DTSBD590
00875       MOVE WRK-FA-EMP-NO     TO R590-EMP-NO.                      DTSBD590
00876       MOVE WRK-FA-FEIN-NO    TO R590-EMP-FEIN.                    DTSBD590
00877       MOVE SPACES            TO R590-EMP-NAME.                    DTSBD590
00878       MOVE SPACES            TO R590-EMP-NAME-A.                  DTSBD590
00879       MOVE ZEROS             TO R590-EMP-CONTR-RATE.              DTSBD590
00880       MOVE ZEROS             TO R590-SIC-CODE.                    DTSBD590
00881       MOVE SPACES            TO R590-EMP-STATUS-CODE.             DTSBD590
00882       MOVE WRK-MESSAGE       TO R590-MESSAGE.                     DTSBD590
00883                                                                   DTSBD590
00884      PERFORM S952-WRITE-590-FILE THRU S952-EXIT.                  DTSBD590
00885        ADD +1 TO WRK-FE-WRITE-CNT.                                DTSBD590
00886                                                                   DTSBD590
00887  P4000-EXIT.                                                      DTSBD590
00888      EXIT.                                                        DTSBD590
00889  P4050-DCERROR-OUTPUT.                                            DTSBD590
00890                                                                   DTSBD590
00891       SET R590-ERROR-88  TO TRUE.                                 DTSBD590
00892       MOVE SPACES            TO R590-FIL1.                        DTSBD590
00893       MOVE WRK-FA-CD         TO R590-FISCAL-AGENT-CD.             DTSBD590
00894       MOVE WRK-EMP-NO        TO R590-EMP-NO.                      DTSBD590
00895 *     MOVE WRK-FEIN-NO       TO R590-EMP-FEIN.                    DTSBD590
00896 *RW1                                                              DTSBD590
00897       IF MPRF-EMP-STATUS = 'A' OR 'I' OR 'N' OR 'U'               DTSBD590
00898          MOVE MPRF-FEIN         TO R590-EMP-FEIN                  DTSBD590
00899      ELSE                                                         DTSBD590
00900          MOVE WRK-XFAQ-EMP-FEIN TO R590-EMP-FEIN.                 DTSBD590
00901 *RW2                                                              DTSBD590
00902       MOVE ZEROS             TO R590-EMP-CONTR-RATE.              DTSBD590
00903       MOVE MPRF-PRIMARY-NAME TO R590-EMP-NAME.                    DTSBD590
00904       MOVE SPACES            TO R590-EMP-NAME-A.                  DTSBD590
00905       MOVE MPRF-SIC-CD       TO R590-SIC-CODE.                    DTSBD590
00906       MOVE MPRF-EMP-STATUS   TO R590-EMP-STATUS-CODE.             DTSBD590
00907       MOVE WRK-MESSAGE       TO R590-MESSAGE.                     DTSBD590
00908       PERFORM S952-WRITE-590-FILE THRU S952-EXIT.                 DTSBD590
00909       ADD +1 TO WRK-FE-WRITE-CNT.                                 DTSBD590
00910                                                                   DTSBD590
00911  P4050-EXIT.                                                      DTSBD590
00912      EXIT.                                                        DTSBD590
00913  P4070-FEIN-ACCT.                                                 DTSBD590
00914                                                                   DTSBD590
00915       SET R590-FEIN-ACCT-88  TO TRUE.                             DTSBD590
00916       MOVE SPACES            TO R590-FIL1.                        DTSBD590
00917       MOVE WRK-FA-CD         TO R590-FISCAL-AGENT-CD.             DTSBD590
00918       MOVE MPRF-EMP-NO       TO R590-EMP-NO.                      DTSBD590
00919 *     MOVE WRK-FEIN-NO       TO R590-EMP-FEIN.                    DTSBD590
00920 *RW1                                                              DTSBD590
00921       MOVE MPRF-FEIN         TO R590-EMP-FEIN.                    DTSBD590
00922 *RW2                                                              DTSBD590
00923       MOVE ZEROS             TO R590-EMP-CONTR-RATE.              DTSBD590
00924       MOVE MPRF-PRIMARY-NAME TO R590-EMP-NAME.                    DTSBD590
00925       MOVE SPACES            TO R590-EMP-NAME-A.                  DTSBD590
00926       MOVE MPRF-SIC-CD       TO R590-SIC-CODE.                    DTSBD590
00927       MOVE MPRF-EMP-STATUS   TO R590-EMP-STATUS-CODE.             DTSBD590
00928       MOVE WRK-MESSAGE       TO R590-MESSAGE.                     DTSBD590
00929      PERFORM S952-WRITE-590-FILE THRU S952-EXIT.                  DTSBD590
00930        ADD +1 TO WRK-FN-FEIN-CNT.                                 DTSBD590
00931                                                                   DTSBD590
00932  P4070-EXIT.                                                      DTSBD590
00933      EXIT.                                                        DTSBD590
00934  T0000-TERMINATE.                                                 DTSBD590
00935                                                                   DTSBD590
00936      DISPLAY ' '.                                                 DTSBD590
00937                                                                   DTSBD590
00938      DISPLAY '*** DTSBD590 TERMINATION STATISTICS ***'.           DTSBD590
00939                                                                   DTSBD590
00940      DISPLAY ' '.                                                 DTSBD590
00941                                                                   DTSBD590
00942      IF WRK-ESTIM-RATE-CNT > ZERO                                 DTSBD590
00943         DISPLAY '**************************************'          DTSBD590
00944         DISPLAY '*                                    *'          DTSBD590
00945         DISPLAY '*    ESTIMATED RATES FOUND ' WRK-ESTIM-RATE-CNT  DTSBD590
00946         DISPLAY '*    DISCARD OUTPUT, CORRECT RATES   *'          DTSBD590
00947         DISPLAY '*    AND RERUN THIS JOB.             *'          DTSBD590
00948         DISPLAY '**************************************'.         DTSBD590
00949                                                                   DTSBD590
00950      DISPLAY 'NUMBER OF FISCAL AGENT RECORDS ENCOUNTERED:        'DTSBD590
00951              WRK-FA-READ-CNT.                                     DTSBD590
00952                                                                   DTSBD590
00953      DISPLAY 'NUMBER OF FISCAL AGENT RECORDS DUPLICATED :        'DTSBD590
00954              WRK-FA-DUP-CNT.                                      DTSBD590
00955                                                                   DTSBD590
00956      DISPLAY 'NUMBER OF FISCAL AGENT EMPLOYER ACCT FOUND:        'DTSBD590
00957              WRK-FA-ACCT-CNT.                                     DTSBD590
00958                                                                   DTSBD590
00959      DISPLAY 'NUMBER OF FISCAL AGENT EMPLOYER FEIN FOUND:        'DTSBD590
00960              WRK-FA-FEIN-CNT.                                     DTSBD590
00961                                                                   DTSBD590
00962      DISPLAY 'NUMBER OF MSTB-MFAE   RECORDS ADDED  :             'DTSBD590
00963              WRK-MFAE-ADDED-CNT.                                  DTSBD590
00964                                                                   DTSBD590
00965      DISPLAY 'NUMBER OF MSTB-MFAE   RECORDS DELETED:             'DTSBD590
00966              WRK-MFAE-DELETED-CNT.                                DTSBD590
00967                                                                   DTSBD590
00968      DISPLAY 'NUMBER OF MSTB-MFAE RECORDS DUPLICATE:             'DTSBD590
00969              WRK-MFAE-DUPL-CNT.                                   DTSBD590
00970                                                                   DTSBD590
00971      DISPLAY '        '.                                          DTSBD590
00972                                                                   DTSBD590
00973      DISPLAY 'NUMBER OF FISCAL AGENT OUTPUT RECORDS WRITTEN:     'DTSBD590
00974                                                                   DTSBD590
00975      DISPLAY 'NUMBER OF TYPE #3 RECORDS WRITTEN:                 'DTSBD590
00976              WRK-FN-FEIN-CNT.                                     DTSBD590
00977                                                                   DTSBD590
00978      DISPLAY 'NUMBER OF FA TAPE      RECORDS WRITTEN:            'DTSBD590
00979              WRK-FA-WRITE-CNT.                                    DTSBD590
00980                                                                   DTSBD590
00981      DISPLAY 'NUMBER OF FISCAL AGENT ERRORS RECORDS :            'DTSBD590
00982              WRK-FE-WRITE-CNT.                                    DTSBD590
00983                                                                   DTSBD590
00984                                                                   DTSBD590
00985      PERFORM S910-CLOSE THRU S910-EXIT.                           DTSBD590
00986      PERFORM S921-CLOSE THRU S921-EXIT.                           DTSBD590
00987      PERFORM S931-CLOSE THRU S931-EXIT.                           DTSBD590
00988                                                                   DTSBD590
00989      PERFORM S953-CLOSE-FA-FILE THRU S953-EXIT.                   DTSBD590
00990                                                                   DTSBD590
00991  T0000-EXIT.                                                      DTSBD590
00992      EXIT.                                                        DTSBD590
00993      EJECT                                                        DTSBD590
00994                                                                   DTSBD590
00995  S004-FROM-5.                                                     DTSBD590
00996      SET L004-FROM-5 TO TRUE.                                     DTSBD590
00997      GO TO S004-QTR.                                              DTSBD590
00998                                                                   DTSBD590
00999  S004-FROM-DATE.                                                  DTSBD590
01000      SET L004-FROM-DATE TO TRUE.                                  DTSBD590
01001      GO TO S004-QTR.                                              DTSBD590
01002                                                                   DTSBD590
01003  S004-QTR.                                                        DTSBD590
01004      CALL 'DTSBU004' USING L004-LINK-AREA.                        DTSBD590
01005                                                                   DTSBD590
01006  S004-EXIT.                                                       DTSBD590
01007      EXIT.                                                        DTSBD590
01008                                                                   DTSBD590
01009  S006-FROM-QTR.                                                   DTSBD590
01010      SET L006-FROM-QTR TO TRUE.                                   DTSBD590
01011      GO TO S006-UI-RATE-YEAR.                                     DTSBD590
01012                                                                   DTSBD590
01013  S006-UI-RATE-YEAR.                                               DTSBD590
01014      CALL 'DTSBU006' USING L006-LINK-AREA.                        DTSBD590
01015                                                                   DTSBD590
01016  S006-EXIT.                                                       DTSBD590
01017      EXIT.                                                        DTSBD590
01018                                                                   DTSBD590
01019  S516-DETERMINE-LIABILITY.                                        DTSBD590
01020      CALL 'DTSBU516' USING L516-LINK-AREA                         DTSBD590
01021                            MPRF-REC.                              DTSBD590
01022  S516-EXIT.                                                       DTSBD590
01023      EXIT.                                                        DTSBD590
01024                                                                   DTSBD590
01025  S600-SUCCESSOR.                                                  DTSBD590
01026      CALL 'DTSBU600' USING L600-LINK-AREA.                        DTSBD590
01027                                                                   DTSBD590
01028  S600-EXIT.                                                       DTSBD590
01029      EXIT.                                                        DTSBD590
01030                                                                   DTSBD590
01031  S910-OPEN-UPDATE-NO-AIX.                                         DTSBD590
01032      SET L910-OPEN-UPDATE-NO-AIX-88 TO TRUE.                      DTSBD590
01033      GO TO S910-MSTR-IO.                                          DTSBD590
01034                                                                   DTSBD590
01035  S910-READ.                                                       DTSBD590
01036      SET L910-READ-88 TO TRUE.                                    DTSBD590
01037      GO TO S910-MSTR-IO.                                          DTSBD590
01038                                                                   DTSBD590
01039  S910-DELETE.                                                     DTSBD590
01040      SET L910-DELETE-88 TO TRUE.                                  DTSBD590
01041      GO TO S910-MSTR-IO.                                          DTSBD590
01042                                                                   DTSBD590
01043  S910-WRITE.                                                      DTSBD590
01044      SET L910-WRITE-88 TO TRUE.                                   DTSBD590
01045      GO TO S910-MSTR-IO.                                          DTSBD590
01046                                                                   DTSBD590
01047  S910-START-BROWSE.                                               DTSBD590
01048      SET L910-START-BROWSE-88 TO TRUE.                            DTSBD590
01049      GO TO S910-MSTR-IO.                                          DTSBD590
01050                                                                   DTSBD590
01051  S910-READ-NEXT.                                                  DTSBD590
01052      SET L910-READ-NEXT-88 TO TRUE.                               DTSBD590
01053      GO TO S910-MSTR-IO.                                          DTSBD590
01054                                                                   DTSBD590
01055  S910-REWRITE.                                                    DTSBD590
01056      SET L910-REWRITE-88 TO TRUE.                                 DTSBD590
01057      GO TO S910-MSTR-IO.                                          DTSBD590
01058                                                                   DTSBD590
01059  S910-CLOSE.                                                      DTSBD590
01060      SET L910-CLOSE-88     TO TRUE.                               DTSBD590
01061      GO TO S910-MSTR-IO.                                          DTSBD590
01062                                                                   DTSBD590
01063  S910-MSTR-IO.                                                    DTSBD590
01064      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBD590
01065                            MSKL-REC.                              DTSBD590
01066  S910-EXIT.                                                       DTSBD590
01067      EXIT.                                                        DTSBD590
01068                                                                   DTSBD590
01069      SKIP3                                                        DTSBD590
01070  S921-OPEN-READ.                                                  DTSBD590
01071      SET L921-OPEN-READ-88 TO TRUE.                               DTSBD590
01072      GO TO S921-AIX-IO.                                           DTSBD590
01073                                                                   DTSBD590
01074  S921-READ.                                                       DTSBD590
01075      SET L921-READ-88 TO TRUE.                                    DTSBD590
01076      GO TO S921-AIX-IO.                                           DTSBD590
01077                                                                   DTSBD590
01078  S921-START-BROWSE.                                               DTSBD590
01079      SET L921-START-BROWSE-88 TO TRUE.                            DTSBD590
01080      GO TO S921-AIX-IO.                                           DTSBD590
01081                                                                   DTSBD590
01082  S921-READ-NEXT.                                                  DTSBD590
01083      SET L921-READ-NEXT-88 TO TRUE.                               DTSBD590
01084      GO TO S921-AIX-IO.                                           DTSBD590
01085                                                                   DTSBD590
01086  S921-CLOSE.                                                      DTSBD590
01087      SET L921-CLOSE-88 TO TRUE.                                   DTSBD590
01088      GO TO S921-AIX-IO.                                           DTSBD590
01089                                                                   DTSBD590
01090  S921-AIX-IO.                                                     DTSBD590
01091      CALL 'DTSBU921' USING L921-LINK-AREA                         DTSBD590
01092                            ISKL-REC.                              DTSBD590
01093  S921-EXIT.                                                       DTSBD590
01094      EXIT.                                                        DTSBD590
01095  S931-OPEN-READ.                                                  DTSBD590
01096      SET L931-OPEN-READ-88 TO TRUE.                               DTSBD590
01097      GO TO S931-REF-IO.                                           DTSBD590
01098                                                                   DTSBD590
01099  S931-OPEN-UPDATE.                                                DTSBD590
01100      SET L931-OPEN-UPDATE-88 TO TRUE.                             DTSBD590
01101      GO TO S931-REF-IO.                                           DTSBD590
01102                                                                   DTSBD590
01103  S931-READ.                                                       DTSBD590
01104      SET L931-READ-88 TO TRUE.                                    DTSBD590
01105      GO TO S931-REF-IO.                                           DTSBD590
01106                                                                   DTSBD590
01107  S931-CLOSE.                                                      DTSBD590
01108      SET L931-CLOSE-88 TO TRUE.                                   DTSBD590
01109      GO TO S931-REF-IO.                                           DTSBD590
01110                                                                   DTSBD590
01111  S931-REF-IO.                                                     DTSBD590
01112      CALL 'DTSBU931' USING L931-LINK-AREA                         DTSBD590
01113                            FSKL-REC.                              DTSBD590
01114  S931-EXIT.                                                       DTSBD590
01115      EXIT.                                                        DTSBD590
01116  S950-OPEN-FA-FILE.                                               DTSBD590
01117      OPEN INPUT FISCAL-AGENT-IFILE.                               DTSBD590
01118                                                                   DTSBD590
01119  S950-EXIT.                                                       DTSBD590
01120      EXIT.                                                        DTSBD590
01121                                                                   DTSBD590
01122  S951-READ-FA-FILE.                                               DTSBD590
01123       READ FISCAL-AGENT-IFILE INTO FISCAL-AGENT-INREC.            DTSBD590
01124       MOVE XFAQ-EMP-FEIN TO WRK-XFAQ-EMP-FEIN.                    DTSBD590
01125                                                                   DTSBD590
01126  S951-EXIT.                                                       DTSBD590
01127      EXIT.                                                        DTSBD590
01128                                                                   DTSBD590
01129  S952-WRITE-590-FILE.                                             DTSBD590
01130      CALL 'DTSBU946' USING R590-REC.                              DTSBD590
01131                                                                   DTSBD590
01132  S952-EXIT.                                                       DTSBD590
01133      EXIT.                                                        DTSBD590
01134                                                                   DTSBD590
01135  S953-CLOSE-FA-FILE.                                              DTSBD590
01136      CLOSE FISCAL-AGENT-IFILE.                                    DTSBD590
01137                                                                   DTSBD590
01138  S953-EXIT.                                                       DTSBD590
01139      EXIT.                                                        DTSBD590
01140                                                                   DTSBD590
01141                                                                   DTSBD590
01142      SKIP3                                                        DTSBD590
01143  S999-ABEND.                                                      DTSBD590
01144      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBD590
01145  S999-EXIT.                                                       DTSBD590
01146      EXIT.                                                        DTSBD590
