00001  IDENTIFICATION DIVISION.                                         05/05/25
00002  PROGRAM-ID.             DTSCU081.                                DTSCU081
00003  AUTHOR.                 TRICOASTAL CONSULTING LTD.                  LV004
00004  DATE-WRITTEN.           NOVEMBER 1991.                           DTSCU081
00005  DATE-COMPILED.                                                   DTSCU081
00006      SKIP3                                                        DTSCU081
00007 *****                                                             DTSCU081
00008 *                                                                 DTSCU081
00009 *    FUNCTION:  CLAIMANT NAME LOOKUP.                             DTSCU081
00010 *                                                                 DTSCU081
00011 *                                                                 DTSCU081
00012 *    MODIFICATION LOG:                                            DTSCU081
00013 *                                                                 DTSCU081
00014 *    11/26/91  INITIAL DEVELOPMENT.                               DTSCU081
00015 *              WORK ORDER:                      PROGRAMMER: TCL   DTSCU081
00016 *                                                                 DTSCU081
00017 *    04/01/94  MODIFIED FOR MONTANA.                              DTSCU081
00018 *              WORK ORDER:                      PROGRAMMER: EHH   DTSCU081
00019 *                                                                 DTSCU081
00020 *    09/08/1998  THE LINK TO THE UI BENEFITS SYSTEM CLAIMANT      DTSCU081
00021 *                MASTER FILE IS PLUGGED.  WHEN THE UI BENEFITS    DTSCU081
00022 *                SYSTEM CLAIMANT MASTER FILE IS AVAILABLE, THIS   DTSCU081
00023 *                MODULE MUST BE REVISITED.                        DTSCU081
00024 *                REFERENCE: DC DEVELOPMENT      PROGRAMMER: EHH   DTSCU081
00025 *                                                                 DTSCU081
00026 *    MM/DD/YYYY  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCU081
00027 *                XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX   DTSCU081
00028 *                REFERENCE: XXXXXXXXXXXXXXX     PROGRAMMER: XXX   DTSCU081
00029 *                                                                 DTSCU081
00030 *                                                                 DTSCU081
00031 *    DESCRIPTION:                                                 DTSCU081
00032 *                                                                 DTSCU081
00033 *    DTSCU081 IS PASSED L081-CLAIMANT-SSN. DTSCU081 READS THE     DTSCU081
00034 *    BEAR MASTER FILE (VIA A LINK TO EC01960).                    DTSCU081
00035 *                                                                 DTSCU081
00036 *    IF THE CLAIMANT IS FOUND ON THE BEAR MASTER FILE, THEN       DTSCU081
00037 *    L081-CLAIMANT-NAME IS RETURNED.                              DTSCU081
00038 *                                                                 DTSCU081
00039 *    L081-CLAIMANT-SSN MUST NOT EQUAL ZERO.  A LINK TO DTSCU081   DTSCU081
00040 *    WITH L081-CLAIMANT-SSN EQUAL TO ZERO WILL YIELD AN ABEND.    DTSCU081
00041 *                                                                 DTSCU081
00042 *****                                                             DTSCU081
00043      SKIP3                                                        DTSCU081
00044  ENVIRONMENT DIVISION.                                            DTSCU081
00045      SKIP3                                                        DTSCU081
00046  DATA DIVISION.                                                   DTSCU081
00047      SKIP3                                                        DTSCU081
00048  WORKING-STORAGE SECTION.                                         DTSCU081
000485 77  PAN-VALET PICTURE X(24) VALUE '004DTSCU081  05/05/25'.       DTSCU081
00049  77  PAN-VALET PICTURE X(24) VALUE '023DTSCU081  09/13/04'.       DTSCU081
00050      SKIP3                                                        DTSCU081
00051  01  WRK-AREA.                                                    DTSCU081
00052      05  WRK-ABEND-CODE              PIC  X(04)  VALUE 'U081'.    DTSCU081
00053                                                                   DTSCU081
00054      05  WRK-RESP-CODE               PIC S9(08)  COMP.            DTSCU081
00055                                                                   DTSCU081
00056      05  WRK-ZIP.                                                 DTSCU081
00057          10  WRK-ZIP-5               PIC  X(05).                  DTSCU081
00058          10  FILLER                  PIC  X(01) VALUE '-'.        DTSCU081
00059          10  WRK-ZIP-4               PIC  X(04).                  DTSCU081
00060      SKIP3                                                        DTSCU081
00061                                                                      CL**4
00062      05 WRK-CLAIMANT-NAME             PIC X(32) VALUE SPACES.        CL**4
00063      05 WRK-CZNAME                    PIC X(12) VALUE SPACES.        CL**4
00064      05 WRK-CFNAME.                                                  CL**4
00065             15 WRK-CFNAMEA               PIC X(01) VALUE '/'.        CL**4
00066             15 WRK-CFNAMEB               PIC X(11) VALUE SPACES.     CL**4
00067      05 WRK-NAME.                                                    CL**4
00068          10 WRK-LNAME                PIC X(15) VALUE SPACES.         CL**4
00069          10 WRK-FNAME                PIC X(12) VALUE SPACES.         CL**4
00070          10 WRK-INAME                PIC X(01) VALUE SPACES.         CL**4
00071                                                                      CL**4
00072  01  EMSG-LITERALS.                                               DTSCU081
00073      05  EMSG-FILE-CLOSED.                                        DTSCU081
00074          10  FILLER                  PIC  X(04)  VALUE 'E091'.    DTSCU081
00075          10  FILLER                  PIC  X(31)                   DTSCU081
00076            VALUE 'FILE  ????????  NOT AVAILABLE  '.               DTSCU081
00077          10  FILLER                  PIC  X(16)                   DTSCU081
00078            VALUE 'PLEASE TRY LATER'.                              DTSCU081
00079      EJECT                                                        DTSCU081
00080                                                                      CL**3
00081  01  L882-COMM-AREA.                                                 CL**3
00082      05  L882-CONTROL-BLOCK.                                         CL**3
00083  ++INCLUDE DTSIL882                                                  CL**3
00084                                                                      CL**3
00085      05  WNAM-COMM-REC.                                              CL**3
00086  ++INCLUDE DTSIWNAM                                                  CL**3
00087                                                                      CL**3
00088  LINKAGE SECTION.                                                 DTSCU081
00089      SKIP3                                                        DTSCU081
00090  01  DFHCOMMAREA.                                                 DTSCU081
00091  ++INCLUDE DTSIL081                                               DTSCU081
00092      EJECT                                                        DTSCU081
00093  PROCEDURE DIVISION.                                              DTSCU081
00094      SKIP2                                                        DTSCU081
00095      SET L081-NAME-NOT-FOUND TO TRUE.                             DTSCU081
00096                                                                   DTSCU081
00097      MOVE SPACES TO L081-CLAIMANT-NAME                            DTSCU081
00098                     L081-CLAIMANT-STREET                          DTSCU081
00099                     L081-CLAIMANT-CITY                            DTSCU081
00100                     L081-CLAIMANT-ZIP                             DTSCU081
00101                     WRK-ZIP-5                                     DTSCU081
00102                     WRK-ZIP-4                                     DTSCU081
00103                     L081-MSG-AREA.                                DTSCU081
00104                                                                   DTSCU081
00105  P2000-FIND-NAMES.                                                   CL**3
00106          MOVE LOW-VALUE               TO WNAM-COMM-REC               CL**3
00107          MOVE L081-CLAIMANT-SSN       TO WNAM-SSN.                   CL**3
00108          PERFORM S882A-START-BROWSE   THRU S882A-EXIT                CL**3
00109          IF L882-OK-88                                               CL**3
00110             SET L081-NAME-FOUND  TO TRUE                             CL**3
00111             MOVE WNAM-LAST-NAME    TO WRK-LNAME                      CL**4
00112             MOVE WNAM-FIRST-NAME   TO WRK-FNAME                      CL**4
00113             MOVE WNAM-MID-INIT     TO WRK-INAME                      CL**4
00114             MOVE WRK-LNAME         TO  WRK-CLAIMANT-NAME             CL**4
00115             INSPECT WRK-CLAIMANT-NAME REPLACING FIRST ' ' BY '/'     CL**4
00116             MOVE WRK-FNAME            TO  WRK-CFNAMEB                CL**4
00117             MOVE WRK-CFNAME           TO WRK-CZNAME                  CL**4
00118             INSPECT WRK-CLAIMANT-NAME REPLACING                      CL**4
00119               FIRST '/           ' BY WRK-CZNAME                     CL**4
00120           INSPECT WRK-CLAIMANT-NAME REPLACING FIRST '  ' BY ' @'     CL**4
00121             INSPECT WRK-CLAIMANT-NAME REPLACING                      CL**4
00122                 FIRST '@' BY WRK-INAME                               CL**4
00123            MOVE WRK-CLAIMANT-NAME     TO L081-CLAIMANT-NAME          CL**4
00124          END-IF.                                                     CL**4
00125          PERFORM S882C-END-BROWSE     THRU S882C-EXIT.               CL**3
00126                                                                      CL**3
00127  P2000-EXIT.                                                         CL**3
00128      EXIT.                                                           CL**3
00129                                                                      CL**3
00130                                                                   DTSCU081
00131                                                                   DTSCU081
00132      EXEC CICS                                                    DTSCU081
00133          RETURN                                                   DTSCU081
00134      END-EXEC.                                                    DTSCU081
00135                                                                   DTSCU081
00136                                                                   DTSCU081
00137      GOBACK.                                                      DTSCU081
00138      EJECT                                                        DTSCU081
00139  S882A-START-BROWSE.                                                 CL**3
00140      SET L882-START-BROWSE-88 TO TRUE.                               CL**3
00141      PERFORM S882Z-WNAM-IO    THRU S882Z-EXIT.                       CL**3
00142                                                                      CL**3
00143  S882A-EXIT.                                                         CL**3
00144      EXIT.                                                           CL**3
00145                                                                      CL**3
00146  S882C-END-BROWSE.                                                   CL**3
00147      SET L882-END-BROWSE-88 TO TRUE.                                 CL**3
00148      PERFORM S882Z-WNAM-IO    THRU S882Z-EXIT.                       CL**3
00149                                                                      CL**3
00150  S882C-EXIT.                                                         CL**3
00151      EXIT.                                                           CL**3
00152                                                                      CL**3
00153  S882Z-WNAM-IO.                                                      CL**3
00154      EXEC CICS                                                       CL**3
00155         LINK                                                         CL**3
00156            PROGRAM('DTSCU882')                                       CL**3
00157            COMMAREA(L882-COMM-AREA)                                  CL**3
00158      END-EXEC.                                                       CL**3
00159                                                                      CL**3
00160  S882Z-EXIT.                                                         CL**3
00161      EXIT.                                                           CL**3
00162                                                                      CL**3
00163                                                                      CL**3
00164  S899-ABEND.                                                      DTSCU081
00165      SKIP1                                                        DTSCU081
00166      EXEC CICS                                                    DTSCU081
00167          ABEND                                                    DTSCU081
00168              ABCODE (WRK-ABEND-CODE)                              DTSCU081
00169      END-EXEC.                                                    DTSCU081
00170      SKIP1                                                        DTSCU081
00171  S899-EXIT.                                                       DTSCU081
00172      EXIT.                                                        DTSCU081
