MP Batchs, copybooks, jcls, Procs
This commit is contained in:
256
Batch/DTSBU081.cob
Normal file
256
Batch/DTSBU081.cob
Normal file
@ -0,0 +1,256 @@
|
||||
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
|
||||
Reference in New Issue
Block a user