00001  IDENTIFICATION DIVISION.                                         05/09/25
00002  PROGRAM-ID.             DTSBU081.                                DTSBU081
00003  AUTHOR.                 TRW.                                        LV023
00004  DATE-WRITTEN.           JUNE 2001.                               DTSBU081
00005  DATE-COMPILED.                                                   DTSBU081
00006      SKIP3                                                        DTSBU081
00007 *****                                                             DTSBU081
00008 *                                                                 DTSBU081
00009 *    FUNCTION:  CLAIMANT NAME LOOKUP.                             DTSBU081
00010 *                                                                 DTSBU081
00011 *                                                                 DTSBU081
00012 *    MODIFICATION LOG:                                            DTSBU081
00013 *                                                                 DTSBU081
00014 *    11/26/91  INITIAL DEVELOPMENT.                               DTSBU081
00015 *              WORK ORDER:                      PROGRAMMER: TCL   DTSBU081
00016 *                                                                 DTSBU081
00017 *    04/01/94  MODIFIED FOR MONTANA.                              DTSBU081
00018 *              WORK ORDER:                      PROGRAMMER: EHH   DTSBU081
00019 *                                                                 DTSBU081
00020 *    09/08/1998  THE LINK TO THE UI BENEFITS SYSTEM CLAIMANT      DTSBU081
00021 *                MASTER FILE IS PLUGGED.  WHEN THE UI BENEFITS    DTSBU081
00022 *                SYSTEM CLAIMANT MASTER FILE IS AVAILABLE, THIS   DTSBU081
00023 *                MODULE MUST BE REVISITED.                        DTSBU081
00024 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH   DTSBU081
00025 *                                                                 DTSBU081
00026 *    06/01/2002  MODED DTSCU081 TO THIS BATCH VERSION TO PICK     DTSBU081
00027 *                UP THE CLAIMANT NAME FROM THE BENEFITS SYSTEM    DTSBU081
00028 *                CLAIMANT MASTER FILE.                            DTSBU081
00029 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: G-D   DTSBU081
00030 *                                                                 DTSBU081
00031 *    07/06/2004  CORRECTED PROBLEM WITH L081-CLAIMANT-SSN.        DTSBU081
00032 *                THE BATCH PROGRAM WAS NOT CONSISTENT WITH        DTSBU081
00033 *                THE CICS PROGRAM.                                DTSBU081
00034 *                THE PROGRAM WAS MOVING THIS 9 DIGIT FIELD TO     DTSBU081
00035 *                THE 10 DIGIT VSAM-KEY (SSN PLUS SEQUENCE NUMBER).DTSBU081
00036 *                THE PROGRAM NOW BUILDS THE KEY IN WORKING-STORAGEDTSBU081
00037 *                AND MOVE THE FULL 10 DIGIT KEY.  THE SEQUENCE    DTSBU081
00038 *                NUMBER IS ALWAYS SET TO ZERO.                    DTSBU081
00039 *                REFERENCE:                     PROGRAMMER: GD    DTSBU081
00040 *                                                                 DTSBU081
00041 *    07/14/2004  REMOVED DISPLAYS.                                DTSBU081
00042 *                REFERENCE:                     PROGRAMMER: GD    DTSBU081
00043 *                                                                 DTSBU081
00044 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBU081
00045 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSBU081
00046 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSBU081
00047 *                                                                 DTSBU081
00048 *                                                                 DTSBU081
00049 *    DESCRIPTION:                                                 DTSBU081
00050 *                                                                 DTSBU081
00051 *   DTSBU081 IS PASSED L081-CLAIMANT-SSN. DTSBU081 READS THE      DTSBU081
00052 *   BENEFITS MASTER FILE.                                         DTSBU081
00053 *                                                                 DTSBU081
00054 *   IF THE CLAIMANT IS FOUND, THEN L081-CLAIMANT-NAME IS RETURNED DTSBU081
00055 *****                                                             DTSBU081
00056      SKIP3                                                        DTSBU081
00057  ENVIRONMENT DIVISION.                                            DTSBU081
00058      SKIP3                                                        DTSBU081
00059  DATA DIVISION.                                                   DTSBU081
00060      SKIP3                                                        DTSBU081
00061  WORKING-STORAGE SECTION.                                         DTSBU081
000615 77  PAN-VALET PICTURE X(24) VALUE '023DTSBU081  05/09/25'.       DTSBU081
00062  77  PAN-VALET PICTURE X(24) VALUE '001DTSBU081  01/05/10'.       DTSBU081
00063      SKIP3                                                        DTSBU081
00064  01  WRK-AREA.                                                    DTSBU081
00065      05  WRK-ABEND-CODE              PIC  X(04)  VALUE 'U081'.    DTSBU081
00066                                                                   DTSBU081
00067      05  WRK-KEY         PIC  9(10).                              DTSBU081
00068      05  FILLER REDEFINES WRK-KEY.                                DTSBU081
00069          10  WRK-SSN                 PIC  9(09).                  DTSBU081
00070          10  WRK-SSN-SEQ             PIC  9(01).                  DTSBU081
00071                                                                   DTSBU081
00072      05  WRK-FIRST-TIME-IND          PIC  X(01)  VALUE 'Y'.       DTSBU081
00073          88  WRK-FIRST-TIME-YES-88 VALUE 'Y'.                     DTSBU081
00074          88  WRK-FIRST-TIME-NO-88  VALUE 'N'.                     DTSBU081
00075                                                                   DTSBU081
00076      05 WRK-CLAIMANT-NAME             PIC X(32) VALUE SPACES.        CL*16
00077      05 WRK-CZNAME                    PIC X(12) VALUE SPACES.        CL*18
00078      05 WRK-CFNAME.                                                  CL*18
00079             15 WRK-CFNAMEA               PIC X(01) VALUE '/'.        CL*16
00080             15 WRK-CFNAMEB               PIC X(11) VALUE SPACES.     CL*16
00081      05 WRK-NAME.                                                    CL**2
00082          10 WRK-LNAME                PIC X(15) VALUE SPACES.         CL*17
00083          10 WRK-FNAME                PIC X(12) VALUE SPACES.         CL*17
00084          10 WRK-INAME                PIC X(01) VALUE SPACES.         CL**2
00085                                                                      CL**2
00086      05  W-SSN                     PIC S9(09)  COMP-3  VALUE 0.      CL**5
00087                                                                      CL**4
00088  01  EMSG-LITERALS.                                               DTSBU081
00089      05  EMSG-NO-REC.                                             DTSBU081
00090          10  FILLER                  PIC  X(31)                   DTSBU081
00091            VALUE 'NO BENEFITS RECORD FOUND       '.               DTSBU081
00092          10  FILLER                  PIC  X(16)                   DTSBU081
00093            VALUE SPACES.                                          DTSBU081
00094      05  EMSG-EOF.                                                DTSBU081
00095          10  FILLER                  PIC  X(31)                   DTSBU081
00096            VALUE 'END OF FILE                    '.               DTSBU081
00097          10  FILLER                  PIC  X(16)                   DTSBU081
00098            VALUE SPACES.                                          DTSBU081
00099      EJECT                                                        DTSBU081
00100  01  L982-LINK-AREA.                                                 CL**3
00101  ++INCLUDE DTSIL982                                                  CL**3
00102                                                                      CL**3
00103  01  WNAM-REC.                                                       CL**5
00104  ++INCLUDE DTSIWNAM                                                  CL**4
00105                                                                      CL**4
00106  LINKAGE SECTION.                                                 DTSBU081
00107      SKIP3                                                        DTSBU081
00108  01  BU081-LINK-AREA.                                             DTSBU081
00109  ++INCLUDE DTSIL081                                               DTSBU081
00110                                                                      CL**3
00111      EJECT                                                        DTSBU081
00112  PROCEDURE DIVISION USING BU081-LINK-AREA.                        DTSBU081
00113      SKIP2                                                        DTSBU081
00114      IF WRK-FIRST-TIME-YES-88                                     DTSBU081
00115         PERFORM I0000-INIT           THRU I0000-EXIT              DTSBU081
00116         SET WRK-FIRST-TIME-NO-88     TO TRUE                      DTSBU081
00117         PERFORM P0000-FIND-NAME      THRU P0000-EXIT              DTSBU081
00118      ELSE                                                         DTSBU081
00119         PERFORM P0000-FIND-NAME      THRU P0000-EXIT.             DTSBU081
00120                                                                   DTSBU081
00121 *    PERFORM S982F-CLOSE    THRU S982F-EXIT.                         CL*11
00122      GOBACK.                                                      DTSBU081
00123      EJECT                                                        DTSBU081
00124  I0000-INIT.                                                      DTSBU081
00125 *    MOVE 'DTSBU081'   TO DB-PROGRAM-NAME.                           CL*20
00126 *    SET DB-HEADER-RECORD        TO TRUE.                            CL*20
00127 *    SET DB-RANDOM-PROCESSING    TO TRUE.                            CL*20
00128 *    SET DB-OPEN-INPUT           TO TRUE.                            CL*20
00129 *    MOVE ZEROS                  TO DB-KEY.                          CL*20
00130 *    CALL 'ESP960D' USING COMMON-LINKAGE-SECTION.                    CL*20
00131 *    IF DB-SUCCESSFUL-COMPLETION                                     CL*20
00132 *       NEXT SENTENCE                                                CL*20
00133 *    ELSE                                                            CL*20
00134 *       DISPLAY 'CANNOT OPEN BENEFITS FILE'                          CL*20
00135 *       PERFORM S9999-ABEND THRU S9999-EXIT.                         CL*20
00136                                                                      CL**3
00137      PERFORM S982O-OPEN-READ THRU S982O-EXIT.                        CL**9
00138 *    PERFORM S981D-CLOSE    THRU S981D-EXIT.                         CL**3
00139                                                                      CL**3
00140                                                                   DTSBU081
00141  I0000-EXIT.                                                      DTSBU081
00142      EXIT.                                                        DTSBU081
00143  P0000-FIND-NAME.                                                 DTSBU081
00144      SET L081-NAME-NOT-FOUND TO TRUE.                             DTSBU081
00145                                                                   DTSBU081
00146      MOVE SPACES TO L081-CLAIMANT-NAME                            DTSBU081
00147                     L081-MSG-AREA.                                DTSBU081
00148                                                                   DTSBU081
00149 *    SET DB-RANDOM-PROCESSING        TO TRUE.                        CL*20
00150 *    SET DB-CLAIMANT-PROFILE         TO TRUE.                        CL*20
00151 *    SET DB-READ-SEGMENT             TO TRUE.                        CL*20
00152 *    MOVE L081-CLAIMANT-SSN          TO WRK-SSN.                     CL*20
00153 *    MOVE ZERO                       TO WRK-SSN-SEQ.                 CL*20
00154 *    MOVE WRK-KEY                    TO VSAM-KEY.                    CL*20
00155                                                                   DTSBU081
00156 *    CALL 'ESP960D' USING COMMON-LINKAGE-SECTION.                    CL*20
00157 *    IF DB-SUCCESSFUL-COMPLETION                                     CL*20
00158 *       SET L081-NAME-FOUND TO TRUE                                  CL*20
00159 *       MOVE CPD-NAME   TO L081-CLAIMANT-NAME                        CL*20
00160 *       GO TO P0000-EXIT.                                            CL*20
00161                                                                      CL**2
00162 *    IF DB-NO-RECORD-FOUND                                           CL*20
00163         MOVE SPACES               TO WRK-NAME                        CL**3
00164         MOVE LOW-VALUE            TO WNAM-REC                        CL**3
00165         MOVE L081-CLAIMANT-SSN    TO WNAM-SSN WRK-SSN                CL**4
00166         PERFORM P3000-READ-NAME  THRU P3000-EXIT.                    CL*20
00167 *    ELSE                                                            CL*20
00168 *       PERFORM S9999-ABEND THRU S9999-EXIT.                         CL*20
00169                                                                      CL**3
00170      IF L982-OK-88                                                   CL**3
00171         SET L081-NAME-FOUND TO TRUE                                  CL**3
00172          MOVE WRK-LNAME            TO  WRK-CLAIMANT-NAME             CL*13
00173          INSPECT WRK-CLAIMANT-NAME REPLACING FIRST ' ' BY '/'        CL*13
00174          MOVE WRK-FNAME            TO  WRK-CFNAMEB                   CL*17
00175          MOVE WRK-CFNAME           TO WRK-CZNAME                     CL*18
00176          INSPECT WRK-CLAIMANT-NAME REPLACING                         CL*14
00177               FIRST '/           ' BY WRK-CZNAME                     CL*18
00178          INSPECT WRK-CLAIMANT-NAME REPLACING FIRST '  ' BY ' @'      CL*14
00179          INSPECT WRK-CLAIMANT-NAME REPLACING                         CL*14
00180                 FIRST '@' BY WRK-INAME                               CL*15
00181         MOVE WRK-CLAIMANT-NAME     TO L081-CLAIMANT-NAME             CL**3
00182         DISPLAY ' NAME ' WRK-CLAIMANT-NAME                           CL*13
00183      ELSE                                                            CL**3
00184         SET L081-NAME-NOT-FOUND TO TRUE                           DTSBU081
00185         DISPLAY '*SSNE NOT ON TAX NAME FILE ' L081-CLAIMANT-SSN      CL*19
00186         MOVE EMSG-NO-REC      TO L081-MSG-TEXT                       CL*13
00187         GO TO P0000-EXIT.                                            CL*13
00188                                                                   DTSBU081
00189  P0000-EXIT.                                                      DTSBU081
00190      EXIT.                                                        DTSBU081
00191  P3000-READ-NAME.                                                    CL**3
00192 ******************************************************************   CL**3
00193 *           SEARCH FOR NAME ON WAGE NAME FILE          *             CL**3
00194 ******************************************************************   CL**3
00195                                                                      CL**3
00196                                                                      CL**3
00197      PERFORM S982A-START-BROWSE        THRU S982A-EXIT.              CL**3
00198                                                                      CL**3
00199      IF NOT L982-OK-88                                               CL**3
00200         SET L081-NAME-NOT-FOUND TO TRUE                              CL**3
00201        DISPLAY 'SSN NOT ON WAGE FILE: ' WRK-SSN                      CL**3
00202        GO TO P3000-EXIT                                              CL**3
00203      END-IF.                                                         CL**3
00204                                                                      CL**3
00205      MOVE WNAM-SSN  TO W-SSN.                                        CL**3
00206                                                                      CL**3
00207      IF WRK-SSN = W-SSN                                              CL**3
00208         MOVE WNAM-LAST-NAME    TO WRK-LNAME                          CL**3
00209         MOVE WNAM-FIRST-NAME   TO WRK-FNAME                          CL**3
00210         MOVE WNAM-MID-INIT     TO WRK-INAME                          CL**3
00211      ELSE                                                            CL**3
00212         SET L081-NAME-NOT-FOUND TO TRUE                              CL**3
00213        DISPLAY 'SSN NOT ON WAGE FILE: ' WRK-SSN.                     CL**3
00214  P3000-EXIT.                                                         CL**3
00215      EXIT.                                                           CL**3
00216                                                                      CL**3
00217  S982O-OPEN-READ.                                                    CL**3
00218      SET L982-OPEN-READ-88 TO TRUE.                                  CL**3
00219      PERFORM S982Z-WNAM-IO    THRU S982Z-EXIT.                       CL**3
00220                                                                      CL**3
00221  S982O-EXIT.                                                         CL**3
00222      EXIT.                                                           CL**3
00223                                                                      CL**3
00224  S982A-START-BROWSE.                                                 CL**3
00225      SET L982-START-BROWSE-88 TO TRUE.                               CL**3
00226      PERFORM S982Z-WNAM-IO    THRU S982Z-EXIT.                       CL**3
00227                                                                      CL**3
00228  S982A-EXIT.                                                         CL**3
00229      EXIT.                                                           CL**3
00230  S982B-READ-NEXT.                                                    CL**3
00231      SET L982-READ-NEXT-88    TO TRUE.                               CL**3
00232      PERFORM S982Z-WNAM-IO    THRU S982Z-EXIT.                       CL**3
00233                                                                      CL**3
00234  S982B-EXIT.                                                         CL**3
00235      EXIT.                                                           CL**3
00236  S982F-CLOSE.                                                        CL**3
00237      SET L982-CLOSE-88        TO TRUE.                               CL**3
00238      PERFORM S982Z-WNAM-IO    THRU S982Z-EXIT.                       CL**3
00239                                                                      CL**3
00240  S982F-EXIT.                                                         CL**3
00241      EXIT.                                                           CL**3
00242                                                                      CL**3
00243  S982Z-WNAM-IO.                                                      CL**3
00244      CALL 'DTSBU982' USING L982-LINK-AREA                            CL**3
00245                           WNAM-REC.                                  CL**3
00246  S982Z-EXIT.                                                         CL**3
00247      EXIT.                                                           CL**3
00248                                                                      CL**3
00249                                                                      CL**3
00250  S9999-ABEND.                                                     DTSBU081
00251      SKIP1                                                        DTSBU081
00252      CALL 'DTSBU999' USING WRK-ABEND-CODE.                        DTSBU081
00253      SKIP1                                                        DTSBU081
00254  S9999-EXIT.                                                      DTSBU081
00255      EXIT.                                                        DTSBU081
