246 lines
19 KiB
COBOL
246 lines
19 KiB
COBOL
00001 IDENTIFICATION DIVISION. 08/11/11
|
|
00002 PROGRAM-ID. WGEDC090. WGEDC090
|
|
00003 LV017
|
|
00004 ******************************************************************WGEDC090
|
|
00005 * 90 BYTE RECORD FORMAT ONLY USE WAGEDC1 FOR 256 BYTE FORMAT * CL*11
|
|
00006 * FUNCTION: *WGEDC090
|
|
00007 * THE FUNCTION OF WAGEMDC1IS TO REFORMAT THE DC PAYROLL WGEDC090
|
|
00008 * INTO THE DOCS SYSTEM W4 FORMAT. *WGEDC090
|
|
00009 * WGEDC090
|
|
00010 * 7/19/11 MODIFY PROGRAM TO INCLUDE YEARS 2011 2012 2013 ZL1 CL**3
|
|
00011 * *WGEDC090
|
|
00012 ******************************************************************WGEDC090
|
|
00013 WGEDC090
|
|
00014 ENVIRONMENT DIVISION. WGEDC090
|
|
00015 CONFIGURATION SECTION. WGEDC090
|
|
00016 SPECIAL-NAMES. C01 IS TOP-OF-PAGE. WGEDC090
|
|
00017 INPUT-OUTPUT SECTION. WGEDC090
|
|
00018 FILE-CONTROL. WGEDC090
|
|
00019 SELECT MAGFILE ASSIGN TO MAGFILE. WGEDC090
|
|
00020 SELECT MAGFILEO ASSIGN TO MAGFILEO. WGEDC090
|
|
00021 SELECT LISTOUT ASSIGN TO UR-S-LISTOUT. WGEDC090
|
|
00022 DATA DIVISION. WGEDC090
|
|
00023 FILE SECTION. WGEDC090
|
|
00024 FD MAGFILE WGEDC090
|
|
00025 RECORDING MODE IS F CL*11
|
|
00026 DATA RECORD IS MAGREC. WGEDC090
|
|
00027 01 MAGREC PIC X(090). CL*11
|
|
00028 FD MAGFILEO WGEDC090
|
|
00029 RECORDING MODE IS F WGEDC090
|
|
00030 BLOCK CONTAINS 0 CHARACTERS WGEDC090
|
|
00031 LABEL RECORDS ARE STANDARD WGEDC090
|
|
00032 DATA RECORD IS MAGRECO. WGEDC090
|
|
00033 01 MAGRECO PIC X(90). WGEDC090
|
|
00034 FD LISTOUT WGEDC090
|
|
00035 RECORD CONTAINS 133 CHARACTERS WGEDC090
|
|
00036 LABEL RECORDS ARE OMITTED WGEDC090
|
|
00037 RECORDING MODE IS F WGEDC090
|
|
00038 DATA RECORD IS PRINT-REC. WGEDC090
|
|
00039 01 PRINT-REC PIC X(133). WGEDC090
|
|
00040 WORKING-STORAGE SECTION. WGEDC090
|
|
000405 77 PAN-VALET PICTURE X(24) VALUE '017WGEDC090 08/11/11'. WGEDC090
|
|
00041 01 WS-MAGRECO. WGEDC090
|
|
00042 05 OUT-MONTH PIC X. WGEDC090
|
|
00043 05 FIL PIC 9X(89). WGEDC090
|
|
00044 01 MAGNETIC-WORK-AREA. WGEDC090
|
|
00045 03 EXTRACT-QTR-YEAR. WGEDC090
|
|
00046 05 EXTRACT-MONTH PIC X. WGEDC090
|
|
00047 05 EXTRACT-YEAR PIC XX. WGEDC090
|
|
00048 03 EXTRACT-EMPLOYER-ID PIC X(6). WGEDC090
|
|
00049 03 EXTRACT-FIVE-ZEROS PIC 9(5). WGEDC090
|
|
00050 03 EXTRACT-CONSTANT PIC XXX. WGEDC090
|
|
00051 03 EXTRACT-SSN PIC 9(9). WGEDC090
|
|
00052 03 EXTRACT-NAME-SYSTEM PIC X(5). WGEDC090
|
|
00053 03 EXTRACT-WAGES PIC S9(7)V99. WGEDC090
|
|
00054 03 EXTRACT-NAME PIC X(28). WGEDC090
|
|
00055 03 EXTRACT-12 PIC X(22). CL**4
|
|
00056 01 COUNTERS. WGEDC090
|
|
00057 03 FIX-RECS-OUT PIC 9(9). WGEDC090
|
|
00058 03 QTR-RECS-OUT PIC 9(9). WGEDC090
|
|
00059 03 EMP-QTR-TOT-EARNINGS PIC 9(10)V99. WGEDC090
|
|
00060 03 RECS-IN PIC 9(9). WGEDC090
|
|
00061 03 RECS-OUT PIC 9(9). WGEDC090
|
|
00062 03 PAGE-CTR PIC 9(5). WGEDC090
|
|
00063 03 ERROR-RECS PIC 9(9). WGEDC090
|
|
00064 03 ZEROS-WS PIC 9(9). WGEDC090
|
|
00065 03 ERROR-SW PIC 9. WGEDC090
|
|
00066 01 LINE-CTR PIC 9(5) VALUE 56. WGEDC090
|
|
00067 01 EOF PIC X. WGEDC090
|
|
00068 01 HD1. WGEDC090
|
|
00069 03 FIL PIC X(5) VALUE SPACES. WGEDC090
|
|
00070 03 FIL PIC X(8) VALUE 'DTSWGE01'. CL*13
|
|
00071 03 FIL PIC X(31) VALUE SPACES. WGEDC090
|
|
00072 03 FIL PIC X(42) VALUE WGEDC090
|
|
00073 'DISTRICT DEPARTMENT OF EMPLOYMENT SERVICES'. WGEDC090
|
|
00074 03 FIL PIC X(35) VALUE SPACES. WGEDC090
|
|
00075 03 FIL PIC X(5) VALUE 'PAGE:'. WGEDC090
|
|
00076 03 PAGE-CTR-PRT PIC ZZ,ZZ9. WGEDC090
|
|
00077 01 HD2. WGEDC090
|
|
00078 03 FIL PIC X(49) VALUE SPACES. WGEDC090
|
|
00079 03 FIL PIC X(39) VALUE WGEDC090
|
|
00080 'DC-GOV WAGE RECORD EDIT REPORT'. CL*13
|
|
00081 01 HD3. WGEDC090
|
|
00082 03 FIL PIC X(57) VALUE SPACES. WGEDC090
|
|
00083 03 FIL PIC X(9) VALUE 'RUN DATE:'. WGEDC090
|
|
00084 03 RUN-DATE PIC X(8). WGEDC090
|
|
00085 01 HD4. WGEDC090
|
|
00086 03 FIL PIC X(5) VALUE SPACES. WGEDC090
|
|
00087 03 FIL PIC X(3) VALUE 'SSN'. WGEDC090
|
|
00088 03 FIL PIC X(7) VALUE SPACES. WGEDC090
|
|
00089 03 FIL PIC X(12) VALUE 'DATE ENTERED'. WGEDC090
|
|
00090 03 FIL PIC X(02) VALUE SPACES. WGEDC090
|
|
00091 03 FIL PIC X(13) VALUE 'EMPLOYEE NAME'. WGEDC090
|
|
00092 03 FIL PIC X(2) VALUE SPACES. WGEDC090
|
|
00093 03 FIL PIC X(7) VALUE 'QUARTER'. WGEDC090
|
|
00094 03 FIL PIC X(6) VALUE SPACES. WGEDC090
|
|
00095 03 FIL PIC X(8) VALUE 'EARNINGS'. WGEDC090
|
|
00096 03 FIL PIC X(6) VALUE SPACES. WGEDC090
|
|
00097 03 FIL PIC X(14) VALUE 'ACCOUNT NUMBER'. WGEDC090
|
|
00098 03 FIL PIC X(2) VALUE SPACES. WGEDC090
|
|
00099 03 FIL PIC X(13) VALUE 'EMPLOYER NAME'. WGEDC090
|
|
00100 03 FIL PIC X(10) VALUE SPACES. WGEDC090
|
|
00101 03 FIL PIC X(18) VALUE 'ERRORS ENCOUNTERED'. WGEDC090
|
|
00102 01 DTL1. WGEDC090
|
|
00103 03 FIL PIC X(5) VALUE SPACES. WGEDC090
|
|
00104 03 SSN-PRT PIC X(9). WGEDC090
|
|
00105 03 FIL PIC XX VALUE SPACES. WGEDC090
|
|
00106 03 DATE-ENTERED-PRT PIC X(08). WGEDC090
|
|
00107 03 FIL PIC X(10) VALUE SPACES. WGEDC090
|
|
00108 03 EMPEE-NAME PIC X(3). WGEDC090
|
|
00109 03 FIL PIC X(12) VALUE SPACES. WGEDC090
|
|
00110 03 QTR-PRT. WGEDC090
|
|
00111 05 QTR-PRT-QTR PIC X. WGEDC090
|
|
00112 05 QTR-PRT-YR PIC 99. WGEDC090
|
|
00113 03 FIL PIC X(9) VALUE SPACES. WGEDC090
|
|
00114 03 EARNINGS-PRT PIC 9(9). WGEDC090
|
|
00115 03 FIL PIC X(9) VALUE SPACES. WGEDC090
|
|
00116 03 ACCT-NUM-PRT PIC X(6). WGEDC090
|
|
00117 03 FIL PIC X(9) VALUE SPACES. WGEDC090
|
|
00118 03 EMPOR-PRT PIC X(6). WGEDC090
|
|
00119 03 FIL PIC X(08) VALUE SPACES. WGEDC090
|
|
00120 03 MESSAGE-AREA PIC X(30) VALUE SPACES. WGEDC090
|
|
00121 01 TOT1. WGEDC090
|
|
00122 03 FIL PIC X(5) VALUE SPACES. WGEDC090
|
|
00123 03 FIL PIC X(19) VALUE 'TOTAL WAGE RECORDS:'. WGEDC090
|
|
00124 03 WAGE-CNT-PRT PIC ZZZ,ZZZ,ZZ9. WGEDC090
|
|
00125 03 FIL PIC X(5) VALUE SPACES. WGEDC090
|
|
00126 03 FIL PIC X(20) VALUE 'TOTAL ERROR RECORDS:'. WGEDC090
|
|
00127 03 ERRORS-PRT PIC ZZZ,ZZ9. WGEDC090
|
|
00128 03 FIL PIC X(5) VALUE SPACES. WGEDC090
|
|
00129 03 FIL PIC X(20) VALUE 'TOTAL WAGE EARNINGS:'. WGEDC090
|
|
00130 03 TOT-EARNINGS-PRT PIC Z,ZZZ,ZZZ,999.99. WGEDC090
|
|
00131 01 BLANK-LINE PIC X(133) VALUE SPACES. WGEDC090
|
|
00132 PROCEDURE DIVISION. WGEDC090
|
|
00133 OPEN INPUT MAGFILE. WGEDC090
|
|
00134 OPEN OUTPUT LISTOUT MAGFILEO. WGEDC090
|
|
00135 MOVE ZEROS TO COUNTERS. WGEDC090
|
|
00136 PERFORM 100-READ-WAGE THRU 100-RW-EXIT WGEDC090
|
|
00137 UNTIL EOF = 1. CL*13
|
|
00138 WGEDC090
|
|
00139 IF EOF = 1 WGEDC090
|
|
00140 GO TO 999-CLOSE-FILES. WGEDC090
|
|
00141 GOBACK. CL*13
|
|
00142 100-READ-WAGE. WGEDC090
|
|
00143 READ MAGFILE INTO MAGNETIC-WORK-AREA WGEDC090
|
|
00144 AT END WGEDC090
|
|
00145 MOVE 1 TO EOF CL*13
|
|
00146 GO TO 100-RW-EXIT. WGEDC090
|
|
00147 WGEDC090
|
|
00148 IF EXTRACT-WAGES = ZEROS WGEDC090
|
|
00149 DISPLAY '2272 ZEROS WAGES ' EXTRACT-SSN CL*17
|
|
00150 GO TO 100-READ-WAGE. WGEDC090
|
|
00151 WGEDC090
|
|
00152 ADD 1 TO RECS-OUT. WGEDC090
|
|
00153 MOVE MAGREC TO WS-MAGRECO. CL*14
|
|
00154 PERFORM 110-VALIDATE-WAGE THRU 121-VW-EXIT. WGEDC090
|
|
00155 IF ERROR-SW = 1 WGEDC090
|
|
00156 MOVE ZERO TO ERROR-SW WGEDC090
|
|
00157 GO TO 100-RW-EXIT. CL*14
|
|
00158 CL*14
|
|
00159 MOVE ZERO TO ERROR-SW. WGEDC090
|
|
00160 WRITE MAGRECO FROM WS-MAGRECO. CL*15
|
|
00161 ADD 1 TO FIX-RECS-OUT. CL*15
|
|
00162 CL*15
|
|
00163 100-RW-EXIT. WGEDC090
|
|
00164 EXIT. WGEDC090
|
|
00165 110-VALIDATE-WAGE. WGEDC090
|
|
00166 MOVE SPACES TO MESSAGE-AREA. WGEDC090
|
|
00167 111-VALIDATE-QUARTER-CODE. WGEDC090
|
|
00168 WGEDC090
|
|
00169 IF EXTRACT-MONTH EQUAL 'D' CL*14
|
|
00170 MOVE 4 TO OUT-MONTH CL*16
|
|
00171 ELSE CL*14
|
|
00172 IF EXTRACT-MONTH EQUAL 'S' CL*14
|
|
00173 MOVE 3 TO OUT-MONTH CL*16
|
|
00174 ELSE CL*14
|
|
00175 IF EXTRACT-MONTH EQUAL 'J' CL*14
|
|
00176 MOVE 2 TO OUT-MONTH CL*16
|
|
00177 ELSE CL*14
|
|
00178 IF EXTRACT-MONTH EQUAL 'M' CL*14
|
|
00179 MOVE 1 TO OUT-MONTH CL*14
|
|
00180 ELSE CL*14
|
|
00181 MOVE 'MONTH NE SJMD ' TO MESSAGE-AREA CL*14
|
|
00182 MOVE 1 TO ERROR-SW CL*14
|
|
00183 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT. CL*14
|
|
00184 CL*14
|
|
00185 112-VALIDATE-YEAR. WGEDC090
|
|
00186 IF EXTRACT-YEAR NOT NUMERIC WGEDC090
|
|
00187 MOVE 'MAG YEAR NOT NUMERIC ' TO MESSAGE-AREA WGEDC090
|
|
00188 MOVE 1 TO ERROR-SW WGEDC090
|
|
00189 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT. CL*13
|
|
00190 114-VALIDATE-SSN. WGEDC090
|
|
00191 IF EXTRACT-SSN NOT NUMERIC WGEDC090
|
|
00192 MOVE 'SSN NOT NUMERIC ' TO MESSAGE-AREA WGEDC090
|
|
00193 MOVE 1 TO ERROR-SW WGEDC090
|
|
00194 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT. WGEDC090
|
|
00195 118-QUARTER-EARNINGS. WGEDC090
|
|
00196 IF EXTRACT-WAGES NOT NUMERIC WGEDC090
|
|
00197 MOVE 'QUARTER EARNINGS NOT NUMERIC' TO MESSAGE-AREA WGEDC090
|
|
00198 MOVE 1 TO ERROR-SW WGEDC090
|
|
00199 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT. WGEDC090
|
|
00200 119-EMPLOYEE-NAME. WGEDC090
|
|
00201 IF EXTRACT-NAME = SPACES WGEDC090
|
|
00202 MOVE 'EMPLOYEE-NAME EQUAL SPACES' TO MESSAGE-AREA WGEDC090
|
|
00203 MOVE 1 TO ERROR-SW WGEDC090
|
|
00204 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT. WGEDC090
|
|
00205 120-VALIDATE-EMPLOYER-ACCOUNT. WGEDC090
|
|
00206 IF EXTRACT-EMPLOYER-ID = ZEROS CL*14
|
|
00207 MOVE 'EMPLOYER ACCOUNT LESS THAN ZERO' TO MESSAGE-AREA WGEDC090
|
|
00208 MOVE 1 TO ERROR-SW WGEDC090
|
|
00209 PERFORM 125-WAGE-REPORT THRU 125-WR-EXIT. CL*13
|
|
00210 121-VW-EXIT. WGEDC090
|
|
00211 EXIT. WGEDC090
|
|
00212 125-WAGE-REPORT. WGEDC090
|
|
00213 ADD 1 TO ERROR-RECS. WGEDC090
|
|
00214 MOVE EXTRACT-SSN TO SSN-PRT. WGEDC090
|
|
00215 MOVE EXTRACT-NAME TO EMPEE-NAME. WGEDC090
|
|
00216 MOVE EXTRACT-WAGES TO EARNINGS-PRT. WGEDC090
|
|
00217 MOVE EXTRACT-MONTH TO QTR-PRT-QTR. WGEDC090
|
|
00218 MOVE EXTRACT-YEAR TO QTR-PRT-YR. WGEDC090
|
|
00219 MOVE EXTRACT-EMPLOYER-ID TO ACCT-NUM-PRT. WGEDC090
|
|
00220 IF LINE-CTR > 55 WGEDC090
|
|
00221 PERFORM 130-WAGE-HEADER THRU 130-WH-EXIT. WGEDC090
|
|
00222 WRITE PRINT-REC FROM DTL1. WGEDC090
|
|
00223 ADD 1 TO LINE-CTR. WGEDC090
|
|
00224 125-WR-EXIT. WGEDC090
|
|
00225 EXIT. WGEDC090
|
|
00226 130-WAGE-HEADER. WGEDC090
|
|
00227 ADD 1 TO PAGE-CTR. WGEDC090
|
|
00228 MOVE PAGE-CTR TO PAGE-CTR-PRT. WGEDC090
|
|
00229 WRITE PRINT-REC FROM HD1 AFTER TOP-OF-PAGE. WGEDC090
|
|
00230 WRITE PRINT-REC FROM HD2. WGEDC090
|
|
00231 WRITE PRINT-REC FROM HD3. WGEDC090
|
|
00232 WRITE PRINT-REC FROM HD4. WGEDC090
|
|
00233 MOVE 4 TO LINE-CTR. WGEDC090
|
|
00234 130-WH-EXIT. WGEDC090
|
|
00235 EXIT. WGEDC090
|
|
00236 999-CLOSE-FILES. WGEDC090
|
|
00237 DISPLAY '3710 999-CLOSE ' WGEDC090
|
|
00238 MOVE RECS-OUT TO WAGE-CNT-PRT. WGEDC090
|
|
00239 MOVE EMP-QTR-TOT-EARNINGS TO TOT-EARNINGS-PRT. WGEDC090
|
|
00240 MOVE ERROR-RECS TO ERRORS-PRT. WGEDC090
|
|
00241 WRITE PRINT-REC FROM TOT1 AFTER 2. WGEDC090
|
|
00242 CLOSE MAGFILE LISTOUT MAGFILEO. WGEDC090
|
|
00243 STOP RUN. WGEDC090
|
|
00244 EJECT WGEDC090
|