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