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