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