DUTAS re-platformed to Raincode - Initial Source Code
This commit is contained in:
Neeraj Kumar
300
Batch/DESBD320.cob
Normal file
300
Batch/DESBD320.cob
Normal file
@ -0,0 +1,300 @@
|
||||
00001 IDENTIFICATION DIVISION. 01/26/18
|
||||
00002 PROGRAM-ID. DESBD320. DESBD320
|
||||
00003 AUTHOR. NGC. LV124
|
||||
00004 DATE-WRITTEN. APRIL 2009 DESBD320
|
||||
00005 DATE-COMPILED. DESBD320
|
||||
00006 SKIP3 DESBD320
|
||||
00007 ***** DESBD320
|
||||
00008 * DESBD320
|
||||
00009 * FUNCTION: BUILD NAME RECORDS FOR EXPORT TO SERVER. DESBD320
|
||||
00010 * INPUT COMES FROM WNAM FILE, WITH NAMES FROM DESBD320
|
||||
00011 * THE ICESA WAGES. DESBD320
|
||||
00012 * DESBD320
|
||||
00013 * MODIFICATION LOG: DESBD320
|
||||
00014 * DESBD320
|
||||
00015 * 04/08/2009 INITIAL DEVELOPMENT DESBD320
|
||||
00016 * WORK ORDER: PROGRAMMER: GD DESBD320
|
||||
00017 * DESBD320
|
||||
00018 * 99/99/9999 XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DESBD320
|
||||
00019 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DESBD320
|
||||
00020 * WORK ORDER: PROGRAMMER: XXX DESBD320
|
||||
00021 * DESBD320
|
||||
00022 * DESCRIPTION: DESBD320
|
||||
00023 * DESBD320
|
||||
00024 * INITIATION: DESBD320
|
||||
00025 * VSAM WAGE FILE OPEN READ DESBD320
|
||||
00026 * DESBD320
|
||||
00027 * PROCESSING: DESBD320
|
||||
00028 * FOR EACH SSN, SELECT THE MOST RECENT NAME RECORD WHERE DESBD320
|
||||
00029 * THE NAME IS 'FULL.' DESBD320
|
||||
00030 * DESBD320
|
||||
00031 * TERMINATION: DESBD320
|
||||
00032 * DESBD320
|
||||
00033 * RECORDS READ: DESBD320
|
||||
00034 * MASTER: DESBD320
|
||||
00035 * VSAM WAGES FILE DESBD320
|
||||
00036 * DESBD320
|
||||
00037 * ALTERNATE INDEX: DESBD320
|
||||
00038 * NONE. DESBD320
|
||||
00039 * DESBD320
|
||||
00040 * REFERENCE: DESBD320
|
||||
00041 * NONE. DESBD320
|
||||
00042 * DESBD320
|
||||
00043 * RECORDS UPDATED: DESBD320
|
||||
00044 * NONE DESBD320
|
||||
00045 * DESBD320
|
||||
00046 * DESBD320
|
||||
00047 * BATCH TRANSACTION COLLECTION RECORDS WRITTEN: DESBD320
|
||||
00048 * NONE. DESBD320
|
||||
00049 * DESBD320
|
||||
00050 * MODULES CALLED: DESBD320
|
||||
00051 * DTSBU001 DATE CONVERSION/EDIT. DESBD320
|
||||
00052 * DTSBU004 QUARERLY SUMMARY REPORT REC. DESBD320
|
||||
00053 * DTSBU981 VSAM.WGH FILE I/O. DESBD320
|
||||
00054 * DTSBU946 VARIABLE LENGTH RECORDS SEQUENTIAL OUTPUT 1. DESBD320
|
||||
00055 * DESBD320
|
||||
00056 * VERMONT REFERENCE: DESBD320
|
||||
00057 * NONE. DESBD320
|
||||
00058 * DESBD320
|
||||
00059 ***** DESBD320
|
||||
00060 SKIP3 DESBD320
|
||||
00061 ENVIRONMENT DIVISION. DESBD320
|
||||
00062 INPUT-OUTPUT SECTION. DESBD320
|
||||
00063 SKIP3 DESBD320
|
||||
00064 FILE-CONTROL. DESBD320
|
||||
00065 SELECT WG-NAME-FILE ASSIGN TO DESFB320 DESBD320
|
||||
00066 FILE STATUS IS WG-NAME-STATUS. DESBD320
|
||||
00067 DESBD320
|
||||
00068 SKIP3 DESBD320
|
||||
00069 DATA DIVISION. DESBD320
|
||||
00070 FILE SECTION. DESBD320
|
||||
00071 FD WG-NAME-FILE DESBD320
|
||||
00072 RECORDING MODE IS F DESBD320
|
||||
00073 LABEL RECORDS ARE STANDARD DESBD320
|
||||
00074 BLOCK CONTAINS 0 CHARACTERS. DESBD320
|
||||
00075 SKIP1 DESBD320
|
||||
00076 01 WG-NAME-REC PIC X(46). DESBD320
|
||||
00077 DESBD320
|
||||
00078 WORKING-STORAGE SECTION. DESBD320
|
||||
000785 77 PAN-VALET PICTURE X(24) VALUE '124DESBD320 01/26/18'. DESBD320
|
||||
00079 DESBD320
|
||||
00080 01 WRK-AREA. DESBD320
|
||||
00081 05 WRK-ABEND-CD PIC S9(04) COMP VALUE +320.DESBD320
|
||||
00082 05 WRK-MOD-NAME PIC X(08) VALUE 'DESBD320'.DESBD320
|
||||
00083 05 WRK-ABEND-MSG PIC X(60). DESBD320
|
||||
00084 DESBD320
|
||||
00085 05 WG-NAME-STATUS PIC X(02). DESBD320
|
||||
00086 88 WG-NAME-OK-88 VALUE '00'. DESBD320
|
||||
00087 DESBD320
|
||||
00088 05 WRK-ERROR-IND PIC X(01). DESBD320
|
||||
00089 88 WRK-ERROR-YES-88 VALUE 'Y'. DESBD320
|
||||
00090 88 WRK-ERROR-NO-88 VALUE 'N'. DESBD320
|
||||
00091 DESBD320
|
||||
00092 05 WRK-CURR-SSN PIC S9(09) COMP-3 VALUE +0. DESBD320
|
||||
00093 DESBD320
|
||||
00094 05 WRK-WNAM-CNT PIC S9(07) COMP-3 VALUE +0. DESBD320
|
||||
00095 05 WRK-X147-CNT PIC S9(07) COMP-3 VALUE +0. DESBD320
|
||||
00096 DESBD320
|
||||
00097 05 AMT-DISP1 PIC ---------9.99. DESBD320
|
||||
00098 05 AMT-DISP2 PIC ---------9.99. DESBD320
|
||||
00099 DESBD320
|
||||
00100 01 L001-LINK-AREA. DESBD320
|
||||
00101 ++INCLUDE DTSIL001 DESBD320
|
||||
00102 EJECT DESBD320
|
||||
00103 01 L004-LINK-AREA. DESBD320
|
||||
00104 ++INCLUDE DTSIL004 DESBD320
|
||||
00105 EJECT DESBD320
|
||||
00106 01 L005-LINK-AREA. DESBD320
|
||||
00107 ++INCLUDE DTSIL005 DESBD320
|
||||
00108 EJECT DESBD320
|
||||
00109 01 WRK-X147-REC. DESBD320
|
||||
00110 ++INCLUDE DTSIX147 DESBD320
|
||||
00111 EJECT DESBD320
|
||||
00112 01 L982-LINK-AREA. DESBD320
|
||||
00113 ++INCLUDE DTSIL982 DESBD320
|
||||
00114 SKIP3 DESBD320
|
||||
00115 01 WNAM-REC. DESBD320
|
||||
00116 ++INCLUDE DTSIWNAM DESBD320
|
||||
00117 EJECT DESBD320
|
||||
00118 PROCEDURE DIVISION. DESBD320
|
||||
00119 PERFORM I0000-INITIALIZE THRU I0000-EXIT. DESBD320
|
||||
00120 IF WRK-ERROR-NO-88 DESBD320
|
||||
00121 PERFORM P0000-PROCESS THRU P0000-EXIT DESBD320
|
||||
00122 PERFORM T0000-TERMINATE THRU T0000-EXIT DESBD320
|
||||
00123 END-IF. DESBD320
|
||||
00124 DESBD320
|
||||
00125 GOBACK. DESBD320
|
||||
00126 EJECT DESBD320
|
||||
00127 I0000-INITIALIZE. DESBD320
|
||||
00128 DESBD320
|
||||
00129 SET WRK-ERROR-NO-88 TO TRUE. DESBD320
|
||||
00130 MOVE WRK-MOD-NAME TO L982-MOD-NAME. DESBD320
|
||||
00131 DESBD320
|
||||
00132 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. DESBD320
|
||||
00133 DESBD320
|
||||
00134 I0000-EXIT. DESBD320
|
||||
00135 EXIT. DESBD320
|
||||
00136 DESBD320
|
||||
00137 DESBD320
|
||||
00138 I2000-OPEN-FILES. DESBD320
|
||||
00139 OPEN OUTPUT WG-NAME-FILE. DESBD320
|
||||
00140 IF NOT WG-NAME-OK-88 DESBD320
|
||||
00141 DISPLAY 'CANNOT OPEN WG-NAME ' WG-NAME-STATUS DESBD320
|
||||
00142 SET WRK-ERROR-YES-88 TO TRUE DESBD320
|
||||
00143 GO TO I2000-EXIT DESBD320
|
||||
00144 END-IF. DESBD320
|
||||
00145 DESBD320
|
||||
00146 PERFORM S982A-OPEN-READ THRU S982A-EXIT. DESBD320
|
||||
00147 DESBD320
|
||||
00148 I2000-EXIT. DESBD320
|
||||
00149 EXIT. DESBD320
|
||||
00150 DESBD320
|
||||
00151 ************************************************************** DESBD320
|
||||
00152 * START BROWSE THE VSAM.WGH FILE WITH THE PARM-START-YRQ * DESBD320
|
||||
00153 * AND PARM-EMP-NO. * DESBD320
|
||||
00154 ************************************************************** DESBD320
|
||||
00155 DESBD320
|
||||
00156 P0000-PROCESS. DESBD320
|
||||
00157 MOVE LOW-VALUES TO WNAM-REC. DESBD320
|
||||
00158 PERFORM S982D-START-BROWSE THRU S982D-EXIT. DESBD320
|
||||
00159 IF L982-OK-88 DESBD320
|
||||
00160 PERFORM UNTIL L982-NO-REC-88 DESBD320
|
||||
00161 IF WNAM-TYPE-FULL-88 DESBD320
|
||||
00162 IF WNAM-SSN NOT = WRK-CURR-SSN DESBD320
|
||||
00163 MOVE WNAM-SSN TO WRK-CURR-SSN DESBD320
|
||||
00164 ADD +1 TO WRK-WNAM-CNT DESBD320
|
||||
00165 PERFORM P1000-BUILD-X147 THRU P1000-EXIT DESBD320
|
||||
00166 END-IF DESBD320
|
||||
00167 END-IF DESBD320
|
||||
00168 PERFORM S982E-READ-NEXT THRU S982E-EXIT DESBD320
|
||||
00169 END-PERFORM DESBD320
|
||||
00170 END-IF. DESBD320
|
||||
00171 DESBD320
|
||||
00172 P0000-EXIT. DESBD320
|
||||
00173 EXIT. DESBD320
|
||||
00174 DESBD320
|
||||
00175 P1000-BUILD-X147. DESBD320
|
||||
00176 MOVE WNAM-SSN TO X147-SSN. DESBD320
|
||||
00177 MOVE WNAM-NINES-COMPLEMENT-ABSTIME TO DESBD320
|
||||
00178 L005-NINES-COMPLEMENT-ABSTIME. DESBD320
|
||||
00179 SET L005-FROM-NINES-COMPLEMENT TO TRUE. DESBD320
|
||||
00180 PERFORM S005-FROM-SYS THRU S005-EXIT. DESBD320
|
||||
00181 MOVE L005-DATE TO X147-EFF-DATE. DESBD320
|
||||
00182 IF L005-DATE = ZERO DESBD320
|
||||
00183 DISPLAY 'BAD DATE ' WNAM-SSN DESBD320
|
||||
00184 END-IF. DESBD320
|
||||
00185 MOVE WNAM-LAST-NAME TO X147-LAST-NAME DESBD320
|
||||
00186 INSPECT X147-LAST-NAME REPLACING ALL ',' BY SPACE. DESBD320
|
||||
00187 MOVE WNAM-FIRST-NAME TO X147-FIRST-NAME DESBD320
|
||||
00188 INSPECT X147-FIRST-NAME REPLACING ALL ',' BY SPACE. DESBD320
|
||||
00189 MOVE WNAM-MID-INIT TO X147-MID-INIT DESBD320
|
||||
00190 INSPECT X147-MID-INIT REPLACING ALL ',' BY SPACE. DESBD320
|
||||
00191 DESBD320
|
||||
00192 WRITE WG-NAME-REC FROM WRK-X147-REC. DESBD320
|
||||
00193 IF NOT WG-NAME-OK-88 DESBD320
|
||||
00194 DISPLAY 'CANNOT WRITE NAME REC ' WG-NAME-STATUS DESBD320
|
||||
00195 PERFORM S999-ABEND THRU S999-EXIT DESBD320
|
||||
00196 ELSE DESBD320
|
||||
00197 ADD +1 TO WRK-X147-CNT DESBD320
|
||||
00198 END-IF. DESBD320
|
||||
00199 DESBD320
|
||||
00200 P1000-EXIT. DESBD320
|
||||
00201 EXIT. DESBD320
|
||||
00202 DESBD320
|
||||
00203 T0000-TERMINATE. DESBD320
|
||||
00204 DESBD320
|
||||
00205 DISPLAY ' '. DESBD320
|
||||
00206 DISPLAY ' '. DESBD320
|
||||
00207 DESBD320
|
||||
00208 DISPLAY '*** DESBD320 TERMINATION STATISTICS ***'. DESBD320
|
||||
00209 DESBD320
|
||||
00210 DISPLAY ' '. DESBD320
|
||||
00211 DISPLAY 'WNAM RECORDS READ :' DESBD320
|
||||
00212 WRK-WNAM-CNT. DESBD320
|
||||
00213 DISPLAY 'X147 RECORDS WRITTEN :' DESBD320
|
||||
00214 WRK-X147-CNT. DESBD320
|
||||
00215 DESBD320
|
||||
00216 DESBD320
|
||||
00217 PERFORM S982C-CLOSE THRU S982C-EXIT. DESBD320
|
||||
00218 DESBD320
|
||||
00219 T0000-EXIT. DESBD320
|
||||
00220 EXIT. DESBD320
|
||||
00221 EJECT DESBD320
|
||||
00222 DESBD320
|
||||
00223 S001-FROM-FED-8. DESBD320
|
||||
00224 SET L001-FROM-FED-8 TO TRUE. DESBD320
|
||||
00225 GO TO S001-DATE. DESBD320
|
||||
00226 DESBD320
|
||||
00227 S001-FROM-ABS-DAY. DESBD320
|
||||
00228 SET L001-FROM-ABS-DAY TO TRUE. DESBD320
|
||||
00229 GO TO S001-DATE. DESBD320
|
||||
00230 DESBD320
|
||||
00231 S001-FROM-CAL-6. DESBD320
|
||||
00232 SET L001-FROM-CAL-6 TO TRUE. DESBD320
|
||||
00233 GO TO S001-DATE. DESBD320
|
||||
00234 DESBD320
|
||||
00235 S001-DATE. DESBD320
|
||||
00236 CALL 'DTSBU001' USING L001-LINK-AREA. DESBD320
|
||||
00237 S001-EXIT. DESBD320
|
||||
00238 EXIT. DESBD320
|
||||
00239 DESBD320
|
||||
00240 S004-FROM-3. DESBD320
|
||||
00241 SET L004-FROM-3 TO TRUE. DESBD320
|
||||
00242 GO TO S004-YRQ. DESBD320
|
||||
00243 DESBD320
|
||||
00244 S004-FROM-5. DESBD320
|
||||
00245 SET L004-FROM-5 TO TRUE. DESBD320
|
||||
00246 GO TO S004-YRQ. DESBD320
|
||||
00247 DESBD320
|
||||
00248 S004-YRQ. DESBD320
|
||||
00249 CALL 'DTSBU004' USING L004-LINK-AREA. DESBD320
|
||||
00250 DESBD320
|
||||
00251 S004-EXIT. DESBD320
|
||||
00252 EXIT. DESBD320
|
||||
00253 DESBD320
|
||||
00254 S005-FROM-SYS. DESBD320
|
||||
00255 CALL 'DTSBU005' USING L005-LINK-AREA. DESBD320
|
||||
00256 S005-EXIT. DESBD320
|
||||
00257 EXIT. DESBD320
|
||||
00258 DESBD320
|
||||
00259 S982A-OPEN-READ. DESBD320
|
||||
00260 SET L982-OPEN-READ-88 TO TRUE. DESBD320
|
||||
00261 PERFORM S982Z-NAME-I THRU S982Z-EXIT. DESBD320
|
||||
00262 DESBD320
|
||||
00263 S982A-EXIT. DESBD320
|
||||
00264 EXIT. DESBD320
|
||||
00265 DESBD320
|
||||
00266 S982C-CLOSE. DESBD320
|
||||
00267 SET L982-CLOSE-88 TO TRUE. DESBD320
|
||||
00268 PERFORM S982Z-NAME-I THRU S982Z-EXIT. DESBD320
|
||||
00269 DESBD320
|
||||
00270 S982C-EXIT. DESBD320
|
||||
00271 EXIT. DESBD320
|
||||
00272 DESBD320
|
||||
00273 S982D-START-BROWSE. CL124
|
||||
00274 SET L982-START-BROWSE-88 TO TRUE. DESBD320
|
||||
00275 PERFORM S982Z-NAME-I THRU S982Z-EXIT. DESBD320
|
||||
00276 DESBD320
|
||||
00277 S982D-EXIT. DESBD320
|
||||
00278 EXIT. DESBD320
|
||||
00279 DESBD320
|
||||
00280 S982E-READ-NEXT. DESBD320
|
||||
00281 SET L982-READ-NEXT-88 TO TRUE. DESBD320
|
||||
00282 PERFORM S982Z-NAME-I THRU S982Z-EXIT. DESBD320
|
||||
00283 DESBD320
|
||||
00284 S982E-EXIT. DESBD320
|
||||
00285 EXIT. DESBD320
|
||||
00286 DESBD320
|
||||
00287 S982Z-NAME-I. DESBD320
|
||||
00288 CALL 'DTSBU982' USING L982-LINK-AREA DESBD320
|
||||
00289 WNAM-REC. DESBD320
|
||||
00290 S982Z-EXIT. DESBD320
|
||||
00291 EXIT. DESBD320
|
||||
00292 DESBD320
|
||||
00293 S999-ABEND. DESBD320
|
||||
00294 DISPLAY '*** DESBD320 ABENDING : ' DESBD320
|
||||
00295 WRK-ABEND-MSG. DESBD320
|
||||
00296 DESBD320
|
||||
00297 CALL 'DTSBU999' USING WRK-ABEND-CD. DESBD320
|
||||
00298 S999-EXIT. DESBD320
|
||||
00299 EXIT. DESBD320
|
||||
Reference in New Issue
Block a user