000100 IDENTIFICATION DIVISION.                                         00010000
000200 PROGRAM-ID.    HHDRV200.                                         00020000
000300 DATE-COMPILED.                                                   00030000
000400******************************************************************00040000
000500*                CY2020.0 CHANGES                                *00050000
000600*----------------------------------------------------------------*00060000
000700* CHANGED CBSA TABLE FROM 7000 TO 7500                           *00070000
000800******************************************************************00080000
000810* LUPA = LOW UTILIZATION PAYMENT ADJUSTMENT                      *00081000
000820******************************************************************00082000
000830******************************************************************00083000
000840*                      RETURN CODES                               00084000
000850******************************************************************00085000
000860*  00 = FINAL PAYMENT                                             00086000
000870*       TOB = 327, 329, 32F, 32G, 32H, 32I, 32J,                  00087000
000880*             32K, 32M, 32Q, 32P                                  00088000
000890        WITH HRG,REVENUE CODE WHERE NO OUTLIER APPLIES            00089000
000900*  01 = FINAL PAYMENT                                             00090000
001000*       TOB = 327, 329, 32F, 32G, 32H, 32I, 32J,                  00100000
001100*             32K, 32M, 32Q, 32P                                  00110000
001200*       WITH HRG,REVENUE CODE WHERE OUTLIER APPLIES               00120000
001300*  03 = INITIAL HALF PAYMENT PAYMENT WILL BE ZERO                 00130000
001400*       TOB = 322                                                 00140000
001500*  04 = INITIAL HALF PAYMENT PAID AT 50%                          00150000
001600*       TOB = 322                                                 00160000
001700*       WITH INITIAL (FIRST) HRG AND NO REVENUE CODES             00170000
001800*  05 = INITIAL HALF PAYMENT PAID AT 60%                          00180000
001900*       TOB = 322                                                 00190000
002000*       WITH INITIAL (FIRST) HRG AND NO REVENUE CODES             00200000
002100*  06 = LUPA PAYMENT ONLY                                         00210000
002200*       TOB = 327, 329, 32F, 32G, 32H, 32I, 32J,                  00220000
002300*             32K, 32M, 32Q, 32P                                  00230000
002400*       WITH REVENUE CODES AND REVENUE QTYS < 5                   00240000
002500******************************************************************00250000
002600*                                                                 00260000
002700*            HHA-RTC   NO PAYMENTS RETURNED                       00270000
002800*                                                                 00280000
002900*  10 = INVALID TOB                                               00290000
003000*  15 = INVALID PEP DAYS FOR SHORTENED EPISODE                    00300000
003100*  20 = INVALID PEP INDICATOR                                     00310000
003200*  25 = INVALID MED REVIEW INDICATOR                              00320000
003300*  30 = INVALID CBSA CODE                                         00330000
003400*  31 = COUNTY CODE MISSING OR INVALID                            00340000
003500*  35 = INVALID INITIAL PAYMENT INDICATOR                         00350000
003600*       0 = MAKE NORMAL PERCENTAGE PAYMENT                        00360000
003700*       1 = PAY 0%                                                00370000
003800*       2 = MAKE FINAL PAYMENT REDUCED BY 2%                      00380000
003900*       3 = MAKE FINAL PAYMENT REDUCED BY 2%,                     00390000
004000*           PAY RAPS AT 0%                                        00400000
004100*  40 = ADMIT-DATE > SERV-FROM-DATE                               00410000
004200*  70 = INVALID OR NO HRG CODE PRESENT                            00420000
004300*  75 = REMOVED IN CY2020 RELEASE                                 00430000
004400*  80 = INVALID REVENUE CODE                                      00440000
004500*  85 = NO REVENUE CODE PRESENT                                   00450000
004600*       TOB = 327, 329, 32F, 32G, 32H, 32I, 32J,                  00460000
004700*             32K, 32M, 32Q, 32P                                  00470000
004800*                                                                 00480000
004900******************************************************************00490000
005000                                                                  00500000
005100 ENVIRONMENT                     DIVISION.                        00510000
005200 CONFIGURATION                   SECTION.                         00520000
005300 SOURCE-COMPUTER.                IBM-370.                         00530000
005400 OBJECT-COMPUTER.                IBM-370.                         00540000
005500                                                                  00550000
005600 INPUT-OUTPUT SECTION.                                            00560000
005700 FILE-CONTROL.                                                    00570000
005800                                                                  00580000
005900 DATA DIVISION.                                                   00590000
006000 FILE SECTION.                                                    00600000
006100 WORKING-STORAGE SECTION.                                         00610000
006200 01  W-STORAGE-REF               PIC X(49)  VALUE                 00620000
006300     'HHA D R I V E R   - W O R K I N G   S T O R A G E'.         00630000
006400 01  DRV-VERSION                 PIC X(07)  VALUE 'D2020.0'.      00640000
006500 01  HHCAL200                    PIC X(08)  VALUE 'HHCAL200'.     00650000
006600 01  SUB1                        PIC 9(03)  VALUE 0.              00660000
006700 01  SS-REV                      PIC 9(01)  VALUE 0.              00670000
006800 01  TB-REV-DOLL-RATE-UNITS.                                      00680000
006900     05  WK-REV-DOLL-RATE-UNITS  PIC 9(07)V9(02)                  00690000
007000                                 OCCURS 6.                        00700000
007100 01  TB-STDV-DATA.                                                00710000
007200     05 TB-STDV-TABLE           OCCURS 6.                         00720000
007300        10  TB-STDV-REV-CODE           PIC X(04).                 00730000
007400        10  TB-STDV-REV-DOLL-RATE      PIC 9(07)V9(02).           00740000
007500                                                                  00750000
007600 01  L-HRG-THRESHOLD            PIC X(01).                        00760000
007700******************************************************************00770000
007800*    PASSED TO HHCAL PROGRAM                                     *00780000
007900******************************************************************00790000
008000 LINKAGE SECTION.                                                 00800000
008100                                                                  00810000
008200 01  WAGE-INDEX-DATA.                                             00820000
008300     02  WIR-MSA               PIC X(04).                         00830000
008400     02  WIR-EFFDATE           PIC X(08).                         00840000
008500     02  WIR-AREA-WAGEIND      PIC 9(02)V9(04).                   00850000
008600                                                                  00860000
008700 01  MSA-WI-TABLE.                                                00870000
008800     05  M-MSA-DATA        OCCURS 4000                            00880000
008900                           INDEXED BY MU1 MU2 MU3.                00890000
009000         10  TB-MSA        PIC X(04).                             00900000
009100         10  FILLER        PIC X(01).                             00910000
009200         10  TB-EFFDATE    PIC X(08).                             00920000
009300         10  FILLER        PIC X(01).                             00930000
009400         10  TB-WAGEIND    PIC 9(02)V9(04).                       00940000
009500                                                                  00950000
009600 01  CBSA-WAGE-INDEX-DATA.                                        00960000
009700     02  WIR-CBSA              PIC X(05).                         00970000
009800     02  WIR-CBSA-EFFDATE      PIC X(08).                         00980000
009900     02  WIR-CBSA-WAGEIND      PIC 9(02)V9(04).                   00990000
010000                                                                  01000000
010100 01  CBSA-WI-TABLE.                                               01010000
010200     05  T-CBSA-DATA        OCCURS 7500                           01020000
010300                           INDEXED BY MA1 MA2 MA3.                01030000
010400         10  T-CBSA            PIC X(05).                         01040000
010500         10  FILLER            PIC X(01).                         01050000
010600         10  T-CBSA-EFFDATE    PIC X(08).                         01060000
010700         10  FILLER            PIC X(01).                         01070000
010800         10  T-CBSA-WAGEIND    PIC 9(02)V9(04).                   01080000
010900                                                                  01090000
011000 01  HRG-TABLE.                                                   01100000
011100     05  TB-HRG-DATA       OCCURS 432                             01110000
011200                           INDEXED BY HU1 HU2 HU3.                01120000
011300         10  TB-HRG            PIC X(05).                         01130000
011400         10  FILLER            PIC X(01).                         01140000
011500         10  TB-HRG-EFFDATE    PIC X(08).                         01150000
011600         10  FILLER            PIC X(01).                         01160000
011700         10  TB-HRG-WGTS       PIC 9(02)V9(04).                   01170000
011800         10  FILLER            PIC X(01).                         01180000
011900         10  TB-HRG-THRESHOLD  PIC X(01).                         01190000
012000                                                                  01200000
012100 01  REVENUE-TABLE.                                               01210000
012200     05  M-REV-DATA        OCCURS 200                             01220000
012300                           INDEXED BY RU1 RU2 RU3.                01230000
012400         10  TB-REV-CODE.                                         01240000
012500             15  TB-REV-CODE-1ST.                                 01250000
012600                 88  TB-REV-CODE-RURAL-CHECK   VALUE '99'.        01260000
012700                 20  TB-REV-CODE-RURAL       PIC XX.              01270000
012800             15  TB-REV-CODE-2ND           PIC XX.                01280000
012900         10  FILLER                        PIC X(01).             01290000
013000         10  TB-REV-EFFDATE                PIC X(08).             01300000
013100         10  FILLER                        PIC X(01).             01310000
013200         10  TB-REV-DOLL-RATE-NRURAL       PIC 9(07)V9(02).       01320000
013300         10  FILLER                        PIC X(01).             01330000
013400         10  TB-REV-DOLL-RATE-RURAL        PIC 9(07)V9(02).       01340000
013500         10  FILLER                        PIC X.                 01350000
013600         10  TB-DOLL-RATE-NRURAL-NOSUBMIT  PIC 9(07)V9(02).       01360000
013700         10  FILLER                        PIC X.                 01370000
013800         10  TB-DOLL-RATE-RURAL-NOSUBMIT   PIC 9(07)V9(02).       01380000
013900         10  FILLER                        PIC X(01).             01390000
014000         10  TB-REV-UDOLL-RATE-NRURAL      PIC 9(07)V9(02).       01400000
014100         10  FILLER                        PIC X(01).             01410000
014200         10  TB-REV-UDOLL-RATE-RURAL       PIC 9(07)V9(02).       01420000
014300         10  FILLER                        PIC X.                 01430000
014400         10  TB-UDOLL-RATE-NRURAL-NOSUBMIT PIC 9(07)V9(02).       01440000
014500         10  FILLER                        PIC X.                 01450000
014600         10  TB-UDOLL-RATE-RURAL-NOSUBMIT  PIC 9(07)V9(02).       01460000
014700                                                                  01470000
014800*----------------------------------------------------------------*01480000
014900*  INPUT/OUTPUT RECORD LAYOUT - PIC X(650)                       *01490000
015000*  THIS RECORD WAS MODIFIED FOR THE 01/01/2020 RELEASE           *01500000
015100*----------------------------------------------------------------*01510000
015200 01  HHA-INPUT-DATA.                                              01520000
015300     05  HHA-DATA.                                                01530000
015400         10  HHA-NPI                 PIC X(10).                   01540000
015500         10  HHA-HIC                 PIC X(12).                   01550000
015600         10  HHA-PROV-NO             PIC X(06).                   01560000
015700         10  HHA-INIT-PAY-QRP-IND        PIC X(01).               01570000
015800             88  HHA-WITH-DATA-CHECK VALUE '0', '1'.              01580000
015900             88  HHA-NO-DATA-CHECK   VALUE '2', '3'.              01590000
016000         10  HHA-PROV-VBP-ADJ-FAC    PIC 9V9(5).                  01600000
016100         10  HHA-PROV-OUTLIER-PAY-TOTAL PIC 9(08)V9(02).          01610000
016200         10  HHA-PROV-PAYMENT-TOTAL  PIC 9(09)V9(02).             01620000
016300         10  HHA-TOB                 PIC X(03).                   01630000
016400             88 HHA-VALID-TOB-CLAIM  VALUE                        01640000
016500             '327', '329',                                        01650000
016600             '32F', '32G', '32H', '32I', '32J',                   01660000
016700             '32K', '32M', '32Q', '32P'.                          01670000
016800             88 HHA-VALID-TOB-RAP    VALUE                        01680000
016900             '322'.                                               01690000
017000         10  HHA-CBSA                PIC X(05).                   01700000
017100             88  HHA-CBSA-RURAL-CHECK-ALL VALUE                   01710000
017200             '50001', '50002', '50005', '50007', '50025',         01720000
017300             '50028', '50031', '50035', '50036', '50037',         01730000
017400             '50041', '50045', '50047', '50048', '50050',         01740000
017500             '50056', '50057', '50066', '50068', '50071',         01750000
017600             '50073', '50080', '50084', '50087', '50089',         01760000
017700             '50090', '50091', '50103', '50104', '50111',         01770000
017800             '50115', '50117', '50118', '50120', '50121',         01780000
017900             '50139', '50146', '50147', '50149', '50151',         01790000
018000             '50164', '50165', '50168', '50169', '50173',         01800000
018100             '50174', '50177', '50180', '50182', '50183'.         01810000
018200         10  FILLER  REDEFINES  HHA-CBSA.                         01820000
018300             15  HHA-CBSA-RURAL      PIC X(03).                   01830000
018400             88  HHA-CBSA-RURAL-CHECK  VALUE '999'.               01840000
018500             15  FILLER             PIC X(02).                    01850000
018600         10  HHA-COUNTY-CODE         PIC X(05).                   01860000
018700         10  HHA-SERV-FROM-DATE.                                  01870000
018800             15  HHA-FROM-CC         PIC XX.                      01880000
018900             15  HHA-FROM-YYMMDD.                                 01890000
019000                 25  HHA-FROM-YY     PIC XX.                      01900000
019100                 25  HHA-FROM-MM     PIC XX.                      01910000
019200                 25  HHA-FROM-DD     PIC XX.                      01920000
019300         10  HHA-SERV-THRU-DATE.                                  01930000
019400             15  HHA-THRU-CC         PIC XX.                      01940000
019500             15  HHA-THRU-YYMMDD.                                 01950000
019600                 25  HHA-THRU-YY     PIC XX.                      01960000
019700                 25  HHA-THRU-MM     PIC XX.                      01970000
019800                 25  HHA-THRU-DD     PIC XX.                      01980000
019900         10  HHA-ADMIT-DATE.                                      01990000
020000             15  HHA-ADMIT-CC        PIC XX.                      02000000
020100             15  HHA-ADMIT-YYMMDD.                                02010000
020200                 25  HHA-ADMIT-YY    PIC XX.                      02020000
020300                 25  HHA-ADMIT-MM    PIC XX.                      02030000
020400                 25  HHA-ADMIT-DD    PIC XX.                      02040000
020500         10  HHA-LUPA-SRC-ADM           PIC X.                    02050000
020600         10  HHA-ADJ-IND                PIC X.                    02060000
020700         10  HHA-PEP-IND             PIC X.                       02070000
020800         10  HHA-HRG-INPUT-CODE       PIC X(05).                  02080000
020900         10  HHA-HRG-NO-OF-DAYS       PIC 9(03).                  02090000
021000         10  HHA-HRG-WGTS             PIC 9(02)V9(04).            02100000
021100         10  HHA-HRG-PAY              PIC 9(07)V9(02).            02110000
021200         10  HHA-REVENUE-DATA     OCCURS 6.                       02120000
021300             15  HHA-REVENUE-CODE              PIC X(04).         02130000
021400             15  HHA-REVENUE-QTY-COV-VISITS    PIC 9(03).         02140000
021500             15  HHA-REVENUE-QTY-OUTL-UNITS    PIC 9(05).         02150000
021600             15  HHA-REVENUE-EARLIEST-DATE     PIC 9(08).         02160000
021700             15  HHA-REVENUE-DOLL-RATE         PIC 9(07)V9(02).   02170000
021800             15  HHA-REVENUE-COST              PIC 9(07)V9(02).   02180000
021900             15  HHA-REVENUE-ADD-ON-VISIT-AMT  PIC 9(07)V9(02).   02190000
022000         10  HHA-PAY-RTC                PIC 99.                   02200000
022100         10  HHA-REVENUE-SUM1-6-QTY-ALL PIC 9(05).                02210000
022200         10  HHA-OUTLIER-PAYMENT        PIC 9(07)V9(02).          02220000
022300         10  HHA-TOTAL-PAYMENT          PIC 9(07)V9(02).          02230000
022400         10  HHA-VBP-ADJ-AMT            PIC S9(7)V99.             02240000
022500         10  HHA-PPS-STD-VALUE          PIC 9(7)V99.              02250000
022600         10  FILLER                     PIC X(206).               02260000
022700                                                                  02270000
022800*******************************************************           02280000
022900*    RETURNED BY HHCAL PROGRAM AND PASSED ON TO MGR   *           02290000
023000*******************************************************           02300000
023100 01  HOLD-VARIABLES-DATA.                                         02310000
023200     02  HOLD-VAR-DATA.                                           02320000
023300         05  PRICER-OPTION-SW              PIC X(01).             02330000
023400         05  HHOPN-VERSION                 PIC X(07).             02340000
023500         05  HHDRV-VERSION                 PIC X(07).             02350000
023600         05  HHCAL-VERSION                 PIC X(07).             02360000
023700         05  FILLER                        PIC X(20).             02370000
023800                                                                  02380000
023900*================================================================*02390000
024000                                                                  02400000
024100 PROCEDURE  DIVISION USING WAGE-INDEX-DATA                        02410000
024200                           MSA-WI-TABLE                           02420000
024300                           CBSA-WAGE-INDEX-DATA                   02430000
024400                           CBSA-WI-TABLE                          02440000
024500                           HRG-TABLE                              02450000
024600                           REVENUE-TABLE                          02460000
024700                           HHA-INPUT-DATA                         02470000
024800                           HOLD-VARIABLES-DATA.                   02480000
024900                                                                  02490000
025000 0000-MAINLINE  SECTION.                                          02500000
025100                                                                  02510000
025200 0100-PROCESS-RECORDS.                                            02520000
025300                                                                  02530000
025400     MOVE DRV-VERSION TO HHDRV-VERSION.                           02540000
025500                                                                  02550000
025600     INITIALIZE      CBSA-WAGE-INDEX-DATA.                        02560000
025700     INITIALIZE      TB-REV-DOLL-RATE-UNITS.                      02570000
025800                                                                  02580000
025900     IF HHA-VALID-TOB-CLAIM                                       02590000
026000     OR HHA-VALID-TOB-RAP                                         02600000
026100        NEXT SENTENCE                                             02610000
026200     ELSE                                                         02620000
026300        MOVE '10' TO HHA-PAY-RTC                                  02630000
026400        GOBACK.                                                   02640000
026500                                                                  02650000
026600     IF HHA-ADMIT-DATE > HHA-SERV-FROM-DATE                       02660000
026700        MOVE '40' TO HHA-PAY-RTC                                  02670000
026800        GOBACK.                                                   02680000
026900                                                                  02690000
027000     COMPUTE HHA-REVENUE-SUM1-6-QTY-ALL =                         02700000
027100             HHA-REVENUE-QTY-COV-VISITS (1) +                     02710000
027200             HHA-REVENUE-QTY-COV-VISITS (2) +                     02720000
027300             HHA-REVENUE-QTY-COV-VISITS (3) +                     02730000
027400             HHA-REVENUE-QTY-COV-VISITS (4) +                     02740000
027500             HHA-REVENUE-QTY-COV-VISITS (5) +                     02750000
027600             HHA-REVENUE-QTY-COV-VISITS (6).                      02760000
027700                                                                  02770000
027800     IF  HHA-VALID-TOB-CLAIM                                      02780000
027900     AND HHA-HRG-INPUT-CODE = SPACE                               02790000
028000         MOVE '70' TO HHA-PAY-RTC                                 02800000
028100         GOBACK.                                                  02810000
028200                                                                  02820000
028300     IF HHA-PAY-RTC NOT = '00'                                    02830000
028400        GOBACK.                                                   02840000
028500                                                                  02850000
028600     IF  ((HHA-VALID-TOB-CLAIM) AND                               02860000
028700         (HHA-REVENUE-CODE (1) = SPACE OR                         02870000
028800          HHA-REVENUE-CODE (2) = SPACE OR                         02880000
028900          HHA-REVENUE-CODE (3) = SPACE OR                         02890000
029000          HHA-REVENUE-CODE (4) = SPACE OR                         02900000
029100          HHA-REVENUE-CODE (5) = SPACE OR                         02910000
029200          HHA-REVENUE-CODE (6) = SPACE))                          02920000
029300         MOVE '85' TO HHA-PAY-RTC.                                02930000
029400                                                                  02940000
029500     IF HHA-PAY-RTC = '00'                                        02950000
029600        NEXT SENTENCE                                             02960000
029700     ELSE                                                         02970000
029800        GOBACK.                                                   02980000
029900                                                                  02990000
030000*================================================================*03000000
030100*    GET THE CBSA DATA                                           *03010000
030200*================================================================*03020000
030300     PERFORM 1250-GET-CBSA THRU 1250-EXIT.                        03030000
030400     IF HHA-PAY-RTC = '00'                                        03040000
030500        PERFORM 1260-GET-CBSA-WAGE-INDEX THRU 1260-EXIT           03050000
030600        VARYING MA2 FROM MA1 BY 1 UNTIL                           03060000
030700        T-CBSA (MA2) NOT = HHA-CBSA.                              03070000
030800                                                                  03080000
030900*================================================================*03090000
031000*    GET THE HRG DATA                                            *03100000
031100*================================================================*03110000
031200     IF HHA-PAY-RTC = '00'                                        03120000
031300        PERFORM 2000-GET-HRG THRU 2000-EXIT                       03130000
031400     END-IF.                                                      03140000
031500                                                                  03150000
031600*================================================================*03160000
031700*    GET THE REVENUE DATA                                        *03170000
031800*================================================================*03180000
031900     IF HHA-PAY-RTC = '00'                                        03190000
032000        IF HHA-VALID-TOB-CLAIM                                    03200000
032100           PERFORM 2700-GET-REV THRU 2700-EXIT                    03210000
032200               VARYING SUB1 FROM 1 BY 1 UNTIL                     03220000
032300                SUB1 > 6.                                         03230000
032400                                                                  03240000
032500     IF HHA-PAY-RTC = '00'                                        03250000
032600        NEXT SENTENCE                                             03260000
032700     ELSE                                                         03270000
032800        GOBACK.                                                   03280000
032900                                                                  03290000
033000*================================================================*03300000
033100*    FY 2020 VERSION 0                                           *03310000
033200*================================================================*03320000
033300     IF HHA-SERV-FROM-DATE > 20191231                             03330000
033400        CALL HHCAL200 USING HHA-INPUT-DATA                        03340000
033500                            HOLD-VARIABLES-DATA                   03350000
033600                            CBSA-WAGE-INDEX-DATA                  03360000
033700                            TB-REV-DOLL-RATE-UNITS                03370000
033800                            TB-STDV-DATA                          03380000
033900                            L-HRG-THRESHOLD                       03390000
034000         GOBACK.                                                  03400000
034100                                                                  03410000
034200*******************************************************           03420000
034300                                                                  03430000
034400     MOVE '40' TO HHA-PAY-RTC.                                    03440000
034500     GOBACK.                                                      03450000
034600                                                                  03460000
034700 0100-EXIT.  EXIT.                                                03470000
034800                                                                  03480000
034900*================================================================*03490000
035000*    GET THE CBSA DATA                                           *03500000
035100*================================================================*03510000
035200 1250-GET-CBSA.                                                   03520000
035300                                                                  03530000
035400     SET MA1 TO 1.                                                03540000
035500                                                                  03550000
035600     SEARCH T-CBSA-DATA VARYING MA1                               03560000
035700            AT END                                                03570000
035800               MOVE '30' TO HHA-PAY-RTC                           03580000
035900               GO TO 1250-EXIT                                    03590000
036000            WHEN T-CBSA (MA1) = HHA-CBSA                          03600000
036100               SET MA2 TO MA1.                                    03610000
036200                                                                  03620000
036300 1250-EXIT.  EXIT.                                                03630000
036400                                                                  03640000
036500*================================================================*03650000
036600*    GET THE CBSA WAGE INDEX                                     *03660000
036700*    SERV-THRU-DATA (CCYY) = CBSA-EFFECTIVE-DATE (CCYY)          *03670000
036800*================================================================*03680000
036900 1260-GET-CBSA-WAGE-INDEX.                                        03690000
037000                                                                  03700000
037100     IF HHA-VALID-TOB-CLAIM OR HHA-VALID-TOB-RAP                  03710000
037200       IF HHA-SERV-THRU-DATE (1:4) = T-CBSA-EFFDATE (MA2) (1:4)   03720000
037300         IF HHA-SERV-THRU-DATE NOT < T-CBSA-EFFDATE (MA2)         03730000
037400            MOVE T-CBSA       (MA2) TO WIR-CBSA                   03740000
037500            MOVE T-CBSA-EFFDATE (MA2) TO WIR-CBSA-EFFDATE         03750000
037600            MOVE T-CBSA-WAGEIND (MA2) TO WIR-CBSA-WAGEIND         03760000
037700            MOVE '00' TO HHA-PAY-RTC                              03770000
037800            GO TO 1260-EXIT.                                      03780000
037900                                                                  03790000
038000     IF WIR-CBSA-WAGEIND NOT NUMERIC                              03800000
038100           MOVE '30' TO HHA-PAY-RTC.                              03810000
038200                                                                  03820000
038300 1260-EXIT.  EXIT.                                                03830000
038400                                                                  03840000
038500*================================================================*03850000
038600*    GET THE HRG DATA                                            *03860000
038700*================================================================*03870000
038800 2000-GET-HRG.                                                    03880000
038900                                                                  03890000
039000     SET HU1 TO 1.                                                03900000
039100     SEARCH TB-HRG-DATA VARYING HU1                               03910000
039200            AT END                                                03920000
039300               MOVE '70' TO HHA-PAY-RTC                           03930000
039400            WHEN TB-HRG (HU1) = HHA-HRG-INPUT-CODE                03940000
039500               MOVE TB-HRG-WGTS (HU1) TO HHA-HRG-WGTS             03950000
039600               MOVE TB-HRG-THRESHOLD (HU1)                        03960000
039700                                     TO L-HRG-THRESHOLD           03970000
039800     END-SEARCH.                                                  03980000
039900                                                                  03990000
040000 2000-EXIT.  EXIT.                                                04000000
040100                                                                  04010000
040200*================================================================*04020000
040300*    GET THE REVENUE DATA                                        *04030000
040400*================================================================*04040000
040500 2700-GET-REV.                                                    04050000
040600                                                                  04060000
040700     IF HHA-REVENUE-CODE (SUB1) = SPACES                          04070000
040800        MOVE 6 TO SUB1                                            04080000
040900        GO TO 2700-EXIT.                                          04090000
041000                                                                  04100000
041100     SET RU1 TO 1.                                                04110000
041200     SEARCH M-REV-DATA VARYING RU1                                04120000
041300            AT END                                                04130000
041400               MOVE '80' TO HHA-PAY-RTC                           04140000
041500               MOVE 6 TO SUB1                                     04150000
041600               GO TO 2700-EXIT                                    04160000
041700            WHEN TB-REV-CODE (RU1) = HHA-REVENUE-CODE (SUB1)      04170000
041800               SET RU2 TO RU1                                     04180000
041900               PERFORM 2750-GET-REV-DOLLARS THRU 2750-EXIT.       04190000
042000                                                                  04200000
042100 2700-EXIT.  EXIT.                                                04210000
042200                                                                  04220000
042300 2750-GET-REV-DOLLARS.                                            04230000
042400                                                                  04240000
042500      PERFORM 2800-GET-REV-SEARCH THRU 2800-EXIT                  04250000
042600           VARYING RU2 FROM RU1 BY 1 UNTIL                        04260000
042700           TB-REV-CODE (RU2) NOT = HHA-REVENUE-CODE (SUB1).       04270000
042800                                                                  04280000
042900 2750-EXIT.   EXIT.                                               04290000
043000                                                                  04300000
043100 2800-GET-REV-SEARCH.                                             04310000
043200                                                                  04320000
043300     IF HHA-SERV-THRU-DATE NOT < TB-REV-EFFDATE (RU2)             04330000
043400         MOVE TB-REV-CODE             (RU2) TO                    04340000
043500              TB-STDV-REV-CODE      (SUB1)                        04350000
043600         MOVE TB-REV-DOLL-RATE-NRURAL (RU2) TO                    04360000
043700              TB-STDV-REV-DOLL-RATE (SUB1)                        04370000
043800         MOVE TB-REV-DOLL-RATE-NRURAL (RU2) TO                    04380000
043900              HHA-REVENUE-DOLL-RATE (SUB1)                        04390000
044000         MOVE TB-REV-UDOLL-RATE-NRURAL (RU2) TO                   04400000
044100              WK-REV-DOLL-RATE-UNITS (SUB1)                       04410000
044200     ELSE                                                         04420000
044300         GO TO 2800-EXIT.                                         04430000
044400                                                                  04440000
044500     IF HHA-CBSA-RURAL-CHECK                                      04450000
044600     OR HHA-CBSA-RURAL-CHECK-ALL                                  04460000
044700        MOVE TB-REV-CODE             (RU2) TO                     04470000
044800             TB-STDV-REV-CODE      (SUB1)                         04480000
044900        MOVE TB-REV-DOLL-RATE-NRURAL (RU2) TO                     04490000
045000             TB-STDV-REV-DOLL-RATE  (SUB1)                        04500000
045100        IF HHA-WITH-DATA-CHECK                                    04510000
045200            MOVE TB-REV-DOLL-RATE-RURAL (RU2) TO                  04520000
045300                 HHA-REVENUE-DOLL-RATE (SUB1)                     04530000
045400            MOVE TB-REV-UDOLL-RATE-RURAL (RU2) TO                 04540000
045500              WK-REV-DOLL-RATE-UNITS (SUB1)                       04550000
045600        ELSE                                                      04560000
045700            MOVE TB-DOLL-RATE-RURAL-NOSUBMIT (RU2) TO             04570000
045800                 HHA-REVENUE-DOLL-RATE (SUB1)                     04580000
045900            MOVE TB-UDOLL-RATE-RURAL-NOSUBMIT (RU2) TO            04590000
046000              WK-REV-DOLL-RATE-UNITS (SUB1)                       04600000
046100        END-IF                                                    04610000
046200     ELSE                                                         04620000
046300        MOVE TB-REV-CODE             (RU2) TO                     04630000
046400             TB-STDV-REV-CODE      (SUB1)                         04640000
046500        MOVE TB-REV-DOLL-RATE-NRURAL (RU2) TO                     04650000
046600             TB-STDV-REV-DOLL-RATE  (SUB1)                        04660000
046700        IF HHA-WITH-DATA-CHECK                                    04670000
046800           MOVE TB-REV-DOLL-RATE-NRURAL (RU2) TO                  04680000
046900                HHA-REVENUE-DOLL-RATE (SUB1)                      04690000
047000           MOVE TB-REV-UDOLL-RATE-NRURAL (RU2) TO                 04700000
047100              WK-REV-DOLL-RATE-UNITS (SUB1)                       04710000
047200        ELSE                                                      04720000
047300            MOVE TB-DOLL-RATE-NRURAL-NOSUBMIT (RU2) TO            04730000
047400                 HHA-REVENUE-DOLL-RATE (SUB1)                     04740000
047500            MOVE TB-UDOLL-RATE-NRURAL-NOSUBMIT (RU2) TO           04750000
047600              WK-REV-DOLL-RATE-UNITS (SUB1)                       04760000
047700        END-IF                                                    04770000
047800     END-IF.                                                      04780000
047900                                                                  04790000
048000 2800-EXIT.  EXIT.                                                04800000
