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