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