257 lines
20 KiB
COBOL
257 lines
20 KiB
COBOL
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
|