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
