301 lines
24 KiB
COBOL
301 lines
24 KiB
COBOL
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
|