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