00001  IDENTIFICATION DIVISION.                                         02/01/04
00002  PROGRAM-ID.             DTSBX771.                                DTSBX771
00003  AUTHOR.                 TRW.                                        LV001
00004  DATE-WRITTEN.           NOVEMBER 2002.                           DTSBX771
00005  DATE-COMPILED.                                                   DTSBX771
00006      SKIP3                                                        DTSBX771
00007 *****                                                             DTSBX771
00008 *                                                                 DTSBX771
00009 *                                                                 DTSBX771
00010 *    FUNCTION:  BUILD ACTIVE EMPLOYER RECONSTRUCTION FILE         DTSBX771
00011 *               RECORDS FOR ETA581 DATA VALIDATION SYSTEM.        DTSBX771
00012 *                                                                 DTSBX771
00013 *                                                                 DTSBX771
00014 *    MODIFICATION LOG:                                            DTSBX771
00015 *                                                                 DTSBX771
00016 *    11/28/2002  INITIAL DEVELOPMENT.                             DTSBX771
00017 *                REFERENCE: DATA VALIDATION     PROGRAMMER: GD    DTSBX771
00018 *                                                                 DTSBX771
00019 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBX771
00020 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBX771
00021 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSBX771
00022 *                                                                 DTSBX771
00023 *                                                                 DTSBX771
00024 *  DESCRIPTION:                                                   DTSBX771
00025 *                                                                 DTSBX771
00026 *                                                                 DTSBX771
00027 *    INITIATION:                                                  DTSBX771
00028 *                                                                 DTSBX771
00029 *      OPEN DTSX771                                               DTSBX771
00030 *                                                                 DTSBX771
00031 *                                                                 DTSBX771
00032 *    PROCESSING:                                                  DTSBX771
00033 *                                                                 DTSBX771
00034 *      BUILD POPULATION 1 RECONSTRUCTION FILE RECORD (DTSIX771)   DTSBX771
00035 *      FROM DTSIY771 INPUT RECORD.                                DTSBX771
00036 *                                                                 DTSBX771
00037 *    TERMINATION:                                                 DTSBX771
00038 *                                                                 DTSBX771
00039 *      CLOSE DTSX771                                              DTSBX771
00040 *                                                                 DTSBX771
00041 *    RECORDS READ:                                                DTSBX771
00042 *                                                                 DTSBX771
00043 *      MASTER:                                                    DTSBX771
00044 *                                                                 DTSBX771
00045 *        NONE                                                     DTSBX771
00046 *                                                                 DTSBX771
00047 *                                                                 DTSBX771
00048 *      ALTERNATE INDEX:                                           DTSBX771
00049 *                                                                 DTSBX771
00050 *        NONE.                                                    DTSBX771
00051 *                                                                 DTSBX771
00052 *                                                                 DTSBX771
00053 *      REFERENCE:                                                 DTSBX771
00054 *                                                                 DTSBX771
00055 *                                                                 DTSBX771
00056 *                                                                 DTSBX771
00057 *    RECORDS UPDATED:                                             DTSBX771
00058 *                                                                 DTSBX771
00059 *        NONE                                                     DTSBX771
00060 *                                                                 DTSBX771
00061 *                                                                 DTSBX771
00062 *    OUTPUT RECORDS WRITTEN:                                      DTSBX771
00063 *                                                                 DTSBX771
00064 *        DTSIX771 POPULATION 1 DOWNLOAD                           DTSBX771
00065 *                                                                 DTSBX771
00066 *                                                                 DTSBX771
00067 *    BATCH TRANSACTION COLLECTION RECORDS WRITTEN:                DTSBX771
00068 *                                                                 DTSBX771
00069 *        NONE.                                                    DTSBX771
00070 *                                                                 DTSBX771
00071 *                                                                 DTSBX771
00072 *    MODULES CALLED:                                              DTSBX771
00073 *                                                                 DTSBX771
00074 *        DTSBU001  DATE EDIT/CONVERSION.                          DTSBX771
00075 *        DTSBU004  QUARTER EDIT/CONVERSION.                       DTSBX771
00076 *        DTSBU910  MASTER FILE I/O.                               DTSBX771
00077 *                                                                 DTSBX771
00078 *                                                                 DTSBX771
00079 *                                                                 DTSBX771
00080 *****                                                             DTSBX771
00081      SKIP3                                                        DTSBX771
00082  ENVIRONMENT DIVISION.                                            DTSBX771
00083  INPUT-OUTPUT SECTION.                                            DTSBX771
00084  FILE-CONTROL.                                                    DTSBX771
00085      SELECT ACTIVE-EMPLOYERS ASSIGN TO DTSX771                    DTSBX771
00086             FILE STATUS IS BX771-STATUS.                          DTSBX771
00087      EJECT                                                        DTSBX771
00088  DATA DIVISION.                                                   DTSBX771
00089  FILE SECTION.                                                    DTSBX771
00090  FD  ACTIVE-EMPLOYERS                                             DTSBX771
00091      RECORDING MODE IS F                                          DTSBX771
00092      LABEL RECORDS ARE STANDARD                                   DTSBX771
00093      BLOCK CONTAINS 0 RECORDS.                                    DTSBX771
00094  01  ACTIVE-EMPLOYERS-REC              PIC X(235).                DTSBX771
00095      SKIP3                                                        DTSBX771
00096  WORKING-STORAGE SECTION.                                         DTSBX771
000965 77  PAN-VALET PICTURE X(24) VALUE '001DTSBX771  02/01/04'.       DTSBX771
00097      SKIP3                                                        DTSBX771
00098  01  WRK-AREA.                                                    DTSBX771
00099      05  WRK-ABEND-CD                PIC S9(04)  COMP  VALUE +771.DTSBX771
00100                                                                   DTSBX771
00101      05  WRK-MOD-NAME                PIC  X(08)  VALUE 'DTSBX771'.DTSBX771
00102                                                                   DTSBX771
00103      05  ABEND-MSG                   PIC  X(60).                  DTSBX771
00104                                                                   DTSBX771
00105      05  BX771-STATUS                PIC X(02) VALUE SPACES.      DTSBX771
00106          88 BX771-STATUS-OK-88    VALUE ZEROS.                    DTSBX771
00107      SKIP3                                                        DTSBX771
00108      05  WRK-PARM-SUBJECT-YRQ        PIC S9(05)  COMP-3 VALUE +0. DTSBX771
00109                                                                   DTSBX771
00110      05  WRK-OBS-NBR                 PIC S9(07)  COMP-3 VALUE +0. DTSBX771
00111                                                                   DTSBX771
00112      05  WRK-STATUS-AREA.                                         DTSBX771
00113          10  WRK-DV-STATUS           PIC  X(01).                  DTSBX771
00114              88  WRK-DV-STATUS-ACTIVE-88        VALUE 'A'.        DTSBX771
00115          10  FILLER                  PIC  X(01) VALUE '-'.        DTSBX771
00116          10  WRK-MPRF-STATUS         PIC  X(01).                  DTSBX771
00117              88  WRK-MPRF-STATUS-ACTIVE-88      VALUE 'A'.        DTSBX771
00118          10  FILLER                  PIC  X(21) VALUE SPACES.     DTSBX771
00119      05  WRK-STATUS REDEFINES WRK-STATUS-AREA                     DTSBX771
00120                                      PIC  X(24).                  DTSBX771
00121                                                                   DTSBX771
00122      05  WRK-EMP-CLASS-AREA.                                      DTSBX771
00123          10  WRK-DV-EMP-CLASS        PIC  X(01).                  DTSBX771
00124              88  WRK-DV-EMP-CLASS-CONTRIB-88    VALUE 'C'.        DTSBX771
00125              88  WRK-DV-EMP-CLASS-REIMB-88      VALUE 'R'.        DTSBX771
00126          10  FILLER                  PIC  X(01) VALUE '-'.        DTSBX771
00127          10  WRK-MPRF-EMP-CLASS      PIC  X(01).                  DTSBX771
00128          10  FILLER                  PIC  X(21) VALUE SPACES.     DTSBX771
00129      05  WRK-EMP-CLASS REDEFINES WRK-EMP-CLASS-AREA               DTSBX771
00130                                      PIC  X(24).                  DTSBX771
00131                                                                   DTSBX771
00132      05  WRK-RECS-WRITTEN-CNT       PIC S9(07)  COMP-3            DTSBX771
00133                                      VALUE +0.                    DTSBX771
00134      05  WRK-CON-EMP-CNT            PIC S9(07)  COMP-3            DTSBX771
00135                                      VALUE +0.                    DTSBX771
00136      05  WRK-REIMB-EMP-CNT          PIC S9(07)  COMP-3            DTSBX771
00137                                      VALUE +0.                    DTSBX771
00138      05  DISPLAY-CNT                PIC Z(06)9.                   DTSBX771
00139                                                                   DTSBX771
00140      05  DISPLAY-AMT-X               PIC  X(15).                  DTSBX771
00141      05  DISPLAY-AMT REDEFINES DISPLAY-AMT-X                      DTSBX771
00142                                      PIC  ZZZ,ZZZ,ZZ9.99-.        DTSBX771
00143                                                                   DTSBX771
00144  01  WRK-LEN                         PIC S9(04) COMP VALUE +235.  DTSBX771
00145  01  WRK-REC-AREA                    PIC  X(235).                 DTSBX771
00146                                                                   DTSBX771
00147  01  X771-DATA-AREA.                                              DTSBX771
00148  ++INCLUDE DTSIX771                                               DTSBX771
00149      05  X771-REC1-FILLER           PIC  X(21) VALUE SPACES.      DTSBX771
00150      05  X771-REC2-FILLER           PIC  X(11) VALUE SPACES.      DTSBX771
00151      05  X771-REC3-FILLER           PIC  X(11) VALUE SPACES.      DTSBX771
00152      05  X771-REC4-FILLER           PIC  X(01) VALUE SPACES.      DTSBX771
00153      EJECT                                                        DTSBX771
00154  01  L001-LINK-AREA.                                              DTSBX771
00155  ++INCLUDE DTSIL001                                               DTSBX771
00156      EJECT                                                        DTSBX771
00157  01  L004-LINK-AREA.                                              DTSBX771
00158  ++INCLUDE DTSIL004                                               DTSBX771
00159      EJECT                                                        DTSBX771
00160  01  Y771-REC.                                                    DTSBX771
00161  ++INCLUDE DTSIY771                                               DTSBX771
00162      EJECT                                                        DTSBX771
00163  LINKAGE SECTION.                                                 DTSBX771
00164      SKIP3                                                        DTSBX771
00165  01  XL771-LINK-AREA.                                             DTSBX771
00166  ++INCLUDE DTSXL771                                               DTSBX771
00167                                                                   DTSBX771
00168  01  L770-PARM-REC.                                               DTSBX771
00169  ++INCLUDE DTSIX770                                               DTSBX771
00170                                                                   DTSBX771
00171  01  RSKL-REC.                                                    DTSBX771
00172  ++INCLUDE DTSIRSK1                                               DTSBX771
00173                                                                   DTSBX771
00174  PROCEDURE DIVISION USING XL771-LINK-AREA                         DTSBX771
00175                           L770-PARM-REC                           DTSBX771
00176                           RSKL-REC.                               DTSBX771
00177                                                                   DTSBX771
00178      IF XL771-CMD-PROCESS-88                                      DTSBX771
00179          PERFORM P0000-PROCESS THRU P0000-EXIT                    DTSBX771
00180      ELSE                                                         DTSBX771
00181      IF XL771-CMD-INIT-88                                         DTSBX771
00182          PERFORM I0000-INITIALIZE THRU I0000-EXIT                 DTSBX771
00183      ELSE                                                         DTSBX771
00184      IF XL771-CMD-TERMINATE-88                                    DTSBX771
00185          PERFORM T0000-TERMINATE THRU T0000-EXIT                  DTSBX771
00186      ELSE                                                         DTSBX771
00187          MOVE 'INVALID LECM-CALL-TYPE-IND ENCOUNTERED'            DTSBX771
00188            TO ABEND-MSG                                           DTSBX771
00189          PERFORM S999-ABEND THRU S999-EXIT.                       DTSBX771
00190      SKIP2                                                        DTSBX771
00191      GOBACK.                                                      DTSBX771
00192      EJECT                                                        DTSBX771
00193  I0000-INITIALIZE.                                                DTSBX771
00194      OPEN OUTPUT ACTIVE-EMPLOYERS                                 DTSBX771
00195      IF NOT BX771-STATUS-OK-88                                    DTSBX771
00196         DISPLAY 'FILE STATUS IS : ' BX771-STATUS                  DTSBX771
00197         MOVE 'CANNOT OPEN OUTPUT FILE '  TO ABEND-MSG             DTSBX771
00198         PERFORM S999-ABEND THRU S999-EXIT.                        DTSBX771
00199                                                                   DTSBX771
00200      MOVE ZERO           TO XL771-CON-EMP-CNT                     DTSBX771
00201                             XL771-REIMB-EMP-CNT                   DTSBX771
00202                             XL771-TOT-EMP-CNT.                    DTSBX771
00203  I0000-EXIT.                                                      DTSBX771
00204      EXIT.                                                        DTSBX771
00205      EJECT                                                        DTSBX771
00206  P0000-PROCESS.                                                   DTSBX771
00207      MOVE RSKL-REC                 TO Y771-REC.                   DTSBX771
00208      PERFORM P1000-WRITE-OUTPUT    THRU P1000-EXIT.               DTSBX771
00209                                                                   DTSBX771
00210  P0000-EXIT.                                                      DTSBX771
00211      EXIT.                                                        DTSBX771
00212                                                                   DTSBX771
00213  P1000-WRITE-OUTPUT.                                              DTSBX771
00214      ADD +1            TO WRK-OBS-NBR.                            DTSBX771
00215      ADD +1            TO WRK-RECS-WRITTEN-CNT.                   DTSBX771
00216                                                                   DTSBX771
00217      MOVE Y771-EMP-NO  TO X771-EMP-NO.                            DTSBX771
00218      MOVE WRK-OBS-NBR  TO X771-OBS-NBR.                           DTSBX771
00219      SET WRK-DV-STATUS-ACTIVE-88   TO TRUE.                       DTSBX771
00220      SET WRK-MPRF-STATUS-ACTIVE-88 TO TRUE.                       DTSBX771
00221      MOVE WRK-STATUS-AREA  TO X771-EMP-STATUS.                    DTSBX771
00222                                                                   DTSBX771
00223      IF Y771-CLASS-RATED-88                                       DTSBX771
00224         SET WRK-DV-EMP-CLASS-CONTRIB-88  TO TRUE                  DTSBX771
00225         ADD +1 TO WRK-CON-EMP-CNT                                 DTSBX771
00226      ELSE                                                         DTSBX771
00227         IF Y771-CLASS-SELF-INS-88                                 DTSBX771
00228            SET WRK-DV-EMP-CLASS-REIMB-88    TO TRUE               DTSBX771
00229            ADD +1 TO WRK-REIMB-EMP-CNT                            DTSBX771
00230         ELSE                                                      DTSBX771
00231            DISPLAY 'INVALID EMPLOYER CLASS ' Y771-EMP-NO          DTSBX771
00232               '  CLASS: ' Y771-EMP-CLASS                          DTSBX771
00233            GO TO P1000-EXIT.                                      DTSBX771
00234                                                                   DTSBX771
00235      MOVE Y771-EMP-CLASS          TO WRK-MPRF-EMP-CLASS.          DTSBX771
00236      MOVE WRK-EMP-CLASS-AREA      TO X771-EMP-TYPE.               DTSBX771
00237                                                                   DTSBX771
00238      MOVE Y771-LIAB-DATE          TO L001-FED-8-DATE-9.           DTSBX771
00239      PERFORM S001-FROM-FED-8      THRU S001-EXIT.                 DTSBX771
00240      MOVE L001-SLASH-8-DATE       TO X771-LIAB-DATE.              DTSBX771
00241                                                                   DTSBX771
00242      IF Y771-REOPEN-PROCESS-DATE  = ZERO                          DTSBX771
00243         MOVE SPACES               TO X771-REOPEN-PROCESS-DATE     DTSBX771
00244      ELSE                                                         DTSBX771
00245         MOVE Y771-REOPEN-PROCESS-DATE                             DTSBX771
00246                                   TO L001-FED-8-DATE-9            DTSBX771
00247         PERFORM S001-FROM-FED-8   THRU S001-EXIT                  DTSBX771
00248         MOVE L001-SLASH-8-DATE    TO X771-REOPEN-PROCESS-DATE.    DTSBX771
00249                                                                   DTSBX771
00250      IF Y771-INACTIVE-DATE        = ZERO                          DTSBX771
00251         MOVE SPACES               TO X771-INACTIVE-DATE           DTSBX771
00252      ELSE                                                         DTSBX771
00253         MOVE Y771-INACTIVE-DATE   TO L001-FED-8-DATE-9            DTSBX771
00254         PERFORM S001-FROM-FED-8   THRU S001-EXIT                  DTSBX771
00255         MOVE L001-SLASH-8-DATE    TO X771-INACTIVE-DATE.          DTSBX771
00256                                                                   DTSBX771
00257      MOVE Y771-PROCESS-DATE       TO L001-FED-8-DATE-9.           DTSBX771
00258      PERFORM S001-FROM-FED-8      THRU S001-EXIT.                 DTSBX771
00259      MOVE L001-SLASH-8-DATE       TO X771-PROCESS-DATE.           DTSBX771
00260                                                                   DTSBX771
00261      MOVE Y771-LIAB-QTR-CNT       TO X771-LIAB-QTR-CNT.           DTSBX771
00262                                                                   DTSBX771
00263      MOVE Y771-QTR1-WAGES         TO X771-QTR1-WAGES.             DTSBX771
00264      MOVE Y771-QTR2-WAGES         TO X771-QTR2-WAGES.             DTSBX771
00265      MOVE Y771-QTR3-WAGES         TO X771-QTR3-WAGES.             DTSBX771
00266      MOVE Y771-QTR4-WAGES         TO X771-QTR4-WAGES.             DTSBX771
00267      MOVE Y771-QTR5-WAGES         TO X771-QTR5-WAGES.             DTSBX771
00268      MOVE Y771-QTR6-WAGES         TO X771-QTR6-WAGES.             DTSBX771
00269      MOVE Y771-QTR7-WAGES         TO X771-QTR7-WAGES.             DTSBX771
00270      MOVE Y771-QTR8-WAGES         TO X771-QTR8-WAGES.             DTSBX771
00271                                                                   DTSBX771
00272      IF X771-REOPEN-PROCESS-DATE    = SPACES                      DTSBX771
00273         IF X771-INACTIVE-DATE       = SPACES                      DTSBX771
00274            PERFORM P1100-WRITE-REC1 THRU P1100-EXIT               DTSBX771
00275         ELSE                                                      DTSBX771
00276            PERFORM P1200-WRITE-REC2 THRU P1200-EXIT               DTSBX771
00277         END-IF                                                    DTSBX771
00278      ELSE                                                         DTSBX771
00279         IF X771-INACTIVE-DATE       = SPACES                      DTSBX771
00280            PERFORM P1300-WRITE-REC3 THRU P1300-EXIT               DTSBX771
00281         ELSE                                                      DTSBX771
00282            PERFORM P1400-WRITE-REC4 THRU P1400-EXIT               DTSBX771
00283         END-IF                                                    DTSBX771
00284      END-IF.                                                      DTSBX771
00285                                                                   DTSBX771
00286      IF NOT BX771-STATUS-OK-88                                    DTSBX771
00287         DISPLAY 'FILE STATUS IS : ' BX771-STATUS                  DTSBX771
00288         MOVE 'WRITE OUTPUT RECORD ERROR ' TO ABEND-MSG            DTSBX771
00289         PERFORM S999-ABEND THRU S999-EXIT.                        DTSBX771
00290                                                                   DTSBX771
00291                                                                   DTSBX771
00292  P1000-EXIT.                                                      DTSBX771
00293      EXIT.                                                        DTSBX771
00294                                                                   DTSBX771
00295  P1100-WRITE-REC1.                                                DTSBX771
00296      MOVE SPACES TO WRK-REC-AREA.                                 DTSBX771
00297                                                                   DTSBX771
00298      STRING                                                       DTSBX771
00299         X771-OBS-NBR ','                                          DTSBX771
00300         X771-EMP-NO ','                                           DTSBX771
00301         X771-EMP-STATUS ','                                       DTSBX771
00302         X771-EMP-TYPE ','                                         DTSBX771
00303         X771-LIAB-DATE ',' ',' ','                                DTSBX771
00304         X771-PROCESS-DATE ','                                     DTSBX771
00305         X771-LIAB-QTR-CNT ','                                     DTSBX771
00306         X771-QTR1-WAGES ','                                       DTSBX771
00307         X771-QTR2-WAGES ','                                       DTSBX771
00308         X771-QTR3-WAGES ','                                       DTSBX771
00309         X771-QTR4-WAGES ','                                       DTSBX771
00310         X771-QTR5-WAGES ','                                       DTSBX771
00311         X771-QTR6-WAGES ','                                       DTSBX771
00312         X771-QTR7-WAGES ','                                       DTSBX771
00313         X771-QTR8-WAGES ','                                       DTSBX771
00314         X771-REC1-FILLER                                          DTSBX771
00315            DELIMITED BY SIZE                                      DTSBX771
00316            INTO WRK-REC-AREA                                      DTSBX771
00317      END-STRING.                                                  DTSBX771
00318                                                                   DTSBX771
00319      MOVE WRK-REC-AREA (1:WRK-LEN) TO                             DTSBX771
00320           ACTIVE-EMPLOYERS-REC (1:WRK-LEN).                       DTSBX771
00321                                                                   DTSBX771
00322      WRITE ACTIVE-EMPLOYERS-REC.                                  DTSBX771
00323                                                                   DTSBX771
00324  P1100-EXIT.                                                      DTSBX771
00325      EXIT.                                                        DTSBX771
00326                                                                   DTSBX771
00327  P1200-WRITE-REC2.                                                DTSBX771
00328      MOVE SPACES TO WRK-REC-AREA.                                 DTSBX771
00329                                                                   DTSBX771
00330      STRING                                                       DTSBX771
00331         X771-OBS-NBR ','                                          DTSBX771
00332         X771-EMP-NO ','                                           DTSBX771
00333         X771-EMP-STATUS ','                                       DTSBX771
00334         X771-EMP-TYPE ','                                         DTSBX771
00335         X771-LIAB-DATE ',' ','                                    DTSBX771
00336         X771-INACTIVE-DATE ','                                    DTSBX771
00337         X771-PROCESS-DATE ','                                     DTSBX771
00338         X771-LIAB-QTR-CNT ','                                     DTSBX771
00339         X771-QTR1-WAGES ','                                       DTSBX771
00340         X771-QTR2-WAGES ','                                       DTSBX771
00341         X771-QTR3-WAGES ','                                       DTSBX771
00342         X771-QTR4-WAGES ','                                       DTSBX771
00343         X771-QTR5-WAGES ','                                       DTSBX771
00344         X771-QTR6-WAGES ','                                       DTSBX771
00345         X771-QTR7-WAGES ','                                       DTSBX771
00346         X771-QTR8-WAGES ','                                       DTSBX771
00347         X771-REC2-FILLER                                          DTSBX771
00348            DELIMITED BY SIZE                                      DTSBX771
00349            INTO WRK-REC-AREA                                      DTSBX771
00350      END-STRING.                                                  DTSBX771
00351                                                                   DTSBX771
00352      MOVE WRK-REC-AREA (1:WRK-LEN) TO                             DTSBX771
00353           ACTIVE-EMPLOYERS-REC (1:WRK-LEN).                       DTSBX771
00354                                                                   DTSBX771
00355      WRITE ACTIVE-EMPLOYERS-REC.                                  DTSBX771
00356                                                                   DTSBX771
00357  P1200-EXIT.                                                      DTSBX771
00358      EXIT.                                                        DTSBX771
00359                                                                   DTSBX771
00360  P1300-WRITE-REC3.                                                DTSBX771
00361      MOVE SPACES TO WRK-REC-AREA.                                 DTSBX771
00362                                                                   DTSBX771
00363      STRING                                                       DTSBX771
00364         X771-OBS-NBR ','                                          DTSBX771
00365         X771-EMP-NO ','                                           DTSBX771
00366         X771-EMP-STATUS ','                                       DTSBX771
00367         X771-EMP-TYPE ','                                         DTSBX771
00368         X771-LIAB-DATE ','                                        DTSBX771
00369         X771-REOPEN-PROCESS-DATE ',' ','                          DTSBX771
00370         X771-PROCESS-DATE ','                                     DTSBX771
00371         X771-LIAB-QTR-CNT ','                                     DTSBX771
00372         X771-QTR1-WAGES ','                                       DTSBX771
00373         X771-QTR2-WAGES ','                                       DTSBX771
00374         X771-QTR3-WAGES ','                                       DTSBX771
00375         X771-QTR4-WAGES ','                                       DTSBX771
00376         X771-QTR5-WAGES ','                                       DTSBX771
00377         X771-QTR6-WAGES ','                                       DTSBX771
00378         X771-QTR7-WAGES ','                                       DTSBX771
00379         X771-QTR8-WAGES ','                                       DTSBX771
00380         X771-REC3-FILLER                                          DTSBX771
00381            DELIMITED BY SIZE                                      DTSBX771
00382            INTO WRK-REC-AREA                                      DTSBX771
00383      END-STRING.                                                  DTSBX771
00384                                                                   DTSBX771
00385      MOVE WRK-REC-AREA (1:WRK-LEN) TO                             DTSBX771
00386           ACTIVE-EMPLOYERS-REC (1:WRK-LEN).                       DTSBX771
00387                                                                   DTSBX771
00388      WRITE ACTIVE-EMPLOYERS-REC.                                  DTSBX771
00389                                                                   DTSBX771
00390  P1300-EXIT.                                                      DTSBX771
00391      EXIT.                                                        DTSBX771
00392                                                                   DTSBX771
00393  P1400-WRITE-REC4.                                                DTSBX771
00394      MOVE SPACES TO WRK-REC-AREA.                                 DTSBX771
00395                                                                   DTSBX771
00396      STRING                                                       DTSBX771
00397         X771-OBS-NBR ','                                          DTSBX771
00398         X771-EMP-NO ','                                           DTSBX771
00399         X771-EMP-STATUS ','                                       DTSBX771
00400         X771-EMP-TYPE ','                                         DTSBX771
00401         X771-LIAB-DATE ','                                        DTSBX771
00402         X771-REOPEN-PROCESS-DATE ','                              DTSBX771
00403         X771-INACTIVE-DATE ','                                    DTSBX771
00404         X771-PROCESS-DATE ','                                     DTSBX771
00405         X771-LIAB-QTR-CNT ','                                     DTSBX771
00406         X771-QTR1-WAGES ','                                       DTSBX771
00407         X771-QTR2-WAGES ','                                       DTSBX771
00408         X771-QTR3-WAGES ','                                       DTSBX771
00409         X771-QTR4-WAGES ','                                       DTSBX771
00410         X771-QTR5-WAGES ','                                       DTSBX771
00411         X771-QTR6-WAGES ','                                       DTSBX771
00412         X771-QTR7-WAGES ','                                       DTSBX771
00413         X771-QTR8-WAGES ','                                       DTSBX771
00414         X771-REC4-FILLER                                          DTSBX771
00415            DELIMITED BY SIZE                                      DTSBX771
00416            INTO WRK-REC-AREA                                      DTSBX771
00417      END-STRING.                                                  DTSBX771
00418                                                                   DTSBX771
00419      MOVE WRK-REC-AREA (1:WRK-LEN) TO                             DTSBX771
00420           ACTIVE-EMPLOYERS-REC (1:WRK-LEN).                       DTSBX771
00421                                                                   DTSBX771
00422      WRITE ACTIVE-EMPLOYERS-REC.                                  DTSBX771
00423                                                                   DTSBX771
00424  P1400-EXIT.                                                      DTSBX771
00425      EXIT.                                                        DTSBX771
00426                                                                   DTSBX771
00427  T0000-TERMINATE.                                                 DTSBX771
00428      PERFORM T1000-UPDATE-LINK   THRU T1000-EXIT.                 DTSBX771
00429                                                                   DTSBX771
00430      MOVE WRK-RECS-WRITTEN-CNT  TO DISPLAY-CNT.                   DTSBX771
00431                                                                   DTSBX771
00432      DISPLAY '*********************************************'.     DTSBX771
00433      DISPLAY '       DTSBX771 TERMINATION STATISTICS       '.     DTSBX771
00434      DISPLAY '***'.                                               DTSBX771
00435      DISPLAY '    RECORDS WRITTEN ' DISPLAY-CNT.                  DTSBX771
00436                                                                   DTSBX771
00437      MOVE XL771-CON-EMP-CNT     TO DISPLAY-CNT.                   DTSBX771
00438      DISPLAY ' CONTRIBUTORY COUNT ' DISPLAY-CNT.                  DTSBX771
00439                                                                   DTSBX771
00440      MOVE XL771-REIMB-EMP-CNT     TO DISPLAY-CNT.                 DTSBX771
00441      DISPLAY ' REIMBURSABLE COUNT ' DISPLAY-CNT.                  DTSBX771
00442                                                                   DTSBX771
00443      MOVE XL771-TOT-EMP-CNT     TO DISPLAY-CNT.                   DTSBX771
00444      DISPLAY '        TOTAL COUNT ' DISPLAY-CNT.                  DTSBX771
00445                                                                   DTSBX771
00446      DISPLAY '***'.                                               DTSBX771
00447      DISPLAY '*********************************************'.     DTSBX771
00448                                                                   DTSBX771
00449      CLOSE       ACTIVE-EMPLOYERS.                                DTSBX771
00450  T0000-EXIT.                                                      DTSBX771
00451      EXIT.                                                        DTSBX771
00452                                                                   DTSBX771
00453  T1000-UPDATE-LINK.                                               DTSBX771
00454      MOVE WRK-CON-EMP-CNT       TO XL771-CON-EMP-CNT.             DTSBX771
00455      MOVE WRK-REIMB-EMP-CNT     TO XL771-REIMB-EMP-CNT.           DTSBX771
00456      COMPUTE XL771-TOT-EMP-CNT =                                  DTSBX771
00457         (WRK-CON-EMP-CNT + WRK-REIMB-EMP-CNT).                    DTSBX771
00458                                                                   DTSBX771
00459  T1000-EXIT.                                                      DTSBX771
00460      EXIT.                                                        DTSBX771
00461                                                                   DTSBX771
00462  S001-FROM-FED-8.                                                 DTSBX771
00463      SET L001-FROM-FED-8 TO TRUE.                                 DTSBX771
00464      GO TO S001-DATE.                                             DTSBX771
00465                                                                   DTSBX771
00466  S001-FROM-ABS-DAY.                                               DTSBX771
00467      SET L001-FROM-ABS-DAY TO TRUE.                               DTSBX771
00468      GO TO S001-DATE.                                             DTSBX771
00469                                                                   DTSBX771
00470  S001-FROM-CAL-6.                                                 DTSBX771
00471      SET L001-FROM-CAL-6 TO TRUE.                                 DTSBX771
00472      GO TO S001-DATE.                                             DTSBX771
00473                                                                   DTSBX771
00474  S001-DATE.                                                       DTSBX771
00475      CALL 'DTSBU001' USING L001-LINK-AREA.                        DTSBX771
00476  S001-EXIT.                                                       DTSBX771
00477      EXIT.                                                        DTSBX771
00478      SKIP3                                                        DTSBX771
00479  S004-FROM-5.                                                     DTSBX771
00480      SET L004-FROM-5 TO TRUE.                                     DTSBX771
00481      GO TO S004-QTR.                                              DTSBX771
00482                                                                   DTSBX771
00483  S004-FROM-ABS.                                                   DTSBX771
00484      SET L004-FROM-ABS TO TRUE.                                   DTSBX771
00485      GO TO S004-QTR.                                              DTSBX771
00486                                                                   DTSBX771
00487  S004-FROM-3.                                                     DTSBX771
00488      SET L004-FROM-3 TO TRUE.                                     DTSBX771
00489      GO TO S004-QTR.                                              DTSBX771
00490                                                                   DTSBX771
00491  S004-FROM-DATE.                                                  DTSBX771
00492      SET L004-FROM-DATE TO TRUE.                                  DTSBX771
00493      GO TO S004-QTR.                                              DTSBX771
00494                                                                   DTSBX771
00495  S004-QTR.                                                        DTSBX771
00496                                                                   DTSBX771
00497      CALL 'DTSBU004' USING L004-LINK-AREA.                        DTSBX771
00498                                                                   DTSBX771
00499  S004-EXIT.                                                       DTSBX771
00500      EXIT.                                                        DTSBX771
00501      SKIP3                                                        DTSBX771
00502                                                                   DTSBX771
00503  S999-ABEND.                                                      DTSBX771
00504      DISPLAY '*** DTSBD771 ABENDING.  '                           DTSBX771
00505              ABEND-MSG.                                           DTSBX771
00506                                                                   DTSBX771
00507      CALL 'DTSBU999' USING WRK-ABEND-CD.                          DTSBX771
00508  S999-EXIT.                                                       DTSBX771
00509      EXIT.                                                        DTSBX771
