000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID.    PY100 IS INITIAL.
000300 AUTHOR.        MJD.
000400 ENVIRONMENT DIVISION.
000500 CONFIGURATION SECTION.
           COPY "EXCEL.CS".
000600 SOURCE-COMPUTER. IBM-PC-XT.
000700 OBJECT-COMPUTER. IBM-PC-XT.
000800*REMARKS.
000900*****************************************************************
001000*
001100* PY100 - Calculate Taxes and Deductions
001200* VERSION 4.00  - OFFICER
001200* VERSION 4.01 04/10/1986 - Problem calculating taxes when annual
001200*                           gross is low.
001200*                           Set TEMP-GROSS to zero when below 0
001200*                           Set TAX-AMT to zero when below 0
001200* VERSION 4.02 03/09/1987 - E.I.C. Payments not calculated right
001200*              03/09/1987 - New EIC Rates added
001200*              03/26/1987 - 401K Deduction Logic added.
111890* UPD KWS - ADDED CHANGE TO READ STATE FILE FOR 401K LIMIT      *
112090* UPD KWS - ADDED LOGIC TO UPDATE PYHD-401K & S125-DED BUCKETS  *
112190* UPD KWS - ADDED LOGIC TO CALC MEDICARE PORTION                *
112590* UPD KWS - ADDED LOGIC FOR S125 PLANS                          *
122790* FIX KWS - YTD GROSS WAS NOT INCLUDING 401K AND S125 DEDUC     *
122890* FIX KWS - COULD END UP WITH NEGATIVE FICA AND MEDICARE        *
TS0319* UPD TNS - EXPANED # OF DEDUCTIONS FROM 9 TO 10                *
092691* UPD KWS - ALLOW EXEMPT ON MEDICARE                            *
121791* UPD KWS - UPDATED EIC TO 1991 FIGURES                         *
121791* UPD KWS - ASK CALC FIT, FICA, STATE ON EACH CHECK TYPE        *
123091* UPD KWS - CALL EXTENDED PY REGISTER IF FLAG SET IN CNTL       *
123191* UPD KWS - 1992 EIC CHANGES                                    *
022592* FIX KWS - PREVENT NEGATIVE FICA/MEDICARE                      *
060292* FIX KWS - CLEAR SCREEN BEFORE ASKING WHICH TAXES TO TAKE      *
070192* UPD KWS - IF ONLY HEADER DELETE AND PROCESS NEXT RECORD       *
070892* FIX KWS - NOT SUBTRACTING DIS TAX FROM NET PAY                *
070892* FIX KWS - NOT CLEARING STATE 401K BEFORE CALC... CUMULATIVE   *
082692* UPD BOB - PIONEER - TAKE PARTIAL UNION DUES [SEE 88 LEVEL]    *
090492* UPD BOB - GARNISHMENTS (PIONEER)                              *
100692* FIX BOB - GARNISHMENTS - VAR CORRUPTED IF UNION DUES          *
100792* UPD BOB - GARNISHMENT - USE TAXABLE/NONTAXABLE FLAG (FM NET)  *
102092* FIX BOB - GARNISHMENT - CALCULATING FOR EVERYONE              *
122392* UPD BOB - 1993 EIC CHANGES                                    *
012793* FIX BOB - GARNISHMENT - KEEPS TAKING PAST EMPD-LIMIT          *
031893* UPD BOB - 20 DEDUCTIONS                                       *
032493* UPD KWS - READ PIONEER BLOCK TO CONTROL MOD                   *
033093* UPD BOB - SET READY-TO-POST FLAG IN CNTLF                     *
033193* FIX BOB - CALC GARNISHMENT- SET YTD-DED(20)                   *
040593* FIX BOB - SET EMPL 401K LIMIT TO FEDERAL IF NOT SET           *
042693* UPD RWK - TAKE GARNISHMENT DEDUCTION FIRST,NO NEGATIVE CHECKS *
120693* UPD BOB - FEDERAL LEVY                                        *
051294* UPD BOB - KY JDAF STATE TAX CREDIT  (QUEST)                   *
051994* UPD KWS - UPDATED EIC FOR 1994 AMOUNTS, OLD LOGIC DID NOT MAKE*
      *         - SENSE, SO I REWROTE PARTS OF IT. ADDED LIMIT LOGIC  *
070194* FIX AHK - AMT. NOT BEING ADDED TO YTD-DED(11), WAS MOVED TO IT*
PROFIT* CVT AHK - PN-FILE/PATHNAME NOT NEEDED IN PROFITS.             *
113094* UPD BOB - IF JDAF & GARNISHMENT, REDUCE NET BY JDAF (QUEST)   *
122795* UPD BOB - 1996 EIC CHANGES                                    *
122396* MOD KWS V2.6A- ALLIED - SUPPORT FOR 401K EXPORT VALUSELECT    *
010797* UPD KWS V2.6A- 1997 EIC CHANGES                               *
020697* MOD KWS V2.6B- PIONEER - NEEDS TO USE NEW JULIAN DATE LOGIC   *
020796* FIX KWS V2.6B- PREVENT OUT OF BALANCE GL IF LINES DELETED     *
030697* FIX KWS V2.6B- MISSED DED REG NOT WORKING BECAUSE REC DELETED *
032897* FIX KWS V2.6C- PREVENT 401K/S125 FROM TAKING MOVE THAN AVAIL  *
042197* FIX BOB V2.6C- MANUAL CHECK TAXES BEING CLEARED               *
081397* UPD KWS V2.7 - CONVERT TO JULIAN DATES                         *
122897* UPD KWS V2.7 - 1998 EIC CHANGES                                *
121798* MOD KWS V2.7B- AGMC- FASCorp DATA INTERCHANGE FILE             *
122498* UPD KWS V2.7B- 1999 EIC CHANGES                                *
122688* UPD KWS V2.7B- Y2K DATE CHANGES                                *
010399* UPD KWS V2.7B- ADDED LOGIC FOR P106 DEDUCTIONS                 *
072899* FIX KWS V2.8A- P106/PY+ LOGIC AT FICA LIMIT NOT WORKING        *
120599* UPD KWS V2.8B- CHECK EIC FOR YEAR 2000 TABLES                  *
121499* FIX KWS V2.8C- AGMC - USING WRONG DED# FOR 401K EXPORT         *
041000* MOD KWS V2.8C- SECOND- SPECIAL DEDUC. CALC MEDICARE            *
080100* UPD KWS V2.8E- LOGIC FOR NEW EMPL-NAME FORMAT                  *
122100* UPD KWS V2.7B- 2001 EIC CHANGES, MAKE FUTURE CHANGES IN WORKSTO*
122301* UPD KWS V2.9A- 2002 EIC CHANGES, MAKE FUTURE CHANGES IN WORKSTO*
010502* UPD KWS V2.9A- REMOVE S106/P106 LOGIC                          *  
010602* UPD KWS V2.9A- *NEW FUNCTION* - COMPUTE ACCRUED VAC/SICK TIME  *
122402* UPD KWS V2.9A- 2002 EIC CHANGES, CHECK % IN CALC-EIC ROUTINE   *
102003* FIX SKI V3.0 - FUIJTSU MODS                                     *
010805* UPD KWS V3.1 - 2005 EIC CHANGES, CHECK % IN CALC-EIC ROUTINE   *
021206* UPD KWS      - ALLIED CHANGED 401K LAYOUT MORE READABLE        *
081308* UPD KWS V4.4 - REMOVE THSTF USAGE                              *
010609* UPD KWS V4.4.1- 2009 EIC CHANGES                               *
091309* UPD SKI V4.5 - NEW EARNING TYPES/PAYRATES.                     *
012810* MOD KWS V4.5 - ALLIED - CREATE 401K XLS FILE                   *
090610* UPD KWS V4.5.2- PREVENT ERROR IF EXCEL NOT INSTALLED           *
122210* FIX KWS V4.5.3- YTD-GROSS SHOWING DOUBLE OF CHECK-AMT ON MANUAL*
012111* MOD KWS V4.5.3- AGMC - ADD ROTH-IRA TO TEXT EXPORT FILE        *
001400******************************************************************
001500 INPUT-OUTPUT SECTION.
001600 FILE-CONTROL.
001700     COPY "PYHDF.SL".
001800     COPY "PYLNF.SL".
003000     COPY "EMPLF.SL".
003000     COPY "EMPSF.SL".
003000     COPY "TAXRF.SL".
003100     COPY "CNTLF.SL".
091309     COPY "EXCNF.SL".
003100     COPY "DEDCF.SL".
111890     COPY "STATF.SL".
003300     COPY "USERF.SL".
081308*    COPY "THSTF.SL".
050594     COPY "SKILF.SL".
           COPY "STEST.SL".
003400
003500 DATA DIVISION.
       BASED-STORAGE SECTION.
            COPY "STEST.BS".
003600 FILE SECTION.
003700     COPY "PYHDF.FD".
003800     COPY "PYLNF.FD".
005300     COPY "EMPLF.FD".
005300     COPY "EMPSF.FD".
005300     COPY "TAXRF.FD".
005400     COPY "CNTLF.FD".
091309     COPY "EXCNF.FD".
005400     COPY "DEDCF.FD".
111890     COPY "STATF.FD".
005600     COPY "USERF.FD".
081308*    COPY "THSTF.FD".
122396******************************************************************
122396*    SKILF.FD   PAYROLL EXPORT FILE FOR SUNSPORTS APPAREL        *
122396*               TO SKILSTAF/STAFCO.                              *
122396******************************************************************
122396 FD  SKILF
122396     LABEL RECORD IS STANDARD
122396     VALUE OF ID IS "TIME.CCC".

122396     01  401KF-REC.
               05  401K-FILLER                 PIC 9(06).
021206         05  401K-FILLER-01              PIC X(3).
               05  401K-EMPL-SSNO              PIC 9(09).
021206         05  401K-FILLER-02              PIC X(3).
               05  401K-EMPL-NAME              PIC X(30).
021206         05  401K-FILLER-03              PIC X(3).
               05  401K-EMPL-STATUS-CD         PIC 9(3).
021206         05  401K-FILLER-04              PIC X(3).
               05  401K-EMPL-ADDR1             PIC X(30).
021206         05  401K-FILLER-05              PIC X(3).
               05  401K-EMPL-ADDR2             PIC X(30).
021206         05  401K-FILLER-06              PIC X(3).
               05  401K-EMPL-CITY              PIC X(30).
021206         05  401K-FILLER-07              PIC X(3).
               05  401K-EMPL-STATE             PIC X(02).
021206         05  401K-FILLER-08              PIC X(3).
               05  401K-EMPL-ZIP               PIC X(10).
021206         05  401K-FILLER-09              PIC X(3).
               05  401K-EMPL-ELIGIBLE-DATE     PIC X(11).
021206         05  401K-FILLER-10              PIC X(3).
               05  401K-EMPL-HIRE-DATE         PIC X(11).
021206         05  401K-FILLER-11              PIC X(3).
               05  401K-EMPL-TERM-DATE         PIC X(11).
021206         05  401K-FILLER-12              PIC X(3).
               05  401K-EMPL-BIRTH-DATE        PIC X(11).
021206         05  401K-FILLER-13              PIC X(3).
               05  401K-EMPL-CURRENT-HRS       PIC Z(3).99.
021206         05  401K-FILLER-14              PIC X(3).
               05  401K-EMPL-TAXABLE-WAGES     PIC Z(11).99.
021206         05  401K-FILLER-15              PIC X(3).
               05  401K-EMPL-GROSS-WAGES       PIC Z(11).99.
021206         05  401K-FILLER-16              PIC X(3).
               05  401K-EMPL-401K-DED          PIC Z(11).99.
021206         05  401K-FILLER-17              PIC X(3).
               05  401K-EMPL-401K-MATCH        PIC Z(11).99.
021206         05  401K-FILLER-18              PIC X(3).
               05  401K-EMPL-LOAN-NUMBER       PIC Z(4).
021206         05  401K-FILLER-19              PIC X(3).
               05  401K-EMPL-LOAN-PAYMENT      PIC Z(11).99.
021206         05  401K-FILLER-20              PIC X(3).
021206*        05  FILLER                      PIC X(245).
021206         05  FILLER                      PIC X(173).

121798     01  AGMC-REC.
               05  AGMC-SSN                    PIC X(09).
               05  FILLER                      PIC X(02).
               05  FILLER                      PIC X(20).
               05  AGMC-NAME                   PIC X(35).
               05  FILLER                      PIC X(20).
               05  FILLER                      PIC X(20).
               05  FILLER                      PIC X(15).
               05  AGMC-BIRTH-DATE             PIC X(10).
               05  FILLER                      PIC X(01).
               05  FILLER                      PIC X(01).
               05  AGMC-ADDR1                  PIC X(35).
               05  AGMC-ADDR2                  PIC X(35).
               05  AGMC-CITY                   PIC X(20).
               05  AGMC-STATE                  PIC X(02).
               05  AGMC-ZIP                    PIC X(10).
               05  AGMC-HOME-PHONE             PIC X(10).
               05  AGMC-WORK-PHONE             PIC X(10).
               05  AGMC-WORK-EXT               PIC X(04).
               05  FILLER                      PIC X(02).
               05  AGMC-HIRE-DATE              PIC X(10).
               05  AGMC-TERMINATION-DATE       PIC X(10).
               05  AGMC-REHIRE-DATE            PIC X(10).
               05  AGMC-GROSS-SALARY           PIC -Z(07).99
                                  BLANK ZERO.
               05  FILLER                      PIC X(01).
               05  AGMC-EXEMPTIONS             PIC Z(02).
               05  AGMC-PRE-TAX-CONT-PERC      PIC ZZ9.9
                                  BLANK ZERO.
               05  AGMC-PRE-TAX-CONT-DOL       PIC Z(05).99
                                  BLANK ZERO.
               05  AGMC-AFTER-TAX-CONT-PERC    PIC ZZ9.9
                                  BLANK ZERO.
               05  AGMC-AFTER-TAX-CONT-DOL     PIC Z(05).99
                                  BLANK ZERO.
               05  AGMC-PERIOD-END-DATE        PIC X(10).
               05  AGMC-CONTRIBUTION-1         PIC -ZZZZZZ9.99
                                  BLANK ZERO.
012111*        05  AGMC-C2                     PIC -ZZZZZZ9.99
012111         05  AGMC-ROTH-IRA               PIC -ZZZZZZ9.99
                                  BLANK ZERO.
               05  AGMC-C3                     PIC -ZZZZZZ9.99
                                  BLANK ZERO.
               05  AGMC-C4                     PIC -ZZZZZZ9.99
                                  BLANK ZERO.
               05  AGMC-C5                     PIC -ZZZZZZ9.99
                                  BLANK ZERO.
               05  AGMC-C6                     PIC -ZZZZZZ9.99
                                  BLANK ZERO.
               05  AGMC-C7                     PIC -ZZZZZZ9.99
                                  BLANK ZERO.
               05  AGMC-C8                     PIC -ZZZZZZ9.99
                                  BLANK ZERO.
               05  AGMC-PARTICIPATION-DATE     PIC X(10).
               05  AGMC-YTD-HOURS              PIC ZZZZ9.99.
               05  AGMC-YTD-TOT-COMPENSATION   PIC -ZZZZZZ9.99
                                  BLANK ZERO.
               05  AGMC-YTD-PLAN-COMPENSATION  PIC -ZZZZZZ9.99
                                  BLANK ZERO.
               05  AGMC-YTD-PRE-ENTRY-COMP     PIC -ZZZZZZ9.99
                                  BLANK ZERO.
               05  AGMC-PRIOR-YEAR-COMP        PIC -ZZZZZZ9.99
                                  BLANK ZERO.
               05  AGMC-S125-CONT              PIC -ZZZZZZ9.99
                                  BLANK ZERO.
               05  FILLER                      PIC X(01).
               05  AGMC-OWNERSHIP-PERC         PIC ZZ9.99
                                  BLANK ZERO.
               05  FILLER                      PIC X(01).
            COPY "STEST.FD".
      ******************************************************************
005900 WORKING-STORAGE SECTION.
CVT    01  PROG-NAME    PIC X(6) VALUE    "PY100".
006000
       01  SCRN-1.
           05  SCRN-1-01        PIC X(80) VALUE "                       
      -    "   Payroll Deduction Selection                           ".
           05  SCRN-1-02        PIC X(80) VALUE "                       
      -    "                                                         ".
           05  SCRN-1-03        PIC X(80) VALUE "                   Spec
      -    "ify which Deductions are to be Taken:                    ".
           05  SCRN-1-04        PIC X(80) VALUE "                       
      -    "                                                         ".
           05  SCRN-1-05        PIC X(80) VALUE "Regular Checks         
      -    "    Vacation Checks             Bonus Checks             ".
       01  SCRN-02.
031893     05  SCRN-2-00        PIC X(80) VALUE "                       
      -    "                                                         ".
           05  SCRN-2-01        PIC X(80) VALUE "Regular Checks         
      -    "    Vacation Checks             Bonus Checks             ".
031893     05  SCRN-2-02        PIC X(80) VALUE "                       
      -    "                                                         ".
           05  SCRN-2-03        PIC X(80) VALUE "FIT Taxes              
      -    "    FIT Taxes                   FIT Taxes                ".
           05  SCRN-2-04        PIC X(80) VALUE "FICA/Med.              
      -    "    FICA/Med.                   FICA/Med.                ".
           05  SCRN-2-05        PIC X(80) VALUE "State Taxes            
      -    "    State Taxes                 State Taxes              ".
        01 REDEFINES SCRN-02 .
        02 SCRN-02-1-80 PIC X(80) .
        02 SCRN-02-81-160 PIC X(80) .
        02 SCRN-02-161-240 PIC X(80) .
        02 SCRN-02-241-320 PIC X(80) .
        02 SCRN-02-321-400 PIC X(80) .
        02 SCRN-02-401-480 PIC X(80) .
006500
       01  INPUT-SPECS-1.
           05  FILLER      PIC X(14)  VALUE "1119O02031    ".
           05  FILLER      PIC X(14)  VALUE "1219O02031    ".
           05  FILLER      PIC X(14)  VALUE "1319O02031    ".
           05  FILLER      PIC X(14)  VALUE "1419O02031    ".
           05  FILLER      PIC X(14)  VALUE "1519O02031    ".
           05  FILLER      PIC X(14)  VALUE "1619O02031    ".
           05  FILLER      PIC X(14)  VALUE "1719O02031    ".
           05  FILLER      PIC X(14)  VALUE "1819O02031    ".
           05  FILLER      PIC X(14)  VALUE "1919O02031    ".
           05  FILLER      PIC X(14)  VALUE "2019O02031    ".
           05  FILLER      PIC X(14)  VALUE "1146O02031    ".
           05  FILLER      PIC X(14)  VALUE "1246O02031    ".
           05  FILLER      PIC X(14)  VALUE "1346O02031    ".
           05  FILLER      PIC X(14)  VALUE "1446O02031    ".
           05  FILLER      PIC X(14)  VALUE "1546O02031    ".
           05  FILLER      PIC X(14)  VALUE "1646O02031    ".
           05  FILLER      PIC X(14)  VALUE "1746O02031    ".
           05  FILLER      PIC X(14)  VALUE "1846O02031    ".
           05  FILLER      PIC X(14)  VALUE "1946O02031    ".
           05  FILLER      PIC X(14)  VALUE "2046O02031    ".
           05  FILLER      PIC X(14)  VALUE "1174O02031    ".
           05  FILLER      PIC X(14)  VALUE "1274O02031    ".
           05  FILLER      PIC X(14)  VALUE "1374O02031    ".
           05  FILLER      PIC X(14)  VALUE "1474O02031    ".
           05  FILLER      PIC X(14)  VALUE "1574O02031    ".
           05  FILLER      PIC X(14)  VALUE "1674O02031    ".
           05  FILLER      PIC X(14)  VALUE "1774O02031    ".
           05  FILLER      PIC X(14)  VALUE "1874O02031    ".
           05  FILLER      PIC X(14)  VALUE "1974O02031    ".
           05  FILLER      PIC X(14)  VALUE "2074O02031    ".

031893     05  FILLER      PIC X(14)  VALUE "1119O02031    ".
           05  FILLER      PIC X(14)  VALUE "1219O02031    ".
           05  FILLER      PIC X(14)  VALUE "1319O02031    ".
           05  FILLER      PIC X(14)  VALUE "1419O02031    ".
           05  FILLER      PIC X(14)  VALUE "1519O02031    ".
           05  FILLER      PIC X(14)  VALUE "1619O02031    ".
           05  FILLER      PIC X(14)  VALUE "1719O02031    ".
           05  FILLER      PIC X(14)  VALUE "1819O02031    ".
           05  FILLER      PIC X(14)  VALUE "1919O02031    ".
           05  FILLER      PIC X(14)  VALUE "2019O02031    ".
           05  FILLER      PIC X(14)  VALUE "1146O02031    ".
           05  FILLER      PIC X(14)  VALUE "1246O02031    ".
           05  FILLER      PIC X(14)  VALUE "1346O02031    ".
           05  FILLER      PIC X(14)  VALUE "1446O02031    ".
           05  FILLER      PIC X(14)  VALUE "1546O02031    ".
           05  FILLER      PIC X(14)  VALUE "1646O02031    ".
           05  FILLER      PIC X(14)  VALUE "1746O02031    ".
           05  FILLER      PIC X(14)  VALUE "1846O02031    ".
           05  FILLER      PIC X(14)  VALUE "1946O02031    ".
           05  FILLER      PIC X(14)  VALUE "2046O02031    ".
           05  FILLER      PIC X(14)  VALUE "1174O02031    ".
           05  FILLER      PIC X(14)  VALUE "1274O02031    ".
           05  FILLER      PIC X(14)  VALUE "1374O02031    ".
           05  FILLER      PIC X(14)  VALUE "1474O02031    ".
           05  FILLER      PIC X(14)  VALUE "1574O02031    ".
           05  FILLER      PIC X(14)  VALUE "1674O02031    ".
           05  FILLER      PIC X(14)  VALUE "1774O02031    ".
           05  FILLER      PIC X(14)  VALUE "1874O02031    ".
           05  FILLER      PIC X(14)  VALUE "1974O02031    ".
           05  FILLER      PIC X(14)  VALUE "2074O02031    ".

       01  SPECS-1 REDEFINES INPUT-SPECS-1.
           05  SPEC-1 OCCURS 60 TIMES.
               10  ROW         PIC 99.
               10  COL         PIC 99.
               10  TYP         PIC X.
               10  FLEN        PIC 99.
               10  SLEN        PIC 99.
               10  OPTION      PIC 9.
               10  ATTR1       PIC XX.
               10  ATTR2       PIC XX.

031893 01  SPECS-1R REDEFINES INPUT-SPECS-1.
031893      05  SP-1 OCCURS 30 TIMES.
031893         10  FILLER      PIC X(14).
031893     05  SPECS-1B.
031893         10  SPEC-1B OCCURS 30 TIMES.
                   15 ROW      PIC 99.
                   15 COL      PIC 99.
                   15 TYP      PIC X.
                   15 FLEN     PIC 99.
                   15 SLEN     PIC 99.
                   15 OPTION   PIC 9.
                   15 ATTR1    PIC XX.
                   15 ATTR2    PIC XX.

121791 01  INPUT-SPECS-2.
           05  FILLER      PIC X(14)  VALUE "1119O02031    ".
           05  FILLER      PIC X(14)  VALUE "1219O02031    ".
           05  FILLER      PIC X(14)  VALUE "1319O02031    ".
           05  FILLER      PIC X(14)  VALUE "1146O02031    ".
           05  FILLER      PIC X(14)  VALUE "1246O02031    ".
           05  FILLER      PIC X(14)  VALUE "1346O02031    ".
           05  FILLER      PIC X(14)  VALUE "1174O02031    ".
           05  FILLER      PIC X(14)  VALUE "1274O02031    ".
           05  FILLER      PIC X(14)  VALUE "1374O02031    ".

121791 01  SPECS-2 REDEFINES INPUT-SPECS-2.
           05  SPEC-2 OCCURS 9 TIMES.
               10  ROW         PIC 99.
               10  COL         PIC 99.
               10  TYP         PIC X.
               10  FLEN        PIC 99.
               10  SLEN        PIC 99.
               10  OPTION      PIC 9.
               10  ATTR1       PIC XX.
               10  ATTR2       PIC XX.

121791 01  WS-TAKE-TAXES.
           05  WS-TAKE-FIT     PIC 9  OCCURS 3.
           05  WS-TAKE-FICA    PIC 9  OCCURS 3.
           05  WS-TAKE-STATE   PIC 9  OCCURS 3.
           05  WS-TAKE-TAXES-CD PIC 9.
           05  WS-TOTAL-HRS    PIC 9(6)V999 COMP-3 VALUE ZERO.
042693     05  WS-GARNISHMENT  PIC S9(7)V99 COMP-3 VALUE 0.00.
042693     05  NET-OF-GARNISHMENT PIC S9(7)V99 COMP-3 VALUE 0.00.
120693     05  WS-LEVY         PIC S9(7)V99 COMP-3 VALUE 0.00.
120693     05  NET-OF-LEVY     PIC S9(7)V99 COMP-3 VALUE 0.00.
010502*    05  WS-S106-DED-AMT PIC S9(7)V99 COMP-3 VALUE ZEROES.
010502*    05  WS-S106-TAX-SAV PIC S9(7)V99 COMP-3 VALUE ZEROES.
010502*    05  WS-TAX-DIFF     PIC S9(7)V99 COMP-3 VALUE ZEROES.
010502*    05  WS-S106-PROCESSING-CD  PIC 9 VALUE 2.
010502*        88  PROCESSING-S106-YES      VALUE 1.
010502*        88  PROCESSING-S106-NO       VALUE 2.
010602     05  WS-PAID-HOURS   PIC S999V99  COMP-3 VALUE ZERO.
042197 77  WS-DISP             PIC 9(7).99- VALUE ZERO.
007200     COPY "CONSTANT.DTA".
051503     COPY "WAIT.OPT".
007400     COPY "ERROR.DTA".
007500     COPY "SCREEN.DTA".
007600     COPY "STATUS.DTA".
082692     COPY "DATE.DTA".
082692     COPY "CLKFILES.DTA".
007700     COPY "PYTYPE.OPT".
090610     COPY "COMPRINT.DTA".
007800
012810     COPY "EXCEL.DTA".
012810     COPY "PC_FileRoutines.DTA".
012810 77  RETURN-VALUE  PIC S9(9) COMP-5 VALUE ZERO.
012810 77  CURR-DRIVE    PIC X      VALUE "C".
012810 01  OUTPUT-SPECS.
012810     05  FILLER     PIC X(9)  VALUE "1237O0203".
012810     05  OPTION     PIC 9     VALUE 2.
012810         88 ON-PRINTER      VALUE 2.
012810         88 TO-EXCEL        VALUE 1.
012810     05  FILLER     PIC X(4)  VALUE "E   ". 
012810 01  OUTPUT-HELP  PIC X(40) VALUE " Select how you want the data
012810-    "output. $". 
012810 01  XLS-OPTS.
012810     05 FILLER               PIC X(03) VALUE "Yes".
012810     05 FILLER               PIC X(03) VALUE "No".

008300 77  PYHDF-STATUS        PIC XX.
CLNUP1     88 C-RECORD-OK VALUES "00", "02".
CLNUP1     88 C-FOUND VALUES "00", "02".
CLNUP1     88 C-AT-END VALUES "10", "14".
CLNUP1     88 C-END-OF-FILE VALUES "10", "14".
008400 77  PYLNF-STATUS        PIC XX.
CLNUP1     88 C-RECORD-OK VALUES "00", "02".
CLNUP1     88 C-FOUND VALUES "00", "02".
CLNUP1     88 C-AT-END VALUES "10", "14".
CLNUP1     88 C-END-OF-FILE VALUES "10", "14".
008700 77  CNTLF-STATUS        PIC XX.
091309 77  EXCNF-STATUS        PIC XX.
008700 77  DEDCF-STATUS        PIC XX.
008700 77  DEDCF-KEY           PIC 9(6)  VALUE 1.
008900 77  USERF-STATUS        PIC XX.
009000 77  EMPLF-STATUS        PIC XX.
CLNUP1     88 C-RECORD-OK VALUES "00", "02".
CLNUP1     88 C-FOUND VALUES "00", "02".
CLNUP1     88 C-AT-END VALUES "10", "14".
CLNUP1     88 C-END-OF-FILE VALUES "10", "14".
009000 77  EMPSF-STATUS        PIC XX.
CLNUP1     88 C-RECORD-OK VALUES "00", "02".
CLNUP1     88 C-FOUND VALUES "00", "02".
CLNUP1     88 C-AT-END VALUES "10", "14".
CLNUP1     88 C-END-OF-FILE VALUES "10", "14".
009000 77  TAXRF-STATUS        PIC XX.
111890 77  STATF-STATUS        PIC XX.
CLNUP1     88 C-RECORD-OK VALUES "00", "02".
CLNUP1     88 C-FOUND VALUES "00", "02".
CLNUP1     88 C-AT-END VALUES "10", "14".
CLNUP1     88 C-END-OF-FILE VALUES "10", "14".
081308*77  THSTF-STATUS        PIC XX.
CLNUP1*    88 C-RECORD-OK VALUES "00", "02".
CLNUP1*    88 C-FOUND VALUES "00", "02".
CLNUP1*    88 C-AT-END VALUES "10", "14".
CLNUP1*    88 C-END-OF-FILE VALUES "10", "14".
122396 01  SKILF-STATUS        PIC XX.
122396 01  SKIL-FILENAME.
122396     05 FILLER           PIC X(05) VALUE "TIME.".
122396     05 SKIL-ID          PIC X(03) VALUE SPACES.
122396     05 FILLER           PIC X(04) VALUE SPACES.
CLNUP1 01  SKILF--NAME REDEFINES SKIL-FILENAME PIC X(12) .
CLNUP1 01  SKILF-FULLPATH REDEFINES SKIL-FILENAME PIC X(12) .
122396 77  WS-TEMP-AMT         PIC S9(11)V99 VALUE ZERO.
122396 01  WS-401K-TOTALS.
           05 TOT-401K-TAXABLE-WAGES   PIC S9(11)V99 VALUE ZERO.
           05 TOT-401K-GROSS-WAGES     PIC S9(11)V99 VALUE ZERO.
           05 TOT-401K-EMPL-401K-DED   PIC S9(11)V99 VALUE ZERO.
           05 TOT-401K-EMPL-401K-MATCH PIC S9(11)V99 VALUE ZERO.
           05 TOT-401K-EMPL-LOAN-PAYMENT  PIC S9(11)V99 VALUE ZERO.
009100
012600 77  FIRST-FLAG  PIC X.
012700     88  FIRST-ITEM   VALUE "Y".
012800     88  NOT-FIRST    VALUE "N".
012600 77  PROCESSING-DEDS-FLAG PIC X.
012700     88  PROCESSING-DEDS  VALUE "Y".
012600 77  NONTAX-DEDS-FLAG PIC X.
012700     88  NONTAX-DEDS  VALUE "Y".
012800     88  TAX-DEDS     VALUE "N".
012900
007700 01  DISPLAY-MESSAGES.
007800     05  EDIT-QUES       PIC X(46) VALUE "Do you wish to print a P
007900-        "re-Check Edit Listing?".
008000     05  PRESS-ENTER     PIC X(40)
008100         VALUE "Align the form, press ENTER when ready.".
015300 01  OK-FLAG                 PIC X.
015400     88  OK           VALUE "Y".
017000
017600     COPY "PY100.HLP".
017700
018300 77  CALCULATING      PIC X(18) VALUE "Calculating Taxes.".
090492 77  K                 PIC 9(5).
018300 77  J                 PIC 9(5).
       77  JJ                PIC 9(5).
       77  JJJ               PIC 9(5).
100692 77  LL                PIC 9(5).
018300 77  TAX-CODE         PIC 99.
018300 77  TAX-NO           PIC 99.
018300 77  PER-FACT         PIC 999V9999.
018300 77  FICA-MAX         PIC S9(7)V99   COMP-3.
112190 77  MEDICARE-MAX     PIC S9(7)V99   COMP-3.
018300 77  TAXABLE-GROSS    PIC S9(7)V99   COMP-3.
018300 77  ANNUAL-GROSS     PIC S9(7)V99   COMP-3.
018300 77  ANNUAL-FIT       PIC S9(7)V99   COMP-3.
018300 77  TEMP-GROSS       PIC S9(7)V99   COMP-3.
051994 77  EIC-TOTAL        PIC S9(7)V99   COMP-3.
122100 01  EIC-LIMITS.
122301*    05  EIC-WAGE-LIMIT    PIC S9(6)V99   COMP-3 VALUE 28281.00.
122301*    05  EIC-ONE.
122301*        10 EIC-ONE-MIN    PIC S9(6)V99   COMP-3 VALUE  7140.00.
122301*        10 EIC-ONE-MAX    PIC S9(6)V99   COMP-3 VALUE 13090.00.
122301*        10 EIC-ONE-TAX    PIC S9(6)V99   COMP-3 VALUE  1457.00.
122301*    05  EIC-TWO.
122301*        10 EIC-TWO-MIN    PIC S9(6)V99   COMP-3 VALUE  3570.00.
122301*        10 EIC-TWO-MAX    PIC S9(6)V99   COMP-3 VALUE  6545.00.
122301*        10 EIC-TWO-TAX    PIC S9(6)V99   COMP-3 VALUE   728.00.

122301*--- Changes for Year 2002 ---*
122301*    05  EIC-WAGE-LIMIT-M2   PIC S9(6)V99   COMP-3 VALUE 30201.00.
122301*    05  EIC-WAGE-LIMIT-M1   PIC S9(6)V99   COMP-3 VALUE 29201.00.
122301*    05  EIC-WAGE-LIMIT-SHH  PIC S9(6)V99   COMP-3 VALUE 29201.00.
122301*    05  EIC-SINGLE.
122301*        10 EIC-SHH-MIN    PIC S9(6)V99   COMP-3 VALUE  7370.00.
122301*        10 EIC-SHH-MAX    PIC S9(6)V99   COMP-3 VALUE 13520.00.
122301*        10 EIC-SHH-TAX    PIC S9(6)V99   COMP-3 VALUE  1503.00.
122301*    05  EIC-MARRIED-ONE.
122301*        10 EIC-M1-MIN     PIC S9(6)V99   COMP-3 VALUE  7370.00.
122301*        10 EIC-M1-MAX     PIC S9(6)V99   COMP-3 VALUE 14520.00.
122301*        10 EIC-M1-TAX     PIC S9(6)V99   COMP-3 VALUE  1503.00.
122301*    05  EIC-MARRIED-BOTH.
122301*        10 EIC-M2-MIN     PIC S9(6)V99   COMP-3 VALUE  3685.00.
122301*        10 EIC-M2-MAX     PIC S9(6)V99   COMP-3 VALUE  7260.00.
122301*        10 EIC-M2-TAX     PIC S9(6)V99   COMP-3 VALUE   752.00.

122402*--- Changes for Year 2005 ---*
122402*    05  EIC-WAGE-LIMIT-M2   PIC S9(6)V99   COMP-3 VALUE 33030.00.
122402*    05  EIC-WAGE-LIMIT-M1   PIC S9(6)V99   COMP-3 VALUE 31030.00.
122402*    05  EIC-WAGE-LIMIT-SHH  PIC S9(6)V99   COMP-3 VALUE 29666.00.
122402*    05  EIC-SINGLE.
122402*        10 EIC-SHH-MIN    PIC S9(6)V99   COMP-3 VALUE  7830.00.
122402*        10 EIC-SHH-MAX    PIC S9(6)V99   COMP-3 VALUE 14370.00.
122402*        10 EIC-SHH-TAX    PIC S9(6)V99   COMP-3 VALUE  1597.00.
122402*    05  EIC-MARRIED-ONE.
122402*        10 EIC-M1-MIN     PIC S9(6)V99   COMP-3 VALUE  7830.00.
122402*        10 EIC-M1-MAX     PIC S9(6)V99   COMP-3 VALUE 16370.00.
122402*        10 EIC-M1-TAX     PIC S9(6)V99   COMP-3 VALUE  1597.00.
122402*    05  EIC-MARRIED-BOTH.
122402*        10 EIC-M2-MIN     PIC S9(6)V99   COMP-3 VALUE  3915.00.
122402*        10 EIC-M2-MAX     PIC S9(6)V99   COMP-3 VALUE  8185.00.
122402*        10 EIC-M2-TAX     PIC S9(6)V99   COMP-3 VALUE   799.00.
      
010609*--- Changes for Year 2009 ---*
010609     05  EIC-WAGE-LIMIT-M2   PIC S9(6)V99   COMP-3 VALUE 38584.00.
010609     05  EIC-WAGE-LIMIT-M1   PIC S9(6)V99   COMP-3 VALUE 35464.00.
010609     05  EIC-WAGE-LIMIT-SHH  PIC S9(6)V99   COMP-3 VALUE 35464.00.
010609     05  EIC-SINGLE.
010609         10 EIC-SHH-MIN    PIC S9(6)V99   COMP-3 VALUE  8950.00.
010609         10 EIC-SHH-MAX    PIC S9(6)V99   COMP-3 VALUE 16420.00.
010609         10 EIC-SHH-TAX    PIC S9(6)V99   COMP-3 VALUE  1826.00.
010609     05  EIC-MARRIED-ONE.
010609         10 EIC-M1-MIN     PIC S9(6)V99   COMP-3 VALUE  8950.00.
010609         10 EIC-M1-MAX     PIC S9(6)V99   COMP-3 VALUE 19540.00.
010609         10 EIC-M1-TAX     PIC S9(6)V99   COMP-3 VALUE  1826.00.
010609     05  EIC-MARRIED-BOTH.
010609         10 EIC-M2-MIN     PIC S9(6)V99   COMP-3 VALUE  4475.00.
010609         10 EIC-M2-MAX     PIC S9(6)V99   COMP-3 VALUE  9770.00.
010609         10 EIC-M2-TAX     PIC S9(6)V99   COMP-3 VALUE   913.00.


018300 77  REM-AMT          PIC S9(7)V99   COMP-3.
032687 77  TEMP-AMT         PIC S9(7)V99   COMP-3.
018300 77  YTD-GROSS        PIC S9(7)V99   COMP-3.
018300 77  TAX-AMT          PIC S9(7)V99   COMP-3.
122301*77  WS-JDAF          PIC S9(7)V99   COMP-3.
122301*77  WS-DIFF          PIC S9(7)V99   COMP-3.
018300 77  PE-AMT           PIC S9(7)V99   COMP-3.
018300 77  TC-AMT           PIC S9(7)V99   COMP-3.
018300 77  STDED-GROSS      PIC S9(7)V99   COMP-3.
018300 77  STDED-AMT        PIC S9(7)V99   COMP-3.
018300 77  STDED-FIT-DED    PIC S9(7)V99   COMP-3.
018300 77  STDED-FICA-DED   PIC S9(7)V99   COMP-3.
018300 77  LOW-BRACKET      PIC S9(7)V99   COMP-3.
018300 77  SPREAD-AMT       PIC S9(7)V99   COMP-3.
018300 77  WH-BASE          PIC S9(7)V99   COMP-3.
018300 77  YTD-DISAB        PIC S9(7)V99   COMP-3.
       77  YTD-FEDERAL      PIC S9(7)V99   COMP-3.
018300 77  YTD-FICA         PIC S9(7)V99   COMP-3.
112190 77  YTD-MEDICARE     PIC S9(7)V99   COMP-3.
       77  YTD-STATE        PIC S9(7)V99   COMP-3.
       77  YTD-LOCAL        PIC S9(7)V99   COMP-3.
       77  YTD-DISUE        PIC S9(7)V99   COMP-3.
032687 77  ANNUAL-GROSS-ST    PIC S9(7)V99 COMP-3.
       77  TAXABLE-GROSS-FICA PIC S9(7)V99 COMP-3.
       77  TAXABLE-GROSS-MEDICARE PIC S9(7)V99 COMP-3.
       77  TAXABLE-GROSS-STATE  PIC S9(7)V99 COMP-3.
112590 77  S125-RETURN-DEDUCTIONS  PIC S9(7)V99 COMP-3.
       01  TAXES.
112190     05  YTD-TAX      PIC S9(7)V99 OCCURS 6 TIMES.
       01  DEDUCTIONS.
090492     05  YTD-DED      PIC S9(7)V99 OCCURS 20 TIMES.
018300 01  TAKE-CDS.
031893     05  TAKE-CD      PIC 9  OCCURS 60 TIMES.
       01  BREAK-CONTROL.
           03  BREAK-EMPL-NUMBER          PIC X(8).
082692 01  CNTL-CURRENT-WEEK PIC 99 VALUE 3.
042197*01  WS-CURRENT-WEEK   PIC 99 VALUE 3.
082692 01  WS-WEEK1          PIC S9(3)V99 COMP-3 VALUE 0.
082692 01  WS-WEEK2          PIC S9(3)V99 COMP-3 VALUE 0.
082792 01  WS-HOURS          PIC S9(3)V99 COMP-3 VALUE 0.
082692 01  WS-I1             PIC 99 VALUE 0.
082692 01  WS-I2             PIC 99 VALUE 0.
009200 01  PE-DATE-QUES  PIC X(26)
009300     VALUE "Enter period ending date: ".
009400 01  PE-DATE-SPEC   PIC X(14) VALUE "1450D06060E   ".
017900 01  PE-DATE PIC 9(6) VALUE 0.
082792 01  PE-DAY    PIC 9(5) VALUE 0.
082792 01  PE-DAY-B1 PIC 9(5) VALUE 0.
082792 01  PE-DAY-E1 PIC 9(5) VALUE 0.
082792 01  PE-DAY-B2 PIC 9(5) VALUE 0.
082792 01  PE-DAY-E2 PIC 9(5) VALUE 0.
       01  DATE-HELP.
           05  FILLER PIC X(120)   VALUE " 6 digit numeric field.  The d
      -    "isplayed date is the date you entered when you     powered o
      -    "n your computer.  The date sho".
           05  FILLER PIC X(029) VALUE "uld be in the format MMDDYY.$".
019900
090492 01  GARNISH-KEY.
090492     05 GAR-STATE    PIC X(2) VALUE SPACES.
090492     05 GAR-REC-TYPE PIC X(3) VALUE "GAR".
090492     05 FILLER       PIC X(2) VALUE SPACES.
120693 01  LEVY-KEY.
120693     05 LEVY-CODE    PIC X(5) VALUE "FLEVY".
120693     05 LEVY-TYPE    PIC X(2) VALUE "S ".

122396 01  WS-CUSTOMIZED-FLAG     PIC 9(5) VALUE ZERO.
121798     88 AGMC                VALUE 00245.
122396     88 ALLIEDCO            VALUE 00238.
122396     88 PIONEER             VALUE 00224.
122301*    88 QUESTAPP            VALUE 00276.
041000     88 2NDCOURT            VALUE 00344.
CLNUP1 77  CNTLF--NAME PIC X(15) VALUE "CONTROL.FIL" .
CLNUP1 77  CNTLF-FULLPATH PIC X(35) VALUE SPACES .
091309 77  EXCNF--NAME PIC X(15) VALUE "CONTROL2.FIL" .
091309 77  EXCNF-FULLPATH PIC X(35) VALUE SPACES .
CLNUP1 77  TEMP-MASTER-DIR PIC X(14) VALUE SPACES .
CLNUP1 77  TEMP-SUB-DIR PIC X(14) VALUE SPACES .
CLNUP1 77  USERF--NAME PIC X(15) VALUE "USER.FIL" .
CLNUP1 77  USERF-FULLPATH PIC X(35) VALUE SPACES .
CLNUP1 01  IO-WAIT-CD  PIC X VALUE "1"                                  
CLNUP1     88 IO-WAIT-ON VALUE IS "1".
CLNUP1     88 IO-WAIT-OFF VALUE IS "0".
            COPY "STEST.DTA".
CLNUP1 77  EMPLF--NAME PIC X(15) VALUE "EMPLOYEE.FIL" .
CLNUP1 77  EMPLF-FULLPATH PIC X(35) VALUE SPACES .
CLNUP1 77  DEDCF--NAME PIC X(15) VALUE "DEDCNTL.FIL" .
CLNUP1 77  DEDCF-FULLPATH PIC X(35) VALUE SPACES .
CLNUP1 77  PYHDF--NAME PIC X(15) VALUE "PYBATHDR.FIL" .
CLNUP1 77  PYHDF-FULLPATH PIC X(35) VALUE SPACES .
CLNUP1 77  STATF--NAME PIC X(15) VALUE "STATE.FIL" .
CLNUP1 77  STATF-FULLPATH PIC X(35) VALUE SPACES .
CLNUP1 77  EMPSF--NAME PIC X(15) VALUE "STATETAX.FIL" .
CLNUP1 77  EMPSF-FULLPATH PIC X(35) VALUE SPACES .
CLNUP1 77  TAXRF--NAME PIC X(15) VALUE "TAXRATE.FIL" .
CLNUP1 77  TAXRF-FULLPATH PIC X(35) VALUE SPACES .
CLNUP1 77  PYLNF--NAME PIC X(15) VALUE "PYBATLIN.FIL" .
CLNUP1 77  PYLNF-FULLPATH PIC X(35) VALUE SPACES .
CLNUP1 01  CHAIN-PARAM-LEN PIC S9(4) COMP-5.
CLNUP1 01  CHAIN-NAME-LEN PIC S9(4) COMP-5.
CLNUP1 01  DSPL--CONTROL PIC X(100) IS EXTERNAL.
       SCREEN SECTION.
CLNUP1     COPY "CONSTANT.SCR".
CLNUP1     COPY "SCRNINIT.SCR".
CLNUP1     COPY "ERRORFIL.SCR".
CLNUP1     COPY "WAIT.SCR".    
CLNUP1                         
CLNUP1*01 SCR-errorfil-sr-14-20 PIC IS X(51) FROM BOX-TOP CONTROL 
CLNUP1*     DSPL--CONTROL LINE 08 COLUMN 14 REVERSE-VIDEO.
CLNUP1*01 SCR-errorfil-sr-15-20 PIC IS X(51) FROM BOX-MIDDLE CONTROL 
CLNUP1*     DSPL--CONTROL LINE 09 COLUMN 14 REVERSE-VIDEO.
CLNUP1*01 SCR-errorfil-sr-16-20 PIC IS X(51) FROM BOX-MIDDLE CONTROL 
CLNUP1*     DSPL--CONTROL LINE 10 COLUMN 14 REVERSE-VIDEO.
CLNUP1*01 SCR-errorfil-sr-17-20 PIC IS X(51) FROM BOX-MIDDLE CONTROL 
CLNUP1*     DSPL--CONTROL LINE 11 COLUMN 14 REVERSE-VIDEO.
CLNUP1*01 SCR-errorfil-sr-18-20 PIC IS X(51) FROM BOX-MIDDLE CONTROL 
CLNUP1*     DSPL--CONTROL LINE 12 COLUMN 14 REVERSE-VIDEO.
CLNUP1*01 SCR-errorfil-sr-19-20 PIC IS X(51) FROM BOX-MIDDLE CONTROL 
CLNUP1*     DSPL--CONTROL LINE 13 COLUMN 14 REVERSE-VIDEO.
CLNUP1*01 SCR-errorfil-sr-20-20 PIC IS X(51) FROM BOX-MIDDLE CONTROL 
CLNUP1*     DSPL--CONTROL LINE 14 COLUMN 14 REVERSE-VIDEO.
CLNUP1*01 SCR-errorfil-sr-21-20 PIC IS X(51) FROM BOX-BOTTOM CONTROL 
CLNUP1*     DSPL--CONTROL LINE 15 COLUMN 14 REVERSE-VIDEO.
CLNUP1*01 SCR-errorfil-sr-35-20 PIC IS X(40) FROM ERROR-MSG CONTROL 
CLNUP1*     DSPL--CONTROL LINE 10 COLUMN 17 REVERSE-VIDEO.
CLNUP1*01 SCR-errorfil-sr-36-20 PIC IS X(35) FROM ERROR-LINE-1 CONTROL 
CLNUP1*     DSPL--CONTROL LINE 11 COLUMN 17 REVERSE-VIDEO.
CLNUP1*01 SCR-errorfil-sr-37-20 PIC IS X(41) FROM ERROR-LINE-2 CONTROL 
CLNUP1*     DSPL--CONTROL LINE 12 COLUMN 17 REVERSE-VIDEO.
CLNUP1*01 SCR-errorfil-sr-38-20 PIC IS X(40) FROM ERROR-CONTACT CONTROL 
CLNUP1*     DSPL--CONTROL LINE 13 COLUMN 17 REVERSE-VIDEO.
CLNUP1*01 SCR-errorfil-sr-39-20 PIC IS X(40) FROM ERROR-RESUME CONTROL 
CLNUP1*     DSPL--CONTROL LINE 14 COLUMN 17 REVERSE-VIDEO.
CLNUP1*01 SCR-errorfil-sr-40-20 VALUE IS "Program Name = " CONTROL 
CLNUP1*     DSPL--CONTROL LINE 09 COLUMN 17 REVERSE-VIDEO.
CLNUP1*01 SCR-errorfil-sr-41-20 PIC IS X(6) FROM PROG-NAME CONTROL 
CLNUP1*     DSPL--CONTROL LINE 09 COLUMN 32 REVERSE-VIDEO.
CLNUP1*01 SCR-datechk-sr-35-23 PIC IS X(29) FROM DATE-ERROR CONTROL 
CLNUP1*     DSPL--CONTROL LINE 21 COLUMN 1 REVERSE-VIDEO.
CLNUP1*01 SCR-scrninit-sr-13-20 PIC IS X(80) FROM SCRN-TITLE-1 CONTROL 
CLNUP1*     DSPL--CONTROL LINE 01 COLUMN 01.
CLNUP1*01 SCR-scrninit-sr-14-20 PIC IS X(80) FROM SCRN-TITLE-2 CONTROL 
CLNUP1*     DSPL--CONTROL LINE 02 COLUMN 01.
CLNUP1*01 SCR-scrninit-sr-15-20 VALUE IS " PGM=" CONTROL DSPL--CONTROL 
CLNUP1*     LINE 02 COLUMN 04.
CLNUP1*01 SCR-scrninit-sr-16-20 PIC IS X(6) FROM PROG-NAME CONTROL 
CLNUP1*     DSPL--CONTROL LINE 02 COLUMN 09.
CLNUP1*01 SCR-scrninit-sr-17-20 VALUE IS " Station " CONTROL 
CLNUP1*     DSPL--CONTROL LINE 02 COLUMN 19.
CLNUP1*01 SCR-scrninit-sr-18-20 PIC IS X(2) FROM USER-TERMID CONTROL 
CLNUP1*     DSPL--CONTROL LINE 02 COLUMN 28.
CLNUP1*01 SCR-scrninit-sr-21-20 VALUE IS " " CONTROL DSPL--CONTROL LINE 
CLNUP1*     TIMER-CNT COLUMN 1 SIZE IS 80.
CLNUP1*01 SCR-wait-sr-4-21 VALUE IS "Press         to Continue!" CONTROL
CLNUP1*      DSPL--CONTROL LINE 19 COLUMN 27.
CLNUP1*01 SCR-wait-sr-7-21 PIC IS X(78) FROM CLEAR-19 CONTROL 
CLNUP1*     DSPL--CONTROL LINE 19 COLUMN 2.
       01 SCR-py100-cbl-617-20 PIC IS X(18) FROM CALCULATING CONTROL 
            DSPL--CONTROL LINE 12 COLUMN 31.
       01 SCR-py100-cbl-1411-20 PIC IS X(26) FROM PE-DATE-QUES CONTROL 
            DSPL--CONTROL LINE 14 COLUMN 20.
       01 SCR-py100-cbl-1423-24 PIC IS X(29) FROM DATE-ERROR CONTROL 
            DSPL--CONTROL LINE 21 REVERSE-VIDEO.
       01 SCR-py100-cbl-1478-24 VALUE IS "NET LESS THAN 0 !!!" CONTROL 
            DSPL--CONTROL LINE 1 COLUMN 1.
       01 SCR-py100-cbl-1951-23 PIC IS X(45) FROM NOT-PURCHASED-MSG 
            CONTROL DSPL--CONTROL LINE 21 REVERSE-VIDEO.
       01 SCR-py100-cbl-2048-20 PIC IS X(80) FROM SCRN-1-01 CONTROL 
            DSPL--CONTROL LINE 5.
       01 SCR-py100-cbl-2048-38 PIC IS X(80) FROM SCRN-1-02 CONTROL 
            DSPL--CONTROL LINE 6 COLUMN 1.
       01 SCR-py100-cbl-2048-49 PIC IS X(80) FROM SCRN-1-03 CONTROL 
            DSPL--CONTROL LINE 7 COLUMN 1.
       01 SCR-py100-cbl-2049-16 PIC IS X(80) FROM SCRN-1-04 CONTROL 
            DSPL--CONTROL LINE 8 COLUMN 1.
       01 SCR-py100-cbl-2049-27 PIC IS X(80) FROM SCRN-1-05 CONTROL 
            DSPL--CONTROL LINE 9 COLUMN 1.
       01 SCR-py100-cbl-2055-20 PIC IS X(80) FROM SCRN-1-01 CONTROL 
            DSPL--CONTROL LINE 5.
       01 SCR-py100-cbl-2055-38 PIC IS X(80) FROM SCRN-1-02 CONTROL 
            DSPL--CONTROL LINE 6 COLUMN 1.
       01 SCR-py100-cbl-2055-49 PIC IS X(80) FROM SCRN-1-03 CONTROL 
            DSPL--CONTROL LINE 7 COLUMN 1.
       01 SCR-py100-cbl-2056-16 PIC IS X(80) FROM SCRN-1-04 CONTROL 
            DSPL--CONTROL LINE 8 COLUMN 1.
       01 SCR-py100-cbl-2056-27 PIC IS X(80) FROM SCRN-1-05 CONTROL 
            DSPL--CONTROL LINE 9 COLUMN 1.
       01 SCR-py100-cbl-2066-23 PIC IS X(15) FROM DEDC-NAME ( I ) 
            CONTROL DSPL--CONTROL LINE J COLUMN 1.
       01 SCR-py100-cbl-2067-23 PIC IS X(15) FROM DEDC-NAME ( I ) 
            CONTROL DSPL--CONTROL LINE J COLUMN 28.
       01 SCR-py100-cbl-2068-23 PIC IS X(15) FROM DEDC-NAME ( I ) 
            CONTROL DSPL--CONTROL LINE J COLUMN 56.
       01 SCR-py100-cbl-2091-23 PIC IS X(15) FROM DEDC-NAME ( I ) 
            CONTROL DSPL--CONTROL LINE J COLUMN 1.
       01 SCR-py100-cbl-2092-23 PIC IS X(15) FROM DEDC-NAME ( I ) 
            CONTROL DSPL--CONTROL LINE J COLUMN 28.
       01 SCR-py100-cbl-2093-23 PIC IS X(15) FROM DEDC-NAME ( I ) 
            CONTROL DSPL--CONTROL LINE J COLUMN 56.
       01 SCR-py100-cbl-2111-20 PIC IS X(80) FROM CLEAR-21 CONTROL 
            DSPL--CONTROL LINE 21.
       01 SCR-py100-cbl-2112-20 PIC IS X(80) FROM CLEAR-21 CONTROL 
            DSPL--CONTROL LINE 11.
       01 SCR-py100-cbl-2112-38 PIC IS X(80) FROM CLEAR-21 CONTROL 
            DSPL--CONTROL LINE 12.
       01 SCR-py100-cbl-2113-20 PIC IS X(80) FROM CLEAR-21 CONTROL 
            DSPL--CONTROL LINE 13.
       01 SCR-py100-cbl-2113-38 PIC IS X(80) FROM CLEAR-21 CONTROL 
            DSPL--CONTROL LINE 14.
       01 SCR-py100-cbl-2114-20 PIC IS X(80) FROM CLEAR-21 CONTROL 
            DSPL--CONTROL LINE 15.
       01 SCR-py100-cbl-2114-38 PIC IS X(80) FROM CLEAR-21 CONTROL 
            DSPL--CONTROL LINE 16.
       01 SCR-py100-cbl-2115-20 PIC IS X(80) FROM CLEAR-21 CONTROL 
            DSPL--CONTROL LINE 17.
       01 SCR-py100-cbl-2115-38 PIC IS X(80) FROM CLEAR-21 CONTROL 
            DSPL--CONTROL LINE 18.
       01 SCR-py100-cbl-2116-20 PIC IS X(80) FROM CLEAR-21 CONTROL 
            DSPL--CONTROL LINE 19.
       01 SCR-py100-cbl-2116-38 PIC IS X(80) FROM CLEAR-21 CONTROL 
            DSPL--CONTROL LINE 20.
       01 SCR-py100-cbl-2117-20 CONTROL DSPL--CONTROL.
        02 PIC X(80) FROM SCRN-02-1-80 LINE 8 COLUMN 1 .
        02 PIC X(80) FROM SCRN-02-81-160 LINE 9 COLUMN 1 .
        02 PIC X(80) FROM SCRN-02-161-240 LINE 10 COLUMN 1 .
        02 PIC X(80) FROM SCRN-02-241-320 LINE 11 COLUMN 1 .
        02 PIC X(80) FROM SCRN-02-321-400 LINE 12 COLUMN 1 .
        02 PIC X(80) FROM SCRN-02-401-480 LINE 13 COLUMN 1 .
       01 SCR-py100-cbl-2124-20 PIC IS X(46) FROM EDIT-QUES CONTROL 
            DSPL--CONTROL LINE 11 COLUMN 15.
       01 SCR-py100-cbl-2305-23 PIC IS X(8) FROM EMPLF-KEY CONTROL 
            DSPL--CONTROL LINE 21 COLUMN 1.
       01 SCR-py100-cbl-2306-23 VALUE IS "- EMPLOYEE RECORD NOT FOUND! "
             CONTROL DSPL--CONTROL LINE 21 COLUMN 10.
090492
020000 PROCEDURE DIVISION.
020100 DECLARATIVES.
       Z-SKILF SECTION.
            USE AFTER ERROR PROCEDURE ON SKILF.
       Z-SKILF-D.
            GO TO STATUS-EXIT.
090610     COPY "EXCEL.DS".
020200     COPY "CNTLF.DS".
091309     COPY "EXCNF.DS".
020200     COPY "DEDCF.DS".
020400     COPY "USERF.DS".
020600     COPY "EMPLF.DS".
020600     COPY "EMPSF.DS".
020600     COPY "TAXRF.DS".
020700     COPY "PYHDF.DS".
020800     COPY "PYLNF.DS".
111890     COPY "STATF.DS".
081308*    COPY "THSTF.DS".
021900
022000     GO TO STATUS-EXIT.
022100
022200     COPY "ERRORFIL.SR".
022300 STATUS-EXIT. EXIT.
022400 END DECLARATIVES.
      ******************************************************************
022600 MAIN-PROG SECTION.
022700 OPEN-FILES.
           PERFORM TAXRF-FILL-FULLPATH.
           PERFORM USERF-FILL-FULLPATH.
023400     PERFORM OPEN-TAXRF.
022800     PERFORM PGM-INIT.
091309     PERFORM OPEN-EXCNF.
091309     PERFORM READ-EXCNF.
041000     IF USER-SN = 00238 OR 00224 OR 00276 OR 00245 OR 00344
122396        MOVE USER-SN TO WS-CUSTOMIZED-FLAG.
122396     IF WS-CUSTOMIZED-FLAG > ZERO
122396        MOVE "PY100M" TO PROG-NAME.
060292     PERFORM SCREEN-INIT.
022900     PERFORM OPEN-PYHDF.
023000     PERFORM OPEN-PYLNF.
023400     PERFORM OPEN-EMPLF.
023400     PERFORM OPEN-EMPSF.
048100     PERFORM OPEN-DEDCF.
048200     PERFORM READ-DEDCF.
111890     PERFORM OPEN-STATF.
081308*    IF PIONEER
081308*        PERFORM OPEN-THSTF.
121798     IF ALLIEDCO OR AGMC
050594         PERFORM OPEN-SKILF.
012810     IF ALLIEDCO
012810        PERFORM GET-FILE
012810        IF FLAG = 3
012810           GO TO EXIT-RUN
012810        ELSE
012810           PERFORM CREATE-XLS-FILE.

023500 BEGIN-RUN.
           IF DEDC-METHOD-CD(1)  NOT = 1 OR
              DEDC-METHOD-CD(2)  NOT = 1 OR
              DEDC-METHOD-CD(3)  NOT = 1 OR
              DEDC-METHOD-CD(4)  NOT = 1 OR
              DEDC-METHOD-CD(5)  NOT = 1 OR
              DEDC-METHOD-CD(6)  NOT = 1 OR
              DEDC-METHOD-CD(7)  NOT = 1 OR
              DEDC-METHOD-CD(8)  NOT = 1 OR
              DEDC-METHOD-CD(9)  NOT = 1 OR
              DEDC-METHOD-CD(10) NOT = 1
023600        PERFORM SELECT-DEDUCTIONS THRU SELECT-DEDUCTIONS-EXIT.
060292     IF FLAG = 4 OR FLAG = 3
023800         GO TO EXIT-RUN.
042197*SCREEN-2.
121791     PERFORM SELECT-TAXES THRU SELECT-TAXES-EXIT.
121791     IF FLAG = 3 GO TO BEGIN-RUN.
082792 EDITLIST-QUES.
           PERFORM EDITLIST-CHECK THRU EDITLIST-CHECK-EXIT.
023700     IF FLAG = 3
023800         GO TO BEGIN-RUN.
010602*    IF PIONEER OR AGMC
082692         PERFORM GET-PERIOD-END-DATE THRU
                       GET-PERIOD-END-DATE-EXIT.
082692     IF FLAG = 3
082792         GO TO EDITLIST-QUES.
018300     DISPLAY SCR-py100-cbl-617-20  .
           PERFORM PROCESS-TAXES THRU PROCESS-TAXES-EXIT.
122396 END-RUN.
122396     IF ALLIEDCO
021206        PERFORM INIT-401K-FILLER
122396        MOVE ZERO               TO 401K-EMPL-SSNO
122396        MOVE "** TOTALS **   "  TO 401K-EMPL-NAME
122396        MOVE ZERO               TO 401K-EMPL-STATUS-CD
122396        MOVE SPACES             TO 401K-EMPL-ADDR1,
122396                                   401K-EMPL-ADDR2,
122396                                   401K-EMPL-CITY,
122396                                   401K-EMPL-STATE,
122396                                   401K-EMPL-ZIP
122396        MOVE ZERO               TO 401K-EMPL-ELIGIBLE-DATE,
122396                                   401K-EMPL-HIRE-DATE,
122396                                   401K-EMPL-TERM-DATE,
122396                                   401K-EMPL-BIRTH-DATE,
122396                                   401K-EMPL-CURRENT-HRS,
122396                                   401K-EMPL-LOAN-NUMBER
              MOVE TOT-401K-TAXABLE-WAGES TO 401K-EMPL-TAXABLE-WAGES
              MOVE TOT-401K-GROSS-WAGES   TO 401K-EMPL-GROSS-WAGES
              MOVE TOT-401K-EMPL-401K-DED TO 401K-EMPL-401K-DED
              MOVE TOT-401K-EMPL-401K-MATCH TO 401K-EMPL-401K-MATCH
              MOVE TOT-401K-EMPL-LOAN-PAYMENT TO 401K-EMPL-LOAN-PAYMENT
122396        PERFORM WRITE-SKILF
090610        IF EXCEL-INSTALLED 
012810           PERFORM SAVE-EXCEL.

024900 EXIT-RUN.
033093     IF FLAG = 0
033093         CLOSE CNTLF
033093         OPEN I-O CNTLF
033093         MOVE 1 TO CNTL-POST-PAYROLL-CD
033093         REWRITE CNTLF-REC.
024800     PERFORM CLOSE-FILES.
025200     COPY "FINISH.SR".
082692     COPY "DATECVT.SR".
081397*    COPY "DAYCVT.SR".
081397*    COPY "DAYREV.SR".
025300     COPY "DATECHK.SR".
      ******************************************************************
025400 SELECT-DEDUCTIONS SECTION.
025500 SELECT-DEDUCTIONS-START.
025600     PERFORM SCREEN-INIT.
036900     PERFORM DISPLAY-SCREEN-1.
026000 SELECT-DEDUCTIONS-ACCEPT.
026000     IF PROCESSING-DEDS
026100        PERFORM ACCEPT-DATA-1
026200        IF RETURN-TO-MENU
026300           GO TO SELECT-DEDUCTIONS-EXIT.
031893     IF PROCESSING-DEDS
031893        PERFORM SCREEN-INIT
031893        PERFORM DISPLAY-SCREEN-1-B
031893        PERFORM ACCEPT-DATA-1-B
031893        IF RETURN-TO-MENU
031893           GO TO SELECT-DEDUCTIONS-EXIT.
028100     PERFORM SET-TAKE-CODES
028100       VARYING I FROM 1 BY 1 UNTIL I > 10.
031893     PERFORM SET-TAKE-CODES-B
031893       VARYING I FROM 11 BY 1 UNTIL I > 20.
028100 SELECT-DEDUCTIONS-EXIT. EXIT.
121791******************************************************************
121791 SELECT-TAXES SECTION.
121791 SELECT-TAXES-START.
121791     PERFORM DISPLAY-SCREEN-2.
121791 SELECT-TAXES-ACCEPT.
121791     PERFORM ACCEPT-DATA-2.
121791     IF GO-BACK
121791        GO TO SELECT-TAXES-EXIT.
121791     MOVE OPTION OF SPEC-2(1) TO WS-TAKE-FIT(1).
121791     MOVE OPTION OF SPEC-2(2) TO WS-TAKE-FICA(1).
121791     MOVE OPTION OF SPEC-2(3) TO WS-TAKE-STATE(1).
121791     MOVE OPTION OF SPEC-2(4) TO WS-TAKE-FIT(2).
121791     MOVE OPTION OF SPEC-2(5) TO WS-TAKE-FICA(2).
121791     MOVE OPTION OF SPEC-2(6) TO WS-TAKE-STATE(2).
121791     MOVE OPTION OF SPEC-2(7) TO WS-TAKE-FIT(3).
121791     MOVE OPTION OF SPEC-2(8) TO WS-TAKE-FICA(3).
121791     MOVE OPTION OF SPEC-2(9) TO WS-TAKE-STATE(3).
121791 SELECT-TAXES-EXIT. EXIT.

025400 PROCESS-TAXES SECTION.
025500 PROCESS-TAXES-START.
025600     COMPUTE FICA-MAX ROUNDED =
025600       CNTL-FICA-MAX * CNTL-FICA-PCT / 100.00000 ON SIZE ERROR 
             MOVE ZERO TO FICA-MAX END-COMPUTE.
112190     COMPUTE MEDICARE-MAX ROUNDED =
112190       CNTL-MEDICARE-MAX * CNTL-MEDICARE-PCT / 100.00000 
             ON SIZE ERROR MOVE ZERO TO MEDICARE-MAX END-COMPUTE.
           PERFORM READ-PYHDF-NEXT.
           PERFORM AT-END-CHECK.
           IF NOT C-AT-END OF PYHDF-STATUS
               PERFORM SET-BREAK.
026000 PROCESS-TAXES-LOOP.
           IF C-AT-END OF PYHDF-STATUS
026000         GO TO PROCESS-TAXES-EXIT.
           PERFORM BREAK-CHECK.
026000     PERFORM SETUP-TOTALS THRU SETUP-TOTALS-EXIT.
           IF PYHD-CHECK-CD = 3
               ADD PYHD-TAX(1) TO YTD-TAX(1)
               ADD PYHD-TAX(2) TO YTD-TAX(2)
               ADD PYHD-TAX(3) TO YTD-TAX(3)
               ADD PYHD-TAX(4) TO YTD-TAX(4)
               ADD PYHD-TAX(5) TO YTD-TAX(5)
112190         ADD PYHD-TAX(6) TO YTD-TAX(6)
               ADD PYHD-DED(1)  TO YTD-DED(1)
               ADD PYHD-DED(2)  TO YTD-DED(2)
               ADD PYHD-DED(3)  TO YTD-DED(3)
               ADD PYHD-DED(4)  TO YTD-DED(4)
               ADD PYHD-DED(5)  TO YTD-DED(5)
               ADD PYHD-DED(6)  TO YTD-DED(6)
               ADD PYHD-DED(7)  TO YTD-DED(7)
               ADD PYHD-DED(8)  TO YTD-DED(8)
               ADD PYHD-DED(9)  TO YTD-DED(9)
               ADD PYHD-DED(10) TO YTD-DED(10)
031893         ADD PYHD-DED(11) TO YTD-DED(11)
031893         ADD PYHD-DED(12) TO YTD-DED(12)
031893         ADD PYHD-DED(13) TO YTD-DED(13)
031893         ADD PYHD-DED(14) TO YTD-DED(14)
031893         ADD PYHD-DED(15) TO YTD-DED(15)
031893         ADD PYHD-DED(16) TO YTD-DED(16)
031893         ADD PYHD-DED(17) TO YTD-DED(17)
031893         ADD PYHD-DED(18) TO YTD-DED(18)
031893         ADD PYHD-DED(19) TO YTD-DED(19)
090492         ADD PYHD-DED(20) TO YTD-DED(20)
122210*        ADD PYHD-TAXABLE-AMT TO YTD-GROSS
               GO TO SKIP-TAX-CALC.
030697*
070192*    IF PYHD-TOTAL-AMT = ZERO AND WS-TOTAL-HRS = ZERO
070192*       PERFORM DELETE-PYHDF
070192*       PERFORM READ-PYHDF-NEXT
070192*       GO TO PROCESS-TAXES-LOOP.

120693     MOVE ZEROS TO WS-LEVY.
120693     IF EMPD-ACTIVE-CD(19) = 1
120693         COMPUTE ANNUAL-GROSS ROUNDED =
120693             TAXABLE-GROSS * PER-FACT
120693         PERFORM CALC-LEVY
120693         IF PYHD-DED(19) NOT > 0
120693             MOVE 0 TO PYHD-DED(19)
120693           ELSE
120693             MOVE PYHD-DED(19) TO WS-LEVY.

042693     MOVE ZEROS TO WS-GARNISHMENT.
042693     IF EMPD-ACTIVE-CD(20) = 1
028200         COMPUTE ANNUAL-GROSS ROUNDED =
                   TAXABLE-GROSS * PER-FACT
042693         PERFORM CALC-GARNISHMENT
042693         IF PYHD-DED(20) NOT > 0
042693             MOVE 0 TO PYHD-DED(20)
042693           ELSE
042693             MOVE PYHD-DED(20) TO WS-GARNISHMENT.

026000     IF PROCESSING-DEDS
112590         MOVE ZEROES TO S125-RETURN-DEDUCTIONS, PYHD-FED-401K-DED,
112590              PYHD-FED-S125-DED, PYHD-ST-S125-DED,
070892              PYHD-ST-401K-DED
010502*        MOVE ZERO TO WS-S106-DED-AMT, WS-S106-TAX-SAV
026000         MOVE "Y" TO NONTAX-DEDS-FLAG
026000         PERFORM CALC-DEDUCTIONS
120693           VARYING I FROM 1 BY 1 UNTIL I > 18.
028200     COMPUTE ANNUAL-GROSS ROUNDED =
               TAXABLE-GROSS * PER-FACT.
032687     COMPUTE ANNUAL-GROSS-ST ROUNDED =
032687         TAXABLE-GROSS-STATE * PER-FACT.
030987* ADDED FOR EIC 1987
051994*    COMPUTE TEMP-GROSS =
051994*        YTD-GROSS - TAXABLE-GROSS.
051994*    IF TEMP-GROSS < 22369
051994     MOVE 0 TO PYHD-EIC-AMT.
122795*     IF ANNUAL-GROSS < 26673
122897*     IF ANNUAL-GROSS < 25760
122897*     IF ANNUAL-GROSS < 26473
120599*     IF ANNUAL-GROSS < 26928
122100*     IF ANNUAL-GROSS < 27413
122301*     IF ANNUAL-GROSS < EIC-WAGE-LIMIT
122301*       PERFORM CALC-EIC.
122301      IF EIC-NONE
122301         MOVE ZERO TO PYHD-EIC-AMT
122301      ELSE
122301      IF (EIC-SHH AND ANNUAL-GROSS < EIC-WAGE-LIMIT-SHH) OR
122301         (EIC-M1  AND ANNUAL-GROSS < EIC-WAGE-LIMIT-M1)  OR
122301         (EIC-M2  AND ANNUAL-GROSS < EIC-WAGE-LIMIT-M2) 
122301            PERFORM CALC-EIC.
028200     ADD PYHD-EIC-AMT TO REM-AMT.
030987     MOVE ZEROES TO TEMP-GROSS.
121791     IF PYHD-CHECK-CD = 4
              MOVE 3 TO WS-TAKE-TAXES-CD
           ELSE MOVE PYHD-CHECK-CD TO WS-TAKE-TAXES-CD.
121791     IF WS-TAKE-FIT(WS-TAKE-TAXES-CD) = 1
010502*       MOVE 2 TO WS-S106-PROCESSING-CD
026000        PERFORM CALC-FIT
010502*       IF WS-S106-DED-AMT > ZERO
010502*          MOVE 1 TO WS-S106-PROCESSING-CD
010502*          PERFORM CALC-FIT
010502*          MOVE 2 TO WS-S106-PROCESSING-CD
010502*       ELSE
010502*          NEXT SENTENCE
121791     ELSE MOVE ZERO TO PYHD-TAX(1).

121791     IF WS-TAKE-FICA(WS-TAKE-TAXES-CD) = 1
026000        PERFORM CALC-FICA
112190        PERFORM CALC-MEDICARE
121791     ELSE MOVE ZERO TO PYHD-TAX(2) PYHD-TAX(3).

121791     IF WS-TAKE-STATE(WS-TAKE-TAXES-CD) = 1
026000        PERFORM CALC-STATES
112190                VARYING TAX-NO FROM 4 BY 1 UNTIL TAX-NO > 6
121791     ELSE MOVE ZERO TO PYHD-TAX(4), PYHD-TAX(5), PYHD-TAX(6).

120693     IF EMPD-ACTIVE-CD(19) = 1
120693       MOVE ZEROS TO WS-LEVY
120693       PERFORM CALC-LEVY
120693         IF PYHD-DED(19) NOT > 0
120693             MOVE 0 TO PYHD-DED(19)
120693           ELSE
120693             MOVE PYHD-DED(19) TO WS-LEVY
120693             ADD PYHD-DED(19) TO YTD-DED(19).

102092     IF EMPD-ACTIVE-CD(20) = 1
042693       MOVE ZEROS TO WS-GARNISHMENT
100792       PERFORM CALC-GARNISHMENT
100792         IF PYHD-DED(20) NOT > 0
100792             MOVE 0 TO PYHD-DED(20)
042693           ELSE
042693             MOVE PYHD-DED(20) TO WS-GARNISHMENT
042693             ADD PYHD-DED(20) TO YTD-DED(20).

026000     IF PROCESSING-DEDS
026000         MOVE "N" TO NONTAX-DEDS-FLAG
026000         PERFORM CALC-DEDUCTIONS
120693           VARYING I FROM 1 BY 1 UNTIL I > 18.
122890     IF TAXABLE-GROSS-MEDICARE < ZERO
122890        MOVE ZERO TO TAXABLE-GROSS-MEDICARE.
122890     IF TAXABLE-GROSS-FICA < ZERO
122890        MOVE ZERO TO TAXABLE-GROSS-FICA.
026000     PERFORM CALC-NET.
       SKIP-TAX-CALC.
           PERFORM MOVE-AMOUNTS
090492           VARYING I FROM 1 BY 1 UNTIL I > 20.
           MOVE YTD-GROSS TO PYHD-YTD-GROSS.
           MOVE EMPL-TAX-CODE(1) TO PYHD-TAX-CODE(1).
           MOVE EMPL-TAX-CODE(2) TO PYHD-TAX-CODE(2).
           MOVE EMPL-TAX-CODE(3) TO PYHD-TAX-CODE(3).
010502*    MOVE WS-S106-DED-AMT  TO PYHD-S106-DED-AMT.
010502*    MOVE WS-S106-TAX-SAV  TO PYHD-S106-TAX-SAV.
010602     IF ACCRUE-VAC-YES
010602        PERFORM ACCRUE-VAC THRU ACCRUE-VAC-EXIT.
010602     IF ACCRUE-SICK-YES
010602        PERFORM ACCRUE-SICK THRU ACCRUE-SICK-EXIT.
           PERFORM REWRITE-PYHDF.
122396     IF ALLIEDCO
122396        PERFORM CREATE-401K-REC THRU CREATE-401K-REC-EXIT
090610        IF EXCEL-INSTALLED 
012810           PERFORM WRITE-XLS-DATA.
121798     IF AGMC
121796        PERFORM CREATE-AGMC-REC THRU CREATE-AGMC-REC-EXIT.
           PERFORM READ-PYHDF-NEXT.
026000     GO TO PROCESS-TAXES-LOOP.
028100 PROCESS-TAXES-EXIT. EXIT.

028200 SETUP-TOTALS SECTION.
028200 SETUP-TOTALS-START.
028200     MOVE PYHD-EMPL-NO TO EMPL-NUMBER.
028200     PERFORM READ-EMPLF.
028200*    DISPLAY EMPL-NAME LINE 3 POSITION 26.
028200     MOVE 0 TO PYHD-TOTAL-AMT, PYHD-TAXABLE-AMT, PYHD-NONTAX-AMT.
010502*    MOVE ZERO TO PYHD-S106-DED-AMT, PYHD-S106-TAX-SAV.
070192     MOVE ZERO TO WS-TOTAL-HRS.
028200     PERFORM ZERO-CHECK-TOTALS
090492       VARYING I FROM 1 BY 1 UNTIL I > 20.
028200     MOVE PYHD-EMPL-NO TO PYLN-EMPL-NO.
028200     MOVE PYHD-CHECK-CD TO PYLN-CHECK-CD.
028200     MOVE 0 TO PYLN-SEQ-NO.
028200     PERFORM START-PYLNF-GREATER.
028200     IF NOT C-AT-END OF PYLNF-STATUS
028200         PERFORM READ-PYLNF-NEXT.
028200 SETUP-TOTALS-LOOP.
122301*    IF QUESTAPP
122301*       IF PYLN-SEQ-NO = 777777
122301*         IF PYLN-AMT NOT = 0
122301*           MOVE 0 TO PYLN-AMT
122301*           PERFORM REWRITE-PYLNF.
028200     IF C-AT-END OF PYLNF-STATUS
028200         GO TO SETUP-TOTALS-DONE.
042197     IF PYHD-CHECK-CD NOT = 3
028200        ADD PYLN-AMT TO PYHD-AMT(PYLN-EARN-CD)
028200        ADD PYLN-HR TO PYHD-HR(PYLN-EARN-CD)
070192        ADD PYLN-HR TO WS-TOTAL-HRS.
091309*    IF PYLN-EARN-CD NOT = 7
091309     IF PYLN-EARN-CD NOT = EXCN-NON-TAX-ADJ-CD
028200        ADD PYLN-AMT TO PYHD-TAXABLE-AMT
028200     ELSE
              ADD PYLN-AMT TO PYHD-NONTAX-AMT.
028200     PERFORM READ-PYLNF-NEXT.
028200     GO TO SETUP-TOTALS-LOOP.
028200 SETUP-TOTALS-DONE.
032687     MOVE PYHD-TAXABLE-AMT TO TAXABLE-GROSS, REM-AMT,
                TAXABLE-GROSS-FICA, TAXABLE-GROSS-MEDICARE,
                TAXABLE-GROSS-STATE.
028200     COMPUTE PYHD-TOTAL-AMT = PYHD-TAXABLE-AMT + PYHD-NONTAX-AMT.
           ADD TAXABLE-GROSS TO YTD-GROSS.
028200     MOVE FREQ-FACTOR(EMPL-PAY-FREQUENCY-CD) TO PER-FACT.
028200     IF PYHD-PAY-PERIODS NOT = 0
028200         COMPUTE PER-FACT ROUNDED = PER-FACT / PYHD-PAY-PERIODS 
               ON SIZE ERROR MOVE ZERO TO PER-FACT END-COMPUTE.
028200 SETUP-TOTALS-EXIT. EXIT.

028200 CALC-EIC SECTION.
028200 CALC-EIC-START.
028200     MOVE 0 TO PYHD-EIC-AMT.
028200     IF EMPL-EIC-CD = 2
122100         IF ANNUAL-GROSS < EIC-SHH-MIN
122795             COMPUTE PYHD-EIC-AMT ROUNDED = ANNUAL-GROSS * .2040
122301         ELSE MOVE EIC-SHH-TAX TO PYHD-EIC-AMT
122301             IF ANNUAL-GROSS > EIC-SHH-MAX
030987                 COMPUTE PYHD-EIC-AMT ROUNDED = PYHD-EIC-AMT -
122301                   ((ANNUAL-GROSS - EIC-SHH-MAX) * .09588).
028200     IF EMPL-EIC-CD = 3
122301         IF ANNUAL-GROSS < EIC-M1-MIN
122795             COMPUTE PYHD-EIC-AMT ROUNDED = ANNUAL-GROSS * .2040
122301         ELSE MOVE EIC-M1-TAX TO PYHD-EIC-AMT
122301             IF ANNUAL-GROSS > EIC-M1-MAX
030987                 COMPUTE PYHD-EIC-AMT ROUNDED = PYHD-EIC-AMT -
122301                   ((ANNUAL-GROSS - EIC-M1-MAX) * .09588).
122301     IF EMPL-EIC-CD = 4
122301         IF ANNUAL-GROSS < EIC-M2-MIN
122301             COMPUTE PYHD-EIC-AMT ROUNDED = ANNUAL-GROSS * .2040
122301         ELSE MOVE EIC-M2-TAX TO PYHD-EIC-AMT
122301             IF ANNUAL-GROSS > EIC-M2-MAX
122301                 COMPUTE PYHD-EIC-AMT ROUNDED = PYHD-EIC-AMT -
122301                   ((ANNUAL-GROSS - EIC-M2-MAX) * .09588).
030987     COMPUTE PYHD-EIC-AMT ROUNDED = PYHD-EIC-AMT / PER-FACT 
            ON SIZE ERROR MOVE ZERO TO PYHD-EIC-AMT END-COMPUTE.
051994     COMPUTE EIC-TOTAL ROUNDED = EMPL-EIC-PAYMTS(1) +
051994             EMPL-EIC-PAYMTS(2) + EMPL-EIC-PAYMTS(3) +
051994             EMPL-EIC-PAYMTS(4) + PYHD-EIC-AMT.
122301     IF EMPL-EIC-CD = 2 AND EIC-TOTAL > EIC-SHH-TAX
051994        COMPUTE PYHD-EIC-AMT ROUNDED =
122301             EIC-SHH-TAX - (EIC-TOTAL - PYHD-EIC-AMT).
122100     IF EMPL-EIC-CD = 3 AND EIC-TOTAL > EIC-M1-TAX
051994        COMPUTE PYHD-EIC-AMT ROUNDED =
122301             EIC-M1-TAX - (EIC-TOTAL - PYHD-EIC-AMT).
122301     IF EMPL-EIC-CD = 4 AND EIC-TOTAL > EIC-M2-TAX
122301        COMPUTE PYHD-EIC-AMT ROUNDED =
122301             EIC-M2-TAX - (EIC-TOTAL - PYHD-EIC-AMT).
051994     IF PYHD-EIC-AMT < 0 MOVE 0 TO PYHD-EIC-AMT.
028200
028200 CALC-EIC-EXIT. EXIT.

028200 CALC-FIT SECTION.
028200 CALC-FIT-START.
028200     MOVE EMPL-FIT-EXEMPT-CD TO EMPS-EXEMPT-CD.
028200     MOVE EMPL-EXTRAFIT-AMT TO EMPS-EXTRA-AMT.
028200     MOVE EMPL-EXTRAFIT-PCT TO EMPS-EXTRA-PCT.
028200     MOVE EMPL-FED-ALLOW TO EMPS-ALLOW-CD(1).
028200     MOVE "FIT  " TO TAXR-NUMBER.
028200     IF EMPL-FED-MSTAT-CD = 1
028200         MOVE "M " TO TAXR-FILING-STATUS
028200     ELSE MOVE "S " TO TAXR-FILING-STATUS.
028200     PERFORM CALCULATE-TAX.
010502*    IF PROCESSING-S106-YES
010502*       COMPUTE WS-TAX-DIFF ROUNDED = TAX-AMT - PYHD-TAX(1)
010502*       ADD  WS-TAX-DIFF TO WS-S106-TAX-SAV
010502*    ELSE
028200        MOVE TAX-AMT TO PYHD-TAX(1)
              ADD TAX-AMT TO YTD-TAX(1)
028200        COMPUTE ANNUAL-FIT ROUNDED = PYHD-TAX(1) * PER-FACT.
028200 CALC-FIT-EXIT. EXIT.

028200 CALC-FICA SECTION.
028200 CALC-FICA-START.
           IF YTD-TAX(2) > FICA-MAX OR EMPL-FICA-EXEMPT-CD = 1
028200         MOVE 0 TO PYHD-TAX(2)
028200         GO TO CALC-FICA-EXIT.
022592     IF TAXABLE-GROSS-FICA < ZERO
022592        MOVE ZERO TO PYHD-TAX(2)
022592        GO TO CALC-FICA-EXIT.
028200     COMPUTE PYHD-TAX(2) ROUNDED =
032687           TAXABLE-GROSS-FICA * CNTL-FICA-PCT / 100.00000 
                 ON SIZE ERROR MOVE ZERO TO PYHD-TAX(2) END-COMPUTE.
072899     IF PYHD-TAX(2) + YTD-TAX(2) > FICA-MAX
072899           COMPUTE PYHD-TAX(2) = FICA-MAX - YTD-TAX(2).
028200     IF PYHD-TAX(2) > REM-AMT
028200           MOVE REM-AMT TO PYHD-TAX(2).
028200     SUBTRACT PYHD-TAX(2) FROM REM-AMT.
           ADD PYHD-TAX(2) TO YTD-TAX(2).
028200 CALC-FICA-EXIT. EXIT.

028200 CALC-MEDICARE SECTION.
028200 CALC-MEDICARE-START.
092691     IF YTD-TAX(3) > MEDICARE-MAX OR EMPL-MED-EXEMPT-CD = 1
028200         MOVE 0 TO PYHD-TAX(3)
028200         GO TO CALC-MEDICARE-EXIT.
022592     IF TAXABLE-GROSS-MEDICARE < ZERO
022592        MOVE ZERO TO PYHD-TAX(3)
022592        GO TO CALC-MEDICARE-EXIT.
010502*    IF PROCESSING-S106-YES
010502*       COMPUTE TAX-AMT ROUNDED =
010502*           (TAXABLE-GROSS-FICA + WS-S106-DED-AMT) *
010502*           (CNTL-MEDICARE-PCT / 100)
010502*    ELSE
028200     COMPUTE PYHD-TAX(3) ROUNDED =
032687           TAXABLE-GROSS-MEDICARE * CNTL-MEDICARE-PCT / 100.00000 
                 ON SIZE ERROR MOVE ZERO TO PYHD-TAX(3) END-COMPUTE.
           IF PYHD-TAX(3) + YTD-TAX(3) > MEDICARE-MAX
               COMPUTE PYHD-TAX(3) = MEDICARE-MAX - YTD-TAX(3).
010502*    IF PROCESSING-S106-NO
028200     IF PYHD-TAX(3) > REM-AMT
028200            MOVE REM-AMT TO PYHD-TAX(3).
010502*    IF PROCESSING-S106-YES
010502*       COMPUTE WS-TAX-DIFF ROUNDED = TAX-AMT - PYHD-TAX(3)
010502*       ADD  WS-TAX-DIFF TO WS-S106-TAX-SAV
010502*    ELSE
028200     SUBTRACT PYHD-TAX(3) FROM REM-AMT.
           ADD PYHD-TAX(3) TO YTD-TAX(3).
028200 CALC-MEDICARE-EXIT. EXIT.

028200 CALC-STATES SECTION.
028200 CALC-STATES-START.
010502*    IF PROCESSING-S106-NO
010502*       MOVE 0 TO PYHD-TAX(TAX-NO).
112190     COMPUTE TAX-CODE = TAX-NO - 3.
028200     IF EMPL-TAX-CODE(TAX-CODE) = SPACES
028200         GO TO CALC-STATES-EXIT.
028200     MOVE PYHD-EMPL-NO TO EMPS-EMPL-NUMBER.
028200     MOVE EMPL-TAX-CODE(TAX-CODE) TO EMPS-STATE-CODE, TAXR-NUMBER.
028200     PERFORM READ-EMPSF.
028200     MOVE EMPS-FILING-STATUS TO TAXR-FILING-STATUS.
032687     MOVE ANNUAL-GROSS-ST TO ANNUAL-GROSS.
028200     PERFORM CALCULATE-TAX.
122301*    IF QUESTAPP
122301*      IF TAX-NO = 4
122301*        PERFORM JDAF-CALC.
010502*    IF PROCESSING-S106-YES
010502*       COMPUTE WS-TAX-DIFF ROUNDED = TAX-AMT - PYHD-TAX(TAX-NO)
010502*       ADD  WS-TAX-DIFF TO WS-S106-TAX-SAV
010502*    ELSE
028200     MOVE TAX-AMT TO PYHD-TAX(TAX-NO).
           ADD TAX-AMT TO YTD-TAX(TAX-NO).
013197
028200
028200 CALC-STATES-EXIT. EXIT.

122301*JDAF-CALC SECTION.
122301*JCS.
122301*    IF EMPD-ACTIVE-CD(11) = 2 OR EMPD-ACTIVE-CD(12) = 2
122301*        MOVE 1 TO EMPD-ACTIVE-CD(11)
122301*        MOVE 1 TO EMPD-ACTIVE-CD(12)
122301*        PERFORM REWRITE-EMPLF.
122301*    COMPUTE WS-JDAF ROUNDED = PYHD-TAXABLE-AMT * .04.
122301*    MOVE WS-JDAF TO PYHD-DED(11).
122301*    ADD PYHD-DED(11) TO YTD-DED(11).
122301*    IF WS-JDAF > TAX-AMT
122301*      COMPUTE WS-DIFF = WS-JDAF - TAX-AMT
122301*      ADD WS-DIFF TO PYHD-NONTAX-AMT
122301*      ADD WS-DIFF TO PYHD-TOTAL-AMT
122301*      ADD WS-DIFF TO PYHD-AMT(7)
122301*      PERFORM CREATE-JDAF-ADJ
122301*      MOVE 0 TO TAX-AMT
122301*    ELSE
122301*      COMPUTE WS-DIFF = TAX-AMT - WS-JDAF
122301*      MOVE WS-DIFF TO TAX-AMT.
122301*
122301*JDAF-CALC-EXIT. EXIT.
051294
122301*CREATE-JDAF-ADJ SECTION.
122301*CJA.
122301*    MOVE SPACES TO PYLNF-REC.
122301*    MOVE PYHD-EMPL-NO  TO PYLN-EMPL-NO.
122301*    MOVE PYHD-CHECK-CD TO PYLN-CHECK-CD.
122301*    MOVE 777777        TO PYLN-SEQ-NO.
122301*    MOVE 7             TO PYLN-EARN-CD.
122301*    MOVE WS-DIFF       TO PYLN-AMT.
122301*    MOVE EMPL-EXP-ACCT TO PYLN-ACCT-NO.
122301*    MOVE 0 TO PYLN-HR, PYLN-RATE, PYLN-DEPT-NO,
122301*      PYLN-JOB-GL-ACCT.
122301*    PERFORM WRITE-PYLNF.
122301*    IF PYLNF-STATUS = DUPLICATE-RECORD
122301*      PERFORM REWRITE-PYLNF.
122301*CREATE-JDAF-ADJ-EXIT. EXIT.
051294
028200 CALC-DEDUCTIONS SECTION.
028200 CALC-DEDUCTIONS-START.
           IF PYHD-CHECK-CD = 3
               GO TO CALC-DEDUCTIONS-EXIT.

031893     IF I < 11
             IF PYHD-CHECK-CD = 1
102003*        SET JJ TO I
102003         COMPUTE JJ = I
             ELSE
             IF PYHD-CHECK-CD = 2
               COMPUTE JJ = I + 10
             ELSE
             IF PYHD-CHECK-CD = 4
               COMPUTE JJ = I + 20
031893       ELSE NEXT SENTENCE
031893     ELSE
031893*IF DED 11-19 USE ARRAY ELEMENTS 31-60
             IF PYHD-CHECK-CD = 1
031893         COMPUTE JJ = I + 20
             ELSE
             IF PYHD-CHECK-CD = 2
031893         COMPUTE JJ = I + 30
             ELSE
             IF PYHD-CHECK-CD = 4
031893         COMPUTE JJ = I + 40.

           IF (NONTAX-DEDS AND DEDC-TAX-CD(I) NOT = 2) OR
              (TAX-DEDS AND DEDC-TAX-CD(I) NOT = 1)
028200        GO TO CALC-DEDUCTIONS-EXIT.
           IF (DEDC-METHOD-CD(I) = 1) OR
              (TAKE-CD(JJ) = 2)       OR
              (EMPD-ACTIVE-CD(I) = 2)
028200        MOVE 0 TO PYHD-DED(I)
028200        GO TO CALC-DEDUCTIONS-EXIT.
010398*    IF DEDC-METHOD-CD(I) = 2 OR 5 OR 7 OR 9
010502*    IF DEDC-METHOD-CD(I) = 2 OR 5 OR 7 OR 8 OR 9
010502     IF DEDC-METHOD-CD(I) = 2 OR 5 OR 7 OR 9
028200        MOVE EMPD-AMT-PCT(I) TO PYHD-DED(I)
028200     ELSE
              COMPUTE PYHD-DED(I) ROUNDED =
028200                PYHD-TOTAL-AMT * EMPD-AMT-PCT(I) / 100.00000 
                      ON SIZE ERROR MOVE ZERO TO PYHD-DED(I) END-COMPUTE
                      .

040593     IF DEDC-METHOD-CD(I) = 4 OR 5
040593        IF EMPD-LIMIT(I) = 0
040593            OR EMPD-LIMIT(I) > CNTL-401K-FEDERAL
040593                MOVE CNTL-401K-FEDERAL TO EMPD-LIMIT(I).

028200     IF (EMPD-LIMIT(I) > 0) AND
028200        (PYHD-DED(I) + YTD-DED(I) > EMPD-LIMIT(I))
028200        COMPUTE PYHD-DED(I) = EMPD-LIMIT(I) - YTD-DED(I).

032897*-- MAKE SURE DED AMT DOES NOT EXCEED REMAINING FUNDS --*
032897     IF PYHD-DED(I) > REM-AMT
032897        MOVE REM-AMT TO PYHD-DED(I).

111890     IF NONTAX-DEDS AND DEDC-METHOD-CD(I) < 4
032687        SUBTRACT PYHD-DED(I) FROM TAXABLE-GROSS,
032687                             TAXABLE-GROSS-STATE,
                                   TAXABLE-GROSS-FICA,
112190                             TAXABLE-GROSS-MEDICARE.
081308*  IF PIONEER
081308*     IF I = 1 AND PYHD-DED(I) > 0
081308*        PERFORM CALC-WEEKS-WORKED.

*******-- DETERMINE IF 401K AND IF SO CHECK AGAINST FED LIMIT ---
           IF NONTAX-DEDS
              IF DEDC-METHOD-CD(I) = 4 OR 5
032687           IF (YTD-DED(I) + PYHD-DED(I) < CNTL-401K-FEDERAL)
032687              SUBTRACT PYHD-DED(I) FROM TAXABLE-GROSS
112090              ADD PYHD-DED(I) TO PYHD-FED-401K-DED
                 ELSE
032687              COMPUTE TEMP-AMT = CNTL-401K-FEDERAL - YTD-DED(I)
032687              IF TEMP-AMT > 0
032687                 SUBTRACT TEMP-AMT FROM TAXABLE-GROSS
112090                 ADD TEMP-AMT TO PYHD-FED-401K-DED.
032687     MOVE ZEROES TO TEMP-AMT.
111890*-- 401K STATE --*
111890     IF EMPL-TAX-CODE(1) NOT = SPACES
111890        MOVE EMPL-TAX-CODE(1) TO STAT-CODE
111890        PERFORM READ-STATF
111890        IF NOT C-FOUND OF STATF-STATUS
111890           MOVE ZERO TO STAT-401K-LIMIT.
           IF NONTAX-DEDS
              IF DEDC-METHOD-CD(I) = 4 OR 5
032687           IF (YTD-DED(I) + PYHD-DED(I) < STAT-401K-LIMIT)
032687              SUBTRACT PYHD-DED(I) FROM TAXABLE-GROSS-STATE
112090              ADD PYHD-DED(I) TO PYHD-ST-401K-DED
                 ELSE
032687              COMPUTE TEMP-AMT = STAT-401K-LIMIT - YTD-DED(I)
032687              IF TEMP-AMT > 0
112090                 ADD PYHD-DED(I) TO PYHD-ST-401K-DED
032687                 SUBTRACT TEMP-AMT FROM TAXABLE-GROSS-STATE.
032687     MOVE ZEROES TO TEMP-AMT.
112590*-- S125 FED --*
112590     IF NONTAX-DEDS
              IF DEDC-METHOD-CD(I) > 5
112590            SUBTRACT PYHD-DED(I) FROM TAXABLE-GROSS,
                                            TAXABLE-GROSS-FICA,
                                            TAXABLE-GROSS-MEDICARE
112590            ADD PYHD-DED(I) TO PYHD-FED-S125-DED
010398*           IF DEDC-METHOD-CD(I) > 7
010502            IF DEDC-METHOD-CD(I) = 9
112590               ADD PYHD-DED(I) TO S125-RETURN-DEDUCTIONS.

041000*-- Charge Medicare Tax on these three deductions numbers --*
041000     IF 2NDCOURT
041000        IF I = 1 OR 2 OR 9
041000           ADD PYHD-DED(I) TO TAXABLE-GROSS-MEDICARE.
112590*-- S125 STATE --*
112590     IF EMPL-TAX-CODE(1) NOT = SPACES
112590        MOVE EMPL-TAX-CODE(1) TO STAT-CODE
112590        PERFORM READ-STATF
112590        IF NOT C-FOUND OF STATF-STATUS
112590           MOVE 2 TO STAT-S125-ALLOWED.
112590     IF NONTAX-DEDS      AND
              S125-ALLOWED     AND
              (DEDC-METHOD-CD(I) > 5)
              SUBTRACT PYHD-DED(I) FROM TAXABLE-GROSS-STATE
112590        ADD PYHD-DED(I) TO PYHD-ST-S125-DED.
*******
010502*    IF NONTAX-DEDS AND DEDC-METHOD-CD(I) = 8
010502*       ADD PYHD-DED(I)  TO WS-S106-DED-AMT.

120693     COMPUTE NET-OF-LEVY = REM-AMT - WS-LEVY.
120693     IF PYHD-DED(I) > NET-OF-LEVY
120693        MOVE NET-OF-LEVY TO PYHD-DED(I).

042693     COMPUTE NET-OF-GARNISHMENT = REM-AMT - WS-GARNISHMENT.
042693     IF PYHD-DED(I) > NET-OF-GARNISHMENT
042693        MOVE NET-OF-GARNISHMENT  TO PYHD-DED(I).
028200*    IF PYHD-DED(I) > REM-AMT
028200*       MOVE REM-AMT TO PYHD-DED(I).
028200     SUBTRACT PYHD-DED(I) FROM REM-AMT.
           ADD PYHD-DED(I) TO YTD-DED(I).
028200 CALC-DEDUCTIONS-EXIT. EXIT.

090492 CALC-GARNISHMENT SECTION.
090492 CGS.
           MOVE 0 TO PYHD-DED(20).
           MOVE 0 TO TAX-AMT.
100792     IF DEDC-TAX-CD(20) = 2
100792         COMPUTE TEMP-GROSS ROUNDED = (TAXABLE-GROSS -
028200       PYHD-TAX(1) - PYHD-TAX(2) - PYHD-TAX(3) -
070892       PYHD-TAX(4) - PYHD-TAX(5) - PYHD-TAX(6) ) * PER-FACT
           ELSE MOVE ANNUAL-GROSS TO TEMP-GROSS.
122301*    IF QUESTAPP
122301*      IF DEDC-TAX-CD(20) = 2
122301*        COMPUTE TEMP-GROSS ROUNDED = TEMP-GROSS -
122301*          ((PYHD-DED(11) - PYHD-NONTAX-AMT) * PER-FACT).
           MOVE EMPL-STATE TO GAR-STATE.
090492     MOVE GARNISH-KEY TO TAXRF-KEY.
           PERFORM READ-TAXRF.
           IF TAXRF-STATUS = NOT-FOUND
               GO TO CALC-GARNISHMENT-EXIT.
           IF TEMP-GROSS < 0
               GO TO CALC-GARNISHMENT-EXIT.
           MOVE 0 TO LOW-BRACKET.
           PERFORM CALC-GAR1-LOOP VARYING J FROM 1 BY 1
               UNTIL TEMP-GROSS < TAXR-BRACKET-AMT(J).
           PERFORM CALC-GAR1-LOOP.
012793     IF (EMPD-LIMIT(20) > 0) AND
012793         (PYHD-DED(20) + YTD-DED(20) > EMPD-LIMIT(20))
012793             COMPUTE PYHD-DED(20) = EMPD-LIMIT(20) - YTD-DED(20).
012793     IF PYHD-DED(20) < 0 MOVE 0 TO PYHD-DED(20).
042693*    ADD PYHD-DED(20) TO YTD-DED(20).
           GO TO CALC-GARNISHMENT-EXIT.

       CALC-GAR1-LOOP.
           IF J > 1
               COMPUTE K = J - 1
               MOVE TAXR-BRACKET-AMT(K) TO LOW-BRACKET.
028200     IF TEMP-GROSS > TAXR-BRACKET-AMT(J)
028200         COMPUTE SPREAD-AMT = TAXR-BRACKET-AMT(J) - LOW-BRACKET
028200     ELSE COMPUTE SPREAD-AMT = TEMP-GROSS - LOW-BRACKET.
028200     COMPUTE TAX-AMT ROUNDED = TAX-AMT +
028200           SPREAD-AMT * TAXR-BRACKET-PCT(J) / 100.00000 
                 ON SIZE ERROR MOVE ZERO TO TAX-AMT END-COMPUTE.

           COMPUTE PYHD-DED(20) ROUNDED = TAX-AMT / PER-FACT 
            ON SIZE ERROR MOVE ZERO TO PYHD-DED(20) END-COMPUTE.

090492 CALC-GARNISHMENT-EXIT. EXIT.

120693 CALC-LEVY SECTION.
120693 CLS.
120693     MOVE 0 TO PYHD-DED(19).
120693     MOVE 0 TO TAX-AMT.
120693     IF DEDC-TAX-CD(19) = 2
120693         COMPUTE TEMP-GROSS ROUNDED = ( TAXABLE-GROSS -
120693       PYHD-TAX(1) - PYHD-TAX(2) - PYHD-TAX(3) -
120693       PYHD-TAX(4) - PYHD-TAX(5) - PYHD-TAX(6) )
120693       * PER-FACT
120693     ELSE MOVE ANNUAL-GROSS TO TEMP-GROSS.
120693*    MOVE EMPL-STATE TO GAR-STATE.
120693     IF EMPL-FED-MSTAT-CD = 1
120693         MOVE "M " TO LEVY-TYPE
120693     ELSE MOVE "S " TO LEVY-TYPE.
120693     MOVE LEVY-KEY TO TAXRF-KEY.
120693     PERFORM READ-TAXRF.
120693     IF TAXRF-STATUS = NOT-FOUND
120693         GO TO CALC-LEVY-EXIT.
120693     PERFORM STANDARD-DED-CALC.
120693     PERFORM LEVY-EXEMPT-CALC.
120693**   COMPUTE TEMP-GROSS = TEMP-GROSS - STDED-AMT.
120693     IF TEMP-GROSS < 0
120693         GO TO CALC-LEVY-EXIT.
120693     MOVE 0 TO LOW-BRACKET.
120693     PERFORM CALC-LEV1-LOOP VARYING J FROM 1 BY 1
120693         UNTIL TEMP-GROSS < TAXR-BRACKET-AMT(J).
120693     PERFORM CALC-LEV1-LOOP.
120693     IF (EMPD-LIMIT(19) > 0) AND
120693         (PYHD-DED(19) + YTD-DED(19) > EMPD-LIMIT(19))
120693             COMPUTE PYHD-DED(19) = EMPD-LIMIT(19) - YTD-DED(19).
120693     IF PYHD-DED(19) < 0 MOVE 0 TO PYHD-DED(19).
120693     GO TO CALC-LEVY-EXIT.
120693
120693 CALC-LEV1-LOOP.
120693     IF J > 1
120693         COMPUTE K = J - 1
120693         MOVE TAXR-BRACKET-AMT(K) TO LOW-BRACKET.
120693     IF TEMP-GROSS > TAXR-BRACKET-AMT(J)
120693         COMPUTE SPREAD-AMT = TAXR-BRACKET-AMT(J) - LOW-BRACKET
120693     ELSE COMPUTE SPREAD-AMT = TEMP-GROSS - LOW-BRACKET.
120693     COMPUTE TAX-AMT ROUNDED = TAX-AMT +
120693           SPREAD-AMT * TAXR-BRACKET-PCT(J) / 100.00000 
                 ON SIZE ERROR MOVE ZERO TO TAX-AMT END-COMPUTE.
120693
120693     COMPUTE PYHD-DED(19) ROUNDED = TAX-AMT / PER-FACT 
            ON SIZE ERROR MOVE ZERO TO PYHD-DED(19) END-COMPUTE.
120693
120693 CALC-LEVY-EXIT. EXIT.

081308*CALC-WEEKS-WORKED SECTION.
081308*CWWS.
082792*    MOVE 0 TO WS-WEEK1, WS-WEEK2, WS-HOURS.
      *
081397*    MOVE PE-DAY-B2  TO THST-DATE-JULIAN.
082792*    MOVE PYHD-EMPL-NO TO THST-EMPL-NUMBER.
082792*    PERFORM START-THSTF.
082792*LOOP-1.
082792*    IF NOT C-AT-END OF THSTF-STATUS
082792*        PERFORM READ-THSTF-NEXT
082792*    ELSE GO TO LOOP-1-END.
082792*    IF THST-EMPL-NUMBER NOT = PYHD-EMPL-NO GO TO LOOP-1-END.
081397*    IF THST-DATE-JULIAN > PE-DAY-E2 GO TO LOOP-1-END.
100692*    PERFORM CHECK-FOR-HOURS VARYING LL FROM 1 BY 1 UNTIL LL > 20.
082792*    IF WS-HOURS > 0 OR THST-OT-HOURS > 0
082792*        MOVE WS-HOURS TO WS-WEEK1
082792*        GO TO LOOP-1-END
082792*    ELSE GO TO LOOP-1.
082792*LOOP-1-END.
082792*    MOVE 0 TO WS-HOURS.
081397*    MOVE PE-DAY-B1  TO THST-DATE-JULIAN.
082792*    MOVE PYHD-EMPL-NO TO THST-EMPL-NUMBER.
082792*    PERFORM START-THSTF.
      *
082792*LOOP-2.
082792*    IF NOT C-AT-END OF THSTF-STATUS
082792*        PERFORM READ-THSTF-NEXT
082792*    ELSE GO TO LOOP-2-END.
082792*    IF THST-EMPL-NUMBER NOT = PYHD-EMPL-NO GO TO LOOP-2-END.
081397*    IF THST-DATE-JULIAN > PE-DAY-E1 GO TO LOOP-2-END.
082792*    PERFORM CHECK-FOR-HOURS VARYING LL FROM 1 BY 1 UNTIL LL > 20.
082792*    IF WS-HOURS > 0 OR THST-OT-HOURS > 0
082792*        MOVE WS-HOURS TO WS-WEEK2
082792*        GO TO LOOP-2-END
082792*    ELSE GO TO LOOP-2.
      *
082792*LOOP-2-END.
      *
      *    IF WS-WEEK1 = 0 AND WS-WEEK2 = 0
      *        MOVE 0 TO PYHD-DED(1)
      *    ELSE IF (WS-WEEK1 = 0 OR WS-WEEK2 = 0)
      *        COMPUTE PYHD-DED(1) ROUNDED = PYHD-DED(1) / 2 
      *        ON SIZE ERROR MOVE ZERO TO PYHD-DED(1) END-COMPUTE.
      *
082792*    GO TO CALC-WEEKS-WORKED-EXIT.
      *
082792*CHECK-FOR-HOURS.
100692*    ADD THST-PAY-CATEGORY-HOURS(LL) TO WS-HOURS.
      *
      *CALC-WEEKS-WORKED-EXIT. EXIT.

082692 GET-PERIOD-END-DATE SECTION.
028200 GET-PERIOD-END-DATE-START.
028300*    PERFORM SCREEN-INIT.
082692     DISPLAY SCR-py100-cbl-1411-20  .
028500     MOVE TODAYS-DATE TO PE-DATE.
028600 ACCEPT-DATE.
028700     MOVE "1010000000" TO FKEYS.
028800     MOVE 0 TO FLAG.
           PERFORM STEST-py100-cbl-1416
028900     CALL "SCRN01" USING FLAG, FKEYS, STEST-SCRN-SPECS, DATE-HELP,
029000         PE-DATE
           PERFORM STEST-AFTER-CALL.
029100     IF FLAG = 3 GO TO GET-PERIOD-END-DATE-EXIT.
029200     MOVE PE-DATE TO DATE-IN.
029300     PERFORM DATE-CHECK THRU DATE-CHECK-EXIT.
122698     MOVE DATE-IN TO PE-DATE.
029400     IF BAD-DATE OR PE-DATE = 0
029500         DISPLAY SCR-py100-cbl-1423-24  
029600         GO TO ACCEPT-DATE.

082792     MOVE PE-DATE TO DATE-IN.
020697*    PERFORM DAY-CONVERT.
020697*    MOVE DAY-OUT TO PE-DAY, PE-DAY-E1.
020697     MOVE JULIAN-DAYS TO PE-DAY, PE-DAY-E1.
082792     COMPUTE PE-DAY-B1 = PE-DAY - 6.
082792     COMPUTE PE-DAY-B2 = PE-DAY - 13.
082792     COMPUTE PE-DAY-E2 = PE-DAY - 7.

******* EXAMPLE DATE = 62692
      *  B1 = 6/20  E1 = 6/26
      *  B2 = 6/13  E2 = 6/19

020697*    MOVE PE-DAY-B1 TO DAY-OUT.
020697*    PERFORM DAY-REVERSE.
020697*    MOVE I-MONTH TO WS-MONTH-B1.
020697*    MOVE I-DAY   TO WS-DAY-B1.
020697*    MOVE I-YEAR  TO WS-YEAR-B1.
020697*
020697*    MOVE PE-DAY-B2 TO DAY-OUT.
020697*    PERFORM DAY-REVERSE.
020697*    MOVE I-MONTH TO WS-MONTH-B2.
020697*    MOVE I-DAY   TO WS-DAY-B2.
020697*    MOVE I-YEAR  TO WS-YEAR-B2.
020697*
020697*    MOVE PE-DAY-E1 TO DAY-OUT.
020697*    PERFORM DAY-REVERSE.
020697*    MOVE I-MONTH TO WS-MONTH-E1.
020697*    MOVE I-DAY   TO WS-DAY-E1.
020697*    MOVE I-YEAR  TO WS-YEAR-E1.
020697*
020697*    MOVE PE-DAY-E2 TO DAY-OUT.
020697*    PERFORM DAY-REVERSE.
020697*    MOVE I-MONTH TO WS-MONTH-E2.
020697*    MOVE I-DAY   TO WS-DAY-E2.
020697*    MOVE I-YEAR  TO WS-YEAR-E2.

029900 GET-PERIOD-END-DATE-EXIT. EXIT.

028200 CALC-NET SECTION.
028200 CALC-NET-START.
028200     COMPUTE PYHD-NET-PAY = PYHD-TOTAL-AMT + PYHD-EIC-AMT -
028200       PYHD-TAX(1) - PYHD-TAX(2) - PYHD-TAX(3) -
070892       PYHD-TAX(4) - PYHD-TAX(5) - PYHD-TAX(6) -
028200       PYHD-DED(1) - PYHD-DED(2) - PYHD-DED(3) -
028200       PYHD-DED(4) - PYHD-DED(5) - PYHD-DED(6) -
028200       PYHD-DED(7) - PYHD-DED(8) - PYHD-DED(9) - PYHD-DED(10) -
031893       PYHD-DED(11) - PYHD-DED(12) - PYHD-DED(13) -
031893       PYHD-DED(14) - PYHD-DED(15) - PYHD-DED(16) -
031893       PYHD-DED(17) - PYHD-DED(18) - PYHD-DED(19) -
090492       PYHD-DED(20).
112590     ADD S125-RETURN-DEDUCTIONS TO PYHD-NET-PAY.
028200     IF PYHD-NET-PAY < 0
028200         DISPLAY SCR-py100-cbl-1478-24.
028200
028200 CALC-NET-EXIT. EXIT.

       MOVE-AMOUNTS SECTION.
       MOVE-AMOUNTS-START.
           IF I < 7
               MOVE YTD-TAX(I) TO PYHD-YTD-TAX(I).
           MOVE YTD-DED(I) TO PYHD-YTD-DED(I).

       MOVE-AMOUNTS-EXIT. EXIT.

028200 CALCULATE-TAX SECTION.
028200 CALCULATE-TAX-START.
028200     MOVE 0 TO TAX-AMT.
010502*    IF PROCESSING-S106-YES
010502*       COMPUTE TEMP-GROSS ROUNDED = ANNUAL-GROSS +
010502*               (WS-S106-DED-AMT * PER-FACT)
010502*    ELSE
028200        MOVE ANNUAL-GROSS TO TEMP-GROSS.
028200     PERFORM READ-TAXRF.
028200     IF TAXR-PAGE-CD = 4
028200        PERFORM DISABILITY-CALC
028200        GO TO CALCULATE-TAX-DONE
028200     ELSE
           IF EMPS-EXEMPT-CD NOT = 1
028200        PERFORM STANDARD-DED-CALC
028200        PERFORM PERSONAL-EXEMPT-CALC
028200        PERFORM BRACKET-CALC
028200        PERFORM TAX-CREDIT-CALC.
028200     COMPUTE TAX-AMT ROUNDED = TAX-AMT +
028200       (EMPS-EXTRA-AMT * PER-FACT).
028200     COMPUTE TAX-AMT ROUNDED = TAX-AMT +
028200       (ANNUAL-GROSS * EMPS-EXTRA-PCT / 100.00000) ON SIZE ERROR 
             MOVE ZERO TO TAX-AMT END-COMPUTE.
028200     IF TAX-AMT < TAXR-MIN-TAX
028200         MOVE TAXR-MIN-TAX TO TAX-AMT.
028200 CALCULATE-TAX-DONE.
028200     IF TAXR-PAGE-CD NOT = 4 OR
028200       (TAXR-PAGE-CD = 4 AND TAXR-DISAB-TYPE-CD = 1)
028200         COMPUTE TAX-AMT ROUNDED = TAX-AMT / PER-FACT 
               ON SIZE ERROR MOVE ZERO TO TAX-AMT END-COMPUTE.
028200     IF TAX-AMT > REM-AMT
028200         MOVE REM-AMT TO TAX-AMT.
028200     SUBTRACT TAX-AMT FROM REM-AMT.
028200
028200 CALCULATE-TAX-EXIT. EXIT.

028200 DISABILITY-CALC SECTION.
028200 DISABILITY-CALC-START.
028200     IF TAXR-DISAB-TYPE-CD = 1
028200         COMPUTE TAX-AMT ROUNDED =
028200           TEMP-GROSS * TAXR-DISAB-PCT / 100.00000 ON SIZE ERROR 
                 MOVE ZERO TO TAX-AMT END-COMPUTE
028200         IF TAX-AMT > TAXR-DISAB-LIMIT
028200             MOVE TAXR-DISAB-LIMIT TO TAX-AMT.
028200     IF TAXR-DISAB-TYPE-CD = 2
028200         COMPUTE TAX-AMT ROUNDED =
028200           TAXABLE-GROSS * TAXR-DISAB-PCT / 100.00000 
                 ON SIZE ERROR MOVE ZERO TO TAX-AMT END-COMPUTE
028200         COMPUTE YTD-DISAB = EMPS-TAXES(1) + EMPS-TAXES(2) +
028200                EMPS-TAXES(3) + EMPS-TAXES(4)
028200         IF TAX-AMT + YTD-DISAB > TAXR-DISAB-LIMIT
028200             COMPUTE TAX-AMT = TAXR-DISAB-LIMIT - YTD-DISAB.
028200
028200 DISABILITY-CALC-EXIT. EXIT.

028200 STANDARD-DED-CALC SECTION.
028200 STANDARD-DED-CALC-START.
028200     MOVE 0 TO STDED-AMT.
028200* CALC FIT AMT FOR PRIOR DEDUCTION
028200     IF TAXR-STDED-FIT-PCT = 0
028200         MOVE ANNUAL-FIT TO STDED-FIT-DED
028200     ELSE COMPUTE STDED-FIT-DED ROUNDED =
028200           ANNUAL-FIT * TAXR-STDED-FIT-PCT / 100.00000 
                 ON SIZE ERROR MOVE ZERO TO STDED-FIT-DED END-COMPUTE.
028200     IF STDED-FIT-DED > TAXR-FIT-MAX
028200         MOVE TAXR-FIT-MAX TO STDED-FIT-DED.
028200* CALC FICA AMT FOR PRIOR DEDUCTION
028200     COMPUTE STDED-FICA-DED ROUNDED = PYHD-TAX(2) * PER-FACT.
028200     IF STDED-FICA-DED > TAXR-FICA-MAX
028200         MOVE TAXR-FICA-MAX TO STDED-FICA-DED.
028200     MOVE ANNUAL-GROSS TO STDED-GROSS.
028200* SUBTRACT THEM IF BEFORE
028200     IF TAXR-FIT-DEDUCT-CD = 2 OR TAXR-FIT-DEDUCT-CD = 4
028200         SUBTRACT STDED-FIT-DED FROM STDED-GROSS.
028200     IF TAXR-FICA-DEDUCT-CD = 2 OR TAXR-FICA-DEDUCT-CD = 4
028200         SUBTRACT STDED-FICA-DED FROM STDED-GROSS.
028200     IF TAXR-STDED-CD = 2
028200         GO TO STANDARD-DED-CALC-DONE.
028200* CALC STD DED
028200     COMPUTE STDED-AMT ROUNDED = STDED-GROSS *
028200       TAXR-STDED-PCT / 100.00000 ON SIZE ERROR MOVE ZERO TO 
             STDED-AMT END-COMPUTE.
028200     IF STDED-AMT > TAXR-STDED-MAX
028200         MOVE TAXR-STDED-MAX TO STDED-AMT.
028200     IF STDED-AMT < TAXR-STDED-MIN
028200         MOVE TAXR-STDED-MIN TO STDED-AMT.
028200     ADD TAXR-STDED-ADDL TO STDED-AMT.
028200 STANDARD-DED-CALC-DONE.
028200     SUBTRACT STDED-AMT FROM TEMP-GROSS.
028200* SUBTRACT THEM IF AFTER
028200     IF TAXR-FIT-DEDUCT-CD = 3 OR TAXR-FIT-DEDUCT-CD = 4
028200         SUBTRACT STDED-FIT-DED FROM TEMP-GROSS.
028200     IF TAXR-FICA-DEDUCT-CD = 3 OR TAXR-FICA-DEDUCT-CD = 4
028200         SUBTRACT STDED-FICA-DED FROM TEMP-GROSS.
028200     IF TEMP-GROSS < 0
028200         MOVE ZEROES TO TEMP-GROSS.

028200 STANDARD-DED-CALC-EXIT. EXIT.

120693 LEVY-EXEMPT-CALC SECTION.
028200 LEVY-EXEMPT-CALC-START.
028200     MOVE 0 TO PE-AMT.
028200     PERFORM LEVY-EXEMPT-CALC-LOOP
120693       VARYING I FROM 1 BY 1 UNTIL I > 3.
028200     SUBTRACT PE-AMT FROM TEMP-GROSS.
028200     IF TEMP-GROSS < 0
028200         MOVE ZEROES TO TEMP-GROSS.
028200     GO TO LEVY-EXEMPT-CALC-EXIT.
028200
028200 LEVY-EXEMPT-CALC-LOOP.
120693     IF TAXR-ALLOW-CD(I) = 1
028200         COMPUTE PE-AMT ROUNDED = PE-AMT +
120693           TAXR-ALLOW-AMT(I) * EMPL-FED-ALLOW.
120693 LEVY-EXEMPT-CALC-EXIT. EXIT.

028200 PERSONAL-EXEMPT-CALC SECTION.
028200 PERSONAL-EXEMPT-CALC-START.
028200     MOVE 0 TO PE-AMT.
028200     PERFORM PERSONAL-EXEMPT-CALC-LOOP
028200       VARYING I FROM 1 BY 1 UNTIL I > 3.
028200     SUBTRACT PE-AMT FROM TEMP-GROSS.
028200     IF TEMP-GROSS < 0
028200         MOVE ZEROES TO TEMP-GROSS.
028200     GO TO PERSONAL-EXEMPT-CALC-EXIT.
028200
028200 PERSONAL-EXEMPT-CALC-LOOP.
028200     IF EMPS-ALLOW-CD(I) > 0
028200         COMPUTE PE-AMT ROUNDED = PE-AMT +
028200           TAXR-ALLOW-AMT(I) * EMPS-ALLOW-CD(I).
028200 PERSONAL-EXEMPT-CALC-EXIT. EXIT.

028200 BRACKET-CALC SECTION.
028200 BRACKET-CALC-START.
028200     IF TEMP-GROSS < 0
028200         GO TO BRACKET-CALC-EXIT.
028200     GO TO CALC-TYPE1, CALC-TYPE2, CALC-TYPE3, CALC-TYPE4,
028200       CALC-TYPE5 DEPENDING ON TAXR-CALC-TYPE-CD.
028200 BRACKET-CALC-RETURN.
028200
028200     GO TO BRACKET-CALC-EXIT.
028200
028200 CALC-TYPE1.
028200     MOVE 0 TO LOW-BRACKET.
028200     PERFORM CALC-TYPE1-LOOP VARYING I FROM 1 BY 1
028200       UNTIL TEMP-GROSS < TAXR-BRACKET-AMT(I).
028200     PERFORM CALC-TYPE1-LOOP.
028200     GO TO BRACKET-CALC-RETURN.
028200
028200 CALC-TYPE1-LOOP.
028200     IF I > 1
028200         COMPUTE J = I - 1
028200         MOVE TAXR-BRACKET-AMT(J) TO LOW-BRACKET.
028200     IF TEMP-GROSS > TAXR-BRACKET-AMT(I)
028200         COMPUTE SPREAD-AMT = TAXR-BRACKET-AMT(I) - LOW-BRACKET
028200     ELSE COMPUTE SPREAD-AMT = TEMP-GROSS - LOW-BRACKET.
028200     COMPUTE TAX-AMT ROUNDED = TAX-AMT +
028200           SPREAD-AMT * TAXR-BRACKET-PCT(I) / 100.00000 
                 ON SIZE ERROR MOVE ZERO TO TAX-AMT END-COMPUTE.
028200
028200 CALC-TYPE2.
028200     MOVE 0 TO LOW-BRACKET.
028200     PERFORM CALC-TYPE2-LOOP VARYING I FROM 1 BY 1
028200       UNTIL ANNUAL-FIT < TAXR-BRACKET-AMT(I).
028200     PERFORM CALC-TYPE2-LOOP.
028200     GO TO BRACKET-CALC-RETURN.
028200
028200 CALC-TYPE2-LOOP.
028200     IF I > 1
028200         COMPUTE J = I - 1
028200         MOVE TAXR-BRACKET-AMT(J) TO LOW-BRACKET.
028200     IF ANNUAL-FIT > TAXR-BRACKET-AMT(I)
028200         COMPUTE SPREAD-AMT = TAXR-BRACKET-AMT(I) - LOW-BRACKET
028200     ELSE COMPUTE SPREAD-AMT = ANNUAL-FIT - LOW-BRACKET.
028200     COMPUTE TAX-AMT ROUNDED = TAX-AMT +
028200           SPREAD-AMT * TAXR-BRACKET-PCT(I) / 100.00000 
                 ON SIZE ERROR MOVE ZERO TO TAX-AMT END-COMPUTE.
028200
028200 CALC-TYPE3.
028200     IF ANNUAL-GROSS < TAXR-BRACKET-AMT(20)
028200         MOVE ANNUAL-GROSS TO WH-BASE
028200     ELSE MOVE TAXR-BRACKET-AMT(20) TO WH-BASE.
028200     COMPUTE WH-BASE ROUNDED =
028200       WH-BASE * TAXR-BRACKET-PCT(20) / 100.00000 ON SIZE ERROR 
             MOVE ZERO TO WH-BASE END-COMPUTE.
028200     COMPUTE WH-BASE ROUNDED = WH-BASE -
028200       (ANNUAL-GROSS - TEMP-GROSS).
028200* REGULAR BRACKETS
028200     MOVE 0 TO LOW-BRACKET.
028200     PERFORM CALC-TYPE3-LOOP VARYING I FROM 1 BY 1
028200       UNTIL WH-BASE < TAXR-BRACKET-AMT(I).
028200     PERFORM CALC-TYPE3-LOOP.
028200     IF ANNUAL-GROSS > TAXR-BRACKET-AMT(20)
028200         COMPUTE TAX-AMT ROUNDED = TAX-AMT + ((ANNUAL-GROSS
028200          - TAXR-BRACKET-AMT(20)) * TAXR-BRACKET-PCT(19) / 
                100.00000) ON SIZE ERROR MOVE ZERO TO TAX-AMT 
                END-COMPUTE.
028200     GO TO BRACKET-CALC-RETURN.
028200
028200 CALC-TYPE3-LOOP.
028200     IF I > 1
028200         COMPUTE J = I - 1
028200         MOVE TAXR-BRACKET-AMT(J) TO LOW-BRACKET.
028200     IF WH-BASE > TAXR-BRACKET-AMT(I)
028200         COMPUTE SPREAD-AMT = TAXR-BRACKET-AMT(I) - LOW-BRACKET
028200     ELSE COMPUTE SPREAD-AMT = WH-BASE - LOW-BRACKET.
028200     COMPUTE TAX-AMT ROUNDED = TAX-AMT +
028200           SPREAD-AMT * TAXR-BRACKET-PCT(I) / 100.00000 
                 ON SIZE ERROR MOVE ZERO TO TAX-AMT END-COMPUTE.
028200
028200 CALC-TYPE4.
028200     GO TO BRACKET-CALC-RETURN.
028200 CALC-TYPE5.
028200     GO TO BRACKET-CALC-RETURN.
028200 BRACKET-CALC-EXIT. EXIT.

028200 TAX-CREDIT-CALC SECTION.
028200 TAX-CREDIT-CALC-START.
028200     MOVE 0 TO TC-AMT.
028200     PERFORM TAX-CREDIT-CALC-LOOP
028200       VARYING I FROM 4 BY 1 UNTIL I > 6.
028200     SUBTRACT TC-AMT FROM TAX-AMT.
028200     IF TAX-AMT < 0
028200         MOVE ZEROES TO TAX-AMT.
028200     GO TO TAX-CREDIT-CALC-EXIT.
028200
028200 TAX-CREDIT-CALC-LOOP.
028200     IF EMPS-ALLOW-CD(I) > 0
028200         COMPUTE TC-AMT ROUNDED = TC-AMT +
028200           TAXR-ALLOW-AMT(I) * EMPS-ALLOW-CD(I).
028200
028200 TAX-CREDIT-CALC-EXIT. EXIT.
028200
122396 CREATE-401K-REC SECTION.
122396 CREATE-401K-REC-START.
021206     PERFORM INIT-401K-FILLER
122396     MOVE ZERO          TO 401K-FILLER
122396     MOVE EMPL-SSNO     TO 401K-EMPL-SSNO.
080100     MOVE PYHD-EMPL-NAME TO 401K-EMPL-NAME.
122396     IF INACTIVE-EMPL OR PURGE-EMPL
122396        MOVE 753        TO 401K-EMPL-STATUS-CD
           ELSE
122396        MOVE 751        TO 401K-EMPL-STATUS-CD.
122396     MOVE EMPL-ADDR     TO 401K-EMPL-ADDR1.
122396     MOVE SPACES        TO 401K-EMPL-ADDR2.
122396     MOVE EMPL-CITY     TO 401K-EMPL-CITY.
122396     MOVE EMPL-STATE    TO 401K-EMPL-STATE.
122396     MOVE EMPL-ZIP      TO 401K-EMPL-ZIP.
122396     MOVE EMPL-PLAN-ELIGIBLE-DATE TO DATE-IN.
122396     PERFORM DATE-CHECK THRU DATE-CHECK-EXIT.
122396     STRING J-MONTH     DELIMITED BY SIZE
122396            J-DAY       DELIMITED BY SIZE
122396            J-YEAR      DELIMITED BY SIZE
122396            INTO 401K-EMPL-ELIGIBLE-DATE.
021606     PERFORM DATE-CONVERT THRU DATE-CONVERT-EXIT.
021606     MOVE DATE-OUT-11 TO 401K-EMPL-ELIGIBLE-DATE.
           IF NOT INACTIVE-EMPL AND NOT PURGE-EMPL
              IF TODAYS-DAYS < JULIAN-DAYS
                 MOVE 757         TO 401K-EMPL-STATUS-CD
              ELSE
                 COMPUTE WS-JUNK = TODAYS-DAYS - JULIAN-DAYS
                 IF WS-JUNK < 15
                    MOVE 760      TO 401K-EMPL-STATUS-CD.

122396     MOVE EMPL-HIRE-DATE TO DATE-IN.
122396     PERFORM DATE-CHECK THRU DATE-CHECK-EXIT.
122396     STRING J-MONTH     DELIMITED BY SIZE
122396            J-DAY       DELIMITED BY SIZE
122396            J-YEAR      DELIMITED BY SIZE
122396            INTO 401K-EMPL-HIRE-DATE.
021606     PERFORM DATE-CONVERT THRU DATE-CONVERT-EXIT.
021606     MOVE DATE-OUT-11 TO 401K-EMPL-HIRE-DATE.

122396     MOVE EMPL-TERM-DATE TO DATE-IN.
122396     PERFORM DATE-CHECK THRU DATE-CHECK-EXIT.
122396     STRING J-MONTH     DELIMITED BY SIZE
122396            J-DAY       DELIMITED BY SIZE
122396            J-YEAR      DELIMITED BY SIZE
122396            INTO 401K-EMPL-TERM-DATE.
021606     PERFORM DATE-CONVERT THRU DATE-CONVERT-EXIT.
021606     MOVE DATE-OUT-11 TO 401K-EMPL-TERM-DATE.
           IF TODAYS-DAYS < JULIAN-DAYS
              MOVE 753          TO 401K-EMPL-STATUS-CD.

122396     MOVE EMPL-BIRTH-DATE TO DATE-IN.
122396     PERFORM DATE-CHECK THRU DATE-CHECK-EXIT.
122396     STRING J-MONTH     DELIMITED BY SIZE
122396            J-DAY       DELIMITED BY SIZE
122396            J-YEAR      DELIMITED BY SIZE
122396            INTO 401K-EMPL-BIRTH-DATE.
021606     PERFORM DATE-CONVERT THRU DATE-CONVERT-EXIT.
021606     MOVE DATE-OUT-11 TO 401K-EMPL-BIRTH-DATE.

           MOVE PYHD-TOTAL-HR     TO 401K-EMPL-CURRENT-HRS.
           COMPUTE WS-TEMP-AMT ROUNDED =
                   PYHD-TOTAL-AMT - PYHD-FED-401K-DED.
           MOVE WS-TEMP-AMT       TO 401K-EMPL-TAXABLE-WAGES.
           MOVE PYHD-TOTAL-AMT    TO 401K-EMPL-GROSS-WAGES.
           ADD WS-TEMP-AMT        TO TOT-401K-TAXABLE-WAGES.
           ADD PYHD-TOTAL-AMT     TO TOT-401K-GROSS-WAGES.

           IF PYHD-FED-401K-DED = ZERO
              IF 401K-EMPL-STATUS-CD NOT = 753 AND
                 401K-EMPL-STATUS-CD NOT = 757
                    MOVE 752 TO 401K-EMPL-STATUS-CD.

           MOVE PYHD-FED-401K-DED TO 401K-EMPL-401K-DED.
           IF PYHD-FED-401K-DED = ZERO
              MOVE ZERO TO 401K-EMPL-401K-MATCH
              MOVE ZERO TO WS-TEMP-AMT
           ELSE
              COMPUTE WS-TEMP-AMT ROUNDED = PYHD-TAXABLE-AMT * .06
              IF WS-TEMP-AMT > PYHD-FED-401K-DED
                 COMPUTE WS-TEMP-AMT ROUNDED =
                         PYHD-FED-401K-DED * .50
                 MOVE WS-TEMP-AMT TO 401K-EMPL-401K-MATCH
              ELSE
                 COMPUTE WS-TEMP-AMT ROUNDED =
                         WS-TEMP-AMT * .50
                 MOVE WS-TEMP-AMT TO 401K-EMPL-401K-MATCH.
           ADD PYHD-FED-401K-DED  TO TOT-401K-EMPL-401K-DED.
           ADD WS-TEMP-AMT        TO TOT-401K-EMPL-401K-MATCH.

           MOVE ZERO              TO 401K-EMPL-LOAN-NUMBER.
           MOVE ZERO              TO 401K-EMPL-LOAN-PAYMENT.
050594     PERFORM WRITE-SKILF.

      *-- PROCESS LOAN RE-PAYMENT RECORDS --*
           MOVE ZERO TO 401K-EMPL-TAXABLE-WAGES, 401K-EMPL-GROSS-WAGES.
           MOVE ZERO TO 401K-EMPL-401K-DED, 401K-EMPL-401K-MATCH.
           MOVE ZERO TO 401K-EMPL-LOAN-PAYMENT.
           IF PYHD-DED(15) NOT = ZERO
              MOVE 15           TO 401K-EMPL-LOAN-NUMBER
              MOVE PYHD-DED(15) TO 401K-EMPL-LOAN-PAYMENT
              ADD  PYHD-DED(15) TO TOT-401K-EMPL-LOAN-PAYMENT
050594        PERFORM WRITE-SKILF.
           IF PYHD-DED(16) NOT = ZERO
              MOVE 16           TO 401K-EMPL-LOAN-NUMBER
              MOVE PYHD-DED(16) TO 401K-EMPL-LOAN-PAYMENT
              ADD  PYHD-DED(16) TO TOT-401K-EMPL-LOAN-PAYMENT
050594        PERFORM WRITE-SKILF.
           IF PYHD-DED(17) NOT = ZERO
              MOVE 17           TO 401K-EMPL-LOAN-NUMBER
              MOVE PYHD-DED(17) TO 401K-EMPL-LOAN-PAYMENT
              ADD  PYHD-DED(17) TO TOT-401K-EMPL-LOAN-PAYMENT
050594        PERFORM WRITE-SKILF.
           IF PYHD-DED(18) NOT = ZERO
              MOVE 18           TO 401K-EMPL-LOAN-NUMBER
              MOVE PYHD-DED(18) TO 401K-EMPL-LOAN-PAYMENT
              ADD  PYHD-DED(18) TO TOT-401K-EMPL-LOAN-PAYMENT
050594        PERFORM WRITE-SKILF.

122396 CREATE-401K-REC-EXIT. EXIT.

012810 CREATE-401K-XLS SECTION.
012810 CREATE-401K-XLS-BEGIN.
012810     
012810 CREATE-401K-XLS-EXIT. EXIT.

010602 ACCRUE-VAC SECTION.
010602 ACCRUE-VAC-BEGIN.
           MOVE ZERO TO PYHD-VAC-ACCRUED
           PERFORM COMPUTE-PAID-HOURS.
           IF EMPL-EARNED-VAC-RATE = ZERO 
              GO TO ACCRUE-VAC-EXIT.
           MOVE EMPL-HIRE-DATE TO DATE-IN.
           PERFORM CVT-TO-JULIAN THRU CVT-TO-JULIAN-EXIT.
           COMPUTE JULIAN-DAYS = JULIAN-DAYS + EMPL-VAC-WAITING.
           IF JULIAN-DAYS > PE-DAY
              MOVE ZERO TO PYHD-VAC-ACCRUED
              GO TO ACCRUE-VAC-EXIT.
           COMPUTE PYHD-VAC-ACCRUED ROUNDED =
               WS-PAID-HOURS * EMPL-EARNED-VAC-RATE.
010602 ACCRUE-VAC-EXIT. EXIT.

010602 ACCRUE-SICK SECTION.
010602 ACCRUE-SICK-BEGIN.
           MOVE ZERO TO PYHD-SICK-ACCRUED
           PERFORM COMPUTE-PAID-HOURS.
           IF EMPL-EARNED-SICK-RATE = ZERO 
              GO TO ACCRUE-SICK-EXIT.
           MOVE EMPL-HIRE-DATE TO DATE-IN.
           PERFORM CVT-TO-JULIAN THRU CVT-TO-JULIAN-EXIT.
           COMPUTE JULIAN-DAYS = JULIAN-DAYS + EMPL-SICK-WAITING.
           IF JULIAN-DAYS > PE-DAY
              MOVE ZERO TO PYHD-SICK-ACCRUED
              GO TO ACCRUE-SICK-EXIT.
           COMPUTE PYHD-SICK-ACCRUED ROUNDED =
               WS-PAID-HOURS * EMPL-EARNED-SICK-RATE.
010602 ACCRUE-SICK-EXIT. EXIT.

121798 CREATE-AGMC-REC SECTION.
122396 CREATE-AGMC-REC-START.
122396     MOVE SPACES        TO AGMC-REC.
           MOVE ZEROES        TO AGMC-GROSS-SALARY, AGMC-EXEMPTIONS,
                AGMC-PRE-TAX-CONT-PERC, AGMC-PRE-TAX-CONT-DOL,
                AGMC-AFTER-TAX-CONT-PERC, AGMC-AFTER-TAX-CONT-DOL,
012111*         AGMC-CONTRIBUTION-1, AGMC-C2, AGMC-C3,
012111          AGMC-CONTRIBUTION-1, AGMC-ROTH-IRA, AGMC-C3,
                AGMC-C4, AGMC-C5, AGMC-C6, AGMC-C7, AGMC-C8,
                AGMC-YTD-HOURS, AGMC-YTD-TOT-COMPENSATION,
                AGMC-YTD-PLAN-COMPENSATION, AGMC-YTD-PRE-ENTRY-COMP,
                AGMC-PRIOR-YEAR-COMP, AGMC-S125-CONT,
                AGMC-OWNERSHIP-PERC.
122396     MOVE EMPL-SSNO     TO AGMC-SSN.
080100*    MOVE EMPL-NAME     TO AGMC-NAME.
080100     MOVE PYHD-EMPL-NAME TO AGMC-NAME.
122396     MOVE EMPL-ADDR     TO AGMC-ADDR1.
122396     MOVE SPACES        TO AGMC-ADDR2.
122396     MOVE EMPL-CITY     TO AGMC-CITY.
122396     MOVE EMPL-STATE    TO AGMC-STATE.
122396     MOVE EMPL-ZIP      TO AGMC-ZIP.
           MOVE EMPL-PHONE    TO AGMC-HOME-PHONE.
           MOVE EMPL-WORK-PHONE TO AGMC-WORK-PHONE.
           MOVE EMPL-WORK-EXT   TO AGMC-WORK-EXT.
122396     MOVE EMPL-BIRTH-DATE TO DATE-IN.
122396     PERFORM DATE-CHECK THRU DATE-CHECK-EXIT.
122396     STRING J-MONTH     DELIMITED BY SIZE
                  "/"         DELIMITED BY SIZE
122396            J-DAY       DELIMITED BY SIZE
                  "/"         DELIMITED BY SIZE
122396            J-YEAR      DELIMITED BY SIZE
122396            INTO AGMC-BIRTH-DATE.

122396     MOVE EMPL-HIRE-DATE TO DATE-IN.
122396     PERFORM DATE-CHECK THRU DATE-CHECK-EXIT.
122396     STRING J-MONTH     DELIMITED BY SIZE
                  "/"         DELIMITED BY SIZE
122396            J-DAY       DELIMITED BY SIZE
                  "/"         DELIMITED BY SIZE
122396            J-YEAR      DELIMITED BY SIZE
122396            INTO AGMC-HIRE-DATE.

122396     MOVE EMPL-TERM-DATE TO DATE-IN.
122396     PERFORM DATE-CHECK THRU DATE-CHECK-EXIT.
122396     STRING J-MONTH     DELIMITED BY SIZE
                  "/"         DELIMITED BY SIZE
122396            J-DAY       DELIMITED BY SIZE
                  "/"         DELIMITED BY SIZE
122396            J-YEAR      DELIMITED BY SIZE
                  "/"         DELIMITED BY SIZE
122396            INTO AGMC-TERMINATION-DATE.

           MOVE SPACES TO AGMC-REHIRE-DATE.
121499*    MOVE EMPD-AMT-PCT(5)         TO AGMC-PRE-TAX-CONT-PERC.
121499     MOVE EMPD-AMT-PCT(9)         TO AGMC-PRE-TAX-CONT-PERC.

122396     MOVE PE-DATE TO DATE-IN.
122396     PERFORM DATE-CHECK THRU DATE-CHECK-EXIT.
122396     STRING J-MONTH     DELIMITED BY SIZE
                  "/"         DELIMITED BY SIZE
122396            J-DAY       DELIMITED BY SIZE
                  "/"         DELIMITED BY SIZE
122396            J-YEAR      DELIMITED BY SIZE
122396            INTO AGMC-PERIOD-END-DATE.

121499*    MOVE PYHD-DED(5)             TO AGMC-CONTRIBUTION-1.
121499     MOVE PYHD-DED(9)             TO AGMC-CONTRIBUTION-1.
012111     MOVE PYHD-DED(14)            TO AGMC-ROTH-IRA.

122396     MOVE EMPL-PLAN-ELIGIBLE-DATE TO DATE-IN.
122396     PERFORM DATE-CHECK THRU DATE-CHECK-EXIT.
122396     STRING J-MONTH     DELIMITED BY SIZE
                  "/"         DELIMITED BY SIZE
122396            J-DAY       DELIMITED BY SIZE
                  "/"         DELIMITED BY SIZE
122396            J-YEAR      DELIMITED BY SIZE
122396            INTO AGMC-PARTICIPATION-DATE.

           COMPUTE WS-TOTAL-HRS ROUNDED = EMPL-REG-HOURS(1) +
                   EMPL-REG-HOURS(2) + EMPL-REG-HOURS(3) +
                   EMPL-REG-HOURS(4).
           MOVE WS-TOTAL-HRS      TO AGMC-YTD-HOURS.

           COMPUTE WS-TEMP-AMT ROUNDED =
                   EMPL-TAX-WAGES(1) + EMPL-TAX-WAGES(2) +
                   EMPL-TAX-WAGES(3) + EMPL-TAX-WAGES(4).
           MOVE WS-TEMP-AMT       TO AGMC-YTD-TOT-COMPENSATION.
           MOVE ZERO              TO AGMC-YTD-PLAN-COMPENSATION.
           MOVE ZERO              TO AGMC-PRIOR-YEAR-COMP.
050594     PERFORM WRITE-SKILF.
122396 CREATE-AGMC-REC-EXIT. EXIT.

044800     COPY "CONTROL.SR".

045000 SUBROUTINE SECTION.
045200 PGM-INIT.
045300     PERFORM CONTROL-INIT.
011190     IF NOT PY-YES
011190        DISPLAY SCR-py100-cbl-1951-23  
011190        GO TO EXIT-RUN.
122396     ACCEPT DATE-ACCP FROM DATE.
122396     MOVE A-YEAR  TO I-YEAR.
122396     MOVE A-MONTH TO I-MONTH.
122396     MOVE A-DAY   TO I-DAY.
122306     PERFORM CVT-TO-JULIAN THRU CVT-TO-JULIAN-EXIT.
122396     MOVE JULIAN-DAYS TO TODAYS-DAYS.
047300
PROFIT     COPY "SCRNINIT.SR".
051503     COPY "WAIT.SR".
053100
028200 ZERO-CHECK-TOTALS.
           IF PYHD-CHECK-CD NOT = 3
               MOVE 0 TO PYHD-DED(I).
042197     IF PYHD-CHECK-CD NOT = 3
090992       IF I NOT > 9
               MOVE 0 TO PYHD-AMT(I), PYHD-HR(I).
042197     IF PYHD-CHECK-CD NOT = 3
020797       IF I NOT > 6
               MOVE ZERO TO PYHD-TAX(I), PYHD-YTD-TAX(I).
028200
028100 SET-TAKE-CODES.
           COMPUTE JJ = I + 10.
           COMPUTE JJJ = I + 20.
           MOVE OPTION OF SPEC-1(I) TO TAKE-CD(I).
           MOVE OPTION OF SPEC-1(JJ) TO TAKE-CD(JJ).
           MOVE OPTION OF SPEC-1(JJJ) TO TAKE-CD(JJJ).

031893 SET-TAKE-CODES-B.
031893     COMPUTE K  = I + 20
031893     COMPUTE JJ = I + 30.
031893     COMPUTE JJJ = I + 40.
031893     MOVE OPTION OF SPEC-1(K) TO TAKE-CD(K).
031893     MOVE OPTION OF SPEC-1(JJ) TO TAKE-CD(JJ).
031893     MOVE OPTION OF SPEC-1(JJJ) TO TAKE-CD(JJJ).
031893* INDEXED FROM SPEC-1: ARRAY ELEMENTS 31-60, I FROM 11 TO 20
028100
010602 COMPUTE-PAID-HOURS.
010602     MOVE ZERO TO WS-PAID-HOURS.
091309*    ADD PYHD-HR(1)   TO WS-PAID-HOURS.
091309     ADD PYHD-HR(EXCN-REGULAR-CD)   TO WS-PAID-HOURS.
091309*    IF PYHD-HR(4) NOT ZERO
091309     IF PYHD-HR(EXCN-SICK-CD) NOT ZERO
091309*       IF PYHD-HR(4) > EMPL-SICK-HOURS-AVAIL
091309        IF PYHD-HR(EXCN-SICK-CD) > EMPL-SICK-HOURS-AVAIL
010602           COMPUTE WS-PAID-HOURS =
                       WS-PAID-HOURS + EMPL-SICK-HOURS-AVAIL
              ELSE
010602           COMPUTE WS-PAID-HOURS =
091309*                WS-PAID-HOURS + PYHD-HR(4).
091309                 WS-PAID-HOURS + PYHD-HR(EXCN-SICK-CD)
091309        END-IF
091309     END-IF.
091309*    IF PYHD-HR(5) NOT ZERO
091309     IF PYHD-HR(EXCN-VAC-CD) NOT ZERO
091309*       IF PYHD-HR(4) > EMPL-VAC-HOURS-AVAIL
091309        IF PYHD-HR(EXCN-VAC-CD) > EMPL-VAC-HOURS-AVAIL
010602           COMPUTE WS-PAID-HOURS =
                       WS-PAID-HOURS + EMPL-VAC-HOURS-AVAIL
              ELSE
010602           COMPUTE WS-PAID-HOURS =
091309*                WS-PAID-HOURS + PYHD-HR(5).
091309                 WS-PAID-HOURS + PYHD-HR(EXCN-VAC-CD)
091309        END-IF
091309     END-IF.
                 
021206 INIT-401K-FILLER.
           MOVE SPACES TO 401K-FILLER-01, 401K-FILLER-02, 401K-FILLER-03                   
                          401K-FILLER-04, 401K-FILLER-05, 401K-FILLER-06                   
                          401K-FILLER-07, 401K-FILLER-08, 401K-FILLER-09                   
                          401K-FILLER-10, 401K-FILLER-11, 401K-FILLER-12                   
                          401K-FILLER-13, 401K-FILLER-14, 401K-FILLER-15                   
                          401K-FILLER-16, 401K-FILLER-17, 401K-FILLER-18                   
                          401K-FILLER-19, 401K-FILLER-20.

012210     COPY "EXCEL.SR".
012210 CREATE-XLS-FILE.
012210        PERFORM CREATE-EXCEL.
090610        IF EXCEL-INSTALLED 
012210           PERFORM WRITE-EXCEL-HDRS1.

102909 WRITE-EXCEL-HDRS1.
012210     MOVE 1 TO W-COL.
012210     INVOKE OBJ-WKS "GET-Cells" USING W-ROW, W-COL
012210            RETURNING W-RANGE.
012210     MOVE SPACES TO WS-TXT.
012210     STRING "'" "PAY PERIOD ENDING DATE" DELIMITED BY SIZE
                  INTO WS-TXT.
012210     INVOKE W-RANGE "SET-Value" USING WS-TXT.
012210
012210     ADD 1 TO W-COL.
012210     INVOKE OBJ-WKS "GET-Cells" USING W-ROW, W-COL
012210            RETURNING W-RANGE.
012210     MOVE SPACES TO WS-TXT.
012210     STRING "'" "SSN" DELIMITED BY SIZE INTO WS-TXT.
012210     INVOKE W-RANGE "SET-Value" USING WS-TXT.
012210
012210     ADD  1 TO W-COL.
012210     INVOKE OBJ-WKS "GET-Cells" USING W-ROW, W-COL
012210            RETURNING W-RANGE.
012210     MOVE SPACES TO WS-TXT.
012210     STRING "'" "EMPL NBR"  DELIMITED BY SIZE INTO WS-TXT.
012210     INVOKE W-RANGE "SET-Value" USING WS-TXT.
012210
012210     ADD  1 TO W-COL.
012210     INVOKE OBJ-WKS "GET-Cells" USING W-ROW, W-COL
012210            RETURNING W-RANGE.
012210     MOVE SPACES TO WS-TXT.
012210     STRING "'" "LAST NAME"  DELIMITED BY SIZE
                  INTO WS-TXT.
012210     INVOKE W-RANGE "SET-Value" USING WS-TXT.
012210
012210     ADD  1 TO W-COL.
012210     INVOKE OBJ-WKS "GET-Cells" USING W-ROW, W-COL
012210            RETURNING W-RANGE.
012210     MOVE SPACES TO WS-TXT.
012210     STRING "'" "SUFFIX"  DELIMITED BY SIZE
                  INTO WS-TXT.
012210     INVOKE W-RANGE "SET-Value" USING WS-TXT.

012210     ADD  1 TO W-COL.
012210     INVOKE OBJ-WKS "GET-Cells" USING W-ROW, W-COL
012210            RETURNING W-RANGE.
012210     MOVE SPACES TO WS-TXT.
012210     STRING "'" "FIRST NAME"  DELIMITED BY SIZE
                  INTO WS-TXT.
012210     INVOKE W-RANGE "SET-Value" USING WS-TXT.
012210
012210     ADD  1 TO W-COL.
012210     INVOKE OBJ-WKS "GET-Cells" USING W-ROW, W-COL
012210            RETURNING W-RANGE.
012210     MOVE SPACES TO WS-TXT.
012210     STRING "'" "MIDDLE"  DELIMITED BY SIZE
                  INTO WS-TXT.
012210     INVOKE W-RANGE "SET-Value" USING WS-TXT.
012210
012210     ADD  1 TO W-COL.
012210     INVOKE OBJ-WKS "GET-Cells" USING W-ROW, W-COL
012210            RETURNING W-RANGE.
012210     MOVE SPACES TO WS-TXT.
012210     STRING "'" "BIRTH DATE"  DELIMITED BY SIZE 
                  INTO WS-TXT.
012210     INVOKE W-RANGE "SET-Value" USING WS-TXT.
012210
012210     ADD  1 TO W-COL.
012210     INVOKE OBJ-WKS "GET-Cells" USING W-ROW, W-COL
012210            RETURNING W-RANGE.
012210     MOVE SPACES TO WS-TXT.
012210     STRING "'" "HIRE DATE"  DELIMITED BY SIZE 
                  INTO WS-TXT.
012210     INVOKE W-RANGE "SET-Value" USING WS-TXT.
012210
012210     ADD  1 TO W-COL.
012210     INVOKE OBJ-WKS "GET-Cells" USING W-ROW, W-COL
012210            RETURNING W-RANGE.
012210     MOVE SPACES TO WS-TXT.
012210     STRING "'" "TERM. DATE"  DELIMITED BY SIZE 
                  INTO WS-TXT.
012210     INVOKE W-RANGE "SET-Value" USING WS-TXT.
012210
012210     ADD  1 TO W-COL.
012210     INVOKE OBJ-WKS "GET-Cells" USING W-ROW, W-COL
012210            RETURNING W-RANGE.
012210     MOVE SPACES TO WS-TXT.
012210     STRING "'" "TAXABLE WAGES     "  DELIMITED BY SIZE 
                  INTO WS-TXT.
012210     INVOKE W-RANGE "SET-Value" USING WS-TXT.
012210
012210     ADD  1 TO W-COL.
012210     INVOKE OBJ-WKS "GET-Cells" USING W-ROW, W-COL
012210            RETURNING W-RANGE.
012210     MOVE SPACES TO WS-TXT.
012210     STRING "'" "GROSS WAGES     "  DELIMITED BY SIZE 
                  INTO WS-TXT.
012210     INVOKE W-RANGE "SET-Value" USING WS-TXT.
012210
012210     ADD  1 TO W-COL.
012210     INVOKE OBJ-WKS "GET-Cells" USING W-ROW, W-COL
012210            RETURNING W-RANGE.
012210     MOVE SPACES TO WS-TXT.
012210     STRING "'" "HOURS WORKED"  DELIMITED BY SIZE 
                  INTO WS-TXT.
012210     INVOKE W-RANGE "SET-Value" USING WS-TXT.
012210
012210     ADD  1 TO W-COL.
012210     INVOKE OBJ-WKS "GET-Cells" USING W-ROW, W-COL
012210            RETURNING W-RANGE.
012210     MOVE SPACES TO WS-TXT.
012210     STRING "'" "401K CONTRIBUTION"  DELIMITED BY SIZE 
                  INTO WS-TXT.
012210     INVOKE W-RANGE "SET-Value" USING WS-TXT.
012210
012210     ADD  1 TO W-COL.
012210     INVOKE OBJ-WKS "GET-Cells" USING W-ROW, W-COL
012210            RETURNING W-RANGE.
012210     MOVE SPACES TO WS-TXT.
012210     STRING "'" "401K MATCH"  DELIMITED BY SIZE 
                  INTO WS-TXT.
012210     INVOKE W-RANGE "SET-Value" USING WS-TXT.
012210
012210     ADD  1 TO W-COL.
012210     INVOKE OBJ-WKS "GET-Cells" USING W-ROW, W-COL
012210            RETURNING W-RANGE.
012210     MOVE SPACES TO WS-TXT.
012210     STRING "'" "HIGHLY COMP."  DELIMITED BY SIZE 
                  INTO WS-TXT.
012210     INVOKE W-RANGE "SET-Value" USING WS-TXT.
012210
012210     ADD  1 TO W-ROW.
012210     MOVE 1 TO W-COL.

102909 WRITE-XLS-DATA.
      *-- WEEK ENDING DATE --*
            MOVE PE-DATE TO DATE-IN.
            PERFORM DATE-CONVERT THRU DATE-CONVERT-EXIT.
012210      MOVE 1 TO W-COL.
012210      INVOKE OBJ-WKS "GET-Cells" USING W-ROW, W-COL
012210             RETURNING W-RANGE.
012210      MOVE SPACES TO WS-TXT.
012210      STRING "'" DATE-OUT-11  DELIMITED BY SIZE INTO WS-TXT.
012210      INVOKE W-RANGE "SET-Value" USING WS-TXT.

      *-- SSN --*
012210      ADD  1 TO W-COL.
012210      INVOKE OBJ-WKS "GET-Cells" USING W-ROW, W-COL
012210             RETURNING W-RANGE.
012210      MOVE SPACES TO WS-TXT.
012210      STRING "'" EMPL-SSNO   DELIMITED BY SIZE INTO WS-TXT.
012210      INVOKE W-RANGE "SET-Value" USING WS-TXT.

      *-- EMPL # --*
012210      ADD  1 TO W-COL.
012210      INVOKE OBJ-WKS "GET-Cells" USING W-ROW, W-COL
012210             RETURNING W-RANGE.
012210      MOVE SPACES TO WS-TXT.
012210      STRING "'" EMPL-NUMBER DELIMITED BY SIZE INTO WS-TXT.
012210      INVOKE W-RANGE "SET-Value" USING WS-TXT.

      *-- LAST NAME  --*
012210      ADD  1 TO W-COL.
012210      INVOKE OBJ-WKS "GET-Cells" USING W-ROW, W-COL
012210             RETURNING W-RANGE.
012210      MOVE SPACES TO WS-TXT.
012210      STRING "'" EMPL-L-NAME   DELIMITED BY SIZE INTO WS-TXT.
012210      INVOKE W-RANGE "SET-Value" USING WS-TXT.

      *-- NAME SUFFIX --*
012210      ADD  1 TO W-COL.
012210      INVOKE OBJ-WKS "GET-Cells" USING W-ROW, W-COL
012210             RETURNING W-RANGE.
012210      MOVE SPACES TO WS-TXT.
012210      STRING "'" EMPL-SUFFIX   DELIMITED BY SIZE INTO WS-TXT.
012210      INVOKE W-RANGE "SET-Value" USING WS-TXT.

      *-- FIRST NAME  --*
012210      ADD  1 TO W-COL.
012210      INVOKE OBJ-WKS "GET-Cells" USING W-ROW, W-COL
012210             RETURNING W-RANGE.
012210      MOVE SPACES TO WS-TXT.
012210      STRING "'" EMPL-F-NAME   DELIMITED BY SIZE INTO WS-TXT.
012210      INVOKE W-RANGE "SET-Value" USING WS-TXT.

      *-- MIDDLE INIT  --*
012210      ADD  1 TO W-COL.
012210      INVOKE OBJ-WKS "GET-Cells" USING W-ROW, W-COL
012210             RETURNING W-RANGE.
012210      MOVE SPACES TO WS-TXT.
012210      STRING "'" EMPL-MI   DELIMITED BY SIZE INTO WS-TXT.
012210      INVOKE W-RANGE "SET-Value" USING WS-TXT.

      *-- BIRTH DATE --*
            MOVE EMPL-BIRTH-DATE TO DATE-IN.
            PERFORM DATE-CONVERT THRU DATE-CONVERT-EXIT.
012210      ADD  1 TO W-COL.
012210      INVOKE OBJ-WKS "GET-Cells" USING W-ROW, W-COL
012210             RETURNING W-RANGE.
012210      MOVE SPACES TO WS-TXT.
012210      STRING "'" DATE-OUT-11  DELIMITED BY SIZE INTO WS-TXT.
            IF EMPL-BIRTH-DATE NOT = ZERO
012210         INVOKE W-RANGE "SET-Value" USING WS-TXT.

      *-- HIRE DATE --*
            MOVE EMPL-HIRE-DATE TO DATE-IN.
            PERFORM DATE-CONVERT THRU DATE-CONVERT-EXIT.
012210      ADD  1 TO W-COL.
012210      INVOKE OBJ-WKS "GET-Cells" USING W-ROW, W-COL
012210             RETURNING W-RANGE.
012210      MOVE SPACES TO WS-TXT.
012210      STRING "'" DATE-OUT-11  DELIMITED BY SIZE INTO WS-TXT.
            IF EMPL-HIRE-DATE NOT = ZERO
012210         INVOKE W-RANGE "SET-Value" USING WS-TXT.

      *-- TERMINATION DATE --*
            MOVE EMPL-TERM-DATE TO DATE-IN.
            PERFORM DATE-CONVERT THRU DATE-CONVERT-EXIT.
012210      ADD  1 TO W-COL.
012210      INVOKE OBJ-WKS "GET-Cells" USING W-ROW, W-COL
012210             RETURNING W-RANGE.
012210      MOVE SPACES TO WS-TXT.
012210      STRING "'" DATE-OUT-11  DELIMITED BY SIZE INTO WS-TXT.
            IF EMPL-TERM-DATE NOT = ZERO
012210        INVOKE W-RANGE "SET-Value" USING WS-TXT.

      *-- TAXABLE --*
           COMPUTE WS-TEMP-AMT ROUNDED =
                   PYHD-TOTAL-AMT - PYHD-FED-401K-DED.
012210     ADD  1 TO W-COL.
012210     INVOKE OBJ-WKS "GET-Cells" USING W-ROW, W-COL
012210            RETURNING W-RANGE.
012210     COMPUTE W-FLOAT = WS-TEMP-AMT.
012210     INVOKE W-RANGE "SET-Value" USING W-FLOAT.

      *-- GROLL WAGES --*
012210     ADD  1 TO W-COL.
012210     INVOKE OBJ-WKS "GET-Cells" USING W-ROW, W-COL
012210            RETURNING W-RANGE.
012210     COMPUTE W-FLOAT = PYHD-TOTAL-AMT.
012210     INVOKE W-RANGE "SET-Value" USING W-FLOAT.

      *-- HOURS WORKED --*
012210      ADD  1 TO W-COL.
012210      INVOKE OBJ-WKS "GET-Cells" USING W-ROW, W-COL
012210             RETURNING W-RANGE.
012210      COMPUTE W-FLOAT = PYHD-TOTAL-HR
012210      INVOKE W-RANGE "SET-Value" USING W-FLOAT.

           IF PYHD-FED-401K-DED = ZERO
              MOVE ZERO TO WS-TEMP-AMT
           ELSE
              COMPUTE WS-TEMP-AMT ROUNDED = PYHD-TAXABLE-AMT * .06
              IF WS-TEMP-AMT > PYHD-FED-401K-DED
                 COMPUTE WS-TEMP-AMT ROUNDED =
                         PYHD-FED-401K-DED * .50
              ELSE
                 COMPUTE WS-TEMP-AMT ROUNDED =
                         WS-TEMP-AMT * .50.
      *-- 401K CONTRIBUTION --*
012210      ADD  1 TO W-COL.
012210      INVOKE OBJ-WKS "GET-Cells" USING W-ROW, W-COL
012210             RETURNING W-RANGE.
012210      COMPUTE W-FLOAT = PYHD-FED-401K-DED
012210      INVOKE W-RANGE "SET-Value" USING W-FLOAT.

      *-- 401K MATCH --*
012210      ADD  1 TO W-COL.
012210      INVOKE OBJ-WKS "GET-Cells" USING W-ROW, W-COL
012210             RETURNING W-RANGE.
012210      COMPUTE W-FLOAT = WS-TEMP-AMT
012210      INVOKE W-RANGE "SET-Value" USING W-FLOAT.

      *-- HIGHLY COMP --*
012210      ADD  1 TO W-COL.
012210      INVOKE OBJ-WKS "GET-Cells" USING W-ROW, W-COL
012210             RETURNING W-RANGE.
012210      MOVE SPACES TO WS-TXT.
            IF  HIGHLY-COMPENSATED
012210          STRING "YES"   DELIMITED BY SIZE INTO WS-TXT
            ELSE
012210          STRING "NO"    DELIMITED BY SIZE INTO WS-TXT.
012210      INVOKE W-RANGE "SET-Value" USING WS-TXT.

           ADD 1 TO W-ROW.


012210 GET-FILE.
012210     PERFORM SAVE-CURRENT-DRIVE.
012210     MOVE "Save File AS"
012210          TO WS-FILE-DIALOG-TITLE.
012210     MOVE "XLS|*.XLS|All Files|*.*" TO WS-FILE-MASK-LIST.
012210     MOVE POW-CDSAVE                TO WS-FILE-DIALOG-STYLE.
012210     ADD  POW-CDNOCHANGEDIR         TO WS-FILE-DIALOG-STYLE.
012210     MOVE "C:\401K.XLS"             TO WS-FILENAME.
012210     MOVE "FileSelect"              TO FORMNAME.
012210     MOVE "\PROFITS\FileRoutines"   TO DLLNAME.
012210     CALL "POWEROPENFORM" USING DLLNAME FORMNAME.
012210     CANCEL DLLNAME.
012210     PERFORM RESTORE-CURRENT-DRIVE.
012210     IF WS-FILE-RETURNVALUE = POW-TRUE
012210        MOVE WS-FILENAME TO W-WORKBOOK
012210     ELSE
012210        MOVE 3 TO FLAG.
012210     CALL "CHGDIR" USING MASTER-DIR, RETURN-CD.
012210     CALL "CHGDIR" USING SUB-DIR, RETURN-CD.
012210
012210 SAVE-CURRENT-DRIVE.
032309     CALL "PC_READ_DRIVE" USING CURR-DRIVE
032309                          RETURNING RETURN-VALUE.
 
012210 RESTORE-CURRENT-DRIVE.
032806     CALL "PC_SET_DRIVE"    USING CURR-DRIVE
032806                            RETURNING RETURN-VALUE.
071700 END-SUBROUTINE-EXIT. EXIT.

077700 ACCEPT-DATA-1 SECTION.
077800 ACCEPT-1.
077900     MOVE 0 TO FLAG.
078100     MOVE "1001000000" TO FKEYS.
           PERFORM STEST-py100-cbl-2014
078300     CALL "SCRN30" USING FLAG, FKEYS, STEST-SCRN-SPECS, HELP1,
078400       YES-NO, YES-NO, YES-NO, YES-NO, YES-NO, YES-NO,
             YES-NO, YES-NO, YES-NO, YES-NO,
             YES-NO, YES-NO, YES-NO, YES-NO, YES-NO, YES-NO,
             YES-NO, YES-NO, YES-NO, YES-NO,
             YES-NO, YES-NO, YES-NO, YES-NO, YES-NO, YES-NO,
             YES-NO, YES-NO, YES-NO, YES-NO
           PERFORM STEST-AFTER-CALL.
078900 ACCEPT-DATA-1-EXIT. EXIT.

077700 ACCEPT-DATA-1-B SECTION.
077800 ACCEPT-1-B.
077900     MOVE 0 TO FLAG.
078100     MOVE "1010000000" TO FKEYS.
           PERFORM STEST-py100-cbl-2027
078300     CALL "SCRN30" USING FLAG, FKEYS, STEST-SCRN-SPECS, HELP1,
078400       YES-NO, YES-NO, YES-NO, YES-NO, YES-NO, YES-NO,
             YES-NO, YES-NO, YES-NO, YES-NO,
             YES-NO, YES-NO, YES-NO, YES-NO, YES-NO, YES-NO,
             YES-NO, YES-NO, YES-NO, YES-NO,
             YES-NO, YES-NO, YES-NO, YES-NO, YES-NO, YES-NO,
             YES-NO, YES-NO, YES-NO, YES-NO
           PERFORM STEST-AFTER-CALL.
078900 ACCEPT-DATA-1-B-EXIT. EXIT.

077700 ACCEPT-DATA-2 SECTION.
077800 ACCEPT-2.
077900     MOVE 0 TO FLAG.
078100     MOVE "1010000000" TO FKEYS.
           PERFORM STEST-py100-cbl-2040
078300     CALL "SCRN09" USING FLAG, FKEYS, STEST-SCRN-SPECS, HELP2,
078400       YES-NO, YES-NO, YES-NO, YES-NO,
             YES-NO, YES-NO, YES-NO, YES-NO,
             YES-NO
           PERFORM STEST-AFTER-CALL.
078900 ACCEPT-DATA-2-EXIT. EXIT.

093100 DISPLAY-SCREENS SECTION.
094400 DISPLAY-SCREEN-1.
           
            DISPLAY SCR-py100-cbl-2048-20
            DISPLAY SCR-py100-cbl-2048-38
            DISPLAY SCR-py100-cbl-2048-49
            DISPLAY SCR-py100-cbl-2049-16
            DISPLAY SCR-py100-cbl-2049-27.
094500     MOVE "N" TO PROCESSING-DEDS-FLAG.
094500     PERFORM DISPLAY-DEDUCTIONS
094500       VARYING I FROM 1 BY 1 UNTIL I > 10.
094600
031893 DISPLAY-SCREEN-1-B.
           
            DISPLAY SCR-py100-cbl-2055-20
            DISPLAY SCR-py100-cbl-2055-38
            DISPLAY SCR-py100-cbl-2055-49
            DISPLAY SCR-py100-cbl-2056-16
            DISPLAY SCR-py100-cbl-2056-27.
031893     MOVE "N" TO PROCESSING-DEDS-FLAG.
031893     PERFORM DISPLAY-DEDUCTIONS-B
031893       VARYING I FROM 11 BY 1 UNTIL I > 20.

094500 DISPLAY-DEDUCTIONS.
094500     COMPUTE J = I + 10.
           COMPUTE JJ = I + 10.
           COMPUTE JJJ = I + 20.
           IF DEDC-METHOD-CD(I) NOT = 1
              
            DISPLAY SCR-py100-cbl-2066-23
            DISPLAY SCR-py100-cbl-2067-23
            DISPLAY SCR-py100-cbl-2068-23.
           IF DEDC-METHOD-CD(I) = 1
              MOVE "IP" TO ATTR1 OF SPEC-1(I)
              MOVE 2 TO OPTION OF SPEC-1(I)
              MOVE "IP" TO ATTR1 OF SPEC-1(JJ)
              MOVE 2 TO OPTION OF SPEC-1(JJ)
              MOVE "IP" TO ATTR1 OF SPEC-1(JJJ)
              MOVE 2 TO OPTION OF SPEC-1(JJJ)
           ELSE
              MOVE SPACES TO ATTR1 OF SPEC-1(I)
              MOVE SPACES TO ATTR1 OF SPEC-1(JJ)
              MOVE SPACES TO ATTR1 OF SPEC-1(JJJ)
              MOVE 1 TO OPTION OF SPEC-1(I)
              MOVE 1 TO OPTION OF SPEC-1(JJ)
              MOVE 1 TO OPTION OF SPEC-1(JJJ)
094500        MOVE "Y" TO PROCESSING-DEDS-FLAG.

094500 DISPLAY-DEDUCTIONS-B.
031893     COMPUTE K = I - 10.
031893     COMPUTE J = I + 0.
031893     COMPUTE JJ = I + 0.
031893     COMPUTE JJJ = I + 10.
           IF DEDC-METHOD-CD(I) NOT = 1
              
            DISPLAY SCR-py100-cbl-2091-23
            DISPLAY SCR-py100-cbl-2092-23
            DISPLAY SCR-py100-cbl-2093-23.
           IF DEDC-METHOD-CD(I) = 1
              MOVE "IP" TO ATTR1 OF SPEC-1B(K)
              MOVE 2 TO OPTION OF SPEC-1B(K)
              MOVE "IP" TO ATTR1 OF SPEC-1B(JJ)
              MOVE 2 TO OPTION OF SPEC-1B(JJ)
              MOVE "IP" TO ATTR1 OF SPEC-1B(JJJ)
              MOVE 2 TO OPTION OF SPEC-1B(JJJ)
           ELSE
              MOVE SPACES TO ATTR1 OF SPEC-1B(K)
              MOVE SPACES TO ATTR1 OF SPEC-1B(JJ)
              MOVE SPACES TO ATTR1 OF SPEC-1B(JJJ)
              MOVE 1 TO OPTION OF SPEC-1B(K)
              MOVE 1 TO OPTION OF SPEC-1B(JJ)
              MOVE 1 TO OPTION OF SPEC-1B(JJJ)
094500        MOVE "Y" TO PROCESSING-DEDS-FLAG.
094500
094400 DISPLAY-SCREEN-2.
           
            DISPLAY SCR-py100-cbl-2111-20
            DISPLAY SCR-py100-cbl-2112-20
            DISPLAY SCR-py100-cbl-2112-38
            DISPLAY SCR-py100-cbl-2113-20
            DISPLAY SCR-py100-cbl-2113-38
            DISPLAY SCR-py100-cbl-2114-20
            DISPLAY SCR-py100-cbl-2114-38
            DISPLAY SCR-py100-cbl-2115-20
            DISPLAY SCR-py100-cbl-2115-38
            DISPLAY SCR-py100-cbl-2116-20
            DISPLAY SCR-py100-cbl-2116-38.
031893     DISPLAY SCR-py100-cbl-2117-20  .
094600
099400 DISPLAY-SCREENS-EXIT. EXIT.

030100 EDITLIST-CHECK SECTION.
030200 EDITLIST-START.
030400     PERFORM SCREEN-INIT.
030500     DISPLAY SCR-py100-cbl-2124-20  .
030600     MOVE 11 TO ROW OF YES-NO-SPECS.
030700     MOVE 63 TO COL OF YES-NO-SPECS.
030800     MOVE 1 TO OPTION OF YES-NO-SPECS.
030900     MOVE "1010000000" TO FKEYS.
031000     MOVE 0 TO FLAG.
           PERFORM STEST-py100-cbl-2130
031100     CALL "SCRN01" USING FLAG, FKEYS, STEST-SCRN-SPECS, HELP2,
031200         YES-NO
           PERFORM STEST-AFTER-CALL.
031300     IF FLAG = 3 OR OPTION OF YES-NO-SPECS = 2
031400         GO TO EDITLIST-CHECK-EXIT.
123091     IF EXT-PY-REGISTER
123091        MOVE "PY115" TO NEXT-PROG
123091     ELSE
              MOVE "PY110" TO NEXT-PROG.
035400
035500 EDITLIST-CHECK-EXIT. EXIT.

030100 CONTROL-BREAK-CHECK SECTION.
030200 CONTROL-BREAK-START.
       SET-BREAK.
           MOVE PYHD-EMPL-NO TO BREAK-EMPL-NUMBER.
           PERFORM EMPL-BREAK.

       AT-END-CHECK.

       BREAK-CHECK.
           IF PYHD-EMPL-NO NOT = BREAK-EMPL-NUMBER
              PERFORM EMPL-BREAK
              MOVE PYHD-EMPL-NO TO BREAK-EMPL-NUMBER.

       EMPL-BREAK.
           MOVE PYHD-EMPL-NO TO EMPL-NUMBER.
           PERFORM READ-EMPLF.
           MOVE ZEROES TO YTD-FEDERAL, YTD-FICA, YTD-STATE,
112190                    YTD-LOCAL, YTD-DISUE, YTD-MEDICARE.
           MOVE ZEROES TO YTD-TAX(1), YTD-TAX(2), YTD-TAX(3),
               YTD-TAX(4), YTD-TAX(5), YTD-DED(1), YTD-DED(2),
               YTD-DED(3), YTD-DED(4), YTD-DED(5), YTD-DED(6),
112190         YTD-DED(7), YTD-DED(8), YTD-DED(9), YTD-TAX(6),
090492         YTD-DED(10), YTD-DED(11), YTD-DED(12), YTD-DED(13),
090492         YTD-DED(14), YTD-DED(15), YTD-DED(16),
090492         YTD-DED(17), YTD-DED(18), YTD-DED(19), YTD-DED(20).
           COMPUTE YTD-FEDERAL = EMPL-FEDERAL-TAX(1) +
                   EMPL-FEDERAL-TAX(2) + EMPL-FEDERAL-TAX(3) +
                   EMPL-FEDERAL-TAX(4).
           COMPUTE YTD-FICA = EMPL-FICA-TAX(1) + EMPL-FICA-TAX(2) +
                   EMPL-FICA-TAX(3) + EMPL-FICA-TAX(4).
112190     COMPUTE YTD-MEDICARE = EMPL-MEDICARE-TAX(1) +
112190             EMPL-MEDICARE-TAX(2) + EMPL-MEDICARE-TAX(3) +
112190             EMPL-MEDICARE-TAX(4).
           COMPUTE YTD-GROSS = EMPL-TAX-WAGES(1) + EMPL-TAX-WAGES(2) +
                   EMPL-TAX-WAGES(3) + EMPL-TAX-WAGES(4).
122790     ADD EMPL-FED-401K-DED(1) TO YTD-GROSS.
122790     ADD EMPL-FED-401K-DED(2) TO YTD-GROSS.
122790     ADD EMPL-FED-401K-DED(3) TO YTD-GROSS.
122790     ADD EMPL-FED-401K-DED(4) TO YTD-GROSS.
122790     ADD EMPL-FED-S125-DED(1) TO YTD-GROSS.
122790     ADD EMPL-FED-S125-DED(2) TO YTD-GROSS.
122790     ADD EMPL-FED-S125-DED(3) TO YTD-GROSS.
122790     ADD EMPL-FED-S125-DED(4) TO YTD-GROSS.
           ADD YTD-FEDERAL  TO YTD-TAX(1).
           ADD YTD-FICA     TO YTD-TAX(2).
112190     ADD YTD-MEDICARE TO YTD-TAX(3).
           PERFORM PROCESS-STATE.
112190     ADD YTD-STATE    TO YTD-TAX(4).
112190     ADD YTD-LOCAL    TO YTD-TAX(5).
112190     ADD YTD-DISUE    TO YTD-TAX(6).
           MOVE EMPD-YTD-TAKEN(1)  TO YTD-DED(1).
           MOVE EMPD-YTD-TAKEN(2)  TO YTD-DED(2).
           MOVE EMPD-YTD-TAKEN(3)  TO YTD-DED(3).
           MOVE EMPD-YTD-TAKEN(4)  TO YTD-DED(4).
           MOVE EMPD-YTD-TAKEN(5)  TO YTD-DED(5).
           MOVE EMPD-YTD-TAKEN(6)  TO YTD-DED(6).
           MOVE EMPD-YTD-TAKEN(7)  TO YTD-DED(7).
           MOVE EMPD-YTD-TAKEN(8)  TO YTD-DED(8).
           MOVE EMPD-YTD-TAKEN(9)  TO YTD-DED(9).
           MOVE EMPD-YTD-TAKEN(10) TO YTD-DED(10).
033193     MOVE EMPD-YTD-TAKEN(11) TO YTD-DED(11).
033193     MOVE EMPD-YTD-TAKEN(12) TO YTD-DED(12).
033193     MOVE EMPD-YTD-TAKEN(13) TO YTD-DED(13).
033193     MOVE EMPD-YTD-TAKEN(14) TO YTD-DED(14).
033193     MOVE EMPD-YTD-TAKEN(15) TO YTD-DED(15).
033193     MOVE EMPD-YTD-TAKEN(16) TO YTD-DED(16).
033193     MOVE EMPD-YTD-TAKEN(17) TO YTD-DED(17).
033193     MOVE EMPD-YTD-TAKEN(18) TO YTD-DED(18).
033193     MOVE EMPD-YTD-TAKEN(19) TO YTD-DED(19).
090492     MOVE EMPD-YTD-TAKEN(20) TO YTD-DED(20).
035500 CONTROL-BREAK-CHECK-EXIT. EXIT.

       PROCESS-STATE SECTION.
       PROCESS-STATE-BEGIN.
           MOVE EMPL-NUMBER TO EMPS-EMPL-NUMBER.
           MOVE SPACES TO EMPS-STATE-CODE.
           PERFORM START-EMPSF.
           IF NOT C-AT-END OF EMPSF-STATUS
               PERFORM READ-EMPSF-NEXT.

       PROCESS-STATE-NEXT.
           IF C-AT-END OF EMPSF-STATUS
              GO TO PROCESS-STATE-EXIT.
           PERFORM ADD-STATE-DETAIL.
       PROCESS-STATE-READ.
           PERFORM READ-EMPSF-NEXT.
           GO TO PROCESS-STATE-NEXT.

       ADD-STATE-DETAIL.
           IF EMPS-PAGE-TYPE = 2
              ADD EMPS-TAXES(1) TO YTD-STATE
              ADD EMPS-TAXES(2) TO YTD-STATE
              ADD EMPS-TAXES(3) TO YTD-STATE
              ADD EMPS-TAXES(4) TO YTD-STATE
           ELSE
           IF EMPS-PAGE-TYPE = 3
              ADD EMPS-TAXES(1) TO YTD-LOCAL
              ADD EMPS-TAXES(2) TO YTD-LOCAL
              ADD EMPS-TAXES(3) TO YTD-LOCAL
              ADD EMPS-TAXES(4) TO YTD-LOCAL
           ELSE
           IF EMPS-PAGE-TYPE = 4
              ADD EMPS-TAXES(1) TO YTD-DISUE
              ADD EMPS-TAXES(2) TO YTD-DISUE
              ADD EMPS-TAXES(3) TO YTD-DISUE
              ADD EMPS-TAXES(4) TO YTD-DISUE.

       PROCESS-STATE-EXIT. EXIT.

099600 IN-OUT SECTION.
091309 OPEN-EXCNF.
091309     OPEN INPUT EXCNF.
091309 READ-EXCNF.
091309     READ EXCNF.

099800 OPEN-PYHDF.
099900     OPEN I-O PYHDF.
100000 OPEN-PYLNF.
051294     OPEN I-O PYLNF.
100400 OPEN-EMPLF.
051294     OPEN I-O   EMPLF.
051294 REWRITE-EMPLF.
051294     REWRITE EMPLF-REC.
100400 OPEN-EMPSF.
100500     OPEN INPUT EMPSF.
100400 OPEN-TAXRF.
100500     OPEN INPUT TAXRF.
071500 OPEN-DEDCF.
071600     OPEN INPUT DEDCF.
111890 OPEN-STATF.
111890     OPEN INPUT STATF.
050594 OPEN-SKILF.
122396     STRING CNTL-PY-SERVICE-ID   DELIMITED BY SPACE
122396            A-MONTH              DELIMITED BY SIZE
122396            A-DAY                DELIMITED BY SIZE
122396            "1.FIN"              DELIMITED BY SIZE
                  INTO SKIL-FILENAME.
121798     IF AGMC
121798        STRING "AGMC"            DELIMITED BY SIZE
122396            A-MONTH              DELIMITED BY SIZE
122396            A-DAY                DELIMITED BY SIZE
122396            ".ASC"               DELIMITED BY SIZE
                  INTO SKIL-FILENAME.
050594     OPEN OUTPUT SKILF.
042197*START-PYLNF.
100900*    START PYLNF KEY NOT < PYLNF-KEY
101000*        INVALID KEY MOVE AT-END TO PYLNF-STATUS.
101100 START-PYLNF-GREATER.
101200     START PYLNF KEY > PYLNF-KEY
101300         INVALID KEY MOVE AT-END TO PYLNF-STATUS.
102000 READ-PYHDF-NEXT.
102100     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      PYHDF-STATUS OR IO-WAIT-OFF 
           READ PYHDF NEXT
102200         AT END MOVE AT-END TO PYHDF-STATUS
           END-READ END-PERFORM.
020797*    IF PYHDF-STATUS NOT = AT-END
020797*       IF PYHD-TOTAL-AMT = ZERO
020797*          GO TO READ-PYHDF-NEXT.
       START-EMPSF.
           START EMPSF KEY NOT < EMPSF-KEY
               INVALID KEY MOVE AT-END TO EMPSF-STATUS.
       READ-EMPSF-NEXT.
           PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      EMPSF-STATUS OR IO-WAIT-OFF 
           READ EMPSF NEXT
               AT END MOVE AT-END TO EMPSF-STATUS
           END-READ END-PERFORM.
           IF NOT C-AT-END OF EMPSF-STATUS AND
               EMPS-EMPL-NUMBER NOT = EMPL-NUMBER MOVE AT-END
                 TO EMPSF-STATUS.
104000 READ-EMPLF.
104100     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      EMPLF-STATUS OR IO-WAIT-OFF 
           READ EMPLF INVALID KEY
104200         MOVE NOT-FOUND TO EMPLF-STATUS
           END-READ END-PERFORM.
CLNUP1     IF NOT C-RECORD-OK OF EMPLF-STATUS
010499        DISPLAY SCR-py100-cbl-2305-23  
010499        DISPLAY SCR-py100-cbl-2306-23
                   
DEBUG *       DISPLAY PYHDF-REC LINE 1 POSITION 1 REVERSE
051503*       ACCEPT CNT.
051503        PERFORM WAIT-ENTER.
010302*       STOP RUN.
104000 READ-EMPSF.
104100     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      EMPSF-STATUS OR IO-WAIT-OFF 
           READ EMPSF INVALID KEY
104200         MOVE NOT-FOUND TO EMPSF-STATUS
           END-READ END-PERFORM.
104000 READ-TAXRF.
104100     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      TAXRF-STATUS OR IO-WAIT-OFF 
           READ TAXRF INVALID KEY
104200         MOVE NOT-FOUND TO TAXRF-STATUS
           END-READ END-PERFORM.
104600 READ-PYLNF.
104700     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      PYLNF-STATUS OR IO-WAIT-OFF 
           READ PYLNF INVALID KEY
104800         MOVE NOT-FOUND TO PYLNF-STATUS
           END-READ END-PERFORM.
072200 READ-DEDCF.
072300     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      DEDCF-STATUS OR IO-WAIT-OFF 
           READ DEDCF
           END-READ END-PERFORM.
111890 READ-STATF.
111890     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      STATF-STATUS OR IO-WAIT-OFF 
           READ STATF INVALID KEY
111890         MOVE NOT-FOUND TO STATF-STATUS
           END-READ END-PERFORM.
104900 READ-PYLNF-NEXT.
105000     PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1      PYLNF-STATUS OR IO-WAIT-OFF 
           READ PYLNF NEXT
105100         AT END MOVE AT-END TO PYLNF-STATUS
           END-READ END-PERFORM.
105200     IF NOT C-AT-END OF PYLNF-STATUS
105300         AND (PYLN-EMPL-NO NOT = PYHD-EMPL-NO OR
105400              PYLN-CHECK-CD NOT = PYHD-CHECK-CD)
105500             MOVE AT-END TO PYLNF-STATUS.
106200 REWRITE-PYHDF.
106300     REWRITE PYHDF-REC.
051294 WRITE-PYLNF.
051294     WRITE PYLNF-REC INVALID KEY
051294       MOVE DUPLICATE-RECORD TO PYLNF-STATUS.
051294 REWRITE-PYLNF.
051294     REWRITE PYLNF-REC.
050594 WRITE-SKILF.
122396     WRITE 401KF-REC.
107000
042197*DELETE-PYHDF.
070192*    DELETE PYHDF.

081308*OPEN-THSTF.
081308*    MOVE THST TO THST-FILENAME.
053000*    OPEN INPUT THSTF.
061192*READ-THSTF-NEXT.
053900*    PERFORM WITH TEST AFTER UNTIL RECORD-LOCK NOT EQUAL 
CLNUP1*     THSTF-STATUS OR IO-WAIT-OFF 
      *    READ THSTF NEXT
054000*        AT END MOVE AT-END TO THSTF-STATUS
      *    END-READ END-PERFORM.
053500*START-THSTF.
053600*    START THSTF KEY NOT < THSTF-KEY
053700*        INVALID KEY MOVE AT-END TO THSTF-STATUS.
      *
107100 CLOSE-FILES.
107200     CLOSE PYHDF.
107300     CLOSE PYLNF.
107500     CLOSE EMPLF.
107500     CLOSE EMPSF.
107500     CLOSE TAXRF.
073200     CLOSE DEDCF.
107900
108000 IN-OUT-EXIT. EXIT.
       FILENAMES SECTION.
       FILL-PATHS.
            MOVE SPACES TO TEMP-SUB-DIR.
            STRING SUB-DIR DELIMITED BY LOW-VALUES INTO TEMP-SUB-DIR.
            PERFORM CNTLF-FILL-FULLPATH.
091309      PERFORM EXCNF-FILL-FULLPATH.
            PERFORM EMPLF-FILL-FULLPATH.
            PERFORM DEDCF-FILL-FULLPATH.
            PERFORM PYHDF-FILL-FULLPATH.
            PERFORM STATF-FILL-FULLPATH.
            PERFORM EMPSF-FILL-FULLPATH.
            PERFORM PYLNF-FILL-FULLPATH.
       CNTLF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO CNTLF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" CNTLF--NAME 
            DELIMITED BY SPACES INTO CNTLF-FULLPATH.
091309 EXCNF-FILL-FULLPATH.
091309      MOVE SPACES TO TEMP-MASTER-DIR.
091309      STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
091309      TEMP-MASTER-DIR.
091309      MOVE SPACES TO EXCNF-FULLPATH.
091309      STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" EXCNF--NAME 
091309      DELIMITED BY SPACES INTO EXCNF-FULLPATH.
       USERF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO USERF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" USERF--NAME DELIMITED BY SPACES 
            INTO USERF-FULLPATH.
       EMPLF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO EMPLF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" EMPLF--NAME 
            DELIMITED BY SPACES INTO EMPLF-FULLPATH.
       DEDCF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO DEDCF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" DEDCF--NAME 
            DELIMITED BY SPACES INTO DEDCF-FULLPATH.
       PYHDF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO PYHDF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" PYHDF--NAME 
            DELIMITED BY SPACES INTO PYHDF-FULLPATH.
       STATF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO STATF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" STATF--NAME 
            DELIMITED BY SPACES INTO STATF-FULLPATH.
       EMPSF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO EMPSF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" EMPSF--NAME 
            DELIMITED BY SPACES INTO EMPSF-FULLPATH.
       TAXRF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO TAXRF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" TAXRF--NAME DELIMITED BY SPACES 
            INTO TAXRF-FULLPATH.
       PYLNF-FILL-FULLPATH.
            MOVE SPACES TO TEMP-MASTER-DIR.
            STRING MASTER-DIR DELIMITED BY LOW-VALUES INTO 
            TEMP-MASTER-DIR.
            MOVE SPACES TO PYLNF-FULLPATH.
            STRING TEMP-MASTER-DIR "\" TEMP-SUB-DIR "\" PYLNF--NAME 
            DELIMITED BY SPACES INTO PYLNF-FULLPATH.
       CHAINCALLS SECTION.
       CHN--PARM-BLOCK.
            COPY "CHAIN.CBL" REPLACING ==PARAM-BLOCK== BY ==PARM-BLOCK==
            .

       CHN--PARM-BLK.
            COPY "CHAIN.CBL" REPLACING ==PARAM-BLOCK== BY ==PARM-BLK==.

       SCRN-TEST SECTION.
            COPY "STEST.SR".
CLNUP1*STEST-errorfil-sr-46.
CLNUP1*     MOVE "   py100.cbl  errorfil.sr   46" TO STEST-KEY.
CLNUP1*     MOVE ERROR-FIELD TO STEST-SCRN-SPECS.
CLNUP1*     MOVE FUNCTION ADDR(ERROR-FIELD) TO STEST-PTR.
CLNUP1*     PERFORM STEST-BEGIN.
CLNUP1*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
CLNUP1*     = FUNCTION LENG (FLAG).
CLNUP1*     MOVE 4 TO STEST-PARAM-W-SIZE OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     MOVE "FLAG" TO STEST-PARAM-NAME OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     PERFORM STEST-PARAM-CHECK.
CLNUP1*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
CLNUP1*     = FUNCTION LENG (FKEYS).
CLNUP1*     MOVE 10 TO STEST-PARAM-W-SIZE OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     MOVE "FKEYS" TO STEST-PARAM-NAME OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     PERFORM STEST-PARAM-CHECK.
CLNUP1*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
CLNUP1*     = FUNCTION LENG (ERROR-FIELD).
CLNUP1*     MOVE 14 TO STEST-PARAM-W-SIZE OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     MOVE "ERROR-FIELD" TO STEST-PARAM-NAME OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     PERFORM STEST-PARAM-CHECK.
CLNUP1*     PERFORM STEST-SKIP.
CLNUP1*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
CLNUP1*     = FUNCTION LENG (ERROR-ANSWER).
CLNUP1*     MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     MOVE "ERROR-ANSWER" TO STEST-PARAM-NAME OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     PERFORM STEST-PARAM-CHECK.
CLNUP1*     PERFORM STEST-FINAL.
CLNUP1*STEST-wait-sr-5.
CLNUP1*     MOVE "   py100.cbl      wait.sr    5" TO STEST-KEY.
CLNUP1*     MOVE WAIT-SPECS TO STEST-SCRN-SPECS.
CLNUP1*     MOVE FUNCTION ADDR(WAIT-SPECS) TO STEST-PTR.
CLNUP1*     PERFORM STEST-BEGIN.
CLNUP1*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
CLNUP1*     = FUNCTION LENG (FLAG).
CLNUP1*     MOVE 4 TO STEST-PARAM-W-SIZE OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     MOVE "FLAG" TO STEST-PARAM-NAME OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     PERFORM STEST-PARAM-CHECK.
CLNUP1*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
CLNUP1*     = FUNCTION LENG (FKEYS).
CLNUP1*     MOVE 10 TO STEST-PARAM-W-SIZE OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     MOVE "FKEYS" TO STEST-PARAM-NAME OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     PERFORM STEST-PARAM-CHECK.
CLNUP1*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
CLNUP1*     = FUNCTION LENG (WAIT-SPECS).
CLNUP1*     MOVE 14 TO STEST-PARAM-W-SIZE OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     MOVE "WAIT-SPECS" TO STEST-PARAM-NAME OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     PERFORM STEST-PARAM-CHECK.
CLNUP1*     PERFORM STEST-SKIP.
CLNUP1*     COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
CLNUP1*     = FUNCTION LENG (ENTER-QUESTION).
CLNUP1*     MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     MOVE "ENTER-QUESTION" TO STEST-PARAM-NAME OF 
CLNUP1*     STEST-PARAMS (STEST-PARAM-NUM).
CLNUP1*     PERFORM STEST-PARAM-CHECK.
CLNUP1*     PERFORM STEST-FINAL.
       STEST-py100-cbl-1416.
            MOVE "   py100.cbl              1416" TO STEST-KEY.
            MOVE PE-DATE-SPEC TO STEST-SCRN-SPECS.
            MOVE FUNCTION ADDR(PE-DATE-SPEC) TO STEST-PTR.
            PERFORM STEST-BEGIN.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (FLAG).
            MOVE 4 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "FLAG" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (FKEYS).
            MOVE 10 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "FKEYS" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (PE-DATE-SPEC).
            MOVE 14 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "PE-DATE-SPEC" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            PERFORM STEST-SKIP.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (PE-DATE).
            MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "PE-DATE" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            PERFORM STEST-FINAL.
       STEST-py100-cbl-2014.
            MOVE "   py100.cbl              2014" TO STEST-KEY.
            MOVE SPECS-1 TO STEST-SCRN-SPECS.
            MOVE FUNCTION ADDR(SPECS-1) TO STEST-PTR.
            PERFORM STEST-BEGIN.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (FLAG).
            MOVE 4 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "FLAG" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (FKEYS).
            MOVE 10 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "FKEYS" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (SPECS-1).
            MOVE 420 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "SPECS-1" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            PERFORM STEST-SKIP.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (2) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (3) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (4) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (5) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (6) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (7) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (8) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (9) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (10) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (11) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (12) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (13) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (14) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (15) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (16) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (17) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (18) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (19) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (20) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (21) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (22) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (23) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (24) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (25) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (26) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (27) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (28) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (29) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (30) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            PERFORM STEST-FINAL.
       STEST-py100-cbl-2027.
            MOVE "   py100.cbl              2027" TO STEST-KEY.
            MOVE SPECS-1B TO STEST-SCRN-SPECS.
            MOVE FUNCTION ADDR(SPECS-1B) TO STEST-PTR.
            PERFORM STEST-BEGIN.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (FLAG).
            MOVE 4 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "FLAG" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (FKEYS).
            MOVE 10 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "FKEYS" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (SPECS-1B).
            MOVE 420 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "SPECS-1B" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            PERFORM STEST-SKIP.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (2) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (3) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (4) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (5) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (6) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (7) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (8) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (9) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (10) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (11) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (12) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (13) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (14) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (15) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (16) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (17) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (18) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (19) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (20) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (21) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (22) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (23) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (24) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (25) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (26) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (27) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (28) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (29) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (30) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            PERFORM STEST-FINAL.
       STEST-py100-cbl-2040.
            MOVE "   py100.cbl              2040" TO STEST-KEY.
            MOVE SPECS-2 TO STEST-SCRN-SPECS.
            MOVE FUNCTION ADDR(SPECS-2) TO STEST-PTR.
            PERFORM STEST-BEGIN.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (FLAG).
            MOVE 4 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "FLAG" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (FKEYS).
            MOVE 10 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "FKEYS" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (SPECS-2).
            MOVE 126 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "SPECS-2" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            PERFORM STEST-SKIP.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (2) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (3) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (4) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (5) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (6) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (7) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (8) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (9) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            PERFORM STEST-FINAL.
       STEST-py100-cbl-2130.
            MOVE "   py100.cbl              2130" TO STEST-KEY.
            MOVE YES-NO-SPECS TO STEST-SCRN-SPECS.
            MOVE FUNCTION ADDR(YES-NO-SPECS) TO STEST-PTR.
            PERFORM STEST-BEGIN.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (FLAG).
            MOVE 4 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "FLAG" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (FKEYS).
            MOVE 10 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "FKEYS" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO-SPECS).
            MOVE 14 TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO-SPECS" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            PERFORM STEST-SKIP.
            COMPUTE STEST-PARAM-SIZE OF STEST-PARAMS (STEST-PARAM-NUM)
            = FUNCTION LENG (YES-NO).
            MOVE FLEN OF STEST-SPECS (1) TO STEST-PARAM-W-SIZE OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            MOVE "YES-NO" TO STEST-PARAM-NAME OF 
            STEST-PARAMS (STEST-PARAM-NUM).
            PERFORM STEST-PARAM-CHECK.
            PERFORM STEST-FINAL.
108100*END-OF-FILE*
