MP Batchs, copybooks, jcls, Procs
This commit is contained in:
216
Batch/DTSBU083.cob
Normal file
216
Batch/DTSBU083.cob
Normal file
@ -0,0 +1,216 @@
|
||||
00001 IDENTIFICATION DIVISION. 08/13/04
|
||||
00002 PROGRAM-ID. DTSBU083. DTSBU083
|
||||
00003 AUTHOR. TRW. LV003
|
||||
00004 DATE-WRITTEN. JUNE 2001. DTSBU083
|
||||
00005 DATE-COMPILED. DTSBU083
|
||||
00006 SKIP3 DTSBU083
|
||||
00007 ***** DTSBU083
|
||||
00008 * DTSBU083
|
||||
00009 * FUNCTION: CLAIMANT NAME LOOKUP FROM IB6 FILE. DTSBU083
|
||||
00010 * DTSBU083
|
||||
00011 * DTSBU083
|
||||
00012 * MODIFICATION LOG: DTSBU083
|
||||
00013 * DTSBU083
|
||||
00014 * 07/22/2002 INITIAL DEVELOPMENT. DTSBU083
|
||||
00015 * WORK ORDER: PROGRAMMER: GD DTSBU083
|
||||
00016 * DTSBU083
|
||||
00017 * 07/22/2004 CORRECTED PROBLEM WITH L081-CLAIMANT-SSN. DTSBU083
|
||||
00018 * THE BATCH PROGRAM WAS NOT CONSISTENT WITH DTSBU083
|
||||
00019 * THE CICS PROGRAM. DTSBU083
|
||||
00020 * THE PROGRAM WAS MOVING THIS 9 DIGIT FIELD TO DTSBU083
|
||||
00021 * THE 10 DIGIT VSAM-KEY (SSN PLUS SEQUENCE NUMBER).DTSBU083
|
||||
00022 * THE PROGRAM NOW BUILDS THE KEY IN WORKING-STORAGEDTSBU083
|
||||
00023 * AND MOVE THE FULL 10 DIGIT KEY. THE SEQUENCE DTSBU083
|
||||
00024 * NUMBER IS ALWAYS SET TO ZERO. DTSBU083
|
||||
00025 * REFERENCE: PROGRAMMER: GD DTSBU083
|
||||
00026 * DTSBU083
|
||||
00027 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU083
|
||||
00028 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSBU083
|
||||
00029 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSBU083
|
||||
00030 * DTSBU083
|
||||
00031 * DTSBU083
|
||||
00032 * DESCRIPTION: DTSBU083
|
||||
00033 * DTSBU083
|
||||
00034 * DTSBU083 IS PASSED L081-CLAIMANT-SSN. DTSBU083 READS THE DTSBU083
|
||||
00035 * IB6 MASTER FILE. DTSBU083
|
||||
00036 * DTSBU083
|
||||
00037 * IF THE CLAIMANT IS FOUND, THEN L081-CLAIMANT-NAME IS RETURNED DTSBU083
|
||||
00038 ***** DTSBU083
|
||||
00039 SKIP3 DTSBU083
|
||||
00040 ENVIRONMENT DIVISION. DTSBU083
|
||||
00041 SKIP3 DTSBU083
|
||||
00042 DATA DIVISION. DTSBU083
|
||||
00043 SKIP3 DTSBU083
|
||||
00044 WORKING-STORAGE SECTION. DTSBU083
|
||||
000445 77 PAN-VALET PICTURE X(24) VALUE '003DTSBU083 08/13/04'. DTSBU083
|
||||
00045 SKIP3 DTSBU083
|
||||
00046 01 WRK-AREA. DTSBU083
|
||||
00047 05 WRK-ABEND-CODE PIC X(04) VALUE 'U083'. DTSBU083
|
||||
00048 DTSBU083
|
||||
00049 05 WRK-FIRST-TIME-IND PIC X(01) VALUE 'Y'. DTSBU083
|
||||
00050 88 WRK-FIRST-TIME-YES-88 VALUE 'Y'. DTSBU083
|
||||
00051 88 WRK-FIRST-TIME-NO-88 VALUE 'N'. DTSBU083
|
||||
00052 DTSBU083
|
||||
00053 05 WRK-KEY PIC 9(10). DTSBU083
|
||||
00054 05 FILLER REDEFINES WRK-KEY. DTSBU083
|
||||
00055 10 WRK-SSN PIC 9(09). DTSBU083
|
||||
00056 10 WRK-SSN-SEQ PIC 9(01). DTSBU083
|
||||
00057 DTSBU083
|
||||
00058 05 WRK-SPACE-NEEDED-IND PIC X(01). DTSBU083
|
||||
00059 88 WRK-SPACE-NEEDED-YES-88 VALUE 'Y'. DTSBU083
|
||||
00060 88 WRK-SPACE-NEEDED-NO-88 VALUE 'N'. DTSBU083
|
||||
00061 DTSBU083
|
||||
00062 05 WRK-LEN PIC S9(04) COMP DTSBU083
|
||||
00063 VALUE +31. DTSBU083
|
||||
00064 05 SUB1 PIC S9(04) COMP. DTSBU083
|
||||
00065 05 SUB2 PIC S9(04) COMP. DTSBU083
|
||||
00066 DTSBU083
|
||||
00067 05 WRK-NAME. DTSBU083
|
||||
00068 10 WRK-FIRST-NAME PIC X(12). DTSBU083
|
||||
00069 10 WRK-MIDDLE-NAME PIC X(01). DTSBU083
|
||||
00070 10 WRK-LAST-NAME PIC X(18). DTSBU083
|
||||
00071 DTSBU083
|
||||
00072 05 WRK-NAME-OUT PIC X(32). DTSBU083
|
||||
00073 DTSBU083
|
||||
00074 01 EMSG-LITERALS. DTSBU083
|
||||
00075 05 EMSG-NO-REC. DTSBU083
|
||||
00076 10 FILLER PIC X(31) DTSBU083
|
||||
00077 VALUE 'NO BENEFITS RECORD FOUND '. DTSBU083
|
||||
00078 10 FILLER PIC X(16) DTSBU083
|
||||
00079 VALUE SPACES. DTSBU083
|
||||
00080 05 EMSG-EOF. DTSBU083
|
||||
00081 10 FILLER PIC X(31) DTSBU083
|
||||
00082 VALUE 'END OF FILE '. DTSBU083
|
||||
00083 10 FILLER PIC X(16) DTSBU083
|
||||
00084 VALUE SPACES. DTSBU083
|
||||
00085 EJECT DTSBU083
|
||||
00086 01 IB6-LINKAGE-SECTION. DTSBU083
|
||||
00087 ++INCLUDE IB6VSMCB DTSBU083
|
||||
00088 EJECT DTSBU083
|
||||
00089 ++INCLUDE ESPDATEW DTSBU083
|
||||
00090 EJECT DTSBU083
|
||||
00091 ++INCLUDE IB6SCCD DTSBU083
|
||||
00092 EJECT DTSBU083
|
||||
00093 ++INCLUDE ESPSTRER DTSBU083
|
||||
00094 EJECT DTSBU083
|
||||
00095 ++INCLUDE IB6SCSWA DTSBU083
|
||||
00096 EJECT DTSBU083
|
||||
00097 ++INCLUDE IB6SCTWA DTSBU083
|
||||
00098 EJECT DTSBU083
|
||||
00099 ++INCLUDE IB6SEG01 DTSBU083
|
||||
00100 EJECT DTSBU083
|
||||
00101 ++INCLUDE IB6SEG02 DTSBU083
|
||||
00102 EJECT DTSBU083
|
||||
00103 ++INCLUDE IB6SEG03 DTSBU083
|
||||
00104 EJECT DTSBU083
|
||||
00105 ++INCLUDE IB6TRAND DTSBU083
|
||||
00106 EJECT DTSBU083
|
||||
00107 ++INCLUDE IB6HEADR DTSBU083
|
||||
00108 EJECT DTSBU083
|
||||
00109 LINKAGE SECTION. DTSBU083
|
||||
00110 SKIP3 DTSBU083
|
||||
00111 01 BU081-LINK-AREA. DTSBU083
|
||||
00112 ++INCLUDE DTSIL081 DTSBU083
|
||||
00113 EJECT DTSBU083
|
||||
00114 PROCEDURE DIVISION USING BU081-LINK-AREA. DTSBU083
|
||||
00115 SKIP2 DTSBU083
|
||||
00116 IF WRK-FIRST-TIME-YES-88 DTSBU083
|
||||
00117 PERFORM I0000-INIT THRU I0000-EXIT DTSBU083
|
||||
00118 SET WRK-FIRST-TIME-NO-88 TO TRUE DTSBU083
|
||||
00119 PERFORM P0000-FIND-NAME THRU P0000-EXIT DTSBU083
|
||||
00120 ELSE DTSBU083
|
||||
00121 PERFORM P0000-FIND-NAME THRU P0000-EXIT. DTSBU083
|
||||
00122 DTSBU083
|
||||
00123 GOBACK. DTSBU083
|
||||
00124 EJECT DTSBU083
|
||||
00125 I0000-INIT. DTSBU083
|
||||
00126 MOVE 'DTSBU083' TO DB-PROGRAM-NAME. DTSBU083
|
||||
00127 SET DB-HEADER-RECORD TO TRUE. DTSBU083
|
||||
00128 SET DB-RANDOM-PROCESSING TO TRUE. DTSBU083
|
||||
00129 SET DB-OPEN-INPUT TO TRUE. DTSBU083
|
||||
00130 MOVE ZEROS TO DB-KEY. DTSBU083
|
||||
00131 DTSBU083
|
||||
00132 CALL 'IB6960D' USING IB6-LINKAGE-SECTION. DTSBU083
|
||||
00133 IF DB-SUCCESSFUL-COMPLETION DTSBU083
|
||||
00134 NEXT SENTENCE DTSBU083
|
||||
00135 ELSE DTSBU083
|
||||
00136 DISPLAY 'CANNOT OPEN IB6 FILE' DTSBU083
|
||||
00137 PERFORM S9999-ABEND THRU S9999-EXIT. DTSBU083
|
||||
00138 DTSBU083
|
||||
00139 I0000-EXIT. DTSBU083
|
||||
00140 EXIT. DTSBU083
|
||||
00141 P0000-FIND-NAME. DTSBU083
|
||||
00142 SET L081-NAME-NOT-FOUND TO TRUE. DTSBU083
|
||||
00143 DTSBU083
|
||||
00144 MOVE SPACES TO L081-CLAIMANT-NAME DTSBU083
|
||||
00145 L081-MSG-AREA. DTSBU083
|
||||
00146 DTSBU083
|
||||
00147 SET DB-RANDOM-PROCESSING TO TRUE. DTSBU083
|
||||
00148 SET DB-IB6-PROFILE TO TRUE. DTSBU083
|
||||
00149 SET DB-READ-SEGMENT TO TRUE. DTSBU083
|
||||
00150 MOVE L081-CLAIMANT-SSN TO WRK-SSN. DTSBU083
|
||||
00151 MOVE ZERO TO WRK-SSN-SEQ. DTSBU083
|
||||
00152 MOVE WRK-KEY TO VSAM-KEY. DTSBU083
|
||||
00153 DTSBU083
|
||||
00154 CALL 'IB6960D' USING IB6-LINKAGE-SECTION. DTSBU083
|
||||
00155 IF DB-SUCCESSFUL-COMPLETION DTSBU083
|
||||
00156 SET L081-NAME-FOUND TO TRUE DTSBU083
|
||||
00157 PERFORM P1000-FORMAT-NAME THRU P1000-EXIT DTSBU083
|
||||
00158 MOVE WRK-NAME-OUT TO L081-CLAIMANT-NAME DTSBU083
|
||||
00159 ELSE DTSBU083
|
||||
00160 IF DB-NO-RECORD-FOUND DTSBU083
|
||||
00161 SET L081-NAME-NOT-FOUND TO TRUE DTSBU083
|
||||
00162 MOVE EMSG-NO-REC TO L081-MSG-TEXT DTSBU083
|
||||
00163 ELSE DTSBU083
|
||||
00164 PERFORM S9999-ABEND THRU S9999-EXIT. DTSBU083
|
||||
00165 DTSBU083
|
||||
00166 P0000-EXIT. DTSBU083
|
||||
00167 EXIT. DTSBU083
|
||||
00168 DTSBU083
|
||||
00169 P1000-FORMAT-NAME. DTSBU083
|
||||
00170 MOVE SPACES TO WRK-NAME DTSBU083
|
||||
00171 WRK-NAME-OUT. DTSBU083
|
||||
00172 DTSBU083
|
||||
00173 MOVE IN1-CLAIM-FIRST-NAME TO WRK-FIRST-NAME. DTSBU083
|
||||
00174 MOVE IN1-CLAIM-MIDDLE-NAME TO WRK-MIDDLE-NAME DTSBU083
|
||||
00175 MOVE IN1-CLAIM-LAST-NAME TO WRK-LAST-NAME DTSBU083
|
||||
00176 DTSBU083
|
||||
00177 SET WRK-SPACE-NEEDED-YES-88 TO TRUE. DTSBU083
|
||||
00178 MOVE +0 TO SUB2. DTSBU083
|
||||
00179 PERFORM P1100-PARSE THRU P1100-EXIT. DTSBU083
|
||||
00180 DTSBU083
|
||||
00181 MOVE WRK-NAME-OUT TO L081-CLAIMANT-NAME. DTSBU083
|
||||
00182 DTSBU083
|
||||
00183 P1000-EXIT. DTSBU083
|
||||
00184 EXIT. DTSBU083
|
||||
00185 DTSBU083
|
||||
00186 P1100-PARSE. DTSBU083
|
||||
00187 PERFORM DTSBU083
|
||||
00188 VARYING SUB1 FROM +1 BY +1 DTSBU083
|
||||
00189 UNTIL SUB1 > WRK-LEN DTSBU083
|
||||
00190 IF WRK-NAME (SUB1:1) NOT = SPACE DTSBU083
|
||||
00191 SET WRK-SPACE-NEEDED-YES-88 TO TRUE DTSBU083
|
||||
00192 ADD +1 TO SUB2 DTSBU083
|
||||
00193 MOVE WRK-NAME (SUB1:1) TO WRK-NAME-OUT (SUB2:1) DTSBU083
|
||||
00194 IF SUB1 = +13 DTSBU083
|
||||
00195 ADD +1 TO SUB2 DTSBU083
|
||||
00196 MOVE SPACE TO WRK-NAME-OUT (SUB2:1) DTSBU083
|
||||
00197 END-IF DTSBU083
|
||||
00198 ELSE DTSBU083
|
||||
00199 IF WRK-SPACE-NEEDED-YES-88 DTSBU083
|
||||
00200 ADD +1 TO SUB2 DTSBU083
|
||||
00201 MOVE SPACE TO WRK-NAME-OUT (SUB2:1) DTSBU083
|
||||
00202 SET WRK-SPACE-NEEDED-NO-88 TO TRUE DTSBU083
|
||||
00203 END-IF DTSBU083
|
||||
00204 END-IF DTSBU083
|
||||
00205 END-PERFORM. DTSBU083
|
||||
00206 DTSBU083
|
||||
00207 P1100-EXIT. DTSBU083
|
||||
00208 EXIT. DTSBU083
|
||||
00209 DTSBU083
|
||||
00210 S9999-ABEND. DTSBU083
|
||||
00211 SKIP1 DTSBU083
|
||||
00212 CALL 'DTSBU999' USING WRK-ABEND-CODE. DTSBU083
|
||||
00213 SKIP1 DTSBU083
|
||||
00214 S9999-EXIT. DTSBU083
|
||||
00215 EXIT. DTSBU083
|
||||
Reference in New Issue
Block a user