000100 IDENTIFICATION DIVISION.                                         00010017
000200 PROGRAM-ID.      HHCAL033.                                       00020031
000300*AUTHOR.          DAVE PANUSKA                                    00030017
000400*REMARKS.     (CENTERS FOR MEDICARE & MEDICAID SERVICES)          00040017
000500*REMARKS. A). NATIONAL HHA PRICER                                 00050017
000600***       B). NATIONAL HHA PRICER EFFECTIVE OCT 1 2001            00060017
000700***       C). THERE ARE YEARLY HHA PRICER MODULES THAT WILL       00070017
000800***           CALCULATE THE HRG'S,REVENUE CODES AND               00080017
000900***           TYPE OF BILLS.                                      00090017
001000*REMARKS.                                                         00100017
001100*     FOR FY 2003 CALCULATIONS AND RATES                          00110017
001200*     HHCAL030   NEW RATES EFFECTIVE OCT 1, 2002                  00120017
001300*     HHCAL031 EXPAND BILLING RECORD TO 500 BYTES - BEATA VERSION 00121029
001400*     HHCAL032 INCREASE PROV-PAYMET-TOTAL TO  PIC 9(09)V9(02)     00122029
001410*     HHCAL033 ADD NEW FIELDS FOR EARLIEST DATES                  00123031
001500******************************************************************00130017
001600*----------------------------------------------------------------*
001610* 2016 - ADDED 32Q AND 33Q AS VALID TOB CODES IN PARAGRAPH       *
001620*        400-CALC-THE-HHA                                        *
001630*----------------------------------------------------------------*
001700******************************************************************00150017
001800*            RETURN CODE VALUES (HHA-RTC)                         00160017
001900*                                                                 00170017
002000*        HHA-RTC  WITH PAYMENTS RETURNED                          00180017
002100*                                                                 00190017
002200*     RETURN CODES                                                00200017
002300*          00 = FINAL PAYMENT                                     00210017
002400*               TOB = 329,339,327,337                             00220017
002410*                  OR 32Q OR 33Q
002500*                  OR 32G OR 33G OR 32I OR 33I                    00230017
002600*                  OR 32J OR 33J OR 32M OR 33M                    00240017
002700*                  OR 32F OR 32K OR 32P OR 32H                    00250017
002800*                  OR 33F OR 33K OR 33P OR 33H                    00260017
002900*               WITH HRG,REVENUE CODE WHERE NO OUTLIER APPLIES    00270017
003000*          01 = FINAL PAYMENT                                     00280017
003100*               TOB = 329,339,327,337                             00290017
003110*                  OR 32Q OR 33Q
003200*                  OR 32G OR 33G OR 32I OR 33I                    00300017
003300*                  OR 32J OR 33J OR 32M OR 33M                    00310017
003400*                  OR 32F OR 32K OR 32P OR 32H                    00320017
003500*                  OR 33F OR 33K OR 33P OR 33H                    00330017
003600*               WITH HRG,REVENUE CODE WHERE OUTLIER APPLIES       00340017
003700*          03 = INITIAL HALF PAYMENT PAYMENT WILL BE ZERO         00350017
003800*               TOB = 332 AND 322                                 00360017
003900*          04 = INITIAL HALF PAYMENT PAID AT 50%                  00370017
004000*               TOB = 332 AND 322                                 00380017
004100*               WITH INITIAL (FIRST) HRG AND NO REVENUE CODES     00390017
004200*          05 = INITIAL HALF PAYMENT PAID AT 60%                  00400017
004300*               TOB = 332 AND 322                                 00410017
004400*               WITH INITIAL (FIRST) HRG AND NO REVENUE CODES     00420017
004500*          06 = LUPA PAYMENT ONLY                                 00430017
004600*               TOB = 329,339,327,337                             00440017
004610*                  OR 32Q OR 33Q
004700*                  OR 32G OR 33G OR 32I OR 33I                    00450017
004800*                  OR 32J OR 33J OR 32M OR 33M                    00460017
004900*                  OR 32F OR 32K OR 32P OR 32H                    00470017
005000*                  OR 33F OR 33K OR 33P OR 33H                    00480017
005100*               WITH REVENUE CODES AND REVENUE QTYS < 5       *   00490017
005200******************************************************************00500017
005300*          07 = FINAL PAYMENT, SCIC, PEP = N, NO OUTLIER          00510017
005400*               TOB = 329,339,327,337                             00520017
005410*                  OR 32Q OR 33Q
005500*                  OR 32G OR 33G OR 32I OR 33I                    00530017
005600*                  OR 32J OR 33J OR 32M OR 33M                    00540017
005700*                  OR 32F OR 32K OR 32P OR 32H                    00550017
005800*                  OR 33F OR 33K OR 33P OR 33H                    00560017
005900*               WITH REVENUE CODE WHERE NO OUTLIER APPLIES        00570017
006000*               WITH MORE THAN ONE HRG OCCURRENCE             *   00580017
006100*          08 = FINAL PAYMENT, SCIC, PEP = N, WITH OUTLIER        00590017
006200*               TOB = 329,339,327,337                             00600017
006210*                  OR 32Q OR 33Q
006300*                  OR 32G OR 33G OR 32I OR 33I                    00610017
006400*                  OR 32J OR 33J OR 32M OR 33M                    00620017
006500*                  OR 32F OR 32K OR 32P OR 32H                    00630017
006600*                  OR 33F OR 33K OR 33P OR 33H                    00640017
006700*               WITH REVENUE CODE WHERE OUTLIER APPLIES           00650017
006800*               WITH MORE THAN ONE HRG OCCURRENCE             *   00660017
006900******************************************************************00670017
007000*          09 = FINAL PAYMENT, PEP = Y, NO OUTLIER                00680017
007100*               TOB = 329,339,327,337                             00690017
007110*                  OR 32Q OR 33Q
007200*                  OR 32G OR 33G OR 32I OR 33I                    00700017
007300*                  OR 32J OR 33J OR 32M OR 33M                    00710017
007400*                  OR 32F OR 32K OR 32P OR 32H                    00720017
007500*                  OR 33F OR 33K OR 33P OR 33H                    00730017
007600*               WITH REVENUE CODE WHERE NO OUTLIER APPLIES        00740017
007700*               WITH ONE HRG OCCURRENCE                       *   00750017
007800*          11 = FINAL PAYMENT, PEP = Y, WITH OUTLIER              00760017
007900*               TOB = 329,339,327,337                             00770017
007910*                  OR 32Q OR 33Q
008000*                  OR 32G OR 33G OR 32I OR 33I                    00780017
008100*                  OR 32J OR 33J OR 32M OR 33M                    00790017
008200*                  OR 32F OR 32K OR 32P OR 32H                    00800017
008300*                  OR 33F OR 33K OR 33P OR 33H                    00810017
008400*               WITH REVENUE CODE WHERE OUTLIER APPLIES           00820017
008500*               WITH ONE HRG OCCURRENCE                       *   00830017
008600******************************************************************00840017
008700*          12 = FINAL PAYMENT, SCIC, PEP = Y, NO OUTLIER          00850017
008800*               TOB = 329,339,327,337                             00860017
008810*                  OR 32Q OR 33Q
008900*                  OR 32G OR 33G OR 32I OR 33I                    00870017
009000*                  OR 32J OR 33J OR 32M OR 33M                    00880017
009100*                  OR 32F OR 32K OR 32P OR 32H                    00890017
009200*                  OR 33F OR 33K OR 33P OR 33H                    00900017
009300*               WITH REVENUE CODE WHERE NO OUTLIER APPLIES        00910017
009400*               WITH MORE THAN ONE HRG OCCURRENCE             *   00920017
009500*          13 = FINAL PAYMENT, SCIC, PEP = Y, WITH OUTLIER        00930017
009600*               TOB = 329,339,327,337                             00940017
009610*                  OR 32Q OR 33Q
009700*                  OR 32G OR 33G OR 32I OR 33I                    00950017
009800*                  OR 32J OR 33J OR 32M OR 33M                    00960017
009900*                  OR 32F OR 32K OR 32P OR 32H                    00970017
010000*                  OR 33F OR 33K OR 33P OR 33H                    00980017
010100*               WITH REVENUE CODE WHERE OUTLIER APPLIES           00990017
010200*               WITH MORE THAN ONE HRG OCCURRENCE             *   01000017
010300******************************************************************01010017
010400******************************************************************01020017
010500*                                                             *   01030017
010600*            HHA-RTC   NO PAYMENTS RETURNED                   *   01040017
010700*                                                             *   01050017
010800*              10 = INVALID TOB                               *   01060017
010900*                                                             *   01070017
011000*              15 = INVALID PEP DAYS                          *   01080017
011100*                   FOR SHORTENED EPISODE                     *   01090017
011200*                                                             *   01100017
011300*              16 = INVALID HRG DAYS , > 60 DAYS              *   01110017
011400*                                                             *   01120017
011500*              20 = INVALID PEP INDICATOR                     *   01130017
011600*                                                             *   01140017
011700*              25 = INVALID MED REVIEW INDICATOR              *   01150017
011800*                                                             *   01160017
011900*              30 = INVALID MSA CODE                          *   01170017
012000*                                                             *   01180017
012100*              35 = INVALID INITIAL PAYMENT INDICATOR         *   01190017
012200*                        0 = MAKE NORMAL INITIAL PAYMENT      *   01200017
012300*                        1 = MAKE ZERO PAYMANT                *   01210017
012400*                                                             *   01220017
012500*              40 = THRU DATE  < OCT 1, 2002 FOR FY2003       *   01230017
012600*                     OR ADMIT DATE > SERV FROM DATE          *   01240017
012700*                     OR INVALID                              *   01250017
012800*                                                             *   01260017
012900*              70 = INVALID OR NO HRG CODE PRESENT            *   01270017
013000*                                                             *   01280017
013100*              75 = NO HRG PRESENT IN FIRST OCCURANCE AND     *   01290017
013200*                   REVENUE-QTY-COV-VISITS > 4  AND           *   01300017
013300*                       TOB = 329,339,327,337                 *   01310017
013400*                          OR 32G OR 33G OR 32I OR 33I        *   01320017
013500*                          OR 32J OR 33J OR 32M OR 33M        *   01330017
013600*                          OR 32F OR 32K OR 32P OR 32H            01340017
013700*                          OR 33F OR 33K OR 33P OR 33H            01350017
013800*                                                             *   01360017
013900*              80 = INVALID REVENUE CODE                      *   01370017
014000*                                                             *   01380017
014100*              85 = NO REVENUE CODE PRESENT                   *   01390017
014200*                   WITH TOB 329 OR 339 OR 327 OR 337         *   01400017
014300*                         OR 32G OR 33G OR 32I OR 33I         *   01410017
014400*                         OR 32J OR 33J OR 32M OR 33M         *   01420017
014500*                         OR 32F OR 32K OR 32P OR 32H             01430017
014600*                         OR 33F OR 33K OR 33P OR 33H             01440017
014700*                                                             *   01450017
014800***************************************************************   01460017
014900***************************************************************   01470017
015000***************************************************************   01480017
015100 DATE-COMPILED.                                                   01490017
015200 ENVIRONMENT DIVISION.                                            01500017
015300 CONFIGURATION SECTION.                                           01510017
015400 SOURCE-COMPUTER.            IBM-370.                             01520017
015500 OBJECT-COMPUTER.            IBM-370.                             01530017
015600 INPUT-OUTPUT  SECTION.                                           01540017
015700 FILE-CONTROL.                                                    01550017
015800                                                                  01560017
015900 DATA DIVISION.                                                   01570017
016000 FILE SECTION.                                                    01580017
016100                                                                  01590017
016200 WORKING-STORAGE SECTION.                                         01600017
016300 01  W-STORAGE-REF                  PIC X(46)  VALUE              01610017
016400     'HHCAL033      - W O R K I N G   S T O R A G E'.             01620031
016500 01  CAL-VERSION                    PIC X(07)  VALUE 'C2003.3'.   01630031
016600 01  CO1                            PIC S9(04) COMP SYNC.         01640017
016700 01  SUB1                           PIC S9(04) COMP SYNC.         01650017
016800 01  R1                             PIC S9(04) COMP SYNC.         01660017
016900 01  R2                             PIC S9(04) COMP SYNC.         01670017
017000 01  R3                             PIC S9(04) COMP SYNC.         01680017
017100                                                                  01690017
017200 01  LABOR-NLABOR-PERCENT.                                        01700017
017300     05 LABOR-PERCENT        PIC 9V9(05)  VALUE 0.77668.          01710017
017400     05 NONLABOR-PERCENT     PIC 9V9(05)  VALUE 0.22332.          01720017
017500                                                                  01730017
017600 01  FED-EPISODE-RATE-AMT         PIC 9(05)V9(02) VALUE 0.        01740017
017700 01  OUTLIER-THRESHOLD-AMT        PIC 9(05)V9(02) VALUE 0.        01750017
017800***************************************************************** 01760017
017900***    EXAMPLE    *********************************************** 01770017
018000*** FED-EPISODE-RATE-AMT TIMES 1.13 = OUTLIER-THRESHOLD-AMT ***** 01780017
018100******  2159.39 TIMES 1.13  = 2440.11  ROUNDED UP  ************** 01790017
018200***************************************************************** 01800017
018300 01  OUTL-LOSS-SHAR-RATIO-PERCENT PIC 9(01)V9(02) VALUE 0.80.     01810017
018400                                                                  01820017
018500 01  WK-PEP-DAYS           PIC S9(04)       VALUE 0.              01830017
018600 01  WK-HRG-NO-OF-DAYS     PIC S9(04)       VALUE 0.              01840017
018700 01  WK-HRG-NO-OF-DAYS-TOT PIC S9(04)       VALUE 0.              01850017
018800 01  WK-RTC-ADJ-IND        PIC 9            VALUE 0.              01860017
018900 01  WK-ALL-TOTALS.                                               01870017
019000     05  FED-ADJ                        PIC S9(07)V9(02).         01880017
019100     05  FED-ADJ1                       PIC S9(07)V9(02).         01890017
019200     05  FED-LABOR-ADJ                  PIC S9(07)V9(02).         01900017
019300     05  FED-NON-LABOR-ADJ              PIC S9(07)V9(02).         01910017
019400     05  OUT-THRES-AMT-ADJ              PIC S9(07)V9(02).         01920017
019500     05  OUT-THRES-LABOR-ADJ            PIC S9(07)V9(02).         01930017
019600     05  OUT-THRES-NON-LABOR-ADJ        PIC S9(07)V9(02).         01940017
019700     05  WK-3000-PEP-N-PRETOT-PAY       PIC S9(07)V9(02).         01950017
019800     05  WK-3000-PEP-N-PAYMENT          PIC S9(07)V9(02).         01960017
019900     05  WK-4000-PEP-Y-PRETOT-PAY       PIC S9(07)V9(02).         01970017
020000     05  WK-4000-PEP-Y-PAYMENT          PIC S9(07)V9(02).         01980017
020100     05  WK-5000-PEP-N-PRETOT-PAY       PIC S9(07)V9(02).         01990017
020200     05  WK-5000-PEP-N-PAYMENT          PIC S9(07)V9(02).         02000017
020300     05  WK-6000-PEP-Y-PRETOT-PAY       PIC S9(07)V9(02).         02010017
020400     05  WK-6000-PEP-Y-PAYMENT          PIC S9(07)V9(02).         02020017
020500     05  WK-6050-PEP-Y-TOT-DAYS         PIC S9(04).               02030017
020600     05  WK-7000-OUTLIER-VALUE-A        PIC S9(07)V9(02).         02040017
020700     05  WK-7000-AB-DIFF                PIC S9(07)V9(02).         02050017
020800     05  WK-7000-CALC                   PIC S9(07)V9(02).         02060017
020900     05  WK-8000-OUTLIER-VALUE-B        PIC S9(07)V9(02).         02070017
021000     05  WK-8000-OUTLIER-LAB-NLAB       PIC S9(07)V9(02).         02080017
021100                                                                  02090017
021200                                                                  02100017
021300                                                                  02110017
021400*******************************************************           02120017
021500 01  HOLD-HHA-DATA.                                               02130017
021600     05  H-HHA-INPUT-DATA.                                        02140017
021700         10  H-HHA-NPI                 PIC X(10).                 02150017
021800         10  H-HHA-HIC                 PIC X(12).                 02160017
021900         10  H-HHA-PROV-NO             PIC X(06).                 02170017
022000         10  H-HHA-TOB                 PIC XXX.                   02180017
022100         10  H-HHA-PEP-INDICATOR       PIC X.                     02190017
022200         10  H-HHA-PEP-DAYS            PIC 999.                   02200017
022300         10  H-HHA-INIT-PAY-INDICATOR  PIC X.                     02210017
022400         10  FILLER                    PIC X(07).                 02220017
022500         10  H-HHA-MSA1                PIC 9(07)V9(02).           02230017
022600         10  H-HHA-MSA2-DATA REDEFINES H-HHA-MSA1.                02240017
022700             15  FILLER             PIC XXX.                      02250017
022800             15  H-HHA-MSA2           PIC XXXX.                   02260017
022900             15  FILLER             PIC XX.                       02270017
023000         10  H-HHA-SERV-FROM-DATE.                                02280017
023100             15  H-HHA-FROM-CC         PIC XX.                    02290017
023200             15  H-HHA-FROM-YYMMDD.                               02300017
023300                 25  H-HHA-FROM-YY     PIC XX.                    02310017
023400                 25  H-HHA-FROM-MM     PIC XX.                    02320017
023500                 25  H-HHA-FROM-DD     PIC XX.                    02330017
023600         10  H-HHA-SERV-THRU-DATE.                                02340017
023700             15  H-HHA-THRU-CC         PIC XX.                    02350017
023800             15  H-HHA-THRU-YYMMDD.                               02360017
023900                 25  H-HHA-THRU-YY     PIC XX.                    02370017
024000                 25  H-HHA-THRU-MM     PIC XX.                    02380017
024100                 25  H-HHA-THRU-DD     PIC XX.                    02390017
024200         10  H-HHA-ADMIT-DATE.                                    02400017
024300             15  H-HHA-ADMIT-CC        PIC XX.                    02410017
024400             15  H-HHA-ADMIT-YYMMDD.                              02420017
024500                 25  H-HHA-ADMIT-YY    PIC XX.                    02430017
024600                 25  H-HHA-ADMIT-MM    PIC XX.                    02440017
024700                 25  H-HHA-ADMIT-DD    PIC XX.                    02450017
024800         10  H-HHA-HRG-DATA      OCCURS 6.                        02460017
024900             15  H-HHA-MED-REVIEW-INDICATOR PIC X.                02470017
025000             15  H-HHA-HRG-INPUT-CODE       PIC X(05).            02480017
025100             15  H-HHA-HRG-OUTPUT-CODE      PIC X(05).            02490017
025200             15  H-HHA-HRG-NO-OF-DAYS       PIC 9(03).            02500017
025300             15  H-HHA-HRG-WGTS             PIC 9(02)V9(04).      02510017
025400             15  H-HHA-HRG-PAY              PIC 9(07)V9(02).      02520017
025500         10  H-HHA-REVENUE-DATA     OCCURS 6.                     02530017
025600             15  H-HHA-REVENUE-CODE             PIC X(04).        02540032
025700             15  H-HHA-REVENUE-QTY-COV-VISITS   PIC 9(03).        02550032
025710             15  H-HHA-REVENUE-EARLIEST-DATE    PIC 9(08).        02551032
025800             15  H-HHA-REVENUE-DOLL-RATE        PIC 9(07)V9(02).  02560032
025900             15  H-HHA-REVENUE-COST             PIC 9(07)V9(02).  02570032
025910             15  H-HHA-REVENUE-ADD-ON-VISIT-AMT PIC 9(07)V9(02).  02572032
026000     05  H-HHA-PASSBACK-DATA.                                     02580017
026100         10  H-HHA-PAY-RTC                PIC 99.                 02590017
026200         10  H-HHA-REVENUE-SUM1-3-QTY-THR PIC 9(05).              02600017
026300         10  H-HHA-REVENUE-SUM1-6-QTY-ALL PIC 9(05).              02610017
026400         10  H-HHA-OUTLIER-PAYMENT        PIC 9(07)V9(02).        02620017
026500         10  H-HHA-TOTAL-PAYMENT          PIC 9(07)V9(02).        02630017
026600     05  H-HHA-CASE-MIX-DATA.                                     02640024
026700         10  H-HHA-LUPA-ADD-ON-PAYMENT    PIC 9(03)V9(02).        02640124
026800         10  H-HHA-LUPA-SRC-ADM           PIC X.                  02640224
026900         10  H-HHA-RECODE-IND             PIC X.                  02640324
027000         10  H-HHA-EPISODE-TIMING         PIC 9.                  02640424
027100         10  H-HHA-SEVERITY-POINTS.                               02640524
027200             15  H-HHA-CLINICAL-SEV-EQ1   PIC X(01).              02640624
027300             15  H-HHA-FUNCTION-SEV-EQ1   PIC X(01).              02640724
027400             15  H-HHA-CLINICAL-SEV-EQ2   PIC X(01).              02640824
027500             15  H-HHA-FUNCTION-SEV-EQ2   PIC X(01).              02640924
027600             15  H-HHA-CLINICAL-SEV-EQ3   PIC X(01).              02641024
027700             15  H-HHA-FUNCTION-SEV-EQ3   PIC X(01).              02641124
027800             15  H-HHA-CLINICAL-SEV-EQ4   PIC X(01).              02641224
027900             15  H-HHA-FUNCTION-SEV-EQ4   PIC X(01).              02641324
028000     05  H-HHA-PROV-TOTAL-DATA.                                   02641424
028100         10  H-HHA-PROV-OUTLIER-PAY-TOTAL PIC 9(08)V9(02).        02641524
028200         10  H-HHA-PROV-PAYMET-TOTAL      PIC 9(09)V9(02).        02641626
028300     05  FILLER                           PIC X(33).              02641726
028400**==================================================***           02641824
028500                                                                  02651017
028600***************************************************************   02660017
028700                                                                  02670017
028800 LINKAGE SECTION.                                                 02680017
028900***************************************************************   02690017
029000*                 * * * * * * * * *                           *   02700017
029100***************************************************************   02710017
029200***************************************************************   02720017
029300*    THIS DATA IS CALCULATED BY THIS HHAPR  SUBROUTINE        *   02730017
029400*    AND PASSED BACK TO THE CALLING PROGRAM                   *   02740017
029500***************************************************************   02750017
029600 01  HHA-INPUT-DATA.                                              02760017
029700     05  HHA-DATA.                                                02770017
029800         10  HHA-NPI                 PIC X(10).                   02780017
029900         10  HHA-HIC                 PIC X(12).                   02790017
030000         10  HHA-PROV-NO             PIC X(06).                   02800017
030100         10  HHA-TOB                 PIC XXX.                     02810017
030200         10  HHA-PEP-INDICATOR       PIC X.                       02820017
030300         10  HHA-PEP-DAYS            PIC 999.                     02830017
030400         10  HHA-INIT-PAY-INDICATOR  PIC X.                       02840017
030500         10  FILLER                  PIC X(07).                   02850017
030600         10  HHA-MSA1                PIC 9(07)V9(02).             02860017
030700         10  HHA-MSA2-DATA REDEFINES HHA-MSA1.                    02870017
030800             15  FILLER             PIC XXX.                      02880017
030900             15  HHA-MSA2.                                        02890017
031000                 25  HHA-MSA2-RURAL-1ST.                          02900017
031100                     88  HHA-MSA-RURAL-CHECK   VALUE '99'.        02910017
031200                     30  HHA-RURAL-MSA         PIC XX.            02920017
031300                 25  HHA-MSA2-RURAL-2ND        PIC XX.            02930017
031400             15  FILLER             PIC XX.                       02940017
031500         10  HHA-SERV-FROM-DATE.                                  02950017
031600             15  HHA-FROM-CC         PIC XX.                      02960017
031700             15  HHA-FROM-YYMMDD.                                 02970017
031800                 25  HHA-FROM-YY     PIC XX.                      02980017
031900                 25  HHA-FROM-MM     PIC XX.                      02990017
032000                 25  HHA-FROM-DD     PIC XX.                      03000017
032100         10  HHA-SERV-THRU-DATE.                                  03010017
032200             15  HHA-THRU-CC         PIC XX.                      03020017
032300             15  HHA-THRU-YYMMDD.                                 03030017
032400                 25  HHA-THRU-YY     PIC XX.                      03040017
032500                 25  HHA-THRU-MM     PIC XX.                      03050017
032600                 25  HHA-THRU-DD     PIC XX.                      03060017
032700         10  HHA-ADMIT-DATE.                                      03070017
032800             15  HHA-ADMIT-CC        PIC XX.                      03080017
032900             15  HHA-ADMIT-YYMMDD.                                03090017
033000                 25  HHA-ADMIT-YY    PIC XX.                      03100017
033100                 25  HHA-ADMIT-MM    PIC XX.                      03110017
033200                 25  HHA-ADMIT-DD    PIC XX.                      03120017
033300         10  HHA-HRG-DATA      OCCURS 6.                          03130017
033400             15  HHA-MED-REVIEW-INDICATOR PIC X.                  03140017
033500             15  HHA-HRG-INPUT-CODE       PIC X(05).              03150017
033600             15  HHA-HRG-OUTPUT-CODE      PIC X(05).              03160017
033700             15  HHA-HRG-NO-OF-DAYS       PIC 9(03).              03170017
033800             15  HHA-HRG-WGTS             PIC 9(02)V9(04).        03180017
033900             15  HHA-HRG-PAY              PIC 9(07)V9(02).        03190017
034000         10  HHA-REVENUE-DATA     OCCURS 6.                       03200017
034100             15  HHA-REVENUE-CODE             PIC X(04).          03210032
034200             15  HHA-REVENUE-QTY-COV-VISITS   PIC 9(03).          03220032
034210             15  HHA-REVENUE-EARLIEST-DATE    PIC 9(08).          03221032
034300             15  HHA-REVENUE-DOLL-RATE        PIC 9(07)V9(02).    03230032
034400             15  HHA-REVENUE-COST             PIC 9(07)V9(02).    03240032
034410             15  HHA-REVENUE-ADD-ON-VISIT-AMT PIC 9(07)V9(02).    03242032
034500     05  HHA-PASSBACK-DATA.                                       03250017
034600         10  HHA-PAY-RTC                PIC 99.                   03260017
034700         10  HHA-REVENUE-SUM1-3-QTY-THR PIC 9(05).                03270017
034800         10  HHA-REVENUE-SUM1-6-QTY-ALL PIC 9(05).                03280017
034900         10  HHA-OUTLIER-PAYMENT        PIC 9(07)V9(02).          03290017
035000         10  HHA-TOTAL-PAYMENT          PIC 9(07)V9(02).          03300017
035100     05  HHA-CASE-MIX-DATA.                                       03301024
035200         10  HHA-LUPA-ADD-ON-PAYMENT    PIC 9(03)V9(02).          03302024
035300         10  HHA-LUPA-SRC-ADM           PIC X.                    03303024
035400         10  HHA-RECODE-IND             PIC X.                    03304024
035500         10  HHA-EPISODE-TIMING         PIC 9.                    03305024
035600         10  HHA-SEVERITY-POINTS.                                 03306024
035700             15  HHA-CLINICAL-SEV-EQ1   PIC X(01).                03307024
035800             15  HHA-FUNCTION-SEV-EQ1   PIC X(01).                03308024
035900             15  HHA-CLINICAL-SEV-EQ2   PIC X(01).                03309024
036000             15  HHA-FUNCTION-SEV-EQ2   PIC X(01).                03309124
036100             15  HHA-CLINICAL-SEV-EQ3   PIC X(01).                03309224
036200             15  HHA-FUNCTION-SEV-EQ3   PIC X(01).                03309324
036300             15  HHA-CLINICAL-SEV-EQ4   PIC X(01).                03309424
036400             15  HHA-FUNCTION-SEV-EQ4   PIC X(01).                03309524
036500     05  HHA-PROV-TOTAL-DATA.                                     03309624
036600         10  HHA-PROV-OUTLIER-PAY-TOTAL PIC 9(08)V9(02).          03309724
036700         10  HHA-PROV-PAYMET-TOTAL      PIC 9(09)V9(02).          03309826
036800     05  FILLER                         PIC X(33).                03309926
036900**==================================================***           03310024
037000*    05  FILLER                         PIC X(20).                03311024
037100**==================================================***           03312024
037200                                                                  03320017
037300 01  HOLD-VARIABLES-DATA.                                         03330017
037400     02  HOLD-VAR-DATA.                                           03340017
037500         05  PRICER-OPTION-SW                   PIC X(01).        03350017
037600         05  HHDRV-VERSION                      PIC X(07).        03360017
037700         05  HHCAL-VERSION                      PIC X(07).        03370017
037800         05  FILLER                             PIC X(20).        03380017
037900                                                                  03390017
038000 01  WAGE-INDEX-DATA.                                             03400017
038100     02  HOLD-WIR-DATA.                                           03410017
038200         05  WIR-MSA                        PIC X(04).            03420017
038300         05  WIR-EFFDATE                    PIC X(08).            03430017
038400         05  WIR-AREA-WAGEIND               PIC 9(02)V9(04).      03440017
038500                                                                  03450017
038600 PROCEDURE DIVISION  USING HHA-INPUT-DATA                         03460017
038700                           HOLD-VARIABLES-DATA                    03470017
038800                           WAGE-INDEX-DATA.                       03480017
038900                                                                  03490017
039000***************************************************************   03500017
039100*    PROCESSING:                                              *   03510017
039200*        A. WILL PROCESS NATIONAL HHA FOR FY 2003             *   03520017
039300*                STARTING OCT 1, 2002                         *   03530017
039400***************************************************************   03540017
039500                                                                  03550017
039600     MOVE CAL-VERSION TO HHCAL-VERSION.                           03560017
039700                                                                  03570017
039800     PERFORM 200-MAINLINE-CONTROL THRU 200-EXIT.                  03580017
039900                                                                  03590017
040000     MOVE HOLD-HHA-DATA TO HHA-INPUT-DATA.                        03600017
040100                                                                  03610017
040200     GOBACK.                                                      03620017
040300                                                                  03630017
040400 200-MAINLINE-CONTROL.                                            03640017
040500                                                                  03650017
040600     MOVE HHA-INPUT-DATA TO HOLD-HHA-DATA.                        03660017
040700                                                                  03670017
040800     MOVE ALL '0' TO                                              03680017
040900                     WK-ALL-TOTALS                                03690017
041000                     WK-HRG-NO-OF-DAYS                            03700017
041100                     WK-HRG-NO-OF-DAYS-TOT                        03710017
041200                     WK-RTC-ADJ-IND                               03720017
041300                     WK-PEP-DAYS                                  03730017
041400                     H-HHA-PASSBACK-DATA                          03740017
041500                     H-HHA-HRG-PAY (1)                            03750017
041600                     H-HHA-HRG-PAY (2)                            03760017
041700                     H-HHA-HRG-PAY (3)                            03770017
041800                     H-HHA-HRG-PAY (4)                            03780017
041900                     H-HHA-HRG-PAY (5)                            03790017
042000                     H-HHA-HRG-PAY (6)                            03800017
042100                     H-HHA-REVENUE-COST (1)                       03810017
042200                     H-HHA-REVENUE-COST (2)                       03820017
042300                     H-HHA-REVENUE-COST (3)                       03830017
042400                     H-HHA-REVENUE-COST (4)                       03840017
042500                     H-HHA-REVENUE-COST (5)                       03850017
042600                     H-HHA-REVENUE-COST (6).                      03860017
042700                                                                  03870017
042800     IF  H-HHA-PAY-RTC = 00                                       03880017
042900         PERFORM 400-CALC-THE-HHA THRU 400-EXIT.                  03890017
043000                                                                  03900017
043100 200-EXIT.   EXIT.                                                03910017
043200                                                                  03920017
043300 400-CALC-THE-HHA.                                                03930017
043400                                                                  03940017
043500     IF H-HHA-SERV-THRU-DATE < 20021001                           03950017
043600         MOVE '40' TO H-HHA-PAY-RTC                               03960017
043700         GO TO 400-EXIT.                                          03970017
043800                                                                  03980017
043900     IF H-HHA-ADMIT-DATE >                                        03990017
044000        H-HHA-SERV-FROM-DATE                                      04000017
044100         MOVE '40' TO H-HHA-PAY-RTC                               04010017
044200         GO TO 400-EXIT.                                          04020017
044300                                                                  04030017
044400     IF ((H-HHA-TOB = '332' OR '322') AND                         04040017
044500        (H-HHA-HRG-INPUT-CODE (1) = SPACE))                       04050017
044600        MOVE '70' TO H-HHA-PAY-RTC                                04060017
044700        GO TO 400-EXIT.                                           04070017
044800                                                                  04080017
044900     IF ((H-HHA-TOB = '329' OR '339' OR '327' OR '337' OR         04090017
044910                      '32Q' OR '33Q' OR
045000                      '32G' OR '33G' OR '32I' OR '33I' OR         04100017
045100                      '32F' OR '32K' OR '32P' OR '32H' OR         04110017
045200                      '33F' OR '33K' OR '33P' OR '33H' OR         04120017
045300                      '32J' OR '33J' OR '32M' OR '33M') AND       04130017
045400         (H-HHA-REVENUE-SUM1-6-QTY-ALL > 4 ) AND                  04140017
045500         (H-HHA-HRG-INPUT-CODE (1) = SPACE))                      04150017
045600        MOVE '75' TO H-HHA-PAY-RTC                                04160017
045700        GO TO 400-EXIT.                                           04170017
045800                                                                  04180017
045900     IF ((H-HHA-TOB = '329' OR '339' OR '327' OR '337' OR         04190017
045910                      '32Q' OR '33Q' OR
046000                      '32G' OR '33G' OR '32I' OR '33I' OR         04200017
046100                      '32F' OR '32K' OR '32P' OR '32H' OR         04210017
046200                      '33F' OR '33K' OR '33P' OR '33H' OR         04220017
046300                      '32J' OR '33J' OR '32M' OR '33M') AND       04230017
046400         (H-HHA-REVENUE-CODE (1) = SPACE))                        04240017
046500        MOVE '85' TO H-HHA-PAY-RTC                                04250017
046600        GO TO 400-EXIT.                                           04260017
046700                                                                  04270017
046800     IF ((H-HHA-TOB = '329' OR '339' OR '327' OR '337' OR         04280017
046810                      '32Q' OR '33Q' OR
046900                      '32G' OR '33G' OR '32I' OR '33I' OR         04290017
047000                      '32F' OR '32K' OR '32P' OR '32H' OR         04300017
047100                      '33F' OR '33K' OR '33P' OR '33H' OR         04310017
047200                      '32J' OR '33J' OR '32M' OR '33M') AND       04320017
047300         (H-HHA-HRG-INPUT-CODE (2) NOT = SPACES) AND              04330017
047400         (H-HHA-PEP-INDICATOR = 'Y') AND                          04340017
047500         (H-HHA-PEP-DAYS NOT NUMERIC OR                           04350017
047600          H-HHA-PEP-DAYS = ZEROES))                               04360017
047700        MOVE '15' TO H-HHA-PAY-RTC                                04370017
047800        GO TO 400-EXIT.                                           04380017
047900                                                                  04390017
048000     IF H-HHA-PAY-RTC NOT = 00 GO TO 400-EXIT.                    04400017
048100                                                                  04410017
048200***************************************************************   04420017
048300***************************************************************   04430017
048400*        THESE RATES & THRESHOLDS ARE APPLIED                 *   04440017
048500* FOR NON-RURAL --   THESE RATES & THRESHOLDS ARE APPLIED     *   04450017
048600***************************************************************   04460017
048700     MOVE 02159.39 TO   FED-EPISODE-RATE-AMT                      04470017
048800     MOVE 02440.11 TO   OUTLIER-THRESHOLD-AMT.                    04480017
048900***************************************************************   04490017
049000***************************************************************   04500017
049100* FOR RURAL  -- THESE RATES & THRESHOLDS ARE APPLIED          *   04510017
049200***************************************************************   04520017
049300     IF HHA-MSA-RURAL-CHECK                                       04530017
049400           MOVE 02375.33 TO   FED-EPISODE-RATE-AMT                04540017
049500           MOVE 02684.12 TO   OUTLIER-THRESHOLD-AMT.              04550017
049600***************************************************************   04560017
049700*    EFFECTIVE APR 1, 2003                                    *   04570017
049800*    10% ADD-ONS ENDS                                         *   04580017
049900*    THESE RATES & THRESHOLDS ARE APPLIED LESS 10%            *   04590017
050000***************************************************************   04600017
050100     IF H-HHA-SERV-THRU-DATE > 20030331                           04610017
050200        MOVE 02159.39 TO   FED-EPISODE-RATE-AMT                   04620017
050300        MOVE 02440.11 TO   OUTLIER-THRESHOLD-AMT.                 04630017
050400***************************************************************   04640017
050500***************************************************************   04650017
050600                                                                  04660017
050700     IF H-HHA-TOB = '322' OR '332'                                04670017
050800        PERFORM 500-INITIAL-PAYMENT THRU 500-EXIT                 04680017
050900        GO TO 400-EXIT.                                           04690017
051000                                                                  04700017
051100     IF H-HHA-TOB = '329' OR '339' OR '327' OR '337' OR           04710017
051110                    '32Q' OR '33Q' OR
051200                    '32G' OR '33G' OR '32I' OR '33I' OR           04720017
051300                    '32F' OR '32K' OR '32P' OR '32H' OR           04730017
051400                    '33F' OR '33K' OR '33P' OR '33H' OR           04740017
051500                    '32J' OR '33J' OR '32M' OR '33M'              04750017
051600        PERFORM 1000-FINAL-PAYMENT THRU 1000-EXIT                 04760017
051700        GO TO 400-EXIT.                                           04770017
051800                                                                  04780017
051900     MOVE '10' TO H-HHA-PAY-RTC.                                  04790017
052000                                                                  04800017
052100                                                                  04810017
052200 400-EXIT.   EXIT.                                                04820017
052300                                                                  04830017
052400 500-INITIAL-PAYMENT.                                             04840017
052500                                                                  04850017
052600***************************************************************   04860017
052700*            TOB = 322 OR 332 INITIAL PAYMENT                     04870017
052800***************************************************************   04880017
052900                                                                  04890017
053000     IF  H-HHA-INIT-PAY-INDICATOR  = '1' OR '0'                   04900017
053100         NEXT SENTENCE                                            04910017
053200     ELSE                                                         04920017
053300         MOVE '35' TO H-HHA-PAY-RTC                               04930017
053400         GO TO 500-EXIT.                                          04940017
053500                                                                  04950017
053600     IF  H-HHA-INIT-PAY-INDICATOR  = '1'                          04960017
053700         MOVE '03' TO H-HHA-PAY-RTC                               04970017
053800         GO TO 500-EXIT.                                          04980017
053900                                                                  04990017
054000     COMPUTE FED-ADJ ROUNDED =                                    05000017
054100               H-HHA-HRG-WGTS (1) * FED-EPISODE-RATE-AMT.         05010017
054200                                                                  05020017
054300     COMPUTE FED-LABOR-ADJ ROUNDED =                              05030017
054400             WIR-AREA-WAGEIND *                                   05040017
054500             LABOR-PERCENT *                                      05050017
054600             FED-ADJ.                                             05060017
054700                                                                  05070017
054800     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          05080017
054900               NONLABOR-PERCENT * FED-ADJ.                        05090017
055000                                                                  05100017
055100     IF H-HHA-SERV-FROM-DATE = H-HHA-ADMIT-DATE                   05110017
055200        COMPUTE H-HHA-TOTAL-PAYMENT ROUNDED =                     05120017
055300                 (FED-LABOR-ADJ + FED-NON-LABOR-ADJ) * .6         05130017
055400        MOVE H-HHA-TOTAL-PAYMENT TO H-HHA-HRG-PAY (1)             05140017
055500        MOVE '05' TO H-HHA-PAY-RTC                                05150017
055600     ELSE                                                         05160017
055700        COMPUTE H-HHA-TOTAL-PAYMENT ROUNDED =                     05170017
055800                 (FED-LABOR-ADJ + FED-NON-LABOR-ADJ) * .5         05180017
055900        MOVE H-HHA-TOTAL-PAYMENT TO H-HHA-HRG-PAY (1)             05190017
056000        MOVE '04' TO H-HHA-PAY-RTC.                               05200017
056100                                                                  05210017
056200 500-EXIT.   EXIT.                                                05220017
056300                                                                  05230017
056400 1000-FINAL-PAYMENT.                                              05240017
056500                                                                  05250017
056600     IF H-HHA-REVENUE-QTY-COV-VISITS (1) NOT NUMERIC              05260017
056700        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (1).          05270017
056800     IF H-HHA-REVENUE-QTY-COV-VISITS (2) NOT NUMERIC              05280017
056900        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (2).          05290017
057000     IF H-HHA-REVENUE-QTY-COV-VISITS (3) NOT NUMERIC              05300017
057100        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (3).          05310017
057200     IF H-HHA-REVENUE-QTY-COV-VISITS (4) NOT NUMERIC              05320017
057300        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (4).          05330017
057400     IF H-HHA-REVENUE-QTY-COV-VISITS (5) NOT NUMERIC              05340017
057500        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (5).          05350017
057600     IF H-HHA-REVENUE-QTY-COV-VISITS (6) NOT NUMERIC              05360017
057700        MOVE ZEROES TO H-HHA-REVENUE-QTY-COV-VISITS (6).          05370017
057800                                                                  05380017
057900     COMPUTE H-HHA-REVENUE-SUM1-3-QTY-THR ROUNDED =               05390017
058000             H-HHA-REVENUE-QTY-COV-VISITS (1) +                   05400017
058100             H-HHA-REVENUE-QTY-COV-VISITS (2) +                   05410017
058200             H-HHA-REVENUE-QTY-COV-VISITS (3).                    05420017
058300     COMPUTE H-HHA-REVENUE-SUM1-6-QTY-ALL ROUNDED =               05430017
058400             H-HHA-REVENUE-QTY-COV-VISITS (1) +                   05440017
058500             H-HHA-REVENUE-QTY-COV-VISITS (2) +                   05450017
058600             H-HHA-REVENUE-QTY-COV-VISITS (3) +                   05460017
058700             H-HHA-REVENUE-QTY-COV-VISITS (4) +                   05470017
058800             H-HHA-REVENUE-QTY-COV-VISITS (5) +                   05480017
058900             H-HHA-REVENUE-QTY-COV-VISITS (6).                    05490017
059000                                                                  05500017
059100     IF H-HHA-REVENUE-SUM1-6-QTY-ALL < 5                          05510017
059200        PERFORM 1050-LUPA THRU 1050-EXIT                          05520017
059300            VARYING SUB1 FROM 1 BY 1 UNTIL                        05530017
059400***         (H-HHA-REVENUE-CODE (SUB1) = SPACES OR                05540017
059500             SUB1 > 6                                             05550017
059600        MOVE '06' TO H-HHA-PAY-RTC                                05560017
059700        COMPUTE H-HHA-TOTAL-PAYMENT   ROUNDED =                   05570017
059800                H-HHA-REVENUE-COST (1) +                          05580017
059900                H-HHA-REVENUE-COST (2) +                          05590017
060000                H-HHA-REVENUE-COST (3) +                          05600017
060100                H-HHA-REVENUE-COST (4) +                          05610017
060200                H-HHA-REVENUE-COST (5) +                          05620017
060300                H-HHA-REVENUE-COST (6)                            05630017
060400        GO TO 1000-EXIT.                                          05640017
060500                                                                  05650017
060600     IF (H-HHA-PEP-INDICATOR NOT = 'Y' AND NOT = 'N')             05660017
060700         MOVE '20' TO H-HHA-PAY-RTC                               05670017
060800         GO TO 1000-EXIT.                                         05680017
060900                                                                  05690017
061000      PERFORM 1100-ADD-HRG-DAYS THRU 1100-EXIT                    05700017
061100         VARYING CO1 FROM 1 BY 1 UNTIL CO1 > 6.                   05710017
061200                                                                  05720017
061300      IF WK-HRG-NO-OF-DAYS-TOT > 60                               05730017
061400         MOVE '16' TO H-HHA-PAY-RTC                               05740017
061500         GO TO 1000-EXIT.                                         05750017
061600                                                                  05760017
061700                                                                  05770017
061800*********  HRG  PAYMENT   *******************                     05780017
061900                                                                  05790017
062000***  IF H-HHA-REVENUE-SUM1-3-QTY-THR > 9                          05800017
062100        IF H-HHA-HRG-INPUT-CODE (2) = SPACES                      05810017
062200           IF H-HHA-PEP-INDICATOR = 'N'                           05820017
062300              PERFORM 3000-PEP-N-ADJUST THRU 3000-EXIT            05830017
062400                  VARYING CO1 FROM 1 BY 1 UNTIL                   05840017
062500*                 (H-HHA-HRG-INPUT-CODE (CO1) = SPACES OR         05850017
062600                   CO1 > 6                                        05860017
062700               PERFORM 7000-OUTLIER-PAYMENT THRU 7000-EXIT        05870017
062800               GO TO 1000-EXIT.                                   05880017
062900                                                                  05890017
063000                                                                  05900017
063100***  IF H-HHA-REVENUE-SUM1-3-QTY-THR > 9                          05910017
063200        IF H-HHA-HRG-INPUT-CODE (2) = SPACES                      05920017
063300           IF H-HHA-PEP-INDICATOR = 'Y'                           05930017
063400              PERFORM 4000-PEP-Y-ADJUST THRU 4000-EXIT            05940017
063500                  VARYING CO1 FROM 1 BY 1 UNTIL                   05950017
063600*                 (H-HHA-HRG-INPUT-CODE (CO1) = SPACES OR         05960017
063700                   CO1 > 6                                        05970017
063800               PERFORM 7000-OUTLIER-PAYMENT THRU 7000-EXIT        05980017
063900               GO TO 1000-EXIT.                                   05990017
064000                                                                  06000017
064100**** IF H-HHA-REVENUE-SUM1-3-QTY-THR > 9                          06010017
064200        IF H-HHA-HRG-INPUT-CODE (2) NOT = SPACES                  06020017
064300           IF H-HHA-PEP-INDICATOR = 'N'                           06030017
064400              PERFORM 5000-PEP-N-ADJUST THRU 5000-EXIT            06040017
064500                  VARYING CO1 FROM 1 BY 1 UNTIL                   06050017
064600*                 (H-HHA-HRG-INPUT-CODE (CO1) = SPACES OR         06060017
064700                   CO1 > 6                                        06070017
064800               PERFORM 7000-OUTLIER-PAYMENT THRU 7000-EXIT        06080017
064900               GO TO 1000-EXIT.                                   06090017
065000                                                                  06100017
065100**** IF H-HHA-REVENUE-SUM1-3-QTY-THR > 9                          06110017
065200        IF H-HHA-HRG-INPUT-CODE (2) NOT = SPACES                  06120017
065300           IF H-HHA-PEP-INDICATOR = 'Y'                           06130017
065400              PERFORM 6000-PEP-Y-ADJUST THRU 6000-EXIT            06140017
065500                  VARYING CO1 FROM 1 BY 1 UNTIL                   06150017
065600*                 (H-HHA-HRG-INPUT-CODE (CO1) = SPACES OR         06160017
065700                   CO1 > 6                                        06170017
065800               PERFORM 7000-OUTLIER-PAYMENT THRU 7000-EXIT        06180017
065900               GO TO 1000-EXIT.                                   06190017
066000                                                                  06200017
066100                                                                  06210017
066200      MOVE '20' TO H-HHA-PAY-RTC.                                 06220017
066300                                                                  06230017
066400 1000-EXIT.  EXIT.                                                06240017
066500 1050-LUPA.                                                       06250017
066600                                                                  06260017
066700***************************************************************   06270017
066800*                    LUPA PAYMENT                                 06280017
066900***************************************************************   06290017
067000                                                                  06300017
067100     IF H-HHA-REVENUE-CODE (SUB1) = SPACES                        06310017
067200        MOVE 6 TO SUB1                                            06320017
067300        GO TO 1050-EXIT.                                          06330017
067400                                                                  06340017
067500     COMPUTE FED-ADJ ROUNDED =                                    06350017
067600             H-HHA-REVENUE-QTY-COV-VISITS (SUB1) *                06360017
067700             H-HHA-REVENUE-DOLL-RATE (SUB1).                      06370017
067800                                                                  06380017
067900     COMPUTE FED-LABOR-ADJ ROUNDED =                              06390017
068000             WIR-AREA-WAGEIND *                                   06400017
068100             LABOR-PERCENT *                                      06410017
068200             FED-ADJ.                                             06420017
068300                                                                  06430017
068400     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          06440017
068500             NONLABOR-PERCENT *                                   06450017
068600             FED-ADJ.                                             06460017
068700                                                                  06470017
068800     COMPUTE H-HHA-REVENUE-COST (SUB1) ROUNDED =                  06480017
068900             (FED-LABOR-ADJ + FED-NON-LABOR-ADJ).                 06490017
069000                                                                  06500017
069100 1050-EXIT.   EXIT.                                               06510017
069200                                                                  06520017
069300 1100-ADD-HRG-DAYS.                                               06530017
069400                                                                  06540017
069500      IF H-HHA-HRG-NO-OF-DAYS (CO1) NUMERIC                       06550017
069600         ADD H-HHA-HRG-NO-OF-DAYS (CO1) TO                        06560017
069700             WK-HRG-NO-OF-DAYS-TOT.                               06570017
069800                                                                  06580017
069900 1100-EXIT.   EXIT.                                               06590017
070000                                                                  06600017
070100 3000-PEP-N-ADJUST.                                               06610017
070200                                                                  06620017
070300***************************************************************   06630017
070400*           HRG OCCUR < 2 AND PEP = N ADJUSTMENT                  06640017
070500***************************************************************   06650017
070600                                                                  06660017
070700     IF H-HHA-HRG-INPUT-CODE (CO1) = SPACES                       06670017
070800        MOVE 6 TO SUB1                                            06680017
070900        GO TO 3000-EXIT.                                          06690017
071000                                                                  06700017
071100     MOVE H-HHA-HRG-NO-OF-DAYS (CO1) TO WK-HRG-NO-OF-DAYS.        06710017
071200                                                                  06720017
071300     COMPUTE FED-ADJ ROUNDED =                                    06730017
071400               (WK-HRG-NO-OF-DAYS  *                              06740017
071500                H-HHA-HRG-WGTS (CO1) *                            06750017
071600                FED-EPISODE-RATE-AMT) / 60.                       06760017
071700                                                                  06770017
071800     COMPUTE FED-LABOR-ADJ ROUNDED =                              06780017
071900               WIR-AREA-WAGEIND *                                 06790017
072000               LABOR-PERCENT * FED-ADJ.                           06800017
072100                                                                  06810017
072200     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          06820017
072300               NONLABOR-PERCENT * FED-ADJ.                        06830017
072400                                                                  06840017
072500     COMPUTE WK-3000-PEP-N-PAYMENT ROUNDED =                      06850017
072600              (FED-LABOR-ADJ + FED-NON-LABOR-ADJ).                06860017
072700                                                                  06870017
072800     COMPUTE H-HHA-HRG-PAY (CO1) ROUNDED =                        06880017
072900             WK-3000-PEP-N-PAYMENT.                               06890017
073000                                                                  06900017
073100     COMPUTE WK-3000-PEP-N-PRETOT-PAY ROUNDED =                   06910017
073200             WK-3000-PEP-N-PRETOT-PAY + WK-3000-PEP-N-PAYMENT.    06920017
073300                                                                  06930017
073400                                                                  06940017
073500 3000-EXIT.   EXIT.                                               06950017
073600                                                                  06960017
073700 4000-PEP-Y-ADJUST.                                               06970017
073800                                                                  06980017
073900***************************************************************   06990017
074000*           HRG OCCUR < 2 AND PEP = Y ADJUSTMENT                  07000017
074100***************************************************************   07010017
074200                                                                  07020017
074300     IF H-HHA-HRG-INPUT-CODE (CO1) = SPACES                       07030017
074400        MOVE 6 TO SUB1                                            07040017
074500        GO TO 4000-EXIT.                                          07050017
074600                                                                  07060017
074700     MOVE 2 TO WK-RTC-ADJ-IND.                                    07070017
074800                                                                  07080017
074900     MOVE H-HHA-HRG-NO-OF-DAYS (CO1) TO WK-HRG-NO-OF-DAYS.        07090017
075000                                                                  07100017
075100     COMPUTE FED-ADJ ROUNDED =                                    07110017
075200               (WK-HRG-NO-OF-DAYS  *                              07120017
075300                H-HHA-HRG-WGTS (CO1) *                            07130017
075400                FED-EPISODE-RATE-AMT) / 60.                       07140017
075500                                                                  07150017
075600     COMPUTE FED-LABOR-ADJ ROUNDED =                              07160017
075700               WIR-AREA-WAGEIND *                                 07170017
075800               LABOR-PERCENT * FED-ADJ.                           07180017
075900                                                                  07190017
076000     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          07200017
076100               NONLABOR-PERCENT * FED-ADJ.                        07210017
076200                                                                  07220017
076300     COMPUTE WK-4000-PEP-Y-PAYMENT ROUNDED =                      07230017
076400              (FED-LABOR-ADJ + FED-NON-LABOR-ADJ).                07240017
076500                                                                  07250017
076600     COMPUTE H-HHA-HRG-PAY (CO1) ROUNDED =                        07260017
076700             WK-4000-PEP-Y-PAYMENT.                               07270017
076800                                                                  07280017
076900     COMPUTE WK-4000-PEP-Y-PRETOT-PAY ROUNDED =                   07290017
077000             WK-4000-PEP-Y-PRETOT-PAY + WK-4000-PEP-Y-PAYMENT.    07300017
077100                                                                  07310017
077200                                                                  07320017
077300 4000-EXIT.   EXIT.                                               07330017
077400 5000-PEP-N-ADJUST.                                               07340017
077500                                                                  07350017
077600***************************************************************   07360017
077700*           HRG OCCUR > 1 AND PEP = N ADJUSTMENT                  07370017
077800***************************************************************   07380017
077900                                                                  07390017
078000     IF H-HHA-HRG-INPUT-CODE (CO1) = SPACES                       07400017
078100        MOVE 6 TO SUB1                                            07410017
078200        GO TO 5000-EXIT.                                          07420017
078300                                                                  07430017
078400     MOVE 1 TO WK-RTC-ADJ-IND.                                    07440017
078500                                                                  07450017
078600     MOVE H-HHA-HRG-NO-OF-DAYS (CO1) TO WK-HRG-NO-OF-DAYS.        07460017
078700                                                                  07470017
078800     COMPUTE FED-ADJ ROUNDED =                                    07480017
078900               (WK-HRG-NO-OF-DAYS  *                              07490017
079000                H-HHA-HRG-WGTS (CO1) *                            07500017
079100                FED-EPISODE-RATE-AMT) / 60.                       07510017
079200                                                                  07520017
079300     COMPUTE FED-LABOR-ADJ ROUNDED =                              07530017
079400               WIR-AREA-WAGEIND *                                 07540017
079500               LABOR-PERCENT * FED-ADJ.                           07550017
079600                                                                  07560017
079700     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          07570017
079800               NONLABOR-PERCENT * FED-ADJ.                        07580017
079900                                                                  07590017
080000     COMPUTE WK-5000-PEP-N-PAYMENT ROUNDED =                      07600017
080100              (FED-LABOR-ADJ + FED-NON-LABOR-ADJ).                07610017
080200                                                                  07620017
080300     COMPUTE H-HHA-HRG-PAY (CO1) ROUNDED =                        07630017
080400             WK-5000-PEP-N-PAYMENT.                               07640017
080500                                                                  07650017
080600                                                                  07660017
080700     COMPUTE WK-5000-PEP-N-PRETOT-PAY ROUNDED =                   07670017
080800             WK-5000-PEP-N-PRETOT-PAY + WK-5000-PEP-N-PAYMENT.    07680017
080900                                                                  07690017
081000                                                                  07700017
081100 5000-EXIT.   EXIT.                                               07710017
081200 6000-PEP-Y-ADJUST.                                               07720017
081300                                                                  07730017
081400***************************************************************   07740017
081500*           HRG OCCUR > 1 AND PEP = Y SHORTENED EPISODE           07750017
081600***************************************************************   07760017
081700                                                                  07770017
081800     IF H-HHA-HRG-INPUT-CODE (CO1) = SPACES                       07780017
081900        MOVE 6 TO SUB1                                            07790017
082000        GO TO 6000-EXIT.                                          07800017
082100                                                                  07810017
082200     MOVE 3 TO WK-RTC-ADJ-IND.                                    07820017
082300                                                                  07830017
082400     MOVE H-HHA-HRG-NO-OF-DAYS (CO1) TO WK-HRG-NO-OF-DAYS.        07840017
082500     MOVE H-HHA-PEP-DAYS             TO WK-PEP-DAYS.              07850017
082600                                                                  07860017
082700*    COMPUTE FED-ADJ ROUNDED =                                    07870017
082800*        (WK-HRG-NO-OF-DAYS / WK-PEP-DAYS)                        07880017
082900*                                *                                07890017
083000*                    ((WK-PEP-DAYS / 60)                          07900017
083100*                                *                                07910017
083200*          (H-HHA-HRG-WGTS (CO1) * FED-EPISODE-RATE-AMT)).        07920017
083300*                                                                 07930017
083400                                                                  07940017
083500*    COMPUTE FED-ADJ ROUNDED =                                    07950017
083600*        (WK-HRG-NO-OF-DAYS / WK-PEP-DAYS)                        07960017
083700*                                *                                07970017
083800*      ((WK-PEP-DAYS * H-HHA-HRG-WGTS (CO1) *                     07980017
083900*                          FED-EPISODE-RATE-AMT) / 60).           07990017
084000                                                                  08000017
084100     COMPUTE FED-ADJ1 ROUNDED =                                   08010017
084200      ((WK-PEP-DAYS * H-HHA-HRG-WGTS (CO1) *                      08020017
084300                           FED-EPISODE-RATE-AMT) / 60).           08030017
084400                                                                  08040017
084500     COMPUTE FED-ADJ ROUNDED  =                                   08050017
084600                  (FED-ADJ1 * WK-HRG-NO-OF-DAYS) / WK-PEP-DAYS.   08060017
084700                                                                  08070017
084800     COMPUTE FED-LABOR-ADJ ROUNDED =                              08080017
084900               WIR-AREA-WAGEIND *                                 08090017
085000               LABOR-PERCENT * FED-ADJ.                           08100017
085100                                                                  08110017
085200     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          08120017
085300               NONLABOR-PERCENT * FED-ADJ.                        08130017
085400                                                                  08140017
085500     COMPUTE WK-6000-PEP-Y-PAYMENT ROUNDED =                      08150017
085600              (FED-LABOR-ADJ + FED-NON-LABOR-ADJ).                08160017
085700                                                                  08170017
085800     COMPUTE H-HHA-HRG-PAY (CO1) ROUNDED =                        08180017
085900             WK-6000-PEP-Y-PAYMENT.                               08190017
086000                                                                  08200017
086100     COMPUTE WK-6000-PEP-Y-PRETOT-PAY ROUNDED =                   08210017
086200             WK-6000-PEP-Y-PRETOT-PAY + WK-6000-PEP-Y-PAYMENT.    08220017
086300                                                                  08230017
086400                                                                  08240017
086500 6000-EXIT.   EXIT.                                               08250017
086600                                                                  08260017
086700 7000-OUTLIER-PAYMENT.                                            08270017
086800                                                                  08280017
086900***************************************************************   08290017
087000*                    OUTLIER PAYMENT                              08300017
087100***************************************************************   08310017
087200     COMPUTE OUT-THRES-LABOR-ADJ ROUNDED =                        08320017
087300               WIR-AREA-WAGEIND *                                 08330017
087400               LABOR-PERCENT * OUTLIER-THRESHOLD-AMT.             08340017
087500                                                                  08350017
087600     COMPUTE OUT-THRES-NON-LABOR-ADJ ROUNDED =                    08360017
087700               NONLABOR-PERCENT * OUTLIER-THRESHOLD-AMT.          08370017
087800                                                                  08380017
087900     COMPUTE OUT-THRES-AMT-ADJ ROUNDED  =                         08390017
088000             (OUT-THRES-LABOR-ADJ +                               08400017
088100              OUT-THRES-NON-LABOR-ADJ).                           08410017
088200                                                                  08420017
088300      COMPUTE WK-7000-OUTLIER-VALUE-A ROUNDED =                   08430017
088400              OUT-THRES-AMT-ADJ +                                 08440017
088500             WK-3000-PEP-N-PRETOT-PAY +                           08450017
088600             WK-4000-PEP-Y-PRETOT-PAY +                           08460017
088700             WK-5000-PEP-N-PRETOT-PAY +                           08470017
088800             WK-6000-PEP-Y-PRETOT-PAY.                            08480017
088900                                                                  08490017
089000      PERFORM 8000-ADD-REV-DOLL THRU 8000-EXIT                    08500017
089100                  VARYING CO1 FROM 1 BY 1 UNTIL                   08510017
089200                   CO1 > 6.                                       08520017
089300                                                                  08530017
089400      COMPUTE WK-7000-AB-DIFF ROUNDED =                           08540017
089500              WK-8000-OUTLIER-VALUE-B - WK-7000-OUTLIER-VALUE-A.  08550017
089600                                                                  08560017
089700      IF WK-7000-AB-DIFF > ZERO                                   08570017
089800         COMPUTE WK-7000-CALC ROUNDED =                           08580017
089900               OUTL-LOSS-SHAR-RATIO-PERCENT * WK-7000-AB-DIFF     08590017
090000         COMPUTE H-HHA-OUTLIER-PAYMENT ROUNDED =                  08600017
090100               WK-7000-CALC                                       08610017
090200         COMPUTE H-HHA-TOTAL-PAYMENT ROUNDED =                    08620017
090300                (WK-7000-CALC +                                   08630017
090400                 WK-3000-PEP-N-PRETOT-PAY +                       08640017
090500                 WK-4000-PEP-Y-PRETOT-PAY +                       08650017
090600                 WK-5000-PEP-N-PRETOT-PAY +                       08660017
090700                 WK-6000-PEP-Y-PRETOT-PAY)                        08670017
090800          PERFORM 9000-WHICH-RTC-OUTLIER THRU 9000-EXIT           08680019
090900      ELSE                                                        08690017
091000         COMPUTE H-HHA-TOTAL-PAYMENT ROUNDED =                    08700017
091100                (WK-3000-PEP-N-PRETOT-PAY +                       08710017
091200                 WK-4000-PEP-Y-PRETOT-PAY +                       08720017
091300                 WK-5000-PEP-N-PRETOT-PAY +                       08730017
091400                 WK-6000-PEP-Y-PRETOT-PAY)                        08740017
091500          PERFORM 9050-WHICH-RTC-NO-OUTLIER THRU 9050-EXIT.       08750019
091600                                                                  08760017
091700                                                                  08770017
091800 7000-EXIT.   EXIT.                                               08780017
091900 8000-ADD-REV-DOLL.                                               08790017
092000                                                                  08800017
092100***************************************************************   08810017
092200*        ADD ALL REVENUE DOLLARS                                  08820017
092300***************************************************************   08830017
092400                                                                  08840017
092500     IF H-HHA-REVENUE-CODE (CO1) = SPACES                         08850017
092600        MOVE 6 TO SUB1                                            08860017
092700        GO TO 8000-EXIT.                                          08870017
092800                                                                  08880017
092900     COMPUTE FED-ADJ ROUNDED =                                    08890017
093000                H-HHA-REVENUE-DOLL-RATE (CO1) *                   08900017
093100                H-HHA-REVENUE-QTY-COV-VISITS (CO1).               08910017
093200                                                                  08920017
093300     COMPUTE FED-LABOR-ADJ ROUNDED =                              08930017
093400               WIR-AREA-WAGEIND *                                 08940017
093500               LABOR-PERCENT * FED-ADJ.                           08950017
093600                                                                  08960017
093700     COMPUTE FED-NON-LABOR-ADJ ROUNDED =                          08970017
093800               NONLABOR-PERCENT * FED-ADJ.                        08980017
093900                                                                  08990017
094000     COMPUTE WK-8000-OUTLIER-LAB-NLAB ROUNDED =                   09000017
094100              (FED-LABOR-ADJ + FED-NON-LABOR-ADJ).                09010017
094200                                                                  09020017
094300                                                                  09030017
094400     COMPUTE H-HHA-REVENUE-COST (CO1) ROUNDED =                   09040017
094500               WK-8000-OUTLIER-LAB-NLAB.                          09050017
094600                                                                  09060017
094700     COMPUTE WK-8000-OUTLIER-VALUE-B ROUNDED =                    09070017
094800             WK-8000-OUTLIER-VALUE-B + WK-8000-OUTLIER-LAB-NLAB.  09080017
094900                                                                  09090017
095000 8000-EXIT.   EXIT.                                               09100017
095100                                                                  09110017
095200 9000-WHICH-RTC-OUTLIER.                                          09120017
095300                                                                  09130017
095400      MOVE '01' TO H-HHA-PAY-RTC.                                 09140017
095500                                                                  09150017
095600      IF WK-RTC-ADJ-IND = 1  MOVE '08' TO H-HHA-PAY-RTC.          09160017
095700      IF WK-RTC-ADJ-IND = 2  MOVE '11' TO H-HHA-PAY-RTC.          09170017
095800      IF WK-RTC-ADJ-IND = 3  MOVE '13' TO H-HHA-PAY-RTC.          09180017
095900                                                                  09190017
096000                                                                  09200017
096100 9000-EXIT.   EXIT.                                               09210017
096200                                                                  09220017
096300 9050-WHICH-RTC-NO-OUTLIER.                                       09230017
096400                                                                  09240017
096500      MOVE '00' TO H-HHA-PAY-RTC.                                 09250017
096600                                                                  09260017
096700      IF WK-RTC-ADJ-IND = 1  MOVE '07' TO H-HHA-PAY-RTC.          09270017
096800      IF WK-RTC-ADJ-IND = 2  MOVE '09' TO H-HHA-PAY-RTC.          09280017
096900      IF WK-RTC-ADJ-IND = 3  MOVE '12' TO H-HHA-PAY-RTC.          09290017
097000                                                                  09300017
097100                                                                  09310017
097200 9050-EXIT.   EXIT.                                               09320017
097300                                                                  09330017
097400******        L A S T   S O U R C E   S T A T E M E N T   *****   09340017
