000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID.      HHCAL145.
000300*AUTHOR.          DDS TEAM.
000400*REVISED. 05/07/15 DDS TEAM.
000500*REMARKS.     (CENTERS FOR MEDICARE & MEDICAID SERVICES)
000600*REMARKS. A). NATIONAL HHA PRICER
000700***       B). NATIONAL HHA PRICER EFFECTIVE OCT 1 2001
000800***       C). THERE ARE YEARLY HHA PRICER MODULES THAT WILL
000900***           CALCULATE THE HRG'S,REVENUE CODES AND
001000***           TYPE OF BILLS.
001100*REMARKS.
001200******************************************************************
001300*     FOR FY 2009 CALCULATIONS AND RATES NO CHANGES JUST SYNC TO
001400*              CORRECT LUPA RATE DETERMINATION IF LOGIC
001500*                CORRECT LUPA CALCULATION FOR REJECTED AND
001600*                REPROCESSED CLAIMS
001700*     HHCAL090   RATES EFFECTIVE JAN 1, 2009 CICS VERSION
001800*     HHCAL091   LUPA PAYMENT TO ZERO FOR ZERO REV VISITS
001900*     HHCAL092   HIPPA RECODE REVISION FOR 5 IN POS 1
002000*     HHCAL100 EXPAND BILLING RECORD TO 500 BYTES
002100*     HHCAL101
002200*     HHCAL106 CORRECT HIPPS RECODING ISSUE
002300*     HHCAL107 NEW HEALTH CARE REFORM
002400*     HHCAL111 CY 2011
002500*     HHCAL120 CY 2012
002600*     HHCAL131 CY 2013
002700*     HHCAL142 ADD NEW FIELDS FOR EARLIEST DATES ZERO
002800*              LUPA-ADD-ON-PAYMENT
002900*     HHCAL145 CORRECT THE EARLIEST DATE COMPARISON
003000*              ALSO CORRECT 3AGP VALUE IN HRGTABLE
003100*
003200******************************************************************
003300******************************************************************
003400*            RETURN CODE VALUES (HHA-RTC)
003500*
003600*        HHA-RTC  WITH PAYMENTS RETURNED
003700*
003800*     RETURN CODES
003900*          00 = FINAL PAYMENT
004000*               TOB = 329,339,327,337
004100*                  OR 32G OR 33G OR 32I OR 33I OR 32Q
004200*                  OR 32J OR 33J OR 32M OR 33M OR 33Q
004300*                  OR 32F OR 32K OR 32P OR 32H
004400*                  OR 33F OR 33K OR 33P OR 33H
004500*               WITH HRG,REVENUE CODE WHERE NO OUTLIER APPLIES
004600*          01 = FINAL PAYMENT
004700*               TOB = 329,339,327,337
004800*                  OR 32G OR 33G OR 32I OR 33I OR 32Q
004900*                  OR 32J OR 33J OR 32M OR 33M OR 33Q
005000*                  OR 32F OR 32K OR 32P OR 32H
005100*                  OR 33F OR 33K OR 33P OR 33H
005200*               WITH HRG,REVENUE CODE WHERE OUTLIER APPLIES
005300*          03 = INITIAL HALF PAYMENT PAYMENT WILL BE ZERO
005400*               TOB = 332 AND 322
005500*          04 = INITIAL HALF PAYMENT PAID AT 50%
005600*               TOB = 332 AND 322
005700*               WITH INITIAL (FIRST) HRG AND NO REVENUE CODES
005800*          05 = INITIAL HALF PAYMENT PAID AT 60%
005900*               TOB = 332 AND 322
006000*               WITH INITIAL (FIRST) HRG AND NO REVENUE CODES
006100*       06,14 = LUPA PAYMENT ONLY
006200*               TOB = 329,339,327,337
006300*                  OR 32G OR 33G OR 32I OR 33I OR 32Q
006400*                  OR 32J OR 33J OR 32M OR 33M OR 33Q
006500*                  OR 32F OR 32K OR 32P OR 32H
006600*                  OR 33F OR 33K OR 33P OR 33H
006700*               WITH REVENUE CODES AND REVENUE QTYS < 5       *
006800******************************************************************
006900*          07 = FINAL PAYMENT, SCIC, PEP = N, NO OUTLIER
007000*               TOB = 329,339,327,337
007100*                  OR 32G OR 33G OR 32I OR 33I OR 32Q
007200*                  OR 32J OR 33J OR 32M OR 33M OR 33Q
007300*                  OR 32F OR 32K OR 32P OR 32H
007400*                  OR 33F OR 33K OR 33P OR 33H
007500*               WITH REVENUE CODE WHERE NO OUTLIER APPLIES
007600*               WITH MORE THAN ONE HRG OCCURRENCE             *
007700*          08 = FINAL PAYMENT, SCIC, PEP = N, WITH OUTLIER
007800*               TOB = 329,339,327,337
007900*                  OR 32G OR 33G OR 32I OR 33I OR 32Q
008000*                  OR 32J OR 33J OR 32M OR 33M OR 33Q
008100*                  OR 32F OR 32K OR 32P OR 32H
008200*                  OR 33F OR 33K OR 33P OR 33H
008300*               WITH REVENUE CODE WHERE OUTLIER APPLIES
008400*               WITH MORE THAN ONE HRG OCCURRENCE             *
008500******************************************************************
008600*          09 = FINAL PAYMENT, PEP = Y, NO OUTLIER
008700*               TOB = 329,339,327,337
008800*                  OR 32G OR 33G OR 32I OR 33I OR 32Q
008900*                  OR 32J OR 33J OR 32M OR 33M OR 33Q
009000*                  OR 32F OR 32K OR 32P OR 32H
009100*                  OR 33F OR 33K OR 33P OR 33H
009200*               WITH REVENUE CODE WHERE NO OUTLIER APPLIES
009300*               WITH ONE HRG OCCURRENCE                       *
009400*          11 = FINAL PAYMENT, PEP = Y, WITH OUTLIER
009500*               TOB = 329,339,327,337
009600*                  OR 32G OR 33G OR 32I OR 33I OR 32Q
009700*                  OR 32J OR 33J OR 32M OR 33M OR 33Q
009800*                  OR 32F OR 32K OR 32P OR 32H
009900*                  OR 33F OR 33K OR 33P OR 33H
010000*               WITH REVENUE CODE WHERE OUTLIER APPLIES
010100*               WITH ONE HRG OCCURRENCE                       *
010200******************************************************************
010300*          12 = FINAL PAYMENT, SCIC, PEP = Y, NO OUTLIER
010400*               TOB = 329,339,327,337
010500*                  OR 32G OR 33G OR 32I OR 33I OR 32Q
010600*                  OR 32J OR 33J OR 32M OR 33M OR 33Q
010700*                  OR 32F OR 32K OR 32P OR 32H
010800*                  OR 33F OR 33K OR 33P OR 33H
010900*               WITH REVENUE CODE WHERE NO OUTLIER APPLIES
011000*               WITH MORE THAN ONE HRG OCCURRENCE             *
011100*          13 = FINAL PAYMENT, SCIC, PEP = Y, WITH OUTLIER
011200*               TOB = 329,339,327,337
011300*                  OR 32G OR 33G OR 32I OR 33I OR 32Q
011400*                  OR 32J OR 33J OR 32M OR 33M OR 33Q
011500*                  OR 32F OR 32K OR 32P OR 32H
011600*                  OR 33F OR 33K OR 33P OR 33H
011700*               WITH REVENUE CODE WHERE OUTLIER APPLIES
011800*               WITH MORE THAN ONE HRG OCCURRENCE             *
011900******************************************************************
012000******************************************************************
012100*                                                             *
012200*            HHA-RTC   NO PAYMENTS RETURNED                   *
012300*                                                             *
012400*              10 = INVALID TOB                               *
012500*                                                             *
012600*              15 = INVALID PEP DAYS                          *
012700*                   FOR SHORTENED EPISODE                     *
012800*                                                             *
012900*              16 = INVALID HRG DAYS , > 60 DAYS              *
013000*                                                             *
013100*              20 = INVALID PEP INDICATOR                     *
013200*                                                             *
013300*              25 = INVALID MED REVIEW INDICATOR              *
013400*                                                             *
013500*              30 = INVALID CBSA CODE                         *
013600*                                                             *
013700*              35 = INVALID INITIAL PAYMENT INDICATOR         *
013800*                        0 = MAKE NORMAL INITIAL PAYMENT      *
013900*                        1 = MAKE ZERO PAYMANT                *
014000*                                                             *
014100*              40 = INVALID SERVICE THRU DATE FOR             *
014200*                      CURRENT CALENDER YEAR                  *
014300*                                                             *
014400*              70 = INVALID OR NO HRG CODE PRESENT            *
014500*                                                             *
014600*              75 = NO HRG PRESENT IN FIRST OCCURANCE AND     *
014700*                   REVENUE-QTY-COV-VISITS > 4  AND           *
014800*                       TOB = 329,339,327,337                 *
014900*                          OR 32G OR 33G OR 32I OR 33I OR 32Q *
015000*                          OR 32J OR 33J OR 32M OR 33M OR 33Q *
015100*                          OR 32F OR 32K OR 32P OR 32H
015200*                          OR 33F OR 33K OR 33P OR 33H
015300*                                                             *
015400*              80 = INVALID REVENUE CODE                      *
015500*                                                             *
015600*              85 = NO REVENUE CODE PRESENT                   *
015700*                   WITH TOB 329 OR 339 OR 327 OR 337 OR 32Q  *
015800*                         OR 32G OR 33G OR 32I OR 33I OR 33Q  *
015900*                         OR 32J OR 33J OR 32M OR 33M         *
016000*                         OR 32F OR 32K OR 32P OR 32H
016100*                         OR 33F OR 33K OR 33P OR 33H
016200*                                                             *
016300***************************************************************
016400***************************************************************
016500***************************************************************
016600 DATE-COMPILED.
016700 ENVIRONMENT DIVISION.
016800 CONFIGURATION SECTION.
016900 SOURCE-COMPUTER.            IBM-370.
017000 OBJECT-COMPUTER.            IBM-370.
017100 INPUT-OUTPUT  SECTION.
017200 FILE-CONTROL.
017300
017400 DATA DIVISION.
017500 FILE SECTION.
017600
017700 WORKING-STORAGE SECTION.
017800 01  W-STORAGE-REF                  PIC X(46)  VALUE
017900     'HHCAL145       - W O R K I N G   S T O R A G E'.
018000 01  CAL-VERSION                    PIC X(07)  VALUE 'C2014.5'.
018100 01  CO1                            PIC S9(04) COMP SYNC.
018200 01  SUB1                           PIC S9(04) COMP SYNC.
018300 01  R1                             PIC S9(04) COMP SYNC.
018400 01  R2                             PIC S9(04) COMP SYNC.
018500 01  R3                             PIC S9(04) COMP SYNC.
018600
018700***************************************************************
018800*         YEARCHANGE
018900***************************************************************
019000 01  LABOR-NLABOR-PERCENT.
019100     05 LABOR-PERCENT        PIC 9V9(05)  VALUE 0.78535.
019200     05 NONLABOR-PERCENT     PIC 9V9(05)  VALUE 0.21465.
019300
019400***************************************************************
019500*         YEARCHANGE                              ===========**
019600***************************************************************
019700 01  LUPA-ADD-ON                  PIC 9(03)V9(02) VALUE 093.96.
019800 01  LUPA-ADD-ON-RURAL            PIC 9(03)V9(02) VALUE 096.78.
019900 01  LUPA-ADD-ON-2PERCENT         PIC 9(03)V9(02) VALUE 095.85.
020000 01  LUPA-ADD-ON-2PERCENT-RUR     PIC 9(03)V9(02) VALUE 098.73.
020100 01  LUPA-LABOR-ADJ               PIC 9(03)V9(02).
020200 01  LUPA-NON-LABOR-ADJ           PIC 9(03)V9(02).
020300
020400 01  LUPA-ADD-ON-SN4              PIC 9(01)V9(04) VALUE 00.8451.
020500 01  LUPA-ADD-ON-PT1              PIC 9(01)V9(04) VALUE 00.6700.
020600 01  LUPA-ADD-ON-SLT3             PIC 9(01)V9(04) VALUE 00.6266.
020700
020800 01  FED-EPISODE-RATE-AMT         PIC 9(05)V9(02) VALUE 0.
020900 01  OUTLIER-THRESHOLD-AMT        PIC 9(05)V9(02) VALUE 0.
021000*****************************************************************
021100***    EXAMPLE    ***********************************************
021200*** FED-EPISODE-RATE-AMT TIMES 1.13 = OUTLIER-THRESHOLD-AMT *****
021300******  2327.68 TIMES 0.65  = 1512.99  ROUNDED UP  **************
021400*****************************************************************
021500 01  OUTL-LOSS-SHAR-RATIO-PERCENT PIC 9(01)V9(02) VALUE 0.80.
021600
021700 01  WK-PEP-DAYS           PIC S9(04)       VALUE 0.
021800 01  WK-HRG-NO-OF-DAYS     PIC S9(04)       VALUE 0.
021900 01  WK-HRG-NO-OF-DAYS-FAC PIC S9(04)V9(06) VALUE 0.
022000 01  WK-HRG-NO-OF-DAYS-TOT PIC S9(04)       VALUE 0.
022100 01  WK-RTC-ADJ-IND        PIC 9            VALUE 0.
022200 01  WK-ALL-TOTALS.
022300     05  FED-ADJ                        PIC S9(07)V9(02).
022400     05  FED-ADJP                       PIC S9(07)V9(02).
022500     05  FED-ADJ1                       PIC S9(07)V9(02).
022600     05  FED-ADJ2                       PIC S9(07)V9(02).
022700     05  FED-ADJ3                       PIC S9(07)V9(02).
022800     05  FED-ADJ4                       PIC S9(07)V9(02).
022900     05  FED-ADJ5                       PIC S9(07)V9(02).
023000     05  FED-ADJ6                       PIC S9(07)V9(02).
023100     05  FED-LUPA-ADJ1                  PIC S9(07)V9(02).
023200     05  FED-LUPA-ADJ2                  PIC S9(07)V9(02).
023300     05  FED-LUPA-ADJ3                  PIC S9(07)V9(02).
023400     05  FED-LUPA-ADJ4                  PIC S9(07)V9(02).
023500     05  FED-LUPA-ADJ5                  PIC S9(07)V9(02).
023600     05  FED-LUPA-ADJ6                  PIC S9(07)V9(02).
023700     05  FED-LABOR-ADJ                  PIC S9(07)V9(02).
023800     05  FED-LABOR-ADJP                 PIC S9(07)V9(02).
023900     05  FED-LABOR-ADJ1                 PIC S9(07)V9(02).
024000     05  FED-LABOR-ADJ2                 PIC S9(07)V9(02).
024100     05  FED-LABOR-ADJ3                 PIC S9(07)V9(02).
024200     05  FED-LABOR-ADJ4                 PIC S9(07)V9(02).
024300     05  FED-LABOR-ADJ5                 PIC S9(07)V9(02).
024400     05  FED-LABOR-ADJ6                 PIC S9(07)V9(02).
024500     05  FED-LABOR-LUPA-ADJ1            PIC S9(07)V9(02).
024600     05  FED-LABOR-LUPA-ADJ2            PIC S9(07)V9(02).
024700     05  FED-LABOR-LUPA-ADJ3            PIC S9(07)V9(02).
024800     05  FED-LABOR-LUPA-ADJ4            PIC S9(07)V9(02).
024900     05  FED-LABOR-LUPA-ADJ5            PIC S9(07)V9(02).
025000     05  FED-LABOR-LUPA-ADJ6            PIC S9(07)V9(02).
025100     05  FED-SUPPLY-ADJ                 PIC S9(07)V9(02).
025200     05  FED-NON-LABOR-ADJ              PIC S9(07)V9(02).
025300     05  FED-NON-LABOR-ADJP             PIC S9(07)V9(02).
025400     05  FED-NON-LABOR-ADJ1             PIC S9(07)V9(02).
025500     05  FED-NON-LABOR-ADJ2             PIC S9(07)V9(02).
025600     05  FED-NON-LABOR-ADJ3             PIC S9(07)V9(02).
025700     05  FED-NON-LABOR-ADJ4             PIC S9(07)V9(02).
025800     05  FED-NON-LABOR-ADJ5             PIC S9(07)V9(02).
025900     05  FED-NON-LABOR-ADJ6             PIC S9(07)V9(02).
026000     05  FED-NON-LABOR-LUPA-ADJ1        PIC S9(07)V9(02).
026100     05  FED-NON-LABOR-LUPA-ADJ2        PIC S9(07)V9(02).
026200     05  FED-NON-LABOR-LUPA-ADJ3        PIC S9(07)V9(02).
026300     05  FED-NON-LABOR-LUPA-ADJ4        PIC S9(07)V9(02).
026400     05  FED-NON-LABOR-LUPA-ADJ5        PIC S9(07)V9(02).
026500     05  FED-NON-LABOR-LUPA-ADJ6        PIC S9(07)V9(02).
026600     05  OUT-THRES-AMT-ADJ              PIC S9(07)V9(02).
026700     05  OUT-THRES-LABOR-ADJ            PIC S9(07)V9(02).
026800     05  OUT-THRES-NON-LABOR-ADJ        PIC S9(07)V9(02).
026900     05  WK-3000-PEP-N-PRETOT-PAY       PIC S9(07)V9(02).
027000     05  WK-3000-PEP-N-PAYMENT          PIC S9(07)V9(02).
027100     05  WK-4000-PEP-Y-PRETOT-PAY       PIC S9(07)V9(02).
027200     05  WK-4000-PEP-Y-PAYMENT          PIC S9(07)V9(02).
027300     05  WK-5000-PEP-N-PRETOT-PAY       PIC S9(07)V9(02).
027400     05  WK-5000-PEP-N-PAYMENT          PIC S9(07)V9(02).
027500     05  WK-6000-PEP-Y-PRETOT-PAY       PIC S9(07)V9(02).
027600     05  WK-6000-PEP-Y-PAYMENT          PIC S9(07)V9(02).
027700     05  WK-6050-PEP-Y-TOT-DAYS         PIC S9(04).
027800     05  WK-7000-OUTLIER-VALUE-A        PIC S9(07)V9(02).
027900     05  WK-7000-AB-DIFF                PIC S9(07)V9(02).
028000     05  WK-7000-CALC                   PIC S9(07)V9(02).
028100     05  WK-8000-OUTLIER-VALUE-B        PIC S9(07)V9(02).
028200     05  WK-8000-OUTLIER-LAB-NLAB       PIC S9(07)V9(02).
028300     05  WK-10000-OUTLIER-POOL-DIF      PIC S9(07)V9(02).
028400     05  WK-10000-OUTLIER-POOL-PERCENT  PIC S9(09)V9(02).
028500     05  WK-10000-OUTLIER-AVAIL-POOL    PIC S9(09)V9(02).
028600
028700 01  WORK-HRG.
028800     05  WORK-HRG1                      PIC X(01).
028900     05  WORK-HRG2                      PIC X(01).
029000     05  WORK-HRG3                      PIC X(01).
029100     05  WORK-HRG4                      PIC X(01).
029200     05  WORK-HRG5                      PIC X(01).
029300
029400
029500*******************************************************
029600 01  HOLD-HHA-DATA.
029700     05  H-HHA-INPUT-DATA.
029800         10  H-HHA-NPI                 PIC X(10).
029900         10  H-HHA-HIC                 PIC X(12).
030000         10  H-HHA-PROV-NO             PIC X(06).
030100         10  H-HHA-TOB                 PIC XXX.
030200             88 H-HHA-VALID-TOB-CLAIM       VALUE
030300             '329', '339', '327', '337',
030400             '32G', '33G', '32I', '33I',
030500             '32J', '33J', '32M', '33M', '32Q',
030600             '32F', '32K', '32P', '32H', '33Q',
030700             '33F', '33K', '33P', '33H'.
030800             88 H-HHA-VALID-TOB-RAP         VALUE
030900             '322', '332'.
031000*                                                             *
031100         10  H-HHA-PEP-INDICATOR       PIC X.
031200         10  H-HHA-PEP-DAYS            PIC 999.
031300         10  H-HHA-INIT-PAY-INDICATOR  PIC X.
031400             88 H-HHA-WITH-DATA-CHECK VALUE '0', '1'.
031500             88 H-HHA-NO-DATA-CHECK   VALUE '2', '3'.
031600         10  FILLER                    PIC X(07).
031700         10  H-HHA-MSA1                PIC 9(07)V9(02).
031800         10  H-HHA-MSA2-DATA REDEFINES H-HHA-MSA1.
031900             15  FILLER             PIC XXX.
032000             15  H-HHA-MSA2         PIC XXXX.
032100             15  FILLER             PIC XX.
032200         10  H-HHA-CBSA-DATA REDEFINES H-HHA-MSA1.
032300             15  FILLER             PIC XX.
032400             15  H-HHA-CBSA         PIC XXXXX.
032500             15  FILLER             PIC XX.
032600         10  H-HHA-SERV-FROM-DATE.
032700             15  H-HHA-FROM-CC         PIC XX.
032800             15  H-HHA-FROM-YYMMDD.
032900                 25  H-HHA-FROM-YY     PIC XX.
033000                 25  H-HHA-FROM-MM     PIC XX.
033100                 25  H-HHA-FROM-DD     PIC XX.
033200         10  H-HHA-SERV-THRU-DATE.
033300             15  H-HHA-THRU-CC         PIC XX.
033400             15  H-HHA-THRU-YYMMDD.
033500                 25  H-HHA-THRU-YY     PIC XX.
033600                 25  H-HHA-THRU-MM     PIC XX.
033700                 25  H-HHA-THRU-DD     PIC XX.
033800         10  H-HHA-ADMIT-DATE.
033900             15  H-HHA-ADMIT-CC        PIC XX.
034000             15  H-HHA-ADMIT-YYMMDD.
034100                 25  H-HHA-ADMIT-YY    PIC XX.
034200                 25  H-HHA-ADMIT-MM    PIC XX.
034300                 25  H-HHA-ADMIT-DD    PIC XX.
034400         10  H-HHA-HRG-DATA      OCCURS 6.
034500             15  H-HHA-MED-REVIEW-INDICATOR PIC X.
034600             15  H-HHA-HRG-INPUT-CODE       PIC X(05).
034700             15  H-HHA-HRG-OUTPUT-CODE      PIC X(05).
034800             15  H-HHA-HRG-NO-OF-DAYS       PIC 9(03).
034900             15  H-HHA-HRG-WGTS             PIC 9(02)V9(04).
035000             15  H-HHA-HRG-PAY              PIC 9(07)V9(02).
035100         10  H-HHA-REVENUE-DATA     OCCURS 6.
035200             15  H-HHA-REVENUE-CODE             PIC X(04).
035300             15  H-HHA-REVENUE-QTY-COV-VISITS   PIC 9(03).
035400             15  H-HHA-REVENUE-EARLIEST-DATE    PIC 9(08).
035500             15  H-HHA-REVENUE-DOLL-RATE        PIC 9(07)V9(02).
035600             15  H-HHA-REVENUE-COST             PIC 9(07)V9(02).
035700             15  H-HHA-REVENUE-ADD-ON-VISIT-AMT PIC 9(07)V9(02).
035800     05  H-HHA-PASSBACK-DATA.
035900         10  H-HHA-PAY-RTC                PIC 99.
036000         10  H-HHA-REVENUE-SUM1-3-QTY-THR PIC 9(05).
036100         10  H-HHA-REVENUE-SUM1-6-QTY-ALL PIC 9(05).
036200         10  H-HHA-OUTLIER-PAYMENT        PIC 9(07)V9(02).
036300         10  H-HHA-TOTAL-PAYMENT          PIC 9(07)V9(02).
036400     05  H-HHA-CASE-MIX-DATA.
036500         10  H-HHA-LUPA-ADD-ON-PAYMENT    PIC 9(03)V9(02).
036600         10  H-HHA-LUPA-SRC-ADM           PIC X.
036700         10  H-HHA-RECODE-IND             PIC X.
036800         10  H-HHA-EPISODE-TIMING         PIC 9.
036900         10  H-HHA-SEVERITY-POINTS.
037000             15  H-HHA-CLINICAL-SEV-EQ1   PIC X(01).
037100             15  H-HHA-FUNCTION-SEV-EQ1   PIC X(01).
037200             15  H-HHA-CLINICAL-SEV-EQ2   PIC X(01).
037300             15  H-HHA-FUNCTION-SEV-EQ2   PIC X(01).
037400             15  H-HHA-CLINICAL-SEV-EQ3   PIC X(01).
037500             15  H-HHA-FUNCTION-SEV-EQ3   PIC X(01).
037600             15  H-HHA-CLINICAL-SEV-EQ4   PIC X(01).
037700             15  H-HHA-FUNCTION-SEV-EQ4   PIC X(01).
037800     05  H-HHA-PROV-TOTAL-DATA.
037900         10  H-HHA-PROV-OUTLIER-PAY-TOTAL PIC 9(08)V9(02).
038000         10  H-HHA-PROV-PAYMET-TOTAL      PIC 9(09)V9(02).
038100     05  FILLER                           PIC X(33).
038200**==================================================***
038300*    05  FILLER                         PIC X(20).
038400**==================================================***
038500
038600 LINKAGE SECTION.
038700***************************************************************
038800*                 * * * * * * * * *                           *
038900***************************************************************
039000***************************************************************
039100*    THIS DATA IS CALCULATED BY THIS HHAPR  SUBROUTINE        *
039200*    AND PASSED BACK TO THE CALLING PROGRAM                   *
039300***************************************************************
039400 01  HHA-INPUT-DATA.
039500     05  HHA-DATA.
039600         10  HHA-NPI                 PIC X(10).
039700         10  HHA-HIC                 PIC X(12).
039800         10  HHA-PROV-NO             PIC X(06).
039900         10  HHA-TOB                 PIC XXX.
040000             88 HHA-VALID-TOB-CLAIM       VALUE
040100             '329', '339', '327', '337',
040200             '32G', '33G', '32I', '33I',
040300             '32J', '33J', '32M', '33M', '32Q',
040400             '32F', '32K', '32P', '32H', '33Q',
040500             '33F', '33K', '33P', '33H'.
040600             88 HHA-VALID-TOB-RAP         VALUE
040700             '322', '332'.
040800*                                                             *
040900         10  HHA-PEP-INDICATOR       PIC X.
041000         10  HHA-PEP-DAYS            PIC 999.
041100         10  HHA-INIT-PAY-INDICATOR  PIC X.
041200             88  HHA-WITH-DATA-CHECK VALUE '0', '1'.
041300             88  HHA-NO-DATA-CHECK   VALUE '2', '3'.
041400         10  FILLER                  PIC X(07).
041500         10  HHA-MSA1                PIC 9(07)V9(02).
041600         10  HHA-MSA2-DATA REDEFINES HHA-MSA1.
041700             15  FILLER             PIC XXX.
041800             15  HHA-MSA2.
041900                 25  HHA-MSA2-RURAL-1ST.
042000                     30  HHA-RURAL-MSA         PIC XX.
042100                     88  HHA-MSA-RURAL-CHECK   VALUE '99'.
042200                 25  HHA-MSA2-RURAL-2ND        PIC XX.
042300             15  FILLER             PIC XX.
042400         10  HHA-CBSA-DATA REDEFINES HHA-MSA1.
042500             15  FILLER             PIC XX.
042600             15  HHA-CBSA.
042700                 88  HHA-CBSA-RURAL-CHECK-ALL VALUE
042800                 '50001', '50007', '50016', '50020', '50031',
042900                 '50036', '50054', '50060', '50067', '50087',
043000                 '50089', '50091', '50092', '50100', '50104',
043100                 '50108', '50114', '50121', '50125', '50140',
043200                 '50145', '50152', '50164', '50170', '50199',
043300                 '50206', '50210', '50214', '50218', '50222',
043400                 '50225', '50226', '50231', '50234', '50237',
043500                 '50243', '50248', '50250', '50255', '50256',
043600                 '50257', '50260', '50261', '50262', '50266',
043700                 '50268', '50272', '50275', '50281', '50286',
043800                 '50313', '50314', '50316', '50325', '50326',
043900                 '50327', '50329', '50336', '50344', '50352',
044000                 '50192', '50263', '50293'.
044100                 25  HHA-CBSA-RURAL-1ST.
044200                     30  HHA-RURAL-CBSA        PIC XXX.
044300                     88  HHA-CBSA-RURAL-CHECK   VALUE '999'.
044400                 25  HHA-CBSA-RURAL-2ND        PIC XX.
044500             15  FILLER             PIC XX.
044600         10  HHA-SERV-FROM-DATE.
044700             15  HHA-FROM-CC         PIC XX.
044800             15  HHA-FROM-YYMMDD.
044900                 25  HHA-FROM-YY     PIC XX.
045000                 25  HHA-FROM-MM     PIC XX.
045100                 25  HHA-FROM-DD     PIC XX.
045200         10  HHA-SERV-THRU-DATE.
045300             15  HHA-THRU-CC         PIC XX.
045400             15  HHA-THRU-YYMMDD.
045500                 25  HHA-THRU-YY     PIC XX.
045600                 25  HHA-THRU-MM     PIC XX.
045700                 25  HHA-THRU-DD     PIC XX.
045800         10  HHA-ADMIT-DATE.
045900             15  HHA-ADMIT-CC        PIC XX.
046000             15  HHA-ADMIT-YYMMDD.
046100                 25  HHA-ADMIT-YY    PIC XX.
046200                 25  HHA-ADMIT-MM    PIC XX.
046300                 25  HHA-ADMIT-DD    PIC XX.
046400         10  HHA-HRG-DATA      OCCURS 6.
046500             15  HHA-MED-REVIEW-INDICATOR PIC X.
046600             15  HHA-HRG-INPUT-CODE       PIC X(05).
046700             15  HHA-HRG-OUTPUT-CODE      PIC X(05).
046800             15  HHA-HRG-NO-OF-DAYS       PIC 9(03).
046900             15  HHA-HRG-WGTS             PIC 9(02)V9(04).
047000             15  HHA-HRG-PAY              PIC 9(07)V9(02).
047100         10  HHA-REVENUE-DATA     OCCURS 6.
047200             15  HHA-REVENUE-CODE             PIC X(04).
047300             15  HHA-REVENUE-QTY-COV-VISITS   PIC 9(03).
047400             15  HHA-REVENUE-EARLIEST-DATE    PIC 9(08).
047500             15  HHA-REVENUE-DOLL-RATE        PIC 9(07)V9(02).
047600             15  HHA-REVENUE-COST             PIC 9(07)V9(02).
047700             15  HHA-REVENUE-ADD-ON-VISIT-AMT PIC 9(07)V9(02).
047800     05  HHA-PASSBACK-DATA.
047900         10  HHA-PAY-RTC                PIC 99.
048000         10  HHA-REVENUE-SUM1-3-QTY-THR PIC 9(05).
048100         10  HHA-REVENUE-SUM1-6-QTY-ALL PIC 9(05).
048200         10  HHA-OUTLIER-PAYMENT        PIC 9(07)V9(02).
048300         10  HHA-TOTAL-PAYMENT          PIC 9(07)V9(02).
048400     05  HHA-CASE-MIX-DATA.
048500         10  HHA-LUPA-ADD-ON-PAYMENT      PIC 9(03)V9(02).
048600         10  HHA-LUPA-SRC-ADM             PIC X.
048700         10  HHA-RECODE-IND               PIC X.
048800         10  HHA-EPISODE-TIMING           PIC 9.
048900         10  HHA-SEVERITY-POINTS.
049000             15  HHA-CLINICAL-SEV-EQ1     PIC X(01).
049100             15  HHA-FUNCTION-SEV-EQ1     PIC X(01).
049200             15  HHA-CLINICAL-SEV-EQ2     PIC X(01).
049300             15  HHA-FUNCTION-SEV-EQ2     PIC X(01).
049400             15  HHA-CLINICAL-SEV-EQ3     PIC X(01).
049500             15  HHA-FUNCTION-SEV-EQ3     PIC X(01).
049600             15  HHA-CLINICAL-SEV-EQ4     PIC X(01).
049700             15  HHA-FUNCTION-SEV-EQ4     PIC X(01).
049800     05  HHA-PROV-TOTAL-DATA.
049900         10  HHA-PROV-OUTLIER-PAY-TOTAL PIC 9(08)V9(02).
050000         10  HHA-PROV-PAYMET-TOTAL      PIC 9(09)V9(02).
050100     05  FILLER                         PIC X(33).
050200**==================================================***
050300*    05  FILLER                         PIC X(20).
050400
050500 01  HOLD-VARIABLES-DATA.
050600     02  HOLD-VAR-DATA.
050700         05  PRICER-OPTION-SW                   PIC X(01).
050800         05  HHOPN-VERSION                      PIC X(07).
050900         05  HHDRV-VERSION                      PIC X(07).
051000         05  HHCAL-VERSION                      PIC X(07).
051100         05  FILLER                             PIC X(20).
051200
051300 01  CBSA-WAGE-INDEX-DATA.
051400     02  HOLD-WIR-DATA.
051500         05  WIR-CBSA                       PIC X(05).
051600         05  WIR-CBSA-EFFDATE               PIC X(08).
051700         05  WIR-CBSA-WAGEIND               PIC 9(02)V9(04).
051800
051900 PROCEDURE DIVISION  USING HHA-INPUT-DATA
052000                           HOLD-VARIABLES-DATA
052100                           CBSA-WAGE-INDEX-DATA.
052200
052300***************************************************************
052400*    PROCESSING:                                              *
052500*        A. WILL PROCESS NATIONAL HHA FOR CY 2010             *
052600*                STARTING JAN 1, 2010                         *
052700***************************************************************
052800
052900     MOVE CAL-VERSION TO HHCAL-VERSION.
053000
053100     PERFORM 200-MAINLINE-CONTROL THRU 200-EXIT.
053200
053300*         YEARCHANGE  2014.1                      ===========**
053400     MOVE 0 TO  H-HHA-LUPA-ADD-ON-PAYMENT.
053500*         YEARCHANGE  2014.1                      ===========**
053600
053700     MOVE HOLD-HHA-DATA TO HHA-INPUT-DATA.
053800
053900     GOBACK.
054000
054100 200-MAINLINE-CONTROL.
054200
054300     MOVE HHA-INPUT-DATA TO HOLD-HHA-DATA.
054400
054500
054600*     DISPLAY '-- HHA-HIC HHCAL145  ===> ' HHA-HIC.
054700
054800     MOVE ALL '0' TO
054900                     WK-ALL-TOTALS
055000                     WK-HRG-NO-OF-DAYS
055100                     WK-HRG-NO-OF-DAYS-TOT
055200                     WK-RTC-ADJ-IND
055300                     WK-PEP-DAYS
055400                     H-HHA-PASSBACK-DATA
055500                     H-HHA-HRG-PAY (1)
055600                     H-HHA-HRG-PAY (2)
055700                     H-HHA-HRG-PAY (3)
055800                     H-HHA-HRG-PAY (4)
055900                     H-HHA-HRG-PAY (5)
056000                     H-HHA-HRG-PAY (6)
056100                     H-HHA-REVENUE-COST (1)
056200                     H-HHA-REVENUE-COST (2)
056300                     H-HHA-REVENUE-COST (3)
056400                     H-HHA-REVENUE-COST (4)
056500                     H-HHA-REVENUE-COST (5)
056600                     H-HHA-REVENUE-COST (6)
056700                     H-HHA-REVENUE-ADD-ON-VISIT-AMT (1)
056800                     H-HHA-REVENUE-ADD-ON-VISIT-AMT (2)
056900                     H-HHA-REVENUE-ADD-ON-VISIT-AMT (3)
057000                     H-HHA-REVENUE-ADD-ON-VISIT-AMT (4)
057100                     H-HHA-REVENUE-ADD-ON-VISIT-AMT (5)
057200                     H-HHA-REVENUE-ADD-ON-VISIT-AMT (6).
057300
057400     IF  H-HHA-PAY-RTC = 00
057500         PERFORM 400-CALC-THE-HHA THRU 400-EXIT.
057600
057700 200-EXIT.   EXIT.
057800
057900 400-CALC-THE-HHA.
058000
058100*    IF H-HHA-SERV-THRU-DATE < 20070101
058200*        MOVE '40' TO H-HHA-PAY-RTC
058300*        GO TO 400-EXIT.
058400
058500     IF H-HHA-ADMIT-DATE >
058600        H-HHA-SERV-FROM-DATE
058700         MOVE '40' TO H-HHA-PAY-RTC
058800         GO TO 400-EXIT.
058900
059000     IF (H-HHA-VALID-TOB-RAP   AND
059100        (H-HHA-HRG-INPUT-CODE (1) = SPACE))
059200        MOVE '70' TO H-HHA-PAY-RTC
059300        GO TO 400-EXIT.
059400
059500     IF  (H-HHA-VALID-TOB-CLAIM AND
059600         (H-HHA-REVENUE-SUM1-6-QTY-ALL > 4 ) AND
059700         (H-HHA-HRG-INPUT-CODE (1) = SPACE))
059800        MOVE '75' TO H-HHA-PAY-RTC
059900        GO TO 400-EXIT.
060000
060100     IF  (H-HHA-VALID-TOB-CLAIM AND
060200         (H-HHA-REVENUE-CODE (1) = SPACE))
060300        MOVE '85' TO H-HHA-PAY-RTC
060400        GO TO 400-EXIT.
060500
060600     IF  (H-HHA-VALID-TOB-CLAIM AND
060700         (H-HHA-HRG-INPUT-CODE (2) NOT = SPACES) AND
060800         (H-HHA-PEP-INDICATOR = 'Y') AND
060900         (H-HHA-PEP-DAYS NOT NUMERIC OR
061000          H-HHA-PEP-DAYS = ZEROES))
061100        MOVE '15' TO H-HHA-PAY-RTC
061200        GO TO 400-EXIT.
061300
061400     IF H-HHA-PAY-RTC NOT = 00 GO TO 400-EXIT.
061500
061600***************************************************************
061700***************************************************************
061800*        THESE RATES & THRESHOLDS ARE APPLIED                 *
061900* FOR NON-RURAL AND  RURAL                                    *
062000***************************************************************
062100*         YEARCHANGE                              ===========**
062200***************************************************************
062300* FOR NON RURAL NO DATA - TABLE 2
062400     MOVE 02813.18 TO   FED-EPISODE-RATE-AMT.
062500     MOVE 01265.93 TO   OUTLIER-THRESHOLD-AMT.
062600
062700*------------------------------------------------------
062800*    WITH   REPORTING DATA  ---------------
062900*         YEARCHANGE                      ===========**
063000*------------------------------------------------------
063100     IF HHA-WITH-DATA-CHECK
063200        NEXT SENTENCE
063300     ELSE
063400        GO TO NO-REPORTING-DATA.
063500
063600        IF HHA-CBSA-RURAL-CHECK
063700        OR HHA-CBSA-RURAL-CHECK-ALL
063800*------------------------------------------------------
063900*    RURAL, AND REPORTING DATA -------- TABLE 8 1ST COL
064000*         YEARCHANGE                      ===========**
064100*------------------------------------------------------
064200           MOVE 02955.35 TO   FED-EPISODE-RATE-AMT
064300           MOVE 01329.91 TO   OUTLIER-THRESHOLD-AMT
064400        ELSE
064500*------------------------------------------------------
064600*    NON RURAL, AND REPORTING DATA -------- TABLE 1
064700*         YEARCHANGE                      ===========**
064800*------------------------------------------------------
064900           MOVE 02869.27 TO   FED-EPISODE-RATE-AMT
065000           MOVE 01291.17 TO   OUTLIER-THRESHOLD-AMT.
065100
065200
065300      GO TO PROCESS-PAYMENT.
065400
065500 NO-REPORTING-DATA.
065600
065700        IF HHA-CBSA-RURAL-CHECK
065800        OR HHA-CBSA-RURAL-CHECK-ALL
065900*------------------------------------------------------
066000*    RURAL, AND NO REPORTING DATA TABLE 8 ===========**
066100*         YEARCHANGE                      ===========**
066200*------------------------------------------------------
066300           MOVE 02897.58 TO   FED-EPISODE-RATE-AMT
066400           MOVE 01303.91 TO   OUTLIER-THRESHOLD-AMT
066500        GO TO PROCESS-PAYMENT.
066600
066700
066800*------------------------------------------------------
066900*    NON RURAL, AND NO REPORTING DATA --------
067000*------------------------------------------------------
067100*          MOVE 02096.34 TO   FED-EPISODE-RATE-AMT.
067200*          MOVE 01404.55 TO   OUTLIER-THRESHOLD-AMT.
067300
067400
067500 PROCESS-PAYMENT.
067600
067700*------------------------------------------------------
067800***************************************************************
067900
068000     IF H-HHA-VALID-TOB-RAP
068100        PERFORM 500-INITIAL-PAYMENT THRU 500-EXIT
068200        GO TO 400-EXIT.
068300
068400     IF H-HHA-VALID-TOB-CLAIM
068500        PERFORM 1000-FINAL-PAYMENT THRU 1000-EXIT
068600        GO TO 400-EXIT.
068700
068800     MOVE '10' TO H-HHA-PAY-RTC.
068900
069000
069100 400-EXIT.   EXIT.
069200
069300 500-INITIAL-PAYMENT.
069400
069500***************************************************************
069600*            TOB = 322 OR 332 INITIAL PAYMENT
069700***************************************************************
069800
069900     IF  H-HHA-INIT-PAY-INDICATOR  = '0' OR '1' OR '2' OR '3'
070000         NEXT SENTENCE
070100     ELSE
070200         MOVE '35' TO H-HHA-PAY-RTC
070300         GO TO 500-EXIT.
070400
070500     IF  H-HHA-INIT-PAY-INDICATOR  = '1' OR '3'
070600         MOVE '03' TO H-HHA-PAY-RTC
070700         GO TO 500-EXIT.
070800
070900     COMPUTE FED-ADJ ROUNDED =
071000               H-HHA-HRG-WGTS (1) * FED-EPISODE-RATE-AMT.
071100
071200     COMPUTE FED-LABOR-ADJ ROUNDED =
071300             WIR-CBSA-WAGEIND *
071400             LABOR-PERCENT *
071500             FED-ADJ.
071600
071700     COMPUTE FED-NON-LABOR-ADJ ROUNDED =
071800              (NONLABOR-PERCENT * FED-ADJ).
071900
072000     MOVE H-HHA-HRG-OUTPUT-CODE (1) TO WORK-HRG.
072100
072200*         YEARCHANGE                              ===========**
072300
072400      PERFORM 10100-SUPPLY-ADD-ON-CALC  THRU 10100-EXIT.
072500
072600*         YEARCHANGE                              ===========**
072700
072800*    IF HHA-SERV-THRU-DATE > 20071231 AND
072900*       HHA-SERV-FROM-DATE > 20071231
073000*        NEXT SENTENCE
073100*    ELSE
073200*        MOVE 0000000.00 TO FED-SUPPLY-ADJ.
073300
073400
073500     IF H-HHA-SERV-FROM-DATE = H-HHA-ADMIT-DATE
073600        COMPUTE H-HHA-TOTAL-PAYMENT ROUNDED =
073700       (FED-LABOR-ADJ + FED-NON-LABOR-ADJ + FED-SUPPLY-ADJ) * .6
073800        MOVE H-HHA-TOTAL-PAYMENT TO H-HHA-HRG-PAY (1)
073900        MOVE '05' TO H-HHA-PAY-RTC
074000     ELSE
074100        COMPUTE H-HHA-TOTAL-PAYMENT ROUNDED =
074200       (FED-LABOR-ADJ + FED-NON-LABOR-ADJ + FED-SUPPLY-ADJ) * .5
074300        MOVE H-HHA-TOTAL-PAYMENT TO H-HHA-HRG-PAY (1)
074400        MOVE '04' TO H-HHA-PAY-RTC.
074500
074600 500-EXIT.   EXIT.
074700
074800 1000-FINAL-PAYMENT.
074900
075000     IF H-HHA-REVENUE-QTY-COV-VISITS (1) NOT NUMERIC
075100        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (1).
075200     IF H-HHA-REVENUE-QTY-COV-VISITS (2) NOT NUMERIC
075300        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (2).
075400     IF H-HHA-REVENUE-QTY-COV-VISITS (3) NOT NUMERIC
075500        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (3).
075600     IF H-HHA-REVENUE-QTY-COV-VISITS (4) NOT NUMERIC
075700        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (4).
075800     IF H-HHA-REVENUE-QTY-COV-VISITS (5) NOT NUMERIC
075900        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (5).
076000     IF H-HHA-REVENUE-QTY-COV-VISITS (6) NOT NUMERIC
076100        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (6).
076200
076300     COMPUTE H-HHA-REVENUE-SUM1-3-QTY-THR ROUNDED =
076400             H-HHA-REVENUE-QTY-COV-VISITS (1) +
076500             H-HHA-REVENUE-QTY-COV-VISITS (2) +
076600             H-HHA-REVENUE-QTY-COV-VISITS (3).
076700     COMPUTE H-HHA-REVENUE-SUM1-6-QTY-ALL ROUNDED =
076800             H-HHA-REVENUE-QTY-COV-VISITS (1) +
076900             H-HHA-REVENUE-QTY-COV-VISITS (2) +
077000             H-HHA-REVENUE-QTY-COV-VISITS (3) +
077100             H-HHA-REVENUE-QTY-COV-VISITS (4) +
077200             H-HHA-REVENUE-QTY-COV-VISITS (5) +
077300             H-HHA-REVENUE-QTY-COV-VISITS (6).
077400
077500     MOVE H-HHA-HRG-OUTPUT-CODE (1) TO WORK-HRG.
077600
077700     IF H-HHA-REVENUE-SUM1-6-QTY-ALL < 5
077800       NEXT SENTENCE
077900     ELSE
078000       GO TO PEP-CHECK.
078100
078200*01  LUPA-ADD-ON
078300*01  LUPA-ADD-ON-RURAL
078400*01  LUPA-ADD-ON-2PERCENT
078500*01  LUPA-ADD-ON-2PERCENT-RUR
078600
078700     IF HHA-WITH-DATA-CHECK
078800        IF HHA-CBSA-RURAL-CHECK
078900        OR HHA-CBSA-RURAL-CHECK-ALL
079000         COMPUTE LUPA-LABOR-ADJ ROUNDED =
079100                 WIR-CBSA-WAGEIND *
079200                 LABOR-PERCENT *
079300                 LUPA-ADD-ON-2PERCENT-RUR
079400        ELSE
079500         COMPUTE LUPA-LABOR-ADJ ROUNDED =
079600                 WIR-CBSA-WAGEIND *
079700                 LABOR-PERCENT *
079800                 LUPA-ADD-ON-2PERCENT
079900        END-IF
080000     ELSE
080100        IF HHA-CBSA-RURAL-CHECK
080200        OR HHA-CBSA-RURAL-CHECK-ALL
080300         COMPUTE LUPA-LABOR-ADJ ROUNDED =
080400                 WIR-CBSA-WAGEIND *
080500                 LABOR-PERCENT *
080600                 LUPA-ADD-ON-RURAL
080700        ELSE
080800         COMPUTE LUPA-LABOR-ADJ ROUNDED =
080900                 WIR-CBSA-WAGEIND *
081000                 LABOR-PERCENT *
081100                 LUPA-ADD-ON
081200        END-IF
081300     END-IF.
081400
081500     IF HHA-WITH-DATA-CHECK
081600        IF HHA-CBSA-RURAL-CHECK
081700        OR HHA-CBSA-RURAL-CHECK-ALL
081800         COMPUTE LUPA-NON-LABOR-ADJ ROUNDED =
081900                 NONLABOR-PERCENT *
082000                 LUPA-ADD-ON-2PERCENT-RUR
082100        ELSE
082200         COMPUTE LUPA-NON-LABOR-ADJ ROUNDED =
082300                 NONLABOR-PERCENT *
082400                  LUPA-ADD-ON-2PERCENT
082500        END-IF
082600     ELSE
082700        IF HHA-CBSA-RURAL-CHECK
082800        OR HHA-CBSA-RURAL-CHECK-ALL
082900         COMPUTE LUPA-NON-LABOR-ADJ ROUNDED =
083000                 NONLABOR-PERCENT *
083100                 LUPA-ADD-ON-RURAL
083200        ELSE
083300         COMPUTE LUPA-NON-LABOR-ADJ ROUNDED =
083400                 NONLABOR-PERCENT *
083500                 LUPA-ADD-ON
083600        END-IF
083700     END-IF.
083800
083900
084000*    IF H-HHA-ADMIT-DATE = H-HHA-SERV-FROM-DATE AND
084100*        WORK-HRG1 = '1' OR '2'
084200*       COMPUTE H-HHA-LUPA-ADD-ON-PAYMENT ROUNDED =
084300*         LUPA-LABOR-ADJ + LUPA-NON-LABOR-ADJ
084400*    ELSE
084500*       MOVE 0 TO  H-HHA-LUPA-ADD-ON-PAYMENT.
084600*
084700***         VARYING SUB1 FROM 1 BY 1 UNTIL
084800***         (H-HHA-REVENUE-CODE (SUB1) = SPACES OR
084900***          SUB1 > 6.
085000
085100
085200**   CHANGE MISSING DATES TO DEFAULT FOR EARLIEST DATE COMPARE **
085300
085400     IF H-HHA-REVENUE-EARLIEST-DATE (1) = 0
085500        MOVE 29990101 TO H-HHA-REVENUE-EARLIEST-DATE (1).
085600
085700     IF H-HHA-REVENUE-EARLIEST-DATE (3) = 0
085800        MOVE 29990101 TO H-HHA-REVENUE-EARLIEST-DATE (3).
085900
086000     IF H-HHA-REVENUE-EARLIEST-DATE (4) = 0
086100        MOVE 29990101 TO H-HHA-REVENUE-EARLIEST-DATE (4).
086200
086300*    IF REVENUE EARLIEST DATES = ALL 9'S THEN
086400*    LUPA ADD ON DOES NOT CALCULATE
086500
086600     IF (H-HHA-REVENUE-EARLIEST-DATE (1) = 99999999 AND
086700         H-HHA-REVENUE-EARLIEST-DATE (3) = 99999999 AND
086800         H-HHA-REVENUE-EARLIEST-DATE (4) = 99999999)
086900         MOVE 0 TO  H-HHA-LUPA-ADD-ON-PAYMENT
087000                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (1)
087100                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (2)
087200                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (3)
087300                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (4)
087400                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (5)
087500         MOVE 0 TO  H-HHA-LUPA-ADD-ON-PAYMENT
087600           GO TO RTC-CHECK.
087700
087800*    IF  REVENUE EARLIEST DATES = DEFAULT THEN
087900*    LUPA ADD ON DOES NOT CALCULATE
088000
088100     IF (H-HHA-REVENUE-EARLIEST-DATE (1) = 29990101 AND
088200         H-HHA-REVENUE-EARLIEST-DATE (3) = 29990101 AND
088300         H-HHA-REVENUE-EARLIEST-DATE (4) = 29990101)
088400         MOVE 0 TO  H-HHA-LUPA-ADD-ON-PAYMENT
088500                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (1)
088600                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (2)
088700                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (3)
088800                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (4)
088900                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (5)
089000         MOVE 0 TO  H-HHA-LUPA-ADD-ON-PAYMENT
089100           GO TO RTC-CHECK.
089200
089300*    IF PT OCCURS ON EARLIEST DATE THEN LUPA ADD ON APPLIES TO
089400*       PT
089500
089600     IF (H-HHA-REVENUE-EARLIEST-DATE (1) <
089700         H-HHA-REVENUE-EARLIEST-DATE (3)) AND
089800        (H-HHA-REVENUE-EARLIEST-DATE (1) <
089900         H-HHA-REVENUE-EARLIEST-DATE (4))
090000        COMPUTE  H-HHA-REVENUE-ADD-ON-VISIT-AMT (1) ROUNDED =
090100           H-HHA-REVENUE-DOLL-RATE (1) * LUPA-ADD-ON-PT1
090200        COMPUTE H-HHA-LUPA-ADD-ON-PAYMENT ROUNDED =
090300           H-HHA-LUPA-ADD-ON-PAYMENT +
090400           H-HHA-REVENUE-ADD-ON-VISIT-AMT (1)
090500           GO TO RTC-CHECK.
090600
090700*    IF SLT OCCURS ON EARLIEST DATE THEN LUPA ADD ON APPLIES TO
090800*       SLT
090900
091000     IF (H-HHA-REVENUE-EARLIEST-DATE (3) <
091100         H-HHA-REVENUE-EARLIEST-DATE (1)) AND
091200        (H-HHA-REVENUE-EARLIEST-DATE (3) <
091300         H-HHA-REVENUE-EARLIEST-DATE (4))
091400        COMPUTE  H-HHA-REVENUE-ADD-ON-VISIT-AMT (3) ROUNDED =
091500           H-HHA-REVENUE-DOLL-RATE (3) * LUPA-ADD-ON-SLT3
091600        COMPUTE H-HHA-LUPA-ADD-ON-PAYMENT ROUNDED =
091700           H-HHA-LUPA-ADD-ON-PAYMENT +
091800           H-HHA-REVENUE-ADD-ON-VISIT-AMT (3)
091900           GO TO RTC-CHECK.
092000
092100*    IF SN OCCURS ON EARLIEST DATE THEN LUPA ADD ON APPLIES TO
092200*       SN
092300
092400     IF (H-HHA-REVENUE-EARLIEST-DATE (4) <
092500         H-HHA-REVENUE-EARLIEST-DATE (1)) AND
092600        (H-HHA-REVENUE-EARLIEST-DATE (4) <
092700         H-HHA-REVENUE-EARLIEST-DATE (3))
092800        COMPUTE  H-HHA-REVENUE-ADD-ON-VISIT-AMT (4) ROUNDED =
092900           H-HHA-REVENUE-DOLL-RATE (4) * LUPA-ADD-ON-SN4
093000        COMPUTE H-HHA-LUPA-ADD-ON-PAYMENT ROUNDED =
093100           H-HHA-LUPA-ADD-ON-PAYMENT +
093200           H-HHA-REVENUE-ADD-ON-VISIT-AMT (4)
093300           GO TO RTC-CHECK.
093400
093500*    IF PT  EARLIEST DATE = SLT EARLIEST AND = SN EARLIEST
093600*    THEN LUPA ADD ON APPLIES TO SN
093700*
093800
093900     IF (H-HHA-REVENUE-EARLIEST-DATE (1) =
094000         H-HHA-REVENUE-EARLIEST-DATE (3)) AND
094100        (H-HHA-REVENUE-EARLIEST-DATE (1) =
094200         H-HHA-REVENUE-EARLIEST-DATE (4))
094300        COMPUTE  H-HHA-REVENUE-ADD-ON-VISIT-AMT (4) ROUNDED =
094400           H-HHA-REVENUE-DOLL-RATE (4) * LUPA-ADD-ON-SN4
094500        COMPUTE H-HHA-LUPA-ADD-ON-PAYMENT ROUNDED =
094600           H-HHA-LUPA-ADD-ON-PAYMENT +
094700           H-HHA-REVENUE-ADD-ON-VISIT-AMT (4)
094800           GO TO RTC-CHECK.
094900
095000*    IF PT EARLIEST DATE = SN EARLIEST
095100*    THEN LUPA ADD ON APPLIES TO SN
095200*
095300
095400     IF (H-HHA-REVENUE-EARLIEST-DATE (1) =
095500         H-HHA-REVENUE-EARLIEST-DATE (4))
095600        COMPUTE  H-HHA-REVENUE-ADD-ON-VISIT-AMT (4) ROUNDED =
095700           H-HHA-REVENUE-DOLL-RATE (4) * LUPA-ADD-ON-SN4
095800        COMPUTE H-HHA-LUPA-ADD-ON-PAYMENT ROUNDED =
095900           H-HHA-LUPA-ADD-ON-PAYMENT +
096000           H-HHA-REVENUE-ADD-ON-VISIT-AMT (4)
096100           GO TO RTC-CHECK.
096200
096300*    IF SLT EARLIEST DATE = SN EARLIEST
096400*    THEN LUPA ADD ON APPLIES TO SN
096500*
096600
096700     IF (H-HHA-REVENUE-EARLIEST-DATE (3) =
096800         H-HHA-REVENUE-EARLIEST-DATE (4))
096900        COMPUTE  H-HHA-REVENUE-ADD-ON-VISIT-AMT (4) ROUNDED =
097000           H-HHA-REVENUE-DOLL-RATE (4) * LUPA-ADD-ON-SN4
097100        COMPUTE H-HHA-LUPA-ADD-ON-PAYMENT ROUNDED =
097200           H-HHA-LUPA-ADD-ON-PAYMENT +
097300           H-HHA-REVENUE-ADD-ON-VISIT-AMT (4)
097400           GO TO RTC-CHECK.
097500
097600*    IF PT  EARLIEST DATE = SLT EARLIEST
097700*    THEN LUPA ADD ON APPLIES TO PT
097800*
097900
098000     IF (H-HHA-REVENUE-EARLIEST-DATE (1) =
098100         H-HHA-REVENUE-EARLIEST-DATE (3))
098200        COMPUTE  H-HHA-REVENUE-ADD-ON-VISIT-AMT (1) ROUNDED =
098300           H-HHA-REVENUE-DOLL-RATE (1) * LUPA-ADD-ON-PT1
098400        COMPUTE H-HHA-LUPA-ADD-ON-PAYMENT ROUNDED =
098500           H-HHA-LUPA-ADD-ON-PAYMENT +
098600           H-HHA-REVENUE-ADD-ON-VISIT-AMT (1)
098700           GO TO RTC-CHECK.
098800
098900
099000 RTC-CHECK.
099100************************************************************
099200* ZERO OUT LUPA ADD-ON PAYMENT WHEN CERTAIN CONDITIONS MET *
099300************************************************************
099400
099500     MOVE H-HHA-HRG-OUTPUT-CODE (1) TO WORK-HRG.
099600
099700     IF H-HHA-ADMIT-DATE NOT = H-HHA-SERV-FROM-DATE
099800         MOVE 0 TO  H-HHA-LUPA-ADD-ON-PAYMENT
099900                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (1)
100000                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (2)
100100                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (3)
100200                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (4)
100300                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (5).
100400*
100500     IF (WORK-HRG1 =  '1' OR '2')
100600       NEXT SENTENCE
100700     ELSE
100800         MOVE 0 TO  H-HHA-LUPA-ADD-ON-PAYMENT
100900                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (1)
101000                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (2)
101100                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (3)
101200                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (4)
101300                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (5).
101400*
101500     IF (H-HHA-LUPA-SRC-ADM = 'B' OR 'C')
101600         MOVE 0 TO  H-HHA-LUPA-ADD-ON-PAYMENT
101700                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (1)
101800                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (2)
101900                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (3)
102000                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (4)
102100                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (5).
102200*
102300
102400     IF H-HHA-RECODE-IND  = '2'
102500         MOVE 0 TO  H-HHA-LUPA-ADD-ON-PAYMENT
102600                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (1)
102700                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (2)
102800                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (3)
102900                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (4)
103000                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (5).
103100
103200*
103300     IF H-HHA-REVENUE-SUM1-6-QTY-ALL = 0
103400         MOVE 0 TO  H-HHA-LUPA-ADD-ON-PAYMENT
103500                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (1)
103600                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (2)
103700                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (3)
103800                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (4)
103900                    H-HHA-REVENUE-ADD-ON-VISIT-AMT (5).
104000*
104100        PERFORM 1050-LUPA THRU 1050-EXIT.
104200
104300        IF H-HHA-LUPA-ADD-ON-PAYMENT > 0
104400           MOVE '14' TO H-HHA-PAY-RTC
104500        ELSE
104600           MOVE '06' TO H-HHA-PAY-RTC
104700        END-IF.
104800
104900**   CHANGE DATES WITH DEFAULT BACK TO ZERO FOR PASSBACK       **
105000
105100     IF H-HHA-REVENUE-EARLIEST-DATE (1) = 29990101
105200        MOVE 0 TO H-HHA-REVENUE-EARLIEST-DATE (1).
105300
105400     IF H-HHA-REVENUE-EARLIEST-DATE (3) = 29990101
105500        MOVE 0 TO H-HHA-REVENUE-EARLIEST-DATE (3).
105600
105700     IF H-HHA-REVENUE-EARLIEST-DATE (4) = 29990101
105800        MOVE 0 TO H-HHA-REVENUE-EARLIEST-DATE (4).
105900
106000
106100        COMPUTE H-HHA-TOTAL-PAYMENT   ROUNDED =
106200                H-HHA-REVENUE-COST (1) +
106300                H-HHA-REVENUE-ADD-ON-VISIT-AMT (1) +
106400                H-HHA-REVENUE-COST (2) +
106500                H-HHA-REVENUE-ADD-ON-VISIT-AMT (2) +
106600                H-HHA-REVENUE-COST (3) +
106700                H-HHA-REVENUE-ADD-ON-VISIT-AMT (3) +
106800                H-HHA-REVENUE-COST (4) +
106900                H-HHA-REVENUE-ADD-ON-VISIT-AMT (4) +
107000                H-HHA-REVENUE-COST (5) +
107100                H-HHA-REVENUE-ADD-ON-VISIT-AMT (5) +
107200                H-HHA-REVENUE-COST (6) +
107300                H-HHA-REVENUE-ADD-ON-VISIT-AMT (6).
107400
107500        GO TO 1000-EXIT.
107600
107700 PEP-CHECK.
107800
107900     IF (H-HHA-PEP-INDICATOR NOT = 'Y' AND NOT = 'N')
108000         MOVE '20' TO H-HHA-PAY-RTC
108100         GO TO 1000-EXIT.
108200
108300      PERFORM 1100-ADD-HRG-DAYS THRU 1100-EXIT
108400         VARYING CO1 FROM 1 BY 1 UNTIL CO1 > 6.
108500
108600      IF WK-HRG-NO-OF-DAYS-TOT > 60
108700         MOVE '16' TO H-HHA-PAY-RTC
108800         GO TO 1000-EXIT.
108900
109000
109100*********  HRG  PAYMENT   *******************
109200
109300***  IF H-HHA-REVENUE-SUM1-3-QTY-THR > 9
109400        IF H-HHA-HRG-INPUT-CODE (2) = SPACES
109500           IF H-HHA-PEP-INDICATOR = 'N'
109600              PERFORM 3000-PEP-N-ADJUST THRU 3000-EXIT
109700                  VARYING CO1 FROM 1 BY 1 UNTIL
109800*                 (H-HHA-HRG-INPUT-CODE (CO1) = SPACES OR
109900                   CO1 > 6
110000               PERFORM 7000-OUTLIER-PAYMENT THRU 7000-EXIT
110100               GO TO 1000-EXIT.
110200
110300
110400***  IF H-HHA-REVENUE-SUM1-3-QTY-THR > 9
110500        IF H-HHA-HRG-INPUT-CODE (2) = SPACES
110600           IF H-HHA-PEP-INDICATOR = 'Y'
110700              PERFORM 4000-PEP-Y-ADJUST THRU 4000-EXIT
110800                  VARYING CO1 FROM 1 BY 1 UNTIL
110900*                 (H-HHA-HRG-INPUT-CODE (CO1) = SPACES OR
111000                   CO1 > 6
111100               PERFORM 7000-OUTLIER-PAYMENT THRU 7000-EXIT
111200               GO TO 1000-EXIT.
111300
111400**** IF H-HHA-REVENUE-SUM1-3-QTY-THR > 9
111500        IF H-HHA-HRG-INPUT-CODE (2) NOT = SPACES
111600           IF H-HHA-PEP-INDICATOR = 'N'
111700              PERFORM 5000-PEP-N-ADJUST THRU 5000-EXIT
111800                  VARYING CO1 FROM 1 BY 1 UNTIL
111900*                 (H-HHA-HRG-INPUT-CODE (CO1) = SPACES OR
112000                   CO1 > 6
112100               PERFORM 7000-OUTLIER-PAYMENT THRU 7000-EXIT
112200               GO TO 1000-EXIT.
112300
112400**** IF H-HHA-REVENUE-SUM1-3-QTY-THR > 9
112500        IF H-HHA-HRG-INPUT-CODE (2) NOT = SPACES
112600           IF H-HHA-PEP-INDICATOR = 'Y'
112700              PERFORM 6000-PEP-Y-ADJUST THRU 6000-EXIT
112800                  VARYING CO1 FROM 1 BY 1 UNTIL
112900*                 (H-HHA-HRG-INPUT-CODE (CO1) = SPACES OR
113000                   CO1 > 6
113100               PERFORM 7000-OUTLIER-PAYMENT THRU 7000-EXIT
113200               GO TO 1000-EXIT.
113300
113400
113500      MOVE '20' TO H-HHA-PAY-RTC.
113600
113700 1000-EXIT.  EXIT.
113800 1050-LUPA.
113900
114000***************************************************************
114100*                    LUPA PAYMENT
114200***************************************************************
114300
114400*    IF H-HHA-REVENUE-QTY-COV-VISITS (1) = 0
114500*       GO TO 1050-EXIT.
114600
114700     MOVE H-HHA-HRG-OUTPUT-CODE (1) TO WORK-HRG.
114800
114900     COMPUTE FED-ADJ1 ROUNDED =
115000            (H-HHA-REVENUE-QTY-COV-VISITS (1) *
115100             H-HHA-REVENUE-DOLL-RATE (1)).
115200
115300     COMPUTE FED-LUPA-ADJ1 ROUNDED =
115400             H-HHA-REVENUE-ADD-ON-VISIT-AMT (1).
115500
115600     COMPUTE FED-LABOR-ADJ1 ROUNDED =
115700             WIR-CBSA-WAGEIND *
115800             LABOR-PERCENT *
115900             FED-ADJ1.
116000
116100     COMPUTE FED-LABOR-LUPA-ADJ1 ROUNDED =
116200             WIR-CBSA-WAGEIND *
116300             LABOR-PERCENT *
116400             FED-LUPA-ADJ1.
116500
116600     COMPUTE FED-NON-LABOR-ADJ1 ROUNDED =
116700             NONLABOR-PERCENT *
116800             FED-ADJ1.
116900
117000     COMPUTE FED-NON-LABOR-LUPA-ADJ1 ROUNDED =
117100             NONLABOR-PERCENT *
117200             FED-LUPA-ADJ1.
117300
117400     COMPUTE H-HHA-REVENUE-COST (1) ROUNDED =
117500             (FED-LABOR-ADJ1 + FED-NON-LABOR-ADJ1).
117600
117700     COMPUTE H-HHA-REVENUE-ADD-ON-VISIT-AMT (1) ROUNDED =
117800             (FED-LABOR-LUPA-ADJ1 + FED-NON-LABOR-LUPA-ADJ1).
117900
118000     COMPUTE FED-ADJ2 ROUNDED =
118100            (H-HHA-REVENUE-QTY-COV-VISITS (2) *
118200             H-HHA-REVENUE-DOLL-RATE (2)).
118300
118400     COMPUTE FED-LABOR-ADJ2 ROUNDED =
118500             WIR-CBSA-WAGEIND *
118600             LABOR-PERCENT *
118700             FED-ADJ2.
118800
118900     COMPUTE FED-NON-LABOR-ADJ2 ROUNDED =
119000             NONLABOR-PERCENT *
119100             FED-ADJ2.
119200
119300     COMPUTE H-HHA-REVENUE-COST (2) ROUNDED =
119400             (FED-LABOR-ADJ2 + FED-NON-LABOR-ADJ2).
119500
119600     COMPUTE FED-ADJ3 ROUNDED =
119700            (H-HHA-REVENUE-QTY-COV-VISITS (3) *
119800             H-HHA-REVENUE-DOLL-RATE (3)).
119900
120000     COMPUTE FED-LUPA-ADJ3 ROUNDED =
120100             H-HHA-REVENUE-ADD-ON-VISIT-AMT (3).
120200
120300     COMPUTE FED-LABOR-ADJ3 ROUNDED =
120400             WIR-CBSA-WAGEIND *
120500             LABOR-PERCENT *
120600             FED-ADJ3.
120700
120800     COMPUTE FED-LABOR-LUPA-ADJ3 ROUNDED =
120900             WIR-CBSA-WAGEIND *
121000             LABOR-PERCENT *
121100             FED-LUPA-ADJ3.
121200
121300     COMPUTE FED-NON-LABOR-ADJ3 ROUNDED =
121400             NONLABOR-PERCENT *
121500             FED-ADJ3.
121600
121700     COMPUTE FED-NON-LABOR-LUPA-ADJ3 ROUNDED =
121800             NONLABOR-PERCENT *
121900             FED-LUPA-ADJ3.
122000
122100     COMPUTE H-HHA-REVENUE-COST (3) ROUNDED =
122200             (FED-LABOR-ADJ3 + FED-NON-LABOR-ADJ3).
122300
122400     COMPUTE H-HHA-REVENUE-ADD-ON-VISIT-AMT (3) ROUNDED =
122500             (FED-LABOR-LUPA-ADJ3 + FED-NON-LABOR-LUPA-ADJ3).
122600
122700     COMPUTE FED-ADJ4 ROUNDED =
122800            (H-HHA-REVENUE-QTY-COV-VISITS (4) *
122900             H-HHA-REVENUE-DOLL-RATE (4)).
123000
123100     COMPUTE FED-LUPA-ADJ4 ROUNDED =
123200             H-HHA-REVENUE-ADD-ON-VISIT-AMT (4).
123300
123400     COMPUTE FED-LABOR-ADJ4 ROUNDED =
123500             WIR-CBSA-WAGEIND *
123600             LABOR-PERCENT *
123700             FED-ADJ4.
123800
123900     COMPUTE FED-LABOR-LUPA-ADJ4 ROUNDED =
124000             WIR-CBSA-WAGEIND *
124100             LABOR-PERCENT *
124200             FED-LUPA-ADJ4.
124300
124400     COMPUTE FED-NON-LABOR-ADJ4 ROUNDED =
124500             NONLABOR-PERCENT *
124600             FED-ADJ4.
124700
124800     COMPUTE FED-NON-LABOR-LUPA-ADJ4 ROUNDED =
124900             NONLABOR-PERCENT *
125000             FED-LUPA-ADJ4.
125100
125200     COMPUTE H-HHA-REVENUE-COST (4) ROUNDED =
125300             (FED-LABOR-ADJ4 + FED-NON-LABOR-ADJ4).
125400
125500     COMPUTE H-HHA-REVENUE-ADD-ON-VISIT-AMT (4) ROUNDED =
125600             (FED-LABOR-LUPA-ADJ4 + FED-NON-LABOR-LUPA-ADJ4).
125700
125800     COMPUTE FED-ADJ5 ROUNDED =
125900            (H-HHA-REVENUE-QTY-COV-VISITS (5) *
126000             H-HHA-REVENUE-DOLL-RATE (5)).
126100
126200     COMPUTE FED-LABOR-ADJ5 ROUNDED =
126300             WIR-CBSA-WAGEIND *
126400             LABOR-PERCENT *
126500             FED-ADJ5.
126600
126700
126800     COMPUTE FED-NON-LABOR-ADJ5 ROUNDED =
126900             NONLABOR-PERCENT *
127000             FED-ADJ5.
127100
127200     COMPUTE H-HHA-REVENUE-COST (5) ROUNDED =
127300             (FED-LABOR-ADJ5 + FED-NON-LABOR-ADJ5).
127400
127500     COMPUTE FED-ADJ6 ROUNDED =
127600            (H-HHA-REVENUE-QTY-COV-VISITS (6) *
127700             H-HHA-REVENUE-DOLL-RATE (6)).
127800
127900     COMPUTE FED-LABOR-ADJ6 ROUNDED =
128000             WIR-CBSA-WAGEIND *
128100             LABOR-PERCENT *
128200             FED-ADJ6.
128300
128400
128500     COMPUTE FED-NON-LABOR-ADJ6 ROUNDED =
128600             NONLABOR-PERCENT *
128700             FED-ADJ6.
128800
128900     COMPUTE H-HHA-REVENUE-COST (6) ROUNDED =
129000             (FED-LABOR-ADJ6 + FED-NON-LABOR-ADJ6).
129100
129200
129300 1050-EXIT.   EXIT.
129400
129500 1100-ADD-HRG-DAYS.
129600
129700      IF H-HHA-HRG-NO-OF-DAYS (CO1) NUMERIC
129800         ADD H-HHA-HRG-NO-OF-DAYS (CO1) TO
129900             WK-HRG-NO-OF-DAYS-TOT.
130000
130100 1100-EXIT.   EXIT.
130200
130300 3000-PEP-N-ADJUST.
130400
130500***************************************************************
130600*           HRG OCCUR < 2 AND PEP = N ADJUSTMENT
130700***************************************************************
130800
130900     IF H-HHA-HRG-INPUT-CODE (CO1) = SPACES
131000        MOVE 6 TO CO1
131100        GO TO 3000-EXIT.
131200
131300     MOVE H-HHA-HRG-NO-OF-DAYS (CO1) TO WK-HRG-NO-OF-DAYS.
131400
131500     MOVE H-HHA-HRG-OUTPUT-CODE (CO1) TO WORK-HRG.
131600
131700*         YEARCHANGE                              ===========**
131800
131900      PERFORM 10100-SUPPLY-ADD-ON-CALC  THRU 10100-EXIT.
132000
132100*         YEARCHANGE                              ===========**
132200
132300
132400*    IF HHA-SERV-THRU-DATE > 20071231 AND
132500*       HHA-SERV-FROM-DATE > 20071231
132600*        NEXT SENTENCE
132700*    ELSE
132800*        MOVE 0000000.00 TO FED-SUPPLY-ADJ.
132900
133000     COMPUTE FED-ADJ ROUNDED =
133100               H-HHA-HRG-WGTS (1) * FED-EPISODE-RATE-AMT.
133200
133300     COMPUTE FED-LABOR-ADJ ROUNDED =
133400              (WIR-CBSA-WAGEIND *
133500               LABOR-PERCENT * FED-ADJ).
133600
133700     COMPUTE FED-NON-LABOR-ADJ ROUNDED =
133800              (NONLABOR-PERCENT * FED-ADJ).
133900
134000     COMPUTE WK-3000-PEP-N-PAYMENT ROUNDED =
134100          (FED-LABOR-ADJ + FED-NON-LABOR-ADJ + FED-SUPPLY-ADJ).
134200
134300     COMPUTE H-HHA-HRG-PAY (CO1) ROUNDED =
134400             WK-3000-PEP-N-PAYMENT.
134500
134600     COMPUTE WK-3000-PEP-N-PRETOT-PAY ROUNDED =
134700             WK-3000-PEP-N-PRETOT-PAY + WK-3000-PEP-N-PAYMENT.
134800
134900
135000 3000-EXIT.   EXIT.
135100
135200 4000-PEP-Y-ADJUST.
135300
135400***************************************************************
135500*           HRG OCCUR < 2 AND PEP = Y ADJUSTMENT
135600***************************************************************
135700
135800     IF H-HHA-HRG-INPUT-CODE (CO1) = SPACES
135900        MOVE 6 TO SUB1
136000        GO TO 4000-EXIT.
136100
136200     MOVE 2 TO WK-RTC-ADJ-IND.
136300
136400     MOVE H-HHA-HRG-NO-OF-DAYS (CO1) TO WK-HRG-NO-OF-DAYS.
136500
136600     MOVE H-HHA-HRG-OUTPUT-CODE (CO1) TO WORK-HRG.
136700
136800*         YEARCHANGE                              ===========**
136900
137000      PERFORM 10100-SUPPLY-ADD-ON-CALC  THRU 10100-EXIT.
137100
137200*         YEARCHANGE                              ===========**
137300
137400
137500*    IF HHA-SERV-THRU-DATE > 20071231 AND
137600*       HHA-SERV-FROM-DATE > 20071231
137700*        NEXT SENTENCE
137800*    ELSE
137900*        MOVE 0000000.00 TO FED-SUPPLY-ADJ.
138000
138100
138200     COMPUTE FED-ADJP ROUNDED =
138300               H-HHA-HRG-WGTS (1) * FED-EPISODE-RATE-AMT.
138400
138500     COMPUTE FED-LABOR-ADJP ROUNDED =
138600               WIR-CBSA-WAGEIND *
138700               LABOR-PERCENT * FED-ADJP.
138800
138900     COMPUTE FED-NON-LABOR-ADJP ROUNDED =
139000               NONLABOR-PERCENT * FED-ADJP.
139100
139200     COMPUTE WK-4000-PEP-Y-PAYMENT ROUNDED =
139300         (FED-LABOR-ADJP + FED-NON-LABOR-ADJP + FED-SUPPLY-ADJ).
139400
139500     COMPUTE WK-HRG-NO-OF-DAYS-FAC ROUNDED =
139600               (WK-HRG-NO-OF-DAYS / 60).
139700
139800     COMPUTE WK-4000-PEP-Y-PAYMENT ROUNDED =
139900             WK-4000-PEP-Y-PAYMENT *
140000             WK-HRG-NO-OF-DAYS-FAC.
140100
140200     COMPUTE H-HHA-HRG-PAY (CO1) ROUNDED =
140300             WK-4000-PEP-Y-PAYMENT.
140400
140500     COMPUTE WK-4000-PEP-Y-PRETOT-PAY ROUNDED =
140600             WK-4000-PEP-Y-PRETOT-PAY + WK-4000-PEP-Y-PAYMENT.
140700
140800
140900 4000-EXIT.   EXIT.
141000 5000-PEP-N-ADJUST.
141100
141200***************************************************************
141300*           HRG OCCUR > 1 AND PEP = N ADJUSTMENT
141400***************************************************************
141500
141600     IF H-HHA-HRG-INPUT-CODE (CO1) = SPACES
141700        MOVE 6 TO SUB1
141800        GO TO 5000-EXIT.
141900
142000     MOVE 1 TO WK-RTC-ADJ-IND.
142100
142200     MOVE H-HHA-HRG-NO-OF-DAYS (CO1) TO WK-HRG-NO-OF-DAYS.
142300
142400     MOVE H-HHA-HRG-OUTPUT-CODE (CO1) TO WORK-HRG.
142500
142600*         YEARCHANGE                              ===========**
142700
142800      PERFORM 10100-SUPPLY-ADD-ON-CALC  THRU 10100-EXIT.
142900
143000*         YEARCHANGE                              ===========**
143100
143200
143300*    IF HHA-SERV-THRU-DATE > 20071231 AND
143400*       HHA-SERV-FROM-DATE > 20071231
143500*        NEXT SENTENCE
143600*    ELSE
143700*        MOVE 0000000.00 TO FED-SUPPLY-ADJ.
143800
143900
144000     COMPUTE FED-ADJ ROUNDED =
144100               (WK-HRG-NO-OF-DAYS  *
144200                H-HHA-HRG-WGTS (CO1) *
144300                FED-EPISODE-RATE-AMT) / 60.
144400
144500     COMPUTE FED-LABOR-ADJ ROUNDED =
144600               WIR-CBSA-WAGEIND *
144700               LABOR-PERCENT * FED-ADJ.
144800
144900     COMPUTE FED-NON-LABOR-ADJ ROUNDED =
145000               NONLABOR-PERCENT * FED-ADJ.
145100
145200     COMPUTE WK-5000-PEP-N-PAYMENT ROUNDED =
145300           (FED-LABOR-ADJ + FED-NON-LABOR-ADJ + FED-SUPPLY-ADJ).
145400
145500     COMPUTE H-HHA-HRG-PAY (CO1) ROUNDED =
145600             WK-5000-PEP-N-PAYMENT.
145700
145800
145900     COMPUTE WK-5000-PEP-N-PRETOT-PAY ROUNDED =
146000             WK-5000-PEP-N-PRETOT-PAY + WK-5000-PEP-N-PAYMENT.
146100
146200
146300 5000-EXIT.   EXIT.
146400 6000-PEP-Y-ADJUST.
146500
146600***************************************************************
146700*           HRG OCCUR > 1 AND PEP = Y SHORTENED EPISODE
146800***************************************************************
146900
147000     IF H-HHA-HRG-INPUT-CODE (CO1) = SPACES
147100        MOVE 6 TO SUB1
147200        GO TO 6000-EXIT.
147300
147400     MOVE 3 TO WK-RTC-ADJ-IND.
147500
147600     MOVE H-HHA-HRG-NO-OF-DAYS (CO1) TO WK-HRG-NO-OF-DAYS.
147700     MOVE H-HHA-PEP-DAYS             TO WK-PEP-DAYS.
147800
147900     MOVE H-HHA-HRG-OUTPUT-CODE (CO1) TO WORK-HRG.
148000
148100*         YEARCHANGE                              ===========**
148200
148300      PERFORM 10100-SUPPLY-ADD-ON-CALC  THRU 10100-EXIT.
148400
148500*         YEARCHANGE                              ===========**
148600
148700
148800*    IF HHA-SERV-THRU-DATE > 20071231 AND
148900*       HHA-SERV-FROM-DATE > 20071231
149000*        NEXT SENTENCE
149100*    ELSE
149200*        MOVE 0000000.00 TO FED-SUPPLY-ADJ.
149300*
149400*    COMPUTE FED-ADJ ROUNDED =
149500*        (WK-HRG-NO-OF-DAYS / WK-PEP-DAYS)
149600*                                *
149700*                    ((WK-PEP-DAYS / 60)
149800*                                *
149900*          (H-HHA-HRG-WGTS (CO1) * FED-EPISODE-RATE-AMT)).
150000*
150100*
150200*    COMPUTE FED-ADJ ROUNDED =
150300*        (WK-HRG-NO-OF-DAYS / WK-PEP-DAYS)
150400*                                *
150500*      ((WK-PEP-DAYS * H-HHA-HRG-WGTS (CO1) *
150600*                          FED-EPISODE-RATE-AMT) / 60).
150700
150800     COMPUTE FED-ADJ  ROUNDED =
150900      ((WK-PEP-DAYS * H-HHA-HRG-WGTS (CO1) *
151000                           FED-EPISODE-RATE-AMT) / 60).
151100
151200     COMPUTE FED-ADJ ROUNDED  =
151300                  (FED-ADJP * WK-HRG-NO-OF-DAYS) / WK-PEP-DAYS.
151400
151500     COMPUTE FED-LABOR-ADJ ROUNDED =
151600               WIR-CBSA-WAGEIND *
151700               LABOR-PERCENT * FED-ADJ.
151800
151900     COMPUTE FED-NON-LABOR-ADJ ROUNDED =
152000               NONLABOR-PERCENT * FED-ADJ.
152100
152200     COMPUTE WK-6000-PEP-Y-PAYMENT ROUNDED =
152300          (FED-LABOR-ADJ + FED-NON-LABOR-ADJ + FED-SUPPLY-ADJ).
152400
152500     COMPUTE H-HHA-HRG-PAY (CO1) ROUNDED =
152600             WK-6000-PEP-Y-PAYMENT.
152700
152800     COMPUTE WK-6000-PEP-Y-PRETOT-PAY ROUNDED =
152900             WK-6000-PEP-Y-PRETOT-PAY + WK-6000-PEP-Y-PAYMENT.
153000
153100
153200 6000-EXIT.   EXIT.
153300
153400 7000-OUTLIER-PAYMENT.
153500***************************************************************
153600*                    OUTLIER PAYMENT
153700***************************************************************
153800     COMPUTE OUT-THRES-LABOR-ADJ ROUNDED =
153900               WIR-CBSA-WAGEIND *
154000               LABOR-PERCENT * OUTLIER-THRESHOLD-AMT.
154100
154200     COMPUTE OUT-THRES-NON-LABOR-ADJ ROUNDED =
154300               NONLABOR-PERCENT * OUTLIER-THRESHOLD-AMT.
154400
154500     COMPUTE OUT-THRES-AMT-ADJ ROUNDED  =
154600             (OUT-THRES-LABOR-ADJ +
154700              OUT-THRES-NON-LABOR-ADJ).
154800
154900      COMPUTE WK-7000-OUTLIER-VALUE-A ROUNDED =
155000              OUT-THRES-AMT-ADJ +
155100             WK-3000-PEP-N-PRETOT-PAY +
155200             WK-4000-PEP-Y-PRETOT-PAY +
155300             WK-5000-PEP-N-PRETOT-PAY +
155400             WK-6000-PEP-Y-PRETOT-PAY.
155500
155600      PERFORM 8000-ADD-REV-DOLL THRU 8000-EXIT
155700                  VARYING CO1 FROM 1 BY 1 UNTIL
155800                   CO1 > 6.
155900
156000      COMPUTE WK-7000-AB-DIFF ROUNDED =
156100              WK-8000-OUTLIER-VALUE-B - WK-7000-OUTLIER-VALUE-A.
156200****===================
156300      IF WK-7000-AB-DIFF > ZERO
156400         COMPUTE WK-7000-CALC ROUNDED =
156500               OUTL-LOSS-SHAR-RATIO-PERCENT * WK-7000-AB-DIFF
156600
156700*** ================== NEW OUTLIER CAP HERE ========
156800         PERFORM 10000-OUTLIER-CAP-CALC THRU 10000-EXIT
156900*** ================== NEW OUTLIER CAP HERE ========
157000
157100****===================
157200         COMPUTE H-HHA-OUTLIER-PAYMENT ROUNDED =
157300               WK-7000-CALC
157400
157500****===================
157600         COMPUTE H-HHA-TOTAL-PAYMENT ROUNDED =
157700                (WK-7000-CALC +
157800                 WK-3000-PEP-N-PRETOT-PAY +
157900                 WK-4000-PEP-Y-PRETOT-PAY +
158000                 WK-5000-PEP-N-PRETOT-PAY +
158100                 WK-6000-PEP-Y-PRETOT-PAY)
158200
158300          PERFORM 9000-WHICH-RTC-OUTLIER THRU 9000-EXIT
158400      ELSE
158500         COMPUTE H-HHA-TOTAL-PAYMENT ROUNDED =
158600                (WK-3000-PEP-N-PRETOT-PAY +
158700                 WK-4000-PEP-Y-PRETOT-PAY +
158800                 WK-5000-PEP-N-PRETOT-PAY +
158900                 WK-6000-PEP-Y-PRETOT-PAY)
159000          PERFORM 9050-WHICH-RTC-NO-OUTLIER THRU 9050-EXIT.
159100
159200
159300 7000-EXIT.   EXIT.
159400
159500 8000-ADD-REV-DOLL.
159600
159700***************************************************************
159800*        ADD ALL REVENUE DOLLARS
159900***************************************************************
160000
160100     IF H-HHA-REVENUE-CODE (CO1) = SPACES
160200        MOVE 6 TO CO1
160300        GO TO 8000-EXIT.
160400
160500     IF H-HHA-REVENUE-QTY-COV-VISITS (CO1) = 0
160600        GO TO 8000-EXIT.
160700
160800     COMPUTE FED-ADJ ROUNDED =
160900                H-HHA-REVENUE-DOLL-RATE (CO1) *
161000                H-HHA-REVENUE-QTY-COV-VISITS (CO1).
161100
161200     COMPUTE FED-LABOR-ADJ ROUNDED =
161300               WIR-CBSA-WAGEIND *
161400               LABOR-PERCENT * FED-ADJ.
161500
161600     COMPUTE FED-NON-LABOR-ADJ ROUNDED =
161700               NONLABOR-PERCENT * FED-ADJ.
161800
161900     COMPUTE WK-8000-OUTLIER-LAB-NLAB ROUNDED =
162000           (FED-LABOR-ADJ + FED-NON-LABOR-ADJ).
162100
162200
162300     COMPUTE H-HHA-REVENUE-COST (CO1) ROUNDED =
162400               WK-8000-OUTLIER-LAB-NLAB.
162500
162600     COMPUTE WK-8000-OUTLIER-VALUE-B ROUNDED =
162700             WK-8000-OUTLIER-VALUE-B + WK-8000-OUTLIER-LAB-NLAB.
162800
162900 8000-EXIT.   EXIT.
163000
163100 9000-WHICH-RTC-OUTLIER.
163200
163300      MOVE '01' TO H-HHA-PAY-RTC.
163400      IF WK-RTC-ADJ-IND = 1  MOVE '08' TO H-HHA-PAY-RTC.
163500      IF WK-RTC-ADJ-IND = 2  MOVE '11' TO H-HHA-PAY-RTC.
163600      IF WK-RTC-ADJ-IND = 3  MOVE '13' TO H-HHA-PAY-RTC.
163700      IF WK-RTC-ADJ-IND = 4  MOVE '02' TO H-HHA-PAY-RTC.
163800
163900
164000 9000-EXIT.   EXIT.
164100
164200 9050-WHICH-RTC-NO-OUTLIER.
164300
164400      MOVE '00' TO H-HHA-PAY-RTC.
164500
164600      IF WK-RTC-ADJ-IND = 1  MOVE '07' TO H-HHA-PAY-RTC.
164700      IF WK-RTC-ADJ-IND = 2  MOVE '09' TO H-HHA-PAY-RTC.
164800      IF WK-RTC-ADJ-IND = 3  MOVE '12' TO H-HHA-PAY-RTC.
164900
165000 9050-EXIT.   EXIT.
165100
165200*         YEARCHANGE  2011.0                      ===========**
165300
165400 10000-OUTLIER-CAP-CALC.
165500
165600     IF  HHA-PROV-PAYMET-TOTAL = 0
165700        GO TO 10000-EXIT.
165800
165900     IF  HHA-PROV-OUTLIER-PAY-TOTAL = 0
166000        GO TO 10000-EXIT.
166100
166200     COMPUTE WK-10000-OUTLIER-POOL-PERCENT ROUNDED =
166300         HHA-PROV-PAYMET-TOTAL * .1.
166400
166500     COMPUTE WK-10000-OUTLIER-AVAIL-POOL ROUNDED =
166600      WK-10000-OUTLIER-POOL-PERCENT - HHA-PROV-OUTLIER-PAY-TOTAL.
166700
166800      COMPUTE WK-10000-OUTLIER-POOL-DIF ROUNDED =
166900         WK-10000-OUTLIER-AVAIL-POOL - WK-7000-CALC.
167000
167100      IF WK-10000-OUTLIER-POOL-DIF > 0
167200        GO TO 10000-EXIT.
167300
167400      IF WK-10000-OUTLIER-POOL-DIF < 0 OR
167500         HHA-PROV-OUTLIER-PAY-TOTAL < 0
167600        COMPUTE WK-7000-CALC ROUNDED = 0
167700        MOVE 4 TO WK-RTC-ADJ-IND.
167800
167900*         YEARCHANGE  2011.0                      ===========**
168000
168100 10000-EXIT.   EXIT.
168200
168300*         YEARCHANGE  2014.0                      ===========**
168400
168500 10100-SUPPLY-ADD-ON-CALC.
168600
168700
168800     IF HHA-CBSA-RURAL-CHECK
168900     OR HHA-CBSA-RURAL-CHECK-ALL
169000       GO TO RURAL-DATA-CHECK.
169100
169200     IF HHA-WITH-DATA-CHECK
169300       NEXT SENTENCE
169400     ELSE
169500       GO TO NO-DATA-CHECK.
169600
169700*         YEARCHANGE  2014.0 NON RURAL W/ QUALITY DATA =====**
169800*         YEARCHANGE  2014.0 TABLE 10B 1ST COL         =====**
169900
170000        IF  WORK-HRG5 = 'S' OR '1'
170100         MOVE 0000014.47 TO FED-SUPPLY-ADJ
170200         GO TO 10100-EXIT.
170300
170400        IF  WORK-HRG5 = 'T' OR '2'
170500         MOVE 0000052.27 TO FED-SUPPLY-ADJ
170600         GO TO 10100-EXIT.
170700
170800        IF  WORK-HRG5 = 'U' OR '3'
170900         MOVE 0000143.31 TO FED-SUPPLY-ADJ
171000         GO TO 10100-EXIT.
171100
171200        IF  WORK-HRG5 = 'V' OR '4'
171300         MOVE 0000212.92 TO FED-SUPPLY-ADJ
171400         GO TO 10100-EXIT.
171500
171600        IF  WORK-HRG5 = 'W' OR '5'
171700         MOVE 0000328.33 TO FED-SUPPLY-ADJ
171800         GO TO 10100-EXIT.
171900
172000        IF  WORK-HRG5 = 'X' OR '6'
172100         MOVE 0000564.69 TO FED-SUPPLY-ADJ
172200         GO TO 10100-EXIT.
172300
172400 NO-DATA-CHECK.
172500
172600     IF HHA-NO-DATA-CHECK
172700       NEXT SENTENCE
172800     ELSE
172900         GO TO 10100-EXIT.
173000
173100*         YEARCHANGE  2014.0 NON RURAL WO/ QUALITY DATA ====**
173200*         YEARCHANGE  2014.0 TABLE 10B 2ND COL         =====**
173300
173400        IF  WORK-HRG5 = 'S' OR '1'
173500         MOVE 0000014.19 TO FED-SUPPLY-ADJ
173600         GO TO 10100-EXIT.
173700
173800        IF  WORK-HRG5 = 'T' OR '2'
173900         MOVE 0000051.25 TO FED-SUPPLY-ADJ
174000         GO TO 10100-EXIT.
174100
174200        IF  WORK-HRG5 = 'U' OR '3'
174300         MOVE 0000140.53 TO FED-SUPPLY-ADJ
174400         GO TO 10100-EXIT.
174500
174600        IF  WORK-HRG5 = 'V' OR '4'
174700         MOVE 0000208.79 TO FED-SUPPLY-ADJ
174800         GO TO 10100-EXIT.
174900
175000        IF  WORK-HRG5 = 'W' OR '5'
175100         MOVE 0000321.96 TO FED-SUPPLY-ADJ
175200         GO TO 10100-EXIT.
175300
175400        IF  WORK-HRG5 = 'X' OR '6'
175500         MOVE 0000553.74 TO FED-SUPPLY-ADJ
175600         GO TO 10100-EXIT.
175700
175800
175900 RURAL-DATA-CHECK.
176000
176100     IF HHA-WITH-DATA-CHECK
176200       NEXT SENTENCE
176300     ELSE
176400       GO TO RURAL-NO-DATA-CHECK.
176500
176600*         YEARCHANGE  2014.0 RURAL W/ QUALITY DATA ====**
176700*         YEARCHANGE  2014.0 TABLE  6B  COL 3          =====**
176800
176900        IF  WORK-HRG5 = 'S' OR '1'
177000         MOVE 0000014.91 TO FED-SUPPLY-ADJ
177100         GO TO 10100-EXIT.
177200
177300        IF  WORK-HRG5 = 'T' OR '2'
177400         MOVE 0000053.83 TO FED-SUPPLY-ADJ
177500         GO TO 10100-EXIT.
177600
177700        IF  WORK-HRG5 = 'U' OR '3'
177800         MOVE 0000147.61 TO FED-SUPPLY-ADJ
177900         GO TO 10100-EXIT.
178000
178100        IF  WORK-HRG5 = 'V' OR '4'
178200         MOVE 0000219.30 TO FED-SUPPLY-ADJ
178300         GO TO 10100-EXIT.
178400
178500        IF  WORK-HRG5 = 'W' OR '5'
178600         MOVE 0000338.18 TO FED-SUPPLY-ADJ
178700         GO TO 10100-EXIT.
178800
178900        IF  WORK-HRG5 = 'X' OR '6'
179000         MOVE 0000581.63 TO FED-SUPPLY-ADJ.
179100         GO TO 10100-EXIT.
179200
179300 RURAL-NO-DATA-CHECK.
179400
179500     IF HHA-NO-DATA-CHECK
179600       NEXT SENTENCE
179700     ELSE
179800         GO TO 10100-EXIT.
179900
180000*         YEARCHANGE  2014.0 RURAL WO/ QUALITY DATA ====**
180100*         YEARCHANGE  2014.0 TABLE  7B COL 4           =====**
180200
180300
180400        IF  WORK-HRG5 = 'S' OR '1'
180500         MOVE 0000014.62 TO FED-SUPPLY-ADJ
180600         GO TO 10100-EXIT.
180700
180800        IF  WORK-HRG5 = 'T' OR '2'
180900         MOVE 0000052.79 TO FED-SUPPLY-ADJ
181000         GO TO 10100-EXIT.
181100
181200        IF  WORK-HRG5 = 'U' OR '3'
181300         MOVE 0000144.75 TO FED-SUPPLY-ADJ
181400         GO TO 10100-EXIT.
181500
181600        IF  WORK-HRG5 = 'V' OR '4'
181700         MOVE 0000215.06 TO FED-SUPPLY-ADJ
181800         GO TO 10100-EXIT.
181900
182000        IF  WORK-HRG5 = 'W' OR '5'
182100         MOVE 0000331.63 TO FED-SUPPLY-ADJ
182200         GO TO 10100-EXIT.
182300
182400        IF  WORK-HRG5 = 'X' OR '6'
182500         MOVE 0000570.37 TO FED-SUPPLY-ADJ
182600         GO TO 10100-EXIT.
182700
182800
182900*         YEARCHANGE  2014.0                      ===========**
183000
183100 10100-EXIT.   EXIT.
183200
183300******        L A S T   S O U R C E   S T A T E M E N T   *****
