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