00001  IDENTIFICATION DIVISION.                                         08/13/04
00002  PROGRAM-ID.             DTSBU083.                                DTSBU083
00003  AUTHOR.                 TRW.                                        LV003
00004  DATE-WRITTEN.           JUNE 2001.                               DTSBU083
00005  DATE-COMPILED.                                                   DTSBU083
00006      SKIP3                                                        DTSBU083
00007 *****                                                             DTSBU083
00008 *                                                                 DTSBU083
00009 *    FUNCTION:  CLAIMANT NAME LOOKUP FROM IB6 FILE.               DTSBU083
00010 *                                                                 DTSBU083
00011 *                                                                 DTSBU083
00012 *    MODIFICATION LOG:                                            DTSBU083
00013 *                                                                 DTSBU083
00014 *    07/22/2002  INITIAL DEVELOPMENT.                             DTSBU083
00015 *                WORK ORDER:                      PROGRAMMER: GD  DTSBU083
00016 *                                                                 DTSBU083
00017 *    07/22/2004  CORRECTED PROBLEM WITH L081-CLAIMANT-SSN.        DTSBU083
00018 *                THE BATCH PROGRAM WAS NOT CONSISTENT WITH        DTSBU083
00019 *                THE CICS PROGRAM.                                DTSBU083
00020 *                THE PROGRAM WAS MOVING THIS 9 DIGIT FIELD TO     DTSBU083
00021 *                THE 10 DIGIT VSAM-KEY (SSN PLUS SEQUENCE NUMBER).DTSBU083
00022 *                THE PROGRAM NOW BUILDS THE KEY IN WORKING-STORAGEDTSBU083
00023 *                AND MOVE THE FULL 10 DIGIT KEY.  THE SEQUENCE    DTSBU083
00024 *                NUMBER IS ALWAYS SET TO ZERO.                    DTSBU083
00025 *                REFERENCE:                     PROGRAMMER: GD    DTSBU083
00026 *                                                                 DTSBU083
00027 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBU083
00028 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBU083
00029 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSBU083
00030 *                                                                 DTSBU083
00031 *                                                                 DTSBU083
00032 *    DESCRIPTION:                                                 DTSBU083
00033 *                                                                 DTSBU083
00034 *   DTSBU083 IS PASSED L081-CLAIMANT-SSN. DTSBU083 READS THE      DTSBU083
00035 *   IB6 MASTER FILE.                                              DTSBU083
00036 *                                                                 DTSBU083
00037 *   IF THE CLAIMANT IS FOUND, THEN L081-CLAIMANT-NAME IS RETURNED DTSBU083
00038 *****                                                             DTSBU083
00039      SKIP3                                                        DTSBU083
00040  ENVIRONMENT DIVISION.                                            DTSBU083
00041      SKIP3                                                        DTSBU083
00042  DATA DIVISION.                                                   DTSBU083
00043      SKIP3                                                        DTSBU083
00044  WORKING-STORAGE SECTION.                                         DTSBU083
000445 77  PAN-VALET PICTURE X(24) VALUE '003DTSBU083  08/13/04'.       DTSBU083
00045      SKIP3                                                        DTSBU083
00046  01  WRK-AREA.                                                    DTSBU083
00047      05  WRK-ABEND-CODE              PIC  X(04)  VALUE 'U083'.    DTSBU083
00048                                                                   DTSBU083
00049      05  WRK-FIRST-TIME-IND          PIC  X(01)  VALUE 'Y'.       DTSBU083
00050          88  WRK-FIRST-TIME-YES-88 VALUE 'Y'.                     DTSBU083
00051          88  WRK-FIRST-TIME-NO-88  VALUE 'N'.                     DTSBU083
00052                                                                   DTSBU083
00053      05  WRK-KEY         PIC  9(10).                              DTSBU083
00054      05  FILLER REDEFINES WRK-KEY.                                DTSBU083
00055          10  WRK-SSN                 PIC  9(09).                  DTSBU083
00056          10  WRK-SSN-SEQ             PIC  9(01).                  DTSBU083
00057                                                                   DTSBU083
00058      05  WRK-SPACE-NEEDED-IND        PIC  X(01).                  DTSBU083
00059          88  WRK-SPACE-NEEDED-YES-88  VALUE 'Y'.                  DTSBU083
00060          88  WRK-SPACE-NEEDED-NO-88   VALUE 'N'.                  DTSBU083
00061                                                                   DTSBU083
00062      05  WRK-LEN                     PIC S9(04) COMP              DTSBU083
00063                                       VALUE +31.                  DTSBU083
00064      05  SUB1                        PIC S9(04) COMP.             DTSBU083
00065      05  SUB2                        PIC S9(04) COMP.             DTSBU083
00066                                                                   DTSBU083
00067      05  WRK-NAME.                                                DTSBU083
00068          10 WRK-FIRST-NAME           PIC X(12).                   DTSBU083
00069          10 WRK-MIDDLE-NAME          PIC X(01).                   DTSBU083
00070          10 WRK-LAST-NAME            PIC X(18).                   DTSBU083
00071                                                                   DTSBU083
00072      05  WRK-NAME-OUT                PIC X(32).                   DTSBU083
00073                                                                   DTSBU083
00074  01  EMSG-LITERALS.                                               DTSBU083
00075      05  EMSG-NO-REC.                                             DTSBU083
00076          10  FILLER                  PIC  X(31)                   DTSBU083
00077            VALUE 'NO BENEFITS RECORD FOUND       '.               DTSBU083
00078          10  FILLER                  PIC  X(16)                   DTSBU083
00079            VALUE SPACES.                                          DTSBU083
00080      05  EMSG-EOF.                                                DTSBU083
00081          10  FILLER                  PIC  X(31)                   DTSBU083
00082            VALUE 'END OF FILE                    '.               DTSBU083
00083          10  FILLER                  PIC  X(16)                   DTSBU083
00084            VALUE SPACES.                                          DTSBU083
00085      EJECT                                                        DTSBU083
00086  01  IB6-LINKAGE-SECTION.                                         DTSBU083
00087  ++INCLUDE IB6VSMCB                                               DTSBU083
00088      EJECT                                                        DTSBU083
00089  ++INCLUDE ESPDATEW                                               DTSBU083
00090      EJECT                                                        DTSBU083
00091  ++INCLUDE IB6SCCD                                                DTSBU083
00092      EJECT                                                        DTSBU083
00093  ++INCLUDE ESPSTRER                                               DTSBU083
00094      EJECT                                                        DTSBU083
00095  ++INCLUDE IB6SCSWA                                               DTSBU083
00096      EJECT                                                        DTSBU083
00097  ++INCLUDE IB6SCTWA                                               DTSBU083
00098      EJECT                                                        DTSBU083
00099  ++INCLUDE IB6SEG01                                               DTSBU083
00100      EJECT                                                        DTSBU083
00101  ++INCLUDE IB6SEG02                                               DTSBU083
00102      EJECT                                                        DTSBU083
00103  ++INCLUDE IB6SEG03                                               DTSBU083
00104      EJECT                                                        DTSBU083
00105  ++INCLUDE IB6TRAND                                               DTSBU083
00106      EJECT                                                        DTSBU083
00107  ++INCLUDE IB6HEADR                                               DTSBU083
00108      EJECT                                                        DTSBU083
00109  LINKAGE SECTION.                                                 DTSBU083
00110      SKIP3                                                        DTSBU083
00111  01  BU081-LINK-AREA.                                             DTSBU083
00112  ++INCLUDE DTSIL081                                               DTSBU083
00113      EJECT                                                        DTSBU083
00114  PROCEDURE DIVISION USING BU081-LINK-AREA.                        DTSBU083
00115      SKIP2                                                        DTSBU083
00116      IF WRK-FIRST-TIME-YES-88                                     DTSBU083
00117         PERFORM I0000-INIT           THRU I0000-EXIT              DTSBU083
00118         SET WRK-FIRST-TIME-NO-88     TO TRUE                      DTSBU083
00119         PERFORM P0000-FIND-NAME      THRU P0000-EXIT              DTSBU083
00120      ELSE                                                         DTSBU083
00121         PERFORM P0000-FIND-NAME      THRU P0000-EXIT.             DTSBU083
00122                                                                   DTSBU083
00123      GOBACK.                                                      DTSBU083
00124      EJECT                                                        DTSBU083
00125  I0000-INIT.                                                      DTSBU083
00126      MOVE 'DTSBU083'   TO DB-PROGRAM-NAME.                        DTSBU083
00127      SET DB-HEADER-RECORD        TO TRUE.                         DTSBU083
00128      SET DB-RANDOM-PROCESSING    TO TRUE.                         DTSBU083
00129      SET DB-OPEN-INPUT           TO TRUE.                         DTSBU083
00130      MOVE ZEROS                  TO DB-KEY.                       DTSBU083
00131                                                                   DTSBU083
00132      CALL 'IB6960D' USING IB6-LINKAGE-SECTION.                    DTSBU083
00133      IF DB-SUCCESSFUL-COMPLETION                                  DTSBU083
00134         NEXT SENTENCE                                             DTSBU083
00135      ELSE                                                         DTSBU083
00136         DISPLAY 'CANNOT OPEN IB6 FILE'                            DTSBU083
00137         PERFORM S9999-ABEND THRU S9999-EXIT.                      DTSBU083
00138                                                                   DTSBU083
00139  I0000-EXIT.                                                      DTSBU083
00140      EXIT.                                                        DTSBU083
00141  P0000-FIND-NAME.                                                 DTSBU083
00142      SET L081-NAME-NOT-FOUND TO TRUE.                             DTSBU083
00143                                                                   DTSBU083
00144      MOVE SPACES TO L081-CLAIMANT-NAME                            DTSBU083
00145                     L081-MSG-AREA.                                DTSBU083
00146                                                                   DTSBU083
00147      SET DB-RANDOM-PROCESSING        TO TRUE.                     DTSBU083
00148      SET DB-IB6-PROFILE              TO TRUE.                     DTSBU083
00149      SET DB-READ-SEGMENT             TO TRUE.                     DTSBU083
00150      MOVE L081-CLAIMANT-SSN          TO WRK-SSN.                  DTSBU083
00151      MOVE ZERO                       TO WRK-SSN-SEQ.              DTSBU083
00152      MOVE WRK-KEY                    TO VSAM-KEY.                 DTSBU083
00153                                                                   DTSBU083
00154      CALL 'IB6960D' USING IB6-LINKAGE-SECTION.                    DTSBU083
00155      IF DB-SUCCESSFUL-COMPLETION                                  DTSBU083
00156         SET L081-NAME-FOUND TO TRUE                               DTSBU083
00157         PERFORM P1000-FORMAT-NAME      THRU P1000-EXIT            DTSBU083
00158         MOVE WRK-NAME-OUT            TO L081-CLAIMANT-NAME        DTSBU083
00159      ELSE                                                         DTSBU083
00160      IF DB-NO-RECORD-FOUND                                        DTSBU083
00161         SET L081-NAME-NOT-FOUND TO TRUE                           DTSBU083
00162         MOVE EMSG-NO-REC      TO L081-MSG-TEXT                    DTSBU083
00163      ELSE                                                         DTSBU083
00164         PERFORM S9999-ABEND THRU S9999-EXIT.                      DTSBU083
00165                                                                   DTSBU083
00166  P0000-EXIT.                                                      DTSBU083
00167      EXIT.                                                        DTSBU083
00168                                                                   DTSBU083
00169  P1000-FORMAT-NAME.                                               DTSBU083
00170         MOVE SPACES                    TO WRK-NAME                DTSBU083
00171                                           WRK-NAME-OUT.           DTSBU083
00172                                                                   DTSBU083
00173         MOVE IN1-CLAIM-FIRST-NAME      TO WRK-FIRST-NAME.         DTSBU083
00174         MOVE IN1-CLAIM-MIDDLE-NAME     TO WRK-MIDDLE-NAME         DTSBU083
00175         MOVE IN1-CLAIM-LAST-NAME       TO WRK-LAST-NAME           DTSBU083
00176                                                                   DTSBU083
00177         SET WRK-SPACE-NEEDED-YES-88    TO TRUE.                   DTSBU083
00178         MOVE +0                        TO SUB2.                   DTSBU083
00179         PERFORM P1100-PARSE            THRU P1100-EXIT.           DTSBU083
00180                                                                   DTSBU083
00181         MOVE WRK-NAME-OUT              TO L081-CLAIMANT-NAME.     DTSBU083
00182                                                                   DTSBU083
00183  P1000-EXIT.                                                      DTSBU083
00184      EXIT.                                                        DTSBU083
00185                                                                   DTSBU083
00186  P1100-PARSE.                                                     DTSBU083
00187      PERFORM                                                      DTSBU083
00188         VARYING SUB1 FROM +1 BY +1                                DTSBU083
00189         UNTIL SUB1 > WRK-LEN                                      DTSBU083
00190            IF WRK-NAME (SUB1:1) NOT = SPACE                       DTSBU083
00191               SET WRK-SPACE-NEEDED-YES-88 TO TRUE                 DTSBU083
00192               ADD +1 TO SUB2                                      DTSBU083
00193               MOVE WRK-NAME (SUB1:1) TO WRK-NAME-OUT (SUB2:1)     DTSBU083
00194               IF SUB1 = +13                                       DTSBU083
00195                  ADD +1 TO SUB2                                   DTSBU083
00196                  MOVE SPACE TO  WRK-NAME-OUT (SUB2:1)             DTSBU083
00197               END-IF                                              DTSBU083
00198            ELSE                                                   DTSBU083
00199               IF WRK-SPACE-NEEDED-YES-88                          DTSBU083
00200                  ADD +1 TO SUB2                                   DTSBU083
00201                  MOVE SPACE TO  WRK-NAME-OUT (SUB2:1)             DTSBU083
00202                  SET WRK-SPACE-NEEDED-NO-88 TO TRUE               DTSBU083
00203               END-IF                                              DTSBU083
00204            END-IF                                                 DTSBU083
00205      END-PERFORM.                                                 DTSBU083
00206                                                                   DTSBU083
00207  P1100-EXIT.                                                      DTSBU083
00208      EXIT.                                                        DTSBU083
00209                                                                   DTSBU083
00210  S9999-ABEND.                                                     DTSBU083
00211      SKIP1                                                        DTSBU083
00212      CALL 'DTSBU999' USING WRK-ABEND-CODE.                        DTSBU083
00213      SKIP1                                                        DTSBU083
00214  S9999-EXIT.                                                      DTSBU083
00215      EXIT.                                                        DTSBU083