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