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