174 lines
14 KiB
COBOL
174 lines
14 KiB
COBOL
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
|