00001  IDENTIFICATION DIVISION.                                         04/08/10
00002  PROGRAM-ID.             DESBD321.                                DESBD321
00003  AUTHOR.                 NGC.                                        LV005
00004  DATE-WRITTEN.           APRIL 2009.                              DESBD321
00005  DATE-COMPILED.                                                   DESBD321
00006      SKIP3                                                        DESBD321
00007 *****                                                             DESBD321
00008 *                                                                 DESBD321
00009 *                                                                 DESBD321
00010 *    FUNCTION:  EXTRACT CLAIMANT NAMES FROM BENEFITS              DESBD321
00011 *               MASTER FILE FOR DOWNLOAD TO SERVER                DESBD321
00012 *                                                                 DESBD321
00013 *    MODIFICATION LOG:                                            DESBD321
00014 *                                                                 DESBD321
00015 *    04/08/2009  INITIAL DEVELOPMENT.                             DESBD321
00016 *                WORK ORDER:                      PROGRAMMER: GD  DESBD321
00017 *                                                                 DESBD321
00018 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DESBD321
00019 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DESBD321
00020 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DESBD321
00021 *                                                                 DESBD321
00022 *                                                                 DESBD321
00023 *    DESCRIPTION:                                                 DESBD321
00024 *                                                                 DESBD321
00025 *                                                                 DESBD321
00026 *    MODULES CALLED:                                              DESBD321
00027 *                                                                 DESBD321
00028 *                                                                 DESBD321
00029 *                                                                 DESBD321
00030 *****                                                             DESBD321
00031      SKIP3                                                        DESBD321
00032  ENVIRONMENT DIVISION.                                            DESBD321
00033  INPUT-OUTPUT SECTION.                                            DESBD321
00034                                                                   DESBD321
00035  FILE-CONTROL.                                                    DESBD321
00036                                                                   DESBD321
00037      SELECT SSN-NAME-FILE ASSIGN TO DESFB321                      DESBD321
00038                           FILE STATUS IS NAME-STATUS.             DESBD321
00039                                                                   DESBD321
00040  DATA DIVISION.                                                   DESBD321
00041  FILE SECTION.                                                    DESBD321
00042                                                                   DESBD321
00043  FD  SSN-NAME-FILE                                                DESBD321
00044      RECORDING MODE IS F                                          DESBD321
00045      BLOCK CONTAINS 0 RECORDS                                     DESBD321
00046      LABEL RECORDS ARE OMITTED.                                   DESBD321
00047                                                                   DESBD321
00048  01  SSN-NAME-REC                      PIC X(46).                 DESBD321
00049                                                                   DESBD321
00050  WORKING-STORAGE SECTION.                                         DESBD321
000505 77  PAN-VALET PICTURE X(24) VALUE '005DESBD321  04/08/10'.       DESBD321
00051      SKIP3                                                        DESBD321
00052                                                                   DESBD321
00053  01  WRK-AREA.                                                    DESBD321
00054      05  WRK-ABEND-CODE              PIC  X(04)  VALUE 'B321'.    DESBD321
00055                                                                   DESBD321
00056      05  NAME-STATUS                 PIC  X(02).                  DESBD321
00057          88  NAME-STATUS-OK-88         VALUE '00'.                DESBD321
00058                                                                   DESBD321
00059      05  WRK-ERROR-IND               PIC  X(01).                  DESBD321
00060          88  WRK-ERROR-YES-88         VALUE 'Y'.                  DESBD321
00061                                                                   DESBD321
00062      05  WRK-CURR-SSN                PIC S9(09) COMP-3 VALUE +0.  DESBD321
00063                                                                   DESBD321
00064      05  NAME-REFORMAT-AREA.                                      DESBD321
00065          10  NAME-MAX                PIC S9(04) COMP   VALUE +32. DESBD321
00066          10  S1                      PIC S9(04) COMP   VALUE +0.  DESBD321
00067          10  S2                      PIC S9(04) COMP   VALUE +0.  DESBD321
00068          10  S3                      PIC S9(04) COMP   VALUE +0.  DESBD321
00069          10  WRK-LAST-FOUND          PIC  X(01).                  DESBD321
00070              88  WRK-LAST-FOUND-YES-88  VALUE 'Y'.                DESBD321
00071              88  WRK-LAST-FOUND-NO-88   VALUE 'N'.                DESBD321
00072          10  WRK-FIRST-FOUND         PIC  X(01).                  DESBD321
00073              88  WRK-FIRST-FOUND-YES-88  VALUE 'Y'.               DESBD321
00074              88  WRK-FIRST-FOUND-NO-88   VALUE 'N'.               DESBD321
00075          10  WRK-INIT-FOUND          PIC  X(01).                  DESBD321
00076              88  WRK-INIT-FOUND-YES-88   VALUE 'Y'.               DESBD321
00077              88  WRK-INIT-FOUND-NO-88    VALUE 'N'.               DESBD321
00078          10  WRK-LAST-NAME           PIC  X(32).                  DESBD321
00079          10  WRK-FIRST-NAME          PIC  X(32).                  DESBD321
00080          10  WRK-MID-INIT            PIC  X(01).                  DESBD321
00081                                                                   DESBD321
00082      05  WRK-SSN-IN-CNT              PIC S9(09) COMP-3 VALUE +0.  DESBD321
00083      05  WRK-X147-CNT                PIC S9(09) COMP-3 VALUE +0.  DESBD321
00084                                                                   DESBD321
00085                                                                   DESBD321
00086  01  COMMON-LINKAGE-SECTION.                                      DESBD321
00087                                                                   DESBD321
00088  ++INCLUDE ESPLINKB                                               DESBD321
00089                                                                   DESBD321
00090  ++INCLUDE EWGLINKB                                               DESBD321
00091                                                                   DESBD321
00092  ++INCLUDE EWGTRNB0                                               DESBD321
00093                                                                   DESBD321
00094  01  L001-LINK-AREA.                                              DESBD321
00095  ++INCLUDE DTSIL001                                               DESBD321
00096                                                                   DESBD321
00097  01  L005-LINK-AREA.                                              DESBD321
00098  ++INCLUDE DTSIL005                                               DESBD321
00099                                                                   DESBD321
00100  01  WRK-X147-REC.                                                DESBD321
00101  ++INCLUDE DTSIX147                                               DESBD321
00102                                                                   DESBD321
00103  PROCEDURE DIVISION.                                              DESBD321
00104      PERFORM I0000-INIT              THRU I0000-EXIT.             DESBD321
00105                                                                   DESBD321
00106      PERFORM P0000-PROCESS           THRU P0000-EXIT.             DESBD321
00107                                                                   DESBD321
00108      PERFORM T0000-TERMINATE         THRU T0000-EXIT.             DESBD321
00109      GOBACK.                                                      DESBD321
00110      EJECT                                                        DESBD321
00111  I0000-INIT.                                                      DESBD321
00112      PERFORM I1000-OPEN-FILES        THRU I1000-EXIT.             DESBD321
00113                                                                   DESBD321
00114  I0000-EXIT.                                                      DESBD321
00115      EXIT.                                                        DESBD321
00116                                                                   DESBD321
00117  I1000-OPEN-FILES.                                                DESBD321
00118      OPEN OUTPUT SSN-NAME-FILE.                                   DESBD321
00119      IF NOT NAME-STATUS-OK-88                                     DESBD321
00120         DISPLAY 'CANNOT OPEN SSN-NAME FILE ' NAME-STATUS          DESBD321
00121         PERFORM S9999-ABEND THRU S9999-EXIT                       DESBD321
00122      END-IF.                                                      DESBD321
00123                                                                   DESBD321
00124      MOVE 'DESBD321'             TO DB-PROGRAM-NAME.              DESBD321
00125      SET DB-HEADER-RECORD        TO TRUE.                         DESBD321
00126      SET DB-RANDOM-PROCESSING    TO TRUE.                         DESBD321
00127      SET DB-OPEN-INPUT           TO TRUE.                         DESBD321
00128      MOVE ZEROS                  TO DB-KEY.                       DESBD321
00129                                                                   DESBD321
00130      CALL 'ESP960D' USING COMMON-LINKAGE-SECTION.                 DESBD321
00131      IF DB-SUCCESSFUL-COMPLETION                                  DESBD321
00132         NEXT SENTENCE                                             DESBD321
00133      ELSE                                                         DESBD321
00134         DISPLAY 'CANNOT OPEN BENEFITS FILE'                       DESBD321
00135         PERFORM S9999-ABEND THRU S9999-EXIT                       DESBD321
00136      END-IF.                                                      DESBD321
00137                                                                   DESBD321
00138  I1000-EXIT.                                                      DESBD321
00139      EXIT.                                                        DESBD321
00140                                                                   DESBD321
00141  P0000-PROCESS.                                                   DESBD321
00142      PERFORM S1000-RESET-ALL          THRU S1000-EXIT.            DESBD321
00143      PERFORM S1100-READ-SEG01         THRU S1100-EXIT.            DESBD321
00144                                                                   DESBD321
00145      PERFORM UNTIL DB-END-OF-FILE                                 DESBD321
00146        IF CPD-SSN-SEQ = 0                                         DESBD321
00147           PERFORM P1000-BUILD-X147  THRU P1000-EXIT               DESBD321
00148        END-IF                                                     DESBD321
00149        PERFORM S1100-READ-SEG01       THRU S1100-EXIT             DESBD321
00150      END-PERFORM.                                                 DESBD321
00151                                                                   DESBD321
00152  P0000-EXIT.                                                      DESBD321
00153      EXIT.                                                        DESBD321
00154                                                                   DESBD321
00155  P1000-BUILD-X147.                                                DESBD321
00156      MOVE CPD-SSN                       TO X147-SSN.              DESBD321
00157                                                                   DESBD321
00158      MOVE CPD-INITIAL-ENTRY-DATE        TO L001-FED-8-DATE-9.     DESBD321
00159      PERFORM S001-FROM-FED-8            THRU S001-EXIT.           DESBD321
00160      IF NOT L001-VALID-DATE                                       DESBD321
00161         DISPLAY 'BD321 INVALID EFF DT ' CPD-SSN                   DESBD321
00162            '  ' CPD-INITIAL-ENTRY-DATE                            DESBD321
00163         MOVE CPD-INITIAL-ENTRY-DATE     TO L001-FED-8-DATE-9      DESBD321
00164         MOVE 2008                       TO L001-FED-8-YR          DESBD321
00165         PERFORM S001-FROM-FED-8         THRU S001-EXIT            DESBD321
00166         IF L001-VALID-DATE                                        DESBD321
00167            MOVE L001-FED-8-DATE-9       TO X147-EFF-DATE          DESBD321
00168         ELSE                                                      DESBD321
00169            DISPLAY 'STILL BAD ' CPD-SSN '  '                      DESBD321
00170               L001-FED-8-DATE-9                                   DESBD321
00171            MOVE 20091101                TO X147-EFF-DATE          DESBD321
00172         END-IF                                                    DESBD321
00173      ELSE                                                         DESBD321
00174         MOVE L001-FED-8-DATE-9          TO X147-EFF-DATE          DESBD321
00175      END-IF.                                                      DESBD321
00176                                                                   DESBD321
00177      PERFORM P1100-REFORMAT-NAME        THRU P1100-EXIT.          DESBD321
00178      MOVE WRK-LAST-NAME                 TO X147-LAST-NAME         DESBD321
00179      MOVE WRK-FIRST-NAME                TO X147-FIRST-NAME        DESBD321
00180      MOVE WRK-MID-INIT                  TO X147-MID-INIT.         DESBD321
00181                                                                   DESBD321
00182      WRITE SSN-NAME-REC                 FROM WRK-X147-REC.        DESBD321
00183      IF NOT NAME-STATUS-OK-88                                     DESBD321
00184         DISPLAY 'CANNOT WRITE NAME REC ' NAME-STATUS              DESBD321
00185         PERFORM S9999-ABEND             THRU S9999-EXIT           DESBD321
00186      ELSE                                                         DESBD321
00187         ADD +1                          TO WRK-X147-CNT           DESBD321
00188      END-IF.                                                      DESBD321
00189                                                                   DESBD321
00190  P1000-EXIT.                                                      DESBD321
00191      EXIT.                                                        DESBD321
00192                                                                   DESBD321
00193  P1100-REFORMAT-NAME.                                             DESBD321
00194      INSPECT CPD-NAME REPLACING ALL ',' BY SPACE.                 DESBD321
00195      INSPECT CPD-NAME REPLACING ALL LOW-VALUES BY SPACE.          DESBD321
00196                                                                   DESBD321
00197      MOVE SPACES                     TO WRK-LAST-NAME             DESBD321
00198                                         WRK-FIRST-NAME            DESBD321
00199                                         WRK-MID-INIT.             DESBD321
00200                                                                   DESBD321
00201      MOVE ZERO                       TO S1                        DESBD321
00202                                         S2.                       DESBD321
00203                                                                   DESBD321
00204                                                                   DESBD321
00205      SET WRK-LAST-FOUND-NO-88        TO TRUE.                     DESBD321
00206      SET WRK-FIRST-FOUND-NO-88       TO TRUE.                     DESBD321
00207      SET WRK-INIT-FOUND-NO-88        TO TRUE.                     DESBD321
00208                                                                   DESBD321
00209 **    FIND LAST NAME                                              DESBD321
00210      PERFORM                                                      DESBD321
00211       VARYING S1 FROM +1 BY +1                                    DESBD321
00212       UNTIL WRK-LAST-FOUND-YES-88                                 DESBD321
00213       OR S1 > NAME-MAX                                            DESBD321
00214        IF CPD-NAME (S1:1) NOT = '/'                               DESBD321
00215           ADD +1                      TO S2                       DESBD321
00216           MOVE CPD-NAME (S1:1)        TO WRK-LAST-NAME(S2:1)      DESBD321
00217        ELSE                                                       DESBD321
00218           MOVE S1                     TO S3                       DESBD321
00219           SET WRK-LAST-FOUND-YES-88   TO TRUE                     DESBD321
00220        END-IF                                                     DESBD321
00221      END-PERFORM.                                                 DESBD321
00222                                                                   DESBD321
00223 **    FIND FIRST NAME                                             DESBD321
00224      MOVE ZERO                        TO S2.                      DESBD321
00225                                                                   DESBD321
00226      IF S3 = +32                                                  DESBD321
00227         GO TO P1100-EXIT                                          DESBD321
00228      END-IF.                                                      DESBD321
00229                                                                   DESBD321
00230      ADD +1                           TO S3.                      DESBD321
00231                                                                   DESBD321
00232      PERFORM                                                      DESBD321
00233       VARYING S1 FROM S3 BY +1                                    DESBD321
00234       UNTIL WRK-FIRST-FOUND-YES-88                                DESBD321
00235       OR S1 > NAME-MAX                                            DESBD321
00236        IF CPD-NAME (S1:1) NOT = ' '                               DESBD321
00237           ADD +1                      TO S2                       DESBD321
00238           MOVE CPD-NAME (S1:1)        TO WRK-FIRST-NAME(S2:1)     DESBD321
00239        ELSE                                                       DESBD321
00240           MOVE S1                     TO S3                       DESBD321
00241           SET WRK-FIRST-FOUND-YES-88  TO TRUE                     DESBD321
00242        END-IF                                                     DESBD321
00243      END-PERFORM.                                                 DESBD321
00244                                                                   DESBD321
00245 **    FIND MIDDLE INITIAL                                         DESBD321
00246                                                                   DESBD321
00247      IF S3 = +32                                                  DESBD321
00248         GO TO P1100-EXIT                                          DESBD321
00249      END-IF.                                                      DESBD321
00250                                                                   DESBD321
00251      PERFORM                                                      DESBD321
00252       VARYING S1 FROM NAME-MAX BY -1                              DESBD321
00253       UNTIL WRK-INIT-FOUND-YES-88                                 DESBD321
00254       OR S1 < S3                                                  DESBD321
00255        IF CPD-NAME (S1:1) NOT = ' '                               DESBD321
00256           IF CPD-NAME ((S1 - 1):1)  = ' '                         DESBD321
00257              MOVE CPD-NAME (S1:1)        TO WRK-MID-INIT          DESBD321
00258              SET WRK-INIT-FOUND-YES-88   TO TRUE                  DESBD321
00259           END-IF                                                  DESBD321
00260        END-IF                                                     DESBD321
00261      END-PERFORM.                                                 DESBD321
00262                                                                   DESBD321
00263                                                                   DESBD321
00264  P1100-EXIT.                                                      DESBD321
00265      EXIT.                                                        DESBD321
00266                                                                   DESBD321
00267                                                                   DESBD321
00268  S1000-RESET-ALL.                                                 DESBD321
00269      SET DB-RESET-POINTERS           TO TRUE.                     DESBD321
00270      SET DB-RANDOM-PROCESSING        TO TRUE.                     DESBD321
00271      SET DB-BENEFIT-PAYMENTS         TO TRUE.                     DESBD321
00272      SET DB-ALL-SEGMENTS             TO TRUE.                     DESBD321
00273                                                                   DESBD321
00274      CALL 'ESP960D' USING COMMON-LINKAGE-SECTION.                 DESBD321
00275                                                                   DESBD321
00276  S1000-EXIT.                                                      DESBD321
00277      EXIT.                                                        DESBD321
00278                                                                   DESBD321
00279  S1100-READ-SEG01.                                                DESBD321
00280      SET DB-SEQUENTIAL-PROCESSING    TO TRUE.                     DESBD321
00281      SET DB-CLAIMANT-PROFILE         TO TRUE.                     DESBD321
00282      SET DB-READ-SEGMENT             TO TRUE.                     DESBD321
00283                                                                   DESBD321
00284      CALL 'ESP960D' USING COMMON-LINKAGE-SECTION.                 DESBD321
00285                                                                   DESBD321
00286      IF DB-SUCCESSFUL-COMPLETION                                  DESBD321
00287         ADD +1               TO WRK-SSN-IN-CNT                    DESBD321
00288      ELSE                                                         DESBD321
00289         IF DB-END-OF-FILE                                         DESBD321
00290            NEXT SENTENCE                                          DESBD321
00291         ELSE                                                      DESBD321
00292            DISPLAY 'BAD READ ON SEG01 ' DB-COMPLETION-CODE        DESBD321
00293            SET DB-END-OF-FILE    TO TRUE                          DESBD321
00294         END-IF                                                    DESBD321
00295      END-IF.                                                      DESBD321
00296                                                                   DESBD321
00297  S1100-EXIT.                                                      DESBD321
00298      EXIT.                                                        DESBD321
00299                                                                   DESBD321
00300  T0000-TERMINATE.                                                 DESBD321
00301                                                                   DESBD321
00302      CLOSE SSN-NAME-FILE.                                         DESBD321
00303                                                                   DESBD321
00304      MOVE 'C' TO DB-COMMAND-CODE.                                 DESBD321
00305                                                                   DESBD321
00306      CALL 'ESP960D' USING COMMON-LINKAGE-SECTION.                 DESBD321
00307                                                                   DESBD321
00308      DISPLAY 'SEG1 READ    ' WRK-SSN-IN-CNT.                      DESBD321
00309      DISPLAY 'X147 WRITTEN ' WRK-X147-CNT.                        DESBD321
00310                                                                   DESBD321
00311  T0000-EXIT.                                                      DESBD321
00312      EXIT.                                                        DESBD321
00313                                                                   DESBD321
00314  S001-FROM-FED-8.                                                 DESBD321
00315      SET L001-FROM-FED-8 TO TRUE.                                 DESBD321
00316      GO TO S001-DATE.                                             DESBD321
00317                                                                   DESBD321
00318  S001-FROM-ABS-DAY.                                               DESBD321
00319      SET L001-FROM-ABS-DAY TO TRUE.                               DESBD321
00320      GO TO S001-DATE.                                             DESBD321
00321                                                                   DESBD321
00322  S001-FROM-CAL-6.                                                 DESBD321
00323      SET L001-FROM-CAL-6 TO TRUE.                                 DESBD321
00324      GO TO S001-DATE.                                             DESBD321
00325                                                                   DESBD321
00326  S001-DATE.                                                       DESBD321
00327      CALL 'DTSBU001' USING L001-LINK-AREA.                        DESBD321
00328  S001-EXIT.                                                       DESBD321
00329      EXIT.                                                        DESBD321
00330                                                                   DESBD321
00331                                                                   DESBD321
00332  S005-FROM-SYS.                                                   DESBD321
00333                                                                   DESBD321
00334      SET L005-FROM-SYS TO TRUE.                                   DESBD321
00335      GO TO S005-ABSTIME.                                          DESBD321
00336                                                                   DESBD321
00337  S005-ABSTIME.                                                    DESBD321
00338                                                                   DESBD321
00339      CALL 'DTSBU005' USING L005-LINK-AREA.                        DESBD321
00340                                                                   DESBD321
00341  S005-EXIT.                                                       DESBD321
00342      EXIT.                                                        DESBD321
00343                                                                   DESBD321
00344  S9999-ABEND.                                                     DESBD321
00345      SKIP1                                                        DESBD321
00346      CALL 'DTSBU999' USING WRK-ABEND-CODE.                        DESBD321
00347      SKIP1                                                        DESBD321
00348  S9999-EXIT.                                                      DESBD321
00349      EXIT.                                                        DESBD321
