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