00001  IDENTIFICATION DIVISION.                                         10/29/19
00002  PROGRAM-ID.             DTSBD640.                                DTSBD640
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV003
00004  DATE-WRITTEN.           DECEMBER 1991.                           DTSBD640
00005  DATE-COMPILED.                                                   DTSBD640
00006      SKIP3                                                        DTSBD640
00007 *****                                                             DTSBD640
00008 *                                                                 DTSBD640
00009 *    FUNCTION:  PROCESS FUTA QUARTERLY ENTITY UPDATE TAPE.        DTSBD640
00010 *                                                                 DTSBD640
00011 *                                                                 DTSBD640
00012 *    MODIFICATION LOG:                                            DTSBD640
00013 *                                                                 DTSBD640
00014 *  02/17/1999  WRITTEN FOR DC.                                    DTSBD640
00015 *              REFERENCE: DC DEVELOPMENT        PROGRAMMER: EHH   DTSBD640
00016 *                                                                 DTSBD640
00017 *  10/07/2013  UPDATED TO CREATE POTENTIAL EMPLOYERS FROM         DTSBD640
00018 *              QUARTERLY IRS EIN FILE.                            DTSBD640
00019 *              REFERENCE: TICKET 2021           PROGRAMMER: GD    DTSBD640
00020 *                                                                 DTSBD640
00021 *  09/01/2019  UPDATED TO ADD NEW ELEMENTS FROM IRS QTRLY FUTA FILDTSBD640
00022 *              REFERENCE: TICKET ????           PROGRAMMER: ZL1   DTSBD640
00023 *                                                                 DTSBD640
00024 *  MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBD640
00025 *              XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBD640
00026 *              REFERENCE: XXXXXXXXXXXXXXX       PROGRAMMER: XXX   DTSBD640
00027 *                                                                 DTSBD640
00028 *                                                                 DTSBD640
00029 *  DESCRIPTION:                                                   DTSBD640
00030 *                                                                 DTSBD640
00031 *      DTSBD640 DOES THE QUARTERLY ENTITY UPDATE TAPE PROCESSING. DTSBD640
00032 *      SEE IRS DOCUMENT 6581 ("SPECIFICATIONS FOR THE NATIONWIDE  DTSBD640
00033 *      SYSTEM FOR COMPUTERIZED CERTIFICATION OF STATE FUTA        DTSBD640
00034 *      CREDITS") - SECTION 11.                                    DTSBD640
00035 *                                                                 DTSBD640
00036 *      READ THE IRS FUTA QUARTERLY ENTITY UPDATE TAPE.            DTSBD640
00037 *                                                                 DTSBD640
00038 *      FOR EACH RECORD ON THE IRS FUTA QUARTERLY ENTITY UPDATE    DTSBD640
00039 *      TAPE, IF NO DC UI TAX SYSTEM EMPLOYER WITH MPRF-FEIN       DTSBD640
00040 *      EQUAL TO QEUP-FEIN EXISTS, THEN WRITE A R793 RECORD.       DTSBD640
00041 *                                                                 DTSBD640
00042 *                                                                 DTSBD640
00043 *                                                                 DTSBD640
00044 *      PARAMETERS INPUT:                                          DTSBD640
00045 *                                                                 DTSBD640
00046 *        NONE.                                                    DTSBD640
00047 *                                                                 DTSBD640
00048 *                                                                 DTSBD640
00049 *      TAPES INPUT:                                               DTSBD640
00050 *                                                                 DTSBD640
00051 *        IRS FUTA QUARTERLY ENTITY UPDATE TAPE.                   DTSBD640
00052 *                                                                 DTSBD640
00053 *                                                                 DTSBD640
00054 *      MASTER FILE RECORDS READ:                                  DTSBD640
00055 *                                                                 DTSBD640
00056 *        MPRF                                                     DTSBD640
00057 *                                                                 DTSBD640
00058 *                                                                 DTSBD640
00059 *      ALTERNATE INDEX FILE RECORDS READ:                         DTSBD640
00060 *                                                                 DTSBD640
00061 *        IEIN                                                     DTSBD640
00062 *                                                                 DTSBD640
00063 *                                                                 DTSBD640
00064 *      MASTER FILE RECORDS UPDATED:                               DTSBD640
00065 *                                                                 DTSBD640
00066 *        NONE.                                                    DTSBD640
00067 *                                                                 DTSBD640
00068 *                                                                 DTSBD640
00069 *      REPORT RECORDS WRITTEN:                                    DTSBD640
00070 *                                                                 DTSBD640
00071 *        R793  FUTA QUARTERLY FEIN CHANGES.                       DTSBD640
00072 *        R907  UNUSUAL CONDITIONS ENCOUNTERED.                    DTSBD640
00073 *                                                                 DTSBD640
00074 *                                                                 DTSBD640
00075 *      TAPES WRITTEN:                                             DTSBD640
00076 *                                                                 DTSBD640
00077 *        NONE                                                     DTSBD640
00078 *                                                                 DTSBD640
00079 *                                                                 DTSBD640
00080 *      DISK DATASETS WRITTEN:                                     DTSBD640
00081 *                                                                 DTSBD640
00082 *        NONE                                                     DTSBD640
00083 *                                                                 DTSBD640
00084 *                                                                 DTSBD640
00085 *      MODULES CALLED:                                            DTSBD640
00086 *                                                                 DTSBD640
00087 *        DTSBU910 MASTER FILE I/O DRIVER.                         DTSBD640
00088 *        DTSBU921 ALTERNATE INDEX FILE I/O.                       DTSBD640
00089 *        DTSBU946 VARIABLE LENGTH RECORD SEQUENTIAL OUTPUT 1.     DTSBD640
00090 *                                                                 DTSBD640
00091 *****                                                             DTSBD640
00092      SKIP3                                                        DTSBD640
00093  ENVIRONMENT DIVISION.                                            DTSBD640
00094      SKIP2                                                        DTSBD640
00095  INPUT-OUTPUT SECTION.                                            DTSBD640
00096                                                                   DTSBD640
00097  FILE-CONTROL.                                                    DTSBD640
00098      SELECT QUARTERLY-ENTITY-UPDATE-FILE ASSIGN TO DTSFQEUP       DTSBD640
00099         FILE STATUS IS QEUP-FILE-STATUS.                          DTSBD640
00100                                                                   DTSBD640
00101      SELECT QUARTERLY-ENTITY-BYPASS-FILE ASSIGN TO DTSFBPAS       DTSBD640
00102         FILE STATUS IS QEUP-FILE-STATUS.                          DTSBD640
00103                                                                   DTSBD640
00104  DATA DIVISION.                                                   DTSBD640
00105      SKIP3                                                        DTSBD640
00106  FILE SECTION.                                                    DTSBD640
00107      SKIP2                                                        DTSBD640
00108  FD  QUARTERLY-ENTITY-UPDATE-FILE.                                DTSBD640
00109  01  X793-REC.                                                    DTSBD640
00110  ++INCLUDE DTSIX793                                               DTSBD640
00111                                                                   DTSBD640
00112  FD  QUARTERLY-ENTITY-BYPASS-FILE                                 DTSBD640
00113      RECORDING MODE IS F                                          DTSBD640
00114      BLOCK CONTAINS 0 RECORDS                                     DTSBD640
00115      LABEL RECORDS ARE STANDARD.                                  DTSBD640
00116                                                                   DTSBD640
00117  01  QUARTERLY-ENTITY-BYPASS-REC.                                 DTSBD640
00118      05  BPASS-FEIN-NO                   PIC 9(09).               DTSBD640
00119      05  FILLER                          PIC X(71).               DTSBD640
00120  WORKING-STORAGE SECTION.                                         DTSBD640
001205 77  PAN-VALET PICTURE X(24) VALUE '003DTSBD640  10/29/19'.       DTSBD640
00121  77  PAN-VALET PICTURE X(24) VALUE '022DTSBD640  10/16/19'.       DTSBD640
00122  77  PAN-VALET PICTURE X(24) VALUE '015DTSBD640  10/04/19'.       DTSBD640
00123  77  PAN-VALET PICTURE X(24) VALUE '020DTSBD640  01/09/14'.       DTSBD640
00124  77  PAN-VALET PICTURE X(24) VALUE '012DTSBD640  11/26/13'.       DTSBD640
00125  77  PAN-VALET PICTURE X(24) VALUE '018DTSBD640  11/18/13'.       DTSBD640
00126  77  PAN-VALET PICTURE X(24) VALUE '047DTSBD640  11/18/13'.       DTSBD640
00127  77  PAN-VALET PICTURE X(24) VALUE '016DTSBD640  02/18/99'.       DTSBD640
00128      SKIP3                                                        DTSBD640
00129  01  WRK-AREA.                                                    DTSBD640
00130      05  W-ABEND-CD                  PIC S9(04)  COMP  VALUE +640.DTSBD640
00131                                                                   DTSBD640
00132      05  W-MOD-NAME                  PIC  X(08)  VALUE 'DTSBD640'.DTSBD640
00133                                                                   DTSBD640
00134      05  QEUP-FILE-STATUS                PIC  X(02).              DTSBD640
00135          88  QEUP-STATUS-OK-88             VALUE '00'.            DTSBD640
00136          88  QEUP-STATUS-EOF-88            VALUE '10'.            DTSBD640
00137                                                                   DTSBD640
00138      05  W-ERROR-IND                     PIC  X(01).              DTSBD640
00139          88  W-ERROR-YES-88                VALUE 'Y'.             DTSBD640
00140          88  W-ERROR-NO-88                 VALUE 'N'.             DTSBD640
00141                                                                   DTSBD640
00142      05  WRK-FEIN                        PIC  9(09)  VALUE 0.     DTSBD640
00143                                                                   DTSBD640
00144      05  W-LAST-FEIN                     PIC S9(09)      COMP-3   DTSBD640
00145                                            VALUE +0.              DTSBD640
00146                                                                   DTSBD640
00147      05  W-FEIN-EMP-NO                   PIC S9(07)      COMP-3.  DTSBD640
00148                                                                   DTSBD640
00149      05  WRK-T001-ADD-CNT                PIC 9(05) VALUE 0.       DTSBD640
00150      05  WRK-BPASS-FEIN                  PIC 9(09).               DTSBD640
00151      05  WRK-BYPASS-EMP                  PIC 9(01) VALUE 0.       DTSBD640
00152                                                                   DTSBD640
00153      05  SUB1                            PIC S9(04)      COMP.    DTSBD640
00154      05  SUB2                            PIC S9(04)      COMP.    DTSBD640
00155      05  SUB3                            PIC S9(04)      COMP.    DTSBD640
00156      05  W-MNTE-IDX                      PIC S9(04)      COMP.    DTSBD640
00157                                                                   DTSBD640
00158      05  W-SELECT-IND                    PIC X(01).               DTSBD640
00159          88  W-SELECT-YES-88               VALUE 'Y'.             DTSBD640
00160          88  W-SELECT-NO-88                VALUE 'N'.             DTSBD640
00161                                                                   DTSBD640
00162      05  W-EMP-NO-UNUSED-IND             PIC X(01).               DTSBD640
00163          88  W-EMP-NO-UNUSED-NO-88         VALUE 'N'.             DTSBD640
00164          88  W-EMP-NO-UNUSED-YES-88        VALUE 'Y'.             DTSBD640
00165                                                                   DTSBD640
00166      05  W-END-FOUND-IND                 PIC X(01).               DTSBD640
00167          88  W-END-FOUND-YES-88            VALUE 'Y'.             DTSBD640
00168          88  W-END-FOUND-NO-88             VALUE 'N'.             DTSBD640
00169                                                                   DTSBD640
00170      05  W-NOT-LIAB-EMP-NO               PIC S9(07)      COMP-3.  DTSBD640
00171      05  W-EMP-STATUS                    PIC  X(01).              DTSBD640
00172                                                                   DTSBD640
00173      05  W-IRS-FORM-IND                  PIC X(10).               DTSBD640
00174          88  W-IRS-FORM-940-88             VALUE '940'.           DTSBD640
00175          88  W-IRS-FORM-940EZ-88           VALUE '940-EZ'.        DTSBD640
00176          88  W-IRS-FORM-941-88             VALUE '941'.           DTSBD640
00177          88  W-IRS-FORM-942-88             VALUE '942'.           DTSBD640
00178          88  W-IRS-FORM-943-88             VALUE '943'.           DTSBD640
00179          88  W-IRS-FORM-NULL-88            VALUE 'XXX'.           DTSBD640
00180                                                                   DTSBD640
00181      05  W-TRANS-CODE                    PIC X(20).               DTSBD640
00182          88  W-TRANS-CODE-NEW-88           VALUE 'NEW ACCOUNT'.   DTSBD640
00183          88  W-TRANS-CODE-FEIN-88          VALUE 'FEIN CHANGE'.   DTSBD640
00184          88  W-TRANS-CODE-NAME-88          VALUE 'NAME CHANGE'.   DTSBD640
00185          88  W-TRANS-CODE-NULL-88          VALUE 'XXX'.           DTSBD640
00186                                                                   DTSBD640
00187      05  QEUP-INPUT-REC-CNT              PIC S9(07)      COMP-3   DTSBD640
00188                                           VALUE +0.               DTSBD640
00189      05  QEUP-ERROR-REC-CNT              PIC S9(07)      COMP-3   DTSBD640
00190                                           VALUE +0.               DTSBD640
00191      05  QEUP-MATCHED-REC-CNT            PIC S9(07)      COMP-3   DTSBD640
00192                                           VALUE +0.               DTSBD640
00193      05  MATCHED-NOT-LIAB-CNT            PIC S9(07)      COMP-3   DTSBD640
00194                                           VALUE +0.               DTSBD640
00195      05  QEUP-UNMATCHED-REC-CNT          PIC S9(07)      COMP-3   DTSBD640
00196                                           VALUE +0.               DTSBD640
00197      05  W-PROFILE-CNT                   PIC S9(07)      COMP-3   DTSBD640
00198                                           VALUE +0.               DTSBD640
00199      05  W-ADDRESS-CNT                   PIC S9(07)      COMP-3   DTSBD640
00200                                           VALUE +0.               DTSBD640
00201      05  W-MNTE-CNT                      PIC S9(07)      COMP-3   DTSBD640
00202                                           VALUE +0.               DTSBD640
00203                                                                   DTSBD640
00204  01  MSG-AREA.                                                    DTSBD640
00205      05  MSG01-STATE-CODE-NOT-DC.                                 DTSBD640
00206          10  MSG01-ID                    PIC  X(03)  VALUE '793'. DTSBD640
00207          10  MSG01-TEXT.                                          DTSBD640
00208              15  FILLER                  PIC  X(40)               DTSBD640
00209                VALUE 'STATE CODE NOT EQUAL TO DC ENCOUNTERED O'.  DTSBD640
00210              15  FILLER                  PIC  X(40)               DTSBD640
00211                VALUE 'N QUARTERLY ENTITY UPDATE FROM IRS    : '.  DTSBD640
00212              15  MSG01-STATE-CODE        PIC  X(02).              DTSBD640
00213              15  FILLER                  PIC  X(05)  VALUE SPACES.DTSBD640
00214              15  MSG01-FEIN-X            PIC  X(09).              DTSBD640
00215                                                                   DTSBD640
00216      05  MSG02-NON-NUMERIC-FEIN.                                  DTSBD640
00217          10  MSG02-ID                    PIC  X(03)  VALUE '793'. DTSBD640
00218          10  MSG02-TEXT.                                          DTSBD640
00219              15  FILLER                  PIC  X(40)               DTSBD640
00220                VALUE 'NON NUMERIC FEIN VALUE ENCOUNTERED ON QU'.  DTSBD640
00221              15  FILLER                  PIC  X(40)               DTSBD640
00222                VALUE 'ARTERLY ENTITY UPDATE FROM IRS        : '.  DTSBD640
00223              15  MSG02-FEIN-X            PIC  X(09).              DTSBD640
00224                                                                   DTSBD640
00225      05  MSG03-DUPLICATE-FEIN.                                    DTSBD640
00226          10  MSG03-ID                    PIC  X(03)  VALUE '793'. DTSBD640
00227          10  MSG03-TEXT.                                          DTSBD640
00228              15  FILLER                  PIC  X(40)               DTSBD640
00229                VALUE 'DUPLICATE FEIN VALUE ENCOUNTERED ON QUAR'.  DTSBD640
00230              15  FILLER                  PIC  X(40)               DTSBD640
00231                VALUE 'TERLY ENTITY UPDATE FROM IRS          : '.  DTSBD640
00232              15  MSG03-FEIN-X            PIC  X(09).              DTSBD640
00233                                                                   DTSBD640
00234  01  T002-REC.                                                    DTSBD640
00235  ++INCLUDE DTSIT002                                               DTSBD640
00236                                                                   DTSBD640
00237 *************************                                         DTSBD640
00238 * PROFILE RECORD                                                  DTSBD640
00239 *************************                                         DTSBD640
00240  01  Y104-REC.                                                    DTSBD640
00241  ++INCLUDE DTSIY104                                               DTSBD640
00242                                                                   DTSBD640
00243 *************************                                         DTSBD640
00244 * NAME RECORD                                                     DTSBD640
00245 *************************                                         DTSBD640
00246  01  Y106-REC.                                                    DTSBD640
00247  ++INCLUDE DTSIY106                                               DTSBD640
00248                                                                   DTSBD640
00249 *************************                                         DTSBD640
00250 * ADDRESS RECORD                                                  DTSBD640
00251 *************************                                         DTSBD640
00252  01  Y110-REC.                                                    DTSBD640
00253  ++INCLUDE DTSIY110                                               DTSBD640
00254                                                                   DTSBD640
00255  01  T003-REC.                                                    DTSBD640
00256  ++INCLUDE DTSIT003                                               DTSBD640
00257                                                                   DTSBD640
00258  01  T001-REC.                                                    DTSBD640
00259  ++INCLUDE DTSIT001                                               DTSBD640
00260                                                                   DTSBD640
00261  01  CENO-LITERALS.                                               DTSBD640
00262  ++INCLUDE DTSICENO                                               DTSBD640
00263                                                                   DTSBD640
00264  01  L910-LINK-AREA.                                              DTSBD640
00265  ++INCLUDE DTSIL910                                               DTSBD640
00266                                                                   DTSBD640
00267  01  MSKL-REC.                                                    DTSBD640
00268  ++INCLUDE DTSIMSKL                                               DTSBD640
00269      SKIP3                                                        DTSBD640
00270  01  MHDR-REC.                                                    DTSBD640
00271  ++INCLUDE DTSIMHDR                                               DTSBD640
00272                                                                   DTSBD640
00273  01  MPRF-REC.                                                    DTSBD640
00274  ++INCLUDE DTSIMPRF                                               DTSBD640
00275                                                                   DTSBD640
00276  01  MNTE-REC.                                                    DTSBD640
00277  ++INCLUDE DTSIMNTE                                               DTSBD640
00278                                                                   DTSBD640
00279  01  MERA-REC.                                                    DTSBD640
00280  ++INCLUDE DTSIMERA                                               DTSBD640
00281                                                                   DTSBD640
00282  01  L921-LINK-AREA.                                              DTSBD640
00283  ++INCLUDE DTSIL921                                               DTSBD640
00284                                                                   DTSBD640
00285  01  ISKL-REC.                                                    DTSBD640
00286  ++INCLUDE DTSIISKL                                               DTSBD640
00287                                                                   DTSBD640
00288  01  IEIN-REC.                                                    DTSBD640
00289  ++INCLUDE DTSIIEIN                                               DTSBD640
00290                                                                   DTSBD640
00291  01  L005-COMM-AREA.                                              DTSBD640
00292  ++INCLUDE DTSIL005                                               DTSBD640
00293                                                                   DTSBD640
00294  01  R793-REC.                                                    DTSBD640
00295  ++INCLUDE DTSIR793                                               DTSBD640
00296      SKIP3                                                        DTSBD640
00297  01  R907-REC.                                                    DTSBD640
00298  ++INCLUDE DTSIR907                                               DTSBD640
00299                                                                   DTSBD640
00300  01  L142-LINK-AREA.                                              DTSBD640
00301  ++INCLUDE DTSIL142                                               DTSBD640
00302                                                                   DTSBD640
00303  01  L927-LINK-AREA.                                              DTSBD640
00304  ++INCLUDE DTSIL927                                               DTSBD640
00305                                                                   DTSBD640
00306  01  TSKL-REC.                                                    DTSBD640
00307  ++INCLUDE DTSITSKL                                               DTSBD640
00308                                                                   DTSBD640
00309  PROCEDURE DIVISION.                                              DTSBD640
00310                                                                   DTSBD640
00311                                                                   DTSBD640
00312      PERFORM I0000-INITIALIZATION  THRU I0000-EXIT.               DTSBD640
00313                                                                   DTSBD640
00314      PERFORM P0000-PROCESS-QEUP    THRU P0000-EXIT.               DTSBD640
00315                                                                   DTSBD640
00316      PERFORM T0000-TERMINATE       THRU T0000-EXIT.               DTSBD640
00317                                                                   DTSBD640
00318                                                                   DTSBD640
00319      GOBACK.                                                      DTSBD640
00320                                                                   DTSBD640
00321  I0000-INITIALIZATION.                                            DTSBD640
00322      SET W-ERROR-NO-88             TO TRUE.                       DTSBD640
00323                                                                   DTSBD640
00324      MOVE 'N'                      TO L910-TRACE-IND              DTSBD640
00325                                       L921-TRACE-IND              DTSBD640
00326                                       L927-TRACE-IND.             DTSBD640
00327                                                                   DTSBD640
00328      MOVE W-MOD-NAME               TO L910-MOD-NAME               DTSBD640
00329                                       L921-MOD-NAME               DTSBD640
00330                                       L927-MOD-NAME.              DTSBD640
00331                                                                   DTSBD640
00332      PERFORM I2000-OPEN-FILES      THRU I2000-EXIT.               DTSBD640
00333                                                                   DTSBD640
00334      PERFORM I3000-READ-HDR        THRU I3000-EXIT.               DTSBD640
00335                                                                   DTSBD640
00336 *    SET L142-INITIATE-88          TO TRUE.                       DTSBD640
00337 *    MOVE MHDR-CURR-RUN-DATE       TO L142-CURR-RUN-DATE.         DTSBD640
00338 *    PERFORM S142-NEW-EMP          THRU S142-EXIT.                DTSBD640
00339                                                                   DTSBD640
00340      MOVE LENGTH OF R793-REC       TO R793-LENGTH.                DTSBD640
00341                                                                   DTSBD640
00342      MOVE LENGTH OF R907-REC       TO R907-LENGTH.                DTSBD640
00343      MOVE +0                       TO R907-EMP-NO.                DTSBD640
00344      MOVE W-MOD-NAME               TO R907-MODULE-NAME.           DTSBD640
00345                                                                   DTSBD640
00346                                                                   DTSBD640
00347      SET L005-FROM-SYS             TO TRUE.                       DTSBD640
00348      PERFORM S005-SYS-DATE         THRU S005-EXIT.                DTSBD640
00349                                                                   DTSBD640
00350  I0000-EXIT.                                                      DTSBD640
00351      EXIT.                                                        DTSBD640
00352                                                                   DTSBD640
00353  I2000-OPEN-FILES.                                                DTSBD640
00354      PERFORM S910-OPEN-READ        THRU S910-EXIT.                   CL**2
00355 **   PERFORM S910-OPEN-UPDATE      THRU S910-EXIT.                   CL**2
00356                                                                   DTSBD640
00357      PERFORM S921-OPEN-READ        THRU S921-EXIT.                   CL**2
00358 **   PERFORM S921-OPEN-UPDATE      THRU S921-EXIT.                   CL**2
00359                                                                   DTSBD640
00360      PERFORM S927A-OPEN            THRU S927A-EXIT.               DTSBD640
00361                                                                   DTSBD640
00362      OPEN INPUT QUARTERLY-ENTITY-UPDATE-FILE.                     DTSBD640
00363      IF NOT QEUP-STATUS-OK-88                                     DTSBD640
00364         DISPLAY 'CANNOT OPEN QEUP FILE ' QEUP-FILE-STATUS         DTSBD640
00365         PERFORM S999-ABEND         THRU S999-EXIT                 DTSBD640
00366      END-IF.                                                      DTSBD640
00367                                                                   DTSBD640
00368                                                                   DTSBD640
00369  I2000-EXIT.                                                      DTSBD640
00370      EXIT.                                                        DTSBD640
00371                                                                   DTSBD640
00372  I3000-READ-HDR.                                                  DTSBD640
00373      MOVE LOW-VALUES               TO MHDR-KEY-AREA.              DTSBD640
00374      MOVE +0                       TO MHDR-EMP-NO.                DTSBD640
00375      SET MHDR-HDR-88               TO TRUE.                       DTSBD640
00376      MOVE MHDR-KEY-AREA            TO MSKL-KEY-AREA.              DTSBD640
00377                                                                   DTSBD640
00378      PERFORM S910-READ             THRU S910-EXIT.                DTSBD640
00379      IF L910-OK-88                                                DTSBD640
00380         MOVE MSKL-REC              TO MHDR-REC                    DTSBD640
00381      ELSE                                                         DTSBD640
00382         DISPLAY 'CANNOT READ MHDR '                               DTSBD640
00383         PERFORM S999-ABEND         THRU S999-EXIT                 DTSBD640
00384      END-IF.                                                      DTSBD640
00385                                                                   DTSBD640
00386  I3000-EXIT.                                                      DTSBD640
00387      EXIT.                                                        DTSBD640
00388                                                                   DTSBD640
00389  P0000-PROCESS-QEUP.                                              DTSBD640
00390      READ QUARTERLY-ENTITY-UPDATE-FILE.                           DTSBD640
00391      PERFORM UNTIL NOT QEUP-STATUS-OK-88                          DTSBD640
00392         ADD +1                           TO QEUP-INPUT-REC-CNT    DTSBD640
00393 *       SET W-ERROR-NO-88                TO TRUE                  DTSBD640
00394 *       PERFORM P1000-EDIT-REC           THRU P1000-EXIT          DTSBD640
00395 *       IF W-ERROR-NO-88                                          DTSBD640
00396            PERFORM P0900-CHECK-FEIN      THRU P0900-EXIT          DTSBD640
00397 *          PERFORM P2000-CHECK-FEIN      THRU P2000-EXIT          DTSBD640
00398 *          IF W-SELECT-YES-88                                     DTSBD640
00399 *             PERFORM P3000-ADD-T002     THRU P3000-EXIT          DTSBD640
00400 *             PERFORM P4000-ADD-MNTE     THRU P4000-EXIT          DTSBD640
00401 *          END-IF                                                 DTSBD640
00402 *       END-IF                                                    DTSBD640
00403         READ QUARTERLY-ENTITY-UPDATE-FILE                         DTSBD640
00404      END-PERFORM.                                                 DTSBD640
00405                                                                   DTSBD640
00406                                                                   DTSBD640
00407  P0000-EXIT.                                                      DTSBD640
00408      EXIT.                                                        DTSBD640
00409                                                                   DTSBD640
00410                                                                   DTSBD640
00411  P0900-CHECK-FEIN.                                                DTSBD640
00412                                                                   DTSBD640
00413      MOVE LOW-VALUES TO IEIN-KEY-AREA.                            DTSBD640
00414                                                                   DTSBD640
00415      SET IEIN-EIN-88 TO TRUE.                                     DTSBD640
00416                                                                   DTSBD640
00417      MOVE QEUP-FEIN TO IEIN-FEIN.                                 DTSBD640
00418                                                                   DTSBD640
00419      MOVE IEIN-KEY-AREA TO ISKL-KEY-AREA.                         DTSBD640
00420                                                                   DTSBD640
00421      PERFORM S921-START-BROWSE THRU S921-EXIT.                    DTSBD640
00422                                                                   DTSBD640
00423      IF L921-NO-REC-88                                            DTSBD640
00424         SET R793-POT-EMP-ADDED-88 TO TRUE                         DTSBD640
00425          PERFORM P7000-GENERATE-R793 THRU P7000-EXIT              DTSBD640
00426          GO TO P0900-EXIT.                                        DTSBD640
00427                                                                   DTSBD640
00428      MOVE ISKL-REC             TO IEIN-REC                        DTSBD640
00429      MOVE IEIN-FEIN            TO WRK-FEIN.                       DTSBD640
00430                                                                   DTSBD640
00431      IF WRK-FEIN NOT = QEUP-FEIN                                  DTSBD640
00432 *    DISPLAY 'IRS FEIN: ' QEUP-FEIN                               DTSBD640
00433 *            'DTS FEIN: ' WRK-FEIN                                DTSBD640
00434      SET R793-POT-EMP-ADDED-88 TO TRUE                            DTSBD640
00435      PERFORM P7000-GENERATE-R793 THRU P7000-EXIT                  DTSBD640
00436      ADD 1 TO QEUP-UNMATCHED-REC-CNT                              DTSBD640
00437      GO TO P0900-EXIT.                                            DTSBD640
00438                                                                   DTSBD640
00439      MOVE LOW-VALUES TO MSKL-KEY-AREA.                            DTSBD640
00440                                                                   DTSBD640
00441      MOVE IEIN-EMP-NO TO MSKL-EMP-NO.                             DTSBD640
00442                                                                   DTSBD640
00443      SET MSKL-PRF-88 TO TRUE.                                     DTSBD640
00444                                                                   DTSBD640
00445      PERFORM S910-READ THRU S910-EXIT.                            DTSBD640
00446                                                                   DTSBD640
00447      IF L910-NO-REC-88                                            DTSBD640
00448         SET R793-POT-EMP-ADDED-88 TO TRUE                         DTSBD640
00449          PERFORM P7000-GENERATE-R793 THRU P7000-EXIT              DTSBD640
00450      ADD 1 TO QEUP-UNMATCHED-REC-CNT                              DTSBD640
00451          GO TO P0900-EXIT.                                        DTSBD640
00452                                                                   DTSBD640
00453      MOVE MSKL-REC TO MPRF-REC.                                   DTSBD640
00454      DISPLAY 'FUTA EMP: ' MPRF-EMP-NO ' ' WRK-FEIN                DTSBD640
00455          ' ' MPRF-PRIMARY-NAME.                                   DTSBD640
00456                                                                   DTSBD640
00457      SET R793-POT-EMP-FOUND-88 TO TRUE                            DTSBD640
00458      PERFORM P7000-GENERATE-R793 THRU P7000-EXIT                  DTSBD640
00459      ADD +1 TO QEUP-MATCHED-REC-CNT.                              DTSBD640
00460  P0900-EXIT. EXIT.                                                DTSBD640
00461                                                                   DTSBD640
00462  P1000-EDIT-REC.                                                  DTSBD640
00463      IF QEUP-STATE-CODE = 'DC'                                    DTSBD640
00464         NEXT SENTENCE                                             DTSBD640
00465      ELSE                                                         DTSBD640
00466         SET W-ERROR-YES-88         TO TRUE                        DTSBD640
00467         MOVE QEUP-STATE-CODE       TO MSG01-STATE-CODE            DTSBD640
00468         MOVE QEUP-FEIN-X           TO MSG01-FEIN-X                DTSBD640
00469         MOVE MSG01-TEXT            TO R907-MSG-TEXT               DTSBD640
00470         PERFORM S946-WRITE-R907    THRU S946-EXIT                 DTSBD640
00471         DISPLAY 'ERR ' MSG01-STATE-CODE-NOT-DC                    DTSBD640
00472         ADD +1                     TO QEUP-ERROR-REC-CNT          DTSBD640
00473         GO TO P1000-EXIT                                          DTSBD640
00474      END-IF.                                                      DTSBD640
00475                                                                   DTSBD640
00476      IF QEUP-FEIN NUMERIC                                         DTSBD640
00477         NEXT SENTENCE                                             DTSBD640
00478      ELSE                                                         DTSBD640
00479         SET W-ERROR-YES-88         TO TRUE                        DTSBD640
00480         MOVE QEUP-FEIN-X           TO MSG02-FEIN-X                DTSBD640
00481         MOVE MSG02-TEXT            TO R907-MSG-TEXT               DTSBD640
00482         PERFORM S946-WRITE-R907    THRU S946-EXIT                 DTSBD640
00483         DISPLAY 'ERR ' MSG02-NON-NUMERIC-FEIN                     DTSBD640
00484         ADD +1                     TO QEUP-ERROR-REC-CNT          DTSBD640
00485         GO TO P1000-EXIT                                          DTSBD640
00486      END-IF.                                                      DTSBD640
00487      DISPLAY 'P1000 '  QEUP-FEIN '  '  W-LAST-FEIN.               DTSBD640
00488      IF QEUP-FEIN NOT = W-LAST-FEIN                               DTSBD640
00489         MOVE QEUP-FEIN         TO W-LAST-FEIN                     DTSBD640
00490      ELSE                                                         DTSBD640
00491         IF QEUP-FEIN = W-LAST-FEIN                                DTSBD640
00492            SET W-ERROR-YES-88         TO TRUE                     DTSBD640
00493            MOVE QEUP-FEIN-X           TO MSG03-FEIN-X             DTSBD640
00494            MOVE MSG03-TEXT            TO R907-MSG-TEXT            DTSBD640
00495            PERFORM S946-WRITE-R907    THRU S946-EXIT              DTSBD640
00496            DISPLAY 'ERR ' MSG03-DUPLICATE-FEIN                    DTSBD640
00497            ADD +1                     TO QEUP-ERROR-REC-CNT       DTSBD640
00498            GO TO P1000-EXIT                                       DTSBD640
00499         END-IF                                                    DTSBD640
00500      END-IF.                                                      DTSBD640
00501                                                                   DTSBD640
00502      MOVE ZERO TO WRK-BYPASS-EMP.                                 DTSBD640
00503      PERFORM P1050-BYPASS-EMP      THRU P1050-EXIT.               DTSBD640
00504      CLOSE QUARTERLY-ENTITY-BYPASS-FILE.                          DTSBD640
00505                                                                   DTSBD640
00506  P1000-EXIT.                                                      DTSBD640
00507      EXIT.                                                        DTSBD640
00508                                                                   DTSBD640
00509  P1050-BYPASS-EMP.                                                DTSBD640
00510      OPEN INPUT QUARTERLY-ENTITY-BYPASS-FILE.                     DTSBD640
00511      IF NOT QEUP-STATUS-OK-88                                     DTSBD640
00512         DISPLAY 'CANNOT OPEN BYPASS FILE ' QEUP-FILE-STATUS       DTSBD640
00513         PERFORM S999-ABEND         THRU S999-EXIT                 DTSBD640
00514      END-IF.                                                      DTSBD640
00515      PERFORM P1060-VERIFY-BYPASS-EMP THRU P1060-EXIT UNTIL        DTSBD640
00516       WRK-BYPASS-EMP = 1.                                         DTSBD640
00517  P1050-EXIT.                                                      DTSBD640
00518      EXIT.                                                        DTSBD640
00519                                                                   DTSBD640
00520  P1060-VERIFY-BYPASS-EMP.                                         DTSBD640
00521      READ QUARTERLY-ENTITY-BYPASS-FILE                            DTSBD640
00522       AT END MOVE 1 TO WRK-BYPASS-EMP.                            DTSBD640
00523                                                                   DTSBD640
00524      MOVE BPASS-FEIN-NO TO WRK-BPASS-FEIN                         DTSBD640
00525                                                                   DTSBD640
00526      IF WRK-BPASS-FEIN < QEUP-FEIN                                DTSBD640
00527         GO TO P1060-EXIT                                          DTSBD640
00528      ELSE                                                         DTSBD640
00529      IF WRK-BPASS-FEIN > QEUP-FEIN                                DTSBD640
00530 *    DISPLAY 'NOT FND ON PASS FILE ' WRK-BPASS-FEIN ' ' QEUP-FEIN DTSBD640
00531         MOVE 1 TO WRK-BYPASS-EMP                                  DTSBD640
00532      ELSE                                                         DTSBD640
00533      IF WRK-BPASS-FEIN = QEUP-FEIN                                DTSBD640
00534         DISPLAY 'EMP RESPONSED -BYPASS EMP  ' QEUP-FEIN           DTSBD640
00535         MOVE 1 TO WRK-BYPASS-EMP                                  DTSBD640
00536         SET W-ERROR-YES-88         TO TRUE                        DTSBD640
00537      ELSE                                                         DTSBD640
00538         DISPLAY 'BAD FEIN ON FILE  ' QEUP-FEIN ' ' WRK-BPASS-FEIN DTSBD640
00539         PERFORM S999-ABEND         THRU S999-EXIT.                DTSBD640
00540  P1060-EXIT.                                                      DTSBD640
00541      EXIT.                                                        DTSBD640
00542                                                                   DTSBD640
00543  P2000-CHECK-FEIN.                                                DTSBD640
00544      SET W-SELECT-NO-88        TO TRUE.                           DTSBD640
00545      MOVE ZERO                 TO W-FEIN-EMP-NO                   DTSBD640
00546                                   W-NOT-LIAB-EMP-NO.              DTSBD640
00547      MOVE SPACES               TO W-EMP-STATUS.                   DTSBD640
00548                                                                   DTSBD640
00549      MOVE LOW-VALUE            TO IEIN-KEY-AREA                   DTSBD640
00550      SET IEIN-EIN-88           TO TRUE                            DTSBD640
00551      MOVE QEUP-FEIN            TO IEIN-FEIN                       DTSBD640
00552      MOVE +0                   TO IEIN-EMP-NO                     DTSBD640
00553      MOVE IEIN-KEY-AREA        TO ISKL-KEY-AREA                   DTSBD640
00554      PERFORM S921-START-BROWSE THRU S921-EXIT                     DTSBD640
00555      MOVE ISKL-REC             TO IEIN-REC                        DTSBD640
00556      PERFORM                                                      DTSBD640
00557        UNTIL L921-NO-REC-88                                       DTSBD640
00558        OR W-FEIN-EMP-NO > ZERO                                    DTSBD640
00559           IF IEIN-FEIN = QEUP-FEIN                                DTSBD640
00560              PERFORM P2100-FIND-MPRF  THRU P2100-EXIT             DTSBD640
00561              IF W-FEIN-EMP-NO = ZERO                              DTSBD640
00562                 PERFORM S921-READ-NEXT THRU S921-EXIT             DTSBD640
00563                 MOVE ISKL-REC TO IEIN-REC                         DTSBD640
00564              END-IF                                               DTSBD640
00565           ELSE                                                    DTSBD640
00566              SET L921-NO-REC-88       TO TRUE                     DTSBD640
00567           END-IF                                                  DTSBD640
00568      END-PERFORM.                                                 DTSBD640
00569                                                                   DTSBD640
00570      IF W-FEIN-EMP-NO = ZERO                                      DTSBD640
00571         IF W-EMP-STATUS = 'N' OR 'U'                              DTSBD640
00572            DISPLAY 'UNKNOWN LIAB ' QEUP-FEIN                      DTSBD640
00573               '  ' QEUP-NAME-LINE-1                               DTSBD640
00574            ADD +1                  TO MATCHED-NOT-LIAB-CNT        DTSBD640
00575         ELSE                                                      DTSBD640
00576            SET W-SELECT-YES-88     TO TRUE                        DTSBD640
00577            ADD +1                  TO QEUP-UNMATCHED-REC-CNT      DTSBD640
00578            SET W-EMP-NO-UNUSED-NO-88  TO TRUE                     DTSBD640
00579            PERFORM P2200-NEXT-EMP-NO  THRU P2200-EXIT             DTSBD640
00580               UNTIL W-EMP-NO-UNUSED-YES-88                        DTSBD640
00581            DISPLAY 'UNMATCHED ' QEUP-FEIN '  ' QEUP-NAME-LINE-1   DTSBD640
00582            SET R793-POT-EMP-ADDED-88 TO TRUE                      DTSBD640
00583            PERFORM P7000-GENERATE-R793 THRU P7000-EXIT            DTSBD640
00584         END-IF                                                    DTSBD640
00585      ELSE                                                         DTSBD640
00586      DISPLAY 'Z' QEUP-FEIN ' ' MPRF-EMP-NO ' ' MPRF-PRIMARY-NAME  DTSBD640
00587         ADD +1                     TO QEUP-MATCHED-REC-CNT        DTSBD640
00588         SET R793-POT-EMP-FOUND-88 TO TRUE                         DTSBD640
00589        PERFORM P7000-GENERATE-R793 THRU P7000-EXIT                DTSBD640
00590      END-IF.                                                      DTSBD640
00591                                                                   DTSBD640
00592  P2000-EXIT.                                                      DTSBD640
00593      EXIT.                                                        DTSBD640
00594                                                                   DTSBD640
00595  P2100-FIND-MPRF.                                                 DTSBD640
00596      MOVE LOW-VALUE                TO MSKL-KEY-AREA.              DTSBD640
00597      MOVE IEIN-EMP-NO              TO MSKL-EMP-NO.                DTSBD640
00598      SET MSKL-PRF-88               TO TRUE.                       DTSBD640
00599                                                                   DTSBD640
00600      PERFORM S910-READ             THRU S910-EXIT.                DTSBD640
00601      IF L910-NO-REC-88                                            DTSBD640
00602          NEXT SENTENCE                                            DTSBD640
00603      ELSE                                                         DTSBD640
00604         MOVE MSKL-REC              TO MPRF-REC                    DTSBD640
00605         IF NOT MPRF-CLASS-SUB-88                                  DTSBD640
00606            MOVE MPRF-EMP-NO        TO W-NOT-LIAB-EMP-NO           DTSBD640
00607            MOVE MPRF-EMP-STATUS    TO W-EMP-STATUS                DTSBD640
00608         ELSE                                                      DTSBD640
00609            MOVE MPRF-EMP-STATUS    TO W-EMP-STATUS                DTSBD640
00610            MOVE MPRF-EMP-NO        TO W-FEIN-EMP-NO               DTSBD640
00611         END-IF                                                    DTSBD640
00612      END-IF.                                                      DTSBD640
00613                                                                   DTSBD640
00614      IF QEUP-FEIN = 203380822                                     DTSBD640
00615         DISPLAY '* ' QEUP-FEIN '  ' MPRF-EMP-NO '  '              DTSBD640
00616            W-NOT-LIAB-EMP-NO '  ' W-EMP-STATUS                    DTSBD640
00617            '  ' W-FEIN-EMP-NO                                     DTSBD640
00618      END-IF.                                                      DTSBD640
00619                                                                   DTSBD640
00620  P2100-EXIT.                                                      DTSBD640
00621      EXIT.                                                        DTSBD640
00622                                                                   DTSBD640
00623  P2200-NEXT-EMP-NO.                                               DTSBD640
00624      IF MHDR-LAST-USED-EMP-NO < 999999                            DTSBD640
00625         NEXT SENTENCE                                             DTSBD640
00626      ELSE                                                         DTSBD640
00627         PERFORM S999-ABEND          THRU S999-EXIT                DTSBD640
00628      END-IF.                                                      DTSBD640
00629                                                                   DTSBD640
00630      SET W-EMP-NO-UNUSED-NO-88      TO TRUE.                      DTSBD640
00631                                                                   DTSBD640
00632      ADD +1                         TO MHDR-LAST-USED-EMP-NO.     DTSBD640
00633                                                                   DTSBD640
00634      PERFORM                                                      DTSBD640
00635        VARYING SUB1 FROM +1 BY +1                                 DTSBD640
00636        UNTIL (SUB1 > CENO-AVAILABLE-RANGE-CNT)                    DTSBD640
00637           OR (W-EMP-NO-UNUSED-YES-88)                             DTSBD640
00638          IF (MHDR-LAST-USED-EMP-NO                                DTSBD640
00639                >= CENO-AVAILABLE-START-EMP-NO (SUB1))             DTSBD640
00640          AND   (MHDR-LAST-USED-EMP-NO                             DTSBD640
00641                <= CENO-AVAILABLE-END-EMP-NO (SUB1))               DTSBD640
00642              SET W-EMP-NO-UNUSED-YES-88 TO TRUE                   DTSBD640
00643          END-IF                                                   DTSBD640
00644      END-PERFORM.                                                 DTSBD640
00645                                                                   DTSBD640
00646  P2200-EXIT.                                                      DTSBD640
00647      EXIT.                                                        DTSBD640
00648                                                                   DTSBD640
00649  P3000-ADD-T002.                                                  DTSBD640
00650      PERFORM P3100-PROFILE          THRU P3100-EXIT.              DTSBD640
00651      PERFORM P3200-ADDRESS          THRU P3200-EXIT.              DTSBD640
00652      PERFORM P3400-T001             THRU P3400-EXIT.              DTSBD640
00653 **   PERFORM P3300-NAME             THRU P3300-EXIT.              DTSBD640
00654                                                                   DTSBD640
00655  P3000-EXIT.                                                      DTSBD640
00656      EXIT.                                                        DTSBD640
00657                                                                   DTSBD640
00658  P3100-PROFILE.                                                   DTSBD640
00659      MOVE LOW-VALUES                TO T002-REC.                  DTSBD640
00660                                                                   DTSBD640
00661      SET T002-LENGTH-DETERM-88      TO TRUE.                      DTSBD640
00662      MOVE '002'                     TO T002-REC-TYPE.             DTSBD640
00663      MOVE MHDR-LAST-USED-EMP-NO     TO T002-EMP-NO.               DTSBD640
00664      MOVE 'FUTA EIN  '              TO T002-ORIGIN.               DTSBD640
00665      MOVE MHDR-CURR-RUN-DATE        TO T002-SYS-DATE.             DTSBD640
00666      ADD +1000                      TO L005-TIME.                 DTSBD640
00667      MOVE L005-TIME                 TO T002-SYS-TIME.             DTSBD640
00668                                                                   DTSBD640
00669      MOVE QEUP-FEIN                 TO Y104-FEIN.                 DTSBD640
00670                                                                   DTSBD640
00671      PERFORM P3110-NAME             THRU P3110-EXIT.              DTSBD640
00672      SET Y104-STAFF-REVIEW-YES-88   TO TRUE.                      DTSBD640
00673      SET Y104-SOURCE-FEIN-LIST-88   TO TRUE.                      DTSBD640
00674      MOVE SPACES                    TO Y104-LIAB-CD               DTSBD640
00675                                        Y104-ELIG-CD.              DTSBD640
00676      MOVE 999999                    TO Y104-NAICS.                DTSBD640
00677      MOVE SPACES                    TO Y104-OWN-CD.               DTSBD640
00678      SET MPRF-ORG-UNK-88            TO TRUE.                      DTSBD640
00679      MOVE SPACES                    TO Y104-HOUSEHOLD-FILING.     DTSBD640
00680      MOVE SPACES                    TO Y104-CORP-STATE.           DTSBD640
00681      MOVE ZEROS                     TO Y104-CORP-DATE             DTSBD640
00682                                        Y104-FIRST-WAGE-DT         DTSBD640
00683                                        Y104-FIRST-500-QTR         DTSBD640
00684                                        Y104-LAST-WAGE-DT.         DTSBD640
00685      SET Y104-ACQUIRE-NO-88         TO TRUE.                      DTSBD640
00686      SET Y104-MERGE-SPLIT-NO-88     TO TRUE.                      DTSBD640
00687      SET Y104-REORG-NO-88           TO TRUE.                      DTSBD640
00688      SET Y104-COMMON-OWN-NO-88      TO TRUE.                      DTSBD640
00689      MOVE SPACES                    TO Y104-SALE-TRANSFER-IND.    DTSBD640
00690      STRING                                                       DTSBD640
00691         QEUP-ZIP-1-5 '-' QEUP-ZIP-6-9                             DTSBD640
00692           DELIMITED BY SIZE                                       DTSBD640
00693         INTO Y104-FIELD-ZIP                                       DTSBD640
00694      END-STRING.                                                  DTSBD640
00695      MOVE QEUP-STATE-CODE           TO Y104-FIELD-STATE.          DTSBD640
00696      SET Y104-NOT-LIAB-NULL-88      TO TRUE.                      DTSBD640
00697                                                                   DTSBD640
00698      MOVE Y104-REC                  TO T002-DATA-AREA.            DTSBD640
00699      SET T002-DETERM-88             TO TRUE.                      DTSBD640
00700 **   MOVE T002-REC                  TO TSKL-REC.                  DTSBD640
00701 **   PERFORM S927B-WRITE            THRU S927B-EXIT.              DTSBD640
00702      ADD +1                         TO W-PROFILE-CNT.             DTSBD640
00703                                                                   DTSBD640
00704      SET L142-PROCESS-88            TO TRUE.                      DTSBD640
00705      PERFORM S142-NEW-EMP           THRU S142-EXIT.               DTSBD640
00706                                                                   DTSBD640
00707  P3100-EXIT.                                                      DTSBD640
00708      EXIT.                                                        DTSBD640
00709                                                                   DTSBD640
00710                                                                   DTSBD640
00711  P3110-NAME.                                                      DTSBD640
00712      SET W-END-FOUND-NO-88          TO TRUE.                      DTSBD640
00713      MOVE 0                         TO SUB2.                      DTSBD640
00714                                                                   DTSBD640
00715      PERFORM                                                      DTSBD640
00716        VARYING SUB1 FROM +35 BY -1                                DTSBD640
00717        UNTIL SUB1 < 1 OR W-END-FOUND-YES-88                       DTSBD640
00718          IF QEUP-NAME-LINE-1 (SUB1:1) > SPACE                     DTSBD640
00719             MOVE SUB1 TO SUB2                                     DTSBD640
00720             SET W-END-FOUND-YES-88  TO TRUE                       DTSBD640
00721          END-IF                                                   DTSBD640
00722      END-PERFORM.                                                 DTSBD640
00723                                                                   DTSBD640
00724 **   DISPLAY 'P3110 '  QEUP-NAME-LINE-1 '  ' SUB1 '  ' SUB2       DTSBD640
00725      COMPUTE SUB3 = 35 - SUB2.                                    DTSBD640
00726      IF SUB3 > +0                                                 DTSBD640
00727         STRING                                                    DTSBD640
00728            QEUP-NAME-LINE-1 (1:SUB2)                              DTSBD640
00729            QEUP-NAME-LINE-2 (1:SUB3)                              DTSBD640
00730            QEUP-NAME-LINE-2 ((SUB3 + 1):5)                        DTSBD640
00731              DELIMITED BY SIZE                                    DTSBD640
00732            INTO Y104-ENTITY-NAME                                  DTSBD640
00733         END-STRING                                                DTSBD640
00734      ELSE                                                         DTSBD640
00735         STRING                                                    DTSBD640
00736            QEUP-NAME-LINE-1                                       DTSBD640
00737            QEUP-NAME-LINE-2 (1:5)                                 DTSBD640
00738              DELIMITED BY SIZE                                    DTSBD640
00739            INTO Y104-ENTITY-NAME                                  DTSBD640
00740         END-STRING                                                DTSBD640
00741      END-IF.                                                      DTSBD640
00742 **   DISPLAY Y104-ENTITY-NAME.                                    DTSBD640
00743      MOVE SPACES                    TO Y104-TRADE-NAME.           DTSBD640
00744                                                                   DTSBD640
00745  P3110-EXIT.                                                      DTSBD640
00746      EXIT.                                                        DTSBD640
00747                                                                   DTSBD640
00748  P3200-ADDRESS.                                                   DTSBD640
00749      MOVE LOW-VALUES                TO T002-REC.                  DTSBD640
00750                                                                   DTSBD640
00751      SET T002-LENGTH-EMP-ADDR-88    TO TRUE.                      DTSBD640
00752      MOVE '002'                     TO T002-REC-TYPE.             DTSBD640
00753      MOVE MHDR-LAST-USED-EMP-NO     TO T002-EMP-NO.               DTSBD640
00754      MOVE 'FUTA EIN  '              TO T002-ORIGIN.               DTSBD640
00755      MOVE MHDR-CURR-RUN-DATE        TO T002-SYS-DATE.             DTSBD640
00756      ADD +1000                      TO L005-TIME.                 DTSBD640
00757      MOVE L005-TIME                 TO T002-SYS-TIME.             DTSBD640
00758                                                                   DTSBD640
00759      SET Y110-EMP-ADDR-TYPE-MAIL-88 TO TRUE.                      DTSBD640
00760      IF QEUP-NAME-LINE-4 (1:1) = '%'                              DTSBD640
00761         MOVE QEUP-NAME-LINE-4       TO Y110-EMP-ATTN              DTSBD640
00762      ELSE                                                         DTSBD640
00763         MOVE SPACES                 TO Y110-EMP-ATTN              DTSBD640
00764      END-IF.                                                      DTSBD640
00765                                                                   DTSBD640
00766      MOVE SPACES                    TO Y110-EMP-DELV1.            DTSBD640
00767      MOVE QEUP-STREET-ADDRESS       TO Y110-EMP-DELV2.            DTSBD640
00768      MOVE QEUP-CITY                 TO Y110-EMP-CITY.             DTSBD640
00769      MOVE QEUP-STATE-CODE           TO Y110-EMP-STATE.            DTSBD640
00770      STRING                                                       DTSBD640
00771         QEUP-ZIP-1-5 '-' QEUP-ZIP-6-9                             DTSBD640
00772           DELIMITED BY SIZE                                       DTSBD640
00773         INTO Y110-EMP-ZIP                                         DTSBD640
00774      END-STRING.                                                  DTSBD640
00775                                                                   DTSBD640
00776      MOVE SPACES                    TO Y110-EMP-VOICE             DTSBD640
00777                                        Y110-EMP-FAX               DTSBD640
00778                                        Y110-EMP-EMAIL.            DTSBD640
00779                                                                   DTSBD640
00780      MOVE Y110-REC                  TO T002-DATA-AREA.            DTSBD640
00781      SET T002-EMP-ADDR-88           TO TRUE.                      DTSBD640
00782      MOVE T002-REC                  TO TSKL-REC.                  DTSBD640
00783      PERFORM S927B-WRITE            THRU S927B-EXIT.              DTSBD640
00784      ADD +1                         TO W-ADDRESS-CNT.             DTSBD640
00785                                                                   DTSBD640
00786  P3200-EXIT.                                                      DTSBD640
00787      EXIT.                                                        DTSBD640
00788                                                                   DTSBD640
00789 *P3300-NAME.                                                      DTSBD640
00790 *    MOVE LOW-VALUES                TO T002-REC.                  DTSBD640
00791 *                                                                 DTSBD640
00792 *    SET T002-LENGTH-DETERM-88      TO TRUE.                      DTSBD640
00793 *    MOVE '002'                     TO T002-REC-TYPE.             DTSBD640
00794 *    MOVE MHDR-LAST-USED-EMP-NO     TO T002-EMP-NO.               DTSBD640
00795 *    MOVE 'FUTA EIN  '              TO T002-ORIGIN.               DTSBD640
00796 *    MOVE MHDR-CURR-RUN-DATE        TO T002-SYS-DATE.             DTSBD640
00797 *    ADD +1000                      TO L005-TIME.                 DTSBD640
00798 *    MOVE L005-TIME                 TO T002-SYS-TIME.             DTSBD640
00799 *                                                                 DTSBD640
00800 *P3300-EXIT.                                                      DTSBD640
00801 *    EXIT.                                                        DTSBD640
00802                                                                   DTSBD640
00803  P3400-T001.                                                      DTSBD640
00804      MOVE LOW-VALUES                TO T001-REC.                  DTSBD640
00805                                                                   DTSBD640
00806      MOVE LENGTH OF T001-REC        TO T001-LENGTH.               DTSBD640
00807      MOVE '001'                     TO T001-REC-TYPE.             DTSBD640
00808      MOVE MHDR-LAST-USED-EMP-NO     TO T001-EMP-NO.               DTSBD640
00809      MOVE 'FUTA EIN '               TO T001-ORIGIN.               DTSBD640
00810      MOVE L005-DATE                 TO T001-SYS-DATE.             DTSBD640
00811      ADD +1000                      TO L005-TIME.                 DTSBD640
00812      MOVE L005-TIME                 TO T001-SYS-TIME.             DTSBD640
00813                                                                   DTSBD640
00814      SET T001-ERA-CYCLE    TO TRUE.                               DTSBD640
00815                                                                   DTSBD640
00816      MOVE T001-REC         TO TSKL-REC.                           DTSBD640
00817                                                                   DTSBD640
00818      PERFORM S927B-WRITE THRU S927B-EXIT.                         DTSBD640
00819      ADD 1 TO WRK-T001-ADD-CNT.                                   DTSBD640
00820  P3400-EXIT.                                                      DTSBD640
00821      EXIT.                                                        DTSBD640
00822                                                                   DTSBD640
00823  P4000-ADD-MNTE.                                                  DTSBD640
00824      MOVE LOW-VALUES              TO MNTE-REC.                    DTSBD640
00825      MOVE MHDR-LAST-USED-EMP-NO   TO MNTE-EMP-NO.                 DTSBD640
00826      SET MNTE-NTE-88              TO TRUE.                        DTSBD640
00827      MOVE +0                      TO MNTE-PURGE-DATE.             DTSBD640
00828      SET MNTE-NOT-CONVERTED-88    TO TRUE.                        DTSBD640
00829                                                                   DTSBD640
00830      MOVE MHDR-CURR-RUN-DATE      TO MNTE-ESTB-DATE               DTSBD640
00831                                      MNTE-CHNG-DATE.              DTSBD640
00832      MOVE ZERO                    TO MNTE-KEY-ESTB-ABSTIME        DTSBD640
00833                                      MNTE-DATA-ESTB-ABSTIME       DTSBD640
00834                                      MNTE-CHNG-ABSTIME.           DTSBD640
00835      MOVE 'FUTA EIN'              TO MNTE-ESTB-OP-ID              DTSBD640
00836                                      MNTE-CHNG-OP-ID.             DTSBD640
00837                                                                   DTSBD640
00838      MOVE 'ADDED FROM FUTA EIN'   TO MNTE-SUBJECT.                DTSBD640
00839                                                                   DTSBD640
00840 *    PERFORM                                                      DTSBD640
00841 *      VARYING W-MNTE-IDX   FROM +1 BY +1                         DTSBD640
00842 *      UNTIL W-MNTE-IDX > +16                                     DTSBD640
00843 *         MOVE SPACES      TO MNTE-TEXT (W-MNTE-IDX)              DTSBD640
00844 *    END-PERFORM.                                                 DTSBD640
00845                                                                   DTSBD640
00846      MOVE +0                        TO MNTE-TEXT-CNT.             DTSBD640
00847                                                                   DTSBD640
00848      IF QEUP-NAME-LINE-3 > SPACES                                 DTSBD640
00849         ADD +1                   TO MNTE-TEXT-CNT                 DTSBD640
00850         STRING                                                    DTSBD640
00851           'ADDITIONAL NAME: ' QEUP-NAME-LINE-3                    DTSBD640
00852             DELIMITED BY SIZE                                     DTSBD640
00853           INTO MNTE-TEXT (MNTE-TEXT-CNT)                          DTSBD640
00854         END-STRING                                                DTSBD640
00855      END-IF.                                                      DTSBD640
00856                                                                   DTSBD640
00857      IF QEUP-XREF-FEIN > ZERO                                     DTSBD640
00858         ADD +1                   TO MNTE-TEXT-CNT                 DTSBD640
00859         STRING                                                    DTSBD640
00860           'PREVIOUS FEIN: ' QEUP-XREF-FEIN                        DTSBD640
00861             DELIMITED BY SIZE                                     DTSBD640
00862           INTO MNTE-TEXT (MNTE-TEXT-CNT)                          DTSBD640
00863         END-STRING                                                DTSBD640
00864      END-IF.                                                      DTSBD640
00865                                                                   DTSBD640
00866      EVALUATE TRUE                                                DTSBD640
00867        WHEN QEUP-FORM-940-YES-88                                  DTSBD640
00868           SET W-IRS-FORM-940-88          TO TRUE                  DTSBD640
00869                                                                   DTSBD640
00870        WHEN QEUP-FORM-940EZ-YES-88                                DTSBD640
00871           SET W-IRS-FORM-940EZ-88          TO TRUE                DTSBD640
00872                                                                   DTSBD640
00873        WHEN QEUP-FORM-941-YES-88                                  DTSBD640
00874           SET W-IRS-FORM-941-88          TO TRUE                  DTSBD640
00875                                                                   DTSBD640
00876        WHEN QEUP-FORM-942-YES-88                                  DTSBD640
00877           SET W-IRS-FORM-942-88          TO TRUE                  DTSBD640
00878                                                                   DTSBD640
00879        WHEN QEUP-FORM-943-YES-88                                  DTSBD640
00880           SET W-IRS-FORM-943-88          TO TRUE                  DTSBD640
00881                                                                   DTSBD640
00882        WHEN OTHER                                                 DTSBD640
00883           SET W-IRS-FORM-NULL-88         TO TRUE                  DTSBD640
00884      END-EVALUATE.                                                DTSBD640
00885                                                                   DTSBD640
00886      IF NOT W-IRS-FORM-NULL-88                                    DTSBD640
00887         ADD +1                   TO MNTE-TEXT-CNT                 DTSBD640
00888         STRING                                                    DTSBD640
00889           'IRS FORM: ' W-IRS-FORM-IND                             DTSBD640
00890             DELIMITED BY SIZE                                     DTSBD640
00891           INTO MNTE-TEXT (MNTE-TEXT-CNT)                          DTSBD640
00892         END-STRING                                                DTSBD640
00893      END-IF.                                                      DTSBD640
00894                                                                   DTSBD640
00895      EVALUATE TRUE                                                DTSBD640
00896        WHEN QEUP-TRAN-NEW-ACCOUNT-YES-88                          DTSBD640
00897           SET W-TRANS-CODE-NEW-88        TO TRUE                  DTSBD640
00898                                                                   DTSBD640
00899        WHEN QEUP-TRAN-FEIN-CHANGE-YES-88                          DTSBD640
00900           SET W-TRANS-CODE-FEIN-88       TO TRUE                  DTSBD640
00901                                                                   DTSBD640
00902        WHEN QEUP-TRAN-NAME-CHANGE-YES-88                          DTSBD640
00903           SET W-TRANS-CODE-NAME-88       TO TRUE                  DTSBD640
00904                                                                   DTSBD640
00905        WHEN OTHER                                                 DTSBD640
00906           SET W-TRANS-CODE-NULL-88       TO TRUE                  DTSBD640
00907                                                                   DTSBD640
00908      END-EVALUATE.                                                DTSBD640
00909                                                                   DTSBD640
00910      IF NOT W-TRANS-CODE-NULL-88                                  DTSBD640
00911         ADD +1                   TO MNTE-TEXT-CNT                 DTSBD640
00912         STRING                                                    DTSBD640
00913           'REASON: ' W-TRANS-CODE                                 DTSBD640
00914             DELIMITED BY SIZE                                     DTSBD640
00915           INTO MNTE-TEXT (MNTE-TEXT-CNT)                          DTSBD640
00916         END-STRING                                                DTSBD640
00917      END-IF.                                                      DTSBD640
00918                                                                   DTSBD640
00919      MOVE LENGTH OF T003-REC        TO T003-LENGTH                DTSBD640
00920      MOVE '003'                     TO T003-REC-TYPE.             DTSBD640
00921      MOVE MHDR-LAST-USED-EMP-NO     TO T003-EMP-NO.               DTSBD640
00922      MOVE 'FUTA EIN  '              TO T003-ORIGIN.               DTSBD640
00923      MOVE L005-DATE                 TO T003-SYS-DATE.             DTSBD640
00924      ADD +1000                      TO L005-TIME.                 DTSBD640
00925      MOVE L005-TIME                 TO T003-SYS-TIME.             DTSBD640
00926      SET T003-ADD-MNTE-88           TO TRUE.                      DTSBD640
00927      MOVE MNTE-REC                  TO T003-MNTE-REC.             DTSBD640
00928                                                                   DTSBD640
00929      MOVE T003-REC                  TO TSKL-REC.                  DTSBD640
00930      PERFORM S927B-WRITE            THRU S927B-EXIT.              DTSBD640
00931      ADD +1                         TO W-MNTE-CNT.                DTSBD640
00932                                                                   DTSBD640
00933      IF MNTE-TEXT-CNT > +0                                        DTSBD640
00934         DISPLAY 'NOTE ' QEUP-FEIN  '  '                           DTSBD640
00935            MHDR-LAST-USED-EMP-NO                                  DTSBD640
00936         PERFORM                                                   DTSBD640
00937           VARYING SUB1 FROM +1 BY +1                              DTSBD640
00938           UNTIL SUB1 > MNTE-TEXT-CNT                              DTSBD640
00939              DISPLAY MNTE-TEXT (SUB1)                             DTSBD640
00940         END-PERFORM                                               DTSBD640
00941      END-IF.                                                      DTSBD640
00942                                                                   DTSBD640
00943  P4000-EXIT.                                                      DTSBD640
00944 *    EXIT.                                                        DTSBD640
00945                                                                   DTSBD640
00946  P7000-GENERATE-R793.                                             DTSBD640
00947      MOVE QEUP-FEIN TO R793-FEIN.                                 DTSBD640
00948                                                                   DTSBD640
00949      MOVE QEUP-ZIP-CODE TO R793-ZIP-CODE.                         DTSBD640
00950                                                                   DTSBD640
00951      MOVE QEUP-STATE-CODE TO R793-STATE-CODE.                     DTSBD640
00952                                                                   DTSBD640
00953      MOVE QEUP-CITY TO R793-CITY.                                 DTSBD640
00954                                                                   DTSBD640
00955      MOVE QEUP-STREET-ADDRESS TO R793-STREET-ADDRESS.             DTSBD640
00956                                                                   DTSBD640
00957      MOVE QEUP-NAME-LINE-1 TO R793-NAME-LINE-1.                   DTSBD640
00958                                                                   DTSBD640
00959      MOVE QEUP-NAME-LINE-2 TO R793-NAME-LINE-2.                   DTSBD640
00960                                                                   DTSBD640
00961      MOVE QEUP-NAME-LINE-3 TO R793-NAME-LINE-3.                   DTSBD640
00962                                                                   DTSBD640
00963      MOVE QEUP-NAME-LINE-4 TO R793-NAME-LINE-4.                   DTSBD640
00964      MOVE QEUP-TRAN-NEW-ACCOUNT-IND TO R793-NEW-ACCT-IND          DTSBD640
00965      MOVE QEUP-TRAN-FEIN-CHANGE-IND TO R793-FEIN-CHNG-IND         DTSBD640
00966      MOVE QEUP-TRAN-NAME-CHANGE-IND TO R793-NAME-CHNG-IND         DTSBD640
00967      MOVE QEUP-TRANSACTION-DATE     TO R793-TRAN-DATE             DTSBD640
00968 *        MOVE ZEROS             TO R793-EMP-NO                    DTSBD640
00969 *        MOVE SPACES            TO R793-EMP-NAME                  DTSBD640
00970 *        MOVE ZEROS             TO R793-EMP-DATE                  DTSBD640
00971 *        MOVE SPACES            TO R793-EMP-CLASS                 DTSBD640
00972 *        MOVE SPACES            TO R793-EMP-STATUS                DTSBD640
00973 *        MOVE SPACES            TO R793-ORG-TYPE                  DTSBD640
00974 *        MOVE SPACES            TO R793-RTN-MAIL                  DTSBD640
00975                                                                   DTSBD640
00976 *    IF  R793-POT-EMP-FOUND-88                                    DTSBD640
00977          MOVE MPRF-EMP-NO       TO R793-EMP-NO                    DTSBD640
00978          MOVE MPRF-PRIMARY-NAME TO R793-EMP-NAME                  DTSBD640
00979          MOVE MPRF-ESTB-DATE    TO R793-EMP-DATE                  DTSBD640
00980          MOVE MPRF-EMP-CLASS    TO R793-EMP-CLASS                 DTSBD640
00981          MOVE MPRF-EMP-STATUS   TO R793-EMP-STATUS                DTSBD640
00982          MOVE MPRF-ORG-TYPE     TO R793-ORG-TYPE                  DTSBD640
00983          MOVE MPRF-RETURN-MAIL-IND  TO R793-RTN-MAIL.             DTSBD640
00984                                                                   DTSBD640
00985      PERFORM S946-WRITE-R793 THRU S946-EXIT.                      DTSBD640
00986                                                                   DTSBD640
00987  P7000-EXIT.                                                      DTSBD640
00988      EXIT.                                                        DTSBD640
00989                                                                   DTSBD640
00990  T0000-TERMINATE.                                                 DTSBD640
00991      DISPLAY ' '.                                                 DTSBD640
00992                                                                   DTSBD640
00993      DISPLAY '*** DTSBD640 TERMINATION STATISTICS'.               DTSBD640
00994                                                                   DTSBD640
00995      DISPLAY ' '.                                                 DTSBD640
00996                                                                   DTSBD640
00997      DISPLAY '*** '                                               DTSBD640
00998              QEUP-INPUT-REC-CNT                                   DTSBD640
00999              ' QUARTERLY ENTITY UPDATE RECORDS RECEIVED FROM IRS'.DTSBD640
01000                                                                   DTSBD640
01001      DISPLAY '*** '.                                              DTSBD640
01002                                                                   DTSBD640
01003      DISPLAY '*** '                                               DTSBD640
01004              QEUP-ERROR-REC-CNT                                   DTSBD640
01005              ' RECORDS NOT PROCESSED - ERRORS DETECTED'.          DTSBD640
01006                                                                   DTSBD640
01007      DISPLAY '*** '.                                              DTSBD640
01008                                                                   DTSBD640
01009      DISPLAY '*** '                                               DTSBD640
01010              QEUP-MATCHED-REC-CNT                                 DTSBD640
01011              ' RECORDS MATCHED TO UI TAX EMPLOYERS -'             DTSBD640
01012              ' NO ACTION TAKEN'.                                  DTSBD640
01013 ***          ' NO LETTER GENERATED'.                              DTSBD640
01014                                                                   DTSBD640
01015      DISPLAY '*** '.                                              DTSBD640
01016                                                                   DTSBD640
01017      DISPLAY '*** '                                               DTSBD640
01018              QEUP-UNMATCHED-REC-CNT                               DTSBD640
01019              ' RECORDS NOT MATCHED TO UI TAX EMPLOYERS -'         DTSBD640
01020              ' POTENTIAL EMPLOYER CREATED'.                       DTSBD640
01021 ***          ' LETTER GENERATED'.                                 DTSBD640
01022                                                                   DTSBD640
01023      DISPLAY '*** '                                               DTSBD640
01024              WRK-T001-ADD-CNT                                     DTSBD640
01025              ' TOTAL CYCLE A LETTERS PRODUCED           '.        DTSBD640
01026 *            ' POTENTIAL EMPLOYER CREATED'.                       DTSBD640
01027 ***          ' LETTER GENERATED'.                                 DTSBD640
01028                                                                   DTSBD640
01029      DISPLAY '*** '.                                              DTSBD640
01030                                                                   DTSBD640
01031      DISPLAY '*** '                                               DTSBD640
01032              MATCHED-NOT-LIAB-CNT                                 DTSBD640
01033              ' RECORDS MATCHED TO NON-LIABLE ACCOUNT -'           DTSBD640
01034              ' NO ACTION TAKEN'.                                  DTSBD640
01035 ***          ' LETTER GENERATED'.                                 DTSBD640
01036                                                                   DTSBD640
01037      DISPLAY '*** '.                                              DTSBD640
01038                                                                   DTSBD640
01039      CLOSE QUARTERLY-ENTITY-UPDATE-FILE.                          DTSBD640
01040                                                                   DTSBD640
01041      SET L142-TERMINATE-88          TO TRUE.                      DTSBD640
01042      PERFORM S142-NEW-EMP           THRU S142-EXIT.               DTSBD640
01043                                                                   DTSBD640
01044 *    PERFORM T1000-UPDATE-HDR       THRU T1000-EXIT.                 CL**3
01045                                                                   DTSBD640
01046      PERFORM S910-CLOSE THRU S910-EXIT.                           DTSBD640
01047                                                                   DTSBD640
01048      PERFORM S921-CLOSE THRU S921-EXIT.                           DTSBD640
01049                                                                   DTSBD640
01050      PERFORM S927C-CLOSE THRU S927C-EXIT.                         DTSBD640
01051                                                                   DTSBD640
01052      MOVE -1 TO R793-LENGTH.                                      DTSBD640
01053                                                                   DTSBD640
01054      PERFORM S946-WRITE-R793 THRU S946-EXIT.                      DTSBD640
01055  T0000-EXIT.                                                      DTSBD640
01056      EXIT.                                                        DTSBD640
01057                                                                   DTSBD640
01058  T1000-UPDATE-HDR.                                                DTSBD640
01059 *    MOVE LOW-VALUES TO MHDR-KEY-AREA.                            DTSBD640
01060 *    MOVE +0 TO MHDR-EMP-NO.                                      DTSBD640
01061 *    SET MHDR-HDR-88 TO TRUE.                                     DTSBD640
01062 *    MOVE MHDR-KEY-AREA TO MSKL-KEY-AREA.                         DTSBD640
01063                                                                   DTSBD640
01064 *    PERFORM S910-READ THRU S910-EXIT.                            DTSBD640
01065                                                                   DTSBD640
01066 *    IF L910-NO-REC-88                                            DTSBD640
01067 *        MOVE 'MHDR RECORD NOT FOUND (T0000)'                     DTSBD640
01068 *          TO ABEND-MSG                                           DTSBD640
01069 *        PERFORM S999-ABEND THRU S999-EXIT.                       DTSBD640
01070                                                                   DTSBD640
01071 *    MOVE MSKL-REC TO MHDR-REC.                                   DTSBD640
01072                                                                   DTSBD640
01073 *    MOVE WRK-ASSIGN-NO      TO MHDR-LAST-USED-ASSIGN-NO.         DTSBD640
01074                                                                   DTSBD640
01075                                                                   DTSBD640
01076      MOVE MHDR-CURR-RUN-DATE TO MHDR-CHNG-DATE.                   DTSBD640
01077      MOVE MHDR-REC TO MSKL-REC.                                   DTSBD640
01078                                                                   DTSBD640
01079      PERFORM S910-REWRITE THRU S910-EXIT.                         DTSBD640
01080                                                                   DTSBD640
01081  T1000-EXIT.                                                      DTSBD640
01082        EXIT.                                                      DTSBD640
01083                                                                   DTSBD640
01084  S142-NEW-EMP.                                                    DTSBD640
01085      CALL 'DTSBD142' USING L142-LINK-AREA                         DTSBD640
01086                            T002-REC.                              DTSBD640
01087                                                                   DTSBD640
01088  S142-EXIT.                                                       DTSBD640
01089      EXIT.                                                        DTSBD640
01090                                                                   DTSBD640
01091  S005-SYS-DATE.                                                   DTSBD640
01092      CALL 'DTSBU005' USING L005-COMM-AREA.                        DTSBD640
01093                                                                   DTSBD640
01094  S005-EXIT.                                                       DTSBD640
01095      EXIT.                                                        DTSBD640
01096                                                                   DTSBD640
01097  S910-OPEN-READ.                                                  DTSBD640
01098      SET L910-OPEN-READ-88 TO TRUE.                               DTSBD640
01099      GO TO S910-MSTR-IO.                                          DTSBD640
01100                                                                   DTSBD640
01101  S910-OPEN-UPDATE.                                                DTSBD640
01102      SET L910-OPEN-UPDATE-88 TO TRUE.                             DTSBD640
01103      GO TO S910-MSTR-IO.                                          DTSBD640
01104                                                                   DTSBD640
01105  S910-READ.                                                       DTSBD640
01106      SET L910-READ-88 TO TRUE.                                    DTSBD640
01107      GO TO S910-MSTR-IO.                                          DTSBD640
01108                                                                   DTSBD640
01109  S910-REWRITE.                                                    DTSBD640
01110      SET L910-REWRITE-88 TO TRUE.                                 DTSBD640
01111      GO TO S910-MSTR-IO.                                          DTSBD640
01112                                                                   DTSBD640
01113 *S910-READ-NEXT.                                                  DTSBD640
01114 *****SET L910-READ-NEXT-88 TO TRUE.                               DTSBD640
01115 *****GO TO S910-MSTR-IO.                                          DTSBD640
01116                                                                   DTSBD640
01117 *S910-COUNT.                                                      DTSBD640
01118 *****SET L910-COUNT-88 TO TRUE.                                   DTSBD640
01119 *****GO TO S910-MSTR-IO.                                          DTSBD640
01120                                                                   DTSBD640
01121  S910-CLOSE.                                                      DTSBD640
01122      SET L910-CLOSE-88 TO TRUE.                                   DTSBD640
01123      GO TO S910-MSTR-IO.                                          DTSBD640
01124                                                                   DTSBD640
01125  S910-MSTR-IO.                                                    DTSBD640
01126      CALL 'DTSBU910' USING L910-LINK-AREA                         DTSBD640
01127                            MSKL-REC.                              DTSBD640
01128  S910-EXIT.                                                       DTSBD640
01129      EXIT.                                                        DTSBD640
01130                                                                   DTSBD640
01131  S921-OPEN-READ.                                                  DTSBD640
01132      SET L921-OPEN-READ-88 TO TRUE.                               DTSBD640
01133      GO TO S921-AIX-IO.                                           DTSBD640
01134                                                                   DTSBD640
01135  S921-OPEN-UPDATE.                                                DTSBD640
01136      SET L921-OPEN-UPDATE-88 TO TRUE.                             DTSBD640
01137      GO TO S921-AIX-IO.                                           DTSBD640
01138                                                                   DTSBD640
01139 *S921-READ.                                                       DTSBD640
01140 *****SET L921-READ-88 TO TRUE.                                    DTSBD640
01141 *****GO TO S921-AIX-IO.                                           DTSBD640
01142                                                                   DTSBD640
01143  S921-START-BROWSE.                                               DTSBD640
01144      SET L921-START-BROWSE-88 TO TRUE.                            DTSBD640
01145      GO TO S921-AIX-IO.                                           DTSBD640
01146                                                                   DTSBD640
01147  S921-READ-NEXT.                                                  DTSBD640
01148      SET L921-READ-NEXT-88 TO TRUE.                               DTSBD640
01149      GO TO S921-AIX-IO.                                           DTSBD640
01150                                                                   DTSBD640
01151  S921-CLOSE.                                                      DTSBD640
01152      SET L921-CLOSE-88 TO TRUE.                                   DTSBD640
01153      GO TO S921-AIX-IO.                                           DTSBD640
01154                                                                   DTSBD640
01155  S921-AIX-IO.                                                     DTSBD640
01156      CALL 'DTSBU921' USING L921-LINK-AREA                         DTSBD640
01157                            ISKL-REC.                              DTSBD640
01158  S921-EXIT.                                                       DTSBD640
01159      EXIT.                                                        DTSBD640
01160                                                                   DTSBD640
01161  S927A-OPEN.                                                      DTSBD640
01162      SET L927-OPEN-UPDATE-88  TO TRUE.                            DTSBD640
01163      PERFORM S927Z-IO   THRU S927Z-EXIT.                          DTSBD640
01164                                                                   DTSBD640
01165  S927A-EXIT.                                                      DTSBD640
01166      EXIT.                                                        DTSBD640
01167                                                                   DTSBD640
01168  S927B-WRITE.                                                     DTSBD640
01169      SET L927-WRITE-88 TO TRUE.                                   DTSBD640
01170      PERFORM S927Z-IO   THRU S927Z-EXIT.                          DTSBD640
01171                                                                   DTSBD640
01172  S927B-EXIT.                                                      DTSBD640
01173      EXIT.                                                        DTSBD640
01174                                                                   DTSBD640
01175  S927C-CLOSE.                                                     DTSBD640
01176      SET L927-CLOSE-88        TO TRUE.                            DTSBD640
01177      PERFORM S927Z-IO   THRU S927Z-EXIT.                          DTSBD640
01178                                                                   DTSBD640
01179  S927C-EXIT.                                                      DTSBD640
01180      EXIT.                                                        DTSBD640
01181                                                                   DTSBD640
01182                                                                   DTSBD640
01183  S927Z-IO.                                                        DTSBD640
01184      CALL 'DTSBU927' USING L927-LINK-AREA                         DTSBD640
01185                            TSKL-REC.                              DTSBD640
01186  S927Z-EXIT.                                                      DTSBD640
01187      EXIT.                                                        DTSBD640
01188                                                                   DTSBD640
01189  S946-WRITE-R793.                                                 DTSBD640
01190      CALL 'DTSBU946' USING R793-REC.                              DTSBD640
01191      GO TO S946-EXIT.                                             DTSBD640
01192                                                                   DTSBD640
01193  S946-WRITE-R907.                                                 DTSBD640
01194      CALL 'DTSBU946' USING R907-REC.                              DTSBD640
01195      GO TO S946-EXIT.                                             DTSBD640
01196                                                                   DTSBD640
01197  S946-EXIT.                                                       DTSBD640
01198      EXIT.                                                        DTSBD640
01199                                                                   DTSBD640
01200  S999-ABEND.                                                      DTSBD640
01201      CALL 'DTSBU999' USING W-ABEND-CD.                            DTSBD640
01202  S999-EXIT.                                                       DTSBD640
01203 *****EXIT.                                                        DTSBD640
