000100 IDENTIFICATION DIVISION.                                         00010000
000200 PROGRAM-ID.      HHCAL066.                                       00020021
000300*AUTHOR.          DAVE PANUSKA                                    00030000
000400*REVISED.         DDS TEAM.                                       00031007
000500*REMARKS.     (CENTERS FOR MEDICARE & MEDICAID SERVICES)          00040000
000600*REMARKS. A). NATIONAL HHA PRICER                                 00050000
000700***       B). NATIONAL HHA PRICER EFFECTIVE OCT 1 2001            00060000
000800***       C). THERE ARE YEARLY HHA PRICER MODULES THAT WILL       00070000
000900***           CALCULATE THE HRG'S,REVENUE CODES AND               00080000
001000***           TYPE OF BILLS.                                      00090000
001100*REMARKS.                                                         00100000
001200*     FOR FY 2006 CALCULATIONS AND RATES                          00110000
001300*     HHCAL060   NEW RATES EFFECTIVE JAN 1, 2006                  00120000
001400******************************************************************00121007
001500*     FOR FY 2006 CALCULATIONS AND RATES                          00122007
001600*     HHCAL061 NEW RATES EFFECTIVE JAN 1, 2006 RURAL DIFFERENTIAL 00123007
001700******************************************************************00124007
001800*     FOR FY 2006 CALCULATIONS AND RATES                          00125007
001900*     HHCAL062 NEW RATES EFFECTIVE JAN 1, 2006 RURAL DIFFERENTIAL 00126007
002000*              FOR SPECIFIC CBSA'S                                00127007
002100******************************************************************00128007
002200******************************************************************00130000
002300*     FOR FY 2006 CALCULATIONS AND RATES                          00140000
002400*     HHCAL063   RATES EFFECTIVE JAN 1, 2006 CICS VERSION         00150007
002500*     HHCAL064 EXPAND BILLING RECORD TO 500 BYTES - BEATA VERSION 00151017
002600*     HHCAL065 INCREASE PROV-PAYMET-TOTAL TO  PIC 9(09)V9(02)     00152017
002610*     HHCAL066 ADD NEW FIELDS FOR EARLIEST DATES                  00153021
002700******************************************************************00160000
002710*----------------------------------------------------------------*
002720* 2016 - ADDED 32Q AND 33Q AS VALID TOB CODES IN PARAGRAPH       *
002730*        400-CALC-THE-HHA                                        *
002740*----------------------------------------------------------------*
002800******************************************************************00170000
002900*            RETURN CODE VALUES (HHA-RTC)                         00180000
003000*                                                                 00190000
003100*        HHA-RTC  WITH PAYMENTS RETURNED                          00200000
003200*                                                                 00210000
003300*     RETURN CODES                                                00220000
003400*          00 = FINAL PAYMENT                                     00230000
003500*               TOB = 329,339,327,337                             00240000
003510*                  OR 32Q OR 33Q
003600*                  OR 32G OR 33G OR 32I OR 33I                    00250000
003700*                  OR 32J OR 33J OR 32M OR 33M                    00260000
003800*                  OR 32F OR 32K OR 32P OR 32H                    00270000
003900*                  OR 33F OR 33K OR 33P OR 33H                    00280000
004000*               WITH HRG,REVENUE CODE WHERE NO OUTLIER APPLIES    00290000
004100*          01 = FINAL PAYMENT                                     00300000
004200*               TOB = 329,339,327,337                             00310000
004210*                  OR 32Q OR 33Q
004300*                  OR 32G OR 33G OR 32I OR 33I                    00320000
004400*                  OR 32J OR 33J OR 32M OR 33M                    00330000
004500*                  OR 32F OR 32K OR 32P OR 32H                    00340000
004600*                  OR 33F OR 33K OR 33P OR 33H                    00350000
004700*               WITH HRG,REVENUE CODE WHERE OUTLIER APPLIES       00360000
004800*          03 = INITIAL HALF PAYMENT PAYMENT WILL BE ZERO         00370000
004900*               TOB = 332 AND 322                                 00380000
005000*          04 = INITIAL HALF PAYMENT PAID AT 50%                  00390000
005100*               TOB = 332 AND 322                                 00400000
005200*               WITH INITIAL (FIRST) HRG AND NO REVENUE CODES     00410000
005300*          05 = INITIAL HALF PAYMENT PAID AT 60%                  00420000
005400*               TOB = 332 AND 322                                 00430000
005500*               WITH INITIAL (FIRST) HRG AND NO REVENUE CODES     00440000
005600*          06 = LUPA PAYMENT ONLY                                 00450000
005700*               TOB = 329,339,327,337                             00460000
005710*                  OR 32Q OR 33Q
005800*                  OR 32G OR 33G OR 32I OR 33I                    00470000
005900*                  OR 32J OR 33J OR 32M OR 33M                    00480000
006000*                  OR 32F OR 32K OR 32P OR 32H                    00490000
006100*                  OR 33F OR 33K OR 33P OR 33H                    00500000
006200*               WITH REVENUE CODES AND REVENUE QTYS < 5       *   00510000
006300******************************************************************00520000
006400*          07 = FINAL PAYMENT, SCIC, PEP = N, NO OUTLIER          00530000
006500*               TOB = 329,339,327,337                             00540000
006510*                  OR 32Q OR 33Q
006600*                  OR 32G OR 33G OR 32I OR 33I                    00550000
006700*                  OR 32J OR 33J OR 32M OR 33M                    00560000
006800*                  OR 32F OR 32K OR 32P OR 32H                    00570000
006900*                  OR 33F OR 33K OR 33P OR 33H                    00580000
007000*               WITH REVENUE CODE WHERE NO OUTLIER APPLIES        00590000
007100*               WITH MORE THAN ONE HRG OCCURRENCE             *   00600000
007200*          08 = FINAL PAYMENT, SCIC, PEP = N, WITH OUTLIER        00610000
007300*               TOB = 329,339,327,337                             00620000
007310*                  OR 32Q OR 33Q
007400*                  OR 32G OR 33G OR 32I OR 33I                    00630000
007500*                  OR 32J OR 33J OR 32M OR 33M                    00640000
007600*                  OR 32F OR 32K OR 32P OR 32H                    00650000
007700*                  OR 33F OR 33K OR 33P OR 33H                    00660000
007800*               WITH REVENUE CODE WHERE OUTLIER APPLIES           00670000
007900*               WITH MORE THAN ONE HRG OCCURRENCE             *   00680000
008000******************************************************************00690000
008100*          09 = FINAL PAYMENT, PEP = Y, NO OUTLIER                00700000
008200*               TOB = 329,339,327,337                             00710000
008210*                  OR 32Q OR 33Q
008300*                  OR 32G OR 33G OR 32I OR 33I                    00720000
008400*                  OR 32J OR 33J OR 32M OR 33M                    00730000
008500*                  OR 32F OR 32K OR 32P OR 32H                    00740000
008600*                  OR 33F OR 33K OR 33P OR 33H                    00750000
008700*               WITH REVENUE CODE WHERE NO OUTLIER APPLIES        00760000
008800*               WITH ONE HRG OCCURRENCE                       *   00770000
008900*          11 = FINAL PAYMENT, PEP = Y, WITH OUTLIER              00780000
009000*               TOB = 329,339,327,337                             00790000
009010*                  OR 32Q OR 33Q
009100*                  OR 32G OR 33G OR 32I OR 33I                    00800000
009200*                  OR 32J OR 33J OR 32M OR 33M                    00810000
009300*                  OR 32F OR 32K OR 32P OR 32H                    00820000
009400*                  OR 33F OR 33K OR 33P OR 33H                    00830000
009500*               WITH REVENUE CODE WHERE OUTLIER APPLIES           00840000
009600*               WITH ONE HRG OCCURRENCE                       *   00850000
009700******************************************************************00860000
009800*          12 = FINAL PAYMENT, SCIC, PEP = Y, NO OUTLIER          00870000
009900*               TOB = 329,339,327,337                             00880000
009910*                  OR 32Q OR 33Q
010000*                  OR 32G OR 33G OR 32I OR 33I                    00890000
010100*                  OR 32J OR 33J OR 32M OR 33M                    00900000
010200*                  OR 32F OR 32K OR 32P OR 32H                    00910000
010300*                  OR 33F OR 33K OR 33P OR 33H                    00920000
010400*               WITH REVENUE CODE WHERE NO OUTLIER APPLIES        00930000
010500*               WITH MORE THAN ONE HRG OCCURRENCE             *   00940000
010600*          13 = FINAL PAYMENT, SCIC, PEP = Y, WITH OUTLIER        00950000
010700*               TOB = 329,339,327,337                             00960000
010710*                  OR 32Q OR 33Q
010800*                  OR 32G OR 33G OR 32I OR 33I                    00970000
010900*                  OR 32J OR 33J OR 32M OR 33M                    00980000
011000*                  OR 32F OR 32K OR 32P OR 32H                    00990000
011100*                  OR 33F OR 33K OR 33P OR 33H                    01000000
011200*               WITH REVENUE CODE WHERE OUTLIER APPLIES           01010000
011300*               WITH MORE THAN ONE HRG OCCURRENCE             *   01020000
011400******************************************************************01030000
011500******************************************************************01040000
011600*                                                             *   01050000
011700*            HHA-RTC   NO PAYMENTS RETURNED                   *   01060000
011800*                                                             *   01070000
011900*              10 = INVALID TOB                               *   01080000
012000*                                                             *   01090000
012100*              15 = INVALID PEP DAYS                          *   01100000
012200*                   FOR SHORTENED EPISODE                     *   01110000
012300*                                                             *   01120000
012400*              16 = INVALID HRG DAYS , > 60 DAYS              *   01130000
012500*                                                             *   01140000
012600*              20 = INVALID PEP INDICATOR                     *   01150000
012700*                                                             *   01160000
012800*              25 = INVALID MED REVIEW INDICATOR              *   01170000
012900*                                                             *   01180000
013000*              30 = INVALID CBSA CODE                         *   01190000
013100*                                                             *   01200000
013200*              35 = INVALID INITIAL PAYMENT INDICATOR         *   01210000
013300*                        0 = MAKE NORMAL INITIAL PAYMENT      *   01220000
013400*                        1 = MAKE ZERO PAYMANT                *   01230000
013500*                                                             *   01240000
013600*              40 = INVALID SERVICE THRU DATE FOR             *   01250000
013700*                      CURRENT CALENDER YEAR                  *   01260000
013800*                                                             *   01270000
013900*              70 = INVALID OR NO HRG CODE PRESENT            *   01280000
014000*                                                             *   01290000
014100*              75 = NO HRG PRESENT IN FIRST OCCURANCE AND     *   01300000
014200*                   REVENUE-QTY-COV-VISITS > 4  AND           *   01310000
014300*                       TOB = 329,339,327,337                 *   01320000
014400*                          OR 32G OR 33G OR 32I OR 33I        *   01330000
014500*                          OR 32J OR 33J OR 32M OR 33M        *   01340000
014600*                          OR 32F OR 32K OR 32P OR 32H            01350000
014700*                          OR 33F OR 33K OR 33P OR 33H            01360000
014800*                                                             *   01370000
014900*              80 = INVALID REVENUE CODE                      *   01380000
015000*                                                             *   01390000
015100*              85 = NO REVENUE CODE PRESENT                   *   01400000
015200*                   WITH TOB 329 OR 339 OR 327 OR 337         *   01410000
015300*                         OR 32G OR 33G OR 32I OR 33I         *   01420000
015400*                         OR 32J OR 33J OR 32M OR 33M         *   01430000
015500*                         OR 32F OR 32K OR 32P OR 32H             01440000
015600*                         OR 33F OR 33K OR 33P OR 33H             01450000
015700*                                                             *   01460000
015800***************************************************************   01470000
015900***************************************************************   01480000
016000***************************************************************   01490000
016100 DATE-COMPILED.                                                   01500000
016200 ENVIRONMENT DIVISION.                                            01510000
016300 CONFIGURATION SECTION.                                           01520000
016400 SOURCE-COMPUTER.            IBM-370.                             01530000
016500 OBJECT-COMPUTER.            IBM-370.                             01540000
016600 INPUT-OUTPUT  SECTION.                                           01550000
016700 FILE-CONTROL.                                                    01560000
016800                                                                  01570000
016900 DATA DIVISION.                                                   01580000
017000 FILE SECTION.                                                    01590000
017100                                                                  01600000
017200 WORKING-STORAGE SECTION.                                         01610000
017300 01  W-STORAGE-REF                  PIC X(46)  VALUE              01620000
017400     'HHCAL066      - W O R K I N G   S T O R A G E'.             01630021
017500 01  CAL-VERSION                    PIC X(07)  VALUE 'C2006.6'.   01640021
017600 01  CO1                            PIC S9(04) COMP SYNC.         01650000
017700 01  SUB1                           PIC S9(04) COMP SYNC.         01660000
017800 01  R1                             PIC S9(04) COMP SYNC.         01670000
017900 01  R2                             PIC S9(04) COMP SYNC.         01680000
018000 01  R3                             PIC S9(04) COMP SYNC.         01690000
018100                                                                  01700000
018200 01  LABOR-NLABOR-PERCENT.                                        01710000
018300     05 LABOR-PERCENT        PIC 9V9(05)  VALUE 0.76775.          01720000
018400     05 NONLABOR-PERCENT     PIC 9V9(05)  VALUE 0.23225.          01730000
018500                                                                  01740000
018600 01  FED-EPISODE-RATE-AMT         PIC 9(05)V9(02) VALUE 0.        01750000
018700 01  OUTLIER-THRESHOLD-AMT        PIC 9(05)V9(02) VALUE 0.        01760000
018800***************************************************************** 01770000
018900***    EXAMPLE    *********************************************** 01780000
019000*** FED-EPISODE-RATE-AMT TIMES 1.13 = OUTLIER-THRESHOLD-AMT ***** 01790000
019100******  2327.68 TIMES 0.65  = 1512.99  ROUNDED UP  ************** 01800004
019200***************************************************************** 01810000
019300 01  OUTL-LOSS-SHAR-RATIO-PERCENT PIC 9(01)V9(02) VALUE 0.80.     01820000
019400                                                                  01830000
019500 01  WK-PEP-DAYS           PIC S9(04)       VALUE 0.              01840000
019600 01  WK-HRG-NO-OF-DAYS     PIC S9(04)       VALUE 0.              01850000
019700 01  WK-HRG-NO-OF-DAYS-TOT PIC S9(04)       VALUE 0.              01860000
019800 01  WK-RTC-ADJ-IND        PIC 9            VALUE 0.              01870000
019900 01  WK-ALL-TOTALS.                                               01880000
020000     05  FED-ADJ                        PIC S9(07)V9(02).         01890000
020100     05  FED-ADJ1                       PIC S9(07)V9(02).         01900000
020200     05  FED-LABOR-ADJ                  PIC S9(07)V9(02).         01910000
020300     05  FED-NON-LABOR-ADJ              PIC S9(07)V9(02).         01920000
020400     05  OUT-THRES-AMT-ADJ              PIC S9(07)V9(02).         01930000
020500     05  OUT-THRES-LABOR-ADJ            PIC S9(07)V9(02).         01940000
020600     05  OUT-THRES-NON-LABOR-ADJ        PIC S9(07)V9(02).         01950000
020700     05  WK-3000-PEP-N-PRETOT-PAY       PIC S9(07)V9(02).         01960000
020800     05  WK-3000-PEP-N-PAYMENT          PIC S9(07)V9(02).         01970000
020900     05  WK-4000-PEP-Y-PRETOT-PAY       PIC S9(07)V9(02).         01980000
021000     05  WK-4000-PEP-Y-PAYMENT          PIC S9(07)V9(02).         01990000
021100     05  WK-5000-PEP-N-PRETOT-PAY       PIC S9(07)V9(02).         02000000
021200     05  WK-5000-PEP-N-PAYMENT          PIC S9(07)V9(02).         02010000
021300     05  WK-6000-PEP-Y-PRETOT-PAY       PIC S9(07)V9(02).         02020000
021400     05  WK-6000-PEP-Y-PAYMENT          PIC S9(07)V9(02).         02030000
021500     05  WK-6050-PEP-Y-TOT-DAYS         PIC S9(04).               02040000
021600     05  WK-7000-OUTLIER-VALUE-A        PIC S9(07)V9(02).         02050000
021700     05  WK-7000-AB-DIFF                PIC S9(07)V9(02).         02060000
021800     05  WK-7000-CALC                   PIC S9(07)V9(02).         02070000
021900     05  WK-8000-OUTLIER-VALUE-B        PIC S9(07)V9(02).         02080000
022000     05  WK-8000-OUTLIER-LAB-NLAB       PIC S9(07)V9(02).         02090000
022100                                                                  02100000
022200                                                                  02110000
022300                                                                  02120000
022400*******************************************************           02130000
022500 01  HOLD-HHA-DATA.                                               02140000
022600     05  H-HHA-INPUT-DATA.                                        02150000
022700         10  H-HHA-NPI                 PIC X(10).                 02160000
022800         10  H-HHA-HIC                 PIC X(12).                 02170000
022900         10  H-HHA-PROV-NO             PIC X(06).                 02180000
023000         10  H-HHA-TOB                 PIC XXX.                   02190000
023100         10  H-HHA-PEP-INDICATOR       PIC X.                     02200000
023200         10  H-HHA-PEP-DAYS            PIC 999.                   02210000
023300         10  H-HHA-INIT-PAY-INDICATOR  PIC X.                     02220000
023400         10  FILLER                    PIC X(07).                 02230000
023500         10  H-HHA-MSA1                PIC 9(07)V9(02).           02240000
023600         10  H-HHA-MSA2-DATA REDEFINES H-HHA-MSA1.                02250000
023700             15  FILLER             PIC XXX.                      02260000
023800             15  H-HHA-MSA2         PIC XXXX.                     02270000
023900             15  FILLER             PIC XX.                       02280000
024000         10  H-HHA-CBSA-DATA REDEFINES H-HHA-MSA1.                02290000
024100             15  FILLER             PIC XX.                       02300000
024200             15  H-HHA-CBSA         PIC XXXXX.                    02310000
024300             15  FILLER             PIC XX.                       02320000
024400         10  H-HHA-SERV-FROM-DATE.                                02330000
024500             15  H-HHA-FROM-CC         PIC XX.                    02340000
024600             15  H-HHA-FROM-YYMMDD.                               02350000
024700                 25  H-HHA-FROM-YY     PIC XX.                    02360000
024800                 25  H-HHA-FROM-MM     PIC XX.                    02370000
024900                 25  H-HHA-FROM-DD     PIC XX.                    02380000
025000         10  H-HHA-SERV-THRU-DATE.                                02390000
025100             15  H-HHA-THRU-CC         PIC XX.                    02400000
025200             15  H-HHA-THRU-YYMMDD.                               02410000
025300                 25  H-HHA-THRU-YY     PIC XX.                    02420000
025400                 25  H-HHA-THRU-MM     PIC XX.                    02430000
025500                 25  H-HHA-THRU-DD     PIC XX.                    02440000
025600         10  H-HHA-ADMIT-DATE.                                    02450000
025700             15  H-HHA-ADMIT-CC        PIC XX.                    02460000
025800             15  H-HHA-ADMIT-YYMMDD.                              02470000
025900                 25  H-HHA-ADMIT-YY    PIC XX.                    02480000
026000                 25  H-HHA-ADMIT-MM    PIC XX.                    02490000
026100                 25  H-HHA-ADMIT-DD    PIC XX.                    02500000
026200         10  H-HHA-HRG-DATA      OCCURS 6.                        02510000
026300             15  H-HHA-MED-REVIEW-INDICATOR PIC X.                02520000
026400             15  H-HHA-HRG-INPUT-CODE       PIC X(05).            02530000
026500             15  H-HHA-HRG-OUTPUT-CODE      PIC X(05).            02540000
026600             15  H-HHA-HRG-NO-OF-DAYS       PIC 9(03).            02550000
026700             15  H-HHA-HRG-WGTS             PIC 9(02)V9(04).      02560000
026800             15  H-HHA-HRG-PAY              PIC 9(07)V9(02).      02570000
026900         10  H-HHA-REVENUE-DATA     OCCURS 6.                     02580000
027000             15  H-HHA-REVENUE-CODE             PIC X(04).        02590022
027100             15  H-HHA-REVENUE-QTY-COV-VISITS   PIC 9(03).        02600022
027110             15  H-HHA-REVENUE-EARLIEST-DATE    PIC 9(08).        02601022
027200             15  H-HHA-REVENUE-DOLL-RATE        PIC 9(07)V9(02).  02610022
027300             15  H-HHA-REVENUE-COST             PIC 9(07)V9(02).  02620022
027310             15  H-HHA-REVENUE-ADD-ON-VISIT-AMT PIC 9(07)V9(02).  02622022
027400     05  H-HHA-PASSBACK-DATA.                                     02630000
027500         10  H-HHA-PAY-RTC                PIC 99.                 02640000
027600         10  H-HHA-REVENUE-SUM1-3-QTY-THR PIC 9(05).              02650000
027700         10  H-HHA-REVENUE-SUM1-6-QTY-ALL PIC 9(05).              02660000
027800         10  H-HHA-OUTLIER-PAYMENT        PIC 9(07)V9(02).        02670000
027900         10  H-HHA-TOTAL-PAYMENT          PIC 9(07)V9(02).        02680000
028000     05  H-HHA-CASE-MIX-DATA.                                     02690013
028100         10  H-HHA-LUPA-ADD-ON-PAYMENT    PIC 9(03)V9(02).        02690113
028200         10  H-HHA-LUPA-SRC-ADM           PIC X.                  02690213
028300         10  H-HHA-RECODE-IND             PIC X.                  02690313
028400         10  H-HHA-EPISODE-TIMING         PIC 9.                  02690413
028500         10  H-HHA-SEVERITY-POINTS.                               02690513
028600             15  H-HHA-CLINICAL-SEV-EQ1   PIC X(01).              02690613
028700             15  H-HHA-FUNCTION-SEV-EQ1   PIC X(01).              02690713
028800             15  H-HHA-CLINICAL-SEV-EQ2   PIC X(01).              02690813
028900             15  H-HHA-FUNCTION-SEV-EQ2   PIC X(01).              02690913
029000             15  H-HHA-CLINICAL-SEV-EQ3   PIC X(01).              02691013
029100             15  H-HHA-FUNCTION-SEV-EQ3   PIC X(01).              02691113
029200             15  H-HHA-CLINICAL-SEV-EQ4   PIC X(01).              02691213
029300             15  H-HHA-FUNCTION-SEV-EQ4   PIC X(01).              02691313
029400     05  H-HHA-PROV-TOTAL-DATA.                                   02691413
029500         10  H-HHA-PROV-OUTLIER-PAY-TOTAL PIC 9(08)V9(02).        02691513
029600         10  H-HHA-PROV-PAYMET-TOTAL      PIC 9(09)V9(02).        02691615
029700     05  FILLER                           PIC X(33).              02691715
029800**==================================================***           02691813
029900                                                                  02701000
030000***************************************************************   02710000
030100                                                                  02720000
030200 LINKAGE SECTION.                                                 02730000
030300***************************************************************   02740000
030400*                 * * * * * * * * *                           *   02750000
030500***************************************************************   02760000
030600***************************************************************   02770000
030700*    THIS DATA IS CALCULATED BY THIS HHAPR  SUBROUTINE        *   02780000
030800*    AND PASSED BACK TO THE CALLING PROGRAM                   *   02790000
030900***************************************************************   02800000
031000 01  HHA-INPUT-DATA.                                              02810000
031100     05  HHA-DATA.                                                02820000
031200         10  HHA-NPI                 PIC X(10).                   02830000
031300         10  HHA-HIC                 PIC X(12).                   02840000
031400         10  HHA-PROV-NO             PIC X(06).                   02850000
031500         10  HHA-TOB                 PIC XXX.                     02860000
031600         10  HHA-PEP-INDICATOR       PIC X.                       02870000
031700         10  HHA-PEP-DAYS            PIC 999.                     02880000
031800         10  HHA-INIT-PAY-INDICATOR  PIC X.                       02890000
031900         10  FILLER                  PIC X(07).                   02900000
032000         10  HHA-MSA1                PIC 9(07)V9(02).             02910000
032100         10  HHA-MSA2-DATA REDEFINES HHA-MSA1.                    02920000
032200             15  FILLER             PIC XXX.                      02930000
032300             15  HHA-MSA2.                                        02940000
032400                 25  HHA-MSA2-RURAL-1ST.                          02950000
032500                     30  HHA-RURAL-MSA         PIC XX.            02960000
032600                     88  HHA-MSA-RURAL-CHECK   VALUE '99'.        02970000
032700                 25  HHA-MSA2-RURAL-2ND        PIC XX.            02980000
032800             15  FILLER             PIC XX.                       02990000
032900         10  HHA-CBSA-DATA REDEFINES HHA-MSA1.                    03000000
033000             15  FILLER             PIC XX.                       03010000
033100             15  HHA-CBSA.                                        03020000
033200                 88  HHA-CBSA-RURAL-CHECK-ALL VALUE               03021007
033300                 '50001', '50007', '50016', '50020', '50031',     03022007
033400                 '50036', '50054', '50060', '50067', '50087',     03023007
033500                 '50089', '50091', '50092', '50100', '50104',     03024007
033600                 '50108', '50114', '50121', '50125', '50140',     03025007
033700                 '50145', '50152', '50164', '50170', '50199',     03026007
033800                 '50206', '50210', '50214', '50218', '50222',     03027007
033900                 '50225', '50226', '50231', '50234', '50237',     03028007
034000                 '50243', '50248', '50250', '50255', '50256',     03029007
034100                 '50257', '50260', '50261', '50262', '50266',     03029107
034200                 '50268', '50272', '50275', '50281', '50286',     03029207
034300                 '50313', '50314', '50316', '50325', '50326',     03029307
034400                 '50327', '50329', '50336', '50344', '50352',     03029407
034500                 '50192', '50263', '50293'.                       03029507
034600                 25  HHA-CBSA-RURAL-1ST.                          03030000
034700                     30  HHA-RURAL-CBSA        PIC XXX.           03040000
034800                     88  HHA-CBSA-RURAL-CHECK   VALUE '999'.      03050000
034900                 25  HHA-CBSA-RURAL-2ND        PIC XX.            03060000
035000             15  FILLER             PIC XX.                       03070000
035100         10  HHA-SERV-FROM-DATE.                                  03080000
035200             15  HHA-FROM-CC         PIC XX.                      03090000
035300             15  HHA-FROM-YYMMDD.                                 03100000
035400                 25  HHA-FROM-YY     PIC XX.                      03110000
035500                 25  HHA-FROM-MM     PIC XX.                      03120000
035600                 25  HHA-FROM-DD     PIC XX.                      03130000
035700         10  HHA-SERV-THRU-DATE.                                  03140000
035800             15  HHA-THRU-CC         PIC XX.                      03150000
035900             15  HHA-THRU-YYMMDD.                                 03160000
036000                 25  HHA-THRU-YY     PIC XX.                      03170000
036100                 25  HHA-THRU-MM     PIC XX.                      03180000
036200                 25  HHA-THRU-DD     PIC XX.                      03190000
036300         10  HHA-ADMIT-DATE.                                      03200000
036400             15  HHA-ADMIT-CC        PIC XX.                      03210000
036500             15  HHA-ADMIT-YYMMDD.                                03220000
036600                 25  HHA-ADMIT-YY    PIC XX.                      03230000
036700                 25  HHA-ADMIT-MM    PIC XX.                      03240000
036800                 25  HHA-ADMIT-DD    PIC XX.                      03250000
036900         10  HHA-HRG-DATA      OCCURS 6.                          03260000
037000             15  HHA-MED-REVIEW-INDICATOR PIC X.                  03270000
037100             15  HHA-HRG-INPUT-CODE       PIC X(05).              03280000
037200             15  HHA-HRG-OUTPUT-CODE      PIC X(05).              03290000
037300             15  HHA-HRG-NO-OF-DAYS       PIC 9(03).              03300000
037400             15  HHA-HRG-WGTS             PIC 9(02)V9(04).        03310000
037500             15  HHA-HRG-PAY              PIC 9(07)V9(02).        03320000
037600         10  HHA-REVENUE-DATA     OCCURS 6.                       03330000
037700             15  HHA-REVENUE-CODE             PIC X(04).          03340022
037800             15  HHA-REVENUE-QTY-COV-VISITS   PIC 9(03).          03350022
037810             15  HHA-REVENUE-EARLIEST-DATE    PIC 9(08).          03351022
037900             15  HHA-REVENUE-DOLL-RATE        PIC 9(07)V9(02).    03360022
038000             15  HHA-REVENUE-COST             PIC 9(07)V9(02).    03370022
038010             15  HHA-REVENUE-ADD-ON-VISIT-AMT PIC 9(07)V9(02).    03372022
038100     05  HHA-PASSBACK-DATA.                                       03380000
038200         10  HHA-PAY-RTC                PIC 99.                   03390000
038300         10  HHA-REVENUE-SUM1-3-QTY-THR PIC 9(05).                03400000
038400         10  HHA-REVENUE-SUM1-6-QTY-ALL PIC 9(05).                03410000
038500         10  HHA-OUTLIER-PAYMENT        PIC 9(07)V9(02).          03420000
038600         10  HHA-TOTAL-PAYMENT          PIC 9(07)V9(02).          03430000
038700     05  HHA-CASE-MIX-DATA.                                       03431013
038800         10  HHA-LUPA-ADD-ON-PAYMENT    PIC 9(03)V9(02).          03432013
038900         10  HHA-LUPA-SRC-ADM           PIC X.                    03433013
039000         10  HHA-RECODE-IND             PIC X.                    03434013
039100         10  HHA-EPISODE-TIMING         PIC 9.                    03435013
039200         10  HHA-SEVERITY-POINTS.                                 03436013
039300             15  HHA-CLINICAL-SEV-EQ1   PIC X(01).                03437013
039400             15  HHA-FUNCTION-SEV-EQ1   PIC X(01).                03438013
039500             15  HHA-CLINICAL-SEV-EQ2   PIC X(01).                03439013
039600             15  HHA-FUNCTION-SEV-EQ2   PIC X(01).                03439113
039700             15  HHA-CLINICAL-SEV-EQ3   PIC X(01).                03439213
039800             15  HHA-FUNCTION-SEV-EQ3   PIC X(01).                03439313
039900             15  HHA-CLINICAL-SEV-EQ4   PIC X(01).                03439413
040000             15  HHA-FUNCTION-SEV-EQ4   PIC X(01).                03439513
040100     05  HHA-PROV-TOTAL-DATA.                                     03439613
040200         10  HHA-PROV-OUTLIER-PAY-TOTAL PIC 9(08)V9(02).          03439713
040300         10  HHA-PROV-PAYMET-TOTAL      PIC 9(09)V9(02).          03439815
040400     05  FILLER                         PIC X(33).                03439915
040500**==================================================***           03440013
040600*    05  FILLER                         PIC X(20).                03441013
040700**==================================================***           03442013
040800                                                                  03450000
040900 01  HOLD-VARIABLES-DATA.                                         03460000
041000     02  HOLD-VAR-DATA.                                           03470000
041100         05  PRICER-OPTION-SW                   PIC X(01).        03480000
041200         05  HHOPN-VERSION                      PIC X(07).        03490001
041300         05  HHDRV-VERSION                      PIC X(07).        03500002
041400         05  HHCAL-VERSION                      PIC X(07).        03510001
041500         05  FILLER                             PIC X(20).        03520000
041600                                                                  03530000
041700 01  CBSA-WAGE-INDEX-DATA.                                        03540000
041800     02  HOLD-WIR-DATA.                                           03550000
041900         05  WIR-CBSA                       PIC X(05).            03560003
042000         05  WIR-CBSA-EFFDATE               PIC X(08).            03570000
042100         05  WIR-CBSA-WAGEIND               PIC 9(02)V9(04).      03580000
042200                                                                  03590000
042300 PROCEDURE DIVISION  USING HHA-INPUT-DATA                         03600000
042400                           HOLD-VARIABLES-DATA                    03610000
042500                           CBSA-WAGE-INDEX-DATA.                  03620000
042600                                                                  03630000
042700***************************************************************   03640000
042800*    PROCESSING:                                              *   03650000
042900*        A. WILL PROCESS NATIONAL HHA FOR CY 2006             *   03660000
043000*                STARTING JAN 1, 2006                         *   03670000
043100***************************************************************   03680000
043200                                                                  03690000
043300     MOVE CAL-VERSION TO HHCAL-VERSION.                           03700000
043400                                                                  03710000
043500     PERFORM 200-MAINLINE-CONTROL THRU 200-EXIT.                  03720000
043600                                                                  03730000
043700     MOVE HOLD-HHA-DATA TO HHA-INPUT-DATA.                        03740000
043800                                                                  03750000
043900     GOBACK.                                                      03760000
044000                                                                  03770000
044100 200-MAINLINE-CONTROL.                                            03780000
044200                                                                  03790000
044300     MOVE HHA-INPUT-DATA TO HOLD-HHA-DATA.                        03800000
044400                                                                  03810000
044500     MOVE ALL '0' TO                                              03820000
044600                     WK-ALL-TOTALS                                03830000
044700                     WK-HRG-NO-OF-DAYS                            03840000
044800                     WK-HRG-NO-OF-DAYS-TOT                        03850000
044900                     WK-RTC-ADJ-IND                               03860000
045000                     WK-PEP-DAYS                                  03870000
045100                     H-HHA-PASSBACK-DATA                          03880000
045200                     H-HHA-HRG-PAY (1)                            03890000
045300                     H-HHA-HRG-PAY (2)                            03900000
045400                     H-HHA-HRG-PAY (3)                            03910000
045500                     H-HHA-HRG-PAY (4)                            03920000
045600                     H-HHA-HRG-PAY (5)                            03930000
045700                     H-HHA-HRG-PAY (6)                            03940000
045800                     H-HHA-REVENUE-COST (1)                       03950000
045900                     H-HHA-REVENUE-COST (2)                       03960000
046000                     H-HHA-REVENUE-COST (3)                       03970000
046100                     H-HHA-REVENUE-COST (4)                       03980000
046200                     H-HHA-REVENUE-COST (5)                       03990000
046300                     H-HHA-REVENUE-COST (6).                      04000000
046400                                                                  04010000
046500     IF  H-HHA-PAY-RTC = 00                                       04020000
046600         PERFORM 400-CALC-THE-HHA THRU 400-EXIT.                  04030000
046700                                                                  04040000
046800 200-EXIT.   EXIT.                                                04050000
046900                                                                  04060000
047000 400-CALC-THE-HHA.                                                04070000
047100                                                                  04080000
047200     IF H-HHA-SERV-THRU-DATE < 20060101                           04090000
047300         MOVE '40' TO H-HHA-PAY-RTC                               04100000
047400         GO TO 400-EXIT.                                          04110000
047500                                                                  04120000
047600     IF H-HHA-ADMIT-DATE >                                        04130000
047700        H-HHA-SERV-FROM-DATE                                      04140000
047800         MOVE '40' TO H-HHA-PAY-RTC                               04150000
047900         GO TO 400-EXIT.                                          04160000
048000                                                                  04170000
048100     IF ((H-HHA-TOB = '332' OR '322') AND                         04180000
048200        (H-HHA-HRG-INPUT-CODE (1) = SPACE))                       04190000
048300        MOVE '70' TO H-HHA-PAY-RTC                                04200000
048400        GO TO 400-EXIT.                                           04210000
048500                                                                  04220000
048600     IF ((H-HHA-TOB = '329' OR '339' OR '327' OR '337' OR         04230000
048610                      '32Q' OR '33Q' OR
048700                      '32G' OR '33G' OR '32I' OR '33I' OR         04240000
048800                      '32F' OR '32K' OR '32P' OR '32H' OR         04250000
048900                      '33F' OR '33K' OR '33P' OR '33H' OR         04260000
049000                      '32J' OR '33J' OR '32M' OR '33M') AND       04270000
049100         (H-HHA-REVENUE-SUM1-6-QTY-ALL > 4 ) AND                  04280000
049200         (H-HHA-HRG-INPUT-CODE (1) = SPACE))                      04290000
049300        MOVE '75' TO H-HHA-PAY-RTC                                04300000
049400        GO TO 400-EXIT.                                           04310000
049500                                                                  04320000
049600     IF ((H-HHA-TOB = '329' OR '339' OR '327' OR '337' OR         04330000
049610                      '32Q' OR '33Q' OR
049700                      '32G' OR '33G' OR '32I' OR '33I' OR         04340000
049800                      '32F' OR '32K' OR '32P' OR '32H' OR         04350000
049900                      '33F' OR '33K' OR '33P' OR '33H' OR         04360000
050000                      '32J' OR '33J' OR '32M' OR '33M') AND       04370000
050100         (H-HHA-REVENUE-CODE (1) = SPACE))                        04380000
050200        MOVE '85' TO H-HHA-PAY-RTC                                04390000
050300        GO TO 400-EXIT.                                           04400000
050400                                                                  04410000
050500     IF ((H-HHA-TOB = '329' OR '339' OR '327' OR '337' OR         04420000
050510                      '32Q' OR '33Q' OR
050600                      '32G' OR '33G' OR '32I' OR '33I' OR         04430000
050700                      '32F' OR '32K' OR '32P' OR '32H' OR         04440000
050800                      '33F' OR '33K' OR '33P' OR '33H' OR         04450000
050900                      '32J' OR '33J' OR '32M' OR '33M') AND       04460000
051000         (H-HHA-HRG-INPUT-CODE (2) NOT = SPACES) AND              04470000
051100         (H-HHA-PEP-INDICATOR = 'Y') AND                          04480000
051200         (H-HHA-PEP-DAYS NOT NUMERIC OR                           04490000
051300          H-HHA-PEP-DAYS = ZEROES))                               04500000
051400        MOVE '15' TO H-HHA-PAY-RTC                                04510000
051500        GO TO 400-EXIT.                                           04520000
051600                                                                  04530000
051700     IF H-HHA-PAY-RTC NOT = 00 GO TO 400-EXIT.                    04540000
051800                                                                  04550000
051900***************************************************************   04560000
052000***************************************************************   04570000
052100*        THESE RATES & THRESHOLDS ARE APPLIED                 *   04580000
052200* FOR NON-RURAL AND  RURAL                                    *   04590000
052300* AS OF 04/01/2005   RURAL AND NON RURAL RATES ARE THE SAME   *   04591005
052400***************************************************************   04600000
052500* FOR NON RURAL RATES AND RURAL RATES                         *   04610005
052600     MOVE 02264.28 TO   FED-EPISODE-RATE-AMT.                     04631007
052700     MOVE 01471.78 TO   OUTLIER-THRESHOLD-AMT.                    04632007
052800                                                                  04633007
052900* FOR RURAL RATES                                                 04634007
053000     IF HHA-CBSA-RURAL-CHECK AND                                  04635007
053100        H-HHA-SERV-FROM-DATE > 20051231                           04636007
053200        MOVE 02377.49 TO   FED-EPISODE-RATE-AMT                   04637007
053300        MOVE 01545.37 TO   OUTLIER-THRESHOLD-AMT.                 04638007
053400                                                                  04639007
053500     IF HHA-CBSA-RURAL-CHECK-ALL AND                              04639107
053600        H-HHA-SERV-FROM-DATE > 20051231                           04639207
053700        MOVE 02377.49 TO   FED-EPISODE-RATE-AMT                   04639307
053800        MOVE 01545.37 TO   OUTLIER-THRESHOLD-AMT.                 04639407
053900                                                                  04639507
054000*                                                                 04640005
054100***************************************************************   04760000
054200***************************************************************   04770000
054300                                                                  04780000
054400     IF H-HHA-TOB = '322' OR '332'                                04790000
054500        PERFORM 500-INITIAL-PAYMENT THRU 500-EXIT                 04800000
054600        GO TO 400-EXIT.                                           04810000
054700                                                                  04820000
054800     IF H-HHA-TOB = '329' OR '339' OR '327' OR '337' OR           04830000
054810                    '32Q' OR '33Q' OR
054900                    '32G' OR '33G' OR '32I' OR '33I' OR           04840000
055000                    '32F' OR '32K' OR '32P' OR '32H' OR           04850000
055100                    '33F' OR '33K' OR '33P' OR '33H' OR           04860000
055200                    '32J' OR '33J' OR '32M' OR '33M'              04870000
055300        PERFORM 1000-FINAL-PAYMENT THRU 1000-EXIT                 04880000
055400        GO TO 400-EXIT.                                           04890000
055500                                                                  04900000
055600     MOVE '10' TO H-HHA-PAY-RTC.                                  04910000
055700                                                                  04920000
055800                                                                  04930000
055900 400-EXIT.   EXIT.                                                04940000
056000                                                                  04950000
056100 500-INITIAL-PAYMENT.                                             04960000
056200                                                                  04970000
056300***************************************************************   04980000
056400*            TOB = 322 OR 332 INITIAL PAYMENT                     04990000
056500***************************************************************   05000000
056600                                                                  05010000
056700     IF  H-HHA-INIT-PAY-INDICATOR  = '1' OR '0'                   05020000
056800         NEXT SENTENCE                                            05030000
056900     ELSE                                                         05040000
057000         MOVE '35' TO H-HHA-PAY-RTC                               05050000
057100         GO TO 500-EXIT.                                          05060000
057200                                                                  05070000
057300     IF  H-HHA-INIT-PAY-INDICATOR  = '1'                          05080010
057400         MOVE '03' TO H-HHA-PAY-RTC                               05090000
057500         GO TO 500-EXIT.                                          05100000
057600                                                                  05110000
057700     COMPUTE FED-ADJ ROUNDED =                                    05120000
057800               H-HHA-HRG-WGTS (1) * FED-EPISODE-RATE-AMT.         05130000
057900                                                                  05140000
058000     COMPUTE FED-LABOR-ADJ ROUNDED =                              05150000
058100             WIR-CBSA-WAGEIND *                                   05160000
058200             LABOR-PERCENT *                                      05170000
058300             FED-ADJ.                                             05180000
058400                                                                  05190000
058500     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          05200000
058600               NONLABOR-PERCENT * FED-ADJ.                        05210000
058700                                                                  05220000
058800     IF H-HHA-SERV-FROM-DATE = H-HHA-ADMIT-DATE                   05230000
058900        COMPUTE H-HHA-TOTAL-PAYMENT ROUNDED =                     05240000
059000                 (FED-LABOR-ADJ + FED-NON-LABOR-ADJ) * .6         05250000
059100        MOVE H-HHA-TOTAL-PAYMENT TO H-HHA-HRG-PAY (1)             05260000
059200        MOVE '05' TO H-HHA-PAY-RTC                                05270000
059300     ELSE                                                         05280000
059400        COMPUTE H-HHA-TOTAL-PAYMENT ROUNDED =                     05290000
059500                 (FED-LABOR-ADJ + FED-NON-LABOR-ADJ) * .5         05300000
059600        MOVE H-HHA-TOTAL-PAYMENT TO H-HHA-HRG-PAY (1)             05310000
059700        MOVE '04' TO H-HHA-PAY-RTC.                               05320000
059800                                                                  05330000
059900 500-EXIT.   EXIT.                                                05340000
060000                                                                  05350000
060100 1000-FINAL-PAYMENT.                                              05360000
060200                                                                  05370000
060300     IF H-HHA-REVENUE-QTY-COV-VISITS (1) NOT NUMERIC              05380000
060400        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (1).          05390000
060500     IF H-HHA-REVENUE-QTY-COV-VISITS (2) NOT NUMERIC              05400000
060600        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (2).          05410000
060700     IF H-HHA-REVENUE-QTY-COV-VISITS (3) NOT NUMERIC              05420000
060800        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (3).          05430000
060900     IF H-HHA-REVENUE-QTY-COV-VISITS (4) NOT NUMERIC              05440000
061000        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (4).          05450000
061100     IF H-HHA-REVENUE-QTY-COV-VISITS (5) NOT NUMERIC              05460000
061200        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (5).          05470000
061300     IF H-HHA-REVENUE-QTY-COV-VISITS (6) NOT NUMERIC              05480000
061400        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (6).          05490000
061500                                                                  05500000
061600     COMPUTE H-HHA-REVENUE-SUM1-3-QTY-THR ROUNDED =               05510000
061700             H-HHA-REVENUE-QTY-COV-VISITS (1) +                   05520000
061800             H-HHA-REVENUE-QTY-COV-VISITS (2) +                   05530000
061900             H-HHA-REVENUE-QTY-COV-VISITS (3).                    05540000
062000     COMPUTE H-HHA-REVENUE-SUM1-6-QTY-ALL ROUNDED =               05550000
062100             H-HHA-REVENUE-QTY-COV-VISITS (1) +                   05560000
062200             H-HHA-REVENUE-QTY-COV-VISITS (2) +                   05570000
062300             H-HHA-REVENUE-QTY-COV-VISITS (3) +                   05580000
062400             H-HHA-REVENUE-QTY-COV-VISITS (4) +                   05590000
062500             H-HHA-REVENUE-QTY-COV-VISITS (5) +                   05600000
062600             H-HHA-REVENUE-QTY-COV-VISITS (6).                    05610000
062700                                                                  05620000
062800     IF H-HHA-REVENUE-SUM1-6-QTY-ALL < 5                          05630000
062900        PERFORM 1050-LUPA THRU 1050-EXIT                          05640000
063000            VARYING SUB1 FROM 1 BY 1 UNTIL                        05650000
063100***         (H-HHA-REVENUE-CODE (SUB1) = SPACES OR                05660000
063200             SUB1 > 6                                             05670000
063300        MOVE '06' TO H-HHA-PAY-RTC                                05680000
063400        COMPUTE H-HHA-TOTAL-PAYMENT   ROUNDED =                   05690000
063500                H-HHA-REVENUE-COST (1) +                          05700000
063600                H-HHA-REVENUE-COST (2) +                          05710000
063700                H-HHA-REVENUE-COST (3) +                          05720000
063800                H-HHA-REVENUE-COST (4) +                          05730000
063900                H-HHA-REVENUE-COST (5) +                          05740000
064000                H-HHA-REVENUE-COST (6)                            05750000
064100        GO TO 1000-EXIT.                                          05760000
064200                                                                  05770000
064300     IF (H-HHA-PEP-INDICATOR NOT = 'Y' AND NOT = 'N')             05780000
064400         MOVE '20' TO H-HHA-PAY-RTC                               05790000
064500         GO TO 1000-EXIT.                                         05800000
064600                                                                  05810000
064700      PERFORM 1100-ADD-HRG-DAYS THRU 1100-EXIT                    05820000
064800         VARYING CO1 FROM 1 BY 1 UNTIL CO1 > 6.                   05830000
064900                                                                  05840000
065000      IF WK-HRG-NO-OF-DAYS-TOT > 60                               05850000
065100         MOVE '16' TO H-HHA-PAY-RTC                               05860000
065200         GO TO 1000-EXIT.                                         05870000
065300                                                                  05880000
065400                                                                  05890000
065500*********  HRG  PAYMENT   *******************                     05900000
065600                                                                  05910000
065700***  IF H-HHA-REVENUE-SUM1-3-QTY-THR > 9                          05920000
065800        IF H-HHA-HRG-INPUT-CODE (2) = SPACES                      05930000
065900           IF H-HHA-PEP-INDICATOR = 'N'                           05940000
066000              PERFORM 3000-PEP-N-ADJUST THRU 3000-EXIT            05950000
066100                  VARYING CO1 FROM 1 BY 1 UNTIL                   05960000
066200*                 (H-HHA-HRG-INPUT-CODE (CO1) = SPACES OR         05970000
066300                   CO1 > 6                                        05980000
066400               PERFORM 7000-OUTLIER-PAYMENT THRU 7000-EXIT        05990000
066500               GO TO 1000-EXIT.                                   06000000
066600                                                                  06010000
066700                                                                  06020000
066800***  IF H-HHA-REVENUE-SUM1-3-QTY-THR > 9                          06030000
066900        IF H-HHA-HRG-INPUT-CODE (2) = SPACES                      06040000
067000           IF H-HHA-PEP-INDICATOR = 'Y'                           06050000
067100              PERFORM 4000-PEP-Y-ADJUST THRU 4000-EXIT            06060000
067200                  VARYING CO1 FROM 1 BY 1 UNTIL                   06070000
067300*                 (H-HHA-HRG-INPUT-CODE (CO1) = SPACES OR         06080000
067400                   CO1 > 6                                        06090000
067500               PERFORM 7000-OUTLIER-PAYMENT THRU 7000-EXIT        06100000
067600               GO TO 1000-EXIT.                                   06110000
067700                                                                  06120000
067800**** IF H-HHA-REVENUE-SUM1-3-QTY-THR > 9                          06130000
067900        IF H-HHA-HRG-INPUT-CODE (2) NOT = SPACES                  06140000
068000           IF H-HHA-PEP-INDICATOR = 'N'                           06150000
068100              PERFORM 5000-PEP-N-ADJUST THRU 5000-EXIT            06160000
068200                  VARYING CO1 FROM 1 BY 1 UNTIL                   06170000
068300*                 (H-HHA-HRG-INPUT-CODE (CO1) = SPACES OR         06180000
068400                   CO1 > 6                                        06190000
068500               PERFORM 7000-OUTLIER-PAYMENT THRU 7000-EXIT        06200000
068600               GO TO 1000-EXIT.                                   06210000
068700                                                                  06220000
068800**** IF H-HHA-REVENUE-SUM1-3-QTY-THR > 9                          06230000
068900        IF H-HHA-HRG-INPUT-CODE (2) NOT = SPACES                  06240000
069000           IF H-HHA-PEP-INDICATOR = 'Y'                           06250000
069100              PERFORM 6000-PEP-Y-ADJUST THRU 6000-EXIT            06260000
069200                  VARYING CO1 FROM 1 BY 1 UNTIL                   06270000
069300*                 (H-HHA-HRG-INPUT-CODE (CO1) = SPACES OR         06280000
069400                   CO1 > 6                                        06290000
069500               PERFORM 7000-OUTLIER-PAYMENT THRU 7000-EXIT        06300000
069600               GO TO 1000-EXIT.                                   06310000
069700                                                                  06320000
069800                                                                  06330000
069900      MOVE '20' TO H-HHA-PAY-RTC.                                 06340000
070000                                                                  06350000
070100 1000-EXIT.  EXIT.                                                06360000
070200 1050-LUPA.                                                       06370000
070300                                                                  06380000
070400***************************************************************   06390000
070500*                    LUPA PAYMENT                                 06400000
070600***************************************************************   06410000
070700                                                                  06420000
070800     IF H-HHA-REVENUE-CODE (SUB1) = SPACES                        06430000
070900        MOVE 6 TO SUB1                                            06440000
071000        GO TO 1050-EXIT.                                          06450000
071100                                                                  06460000
071200     COMPUTE FED-ADJ ROUNDED =                                    06470000
071300             H-HHA-REVENUE-QTY-COV-VISITS (SUB1) *                06480000
071400             H-HHA-REVENUE-DOLL-RATE (SUB1).                      06490000
071500                                                                  06500000
071600     COMPUTE FED-LABOR-ADJ ROUNDED =                              06510000
071700             WIR-CBSA-WAGEIND *                                   06520000
071800             LABOR-PERCENT *                                      06530000
071900             FED-ADJ.                                             06540000
072000                                                                  06550000
072100     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          06560000
072200             NONLABOR-PERCENT *                                   06570000
072300             FED-ADJ.                                             06580000
072400                                                                  06590000
072500     COMPUTE H-HHA-REVENUE-COST (SUB1) ROUNDED =                  06600000
072600             (FED-LABOR-ADJ + FED-NON-LABOR-ADJ).                 06610000
072700                                                                  06620000
072800 1050-EXIT.   EXIT.                                               06630000
072900                                                                  06640000
073000 1100-ADD-HRG-DAYS.                                               06650000
073100                                                                  06660000
073200      IF H-HHA-HRG-NO-OF-DAYS (CO1) NUMERIC                       06670000
073300         ADD H-HHA-HRG-NO-OF-DAYS (CO1) TO                        06680000
073400             WK-HRG-NO-OF-DAYS-TOT.                               06690000
073500                                                                  06700000
073600 1100-EXIT.   EXIT.                                               06710000
073700                                                                  06720000
073800 3000-PEP-N-ADJUST.                                               06730000
073900                                                                  06740000
074000***************************************************************   06750000
074100*           HRG OCCUR < 2 AND PEP = N ADJUSTMENT                  06760000
074200***************************************************************   06770000
074300                                                                  06780000
074400     IF H-HHA-HRG-INPUT-CODE (CO1) = SPACES                       06790000
074500        MOVE 6 TO SUB1                                            06800000
074600        GO TO 3000-EXIT.                                          06810000
074700                                                                  06820000
074800     MOVE H-HHA-HRG-NO-OF-DAYS (CO1) TO WK-HRG-NO-OF-DAYS.        06830000
074900                                                                  06840000
075000     COMPUTE FED-ADJ ROUNDED =                                    06850000
075100               (WK-HRG-NO-OF-DAYS  *                              06860000
075200                H-HHA-HRG-WGTS (CO1) *                            06870000
075300                FED-EPISODE-RATE-AMT) / 60.                       06880000
075400                                                                  06890000
075500     COMPUTE FED-LABOR-ADJ ROUNDED =                              06900000
075600               WIR-CBSA-WAGEIND *                                 06910000
075700               LABOR-PERCENT * FED-ADJ.                           06920000
075800                                                                  06930000
075900     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          06940000
076000               NONLABOR-PERCENT * FED-ADJ.                        06950000
076100                                                                  06960000
076200     COMPUTE WK-3000-PEP-N-PAYMENT ROUNDED =                      06970000
076300              (FED-LABOR-ADJ + FED-NON-LABOR-ADJ).                06980000
076400                                                                  06990000
076500     COMPUTE H-HHA-HRG-PAY (CO1) ROUNDED =                        07000000
076600             WK-3000-PEP-N-PAYMENT.                               07010000
076700                                                                  07020000
076800     COMPUTE WK-3000-PEP-N-PRETOT-PAY ROUNDED =                   07030000
076900             WK-3000-PEP-N-PRETOT-PAY + WK-3000-PEP-N-PAYMENT.    07040000
077000                                                                  07050000
077100                                                                  07060000
077200 3000-EXIT.   EXIT.                                               07070000
077300                                                                  07080000
077400 4000-PEP-Y-ADJUST.                                               07090000
077500                                                                  07100000
077600***************************************************************   07110000
077700*           HRG OCCUR < 2 AND PEP = Y ADJUSTMENT                  07120000
077800***************************************************************   07130000
077900                                                                  07140000
078000     IF H-HHA-HRG-INPUT-CODE (CO1) = SPACES                       07150000
078100        MOVE 6 TO SUB1                                            07160000
078200        GO TO 4000-EXIT.                                          07170000
078300                                                                  07180000
078400     MOVE 2 TO WK-RTC-ADJ-IND.                                    07190000
078500                                                                  07200000
078600     MOVE H-HHA-HRG-NO-OF-DAYS (CO1) TO WK-HRG-NO-OF-DAYS.        07210000
078700                                                                  07220000
078800     COMPUTE FED-ADJ ROUNDED =                                    07230000
078900               (WK-HRG-NO-OF-DAYS  *                              07240000
079000                H-HHA-HRG-WGTS (CO1) *                            07250000
079100                FED-EPISODE-RATE-AMT) / 60.                       07260000
079200                                                                  07270000
079300     COMPUTE FED-LABOR-ADJ ROUNDED =                              07280000
079400               WIR-CBSA-WAGEIND *                                 07290000
079500               LABOR-PERCENT * FED-ADJ.                           07300000
079600                                                                  07310000
079700     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          07320000
079800               NONLABOR-PERCENT * FED-ADJ.                        07330000
079900                                                                  07340000
080000     COMPUTE WK-4000-PEP-Y-PAYMENT ROUNDED =                      07350000
080100              (FED-LABOR-ADJ + FED-NON-LABOR-ADJ).                07360000
080200                                                                  07370000
080300     COMPUTE H-HHA-HRG-PAY (CO1) ROUNDED =                        07380000
080400             WK-4000-PEP-Y-PAYMENT.                               07390000
080500                                                                  07400000
080600     COMPUTE WK-4000-PEP-Y-PRETOT-PAY ROUNDED =                   07410000
080700             WK-4000-PEP-Y-PRETOT-PAY + WK-4000-PEP-Y-PAYMENT.    07420000
080800                                                                  07430000
080900                                                                  07440000
081000 4000-EXIT.   EXIT.                                               07450000
081100 5000-PEP-N-ADJUST.                                               07460000
081200                                                                  07470000
081300***************************************************************   07480000
081400*           HRG OCCUR > 1 AND PEP = N ADJUSTMENT                  07490000
081500***************************************************************   07500000
081600                                                                  07510000
081700     IF H-HHA-HRG-INPUT-CODE (CO1) = SPACES                       07520000
081800        MOVE 6 TO SUB1                                            07530000
081900        GO TO 5000-EXIT.                                          07540000
082000                                                                  07550000
082100     MOVE 1 TO WK-RTC-ADJ-IND.                                    07560000
082200                                                                  07570000
082300     MOVE H-HHA-HRG-NO-OF-DAYS (CO1) TO WK-HRG-NO-OF-DAYS.        07580000
082400                                                                  07590000
082500     COMPUTE FED-ADJ ROUNDED =                                    07600000
082600               (WK-HRG-NO-OF-DAYS  *                              07610000
082700                H-HHA-HRG-WGTS (CO1) *                            07620000
082800                FED-EPISODE-RATE-AMT) / 60.                       07630000
082900                                                                  07640000
083000     COMPUTE FED-LABOR-ADJ ROUNDED =                              07650000
083100               WIR-CBSA-WAGEIND *                                 07660000
083200               LABOR-PERCENT * FED-ADJ.                           07670000
083300                                                                  07680000
083400     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          07690000
083500               NONLABOR-PERCENT * FED-ADJ.                        07700000
083600                                                                  07710000
083700     COMPUTE WK-5000-PEP-N-PAYMENT ROUNDED =                      07720000
083800              (FED-LABOR-ADJ + FED-NON-LABOR-ADJ).                07730000
083900                                                                  07740000
084000     COMPUTE H-HHA-HRG-PAY (CO1) ROUNDED =                        07750000
084100             WK-5000-PEP-N-PAYMENT.                               07760000
084200                                                                  07770000
084300                                                                  07780000
084400     COMPUTE WK-5000-PEP-N-PRETOT-PAY ROUNDED =                   07790000
084500             WK-5000-PEP-N-PRETOT-PAY + WK-5000-PEP-N-PAYMENT.    07800000
084600                                                                  07810000
084700                                                                  07820000
084800 5000-EXIT.   EXIT.                                               07830000
084900 6000-PEP-Y-ADJUST.                                               07840000
085000                                                                  07850000
085100***************************************************************   07860000
085200*           HRG OCCUR > 1 AND PEP = Y SHORTENED EPISODE           07870000
085300***************************************************************   07880000
085400                                                                  07890000
085500     IF H-HHA-HRG-INPUT-CODE (CO1) = SPACES                       07900000
085600        MOVE 6 TO SUB1                                            07910000
085700        GO TO 6000-EXIT.                                          07920000
085800                                                                  07930000
085900     MOVE 3 TO WK-RTC-ADJ-IND.                                    07940000
086000                                                                  07950000
086100     MOVE H-HHA-HRG-NO-OF-DAYS (CO1) TO WK-HRG-NO-OF-DAYS.        07960000
086200     MOVE H-HHA-PEP-DAYS             TO WK-PEP-DAYS.              07970000
086300                                                                  07980000
086400*    COMPUTE FED-ADJ ROUNDED =                                    07990000
086500*        (WK-HRG-NO-OF-DAYS / WK-PEP-DAYS)                        08000000
086600*                                *                                08010000
086700*                    ((WK-PEP-DAYS / 60)                          08020000
086800*                                *                                08030000
086900*          (H-HHA-HRG-WGTS (CO1) * FED-EPISODE-RATE-AMT)).        08040000
087000*                                                                 08050000
087100                                                                  08060000
087200*    COMPUTE FED-ADJ ROUNDED =                                    08070000
087300*        (WK-HRG-NO-OF-DAYS / WK-PEP-DAYS)                        08080000
087400*                                *                                08090000
087500*      ((WK-PEP-DAYS * H-HHA-HRG-WGTS (CO1) *                     08100000
087600*                          FED-EPISODE-RATE-AMT) / 60).           08110000
087700                                                                  08120000
087800     COMPUTE FED-ADJ1 ROUNDED =                                   08130000
087900      ((WK-PEP-DAYS * H-HHA-HRG-WGTS (CO1) *                      08140000
088000                           FED-EPISODE-RATE-AMT) / 60).           08150000
088100                                                                  08160000
088200     COMPUTE FED-ADJ ROUNDED  =                                   08170000
088300                  (FED-ADJ1 * WK-HRG-NO-OF-DAYS) / WK-PEP-DAYS.   08180000
088400                                                                  08190000
088500     COMPUTE FED-LABOR-ADJ ROUNDED =                              08200000
088600               WIR-CBSA-WAGEIND *                                 08210000
088700               LABOR-PERCENT * FED-ADJ.                           08220000
088800                                                                  08230000
088900     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          08240000
089000               NONLABOR-PERCENT * FED-ADJ.                        08250000
089100                                                                  08260000
089200     COMPUTE WK-6000-PEP-Y-PAYMENT ROUNDED =                      08270000
089300              (FED-LABOR-ADJ + FED-NON-LABOR-ADJ).                08280000
089400                                                                  08290000
089500     COMPUTE H-HHA-HRG-PAY (CO1) ROUNDED =                        08300000
089600             WK-6000-PEP-Y-PAYMENT.                               08310000
089700                                                                  08320000
089800     COMPUTE WK-6000-PEP-Y-PRETOT-PAY ROUNDED =                   08330000
089900             WK-6000-PEP-Y-PRETOT-PAY + WK-6000-PEP-Y-PAYMENT.    08340000
090000                                                                  08350000
090100                                                                  08360000
090200 6000-EXIT.   EXIT.                                               08370000
090300                                                                  08380000
090400 7000-OUTLIER-PAYMENT.                                            08390000
090500                                                                  08400000
090600***************************************************************   08410000
090700*                    OUTLIER PAYMENT                              08420000
090800***************************************************************   08430000
090900     COMPUTE OUT-THRES-LABOR-ADJ ROUNDED =                        08440000
091000               WIR-CBSA-WAGEIND *                                 08450000
091100               LABOR-PERCENT * OUTLIER-THRESHOLD-AMT.             08460000
091200                                                                  08470000
091300     COMPUTE OUT-THRES-NON-LABOR-ADJ ROUNDED =                    08480000
091400               NONLABOR-PERCENT * OUTLIER-THRESHOLD-AMT.          08490000
091500                                                                  08500000
091600     COMPUTE OUT-THRES-AMT-ADJ ROUNDED  =                         08510000
091700             (OUT-THRES-LABOR-ADJ +                               08520000
091800              OUT-THRES-NON-LABOR-ADJ).                           08530000
091900                                                                  08540000
092000      COMPUTE WK-7000-OUTLIER-VALUE-A ROUNDED =                   08550000
092100              OUT-THRES-AMT-ADJ +                                 08560000
092200             WK-3000-PEP-N-PRETOT-PAY +                           08570000
092300             WK-4000-PEP-Y-PRETOT-PAY +                           08580000
092400             WK-5000-PEP-N-PRETOT-PAY +                           08590000
092500             WK-6000-PEP-Y-PRETOT-PAY.                            08600000
092600                                                                  08610000
092700      PERFORM 8000-ADD-REV-DOLL THRU 8000-EXIT                    08620000
092800                  VARYING CO1 FROM 1 BY 1 UNTIL                   08630000
092900                   CO1 > 6.                                       08640000
093000                                                                  08650000
093100      COMPUTE WK-7000-AB-DIFF ROUNDED =                           08660000
093200              WK-8000-OUTLIER-VALUE-B - WK-7000-OUTLIER-VALUE-A.  08670000
093300                                                                  08680000
093400      IF WK-7000-AB-DIFF > ZERO                                   08690000
093500         COMPUTE WK-7000-CALC ROUNDED =                           08700000
093600               OUTL-LOSS-SHAR-RATIO-PERCENT * WK-7000-AB-DIFF     08710000
093700         COMPUTE H-HHA-OUTLIER-PAYMENT ROUNDED =                  08720000
093800               WK-7000-CALC                                       08730000
093900         COMPUTE H-HHA-TOTAL-PAYMENT ROUNDED =                    08740000
094000                (WK-7000-CALC +                                   08750000
094100                 WK-3000-PEP-N-PRETOT-PAY +                       08760000
094200                 WK-4000-PEP-Y-PRETOT-PAY +                       08770000
094300                 WK-5000-PEP-N-PRETOT-PAY +                       08780000
094400                 WK-6000-PEP-Y-PRETOT-PAY)                        08790000
094500          PERFORM 9000-WHICH-RTC-OUTLIER THRU 9000-EXIT           08800000
094600      ELSE                                                        08810000
094700         COMPUTE H-HHA-TOTAL-PAYMENT ROUNDED =                    08820000
094800                (WK-3000-PEP-N-PRETOT-PAY +                       08830000
094900                 WK-4000-PEP-Y-PRETOT-PAY +                       08840000
095000                 WK-5000-PEP-N-PRETOT-PAY +                       08850000
095100                 WK-6000-PEP-Y-PRETOT-PAY)                        08860000
095200          PERFORM 9050-WHICH-RTC-NO-OUTLIER THRU 9050-EXIT.       08870000
095300                                                                  08880000
095400                                                                  08890000
095500 7000-EXIT.   EXIT.                                               08900000
095600 8000-ADD-REV-DOLL.                                               08910000
095700                                                                  08920000
095800***************************************************************   08930000
095900*        ADD ALL REVENUE DOLLARS                                  08940000
096000***************************************************************   08950000
096100                                                                  08960000
096200     IF H-HHA-REVENUE-CODE (CO1) = SPACES                         08970000
096300        MOVE 6 TO SUB1                                            08980000
096400        GO TO 8000-EXIT.                                          08990000
096500                                                                  09000000
096600     COMPUTE FED-ADJ ROUNDED =                                    09010000
096700                H-HHA-REVENUE-DOLL-RATE (CO1) *                   09020000
096800                H-HHA-REVENUE-QTY-COV-VISITS (CO1).               09030000
096900                                                                  09040000
097000     COMPUTE FED-LABOR-ADJ ROUNDED =                              09050000
097100               WIR-CBSA-WAGEIND *                                 09060000
097200               LABOR-PERCENT * FED-ADJ.                           09070000
097300                                                                  09080000
097400     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          09090000
097500               NONLABOR-PERCENT * FED-ADJ.                        09100000
097600                                                                  09110000
097700     COMPUTE WK-8000-OUTLIER-LAB-NLAB ROUNDED =                   09120000
097800              (FED-LABOR-ADJ + FED-NON-LABOR-ADJ).                09130000
097900                                                                  09140000
098000                                                                  09150000
098100     COMPUTE H-HHA-REVENUE-COST (CO1) ROUNDED =                   09160000
098200               WK-8000-OUTLIER-LAB-NLAB.                          09170000
098300                                                                  09180000
098400     COMPUTE WK-8000-OUTLIER-VALUE-B ROUNDED =                    09190000
098500             WK-8000-OUTLIER-VALUE-B + WK-8000-OUTLIER-LAB-NLAB.  09200000
098600                                                                  09210000
098700 8000-EXIT.   EXIT.                                               09220000
098800                                                                  09230000
098900 9000-WHICH-RTC-OUTLIER.                                          09240000
099000                                                                  09250000
099100      MOVE '01' TO H-HHA-PAY-RTC.                                 09260000
099200                                                                  09270000
099300      IF WK-RTC-ADJ-IND = 1  MOVE '08' TO H-HHA-PAY-RTC.          09280000
099400      IF WK-RTC-ADJ-IND = 2  MOVE '11' TO H-HHA-PAY-RTC.          09290000
099500      IF WK-RTC-ADJ-IND = 3  MOVE '13' TO H-HHA-PAY-RTC.          09300000
099600                                                                  09310000
099700                                                                  09320000
099800 9000-EXIT.   EXIT.                                               09330000
099900                                                                  09340000
100000 9050-WHICH-RTC-NO-OUTLIER.                                       09350000
100100                                                                  09360000
100200      MOVE '00' TO H-HHA-PAY-RTC.                                 09370000
100300                                                                  09380000
100400      IF WK-RTC-ADJ-IND = 1  MOVE '07' TO H-HHA-PAY-RTC.          09390000
100500      IF WK-RTC-ADJ-IND = 2  MOVE '09' TO H-HHA-PAY-RTC.          09400000
100600      IF WK-RTC-ADJ-IND = 3  MOVE '12' TO H-HHA-PAY-RTC.          09410000
100700                                                                  09420000
100800                                                                  09430000
100900 9050-EXIT.   EXIT.                                               09440000
101000                                                                  09450000
101100******        L A S T   S O U R C E   S T A T E M E N T   *****   09460000
