000100 IDENTIFICATION DIVISION.                                         00010002
000200 PROGRAM-ID.      HHCAL044.                                       00020013
000300*AUTHOR.          DAVE PANUSKA                                    00030002
000400*REMARKS.     (CENTERS FOR MEDICARE & MEDICAID SERVICES)          00040002
000500*REMARKS. A). NATIONAL HHA PRICER                                 00050002
000600***       B). NATIONAL HHA PRICER EFFECTIVE OCT 1 2001            00060002
000700***       C). THERE ARE YEARLY HHA PRICER MODULES THAT WILL       00070002
000800***           CALCULATE THE HRG'S,REVENUE CODES AND               00080002
000900***           TYPE OF BILLS.                                      00090002
001000*REMARKS.                                                         00100002
001100*     FOR FY 2004 CALCULATIONS AND RATES                          00110002
001200*     HHCAL040   NEW RATES EFFECTIVE OCT 1, 2003                  00120002
001300*     HHCAL041   NEW RATES EFFECTIVE APR 1, 2004                  00130002
001400*     HHCAL042 EXPAND BILLING RECORD TO 500 BYTES - BEATA VERSION 00131011
001500*     HHCAL043 INCREASE PROV-PAYMET-TOTAL TO  PIC 9(09)V9(02)     00132011
001510*     HHCAL044 ADD NEW FIELDS FOR EARLIEST DATES                  00133013
001600******************************************************************00140002
001700*----------------------------------------------------------------*
001710* 2016 - ADDED 32Q AND 33Q AS VALID TOB CODES IN PARAGRAPH       *
001720*        400-CALC-THE-HHA                                        *
001730*----------------------------------------------------------------*
001800******************************************************************00160002
001900*            RETURN CODE VALUES (HHA-RTC)                         00170002
002000*                                                                 00180002
002100*        HHA-RTC  WITH PAYMENTS RETURNED                          00190002
002200*                                                                 00200002
002300*     RETURN CODES                                                00210002
002400*          00 = FINAL PAYMENT                                     00220002
002500*               TOB = 329,339,327,337                             00230002
002510*                  OR 32Q OR 33Q
002600*                  OR 32G OR 33G OR 32I OR 33I                    00240002
002700*                  OR 32J OR 33J OR 32M OR 33M                    00250002
002800*                  OR 32F OR 32K OR 32P OR 32H                    00260002
002900*                  OR 33F OR 33K OR 33P OR 33H                    00270002
003000*               WITH HRG,REVENUE CODE WHERE NO OUTLIER APPLIES    00280002
003100*          01 = FINAL PAYMENT                                     00290002
003200*               TOB = 329,339,327,337                             00300002
003210*                  OR 32Q OR 33Q
003300*                  OR 32G OR 33G OR 32I OR 33I                    00310002
003400*                  OR 32J OR 33J OR 32M OR 33M                    00320002
003500*                  OR 32F OR 32K OR 32P OR 32H                    00330002
003600*                  OR 33F OR 33K OR 33P OR 33H                    00340002
003700*               WITH HRG,REVENUE CODE WHERE OUTLIER APPLIES       00350002
003800*          03 = INITIAL HALF PAYMENT PAYMENT WILL BE ZERO         00360002
003900*               TOB = 332 AND 322                                 00370002
004000*          04 = INITIAL HALF PAYMENT PAID AT 50%                  00380002
004100*               TOB = 332 AND 322                                 00390002
004200*               WITH INITIAL (FIRST) HRG AND NO REVENUE CODES     00400002
004300*          05 = INITIAL HALF PAYMENT PAID AT 60%                  00410002
004400*               TOB = 332 AND 322                                 00420002
004500*               WITH INITIAL (FIRST) HRG AND NO REVENUE CODES     00430002
004600*          06 = LUPA PAYMENT ONLY                                 00440002
004700*               TOB = 329,339,327,337                             00450002
004710*                  OR 32Q OR 33Q
004800*                  OR 32G OR 33G OR 32I OR 33I                    00460002
004900*                  OR 32J OR 33J OR 32M OR 33M                    00470002
005000*                  OR 32F OR 32K OR 32P OR 32H                    00480002
005100*                  OR 33F OR 33K OR 33P OR 33H                    00490002
005200*               WITH REVENUE CODES AND REVENUE QTYS < 5       *   00500002
005300******************************************************************00510002
005400*          07 = FINAL PAYMENT, SCIC, PEP = N, NO OUTLIER          00520002
005500*               TOB = 329,339,327,337                             00530002
005510*                  OR 32Q OR 33Q
005600*                  OR 32G OR 33G OR 32I OR 33I                    00540002
005700*                  OR 32J OR 33J OR 32M OR 33M                    00550002
005800*                  OR 32F OR 32K OR 32P OR 32H                    00560002
005900*                  OR 33F OR 33K OR 33P OR 33H                    00570002
006000*               WITH REVENUE CODE WHERE NO OUTLIER APPLIES        00580002
006100*               WITH MORE THAN ONE HRG OCCURRENCE             *   00590002
006200*          08 = FINAL PAYMENT, SCIC, PEP = N, WITH OUTLIER        00600002
006300*               TOB = 329,339,327,337                             00610002
006310*                  OR 32Q OR 33Q
006400*                  OR 32G OR 33G OR 32I OR 33I                    00620002
006500*                  OR 32J OR 33J OR 32M OR 33M                    00630002
006600*                  OR 32F OR 32K OR 32P OR 32H                    00640002
006700*                  OR 33F OR 33K OR 33P OR 33H                    00650002
006800*               WITH REVENUE CODE WHERE OUTLIER APPLIES           00660002
006900*               WITH MORE THAN ONE HRG OCCURRENCE             *   00670002
007000******************************************************************00680002
007100*          09 = FINAL PAYMENT, PEP = Y, NO OUTLIER                00690002
007200*               TOB = 329,339,327,337                             00700002
007210*                  OR 32Q OR 33Q
007300*                  OR 32G OR 33G OR 32I OR 33I                    00710002
007400*                  OR 32J OR 33J OR 32M OR 33M                    00720002
007500*                  OR 32F OR 32K OR 32P OR 32H                    00730002
007600*                  OR 33F OR 33K OR 33P OR 33H                    00740002
007700*               WITH REVENUE CODE WHERE NO OUTLIER APPLIES        00750002
007800*               WITH ONE HRG OCCURRENCE                       *   00760002
007900*          11 = FINAL PAYMENT, PEP = Y, WITH OUTLIER              00770002
008000*               TOB = 329,339,327,337                             00780002
008010*                  OR 32Q OR 33Q
008100*                  OR 32G OR 33G OR 32I OR 33I                    00790002
008200*                  OR 32J OR 33J OR 32M OR 33M                    00800002
008300*                  OR 32F OR 32K OR 32P OR 32H                    00810002
008400*                  OR 33F OR 33K OR 33P OR 33H                    00820002
008500*               WITH REVENUE CODE WHERE OUTLIER APPLIES           00830002
008600*               WITH ONE HRG OCCURRENCE                       *   00840002
008700******************************************************************00850002
008800*          12 = FINAL PAYMENT, SCIC, PEP = Y, NO OUTLIER          00860002
008900*               TOB = 329,339,327,337                             00870002
008910*                  OR 32Q OR 33Q
009000*                  OR 32G OR 33G OR 32I OR 33I                    00880002
009100*                  OR 32J OR 33J OR 32M OR 33M                    00890002
009200*                  OR 32F OR 32K OR 32P OR 32H                    00900002
009300*                  OR 33F OR 33K OR 33P OR 33H                    00910002
009400*               WITH REVENUE CODE WHERE NO OUTLIER APPLIES        00920002
009500*               WITH MORE THAN ONE HRG OCCURRENCE             *   00930002
009600*          13 = FINAL PAYMENT, SCIC, PEP = Y, WITH OUTLIER        00940002
009700*               TOB = 329,339,327,337                             00950002
009710*                  OR 32Q OR 33Q
009800*                  OR 32G OR 33G OR 32I OR 33I                    00960002
009900*                  OR 32J OR 33J OR 32M OR 33M                    00970002
010000*                  OR 32F OR 32K OR 32P OR 32H                    00980002
010100*                  OR 33F OR 33K OR 33P OR 33H                    00990002
010200*               WITH REVENUE CODE WHERE OUTLIER APPLIES           01000002
010300*               WITH MORE THAN ONE HRG OCCURRENCE             *   01010002
010400******************************************************************01020002
010500******************************************************************01030002
010600*                                                             *   01040002
010700*            HHA-RTC   NO PAYMENTS RETURNED                   *   01050002
010800*                                                             *   01060002
010900*              10 = INVALID TOB                               *   01070002
011000*                                                             *   01080002
011100*              15 = INVALID PEP DAYS                          *   01090002
011200*                   FOR SHORTENED EPISODE                     *   01100002
011300*                                                             *   01110002
011400*              16 = INVALID HRG DAYS , > 60 DAYS              *   01120002
011500*                                                             *   01130002
011600*              20 = INVALID PEP INDICATOR                     *   01140002
011700*                                                             *   01150002
011800*              25 = INVALID MED REVIEW INDICATOR              *   01160002
011900*                                                             *   01170002
012000*              30 = INVALID MSA CODE                          *   01180002
012100*                                                             *   01190002
012200*              35 = INVALID INITIAL PAYMENT INDICATOR         *   01200002
012300*                        0 = MAKE NORMAL INITIAL PAYMENT      *   01210002
012400*                        1 = MAKE ZERO PAYMANT                *   01220002
012500*                                                             *   01230002
012600*              40 = THRU DATE  < OCT 1, 2002 FOR FY2003       *   01240002
012700*                     OR ADMIT DATE > SERV FROM DATE          *   01250002
012800*                     OR INVALID                              *   01260002
012900*                                                             *   01270002
013000*              70 = INVALID OR NO HRG CODE PRESENT            *   01280002
013100*                                                             *   01290002
013200*              75 = NO HRG PRESENT IN FIRST OCCURANCE AND     *   01300002
013300*                   REVENUE-QTY-COV-VISITS > 4  AND           *   01310002
013400*                       TOB = 329,339,327,337                 *   01320002
013500*                          OR 32G OR 33G OR 32I OR 33I        *   01330002
013600*                          OR 32J OR 33J OR 32M OR 33M        *   01340002
013700*                          OR 32F OR 32K OR 32P OR 32H            01350002
013800*                          OR 33F OR 33K OR 33P OR 33H            01360002
013900*                                                             *   01370002
014000*              80 = INVALID REVENUE CODE                      *   01380002
014100*                                                             *   01390002
014200*              85 = NO REVENUE CODE PRESENT                   *   01400002
014300*                   WITH TOB 329 OR 339 OR 327 OR 337         *   01410002
014400*                         OR 32G OR 33G OR 32I OR 33I         *   01420002
014500*                         OR 32J OR 33J OR 32M OR 33M         *   01430002
014600*                         OR 32F OR 32K OR 32P OR 32H             01440002
014700*                         OR 33F OR 33K OR 33P OR 33H             01450002
014800*                                                             *   01460002
014900***************************************************************   01470002
015000***************************************************************   01480002
015100***************************************************************   01490002
015200 DATE-COMPILED.                                                   01500002
015300 ENVIRONMENT DIVISION.                                            01510002
015400 CONFIGURATION SECTION.                                           01520002
015500 SOURCE-COMPUTER.            IBM-370.                             01530002
015600 OBJECT-COMPUTER.            IBM-370.                             01540002
015700 INPUT-OUTPUT  SECTION.                                           01550002
015800 FILE-CONTROL.                                                    01560002
015900                                                                  01570002
016000 DATA DIVISION.                                                   01580002
016100 FILE SECTION.                                                    01590002
016200                                                                  01600002
016300 WORKING-STORAGE SECTION.                                         01610002
016400 01  W-STORAGE-REF                  PIC X(46)  VALUE              01620002
016500     'HHCAL044      - W O R K I N G   S T O R A G E'.             01630013
016600 01  CAL-VERSION                    PIC X(07)  VALUE 'C2004.3'.   01640013
016700 01  CO1                            PIC S9(04) COMP SYNC.         01650002
016800 01  SUB1                           PIC S9(04) COMP SYNC.         01660002
016900 01  R1                             PIC S9(04) COMP SYNC.         01670002
017000 01  R2                             PIC S9(04) COMP SYNC.         01680002
017100 01  R3                             PIC S9(04) COMP SYNC.         01690002
017200                                                                  01700002
017300 01  LABOR-NLABOR-PERCENT.                                        01710002
017400     05 LABOR-PERCENT        PIC 9V9(05)  VALUE 0.77668.          01720002
017500     05 NONLABOR-PERCENT     PIC 9V9(05)  VALUE 0.22332.          01730002
017600                                                                  01740002
017700 01  FED-EPISODE-RATE-AMT         PIC 9(05)V9(02) VALUE 0.        01750002
017800 01  OUTLIER-THRESHOLD-AMT        PIC 9(05)V9(02) VALUE 0.        01760002
017900***************************************************************** 01770002
018000***    EXAMPLE    *********************************************** 01780002
018100*** FED-EPISODE-RATE-AMT TIMES 1.13 = OUTLIER-THRESHOLD-AMT ***** 01790002
018200******  2230.65 TIMES 1.13  = 2520.64  ROUNDED UP  ************** 01800002
018300***************************************************************** 01810002
018400 01  OUTL-LOSS-SHAR-RATIO-PERCENT PIC 9(01)V9(02) VALUE 0.80.     01820002
018500                                                                  01830002
018600 01  WK-PEP-DAYS           PIC S9(04)       VALUE 0.              01840002
018700 01  WK-HRG-NO-OF-DAYS     PIC S9(04)       VALUE 0.              01850002
018800 01  WK-HRG-NO-OF-DAYS-TOT PIC S9(04)       VALUE 0.              01860002
018900 01  WK-RTC-ADJ-IND        PIC 9            VALUE 0.              01870002
019000 01  WK-ALL-TOTALS.                                               01880002
019100     05  FED-ADJ                        PIC S9(07)V9(02).         01890002
019200     05  FED-ADJ1                       PIC S9(07)V9(02).         01900002
019300     05  FED-LABOR-ADJ                  PIC S9(07)V9(02).         01910002
019400     05  FED-NON-LABOR-ADJ              PIC S9(07)V9(02).         01920002
019500     05  OUT-THRES-AMT-ADJ              PIC S9(07)V9(02).         01930002
019600     05  OUT-THRES-LABOR-ADJ            PIC S9(07)V9(02).         01940002
019700     05  OUT-THRES-NON-LABOR-ADJ        PIC S9(07)V9(02).         01950002
019800     05  WK-3000-PEP-N-PRETOT-PAY       PIC S9(07)V9(02).         01960002
019900     05  WK-3000-PEP-N-PAYMENT          PIC S9(07)V9(02).         01970002
020000     05  WK-4000-PEP-Y-PRETOT-PAY       PIC S9(07)V9(02).         01980002
020100     05  WK-4000-PEP-Y-PAYMENT          PIC S9(07)V9(02).         01990002
020200     05  WK-5000-PEP-N-PRETOT-PAY       PIC S9(07)V9(02).         02000002
020300     05  WK-5000-PEP-N-PAYMENT          PIC S9(07)V9(02).         02010002
020400     05  WK-6000-PEP-Y-PRETOT-PAY       PIC S9(07)V9(02).         02020002
020500     05  WK-6000-PEP-Y-PAYMENT          PIC S9(07)V9(02).         02030002
020600     05  WK-6050-PEP-Y-TOT-DAYS         PIC S9(04).               02040002
020700     05  WK-7000-OUTLIER-VALUE-A        PIC S9(07)V9(02).         02050002
020800     05  WK-7000-AB-DIFF                PIC S9(07)V9(02).         02060002
020900     05  WK-7000-CALC                   PIC S9(07)V9(02).         02070002
021000     05  WK-8000-OUTLIER-VALUE-B        PIC S9(07)V9(02).         02080002
021100     05  WK-8000-OUTLIER-LAB-NLAB       PIC S9(07)V9(02).         02090002
021200                                                                  02100002
021300                                                                  02110002
021400                                                                  02120002
021500*******************************************************           02130002
021600 01  HOLD-HHA-DATA.                                               02140002
021700     05  H-HHA-INPUT-DATA.                                        02150002
021800         10  H-HHA-NPI                 PIC X(10).                 02160002
021900         10  H-HHA-HIC                 PIC X(12).                 02170002
022000         10  H-HHA-PROV-NO             PIC X(06).                 02180002
022100         10  H-HHA-TOB                 PIC XXX.                   02190002
022200         10  H-HHA-PEP-INDICATOR       PIC X.                     02200002
022300         10  H-HHA-PEP-DAYS            PIC 999.                   02210002
022400         10  H-HHA-INIT-PAY-INDICATOR  PIC X.                     02220002
022500         10  FILLER                    PIC X(07).                 02230002
022600         10  H-HHA-MSA1                PIC 9(07)V9(02).           02240002
022700         10  H-HHA-MSA2-DATA REDEFINES H-HHA-MSA1.                02250002
022800             15  FILLER             PIC XXX.                      02260002
022900             15  H-HHA-MSA2           PIC XXXX.                   02270002
023000             15  FILLER             PIC XX.                       02280002
023100         10  H-HHA-SERV-FROM-DATE.                                02290002
023200             15  H-HHA-FROM-CC         PIC XX.                    02300002
023300             15  H-HHA-FROM-YYMMDD.                               02310002
023400                 25  H-HHA-FROM-YY     PIC XX.                    02320002
023500                 25  H-HHA-FROM-MM     PIC XX.                    02330002
023600                 25  H-HHA-FROM-DD     PIC XX.                    02340002
023700         10  H-HHA-SERV-THRU-DATE.                                02350002
023800             15  H-HHA-THRU-CC         PIC XX.                    02360002
023900             15  H-HHA-THRU-YYMMDD.                               02370002
024000                 25  H-HHA-THRU-YY     PIC XX.                    02380002
024100                 25  H-HHA-THRU-MM     PIC XX.                    02390002
024200                 25  H-HHA-THRU-DD     PIC XX.                    02400002
024300         10  H-HHA-ADMIT-DATE.                                    02410002
024400             15  H-HHA-ADMIT-CC        PIC XX.                    02420002
024500             15  H-HHA-ADMIT-YYMMDD.                              02430002
024600                 25  H-HHA-ADMIT-YY    PIC XX.                    02440002
024700                 25  H-HHA-ADMIT-MM    PIC XX.                    02450002
024800                 25  H-HHA-ADMIT-DD    PIC XX.                    02460002
024900         10  H-HHA-HRG-DATA      OCCURS 6.                        02470002
025000             15  H-HHA-MED-REVIEW-INDICATOR PIC X.                02480002
025100             15  H-HHA-HRG-INPUT-CODE       PIC X(05).            02490002
025200             15  H-HHA-HRG-OUTPUT-CODE      PIC X(05).            02500002
025300             15  H-HHA-HRG-NO-OF-DAYS       PIC 9(03).            02510002
025400             15  H-HHA-HRG-WGTS             PIC 9(02)V9(04).      02520002
025500             15  H-HHA-HRG-PAY              PIC 9(07)V9(02).      02530002
025600         10  H-HHA-REVENUE-DATA     OCCURS 6.                     02540002
025700             15  H-HHA-REVENUE-CODE             PIC X(04).        02550014
025800             15  H-HHA-REVENUE-QTY-COV-VISITS   PIC 9(03).        02560014
025810             15  H-HHA-REVENUE-EARLIEST-DATE    PIC 9(08).        02561014
025900             15  H-HHA-REVENUE-DOLL-RATE        PIC 9(07)V9(02).  02570014
026000             15  H-HHA-REVENUE-COST             PIC 9(07)V9(02).  02580014
026010             15  H-HHA-REVENUE-ADD-ON-VISIT-AMT PIC 9(07)V9(02).  02582014
026100     05  H-HHA-PASSBACK-DATA.                                     02590002
026200         10  H-HHA-PAY-RTC                PIC 99.                 02600002
026300         10  H-HHA-REVENUE-SUM1-3-QTY-THR PIC 9(05).              02610002
026400         10  H-HHA-REVENUE-SUM1-6-QTY-ALL PIC 9(05).              02620002
026500         10  H-HHA-OUTLIER-PAYMENT        PIC 9(07)V9(02).        02630002
026600         10  H-HHA-TOTAL-PAYMENT          PIC 9(07)V9(02).        02640002
026700     05  H-HHA-CASE-MIX-DATA.                                     02650007
026800         10  H-HHA-LUPA-ADD-ON-PAYMENT    PIC 9(03)V9(02).        02650107
026900         10  H-HHA-LUPA-SRC-ADM           PIC X.                  02650207
027000         10  H-HHA-RECODE-IND             PIC X.                  02650307
027100         10  H-HHA-EPISODE-TIMING         PIC 9.                  02650407
027200         10  H-HHA-SEVERITY-POINTS.                               02650507
027300             15  H-HHA-CLINICAL-SEV-EQ1   PIC X(01).              02650607
027400             15  H-HHA-FUNCTION-SEV-EQ1   PIC X(01).              02650707
027500             15  H-HHA-CLINICAL-SEV-EQ2   PIC X(01).              02650807
027600             15  H-HHA-FUNCTION-SEV-EQ2   PIC X(01).              02650907
027700             15  H-HHA-CLINICAL-SEV-EQ3   PIC X(01).              02651007
027800             15  H-HHA-FUNCTION-SEV-EQ3   PIC X(01).              02651107
027900             15  H-HHA-CLINICAL-SEV-EQ4   PIC X(01).              02651207
028000             15  H-HHA-FUNCTION-SEV-EQ4   PIC X(01).              02651307
028100     05  H-HHA-PROV-TOTAL-DATA.                                   02651407
028200         10  H-HHA-PROV-OUTLIER-PAY-TOTAL PIC 9(08)V9(02).        02651507
028300         10  H-HHA-PROV-PAYMET-TOTAL      PIC 9(09)V9(02).        02651609
028400     05  FILLER                           PIC X(33).              02651709
028500**==================================================***           02651807
028600                                                                  02661002
028700***************************************************************   02670002
028800                                                                  02680002
028900 LINKAGE SECTION.                                                 02690002
029000***************************************************************   02700002
029100*                 * * * * * * * * *                           *   02710002
029200***************************************************************   02720002
029300***************************************************************   02730002
029400*    THIS DATA IS CALCULATED BY THIS HHAPR  SUBROUTINE        *   02740002
029500*    AND PASSED BACK TO THE CALLING PROGRAM                   *   02750002
029600***************************************************************   02760002
029700 01  HHA-INPUT-DATA.                                              02770002
029800     05  HHA-DATA.                                                02780002
029900         10  HHA-NPI                 PIC X(10).                   02790002
030000         10  HHA-HIC                 PIC X(12).                   02800002
030100         10  HHA-PROV-NO             PIC X(06).                   02810002
030200         10  HHA-TOB                 PIC XXX.                     02820002
030300         10  HHA-PEP-INDICATOR       PIC X.                       02830002
030400         10  HHA-PEP-DAYS            PIC 999.                     02840002
030500         10  HHA-INIT-PAY-INDICATOR  PIC X.                       02850002
030600         10  FILLER                  PIC X(07).                   02860002
030700         10  HHA-MSA1                PIC 9(07)V9(02).             02870002
030800         10  HHA-MSA2-DATA REDEFINES HHA-MSA1.                    02880002
030900             15  FILLER             PIC XXX.                      02890002
031000             15  HHA-MSA2.                                        02900002
031100                 25  HHA-MSA2-RURAL-1ST.                          02910002
031200                     88  HHA-MSA-RURAL-CHECK   VALUE '99'.        02920002
031300                     30  HHA-RURAL-MSA         PIC XX.            02930002
031400                 25  HHA-MSA2-RURAL-2ND        PIC XX.            02940002
031500             15  FILLER             PIC XX.                       02950002
031600         10  HHA-SERV-FROM-DATE.                                  02960002
031700             15  HHA-FROM-CC         PIC XX.                      02970002
031800             15  HHA-FROM-YYMMDD.                                 02980002
031900                 25  HHA-FROM-YY     PIC XX.                      02990002
032000                 25  HHA-FROM-MM     PIC XX.                      03000002
032100                 25  HHA-FROM-DD     PIC XX.                      03010002
032200         10  HHA-SERV-THRU-DATE.                                  03020002
032300             15  HHA-THRU-CC         PIC XX.                      03030002
032400             15  HHA-THRU-YYMMDD.                                 03040002
032500                 25  HHA-THRU-YY     PIC XX.                      03050002
032600                 25  HHA-THRU-MM     PIC XX.                      03060002
032700                 25  HHA-THRU-DD     PIC XX.                      03070002
032800         10  HHA-ADMIT-DATE.                                      03080002
032900             15  HHA-ADMIT-CC        PIC XX.                      03090002
033000             15  HHA-ADMIT-YYMMDD.                                03100002
033100                 25  HHA-ADMIT-YY    PIC XX.                      03110002
033200                 25  HHA-ADMIT-MM    PIC XX.                      03120002
033300                 25  HHA-ADMIT-DD    PIC XX.                      03130002
033400         10  HHA-HRG-DATA      OCCURS 6.                          03140002
033500             15  HHA-MED-REVIEW-INDICATOR PIC X.                  03150002
033600             15  HHA-HRG-INPUT-CODE       PIC X(05).              03160002
033700             15  HHA-HRG-OUTPUT-CODE      PIC X(05).              03170002
033800             15  HHA-HRG-NO-OF-DAYS       PIC 9(03).              03180002
033900             15  HHA-HRG-WGTS             PIC 9(02)V9(04).        03190002
034000             15  HHA-HRG-PAY              PIC 9(07)V9(02).        03200002
034100         10  HHA-REVENUE-DATA     OCCURS 6.                       03210002
034200             15  HHA-REVENUE-CODE       PIC X(04).                03220002
034300             15  HHA-REVENUE-QTY-COV-VISITS   PIC 9(03).          03230014
034310             15  HHA-REVENUE-EARLIEST-DATE    PIC 9(08).          03231014
034400             15  HHA-REVENUE-DOLL-RATE        PIC 9(07)V9(02).    03240014
034500             15  HHA-REVENUE-COST             PIC 9(07)V9(02).    03250014
034510             15  HHA-REVENUE-ADD-ON-VISIT-AMT PIC 9(07)V9(02).    03252014
034600     05  HHA-PASSBACK-DATA.                                       03260002
034700         10  HHA-PAY-RTC                PIC 99.                   03270002
034800         10  HHA-REVENUE-SUM1-3-QTY-THR PIC 9(05).                03280002
034900         10  HHA-REVENUE-SUM1-6-QTY-ALL PIC 9(05).                03290002
035000         10  HHA-OUTLIER-PAYMENT        PIC 9(07)V9(02).          03300002
035100         10  HHA-TOTAL-PAYMENT          PIC 9(07)V9(02).          03310002
035200     05  HHA-CASE-MIX-DATA.                                       03311007
035300         10  HHA-LUPA-ADD-ON-PAYMENT    PIC 9(03)V9(02).          03312007
035400         10  HHA-LUPA-SRC-ADM           PIC X.                    03313007
035500         10  HHA-RECODE-IND             PIC X.                    03314007
035600         10  HHA-EPISODE-TIMING         PIC 9.                    03315007
035700         10  HHA-SEVERITY-POINTS.                                 03316007
035800             15  HHA-CLINICAL-SEV-EQ1   PIC X(01).                03317007
035900             15  HHA-FUNCTION-SEV-EQ1   PIC X(01).                03318007
036000             15  HHA-CLINICAL-SEV-EQ2   PIC X(01).                03319007
036100             15  HHA-FUNCTION-SEV-EQ2   PIC X(01).                03319107
036200             15  HHA-CLINICAL-SEV-EQ3   PIC X(01).                03319207
036300             15  HHA-FUNCTION-SEV-EQ3   PIC X(01).                03319307
036400             15  HHA-CLINICAL-SEV-EQ4   PIC X(01).                03319407
036500             15  HHA-FUNCTION-SEV-EQ4   PIC X(01).                03319507
036600     05  HHA-PROV-TOTAL-DATA.                                     03319607
036700         10  HHA-PROV-OUTLIER-PAY-TOTAL PIC 9(08)V9(02).          03319707
036800         10  HHA-PROV-PAYMET-TOTAL      PIC 9(09)V9(02).          03319809
036900     05  FILLER                         PIC X(33).                03319909
037000**==================================================***           03320007
037100*    05  FILLER                         PIC X(20).                03321007
037200**==================================================***           03322007
037300                                                                  03330002
037400 01  HOLD-VARIABLES-DATA.                                         03340002
037500     02  HOLD-VAR-DATA.                                           03350002
037600         05  PRICER-OPTION-SW                   PIC X(01).        03360002
037700         05  HHDRV-VERSION                      PIC X(07).        03370002
037800         05  HHCAL-VERSION                      PIC X(07).        03380002
037900         05  FILLER                             PIC X(20).        03390002
038000                                                                  03400002
038100 01  WAGE-INDEX-DATA.                                             03410002
038200     02  HOLD-WIR-DATA.                                           03420002
038300         05  WIR-MSA                        PIC X(04).            03430002
038400         05  WIR-EFFDATE                    PIC X(08).            03440002
038500         05  WIR-AREA-WAGEIND               PIC 9(02)V9(04).      03450002
038600                                                                  03460002
038700 PROCEDURE DIVISION  USING HHA-INPUT-DATA                         03470002
038800                           HOLD-VARIABLES-DATA                    03480002
038900                           WAGE-INDEX-DATA.                       03490002
039000                                                                  03500002
039100***************************************************************   03510002
039200*    PROCESSING:                                              *   03520002
039300*        A. WILL PROCESS NATIONAL HHA FOR FY 2004             *   03530002
039400*                STARTING OCT 1, 2003                         *   03540002
039500***************************************************************   03550002
039600                                                                  03560002
039700     MOVE CAL-VERSION TO HHCAL-VERSION.                           03570002
039800                                                                  03580002
039900     PERFORM 200-MAINLINE-CONTROL THRU 200-EXIT.                  03590002
040000                                                                  03600002
040100     MOVE HOLD-HHA-DATA TO HHA-INPUT-DATA.                        03610002
040200                                                                  03620002
040300     GOBACK.                                                      03630002
040400                                                                  03640002
040500 200-MAINLINE-CONTROL.                                            03650002
040600                                                                  03660002
040700     MOVE HHA-INPUT-DATA TO HOLD-HHA-DATA.                        03670002
040800                                                                  03680002
040900     MOVE ALL '0' TO                                              03690002
041000                     WK-ALL-TOTALS                                03700002
041100                     WK-HRG-NO-OF-DAYS                            03710002
041200                     WK-HRG-NO-OF-DAYS-TOT                        03720002
041300                     WK-RTC-ADJ-IND                               03730002
041400                     WK-PEP-DAYS                                  03740002
041500                     H-HHA-PASSBACK-DATA                          03750002
041600                     H-HHA-HRG-PAY (1)                            03760002
041700                     H-HHA-HRG-PAY (2)                            03770002
041800                     H-HHA-HRG-PAY (3)                            03780002
041900                     H-HHA-HRG-PAY (4)                            03790002
042000                     H-HHA-HRG-PAY (5)                            03800002
042100                     H-HHA-HRG-PAY (6)                            03810002
042200                     H-HHA-REVENUE-COST (1)                       03820002
042300                     H-HHA-REVENUE-COST (2)                       03830002
042400                     H-HHA-REVENUE-COST (3)                       03840002
042500                     H-HHA-REVENUE-COST (4)                       03850002
042600                     H-HHA-REVENUE-COST (5)                       03860002
042700                     H-HHA-REVENUE-COST (6).                      03870002
042800                                                                  03880002
042900     IF  H-HHA-PAY-RTC = 00                                       03890002
043000         PERFORM 400-CALC-THE-HHA THRU 400-EXIT.                  03900002
043100                                                                  03910002
043200 200-EXIT.   EXIT.                                                03920002
043300                                                                  03930002
043400 400-CALC-THE-HHA.                                                03940002
043500                                                                  03950002
043600     IF H-HHA-SERV-THRU-DATE < 20031001                           03960002
043700         MOVE '40' TO H-HHA-PAY-RTC                               03970002
043800         GO TO 400-EXIT.                                          03980002
043900                                                                  03990002
044000     IF H-HHA-ADMIT-DATE >                                        04000002
044100        H-HHA-SERV-FROM-DATE                                      04010002
044200         MOVE '40' TO H-HHA-PAY-RTC                               04020002
044300         GO TO 400-EXIT.                                          04030002
044400                                                                  04040002
044500     IF ((H-HHA-TOB = '332' OR '322') AND                         04050002
044600        (H-HHA-HRG-INPUT-CODE (1) = SPACE))                       04060002
044700        MOVE '70' TO H-HHA-PAY-RTC                                04070002
044800        GO TO 400-EXIT.                                           04080002
044900                                                                  04090002
045000     IF ((H-HHA-TOB = '329' OR '339' OR '327' OR '337' OR         04100002
045010                      '32Q' OR '33Q' OR
045100                      '32G' OR '33G' OR '32I' OR '33I' OR         04110002
045200                      '32F' OR '32K' OR '32P' OR '32H' OR         04120002
045300                      '33F' OR '33K' OR '33P' OR '33H' OR         04130002
045400                      '32J' OR '33J' OR '32M' OR '33M') AND       04140002
045500         (H-HHA-REVENUE-SUM1-6-QTY-ALL > 4 ) AND                  04150002
045600         (H-HHA-HRG-INPUT-CODE (1) = SPACE))                      04160002
045700        MOVE '75' TO H-HHA-PAY-RTC                                04170002
045800        GO TO 400-EXIT.                                           04180002
045900                                                                  04190002
046000     IF ((H-HHA-TOB = '329' OR '339' OR '327' OR '337' OR         04200002
046010                      '32Q' OR '33Q' OR
046100                      '32G' OR '33G' OR '32I' OR '33I' OR         04210002
046200                      '32F' OR '32K' OR '32P' OR '32H' OR         04220002
046300                      '33F' OR '33K' OR '33P' OR '33H' OR         04230002
046400                      '32J' OR '33J' OR '32M' OR '33M') AND       04240002
046500         (H-HHA-REVENUE-CODE (1) = SPACE))                        04250002
046600        MOVE '85' TO H-HHA-PAY-RTC                                04260002
046700        GO TO 400-EXIT.                                           04270002
046800                                                                  04280002
046900     IF ((H-HHA-TOB = '329' OR '339' OR '327' OR '337' OR         04290002
046910                      '32Q' OR '33Q' OR
047000                      '32G' OR '33G' OR '32I' OR '33I' OR         04300002
047100                      '32F' OR '32K' OR '32P' OR '32H' OR         04310002
047200                      '33F' OR '33K' OR '33P' OR '33H' OR         04320002
047300                      '32J' OR '33J' OR '32M' OR '33M') AND       04330002
047400         (H-HHA-HRG-INPUT-CODE (2) NOT = SPACES) AND              04340002
047500         (H-HHA-PEP-INDICATOR = 'Y') AND                          04350002
047600         (H-HHA-PEP-DAYS NOT NUMERIC OR                           04360002
047700          H-HHA-PEP-DAYS = ZEROES))                               04370002
047800        MOVE '15' TO H-HHA-PAY-RTC                                04380002
047900        GO TO 400-EXIT.                                           04390002
048000                                                                  04400002
048100     IF H-HHA-PAY-RTC NOT = 00 GO TO 400-EXIT.                    04410002
048200                                                                  04420002
048300***************************************************************   04430002
048400***************************************************************   04440002
048500*        THESE RATES & THRESHOLDS ARE APPLIED                 *   04450002
048600* FOR NON-RURAL AND  RURAL                                    *   04460002
048700*                                                             *   04470002
048800     MOVE 02230.65 TO   FED-EPISODE-RATE-AMT                      04480002
048900     MOVE 02520.64 TO   OUTLIER-THRESHOLD-AMT.                    04490002
049000                                                                  04500003
049100     IF HHA-SERV-THRU-DATE > 20040331                             04510003
049200        MOVE 02213.37 TO   FED-EPISODE-RATE-AMT                   04520003
049300        MOVE 02501.11 TO   OUTLIER-THRESHOLD-AMT                  04530003
049400        IF HHA-MSA-RURAL-CHECK                                    04540003
049500           MOVE 02324.04 TO   FED-EPISODE-RATE-AMT                04550003
049600           MOVE 02626.17 TO   OUTLIER-THRESHOLD-AMT.              04560003
049700                                                                  04570003
049800***************************************************************   04580002
049900***************************************************************   04590002
050000                                                                  04600002
050100     IF H-HHA-TOB = '322' OR '332'                                04610002
050200        PERFORM 500-INITIAL-PAYMENT THRU 500-EXIT                 04620002
050300        GO TO 400-EXIT.                                           04630002
050400                                                                  04640002
050500     IF H-HHA-TOB = '329' OR '339' OR '327' OR '337' OR           04650002
050510                    '32Q' OR '33Q' OR
050600                    '32G' OR '33G' OR '32I' OR '33I' OR           04660002
050700                    '32F' OR '32K' OR '32P' OR '32H' OR           04670002
050800                    '33F' OR '33K' OR '33P' OR '33H' OR           04680002
050900                    '32J' OR '33J' OR '32M' OR '33M'              04690002
051000        PERFORM 1000-FINAL-PAYMENT THRU 1000-EXIT                 04700002
051100        GO TO 400-EXIT.                                           04710002
051200                                                                  04720002
051300     MOVE '10' TO H-HHA-PAY-RTC.                                  04730002
051400                                                                  04740002
051500                                                                  04750002
051600 400-EXIT.   EXIT.                                                04760002
051700                                                                  04770002
051800 500-INITIAL-PAYMENT.                                             04780002
051900                                                                  04790002
052000***************************************************************   04800002
052100*            TOB = 322 OR 332 INITIAL PAYMENT                     04810002
052200***************************************************************   04820002
052300                                                                  04830002
052400     IF  H-HHA-INIT-PAY-INDICATOR  = '1' OR '0'                   04840002
052500         NEXT SENTENCE                                            04850002
052600     ELSE                                                         04860002
052700         MOVE '35' TO H-HHA-PAY-RTC                               04870002
052800         GO TO 500-EXIT.                                          04880002
052900                                                                  04890002
053000     IF  H-HHA-INIT-PAY-INDICATOR  = '1'                          04900002
053100         MOVE '03' TO H-HHA-PAY-RTC                               04910002
053200         GO TO 500-EXIT.                                          04920002
053300                                                                  04930002
053400     COMPUTE FED-ADJ ROUNDED =                                    04940002
053500               H-HHA-HRG-WGTS (1) * FED-EPISODE-RATE-AMT.         04950002
053600                                                                  04960002
053700     COMPUTE FED-LABOR-ADJ ROUNDED =                              04970002
053800             WIR-AREA-WAGEIND *                                   04980002
053900             LABOR-PERCENT *                                      04990002
054000             FED-ADJ.                                             05000002
054100                                                                  05010002
054200     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          05020002
054300               NONLABOR-PERCENT * FED-ADJ.                        05030002
054400                                                                  05040002
054500     IF H-HHA-SERV-FROM-DATE = H-HHA-ADMIT-DATE                   05050002
054600        COMPUTE H-HHA-TOTAL-PAYMENT ROUNDED =                     05060002
054700                 (FED-LABOR-ADJ + FED-NON-LABOR-ADJ) * .6         05070002
054800        MOVE H-HHA-TOTAL-PAYMENT TO H-HHA-HRG-PAY (1)             05080002
054900        MOVE '05' TO H-HHA-PAY-RTC                                05090002
055000     ELSE                                                         05100002
055100        COMPUTE H-HHA-TOTAL-PAYMENT ROUNDED =                     05110002
055200                 (FED-LABOR-ADJ + FED-NON-LABOR-ADJ) * .5         05120002
055300        MOVE H-HHA-TOTAL-PAYMENT TO H-HHA-HRG-PAY (1)             05130002
055400        MOVE '04' TO H-HHA-PAY-RTC.                               05140002
055500                                                                  05150002
055600 500-EXIT.   EXIT.                                                05160002
055700                                                                  05170002
055800 1000-FINAL-PAYMENT.                                              05180002
055900                                                                  05190002
056000     IF H-HHA-REVENUE-QTY-COV-VISITS (1) NOT NUMERIC              05200002
056100        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (1).          05210002
056200     IF H-HHA-REVENUE-QTY-COV-VISITS (2) NOT NUMERIC              05220002
056300        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (2).          05230002
056400     IF H-HHA-REVENUE-QTY-COV-VISITS (3) NOT NUMERIC              05240002
056500        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (3).          05250002
056600     IF H-HHA-REVENUE-QTY-COV-VISITS (4) NOT NUMERIC              05260002
056700        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (4).          05270002
056800     IF H-HHA-REVENUE-QTY-COV-VISITS (5) NOT NUMERIC              05280002
056900        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (5).          05290002
057000     IF H-HHA-REVENUE-QTY-COV-VISITS (6) NOT NUMERIC              05300002
057100        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (6).          05310002
057200                                                                  05320002
057300     COMPUTE H-HHA-REVENUE-SUM1-3-QTY-THR ROUNDED =               05330002
057400             H-HHA-REVENUE-QTY-COV-VISITS (1) +                   05340002
057500             H-HHA-REVENUE-QTY-COV-VISITS (2) +                   05350002
057600             H-HHA-REVENUE-QTY-COV-VISITS (3).                    05360002
057700     COMPUTE H-HHA-REVENUE-SUM1-6-QTY-ALL ROUNDED =               05370002
057800             H-HHA-REVENUE-QTY-COV-VISITS (1) +                   05380002
057900             H-HHA-REVENUE-QTY-COV-VISITS (2) +                   05390002
058000             H-HHA-REVENUE-QTY-COV-VISITS (3) +                   05400002
058100             H-HHA-REVENUE-QTY-COV-VISITS (4) +                   05410002
058200             H-HHA-REVENUE-QTY-COV-VISITS (5) +                   05420002
058300             H-HHA-REVENUE-QTY-COV-VISITS (6).                    05430002
058400                                                                  05440002
058500     IF H-HHA-REVENUE-SUM1-6-QTY-ALL < 5                          05450002
058600        PERFORM 1050-LUPA THRU 1050-EXIT                          05460002
058700            VARYING SUB1 FROM 1 BY 1 UNTIL                        05470002
058800***         (H-HHA-REVENUE-CODE (SUB1) = SPACES OR                05480002
058900             SUB1 > 6                                             05490002
059000        MOVE '06' TO H-HHA-PAY-RTC                                05500002
059100        COMPUTE H-HHA-TOTAL-PAYMENT   ROUNDED =                   05510002
059200                H-HHA-REVENUE-COST (1) +                          05520002
059300                H-HHA-REVENUE-COST (2) +                          05530002
059400                H-HHA-REVENUE-COST (3) +                          05540002
059500                H-HHA-REVENUE-COST (4) +                          05550002
059600                H-HHA-REVENUE-COST (5) +                          05560002
059700                H-HHA-REVENUE-COST (6)                            05570002
059800        GO TO 1000-EXIT.                                          05580002
059900                                                                  05590002
060000     IF (H-HHA-PEP-INDICATOR NOT = 'Y' AND NOT = 'N')             05600002
060100         MOVE '20' TO H-HHA-PAY-RTC                               05610002
060200         GO TO 1000-EXIT.                                         05620002
060300                                                                  05630002
060400      PERFORM 1100-ADD-HRG-DAYS THRU 1100-EXIT                    05640002
060500         VARYING CO1 FROM 1 BY 1 UNTIL CO1 > 6.                   05650002
060600                                                                  05660002
060700      IF WK-HRG-NO-OF-DAYS-TOT > 60                               05670002
060800         MOVE '16' TO H-HHA-PAY-RTC                               05680002
060900         GO TO 1000-EXIT.                                         05690002
061000                                                                  05700002
061100                                                                  05710002
061200*********  HRG  PAYMENT   *******************                     05720002
061300                                                                  05730002
061400***  IF H-HHA-REVENUE-SUM1-3-QTY-THR > 9                          05740002
061500        IF H-HHA-HRG-INPUT-CODE (2) = SPACES                      05750002
061600           IF H-HHA-PEP-INDICATOR = 'N'                           05760002
061700              PERFORM 3000-PEP-N-ADJUST THRU 3000-EXIT            05770002
061800                  VARYING CO1 FROM 1 BY 1 UNTIL                   05780002
061900*                 (H-HHA-HRG-INPUT-CODE (CO1) = SPACES OR         05790002
062000                   CO1 > 6                                        05800002
062100               PERFORM 7000-OUTLIER-PAYMENT THRU 7000-EXIT        05810002
062200               GO TO 1000-EXIT.                                   05820002
062300                                                                  05830002
062400                                                                  05840002
062500***  IF H-HHA-REVENUE-SUM1-3-QTY-THR > 9                          05850002
062600        IF H-HHA-HRG-INPUT-CODE (2) = SPACES                      05860002
062700           IF H-HHA-PEP-INDICATOR = 'Y'                           05870002
062800              PERFORM 4000-PEP-Y-ADJUST THRU 4000-EXIT            05880002
062900                  VARYING CO1 FROM 1 BY 1 UNTIL                   05890002
063000*                 (H-HHA-HRG-INPUT-CODE (CO1) = SPACES OR         05900002
063100                   CO1 > 6                                        05910002
063200               PERFORM 7000-OUTLIER-PAYMENT THRU 7000-EXIT        05920002
063300               GO TO 1000-EXIT.                                   05930002
063400                                                                  05940002
063500**** IF H-HHA-REVENUE-SUM1-3-QTY-THR > 9                          05950002
063600        IF H-HHA-HRG-INPUT-CODE (2) NOT = SPACES                  05960002
063700           IF H-HHA-PEP-INDICATOR = 'N'                           05970002
063800              PERFORM 5000-PEP-N-ADJUST THRU 5000-EXIT            05980002
063900                  VARYING CO1 FROM 1 BY 1 UNTIL                   05990002
064000*                 (H-HHA-HRG-INPUT-CODE (CO1) = SPACES OR         06000002
064100                   CO1 > 6                                        06010002
064200               PERFORM 7000-OUTLIER-PAYMENT THRU 7000-EXIT        06020002
064300               GO TO 1000-EXIT.                                   06030002
064400                                                                  06040002
064500**** IF H-HHA-REVENUE-SUM1-3-QTY-THR > 9                          06050002
064600        IF H-HHA-HRG-INPUT-CODE (2) NOT = SPACES                  06060002
064700           IF H-HHA-PEP-INDICATOR = 'Y'                           06070002
064800              PERFORM 6000-PEP-Y-ADJUST THRU 6000-EXIT            06080002
064900                  VARYING CO1 FROM 1 BY 1 UNTIL                   06090002
065000*                 (H-HHA-HRG-INPUT-CODE (CO1) = SPACES OR         06100002
065100                   CO1 > 6                                        06110002
065200               PERFORM 7000-OUTLIER-PAYMENT THRU 7000-EXIT        06120002
065300               GO TO 1000-EXIT.                                   06130002
065400                                                                  06140002
065500                                                                  06150002
065600      MOVE '20' TO H-HHA-PAY-RTC.                                 06160002
065700                                                                  06170002
065800 1000-EXIT.  EXIT.                                                06180002
065900 1050-LUPA.                                                       06190002
066000                                                                  06200002
066100***************************************************************   06210002
066200*                    LUPA PAYMENT                                 06220002
066300***************************************************************   06230002
066400                                                                  06240002
066500     IF H-HHA-REVENUE-CODE (SUB1) = SPACES                        06250002
066600        MOVE 6 TO SUB1                                            06260002
066700        GO TO 1050-EXIT.                                          06270002
066800                                                                  06280002
066900     COMPUTE FED-ADJ ROUNDED =                                    06290002
067000             H-HHA-REVENUE-QTY-COV-VISITS (SUB1) *                06300002
067100             H-HHA-REVENUE-DOLL-RATE (SUB1).                      06310002
067200                                                                  06320002
067300     COMPUTE FED-LABOR-ADJ ROUNDED =                              06330002
067400             WIR-AREA-WAGEIND *                                   06340002
067500             LABOR-PERCENT *                                      06350002
067600             FED-ADJ.                                             06360002
067700                                                                  06370002
067800     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          06380002
067900             NONLABOR-PERCENT *                                   06390002
068000             FED-ADJ.                                             06400002
068100                                                                  06410002
068200     COMPUTE H-HHA-REVENUE-COST (SUB1) ROUNDED =                  06420002
068300             (FED-LABOR-ADJ + FED-NON-LABOR-ADJ).                 06430002
068400                                                                  06440002
068500 1050-EXIT.   EXIT.                                               06450002
068600                                                                  06460002
068700 1100-ADD-HRG-DAYS.                                               06470002
068800                                                                  06480002
068900      IF H-HHA-HRG-NO-OF-DAYS (CO1) NUMERIC                       06490002
069000         ADD H-HHA-HRG-NO-OF-DAYS (CO1) TO                        06500002
069100             WK-HRG-NO-OF-DAYS-TOT.                               06510002
069200                                                                  06520002
069300 1100-EXIT.   EXIT.                                               06530002
069400                                                                  06540002
069500 3000-PEP-N-ADJUST.                                               06550002
069600                                                                  06560002
069700***************************************************************   06570002
069800*           HRG OCCUR < 2 AND PEP = N ADJUSTMENT                  06580002
069900***************************************************************   06590002
070000                                                                  06600002
070100     IF H-HHA-HRG-INPUT-CODE (CO1) = SPACES                       06610002
070200        MOVE 6 TO SUB1                                            06620002
070300        GO TO 3000-EXIT.                                          06630002
070400                                                                  06640002
070500     MOVE H-HHA-HRG-NO-OF-DAYS (CO1) TO WK-HRG-NO-OF-DAYS.        06650002
070600                                                                  06660002
070700     COMPUTE FED-ADJ ROUNDED =                                    06670002
070800               (WK-HRG-NO-OF-DAYS  *                              06680002
070900                H-HHA-HRG-WGTS (CO1) *                            06690002
071000                FED-EPISODE-RATE-AMT) / 60.                       06700002
071100                                                                  06710002
071200     COMPUTE FED-LABOR-ADJ ROUNDED =                              06720002
071300               WIR-AREA-WAGEIND *                                 06730002
071400               LABOR-PERCENT * FED-ADJ.                           06740002
071500                                                                  06750002
071600     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          06760002
071700               NONLABOR-PERCENT * FED-ADJ.                        06770002
071800                                                                  06780002
071900     COMPUTE WK-3000-PEP-N-PAYMENT ROUNDED =                      06790002
072000              (FED-LABOR-ADJ + FED-NON-LABOR-ADJ).                06800002
072100                                                                  06810002
072200     COMPUTE H-HHA-HRG-PAY (CO1) ROUNDED =                        06820002
072300             WK-3000-PEP-N-PAYMENT.                               06830002
072400                                                                  06840002
072500     COMPUTE WK-3000-PEP-N-PRETOT-PAY ROUNDED =                   06850002
072600             WK-3000-PEP-N-PRETOT-PAY + WK-3000-PEP-N-PAYMENT.    06860002
072700                                                                  06870002
072800                                                                  06880002
072900 3000-EXIT.   EXIT.                                               06890002
073000                                                                  06900002
073100 4000-PEP-Y-ADJUST.                                               06910002
073200                                                                  06920002
073300***************************************************************   06930002
073400*           HRG OCCUR < 2 AND PEP = Y ADJUSTMENT                  06940002
073500***************************************************************   06950002
073600                                                                  06960002
073700     IF H-HHA-HRG-INPUT-CODE (CO1) = SPACES                       06970002
073800        MOVE 6 TO SUB1                                            06980002
073900        GO TO 4000-EXIT.                                          06990002
074000                                                                  07000002
074100     MOVE 2 TO WK-RTC-ADJ-IND.                                    07010002
074200                                                                  07020002
074300     MOVE H-HHA-HRG-NO-OF-DAYS (CO1) TO WK-HRG-NO-OF-DAYS.        07030002
074400                                                                  07040002
074500     COMPUTE FED-ADJ ROUNDED =                                    07050002
074600               (WK-HRG-NO-OF-DAYS  *                              07060002
074700                H-HHA-HRG-WGTS (CO1) *                            07070002
074800                FED-EPISODE-RATE-AMT) / 60.                       07080002
074900                                                                  07090002
075000     COMPUTE FED-LABOR-ADJ ROUNDED =                              07100002
075100               WIR-AREA-WAGEIND *                                 07110002
075200               LABOR-PERCENT * FED-ADJ.                           07120002
075300                                                                  07130002
075400     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          07140002
075500               NONLABOR-PERCENT * FED-ADJ.                        07150002
075600                                                                  07160002
075700     COMPUTE WK-4000-PEP-Y-PAYMENT ROUNDED =                      07170002
075800              (FED-LABOR-ADJ + FED-NON-LABOR-ADJ).                07180002
075900                                                                  07190002
076000     COMPUTE H-HHA-HRG-PAY (CO1) ROUNDED =                        07200002
076100             WK-4000-PEP-Y-PAYMENT.                               07210002
076200                                                                  07220002
076300     COMPUTE WK-4000-PEP-Y-PRETOT-PAY ROUNDED =                   07230002
076400             WK-4000-PEP-Y-PRETOT-PAY + WK-4000-PEP-Y-PAYMENT.    07240002
076500                                                                  07250002
076600                                                                  07260002
076700 4000-EXIT.   EXIT.                                               07270002
076800 5000-PEP-N-ADJUST.                                               07280002
076900                                                                  07290002
077000***************************************************************   07300002
077100*           HRG OCCUR > 1 AND PEP = N ADJUSTMENT                  07310002
077200***************************************************************   07320002
077300                                                                  07330002
077400     IF H-HHA-HRG-INPUT-CODE (CO1) = SPACES                       07340002
077500        MOVE 6 TO SUB1                                            07350002
077600        GO TO 5000-EXIT.                                          07360002
077700                                                                  07370002
077800     MOVE 1 TO WK-RTC-ADJ-IND.                                    07380002
077900                                                                  07390002
078000     MOVE H-HHA-HRG-NO-OF-DAYS (CO1) TO WK-HRG-NO-OF-DAYS.        07400002
078100                                                                  07410002
078200     COMPUTE FED-ADJ ROUNDED =                                    07420002
078300               (WK-HRG-NO-OF-DAYS  *                              07430002
078400                H-HHA-HRG-WGTS (CO1) *                            07440002
078500                FED-EPISODE-RATE-AMT) / 60.                       07450002
078600                                                                  07460002
078700     COMPUTE FED-LABOR-ADJ ROUNDED =                              07470002
078800               WIR-AREA-WAGEIND *                                 07480002
078900               LABOR-PERCENT * FED-ADJ.                           07490002
079000                                                                  07500002
079100     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          07510002
079200               NONLABOR-PERCENT * FED-ADJ.                        07520002
079300                                                                  07530002
079400     COMPUTE WK-5000-PEP-N-PAYMENT ROUNDED =                      07540002
079500              (FED-LABOR-ADJ + FED-NON-LABOR-ADJ).                07550002
079600                                                                  07560002
079700     COMPUTE H-HHA-HRG-PAY (CO1) ROUNDED =                        07570002
079800             WK-5000-PEP-N-PAYMENT.                               07580002
079900                                                                  07590002
080000                                                                  07600002
080100     COMPUTE WK-5000-PEP-N-PRETOT-PAY ROUNDED =                   07610002
080200             WK-5000-PEP-N-PRETOT-PAY + WK-5000-PEP-N-PAYMENT.    07620002
080300                                                                  07630002
080400                                                                  07640002
080500 5000-EXIT.   EXIT.                                               07650002
080600 6000-PEP-Y-ADJUST.                                               07660002
080700                                                                  07670002
080800***************************************************************   07680002
080900*           HRG OCCUR > 1 AND PEP = Y SHORTENED EPISODE           07690002
081000***************************************************************   07700002
081100                                                                  07710002
081200     IF H-HHA-HRG-INPUT-CODE (CO1) = SPACES                       07720002
081300        MOVE 6 TO SUB1                                            07730002
081400        GO TO 6000-EXIT.                                          07740002
081500                                                                  07750002
081600     MOVE 3 TO WK-RTC-ADJ-IND.                                    07760002
081700                                                                  07770002
081800     MOVE H-HHA-HRG-NO-OF-DAYS (CO1) TO WK-HRG-NO-OF-DAYS.        07780002
081900     MOVE H-HHA-PEP-DAYS             TO WK-PEP-DAYS.              07790002
082000                                                                  07800002
082100*    COMPUTE FED-ADJ ROUNDED =                                    07810002
082200*        (WK-HRG-NO-OF-DAYS / WK-PEP-DAYS)                        07820002
082300*                                *                                07830002
082400*                    ((WK-PEP-DAYS / 60)                          07840002
082500*                                *                                07850002
082600*          (H-HHA-HRG-WGTS (CO1) * FED-EPISODE-RATE-AMT)).        07860002
082700*                                                                 07870002
082800                                                                  07880002
082900*    COMPUTE FED-ADJ ROUNDED =                                    07890002
083000*        (WK-HRG-NO-OF-DAYS / WK-PEP-DAYS)                        07900002
083100*                                *                                07910002
083200*      ((WK-PEP-DAYS * H-HHA-HRG-WGTS (CO1) *                     07920002
083300*                          FED-EPISODE-RATE-AMT) / 60).           07930002
083400                                                                  07940002
083500     COMPUTE FED-ADJ1 ROUNDED =                                   07950002
083600      ((WK-PEP-DAYS * H-HHA-HRG-WGTS (CO1) *                      07960002
083700                           FED-EPISODE-RATE-AMT) / 60).           07970002
083800                                                                  07980002
083900     COMPUTE FED-ADJ ROUNDED  =                                   07990002
084000                  (FED-ADJ1 * WK-HRG-NO-OF-DAYS) / WK-PEP-DAYS.   08000002
084100                                                                  08010002
084200     COMPUTE FED-LABOR-ADJ ROUNDED =                              08020002
084300               WIR-AREA-WAGEIND *                                 08030002
084400               LABOR-PERCENT * FED-ADJ.                           08040002
084500                                                                  08050002
084600     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          08060002
084700               NONLABOR-PERCENT * FED-ADJ.                        08070002
084800                                                                  08080002
084900     COMPUTE WK-6000-PEP-Y-PAYMENT ROUNDED =                      08090002
085000              (FED-LABOR-ADJ + FED-NON-LABOR-ADJ).                08100002
085100                                                                  08110002
085200     COMPUTE H-HHA-HRG-PAY (CO1) ROUNDED =                        08120002
085300             WK-6000-PEP-Y-PAYMENT.                               08130002
085400                                                                  08140002
085500     COMPUTE WK-6000-PEP-Y-PRETOT-PAY ROUNDED =                   08150002
085600             WK-6000-PEP-Y-PRETOT-PAY + WK-6000-PEP-Y-PAYMENT.    08160002
085700                                                                  08170002
085800                                                                  08180002
085900 6000-EXIT.   EXIT.                                               08190002
086000                                                                  08200002
086100 7000-OUTLIER-PAYMENT.                                            08210002
086200                                                                  08220002
086300***************************************************************   08230002
086400*                    OUTLIER PAYMENT                              08240002
086500***************************************************************   08250002
086600     COMPUTE OUT-THRES-LABOR-ADJ ROUNDED =                        08260002
086700               WIR-AREA-WAGEIND *                                 08270002
086800               LABOR-PERCENT * OUTLIER-THRESHOLD-AMT.             08280002
086900                                                                  08290002
087000     COMPUTE OUT-THRES-NON-LABOR-ADJ ROUNDED =                    08300002
087100               NONLABOR-PERCENT * OUTLIER-THRESHOLD-AMT.          08310002
087200                                                                  08320002
087300     COMPUTE OUT-THRES-AMT-ADJ ROUNDED  =                         08330002
087400             (OUT-THRES-LABOR-ADJ +                               08340002
087500              OUT-THRES-NON-LABOR-ADJ).                           08350002
087600                                                                  08360002
087700      COMPUTE WK-7000-OUTLIER-VALUE-A ROUNDED =                   08370002
087800              OUT-THRES-AMT-ADJ +                                 08380002
087900             WK-3000-PEP-N-PRETOT-PAY +                           08390002
088000             WK-4000-PEP-Y-PRETOT-PAY +                           08400002
088100             WK-5000-PEP-N-PRETOT-PAY +                           08410002
088200             WK-6000-PEP-Y-PRETOT-PAY.                            08420002
088300                                                                  08430002
088400      PERFORM 8000-ADD-REV-DOLL THRU 8000-EXIT                    08440002
088500                  VARYING CO1 FROM 1 BY 1 UNTIL                   08450002
088600                   CO1 > 6.                                       08460002
088700                                                                  08470002
088800      COMPUTE WK-7000-AB-DIFF ROUNDED =                           08480002
088900              WK-8000-OUTLIER-VALUE-B - WK-7000-OUTLIER-VALUE-A.  08490002
089000                                                                  08500002
089100      IF WK-7000-AB-DIFF > ZERO                                   08510002
089200         COMPUTE WK-7000-CALC ROUNDED =                           08520002
089300               OUTL-LOSS-SHAR-RATIO-PERCENT * WK-7000-AB-DIFF     08530002
089400         COMPUTE H-HHA-OUTLIER-PAYMENT ROUNDED =                  08540002
089500               WK-7000-CALC                                       08550002
089600         COMPUTE H-HHA-TOTAL-PAYMENT ROUNDED =                    08560002
089700                (WK-7000-CALC +                                   08570002
089800                 WK-3000-PEP-N-PRETOT-PAY +                       08580002
089900                 WK-4000-PEP-Y-PRETOT-PAY +                       08590002
090000                 WK-5000-PEP-N-PRETOT-PAY +                       08600002
090100                 WK-6000-PEP-Y-PRETOT-PAY)                        08610002
090200          PERFORM 9000-WHICH-RTC-OUTLIER THRU 9000-EXIT           08620004
090300      ELSE                                                        08630002
090400         COMPUTE H-HHA-TOTAL-PAYMENT ROUNDED =                    08640002
090500                (WK-3000-PEP-N-PRETOT-PAY +                       08650002
090600                 WK-4000-PEP-Y-PRETOT-PAY +                       08660002
090700                 WK-5000-PEP-N-PRETOT-PAY +                       08670002
090800                 WK-6000-PEP-Y-PRETOT-PAY)                        08680002
090900          PERFORM 9050-WHICH-RTC-NO-OUTLIER THRU 9050-EXIT.       08690004
091000                                                                  08700002
091100                                                                  08710002
091200 7000-EXIT.   EXIT.                                               08720002
091300 8000-ADD-REV-DOLL.                                               08730002
091400                                                                  08740002
091500***************************************************************   08750002
091600*        ADD ALL REVENUE DOLLARS                                  08760002
091700***************************************************************   08770002
091800                                                                  08780002
091900     IF H-HHA-REVENUE-CODE (CO1) = SPACES                         08790002
092000        MOVE 6 TO SUB1                                            08800002
092100        GO TO 8000-EXIT.                                          08810002
092200                                                                  08820002
092300     COMPUTE FED-ADJ ROUNDED =                                    08830002
092400                H-HHA-REVENUE-DOLL-RATE (CO1) *                   08840002
092500                H-HHA-REVENUE-QTY-COV-VISITS (CO1).               08850002
092600                                                                  08860002
092700     COMPUTE FED-LABOR-ADJ ROUNDED =                              08870002
092800               WIR-AREA-WAGEIND *                                 08880002
092900               LABOR-PERCENT * FED-ADJ.                           08890002
093000                                                                  08900002
093100     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          08910002
093200               NONLABOR-PERCENT * FED-ADJ.                        08920002
093300                                                                  08930002
093400     COMPUTE WK-8000-OUTLIER-LAB-NLAB ROUNDED =                   08940002
093500              (FED-LABOR-ADJ + FED-NON-LABOR-ADJ).                08950002
093600                                                                  08960002
093700                                                                  08970002
093800     COMPUTE H-HHA-REVENUE-COST (CO1) ROUNDED =                   08980002
093900               WK-8000-OUTLIER-LAB-NLAB.                          08990002
094000                                                                  09000002
094100     COMPUTE WK-8000-OUTLIER-VALUE-B ROUNDED =                    09010002
094200             WK-8000-OUTLIER-VALUE-B + WK-8000-OUTLIER-LAB-NLAB.  09020002
094300                                                                  09030002
094400 8000-EXIT.   EXIT.                                               09040002
094500                                                                  09050002
094600 9000-WHICH-RTC-OUTLIER.                                          09060002
094700                                                                  09070002
094800      MOVE '01' TO H-HHA-PAY-RTC.                                 09080002
094900                                                                  09090002
095000      IF WK-RTC-ADJ-IND = 1  MOVE '08' TO H-HHA-PAY-RTC.          09100002
095100      IF WK-RTC-ADJ-IND = 2  MOVE '11' TO H-HHA-PAY-RTC.          09110002
095200      IF WK-RTC-ADJ-IND = 3  MOVE '13' TO H-HHA-PAY-RTC.          09120002
095300                                                                  09130002
095400                                                                  09140002
095500 9000-EXIT.   EXIT.                                               09150002
095600                                                                  09160002
095700 9050-WHICH-RTC-NO-OUTLIER.                                       09170002
095800                                                                  09180002
095900      MOVE '00' TO H-HHA-PAY-RTC.                                 09190002
096000                                                                  09200002
096100      IF WK-RTC-ADJ-IND = 1  MOVE '07' TO H-HHA-PAY-RTC.          09210002
096200      IF WK-RTC-ADJ-IND = 2  MOVE '09' TO H-HHA-PAY-RTC.          09220002
096300      IF WK-RTC-ADJ-IND = 3  MOVE '12' TO H-HHA-PAY-RTC.          09230002
096400                                                                  09240002
096500                                                                  09250002
096600 9050-EXIT.   EXIT.                                               09260002
096700                                                                  09270002
096800******        L A S T   S O U R C E   S T A T E M E N T   *****   09280002
