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