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