000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID.      HHCAL113.
000300*AUTHOR.          DDS TEAM.
000450*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
002400*     HHCAL113 ADD NEW FIELDS FOR EARLIEST DATES
002500******************************************************************
002600******************************************************************
002700*            RETURN CODE VALUES (HHA-RTC)
002800*
002900*        HHA-RTC  WITH PAYMENTS RETURNED
003000*
003100*     RETURN CODES
003200*          00 = FINAL PAYMENT
003300*               TOB = 329,339,327,337
003400*                  OR 32G OR 33G OR 32I OR 33I OR 32Q
003500*                  OR 32J OR 33J OR 32M OR 33M OR 33Q
003600*                  OR 32F OR 32K OR 32P OR 32H
003700*                  OR 33F OR 33K OR 33P OR 33H
003800*               WITH HRG,REVENUE CODE WHERE NO OUTLIER APPLIES
003900*          01 = 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 OUTLIER APPLIES
004600*          03 = INITIAL HALF PAYMENT PAYMENT WILL BE ZERO
004700*               TOB = 332 AND 322
004800*          04 = INITIAL HALF PAYMENT PAID AT 50%
004900*               TOB = 332 AND 322
005000*               WITH INITIAL (FIRST) HRG AND NO REVENUE CODES
005100*          05 = INITIAL HALF PAYMENT PAID AT 60%
005200*               TOB = 332 AND 322
005300*               WITH INITIAL (FIRST) HRG AND NO REVENUE CODES
005400*       06,14 = LUPA PAYMENT ONLY
005500*               TOB = 329,339,327,337
005600*                  OR 32G OR 33G OR 32I OR 33I OR 32Q
005700*                  OR 32J OR 33J OR 32M OR 33M OR 33Q
005800*                  OR 32F OR 32K OR 32P OR 32H
005900*                  OR 33F OR 33K OR 33P OR 33H
006000*               WITH REVENUE CODES AND REVENUE QTYS < 5       *
006100******************************************************************
006200*          07 = FINAL PAYMENT, SCIC, PEP = N, NO OUTLIER
006300*               TOB = 329,339,327,337
006400*                  OR 32G OR 33G OR 32I OR 33I OR 32Q
006500*                  OR 32J OR 33J OR 32M OR 33M OR 33Q
006600*                  OR 32F OR 32K OR 32P OR 32H
006700*                  OR 33F OR 33K OR 33P OR 33H
006800*               WITH REVENUE CODE WHERE NO OUTLIER APPLIES
006900*               WITH MORE THAN ONE HRG OCCURRENCE             *
007000*          08 = FINAL PAYMENT, SCIC, PEP = N, WITH OUTLIER
007100*               TOB = 329,339,327,337
007200*                  OR 32G OR 33G OR 32I OR 33I OR 32Q
007300*                  OR 32J OR 33J OR 32M OR 33M OR 33Q
007400*                  OR 32F OR 32K OR 32P OR 32H
007500*                  OR 33F OR 33K OR 33P OR 33H
007600*               WITH REVENUE CODE WHERE OUTLIER APPLIES
007700*               WITH MORE THAN ONE HRG OCCURRENCE             *
007800******************************************************************
007900*          09 = FINAL PAYMENT, PEP = Y, NO OUTLIER
008000*               TOB = 329,339,327,337
008100*                  OR 32G OR 33G OR 32I OR 33I OR 32Q
008200*                  OR 32J OR 33J OR 32M OR 33M OR 33Q
008300*                  OR 32F OR 32K OR 32P OR 32H
008400*                  OR 33F OR 33K OR 33P OR 33H
008500*               WITH REVENUE CODE WHERE NO OUTLIER APPLIES
008600*               WITH ONE HRG OCCURRENCE                       *
008700*          11 = FINAL PAYMENT, PEP = Y, WITH OUTLIER
008800*               TOB = 329,339,327,337
008900*                  OR 32G OR 33G OR 32I OR 33I OR 32Q
009000*                  OR 32J OR 33J OR 32M OR 33M OR 33Q
009100*                  OR 32F OR 32K OR 32P OR 32H
009200*                  OR 33F OR 33K OR 33P OR 33H
009300*               WITH REVENUE CODE WHERE OUTLIER APPLIES
009400*               WITH ONE HRG OCCURRENCE                       *
009500******************************************************************
009600*          12 = FINAL PAYMENT, SCIC, PEP = Y, NO OUTLIER
009700*               TOB = 329,339,327,337
009800*                  OR 32G OR 33G OR 32I OR 33I OR 32Q
009900*                  OR 32J OR 33J OR 32M OR 33M OR 33Q
010000*                  OR 32F OR 32K OR 32P OR 32H
010100*                  OR 33F OR 33K OR 33P OR 33H
010200*               WITH REVENUE CODE WHERE NO OUTLIER APPLIES
010300*               WITH MORE THAN ONE HRG OCCURRENCE             *
010400*          13 = FINAL PAYMENT, SCIC, PEP = Y, WITH OUTLIER
010500*               TOB = 329,339,327,337
010600*                  OR 32G OR 33G OR 32I OR 33I OR 32Q
010700*                  OR 32J OR 33J OR 32M OR 33M OR 33Q
010800*                  OR 32F OR 32K OR 32P OR 32H
010900*                  OR 33F OR 33K OR 33P OR 33H
011000*               WITH REVENUE CODE WHERE OUTLIER APPLIES
011100*               WITH MORE THAN ONE HRG OCCURRENCE             *
011200******************************************************************
011300******************************************************************
011400*                                                             *
011500*            HHA-RTC   NO PAYMENTS RETURNED                   *
011600*                                                             *
011700*              10 = INVALID TOB                               *
011800*                                                             *
011900*              15 = INVALID PEP DAYS                          *
012000*                   FOR SHORTENED EPISODE                     *
012100*                                                             *
012200*              16 = INVALID HRG DAYS , > 60 DAYS              *
012300*                                                             *
012400*              20 = INVALID PEP INDICATOR                     *
012500*                                                             *
012600*              25 = INVALID MED REVIEW INDICATOR              *
012700*                                                             *
012800*              30 = INVALID CBSA CODE                         *
012900*                                                             *
013000*              35 = INVALID INITIAL PAYMENT INDICATOR         *
013100*                        0 = MAKE NORMAL INITIAL PAYMENT      *
013200*                        1 = MAKE ZERO PAYMANT                *
013300*                                                             *
013400*              40 = INVALID SERVICE THRU DATE FOR             *
013500*                      CURRENT CALENDER YEAR                  *
013600*                                                             *
013700*              70 = INVALID OR NO HRG CODE PRESENT            *
013800*                                                             *
013900*              75 = NO HRG PRESENT IN FIRST OCCURANCE AND     *
014000*                   REVENUE-QTY-COV-VISITS > 4  AND           *
014100*                       TOB = 329,339,327,337                 *
014200*                          OR 32G OR 33G OR 32I OR 33I OR 32Q *
014300*                          OR 32J OR 33J OR 32M OR 33M OR 33Q *
014400*                          OR 32F OR 32K OR 32P OR 32H
014500*                          OR 33F OR 33K OR 33P OR 33H
014600*                                                             *
014700*              80 = INVALID REVENUE CODE                      *
014800*                                                             *
014900*              85 = NO REVENUE CODE PRESENT                   *
015000*                   WITH TOB 329 OR 339 OR 327 OR 337 OR 32Q  *
015100*                         OR 32G OR 33G OR 32I OR 33I OR 33Q  *
015200*                         OR 32J OR 33J OR 32M OR 33M         *
015300*                         OR 32F OR 32K OR 32P OR 32H
015400*                         OR 33F OR 33K OR 33P OR 33H
015500*                                                             *
015600***************************************************************
015700***************************************************************
015800***************************************************************
015900 DATE-COMPILED.
016000 ENVIRONMENT DIVISION.
016100 CONFIGURATION SECTION.
016200 SOURCE-COMPUTER.            IBM-370.
016300 OBJECT-COMPUTER.            IBM-370.
016400 INPUT-OUTPUT  SECTION.
016500 FILE-CONTROL.
016600
016700 DATA DIVISION.
016800 FILE SECTION.
016900
017000 WORKING-STORAGE SECTION.
017100 01  W-STORAGE-REF                  PIC X(46)  VALUE
017200     'HHCAL113       - W O R K I N G   S T O R A G E'.
017300 01  CAL-VERSION                    PIC X(07)  VALUE 'C2011.3'.
017400 01  CO1                            PIC S9(04) COMP SYNC.
017500 01  SUB1                           PIC S9(04) COMP SYNC.
017600 01  R1                             PIC S9(04) COMP SYNC.
017700 01  R2                             PIC S9(04) COMP SYNC.
017800 01  R3                             PIC S9(04) COMP SYNC.
017900
018000 01  LABOR-NLABOR-PERCENT.
018100     05 LABOR-PERCENT        PIC 9V9(05)  VALUE 0.77082.
018200     05 NONLABOR-PERCENT     PIC 9V9(05)  VALUE 0.22918.
018300
018400***************************************************************
018500*         YEARCHANGE                              ===========**
018600***************************************************************
018700 01  LUPA-ADD-ON                  PIC 9(03)V9(02) VALUE 091.46.
018800 01  LUPA-ADD-ON-RURAL            PIC 9(03)V9(02) VALUE 094.20.
018900 01  LUPA-ADD-ON-2PERCENT         PIC 9(03)V9(02) VALUE 093.31.
019000 01  LUPA-ADD-ON-2PERCENT-RUR     PIC 9(03)V9(02) VALUE 096.11.
019100 01  LUPA-LABOR-ADJ               PIC 9(03)V9(02).
019200 01  LUPA-NON-LABOR-ADJ           PIC 9(03)V9(02).
019300
019400 01  FED-EPISODE-RATE-AMT         PIC 9(05)V9(02) VALUE 0.
019500 01  OUTLIER-THRESHOLD-AMT        PIC 9(05)V9(02) VALUE 0.
019600*****************************************************************
019700***    EXAMPLE    ***********************************************
019800*** FED-EPISODE-RATE-AMT TIMES 1.13 = OUTLIER-THRESHOLD-AMT *****
019900******  2327.68 TIMES 0.65  = 1512.99  ROUNDED UP  **************
020000*****************************************************************
020100 01  OUTL-LOSS-SHAR-RATIO-PERCENT PIC 9(01)V9(02) VALUE 0.80.
020200
020300 01  WK-PEP-DAYS           PIC S9(04)       VALUE 0.
020400 01  WK-HRG-NO-OF-DAYS     PIC S9(04)       VALUE 0.
020500 01  WK-HRG-NO-OF-DAYS-FAC PIC S9(04)V9(06) VALUE 0.
020600 01  WK-HRG-NO-OF-DAYS-TOT PIC S9(04)       VALUE 0.
020700 01  WK-RTC-ADJ-IND        PIC 9            VALUE 0.
020800 01  WK-ALL-TOTALS.
020900     05  FED-ADJ                        PIC S9(07)V9(02).
021000     05  FED-ADJ1                       PIC S9(07)V9(02).
021100     05  FED-LABOR-ADJ                  PIC S9(07)V9(02).
021200     05  FED-SUPPLY-ADJ                 PIC S9(07)V9(02).
021300     05  FED-NON-LABOR-ADJ              PIC S9(07)V9(02).
021400     05  OUT-THRES-AMT-ADJ              PIC S9(07)V9(02).
021500     05  OUT-THRES-LABOR-ADJ            PIC S9(07)V9(02).
021600     05  OUT-THRES-NON-LABOR-ADJ        PIC S9(07)V9(02).
021700     05  WK-3000-PEP-N-PRETOT-PAY       PIC S9(07)V9(02).
021800     05  WK-3000-PEP-N-PAYMENT          PIC S9(07)V9(02).
021900     05  WK-4000-PEP-Y-PRETOT-PAY       PIC S9(07)V9(02).
022000     05  WK-4000-PEP-Y-PAYMENT          PIC S9(07)V9(02).
022100     05  WK-5000-PEP-N-PRETOT-PAY       PIC S9(07)V9(02).
022200     05  WK-5000-PEP-N-PAYMENT          PIC S9(07)V9(02).
022300     05  WK-6000-PEP-Y-PRETOT-PAY       PIC S9(07)V9(02).
022400     05  WK-6000-PEP-Y-PAYMENT          PIC S9(07)V9(02).
022500     05  WK-6050-PEP-Y-TOT-DAYS         PIC S9(04).
022600     05  WK-7000-OUTLIER-VALUE-A        PIC S9(07)V9(02).
022700     05  WK-7000-AB-DIFF                PIC S9(07)V9(02).
022800     05  WK-7000-CALC                   PIC S9(07)V9(02).
022900     05  WK-8000-OUTLIER-VALUE-B        PIC S9(07)V9(02).
023000     05  WK-8000-OUTLIER-LAB-NLAB       PIC S9(07)V9(02).
023100     05  WK-10000-OUTLIER-POOL-DIF      PIC S9(07)V9(02).
023200     05  WK-10000-OUTLIER-POOL-PERCENT  PIC S9(09)V9(02).
023300     05  WK-10000-OUTLIER-AVAIL-POOL    PIC S9(09)V9(02).
023400
023500 01  WORK-HRG.
023600     05  WORK-HRG1                      PIC X(01).
023700     05  WORK-HRG2                      PIC X(01).
023800     05  WORK-HRG3                      PIC X(01).
023900     05  WORK-HRG4                      PIC X(01).
024000     05  WORK-HRG5                      PIC X(01).
024100
024200
024300*******************************************************
024400 01  HOLD-HHA-DATA.
024500     05  H-HHA-INPUT-DATA.
024600         10  H-HHA-NPI                 PIC X(10).
024700         10  H-HHA-HIC                 PIC X(12).
024800         10  H-HHA-PROV-NO             PIC X(06).
024900         10  H-HHA-TOB                 PIC XXX.
030300             88 H-HHA-VALID-TOB-CLAIM       VALUE
030400             '329', '339', '327', '337',
030500             '32G', '33G', '32I', '33I',
030600             '32J', '33J', '32M', '33M', '32Q',
030700             '32F', '32K', '32P', '32H', '33Q',
030800             '33F', '33K', '33P', '33H'.
030900             88 H-HHA-VALID-TOB-RAP         VALUE
031000             '322', '332'.
031100*                                                             *
025000         10  H-HHA-PEP-INDICATOR       PIC X.
025100         10  H-HHA-PEP-DAYS            PIC 999.
025200         10  H-HHA-INIT-PAY-INDICATOR  PIC X.
025300             88 H-HHA-WITH-DATA-CHECK VALUE '0', '1'.
025400             88 H-HHA-NO-DATA-CHECK   VALUE '2', '3'.
025500         10  FILLER                    PIC X(07).
025600         10  H-HHA-MSA1                PIC 9(07)V9(02).
025700         10  H-HHA-MSA2-DATA REDEFINES H-HHA-MSA1.
025800             15  FILLER             PIC XXX.
025900             15  H-HHA-MSA2         PIC XXXX.
026000             15  FILLER             PIC XX.
026100         10  H-HHA-CBSA-DATA REDEFINES H-HHA-MSA1.
026200             15  FILLER             PIC XX.
026300             15  H-HHA-CBSA         PIC XXXXX.
026400             15  FILLER             PIC XX.
026500         10  H-HHA-SERV-FROM-DATE.
026600             15  H-HHA-FROM-CC         PIC XX.
026700             15  H-HHA-FROM-YYMMDD.
026800                 25  H-HHA-FROM-YY     PIC XX.
026900                 25  H-HHA-FROM-MM     PIC XX.
027000                 25  H-HHA-FROM-DD     PIC XX.
027100         10  H-HHA-SERV-THRU-DATE.
027200             15  H-HHA-THRU-CC         PIC XX.
027300             15  H-HHA-THRU-YYMMDD.
027400                 25  H-HHA-THRU-YY     PIC XX.
027500                 25  H-HHA-THRU-MM     PIC XX.
027600                 25  H-HHA-THRU-DD     PIC XX.
027700         10  H-HHA-ADMIT-DATE.
027800             15  H-HHA-ADMIT-CC        PIC XX.
027900             15  H-HHA-ADMIT-YYMMDD.
028000                 25  H-HHA-ADMIT-YY    PIC XX.
028100                 25  H-HHA-ADMIT-MM    PIC XX.
028200                 25  H-HHA-ADMIT-DD    PIC XX.
028300         10  H-HHA-HRG-DATA      OCCURS 6.
028400             15  H-HHA-MED-REVIEW-INDICATOR PIC X.
028500             15  H-HHA-HRG-INPUT-CODE       PIC X(05).
028600             15  H-HHA-HRG-OUTPUT-CODE      PIC X(05).
028700             15  H-HHA-HRG-NO-OF-DAYS       PIC 9(03).
028800             15  H-HHA-HRG-WGTS             PIC 9(02)V9(04).
028900             15  H-HHA-HRG-PAY              PIC 9(07)V9(02).
029000         10  H-HHA-REVENUE-DATA     OCCURS 6.
029100             15  H-HHA-REVENUE-CODE             PIC X(04).
029200             15  H-HHA-REVENUE-QTY-COV-VISITS   PIC 9(03).
004700             15  H-HHA-REVENUE-EARLIEST-DATE    PIC 9(08).
029300             15  H-HHA-REVENUE-DOLL-RATE        PIC 9(07)V9(02).
029400             15  H-HHA-REVENUE-COST             PIC 9(07)V9(02).
004900             15  H-HHA-REVENUE-ADD-ON-VISIT-AMT PIC 9(07)V9(02).
029500     05  H-HHA-PASSBACK-DATA.
029600         10  H-HHA-PAY-RTC                PIC 99.
029700         10  H-HHA-REVENUE-SUM1-3-QTY-THR PIC 9(05).
029800         10  H-HHA-REVENUE-SUM1-6-QTY-ALL PIC 9(05).
029900         10  H-HHA-OUTLIER-PAYMENT        PIC 9(07)V9(02).
030000         10  H-HHA-TOTAL-PAYMENT          PIC 9(07)V9(02).
030100     05  H-HHA-CASE-MIX-DATA.
030200         10  H-HHA-LUPA-ADD-ON-PAYMENT    PIC 9(03)V9(02).
030300         10  H-HHA-LUPA-SRC-ADM           PIC X.
030400         10  H-HHA-RECODE-IND             PIC X.
030500         10  H-HHA-EPISODE-TIMING         PIC 9.
030600         10  H-HHA-SEVERITY-POINTS.
030700             15  H-HHA-CLINICAL-SEV-EQ1   PIC X(01).
030800             15  H-HHA-FUNCTION-SEV-EQ1   PIC X(01).
030900             15  H-HHA-CLINICAL-SEV-EQ2   PIC X(01).
031000             15  H-HHA-FUNCTION-SEV-EQ2   PIC X(01).
031100             15  H-HHA-CLINICAL-SEV-EQ3   PIC X(01).
031200             15  H-HHA-FUNCTION-SEV-EQ3   PIC X(01).
031300             15  H-HHA-CLINICAL-SEV-EQ4   PIC X(01).
031400             15  H-HHA-FUNCTION-SEV-EQ4   PIC X(01).
031500     05  H-HHA-PROV-TOTAL-DATA.
031600         10  H-HHA-PROV-OUTLIER-PAY-TOTAL PIC 9(08)V9(02).
031700         10  H-HHA-PROV-PAYMET-TOTAL      PIC 9(09)V9(02).
031800     05  FILLER                           PIC X(33).
031900**==================================================***
032000*    05  FILLER                         PIC X(20).
032100**==================================================***
032200
032300 LINKAGE SECTION.
032400***************************************************************
032500*                 * * * * * * * * *                           *
032600***************************************************************
032700***************************************************************
032800*    THIS DATA IS CALCULATED BY THIS HHAPR  SUBROUTINE        *
032900*    AND PASSED BACK TO THE CALLING PROGRAM                   *
033000***************************************************************
033100 01  HHA-INPUT-DATA.
033200     05  HHA-DATA.
033300         10  HHA-NPI                 PIC X(10).
033400         10  HHA-HIC                 PIC X(12).
033500         10  HHA-PROV-NO             PIC X(06).
033600         10  HHA-TOB                 PIC XXX.
030300             88 HHA-VALID-TOB-CLAIM       VALUE
030400             '329', '339', '327', '337',
030500             '32G', '33G', '32I', '33I',
030600             '32J', '33J', '32M', '33M', '32Q',
030700             '32F', '32K', '32P', '32H', '33Q',
030800             '33F', '33K', '33P', '33H'.
030900             88 HHA-VALID-TOB-RAP         VALUE
031000             '322', '332'.
031100*                                                             *
033700         10  HHA-PEP-INDICATOR       PIC X.
033800         10  HHA-PEP-DAYS            PIC 999.
033900         10  HHA-INIT-PAY-INDICATOR  PIC X.
034000             88  HHA-WITH-DATA-CHECK VALUE '0', '1'.
034100             88  HHA-NO-DATA-CHECK   VALUE '2', '3'.
034200         10  FILLER                  PIC X(07).
034300         10  HHA-MSA1                PIC 9(07)V9(02).
034400         10  HHA-MSA2-DATA REDEFINES HHA-MSA1.
034500             15  FILLER             PIC XXX.
034600             15  HHA-MSA2.
034700                 25  HHA-MSA2-RURAL-1ST.
034800                     30  HHA-RURAL-MSA         PIC XX.
034900                     88  HHA-MSA-RURAL-CHECK   VALUE '99'.
035000                 25  HHA-MSA2-RURAL-2ND        PIC XX.
035100             15  FILLER             PIC XX.
035200         10  HHA-CBSA-DATA REDEFINES HHA-MSA1.
035300             15  FILLER             PIC XX.
035400             15  HHA-CBSA.
035500                 88  HHA-CBSA-RURAL-CHECK-ALL VALUE
035600                 '50001', '50007', '50016', '50020', '50031',
035700                 '50036', '50054', '50060', '50067', '50087',
035800                 '50089', '50091', '50092', '50100', '50104',
035900                 '50108', '50114', '50121', '50125', '50140',
036000                 '50145', '50152', '50164', '50170', '50199',
036100                 '50206', '50210', '50214', '50218', '50222',
036200                 '50225', '50226', '50231', '50234', '50237',
036300                 '50243', '50248', '50250', '50255', '50256',
036400                 '50257', '50260', '50261', '50262', '50266',
036500                 '50268', '50272', '50275', '50281', '50286',
036600                 '50313', '50314', '50316', '50325', '50326',
036700                 '50327', '50329', '50336', '50344', '50352',
036800                 '50192', '50263', '50293'.
036900                 25  HHA-CBSA-RURAL-1ST.
037000                     30  HHA-RURAL-CBSA        PIC XXX.
037100                     88  HHA-CBSA-RURAL-CHECK   VALUE '999'.
037200                 25  HHA-CBSA-RURAL-2ND        PIC XX.
037300             15  FILLER             PIC XX.
037400         10  HHA-SERV-FROM-DATE.
037500             15  HHA-FROM-CC         PIC XX.
037600             15  HHA-FROM-YYMMDD.
037700                 25  HHA-FROM-YY     PIC XX.
037800                 25  HHA-FROM-MM     PIC XX.
037900                 25  HHA-FROM-DD     PIC XX.
038000         10  HHA-SERV-THRU-DATE.
038100             15  HHA-THRU-CC         PIC XX.
038200             15  HHA-THRU-YYMMDD.
038300                 25  HHA-THRU-YY     PIC XX.
038400                 25  HHA-THRU-MM     PIC XX.
038500                 25  HHA-THRU-DD     PIC XX.
038600         10  HHA-ADMIT-DATE.
038700             15  HHA-ADMIT-CC        PIC XX.
038800             15  HHA-ADMIT-YYMMDD.
038900                 25  HHA-ADMIT-YY    PIC XX.
039000                 25  HHA-ADMIT-MM    PIC XX.
039100                 25  HHA-ADMIT-DD    PIC XX.
039200         10  HHA-HRG-DATA      OCCURS 6.
039300             15  HHA-MED-REVIEW-INDICATOR PIC X.
039400             15  HHA-HRG-INPUT-CODE       PIC X(05).
039500             15  HHA-HRG-OUTPUT-CODE      PIC X(05).
039600             15  HHA-HRG-NO-OF-DAYS       PIC 9(03).
039700             15  HHA-HRG-WGTS             PIC 9(02)V9(04).
039800             15  HHA-HRG-PAY              PIC 9(07)V9(02).
039900         10  HHA-REVENUE-DATA     OCCURS 6.
040000             15  HHA-REVENUE-CODE             PIC X(04).
040100             15  HHA-REVENUE-QTY-COV-VISITS   PIC 9(03).
004700             15  HHA-REVENUE-EARLIEST-DATE    PIC 9(08).
040200             15  HHA-REVENUE-DOLL-RATE        PIC 9(07)V9(02).
040300             15  HHA-REVENUE-COST             PIC 9(07)V9(02).
004900             15  HHA-REVENUE-ADD-ON-VISIT-AMT PIC 9(07)V9(02).
040400     05  HHA-PASSBACK-DATA.
040500         10  HHA-PAY-RTC                PIC 99.
040600         10  HHA-REVENUE-SUM1-3-QTY-THR PIC 9(05).
040700         10  HHA-REVENUE-SUM1-6-QTY-ALL PIC 9(05).
040800         10  HHA-OUTLIER-PAYMENT        PIC 9(07)V9(02).
040900         10  HHA-TOTAL-PAYMENT          PIC 9(07)V9(02).
041000     05  HHA-CASE-MIX-DATA.
041100         10  HHA-LUPA-ADD-ON-PAYMENT      PIC 9(03)V9(02).
041200         10  HHA-LUPA-SRC-ADM             PIC X.
041300         10  HHA-RECODE-IND               PIC X.
041400         10  HHA-EPISODE-TIMING           PIC 9.
041500         10  HHA-SEVERITY-POINTS.
041600             15  HHA-CLINICAL-SEV-EQ1     PIC X(01).
041700             15  HHA-FUNCTION-SEV-EQ1     PIC X(01).
041800             15  HHA-CLINICAL-SEV-EQ2     PIC X(01).
041900             15  HHA-FUNCTION-SEV-EQ2     PIC X(01).
042000             15  HHA-CLINICAL-SEV-EQ3     PIC X(01).
042100             15  HHA-FUNCTION-SEV-EQ3     PIC X(01).
042200             15  HHA-CLINICAL-SEV-EQ4     PIC X(01).
042300             15  HHA-FUNCTION-SEV-EQ4     PIC X(01).
042400     05  HHA-PROV-TOTAL-DATA.
042500         10  HHA-PROV-OUTLIER-PAY-TOTAL PIC 9(08)V9(02).
042600         10  HHA-PROV-PAYMET-TOTAL      PIC 9(09)V9(02).
042700     05  FILLER                         PIC X(33).
042800**==================================================***
042900*    05  FILLER                         PIC X(20).
043000
043100 01  HOLD-VARIABLES-DATA.
043200     02  HOLD-VAR-DATA.
043300         05  PRICER-OPTION-SW                   PIC X(01).
043400         05  HHOPN-VERSION                      PIC X(07).
043500         05  HHDRV-VERSION                      PIC X(07).
043600         05  HHCAL-VERSION                      PIC X(07).
043700         05  FILLER                             PIC X(20).
043800
043900 01  CBSA-WAGE-INDEX-DATA.
044000     02  HOLD-WIR-DATA.
044100         05  WIR-CBSA                       PIC X(05).
044200         05  WIR-CBSA-EFFDATE               PIC X(08).
044300         05  WIR-CBSA-WAGEIND               PIC 9(02)V9(04).
044400
044500 PROCEDURE DIVISION  USING HHA-INPUT-DATA
044600                           HOLD-VARIABLES-DATA
044700                           CBSA-WAGE-INDEX-DATA.
044800
044900***************************************************************
045000*    PROCESSING:                                              *
045100*        A. WILL PROCESS NATIONAL HHA FOR CY 2010             *
045200*                STARTING JAN 1, 2010                         *
045300***************************************************************
045400
045500     MOVE CAL-VERSION TO HHCAL-VERSION.
045600
045700     PERFORM 200-MAINLINE-CONTROL THRU 200-EXIT.
045800
045900     MOVE HOLD-HHA-DATA TO HHA-INPUT-DATA.
046000
046100     GOBACK.
046200
046300 200-MAINLINE-CONTROL.
046400
046500     MOVE HHA-INPUT-DATA TO HOLD-HHA-DATA.
046600
046700
046800*     DISPLAY '-- HHA-HIC HHCAL113  ===> ' HHA-HIC.
046900
047000     MOVE ALL '0' TO
047100                     WK-ALL-TOTALS
047200                     WK-HRG-NO-OF-DAYS
047300                     WK-HRG-NO-OF-DAYS-TOT
047400                     WK-RTC-ADJ-IND
047500                     WK-PEP-DAYS
047600                     H-HHA-PASSBACK-DATA
047700                     H-HHA-HRG-PAY (1)
047800                     H-HHA-HRG-PAY (2)
047900                     H-HHA-HRG-PAY (3)
048000                     H-HHA-HRG-PAY (4)
048100                     H-HHA-HRG-PAY (5)
048200                     H-HHA-HRG-PAY (6)
048300                     H-HHA-REVENUE-COST (1)
048400                     H-HHA-REVENUE-COST (2)
048500                     H-HHA-REVENUE-COST (3)
048600                     H-HHA-REVENUE-COST (4)
048700                     H-HHA-REVENUE-COST (5)
048800                     H-HHA-REVENUE-COST (6).
048900
049000     IF  H-HHA-PAY-RTC = 00
049100         PERFORM 400-CALC-THE-HHA THRU 400-EXIT.
049200
049300 200-EXIT.   EXIT.
049400
049500 400-CALC-THE-HHA.
049600
049700*    IF H-HHA-SERV-THRU-DATE < 20070101
049800*        MOVE '40' TO H-HHA-PAY-RTC
049900*        GO TO 400-EXIT.
050000
050100     IF H-HHA-ADMIT-DATE >
050200        H-HHA-SERV-FROM-DATE
050300         MOVE '40' TO H-HHA-PAY-RTC
050400         GO TO 400-EXIT.
050500
030300     IF (H-HHA-VALID-TOB-RAP     AND
050700        (H-HHA-HRG-INPUT-CODE (1) = SPACE))
050800        MOVE '70' TO H-HHA-PAY-RTC
050900        GO TO 400-EXIT.
051000
030300     IF (H-HHA-VALID-TOB-CLAIM   AND
051600         (H-HHA-REVENUE-SUM1-6-QTY-ALL > 4 ) AND
051700         (H-HHA-HRG-INPUT-CODE (1) = SPACE))
051800        MOVE '75' TO H-HHA-PAY-RTC
051900        GO TO 400-EXIT.
052000
030300     IF (H-HHA-VALID-TOB-CLAIM   AND
052600         (H-HHA-REVENUE-CODE (1) = SPACE))
052700        MOVE '85' TO H-HHA-PAY-RTC
052800        GO TO 400-EXIT.
052900
030300     IF (H-HHA-VALID-TOB-CLAIM   AND
053500         (H-HHA-HRG-INPUT-CODE (2) NOT = SPACES) AND
053600         (H-HHA-PEP-INDICATOR = 'Y') AND
053700         (H-HHA-PEP-DAYS NOT NUMERIC OR
053800          H-HHA-PEP-DAYS = ZEROES))
053900        MOVE '15' TO H-HHA-PAY-RTC
054000        GO TO 400-EXIT.
054100
054200     IF H-HHA-PAY-RTC NOT = 00 GO TO 400-EXIT.
054300
054400***************************************************************
054500***************************************************************
054600*        THESE RATES & THRESHOLDS ARE APPLIED                 *
054700* FOR NON-RURAL AND  RURAL                                    *
054800***************************************************************
054900*         YEARCHANGE                              ===========**
055000***************************************************************
055100* FOR NON RURAL RATES AND RURAL RATES                         *
055200     MOVE 02148.71 TO   FED-EPISODE-RATE-AMT.
055300     MOVE 01439.64 TO   OUTLIER-THRESHOLD-AMT.
055400
055500*------------------------------------------------------
055600*    WITH   REPORTING DATA  ---------------
055700*         YEARCHANGE                      ===========**
055800*------------------------------------------------------
055900     IF HHA-WITH-DATA-CHECK
056000        NEXT SENTENCE
056100     ELSE
056200        GO TO NO-REPORTING-DATA.
056300
056400        IF HHA-CBSA-RURAL-CHECK
056500        OR HHA-CBSA-RURAL-CHECK-ALL
056600*------------------------------------------------------
056700*    RURAL, AND REPORTING DATA --------
056800*------------------------------------------------------
056900           MOVE 02257.83 TO   FED-EPISODE-RATE-AMT
057000           MOVE 01512.75 TO   OUTLIER-THRESHOLD-AMT
057100        ELSE
057200*------------------------------------------------------
057300*    NON RURAL, AND REPORTING DATA --------
057400*------------------------------------------------------
057500           MOVE 02192.07 TO   FED-EPISODE-RATE-AMT
057600           MOVE 01468.69 TO   OUTLIER-THRESHOLD-AMT.
057700
057800
057900      GO TO PROCESS-PAYMENT.
058000
058100 NO-REPORTING-DATA.
058200
058300        IF HHA-CBSA-RURAL-CHECK
058400        OR HHA-CBSA-RURAL-CHECK-ALL
058500*------------------------------------------------------
058600*    RURAL, AND NO REPORTING DATA --------
058700*------------------------------------------------------
058800           MOVE 02213.17 TO   FED-EPISODE-RATE-AMT
058900           MOVE 01482.82 TO   OUTLIER-THRESHOLD-AMT
059000        GO TO PROCESS-PAYMENT.
059100
059200
059300*------------------------------------------------------
059400*    NON RURAL, AND NO REPORTING DATA --------
059500*------------------------------------------------------
059600*          MOVE 02148.71 TO   FED-EPISODE-RATE-AMT.
059700*          MOVE 01439.64 TO   OUTLIER-THRESHOLD-AMT.
059800
059900
060000 PROCESS-PAYMENT.
060100
060200*------------------------------------------------------
060300***************************************************************
060400
030300     IF H-HHA-VALID-TOB-RAP
060600        PERFORM 500-INITIAL-PAYMENT THRU 500-EXIT
060700        GO TO 400-EXIT.
060800
030300     IF H-HHA-VALID-TOB-CLAIM
061400        PERFORM 1000-FINAL-PAYMENT THRU 1000-EXIT
061500        GO TO 400-EXIT.
061600
061700     MOVE '10' TO H-HHA-PAY-RTC.
061800
061900
062000 400-EXIT.   EXIT.
062100
062200 500-INITIAL-PAYMENT.
062300
062400***************************************************************
062500*            TOB = 322 OR 332 INITIAL PAYMENT
062600***************************************************************
062700
062800     IF  H-HHA-INIT-PAY-INDICATOR  = '0' OR '1' OR '2' OR '3'
062900         NEXT SENTENCE
063000     ELSE
063100         MOVE '35' TO H-HHA-PAY-RTC
063200         GO TO 500-EXIT.
063300
063400     IF  H-HHA-INIT-PAY-INDICATOR  = '1' OR '3'
063500         MOVE '03' TO H-HHA-PAY-RTC
063600         GO TO 500-EXIT.
063700
063800     COMPUTE FED-ADJ ROUNDED =
063900               H-HHA-HRG-WGTS (1) * FED-EPISODE-RATE-AMT.
064000
064100     COMPUTE FED-LABOR-ADJ ROUNDED =
064200             WIR-CBSA-WAGEIND *
064300             LABOR-PERCENT *
064400             FED-ADJ.
064500
064600     COMPUTE FED-NON-LABOR-ADJ ROUNDED =
064700              (NONLABOR-PERCENT * FED-ADJ).
064800
064900     MOVE H-HHA-HRG-OUTPUT-CODE (1) TO WORK-HRG.
065000
065100*         YEARCHANGE                              ===========**
065200
065300      PERFORM 10100-SUPPLY-ADD-ON-CALC  THRU 10100-EXIT.
065400
065500*         YEARCHANGE                              ===========**
065600
065700*    IF HHA-SERV-THRU-DATE > 20071231 AND
065800*       HHA-SERV-FROM-DATE > 20071231
065900*        NEXT SENTENCE
066000*    ELSE
066100*        MOVE 0000000.00 TO FED-SUPPLY-ADJ.
066200
066300
066400     IF H-HHA-SERV-FROM-DATE = H-HHA-ADMIT-DATE
066500        COMPUTE H-HHA-TOTAL-PAYMENT ROUNDED =
066600       (FED-LABOR-ADJ + FED-NON-LABOR-ADJ + FED-SUPPLY-ADJ) * .6
066700        MOVE H-HHA-TOTAL-PAYMENT TO H-HHA-HRG-PAY (1)
066800        MOVE '05' TO H-HHA-PAY-RTC
066900     ELSE
067000        COMPUTE H-HHA-TOTAL-PAYMENT ROUNDED =
067100       (FED-LABOR-ADJ + FED-NON-LABOR-ADJ + FED-SUPPLY-ADJ) * .5
067200        MOVE H-HHA-TOTAL-PAYMENT TO H-HHA-HRG-PAY (1)
067300        MOVE '04' TO H-HHA-PAY-RTC.
067400
067500 500-EXIT.   EXIT.
067600
067700 1000-FINAL-PAYMENT.
067800
067900     IF H-HHA-REVENUE-QTY-COV-VISITS (1) NOT NUMERIC
068000        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (1).
068100     IF H-HHA-REVENUE-QTY-COV-VISITS (2) NOT NUMERIC
068200        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (2).
068300     IF H-HHA-REVENUE-QTY-COV-VISITS (3) NOT NUMERIC
068400        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (3).
068500     IF H-HHA-REVENUE-QTY-COV-VISITS (4) NOT NUMERIC
068600        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (4).
068700     IF H-HHA-REVENUE-QTY-COV-VISITS (5) NOT NUMERIC
068800        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (5).
068900     IF H-HHA-REVENUE-QTY-COV-VISITS (6) NOT NUMERIC
069000        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (6).
069100
069200     COMPUTE H-HHA-REVENUE-SUM1-3-QTY-THR ROUNDED =
069300             H-HHA-REVENUE-QTY-COV-VISITS (1) +
069400             H-HHA-REVENUE-QTY-COV-VISITS (2) +
069500             H-HHA-REVENUE-QTY-COV-VISITS (3).
069600     COMPUTE H-HHA-REVENUE-SUM1-6-QTY-ALL ROUNDED =
069700             H-HHA-REVENUE-QTY-COV-VISITS (1) +
069800             H-HHA-REVENUE-QTY-COV-VISITS (2) +
069900             H-HHA-REVENUE-QTY-COV-VISITS (3) +
070000             H-HHA-REVENUE-QTY-COV-VISITS (4) +
070100             H-HHA-REVENUE-QTY-COV-VISITS (5) +
070200             H-HHA-REVENUE-QTY-COV-VISITS (6).
070300
070400     MOVE H-HHA-HRG-OUTPUT-CODE (1) TO WORK-HRG.
070500
070600     IF H-HHA-REVENUE-SUM1-6-QTY-ALL < 5
070700       NEXT SENTENCE
070800     ELSE
070900       GO TO PEP-CHECK.
071000
071100*01  LUPA-ADD-ON
071200*01  LUPA-ADD-ON-RURAL
071300*01  LUPA-ADD-ON-2PERCENT
071400*01  LUPA-ADD-ON-2PERCENT-RUR
071500
071600
071700     IF HHA-WITH-DATA-CHECK
071800        IF HHA-CBSA-RURAL-CHECK
071900        OR HHA-CBSA-RURAL-CHECK-ALL
072000         COMPUTE LUPA-LABOR-ADJ ROUNDED =
072100                 WIR-CBSA-WAGEIND *
072200                 LABOR-PERCENT *
072300                 LUPA-ADD-ON-2PERCENT-RUR
072400        ELSE
072500         COMPUTE LUPA-LABOR-ADJ ROUNDED =
072600                 WIR-CBSA-WAGEIND *
072700                 LABOR-PERCENT *
072800                 LUPA-ADD-ON-2PERCENT
072900        END-IF
073000     ELSE
073100        IF HHA-CBSA-RURAL-CHECK
073200        OR HHA-CBSA-RURAL-CHECK-ALL
073300         COMPUTE LUPA-LABOR-ADJ ROUNDED =
073400                 WIR-CBSA-WAGEIND *
073500                 LABOR-PERCENT *
073600                 LUPA-ADD-ON-RURAL
073700        ELSE
073800         COMPUTE LUPA-LABOR-ADJ ROUNDED =
073900                 WIR-CBSA-WAGEIND *
074000                 LABOR-PERCENT *
074100                 LUPA-ADD-ON
074200        END-IF
074300     END-IF.
074400
074500     IF HHA-WITH-DATA-CHECK
074600        IF HHA-CBSA-RURAL-CHECK
074700        OR HHA-CBSA-RURAL-CHECK-ALL
074800         COMPUTE LUPA-NON-LABOR-ADJ ROUNDED =
074900                 NONLABOR-PERCENT *
075000                 LUPA-ADD-ON-2PERCENT-RUR
075100        ELSE
075200         COMPUTE LUPA-NON-LABOR-ADJ ROUNDED =
075300                 NONLABOR-PERCENT *
075400                  LUPA-ADD-ON-2PERCENT
075500        END-IF
075600     ELSE
075700        IF HHA-CBSA-RURAL-CHECK
075800        OR HHA-CBSA-RURAL-CHECK-ALL
075900         COMPUTE LUPA-NON-LABOR-ADJ ROUNDED =
076000                 NONLABOR-PERCENT *
076100                 LUPA-ADD-ON-RURAL
076200        ELSE
076300         COMPUTE LUPA-NON-LABOR-ADJ ROUNDED =
076400                 NONLABOR-PERCENT *
076500                 LUPA-ADD-ON
076600        END-IF
076700     END-IF.
076800
076900
077000     IF H-HHA-ADMIT-DATE = H-HHA-SERV-FROM-DATE AND
077100         WORK-HRG1 = '1' OR '2'
077200        COMPUTE H-HHA-LUPA-ADD-ON-PAYMENT ROUNDED =
077300          LUPA-LABOR-ADJ + LUPA-NON-LABOR-ADJ
077400     ELSE
077500        MOVE 0 TO  H-HHA-LUPA-ADD-ON-PAYMENT.
077600
077700     IF (H-HHA-LUPA-SRC-ADM = 'B' OR 'C')
077800        MOVE 0 TO  H-HHA-LUPA-ADD-ON-PAYMENT.
077900
078000     IF  H-HHA-RECODE-IND  = '2'
078100        MOVE 0 TO  H-HHA-LUPA-ADD-ON-PAYMENT.
078200
078300     IF H-HHA-REVENUE-SUM1-6-QTY-ALL = 0
078400        MOVE 0 TO  H-HHA-LUPA-ADD-ON-PAYMENT.
078500
078600        PERFORM 1050-LUPA THRU 1050-EXIT
078700            VARYING SUB1 FROM 1 BY 1 UNTIL
078800***         (H-HHA-REVENUE-CODE (SUB1) = SPACES OR
078900             SUB1 > 6.
079000
079100        IF H-HHA-LUPA-ADD-ON-PAYMENT > 0
079200           MOVE '14' TO H-HHA-PAY-RTC
079300        ELSE
079400           MOVE '06' TO H-HHA-PAY-RTC
079500        END-IF.
079600
079700        COMPUTE H-HHA-TOTAL-PAYMENT   ROUNDED =
079800                H-HHA-REVENUE-COST (1) +
079900                H-HHA-REVENUE-COST (2) +
080000                H-HHA-REVENUE-COST (3) +
080100                H-HHA-REVENUE-COST (4) +
080200                H-HHA-REVENUE-COST (5) +
080300                H-HHA-REVENUE-COST (6) +
080400                H-HHA-LUPA-ADD-ON-PAYMENT.
080500
080600        GO TO 1000-EXIT.
080700
080800 PEP-CHECK.
080900
081000     IF (H-HHA-PEP-INDICATOR NOT = 'Y' AND NOT = 'N')
081100         MOVE '20' TO H-HHA-PAY-RTC
081200         GO TO 1000-EXIT.
081300
081400      PERFORM 1100-ADD-HRG-DAYS THRU 1100-EXIT
081500         VARYING CO1 FROM 1 BY 1 UNTIL CO1 > 6.
081600
081700      IF WK-HRG-NO-OF-DAYS-TOT > 60
081800         MOVE '16' TO H-HHA-PAY-RTC
081900         GO TO 1000-EXIT.
082000
082100
082200*********  HRG  PAYMENT   *******************
082300
082400***  IF H-HHA-REVENUE-SUM1-3-QTY-THR > 9
082500        IF H-HHA-HRG-INPUT-CODE (2) = SPACES
082600           IF H-HHA-PEP-INDICATOR = 'N'
082700              PERFORM 3000-PEP-N-ADJUST THRU 3000-EXIT
082800                  VARYING CO1 FROM 1 BY 1 UNTIL
082900*                 (H-HHA-HRG-INPUT-CODE (CO1) = SPACES OR
083000                   CO1 > 6
083100               PERFORM 7000-OUTLIER-PAYMENT THRU 7000-EXIT
083200               GO TO 1000-EXIT.
083300
083400
083500***  IF H-HHA-REVENUE-SUM1-3-QTY-THR > 9
083600        IF H-HHA-HRG-INPUT-CODE (2) = SPACES
083700           IF H-HHA-PEP-INDICATOR = 'Y'
083800              PERFORM 4000-PEP-Y-ADJUST THRU 4000-EXIT
083900                  VARYING CO1 FROM 1 BY 1 UNTIL
084000*                 (H-HHA-HRG-INPUT-CODE (CO1) = SPACES OR
084100                   CO1 > 6
084200               PERFORM 7000-OUTLIER-PAYMENT THRU 7000-EXIT
084300               GO TO 1000-EXIT.
084400
084500**** IF H-HHA-REVENUE-SUM1-3-QTY-THR > 9
084600        IF H-HHA-HRG-INPUT-CODE (2) NOT = SPACES
084700           IF H-HHA-PEP-INDICATOR = 'N'
084800              PERFORM 5000-PEP-N-ADJUST THRU 5000-EXIT
084900                  VARYING CO1 FROM 1 BY 1 UNTIL
085000*                 (H-HHA-HRG-INPUT-CODE (CO1) = SPACES OR
085100                   CO1 > 6
085200               PERFORM 7000-OUTLIER-PAYMENT THRU 7000-EXIT
085300               GO TO 1000-EXIT.
085400
085500**** IF H-HHA-REVENUE-SUM1-3-QTY-THR > 9
085600        IF H-HHA-HRG-INPUT-CODE (2) NOT = SPACES
085700           IF H-HHA-PEP-INDICATOR = 'Y'
085800              PERFORM 6000-PEP-Y-ADJUST THRU 6000-EXIT
085900                  VARYING CO1 FROM 1 BY 1 UNTIL
086000*                 (H-HHA-HRG-INPUT-CODE (CO1) = SPACES OR
086100                   CO1 > 6
086200               PERFORM 7000-OUTLIER-PAYMENT THRU 7000-EXIT
086300               GO TO 1000-EXIT.
086400
086500
086600      MOVE '20' TO H-HHA-PAY-RTC.
086700
086800 1000-EXIT.  EXIT.
086900 1050-LUPA.
087000
087100***************************************************************
087200*                    LUPA PAYMENT
087300***************************************************************
087400
087500     IF H-HHA-REVENUE-CODE (SUB1) = SPACES
087600        MOVE 6 TO SUB1
087700        GO TO 1050-EXIT.
087800
087900     IF H-HHA-REVENUE-QTY-COV-VISITS (SUB1) = 0
088000        GO TO 1050-EXIT.
088100
088200     MOVE H-HHA-HRG-OUTPUT-CODE (SUB1) TO WORK-HRG.
088300
088400     COMPUTE FED-ADJ ROUNDED =
088500             H-HHA-REVENUE-QTY-COV-VISITS (SUB1) *
088600             H-HHA-REVENUE-DOLL-RATE (SUB1).
088700
088800     COMPUTE FED-LABOR-ADJ ROUNDED =
088900             WIR-CBSA-WAGEIND *
089000             LABOR-PERCENT *
089100             FED-ADJ.
089200
089300
089400     COMPUTE FED-NON-LABOR-ADJ ROUNDED =
089500             NONLABOR-PERCENT *
089600             FED-ADJ.
089700
089800     MOVE H-HHA-HRG-OUTPUT-CODE (1) TO WORK-HRG.
089900     COMPUTE H-HHA-REVENUE-COST (SUB1) ROUNDED =
090000             (FED-LABOR-ADJ + FED-NON-LABOR-ADJ).
090100
090200
090300 1050-EXIT.   EXIT.
090400
090500 1100-ADD-HRG-DAYS.
090600
090700      IF H-HHA-HRG-NO-OF-DAYS (CO1) NUMERIC
090800         ADD H-HHA-HRG-NO-OF-DAYS (CO1) TO
090900             WK-HRG-NO-OF-DAYS-TOT.
091000
091100 1100-EXIT.   EXIT.
091200
091300 3000-PEP-N-ADJUST.
091400
091500***************************************************************
091600*           HRG OCCUR < 2 AND PEP = N ADJUSTMENT
091700***************************************************************
091800
091900     IF H-HHA-HRG-INPUT-CODE (CO1) = SPACES
092000        MOVE 6 TO CO1
092100        GO TO 3000-EXIT.
092200
092300     MOVE H-HHA-HRG-NO-OF-DAYS (CO1) TO WK-HRG-NO-OF-DAYS.
092400
092500     MOVE H-HHA-HRG-OUTPUT-CODE (CO1) TO WORK-HRG.
092600
092700*         YEARCHANGE                              ===========**
092800
092900      PERFORM 10100-SUPPLY-ADD-ON-CALC  THRU 10100-EXIT.
093000
093100*         YEARCHANGE                              ===========**
093200
093300
093400*    IF HHA-SERV-THRU-DATE > 20071231 AND
093500*       HHA-SERV-FROM-DATE > 20071231
093600*        NEXT SENTENCE
093700*    ELSE
093800*        MOVE 0000000.00 TO FED-SUPPLY-ADJ.
093900
094000     COMPUTE FED-ADJ ROUNDED =
094100               H-HHA-HRG-WGTS (1) * FED-EPISODE-RATE-AMT.
094200
094300     COMPUTE FED-LABOR-ADJ ROUNDED =
094400              (WIR-CBSA-WAGEIND *
094500               LABOR-PERCENT * FED-ADJ).
094600
094700     COMPUTE FED-NON-LABOR-ADJ ROUNDED =
094800              (NONLABOR-PERCENT * FED-ADJ).
094900
095000     COMPUTE WK-3000-PEP-N-PAYMENT ROUNDED =
095100          (FED-LABOR-ADJ + FED-NON-LABOR-ADJ + FED-SUPPLY-ADJ).
095200
095300     COMPUTE H-HHA-HRG-PAY (CO1) ROUNDED =
095400             WK-3000-PEP-N-PAYMENT.
095500
095600     COMPUTE WK-3000-PEP-N-PRETOT-PAY ROUNDED =
095700             WK-3000-PEP-N-PRETOT-PAY + WK-3000-PEP-N-PAYMENT.
095800
095900
096000 3000-EXIT.   EXIT.
096100
096200 4000-PEP-Y-ADJUST.
096300
096400***************************************************************
096500*           HRG OCCUR < 2 AND PEP = Y ADJUSTMENT
096600***************************************************************
096700
096800     IF H-HHA-HRG-INPUT-CODE (CO1) = SPACES
096900        MOVE 6 TO SUB1
097000        GO TO 4000-EXIT.
097100
097200     MOVE 2 TO WK-RTC-ADJ-IND.
097300
097400     MOVE H-HHA-HRG-NO-OF-DAYS (CO1) TO WK-HRG-NO-OF-DAYS.
097500
097600     MOVE H-HHA-HRG-OUTPUT-CODE (CO1) TO WORK-HRG.
097700
097800*         YEARCHANGE                              ===========**
097900
098000      PERFORM 10100-SUPPLY-ADD-ON-CALC  THRU 10100-EXIT.
098100
098200*         YEARCHANGE                              ===========**
098300
098400
098500*    IF HHA-SERV-THRU-DATE > 20071231 AND
098600*       HHA-SERV-FROM-DATE > 20071231
098700*        NEXT SENTENCE
098800*    ELSE
098900*        MOVE 0000000.00 TO FED-SUPPLY-ADJ.
099000
099100
099200     COMPUTE FED-ADJ ROUNDED =
099300               H-HHA-HRG-WGTS (1) * FED-EPISODE-RATE-AMT.
099400
099500     COMPUTE FED-LABOR-ADJ ROUNDED =
099600               WIR-CBSA-WAGEIND *
099700               LABOR-PERCENT * FED-ADJ.
099800
099900     COMPUTE FED-NON-LABOR-ADJ ROUNDED =
100000               NONLABOR-PERCENT * FED-ADJ.
100100
100200     COMPUTE WK-4000-PEP-Y-PAYMENT ROUNDED =
100300         (FED-LABOR-ADJ + FED-NON-LABOR-ADJ + FED-SUPPLY-ADJ).
100400
100500     COMPUTE WK-HRG-NO-OF-DAYS-FAC ROUNDED =
100600               (WK-HRG-NO-OF-DAYS / 60).
100700
100800     COMPUTE WK-4000-PEP-Y-PAYMENT ROUNDED =
100900             WK-4000-PEP-Y-PAYMENT *
101000             WK-HRG-NO-OF-DAYS-FAC.
101100
101200     COMPUTE H-HHA-HRG-PAY (CO1) ROUNDED =
101300             WK-4000-PEP-Y-PAYMENT.
101400
101500     COMPUTE WK-4000-PEP-Y-PRETOT-PAY ROUNDED =
101600             WK-4000-PEP-Y-PRETOT-PAY + WK-4000-PEP-Y-PAYMENT.
101700
101800
101900 4000-EXIT.   EXIT.
102000 5000-PEP-N-ADJUST.
102100
102200***************************************************************
102300*           HRG OCCUR > 1 AND PEP = N ADJUSTMENT
102400***************************************************************
102500
102600     IF H-HHA-HRG-INPUT-CODE (CO1) = SPACES
102700        MOVE 6 TO SUB1
102800        GO TO 5000-EXIT.
102900
103000     MOVE 1 TO WK-RTC-ADJ-IND.
103100
103200     MOVE H-HHA-HRG-NO-OF-DAYS (CO1) TO WK-HRG-NO-OF-DAYS.
103300
103400     MOVE H-HHA-HRG-OUTPUT-CODE (CO1) TO WORK-HRG.
103500
103600*         YEARCHANGE                              ===========**
103700
103800      PERFORM 10100-SUPPLY-ADD-ON-CALC  THRU 10100-EXIT.
103900
104000*         YEARCHANGE                              ===========**
104100
104200
104300*    IF HHA-SERV-THRU-DATE > 20071231 AND
104400*       HHA-SERV-FROM-DATE > 20071231
104500*        NEXT SENTENCE
104600*    ELSE
104700*        MOVE 0000000.00 TO FED-SUPPLY-ADJ.
104800
104900
105000     COMPUTE FED-ADJ ROUNDED =
105100               (WK-HRG-NO-OF-DAYS  *
105200                H-HHA-HRG-WGTS (CO1) *
105300                FED-EPISODE-RATE-AMT) / 60.
105400
105500     COMPUTE FED-LABOR-ADJ ROUNDED =
105600               WIR-CBSA-WAGEIND *
105700               LABOR-PERCENT * FED-ADJ.
105800
105900     COMPUTE FED-NON-LABOR-ADJ ROUNDED =
106000               NONLABOR-PERCENT * FED-ADJ.
106100
106200     COMPUTE WK-5000-PEP-N-PAYMENT ROUNDED =
106300           (FED-LABOR-ADJ + FED-NON-LABOR-ADJ + FED-SUPPLY-ADJ).
106400
106500     COMPUTE H-HHA-HRG-PAY (CO1) ROUNDED =
106600             WK-5000-PEP-N-PAYMENT.
106700
106800
106900     COMPUTE WK-5000-PEP-N-PRETOT-PAY ROUNDED =
107000             WK-5000-PEP-N-PRETOT-PAY + WK-5000-PEP-N-PAYMENT.
107100
107200
107300 5000-EXIT.   EXIT.
107400 6000-PEP-Y-ADJUST.
107500
107600***************************************************************
107700*           HRG OCCUR > 1 AND PEP = Y SHORTENED EPISODE
107800***************************************************************
107900
108000     IF H-HHA-HRG-INPUT-CODE (CO1) = SPACES
108100        MOVE 6 TO SUB1
108200        GO TO 6000-EXIT.
108300
108400     MOVE 3 TO WK-RTC-ADJ-IND.
108500
108600     MOVE H-HHA-HRG-NO-OF-DAYS (CO1) TO WK-HRG-NO-OF-DAYS.
108700     MOVE H-HHA-PEP-DAYS             TO WK-PEP-DAYS.
108800
108900     MOVE H-HHA-HRG-OUTPUT-CODE (CO1) TO WORK-HRG.
109000
109100*         YEARCHANGE                              ===========**
109200
109300      PERFORM 10100-SUPPLY-ADD-ON-CALC  THRU 10100-EXIT.
109400
109500*         YEARCHANGE                              ===========**
109600
109700
109800*    IF HHA-SERV-THRU-DATE > 20071231 AND
109900*       HHA-SERV-FROM-DATE > 20071231
110000*        NEXT SENTENCE
110100*    ELSE
110200*        MOVE 0000000.00 TO FED-SUPPLY-ADJ.
110300*
110400*    COMPUTE FED-ADJ ROUNDED =
110500*        (WK-HRG-NO-OF-DAYS / WK-PEP-DAYS)
110600*                                *
110700*                    ((WK-PEP-DAYS / 60)
110800*                                *
110900*          (H-HHA-HRG-WGTS (CO1) * FED-EPISODE-RATE-AMT)).
111000*
111100*
111200*    COMPUTE FED-ADJ ROUNDED =
111300*        (WK-HRG-NO-OF-DAYS / WK-PEP-DAYS)
111400*                                *
111500*      ((WK-PEP-DAYS * H-HHA-HRG-WGTS (CO1) *
111600*                          FED-EPISODE-RATE-AMT) / 60).
111700
111800     COMPUTE FED-ADJ1 ROUNDED =
111900      ((WK-PEP-DAYS * H-HHA-HRG-WGTS (CO1) *
112000                           FED-EPISODE-RATE-AMT) / 60).
112100
112200     COMPUTE FED-ADJ ROUNDED  =
112300                  (FED-ADJ1 * WK-HRG-NO-OF-DAYS) / WK-PEP-DAYS.
112400
112500     COMPUTE FED-LABOR-ADJ ROUNDED =
112600               WIR-CBSA-WAGEIND *
112700               LABOR-PERCENT * FED-ADJ.
112800
112900     COMPUTE FED-NON-LABOR-ADJ ROUNDED =
113000               NONLABOR-PERCENT * FED-ADJ.
113100
113200     COMPUTE WK-6000-PEP-Y-PAYMENT ROUNDED =
113300          (FED-LABOR-ADJ + FED-NON-LABOR-ADJ + FED-SUPPLY-ADJ).
113400
113500     COMPUTE H-HHA-HRG-PAY (CO1) ROUNDED =
113600             WK-6000-PEP-Y-PAYMENT.
113700
113800     COMPUTE WK-6000-PEP-Y-PRETOT-PAY ROUNDED =
113900             WK-6000-PEP-Y-PRETOT-PAY + WK-6000-PEP-Y-PAYMENT.
114000
114100
114200 6000-EXIT.   EXIT.
114300
114400 7000-OUTLIER-PAYMENT.
114500***************************************************************
114600*                    OUTLIER PAYMENT
114700***************************************************************
114800     COMPUTE OUT-THRES-LABOR-ADJ ROUNDED =
114900               WIR-CBSA-WAGEIND *
115000               LABOR-PERCENT * OUTLIER-THRESHOLD-AMT.
115100
115200     COMPUTE OUT-THRES-NON-LABOR-ADJ ROUNDED =
115300               NONLABOR-PERCENT * OUTLIER-THRESHOLD-AMT.
115400
115500     COMPUTE OUT-THRES-AMT-ADJ ROUNDED  =
115600             (OUT-THRES-LABOR-ADJ +
115700              OUT-THRES-NON-LABOR-ADJ).
115800
115900      COMPUTE WK-7000-OUTLIER-VALUE-A ROUNDED =
116000              OUT-THRES-AMT-ADJ +
116100             WK-3000-PEP-N-PRETOT-PAY +
116200             WK-4000-PEP-Y-PRETOT-PAY +
116300             WK-5000-PEP-N-PRETOT-PAY +
116400             WK-6000-PEP-Y-PRETOT-PAY.
116500
116600      PERFORM 8000-ADD-REV-DOLL THRU 8000-EXIT
116700                  VARYING CO1 FROM 1 BY 1 UNTIL
116800                   CO1 > 6.
116900
117000      COMPUTE WK-7000-AB-DIFF ROUNDED =
117100              WK-8000-OUTLIER-VALUE-B - WK-7000-OUTLIER-VALUE-A.
117200****===================
117300      IF WK-7000-AB-DIFF > ZERO
117400         COMPUTE WK-7000-CALC ROUNDED =
117500               OUTL-LOSS-SHAR-RATIO-PERCENT * WK-7000-AB-DIFF
117600
117700*** ================== NEW OUTLIER CAP HERE ========
117800         PERFORM 10000-OUTLIER-CAP-CALC THRU 10000-EXIT
117900*** ================== NEW OUTLIER CAP HERE ========
118000
118100****===================
118200         COMPUTE H-HHA-OUTLIER-PAYMENT ROUNDED =
118300               WK-7000-CALC
118400
118500****===================
118600         COMPUTE H-HHA-TOTAL-PAYMENT ROUNDED =
118700                (WK-7000-CALC +
118800                 WK-3000-PEP-N-PRETOT-PAY +
118900                 WK-4000-PEP-Y-PRETOT-PAY +
119000                 WK-5000-PEP-N-PRETOT-PAY +
119100                 WK-6000-PEP-Y-PRETOT-PAY)
119200
119300          PERFORM 9000-WHICH-RTC-OUTLIER THRU 9000-EXIT
119400      ELSE
119500         COMPUTE H-HHA-TOTAL-PAYMENT ROUNDED =
119600                (WK-3000-PEP-N-PRETOT-PAY +
119700                 WK-4000-PEP-Y-PRETOT-PAY +
119800                 WK-5000-PEP-N-PRETOT-PAY +
119900                 WK-6000-PEP-Y-PRETOT-PAY)
120000          PERFORM 9050-WHICH-RTC-NO-OUTLIER THRU 9050-EXIT.
120100
120200
120300 7000-EXIT.   EXIT.
120400
120500 8000-ADD-REV-DOLL.
120600
120700***************************************************************
120800*        ADD ALL REVENUE DOLLARS
120900***************************************************************
121000
121100     IF H-HHA-REVENUE-CODE (CO1) = SPACES
121200        MOVE 6 TO CO1
121300        GO TO 8000-EXIT.
121400
121500     IF H-HHA-REVENUE-QTY-COV-VISITS (CO1) = 0
121600        GO TO 8000-EXIT.
121700
121800     COMPUTE FED-ADJ ROUNDED =
121900                H-HHA-REVENUE-DOLL-RATE (CO1) *
122000                H-HHA-REVENUE-QTY-COV-VISITS (CO1).
122100
122200     COMPUTE FED-LABOR-ADJ ROUNDED =
122300               WIR-CBSA-WAGEIND *
122400               LABOR-PERCENT * FED-ADJ.
122500
122600     COMPUTE FED-NON-LABOR-ADJ ROUNDED =
122700               NONLABOR-PERCENT * FED-ADJ.
122800
122900     COMPUTE WK-8000-OUTLIER-LAB-NLAB ROUNDED =
123000           (FED-LABOR-ADJ + FED-NON-LABOR-ADJ).
123100
123200
123300     COMPUTE H-HHA-REVENUE-COST (CO1) ROUNDED =
123400               WK-8000-OUTLIER-LAB-NLAB.
123500
123600     COMPUTE WK-8000-OUTLIER-VALUE-B ROUNDED =
123700             WK-8000-OUTLIER-VALUE-B + WK-8000-OUTLIER-LAB-NLAB.
123800
123900 8000-EXIT.   EXIT.
124000
124100 9000-WHICH-RTC-OUTLIER.
124200
124300      MOVE '01' TO H-HHA-PAY-RTC.
124400      IF WK-RTC-ADJ-IND = 1  MOVE '08' TO H-HHA-PAY-RTC.
124500      IF WK-RTC-ADJ-IND = 2  MOVE '11' TO H-HHA-PAY-RTC.
124600      IF WK-RTC-ADJ-IND = 3  MOVE '13' TO H-HHA-PAY-RTC.
124700      IF WK-RTC-ADJ-IND = 4  MOVE '02' TO H-HHA-PAY-RTC.
124800
124900
125000 9000-EXIT.   EXIT.
125100
125200 9050-WHICH-RTC-NO-OUTLIER.
125300
125400      MOVE '00' TO H-HHA-PAY-RTC.
125500
125600      IF WK-RTC-ADJ-IND = 1  MOVE '07' TO H-HHA-PAY-RTC.
125700      IF WK-RTC-ADJ-IND = 2  MOVE '09' TO H-HHA-PAY-RTC.
125800      IF WK-RTC-ADJ-IND = 3  MOVE '12' TO H-HHA-PAY-RTC.
125900
126000 9050-EXIT.   EXIT.
126100
126200*         YEARCHANGE  2011.0                      ===========**
126300
126400 10000-OUTLIER-CAP-CALC.
126500
126600     IF  HHA-PROV-PAYMET-TOTAL = 0
126700        GO TO 10000-EXIT.
126800
126900     IF  HHA-PROV-OUTLIER-PAY-TOTAL = 0
127000        GO TO 10000-EXIT.
127100
127200     COMPUTE WK-10000-OUTLIER-POOL-PERCENT ROUNDED =
127300         HHA-PROV-PAYMET-TOTAL * .1.
127400
127500     COMPUTE WK-10000-OUTLIER-AVAIL-POOL ROUNDED =
127600      WK-10000-OUTLIER-POOL-PERCENT - HHA-PROV-OUTLIER-PAY-TOTAL.
127700
127800      COMPUTE WK-10000-OUTLIER-POOL-DIF ROUNDED =
127900         WK-10000-OUTLIER-AVAIL-POOL - WK-7000-CALC.
128000
128100      IF WK-10000-OUTLIER-POOL-DIF > 0
128200        GO TO 10000-EXIT.
128300
128400      IF WK-10000-OUTLIER-POOL-DIF < 0 OR
128500         HHA-PROV-OUTLIER-PAY-TOTAL < 0
128600        COMPUTE WK-7000-CALC ROUNDED = 0
128700        MOVE 4 TO WK-RTC-ADJ-IND.
128800
128900*         YEARCHANGE  2011.0                      ===========**
129000
129100 10000-EXIT.   EXIT.
129200
129300*         YEARCHANGE  2011.0                      ===========**
129400
129500 10100-SUPPLY-ADD-ON-CALC.
129600
129700
129800     IF HHA-CBSA-RURAL-CHECK
129900     OR HHA-CBSA-RURAL-CHECK-ALL
130000       GO TO RURAL-DATA-CHECK.
130100
130200     IF HHA-WITH-DATA-CHECK
130300       NEXT SENTENCE
130400     ELSE
130500       GO TO NO-DATA-CHECK.
130600
130700        IF  WORK-HRG5 = 'S' OR '1'
130800         MOVE 0000014.18 TO FED-SUPPLY-ADJ
130900         GO TO 10100-EXIT.
131000
131100        IF  WORK-HRG5 = 'T' OR '2'
131200         MOVE 0000051.18 TO FED-SUPPLY-ADJ
131300         GO TO 10100-EXIT.
131400
131500        IF  WORK-HRG5 = 'U' OR '3'
131600         MOVE 0000140.34 TO FED-SUPPLY-ADJ
131700         GO TO 10100-EXIT.
131800
131900        IF  WORK-HRG5 = 'V' OR '4'
132000         MOVE 0000208.51 TO FED-SUPPLY-ADJ
132100         GO TO 10100-EXIT.
132200
132300        IF  WORK-HRG5 = 'W' OR '5'
132400         MOVE 0000321.53 TO FED-SUPPLY-ADJ
132500         GO TO 10100-EXIT.
132600
132700        IF  WORK-HRG5 = 'X' OR '6'
132800         MOVE 0000553.00 TO FED-SUPPLY-ADJ
132900         GO TO 10100-EXIT.
133000
133100 NO-DATA-CHECK.
133200
133300     IF HHA-NO-DATA-CHECK
133400       NEXT SENTENCE
133500     ELSE
133600         GO TO 10100-EXIT.
133700
133800        IF  WORK-HRG5 = 'S' OR '1'
133900         MOVE 0000013.89 TO FED-SUPPLY-ADJ
134000         GO TO 10100-EXIT.
134100
134200        IF  WORK-HRG5 = 'T' OR '2'
134300         MOVE 0000050.17 TO FED-SUPPLY-ADJ
134400         GO TO 10100-EXIT.
134500
134600        IF  WORK-HRG5 = 'U' OR '3'
134700         MOVE 0000137.57 TO FED-SUPPLY-ADJ
134800         GO TO 10100-EXIT.
134900
135000        IF  WORK-HRG5 = 'V' OR '4'
135100         MOVE 0000204.38 TO FED-SUPPLY-ADJ
135200         GO TO 10100-EXIT.
135300
135400        IF  WORK-HRG5 = 'W' OR '5'
135500         MOVE 0000315.17 TO FED-SUPPLY-ADJ
135600         GO TO 10100-EXIT.
135700
135800        IF  WORK-HRG5 = 'X' OR '6'
135900         MOVE 0000542.06 TO FED-SUPPLY-ADJ
136000         GO TO 10100-EXIT.
136100
136200
136300 RURAL-DATA-CHECK.
136400
136500     IF HHA-WITH-DATA-CHECK
136600       NEXT SENTENCE
136700     ELSE
136800       GO TO RURAL-NO-DATA-CHECK.
136900
137000        IF  WORK-HRG5 = 'S' OR '1'
137100         MOVE 0000014.60 TO FED-SUPPLY-ADJ
137200         GO TO 10100-EXIT.
137300
137400        IF  WORK-HRG5 = 'T' OR '2'
137500         MOVE 0000052.72 TO FED-SUPPLY-ADJ
137600         GO TO 10100-EXIT.
137700
137800        IF  WORK-HRG5 = 'U' OR '3'
137900         MOVE 0000144.57 TO FED-SUPPLY-ADJ
138000         GO TO 10100-EXIT.
138100
138200        IF  WORK-HRG5 = 'V' OR '4'
138300         MOVE 0000214.78 TO FED-SUPPLY-ADJ
138400         GO TO 10100-EXIT.
138500
138600        IF  WORK-HRG5 = 'W' OR '5'
138700         MOVE 0000331.20 TO FED-SUPPLY-ADJ
138800         GO TO 10100-EXIT.
138900
139000        IF  WORK-HRG5 = 'X' OR '6'
139100         MOVE 0000569.63 TO FED-SUPPLY-ADJ.
139200         GO TO 10100-EXIT.
139300
139400 RURAL-NO-DATA-CHECK.
139500
139600     IF HHA-NO-DATA-CHECK
139700       NEXT SENTENCE
139800     ELSE
139900         GO TO 10100-EXIT.
140000
140100        IF  WORK-HRG5 = 'S' OR '1'
140200         MOVE 0000014.31 TO FED-SUPPLY-ADJ
140300         GO TO 10100-EXIT.
140400
140500        IF  WORK-HRG5 = 'T' OR '2'
140600         MOVE 0000051.68 TO FED-SUPPLY-ADJ
140700         GO TO 10100-EXIT.
140800
140900        IF  WORK-HRG5 = 'U' OR '3'
141000         MOVE 0000141.71 TO FED-SUPPLY-ADJ
141100         GO TO 10100-EXIT.
141200
141300        IF  WORK-HRG5 = 'V' OR '4'
141400         MOVE 0000210.53 TO FED-SUPPLY-ADJ
141500         GO TO 10100-EXIT.
141600
141700        IF  WORK-HRG5 = 'W' OR '5'
141800         MOVE 0000324.66 TO FED-SUPPLY-ADJ
141900         GO TO 10100-EXIT.
142000
142100        IF  WORK-HRG5 = 'X' OR '6'
142200         MOVE 0000558.37 TO FED-SUPPLY-ADJ
142300         GO TO 10100-EXIT.
142400
142500
142600*         YEARCHANGE  2011.0                      ===========**
142700
142800 10100-EXIT.   EXIT.
142900
143000******        L A S T   S O U R C E   S T A T E M E N T   *****
