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