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