429 lines
34 KiB
COBOL
429 lines
34 KiB
COBOL
00001 IDENTIFICATION DIVISION. 10/10/03
|
|
00002 PROGRAM-ID. CHGBD901. CHGBD901
|
|
00003 *AUTHOR. TRW. LV001
|
|
00004 *DATE-WRITTEN. SEPTEMBER 2003. CHGBD901
|
|
00005 DATE-COMPILED. CHGBD901
|
|
00006 SKIP3 CHGBD901
|
|
00007 ***** CHGBD901
|
|
00008 * CHGBD901
|
|
00009 * FUNCTION: CHGBD901
|
|
00010 * CHGBD901
|
|
00011 * READ THE QUARTERLY DC WAGE FILE FROM PAYROLL AND CHGBD901
|
|
00012 * ADD RECORDS TO THE CHGM040 OUTPUT FILE. CHGBD901
|
|
00013 * CHGBD901
|
|
00014 * CHGBD901
|
|
00015 * INPUT: CHGBD901
|
|
00016 * CHGBD901
|
|
00017 * CHGM040 - DC WAGE INPUT DATA CHGBD901
|
|
00018 * CHGBD901
|
|
00019 * CHGBD901
|
|
00020 * OUTPUT: CHGBD901
|
|
00021 * CHGM010 - DC WAGE OUTPUT FILE CHGBD901
|
|
00022 * CHGBD901
|
|
00023 ***** CHGBD901
|
|
00024 CHGBD901
|
|
00025 ******************************************************************CHGBD901
|
|
00026 * MODIFICATION HISTORY: *CHGBD901
|
|
00027 * *CHGBD901
|
|
00028 * 09-04-2003 INITIAL DEVELOPMENT *CHGBD901
|
|
00029 * REFERENCE RFP # AUTHOR OF CHANGE - GD *CHGBD901
|
|
00030 * *CHGBD901
|
|
00031 * MM-DD-YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBD901
|
|
00032 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX *CHGBD901
|
|
00033 * REFERENCE RFP #**** AUTHOR OF CHANGE - *** *CHGBD901
|
|
00034 ******************************************************************CHGBD901
|
|
00035 CHGBD901
|
|
00036 SKIP3 CHGBD901
|
|
00037 ENVIRONMENT DIVISION. CHGBD901
|
|
00038 SKIP3 CHGBD901
|
|
00039 INPUT-OUTPUT SECTION. CHGBD901
|
|
00040 SKIP3 CHGBD901
|
|
00041 FILE-CONTROL. CHGBD901
|
|
00042 SELECT DC-AGENCY ASSIGN TO DCAGNCY CHGBD901
|
|
00043 FILE STATUS IS DC-AGENCY-STATUS. CHGBD901
|
|
00044 CHGBD901
|
|
00045 SELECT DC-WAGE-IN ASSIGN TO CHGM040 CHGBD901
|
|
00046 FILE STATUS IS DC-WAGE-IN-STATUS. CHGBD901
|
|
00047 CHGBD901
|
|
00048 SELECT DC-WAGE-OUT ASSIGN TO DTSWGHDC CHGBD901
|
|
00049 FILE STATUS IS DC-WAGE-OUT-STATUS. CHGBD901
|
|
00050 CHGBD901
|
|
00051 EJECT CHGBD901
|
|
00052 DATA DIVISION. CHGBD901
|
|
00053 FILE SECTION. CHGBD901
|
|
00054 FD DC-AGENCY CHGBD901
|
|
00055 RECORDING MODE IS F CHGBD901
|
|
00056 LABEL RECORDS ARE STANDARD CHGBD901
|
|
00057 BLOCK CONTAINS 0 CHARACTERS. CHGBD901
|
|
00058 SKIP1 CHGBD901
|
|
00059 01 DC-AGENCY-REC. CHGBD901
|
|
00060 05 DC-AGENCY-CODE PIC X(02). CHGBD901
|
|
00061 05 DC-AGENCY-NAME PIC X(38). CHGBD901
|
|
00062 05 DC-AGENCY-EMP-NO PIC 9(06). CHGBD901
|
|
00063 05 FILLER PIC X(02). CHGBD901
|
|
00064 CHGBD901
|
|
00065 FD DC-WAGE-IN CHGBD901
|
|
00066 RECORDING MODE IS F CHGBD901
|
|
00067 LABEL RECORDS ARE STANDARD CHGBD901
|
|
00068 BLOCK CONTAINS 0 CHARACTERS. CHGBD901
|
|
00069 SKIP1 CHGBD901
|
|
00070 01 CHGM040-REC. CHGBD901
|
|
00071 ++INCLUDE CHGIM040 CHGBD901
|
|
00072 CHGBD901
|
|
00073 FD DC-WAGE-OUT CHGBD901
|
|
00074 RECORDING MODE IS F CHGBD901
|
|
00075 LABEL RECORDS ARE STANDARD CHGBD901
|
|
00076 BLOCK CONTAINS 0 CHARACTERS. CHGBD901
|
|
00077 SKIP1 CHGBD901
|
|
00078 01 CHGM010-REC. CHGBD901
|
|
00079 ++INCLUDE CHGIM010 CHGBD901
|
|
00080 CHGBD901
|
|
00081 EJECT CHGBD901
|
|
00082 WORKING-STORAGE SECTION. CHGBD901
|
|
000825 77 PAN-VALET PICTURE X(24) VALUE '001CHGBD901 10/10/03'. CHGBD901
|
|
00083 CHGBD901
|
|
00084 01 WRK-AREA. CHGBD901
|
|
00085 05 ABEND-CODE PIC S9(04) COMP CHGBD901
|
|
00086 VALUE +220. CHGBD901
|
|
00087 05 ABEND-MOD PIC X(08) CHGBD901
|
|
00088 VALUE 'DTSBU999'. CHGBD901
|
|
00089 05 ABEND-MSG PIC X(60). CHGBD901
|
|
00090 CHGBD901
|
|
00091 05 DC-WAGE-IN-STATUS PIC X(02) VALUE SPACES. CHGBD901
|
|
00092 88 WAGE-IN-OK-88 VALUE ZERO. CHGBD901
|
|
00093 88 WAGE-IN-EOF-88 VALUE '10'. CHGBD901
|
|
00094 CHGBD901
|
|
00095 05 DC-WAGE-OUT-STATUS PIC X(02) VALUE SPACES. CHGBD901
|
|
00096 88 WAGE-OUT-OK-88 VALUE ZERO. CHGBD901
|
|
00097 CHGBD901
|
|
00098 05 DC-AGENCY-STATUS PIC X(02) VALUE SPACES. CHGBD901
|
|
00099 88 DC-AGENCY-OK-88 VALUE ZERO. CHGBD901
|
|
00100 88 DC-AGENCY-EOF-88 VALUE '10'. CHGBD901
|
|
00101 CHGBD901
|
|
00102 CHGBD901
|
|
00103 05 WRK-BYPASS-IND PIC X(01). CHGBD901
|
|
00104 88 WRK-BYPASS-YES-88 VALUE 'Y'. CHGBD901
|
|
00105 88 WRK-BYPASS-NO-88 VALUE 'N'. CHGBD901
|
|
00106 CHGBD901
|
|
00107 05 WRK-ERROR-IND PIC X(01). CHGBD901
|
|
00108 88 WRK-ERROR-YES-88 VALUE 'Y'. CHGBD901
|
|
00109 88 WRK-ERROR-NO-88 VALUE 'N'. CHGBD901
|
|
00110 CHGBD901
|
|
00111 05 WRK-YEAR. CHGBD901
|
|
00112 10 WRK-YEAR-CC PIC X(02). CHGBD901
|
|
00113 10 WRK-YEAR-YY PIC X(02). CHGBD901
|
|
00114 05 WRK-YEAR-CCYY REDEFINES WRK-YEAR CHGBD901
|
|
00115 PIC 9(04). CHGBD901
|
|
00116 CHGBD901
|
|
00117 05 WRK-DEFAULT-DC-EMP-NO PIC S9(07) COMP-3 CHGBD901
|
|
00118 VALUE +998888. CHGBD901
|
|
00119 CHGBD901
|
|
00120 05 WRK-EMP-NO PIC X(06). CHGBD901
|
|
00121 05 WRK-EMP-NO-9 REDEFINES WRK-EMP-NO CHGBD901
|
|
00122 PIC 9(06). CHGBD901
|
|
00123 CHGBD901
|
|
00124 05 WRK-IN-CNT PIC 9(08) COMP-3 VALUE 0. CHGBD901
|
|
00125 05 WRK-OUT-CNT PIC 9(08) COMP-3 VALUE 0. CHGBD901
|
|
00126 05 WRK-AGENCY-CNT PIC 9(08) COMP-3 VALUE 0. CHGBD901
|
|
00127 05 WRK-ERROR-CNT PIC 9(08) COMP-3 VALUE 0. CHGBD901
|
|
00128 CHGBD901
|
|
00129 01 DC-AGENCY-TBL-AREA. CHGBD901
|
|
00130 05 DC-TBL-SUB PIC S9(04) COMP. CHGBD901
|
|
00131 05 DC-TBL-LAST PIC S9(04) COMP VALUE +0. CHGBD901
|
|
00132 05 DC-TBL-MAX PIC S9(04) COMP VALUE +200. CHGBD901
|
|
00133 05 DC-AGENCY-TBL OCCURS 200 TIMES INDEXED BY DC-NDX. CHGBD901
|
|
00134 10 DC-TBL-CODE PIC X(02). CHGBD901
|
|
00135 10 DC-TBL-NAME PIC X(38). CHGBD901
|
|
00136 10 DC-TBL-EMP-NO PIC 9(06). CHGBD901
|
|
00137 10 FILLER PIC X(02). CHGBD901
|
|
00138 CHGBD901
|
|
00139 01 L004-LINK-AREA. CHGBD901
|
|
00140 ++INCLUDE DTSIL004 CHGBD901
|
|
00141 CHGBD901
|
|
00142 PROCEDURE DIVISION. CHGBD901
|
|
00143 SKIP2 CHGBD901
|
|
00144 CHGBD901-MAIN. CHGBD901
|
|
00145 PERFORM I0000-INITIATE THRU I0000-EXIT. CHGBD901
|
|
00146 IF WRK-ERROR-YES-88 CHGBD901
|
|
00147 GO TO CHGBD901-EXIT. CHGBD901
|
|
00148 CHGBD901
|
|
00149 PERFORM P0000-PROCESS THRU P0000-EXIT. CHGBD901
|
|
00150 CHGBD901
|
|
00151 PERFORM T0000-TERMINATE THRU T0000-EXIT. CHGBD901
|
|
00152 CHGBD901
|
|
00153 CHGBD901-EXIT. CHGBD901
|
|
00154 STOP RUN. CHGBD901
|
|
00155 EJECT CHGBD901
|
|
00156 I0000-INITIATE. CHGBD901
|
|
00157 SET WRK-ERROR-NO-88 TO TRUE. CHGBD901
|
|
00158 CHGBD901
|
|
00159 PERFORM I2000-OPEN-FILES THRU I2000-EXIT. CHGBD901
|
|
00160 CHGBD901
|
|
00161 PERFORM I3000-AGENCY-DATA THRU I3000-EXIT. CHGBD901
|
|
00162 CHGBD901
|
|
00163 I0000-EXIT. CHGBD901
|
|
00164 EXIT. CHGBD901
|
|
00165 CHGBD901
|
|
00166 I2000-OPEN-FILES. CHGBD901
|
|
00167 OPEN INPUT DC-AGENCY. CHGBD901
|
|
00168 IF NOT DC-AGENCY-OK-88 CHGBD901
|
|
00169 DISPLAY 'DC AGENCY OPEN ERROR: ' DC-AGENCY-STATUS CHGBD901
|
|
00170 PERFORM S999-ABEND THRU S999-EXIT. CHGBD901
|
|
00171 CHGBD901
|
|
00172 OPEN INPUT DC-WAGE-IN. CHGBD901
|
|
00173 IF NOT WAGE-IN-OK-88 CHGBD901
|
|
00174 DISPLAY 'INPUT FILE OPEN ERROR: ' DC-WAGE-IN-STATUS CHGBD901
|
|
00175 PERFORM S999-ABEND THRU S999-EXIT. CHGBD901
|
|
00176 CHGBD901
|
|
00177 OPEN OUTPUT DC-WAGE-OUT. CHGBD901
|
|
00178 IF NOT WAGE-OUT-OK-88 CHGBD901
|
|
00179 DISPLAY 'OUTPUT FILE OPEN ERROR: ' DC-WAGE-OUT-STATUS CHGBD901
|
|
00180 PERFORM S999-ABEND THRU S999-EXIT. CHGBD901
|
|
00181 CHGBD901
|
|
00182 I2000-EXIT. CHGBD901
|
|
00183 EXIT. CHGBD901
|
|
00184 CHGBD901
|
|
00185 I3000-AGENCY-DATA. CHGBD901
|
|
00186 MOVE +0 TO DC-TBL-LAST. CHGBD901
|
|
00187 CHGBD901
|
|
00188 READ DC-AGENCY. CHGBD901
|
|
00189 IF DC-AGENCY-EOF-88 CHGBD901
|
|
00190 DISPLAY 'CANNOT READ DC AGENCY FILE ' CHGBD901
|
|
00191 DC-AGENCY-STATUS CHGBD901
|
|
00192 SET WRK-ERROR-YES-88 TO TRUE CHGBD901
|
|
00193 GO TO I3000-EXIT CHGBD901
|
|
00194 END-IF. CHGBD901
|
|
00195 CHGBD901
|
|
00196 PERFORM CHGBD901
|
|
00197 UNTIL DC-AGENCY-EOF-88 CHGBD901
|
|
00198 PERFORM I3100-TABLE-DATA THRU I3100-EXIT CHGBD901
|
|
00199 IF WRK-ERROR-NO-88 CHGBD901
|
|
00200 PERFORM I3200-READ-AGENCY THRU I3200-EXIT CHGBD901
|
|
00201 END-IF CHGBD901
|
|
00202 END-PERFORM. CHGBD901
|
|
00203 CHGBD901
|
|
00204 I3000-EXIT. CHGBD901
|
|
00205 EXIT. CHGBD901
|
|
00206 CHGBD901
|
|
00207 I3100-TABLE-DATA. CHGBD901
|
|
00208 IF DC-TBL-LAST < DC-TBL-MAX CHGBD901
|
|
00209 ADD +1 TO DC-TBL-LAST CHGBD901
|
|
00210 MOVE DC-AGENCY-REC TO DC-AGENCY-TBL (DC-TBL-LAST) CHGBD901
|
|
00211 ELSE CHGBD901
|
|
00212 DISPLAY 'AGENCY TABLE LENGTH EXCEEDED' CHGBD901
|
|
00213 SET WRK-ERROR-YES-88 TO TRUE CHGBD901
|
|
00214 SET DC-AGENCY-EOF-88 TO TRUE CHGBD901
|
|
00215 END-IF. CHGBD901
|
|
00216 CHGBD901
|
|
00217 I3100-EXIT. CHGBD901
|
|
00218 EXIT. CHGBD901
|
|
00219 CHGBD901
|
|
00220 I3200-READ-AGENCY. CHGBD901
|
|
00221 READ DC-AGENCY CHGBD901
|
|
00222 IF DC-AGENCY-EOF-88 CHGBD901
|
|
00223 NEXT SENTENCE CHGBD901
|
|
00224 ELSE CHGBD901
|
|
00225 IF NOT WAGE-IN-OK-88 CHGBD901
|
|
00226 DISPLAY 'CANNOT READ DC WAGE IN FILE ' CHGBD901
|
|
00227 DC-WAGE-IN-STATUS CHGBD901
|
|
00228 SET WRK-ERROR-YES-88 TO TRUE CHGBD901
|
|
00229 SET DC-AGENCY-EOF-88 TO TRUE CHGBD901
|
|
00230 ELSE CHGBD901
|
|
00231 ADD 1 TO WRK-AGENCY-CNT CHGBD901
|
|
00232 END-IF CHGBD901
|
|
00233 END-IF. CHGBD901
|
|
00234 CHGBD901
|
|
00235 I3200-EXIT. CHGBD901
|
|
00236 EXIT. CHGBD901
|
|
00237 CHGBD901
|
|
00238 P0000-PROCESS. CHGBD901
|
|
00239 PERFORM S1000-READ-CHGM040 THRU S1000-EXIT. CHGBD901
|
|
00240 IF NOT WAGE-IN-OK-88 CHGBD901
|
|
00241 DISPLAY 'DC-WAGE INPUT FILE EMPTY: ' DC-WAGE-IN-STATUS CHGBD901
|
|
00242 SET WRK-ERROR-YES-88 TO TRUE CHGBD901
|
|
00243 GO TO P0000-EXIT. CHGBD901
|
|
00244 CHGBD901
|
|
00245 PERFORM P1000-PROCESS-WAGES THRU P1000-EXIT CHGBD901
|
|
00246 UNTIL WAGE-IN-EOF-88 CHGBD901
|
|
00247 OR WRK-ERROR-YES-88. CHGBD901
|
|
00248 CHGBD901
|
|
00249 P0000-EXIT. CHGBD901
|
|
00250 EXIT. CHGBD901
|
|
00251 CHGBD901
|
|
00252 P1000-PROCESS-WAGES. CHGBD901
|
|
00253 SET WRK-BYPASS-NO-88 TO TRUE. CHGBD901
|
|
00254 CHGBD901
|
|
00255 PERFORM P1100-FORMAT-OUTPUT THRU P1100-EXIT. CHGBD901
|
|
00256 IF WRK-BYPASS-NO-88 CHGBD901
|
|
00257 PERFORM P1200-FIND-EMP-NO THRU P1200-EXIT CHGBD901
|
|
00258 IF WRK-BYPASS-NO-88 CHGBD901
|
|
00259 PERFORM S2000-WRITE-CHGM010 THRU S2000-EXIT. CHGBD901
|
|
00260 CHGBD901
|
|
00261 PERFORM S1000-READ-CHGM040 THRU S1000-EXIT. CHGBD901
|
|
00262 CHGBD901
|
|
00263 P1000-EXIT. CHGBD901
|
|
00264 EXIT. CHGBD901
|
|
00265 CHGBD901
|
|
00266 P1100-FORMAT-OUTPUT. CHGBD901
|
|
00267 IF CHG40-YEAR NOT NUMERIC CHGBD901
|
|
00268 SET WRK-BYPASS-YES-88 TO TRUE CHGBD901
|
|
00269 ADD +1 TO WRK-ERROR-CNT CHGBD901
|
|
00270 DISPLAY 'ERR - YEAR ' CHG40-YEAR ' ' CHG40-SSN CHGBD901
|
|
00271 GO TO P1100-EXIT CHGBD901
|
|
00272 ELSE CHGBD901
|
|
00273 MOVE CHG40-YEAR TO L004-QTR-3-YR CHGBD901
|
|
00274 END-IF. CHGBD901
|
|
00275 CHGBD901
|
|
00276 EVALUATE CHG40-MONTH CHGBD901
|
|
00277 WHEN 'M' CHGBD901
|
|
00278 MOVE 1 TO L004-QTR-3-Q CHGBD901
|
|
00279 CHGBD901
|
|
00280 WHEN 'J' CHGBD901
|
|
00281 MOVE 2 TO L004-QTR-3-Q CHGBD901
|
|
00282 CHGBD901
|
|
00283 WHEN 'S' CHGBD901
|
|
00284 MOVE 3 TO L004-QTR-3-Q CHGBD901
|
|
00285 CHGBD901
|
|
00286 WHEN 'D' CHGBD901
|
|
00287 MOVE 4 TO L004-QTR-3-Q CHGBD901
|
|
00288 CHGBD901
|
|
00289 WHEN OTHER CHGBD901
|
|
00290 ADD +1 TO WRK-ERROR-CNT CHGBD901
|
|
00291 DISPLAY 'ERR - MONTH ' CHG40-MONTH ' ' CHG40-SSN CHGBD901
|
|
00292 SET WRK-BYPASS-YES-88 TO TRUE CHGBD901
|
|
00293 CHGBD901
|
|
00294 END-EVALUATE. CHGBD901
|
|
00295 CHGBD901
|
|
00296 IF WRK-BYPASS-YES-88 CHGBD901
|
|
00297 GO TO P1100-EXIT. CHGBD901
|
|
00298 CHGBD901
|
|
00299 PERFORM S004-FROM-3 THRU S004-EXIT. CHGBD901
|
|
00300 IF L004-INVALID-QTR CHGBD901
|
|
00301 ADD +1 TO WRK-ERROR-CNT CHGBD901
|
|
00302 SET WRK-BYPASS-YES-88 TO TRUE CHGBD901
|
|
00303 DISPLAY 'ERR - QTR ' CHG40-YEAR ' ' CHG40-MONTH CHGBD901
|
|
00304 CHG40-SSN CHGBD901
|
|
00305 GO TO P1100-EXIT CHGBD901
|
|
00306 ELSE CHGBD901
|
|
00307 MOVE L004-QTR-5-9 TO CHG10-YRQ. CHGBD901
|
|
00308 CHGBD901
|
|
00309 IF CHG40-SSN NUMERIC CHGBD901
|
|
00310 MOVE CHG40-SSN TO CHG10-SSN CHGBD901
|
|
00311 ELSE CHGBD901
|
|
00312 ADD +1 TO WRK-ERROR-CNT CHGBD901
|
|
00313 SET WRK-BYPASS-YES-88 TO TRUE CHGBD901
|
|
00314 DISPLAY 'ERR - SSN ' CHG40-SSN CHGBD901
|
|
00315 GO TO P1100-EXIT. CHGBD901
|
|
00316 CHGBD901
|
|
00317 MOVE CHG40-DC-AGENCY-CD TO CHG10-DC-AGENCY-CD. CHGBD901
|
|
00318 CHGBD901
|
|
00319 IF CHG40-WAGES NUMERIC CHGBD901
|
|
00320 MOVE CHG40-WAGES TO CHG10-WAGES CHGBD901
|
|
00321 ELSE CHGBD901
|
|
00322 IF CHG40-WAGES = ZERO CHGBD901
|
|
00323 ADD +1 TO WRK-ERROR-CNT CHGBD901
|
|
00324 SET WRK-BYPASS-YES-88 TO TRUE CHGBD901
|
|
00325 DISPLAY 'ERR - WAGES ' CHG40-WAGES CHGBD901
|
|
00326 GO TO P1100-EXIT CHGBD901
|
|
00327 ELSE CHGBD901
|
|
00328 ADD +1 TO WRK-ERROR-CNT CHGBD901
|
|
00329 SET WRK-BYPASS-YES-88 TO TRUE CHGBD901
|
|
00330 DISPLAY 'ERR - WAGES = ZERO ' CHG40-WAGES CHGBD901
|
|
00331 GO TO P1100-EXIT. CHGBD901
|
|
00332 CHGBD901
|
|
00333 P1100-EXIT. CHGBD901
|
|
00334 EXIT. CHGBD901
|
|
00335 CHGBD901
|
|
00336 P1200-FIND-EMP-NO. CHGBD901
|
|
00337 SET DC-NDX TO +1. CHGBD901
|
|
00338 SEARCH DC-AGENCY-TBL VARYING DC-NDX CHGBD901
|
|
00339 AT END CHGBD901
|
|
00340 MOVE WRK-DEFAULT-DC-EMP-NO TO CHG10-EMP-NO CHGBD901
|
|
00341 WHEN DC-TBL-CODE (DC-NDX) = CHG40-DC-AGENCY-CD CHGBD901
|
|
00342 MOVE DC-TBL-EMP-NO (DC-NDX) TO CHG10-EMP-NO CHGBD901
|
|
00343 END-SEARCH. CHGBD901
|
|
00344 CHGBD901
|
|
00345 P1200-EXIT. CHGBD901
|
|
00346 EXIT. CHGBD901
|
|
00347 CHGBD901
|
|
00348 S1000-READ-CHGM040. CHGBD901
|
|
00349 READ DC-WAGE-IN. CHGBD901
|
|
00350 IF WAGE-IN-EOF-88 CHGBD901
|
|
00351 GO TO S1000-EXIT CHGBD901
|
|
00352 ELSE CHGBD901
|
|
00353 IF NOT WAGE-IN-OK-88 CHGBD901
|
|
00354 DISPLAY 'CANNOT READ DC WAGE IN FILE ' CHGBD901
|
|
00355 DC-WAGE-IN-STATUS CHGBD901
|
|
00356 SET WRK-ERROR-YES-88 TO TRUE CHGBD901
|
|
00357 ELSE CHGBD901
|
|
00358 ADD 1 TO WRK-IN-CNT CHGBD901
|
|
00359 END-IF CHGBD901
|
|
00360 END-IF. CHGBD901
|
|
00361 CHGBD901
|
|
00362 S1000-EXIT. CHGBD901
|
|
00363 EXIT. CHGBD901
|
|
00364 CHGBD901
|
|
00365 S2000-WRITE-CHGM010. CHGBD901
|
|
00366 WRITE CHGM010-REC. CHGBD901
|
|
00367 IF WAGE-OUT-OK-88 CHGBD901
|
|
00368 ADD 1 TO WRK-OUT-CNT CHGBD901
|
|
00369 ELSE CHGBD901
|
|
00370 DISPLAY 'CANNOT WRITE OUTPUT ' DC-WAGE-OUT-STATUS CHGBD901
|
|
00371 SET WRK-ERROR-YES-88 TO TRUE CHGBD901
|
|
00372 END-IF. CHGBD901
|
|
00373 CHGBD901
|
|
00374 S2000-EXIT. CHGBD901
|
|
00375 EXIT. CHGBD901
|
|
00376 CHGBD901
|
|
00377 S004-FROM-3. CHGBD901
|
|
00378 SET L004-FROM-3 TO TRUE. CHGBD901
|
|
00379 GO TO S004-YRQ. CHGBD901
|
|
00380 CHGBD901
|
|
00381 S004-YRQ. CHGBD901
|
|
00382 CALL 'DTSBU004' USING L004-LINK-AREA. CHGBD901
|
|
00383 CHGBD901
|
|
00384 S004-EXIT. EXIT. CHGBD901
|
|
00385 CHGBD901
|
|
00386 ** REPORT RECORD I-O CHGBD901
|
|
00387 *S946-RPT-REC-O. CHGBD901
|
|
00388 * CALL 'DTSBU946' USING RSKL-REC. CHGBD901
|
|
00389 * CHGBD901
|
|
00390 *S946-EXIT. CHGBD901
|
|
00391 * EXIT. CHGBD901
|
|
00392 CHGBD901
|
|
00393 T0000-TERMINATE. CHGBD901
|
|
00394 CLOSE DC-WAGE-IN CHGBD901
|
|
00395 DC-WAGE-OUT. CHGBD901
|
|
00396 CHGBD901
|
|
00397 CHGBD901
|
|
00398 DISPLAY '***********************************************'. CHGBD901
|
|
00399 DISPLAY '*** CHGBD901 COUNTS *** '. CHGBD901
|
|
00400 DISPLAY '***'. CHGBD901
|
|
00401 CHGBD901
|
|
00402 DISPLAY ' INPUT WAGE RECORDS READ : ' CHGBD901
|
|
00403 WRK-IN-CNT. CHGBD901
|
|
00404 CHGBD901
|
|
00405 DISPLAY ' OUTPUT WAGE RECORDS WRITTEN : ' CHGBD901
|
|
00406 WRK-OUT-CNT. CHGBD901
|
|
00407 CHGBD901
|
|
00408 DISPLAY ' DC AGENCY RECORDS READ : ' CHGBD901
|
|
00409 WRK-AGENCY-CNT. CHGBD901
|
|
00410 CHGBD901
|
|
00411 DISPLAY ' ERRORS : ' CHGBD901
|
|
00412 WRK-ERROR-CNT. CHGBD901
|
|
00413 CHGBD901
|
|
00414 DISPLAY '***********************************************'. CHGBD901
|
|
00415 CHGBD901
|
|
00416 T0000-EXIT. CHGBD901
|
|
00417 EXIT. CHGBD901
|
|
00418 EJECT CHGBD901
|
|
00419 CHGBD901
|
|
00420 S999-ABEND. CHGBD901
|
|
00421 DISPLAY '**** CHGBD901 ABENDING ' CHGBD901
|
|
00422 ABEND-MSG. CHGBD901
|
|
00423 CALL ABEND-MOD USING ABEND-CODE. CHGBD901
|
|
00424 CHGBD901
|
|
00425 S999-EXIT. CHGBD901
|
|
00426 EXIT. CHGBD901
|
|
00427 CHGBD901
|