000100 IDENTIFICATION DIVISION.                                         00010000
000200 PROGRAM-ID.          HHOPN170.                                   00020000
000400                                                                  00040001
000500*----------------------------------------------------------------*00050000
000510*  THIS PROGRAM CALLS HHDRV170                                   *00051001
000600*----------------------------------------------------------------*00060000
000700                                                                  00070001
019200 DATE-COMPILED.                                                   01920000
019300 ENVIRONMENT                     DIVISION.                        01930000
019400                                                                  01940000
019500 CONFIGURATION                   SECTION.                         01950000
019600 SOURCE-COMPUTER.                IBM-370.                         01960000
019700 OBJECT-COMPUTER.                IBM-370.                         01970000
019800                                                                  01980000
019900 INPUT-OUTPUT SECTION.                                            01990000
020000 FILE-CONTROL.                                                    02000000
020100                                                                  02010000
020200     SELECT MSAFILE    ASSIGN TO UT-S-MSAFILE                     02020000
020300         FILE STATUS IS MSA-STAT.                                 02030000
020400     SELECT CBSAFILE   ASSIGN TO UT-S-CBSAFILE                    02040000
020500         FILE STATUS IS CBSA-STAT.                                02050000
020600     SELECT HRGTABL    ASSIGN TO UT-S-HRGTABL                     02060000
020700         FILE STATUS IS HRG-STAT.                                 02070000
020800     SELECT REVTABL    ASSIGN TO UT-S-REVTABL                     02080000
020900         FILE STATUS IS REV-STAT.                                 02090000
021000                                                                  02100000
021100 DATA DIVISION.                                                   02110000
021200 FILE SECTION.                                                    02120000
021300                                                                  02130000
021400 FD  MSAFILE                                                      02140000
021500     RECORDING MODE IS F                                          02150000
021700     LABEL RECORDS ARE STANDARD.                                  02170000
021800 01  MSA-REC.                                                     02180000
021900     05  MSA-CODE.                                                02190000
022000         10  MSA-BLANK            PIC X(02).                      02200000
022100         10  MSA-STATE            PIC X(02).                      02210000
022200     05  FILLER                   PIC X.                          02220000
022300     05  MSA-EFFDATE              PIC X(08).                      02230000
022400     05  FILLER                   PIC X.                          02240000
022500     05  MSA-WAGEIND              PIC 9(02)V9(04).                02250000
022600     05  FILLER                   PIC X(08).                      02260000
022700     05  MSA-NAME                 PIC X(52).                      02270000
022800                                                                  02280000
022900 FD  CBSAFILE                                                     02290000
023000     RECORDING MODE IS F                                          02300000
023200     LABEL RECORDS ARE STANDARD.                                  02320000
023300 01  F-CBSA-REC.                                                  02330000
023400     05  F-CBSA.                                                  02340000
023500         10  F-CBSA-BLANK            PIC X(03).                   02350000
023600         10  F-CBSA-STATE            PIC X(02).                   02360000
023700     05  FILLER                   PIC X.                          02370000
023800     05  F-CBSA-EFFDATE           PIC X(08).                      02380000
023900     05  FILLER                   PIC X.                          02390000
024000     05  F-CBSA-WAGEIND           PIC 9(02)V9(04).                02400000
024100     05  FILLER                   PIC X(08).                      02410000
024200     05  F-CBSA-NAME              PIC X(51).                      02420000
024300                                                                  02430000
024400 FD  HRGTABL                                                      02440000
024500     RECORDING MODE IS F                                          02450000
024700     LABEL RECORDS ARE STANDARD.                                  02470000
024800 01  HRG-TABL-REC.                                                02480000
024900     05  HRG-CODE                 PIC X(05).                      02490000
025000     05  FILLER                   PIC X.                          02500000
025100     05  HRG-EFFDATE              PIC X(08).                      02510000
025200     05  FILLER                   PIC X.                          02520000
025300     05  HRG-WGTS                 PIC 9(02)V9(04).                02530000
025400     05  FILLER                   PIC X.                          02540000
025500     05  HRG-CODE2                PIC X(05).                      02550000
025600     05  FILLER                   PIC X.                          02560000
025700     05  HRG-WGTS2                PIC 9(02)V9(04).                02570000
025800     05  FILLER                   PIC X(46).                      02580000
025900                                                                  02590000
026000 FD  REVTABL                                                      02600000
026100     RECORDING MODE IS F                                          02610000
026300     LABEL RECORDS ARE STANDARD.                                  02630000
026400 01  REV-TABL-REC.                                                02640000
026500     05  REV-CODE                       PIC X(04).                02650000
026600     05  FILLER                         PIC X.                    02660000
026700     05  REV-EFFDATE                    PIC X(08).                02670000
026800     05  FILLER                         PIC X.                    02680000
026900     05  REV-DOLL-RATE-NRURAL           PIC 9(07)V9(02).          02690000
027000     05  FILLER                         PIC X.                    02700000
027100     05  REV-DOLL-RATE-RURAL            PIC 9(07)V9(02).          02710000
027200     05  FILLER                         PIC X.                    02720000
027300     05  REV-DOLL-RATE-NRURAL-NOSUBMIT  PIC 9(07)V9(02).          02730000
027400     05  FILLER                         PIC X.                    02740000
027500     05  REV-DOLL-RATE-RURAL-NOSUBMIT   PIC 9(07)V9(02).          02750000
027510     05  FILLER                         PIC X.                    02751006
027520     05  REV-UDOLL-RATE-NRURAL          PIC 9(07)V9(02).          02752006
027530     05  FILLER                         PIC X.                    02753006
027540     05  REV-UDOLL-RATE-RURAL           PIC 9(07)V9(02).          02754006
027550     05  FILLER                         PIC X.                    02755006
027560     05  REV-UDOLL-RATE-NRURAL-NOSUBMIT PIC 9(07)V9(02).          02756006
027570     05  FILLER                         PIC X.                    02757006
027580     05  REV-UDOLL-RATE-RURAL-NOSUBMIT  PIC 9(07)V9(02).          02758006
027700                                                                  02770000
027800 WORKING-STORAGE SECTION.                                         02780000
027900 77  W-STORAGE-REF               PIC X(36)  VALUE                 02790004
028000     'HHOPN - W O R K I N G  S T O R A G E'.                      02800008
028100 01  OPN-VERSION                 PIC X(07)  VALUE 'O2017.0'.      02810000
028200 01  DRV-VERSION                 PIC X(07)  VALUE 'D2017.0'.      02820000
030010 01  HHDRV170                    PIC X(08)  VALUE 'HHDRV170'.     03001000
030100 01  SUB1                        PIC 9(03)  VALUE 0.              03010000
030200 01  EOF-SW                      PIC 9(01)  VALUE 0.              03020000
030300 01  EOF-MSA                     PIC 9(01)  VALUE 0.              03030000
030400 01  EOF-CBSA                    PIC 9(01)  VALUE 0.              03040000
030500 01  EOF-HRG                     PIC 9(01)  VALUE 0.              03050000
030600 01  EOF-REV                     PIC 9(01)  VALUE 0.              03060000
030700 01  LOAD-TABLES-SW              PIC 9(01)  VALUE 0.              03070000
030800 01  TABLES-LOADED-SW            PIC 9(01)  VALUE 0.              03080000
030900 01  HRG-CT                      PIC 9(10)  VALUE 0.              03090000
031000 01  MSA-STAT.                                                    03100000
031100     05  MSA-STAT1               PIC X.                           03110000
031200     05  MSA-STAT2               PIC X.                           03120000
031300 01  CBSA-STAT.                                                   03130000
031400     05  CBSA-STAT1               PIC X.                          03140000
031500     05  CBSA-STAT2               PIC X.                          03150000
031600 01  HRG-STAT.                                                    03160000
031700     05  HRG-STAT1               PIC X.                           03170000
031800     05  HRG-STAT2               PIC X.                           03180000
031900 01  REV-STAT.                                                    03190000
032000     05  REV-STAT1               PIC X.                           03200000
032100     05  REV-STAT2               PIC X.                           03210000
032200*******************************************************           03220000
032300*    PASSED TO HHDRV PROGRAM                          *           03230000
032400*******************************************************           03240000
032500 01  WAGE-INDEX-DATA.                                             03250000
032600     02  WIR-MSA               PIC X(04).                         03260000
032700     02  WIR-EFFDATE           PIC X(08).                         03270000
032800     02  WIR-AREA-WAGEIND      PIC 9(02)V9(04).                   03280000
032900                                                                  03290000
033000 01  MSA-WI-TABLE.                                                03300000
033100     05  M-MSA-DATA        OCCURS 4000                            03310000
033200                           INDEXED BY MU1 MU2 MU3.                03320000
033300         10  TB-MSA        PIC X(04).                             03330000
033400         10  FILLER        PIC X(01).                             03340000
033500         10  TB-EFFDATE    PIC X(08).                             03350000
033600         10  FILLER        PIC X(01).                             03360000
033700         10  TB-WAGEIND    PIC 9(02)V9(04).                       03370000
033800                                                                  03380000
033900 01  CBSA-WAGE-INDEX-DATA.                                        03390000
034000     02  WIR-CBSA              PIC X(05).                         03400000
034100     02  WIR-CBSA-EFFDATE      PIC X(08).                         03410000
034200     02  WIR-CBSA-WAGEIND      PIC 9(02)V9(04).                   03420000
034300                                                                  03430000
034400 01  CBSA-WI-TABLE.                                               03440000
034500     05  T-CBSA-DATA        OCCURS 6000                           03450000
034600                           INDEXED BY MA1 MA2 MA3.                03460000
034700         10  T-CBSA            PIC X(05).                         03470000
034800         10  FILLER            PIC X(01).                         03480000
034900         10  T-CBSA-EFFDATE    PIC X(08).                         03490000
035000         10  FILLER            PIC X(01).                         03500000
035100         10  T-CBSA-WAGEIND    PIC 9(02)V9(04).                   03510000
035200                                                                  03520000
035300 01  HRG-WI-TABLE.                                                03530000
035400     05  M-HRG-DATA        OCCURS 4000                            03540000
035500                           INDEXED BY HU1 HU2 HU3.                03550000
035600         10  TB-HRG-HRG        PIC X(05).                         03560000
035700         10  FILLER            PIC X(01).                         03570000
035800         10  TB-HRG-EFFDATE    PIC X(08).                         03580000
035900         10  FILLER            PIC X(01).                         03590000
036000         10  TB-HRG-WGTS       PIC 9(02)V9(04).                   03600000
036100         10  FILLER            PIC X(01).                         03610000
036200         10  TB-HRG-HRG2       PIC X(05).                         03620000
036300         10  FILLER            PIC X(01).                         03630000
036400         10  TB-HRG-WGTS2      PIC 9(02)V9(04).                   03640000
036500                                                                  03650000
036600 01  REVENUE-TABLE.                                               03660000
036700     05  M-REV-DATA        OCCURS 200                             03670000
036800                           INDEXED BY RU1 RU2 RU3.                03680000
036900         10  TB-REV-CODE.                                         03690000
037000             15  TB-REV-CODE-1ST.                                 03700000
037100                 88  TB-REV-CODE-RURAL-CHECK   VALUE '99'.        03710000
037200                 20  TB-REV-CODE-RURAL       PIC XX.              03720000
037300             15  TB-REV-CODE-2ND          PIC XX.                 03730000
037400         10  FILLER                       PIC X(01).              03740000
037500         10  TB-REV-EFFDATE               PIC X(08).              03750000
037600         10  FILLER                       PIC X(01).              03760000
037700         10  TB-REV-DOLL-RATE-NRURAL      PIC 9(07)V9(02).        03770000
037800         10  FILLER                       PIC X(01).              03780000
037900         10  TB-REV-DOLL-RATE-RURAL       PIC 9(07)V9(02).        03790000
038000         10  FILLER                       PIC X.                  03800000
038100         10  TB-DOLL-RATE-NRURAL-NOSUBMIT PIC 9(07)V9(02).        03810000
038200         10  FILLER                       PIC X.                  03820000
038300         10  TB-DOLL-RATE-RURAL-NOSUBMIT  PIC 9(07)V9(02).        03830000
038310         10  FILLER                       PIC X(01).              03831006
038320         10  TB-REV-UDOLL-RATE-NRURAL     PIC 9(07)V9(02).        03832006
038330         10  FILLER                       PIC X(01).              03833006
038340         10  TB-REV-UDOLL-RATE-RURAL      PIC 9(07)V9(02).        03834006
038350         10  FILLER                       PIC X.                  03835006
038360         10  TB-UDOLL-RATE-NRURAL-NOSUBMIT PIC 9(07)V9(02).       03836006
038370         10  FILLER                       PIC X.                  03837006
038380         10  TB-UDOLL-RATE-RURAL-NOSUBMIT PIC 9(07)V9(02).        03838006
038400                                                                  03840000
038500 LINKAGE SECTION.                                                 03850000
038600*----------------------------------------------------------------*03860002
038700*  INPUT/OUTPUT RECORD LAYOUT                                    *03870002
038710*----------------------------------------------------------------*03871002
038900 01  HHA-INPUT-DATA.                                              03890000
039000     05  HHA-DATA.                                                03900000
039100         10  HHA-NPI                 PIC X(10).                   03910000
039200         10  HHA-HIC                 PIC X(12).                   03920000
039300         10  HHA-PROV-NO             PIC X(06).                   03930000
039400         10  HHA-TOB                 PIC XXX.                     03940000
039500         10  HHA-PEP-INDICATOR       PIC X.                       03950000
039600         10  HHA-PEP-DAYS            PIC 999.                     03960000
039700         10  HHA-INIT-PAY-INDICATOR  PIC X.                       03970000
039800             88  HHA-WITH-DATA-CHECK VALUE '0', '1'.              03980000
039900             88  HHA-NO-DATA-CHECK   VALUE '2', '3'.              03990000
040000         10  FILLER                  PIC X(07).                   04000000
040100         10  HHA-MSA1                PIC 9(07)V9(02).             04010000
040200         10  HHA-MSA2-DATA REDEFINES HHA-MSA1.                    04020000
040300             15  FILLER             PIC XXX.                      04030000
040400             15  HHA-MSA2.                                        04040000
040500                 20  HHA-MSA2-1ST.                                04050000
040600                     25  HHA-MSA2-RURAL        PIC XX.            04060000
040700                         88  HHA-MSA2-RURAL-CHECK  VALUE '99'.    04070000
040800                 20  HHA-MSA2-2ND              PIC XX.            04080000
040900             15  FILLER             PIC XX.                       04090000
041000         10  HHA-CBSA-DATA REDEFINES HHA-MSA1.                    04100000
041100             15  FILLER             PIC XX.                       04110000
041200             15  HHA-CBSA.                                        04120000
041300                 20  HHA-CBSA-1ST.                                04130000
041400                     25  HHA-CBSA-RURAL        PIC XXX.           04140000
041500                         88  HHA-CBSA-RURAL-CHECK  VALUE '999'.   04150000
041600                 20  HHA-CBSA-2ND              PIC XX.            04160000
041700             15  FILLER             PIC XX.                       04170000
041800         10  HHA-SERV-FROM-DATE.                                  04180000
041900             15  HHA-FROM-CC         PIC XX.                      04190000
042000             15  HHA-FROM-YYMMDD.                                 04200000
042100                 25  HHA-FROM-YY     PIC XX.                      04210000
042200                 25  HHA-FROM-MM     PIC XX.                      04220000
042300                 25  HHA-FROM-DD     PIC XX.                      04230000
042400         10  HHA-SERV-THRU-DATE.                                  04240000
042500             15  HHA-THRU-CC         PIC XX.                      04250000
042600             15  HHA-THRU-YYMMDD.                                 04260000
042700                 25  HHA-THRU-YY     PIC XX.                      04270000
042800                 25  HHA-THRU-MM     PIC XX.                      04280000
042900                 25  HHA-THRU-DD     PIC XX.                      04290000
043000         10  HHA-ADMIT-DATE.                                      04300000
043100             15  HHA-ADMIT-CC        PIC XX.                      04310000
043200             15  HHA-ADMIT-YYMMDD.                                04320000
043300                 25  HHA-ADMIT-YY    PIC XX.                      04330000
043400                 25  HHA-ADMIT-MM    PIC XX.                      04340000
043500                 25  HHA-ADMIT-DD    PIC XX.                      04350000
043600         10  HHA-HRG-DATA      OCCURS 6.                          04360000
043700             15  HHA-MED-REVIEW-INDICATOR PIC X.                  04370000
043800             15  HHA-HRG-INPUT-CODE       PIC X(05).              04380000
043900             15  HHA-HRG-OUTPUT-CODE      PIC X(05).              04390000
044000             15  HHA-HRG-NO-OF-DAYS       PIC 9(03).              04400000
044100             15  HHA-HRG-WGTS             PIC 9(02)V9(04).        04410000
044200             15  HHA-HRG-PAY              PIC 9(07)V9(02).        04420000
044300         10  HHA-REVENUE-DATA     OCCURS 6.                       04430000
044400             15  HHA-REVENUE-CODE                PIC X(04).       04440000
044500             15  HHA-REVENUE-QTY-COV-VISITS      PIC 9(03).       04450000
044510             15  HHA-REVENUE-QTY-OUTL-UNITS      PIC 9(05).       04451003
044600             15  H-HHA-REVENUE-EARLIEST-DATE     PIC 9(08).       04460000
044700             15  HHA-REVENUE-DOLL-RATE           PIC 9(07)V9(02). 04470000
044800             15  HHA-REVENUE-COST                PIC 9(07)V9(02). 04480000
044900             15  H-HHA-REVENUE-ADD-ON-VISIT-AMT  PIC 9(07)V9(02). 04490000
045000     05  HHA-PASSBACK-DATA.                                       04500000
045100         10  HHA-PAY-RTC                PIC 99.                   04510000
045200         10  HHA-REVENUE-SUM1-3-QTY-THR PIC 9(05).                04520000
045300         10  HHA-REVENUE-SUM1-6-QTY-ALL PIC 9(05).                04530000
045400         10  HHA-OUTLIER-PAYMENT        PIC 9(07)V9(02).          04540000
045500         10  HHA-TOTAL-PAYMENT          PIC 9(07)V9(02).          04550000
045600     05  HHA-CASE-MIX-DATA.                                       04560000
045700         10  HHA-LUPA-ADD-ON-PAYMENT    PIC 9(03)V9(02).          04570000
045800         10  HHA-LUPA-SRC-ADM           PIC X.                    04580000
045900         10  HHA-RECODE-IND             PIC X.                    04590000
046000         10  HHA-EPISODE-TIMING         PIC 9.                    04600000
046100         10  HHA-SEVERITY-POINTS.                                 04610000
046200             15  HHA-CLINICAL-SEV-EQ1   PIC X(01).                04620000
046300             15  HHA-FUNCTION-SEV-EQ1   PIC X(01).                04630000
046400             15  HHA-CLINICAL-SEV-EQ2   PIC X(01).                04640000
046500             15  HHA-FUNCTION-SEV-EQ2   PIC X(01).                04650000
046600             15  HHA-CLINICAL-SEV-EQ3   PIC X(01).                04660000
046700             15  HHA-FUNCTION-SEV-EQ3   PIC X(01).                04670000
046800             15  HHA-CLINICAL-SEV-EQ4   PIC X(01).                04680000
046900             15  HHA-FUNCTION-SEV-EQ4   PIC X(01).                04690000
047000     05  HHA-PROV-TOTAL-DATA.                                     04700000
047100         10  HHA-PROV-OUTLIER-PAY-TOTAL PIC 9(08)V9(02).          04710000
047200         10  HHA-PROV-PAYMET-TOTAL      PIC 9(09)V9(02).          04720000
047300     05  FILLER                         PIC X(51).                04730005
047400                                                                  04740003
047900 01  HOLD-VARIABLES-DATA.                                         04790000
048000     02  HOLD-VAR-DATA.                                           04800000
048100         05  PRICER-OPTION-SW              PIC X(01).             04810000
048200         05  HHOPN-VERSION                 PIC X(07).             04820000
048300         05  HHDRV-VERSION                 PIC X(07).             04830000
048400         05  HHCAL-VERSION                 PIC X(07).             04840000
048500         05  FILLER                        PIC X(20).             04850000
048600                                                                  04860000
048700                                                                  04870000
048800**==================================================***           04880000
048900 PROCEDURE  DIVISION USING HHA-INPUT-DATA                         04890000
049000                           HOLD-VARIABLES-DATA.                   04900000
049100                                                                  04910000
049200 0000-MAINLINE  SECTION.                                          04920000
049300                                                                  04930000
049400     MOVE OPN-VERSION TO HHOPN-VERSION.                           04940000
049500                                                                  04950000
049600**** IF PRICER-OPTION-SW = 'A'                                    04960000
049700        IF TABLES-LOADED-SW NOT NUMERIC                           04970000
049800            MOVE 1 TO TABLES-LOADED-SW.                           04980000
049900                                                                  04990000
050000        IF TABLES-LOADED-SW = 0                                   05000000
050100            PERFORM 1100-LOAD-CBSAFILE THRU 1100-EXIT             05010000
050200            PERFORM 1300-LOAD-MSAFILE THRU 1300-EXIT              05020000
050300            PERFORM 1800-LOAD-HRGTABL THRU 1800-EXIT              05030000
050400            PERFORM 2500-LOAD-REVTABL THRU 2500-EXIT              05040000
050500            MOVE 1 TO TABLES-LOADED-SW.                           05050000
050600                                                                  05060000
050700                                                                  05070000
050800     MOVE ALL '0' TO HHA-PASSBACK-DATA.                           05080000
050900                                                                  05090000
051000 0100-PROCESS-RECORDS.                                            05100000
051100                                                                  05110000
051200*******************************************************           05120000
051300*****    FY 2017 VERSION 0                                        05130000
051400***                                                               05140000
051500         CALL HHDRV170 USING WAGE-INDEX-DATA                      05150000
051600                             MSA-WI-TABLE                         05160000
051700                             CBSA-WAGE-INDEX-DATA                 05170000
051800                             CBSA-WI-TABLE                        05180000
051900                             HRG-WI-TABLE                         05190000
052000                             REVENUE-TABLE                        05200000
052100                             HHA-INPUT-DATA                       05210000
052200                             HOLD-VARIABLES-DATA.                 05220000
052300         GOBACK.                                                  05230000
052400                                                                  05240000
052500                                                                  05250000
052600*******************************************************           05260000
052700                                                                  05270000
052800 0100-EXIT.  EXIT.                                                05280000
052900                                                                  05290000
053000                                                                  05300000
053100 1100-LOAD-CBSAFILE.                                              05310000
053200     OPEN INPUT CBSAFILE.                                         05320000
053300     INITIALIZE CBSA-WI-TABLE.                                    05330000
053400     MOVE 0 TO EOF-CBSA.                                          05340000
053500     SET MA3 TO EOF-CBSA.                                         05350000
053600                                                                  05360000
053700     PERFORM 1200-READ-CBSAFILE THRU 1200-EXIT                    05370000
053800             UNTIL EOF-CBSA = 1.                                  05380000
053900                                                                  05390000
054000     CLOSE CBSAFILE.                                              05400000
054100                                                                  05410000
054200 1100-EXIT.  EXIT.                                                05420000
054300                                                                  05430000
054400 1200-READ-CBSAFILE.                                              05440000
054500     READ CBSAFILE                                                05450000
054600          AT END   MOVE 1 TO EOF-CBSA.                            05460000
054700                                                                  05470000
054800     IF EOF-CBSA = 0                                              05480000
054900        IF F-CBSA-EFFDATE > '20050930' OR                         05490000
055000          (F-CBSA-STATE = '98' OR '99')                           05500000
055100           SET MA3 UP BY 1                                        05510000
055200               MOVE F-CBSA         TO T-CBSA         (MA3)        05520000
055300               MOVE F-CBSA-EFFDATE TO T-CBSA-EFFDATE (MA3)        05530000
055400               MOVE F-CBSA-WAGEIND TO T-CBSA-WAGEIND (MA3).       05540000
055500                                                                  05550000
055600 1200-EXIT.  EXIT.                                                05560000
055700                                                                  05570000
055800 1300-LOAD-MSAFILE.                                               05580000
055900     OPEN INPUT MSAFILE.                                          05590000
056000     INITIALIZE MSA-WI-TABLE.                                     05600000
056100     MOVE 0 TO EOF-MSA.                                           05610000
056200     SET MU3 TO EOF-MSA.                                          05620000
056300                                                                  05630000
056400     PERFORM 1400-READ-MSAFILE THRU 1400-EXIT                     05640000
056500             UNTIL EOF-MSA = 1.                                   05650000
056600                                                                  05660000
056700     CLOSE MSAFILE.                                               05670000
056800                                                                  05680000
056900 1300-EXIT.  EXIT.                                                05690000
057000                                                                  05700000
057100 1400-READ-MSAFILE.                                               05710000
057200     READ MSAFILE                                                 05720000
057300          AT END   MOVE 1 TO EOF-MSA.                             05730000
057400                                                                  05740000
057500     IF EOF-MSA = 0                                               05750000
057600        IF MSA-EFFDATE > '19970930' OR                            05760000
057700          (MSA-STATE = '98' OR '99')                              05770000
057800           SET MU3 UP BY 1                                        05780000
057900               MOVE MSA-CODE    TO TB-MSA     (MU3)               05790000
058000               MOVE MSA-EFFDATE TO TB-EFFDATE (MU3)               05800000
058100               MOVE MSA-WAGEIND TO TB-WAGEIND (MU3).              05810000
058200                                                                  05820000
058300 1400-EXIT.  EXIT.                                                05830000
058400                                                                  05840000
058500                                                                  05850000
058600 1800-LOAD-HRGTABL.                                               05860000
058700     OPEN INPUT HRGTABL.                                          05870000
058800     INITIALIZE HRG-WI-TABLE.                                     05880000
058900     MOVE 0 TO EOF-HRG.                                           05890000
059000     SET HU3 TO EOF-HRG.                                          05900000
059100                                                                  05910000
059200     PERFORM 1900-READ-HRGTABL THRU 1900-EXIT                     05920000
059300             UNTIL EOF-HRG = 1.                                   05930000
059400                                                                  05940000
059500     CLOSE HRGTABL.                                               05950000
059600                                                                  05960000
059700 1800-EXIT.  EXIT.                                                05970000
059800                                                                  05980000
059900 1900-READ-HRGTABL.                                               05990000
060000     READ HRGTABL                                                 06000000
060100          AT END   MOVE 1 TO EOF-HRG.                             06010000
060200     ADD 1 TO HRG-CT.                                             06020000
060300     IF EOF-HRG = 0                                               06030000
060400        SET HU3 UP BY 1                                           06040000
060500            MOVE HRG-CODE     TO TB-HRG-HRG      (HU3)            06050000
060600            MOVE HRG-EFFDATE  TO TB-HRG-EFFDATE  (HU3)            06060000
060700            MOVE HRG-WGTS     TO TB-HRG-WGTS     (HU3)            06070000
060800            MOVE HRG-CODE2    TO TB-HRG-HRG2     (HU3)            06080000
060900            MOVE HRG-WGTS2    TO TB-HRG-WGTS2    (HU3).           06090000
061000                                                                  06100000
061100 1900-EXIT.  EXIT.                                                06110000
061200                                                                  06120000
061300                                                                  06130000
061400 2500-LOAD-REVTABL.                                               06140000
061500     OPEN INPUT REVTABL.                                          06150000
061600     INITIALIZE REVENUE-TABLE.                                    06160000
061700     MOVE 0 TO EOF-REV.                                           06170000
061800     SET RU3 TO EOF-REV.                                          06180000
061900                                                                  06190000
062000     PERFORM 2600-READ-REVTABL THRU 2600-EXIT                     06200000
062100             UNTIL EOF-REV = 1.                                   06210000
062200                                                                  06220000
062300     CLOSE REVTABL.                                               06230000
062400                                                                  06240000
062500 2500-EXIT.  EXIT.                                                06250000
062600                                                                  06260000
062700 2600-READ-REVTABL.                                               06270000
062800     READ REVTABL                                                 06280000
062900          AT END   MOVE 1 TO EOF-REV.                             06290000
063000                                                                  06300000
063100     IF EOF-REV = 0                                               06310000
063200        SET RU3 UP BY 1                                           06320000
063300            MOVE REV-CODE      TO TB-REV-CODE     (RU3)           06330000
063400            MOVE REV-EFFDATE   TO TB-REV-EFFDATE  (RU3)           06340000
063500            MOVE REV-DOLL-RATE-NRURAL TO                          06350000
063600                              TB-REV-DOLL-RATE-NRURAL (RU3)       06360000
063700            MOVE REV-DOLL-RATE-RURAL TO                           06370000
063800                              TB-REV-DOLL-RATE-RURAL (RU3)        06380000
063900            MOVE REV-DOLL-RATE-NRURAL-NOSUBMIT TO                 06390000
064000                          TB-DOLL-RATE-NRURAL-NOSUBMIT (RU3)      06400000
064100            MOVE REV-DOLL-RATE-RURAL-NOSUBMIT TO                  06410000
064200                         TB-DOLL-RATE-RURAL-NOSUBMIT (RU3)        06420000
064201                                                                  06420106
064210            MOVE REV-UDOLL-RATE-NRURAL TO                         06421006
064220                              TB-REV-UDOLL-RATE-NRURAL (RU3)      06422006
064230            MOVE REV-UDOLL-RATE-RURAL TO                          06423006
064240                              TB-REV-UDOLL-RATE-RURAL (RU3)       06424006
064250            MOVE REV-UDOLL-RATE-NRURAL-NOSUBMIT TO                06425006
064260                          TB-UDOLL-RATE-NRURAL-NOSUBMIT (RU3)     06426006
064270            MOVE REV-UDOLL-RATE-RURAL-NOSUBMIT TO                 06427006
064280                         TB-UDOLL-RATE-RURAL-NOSUBMIT (RU3)       06428006
064300     END-IF.                                                      06430000
064400                                                                  06440000
064500 2600-EXIT.  EXIT.                                                06450000
