000100 IDENTIFICATION DIVISION.                                         00010000
000200 PROGRAM-ID.      HHCAL130.                                       00020000
000300*AUTHOR.          DDS TEAM.                                       00030000
000400*REVISED.         DDS TEAM.                                       00031000
000500*REMARKS.     (CENTERS FOR MEDICARE & MEDICAID SERVICES)          00032000
000600*REMARKS. A). NATIONAL HHA PRICER                                 00033000
000700***       B). NATIONAL HHA PRICER EFFECTIVE OCT 1 2001            00034000
000800***       C). THERE ARE YEARLY HHA PRICER MODULES THAT WILL       00035000
000900***           CALCULATE THE HRG'S,REVENUE CODES AND               00036000
001000***           TYPE OF BILLS.                                      00037000
001100*REMARKS.                                                         00038000
001200******************************************************************00039000
001300*     FOR FY 2009 CALCULATIONS AND RATES NO CHANGES JUST SYNC TO  00164100
001400*              CORRECT LUPA RATE DETERMINATION IF LOGIC           00164200
001500*                CORRECT LUPA CALCULATION FOR REJECTED AND
001600*                REPROCESSED CLAIMS
001700*     HHCAL090   RATES EFFECTIVE JAN 1, 2009 CICS VERSION         00164300
001800*     HHCAL091   LUPA PAYMENT TO ZERO FOR ZERO REV VISITS         00164300
001900*     HHCAL092   HIPPA RECODE REVISION FOR 5 IN POS 1             00164300
002000*     HHCAL100 EXPAND BILLING RECORD TO 500 BYTES                       00
002100*     HHCAL101                                                          00
002200*     HHCAL106 CORRECT HIPPS RECODING ISSUE                             00
002300*     HHCAL107 NEW HEALTH CARE REFORM                                   00
002400*     HHCAL111 CY 2011                                                  00
002500*     HHCAL120 CY 2012                                                  00
002600*     HHCAL130 CY 2013                                                  00
002700******************************************************************00164400
002800******************************************************************00164500
002900*            RETURN CODE VALUES (HHA-RTC)                         00164600
003000*                                                                 00164700
003100*        HHA-RTC  WITH PAYMENTS RETURNED                          00164800
003200*                                                                 00164900
003300*     RETURN CODES                                                00165000
003400*          00 = FINAL PAYMENT                                     00166000
003500*               TOB = 329,339,327,337                             00167000
003600*                  OR 32G OR 33G OR 32I OR 33I                    00168000
003700*                  OR 32J OR 33J OR 32M OR 33M                    00169000
003800*                  OR 32F OR 32K OR 32P OR 32H                    00170000
003900*                  OR 33F OR 33K OR 33P OR 33H                    00180000
004000*               WITH HRG,REVENUE CODE WHERE NO OUTLIER APPLIES    00190000
004100*          01 = FINAL PAYMENT                                     00200000
004200*               TOB = 329,339,327,337                             00210000
004300*                  OR 32G OR 33G OR 32I OR 33I                    00220000
004400*                  OR 32J OR 33J OR 32M OR 33M                    00230000
004500*                  OR 32F OR 32K OR 32P OR 32H                    00240000
004600*                  OR 33F OR 33K OR 33P OR 33H                    00250000
004700*               WITH HRG,REVENUE CODE WHERE OUTLIER APPLIES       00260000
004800*          03 = INITIAL HALF PAYMENT PAYMENT WILL BE ZERO         00270000
004900*               TOB = 332 AND 322                                 00280000
005000*          04 = INITIAL HALF PAYMENT PAID AT 50%                  00290000
005100*               TOB = 332 AND 322                                 00300000
005200*               WITH INITIAL (FIRST) HRG AND NO REVENUE CODES     00310000
005300*          05 = INITIAL HALF PAYMENT PAID AT 60%                  00320000
005400*               TOB = 332 AND 322                                 00330000
005500*               WITH INITIAL (FIRST) HRG AND NO REVENUE CODES     00340000
005600*       06,14 = LUPA PAYMENT ONLY                                 00350000
005700*               TOB = 329,339,327,337                             00360000
005800*                  OR 32G OR 33G OR 32I OR 33I                    00370000
005900*                  OR 32J OR 33J OR 32M OR 33M                    00380000
006000*                  OR 32F OR 32K OR 32P OR 32H                    00390000
006100*                  OR 33F OR 33K OR 33P OR 33H                    00400000
006200*               WITH REVENUE CODES AND REVENUE QTYS < 5       *   00410000
006300******************************************************************00420000
006400*          07 = FINAL PAYMENT, SCIC, PEP = N, NO OUTLIER          00430000
006500*               TOB = 329,339,327,337                             00440000
006600*                  OR 32G OR 33G OR 32I OR 33I                    00450000
006700*                  OR 32J OR 33J OR 32M OR 33M                    00460000
006800*                  OR 32F OR 32K OR 32P OR 32H                    00470000
006900*                  OR 33F OR 33K OR 33P OR 33H                    00480000
007000*               WITH REVENUE CODE WHERE NO OUTLIER APPLIES        00490000
007100*               WITH MORE THAN ONE HRG OCCURRENCE             *   00500000
007200*          08 = FINAL PAYMENT, SCIC, PEP = N, WITH OUTLIER        00510000
007300*               TOB = 329,339,327,337                             00520000
007400*                  OR 32G OR 33G OR 32I OR 33I                    00530000
007500*                  OR 32J OR 33J OR 32M OR 33M                    00540000
007600*                  OR 32F OR 32K OR 32P OR 32H                    00550000
007700*                  OR 33F OR 33K OR 33P OR 33H                    00560000
007800*               WITH REVENUE CODE WHERE OUTLIER APPLIES           00570000
007900*               WITH MORE THAN ONE HRG OCCURRENCE             *   00580000
008000******************************************************************00590000
008100*          09 = FINAL PAYMENT, PEP = Y, NO OUTLIER                00600000
008200*               TOB = 329,339,327,337                             00610000
008300*                  OR 32G OR 33G OR 32I OR 33I                    00620000
008400*                  OR 32J OR 33J OR 32M OR 33M                    00630000
008500*                  OR 32F OR 32K OR 32P OR 32H                    00640000
008600*                  OR 33F OR 33K OR 33P OR 33H                    00650000
008700*               WITH REVENUE CODE WHERE NO OUTLIER APPLIES        00660000
008800*               WITH ONE HRG OCCURRENCE                       *   00670000
008900*          11 = FINAL PAYMENT, PEP = Y, WITH OUTLIER              00680000
009000*               TOB = 329,339,327,337                             00690000
009100*                  OR 32G OR 33G OR 32I OR 33I                    00700000
009200*                  OR 32J OR 33J OR 32M OR 33M                    00710000
009300*                  OR 32F OR 32K OR 32P OR 32H                    00720000
009400*                  OR 33F OR 33K OR 33P OR 33H                    00730000
009500*               WITH REVENUE CODE WHERE OUTLIER APPLIES           00740000
009600*               WITH ONE HRG OCCURRENCE                       *   00750000
009700******************************************************************00760000
009800*          12 = FINAL PAYMENT, SCIC, PEP = Y, NO OUTLIER          00770000
009900*               TOB = 329,339,327,337                             00780000
010000*                  OR 32G OR 33G OR 32I OR 33I                    00790000
010100*                  OR 32J OR 33J OR 32M OR 33M                    00800000
010200*                  OR 32F OR 32K OR 32P OR 32H                    00810000
010300*                  OR 33F OR 33K OR 33P OR 33H                    00820000
010400*               WITH REVENUE CODE WHERE NO OUTLIER APPLIES        00830000
010500*               WITH MORE THAN ONE HRG OCCURRENCE             *   00840000
010600*          13 = FINAL PAYMENT, SCIC, PEP = Y, WITH OUTLIER        00850000
010700*               TOB = 329,339,327,337                             00860000
010800*                  OR 32G OR 33G OR 32I OR 33I                    00870000
010900*                  OR 32J OR 33J OR 32M OR 33M                    00880000
011000*                  OR 32F OR 32K OR 32P OR 32H                    00890000
011100*                  OR 33F OR 33K OR 33P OR 33H                    00900000
011200*               WITH REVENUE CODE WHERE OUTLIER APPLIES           00910000
011300*               WITH MORE THAN ONE HRG OCCURRENCE             *   00920000
011400******************************************************************00930000
011500******************************************************************00940000
011600*                                                             *   00950000
011700*            HHA-RTC   NO PAYMENTS RETURNED                   *   00960000
011800*                                                             *   00970000
011900*              10 = INVALID TOB                               *   00980000
012000*                                                             *   00990000
012100*              15 = INVALID PEP DAYS                          *   01000000
012200*                   FOR SHORTENED EPISODE                     *   01010000
012300*                                                             *   01020000
012400*              16 = INVALID HRG DAYS , > 60 DAYS              *   01030000
012500*                                                             *   01040000
012600*              20 = INVALID PEP INDICATOR                     *   01050000
012700*                                                             *   01060000
012800*              25 = INVALID MED REVIEW INDICATOR              *   01070000
012900*                                                             *   01080000
013000*              30 = INVALID CBSA CODE                         *   01090000
013100*                                                             *   01100000
013200*              35 = INVALID INITIAL PAYMENT INDICATOR         *   01110000
013300*                        0 = MAKE NORMAL INITIAL PAYMENT      *   01120000
013400*                        1 = MAKE ZERO PAYMANT                *   01130000
013500*                                                             *   01140000
013600*              40 = INVALID SERVICE THRU DATE FOR             *   01150000
013700*                      CURRENT CALENDER YEAR                  *   01160000
013800*                                                             *   01170000
013900*              70 = INVALID OR NO HRG CODE PRESENT            *   01180000
014000*                                                             *   01190000
014100*              75 = NO HRG PRESENT IN FIRST OCCURANCE AND     *   01200000
014200*                   REVENUE-QTY-COV-VISITS > 4  AND           *   01210000
014300*                       TOB = 329,339,327,337                 *   01220000
014400*                          OR 32G OR 33G OR 32I OR 33I        *   01230000
014500*                          OR 32J OR 33J OR 32M OR 33M        *   01240000
014600*                          OR 32F OR 32K OR 32P OR 32H            01250000
014700*                          OR 33F OR 33K OR 33P OR 33H            01260000
014800*                                                             *   01270000
014900*              80 = INVALID REVENUE CODE                      *   01280000
015000*                                                             *   01290000
015100*              85 = NO REVENUE CODE PRESENT                   *   01300000
015200*                   WITH TOB 329 OR 339 OR 327 OR 337         *   01310000
015300*                         OR 32G OR 33G OR 32I OR 33I         *   01320000
015400*                         OR 32J OR 33J OR 32M OR 33M         *   01330000
015500*                         OR 32F OR 32K OR 32P OR 32H             01340000
015600*                         OR 33F OR 33K OR 33P OR 33H             01350000
015700*                                                             *   01360000
015800***************************************************************   01370000
015900***************************************************************   01380000
016000***************************************************************   01390000
016100 DATE-COMPILED.                                                   01400000
016200 ENVIRONMENT DIVISION.                                            01410000
016300 CONFIGURATION SECTION.                                           01420000
016400 SOURCE-COMPUTER.            IBM-370.                             01430000
016500 OBJECT-COMPUTER.            IBM-370.                             01440000
016600 INPUT-OUTPUT  SECTION.                                           01450000
016700 FILE-CONTROL.                                                    01460000
016800                                                                  01470000
016900 DATA DIVISION.                                                   01480000
017000 FILE SECTION.                                                    01490000
017100                                                                  01500000
017200 WORKING-STORAGE SECTION.                                         01510000
017300 01  W-STORAGE-REF                  PIC X(46)  VALUE              01520000
017400     'HHCAL130       - W O R K I N G   S T O R A G E'.            01530000
017500 01  CAL-VERSION                    PIC X(07)  VALUE 'C2013.0'.   01540000
017600 01  CO1                            PIC S9(04) COMP SYNC.         01550000
017700 01  SUB1                           PIC S9(04) COMP SYNC.         01560000
017800 01  R1                             PIC S9(04) COMP SYNC.         01570000
017900 01  R2                             PIC S9(04) COMP SYNC.         01580000
018000 01  R3                             PIC S9(04) COMP SYNC.         01590000
018100                                                                  01600000
018600***************************************************************   04500005
018700*         YEARCHANGE                                              04500005
018800***************************************************************   04500005
018200 01  LABOR-NLABOR-PERCENT.                                        01610000
018300     05 LABOR-PERCENT        PIC 9V9(05)  VALUE 0.78535.          01620004
018400     05 NONLABOR-PERCENT     PIC 9V9(05)  VALUE 0.21465.          01630004
018500                                                                  01640000
018600***************************************************************   04500005
018700*         YEARCHANGE                              ===========**   04500005
018800***************************************************************   04500005
018900 01  LUPA-ADD-ON                  PIC 9(03)V9(02) VALUE 093.96.   01650000
019000 01  LUPA-ADD-ON-RURAL            PIC 9(03)V9(02) VALUE 096.78.   01650000
019100 01  LUPA-ADD-ON-2PERCENT         PIC 9(03)V9(02) VALUE 095.85.   01650000
019200 01  LUPA-ADD-ON-2PERCENT-RUR     PIC 9(03)V9(02) VALUE 098.73.   01650000
019300 01  LUPA-LABOR-ADJ               PIC 9(03)V9(02).                01650000
019400 01  LUPA-NON-LABOR-ADJ           PIC 9(03)V9(02).                01650000
019500                                                                  01640000
019600 01  FED-EPISODE-RATE-AMT         PIC 9(05)V9(02) VALUE 0.        01650000
019700 01  OUTLIER-THRESHOLD-AMT        PIC 9(05)V9(02) VALUE 0.        01660000
019800***************************************************************** 01670000
019900***    EXAMPLE    *********************************************** 01680000
020000*** FED-EPISODE-RATE-AMT TIMES 1.13 = OUTLIER-THRESHOLD-AMT ***** 01690000
020100******  2327.68 TIMES 0.65  = 1512.99  ROUNDED UP  ************** 01700000
020200***************************************************************** 01710000
020300 01  OUTL-LOSS-SHAR-RATIO-PERCENT PIC 9(01)V9(02) VALUE 0.80.     01720000
020400                                                                  01730000
020500 01  WK-PEP-DAYS           PIC S9(04)       VALUE 0.              01740000
020600 01  WK-HRG-NO-OF-DAYS     PIC S9(04)       VALUE 0.              01750000
020700 01  WK-HRG-NO-OF-DAYS-FAC PIC S9(04)V9(06) VALUE 0.              01750000
020800 01  WK-HRG-NO-OF-DAYS-TOT PIC S9(04)       VALUE 0.              01760000
020900 01  WK-RTC-ADJ-IND        PIC 9            VALUE 0.              01770000
021000 01  WK-ALL-TOTALS.                                               01780000
021100     05  FED-ADJ                        PIC S9(07)V9(02).         01790000
021200     05  FED-ADJ1                       PIC S9(07)V9(02).         01800000
021300     05  FED-LABOR-ADJ                  PIC S9(07)V9(02).         01810000
021400     05  FED-SUPPLY-ADJ                 PIC S9(07)V9(02).         01811005
021500     05  FED-NON-LABOR-ADJ              PIC S9(07)V9(02).         01820005
021600     05  OUT-THRES-AMT-ADJ              PIC S9(07)V9(02).         01830005
021700     05  OUT-THRES-LABOR-ADJ            PIC S9(07)V9(02).         01840005
021800     05  OUT-THRES-NON-LABOR-ADJ        PIC S9(07)V9(02).         01850005
021900     05  WK-3000-PEP-N-PRETOT-PAY       PIC S9(07)V9(02).         01860005
022000     05  WK-3000-PEP-N-PAYMENT          PIC S9(07)V9(02).         01870005
022100     05  WK-4000-PEP-Y-PRETOT-PAY       PIC S9(07)V9(02).         01880005
022200     05  WK-4000-PEP-Y-PAYMENT          PIC S9(07)V9(02).         01890005
022300     05  WK-5000-PEP-N-PRETOT-PAY       PIC S9(07)V9(02).         01900005
022400     05  WK-5000-PEP-N-PAYMENT          PIC S9(07)V9(02).         01910005
022500     05  WK-6000-PEP-Y-PRETOT-PAY       PIC S9(07)V9(02).         01920005
022600     05  WK-6000-PEP-Y-PAYMENT          PIC S9(07)V9(02).         01930005
022700     05  WK-6050-PEP-Y-TOT-DAYS         PIC S9(04).               01940005
022800     05  WK-7000-OUTLIER-VALUE-A        PIC S9(07)V9(02).         01950005
022900     05  WK-7000-AB-DIFF                PIC S9(07)V9(02).         01960005
023000     05  WK-7000-CALC                   PIC S9(07)V9(02).         01970005
023100     05  WK-8000-OUTLIER-VALUE-B        PIC S9(07)V9(02).         01980005
023200     05  WK-8000-OUTLIER-LAB-NLAB       PIC S9(07)V9(02).         01990005
023300     05  WK-10000-OUTLIER-POOL-DIF      PIC S9(07)V9(02).         01990005
023400     05  WK-10000-OUTLIER-POOL-PERCENT  PIC S9(09)V9(02).         01990005
023500     05  WK-10000-OUTLIER-AVAIL-POOL    PIC S9(09)V9(02).         01990005
023600                                                                  02000005
023700 01  WORK-HRG.                                                    02001006
023800     05  WORK-HRG1                      PIC X(01).                02002006
023900     05  WORK-HRG2                      PIC X(01).                02003006
024000     05  WORK-HRG3                      PIC X(01).                02004006
024100     05  WORK-HRG4                      PIC X(01).                02005006
024200     05  WORK-HRG5                      PIC X(01).                02006006
024300                                                                  02010005
024400                                                                  02020005
024500*******************************************************           02030005
024600 01  HOLD-HHA-DATA.                                               02040005
024700     05  H-HHA-INPUT-DATA.                                        02050005
024800         10  H-HHA-NPI                 PIC X(10).                 02060005
024900         10  H-HHA-HIC                 PIC X(12).                 02070005
025000         10  H-HHA-PROV-NO             PIC X(06).                 02080005
025100         10  H-HHA-TOB                 PIC XXX.                   02090005
025200         10  H-HHA-PEP-INDICATOR       PIC X.                     02100005
025300         10  H-HHA-PEP-DAYS            PIC 999.                   02110005
025400         10  H-HHA-INIT-PAY-INDICATOR  PIC X.                     02120005
025500             88 H-HHA-WITH-DATA-CHECK VALUE '0', '1'.             02130005
025600             88 H-HHA-NO-DATA-CHECK   VALUE '2', '3'.             02140005
025700         10  FILLER                    PIC X(07).                 02150005
025800         10  H-HHA-MSA1                PIC 9(07)V9(02).           02160005
025900         10  H-HHA-MSA2-DATA REDEFINES H-HHA-MSA1.                02170005
026000             15  FILLER             PIC XXX.                      02180005
026100             15  H-HHA-MSA2         PIC XXXX.                     02190005
026200             15  FILLER             PIC XX.                       02200005
026300         10  H-HHA-CBSA-DATA REDEFINES H-HHA-MSA1.                02210005
026400             15  FILLER             PIC XX.                       02220005
026500             15  H-HHA-CBSA         PIC XXXXX.                    02230005
026600             15  FILLER             PIC XX.                       02240005
026700         10  H-HHA-SERV-FROM-DATE.                                02250005
026800             15  H-HHA-FROM-CC         PIC XX.                    02260005
026900             15  H-HHA-FROM-YYMMDD.                               02270005
027000                 25  H-HHA-FROM-YY     PIC XX.                    02280005
027100                 25  H-HHA-FROM-MM     PIC XX.                    02290005
027200                 25  H-HHA-FROM-DD     PIC XX.                    02300005
027300         10  H-HHA-SERV-THRU-DATE.                                02310005
027400             15  H-HHA-THRU-CC         PIC XX.                    02320005
027500             15  H-HHA-THRU-YYMMDD.                               02330005
027600                 25  H-HHA-THRU-YY     PIC XX.                    02340005
027700                 25  H-HHA-THRU-MM     PIC XX.                    02350005
027800                 25  H-HHA-THRU-DD     PIC XX.                    02360005
027900         10  H-HHA-ADMIT-DATE.                                    02370005
028000             15  H-HHA-ADMIT-CC        PIC XX.                    02380005
028100             15  H-HHA-ADMIT-YYMMDD.                              02390005
028200                 25  H-HHA-ADMIT-YY    PIC XX.                    02400005
028300                 25  H-HHA-ADMIT-MM    PIC XX.                    02410005
028400                 25  H-HHA-ADMIT-DD    PIC XX.                    02420005
028500         10  H-HHA-HRG-DATA      OCCURS 6.                        02430005
028600             15  H-HHA-MED-REVIEW-INDICATOR PIC X.                02440005
028700             15  H-HHA-HRG-INPUT-CODE       PIC X(05).            02450005
028800             15  H-HHA-HRG-OUTPUT-CODE      PIC X(05).            02460005
028900             15  H-HHA-HRG-NO-OF-DAYS       PIC 9(03).            02470005
029000             15  H-HHA-HRG-WGTS             PIC 9(02)V9(04).      02480005
029100             15  H-HHA-HRG-PAY              PIC 9(07)V9(02).      02490005
029200         10  H-HHA-REVENUE-DATA     OCCURS 6.                     02500005
029300             15  H-HHA-REVENUE-CODE       PIC X(04).              02510005
029400             15  H-HHA-REVENUE-QTY-COV-VISITS PIC 9(03).          02520005
029500             15  H-HHA-REVENUE-DOLL-RATE  PIC 9(07)V9(02).        02530005
029600             15  H-HHA-REVENUE-COST       PIC 9(07)V9(02).        02540005
029700     05  H-HHA-PASSBACK-DATA.                                     02550005
029800         10  H-HHA-PAY-RTC                PIC 99.                 02560005
029900         10  H-HHA-REVENUE-SUM1-3-QTY-THR PIC 9(05).              02570005
030000         10  H-HHA-REVENUE-SUM1-6-QTY-ALL PIC 9(05).              02580005
030100         10  H-HHA-OUTLIER-PAYMENT        PIC 9(07)V9(02).        02590005
030200         10  H-HHA-TOTAL-PAYMENT          PIC 9(07)V9(02).        02600005
030300     05  H-HHA-CASE-MIX-DATA.                                     02601005
030400         10  H-HHA-LUPA-ADD-ON-PAYMENT    PIC 9(03)V9(02).        02602005
030500         10  H-HHA-LUPA-SRC-ADM           PIC X.                  02603005
030600         10  H-HHA-RECODE-IND             PIC X.                  02604005
030700         10  H-HHA-EPISODE-TIMING         PIC 9.                  02605005
030800         10  H-HHA-SEVERITY-POINTS.                               02606005
030900             15  H-HHA-CLINICAL-SEV-EQ1   PIC X(01).              02607005
031000             15  H-HHA-FUNCTION-SEV-EQ1   PIC X(01).              02608005
031100             15  H-HHA-CLINICAL-SEV-EQ2   PIC X(01).              02609005
031200             15  H-HHA-FUNCTION-SEV-EQ2   PIC X(01).              02609105
031300             15  H-HHA-CLINICAL-SEV-EQ3   PIC X(01).              02609205
031400             15  H-HHA-FUNCTION-SEV-EQ3   PIC X(01).              02609305
031500             15  H-HHA-CLINICAL-SEV-EQ4   PIC X(01).              02609405
031600             15  H-HHA-FUNCTION-SEV-EQ4   PIC X(01).              02609505
031700     05  H-HHA-PROV-TOTAL-DATA.                                   00010000
031800         10  H-HHA-PROV-OUTLIER-PAY-TOTAL PIC 9(08)V9(02).        00020000
031900         10  H-HHA-PROV-PAYMET-TOTAL      PIC 9(09)V9(02).        00030000
032000     05  FILLER                           PIC X(33).              00040000
032100**==================================================***           02609705
032200*    05  FILLER                         PIC X(20).                02610005
032300**==================================================***           02611005
032400                                                                  02640005
032500 LINKAGE SECTION.                                                 02650005
032600***************************************************************   02660005
032700*                 * * * * * * * * *                           *   02670005
032800***************************************************************   02680005
032900***************************************************************   02690005
033000*    THIS DATA IS CALCULATED BY THIS HHAPR  SUBROUTINE        *   02700005
033100*    AND PASSED BACK TO THE CALLING PROGRAM                   *   02710005
033200***************************************************************   02720005
033300 01  HHA-INPUT-DATA.                                              02730005
033400     05  HHA-DATA.                                                02740005
033500         10  HHA-NPI                 PIC X(10).                   02750005
033600         10  HHA-HIC                 PIC X(12).                   02760005
033700         10  HHA-PROV-NO             PIC X(06).                   02770005
033800         10  HHA-TOB                 PIC XXX.                     02780005
033900         10  HHA-PEP-INDICATOR       PIC X.                       02790005
034000         10  HHA-PEP-DAYS            PIC 999.                     02800005
034100         10  HHA-INIT-PAY-INDICATOR  PIC X.                       02810005
034200             88  HHA-WITH-DATA-CHECK VALUE '0', '1'.              02820005
034300             88  HHA-NO-DATA-CHECK   VALUE '2', '3'.              02830005
034400         10  FILLER                  PIC X(07).                   02840005
034500         10  HHA-MSA1                PIC 9(07)V9(02).             02850005
034600         10  HHA-MSA2-DATA REDEFINES HHA-MSA1.                    02860005
034700             15  FILLER             PIC XXX.                      02870005
034800             15  HHA-MSA2.                                        02880005
034900                 25  HHA-MSA2-RURAL-1ST.                          02890005
035000                     30  HHA-RURAL-MSA         PIC XX.            02900005
035100                     88  HHA-MSA-RURAL-CHECK   VALUE '99'.        02910005
035200                 25  HHA-MSA2-RURAL-2ND        PIC XX.            02920005
035300             15  FILLER             PIC XX.                       02930005
035400         10  HHA-CBSA-DATA REDEFINES HHA-MSA1.                    02940005
035500             15  FILLER             PIC XX.                       02950005
035600             15  HHA-CBSA.                                        02960005
035700                 88  HHA-CBSA-RURAL-CHECK-ALL VALUE               02970005
035800                 '50001', '50007', '50016', '50020', '50031',     02980005
035900                 '50036', '50054', '50060', '50067', '50087',     02990005
036000                 '50089', '50091', '50092', '50100', '50104',     03000005
036100                 '50108', '50114', '50121', '50125', '50140',     03010005
036200                 '50145', '50152', '50164', '50170', '50199',     03020005
036300                 '50206', '50210', '50214', '50218', '50222',     03021005
036400                 '50225', '50226', '50231', '50234', '50237',     03022005
036500                 '50243', '50248', '50250', '50255', '50256',     03023005
036600                 '50257', '50260', '50261', '50262', '50266',     03024005
036700                 '50268', '50272', '50275', '50281', '50286',     03025005
036800                 '50313', '50314', '50316', '50325', '50326',     03026005
036900                 '50327', '50329', '50336', '50344', '50352',     03027005
037000                 '50192', '50263', '50293'.                       03028005
037100                 25  HHA-CBSA-RURAL-1ST.                          03029005
037200                     30  HHA-RURAL-CBSA        PIC XXX.           03029105
037300                     88  HHA-CBSA-RURAL-CHECK   VALUE '999'.      03029205
037400                 25  HHA-CBSA-RURAL-2ND        PIC XX.            03029305
037500             15  FILLER             PIC XX.                       03029405
037600         10  HHA-SERV-FROM-DATE.                                  03029505
037700             15  HHA-FROM-CC         PIC XX.                      03029605
037800             15  HHA-FROM-YYMMDD.                                 03029705
037900                 25  HHA-FROM-YY     PIC XX.                      03029805
038000                 25  HHA-FROM-MM     PIC XX.                      03029905
038100                 25  HHA-FROM-DD     PIC XX.                      03030005
038200         10  HHA-SERV-THRU-DATE.                                  03040005
038300             15  HHA-THRU-CC         PIC XX.                      03050005
038400             15  HHA-THRU-YYMMDD.                                 03060005
038500                 25  HHA-THRU-YY     PIC XX.                      03070005
038600                 25  HHA-THRU-MM     PIC XX.                      03080005
038700                 25  HHA-THRU-DD     PIC XX.                      03090005
038800         10  HHA-ADMIT-DATE.                                      03100005
038900             15  HHA-ADMIT-CC        PIC XX.                      03110005
039000             15  HHA-ADMIT-YYMMDD.                                03120005
039100                 25  HHA-ADMIT-YY    PIC XX.                      03130005
039200                 25  HHA-ADMIT-MM    PIC XX.                      03140005
039300                 25  HHA-ADMIT-DD    PIC XX.                      03150005
039400         10  HHA-HRG-DATA      OCCURS 6.                          03160005
039500             15  HHA-MED-REVIEW-INDICATOR PIC X.                  03170005
039600             15  HHA-HRG-INPUT-CODE       PIC X(05).              03180005
039700             15  HHA-HRG-OUTPUT-CODE      PIC X(05).              03190005
039800             15  HHA-HRG-NO-OF-DAYS       PIC 9(03).              03200005
039900             15  HHA-HRG-WGTS             PIC 9(02)V9(04).        03210005
040000             15  HHA-HRG-PAY              PIC 9(07)V9(02).        03220005
040100         10  HHA-REVENUE-DATA     OCCURS 6.                       03230005
040200             15  HHA-REVENUE-CODE       PIC X(04).                03240005
040300             15  HHA-REVENUE-QTY-COV-VISITS PIC 9(03).            03250005
040400             15  HHA-REVENUE-DOLL-RATE  PIC 9(07)V9(02).          03260005
040500             15  HHA-REVENUE-COST       PIC 9(07)V9(02).          03270005
040600     05  HHA-PASSBACK-DATA.                                       03280005
040700         10  HHA-PAY-RTC                PIC 99.                   03290005
040800         10  HHA-REVENUE-SUM1-3-QTY-THR PIC 9(05).                03300005
040900         10  HHA-REVENUE-SUM1-6-QTY-ALL PIC 9(05).                03310005
041000         10  HHA-OUTLIER-PAYMENT        PIC 9(07)V9(02).          03320005
041100         10  HHA-TOTAL-PAYMENT          PIC 9(07)V9(02).          03330005
041200     05  HHA-CASE-MIX-DATA.                                       02601005
041300         10  HHA-LUPA-ADD-ON-PAYMENT      PIC 9(03)V9(02).        02602005
041400         10  HHA-LUPA-SRC-ADM             PIC X.                  02603005
041500         10  HHA-RECODE-IND               PIC X.                  02604005
041600         10  HHA-EPISODE-TIMING           PIC 9.                  02605005
041700         10  HHA-SEVERITY-POINTS.                                 02606005
041800             15  HHA-CLINICAL-SEV-EQ1     PIC X(01).              02607005
041900             15  HHA-FUNCTION-SEV-EQ1     PIC X(01).              02608005
042000             15  HHA-CLINICAL-SEV-EQ2     PIC X(01).              02609005
042100             15  HHA-FUNCTION-SEV-EQ2     PIC X(01).              02609105
042200             15  HHA-CLINICAL-SEV-EQ3     PIC X(01).              02609205
042300             15  HHA-FUNCTION-SEV-EQ3     PIC X(01).              02609305
042400             15  HHA-CLINICAL-SEV-EQ4     PIC X(01).              02609405
042500             15  HHA-FUNCTION-SEV-EQ4     PIC X(01).              02609505
042600     05  HHA-PROV-TOTAL-DATA.                                     00010000
042700         10  HHA-PROV-OUTLIER-PAY-TOTAL PIC 9(08)V9(02).          00020000
042800         10  HHA-PROV-PAYMET-TOTAL      PIC 9(09)V9(02).          00030000
042900     05  FILLER                         PIC X(33).                00040000
043000**==================================================***           02609705
043100*    05  FILLER                         PIC X(20).                03340005
043200                                                                  03350005
043300 01  HOLD-VARIABLES-DATA.                                         03360005
043400     02  HOLD-VAR-DATA.                                           03370005
043500         05  PRICER-OPTION-SW                   PIC X(01).        03380005
043600         05  HHOPN-VERSION                      PIC X(07).        03390005
043700         05  HHDRV-VERSION                      PIC X(07).        03400005
043800         05  HHCAL-VERSION                      PIC X(07).        03410005
043900         05  FILLER                             PIC X(20).        03420005
044000                                                                  03430005
044100 01  CBSA-WAGE-INDEX-DATA.                                        03440005
044200     02  HOLD-WIR-DATA.                                           03450005
044300         05  WIR-CBSA                       PIC X(05).            03460005
044400         05  WIR-CBSA-EFFDATE               PIC X(08).            03470005
044500         05  WIR-CBSA-WAGEIND               PIC 9(02)V9(04).      03480005
044600                                                                  03490005
044700 PROCEDURE DIVISION  USING HHA-INPUT-DATA                         03500005
044800                           HOLD-VARIABLES-DATA                    03510005
044900                           CBSA-WAGE-INDEX-DATA.                  03520005
045000                                                                  03530005
045100***************************************************************   03540005
045200*    PROCESSING:                                              *   03550005
045300*        A. WILL PROCESS NATIONAL HHA FOR CY 2010             *   03560005
045400*                STARTING JAN 1, 2010                         *   03570005
045500***************************************************************   03580005
045600                                                                  03590005
045700     MOVE CAL-VERSION TO HHCAL-VERSION.                           03600005
045800                                                                  03610005
045900     PERFORM 200-MAINLINE-CONTROL THRU 200-EXIT.                  03620005
046000                                                                  03630005
046100     MOVE HOLD-HHA-DATA TO HHA-INPUT-DATA.                        03640005
046200                                                                  03650005
046300     GOBACK.                                                      03660005
046400                                                                  03670005
046500 200-MAINLINE-CONTROL.                                            03680005
046600                                                                  03690005
046700     MOVE HHA-INPUT-DATA TO HOLD-HHA-DATA.                        03700005
046800                                                                  03710005
046900                                                                  03710005
047000*     DISPLAY '-- HHA-HIC HHCAL130  ===> ' HHA-HIC.               03640000
047100                                                                  03710005
047200     MOVE ALL '0' TO                                              03720005
047300                     WK-ALL-TOTALS                                03730005
047400                     WK-HRG-NO-OF-DAYS                            03740005
047500                     WK-HRG-NO-OF-DAYS-TOT                        03750005
047600                     WK-RTC-ADJ-IND                               03760005
047700                     WK-PEP-DAYS                                  03770005
047800                     H-HHA-PASSBACK-DATA                          03780005
047900                     H-HHA-HRG-PAY (1)                            03790005
048000                     H-HHA-HRG-PAY (2)                            03800005
048100                     H-HHA-HRG-PAY (3)                            03810005
048200                     H-HHA-HRG-PAY (4)                            03820005
048300                     H-HHA-HRG-PAY (5)                            03830005
048400                     H-HHA-HRG-PAY (6)                            03840005
048500                     H-HHA-REVENUE-COST (1)                       03850005
048600                     H-HHA-REVENUE-COST (2)                       03860005
048700                     H-HHA-REVENUE-COST (3)                       03870005
048800                     H-HHA-REVENUE-COST (4)                       03880005
048900                     H-HHA-REVENUE-COST (5)                       03890005
049000                     H-HHA-REVENUE-COST (6).                      03900005
049100                                                                  03910005
049200     IF  H-HHA-PAY-RTC = 00                                       03920005
049300         PERFORM 400-CALC-THE-HHA THRU 400-EXIT.                  03930005
049400                                                                  03940005
049500 200-EXIT.   EXIT.                                                03950005
049600                                                                  03960005
049700 400-CALC-THE-HHA.                                                03970005
049800                                                                  03980005
049900*    IF H-HHA-SERV-THRU-DATE < 20070101                           03990005
050000*        MOVE '40' TO H-HHA-PAY-RTC                               04000005
050100*        GO TO 400-EXIT.                                          04010005
050200                                                                  04020005
050300     IF H-HHA-ADMIT-DATE >                                        04030005
050400        H-HHA-SERV-FROM-DATE                                      04040005
050500         MOVE '40' TO H-HHA-PAY-RTC                               04050005
050600         GO TO 400-EXIT.                                          04060005
050700                                                                  04070005
050800     IF ((H-HHA-TOB = '332' OR '322') AND                         04080005
050900        (H-HHA-HRG-INPUT-CODE (1) = SPACE))                       04090005
051000        MOVE '70' TO H-HHA-PAY-RTC                                04100005
051100        GO TO 400-EXIT.                                           04110005
051200                                                                  04120005
051300     IF ((H-HHA-TOB = '329' OR '339' OR '327' OR '337' OR         04130005
051400                      '32G' OR '33G' OR '32I' OR '33I' OR         04140005
051500                      '32F' OR '32K' OR '32P' OR '32H' OR         04150005
051600                      '33F' OR '33K' OR '33P' OR '33H' OR         04160005
051700                      '32J' OR '33J' OR '32M' OR '33M') AND       04170005
051800         (H-HHA-REVENUE-SUM1-6-QTY-ALL > 4 ) AND                  04180005
051900         (H-HHA-HRG-INPUT-CODE (1) = SPACE))                      04190005
052000        MOVE '75' TO H-HHA-PAY-RTC                                04200005
052100        GO TO 400-EXIT.                                           04210005
052200                                                                  04220005
052300     IF ((H-HHA-TOB = '329' OR '339' OR '327' OR '337' OR         04230005
052400                      '32G' OR '33G' OR '32I' OR '33I' OR         04240005
052500                      '32F' OR '32K' OR '32P' OR '32H' OR         04250005
052600                      '33F' OR '33K' OR '33P' OR '33H' OR         04260005
052700                      '32J' OR '33J' OR '32M' OR '33M') AND       04270005
052800         (H-HHA-REVENUE-CODE (1) = SPACE))                        04280005
052900        MOVE '85' TO H-HHA-PAY-RTC                                04290005
053000        GO TO 400-EXIT.                                           04300005
053100                                                                  04310005
053200     IF ((H-HHA-TOB = '329' OR '339' OR '327' OR '337' OR         04320005
053300                      '32G' OR '33G' OR '32I' OR '33I' OR         04330005
053400                      '32F' OR '32K' OR '32P' OR '32H' OR         04340005
053500                      '33F' OR '33K' OR '33P' OR '33H' OR         04350005
053600                      '32J' OR '33J' OR '32M' OR '33M') AND       04360005
053700         (H-HHA-HRG-INPUT-CODE (2) NOT = SPACES) AND              04370005
053800         (H-HHA-PEP-INDICATOR = 'Y') AND                          04380005
053900         (H-HHA-PEP-DAYS NOT NUMERIC OR                           04390005
054000          H-HHA-PEP-DAYS = ZEROES))                               04400005
054100        MOVE '15' TO H-HHA-PAY-RTC                                04410005
054200        GO TO 400-EXIT.                                           04420005
054300                                                                  04430005
054400     IF H-HHA-PAY-RTC NOT = 00 GO TO 400-EXIT.                    04440005
054500                                                                  04450005
054600***************************************************************   04460005
054700***************************************************************   04470005
054800*        THESE RATES & THRESHOLDS ARE APPLIED                 *   04480005
054900* FOR NON-RURAL AND  RURAL                                    *   04490005
055000***************************************************************   04500005
055100*         YEARCHANGE                              ===========**   04500005
055200***************************************************************   04500005
055300* FOR NON RURAL NO DATA                                           04510005
055400     MOVE 02095.52 TO   FED-EPISODE-RATE-AMT.                     04520005
055500     MOVE 00942.98 TO   OUTLIER-THRESHOLD-AMT.                    04530005
055600                                                                  04540005
055700*------------------------------------------------------           04550005
055800*    WITH   REPORTING DATA  ---------------                       04640105
055900*         YEARCHANGE                      ===========**           04500005
056000*------------------------------------------------------           04570005
056100     IF HHA-WITH-DATA-CHECK                                       04600005
056200        NEXT SENTENCE                                             04630005
056300     ELSE                                                         04630005
056400        GO TO NO-REPORTING-DATA.                                  04630005
056500                                                                  04630005
056600        IF HHA-CBSA-RURAL-CHECK                                   04641005
056700        OR HHA-CBSA-RURAL-CHECK-ALL                               04642005
056800*------------------------------------------------------           04647005
056900*    RURAL, AND REPORTING DATA --------                           04648005
057000*------------------------------------------------------           04649005
057100           MOVE 02201.86 TO   FED-EPISODE-RATE-AMT                04644005
057200           MOVE 00990.84 TO   OUTLIER-THRESHOLD-AMT               04645005
057300        ELSE                                                      04646005
057400*------------------------------------------------------           04647005
057500*    NON RURAL, AND REPORTING DATA --------                       04648005
057600*------------------------------------------------------           04649005
057700           MOVE 02137.73 TO   FED-EPISODE-RATE-AMT                04649105
057800           MOVE 00961.98 TO   OUTLIER-THRESHOLD-AMT.              04649205
057900                                                                  04649305
058000                                                                  04649305
058100      GO TO PROCESS-PAYMENT.                                      04630005
058200                                                                  04630005
058300 NO-REPORTING-DATA.                                               04630005
058400                                                                  04649305
058500        IF HHA-CBSA-RURAL-CHECK                                   04641005
058600        OR HHA-CBSA-RURAL-CHECK-ALL                               04642005
058700*------------------------------------------------------           04647005
058800*    RURAL, AND NO REPORTING DATA --------                        04648005
058900*------------------------------------------------------           04649005
059000           MOVE 02158.39 TO   FED-EPISODE-RATE-AMT                04644005
059100           MOVE 00971.28 TO   OUTLIER-THRESHOLD-AMT               04645005
059200        GO TO PROCESS-PAYMENT.                                    04630005
059300                                                                  04630005
059400                                                                  04646005
059500*------------------------------------------------------           04647005
059600*    NON RURAL, AND NO REPORTING DATA --------                    04648005
059700*------------------------------------------------------           04649005
059800*          MOVE 02096.34 TO   FED-EPISODE-RATE-AMT.               04649105
059900*          MOVE 01404.55 TO   OUTLIER-THRESHOLD-AMT.              04649205
060000                                                                  04649305
060100                                                                  04649305
060200 PROCESS-PAYMENT.                                                 04630005
060300                                                                  04649305
060400*------------------------------------------------------           04640005
060500***************************************************************   04653005
060600                                                                  04654005
060700     IF H-HHA-TOB = '322' OR '332'                                04655005
060800        PERFORM 500-INITIAL-PAYMENT THRU 500-EXIT                 04656005
060900        GO TO 400-EXIT.                                           04657005
061000                                                                  04658005
061100     IF H-HHA-TOB = '329' OR '339' OR '327' OR '337' OR           04659005
061200                    '32G' OR '33G' OR '32I' OR '33I' OR           04660005
061300                    '32F' OR '32K' OR '32P' OR '32H' OR           04670005
061400                    '33F' OR '33K' OR '33P' OR '33H' OR           04680005
061500                    '32J' OR '33J' OR '32M' OR '33M'              04690005
061600        PERFORM 1000-FINAL-PAYMENT THRU 1000-EXIT                 04700005
061700        GO TO 400-EXIT.                                           04710005
061800                                                                  04720005
061900     MOVE '10' TO H-HHA-PAY-RTC.                                  04730005
062000                                                                  04740005
062100                                                                  04750005
062200 400-EXIT.   EXIT.                                                04760005
062300                                                                  04770005
062400 500-INITIAL-PAYMENT.                                             04780005
062500                                                                  04790005
062600***************************************************************   04800005
062700*            TOB = 322 OR 332 INITIAL PAYMENT                     04810005
062800***************************************************************   04820005
062900                                                                  04830005
063000     IF  H-HHA-INIT-PAY-INDICATOR  = '0' OR '1' OR '2' OR '3'     04840005
063100         NEXT SENTENCE                                            04850005
063200     ELSE                                                         04860005
063300         MOVE '35' TO H-HHA-PAY-RTC                               04870005
063400         GO TO 500-EXIT.                                          04880005
063500                                                                  04890005
063600     IF  H-HHA-INIT-PAY-INDICATOR  = '1' OR '3'                   04900005
063700         MOVE '03' TO H-HHA-PAY-RTC                               04910005
063800         GO TO 500-EXIT.                                          04920005
063900                                                                  04930005
064000     COMPUTE FED-ADJ ROUNDED =                                    04940005
064100               H-HHA-HRG-WGTS (1) * FED-EPISODE-RATE-AMT.         04950005
064200                                                                  04960005
064300     COMPUTE FED-LABOR-ADJ ROUNDED =                              04970005
064400             WIR-CBSA-WAGEIND *                                   04980005
064500             LABOR-PERCENT *                                      04990005
064600             FED-ADJ.                                             05000005
064700                                                                  05010005
064800     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          05020005
064900              (NONLABOR-PERCENT * FED-ADJ).                       05030005
065000                                                                  05040005
065100     MOVE H-HHA-HRG-OUTPUT-CODE (1) TO WORK-HRG.                  05040005
065200                                                                  05040005
065300*         YEARCHANGE                              ===========**   04500005
065400                                                                  08500005
065500      PERFORM 10100-SUPPLY-ADD-ON-CALC  THRU 10100-EXIT.          08620005
065600                                                                  06660005
065700*         YEARCHANGE                              ===========**   04500005
065800                                                                  05042407
065900*    IF HHA-SERV-THRU-DATE > 20071231 AND                         04580005
066000*       HHA-SERV-FROM-DATE > 20071231                             04590005
066100*        NEXT SENTENCE                                            04850005
066200*    ELSE                                                         05100005
066300*        MOVE 0000000.00 TO FED-SUPPLY-ADJ.                       05041107
066400                                                                  05042707
066500                                                                  05043007
066600     IF H-HHA-SERV-FROM-DATE = H-HHA-ADMIT-DATE                   05050005
066700        COMPUTE H-HHA-TOTAL-PAYMENT ROUNDED =                     05060005
066800       (FED-LABOR-ADJ + FED-NON-LABOR-ADJ + FED-SUPPLY-ADJ) * .6  05070005
066900        MOVE H-HHA-TOTAL-PAYMENT TO H-HHA-HRG-PAY (1)             05080005
067000        MOVE '05' TO H-HHA-PAY-RTC                                05090005
067100     ELSE                                                         05100005
067200        COMPUTE H-HHA-TOTAL-PAYMENT ROUNDED =                     05110005
067300       (FED-LABOR-ADJ + FED-NON-LABOR-ADJ + FED-SUPPLY-ADJ) * .5  05120005
067400        MOVE H-HHA-TOTAL-PAYMENT TO H-HHA-HRG-PAY (1)             05130005
067500        MOVE '04' TO H-HHA-PAY-RTC.                               05140005
067600                                                                  05150005
067700 500-EXIT.   EXIT.                                                05160005
067800                                                                  05170005
067900 1000-FINAL-PAYMENT.                                              05180005
068000                                                                  05190005
068100     IF H-HHA-REVENUE-QTY-COV-VISITS (1) NOT NUMERIC              05200005
068200        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (1).          05210005
068300     IF H-HHA-REVENUE-QTY-COV-VISITS (2) NOT NUMERIC              05220005
068400        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (2).          05230005
068500     IF H-HHA-REVENUE-QTY-COV-VISITS (3) NOT NUMERIC              05240005
068600        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (3).          05250005
068700     IF H-HHA-REVENUE-QTY-COV-VISITS (4) NOT NUMERIC              05260005
068800        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (4).          05270005
068900     IF H-HHA-REVENUE-QTY-COV-VISITS (5) NOT NUMERIC              05280005
069000        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (5).          05290005
069100     IF H-HHA-REVENUE-QTY-COV-VISITS (6) NOT NUMERIC              05300005
069200        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (6).          05310005
069300                                                                  05320005
069400     COMPUTE H-HHA-REVENUE-SUM1-3-QTY-THR ROUNDED =               05330005
069500             H-HHA-REVENUE-QTY-COV-VISITS (1) +                   05340005
069600             H-HHA-REVENUE-QTY-COV-VISITS (2) +                   05350005
069700             H-HHA-REVENUE-QTY-COV-VISITS (3).                    05360005
069800     COMPUTE H-HHA-REVENUE-SUM1-6-QTY-ALL ROUNDED =               05370005
069900             H-HHA-REVENUE-QTY-COV-VISITS (1) +                   05380005
070000             H-HHA-REVENUE-QTY-COV-VISITS (2) +                   05390005
070100             H-HHA-REVENUE-QTY-COV-VISITS (3) +                   05400005
070200             H-HHA-REVENUE-QTY-COV-VISITS (4) +                   05410005
070300             H-HHA-REVENUE-QTY-COV-VISITS (5) +                   05420005
070400             H-HHA-REVENUE-QTY-COV-VISITS (6).                    05430005
070500                                                                  05440005
070600     MOVE H-HHA-HRG-OUTPUT-CODE (1) TO WORK-HRG.                  05040005
070700                                                                  05440005
070800     IF H-HHA-REVENUE-SUM1-6-QTY-ALL < 5                          05450005
070900       NEXT SENTENCE
071000     ELSE
071100       GO TO PEP-CHECK.                                           01650000
071200                                                                  06440005
071300*01  LUPA-ADD-ON                                                  01650000
071400*01  LUPA-ADD-ON-RURAL                                            01650000
071500*01  LUPA-ADD-ON-2PERCENT                                         01650000
071600*01  LUPA-ADD-ON-2PERCENT-RUR                                     01650000
071700                                                                  01650000
071800                                                                  01650000
071900     IF HHA-WITH-DATA-CHECK                                       04600005
072000        IF HHA-CBSA-RURAL-CHECK
072100        OR HHA-CBSA-RURAL-CHECK-ALL
072200         COMPUTE LUPA-LABOR-ADJ ROUNDED =                         06330005
072300                 WIR-CBSA-WAGEIND *                               06340005
072400                 LABOR-PERCENT *                                  06350005
072500                 LUPA-ADD-ON-2PERCENT-RUR                         06360005
072600        ELSE                                                      06370005
072700         COMPUTE LUPA-LABOR-ADJ ROUNDED =                         06330005
072800                 WIR-CBSA-WAGEIND *                               06340005
072900                 LABOR-PERCENT *                                  06350005
073000                 LUPA-ADD-ON-2PERCENT                             06360005
073100        END-IF                                                    04649305
073200     ELSE                                                         06370005
073300        IF HHA-CBSA-RURAL-CHECK
073400        OR HHA-CBSA-RURAL-CHECK-ALL
073500         COMPUTE LUPA-LABOR-ADJ ROUNDED =                         06330005
073600                 WIR-CBSA-WAGEIND *                               06340005
073700                 LABOR-PERCENT *                                  06350005
073800                 LUPA-ADD-ON-RURAL                                06360005
073900        ELSE                                                      06370005
074000         COMPUTE LUPA-LABOR-ADJ ROUNDED =                         06330005
074100                 WIR-CBSA-WAGEIND *                               06340005
074200                 LABOR-PERCENT *                                  06350005
074300                 LUPA-ADD-ON                                      06360005
074400        END-IF                                                    04649305
074500     END-IF.                                                      04649305
074600                                                                  06370005
074700     IF HHA-WITH-DATA-CHECK                                       04600005
074800        IF HHA-CBSA-RURAL-CHECK
074900        OR HHA-CBSA-RURAL-CHECK-ALL
075000         COMPUTE LUPA-NON-LABOR-ADJ ROUNDED =                     06380005
075100                 NONLABOR-PERCENT *                               06390005
075200                 LUPA-ADD-ON-2PERCENT-RUR                         06400005
075300        ELSE                                                      06370005
075400         COMPUTE LUPA-NON-LABOR-ADJ ROUNDED =                     06380005
075500                 NONLABOR-PERCENT *                               06390005
075600                  LUPA-ADD-ON-2PERCENT                            06360005
075700        END-IF                                                    04649305
075800     ELSE                                                         06370005
075900        IF HHA-CBSA-RURAL-CHECK
076000        OR HHA-CBSA-RURAL-CHECK-ALL
076100         COMPUTE LUPA-NON-LABOR-ADJ ROUNDED =                     06330005
076200                 NONLABOR-PERCENT *                               06350005
076300                 LUPA-ADD-ON-RURAL                                06360005
076400        ELSE                                                      06370005
076500         COMPUTE LUPA-NON-LABOR-ADJ ROUNDED =                     06330005
076600                 NONLABOR-PERCENT *                               06350005
076700                 LUPA-ADD-ON                                      06360005
076800        END-IF                                                    04649305
076900     END-IF.                                                      04649305
077000                                                                  06410005
077100                                                                  05040005
077200     IF H-HHA-ADMIT-DATE = H-HHA-SERV-FROM-DATE AND               04040005
077300         WORK-HRG1 = '1' OR '2'                                   05041007
077400        COMPUTE H-HHA-LUPA-ADD-ON-PAYMENT ROUNDED =               01650000
077500          LUPA-LABOR-ADJ + LUPA-NON-LABOR-ADJ
077600     ELSE
077700        MOVE 0 TO  H-HHA-LUPA-ADD-ON-PAYMENT.                     01650000
077800                                                                  06440005
077900     IF (H-HHA-LUPA-SRC-ADM = 'B' OR 'C')                         02603005
078000        MOVE 0 TO  H-HHA-LUPA-ADD-ON-PAYMENT.                     01650000
078100                                                                  06440005
078200     IF  H-HHA-RECODE-IND  = '2'
078300        MOVE 0 TO  H-HHA-LUPA-ADD-ON-PAYMENT.                     01650000
078400                                                                  06440005
078500     IF H-HHA-REVENUE-SUM1-6-QTY-ALL = 0                          05450005
078600        MOVE 0 TO  H-HHA-LUPA-ADD-ON-PAYMENT.                     01650000
078700                                                                  06440005
078800        PERFORM 1050-LUPA THRU 1050-EXIT                          05460005
078900            VARYING SUB1 FROM 1 BY 1 UNTIL                        05470005
079000***         (H-HHA-REVENUE-CODE (SUB1) = SPACES OR                05480005
079100             SUB1 > 6.                                            05490005
079200                                                                  06440005
079300        IF H-HHA-LUPA-ADD-ON-PAYMENT > 0                          06440005
079400           MOVE '14' TO H-HHA-PAY-RTC                             06440005
079500        ELSE                                                      06440005
079600           MOVE '06' TO H-HHA-PAY-RTC                             05500005
079700        END-IF.                                                   06440005
079800                                                                  06440005
079900        COMPUTE H-HHA-TOTAL-PAYMENT   ROUNDED =                   05510005
080000                H-HHA-REVENUE-COST (1) +                          05520005
080100                H-HHA-REVENUE-COST (2) +                          05530005
080200                H-HHA-REVENUE-COST (3) +                          05540005
080300                H-HHA-REVENUE-COST (4) +                          05550005
080400                H-HHA-REVENUE-COST (5) +                          05560005
080500                H-HHA-REVENUE-COST (6) +                          05570005
080600                H-HHA-LUPA-ADD-ON-PAYMENT.                        01650000
080700                                                                  06440005
080800        GO TO 1000-EXIT.                                          05580005
080900                                                                  05590005
081000 PEP-CHECK.                                                       05590005
081100                                                                  05590005
081200     IF (H-HHA-PEP-INDICATOR NOT = 'Y' AND NOT = 'N')             05600005
081300         MOVE '20' TO H-HHA-PAY-RTC                               05610005
081400         GO TO 1000-EXIT.                                         05620005
081500                                                                  05630005
081600      PERFORM 1100-ADD-HRG-DAYS THRU 1100-EXIT                    05640005
081700         VARYING CO1 FROM 1 BY 1 UNTIL CO1 > 6.                   05650005
081800                                                                  05660005
081900      IF WK-HRG-NO-OF-DAYS-TOT > 60                               05670005
082000         MOVE '16' TO H-HHA-PAY-RTC                               05680005
082100         GO TO 1000-EXIT.                                         05690005
082200                                                                  05700005
082300                                                                  05710005
082400*********  HRG  PAYMENT   *******************                     05720005
082500                                                                  05730005
082600***  IF H-HHA-REVENUE-SUM1-3-QTY-THR > 9                          05740005
082700        IF H-HHA-HRG-INPUT-CODE (2) = SPACES                      05750005
082800           IF H-HHA-PEP-INDICATOR = 'N'                           05760005
082900              PERFORM 3000-PEP-N-ADJUST THRU 3000-EXIT            05770005
083000                  VARYING CO1 FROM 1 BY 1 UNTIL                   05780005
083100*                 (H-HHA-HRG-INPUT-CODE (CO1) = SPACES OR         05790005
083200                   CO1 > 6                                        05800005
083300               PERFORM 7000-OUTLIER-PAYMENT THRU 7000-EXIT        05810005
083400               GO TO 1000-EXIT.                                   05820005
083500                                                                  05830005
083600                                                                  05840005
083700***  IF H-HHA-REVENUE-SUM1-3-QTY-THR > 9                          05850005
083800        IF H-HHA-HRG-INPUT-CODE (2) = SPACES                      05860005
083900           IF H-HHA-PEP-INDICATOR = 'Y'                           05870005
084000              PERFORM 4000-PEP-Y-ADJUST THRU 4000-EXIT            05880005
084100                  VARYING CO1 FROM 1 BY 1 UNTIL                   05890005
084200*                 (H-HHA-HRG-INPUT-CODE (CO1) = SPACES OR         05900005
084300                   CO1 > 6                                        05910005
084400               PERFORM 7000-OUTLIER-PAYMENT THRU 7000-EXIT        05920005
084500               GO TO 1000-EXIT.                                   05930005
084600                                                                  05940005
084700**** IF H-HHA-REVENUE-SUM1-3-QTY-THR > 9                          05950005
084800        IF H-HHA-HRG-INPUT-CODE (2) NOT = SPACES                  05960005
084900           IF H-HHA-PEP-INDICATOR = 'N'                           05970005
085000              PERFORM 5000-PEP-N-ADJUST THRU 5000-EXIT            05980005
085100                  VARYING CO1 FROM 1 BY 1 UNTIL                   05990005
085200*                 (H-HHA-HRG-INPUT-CODE (CO1) = SPACES OR         06000005
085300                   CO1 > 6                                        06010005
085400               PERFORM 7000-OUTLIER-PAYMENT THRU 7000-EXIT        06020005
085500               GO TO 1000-EXIT.                                   06030005
085600                                                                  06040005
085700**** IF H-HHA-REVENUE-SUM1-3-QTY-THR > 9                          06050005
085800        IF H-HHA-HRG-INPUT-CODE (2) NOT = SPACES                  06060005
085900           IF H-HHA-PEP-INDICATOR = 'Y'                           06070005
086000              PERFORM 6000-PEP-Y-ADJUST THRU 6000-EXIT            06080005
086100                  VARYING CO1 FROM 1 BY 1 UNTIL                   06090005
086200*                 (H-HHA-HRG-INPUT-CODE (CO1) = SPACES OR         06100005
086300                   CO1 > 6                                        06110005
086400               PERFORM 7000-OUTLIER-PAYMENT THRU 7000-EXIT        06120005
086500               GO TO 1000-EXIT.                                   06130005
086600                                                                  06140005
086700                                                                  06150005
086800      MOVE '20' TO H-HHA-PAY-RTC.                                 06160005
086900                                                                  06170005
087000 1000-EXIT.  EXIT.                                                06180005
087100 1050-LUPA.                                                       06190005
087200                                                                  06200005
087300***************************************************************   06210005
087400*                    LUPA PAYMENT                                 06220005
087500***************************************************************   06230005
087600                                                                  06240005
087700     IF H-HHA-REVENUE-CODE (SUB1) = SPACES                        06250005
087800        MOVE 6 TO SUB1                                            06260005
087900        GO TO 1050-EXIT.                                          06270005
088000
088100     IF H-HHA-REVENUE-QTY-COV-VISITS (SUB1) = 0                   06300005
088200        GO TO 1050-EXIT.                                          06270005
088300
088400     MOVE H-HHA-HRG-OUTPUT-CODE (SUB1) TO WORK-HRG.               05040005
088500                                                                  05040005
088600     COMPUTE FED-ADJ ROUNDED =                                    06290005
088700             H-HHA-REVENUE-QTY-COV-VISITS (SUB1) *                06300005
088800             H-HHA-REVENUE-DOLL-RATE (SUB1).                      06310005
088900                                                                  06320005
089000     COMPUTE FED-LABOR-ADJ ROUNDED =                              06330005
089100             WIR-CBSA-WAGEIND *                                   06340005
089200             LABOR-PERCENT *                                      06350005
089300             FED-ADJ.                                             06360005
089400                                                                  06370005
089500                                                                  06370005
089600     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          06380005
089700             NONLABOR-PERCENT *                                   06390005
089800             FED-ADJ.                                             06400005
089900                                                                  06410005
090000     MOVE H-HHA-HRG-OUTPUT-CODE (1) TO WORK-HRG.                  05040005
090100     COMPUTE H-HHA-REVENUE-COST (SUB1) ROUNDED =                  06420005
090200             (FED-LABOR-ADJ + FED-NON-LABOR-ADJ).                 01650000
090300                                                                  06440005
090400                                                                  06410005
090500 1050-EXIT.   EXIT.                                               06450005
090600                                                                  06460005
090700 1100-ADD-HRG-DAYS.                                               06470005
090800                                                                  06480005
090900      IF H-HHA-HRG-NO-OF-DAYS (CO1) NUMERIC                       06490005
091000         ADD H-HHA-HRG-NO-OF-DAYS (CO1) TO                        06500005
091100             WK-HRG-NO-OF-DAYS-TOT.                               06510005
091200                                                                  06520005
091300 1100-EXIT.   EXIT.                                               06530005
091400                                                                  06540005
091500 3000-PEP-N-ADJUST.                                               06550005
091600                                                                  06560005
091700***************************************************************   06570005
091800*           HRG OCCUR < 2 AND PEP = N ADJUSTMENT                  06580005
091900***************************************************************   06590005
092000                                                                  06600005
092100     IF H-HHA-HRG-INPUT-CODE (CO1) = SPACES                       06610005
092200        MOVE 6 TO CO1                                             06620005
092300        GO TO 3000-EXIT.                                          06630005
092400                                                                  06640005
092500     MOVE H-HHA-HRG-NO-OF-DAYS (CO1) TO WK-HRG-NO-OF-DAYS.        06650005
092600                                                                  06660005
092700     MOVE H-HHA-HRG-OUTPUT-CODE (CO1) TO WORK-HRG.                05040005
092800                                                                  06660005
092900*         YEARCHANGE                              ===========**   04500005
093000                                                                  08500005
093100      PERFORM 10100-SUPPLY-ADD-ON-CALC  THRU 10100-EXIT.          08620005
093200                                                                  06660005
093300*         YEARCHANGE                              ===========**   04500005
093400                                                                  06660005
093500                                                                  05042407
093600*    IF HHA-SERV-THRU-DATE > 20071231 AND                         04580005
093700*       HHA-SERV-FROM-DATE > 20071231                             04590005
093800*        NEXT SENTENCE                                            04850005
093900*    ELSE                                                         05100005
094000*        MOVE 0000000.00 TO FED-SUPPLY-ADJ.                       05041107
094100                                                                  05042707
094200     COMPUTE FED-ADJ ROUNDED =                                    04940005
094300               H-HHA-HRG-WGTS (1) * FED-EPISODE-RATE-AMT.         04950005
094400                                                                  05042707
094500     COMPUTE FED-LABOR-ADJ ROUNDED =                              06720005
094600              (WIR-CBSA-WAGEIND *                                 06730005
094700               LABOR-PERCENT * FED-ADJ).                          06740005
094800                                                                  06750005
094900     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          06760005
095000              (NONLABOR-PERCENT * FED-ADJ).                       06770005
095100                                                                  06780005
095200     COMPUTE WK-3000-PEP-N-PAYMENT ROUNDED =                      06790005
095300          (FED-LABOR-ADJ + FED-NON-LABOR-ADJ + FED-SUPPLY-ADJ).   06800005
095400                                                                  06810005
095500     COMPUTE H-HHA-HRG-PAY (CO1) ROUNDED =                        06820005
095600             WK-3000-PEP-N-PAYMENT.                               06830005
095700                                                                  06840005
095800     COMPUTE WK-3000-PEP-N-PRETOT-PAY ROUNDED =                   06850005
095900             WK-3000-PEP-N-PRETOT-PAY + WK-3000-PEP-N-PAYMENT.    06860005
096000                                                                  06870005
096100                                                                  06880005
096200 3000-EXIT.   EXIT.                                               06890005
096300                                                                  06900005
096400 4000-PEP-Y-ADJUST.                                               06910005
096500                                                                  06920005
096600***************************************************************   06930005
096700*           HRG OCCUR < 2 AND PEP = Y ADJUSTMENT                  06940005
096800***************************************************************   06950005
096900                                                                  06960005
097000     IF H-HHA-HRG-INPUT-CODE (CO1) = SPACES                       06970005
097100        MOVE 6 TO SUB1                                            06980005
097200        GO TO 4000-EXIT.                                          06990005
097300                                                                  07000005
097400     MOVE 2 TO WK-RTC-ADJ-IND.                                    07010005
097500                                                                  07020005
097600     MOVE H-HHA-HRG-NO-OF-DAYS (CO1) TO WK-HRG-NO-OF-DAYS.        07030005
097700                                                                  06660005
097800     MOVE H-HHA-HRG-OUTPUT-CODE (CO1) TO WORK-HRG.                05040005
097900                                                                  05040005
098000*         YEARCHANGE                              ===========**   04500005
098100                                                                  08500005
098200      PERFORM 10100-SUPPLY-ADD-ON-CALC  THRU 10100-EXIT.          08620005
098300                                                                  06660005
098400*         YEARCHANGE                              ===========**   04500005
098500                                                                  06660005
098600                                                                  05042407
098700*    IF HHA-SERV-THRU-DATE > 20071231 AND                         04580005
098800*       HHA-SERV-FROM-DATE > 20071231                             04590005
098900*        NEXT SENTENCE                                            04850005
099000*    ELSE                                                         05100005
099100*        MOVE 0000000.00 TO FED-SUPPLY-ADJ.                       05041107
099200                                                                  05042707
099300                                                                  05042707
099400     COMPUTE FED-ADJ ROUNDED =                                    04940005
099500               H-HHA-HRG-WGTS (1) * FED-EPISODE-RATE-AMT.         04950005
099600                                                                  07090005
099700     COMPUTE FED-LABOR-ADJ ROUNDED =                              07100005
099800               WIR-CBSA-WAGEIND *                                 07110005
099900               LABOR-PERCENT * FED-ADJ.                           07120005
100000                                                                  07130005
100100     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          07140005
100200               NONLABOR-PERCENT * FED-ADJ.                        07150005
100300                                                                  07160005
100400     COMPUTE WK-4000-PEP-Y-PAYMENT ROUNDED =                      07170005
100500         (FED-LABOR-ADJ + FED-NON-LABOR-ADJ + FED-SUPPLY-ADJ).    07180005
100600                                                                  07190005
100700     COMPUTE WK-HRG-NO-OF-DAYS-FAC ROUNDED =                      07170005
100800               (WK-HRG-NO-OF-DAYS / 60).                          07060005
100900                                                                  07190005
101000     COMPUTE WK-4000-PEP-Y-PAYMENT ROUNDED =                      07170005
101100             WK-4000-PEP-Y-PAYMENT *
101200             WK-HRG-NO-OF-DAYS-FAC.                               07170005
101300                                                                  07190005
101400     COMPUTE H-HHA-HRG-PAY (CO1) ROUNDED =                        07200005
101500             WK-4000-PEP-Y-PAYMENT.                               07210005
101600                                                                  07220005
101700     COMPUTE WK-4000-PEP-Y-PRETOT-PAY ROUNDED =                   07230005
101800             WK-4000-PEP-Y-PRETOT-PAY + WK-4000-PEP-Y-PAYMENT.    07240005
101900                                                                  07250005
102000                                                                  07260005
102100 4000-EXIT.   EXIT.                                               07270005
102200 5000-PEP-N-ADJUST.                                               07280005
102300                                                                  07290005
102400***************************************************************   07300005
102500*           HRG OCCUR > 1 AND PEP = N ADJUSTMENT                  07310005
102600***************************************************************   07320005
102700                                                                  07330005
102800     IF H-HHA-HRG-INPUT-CODE (CO1) = SPACES                       07340005
102900        MOVE 6 TO SUB1                                            07350005
103000        GO TO 5000-EXIT.                                          07360005
103100                                                                  07370005
103200     MOVE 1 TO WK-RTC-ADJ-IND.                                    07380005
103300                                                                  07390005
103400     MOVE H-HHA-HRG-NO-OF-DAYS (CO1) TO WK-HRG-NO-OF-DAYS.        07400005
103500                                                                  06660005
103600     MOVE H-HHA-HRG-OUTPUT-CODE (CO1) TO WORK-HRG.                05040005
103700                                                                  05040005
103800*         YEARCHANGE                              ===========**   04500005
103900                                                                  08500005
104000      PERFORM 10100-SUPPLY-ADD-ON-CALC  THRU 10100-EXIT.          08620005
104100                                                                  06660005
104200*         YEARCHANGE                              ===========**   04500005
104300                                                                  06660005
104400                                                                  05042407
104500*    IF HHA-SERV-THRU-DATE > 20071231 AND                         04580005
104600*       HHA-SERV-FROM-DATE > 20071231                             04590005
104700*        NEXT SENTENCE                                            04850005
104800*    ELSE                                                         05100005
104900*        MOVE 0000000.00 TO FED-SUPPLY-ADJ.                       05041107
105000                                                                  05042707
105100                                                                  07410005
105200     COMPUTE FED-ADJ ROUNDED =                                    07420005
105300               (WK-HRG-NO-OF-DAYS  *                              07430005
105400                H-HHA-HRG-WGTS (CO1) *                            07440005
105500                FED-EPISODE-RATE-AMT) / 60.                       07450005
105600                                                                  07460005
105700     COMPUTE FED-LABOR-ADJ ROUNDED =                              07470005
105800               WIR-CBSA-WAGEIND *                                 07480005
105900               LABOR-PERCENT * FED-ADJ.                           07490005
106000                                                                  07500005
106100     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          07510005
106200               NONLABOR-PERCENT * FED-ADJ.                        07520005
106300                                                                  07530005
106400     COMPUTE WK-5000-PEP-N-PAYMENT ROUNDED =                      07540005
106500           (FED-LABOR-ADJ + FED-NON-LABOR-ADJ + FED-SUPPLY-ADJ).  07550005
106600                                                                  07560005
106700     COMPUTE H-HHA-HRG-PAY (CO1) ROUNDED =                        07570005
106800             WK-5000-PEP-N-PAYMENT.                               07580005
106900                                                                  07590005
107000                                                                  07600005
107100     COMPUTE WK-5000-PEP-N-PRETOT-PAY ROUNDED =                   07610005
107200             WK-5000-PEP-N-PRETOT-PAY + WK-5000-PEP-N-PAYMENT.    07620005
107300                                                                  07630005
107400                                                                  07640005
107500 5000-EXIT.   EXIT.                                               07650005
107600 6000-PEP-Y-ADJUST.                                               07660005
107700                                                                  07670005
107800***************************************************************   07680005
107900*           HRG OCCUR > 1 AND PEP = Y SHORTENED EPISODE           07690005
108000***************************************************************   07700005
108100                                                                  07710005
108200     IF H-HHA-HRG-INPUT-CODE (CO1) = SPACES                       07720005
108300        MOVE 6 TO SUB1                                            07730005
108400        GO TO 6000-EXIT.                                          07740005
108500                                                                  07750005
108600     MOVE 3 TO WK-RTC-ADJ-IND.                                    07760005
108700                                                                  07770005
108800     MOVE H-HHA-HRG-NO-OF-DAYS (CO1) TO WK-HRG-NO-OF-DAYS.        07780005
108900     MOVE H-HHA-PEP-DAYS             TO WK-PEP-DAYS.              07790005
109000                                                                  07800005
109100     MOVE H-HHA-HRG-OUTPUT-CODE (CO1) TO WORK-HRG.                05040005
109200                                                                  05040005
109300*         YEARCHANGE                              ===========**   04500005
109400                                                                  08500005
109500      PERFORM 10100-SUPPLY-ADD-ON-CALC  THRU 10100-EXIT.          08620005
109600                                                                  06660005
109700*         YEARCHANGE                              ===========**   04500005
109800                                                                  05042707
109900                                                                  05042407
110000*    IF HHA-SERV-THRU-DATE > 20071231 AND                         04580005
110100*       HHA-SERV-FROM-DATE > 20071231                             04590005
110200*        NEXT SENTENCE                                            04850005
110300*    ELSE                                                         05100005
110400*        MOVE 0000000.00 TO FED-SUPPLY-ADJ.                       05041107
110500*                                                                 05042707
110600*    COMPUTE FED-ADJ ROUNDED =                                    07810005
110700*        (WK-HRG-NO-OF-DAYS / WK-PEP-DAYS)                        07820005
110800*                                *                                07830005
110900*                    ((WK-PEP-DAYS / 60)                          07840005
111000*                                *                                07850005
111100*          (H-HHA-HRG-WGTS (CO1) * FED-EPISODE-RATE-AMT)).        07860005
111200*                                                                 07870005
111300*                                                                 07880005
111400*    COMPUTE FED-ADJ ROUNDED =                                    07890005
111500*        (WK-HRG-NO-OF-DAYS / WK-PEP-DAYS)                        07900005
111600*                                *                                07910005
111700*      ((WK-PEP-DAYS * H-HHA-HRG-WGTS (CO1) *                     07920005
111800*                          FED-EPISODE-RATE-AMT) / 60).           07930005
111900                                                                  07940005
112000     COMPUTE FED-ADJ1 ROUNDED =                                   07950005
112100      ((WK-PEP-DAYS * H-HHA-HRG-WGTS (CO1) *                      07960005
112200                           FED-EPISODE-RATE-AMT) / 60).           07970005
112300                                                                  07980005
112400     COMPUTE FED-ADJ ROUNDED  =                                   07990005
112500                  (FED-ADJ1 * WK-HRG-NO-OF-DAYS) / WK-PEP-DAYS.   08000005
112600                                                                  08010005
112700     COMPUTE FED-LABOR-ADJ ROUNDED =                              08020005
112800               WIR-CBSA-WAGEIND *                                 08030005
112900               LABOR-PERCENT * FED-ADJ.                           08040005
113000                                                                  08050005
113100     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          08060005
113200               NONLABOR-PERCENT * FED-ADJ.                        08070005
113300                                                                  08080005
113400     COMPUTE WK-6000-PEP-Y-PAYMENT ROUNDED =                      08090005
113500          (FED-LABOR-ADJ + FED-NON-LABOR-ADJ + FED-SUPPLY-ADJ).   08100005
113600                                                                  08110005
113700     COMPUTE H-HHA-HRG-PAY (CO1) ROUNDED =                        08120005
113800             WK-6000-PEP-Y-PAYMENT.                               08130005
113900                                                                  08140005
114000     COMPUTE WK-6000-PEP-Y-PRETOT-PAY ROUNDED =                   08150005
114100             WK-6000-PEP-Y-PRETOT-PAY + WK-6000-PEP-Y-PAYMENT.    08160005
114200                                                                  08170005
114300                                                                  08180005
114400 6000-EXIT.   EXIT.                                               08190005
114500                                                                  08200005
114600 7000-OUTLIER-PAYMENT.                                            08210005
114700***************************************************************   08230005
114800*                    OUTLIER PAYMENT                              08240005
114900***************************************************************   08250005
115000     COMPUTE OUT-THRES-LABOR-ADJ ROUNDED =                        08260005
115100               WIR-CBSA-WAGEIND *                                 08270005
115200               LABOR-PERCENT * OUTLIER-THRESHOLD-AMT.             08280005
115300                                                                  08290005
115400     COMPUTE OUT-THRES-NON-LABOR-ADJ ROUNDED =                    08300005
115500               NONLABOR-PERCENT * OUTLIER-THRESHOLD-AMT.          08310005
115600                                                                  08320005
115700     COMPUTE OUT-THRES-AMT-ADJ ROUNDED  =                         08330005
115800             (OUT-THRES-LABOR-ADJ +                               08340005
115900              OUT-THRES-NON-LABOR-ADJ).                           08350005
116000                                                                  08360005
116100      COMPUTE WK-7000-OUTLIER-VALUE-A ROUNDED =                   08370005
116200              OUT-THRES-AMT-ADJ +                                 08380005
116300             WK-3000-PEP-N-PRETOT-PAY +                           08390005
116400             WK-4000-PEP-Y-PRETOT-PAY +                           08400005
116500             WK-5000-PEP-N-PRETOT-PAY +                           08410005
116600             WK-6000-PEP-Y-PRETOT-PAY.                            08420005
116700                                                                  08430005
116800      PERFORM 8000-ADD-REV-DOLL THRU 8000-EXIT                    08440005
116900                  VARYING CO1 FROM 1 BY 1 UNTIL                   08450005
117000                   CO1 > 6.                                       08460005
117100                                                                  08470005
117200      COMPUTE WK-7000-AB-DIFF ROUNDED =                           08480005
117300              WK-8000-OUTLIER-VALUE-B - WK-7000-OUTLIER-VALUE-A.  08490005
117400****===================                                           08500005
117500      IF WK-7000-AB-DIFF > ZERO                                   08510005
117600         COMPUTE WK-7000-CALC ROUNDED =                           08520005
117700               OUTL-LOSS-SHAR-RATIO-PERCENT * WK-7000-AB-DIFF     08530005
117800                                                                  09070005
117900*** ================== NEW OUTLIER CAP HERE ========              09090005
118000         PERFORM 10000-OUTLIER-CAP-CALC THRU 10000-EXIT           03620005
118100*** ================== NEW OUTLIER CAP HERE ========              09090005
118200                                                                  09070005
118300****===================                                           08500005
118400         COMPUTE H-HHA-OUTLIER-PAYMENT ROUNDED =                  08540005
118500               WK-7000-CALC                                       08550005
118600                                                                  08500005
118700****===================                                           08500005
118800         COMPUTE H-HHA-TOTAL-PAYMENT ROUNDED =                    08560005
118900                (WK-7000-CALC +                                   08570005
119000                 WK-3000-PEP-N-PRETOT-PAY +                       08580005
119100                 WK-4000-PEP-Y-PRETOT-PAY +                       08590005
119200                 WK-5000-PEP-N-PRETOT-PAY +                       08600005
119300                 WK-6000-PEP-Y-PRETOT-PAY)                        08610005
119400                                                                  08500005
119500          PERFORM 9000-WHICH-RTC-OUTLIER THRU 9000-EXIT           08620005
119600      ELSE                                                        08630005
119700         COMPUTE H-HHA-TOTAL-PAYMENT ROUNDED =                    08640005
119800                (WK-3000-PEP-N-PRETOT-PAY +                       08650005
119900                 WK-4000-PEP-Y-PRETOT-PAY +                       08660005
120000                 WK-5000-PEP-N-PRETOT-PAY +                       08670005
120100                 WK-6000-PEP-Y-PRETOT-PAY)                        08680005
120200          PERFORM 9050-WHICH-RTC-NO-OUTLIER THRU 9050-EXIT.       08690005
120300                                                                  08700005
120400                                                                  08710005
120500 7000-EXIT.   EXIT.                                               08720005
120600
120700 8000-ADD-REV-DOLL.                                               08730005
120800                                                                  08740005
120900***************************************************************   08750005
121000*        ADD ALL REVENUE DOLLARS                                  08760005
121100***************************************************************   08770005
121200                                                                  08780005
121300     IF H-HHA-REVENUE-CODE (CO1) = SPACES                         08790005
121400        MOVE 6 TO CO1                                             08800005
121500        GO TO 8000-EXIT.                                          08810005
121600                                                                  08780005
121700     IF H-HHA-REVENUE-QTY-COV-VISITS (CO1) = 0                    08850005
121800        GO TO 8000-EXIT.                                          08810005
121900                                                                  08820005
122000     COMPUTE FED-ADJ ROUNDED =                                    08830005
122100                H-HHA-REVENUE-DOLL-RATE (CO1) *                   08840005
122200                H-HHA-REVENUE-QTY-COV-VISITS (CO1).               08850005
122300                                                                  08860005
122400     COMPUTE FED-LABOR-ADJ ROUNDED =                              08870005
122500               WIR-CBSA-WAGEIND *                                 08880005
122600               LABOR-PERCENT * FED-ADJ.                           08890005
122700                                                                  08900005
122800     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          08910005
122900               NONLABOR-PERCENT * FED-ADJ.                        08920005
123000                                                                  08930005
123100     COMPUTE WK-8000-OUTLIER-LAB-NLAB ROUNDED =                   08940005
123200           (FED-LABOR-ADJ + FED-NON-LABOR-ADJ).                   08950005
123300                                                                  08960005
123400                                                                  08970005
123500     COMPUTE H-HHA-REVENUE-COST (CO1) ROUNDED =                   08980005
123600               WK-8000-OUTLIER-LAB-NLAB.                          08990005
123700                                                                  09000005
123800     COMPUTE WK-8000-OUTLIER-VALUE-B ROUNDED =                    09010005
123900             WK-8000-OUTLIER-VALUE-B + WK-8000-OUTLIER-LAB-NLAB.  09020005
124000                                                                  09030005
124100 8000-EXIT.   EXIT.                                               09040005
124200                                                                  09050005
124300 9000-WHICH-RTC-OUTLIER.                                          09060005
124400                                                                  09070005
124500      MOVE '01' TO H-HHA-PAY-RTC.                                 09080005
124600      IF WK-RTC-ADJ-IND = 1  MOVE '08' TO H-HHA-PAY-RTC.          09100005
124700      IF WK-RTC-ADJ-IND = 2  MOVE '11' TO H-HHA-PAY-RTC.          09110005
124800      IF WK-RTC-ADJ-IND = 3  MOVE '13' TO H-HHA-PAY-RTC.          09120005
124900      IF WK-RTC-ADJ-IND = 4  MOVE '02' TO H-HHA-PAY-RTC.          09120005
125000                                                                  09130005
125100                                                                  09140005
125200 9000-EXIT.   EXIT.                                               09150005
125300                                                                  09160005
125400 9050-WHICH-RTC-NO-OUTLIER.                                       09170005
125500                                                                  09180005
125600      MOVE '00' TO H-HHA-PAY-RTC.                                 09190005
125700                                                                  09200005
125800      IF WK-RTC-ADJ-IND = 1  MOVE '07' TO H-HHA-PAY-RTC.          09210005
125900      IF WK-RTC-ADJ-IND = 2  MOVE '09' TO H-HHA-PAY-RTC.          09220005
126000      IF WK-RTC-ADJ-IND = 3  MOVE '12' TO H-HHA-PAY-RTC.          09230005
126100                                                                  09240005
126200 9050-EXIT.   EXIT.                                               09260005
126300                                                                  09270005
126400*         YEARCHANGE  2011.0                      ===========**   04500005
126500                                                                  09270005
126600 10000-OUTLIER-CAP-CALC.                                          09170005
126700                                                                  09250005
126800     IF  HHA-PROV-PAYMET-TOTAL = 0                                09250005
126900        GO TO 10000-EXIT.                                         08810005
127000                                                                  09250005
127100     IF  HHA-PROV-OUTLIER-PAY-TOTAL = 0                           09250005
127200        GO TO 10000-EXIT.                                         08810005
127300                                                                  09250005
127400     COMPUTE WK-10000-OUTLIER-POOL-PERCENT ROUNDED =              01990005
127500         HHA-PROV-PAYMET-TOTAL * .1.                              09250005
127600                                                                  09250005
127700     COMPUTE WK-10000-OUTLIER-AVAIL-POOL ROUNDED =                01990005
127800      WK-10000-OUTLIER-POOL-PERCENT - HHA-PROV-OUTLIER-PAY-TOTAL. 09250005
127900                                                                  09250005
128000      COMPUTE WK-10000-OUTLIER-POOL-DIF ROUNDED =                 01990005
128100         WK-10000-OUTLIER-AVAIL-POOL - WK-7000-CALC.              09250005
128200                                                                  09250005
128300      IF WK-10000-OUTLIER-POOL-DIF > 0                            01990005
128400        GO TO 10000-EXIT.                                         08810005
128500                                                                  09250005
128600      IF WK-10000-OUTLIER-POOL-DIF < 0 OR                         01990005
128700         HHA-PROV-OUTLIER-PAY-TOTAL < 0                           09250005
128800        COMPUTE WK-7000-CALC ROUNDED = 0                          09080005
128900        MOVE 4 TO WK-RTC-ADJ-IND.                                 09120005
129000                                                                  09250005
129100*         YEARCHANGE  2011.0                      ===========**   04500005
129200                                                                  09250005
129300 10000-EXIT.   EXIT.                                              09260005
129400                                                                  09270005
129500*         YEARCHANGE  2013.0                      ===========**   04500005
129600                                                                  09270005
129700 10100-SUPPLY-ADD-ON-CALC.                                        09170005
129800                                                                  09250005
129900                                                                  06660005
130000     IF HHA-CBSA-RURAL-CHECK                                      04641005
130100     OR HHA-CBSA-RURAL-CHECK-ALL                                  04642005
130200       GO TO RURAL-DATA-CHECK.                                    01650000
130300                                                                  05040005
130400     IF HHA-WITH-DATA-CHECK                                       06660005
130500       NEXT SENTENCE
130600     ELSE
130700       GO TO NO-DATA-CHECK.                                       01650000
130800                                                                  05100005
130900        IF  WORK-HRG5 = 'S' OR '1'                                05041007
131000         MOVE 0000014.56 TO FED-SUPPLY-ADJ                        05041107
131100         GO TO 10100-EXIT.                                        08810005
131200                                                                  05041207
131300        IF  WORK-HRG5 = 'T' OR '2'                                05041307
131400         MOVE 0000052.58 TO FED-SUPPLY-ADJ                        05041107
131500         GO TO 10100-EXIT.                                        08810005
131600                                                                  05041507
131700        IF  WORK-HRG5 = 'U' OR '3'                                05041607
131800         MOVE 0000144.16 TO FED-SUPPLY-ADJ                        05041107
131900         GO TO 10100-EXIT.                                        08810005
132000                                                                  05041807
132100        IF  WORK-HRG5 = 'V' OR '4'                                05041907
132200         MOVE 0000214.19 TO FED-SUPPLY-ADJ                        05041107
132300         GO TO 10100-EXIT.                                        08810005
132400                                                                  05042107
132500        IF  WORK-HRG5 = 'W' OR '5'                                05042207
132600         MOVE 0000330.29 TO FED-SUPPLY-ADJ                        05041107
132700         GO TO 10100-EXIT.                                        08810005
132800                                                                  05042407
132900        IF  WORK-HRG5 = 'X' OR '6'                                05042507
133000         MOVE 0000568.06 TO FED-SUPPLY-ADJ                        05041107
133100         GO TO 10100-EXIT.                                        08810005
133200                                                                  05040005
133300 NO-DATA-CHECK.                                                   05040005
133400                                                                  05040005
133500     IF HHA-NO-DATA-CHECK                                         05100005
133600       NEXT SENTENCE
133700     ELSE
133800         GO TO 10100-EXIT.                                        08810005
133900                                                                  05100005
134000        IF  WORK-HRG5 = 'S' OR '1'                                05041007
134100         MOVE 0000014.28 TO FED-SUPPLY-ADJ                        05041107
134200         GO TO 10100-EXIT.                                        08810005
134300                                                                  05041207
134400        IF  WORK-HRG5 = 'T' OR '2'                                05041307
134500         MOVE 0000051.54 TO FED-SUPPLY-ADJ                        05041107
134600         GO TO 10100-EXIT.                                        08810005
134700                                                                  05041507
134800        IF  WORK-HRG5 = 'U' OR '3'                                05041607
134900         MOVE 0000141.33 TO FED-SUPPLY-ADJ                        05041107
135000         GO TO 10100-EXIT.                                        08810005
135100                                                                  05041807
135200        IF  WORK-HRG5 = 'V' OR '4'                                05041907
135300         MOVE 0000209.98 TO FED-SUPPLY-ADJ                        05041107
135400         GO TO 10100-EXIT.                                        08810005
135500                                                                  05042107
135600        IF  WORK-HRG5 = 'W' OR '5'                                05042207
135700         MOVE 0000323.80 TO FED-SUPPLY-ADJ                        05041107
135800         GO TO 10100-EXIT.                                        08810005
135900                                                                  05042407
136000        IF  WORK-HRG5 = 'X' OR '6'                                05042507
136100         MOVE 0000556.90 TO FED-SUPPLY-ADJ                        05041107
136200         GO TO 10100-EXIT.                                        08810005
136300                                                                  05042707
136400                                                                  05040005
136500 RURAL-DATA-CHECK.                                                05040005
136600                                                                  05040005
136700     IF HHA-WITH-DATA-CHECK                                       04600005
136800       NEXT SENTENCE
136900     ELSE
137000       GO TO RURAL-NO-DATA-CHECK.                                 01650000
137100                                                                  05100005
137200        IF  WORK-HRG5 = 'S' OR '1'                                05041007
137300         MOVE 0000015.00 TO FED-SUPPLY-ADJ                        05041107
137400         GO TO 10100-EXIT.                                        08810005
137500                                                                  05041207
137600        IF  WORK-HRG5 = 'T' OR '2'                                05041307
137700         MOVE 0000054.16 TO FED-SUPPLY-ADJ                        05041107
137800         GO TO 10100-EXIT.                                        08810005
137900                                                                  05041507
138000        IF  WORK-HRG5 = 'U' OR '3'                                05041607
138100         MOVE 0000148.49 TO FED-SUPPLY-ADJ                        05041107
138200         GO TO 10100-EXIT.                                        08810005
138300                                                                  05041807
138400        IF  WORK-HRG5 = 'V' OR '4'                                05041907
138500         MOVE 0000220.61 TO FED-SUPPLY-ADJ                        05041107
138600         GO TO 10100-EXIT.                                        08810005
138700                                                                  05042107
138800        IF  WORK-HRG5 = 'W' OR '5'                                05042207
138900         MOVE 0000340.20 TO FED-SUPPLY-ADJ                        05041107
139000         GO TO 10100-EXIT.                                        08810005
139100                                                                  05042407
139200        IF  WORK-HRG5 = 'X' OR '6'                                05042507
139300         MOVE 0000585.11 TO FED-SUPPLY-ADJ.                       05041107
139400         GO TO 10100-EXIT.                                        08810005
139500                                                                  05100005
139600 RURAL-NO-DATA-CHECK.                                             05100005
139700                                                                  05100005
139800     IF HHA-NO-DATA-CHECK                                         05100005
139900       NEXT SENTENCE
140000     ELSE
140100         GO TO 10100-EXIT.                                        08810005
140200                                                                  05100005
140300        IF  WORK-HRG5 = 'S' OR '1'                                05041007
140400         MOVE 0000014.70 TO FED-SUPPLY-ADJ                        05041107
140500         GO TO 10100-EXIT.                                        08810005
140600                                                                  05041207
140700        IF  WORK-HRG5 = 'T' OR '2'                                05041307
140800         MOVE 0000053.09 TO FED-SUPPLY-ADJ                        05041107
140900         GO TO 10100-EXIT.                                        08810005
141000                                                                  05041507
141100        IF  WORK-HRG5 = 'U' OR '3'                                05041607
141200         MOVE 0000145.58 TO FED-SUPPLY-ADJ                        05041107
141300         GO TO 10100-EXIT.                                        08810005
141400                                                                  05041807
141500        IF  WORK-HRG5 = 'V' OR '4'                                05041907
141600         MOVE 0000216.29 TO FED-SUPPLY-ADJ                        05041107
141700         GO TO 10100-EXIT.                                        08810005
141800                                                                  05042107
141900        IF  WORK-HRG5 = 'W' OR '5'                                05042207
142000         MOVE 0000333.53 TO FED-SUPPLY-ADJ                        05041107
142100         GO TO 10100-EXIT.                                        08810005
142200                                                                  05042407
142300        IF  WORK-HRG5 = 'X' OR '6'                                05042507
142400         MOVE 0000573.26 TO FED-SUPPLY-ADJ                        05041107
142500         GO TO 10100-EXIT.                                        08810005
142600                                                                  05040005
142700                                                                  09250005
142800*         YEARCHANGE  2013.0                      ===========**   04500005
142900                                                                  09250005
143000 10100-EXIT.   EXIT.                                              09260005
143100                                                                  09270005
143200******        L A S T   S O U R C E   S T A T E M E N T   *****   09280005
