000100 IDENTIFICATION DIVISION.                                         00010000
000200 PROGRAM-ID.           PPCAL10P.                                  00020000
000300*AUTHOR.            DDS TEAM    .                                 00030000
000400*REMARKS.                CMS.                                     00040000
000500 DATE-COMPILED.                                                   00050000
000600 ENVIRONMENT DIVISION.                                            00060000
000700 CONFIGURATION SECTION.                                           00070000
000800 SOURCE-COMPUTER.            IBM-370.                             00080000
000900 OBJECT-COMPUTER.            IBM-370.                             00090000
001000 INPUT-OUTPUT  SECTION.                                           00100000
001100 FILE-CONTROL.                                                    00110000
001200                                                                  00120000
001300 DATA DIVISION.                                                   00130000
001400 FILE SECTION.                                                    00140000
001500                                                                  00150000
001600 WORKING-STORAGE SECTION.                                         00160000
001700 01  W-STORAGE-REF                  PIC X(46)  VALUE              00170000
001800     'PPCAL10P      - W O R K I N G   S T O R A G E'.             00180000
001900 01  CAL-VERSION                    PIC X(05)  VALUE 'C10.P'.     00190000
002000 01  HMO-FLAG                       PIC X      VALUE 'N'.         00200000
002100 01  HMO-TAG                        PIC X      VALUE SPACE.       00210000
002200 01  OUTLIER-RECON-FLAG             PIC X      VALUE 'N'.         00220000
002300 01  TEMP-RELIEF-FLAG               PIC X      VALUE 'N'.         00230000
002400 01  NON-TEMP-RELIEF-PAYMENT        PIC 9(07)V9(02) VALUE ZEROES. 00240000
002500 01  WK-H-OPER-DOLLAR-THRESHOLD     PIC 9(07)V9(09) VALUE ZEROES. 00250000
002600 01  WK-LOW-VOL25PCT                PIC 99V999 VALUE 01.000.      00260000
002700 01  WK-LOW-VOL-ADDON               PIC 9(07)V9(02).              00260000
002800 01  R1                             PIC S9(04) COMP SYNC.         00270000
002900 01  R2                             PIC S9(04) COMP SYNC.         00280000
003000 01  R3                             PIC S9(04) COMP SYNC.         00290000
003100 01  R4                             PIC S9(04) COMP SYNC.         00300000
003200 01  H-OPER-DSH-SCH                 PIC 9(01)V9(04).              00310000
003300 01  H-OPER-DSH-RRC                 PIC 9(01)V9(04).              00320000
003400                                                                  00330000
003500***************************************************************   00340000
003600**************YEARCHANGE 2010.7 *******************************   00341001
003700* TABLE 1                                                     *   00350000
003800*    (69.7% LABOR SHARE/30.3% NONLABOR SHARE)                 *   00360000
003900*    (FULL UPDATE (.697)                                      *   00370000
004000*    (QUALITY = 1 WAGE INDEX > 1)                             *   00380000
004100***************************************************************   00390000
004200 01  TB1-RATE-TABLE.                                              00400000
004300     02  TB1-RATE-WORK.                                           00410000
004400*RATE 20100401 REGION  LABOR AND NON-LABOR RATES                  00420000
004500*                  R3=1     /     R3=2                            00430000
004600*               LARGE URBAN / OTHER URBAN                         00440000
004700*               LABOR / NON / LABOR / NON                         00450000
004800*                     /LABOR/       /LABOR                        00460000
004900*             --------------------------------------------        00470000
005000         05  FILLER PIC X(08) VALUE '20100401'.                   00480000
005100         05  TB1-NAT    PIC X(30) VALUE                           00490000
005200            ' 0358724 162678 0358724 162678'.                     00500000
005300         05  TB1-PR     PIC X(30) VALUE                           00510000
005400            ' 0154361 094207 0154361 094207'.                     00520000
005500         05  TB1-NATPR  PIC X(30) VALUE                           00530000
005600            ' 0358724 162678 0358724 162678'.                     00540000
005700***************************************************************   00550000
005800     02  TB1-RATE-TAB REDEFINES TB1-RATE-WORK.                    00560000
005900         05  TB1-RATE-PERIOD            OCCURS 1.                 00570000
006000             10  TB1-RATE-EFF-DATE      PIC X(08).                00580000
006100             10  TB1-REG-NAT            OCCURS 3.                 00590000
006200                 15  TB1-LARGE-OTHER    OCCURS 2.                 00600000
006300                     20  FILLER         PIC X(01).                00610000
006400                     20  TB1-REG-LABOR  PIC 9(05)V9(02).          00620000
006500                     20  FILLER         PIC X(01).                00630000
006600                     20  TB1-REG-NLABOR PIC 9(04)V9(02).          00640000
006700                                                                  00650000
006800***************************************************************   00660000
006900************YEARCHANGE 2010.7 *********************************   00670000
007000* TABLE 2                                                     *   00680000
007100*    (69.7% LABOR SHARE/30.3% NONLABOR SHARE)                 *   00690000
007200*    (REDUCED UPDATE (.697)                                   *   00700000
007300*    (QUALITY NOT = 1 WAGE INDEX > 1)                         *   00710000
007400***************************************************************   00720000
007500 01  TB2-RATE-TABLE.                                              00730000
007600     02  TB2-RATE-WORK.                                           00740000
007700*RATE 20100401 REGION  LABOR AND NON-LABOR RATES                  00750000
007800*                  R3=1     /     R3=2                            00760000
007900*               LARGE URBAN / OTHER URBAN                         00770000
008000*               LABOR / NON / LABOR / NON                         00780000
008100*                     /LABOR/       /LABOR                        00790000
008200*             --------------------------------------------        00800000
008300         05  FILLER PIC X(08) VALUE '20100401'.                   00810000
008400         05  TB2-NAT    PIC X(30) VALUE                           00820000
008500            ' 0351680 159484 0351680 159484'.                     00830000
008600         05  TB2-PR     PIC X(30) VALUE                           00840000
008700            ' 0154361 094207 0154361 094207'.                     00850000
008800         05  TB2-NATPR  PIC X(30) VALUE                           00860000
008900            ' 0351680 159480 0351680 159485'.                     00870000
009000***************************************************************   00880000
009100     02  TB2-RATE-TAB REDEFINES TB2-RATE-WORK.                    00890000
009200         05  TB2-RATE-PERIOD             OCCURS 1.                00900000
009300             10  TB2-RATE-EFF-DATE       PIC X(08).               00910000
009400             10  TB2-REG-NAT             OCCURS 3.                00920000
009500                 15  TB2-LARGE-OTHER     OCCURS 2.                00930000
009600                     20  FILLER          PIC X(01).               00940000
009700                     20  TB2-REG-LABOR   PIC 9(05)V9(02).         00950000
009800                     20  FILLER          PIC X(01).               00960000
009900                     20  TB2-REG-NLABOR  PIC 9(04)V9(02).         00970000
010000***************************************************************   00990000
010100************YEARCHANGE 2010.7 *********************************   00991000
010200* TABLE 3                                                     *   01000000
010300*    (62% LABOR SHARE/38% NONLABOR SHARE)                     *   01010000
010400*    (FULL UPDATE (.62%)                                      *   01020000
010500*    (QUALITY = 1 WAGE INDEX <= 1)                            *   01030000
010600***************************************************************   01040000
010700 01  TB3-RATE-TABLE.                                              01050000
010800     02  TB3-RATE-WORK.                                           01060000
010900*RATE 20100401 REGION  LABOR AND NON-LABOR RATES                  01070000
011000*                  R3=1     /     R3=2                            01080000
011100*               LARGE URBAN / OTHER URBAN                         01090000
011200*               LABOR / NON / LABOR / NON                         01100000
011300*                     /LABOR/       /LABOR                        01110000
011400*             --------------------------------------------        01120000
011500         05  FILLER PIC X(08) VALUE '20100401'.                   01130000
011600         05  TB3-NAT    PIC X(30) VALUE                           01140000
011700            ' 0323269 198133 0323269 198133'.                     01150000
011800         05  TB3-PR     PIC X(30) VALUE                           01160000
011900            ' 0154112 094456 0154112 094456'.                           00
012000         05  TB3-NATPR  PIC X(30) VALUE                                 00
012100            ' 0323269 198133 0323269 198133'.                     01200000
012200****************************************************************  01210000
012300     02  TB3-RATE-TAB REDEFINES TB3-RATE-WORK.                    01210000
012400         05  TB3-RATE-PERIOD            OCCURS 1.                 01220000
012500             10  TB3-RATE-EFF-DATE      PIC X(08).                01230000
012600             10  TB3-REG-NAT            OCCURS 3.                 01240000
012700                 15  TB3-LARGE-OTHER    OCCURS 2.                 01250000
012800                     20  FILLER         PIC X(01).                01260000
012900                     20  TB3-REG-LABOR  PIC 9(05)V9(02).          01270000
013000                     20  FILLER         PIC X(01).                01280000
013100                     20  TB3-REG-NLABOR PIC 9(04)V9(02).          01290000
013200                                                                  01300000
013300***************************************************************   01310000
013400**********YEARCHANGE 2010.7 ***********************************   01320001
013500* TABLE 4                                                     *   01330000
013600*    (62% LABOR SHARE/38% NONLABOR SHARE)                     *   01340000
013700*    (REDUCED UPDATE (.62%)                                   *   01350000
013800*    (QUALITY NOT = 1 WAGE INDEX <=1)                         *   01360000
013900***************************************************************   01370000
014000 01  TB4-RATE-TABLE.                                              01380000
014100     02  TB4-RATE-WORK.                                           01390000
014200*RATE 20100401 REGION  LABOR AND NON-LABOR RATES                  01400000
014300*                  R3=1     /     R3=2                            01410000
014400*               LARGE URBAN / OTHER URBAN                         01420000
014500*               LABOR / NON / LABOR / NON                         01430000
014600*                     /LABOR/       /LABOR                        01440000
014700*             --------------------------------------------        01450000
014800         05  FILLER PIC X(08) VALUE '20100401'.                   01460000
014900         05  TB4-NAT    PIC X(30) VALUE                           01470000
015000            ' 0316922 194242 0316922 194242'.                     01480001
015100         05  TB4-PR     PIC X(30) VALUE                           01490000
015200            ' 0154112 094456 0154112 094456'.                     01500000
015300         05  TB4-NATPR  PIC X(30) VALUE                           01510000
015400            ' 0316922 194242 0316922 194242'.                     01520001
015500***************************************************************   01530000
015600     02  TB4-RATE-TAB REDEFINES TB4-RATE-WORK.                    01540000
015700         05  TB4-RATE-PERIOD             OCCURS 1.                01550000
015800             10  TB4-RATE-EFF-DATE       PIC X(08).               01560000
015900             10  TB4-REG-NAT             OCCURS 3.                01570000
016000                 15  TB4-LARGE-OTHER     OCCURS 2.                01580000
016100                     20  FILLER          PIC X(01).               01590000
016200                     20  TB4-REG-LABOR   PIC 9(05)V9(02).         01600000
016300                     20  FILLER          PIC X(01).               01610000
016400                     20  TB4-REG-NLABOR  PIC 9(04)V9(02).         01620000
016500                                                                  01630000
016600 01  DRG-TABLE.                                                   01640000
016700     05  D-TAB.                                                   01650000
016800       10  FILLER                  PIC X(08) VALUE
016900     '20091001'.
017000       10  FILLER                  PIC X(56) VALUE
017100     '24854831500439117540164002121826673160038511194122900282'.
017200       10  FILLER                  PIC X(56) VALUE
017300     '10135814900203047569083000920945431560018605061510400123'.
017400       10  FILLER                  PIC X(56) VALUE
017500     '06541917700213042752089001000473411270016303030608800105'.
017600       10  FILLER                  PIC X(56) VALUE
017700     '01864305700069000000000000000000000000000000000000000000'.
017800       10  FILLER                  PIC X(56) VALUE
017900     '00000000000000000000000000000000000000000008439214800183'.
018000       10  FILLER                  PIC X(56) VALUE
018100     '06206812200144043765074000890494010850012103256605700080'.
018200       10  FILLER                  PIC X(56) VALUE
018300     '04823609400121029421061000770209020310004105109010200134'.
018400       10  FILLER                  PIC X(56) VALUE
018500     '02776804800067016019027000350453410900013201918603700055'.
018600       10  FILLER                  PIC X(56) VALUE
018700     '01333102200028031900044000690201650200002901574401300016'.
018800       10  FILLER                  PIC X(56) VALUE
018900     '02919005700083014783024000340100330140001703951809400129'.
019000       10  FILLER                  PIC X(56) VALUE
019100     '02124905200070016448024000330000000000000000000000000000'.
019200       10  FILLER                  PIC X(56) VALUE
019300     '00000000000000000000000000000000000000000000000000000000'.
019400       10  FILLER                  PIC X(56) VALUE
019500     '00000000000000000000000000000000000000000001483604500063'.
019600       10  FILLER                  PIC X(56) VALUE
019700     '00838203100040015637050000680106130360004901695205700077'.
019800       10  FILLER                  PIC X(56) VALUE
019900     '00902803900050015512058000780095810420005100708303200038'.
020000       10  FILLER                  PIC X(56) VALUE
020100     '02916806500087019290050000590151870360004201825805300072'.
020200       10  FILLER                  PIC X(56) VALUE
020300     '01158004100050008223029000350133350430005500859302700034'.
020400       10  FILLER                  PIC X(56) VALUE
020500     '00728902400029017919057000740110270410005200761602600033'.
020600       10  FILLER                  PIC X(56) VALUE
020700     '01293904500060008380033000410166700570007300833603300039'.
020800       10  FILLER                  PIC X(56) VALUE
020900     '01624505300066009822036000430073590270003201146103700050'.
021000       10  FILLER                  PIC X(56) VALUE
021100     '00711302700034020130037000630130310360004900853202200029'.
021200       10  FILLER                  PIC X(56) VALUE
021300     '02057205300074012098038000490078150240003101474104200055'.
021400       10  FILLER                  PIC X(56) VALUE
021500     '00929802900037006818019000240154650450006200916703400043'.
021600       10  FILLER                  PIC X(56) VALUE
021700     '00669102400030034161090001170224160640008101792704700059'.
021800       10  FILLER                  PIC X(56) VALUE
021900     '03023309100115017985063000800120840460005501477804500061'.
022000       10  FILLER                  PIC X(56) VALUE
022100     '00757702800036009772032000440063550240003000000000000000'.
022200       10  FILLER                  PIC X(56) VALUE
022300     '00000000000000000000000000000000000000000000000000000000'.
022400       10  FILLER                  PIC X(56) VALUE
022500     '00000000000000000000000000000000000000000000000000000000'.
022600       10  FILLER                  PIC X(56) VALUE
022700     '01770204000057008825020000260115890320004401141802700040'.
022800       10  FILLER                  PIC X(56) VALUE
022900     '00691401600021000000000000000000000000000000000000000000'.
023000       10  FILLER                  PIC X(56) VALUE
023100     '01000604400056006713034000420071530230002801184304100056'.
023200       10  FILLER                  PIC X(56) VALUE
023300     '00662702600033000000000000000000000000000000000000000000'.
023400       10  FILLER                  PIC X(56) VALUE
023500     '02066103600052012054024000300201460390005701135502100027'.
023600       10  FILLER                  PIC X(56) VALUE
023700     '01588403700055008166017000220185200430006500901501700021'.
023800       10  FILLER                  PIC X(56) VALUE
023900     '01400404000054007458019000240080800140001700000000000000'.
024000       10  FILLER                  PIC X(56) VALUE
024100     '00000000000000000000000000000000000000000000000000000000'.
024200       10  FILLER                  PIC X(56) VALUE
024300     '00000000000000021291067000950123450400005800699502300032'.
024400       10  FILLER                  PIC X(56) VALUE
024500     '00629302200027013363040000540061940230002900939603600046'.
024600       10  FILLER                  PIC X(56) VALUE
024700     '00608402700033013872045000610088230340004300620102400030'.
024800       10  FILLER                  PIC X(56) VALUE
024900     '01476304800066009235035000460059490230003000000000000000'.
025000       10  FILLER                  PIC X(56) VALUE
025100     '00000000000000000000000000000495491170014302516406300075'.
025200       10  FILLER                  PIC X(56) VALUE
025300     '01766204000047037227098001250200680600007601302603400046'.
025400       10  FILLER                  PIC X(56) VALUE
025500     '00000000000000000000000000000000000000000000000000000000'.
025600       10  FILLER                  PIC X(56) VALUE
025700     '00000000000000000000000000000161210590007101068504300051'.
025800       10  FILLER                  PIC X(56) VALUE
025900     '02048307100089014860058000710100880430005201726305900077'.
026000       10  FILLER                  PIC X(56) VALUE
026100     '01206204300056008159030000380144320520006600948303700045'.
026200       10  FILLER                  PIC X(56) VALUE
026300     '00666502600032015917055000710106200390005000761202900036'.
026400       10  FILLER                  PIC X(56) VALUE
026500     '01345504700060012076047000580096220400004800717503200038'.
026600       10  FILLER                  PIC X(56) VALUE
026700     '01437805300066009977043000510070950330003901539605600070'.
026800       10  FILLER                  PIC X(56) VALUE
026900     '01064704200051008137032000390182660640008300974503700048'.
027000       10  FILLER                  PIC X(56) VALUE
027100     '00714402900038008374035000430060550270003300647202100028'.
027200       10  FILLER                  PIC X(56) VALUE
027300     '01256604000054007294026000330517801280015102235805100072'.
027400       10  FILLER                  PIC X(56) VALUE
027500     '00000000000000000000000000000000000000000000000000000000'.
027600       10  FILLER                  PIC X(56) VALUE
027700     '00000000000000000000000000001283040700014410196715500181'.
027800       10  FILLER                  PIC X(56) VALUE
027900     '06593210100112052809076000830793361110013605176707300080'.
028000       10  FILLER                  PIC X(56) VALUE
028100     '04392605700061084829098001240622290380005407547707800099'.
028200       10  FILLER                  PIC X(56) VALUE
028300     '05832103900050065457057000850505190180002807540111800142'.
028400       10  FILLER                  PIC X(56) VALUE
028500     '04842807500085037989050000590767841080012905558908300092'.
028600       10  FILLER                  PIC X(56) VALUE
028700     '06924012000137046212081000870568980950011103612806000065'.
028800       10  FILLER                  PIC X(56) VALUE
028900     '05035507300105029366030000430472751220015502537707900097'.
029000       10  FILLER                  PIC X(56) VALUE
029100     '01492205300063035878063000810257370360004801988802100027'.
029200       10  FILLER                  PIC X(56) VALUE
029300     '04053402200034030955035000500191210170002102841904300060'.
029400       10  FILLER                  PIC X(56) VALUE
029500     '01684002000025027546050000700164550200002702944305300082'.
029600       10  FILLER                  PIC X(56) VALUE
029700     '02281704200059015713019000260253880740009901551805600071'.
029800       10  FILLER                  PIC X(56) VALUE
029900     '00952903400045028006050000680171910200002803295607400107'.
030000       10  FILLER                  PIC X(56) VALUE
030100     '01467702900041010412019000250161630330005402508705600085'.
030200       10  FILLER                  PIC X(56) VALUE
030300     '02240702300034000000000000000000000000000000000000000000'.
030400       10  FILLER                  PIC X(56) VALUE
030500     '00000000000000000000000000000000000000000000000000000000'.
030600       10  FILLER                  PIC X(56) VALUE
030700     '00000000000000000000000000000000000000000000000000000000'.
030800       10  FILLER                  PIC X(56) VALUE
030900     '00000000000000000000000000000000000000000001831305400068'.
031000       10  FILLER                  PIC X(56) VALUE
031100     '01162003600045008177023000290167170330005300802401900027'.
031200       10  FILLER                  PIC X(56) VALUE
031300     '00560201500019019634050000670103210240003103088809200118'.
031400       10  FILLER                  PIC X(56) VALUE
031500     '01849606600080012313045000550146090500006400974003900047'.
031600       10  FILLER                  PIC X(56) VALUE
031700     '00694002900034010104046000570065040360004201166501900030'.
031800       10  FILLER                  PIC X(56) VALUE
031900     '00670401400018004469011000120140450500006400937804000050'.
032000       10  FILLER                  PIC X(56) VALUE
032100     '00652202900036009999031000420056810200002401024203700048'.
032200       10  FILLER                  PIC X(56) VALUE
032300     '00595902200028013076041000560076240260003301218804000053'.
032400       10  FILLER                  PIC X(56) VALUE
032500     '00820703000038005710021000260051280190002300721502500031'.
032600       10  FILLER                  PIC X(56) VALUE
032700     '00540401700021017589050000690095980340004400621102200027'.
032800       10  FILLER                  PIC X(56) VALUE
032900     '00000000000000000000000000000000000000000000000000000000'.
033000       10  FILLER                  PIC X(56) VALUE
033100     '00000000000000000000000000000000000000000000000000000000'.
033200       10  FILLER                  PIC X(56) VALUE
033300     '00000000000000056845129001660270620720009201395003000040'.
033400       10  FILLER                  PIC X(56) VALUE
033500     '05139612700157024981079000920159520490005504776212100145'.
033600       10  FILLER                  PIC X(56) VALUE
033700     '02415007300084016208045000520414221150014002245807300088'.
033800       10  FILLER                  PIC X(56) VALUE
033900     '01444104200052030677086001030179790570006601219703400039'.
034000       10  FILLER                  PIC X(56) VALUE
034100     '02210905100068013112031000390093600170002103034509100113'.
034200       10  FILLER                  PIC X(56) VALUE
034300     '01617905900070011755043000480226570640008701323704200055'.
034400       10  FILLER                  PIC X(56) VALUE
034500     '00766502300029022798057000780126280340004400821001900024'.
034600       10  FILLER                  PIC X(56) VALUE
034700     '02534906400084014337039000490098780230002803959709500130'.
034800       10  FILLER                  PIC X(56) VALUE
034900     '02116005900077013008033000430000000000000000000000000000'.
035000       10  FILLER                  PIC X(56) VALUE
035100     '00000000000000000000000000000000000000000000000000000000'.
035200       10  FILLER                  PIC X(56) VALUE
035300     '00000000000000000000000000000000000000000001658405000066'.
035400       10  FILLER                  PIC X(56) VALUE
035500     '01048003800046007501027000320192140670008701286505400066'.
035600       10  FILLER                  PIC X(56) VALUE
035700     '00861904100048020149064000860126310450005900888303000039'.
035800       10  FILLER                  PIC X(56) VALUE
035900     '01614904900063009873036000430071790270003201733305500070'.
036000       10  FILLER                  PIC X(56) VALUE
036100     '01085303900048007785029000350123990440005500814603100037'.
036200       10  FILLER                  PIC X(56) VALUE
036300     '01708906100080010423043000540078710340004101506005300070'.
036400       10  FILLER                  PIC X(56) VALUE
036500     '00926803900049006341029000350109580390005100692102800035'.
036600       10  FILLER                  PIC X(56) VALUE
036700     '01563204900068009572037000470066660260003200000000000000'.
036800       10  FILLER                  PIC X(56) VALUE
036900     '00000000000000000000000000000000000000000000000000000000'.
037000       10  FILLER                  PIC X(56) VALUE
037100     '00000000000000000000000000000000000000000000000000000000'.
037200       10  FILLER                  PIC X(56) VALUE
037300     '05591112500166026729067000850180680410005204084411300140'.
037400       10  FILLER                  PIC X(56) VALUE
037500     '02310307500088016134052000610396551030012402398207300084'.
037600       10  FILLER                  PIC X(56) VALUE
037700     '01622204500054036023096001170198240620007301290403900045'.
037800       10  FILLER                  PIC X(56) VALUE
037900     '02405006400080016354043000530113340240003004118210200140'.
038000       10  FILLER                  PIC X(56) VALUE
038100     '01698704900068011791032000440422551120014902210506900090'.
038200       10  FILLER                  PIC X(56) VALUE
038300     '01447703900052000000000000000000000000000000000000000000'.
038400       10  FILLER                  PIC X(56) VALUE
038500     '00000000000000000000000000000000000000000001636905100068'.
038600       10  FILLER                  PIC X(56) VALUE
038700     '00907603600046006489027000340172930570007401183104300056'.
038800       10  FILLER                  PIC X(56) VALUE
038900     '00878003000039016993055000740099600400005100686503000036'.
039000       10  FILLER                  PIC X(56) VALUE
039100     '01729005200072009407037000480066310280003501505504900064'.
039200       10  FILLER                  PIC X(56) VALUE
039300     '01038603700046007239025000310000000000000000000000000000'.
039400       10  FILLER                  PIC X(56) VALUE
039500     '00000000000000000000000000000000000000000000000000000000'.
039600       10  FILLER                  PIC X(56) VALUE
039700     '10010811200144069533058000720501970330004008741211200140'.
039800       10  FILLER                  PIC X(56) VALUE
039900     '05961706100072048966038000430615060750009303709703500040'.
040000       10  FILLER                  PIC X(56) VALUE
040100     '04561406500081032056038000420530251220016802838407300095'.
040200       10  FILLER                  PIC X(56) VALUE
040300     '01789604400057046698074000920312070450005202516703400037'.
040400       10  FILLER                  PIC X(56) VALUE
040500     '03328206600079020613035000380461820720010102754702800041'.
040600       10  FILLER                  PIC X(56) VALUE
040700     '02003301500019035040097001250192300620008001065003500046'.
040800       10  FILLER                  PIC X(56) VALUE
040900     '03134308700111021321047000650151210190002802875207600089'.
041000       10  FILLER                  PIC X(56) VALUE
041100     '01837305200057015071043000470230240320003901835802000023'.
041200       10  FILLER                  PIC X(56) VALUE
041300     '03087109300114020558064000760143380450005201677403900050'.
041400       10  FILLER                  PIC X(56) VALUE
041500     '01183002500029017718030000430095220170002102850006800085'.
041600       10  FILLER                  PIC X(56) VALUE
041700     '01780604200051012619027000320287430740010101625404200057'.
041800       10  FILLER                  PIC X(56) VALUE
041900     '01034402000026019228054000740089750220002803024408100110'.
042000       10  FILLER                  PIC X(56) VALUE
042100     '01516904600060009834023000290218350670008801508205100064'.
042200       10  FILLER                  PIC X(56) VALUE
042300     '01028202500033011381025000360181880350004801256801700020'.
042400       10  FILLER                  PIC X(56) VALUE
042500     '01206502200031021482050000640137470320003901003301800022'.
042600       10  FILLER                  PIC X(56) VALUE
042700     '01232703500047007712020000250304140780010101835504500058'.
042800       10  FILLER                  PIC X(56) VALUE
042900     '01364002200030000000000000000000000000000000000000000000'.
043000       10  FILLER                  PIC X(56) VALUE
043100     '00000000000000000000000000000000000000000000000000000000'.
043200       10  FILLER                  PIC X(56) VALUE
043300     '00000000000000000000000000000000000000000000000000000000'.
043400       10  FILLER                  PIC X(56) VALUE
043500     '00000000000000000000000000000000000000000000000000000000'.
043600       10  FILLER                  PIC X(56) VALUE
043700     '01563205000069007386032000390129140450005900712703300039'.
043800       10  FILLER                  PIC X(56) VALUE
043900     '00883103700043005863025000300228390790010501383905700072'.
044000       10  FILLER                  PIC X(56) VALUE
044100     '00942204100052019540066000860112110460005800771703600042'.
044200       10  FILLER                  PIC X(56) VALUE
044300     '02278306300087010758043000530074750300003701928106700090'.
044400       10  FILLER                  PIC X(56) VALUE
044500     '01175805000063007082033000410154420540006900793703300041'.
044600       10  FILLER                  PIC X(56) VALUE
044700     '01105704500057006478029000360096980340004700602702500031'.
044800       10  FILLER                  PIC X(56) VALUE
044900     '01468505400066008387036000430175140520007200985203700048'.
045000       10  FILLER                  PIC X(56) VALUE
045100     '00595902100027013793048000610069270310003601506805300070'.
045200       10  FILLER                  PIC X(56) VALUE
045300     '00907003900048006498028000350000000000000000000000000000'.
045400       10  FILLER                  PIC X(56) VALUE
045500     '00000000000000000000000000000000000000000000000000000000'.
045600       10  FILLER                  PIC X(56) VALUE
045700     '03528610000139019090068000890112600450005603359808200126'.
045800       10  FILLER                  PIC X(56) VALUE
045900     '01723504100062009925024000320285560800010701399703600053'.
046000       10  FILLER                  PIC X(56) VALUE
046100     '00858901800024010226021000280078890150001801487703600055'.
046200       10  FILLER                  PIC X(56) VALUE
046300     '00859301700021000000000000000000000000000000000000000000'.
046400       10  FILLER                  PIC X(56) VALUE
046500     '00000000000000000000000000000000000000000001849906600088'.
046600       10  FILLER                  PIC X(56) VALUE
046700     '01080704900063007523037000470176910600008200828503700047'.
046800       10  FILLER                  PIC X(56) VALUE
046900     '01630205600080010650042000570061020260003500980104200054'.
047000       10  FILLER                  PIC X(56) VALUE
047100     '00594103000036014300055000690081780380004601171904100055'.
047200       10  FILLER                  PIC X(56) VALUE
047300     '00682402700034011964043000590064030280003600000000000000'.
047400       10  FILLER                  PIC X(56) VALUE
047500     '00000000000000000000000000000000000000000000000000000000'.
047600       10  FILLER                  PIC X(56) VALUE
047700     '00000000000000026525050000710138590260003104853713200168'.
047800       10  FILLER                  PIC X(56) VALUE
047900     '02031606900085012713050000610358390500007901825802600034'.
048000       10  FILLER                  PIC X(56) VALUE
048100     '01450001700019042285113001600202710690008901130404500056'.
048200       10  FILLER                  PIC X(56) VALUE
048300     '02238004700071011339020000300075450130001403397807400111'.
048400       10  FILLER                  PIC X(56) VALUE
048500     '02300306800085014359035000480000000000000000000000000000'.
048600       10  FILLER                  PIC X(56) VALUE
048700     '00000000000000000000000000000000000000000000000000000000'.
048800       10  FILLER                  PIC X(56) VALUE
048900     '01330304400058008263033000420055470240002901089603700051'.
049000       10  FILLER                  PIC X(56) VALUE
049100     '00684303000037010463036000490163250580007301045304200053'.
049200       10  FILLER                  PIC X(56) VALUE
049300     '00718703000037000000000000000000000000000000000000000000'.
049400       10  FILLER                  PIC X(56) VALUE
049500     '00000000000000000000000000000000000000000002973606500075'.
049600       10  FILLER                  PIC X(56) VALUE
049700     '05818913300165028942083000940191800500005903259207700099'.
049800       10  FILLER                  PIC X(56) VALUE
049900     '01852304800056013668030000340328120780010701813604400060'.
050000       10  FILLER                  PIC X(56) VALUE
050100     '01281702400030027753074001020137130340004901019301500019'.
050200       10  FILLER                  PIC X(56) VALUE
050300     '02805209000114015506041000610076150180002302248106100084'.
050400       10  FILLER                  PIC X(56) VALUE
050500     '01193803000042007573018000230146980400006000769901900024'.
050600       10  FILLER                  PIC X(56) VALUE
050700     '02919205700097020576045000680131290150002100000000000000'.
050800       10  FILLER                  PIC X(56) VALUE
050900     '00000000000000000000000000000000000000000000000000000000'.
051000       10  FILLER                  PIC X(56) VALUE
051100     '00000000000000016422051000700105230420005200674602900035'.
051200       10  FILLER                  PIC X(56) VALUE
051300     '00899402500034015362055000730102600390005100685202300030'.
051400       10  FILLER                  PIC X(56) VALUE
051500     '01212204800060007708035000420147110310004101104401900023'.
051600       10  FILLER                  PIC X(56) VALUE
051700     '01149603500046006539020000250123960420005700645302600032'.
051800       10  FILLER                  PIC X(56) VALUE
051900     '00814002500035014877050000660095180370004700653302600033'.
052000       10  FILLER                  PIC X(56) VALUE
052100     '00000000000000000000000000000000000000000000000000000000'.
052200       10  FILLER                  PIC X(56) VALUE
052300     '00000000000000000000000000000166910320004201202401700020'.
052400       10  FILLER                  PIC X(56) VALUE
052500     '01835003600060013227013000160171280500007400766601900026'.
052600       10  FILLER                  PIC X(56) VALUE
052700     '01128502900041006364016000190174600410006301005301300015'.
052800       10  FILLER                  PIC X(56) VALUE
052900     '01678204800068007921020000270000000000000000000000000000'.
053000       10  FILLER                  PIC X(56) VALUE
053100     '00000000000000014962054000700097320390005100628802100028'.
053200       10  FILLER                  PIC X(56) VALUE
053300     '01068503900051006979028000350131620500006400733103300041'.
053400       10  FILLER                  PIC X(56) VALUE
053500     '00964203700049005786023000280000000000000000000000000000'.
053600       10  FILLER                  PIC X(56) VALUE
053700     '00000000000000025091056000770113700250003004349011400140'.
053800       10  FILLER                  PIC X(56) VALUE
053900     '01965105800068011766033000370305530770010001502804100049'.
054000       10  FILLER                  PIC X(56) VALUE
054100     '01056802400028013481033000430087870190002201469904100057'.
054200       10  FILLER                  PIC X(56) VALUE
054300     '00772102000025012251029000400084710160001800878401500017'.
054400       10  FILLER                  PIC X(56) VALUE
054500     '02437806600091010159023000300000000000000000000000000000'.
054600       10  FILLER                  PIC X(56) VALUE
054700     '00000000000000018829062000850111840410005500588302200029'.
054800       10  FILLER                  PIC X(56) VALUE
054900     '01718906500084010980048000590077190360004400799203000039'.
055000       10  FILLER                  PIC X(56) VALUE
055100     '00495201900024000000000000000000000000000000000000000000'.
055200       10  FILLER                  PIC X(56) VALUE
055300     '01108304000052007526029000300083890250003001775404700058'.
055400       10  FILLER                  PIC X(56) VALUE
055500     '01890003900069005367015000190000000000000000000000000000'.
055600       10  FILLER                  PIC X(56) VALUE
055700     '00000000000000006873026000330049710210002300680802600035'.
055800       10  FILLER                  PIC X(56) VALUE
055900     '00778601900023004229019000300043860160002100202301200013'.
056000       10  FILLER                  PIC X(56) VALUE
056100     '00635702700038004504017000240000000000000000000000000000'.
056200       10  FILLER                  PIC X(56) VALUE
056300     '00000000000000000000000000000000000000000000000000000000'.
056400       10  FILLER                  PIC X(56) VALUE
056500     '01458301800018048090179001790328441330013301981708600086'.
056600       10  FILLER                  PIC X(56) VALUE
056700     '03373804700047011941034000340016170310003100000000000000'.
056800       10  FILLER                  PIC X(56) VALUE
056900     '00000000000000000000000000000510871050013702531505700074'.
057000       10  FILLER                  PIC X(56) VALUE
057100     '01586503200040034788088001190176800490006901038802400032'.
057200       10  FILLER                  PIC X(56) VALUE
057300     '00000000000000000000000000000000000000000002048706300082'.
057400       10  FILLER                  PIC X(56) VALUE
057500     '01172504100052008689031000390124310390005400775102800037'.
057600       10  FILLER                  PIC X(56) VALUE
057700     '01384603700052015144051000680095960360004600695302700034'.
057800       10  FILLER                  PIC X(56) VALUE
057900     '00000000000000000000000000000000000000000005367312800168'.
058000       10  FILLER                  PIC X(56) VALUE
058100     '02267205200075011632024000330390101150014802152006300086'.
058200       10  FILLER                  PIC X(56) VALUE
058300     '01200302900041045104117001490201110520006901238402800035'.
058400       10  FILLER                  PIC X(56) VALUE
058500     '02608806400096009784023000310000000000000000000000000000'.
058600       10  FILLER                  PIC X(56) VALUE
058700     '00000000000000043709093001510248170590009701259503200049'.
058800       10  FILLER                  PIC X(56) VALUE
058900     '06361618100234030949085001290124960480005902725807700105'.
059000       10  FILLER                  PIC X(56) VALUE
059100     '01507105000067009803032000430168520590007901199704500060'.
059200       10  FILLER                  PIC X(56) VALUE
059300     '00804303100041021717060000850094510270003400823502500032'.
059400       10  FILLER                  PIC X(56) VALUE
059500     '01283704400062000000000000000000000000000000000000000000'.
059600       10  FILLER                  PIC X(56) VALUE
059700     '05494612500163027290088001080170400550007304924911400155'.
059800       10  FILLER                  PIC X(56) VALUE
059900     '02043906300081013521044000550000000000000000000000000000'.
060000       10  FILLER                  PIC X(56) VALUE
060100     '00000000000000019008060000800097020410005100815303100039'.
060200       10  FILLER                  PIC X(56) VALUE
060300     '01360104400062006736028000350237050690009401068004200054'.
060400       10  FILLER                  PIC X(56) VALUE
060500     '00741903300041058007129001550184370540007301115504600056'.
060600       10  FILLER                  PIC X(56) VALUE
060700     '00000000000000000000000000000000000000000002589208000131'.
060800       10  FILLER                  PIC X(56) VALUE
060900     '00000000000000000000000000000000000000000000619102400032'.
061000       10  FILLER                  PIC X(56) VALUE
061100     '00604803100043006676031000440111880490008200945204200056'.
061200       10  FILLER                  PIC X(56) VALUE
061300     '00889905500075007895037000600083360310004700000000000000'.
061400       10  FILLER                  PIC X(56) VALUE
061500     '00000000000000000000000000000000000000000000000000000000'.
061600       10  FILLER                  PIC X(56) VALUE
061700     '00000000000000004021021000290097420820010601415504900068'.
061800       10  FILLER                  PIC X(56) VALUE
061900     '00628803200040000000000000000000000000000000000000000000'.
062000       10  FILLER                  PIC X(56) VALUE
062100     '04054510000150017850057000800101370330004502860107300113'.
062200       10  FILLER                  PIC X(56) VALUE
062300     '01090103400046009991021000310380720810011601873604700065'.
062400       10  FILLER                  PIC X(56) VALUE
062500     '01113502600034000000000000000000000000000000000000000000'.
062600       10  FILLER                  PIC X(56) VALUE
062700     '01347304200060006789026000340125450330004600451301700021'.
062800       10  FILLER                  PIC X(56) VALUE
062900     '01444903700052005839020000270158830440006300940503200043'.
063000       10  FILLER                  PIC X(56) VALUE
063100     '00612102300028013114038000550065560230003200000000000000'.
063200       10  FILLER                  PIC X(56) VALUE
063300     '00000000000000000000000000001373512440032705305211700164'.
063400       10  FILLER                  PIC X(56) VALUE
063500     '02008605000074000000000000000000000000000000000000000000'.
063600       10  FILLER                  PIC X(56) VALUE
063700     '02308102400057013403042000620125070350005300000000000000'.
063800       10  FILLER                  PIC X(56) VALUE
063900     '00000000000000000000000000000285930720010901682103500057'.
064000       10  FILLER                  PIC X(56) VALUE
064100     '01129802000026000000000000000000000000000000000000000000'.
064200       10  FILLER                  PIC X(56) VALUE
064300     '01238808200100011159067000770109220380005100668902800035'.
064400       10  FILLER                  PIC X(56) VALUE
064500     '00975802700048005459025000340072390210004200000000000000'.
064600       10  FILLER                  PIC X(56) VALUE
064700     '00000000000000000000000000000567810890012803436407300091'.
064800       10  FILLER                  PIC X(56) VALUE
064900     '06299310500151036544073000950220000450005800000000000000'.
065000       10  FILLER                  PIC X(56) VALUE
065100     '00000000000000000000000000000276870620009201502604600058'.
065200       10  FILLER                  PIC X(56) VALUE
065300     '00978103100038000000000000000000000000000000000000000000'.
065400       10  FILLER                  PIC X(56) VALUE
065500     '05507413200188025627061000890000000000000000000000000000'.
065600       10  FILLER                  PIC X(56) VALUE
065700     '00000000000000024810071001000135970520006800896703700047'.
065800       10  FILLER                  PIC X(56) VALUE
065900     '01053803700050000000000000000000000000000000000000000000'.
066000       10  FILLER                  PIC X(56) VALUE
066100     '05038911300146028954070000900180720340004603344311700146'.
066200       10  FILLER                  PIC X(56) VALUE
066300     '01948106200087011079029000430340200940012601783605400073'.
066400       10  FILLER                  PIC X(56) VALUE
066500     '01035802600037000000000000000000000000000000000000000000'.
066600       10  FILLER                  PIC X(56) VALUE
066700     '00000000000000000000000000000000000000000000000000000000'.
066800       10  FILLER                  PIC X(56) VALUE
066900     '00000000000000000000000000000000000000000000000000000000'.
067000     05  DRGX-TAB REDEFINES D-TAB.                                04619000
067100         10  DRGX-PERIOD               OCCURS 1                   04619100
067200                                        INDEXED BY DX5.           04619200
067300             15  DRGX-EFF-DATE         PIC X(08).                 04619300
067400             15  DRG-DATA              OCCURS 1000                04619400
067500                                        INDEXED BY DX6.           04619500
067600                 20  DRG-WT            PIC 9(02)V9(04).           04619600
067700                 20  DRG-ALOS          PIC 9(02)V9(01).           04619700
067800                 20  DRG-DAYS-TRIM     PIC 9(02).                 04619800
067900                 20  DRG-ARITH-ALOS    PIC 9(02)V9(01).           04619900
068000
068100*****YEARCHANGE 2010.0 ************************************       20110000
068200
068300 01  PPS-SSRFBN-TABLE.
068400     02  WK-SSRFBN-DATA.
068500         05  FILLER   PIC X(58)  VALUE
068600     '01  099835  01 ALABAMA                                   '.
068700         05  FILLER   PIC X(58)  VALUE
068800     '02  099835  02 ALASKA                                    '.
068900         05  FILLER   PIC X(58)  VALUE
069000     '03  099835  03 ARIZONA                                   '.
069100         05  FILLER   PIC X(58)  VALUE
069200     '04  099835  04 ARKANSAS                                  '.
069300         05  FILLER   PIC X(58)  VALUE
069400     '05  099317  05 CALIFORNIA                                '.
069500          05  FILLER   PIC X(58)  VALUE
069600     '06  099413  06 COLORADO                                  '.
069700         05  FILLER   PIC X(58)  VALUE
069800     '07  098016  07 CONNECTICUT                               '.
069900         05  FILLER   PIC X(58)  VALUE
070000     '08  099835  08 DELAWARE                                  '.
070100         05  FILLER   PIC X(58)  VALUE
070200     '09  099835  09 DISTRICT OF CO                            '.
070300         05  FILLER   PIC X(58)  VALUE
070400     '10  099756  10 FLORIDA                                   '.
070500         05  FILLER   PIC X(58)  VALUE
070600     '11  099835  11 GEORGIA                                   '.
070700         05  FILLER   PIC X(58)  VALUE
070800     '12  099835  12 HAWAII                                    '.
070900         05  FILLER   PIC X(58)  VALUE
071000     '13  099835  13 IDAHO                                     '.
071100         05  FILLER   PIC X(58)  VALUE
071200     '14  099835  14 ILLINOIS                                  '.
071300         05  FILLER   PIC X(58)  VALUE
071400     '15  099813  15 INDIANA                                   '.
071500         05  FILLER   PIC X(58)  VALUE
071600     '16  099783  16 IOWA                                      '.
071700         05  FILLER   PIC X(58)  VALUE
071800     '17  099827  17 KANSAS                                    '.
071900         05  FILLER   PIC X(58)  VALUE
072000     '18  099835  18 KENTUCKY                                  '.
072100         05  FILLER   PIC X(58)  VALUE
072200     '19  099834  19 LOUISIANA                                 '.
072300         05  FILLER   PIC X(58)  VALUE
072400     '20  099835  20 MAINE                                     '.
072500         05  FILLER   PIC X(58)  VALUE
072600     '21  100000  21 MARYLAND                                  '.
072700         05  FILLER   PIC X(58)  VALUE
072800     '22  099834  22 MASSACHUSETTS                             '.
072900         05  FILLER   PIC X(58)  VALUE
073000     '23  099833  23 MICHIGAN                                  '.
073100         05  FILLER   PIC X(58)  VALUE
073200     '24  099835  24 MINNESOTA                                 '.
073300         05  FILLER   PIC X(58)  VALUE
073400     '25  099834  25 MISSISSIPPI                               '.
073500         05  FILLER   PIC X(58)  VALUE
073600     '26  099835  26 MISSOURI                                  '.
073700         05  FILLER   PIC X(58)  VALUE
073800     '27  099835  27 MONTANA                                   '.
073900         05  FILLER   PIC X(58)  VALUE
074000     '28  099835  28 NEBRASKA                                  '.
074100         05  FILLER   PIC X(58)  VALUE
074200     '29  099835  29 NEVADA                                    '.
074300         05  FILLER   PIC X(58)  VALUE
074400     '30  099699  30 NEW HAMPSHIRE                             '.
074500         05  FILLER   PIC X(58)  VALUE
074600     '31  098587  31 NEW JERSEY                                '.
074700         05  FILLER   PIC X(58)  VALUE
074800     '32  099577  32 NEW MEXICO                                '.
074900         05  FILLER   PIC X(58)  VALUE
075000     '33  099835  33 NEW YORK                                  '.
075100         05  FILLER   PIC X(58)  VALUE
075200     '34  099834  34 NORTH CAROLINA                            '.
075300         05  FILLER   PIC X(58)  VALUE
075400     '35  099833  35 NORTH DAKOTA                              '.
075500         05  FILLER   PIC X(58)  VALUE
075600     '36  099784  36 OHIO                                      '.
075700         05  FILLER   PIC X(58)  VALUE
075800     '37  099835  37 OKLAHOMA                                  '.
075900         05  FILLER   PIC X(58)  VALUE
076000     '38  099708  38 OREGON                                    '.
076100         05  FILLER   PIC X(58)  VALUE
076200     '39  099834  39 PENNSYLVANIA                              '.
076300         05  FILLER   PIC X(58)  VALUE
076400     '40  099835  40 PUERTO RICO                               '.
076500         05  FILLER   PIC X(58)  VALUE
076600     '41  099835  41 RHODE ISLAND                              '.
076700         05  FILLER   PIC X(58)  VALUE
076800     '42  099779  42 SOUTH CAROLINA                            '.
076900         05  FILLER   PIC X(58)  VALUE
077000     '43  099834  43 SOUTH DAKOTA                              '.
077100         05  FILLER   PIC X(58)  VALUE
077200     '44  099690  44 TENNESSEE                                 '.
077300         05  FILLER   PIC X(58)  VALUE
077400     '45  099832  45 TEXAS                                     '.
077500         05  FILLER   PIC X(58)  VALUE
077600     '46  099835  46 UTAH                                      '.
077700         05  FILLER   PIC X(58)  VALUE
077800     '47  099835  47 VERMONT                                   '.
077900         05  FILLER   PIC X(58)  VALUE
078000     '48  100000  48 VIRGIN ISLANDS                            '.
078100         05  FILLER   PIC X(58)  VALUE
078200     '49  099835  49 VIRGINIA                                  '.
078300         05  FILLER   PIC X(58)  VALUE
078400     '50  099792  50 WASHINGTON                                '.
078500         05  FILLER   PIC X(58)  VALUE
078600     '51  099712  51 WEST VIRGINIA                             '.
078700         05  FILLER   PIC X(58)  VALUE
078800     '52  099816  52 WISCONSIN                                 '.
078900         05  FILLER   PIC X(58)  VALUE
079000     '53  099835  53 WYOMING                                   '.
079100         05  FILLER   PIC X(58)  VALUE
079200     '55  099317  55 CALIFORNIA                                '.
079300         05  FILLER   PIC X(58)  VALUE
079400     '56  100000  56 CANADA                                    '.
079500         05  FILLER   PIC X(58)  VALUE
079600     '59  100000  59 MEXICO                                    '.
079700         05  FILLER   PIC X(58)  VALUE
079800     '64  100000  64 AMERICAN SAMOA                            '.
079900         05  FILLER   PIC X(58)  VALUE
080000     '65  100000  65 GUAM                                      '.
080100         05  FILLER   PIC X(58)  VALUE
080200     '66  100000  66 MARIANAS ISLANDS                          '.
080300         05  FILLER   PIC X(58)  VALUE
080400     '67  099832  67 TEXAS                                     '.
080500         05  FILLER   PIC X(58)  VALUE
080600     '68  099756  68 FLORIDA                                   '.
080700         05  FILLER   PIC X(58)  VALUE
080800     '69  099756  69 FLORIDA                                   '.
080900         05  FILLER   PIC X(58)  VALUE
081000     '70  099827  70 KANSAS                                    '.
081100         05  FILLER   PIC X(58)  VALUE
081200     '71  099834  71 LOUISIANA                                 '.
081300         05  FILLER   PIC X(58)  VALUE
081400     '72  099784  72 OHIO                                      '.
081500         05  FILLER   PIC X(58)  VALUE
081600     '73  099834  73 PENNSYLVANIA                              '.
081700         05  FILLER   PIC X(58)  VALUE
081800     '74  099832  74 TEXAS                                     '.
081900         05  FILLER   PIC X(58)  VALUE
082000     '75  099317  75 CALIFORNIA                                '.
082100         05  FILLER   PIC X(58)  VALUE
082200     '76  099783  76 IOWA                                      '.
082300         05  FILLER   PIC X(58)  VALUE
082400     '77  099835  77 MINNESOTA                                 '.
082500         05  FILLER   PIC X(58)  VALUE
082600     '78  099835  78 ILLINOIS                                  '.
082700         05  FILLER   PIC X(58)  VALUE
082800     '80  100000  80 MARYLAND                                  '.
082900      02  WK-SSRFBN-DATA2 REDEFINES WK-SSRFBN-DATA.
083000         05  SSRFBN-TAB OCCURS 72 ASCENDING KEY IS WK-SSRFBN-STATE
083100                               INDEXED BY SSRFBN-IDX.
083200           10  WK-SSRFBN-REASON-ALL.
083300              15 WK-SSRFBN-STATE  PIC 99.
083400              15 FILLER           PIC XX.
083500              15 WK-SSRFBN-RATE   PIC 9(1)V9(5).
083600              15 FILLER           PIC XX.
083700              15 WK-SSRFBN-CODE2  PIC 99.
083800              15 FILLER           PIC XX.
083900              15 WK-SSRFBN-STNAM  PIC X(20).
084000              15 WK-SSRFBN-REST   PIC X(22).
084100
084200*****YEARCHANGE 2010.0 ************************************       20110000
084300
084400
084500 01  MES-ADD-PROV                   PIC X(53) VALUE SPACES.
084600 01  MES-CHG-PROV                   PIC X(53) VALUE SPACES.
084700 01  MES-PPS-STATE                  PIC X(02).
084800 01  MES-INTRO                      PIC X(53) VALUE SPACES.
084900 01  MES-TOT-PAY                    PIC 9(07)V9(02) VALUE 0.
085000 01  MES-SSRFBN.
085100     05 MES-SSRFBN-STATE PIC 99.
085200     05 FILLER           PIC XX.
085300     05 MES-SSRFBN-RATE  PIC 9(1)V9(5).
085400     05 FILLER           PIC XX.
085500     05 MES-SSRFBN-CODE2 PIC 99.
085600     05 FILLER           PIC XX.
085700     05 MES-SSRFBN-STNAM PIC X(20).
085800     05 MES-SSRFBN-REST  PIC X(22).
085900
086000                                                                  04620000
086100 01  HOLD-AREA.                                                   04630000
086200     02  HOLD-PPS-COMPONENTS.                                     04640000
086300         05  H-OPER-SHARE-DOLL-THRESHOLD  PIC 9(07)V9(09).        04650000
086400         05  H-CAPI-SHARE-DOLL-THRESHOLD  PIC 9(07)V9(09).        04660000
086500                                                                  04670000
086600         05  H-OPER-HSP-PART              PIC 9(06)V9(09).        04680000
086700         05  H-CAPI-HSP-PART              PIC 9(06)V9(09).        04690000
086800                                                                  04700000
086900         05  H-OPER-FSP-PART              PIC 9(06)V9(09).        04710000
087000         05  H-CAPI-FSP-PART              PIC 9(06)V9(09).        04720000
087100         05  H-CAPI2-B-FSP-PART           PIC 9(06)V9(09).        04730000
087200                                                                  04740000
087300         05  H-OPER-OUTLIER-PART          PIC 9(07)V9(09).        04750000
087400         05  H-CAPI-OUTLIER-PART          PIC 9(07)V9(09).        04760000
087500         05  H-CAPI2-B-OUTLIER-PART       PIC 9(07)V9(09).        04770000
087600                                                                  04780000
087700         05  H-OPER-OUTDAY-PART           PIC 9(07)V9(09).        04790000
087800         05  H-CAPI-OUTDAY-PART           PIC 9(07)V9(09).        04800000
087900                                                                  04810000
088000         05  H-OPER-OUTCST-PART           PIC 9(07)V9(09).        04820000
088100         05  H-CAPI-OUTCST-PART           PIC 9(07)V9(09).        04830000
088200                                                                  04840000
088300         05  H-OPER-CSTCHG-RATIO          PIC 9(01)V9(03).        04850000
088400         05  H-CAPI-CSTCHG-RATIO          PIC 9(01)V9(03).        04860000
088500                                                                  04870000
088600         05  H-OPER-IME-TEACH             PIC 9(06)V9(09).        04880000
088700         05  H-CAPI-PAYCDE-PCT1           PIC 9(01)V9(02).        04890000
088800         05  H-CAPI-PAYCDE-PCT2           PIC 9(01)V9(02).        04900000
088900         05  H-CAPI-COST-OUTLIER          PIC 9(07)V9(09).        04910000
089000         05  H-CAPI-BILL-COSTS            PIC 9(07)V9(09).        04920000
089100         05  H-CAPI-DOLLAR-THRESHOLD      PIC 9(07)V9(09).        04930000
089200         05  H-CAPI-COLA                  PIC 9(01)V9(03).        04940000
089300         05  H-CAPI-SCH                   PIC 9(05)V9(02).        04950000
089400         05  H-CAPI-BUD-NEUTRALITY        PIC 9(01)V9(04).        04960000
089500         05  H-CAPI-OLD-HARMLESS          PIC 9(09)V9(02).        04970000
089600         05  H-CAPI-FED-RATE              PIC 9(05)V9(04).        04980000
089700         05  H-CAPI-FULL-PROS             PIC 9(05)V9(04).        04990000
089800         05  H-CAPI-LARG-URBAN            PIC 9(01)V9(02).        05000000
089900         05  H-CAPI-GAF                   PIC 9(05)V9(04).        05010000
090000         05  H-PR-CAPI-GAF                PIC 9(05)V9(04).        05020000
090100         05  H-BLEND-GAF                  PIC 9(05)V9(04).        05030000
090200         05  H-WAGE-INDEX                 PIC 9(02)V9(04).        05040000
090300         05  H-COV-DAYS                   PIC 9(3).               05050000
090400         05  H-PERDIEM-DAYS               PIC 9(3).               05060000
090500         05  H-REG-DAYS                   PIC 9(3).               05070000
090600         05  H-LTR-DAYS                   PIC 9(3).               05080000
090700         05  H-DSCHG-FRCTN                PIC 9(3)V9999.          05090000
090800         05  H-DRG-WT-FRCTN               PIC 9(2)V9999.          05100000
090900         05  H-ALOS                       PIC 9(02)V9(01).        05110000
091000         05  H-DAYS-CUTOFF                PIC 9(02)V9(01).        05120000
091100         05  H-DAYOUT-PCT                 PIC 9(01)V9(02).        05130000
091200         05  H-CSTOUT-PCT                 PIC 9(01)V9(02).        05140000
091300         05  H-CST-THRESH                 PIC 9(05)V9(02).        05150000
091400         05  H-PRE-CAPI-THRESH            PIC 9(05)V9(02).        05160000
091500         05  H-BUDG-NUTR01                PIC 9(01)V9(06).        05170000
091600         05  H-BUDG-NUTR02                PIC 9(01)V9(06).        05180000
091700         05  H-BUDG-NUTR03                PIC 9(01)V9(06).        05190000
091800         05  H-BUDG-NUTR04                PIC 9(01)V9(06).        05200000
091900         05  H-BUDG-NUTR05                PIC 9(01)V9(06).        05210000
092000         05  H-BUDG-NUTR06                PIC 9(01)V9(06).        05220000
092100         05  H-BUDG-NUTR07                PIC 9(01)V9(06).        05230000
092200         05  H-BUDG-NUTR08                PIC 9(01)V9(06).        05240000
092300         05  H-BUDG-NUTR09                PIC 9(01)V9(06).        05240000
092400         05  H-BUDG-NUTR10                PIC 9(01)V9(06).        05240000
092500         05  H-BUDG-NUTR10D               PIC 9(01)V9(06).        05240000
092600         05  H-CASE-MIX-ADJ               PIC 9(01)V9(03).        05250000
092700         05  H-UPDATE-01                  PIC 9(01)V9(04).        05250000
092800         05  H-UPDATE-02                  PIC 9(01)V9(04).        05260000
092900         05  H-UPDATE-03                  PIC 9(01)V9(04).        05270000
093000         05  H-UPDATE-04                  PIC 9(01)V9(04).        05280000
093100         05  H-UPDATE-05                  PIC 9(01)V9(04).        05290000
093200         05  H-UPDATE-06                  PIC 9(01)V9(04).        05300000
093300         05  H-UPDATE-07                  PIC 9(01)V9(04).        05310000
093400         05  H-UPDATE-08                  PIC 9(01)V9(04).        05320000
093500         05  H-UPDATE-09                  PIC 9(01)V9(04).        05320000
093600         05  H-UPDATE-10                  PIC 9(01)V9(04).        05320000
093700         05  H-UPDATE-10D                 PIC 9(01)V9(04).        05320000
093800         05  H-ACCUM-TO-HSP               PIC 9(01)V9(04).        05330000
093900         05  H-HSP-UPDATE94               PIC 9(01)V9(04).        05340000
094000         05  H-HSP-UPDATE95               PIC 9(01)V9(04).        05350000
094100         05  H-HSP-UPDATE96               PIC 9(01)V9(04).        05360000
094200         05  H-HSP-UPDATE97               PIC 9(01)V9(04).        05370000
094300         05  H-HSP-UPDATE98               PIC 9(01)V9(04).        05380000
094400         05  H-HSP-UPDATE99               PIC 9(01)V9(04).        05390000
094500         05  H-HSP-UPDATE00               PIC 9(01)V9(04).        05400000
094600         05  H-HSP-UPDATE01               PIC 9(01)V9(04).        05410000
094700         05  H-PUERTO-RICO-RATE           PIC 9(04)V9(02).        05420000
094800         05  H-FEDERAL-RATE               PIC 9(04)V9(02).        05430000
094900         05  H-LABOR-PCT                  PIC 9(01)V9(04).        05440000
095000         05  H-NONLABOR-PCT               PIC 9(01)V9(04).        05450000
095100         05  H-PR-LABOR-PCT               PIC 9(01)V9(04).        05460000
095200         05  H-PR-NONLABOR-PCT            PIC 9(01)V9(04).        05470000
095300         05  H-HSP-RATE                   PIC 9(06)V9(09).        05480000
095400         05  H-FSP-RATE                   PIC 9(06)V9(09).        05490000
095500         05  H-OUTLIER-OFFSET-NAT         PIC 9(01)V9(06).        05500000
095600         05  H-OUTLIER-OFFSET-PR          PIC 9(01)V9(06).        05510000
095700         05  H-WK-OPER-DSH                PIC 9(01)V9(04).        05520000
095800         05  H-WK-CAPI-IME-TEACH          PIC 9(06)V9(09).        05530000
095900         05  H-OPER-PR-DOLLAR-THRESHOLD   PIC 9(07)V9(09).        05540000
096000         05  H-CAPI-PR-DOLLAR-THRESHOLD   PIC 9(07)V9(09).        05550000
096100         05  H-DSH-REDUCT-FACTOR          PIC 9(01)V9(04).        05560000
096200         05  H-WK-PASS-AMT-PLUS-MISC      PIC 9(06)V99.           05570000
096300         05  H-BASE-DRG-PAYMENT           PIC S9(07)V99.          05580000
096400         05  H-NEW-TECH-ADDON-NEURO       PIC S9(07)V99.          05590000
096500         05  H-NEW-TECH-ADDON-GRAFT       PIC S9(07)V99.          05600000
096600         05  H-NEW-TECH-ADDON-X-STOP      PIC S9(07)V99.          05610000
096700         05  H-NEW-TECH-ADDON-HRTIMP-STOP PIC S9(07)V99.          05610000
096800         05  H-NEW-TECH-ADDON-ISLET       PIC S9(07)V99.          05620000
096900         05  H-NEW-TECH-ADDON-SPIRAT-STOP PIC S9(07)V99.          05620000
097000         05  H-TECH-ADDON-ISLET-CNTR      PIC S9(02).             05630000
097100         05  H-TECH-ADDON-ISLET-CNTR2     PIC S9(02).             05631000
097200                                                                  05632000
097300         05  H-LESSER-NEURO-1             PIC S9(07)V99.          05633000
097400         05  H-LESSER-NEURO-2             PIC S9(07)V99.          05634000
097500                                                                  05635000
097600         05  H-LESSER-GRAFT-1             PIC S9(07)V99.          05636000
097700         05  H-LESSER-GRAFT-2             PIC S9(07)V99.          05637000
097800                                                                  05638000
097900         05  H-LESSER-X-STOP-1            PIC S9(07)V99.          05639000
098000         05  H-LESSER-X-STOP-2            PIC S9(07)V99.          05640000
098100
098200         05  H-LESSER-HRTIMP-STOP-1       PIC S9(07)V99.
098300         05  H-LESSER-HRTIMP-STOP-2       PIC S9(07)V99.
098400                                                                  05660000
098500         05  H-LESSER-SPIRAT-STOP-1       PIC S9(07)V99.
098600         05  H-LESSER-SPIRAT-STOP-2       PIC S9(07)V99.
098700                                                                  05660000
098800         05  H-CSTMED-NEURO               PIC S9(07)V99.          05670000
098900         05  H-CSTMED-GRAFT               PIC S9(07)V99.          05680000
099000         05  H-CSTMED-X-STOP              PIC S9(07)V99.          05690000
099100         05  H-CSTMED-HRTIMP-STOP         PIC S9(07)V99.          05690000
099200         05  H-CSTMED-SPIRAT-STOP         PIC S9(07)V99.          05690000
099300                                                                  05700000
099400                                                                  05710000
099500     02  HOLD-ADDITIONAL-VARIABLES.                               05720000
099600         05  H-OPER-HSP-PCT               PIC 9(01)V9(02).        05730000
099700         05  H-OPER-FSP-PCT               PIC 9(01)V9(02).        05740000
099800         05  H-NAT-PCT                    PIC 9(01)V9(02).        05750000
099900         05  H-REG-PCT                    PIC 9(01)V9(02).        05760000
100000         05  H-FAC-SPEC-RATE              PIC 9(05)V9(02).        05770000
100100         05  H-UPDATE-FACTOR              PIC 9(01)V9(05).        05780000
100200         05  H-DRG-WT                     PIC 9(02)V9(04).        05790000
100300         05  H-NAT-LABOR                  PIC 9(05)V9(02).        05800000
100400         05  H-NAT-NONLABOR               PIC 9(05)V9(02).        05810000
100500         05  H-REG-LABOR                  PIC 9(05)V9(02).        05820000
100600         05  H-REG-NONLABOR               PIC 9(05)V9(02).        05830000
100700         05  H-OPER-COLA                  PIC 9(01)V9(03).        05840000
100800         05  H-INTERN-RATIO               PIC 9(01)V9(04).        05850000
100900         05  H-OPER-COST-OUTLIER          PIC 9(07)V9(09).        05860000
101000         05  H-OPER-BILL-COSTS            PIC 9(07)V9(09).        05870000
101100         05  H-OPER-DOLLAR-THRESHOLD      PIC 9(07)V9(09).        05880000
101200                                                                  05890000
101300     02  HOLD-CAPITAL-VARIABLES.                                  05900000
101400         05  H-CAPI-TOTAL-PAY             PIC 9(07)V9(02).        05910000
101500         05  H-CAPI-HSP                   PIC 9(07)V9(02).        05920000
101600         05  H-CAPI-FSP                   PIC 9(07)V9(02).        05930000
101700         05  H-CAPI-OUTLIER               PIC 9(07)V9(02).        05940000
101800         05  H-CAPI-OLD-HARM              PIC 9(07)V9(02).        05950000
101900         05  H-CAPI-DSH-ADJ               PIC 9(07)V9(02).        05960000
102000         05  H-CAPI-IME-ADJ               PIC 9(07)V9(02).        05970000
102100         05  H-CAPI-EXCEPTIONS            PIC 9(07)V9(02).        05980000
102200                                                                  05990000
102300     02  HOLD-CAPITAL2-VARIABLES.                                 06000000
102400         05  H-CAPI2-PAY-CODE             PIC X(1).               06010000
102500         05  H-CAPI2-B-FSP                PIC 9(07)V9(02).        06020000
102600         05  H-CAPI2-B-OUTLIER            PIC 9(07)V9(02).        06030000
102700                                                                  06040000
102800     02  HOLD-OTHER-VARIABLES.                                    06050000
102900         05  H-NON-TEMP-RELIEF-PAYMENT    PIC 9(07)V9(02).        06060000
103000         05  H-NEW-TECH-PAY-ADD-ON        PIC 9(07)V9(02).        06070000
103100         05  H-LOW-VOL-PAYMENT            PIC 9(07)V9(02).
103200         05  H-HVBP-HRR-DATA.
103300             10  H-VAL-BASED-PURCH-PARTIPNT PIC X.
103400             10  H-VAL-BASED-PURCH-ADJUST     PIC 9V9(11).
103500             10  H-HOSP-READMISS-REDUCTN      PIC X.
103600             10  H-HOSP-HRR-ADJUSTMT          PIC 9V9(4).
103700         05  H-OPERATNG-DATA.
103800             10  H-MODEL1-BUNDLE-DISPRCNT    PIC V999.
103900             10  H-OPER-BASE-DRG-PAY         PIC 9(08)V99.
104000             10  H-OPER-HSP-AMT              PIC 9(08)V99.
104100                                                                  06090000
104200     02  HOLD-PC-OTH-VARIABLES.                                   06100000
104300         05  H-OPER-DSH                   PIC 9(01)V9(04).        06110000
104400         05  H-CAPI-DSH                   PIC 9(01)V9(04).        06120000
104500         05  H-CAPI-HSP-PCT               PIC 9(01)V9(02).        06130000
104600         05  H-CAPI-FSP-PCT               PIC 9(01)V9(04).        06140000
104700         05  H-ARITH-ALOS                 PIC 9(02)V9(01).        06150000
104800         05  H-PR-WAGE-INDEX              PIC 9(02)V9(04).        06160000
104900         05  H-TRANSFER-ADJ               PIC 9(01)V9(05).        06170000
105000         05  H-PC-HMO-FLAG                PIC X(01).              06180000
105100         05  H-PC-COT-FLAG                PIC X(01).              06190000
105200         05  H-FILLER                     PIC X(0998).
105300                                                                  06210000
105400 01  HLD-PPS-DATA.                                                06220000
105500         10  HLD-PPS-RTC                PIC 9(02).                06230000
105600         10  HLD-PPS-WAGE-INDX          PIC 9(02)V9(04).          06240000
105700         10  HLD-PPS-OUTLIER-DAYS       PIC 9(03).                06250000
105800         10  HLD-PPS-AVG-LOS            PIC 9(02)V9(01).          06260000
105900         10  HLD-PPS-DAYS-CUTOFF        PIC 9(02)V9(01).          06270000
106000         10  HLD-PPS-OPER-IME-ADJ       PIC 9(06)V9(02).          06280000
106100         10  HLD-PPS-TOTAL-PAYMENT      PIC 9(07)V9(02).          06290000
106200         10  HLD-PPS-OPER-HSP-PART      PIC 9(06)V9(02).          06300000
106300         10  HLD-PPS-OPER-FSP-PART      PIC 9(06)V9(02).          06310000
106400         10  HLD-PPS-OPER-OUTLIER-PART  PIC 9(07)V9(02).          06320000
106500         10  HLD-PPS-REG-DAYS-USED      PIC 9(03).                06330000
106600         10  HLD-PPS-LTR-DAYS-USED      PIC 9(02).                06340000
106700         10  HLD-PPS-OPER-DSH-ADJ       PIC 9(06)V9(02).          06350000
106800         10  HLD-PPS-CALC-VERS          PIC X(05).                06360000
106900                                                                  06370000
107000 LINKAGE SECTION.                                                 06380000
107100***************************************************************   06390000
107200*                 * * * * * * * * *                           *   06400000
107300*    REVIEW CODES ARE USED TO DIRECT THE PPCAL  SUBROUTINE    *   06410000
107400*    IN HOW TO PAY THE BILL.                                  *   06420000
107500*                         *****                               *   06430000
107600*    COMMENTS  ** CLAIMS RECEIVED WITH CONDITION CODE 66      *   06440000
107700*                 SHOULD BE PROCESSED UNDER REVIEW CODE 06,   *   06450000
107800*                 07 OR 11 AS APPROPRIATE TO EXCLUDE ANY      *   06460000
107900*                 OUTLIER COMPUTATION.                        *   06470000
108000*                         *****                               *   06480000
108100*         REVIEW-CODE:                                        *   06490000
108200*            00 = PAY-WITH-OUTLIER.                           *   06500000
108300*                 WILL CALCULATE THE STANDARD PAYMENT.        *   06510000
108400*                 WILL ALSO ATTEMPT TO PAY ONLY COST          *   06520000
108500*                 OUTLIERS, DAY OUTLIERS EXPIRED 10/01/97     *   06530000
108600*            03 = PAY-PERDIEM-DAYS.                           *   06540000
108700*                 WILL CALCULATE A PERDIEM PAYMENT BASED ON   *   06550000
108800*                 THE STANDARD PAYMENT IF THE COVERED DAYS    *   06560000
108900*                 ARE LESS THAN THE AVERAGE LENGTH OF STAY    *   06570000
109000*                 FOR THE DRG. IF COVERED DAYS EQUAL OR       *   06580000
109100*                 EXCEED THE AVERAGE LENGTH OF STAY, THE      *   06590000
109200*                 STANDARD PAYMENT IS CALCULATED. WILL ALSO   *   06600000
109300*                 CALCULATE THE COST OUTLIER PORTION OF THE   *   06610000
109400*                 PAYMENT IF THE ADJUSTED CHARGES ON THE      *   06620000
109500*                 BILL EXCEED THE COST THRESHOLD.             *   06630000
109600*            06 = PAY-XFER-NO-COST                            *   06640000
109700*                 WILL CALCULATE A PERDIEM PAYMENT BASED ON   *   06650000
109800*                 THE STANDARD PAYMENT IF THE COVERED DAYS    *   06660000
109900*                 ARE LESS THAN THE AVERAGE LENGTH OF STAY    *   06670000
110000*                 FOR THE DRG.  IF COVERED DAYS EQUAL OR      *   06680000
110100*                 EXCEED THE AVERAGE LENGTH OF STAY, THE      *   06690000
110200*                 STANDARD PAYMENT IS CALCULATED. WILL NOT    *   06700000
110300*                 CALCULATE ANY COST OUTLIER PORTION          *   06710000
110400*                 OF THE PAYMENT.                             *   06720000
110500*            07 = PAY-WITHOUT-COST.                           *   06730000
110600*                 WILL CALCULATE THE STANDARD PAYMENT         *   06740000
110700*                 WITHOUT COST PORTION.                       *   06750000
110800*            09 = PAY-XFER-SPEC-DRG - POST-ACUTE TRANSFERS    *   06760000
110900*                 50-50> 28  29  30  40  41  42  219              06770000
111000*                        220 221 477 478 479 480 481              06780000
111100*                        482 492 493 494 500 501 502              06790000
111200*                        515 516 517 495 496 497                  06800000
111300* =======================================================         06801000
111400* THE 50/50 DRG'S DO NOT REPEAT WITH THE FULL PERDIEM DRG'S       06801000
111500* =======================================================         06801000
111600*                                                                 06801000
111700*                                                                 06801000
111800*     FULL PERDIEM >   3   4   25  26  27  28          31         06802000
111900*                      32  33              54  55  56  57         06803000
112000*                      64  65  66  70  71  72  85  86  87         06804000
112100*                      91  92  93  100 101 163 164 165 166        06805000
112200*                      167 168 175 176 177 178 179 186 187        06806000
112300*                      188 190 191 192 193 194 195 196 197        06807000
112400*                      198 205 206 207 216 217 218                06808000
112500*                          228 229 230 233 234 235 236 239        06809000
112600*                      240 241 242 243 244 255 256 257 264        06809100
112700*                      280 281 282 288 289 290 291 292 293        06809200
112800*                      299 300 301 314 315 316 326 327 328        06809300
112900*                      329 330 331 332 333 334 335 336 337        06809400
113000*                      356 357 358 371 372 373 374 375 376        06809500
113100*                      377 378 379 380 381 382 388 389 390        06809600
113200*                      405 406 407 414 415 416 441 442 443        06809700
113300*                      459 460 463 464 465 466 467 468 469        06809800
113400*                      470 474 475 476                            06809900
113500*                          483 484 488 489                        06810000
113600*                                          510 511 512            06810100
113700*                              533 534 535 536 539 540 541        06810200
113800*                      542 543 544 545 546 547 551 552 557        06810300
113900*                      558 559 560 561 562 563 573 574 575        06810400
114000*                      579 580 581 592 593 594 602 603 616        06810500
114100*                      617 618 622 623 624 628 629 630 637        06810600
114200*                      638 639 640 641 643 644 645 653 654        06810700
114300*                      655 659 660 661 682 683 684 689 690        06810800
114400*                      698 699 700 840 841 842 853 854 855        06810900
114500*                      856 857 858 862 863 867 868 869 870        06811000
114600*                      871 872 884 896 897 907 908 909 917        06811100
114700*                      918 945 946 947 948 956 981 982 983        06811200
114800*                      987 988 989                                06811300
114900*                                                                 06811400
115000*                               POST-ACUTE TRANSFERS          *   06811500
115100*                 WILL CALCULATE A PERDIEM PAYMENT BASED ON   *   06811600
115200*                 THE STANDARD DRG PAYMENT IF THE COVERED DAYS*   06811700
115300*                 ARE LESS THAN THE AVERAGE LENGTH OF STAY    *   06811800
115400*                 FOR THE DRG. IF COVERED DAYS EQUAL OR       *   06811900
115500*                 EXCEED THE AVERAGE LENGTH OF STAY, THE      *   06812000
115600*                 STANDARD PAYMENT IS CALCULATED. WILL ALSO   *   06813000
115700*                 CALCULATE THE COST OUTLIER PORTION OF THE   *   06814000
115800*                 PAYMENT IF THE ADJUSTED CHARGES ON THE      *   06815000
115900*                 BILL EXCEED THE COST THRESHOLD.             *   06816000
116000*            11 = PAY-XFER-SPEC-DRG-NO-COST                   *   06817000
116100*                 POST-ACUTE TRANSFERS                        *   06818000
116200*                 50-50> 28  29  30  40  41  42  219              06819000
116300*                        220 221 477 478 479 480 481              06820000
116400*                        482 492 493 494 500 501 502              06830000
116500*                        515 516 517 495 496 497                  06840000
116600*                                                                 06850000
116700* =======================================================         06801000
116800* THE 50/50 DRG'S DO NOT REPEAT WITH THE FULL PERDIEM DRG'S       06801000
116900* =======================================================         06801000
117000*                                                                 06860000
117100*     FULL PERDIEM >     3   4   25  26  27              31       06870000
117200*                        32  33              54  55  56  57       06880000
117300*                        64  65  66  70  71  72  85  86  87       06890000
117400*                        91  92  93  100 101 163 164 165 166      06900000
117500*                        167 168 175 176 177 178 179 186 187      06910000
117600*                        188 190 191 192 193 194 195 196 197      06920000
117700*                        198 205 206 207 216 217 218              06930000
117800*                            228 229 230 233 234 235 236 239      06940000
117900*                        240 241 242 243 244 255 256 257 264      06950000
118000*                        280 281 282 288 289 290 291 292 293      06960000
118100*                        299 300 301 314 315 316 326 327 328      06970000
118200*                        329 330 331 332 333 334 335 336 337      06980000
118300*                        356 357 358 371 372 373 374 375 376      06990000
118400*                        377 378 379 380 381 382 388 389 390      07000000
118500*                        405 406 407 414 415 416 441 442 443      07010000
118600*                        459 460 463 464 465 466 467 468 469      07020000
118700*                        470 474 475 476                          07030000
118800*                            483 484 488 489                      07040000
118900*                                            510 511 512          07050000
119000*                                533 534 535 536 539 540 541      07060000
119100*                        542 543 544 545 546 547 551 552 557      07070000
119200*                        558 559 560 561 562 563 573 574 575      07080000
119300*                        579 580 581 592 593 594 602 603 616      07090000
119400*                        617 618 622 623 624 628 629 630 637      07100000
119500*                        638 639 640 641 643 644 645 653 654      07110000
119600*                        655 659 660 661 682 683 684 689 690      07120000
119700*                        698 699 700 840 841 842 853 854 855      07130000
119800*                        856 857 858 862 863 867 868 869 870      07140000
119900*                        871 872 884 896 897 907 908 909 917      07150000
120000*                        918 945 946 947 948 956 981 982 983      07160000
120100*                        987 988 989                              07170000
120200*                                                                 07180000
120300*                                                                 07190000
120400*                               POST-ACUTE TRANSFERS          *   07200000
120500*                 WILL CALCULATE A PERDIEM PAYMENT BASED ON   *   07210000
120600*                 THE STANDARD DRG PAYMENT IF THE COVERED DAYS*   07220000
120700*                 ARE LESS THAN THE AVERAGE LENGTH OF STAY    *   07230000
120800*                 FOR THE DRG. IF COVERED DAYS EQUAL OR       *   07240000
120900*                 EXCEED THE AVERAGE LENGTH OF STAY, THE      *   07250000
121000*                 STANDARD PAYMENT IS CALCULATED. WILL NOT    *   07260000
121100*                 CALCULATE THE COST OUTLIER PORTION OF THE   *   07270000
121200*                 PAYMENT.                                    *   07280000
121300***************************************************************   07290000
121400                                                                  07300000
121500**************************************************************    07310000
121600*      MILLINNIUM COMPATIBLE                                 *    07320000
121700*      THIS IS THE BILL-RECORD THAT WILL BE PASSED BACK FROM *    07330000
121800*      THE PPCAL001 PROGRAM AND AFTER FOR PROCESSING         *    07340000
121900*      IN THE NEW FORMAT                                     *    07350000
122000**************************************************************    07360000
122100 01  BILL-NEW-DATA.                                               07370000
122200         10  B-NPI10.                                             07380000
122300             15  B-NPI8             PIC X(08).                    07390000
122400             15  B-NPI-FILLER       PIC X(02).                    07400000
122500         10  B-PROVIDER-NO          PIC X(06).                    07410000
122600         10  B-REVIEW-CODE          PIC 9(02).                    07420000
122700             88  VALID-REVIEW-CODE    VALUE 00 03 06 07 09 11.    07430000
122800             88  PAY-WITH-OUTLIER     VALUE 00 07.                07440000
122900             88  PAY-PERDIEM-DAYS     VALUE 03.                   07450000
123000             88  PAY-XFER-NO-COST     VALUE 06.                   07460000
123100             88  PAY-WITHOUT-COST     VALUE 07.                   07470000
123200             88  PAY-XFER-SPEC-DRG    VALUE 09 11.                07480000
123300             88  PAY-XFER-SPEC-DRG-NO-COST VALUE 11.              07490000
123400         10  B-DRG                  PIC 9(03).                    07500000
123500             88  B-DRG-POSTACUTE-50-50                            07510000
123600                   VALUE 28  29  30  40  41  42  219              07520000
123700                         220 221 477 478 479 480 481              07530000
123800                         482 492 493 494 495 496 497
123900                         500 501 502 515 516 517.                 07550000
124000             88  B-DRG-SPIRATN-DRG                                07510000
124100                   VALUE 163 164 165.                             07520000
124200                                                                  07560000
124300* =======================================================         06801000
124400* THE 50/50 DRG'S DO NOT REPEAT WITH THE POSTACUTE  DRG'S         06801000
124500* =======================================================         06801000
124600*                                                                 06860000
124700             88  B-DRG-POSTACUTE-PERDIEM                          07570000
124800                   VALUE 3   4   25  26  27              31       07580000
124900                         32  33              54  55  56  57       07590000
125000                         64  65  66  70  71  72  85  86  87       07600000
125100                         91  92  93  100 101 163 164 165 166      07610000
125200                         167 168 175 176 177 178 179 186 187      07620000
125300                         188 190 191 192 193 194 195 196 197      07630000
125400                         198 205 206 207 216 217 218              07640000
125500                             228 229 230 233 234 235 236 239      07650000
125600                         240 241 242 243 244 255 256 257 264      07660000
125700                         280 281 282 288 289 290 291 292 293      07670000
125800                         299 300 301 314 315 316 326 327 328      07680000
125900                         329 330 331 332 333 334 335 336 337      07690000
126000                         356 357 358 371 372 373 374 375 376      07700000
126100                         377 378 379 380 381 382 388 389 390      07710000
126200                         405 406 407 414 415 416 441 442 443      07720000
126300                         459 460 463 464 465 466 467 468 469      07730000
126400                         470 474 475 476                          07740000
126500                             483 484 488 489                      07750000
126600                                             510 511 512          07760000
126700                                 533 534 535 536 539 540 541      07770000
126800                         542 543 544 545 546 547 551 552 557      07780000
126900                         558 559 560 561 562 563 573 574 575      07790000
127000                         579 580 581 592 593 594 602 603 616      07800000
127100                         617 618 622 623 624 628 629 630 637      07810000
127200                         638 639 640 641 643 644 645 653 654      07820000
127300                         655 659 660 661 682 683 684 689 690      07830000
127400                         698 699 700 840 841 842 853 854 855      07840000
127500                         856 857 858 862 863 867 868 869 870      07850000
127600                         871 872 884 896 897 907 908 909 917      07860000
127700                         918 945 946 947 948 956 981 982 983      07870000
127800                         987 988 989.                             07880000
127900                                                                  07890000
128000         10  B-LOS                  PIC 9(03).                    07900000
128100         10  B-COVERED-DAYS         PIC 9(03).                    07910000
128200         10  B-LTR-DAYS             PIC 9(02).                    07920000
128300         10  B-DISCHARGE-DATE.                                    07930000
128400             15  B-DISCHG-CC        PIC 9(02).                    07940000
128500             15  B-DISCHG-YY        PIC 9(02).                    07950000
128600             15  B-DISCHG-MM        PIC 9(02).                    07960000
128700             15  B-DISCHG-DD        PIC 9(02).                    07970000
128800         10  B-CHARGES-CLAIMED      PIC 9(07)V9(02).              07980000
128900         10  B-PRIN-PROC-CODE       PIC X(07).                    07990000
129000         10  B-OTHER-PROC-CODE1     PIC X(07).                    08000000
129100         10  B-OTHER-PROC-CODE2     PIC X(07).                    08010000
129200         10  B-OTHER-PROC-CODE3     PIC X(07).                    08020000
129300         10  B-OTHER-PROC-CODE4     PIC X(07).                    08030000
129400         10  B-OTHER-PROC-CODE5     PIC X(07).                    08040000
129500         10  B-OTHER-PROC-CODE6     PIC X(07).
129600         10  B-OTHER-PROC-CODE7     PIC X(07).
129700         10  B-OTHER-PROC-CODE8     PIC X(07).
129800         10  B-OTHER-PROC-CODE9     PIC X(07).
129900         10  B-OTHER-PROC-CODE10    PIC X(07).
130000         10  B-OTHER-PROC-CODE11    PIC X(07).
130100         10  B-OTHER-PROC-CODE12    PIC X(07).
130200         10  B-OTHER-PROC-CODE13    PIC X(07).
130300         10  B-OTHER-PROC-CODE14    PIC X(07).
130400         10  B-OTHER-PROC-CODE15    PIC X(07).
130500         10  B-OTHER-PROC-CODE16    PIC X(07).
130600         10  B-OTHER-PROC-CODE17    PIC X(07).
130700         10  B-OTHER-PROC-CODE18    PIC X(07).
130800         10  B-OTHER-PROC-CODE19    PIC X(07).
130900         10  B-OTHER-PROC-CODE20    PIC X(07).
131000         10  B-OTHER-PROC-CODE21    PIC X(07).
131100         10  B-OTHER-PROC-CODE22    PIC X(07).
131200         10  B-OTHER-PROC-CODE23    PIC X(07).
131300         10  B-OTHER-PROC-CODE24    PIC X(07).
131400         10  B-OTHER-DIAG-CODE1     PIC X(07).                    06012000
131500         10  B-OTHER-DIAG-CODE2     PIC X(07).                    06013000
131600         10  B-OTHER-DIAG-CODE3     PIC X(07).                    06014000
131700         10  B-OTHER-DIAG-CODE4     PIC X(07).                    06015000
131800         10  B-OTHER-DIAG-CODE5     PIC X(07).                    06016000
131900         10  B-OTHER-DIAG-CODE6     PIC X(07).                    06017000
132000         10  B-OTHER-DIAG-CODE7     PIC X(07).                    06018000
132100         10  B-OTHER-DIAG-CODE8     PIC X(07).                    06019000
132200         10  B-OTHER-DIAG-CODE9     PIC X(07).                    06019100
132300         10  B-OTHER-DIAG-CODE10    PIC X(07).                    06019200
132400         10  B-OTHER-DIAG-CODE11    PIC X(07).                    06019300
132500         10  B-OTHER-DIAG-CODE12    PIC X(07).                    06019400
132600         10  B-OTHER-DIAG-CODE13    PIC X(07).                    06019500
132700         10  B-OTHER-DIAG-CODE14    PIC X(07).                    06019600
132800         10  B-OTHER-DIAG-CODE15    PIC X(07).                    06019700
132900         10  B-OTHER-DIAG-CODE16    PIC X(07).                    06019800
133000         10  B-OTHER-DIAG-CODE17    PIC X(07).                    06019900
133100         10  B-OTHER-DIAG-CODE18    PIC X(07).                    06020000
133200         10  B-OTHER-DIAG-CODE19    PIC X(07).                    06020100
133300         10  B-OTHER-DIAG-CODE20    PIC X(07).                    06020200
133400         10  B-OTHER-DIAG-CODE21    PIC X(07).                    06020300
133500         10  B-OTHER-DIAG-CODE22    PIC X(07).                    06020400
133600         10  B-OTHER-DIAG-CODE23    PIC X(07).                    06020500
133700         10  B-OTHER-DIAG-CODE24    PIC X(07).                    06020600
133800         10  B-OTHER-DIAG-CODE25    PIC X(07).                    06020700
133900         10  BILL-DEMO-DATA.
134000             15  BILL-DEMO-CODE1        PIC X(02).
134100             15  BILL-DEMO-CODE2        PIC X(02).
134200             15  BILL-DEMO-CODE3        PIC X(02).
134300             15  BILL-DEMO-CODE4        PIC X(02).
134400         10  BILL-NDC-DATA.
134500             15  BILL-NDC-NUMBER        PIC X(11).
134600         10  FILLER                     PIC X(73).
134700                                                                  06020800
134800                                                                  06020800
134900                                                                  08050000
135000***************************************************************   08060000
135100*    THIS DATA IS CALCULATED BY THIS PPCAL  SUBROUTINE        *   08070000
135200*    AND PASSED BACK TO THE CALLING PROGRAM                   *   08080000
135300*            RETURN CODE VALUES (PPS-RTC)                     *   08090000
135400*                                                             *   08100000
135500*            PPS-RTC 00-49 = HOW THE BILL WAS PAID            *   08110000
135600*                                                             *   08120000
135700*      PPS-RTC 30,33,40,42,44  = OUTLIER RECONCILIATION       *   08130000
135800*                                                             *   08140000
135900*           30,00 = PAID NORMAL DRG PAYMENT                   *   08150000
136000*                                                             *   08160000
136100*              01 = PAID AS A DAY-OUTLIER.                    *   08170000
136200*                   NOTE:                                     *   08180000
136300*                     DAY-OUTLIER NO LONGER BEING PAID        *   08190000
136400*                         AS OF 10/01/97                      *   08200000
136500*                                                             *   08210000
136600*              02 = PAID AS A COST-OUTLIER.                   *   08220000
136700*                                                             *   08230000
136800*           33,03 = TRANSFER PAID ON A PERDIEM BASIS UP TO    *   08240000
136900*                   AND INCLUDING THE FULL DRG.               *   08250000
137000*              05 = TRANSFER PAID ON A PERDIEM BASIS UP TO    *   08260000
137100*                   AND INCLUDING THE FULL DRG WHICH ALSO     *   08270000
137200*                   QUALIFIED FOR A COST OUTLIER PAYMENT.     *   08280000
137300*              06 = TRANSFER PAID ON A PERDIEM BASIS UP TO    *   08290000
137400*                   AND INCLUDING THE FULL DRG. PROVIDER      *   08300000
137500*                   REFUSED COST OUTLIER.                     *   08310000
137600*           40,10 = POST-ACUTE TRANSFER                       *   08320000
137700*                   DRG = 28  29  30  40  41  42  219             08330000
137800*                         220 221 477 478 479 480 481             08340000
137900*                         482 492 493 494 500 501 502             08350000
138000*                         515 516 517                             08360000
138100*                                                                 08370000
138200* =======================================================         06801000
138300* THE 50/50 DRG'S DO NOT REPEAT WITH THE POSTACUTE  DRG'S         06801000
138400* =======================================================         06801000
138500*                                                                 06860000
138600*           42,12 = POST-ACAUTE TRANSFER WITH SPECIFIC DRGS   *   08380000
138700*                       THE FOLLOWING DRG'S                   *   08390000
138800*                   DRG = 3   4   25  26  27              31      08400000
138900*                         32  33              54  55  56  57      08410000
139000*                         64  65  66  70  71  72  85  86  87      08420000
139100*                         91  92  93  100 101 163 164 165 166     08430000
139200*                         167 168 175 176 177 178 179 186 187     08440000
139300*                         188 190 191 192 193 194 195 196 197     08450000
139400*                         198 205 206 207 216 217 218             08460000
139500*                             228 229 230 233 234 235 236 239     08470000
139600*                         240 241 242 243 244 255 256 257 264     08480000
139700*                         280 281 282 288 289 290 291 292 293     08490000
139800*                         299 300 301 314 315 316 326 327 328     08500000
139900*                         329 330 331 332 333 334 335 336 337     08510000
140000*                         356 357 358 371 372 373 374 375 376     08520000
140100*                         377 378 379 380 381 382 388 389 390     08530000
140200*                         405 406 407 414 415 416 441 442 443     08540000
140300*                         459 460 463 464 465 466 467 468 469     08550000
140400*                         470 474 475 476                         08560000
140500*                             483 484 488 489             495     08570000
140600*                         496 497             510 511 512         08580000
140700*                                 533 534 535 536 539 540 541     08590000
140800*                         542 543 544 545 546 547 551 552 557     08600000
140900*                         558 559 560 561 562 563 573 574 575     08610000
141000*                         579 580 581 592 593 594 602 603 616     08620000
141100*                         617 618 622 623 624 628 629 630 637     08630000
141200*                         638 639 640 641 643 644 645 653 654     08640000
141300*                         655 659 660 661 682 683 684 689 690     08650000
141400*                         698 699 700 840 841 842 853 854 855     08660000
141500*                         856 857 858 862 863 867 868 869 870     08670000
141600*                         871 872 884 896 897 907 908 909 917     08680000
141700*                         918 945 946 947 948 956 981 982 983     08690000
141800*                         987 988 989                             08700000
141900*                                                                 08710000
142000*           44,14 = PAID NORMAL DRG PAYMENT WITH              *   08720000
142100*                    PERDIEM DAYS = OR > GM  ALOS             *   08730000
142200*              16 = PAID AS A COST-OUTLIER WITH               *   08740000
142300*                    PERDIEM DAYS = OR > GM  ALOS             *   08750000
142400*                                                             *   08760000
142500*            PPS-RTC 50-99 = WHY THE BILL WAS NOT PAID        *   08770000
142600*              51 = NO PROVIDER SPECIFIC INFO FOUND           *   08780000
142700*              52 = INVALID CBSA# IN PROVIDER FILE            *   08790000
142800*                   OR INVALID WAGE INDEX                     *   08800000
142900*              53 = WAIVER STATE - NOT CALCULATED BY PPS      *   08810000
143000*              54 = INVALID DRG                               *   08820000
143100*              55 = DISCHARGE DATE < PROVIDER EFF START DATE  *   08830000
143200*                                      OR                     *   08840000
143300*                   DISCHARGE DATE < CBSA EFF START DATE      *   08850000
143400*                   FOR PPS                                   *   08860000
143500*                                      OR                     *   08870000
143600*                   PROVIDER HAS BEEN TERMINATED ON OR BEFORE *   08880000
143700*                   DISCHARGE DATE                            *   08890000
143800*              56 = INVALID LENGTH OF STAY                    *   08900000
143900*              57 = REVIEW CODE INVALID (NOT 00 03 06 07 09   *   08910000
144000*                                        NOT 11)              *   08920000
144100*              58 = TOTAL CHARGES NOT NUMERIC                 *   08930000
144200*              61 = LIFETIME RESERVE DAYS NOT NUMERIC         *   08940000
144300*                   OR BILL-LTR-DAYS > 60                     *   08950000
144400*              62 = INVALID NUMBER OF COVERED DAYS            *   08960000
144500*              65 = PAY-CODE NOT = A,B OR C ON PROVIDER       *   08970000
144600*                   SPECIFIC FILE FOR CAPITAL                 *   08980000
144700*              67 = COST OUTLIER WITH LOS > COVERED DAYS      *   08990000
144800*                   OR COST OUTLIER THRESHOLD CALUCULATION    *   09000000
144900*              98 = CANNOT PROCESS BILL OLDER THAN 5 YEARS    *   09010000
145000***************************************************************   09020000
145100 01  PPS-DATA.                                                    09030000
145200         10  PPS-RTC                PIC 9(02).                    09040000
145300         10  PPS-WAGE-INDX          PIC 9(02)V9(04).              09050000
145400         10  PPS-OUTLIER-DAYS       PIC 9(03).                    09060000
145500         10  PPS-AVG-LOS            PIC 9(02)V9(01).              09070000
145600         10  PPS-DAYS-CUTOFF        PIC 9(02)V9(01).              09080000
145700         10  PPS-OPER-IME-ADJ       PIC 9(06)V9(02).              09090000
145800         10  PPS-TOTAL-PAYMENT      PIC 9(07)V9(02).              09100000
145900         10  PPS-OPER-HSP-PART      PIC 9(06)V9(02).              09110000
146000         10  PPS-OPER-FSP-PART      PIC 9(06)V9(02).              09120000
146100         10  PPS-OPER-OUTLIER-PART  PIC 9(07)V9(02).              09130000
146200         10  PPS-REG-DAYS-USED      PIC 9(03).                    09140000
146300         10  PPS-LTR-DAYS-USED      PIC 9(02).                    09150000
146400         10  PPS-OPER-DSH-ADJ       PIC 9(06)V9(02).              09160000
146500         10  PPS-CALC-VERS          PIC X(05).                    09170000
146600                                                                  09180000
146700******************************************************************09190000
146800*            THESE ARE THE VERSIONS OF THE PPCAL                  09200000
146900*           PROGRAMS THAT WILL BE PASSED BACK----                 09210000
147000*          ASSOCIATED WITH THE BILL BEING PROCESSED               09220000
147100******************************************************************09230000
147200 01  PRICER-OPT-VERS-SW.                                          09240000
147300     02  PRICER-OPTION-SW          PIC X(01).                     09250000
147400         88  ALL-TABLES-PASSED          VALUE 'A'.                09260000
147500         88  PROV-RECORD-PASSED         VALUE 'P'.                09270000
147600         88  ADDITIONAL-VARIABLES       VALUE 'M'.                09280000
147700         88  PC-PRICER                  VALUE 'C'.                09290000
147800     02  PPS-VERSIONS.                                            09300000
147900         10  PPDRV-VERSION         PIC X(05).                     09310000
148000                                                                  09320000
148100******************************************************************09330000
148200*        THIS IS THE VARIABLES THAT WILL BE PASSED BACK           09340000
148300*          ASSOCIATED WITH THE BILL BEING PROCESSED               09350000
148400******************************************************************09360000
148500 01  PPS-ADDITIONAL-VARIABLES.                                    09370000
148600     05  PPS-HSP-PCT                PIC 9(01)V9(02).              09380000
148700     05  PPS-FSP-PCT                PIC 9(01)V9(02).              09390000
148800     05  PPS-NAT-PCT                PIC 9(01)V9(02).              09400000
148900     05  PPS-REG-PCT                PIC 9(01)V9(02).              09410000
149000     05  PPS-FAC-SPEC-RATE          PIC 9(05)V9(02).              09420000
149100     05  PPS-UPDATE-FACTOR          PIC 9(01)V9(05).              09430000
149200     05  PPS-DRG-WT                 PIC 9(02)V9(04).              09440000
149300     05  PPS-NAT-LABOR              PIC 9(05)V9(02).              09450000
149400     05  PPS-NAT-NLABOR             PIC 9(05)V9(02).              09460000
149500     05  PPS-REG-LABOR              PIC 9(05)V9(02).              09470000
149600     05  PPS-REG-NLABOR             PIC 9(05)V9(02).              09480000
149700     05  PPS-OPER-COLA              PIC 9(01)V9(03).              09490000
149800     05  PPS-INTERN-RATIO           PIC 9(01)V9(04).              09500000
149900     05  PPS-COST-OUTLIER           PIC 9(07)V9(09).              09510000
150000     05  PPS-BILL-COSTS             PIC 9(07)V9(09).              09520000
150100     05  PPS-DOLLAR-THRESHOLD       PIC 9(07)V9(09).              09530000
150200     05  PPS-DSCHG-FRCTN            PIC 9(1)V9999.                09540000
150300     05  PPS-DRG-WT-FRCTN           PIC 9(2)V9999.                09550000
150400     05  PPS-CAPITAL-VARIABLES.                                   09560000
150500         10  PPS-CAPI-TOTAL-PAY           PIC 9(07)V9(02).        09570000
150600         10  PPS-CAPI-HSP                 PIC 9(07)V9(02).        09580000
150700         10  PPS-CAPI-FSP                 PIC 9(07)V9(02).        09590000
150800         10  PPS-CAPI-OUTLIER             PIC 9(07)V9(02).        09600000
150900         10  PPS-CAPI-OLD-HARM            PIC 9(07)V9(02).        09610000
151000         10  PPS-CAPI-DSH-ADJ             PIC 9(07)V9(02).        09620000
151100         10  PPS-CAPI-IME-ADJ             PIC 9(07)V9(02).        09630000
151200         10  PPS-CAPI-EXCEPTIONS          PIC 9(07)V9(02).        09640000
151300     05  PPS-CAPITAL2-VARIABLES.                                  09650000
151400         10  PPS-CAPI2-PAY-CODE             PIC X(1).             09660000
151500         10  PPS-CAPI2-B-FSP                PIC 9(07)V9(02).      09670000
151600         10  PPS-CAPI2-B-OUTLIER            PIC 9(07)V9(02).      09680000
151700                                                                  09690000
151800     05  PPS-OTHER-VARIABLES.                                     09700000
151900         10  PPS-NON-TEMP-RELIEF-PAYMENT    PIC 9(07)V9(02).      09710000
152000         10  PPS-NEW-TECH-PAY-ADD-ON        PIC 9(07)V9(02).      09720000
152100         10  PPS-LOW-VOL-PAYMENT            PIC 9(07)V9(02).
152200         10  PPS-HVBP-HRR-DATA.
152300             15  PPS-VAL-BASED-PURCH-PARTIPNT PIC X.
152400             15  PPS-VAL-BASED-PURCH-ADJUST   PIC 9V9(11).
152500             15  PPS-HOSP-READMISS-REDUCTN    PIC X.
152600             15  PPS-HOSP-HRR-ADJUSTMT        PIC 9V9(4).
152700         10  PPS-OPERATNG-DATA.
152800             15  PPS-MODEL1-BUNDLE-DISPRCNT  PIC V999.
152900             15  PPS-OPER-BASE-DRG-PAY       PIC 9(08)V99.
153000             15  PPS-OPER-HSP-AMT            PIC 9(08)V99.
153100                                                                  09740000
153200     05  PPS-PC-OTH-VARIABLES.                                    09750000
153300         10  PPS-OPER-DSH                   PIC 9(01)V9(04).      09760000
153400         10  PPS-CAPI-DSH                   PIC 9(01)V9(04).      09770000
153500         10  PPS-CAPI-HSP-PCT               PIC 9(01)V9(02).      09780000
153600         10  PPS-CAPI-FSP-PCT               PIC 9(01)V9(04).      09790000
153700         10  PPS-ARITH-ALOS                 PIC 9(02)V9(01).      09800000
153800         10  PPS-PR-WAGE-INDEX              PIC 9(02)V9(04).      09810000
153900         10  PPS-TRANSFER-ADJ               PIC 9(01)V9(05).      09820000
154000         10  PPS-PC-HMO-FLAG                PIC X(01).            09830000
154100         10  PPS-PC-COT-FLAG                PIC X(01).            09840000
154200         10  PPS-FILLER                     PIC X(0998).
154300                                                                  09860000
154400 01  PROV-NEW-HOLD.                                               09870000
154500     02  PROV-NEWREC-HOLD1.                                       09880000
154600         05  P-NEW-NPI10.                                         09890000
154700             10  P-NEW-NPI8             PIC X(08).                09900000
154800             10  P-NEW-NPI-FILLER       PIC X(02).                09910000
154900         05  P-NEW-PROVIDER-NO.                                   09920000
155000             88  P-NEW-DSH-ADJ-PROVIDERS                          09930000
155100                             VALUE '180049' '190044' '190144'     09940000
155200                                   '190191' '330047' '340085'     09950000
155300                                   '370016' '370149' '420043'.    09960000
155400             10  P-NEW-STATE            PIC 9(02).                09970000
155500             10  FILLER                 PIC X(04).                09980000
155600         05  P-NEW-DATE-DATA.                                     09990000
155700             10  P-NEW-EFF-DATE.                                  10000000
155800                 15  P-NEW-EFF-DT-CC    PIC 9(02).                10010000
155900                 15  P-NEW-EFF-DT-YY    PIC 9(02).                10020000
156000                 15  P-NEW-EFF-DT-MM    PIC 9(02).                10030000
156100                 15  P-NEW-EFF-DT-DD    PIC 9(02).                10040000
156200             10  P-NEW-FY-BEGIN-DATE.                             10050000
156300                 15  P-NEW-FY-BEG-DT-CC PIC 9(02).                10060000
156400                 15  P-NEW-FY-BEG-DT-YY PIC 9(02).                10070000
156500                 15  P-NEW-FY-BEG-DT-MM PIC 9(02).                10080000
156600                 15  P-NEW-FY-BEG-DT-DD PIC 9(02).                10090000
156700             10  P-NEW-REPORT-DATE.                               10100000
156800                 15  P-NEW-REPORT-DT-CC PIC 9(02).                10110000
156900                 15  P-NEW-REPORT-DT-YY PIC 9(02).                10120000
157000                 15  P-NEW-REPORT-DT-MM PIC 9(02).                10130000
157100                 15  P-NEW-REPORT-DT-DD PIC 9(02).                10140000
157200             10  P-NEW-TERMINATION-DATE.                          10150000
157300                 15  P-NEW-TERM-DT-CC   PIC 9(02).                10160000
157400                 15  P-NEW-TERM-DT-YY   PIC 9(02).                10170000
157500                 15  P-NEW-TERM-DT-MM   PIC 9(02).                10180000
157600                 15  P-NEW-TERM-DT-DD   PIC 9(02).                10190000
157700         05  P-NEW-WAIVER-CODE          PIC X(01).                10200000
157800             88  P-NEW-WAIVER-STATE       VALUE 'Y'.              10210000
157900         05  P-NEW-INTER-NO             PIC 9(05).                10220000
158000         05  P-NEW-PROVIDER-TYPE        PIC X(02).                10230000
158100             88  P-N-SOLE-COMMUNITY-PROV    VALUE '01' '11'.      10240000
158200             88  P-N-REFERRAL-CENTER        VALUE '07' '11'       10250000
158300                                                  '15' '17'       10260000
158400                                                  '22'.           10270000
158500             88  P-N-INDIAN-HEALTH-SERVICE  VALUE '08'.           10280000
158600             88  P-N-REDESIGNATED-RURAL-YR1 VALUE '09'.           10290000
158700             88  P-N-REDESIGNATED-RURAL-YR2 VALUE '10'.           10300000
158800             88  P-N-SOLE-COM-REF-CENT      VALUE '11'.           10310000
158900             88  P-N-MDH-REBASED-FY90       VALUE '14' '15'.      10320000
159000             88  P-N-MDH-RRC-REBASED-FY90   VALUE '15'.           10330000
159100             88  P-N-SCH-REBASED-FY90       VALUE '16' '17'.      10340000
159200             88  P-N-SCH-RRC-REBASED-FY90   VALUE '17'.           10350000
159300             88  P-N-MEDICAL-ASSIST-FACIL   VALUE '18'.           10360000
159400             88  P-N-EACH                   VALUE '21' '22'.      10370000
159500             88  P-N-EACH-REFERRAL-CENTER   VALUE '22'.           10380000
159600             88  P-N-NHCMQ-II-SNF           VALUE '32'.           10390000
159700             88  P-N-NHCMQ-III-SNF          VALUE '33'.           10400000
159800         05  P-NEW-CURRENT-CENSUS-DIV   PIC 9(01).                10410000
159900             88  P-N-NEW-ENGLAND            VALUE  1.             10420000
160000             88  P-N-MIDDLE-ATLANTIC        VALUE  2.             10430000
160100             88  P-N-SOUTH-ATLANTIC         VALUE  3.             10440000
160200             88  P-N-EAST-NORTH-CENTRAL     VALUE  4.             10450000
160300             88  P-N-EAST-SOUTH-CENTRAL     VALUE  5.             10460000
160400             88  P-N-WEST-NORTH-CENTRAL     VALUE  6.             10470000
160500             88  P-N-WEST-SOUTH-CENTRAL     VALUE  7.             10480000
160600             88  P-N-MOUNTAIN               VALUE  8.             10490000
160700             88  P-N-PACIFIC                VALUE  9.             10500000
160800         05  P-NEW-CURRENT-DIV   REDEFINES                        10510000
160900                    P-NEW-CURRENT-CENSUS-DIV   PIC 9(01).         10520000
161000             88  P-N-VALID-CENSUS-DIV    VALUE 1 THRU 9.          10530000
161100         05  P-NEW-MSA-DATA.                                      10540000
161200             10  P-NEW-CHG-CODE-INDEX       PIC X.                10550000
161300             10  P-NEW-GEO-LOC-MSAX         PIC X(04) JUST RIGHT. 10560000
161400             10  P-NEW-GEO-LOC-MSA9   REDEFINES                   10570000
161500                             P-NEW-GEO-LOC-MSAX  PIC 9(04).       10580000
161600             10  P-NEW-WAGE-INDEX-LOC-MSA   PIC X(04) JUST RIGHT. 10590000
161700             10  P-NEW-STAND-AMT-LOC-MSA    PIC X(04) JUST RIGHT. 10600000
161800             10  P-NEW-STAND-AMT-LOC-MSA9                         10610000
161900       REDEFINES P-NEW-STAND-AMT-LOC-MSA.                         10620000
162000                 15  P-NEW-RURAL-1ST.                             10630000
162100                     20  P-NEW-STAND-RURAL  PIC XX.               10640000
162200                         88  P-NEW-STD-RURAL-CHECK VALUE '  '.    10650000
162300                 15  P-NEW-RURAL-2ND        PIC XX.               10660000
162400         05  P-NEW-SOL-COM-DEP-HOSP-YR PIC XX.                    10670000
162500                 88  P-NEW-SCH-YRBLANK    VALUE   '  '.           10680000
162600                 88  P-NEW-SCH-YR82       VALUE   '82'.           10690000
162700                 88  P-NEW-SCH-YR87       VALUE   '87'.           10700000
162800         05  P-NEW-LUGAR                    PIC X.                10710000
162900         05  P-NEW-TEMP-RELIEF-IND          PIC X.                10720000
163000         05  P-NEW-FED-PPS-BLEND-IND        PIC X.                10730000
163100         05  FILLER                         PIC X(05).            10740000
163200     02  PROV-NEWREC-HOLD2.                                       10750000
163300         05  P-NEW-VARIABLES.                                     10760000
163400             10  P-NEW-FAC-SPEC-RATE     PIC  9(05)V9(02).        10770000
163500             10  P-NEW-COLA              PIC  9(01)V9(03).        10780000
163600             10  P-NEW-INTERN-RATIO      PIC  9(01)V9(04).        10790000
163700             10  P-NEW-BED-SIZE          PIC  9(05).              10800000
163800             10  P-NEW-OPER-CSTCHG-RATIO PIC  9(01)V9(03).        10810000
163900             10  P-NEW-CMI               PIC  9(01)V9(04).        10820000
164000             10  P-NEW-SSI-RATIO         PIC  V9(04).             10830000
164100             10  P-NEW-MEDICAID-RATIO    PIC  V9(04).             10840000
164200             10  P-NEW-PPS-BLEND-YR-IND  PIC  9(01).              10850000
164300             10  P-NEW-PRUF-UPDTE-FACTOR PIC  9(01)V9(05).        10860000
164400             10  P-NEW-DSH-PERCENT       PIC  V9(04).             10870000
164500             10  P-NEW-FYE-DATE          PIC  X(08).              10880000
164600         05  P-NEW-CBSA-DATA.                                     10890000
164700             10  P-NEW-CBSA-SPEC-PAY-IND    PIC X.                10900000
164800             10  P-NEW-CBSA-HOSP-QUAL-IND   PIC X.                10900000
164900             10  P-NEW-CBSA-GEO-LOC         PIC X(05) JUST RIGHT. 10900000
165000             10  P-NEW-CBSA-GEO-RURAL REDEFINES                   10900000
165100                 P-NEW-CBSA-GEO-LOC.                              10900000
165200                 15  P-NEW-CBSA-GEO-RURAL1ST PIC XXX.             10900000
165300                     88  P-NEW-CBSA-GEO-RURAL1    VALUE '   '.    10900000
165400                 15  P-NEW-CBSA-GEO-RURAL2ND PIC XX.              10900000
165500                                                                  10900000
165600             10  P-NEW-CBSA-RECLASS-LOC     PIC X(05) JUST RIGHT. 10900000
165700             10  P-NEW-CBSA-STAND-AMT-LOC   PIC X(05) JUST RIGHT. 10900000
165800             10  P-NEW-CBSA-SPEC-WAGE-INDEX    PIC 9(02)V9(04).   10900000
165900     02  PROV-NEWREC-HOLD3.                                       10930000
166000         05  P-NEW-PASS-AMT-DATA.                                 10940000
166100             10  P-NEW-PASS-AMT-CAPITAL    PIC 9(04)V99.          10950000
166200             10  P-NEW-PASS-AMT-DIR-MED-ED PIC 9(04)V99.          10960000
166300             10  P-NEW-PASS-AMT-ORGAN-ACQ  PIC 9(04)V99.          10970000
166400             10  P-NEW-PASS-AMT-PLUS-MISC  PIC 9(04)V99.          10980000
166500         05  P-NEW-CAPI-DATA.                                     10990000
166600             15  P-NEW-CAPI-PPS-PAY-CODE   PIC X.                 11000000
166700             15  P-NEW-CAPI-HOSP-SPEC-RATE PIC 9(04)V99.          11010000
166800             15  P-NEW-CAPI-OLD-HARM-RATE  PIC 9(04)V99.          11020000
166900             15  P-NEW-CAPI-NEW-HARM-RATIO PIC 9(01)V9999.        11030000
167000             15  P-NEW-CAPI-CSTCHG-RATIO   PIC 9V999.             11040000
167100             15  P-NEW-CAPI-NEW-HOSP       PIC X.                 11050000
167200             15  P-NEW-CAPI-IME            PIC 9V9999.            11060000
167300             15  P-NEW-CAPI-EXCEPTIONS     PIC 9(04)V99.          11070000
167400         05  P-HVBP-HRR-DATA.                                     08690000
167500             15  P-VAL-BASED-PURCH-PARTIPNT PIC X.                08690100
167600             15  P-VAL-BASED-PURCH-ADJUST   PIC 9V9(11).          08690200
167700             15  P-HOSP-READMISSION-REDUCTN PIC X.                08690300
167800             15  P-HOSP-HRR-ADJUSTMT        PIC 9V9(4).           08690400
167900         05  P-MODEL1-BUNDLE-DATA.                                      08
168000             15  P-MODEL1-BUNDLE-DISPRCNT   PIC V999.                   08
168010             15  P-HAC-REDUC-IND            PIC X.
168020             15  P-UNCOMP-CARE-AMOUNT       PIC 9(07)V99.
168030             15  P-EHR-REDUC-IND            PIC X.
168040         05  FILLER                         PIC X(09).
168200
168300******************************************************************11090000
168400 01  WAGE-NEW-CBSA-INDEX-RECORD.                                  11100000
168500     05  W-CBSA                        PIC X(5).                  11110000
168600     05  W-CBSA-SIZE                   PIC X.                     11120000
168700         88  LARGE-URBAN       VALUE 'L'.                         11130000
168800         88  OTHER-URBAN       VALUE 'O'.                         11140000
168900         88  ALL-RURAL         VALUE 'R'.                         11150000
169000     05  W-CBSA-EFF-DATE               PIC X(8).                  11160000
169100     05  FILLER                        PIC X.                     11170000
169200     05  W-CBSA-INDEX-RECORD           PIC S9(02)V9(04).          11180000
169300     05  W-CBSA-PR-INDEX-RECORD        PIC S9(02)V9(04).          11190000
169400                                                                  11200000
169500                                                                  11210000
169600 PROCEDURE DIVISION  USING BILL-NEW-DATA                          11220000
169700                           PPS-DATA                               11230000
169800                           PRICER-OPT-VERS-SW                     11240000
169900                           PPS-ADDITIONAL-VARIABLES               11250000
170000                           PROV-NEW-HOLD                          11260000
170100                           WAGE-NEW-CBSA-INDEX-RECORD.            11270000
170200                                                                  11280000
170300***************************************************************   11290000
170400*    PROCESSING:                                              *   11300000
170500*        A. WILL PROCESS CASES BASED ON DISCHARGE DATE            11310000
170600*        B. INITIALIZE PPCAL  HOLD VARIABLES.                 *   11320000
170700*        C. EDIT THE DATA PASSED FROM THE BILL BEFORE         *   11330000
170800*           ATTEMPTING TO CALCULATE PPS. IF THIS BILL         *   11340000
170900*           CANNOT BE PROCESSED, SET A RETURN CODE AND        *   11350000
171000*           GOBACK.                                           *   11360000
171100*        D. ASSEMBLE PRICING COMPONENTS.                      *   11370000
171200*        E. CALCULATE THE PRICE.                              *   11380000
171300***************************************************************   11390000
171400                                                                  11400000
171500     MOVE ZEROES TO NON-TEMP-RELIEF-PAYMENT.                      11410000
171600     MOVE 'N' TO TEMP-RELIEF-FLAG.                                11420000
171700     MOVE 'N' TO OUTLIER-RECON-FLAG.                              11430000
171800                                                                  11440000
171900     PERFORM 0200-MAINLINE-CONTROL THRU 0200-EXIT.                11450000
172000                                                                  11460000
172100     MOVE HOLD-ADDITIONAL-VARIABLES TO  PPS-ADDITIONAL-VARIABLES. 11470000
172200     MOVE H-DSCHG-FRCTN             TO  PPS-DSCHG-FRCTN.          11480000
172300     MOVE H-DRG-WT-FRCTN            TO  PPS-DRG-WT-FRCTN.         11490000
172400     MOVE HOLD-CAPITAL-VARIABLES    TO  PPS-CAPITAL-VARIABLES.    11500000
172500     MOVE HOLD-CAPITAL2-VARIABLES   TO  PPS-CAPITAL2-VARIABLES.   11510000
172600     MOVE CAL-VERSION               TO  PPS-CALC-VERS.            11520000
172700     MOVE HOLD-OTHER-VARIABLES      TO  PPS-OTHER-VARIABLES.      11530000
172800     MOVE HOLD-PC-OTH-VARIABLES     TO  PPS-PC-OTH-VARIABLES.     11540000
172900                                                                  11550000
173000     IF (PPS-RTC = '00' OR '03' OR '10' OR                        11560000
173100                   '12' OR '14')                                  11570000
173200        MOVE 'Y' TO OUTLIER-RECON-FLAG                            11580000
173300        MOVE PPS-DATA TO HLD-PPS-DATA                             11590000
173400        PERFORM 0200-MAINLINE-CONTROL THRU 0200-EXIT              11600000
173500        MOVE HLD-PPS-DATA TO PPS-DATA.                            11610000
173600                                                                  11620000
173700     GOBACK.                                                      11630000
173800                                                                  11640000
173900 0200-MAINLINE-CONTROL.                                           11650000
174000                                                                  11660000
174100     MOVE 'N' TO HMO-TAG.                                         11670000
174200                                                                  11680000
174300     IF PPS-PC-HMO-FLAG = 'Y' OR                                  11690000
174400               HMO-FLAG = 'Y'                                     11700000
174500        MOVE 'Y' TO HMO-TAG.                                      11710000
174600                                                                  11720000
174700     IF P-NEW-STATE NOT = 40                                      11730000
174800        MOVE ZEROES TO W-CBSA-PR-INDEX-RECORD.                    11740000
174900                                                                  11750000
175000     MOVE ALL '0' TO PPS-DATA                                     11760000
175100                     H-OPER-DSH-SCH                               11770000
175200                     H-OPER-DSH-RRC                               11780000
175300                     HOLD-PPS-COMPONENTS                          11790000
175400                     HOLD-PPS-COMPONENTS                          11800000
175500                     HOLD-ADDITIONAL-VARIABLES                    11810000
175600                     HOLD-CAPITAL-VARIABLES                       11820000
175700                     HOLD-CAPITAL2-VARIABLES                      11830000
175800                     HOLD-OTHER-VARIABLES                         11840000
175900                     HOLD-PC-OTH-VARIABLES.                       11850000
176000                                                                  11860000
176100     IF P-NEW-CAPI-HOSP-SPEC-RATE NOT NUMERIC                     11870000
176200        MOVE 0 TO P-NEW-CAPI-HOSP-SPEC-RATE.                      11880000
176300                                                                  11890000
176400     IF P-NEW-CAPI-OLD-HARM-RATE  NOT NUMERIC                     11900000
176500        MOVE 0 TO P-NEW-CAPI-OLD-HARM-RATE.                       11910000
176600                                                                  11920000
176700     IF P-NEW-CAPI-NEW-HARM-RATIO NOT NUMERIC                     11930000
176800        MOVE 0 TO P-NEW-CAPI-NEW-HARM-RATIO.                      11940000
176900                                                                  11950000
177000     IF P-NEW-CAPI-CSTCHG-RATIO NOT NUMERIC                       11960000
177100        MOVE 0 TO P-NEW-CAPI-CSTCHG-RATIO.                        11970000
177200                                                                  11980000
177300                                                                  11990000
177400     PERFORM 1000-EDIT-THE-BILL-INFO.                             12000000
177500                                                                  12010000
177600     IF  PPS-RTC = 00                                             12020000
177700         PERFORM 2000-ASSEMBLE-PPS-VARIABLES                      12030000
177800         PERFORM 3000-CALC-PAYMENT THRU 3000-EXIT.                12040000
177900                                                                  12050000
178000     IF OUTLIER-RECON-FLAG = 'Y'                                  12060000
178100        MOVE 'N' TO OUTLIER-RECON-FLAG                            12070000
178200        GO TO 0200-EXIT.                                          12080000
178300                                                                  12090000
178400     IF PPS-RTC = 00                                              12100000
178500        IF H-PERDIEM-DAYS = H-ALOS OR                             12110000
178600           H-PERDIEM-DAYS > H-ALOS                                12120000
178700           MOVE 14 TO PPS-RTC.                                    12130000
178800                                                                  12140000
178900     IF PPS-RTC = 02                                              12150000
179000        IF H-PERDIEM-DAYS = H-ALOS OR                             12160000
179100           H-PERDIEM-DAYS > H-ALOS                                12170000
179200           MOVE 16 TO PPS-RTC.                                    12180000
179300                                                                  12190000
179400 0200-EXIT.   EXIT.                                               12200000
179500                                                                  12210000
179600 1000-EDIT-THE-BILL-INFO.                                         12220000
179700                                                                  12230000
179800     MOVE 1.00 TO H-CAPI-PAYCDE-PCT1.                             12240000
179900     MOVE 0.00 TO H-CAPI-PAYCDE-PCT2.                             12250000
180000                                                                  12260000
180100     IF  PPS-RTC = 00                                             12270000
180200         IF  P-NEW-WAIVER-STATE                                   12280000
180300             MOVE 53 TO PPS-RTC.                                  12290000
180400                                                                  12300000
180500     IF  PPS-RTC = 00                                             12310000
180600         IF  B-DRG < 001                                                00
180700               OR = 014 OR = 015 OR = 016 OR = 017                12330000
180800               OR = 018 OR = 019 OR = 043 OR = 044                12340000
180900               OR = 045 OR = 046 OR = 047 OR = 048                12350000
181000               OR = 049 OR = 050 OR = 051 OR = 104                12360000
181100               OR = 105 OR = 106 OR = 107 OR = 108                12370000
181200               OR = 109 OR = 110 OR = 111 OR = 112                12380000
181300               OR = 118 OR = 119 OR = 120 OR = 126                12390000
181400               OR = 127 OR = 128 OR = 140 OR = 141                12400000
181500               OR = 142 OR = 143 OR = 144 OR = 145                12410000
181600               OR = 160 OR = 161 OR = 162 OR = 169                12420000
181700               OR = 170 OR = 171 OR = 172 OR = 173                12430000
181800               OR = 174 OR = 209 OR = 210 OR = 211                12440000
181900               OR = 212 OR = 213 OR = 214                         12450000
182000               OR = 266 OR = 267 OR = 268 OR = 269                12460000
182100               OR = 270 OR = 271 OR = 272 OR = 273                12470000
182200               OR = 274 OR = 275 OR = 276 OR = 277                12480000
182300               OR = 278 OR = 279 OR = 317 OR = 318                12490000
182400               OR = 319 OR = 320 OR = 321 OR = 322                12500000
182500               OR = 323 OR = 324 OR = 325 OR = 359                12510000
182600               OR = 360 OR = 361 OR = 362 OR = 363                12520000
182700               OR = 364 OR = 365 OR = 366 OR = 367                12530000
182800               OR = 396 OR = 397 OR = 398 OR = 399                12540000
182900               OR = 400 OR = 401 OR = 402 OR = 403                12550000
183000               OR = 404 OR = 426 OR = 427 OR = 428                12560000
183100               OR = 429 OR = 430 OR = 431 OR = 447                12570000
183200               OR = 448 OR = 449 OR = 450 OR = 451                12580000
183300               OR = 452 OR = 518 OR = 519 OR = 520                12590000
183400               OR = 521 OR = 522 OR = 523 OR = 524                12600000
183500               OR = 525 OR = 526 OR = 527 OR = 528                12610000
183600               OR = 529 OR = 530 OR = 531 OR = 532                12620000
183700               OR = 567 OR = 568 OR = 569 OR = 570                12630000
183800               OR = 571 OR = 572 OR = 586 OR = 587                12640000
183900               OR = 588 OR = 589 OR = 590 OR = 591                12650000
184000               OR = 608 OR = 609 OR = 610 OR = 611                12660000
184100               OR = 612 OR = 613 OR = 631 OR = 632                12670000
184200               OR = 633 OR = 634 OR = 635 OR = 636                12680000
184300               OR = 646 OR = 647 OR = 648 OR = 649                12690000
184400               OR = 650 OR = 651 OR = 676 OR = 677                12700000
184500               OR = 678 OR = 679 OR = 680 OR = 681                12710000
184600               OR = 701 OR = 702 OR = 703 OR = 704                12720000
184700               OR = 705 OR = 706 OR = 719 OR = 720                12730000
184800               OR = 721 OR = 731 OR = 732 OR = 733                12740000
184900               OR = 751 OR = 752 OR = 753 OR = 762                12750000
185000               OR = 763 OR = 764 OR = 771 OR = 772                12760000
185100               OR = 773 OR = 783 OR = 784 OR = 785                12770000
185200               OR = 786 OR = 787 OR = 788 OR = 796                12780000
185300               OR = 797 OR = 798 OR = 805 OR = 806                12790000
185400               OR = 807 OR = 817 OR = 818 OR = 819                12800000
185500               OR = 831 OR = 832 OR = 833 OR = 850                12810000
185600               OR = 851 OR = 852 OR = 859 OR = 860                12820000
185700               OR = 861 OR = 873 OR = 874 OR = 875                12830000
185800               OR = 877 OR = 878 OR = 879                         12840000
185900               OR = 888 OR = 889 OR = 890                         12840000
186000               OR = 891 OR = 892                                  12850000
186100               OR = 893 OR = 898 OR = 899 OR = 900                12860000
186200               OR = 910 OR = 911 OR = 912 OR = 924                12870000
186300               OR = 925 OR = 926 OR = 930 OR = 931                12880000
186400               OR = 932 OR = 936 OR = 937 OR = 938                12890000
186500               OR = 942 OR = 943 OR = 944 OR = 952                12900000
186600               OR = 953 OR = 954 OR = 960 OR = 961                12910000
186700               OR = 962 OR = 966 OR = 967 OR = 968                12920000
186800               OR = 971 OR = 972 OR = 973 OR = 978                12930000
186900               OR = 979 OR = 980 OR = 990 OR = 991                12940000
187000               OR = 992 OR = 993 OR = 994 OR = 995                12950000
187100               OR = 996 OR = 997                                  12960000
187200             MOVE 54 TO PPS-RTC.                                  12970000
187300                                                                  12980000
187400     IF  PPS-RTC = 00                                             12990000
187500            IF  ((B-DISCHARGE-DATE < P-NEW-EFF-DATE) OR           13000000
187600                 (B-DISCHARGE-DATE < W-CBSA-EFF-DATE))            13010000
187700                MOVE 55 TO PPS-RTC.                               13020000
187800                                                                  13030000
187900     IF  PPS-RTC = 00                                             13040000
188000         IF P-NEW-TERMINATION-DATE > 00000000                     13050000
188100            IF  ((B-DISCHARGE-DATE = P-NEW-TERMINATION-DATE) OR   13060000
188200                 (B-DISCHARGE-DATE > P-NEW-TERMINATION-DATE))     13070000
188300                  MOVE 55 TO PPS-RTC.                             13080000
188400                                                                  13090000
188500     IF  PPS-RTC = 00                                             13100000
188600         IF  B-LOS NOT NUMERIC                                    13110000
188700             MOVE 56 TO PPS-RTC                                   13120000
188800         ELSE                                                     13130000
188900         IF  B-LOS = 0                                            13140000
189000             IF B-REVIEW-CODE NOT = 00 AND                        13150000
189100                              NOT = 03 AND                        13160000
189200                              NOT = 06 AND                        13170000
189300                              NOT = 07 AND                        13180000
189400                              NOT = 09 AND                        13190000
189500                              NOT = 11                            13200000
189600             MOVE 56 TO PPS-RTC.                                  13210000
189700                                                                  13220000
189800     IF  PPS-RTC = 00                                             13230000
189900         IF  B-LTR-DAYS NOT NUMERIC OR B-LTR-DAYS > 60            13240000
190000             MOVE 61 TO PPS-RTC                                   13250000
190100         ELSE                                                     13260000
190200             MOVE B-LTR-DAYS TO H-LTR-DAYS.                       13270000
190300                                                                  13280000
190400     IF  PPS-RTC = 00                                             13290000
190500         IF  B-COVERED-DAYS NOT NUMERIC                           13300000
190600             MOVE 62 TO PPS-RTC                                   13310000
190700         ELSE                                                     13320000
190800         IF  B-COVERED-DAYS = 0 AND B-LOS > 0                     13330000
190900             MOVE 62 TO PPS-RTC                                   13340000
191000         ELSE                                                     13350000
191100             MOVE B-COVERED-DAYS TO H-COV-DAYS.                   13360000
191200                                                                  13370000
191300     IF  PPS-RTC = 00                                             13380000
191400         IF  H-LTR-DAYS  > H-COV-DAYS                             13390000
191500             MOVE 62 TO PPS-RTC                                   13400000
191600         ELSE                                                     13410000
191700             COMPUTE H-REG-DAYS = H-COV-DAYS - H-LTR-DAYS.        13420000
191800                                                                  13430000
191900     IF  PPS-RTC = 00                                             13440000
192000         IF  NOT VALID-REVIEW-CODE                                13450000
192100             MOVE 57 TO PPS-RTC.                                  13460000
192200                                                                  13470000
192300     IF  PPS-RTC = 00                                             13480000
192400         IF  B-CHARGES-CLAIMED NOT NUMERIC                        13490000
192500             MOVE 58 TO PPS-RTC.                                  13500000
192600                                                                  13510000
192700     IF PPS-RTC = 00                                              13520000
192800           IF P-NEW-CAPI-NEW-HOSP NOT = 'Y'                       13530000
192900                 IF P-NEW-CAPI-PPS-PAY-CODE NOT = 'A' AND         13540000
193000                                            NOT = 'B' AND         13550000
193100                                            NOT = 'C'             13560000
193200                 MOVE 65 TO PPS-RTC.                              13570000
193300                                                                  13580000
193400 2000-ASSEMBLE-PPS-VARIABLES.                                     13590000
193500***  GET THE PROVIDER SPECIFIC VARIABLES.                         13600000
193600***  GET THE PROVIDER SPECIFIC VARIABLES.                         13610000
193700                                                                  13620000
193800     MOVE P-NEW-FAC-SPEC-RATE TO H-FAC-SPEC-RATE.                 13630000
193900     MOVE P-NEW-INTERN-RATIO TO H-INTERN-RATIO.                   13640000
194000                                                                  13650000
194100     IF  (P-NEW-STATE = 02 OR 12)                                 13660000
194200         MOVE P-NEW-COLA TO H-OPER-COLA                           13670000
194300     ELSE                                                         13680000
194400         MOVE 1.000  TO H-OPER-COLA.                              13690000
194500                                                                  13700000
194600***************************************************************   13710000
194700***  GET THE DRG RELATIVE WEIGHTS, ALOS, DAYS CUTOFF              13720000
194800***  GET THE DRG RELATIVE WEIGHTS, ALOS, DAYS CUTOFF              13730000
194900                                                                  13740000
195000     PERFORM 2600-GET-DRG-WEIGHT                                  13750000
195100             VARYING DX5 FROM 1 BY 1 UNTIL DX5 > 1.               13760000
195200                                                                  13770000
195300***************************************************************   13780000
195400***  GET THE WAGE-INDEX                                           13790000
195500***  GET THE WAGE-INDEX                                           13800000
195600                                                                  13810000
195700     MOVE W-CBSA-INDEX-RECORD TO H-WAGE-INDEX.                    13820000
195800     MOVE W-CBSA-PR-INDEX-RECORD TO H-PR-WAGE-INDEX.              13830000
195900     MOVE P-NEW-STATE            TO MES-PPS-STATE.                13830000
196000                                                                  13840000
196100
196200     PERFORM 4200-SSRFBN-CODE-RTN THRU 4200-EXIT.
196300
196400*****YEARCHANGE 2009.3 ************************************       16570000
196500
196600     IF  P-NEW-CBSA-SPEC-PAY-IND = '1' OR '2'                           00
196700       COMPUTE H-WAGE-INDEX ROUNDED =
196800                         H-WAGE-INDEX * 1
196900     ELSE                                                         13910000
197000       COMPUTE H-WAGE-INDEX ROUNDED =
197100                         H-WAGE-INDEX * MES-SSRFBN-RATE.
197200
197300*****YEARCHANGE 2009.3 ************************************       16570000
197400
197500***************************************************************   13850000
197600***  GET THE LABOR, NON-LABOR STANDARD RATES                      13860000
197700                                                                  13870000
197800     IF  P-NEW-STATE = 40                                         13880000
197900         MOVE 2 TO R2                                             13890000
198000         MOVE 3 TO R4                                             13900000
198100     ELSE                                                         13910000
198200         MOVE 1 TO R2                                             13920000
198300         MOVE 1 TO R4.                                            13930000
198400                                                                  13940000
198500     IF  LARGE-URBAN                                              13950000
198600         MOVE 1 TO R3                                             13960000
198700     ELSE                                                         13970000
198800         MOVE 2 TO R3.                                            13980000
198900                                                                  13990000
199000     IF ((P-NEW-CBSA-HOSP-QUAL-IND = '1') AND                     14000000
199100        (H-WAGE-INDEX > 01.0000))                                 14010000
199200        PERFORM 2300-GET-LAB-NONLAB-TB1-RATES                     14020000
199300             VARYING R1 FROM 1 BY 1 UNTIL R1 > 1.                 14030000
199400                                                                  14040000
199500     IF ((P-NEW-CBSA-HOSP-QUAL-IND NOT = '1') AND                 14050000
199600         (H-WAGE-INDEX > 01.0000))                                14060000
199700        PERFORM 2300-GET-LAB-NONLAB-TB2-RATES                     14070000
199800             VARYING R1 FROM 1 BY 1 UNTIL R1 > 1.                 14080000
199900                                                                  14090000
200000     IF ((P-NEW-CBSA-HOSP-QUAL-IND  = '1') AND                    14100000
200100         (H-WAGE-INDEX < 01.0000 OR H-WAGE-INDEX = 01.0000))      14110000
200200        PERFORM 2300-GET-LAB-NONLAB-TB3-RATES                     14120000
200300             VARYING R1 FROM 1 BY 1 UNTIL R1 > 1.                 14130000
200400                                                                  14140000
200500     IF ((P-NEW-CBSA-HOSP-QUAL-IND NOT = '1') AND                 14150000
200600         (H-WAGE-INDEX < 01.0000 OR H-WAGE-INDEX = 01.0000))      14160000
200700        PERFORM 2300-GET-LAB-NONLAB-TB4-RATES                     14170000
200800             VARYING R1 FROM 1 BY 1 UNTIL R1 > 1.                 14180000
200900                                                                  14190000
201000     IF P-NEW-STATE = 40                                          14200000
201100        IF ((P-NEW-CBSA-HOSP-QUAL-IND = '1') AND                  14210000
201200            (H-PR-WAGE-INDEX > 01.0000))                          14220000
201300             PERFORM 2300-GET-PR-LAB-TB1-RATES                    14230000
201400             VARYING R1 FROM 1 BY 1 UNTIL R1 > 1.                 14240000
201500                                                                  14250000
201600                                                                  14260000
201700     IF P-NEW-STATE = 40                                          14270000
201800        IF ((P-NEW-CBSA-HOSP-QUAL-IND NOT = '1') AND              14280000
201900             (H-PR-WAGE-INDEX > 01.0000))                         14290000
202000              PERFORM 2300-GET-PR-LAB-TB2-RATES                   14300000
202100                  VARYING R1 FROM 1 BY 1 UNTIL R1 > 1.            14310000
202200                                                                  14320000
202300     IF P-NEW-STATE = 40                                          14330000
202400        IF ((P-NEW-CBSA-HOSP-QUAL-IND  = '1') AND                 14340000
202500         (H-PR-WAGE-INDEX < 01.0000 OR H-PR-WAGE-INDEX = 01.0000))14350000
202600          PERFORM 2300-GET-PR-LAB-TB3-RATES                       14360000
202700              VARYING R1 FROM 1 BY 1 UNTIL R1 > 1.                14370000
202800                                                                  14380000
202900     IF P-NEW-STATE = 40                                          14390000
203000        IF ((P-NEW-CBSA-HOSP-QUAL-IND NOT = '1') AND              14400000
203100         (H-PR-WAGE-INDEX < 01.0000 OR H-PR-WAGE-INDEX = 01.0000))14410000
203200          PERFORM 2300-GET-PR-LAB-TB4-RATES                       14420000
203300              VARYING R1 FROM 1 BY 1 UNTIL R1 > 1.                14430000
203400                                                                  14440000
203500***************************************************************   14450000
203600***  GET THE HSP & FSP BLEND PERCENTS FOR THIS BILL               14460000
203700***  GET THE HSP & FSP BLEND PERCENTS FOR THIS BILL               14470000
203800                                                                  14480000
203900     MOVE 0.00  TO H-OPER-HSP-PCT.                                14490000
204000     MOVE 1.00  TO H-OPER-FSP-PCT.                                14500000
204100                                                                  14510000
204200***************************************************************   14520000
204300***  GET THE NATIONAL & REGIONAL BLEND PERCENTS FOR THIS BILL     14530000
204400***  GET THE NATIONAL & REGIONAL BLEND PERCENTS FOR THIS BILL     14540000
204500                                                                  14550000
204600      MOVE 1.00 TO H-NAT-PCT.                                     14560000
204700      MOVE 0.00 TO H-REG-PCT.                                     14570000
204800                                                                  14580000
204900     IF  P-NEW-STATE = 40                                         14590000
205000         MOVE 0.75 TO H-NAT-PCT                                   14600000
205100         MOVE 0.25 TO H-REG-PCT.                                  14610000
205200                                                                  14620000
205300     IF  P-N-SCH-REBASED-FY90 OR                                  14630000
205400         P-N-EACH OR                                              14640000
205500         P-N-MDH-REBASED-FY90                                     14650000
205600         MOVE 1.00 TO H-OPER-HSP-PCT.                             14660000
205700                                                                  14670000
205800 2300-GET-LAB-NONLAB-TB1-RATES.                                   14680000
205900                                                                  14690000
206000     IF  B-DISCHARGE-DATE NOT < TB1-RATE-EFF-DATE (R1)            14700000
206100         MOVE TB1-REG-LABOR  (R1 R2 R3) TO H-REG-LABOR            14710000
206200         MOVE TB1-REG-NLABOR (R1 R2 R3) TO H-REG-NONLABOR         14720000
206300         MOVE TB1-REG-LABOR  (R1 R4 R3) TO H-NAT-LABOR            14730000
206400         MOVE TB1-REG-NLABOR (R1 R4 R3) TO H-NAT-NONLABOR.        14740000
206500                                                                  14750000
206600 2300-GET-LAB-NONLAB-TB2-RATES.                                   14760000
206700                                                                  14770000
206800     IF  B-DISCHARGE-DATE NOT < TB2-RATE-EFF-DATE (R1)            14780000
206900         MOVE TB2-REG-LABOR  (R1 R2 R3) TO H-REG-LABOR            14790000
207000         MOVE TB2-REG-NLABOR (R1 R2 R3) TO H-REG-NONLABOR         14800000
207100         MOVE TB2-REG-LABOR  (R1 R4 R3) TO H-NAT-LABOR            14810000
207200         MOVE TB2-REG-NLABOR (R1 R4 R3) TO H-NAT-NONLABOR.        14820000
207300                                                                  14830000
207400 2300-GET-LAB-NONLAB-TB3-RATES.                                   14840000
207500                                                                  14850000
207600     IF  B-DISCHARGE-DATE NOT < TB3-RATE-EFF-DATE (R1)            14860000
207700         MOVE TB3-REG-LABOR  (R1 R2 R3) TO H-REG-LABOR            14870000
207800         MOVE TB3-REG-NLABOR (R1 R2 R3) TO H-REG-NONLABOR         14880000
207900         MOVE TB3-REG-LABOR  (R1 R4 R3) TO H-NAT-LABOR            14890000
208000         MOVE TB3-REG-NLABOR (R1 R4 R3) TO H-NAT-NONLABOR.        14900000
208100                                                                  14910000
208200 2300-GET-LAB-NONLAB-TB4-RATES.                                   14920000
208300                                                                  14930000
208400     IF  B-DISCHARGE-DATE NOT < TB4-RATE-EFF-DATE (R1)            14940000
208500         MOVE TB4-REG-LABOR  (R1 R2 R3) TO H-REG-LABOR            14950000
208600         MOVE TB4-REG-NLABOR (R1 R2 R3) TO H-REG-NONLABOR         14960000
208700         MOVE TB4-REG-LABOR  (R1 R4 R3) TO H-NAT-LABOR            14970000
208800         MOVE TB4-REG-NLABOR (R1 R4 R3) TO H-NAT-NONLABOR.        14980000
208900                                                                  14990000
209000 2300-GET-PR-LAB-TB1-RATES.                                       15000000
209100                                                                  15010000
209200     IF  B-DISCHARGE-DATE NOT < TB1-RATE-EFF-DATE (R1)            15020000
209300         MOVE TB1-REG-LABOR  (R1 R2 R3) TO H-REG-LABOR            15030000
209400         MOVE TB1-REG-NLABOR (R1 R2 R3) TO H-REG-NONLABOR.        15040000
209500                                                                  15050000
209600 2300-GET-PR-LAB-TB2-RATES.                                       15060000
209700                                                                  15070000
209800     IF  B-DISCHARGE-DATE NOT < TB2-RATE-EFF-DATE (R1)            15080000
209900         MOVE TB2-REG-LABOR  (R1 R2 R3) TO H-REG-LABOR            15090000
210000         MOVE TB2-REG-NLABOR (R1 R2 R3) TO H-REG-NONLABOR.        15100000
210100                                                                  15110000
210200 2300-GET-PR-LAB-TB3-RATES.                                       15120000
210300                                                                  15130000
210400     IF  B-DISCHARGE-DATE NOT < TB3-RATE-EFF-DATE (R1)            15140000
210500         MOVE TB3-REG-LABOR  (R1 R2 R3) TO H-REG-LABOR            15150000
210600         MOVE TB3-REG-NLABOR (R1 R2 R3) TO H-REG-NONLABOR.        15160000
210700                                                                  15170000
210800 2300-GET-PR-LAB-TB4-RATES.                                       15180000
210900                                                                  15190000
211000     IF  B-DISCHARGE-DATE NOT < TB4-RATE-EFF-DATE (R1)            15200000
211100         MOVE TB4-REG-LABOR  (R1 R2 R3) TO H-REG-LABOR            15210000
211200         MOVE TB4-REG-NLABOR (R1 R2 R3) TO H-REG-NONLABOR.        15220000
211300                                                                  15230000
211400                                                                  15240000
211500 2600-GET-DRG-WEIGHT.                                             15250000
211600                                                                  15260000
211700     IF  B-DISCHARGE-DATE NOT < DRGX-EFF-DATE (DX5)               15270000
211800         SET DX6 TO B-DRG                                         15280000
211900         MOVE DRG-WT (DX5 DX6)         TO H-DRG-WT                15290000
212000         MOVE DRG-ALOS (DX5 DX6)       TO H-ALOS                  15300000
212100         MOVE ZEROES                   TO H-DAYS-CUTOFF           15310000
212200         MOVE DRG-ARITH-ALOS (DX5 DX6) TO H-ARITH-ALOS.           15320000
212300                                                                  15330000
212400 3000-CALC-PAYMENT.                                               15340000
212500***************************************************************   15350000
212600                                                                  15360000
212700     PERFORM 3100-CALC-STAY-UTILIZATION.                          15370000
212800     PERFORM 3300-CALC-OPER-FSP-AMT.                              15380000
212900     PERFORM 3900A-CALC-OPER-DSH THRU 3900A-EXIT.                 15390000
213000                                                                  15400000
213100***********************************************************       15410000
213200***  OPERATING IME CALCULATION                                    15420000
213300***  OPERATING IME CALCULATION                                    15430000
213400                                                                  15440000
213500     COMPUTE H-OPER-IME-TEACH ROUNDED =                           15450000
213600            1.35 * ((1 + H-INTERN-RATIO) ** .405  - 1).           15460000
213700                                                                  15470000
213800***********************************************************       15480000
213900                                                                  15490000
214000     IF P-N-SCH-REBASED-FY90 OR                                   15500000
214100        P-N-EACH OR                                               15510000
214200        P-N-MDH-REBASED-FY90                                      15520000
214300         PERFORM 3450-CALC-ADDITIONAL-HSP.                        15530000
214400                                                                  15540000
214500     MOVE 00                 TO  PPS-RTC.                         15550000
214600     MOVE H-WAGE-INDEX       TO  PPS-WAGE-INDX.                   15560000
214700     MOVE H-ALOS             TO  PPS-AVG-LOS.                     15570000
214800     MOVE H-DAYS-CUTOFF      TO  PPS-DAYS-CUTOFF.                 15580000
214900                                                                  15590000
215000     MOVE B-LOS TO H-PERDIEM-DAYS.                                15600000
215100     IF H-PERDIEM-DAYS < 1                                        15610000
215200         MOVE 1 TO H-PERDIEM-DAYS.                                15620000
215300     ADD 1 TO H-PERDIEM-DAYS.                                     15630000
215400                                                                  15640000
215500     MOVE 1 TO H-DSCHG-FRCTN.                                     15650000
215600                                                                  15660000
215700     COMPUTE H-DRG-WT-FRCTN ROUNDED = H-DSCHG-FRCTN * H-DRG-WT.   15670000
215800                                                                  15680000
215900     IF (PAY-PERDIEM-DAYS  OR                                     15690000
216000         PAY-XFER-NO-COST) OR                                     15700000
216100        (PAY-XFER-SPEC-DRG AND                                    15710000
216200         B-DRG-POSTACUTE-PERDIEM)                                 15720000
216300         COMPUTE H-TRANSFER-ADJ ROUNDED = H-PERDIEM-DAYS / H-ALOS 15730000
216400         COMPUTE H-DSCHG-FRCTN  ROUNDED = H-PERDIEM-DAYS / H-ALOS 15740000
216500         IF H-DSCHG-FRCTN > 1                                     15750000
216600              MOVE 1 TO H-DSCHG-FRCTN                             15760000
216700              MOVE 1 TO H-TRANSFER-ADJ                            15770000
216800         ELSE                                                     15780000
216900              COMPUTE H-DRG-WT-FRCTN ROUNDED =                    15790000
217000                  (H-PERDIEM-DAYS / H-ALOS) * H-DRG-WT.           15800000
217100                                                                  15810000
217200     IF (PAY-XFER-SPEC-DRG AND                                    15820000
217300         B-DRG-POSTACUTE-50-50)                                   15830000
217400         COMPUTE H-TRANSFER-ADJ ROUNDED = H-PERDIEM-DAYS / H-ALOS 15840000
217500         COMPUTE H-DSCHG-FRCTN  ROUNDED =                         15850000
217600                        .5 + ((.5 * H-PERDIEM-DAYS) / H-ALOS)     15860000
217700         IF H-DSCHG-FRCTN > 1                                     15870000
217800              MOVE 1 TO H-DSCHG-FRCTN                             15880000
217900              MOVE 1 TO H-TRANSFER-ADJ                            15890000
218000         ELSE                                                     15900000
218100              COMPUTE H-DRG-WT-FRCTN ROUNDED =                    15910000
218200            (.5 + ((.5 * H-PERDIEM-DAYS) / H-ALOS)) * H-DRG-WT.   15920000
218300                                                                  15930000
218400                                                                  15940000
218500***********************************************************       15950000
218600***  CAPITAL DSH CALCULATION                                      15960000
218700***  CAPITAL DSH CALCULATION                                      15970000
218800                                                                  15980000
218900     MOVE 0 TO H-CAPI-DSH.                                        15990000
219000                                                                  16000000
219100     IF P-NEW-BED-SIZE NOT NUMERIC                                16010000
219200         MOVE 0 TO P-NEW-BED-SIZE.                                16020000
219300                                                                  16030000
219400     IF (W-CBSA-SIZE = 'O' OR 'L') AND P-NEW-BED-SIZE > 99        16040000
219500         COMPUTE H-CAPI-DSH ROUNDED = 2.7183 **                   16050000
219600                  (.2025 * (P-NEW-SSI-RATIO                       16060000
219700                          + P-NEW-MEDICAID-RATIO)) - 1.           16070000
219800                                                                  16080000
219900***********************************************************       16090000
220000***  CAPITAL IME TEACH CALCULATION                                16100000
220100***  CAPITAL IME TEACH CALCULATION                                16110000
220200                                                                  16120000
220300     MOVE 0 TO H-WK-CAPI-IME-TEACH.                               16130000
220400                                                                  16140000
220500     IF P-NEW-CAPI-IME NUMERIC                                    16150000
220600        IF P-NEW-CAPI-IME > 1.5000                                16160000
220700           MOVE 1.5000 TO P-NEW-CAPI-IME.                         16170000
220800                                                                  16180000
220900*****YEARCHANGE 2009.5 ****************************************   18470000
221000***                                                               16230000
221100***  PER POLICY, WE REMOVED THE .5 MULTIPLER                      16230000
221200***                                                               16230000
221300***********************************************************       16230000
221400     IF P-NEW-CAPI-IME NUMERIC                                    16190000
221500        COMPUTE H-WK-CAPI-IME-TEACH ROUNDED =                     16200000
221600         ((2.7183 ** (.2822 * P-NEW-CAPI-IME)) - 1).              16210000
221700                                                                  16220000
221800*****YEARCHANGE 2009.5 ****************************************   18470000
221900***********************************************************       16230000
222000     MOVE 0.00 TO H-DAYOUT-PCT.                                   16240000
222100     MOVE 0.80 TO H-CSTOUT-PCT.                                   16250000
222200                                                                  16260000
222300******************************************************************16270000
222400**                                                                16280000
222500** BURN DRGS FOR FY09 ARE 927, 928, 929, 933, 934 AND 935.        16281000
222600**                                                                16282000
222700******************************************************************16283000
222800                                                                  16284000
222900     IF  B-DRG = 927 OR 928 OR 929 OR 933 OR 934 OR 935           16285000
223000             MOVE 0.90 TO H-CSTOUT-PCT.                           16286000
223100                                                                  16287000
223200***     NATIONAL PERCENTAGE                                       16288000
223300     MOVE 0.6880   TO H-LABOR-PCT.                                16289000
223400     MOVE 0.3120   TO H-NONLABOR-PCT.                             16290000
223500                                                                  16300000
223600***     PUERTO RICO PERCENTAGE                                    16310000
223700     MOVE 0.6210   TO H-PR-LABOR-PCT.                             16320000
223800     MOVE 0.3790   TO H-PR-NONLABOR-PCT.                          16330000
223900                                                                  16340000
224000     IF (H-WAGE-INDEX < 01.0000 OR                                16350000
224100         H-WAGE-INDEX = 01.0000)                                  16360000
224200        MOVE 0.6200 TO H-LABOR-PCT                                16370000
224300        MOVE 0.3800 TO H-NONLABOR-PCT.                            16380000
224400***       ??????????                                              16390000
224500     IF P-NEW-STATE = 40                                          16400000
224600       IF (H-PR-WAGE-INDEX < 01.0000 OR                           16410000
224700           H-PR-WAGE-INDEX = 01.0000)                             16420000
224800          MOVE 0.6200 TO H-PR-LABOR-PCT                           16430000
224900          MOVE 0.3800 TO H-PR-NONLABOR-PCT.                       16440000
225000                                                                  16450000
225100                                                                  16460000
225200     IF  P-NEW-OPER-CSTCHG-RATIO NUMERIC                          16470000
225300             MOVE P-NEW-OPER-CSTCHG-RATIO TO H-OPER-CSTCHG-RATIO  16480000
225400     ELSE                                                         16490000
225500             MOVE 0.000 TO H-OPER-CSTCHG-RATIO.                   16500000
225600                                                                  16510000
225700     IF P-NEW-CAPI-CSTCHG-RATIO NUMERIC                           16520000
225800             MOVE P-NEW-CAPI-CSTCHG-RATIO TO H-CAPI-CSTCHG-RATIO  16530000
225900     ELSE                                                         16540000
226000             MOVE 0.000 TO H-CAPI-CSTCHG-RATIO.                   16550000
226100                                                                  16560000
226200***********************************************************       16570000
226300*****YEARCHANGE 2010.0 ************************************       16570000
226400***  CAPITAL PAYMENT METHOD B - YEARCHNG                          16580000
226500***  CAPITAL PAYMENT METHOD B                                     16590000
226600                                                                  16600000
226700     IF W-CBSA-SIZE = 'L'                                         16610000
226800        MOVE 1.00 TO H-CAPI-LARG-URBAN                            16620000
226900     ELSE                                                         16630000
227000        MOVE 1.00 TO H-CAPI-LARG-URBAN.                           16640000
227100                                                                  16650000
227200     COMPUTE H-CAPI-GAF    ROUNDED = (H-WAGE-INDEX ** .6848).     16660000
227300     COMPUTE H-PR-CAPI-GAF ROUNDED = (H-PR-WAGE-INDEX ** .6848).  16670000
227400                                                                  16680000
227500*****YEARCHANGE 2010.7 ************************************       16570000
227600     COMPUTE H-FEDERAL-RATE ROUNDED =                             16690000
227700                                 (0429.56 * H-CAPI-GAF).          16700000
227800     COMPUTE H-PUERTO-RICO-RATE ROUNDED =                         16710000
227900                                 (0203.57 * H-PR-CAPI-GAF).       16720000
228000*****YEARCHANGE 2010.7 ************************************       16570000
228100                                                                  16730000
228200     COMPUTE H-CAPI-COLA ROUNDED =                                16740000
228300                     (.3152 * (H-OPER-COLA - 1) + 1).             16750000
228400                                                                  16760000
228500     MOVE H-FEDERAL-RATE TO H-CAPI-FED-RATE.                      16770000
228600                                                                  16780000
228700     IF P-NEW-STATE = 40                                          16790000
228800        COMPUTE  H-CAPI-FED-RATE ROUNDED =                        16800000
228900                 (H-NAT-PCT * H-FEDERAL-RATE) +                   16810000
229000                 (H-REG-PCT * H-PUERTO-RICO-RATE).                16820000
229100***********************************************************       16830000
229200***  CAPITAL FSP CALCULATION                                      16840000
229300***  CAPITAL FSP CALCULATION                                      16850000
229400                                                                  16860000
229500     COMPUTE H-CAPI-FSP-PART ROUNDED =                            16870000
229600                               H-DRG-WT * H-CAPI-FED-RATE *       16880000
229700                               H-CAPI-COLA *                      16890000
229800                               H-CAPI-LARG-URBAN.                 16900000
229900                                                                  16910000
230000***********************************************************       16920000
230100***  CAPITAL PAYMENT METHOD A                                     16930000
230200***  CAPITAL PAYMENT METHOD A                                     16940000
230300                                                                  16950000
230400     IF P-N-SCH-REBASED-FY90 OR P-N-EACH                          16960000
230500        MOVE 1.00 TO H-CAPI-SCH                                   16970000
230600     ELSE                                                         16980000
230700        MOVE 0.85 TO H-CAPI-SCH.                                  16990000
230800                                                                  17000000
230900***********************************************************       17010000
231000***********  CAPITAL OLD-HOLD-HARMLESS CALCULATION ***********    17020000
231100***********  CAPITAL OLD-HOLD-HARMLESS CALCULATION ***********    17030000
231200                                                                  17040000
231300     COMPUTE H-CAPI-OLD-HARMLESS ROUNDED =                        17050000
231400                    (P-NEW-CAPI-OLD-HARM-RATE *                   17060000
231500                    H-CAPI-SCH).                                  17070000
231600                                                                  17080000
231700***********************************************************       17090000
231800        IF PAY-PERDIEM-DAYS                                       17100000
231900            IF  H-PERDIEM-DAYS < H-ALOS                           17110000
232000                IF  NOT (B-DRG = 789)                             17120000
232100                    PERFORM 3500-CALC-PERDIEM-AMT                 17130000
232200                    MOVE 03 TO PPS-RTC.                           17140000
232300                                                                  17150000
232400        IF PAY-XFER-SPEC-DRG                                      17160000
232500            IF  H-PERDIEM-DAYS < H-ALOS                           17170000
232600                IF  NOT (B-DRG = 789)                             17180000
232700                    PERFORM 3550-CALC-PERDIEM-AMT.                17190000
232800                                                                  17200000
232900        IF  PAY-XFER-NO-COST                                      17210000
233000            MOVE 00 TO PPS-RTC                                    17220000
233100            IF H-PERDIEM-DAYS < H-ALOS                            17230000
233200               IF  NOT (B-DRG = 789)                              17240000
233300                   PERFORM 3500-CALC-PERDIEM-AMT                  17250000
233400                   MOVE 06 TO PPS-RTC.                            17260000
233500                                                                  17270000
233600     PERFORM 4000-CALC-TECH-ADDON THRU 4000-EXIT.                 17280000
233700                                                                  17290000
233800     PERFORM 3600-CALC-OUTLIER THRU 3600-EXIT.                    17300000
233900                                                                  17310000
234000     IF OUTLIER-RECON-FLAG = 'Y' GO TO 3000-EXIT.                 17320000
234100                                                                  17330000
234200     IF PPS-RTC = 67  GO TO 3000-CONTINUE.                        17340000
234300                                                                  17350000
234400        IF PAY-XFER-SPEC-DRG                                      17360000
234500            IF  H-PERDIEM-DAYS < H-ALOS                           17370000
234600                IF  NOT (B-DRG = 789)                             17380000
234700                    PERFORM 3560-CHECK-RTN-CODE THRU 3560-EXIT.   17390000
234800                                                                  17400000
234900                                                                  17410000
235000        IF  PAY-PERDIEM-DAYS                                      17420000
235100            IF  H-OPER-OUTCST-PART > 0                            17430000
235200                MOVE H-OPER-OUTCST-PART TO                        17440000
235300                     H-OPER-OUTLIER-PART                          17450000
235400                MOVE 05 TO PPS-RTC                                17460000
235500            ELSE                                                  17470000
235600            IF  PPS-RTC NOT = 03                                  17480000
235700                MOVE 00 TO PPS-RTC                                17490000
235800                MOVE 0  TO H-OPER-OUTLIER-PART.                   17500000
235900                                                                  17510000
236000        IF  PAY-PERDIEM-DAYS                                      17520000
236100            IF  H-CAPI-OUTCST-PART > 0                            17530000
236200                MOVE H-CAPI-OUTCST-PART TO                        17540000
236300                     H-CAPI-OUTLIER-PART                          17550000
236400                MOVE 05 TO PPS-RTC                                17560000
236500            ELSE                                                  17570000
236600            IF  PPS-RTC NOT = 03                                  17580000
236700                MOVE 0  TO H-CAPI-OUTLIER-PART.                   17590000
236800                                                                  17600000
236900                                                                  17610000
237000 3000-CONTINUE.                                                   17620000
237100                                                                  17630000
237200***********************************************************       17640000
237300***  DETERMINES THE FEDERAL AMOUNT THAT WOULD BE PAID IF          17650000
237400***  THE PROVIDER WAS TYPE B-HOLD-HARMLESS 100% FED RATE          17660000
237500                                                                  17670000
237600     COMPUTE H-CAPI2-B-FSP-PART ROUNDED = H-CAPI-FSP-PART.        17680000
237700                                                                  17690000
237800***********************************************************       17700000
237900                                                                  17710000
238000     IF  PPS-RTC = 67                                             17720000
238100         MOVE H-OPER-DOLLAR-THRESHOLD TO                          17730000
238200              WK-H-OPER-DOLLAR-THRESHOLD.                         17740000
238300                                                                  17750000
238400     IF  PPS-RTC < 50                                             17760000
238500         PERFORM 3800-CALC-TOT-AMT                                17770000
238600     ELSE                                                         17780000
238700         MOVE ALL '0' TO PPS-OPER-HSP-PART                        17790000
238800                         PPS-OPER-FSP-PART                        17800000
238900                         PPS-OPER-OUTLIER-PART                    17810000
239000                         PPS-OUTLIER-DAYS                         17820000
239100                         PPS-REG-DAYS-USED                        17830000
239200                         PPS-LTR-DAYS-USED                        17840000
239300                         PPS-TOTAL-PAYMENT                        17850000
239400                         PPS-OPER-DSH-ADJ                         17860000
239500                         PPS-OPER-IME-ADJ                         17870000
239600                         H-DSCHG-FRCTN                            17880000
239700                         H-DRG-WT-FRCTN                           17890000
239800                         HOLD-ADDITIONAL-VARIABLES                17900000
239900                         HOLD-CAPITAL-VARIABLES                   17910000
240000                         HOLD-CAPITAL2-VARIABLES                  17920000
240100                         HOLD-OTHER-VARIABLES                     17930000
240200                         HOLD-PC-OTH-VARIABLES.                   17940000
240300                                                                  17950000
240400     IF  PPS-RTC = 67                                             17960000
240500         MOVE WK-H-OPER-DOLLAR-THRESHOLD TO                       17970000
240600                 H-OPER-DOLLAR-THRESHOLD.                         17980000
240700                                                                  17990000
240800 3000-EXIT.  EXIT.                                                18000000
240900                                                                  18010000
241000 3100-CALC-STAY-UTILIZATION.                                      18020000
241100                                                                  18030000
241200     MOVE 0 TO PPS-REG-DAYS-USED.                                 18040000
241300     MOVE 0 TO PPS-LTR-DAYS-USED.                                 18050000
241400                                                                  18060000
241500     IF H-REG-DAYS > 0                                            18070000
241600        IF H-REG-DAYS > B-LOS                                     18080000
241700           MOVE B-LOS TO PPS-REG-DAYS-USED                        18090000
241800        ELSE                                                      18100000
241900           MOVE H-REG-DAYS TO PPS-REG-DAYS-USED                   18110000
242000     ELSE                                                         18120000
242100        IF H-LTR-DAYS > B-LOS                                     18130000
242200           MOVE B-LOS TO PPS-LTR-DAYS-USED                        18140000
242300        ELSE                                                      18150000
242400           MOVE H-LTR-DAYS TO PPS-LTR-DAYS-USED.                  18160000
242500                                                                  18170000
242600                                                                  18180000
242700                                                                  18190000
242800 3300-CALC-OPER-FSP-AMT.                                          18200000
242900***********************************************************       18210000
243000***  OPERATING FSP CALCULATION                                    18220000
243100***  OPERATING FSP CALCULATION                                    18230000
243200                                                                  18240000
243300     COMPUTE H-OPER-FSP-PART ROUNDED =                            18250000
243400           (H-NAT-PCT * (H-NAT-LABOR * H-WAGE-INDEX +             18260000
243500            H-NAT-NONLABOR * H-OPER-COLA) * H-DRG-WT)             18270000
243600                   ON SIZE ERROR MOVE 0 TO H-OPER-FSP-PART.       18280000
243700                                                                  18290000
243800     IF P-NEW-STATE = 40                                          18300000
243900       COMPUTE H-OPER-FSP-PART ROUNDED =                          18310000
244000           (H-NAT-PCT * (H-NAT-LABOR * H-WAGE-INDEX +             18320000
244100            H-NAT-NONLABOR * H-OPER-COLA) * H-DRG-WT)             18330000
244200                           +                                      18340000
244300           (H-REG-PCT * (H-REG-LABOR * H-PR-WAGE-INDEX +          18350000
244400            H-REG-NONLABOR * H-OPER-COLA) * H-DRG-WT)             18360000
244500                   ON SIZE ERROR MOVE 0 TO H-OPER-FSP-PART.       18370000
244600                                                                  18380000
244700                                                                  18390000
244800 3450-CALC-ADDITIONAL-HSP.                                        18400000
244900***********************************************************       18410000
245000*    OBRA 89 CALCULATE ADDITIONAL HSP PAYMENT FOR                 18420000
245100*    SOLE COMMUNITY                                               18430000
245200*    AND ESSENTIAL ACCESS COMMUNITY HOSPITALS (EACH)              18440000
245300*    NOW REIMBURSED WITH 100% NATIONAL FEDERAL RATES              18450000
245400***********************************************************       18460000
245500*****YEARCHANGE 2010.0 ****************************************   18470000
245600***         GET THE UPDATING FACTOR                               18480000
245700***         GET THE UPDATING FACTOR                               18490000
245800                                                                  18500000
245900     MOVE 0.995743 TO H-BUDG-NUTR08.                              18510000
246000     MOVE 0.998795 TO H-BUDG-NUTR09.                              18510000
246100*****YEARCHANGE 2010.0 ****************************************   18470000
246200     MOVE 0.997941 TO H-BUDG-NUTR10.                              18510000
246300*****YEARCHANGE 2010.7 ****************************************   18470000
246400     MOVE 0.997935 TO H-BUDG-NUTR10D.                             18510000
246500*****YEARCHANGE 2010.7 ****************************************   18470000
246600                                                                  18520000
246700     MOVE 1.0330 TO H-UPDATE-08.                                  18530000
246800
246900*****YEARCHANGE 2009.0 ****************************************   18470000
247000     MOVE 1.0360 TO H-UPDATE-09.
247100*****YEARCHANGE 2009.0 ****************************************   18470000
247200
247300     IF P-NEW-CBSA-HOSP-QUAL-IND = '1'
247400*****YEARCHANGE 2010.0 ****************************************   18470000
247500        MOVE 1.0210 TO H-UPDATE-10
247600     ELSE
247700        MOVE 1.0010 TO H-UPDATE-10.
247800*****YEARCHANGE 2010.0 ****************************************   18470000
247900
248000     IF P-NEW-CBSA-HOSP-QUAL-IND = '1'
248100*****YEARCHANGE 2010.7 ****************************************   18470000
248200        MOVE 1.0185 TO H-UPDATE-10D
248300     ELSE
248400        MOVE 0.9985 TO H-UPDATE-10D.
248500*****YEARCHANGE 2010.7 ****************************************   18470000
248600
248700     IF P-NEW-STATE = 40                                          16790000
248800*****YEARCHANGE 2010.7 ****************************************   18470000
248900        MOVE 1.0210 TO H-UPDATE-10D.
249000*****YEARCHANGE 2010.7 ****************************************   18470000
249100
249200     COMPUTE H-UPDATE-FACTOR ROUNDED =
249300                       (H-UPDATE-08 * H-UPDATE-09 *
249400                        H-UPDATE-10D *
249500                        H-BUDG-NUTR08 * H-BUDG-NUTR09 *
249600                                        H-BUDG-NUTR10D).
249700
249800     COMPUTE H-HSP-RATE ROUNDED =
249900         H-FAC-SPEC-RATE * H-UPDATE-FACTOR.
250000***************************************************************
250100*
250200*    IF P-NEW-CBSA-HOSP-QUAL-IND = '1'                            18537000
250300*       COMPUTE H-HSP-RATE ROUNDED =                              18538000
250400*        (H-FAC-SPEC-RATE * 1) * H-UPDATE-FACTOR                  18539000
250500*    ELSE                                                         18540000
250600*       COMPUTE H-HSP-RATE ROUNDED =                              18550000
250700*        ((H-FAC-SPEC-RATE / 1.036) * 1.016) * H-UPDATE-FACTOR.   18560000
250800*                                                                 18570000
250900***************************************************************   18580000
251000********YEARCHANGE 2010.0 *************************************   18590000
251100***         CASE MIX ADJUSTMENT - FOR FUTURE USE                  18480000
251200***         CASE MIX ADJUSTMENT - FOR FUTURE USE                  18480000
251300***                                                                     00
251400***  MOVE 0.994 TO H-CASE-MIX-ADJ.                                      00
251500***                                                                     00
251600***  COMPUTE H-HSP-RATE ROUNDED =                                       00
251700***    H-HSP-RATE * H-CASE-MIX-ADJ.                                     00
251800***                                                                     00
251900********YEARCHANGE 2010.0 *************************************   18590000
252000***     OUTLIER OFFSETS                                           18591000
252100***     OPERATING NATIONAL                                        18600000
252200***     OPERATING PUERTO RICO BLEND                               18610000
252300                                                                  18620000
252400********YEARCHANGE 2010.7 *************************************   18590000
252500                                                                  18620000
252600      MOVE 0.948998 TO H-OUTLIER-OFFSET-NAT                       18630000
252700      MOVE 0.957417 TO H-OUTLIER-OFFSET-PR.                       18640000
252800                                                                  18620000
252900********YEARCHANGE 2010.7 *************************************   18590000
253000                                                                  18650000
253100***************************************************************   18660000
253200     COMPUTE H-FSP-RATE ROUNDED =                                 18670000
253300         (H-NAT-PCT * (H-NAT-LABOR * H-WAGE-INDEX +               18680000
253400         H-NAT-NONLABOR * H-OPER-COLA))                           18690000
253500                           *                                      18700000
253600     ((1 + H-OPER-IME-TEACH + H-OPER-DSH) / H-OUTLIER-OFFSET-NAT) 18710000
253700                   ON SIZE ERROR MOVE 0 TO H-FSP-RATE.            18720000
253800                                                                  18730000
253900     IF P-NEW-STATE = 40                                          18740000
254000       COMPUTE H-FSP-RATE ROUNDED =                               18750000
254100         ((H-NAT-PCT * (H-NAT-LABOR * H-WAGE-INDEX +              18760000
254200         H-NAT-NONLABOR * H-OPER-COLA))                           18770000
254300                           *                                      18780000
254400         ((1 + H-OPER-IME-TEACH + H-OPER-DSH) /                   187810
254500                            H-OUTLIER-OFFSET-NAT))                187820
254600                               +                                  187830
254700         ((H-REG-PCT * (H-REG-LABOR * H-PR-WAGE-INDEX +           18790000
254800         H-REG-NONLABOR * H-OPER-COLA))                           18800000
254900                           *                                      18810000
255000      ((1 + H-OPER-IME-TEACH + H-OPER-DSH) /
255100                             H-OUTLIER-OFFSET-PR))
255200                   ON SIZE ERROR MOVE 0 TO H-FSP-RATE.            18830000
255300                                                                  18840000
255400                                                                  18850000
255500     IF  H-HSP-RATE > H-FSP-RATE                                  18860000
255600           COMPUTE H-OPER-HSP-PART ROUNDED =                      18870000
255700             (H-HSP-RATE - H-FSP-RATE) * H-DRG-WT                 18880000
255800                   ON SIZE ERROR MOVE 0 TO H-OPER-HSP-PART        18890000
255900     ELSE                                                         18900000
256000         MOVE 0 TO H-OPER-HSP-PART.                               18910000
256100                                                                  18920000
256200***************************************************************   18930000
256300***         GET THE MDH REBASE                                    18940000
256400                                                                  18950000
256500     IF  H-HSP-RATE > H-FSP-RATE                                  18960000
256600         IF P-NEW-PROVIDER-TYPE = '14' OR '15'                    18970000
256700           COMPUTE H-OPER-HSP-PART ROUNDED =                      18980000
256800             (H-HSP-RATE - H-FSP-RATE) * H-DRG-WT * .75           18990000
256900                   ON SIZE ERROR MOVE 0 TO H-OPER-HSP-PART.       19000000
257000                                                                  19010000
257100 3500-CALC-PERDIEM-AMT.                                           19020000
257200***********************************************************       19030000
257300***  REVIEW CODE = 03 OR 06                                       19040000
257400***  OPERATING PERDIEM-AMT CALCULATION                            19050000
257500***  OPERATING HSP AND FSP CALCULATION FOR TRANSFERS              19060000
257600                                                                  19070000
257700        COMPUTE H-OPER-FSP-PART ROUNDED =                         19080000
257800        H-OPER-FSP-PART * H-TRANSFER-ADJ                          19090000
257900        ON SIZE ERROR MOVE 0 TO H-OPER-FSP-PART.                  19100000
258000                                                                  19110000
258100***********************************************************       19120000
258200***********************************************************       19130000
258300***  REVIEW CODE = 03 OR 06                                       19140000
258400***  CAPITAL   PERDIEM-AMT CALCULATION                            19150000
258500***  CAPITAL   HSP AND FSP CALCULATION FOR TRANSFERS              19160000
258600                                                                  19170000
258700        COMPUTE H-CAPI-FSP-PART ROUNDED =                         19180000
258800        H-CAPI-FSP-PART * H-TRANSFER-ADJ                          19190000
258900        ON SIZE ERROR MOVE 0 TO H-CAPI-FSP-PART.                  19200000
259000                                                                  19210000
259100***********************************************************       19220000
259200***  REVIEW CODE = 03 OR 06                                       19230000
259300***  CAPITAL PERDIEM-AMT, OLD-HARMLESS CALCULATION                19240000
259400***  CAPITAL PERDIEM-AMT, OLD-HARMLESS CALCULATION                19250000
259500                                                                  19260000
259600        COMPUTE H-CAPI-OLD-HARMLESS ROUNDED =                     19270000
259700        H-CAPI-OLD-HARMLESS * H-TRANSFER-ADJ                      19280000
259800        ON SIZE ERROR MOVE 0 TO H-CAPI-OLD-HARMLESS.              19290000
259900                                                                  19300000
260000 3550-CALC-PERDIEM-AMT.                                           19310000
260100***********************************************************       19320000
260200***  REVIEW CODE = 09  OR 11 TRANSFER WITH SPECIAL DRG            19330000
260300***  OPERATING PERDIEM-AMT CALCULATION                            19340000
260400***  OPERATING HSP AND FSP CALCULATION FOR TRANSFERS              19350000
260500                                                                  19360000
260600     IF (B-DRG-POSTACUTE-50-50)                                   19370000
260700        MOVE 10 TO PPS-RTC                                        19380000
260800        COMPUTE H-OPER-FSP-PART ROUNDED =                         19390000
260900        H-OPER-FSP-PART * (.5 * (1 + H-TRANSFER-ADJ))             19400000
261000        ON SIZE ERROR MOVE 0 TO H-OPER-FSP-PART.                  19410000
261100                                                                  19420000
261200     IF (B-DRG-POSTACUTE-PERDIEM)                                 19430000
261300        MOVE 12 TO PPS-RTC                                        19440000
261400        COMPUTE H-OPER-FSP-PART ROUNDED =                         19450000
261500        H-OPER-FSP-PART *  H-TRANSFER-ADJ                         19460000
261600        ON SIZE ERROR MOVE 0 TO H-OPER-FSP-PART.                  19470000
261700                                                                  19480000
261800***********************************************************       19490000
261900***  CAPITAL PERDIEM-AMT CALCULATION                              19500000
262000***  CAPITAL HSP AND FSP CALCULATION FOR TRANSFERS                19510000
262100                                                                  19520000
262200     IF (B-DRG-POSTACUTE-50-50)                                   19530000
262300        MOVE 10 TO PPS-RTC                                        19540000
262400        COMPUTE H-CAPI-FSP-PART ROUNDED =                         19550000
262500        H-CAPI-FSP-PART * (.5 * (1 + H-TRANSFER-ADJ))             19560000
262600        ON SIZE ERROR MOVE 0 TO H-CAPI-FSP-PART.                  19570000
262700                                                                  19580000
262800     IF (B-DRG-POSTACUTE-PERDIEM)                                 19590000
262900        MOVE 12 TO PPS-RTC                                        19600000
263000        COMPUTE H-CAPI-FSP-PART ROUNDED =                         19610000
263100        H-CAPI-FSP-PART *  H-TRANSFER-ADJ                         19620000
263200        ON SIZE ERROR MOVE 0 TO H-CAPI-FSP-PART.                  19630000
263300                                                                  19640000
263400***********************************************************       19650000
263500***  CAPITAL PERDIEM-AMT, OLD-HARMLESS CALCULATION                19660000
263600***  CAPITAL PERDIEM-AMT, OLD-HARMLESS CALCULATION                19670000
263700                                                                  19680000
263800     IF (B-DRG-POSTACUTE-50-50)                                   19690000
263900        MOVE 10 TO PPS-RTC                                        19700000
264000        COMPUTE H-CAPI-OLD-HARMLESS ROUNDED =                     19710000
264100        H-CAPI-OLD-HARMLESS * (.5 * (1 + H-TRANSFER-ADJ))         19720000
264200        ON SIZE ERROR MOVE 0 TO H-CAPI-OLD-HARMLESS.              19730000
264300                                                                  19740000
264400     IF (B-DRG-POSTACUTE-PERDIEM)                                 19750000
264500        MOVE 12 TO PPS-RTC                                        19760000
264600        COMPUTE H-CAPI-OLD-HARMLESS ROUNDED =                     19770000
264700        H-CAPI-OLD-HARMLESS *  H-TRANSFER-ADJ                     19780000
264800        ON SIZE ERROR MOVE 0 TO H-CAPI-OLD-HARMLESS.              19790000
264900                                                                  19800000
265000 3560-CHECK-RTN-CODE.                                             19810000
265100                                                                  19820000
265200     IF (B-DRG-POSTACUTE-50-50)                                   19830000
265300        MOVE 10 TO PPS-RTC.                                       19840000
265400     IF (B-DRG-POSTACUTE-PERDIEM)                                 19850000
265500        MOVE 12 TO PPS-RTC.                                       19860000
265600                                                                  19870000
265700 3560-EXIT.    EXIT.                                              19880000
265800                                                                  19890000
265900 3600-CALC-OUTLIER.                                               19900000
266000***********************************************************       19910000
266100***  COST OUTLIER OPERATING AND CAPITAL CALCULATION               19920000
266200***  COST OUTLIER OPERATING AND CAPITAL CALCULATION               19930000
266300                                                                  19940000
266400     IF OUTLIER-RECON-FLAG = 'Y'                                  19950000
266500        COMPUTE H-OPER-CSTCHG-RATIO ROUNDED =                     19960000
266600               (H-OPER-CSTCHG-RATIO + .2).                        19970000
266700                                                                  19980000
266800     IF H-CAPI-CSTCHG-RATIO > 0 OR                                19990000
266900       H-OPER-CSTCHG-RATIO > 0                                    20000000
267000        COMPUTE H-OPER-SHARE-DOLL-THRESHOLD ROUNDED =             20010000
267100                H-OPER-CSTCHG-RATIO /                             20020000
267200               (H-OPER-CSTCHG-RATIO + H-CAPI-CSTCHG-RATIO)        20030000
267300        COMPUTE H-CAPI-SHARE-DOLL-THRESHOLD ROUNDED =             20040000
267400                H-CAPI-CSTCHG-RATIO /                             20050000
267500               (H-OPER-CSTCHG-RATIO + H-CAPI-CSTCHG-RATIO)        20060000
267600     ELSE                                                         20070000
267700         MOVE 0 TO H-OPER-SHARE-DOLL-THRESHOLD                    20080000
267800                   H-CAPI-SHARE-DOLL-THRESHOLD.                   20090000
267900                                                                  20100000
268000***********************************************************       20110000
268100*****YEARCHANGE 2010.0 ************************************       20110000
268200***  OUTLIER THRESHOLD AMOUNTS                                    20120000
268300***  OUTLIER THRESHOLD AMOUNTS                                    20130000
268400                                                                  20140000
268500*****YEARCHANGE 2010.7 ************************************       20110000
268600                                                                  20140000
268700     MOVE 23135.00 TO H-CST-THRESH.                               20150000
268800                                                                  20140000
268900*****YEARCHANGE 2010.7 ************************************       20110000
269000                                                                  20160000
269100     IF (B-REVIEW-CODE = '03') AND                                20170000
269200         H-PERDIEM-DAYS < H-ALOS                                  20180000
269300        COMPUTE H-CST-THRESH ROUNDED =                            20190000
269400                      (H-CST-THRESH * H-TRANSFER-ADJ)             20200000
269500                ON SIZE ERROR MOVE 0 TO H-CST-THRESH.             20210000
269600                                                                  20220000
269700     IF ((B-REVIEW-CODE = '09') AND                               20230000
269800         (H-PERDIEM-DAYS < H-ALOS))                               20240000
269900         IF (B-DRG-POSTACUTE-PERDIEM)                             20250000
270000            COMPUTE H-CST-THRESH ROUNDED =                        20260000
270100                      (H-CST-THRESH * H-TRANSFER-ADJ)             20270000
270200                ON SIZE ERROR MOVE 0 TO H-CST-THRESH.             20280000
270300                                                                  20290000
270400     IF ((B-REVIEW-CODE = '09') AND                               20300000
270500         (H-PERDIEM-DAYS < H-ALOS))                               20310000
270600         IF (B-DRG-POSTACUTE-50-50)                               20320000
270700           COMPUTE H-CST-THRESH ROUNDED =                         20330000
270800          (H-CST-THRESH * (.5 * (1 + H-TRANSFER-ADJ)))            20340000
270900                ON SIZE ERROR MOVE 0 TO H-CST-THRESH.             20350000
271000                                                                  20360000
271100     COMPUTE H-OPER-DOLLAR-THRESHOLD ROUNDED =                    20370000
271200        ((H-CST-THRESH * H-LABOR-PCT * H-WAGE-INDEX) +            20380000
271300         (H-CST-THRESH * H-NONLABOR-PCT * H-OPER-COLA)) *         20390000
271400          H-OPER-SHARE-DOLL-THRESHOLD.                            20400000
271500                                                                  20410000
271600     IF P-NEW-STATE = 40                                          20420000
271700        COMPUTE H-OPER-PR-DOLLAR-THRESHOLD ROUNDED =              20430000
271800           ((H-CST-THRESH * H-PR-LABOR-PCT * H-PR-WAGE-INDEX) +   20440000
271900            (H-CST-THRESH * H-PR-NONLABOR-PCT * H-OPER-COLA)) *   20450000
272000             H-OPER-SHARE-DOLL-THRESHOLD                          20460000
272100        COMPUTE H-OPER-DOLLAR-THRESHOLD ROUNDED =                 20470000
272200               (H-OPER-DOLLAR-THRESHOLD * H-NAT-PCT) +            20480000
272300               (H-OPER-PR-DOLLAR-THRESHOLD * H-REG-PCT).          20490000
272400                                                                  20500000
272500***********************************************************       20510000
272600                                                                  20520000
272700     COMPUTE H-CAPI-DOLLAR-THRESHOLD ROUNDED =                    20530000
272800          H-CST-THRESH * H-CAPI-GAF * H-CAPI-LARG-URBAN *         20540000
272900          H-CAPI-SHARE-DOLL-THRESHOLD * H-CAPI-COLA.              20550000
273000                                                                  20560000
273100                                                                  20570000
273200     IF P-NEW-STATE = 40                                          20580000
273300        COMPUTE H-CAPI-PR-DOLLAR-THRESHOLD ROUNDED =              20590000
273400           H-CST-THRESH * H-PR-CAPI-GAF * H-CAPI-LARG-URBAN *     20600000
273500           H-CAPI-SHARE-DOLL-THRESHOLD * H-CAPI-COLA              20610000
273600        COMPUTE H-CAPI-DOLLAR-THRESHOLD ROUNDED =                 20620000
273700               (H-CAPI-DOLLAR-THRESHOLD * H-NAT-PCT) +            20630000
273800               (H-CAPI-PR-DOLLAR-THRESHOLD * H-REG-PCT).          20640000
273900                                                                  20650000
274000                                                                  20660000
274100     COMPUTE H-OPER-COST-OUTLIER ROUNDED =                        20670000
274200      (H-OPER-FSP-PART * (1 + H-OPER-IME-TEACH + H-OPER-DSH))     20680000
274300                       +                                          20690000
274400             H-OPER-DOLLAR-THRESHOLD                              20700000
274500                       +                                          20710000
274600                 H-NEW-TECH-PAY-ADD-ON.                           20720000
274700                                                                  20730000
274800     COMPUTE H-CAPI-COST-OUTLIER ROUNDED =                        20740000
274900      (H-CAPI-FSP-PART * (1 + H-WK-CAPI-IME-TEACH + H-CAPI-DSH))  20750000
275000                       +                                          20760000
275100             H-CAPI-DOLLAR-THRESHOLD.                             20770000
275200                                                                  20780000
275300     IF (P-NEW-CAPI-NEW-HOSP = 'Y')                               20790000
275400         MOVE 0 TO H-CAPI-COST-OUTLIER.                           20800000
275500                                                                  20810000
275600                                                                  20820000
275700***********************************************************       20830000
275800***  OPERATING COST CALCULATION                                   20840000
275900***  OPERATING COST CALCULATION                                   20850000
276000                                                                  20860000
276100     COMPUTE H-OPER-BILL-COSTS ROUNDED =                          20870000
276200         B-CHARGES-CLAIMED * H-OPER-CSTCHG-RATIO                  20880000
276300         ON SIZE ERROR MOVE 0 TO H-OPER-BILL-COSTS.               20890000
276400                                                                  20900000
276500                                                                  20910000
276600     IF  H-OPER-BILL-COSTS > H-OPER-COST-OUTLIER                  20920000
276700         COMPUTE H-OPER-OUTCST-PART ROUNDED =                     20930000
276800         H-CSTOUT-PCT * (H-OPER-BILL-COSTS -                      20940000
276900                         H-OPER-COST-OUTLIER).                    20950000
277000                                                                  20960000
277100     IF PAY-WITHOUT-COST OR                                       20970000
277200        PAY-XFER-NO-COST OR                                       20980000
277300        PAY-XFER-SPEC-DRG-NO-COST                                 20990000
277400         MOVE 0 TO H-OPER-OUTCST-PART.                            21000000
277500                                                                  21010000
277600***********************************************************       21020000
277700***  CAPITAL COST CALCULATION                                     21030000
277800***  CAPITAL COST CALCULATION                                     21040000
277900                                                                  21050000
278000     COMPUTE H-CAPI-BILL-COSTS ROUNDED =                          21060000
278100             B-CHARGES-CLAIMED * H-CAPI-CSTCHG-RATIO              21070000
278200         ON SIZE ERROR MOVE 0 TO H-CAPI-BILL-COSTS.               21080000
278300                                                                  21090000
278400     IF  H-CAPI-BILL-COSTS > H-CAPI-COST-OUTLIER                  21100000
278500         COMPUTE H-CAPI-OUTCST-PART ROUNDED =                     21110000
278600         H-CSTOUT-PCT * (H-CAPI-BILL-COSTS -                      21120000
278700                         H-CAPI-COST-OUTLIER).                    21130000
278800                                                                  21140000
278900     IF P-NEW-CAPI-PPS-PAY-CODE = 'A'                             21150000
279000       COMPUTE H-CAPI-OUTCST-PART ROUNDED =                       21160000
279100              (H-CAPI-OUTCST-PART * P-NEW-CAPI-NEW-HARM-RATIO).   21170000
279200                                                                  21180000
279300     IF P-NEW-CAPI-PPS-PAY-CODE = 'C'                             21190000
279400        COMPUTE H-CAPI-OUTCST-PART ROUNDED =                      21200000
279500               (H-CAPI-OUTCST-PART * H-CAPI-PAYCDE-PCT1).         21210000
279600                                                                  21220000
279700     IF (H-CAPI-BILL-COSTS   + H-OPER-BILL-COSTS) <               21230000
279800        (H-CAPI-COST-OUTLIER + H-OPER-COST-OUTLIER)               21240000
279900        MOVE 0 TO H-CAPI-OUTCST-PART                              21250000
280000                  H-OPER-OUTCST-PART.                             21260000
280100                                                                  21270000
280200     IF PAY-WITHOUT-COST OR                                       21280000
280300        PAY-XFER-NO-COST OR                                       21290000
280400        PAY-XFER-SPEC-DRG-NO-COST                                 21300000
280500         MOVE 0 TO H-CAPI-OUTCST-PART.                            21310000
280600                                                                  21320000
280700***********************************************************       21330000
280800***  DETERMINES THE BILL TO BE COST  OUTLIER                      21340000
280900                                                                  21350000
281000     IF (P-NEW-CAPI-NEW-HOSP = 'Y')                               21360000
281100         MOVE 0 TO H-CAPI-OUTDAY-PART                             21370000
281200                   H-CAPI-OUTCST-PART.                            21380000
281300                                                                  21390000
281400     IF (H-OPER-OUTCST-PART + H-CAPI-OUTCST-PART) > 0             21400000
281500                 MOVE H-OPER-OUTCST-PART TO                       21410000
281600                      H-OPER-OUTLIER-PART                         21420000
281700                 MOVE H-CAPI-OUTCST-PART TO                       21430000
281800                      H-CAPI-OUTLIER-PART                         21440000
281900                 MOVE 02 TO PPS-RTC.                              21450000
282000                                                                  21460000
282100     IF OUTLIER-RECON-FLAG = 'Y'                                  21470000
282200        IF (H-OPER-OUTCST-PART + H-CAPI-OUTCST-PART) > 0          21480000
282300           COMPUTE HLD-PPS-RTC = HLD-PPS-RTC + 30                 21490000
282400           GO TO 3600-EXIT                                        21500000
282500        ELSE                                                      21510000
282600           GO TO 3600-EXIT                                        21520000
282700     ELSE                                                         21530000
282800        NEXT SENTENCE.                                            21540000
282900                                                                  21550000
283000                                                                  21560000
283100***********************************************************       21570000
283200***  DETERMINES IF COST OUTLIER                                   21580000
283300***  RECOMPUTES DOLLAR THRESHOLD TO BE SENT BACK WITH             21590000
283400***         RETURN CODE OF 02                                     21600000
283500                                                                  21610000
283600     MOVE 0 TO H-OPER-DOLLAR-THRESHOLD.                           21620000
283700                                                                  21630000
283800     IF PPS-RTC = 02                                              21640000
283900             COMPUTE H-OPER-DOLLAR-THRESHOLD ROUNDED =            21650000
284000                     (H-CAPI-COST-OUTLIER  +                      21660000
284100                      H-OPER-COST-OUTLIER)                        21670000
284200                             /                                    21680000
284300                    (H-CAPI-CSTCHG-RATIO  +                       21690000
284400                     H-OPER-CSTCHG-RATIO)                         21700000
284500             ON SIZE ERROR MOVE 0 TO H-OPER-DOLLAR-THRESHOLD.     21710000
284600                                                                  21720000
284700***********************************************************       21730000
284800***  DETERMINES IF COST OUTLIER WITH LOS IS > COVERED  DAYS       21740000
284900***         RETURN CODE OF 67                                     21750000
285000                                                                  21760000
285100     IF PPS-RTC = 02                                              21770000
285200         IF ((H-REG-DAYS + H-LTR-DAYS) < B-LOS) OR                21780000
285300            PPS-PC-COT-FLAG = 'Y'                                 21790000
285400             MOVE 67 TO PPS-RTC.                                  21800000
285500***********************************************************       21810000
285600                                                                  21820000
285700***********************************************************       21830000
285800***  DETERMINES THE OUTLIER AMOUNT THAT WOULD BE PAID IF          21840000
285900***  THE PROVIDER WAS TYPE B-HOLD-HARMLESS 100% FED RATE          21850000
286000                                                                  21860000
286100     IF P-NEW-CAPI-PPS-PAY-CODE = 'A'                             21870000
286200        COMPUTE H-CAPI2-B-OUTLIER-PART ROUNDED =                  21880000
286300                H-CAPI-OUTLIER-PART / P-NEW-CAPI-NEW-HARM-RATIO   21890000
286400         ON SIZE ERROR MOVE 0 TO H-CAPI2-B-OUTLIER-PART.          21900000
286500                                                                  21910000
286600     IF P-NEW-CAPI-PPS-PAY-CODE = 'B'                             21920000
286700        COMPUTE H-CAPI2-B-OUTLIER-PART ROUNDED =                  21930000
286800                H-CAPI-OUTLIER-PART.                              21940000
286900                                                                  21950000
287000     IF P-NEW-CAPI-PPS-PAY-CODE = 'C'                             21960000
287100        COMPUTE H-CAPI2-B-OUTLIER-PART ROUNDED =                  21970000
287200                H-CAPI-OUTLIER-PART / H-CAPI-PAYCDE-PCT1          21980000
287300         ON SIZE ERROR MOVE 0 TO H-CAPI2-B-OUTLIER-PART.          21990000
287400                                                                  22000000
287500 3600-EXIT.   EXIT.                                               22010000
287600                                                                  22020000
287700***********************************************************       22030000
287800 3800-CALC-TOT-AMT.                                               22040000
287900***********************************************************       22050000
288000***  CALCULATE TOTALS FOR CAPITAL                                 22060000
288100***  CALCULATE TOTALS FOR CAPITAL                                 22070000
288200                                                                  22080000
288300     MOVE P-NEW-CAPI-PPS-PAY-CODE  TO H-CAPI2-PAY-CODE.           22090000
288400                                                                  22100000
288500     IF P-NEW-CAPI-PPS-PAY-CODE = 'A'                             22110000
288600        MOVE P-NEW-CAPI-NEW-HARM-RATIO TO H-CAPI-FSP-PCT          22120000
288700        MOVE 0.00 TO H-CAPI-HSP-PCT.                              22130000
288800                                                                  22140000
288900     IF P-NEW-CAPI-PPS-PAY-CODE = 'B'                             22150000
289000        MOVE 0    TO H-CAPI-OLD-HARMLESS                          22160000
289100        MOVE 1.00 TO H-CAPI-FSP-PCT                               22170000
289200        MOVE 0.00 TO H-CAPI-HSP-PCT.                              22180000
289300                                                                  22190000
289400     IF P-NEW-CAPI-PPS-PAY-CODE = 'C'                             22200000
289500        MOVE 0    TO H-CAPI-OLD-HARMLESS                          22210000
289600        MOVE H-CAPI-PAYCDE-PCT1 TO H-CAPI-FSP-PCT                 22220000
289700        MOVE H-CAPI-PAYCDE-PCT2 TO H-CAPI-HSP-PCT.                22230000
289800                                                                  22240000
289900     COMPUTE H-CAPI-HSP ROUNDED =                                 22250000
290000         H-CAPI-HSP-PCT * H-CAPI-HSP-PART.                        22260000
290100                                                                  22270000
290200     COMPUTE H-CAPI-FSP ROUNDED =                                 22280000
290300         H-CAPI-FSP-PCT * H-CAPI-FSP-PART.                        22290000
290400                                                                  22300000
290500     MOVE P-NEW-CAPI-EXCEPTIONS TO H-CAPI-EXCEPTIONS.             22310000
290600                                                                  22320000
290700     MOVE H-CAPI-OLD-HARMLESS TO H-CAPI-OLD-HARM.                 22330000
290800                                                                  22340000
290900     COMPUTE H-CAPI-DSH-ADJ ROUNDED =                             22350000
291000             H-CAPI-FSP                                           22360000
291100              * H-CAPI-DSH.                                       22370000
291200                                                                  22380000
291300     COMPUTE H-CAPI-IME-ADJ ROUNDED =                             22390000
291400          H-CAPI-FSP *                                            22400000
291500                 H-WK-CAPI-IME-TEACH.                             22410000
291600                                                                  22420000
291700     COMPUTE H-CAPI-OUTLIER ROUNDED =                             22430000
291800             1.00 * H-CAPI-OUTLIER-PART.                          22440000
291900                                                                  22450000
292000     COMPUTE H-CAPI2-B-FSP ROUNDED =                              22460000
292100             1.00 * H-CAPI2-B-FSP-PART.                           22470000
292200                                                                  22480000
292300     COMPUTE H-CAPI2-B-OUTLIER ROUNDED =                          22490000
292400             1.00 * H-CAPI2-B-OUTLIER-PART.                       22500000
292500***********************************************************       22510000
292600***  IF CAPITAL IS NOT IN EFFECT FOR GIVEN PROVIDER               22520000
292700***        THIS ZEROES OUT ALL CAPITAL DATA                       22530000
292800                                                                  22540000
292900     IF (P-NEW-CAPI-NEW-HOSP = 'Y')                               22550000
293000        MOVE ALL '0' TO HOLD-CAPITAL-VARIABLES.                   22560000
293100***********************************************************       22570000
293200                                                                  22580000
293300***********************************************************       22590000
293400***  CALCULATE FINAL TOTALS FOR OPERATING                         22600000
293500***  CALCULATE FINAL TOTALS FOR OPERATING                         22610000
293600                                                                  22620000
293700     IF (H-CAPI-OUTLIER > 0 AND                                   22630000
293800         PPS-OPER-OUTLIER-PART = 0)                               22640000
293900            COMPUTE PPS-OPER-OUTLIER-PART =                       22650000
294000                    PPS-OPER-OUTLIER-PART + .01.                  22660000
294100                                                                  22670000
294200     MOVE ZERO TO PPS-OPER-DSH-ADJ.                               22730000
294300                                                                  22740000
294400     IF  H-OPER-DSH NUMERIC                                       22750000
294500         COMPUTE PPS-OPER-DSH-ADJ ROUNDED =                       22760000
294600       (PPS-OPER-FSP-PART * H-OPER-DSH).                          22770000
294700                                                                  22780000
294800     COMPUTE PPS-OPER-IME-ADJ ROUNDED =                           22790000
294900        (PPS-OPER-FSP-PART * H-OPER-IME-TEACH).                   22800000
295000                                                                  22810000
295100                                                                  22820000
295200     COMPUTE PPS-OPER-FSP-PART ROUNDED =                          22830000
295300          (H-OPER-FSP-PART * H-OPER-FSP-PCT).                     22840000
295400                                                                  22850000
295500     COMPUTE PPS-OPER-HSP-PART ROUNDED =                          22860000
295600         (H-OPER-HSP-PART * H-OPER-HSP-PCT).                      22870000
295700                                                                  22880000
295800     COMPUTE PPS-OPER-OUTLIER-PART ROUNDED =                      22890000
295900         (H-OPER-OUTLIER-PART * H-OPER-FSP-PCT).                  22900000
296000                                                                  22910000
296100     IF HMO-TAG  = 'Y'                                            22920000
296200        PERFORM 3850-HMO-IME-ADJ.                                 22930000
296300                                                                  22940000
296400***********************************************************       22950000
296500***  CALCULATE FINAL TOTALS FOR CAPITAL AND OPERATING             22960000
296600***  CALCULATE FINAL TOTALS FOR CAPITAL AND OPERATING             22970000
296700                                                                  22980000
296800     COMPUTE H-CAPI-TOTAL-PAY ROUNDED =                           22990000
296900            (H-CAPI-HSP + H-CAPI-FSP + H-CAPI-EXCEPTIONS +        23000000
297000             H-CAPI-OUTLIER + H-CAPI-DSH-ADJ +                    23010000
297100             H-CAPI-IME-ADJ + H-CAPI-OLD-HARM).                   23020000
297200                                                                  23030000
297300     COMPUTE H-NEW-TECH-PAY-ADD-ON ROUNDED =                      23040000
297400              H-NEW-TECH-PAY-ADD-ON.                              23050000
297500                                                                  23060000
297600***********************************************************       23070000
297700* PUT NEW CHECK HERE IF H-NEW-TECH ZERO PERFORM                   23080000
297800*                                                                 23090000
297900     IF   H-NEW-TECH-PAY-ADD-ON = 0                               23100000
298000                                                                  23110000
298100     PERFORM 4100-ISLET-ISOLATION-ADD-ON THRU 4100-EXIT.          23120000
298200                                                                  23150000
298300     MOVE H-NEW-TECH-PAY-ADD-ON TO PPS-NEW-TECH-PAY-ADD-ON.       23151000
298400                                                                  23152000
298500     MOVE 01.000 TO WK-LOW-VOL25PCT.                              22680000
298600                                                                  22690000
298700     IF P-NEW-TEMP-RELIEF-IND = 'Y'                               22700000
298800        MOVE 00.250 TO WK-LOW-VOL25PCT.                           22710000
298900                                                                  22720000
299000     IF  WK-LOW-VOL25PCT < 1.000000                                     00
299100     COMPUTE WK-LOW-VOL-ADDON  ROUNDED =                          23040000
299200              (PPS-OPER-HSP-PART + PPS-OPER-FSP-PART +            23154000
299300               PPS-OPER-OUTLIER-PART + PPS-OPER-DSH-ADJ +         23155000
299400                      PPS-OPER-IME-ADJ                            23156000
299500                           +                                      23157000
299600             H-CAPI-HSP + H-CAPI-FSP + H-CAPI-EXCEPTIONS +        23000000
299700             H-CAPI-OUTLIER + H-CAPI-DSH-ADJ +                    23010000
299800             H-CAPI-IME-ADJ + H-CAPI-OLD-HARM +                   23020000
299900                 PPS-NEW-TECH-PAY-ADD-ON) *  WK-LOW-VOL25PCT      23158000
300000     ELSE
300100     COMPUTE WK-LOW-VOL-ADDON  ROUNDED = 0.000000.                23040000
300200                                                                  23060000
300300     COMPUTE H-LOW-VOL-PAYMENT ROUNDED = WK-LOW-VOL-ADDON.        23040000
300400                                                                  23060000
300500     COMPUTE   PPS-TOTAL-PAYMENT ROUNDED =                        23153000
300600               PPS-OPER-HSP-PART + PPS-OPER-FSP-PART +            23154000
300700               PPS-OPER-OUTLIER-PART + PPS-OPER-DSH-ADJ +         23155000
300800                      PPS-OPER-IME-ADJ                            23156000
300900                           +                                      23157000
301000                 PPS-NEW-TECH-PAY-ADD-ON                          23158000
301100                           +                                      23159000
301200                 H-WK-PASS-AMT-PLUS-MISC                          23160000
301300                           +                                      23170000
301400                   H-CAPI-TOTAL-PAY.                              23180000
301500                                                                  23190000
301600 3850-HMO-IME-ADJ.                                                23200000
301700***********************************************************       23210000
301800***  HMO CALC FOR PASS-THRU ADDON                                 23220000
301900***  HMO CALC FOR PASS-THRU ADDON                                 23230000
302000                                                                  23240000
302100     COMPUTE H-WK-PASS-AMT-PLUS-MISC ROUNDED =                    23250000
302200          (P-NEW-PASS-AMT-PLUS-MISC -                             23260000
302300          (P-NEW-PASS-AMT-ORGAN-ACQ +                             23270000
302400           P-NEW-PASS-AMT-DIR-MED-ED)) * B-LOS.                   23280000
302500                                                                  23290000
302600***********************************************************       23300000
302700***  HMO IME ADJUSTMENT --- NO LONGER PAID AS OF 10/01/2002       23310000
302800                                                                  23320000
302900     COMPUTE PPS-OPER-IME-ADJ ROUNDED =                           23330000
303000                   PPS-OPER-IME-ADJ * .0.                         23340000
303100                                                                  23350000
303200***********************************************************       23360000
303300                                                                  23370000
303400                                                                  23380000
303500 3900A-CALC-OPER-DSH.                                             23390000
303600                                                                  23400000
303700***  OPERATING DSH CALCULATION                                    23410000
303800***  OPERATING DSH CALCULATION                                    23420000
303900                                                                  23430000
304000      MOVE 0.0000 TO H-OPER-DSH.                                  23440000
304100                                                                  23450000
304200      COMPUTE H-WK-OPER-DSH ROUNDED  = (P-NEW-SSI-RATIO           23460000
304300                                     + P-NEW-MEDICAID-RATIO).     23470000
304400                                                                  23480000
304500***********************************************************       23490000
304600**1**    0-99 BEDS                                                23500000
304700***  NOT TO EXCEED 12%                                            23510000
304800                                                                  23520000
304900      IF (W-CBSA-SIZE = 'O' OR 'L') AND P-NEW-BED-SIZE < 100      23530000
305000                               AND H-WK-OPER-DSH > .1499          23540000
305100                               AND H-WK-OPER-DSH < .2020          23550000
305200        COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .15)        23560000
305300                                      * .65 + .025                23570000
305400        IF H-OPER-DSH > .1200  MOVE .1200 TO H-OPER-DSH.          23580000
305500                                                                  23590000
305600      IF (W-CBSA-SIZE = 'O' OR 'L') AND P-NEW-BED-SIZE < 100      23600000
305700                               AND H-WK-OPER-DSH > .2019          23610000
305800        COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .202)       23620000
305900                                      * .825 + .0588              23630000
306000        IF H-OPER-DSH > .1200  MOVE .1200 TO H-OPER-DSH.          23640000
306100                                                                  23650000
306200***********************************************************       23660000
306300**2**   100 + BEDS                                                23670000
306400***  NO CAP >> CAN EXCEED 12%                                     23680000
306500                                                                  23690000
306600      IF (W-CBSA-SIZE = 'O' OR 'L') AND P-NEW-BED-SIZE > 99       23700000
306700                               AND H-WK-OPER-DSH > .1499          23710000
306800                               AND H-WK-OPER-DSH < .2020          23720000
306900        COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .15)        23730000
307000                                      * .65 + .025.               23740000
307100                                                                  23750000
307200      IF (W-CBSA-SIZE = 'O' OR 'L') AND P-NEW-BED-SIZE > 99       23760000
307300                               AND H-WK-OPER-DSH > .2019          23770000
307400        COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .202)       23780000
307500                                      * .825 + .0588.             23790000
307600                                                                  23800000
307700***********************************************************       23810000
307800**3**   OTHER RURAL HOSPITALS LESS THEN 500 BEDS                  23820000
307900***  NOT TO EXCEED 12%                                            23830000
308000                                                                  23840000
308100      IF W-CBSA-SIZE = 'R'     AND P-NEW-BED-SIZE < 500           23850000
308200                               AND H-WK-OPER-DSH > .1499          23860000
308300                               AND H-WK-OPER-DSH < .2020          23870000
308400        COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .15)        23880000
308500                                 * .65 + .025                     23890000
308600        IF H-OPER-DSH > .1200                                     23900000
308700              MOVE .1200 TO H-OPER-DSH.                           23910000
308800                                                                  23920000
308900      IF W-CBSA-SIZE = 'R'     AND P-NEW-BED-SIZE < 500           23930000
309000                               AND H-WK-OPER-DSH > .2019          23940000
309100        COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .202)       23950000
309200                                 * .825 + .0588                   23960000
309300        IF H-OPER-DSH > .1200                                     23970000
309400                 MOVE .1200 TO H-OPER-DSH.                        23980000
309500***********************************************************       23990000
309600**4**   OTHER RURAL HOSPITALS 500 BEDS +                          24000000
309700***  NO CAP >> CAN EXCEED 12%                                     24010000
309800                                                                  24020000
309900      IF W-CBSA-SIZE = 'R'     AND P-NEW-BED-SIZE > 499           24030000
310000                               AND H-WK-OPER-DSH > .1499          24040000
310100                               AND H-WK-OPER-DSH < .2020          24050000
310200        COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .15)        24060000
310300                                 * .65 + .025.                    24070000
310400                                                                  24080000
310500      IF W-CBSA-SIZE = 'R'     AND P-NEW-BED-SIZE > 499           24090000
310600                               AND H-WK-OPER-DSH > .2019          24100000
310700        COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .202)       24110000
310800                                 * .825 + .0588.                  24120000
310900                                                                  24130000
311000***********************************************************       24140000
311100**7**   RURAL HOSPITALS SCH                                       24150000
311200***  NOT TO EXCEED 12%                                            24160000
311300                                                                  24170000
311400      IF W-CBSA-SIZE = 'R'                                        24180000
311500         IF (P-NEW-PROVIDER-TYPE = '16' OR '17' OR '21' OR '22')  24190000
311600                               AND H-WK-OPER-DSH > .1499          24200000
311700                               AND H-WK-OPER-DSH < .2020          24210000
311800         COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .15)       24220000
311900                                 * .65 + .025                     24230000
312000        IF H-OPER-DSH > .1200                                     24240000
312100                 MOVE .1200 TO H-OPER-DSH.                        24250000
312200                                                                  24260000
312300      IF W-CBSA-SIZE = 'R'                                        24270000
312400         IF (P-NEW-PROVIDER-TYPE = '16' OR '17' OR '21' OR '22')  24280000
312500                               AND H-WK-OPER-DSH > .2019          24290000
312600         COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .202)      24300000
312700                                 * .825 + .0588                   24310000
312800        IF H-OPER-DSH > .1200                                     24320000
312900                 MOVE .1200 TO H-OPER-DSH.                        24330000
313000                                                                  24340000
313100***********************************************************       24350000
313200**6**   RURAL HOSPITALS RRC   RULE 5 & 6 SAME                     24360000
313300***  RRC OVERRIDES SCH CAP                                        24370000
313400***  NO CAP >> CAN EXCEED 12%                                     24380000
313500                                                                  24390000
313600         IF (P-NEW-PROVIDER-TYPE = '07' OR '14' OR '15' OR        24400000
313700                                   '17' OR '22')                  24410000
313800                               AND H-WK-OPER-DSH > .1499          24420000
313900                               AND H-WK-OPER-DSH < .2020          24430000
314000         COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .15)       24440000
314100                                 * .65 + .025.                    24450000
314200                                                                  24450000
314300         IF (P-NEW-PROVIDER-TYPE = '07' OR '14' OR '15' OR        24460000
314400                                   '17' OR '22')                  24470000
314500                               AND H-WK-OPER-DSH > .2019          24480000
314600         COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .202)      24490000
314700                                 * .825 + .0588.                  24500000
314800                                                                  24510000
314900      COMPUTE H-OPER-DSH ROUNDED = H-OPER-DSH * 1.0000.           24520000
315000                                                                  24530000
315100 3900A-EXIT.   EXIT.                                              24540000
315200                                                                  24550000
315300 4000-CALC-TECH-ADDON.                                            24560000
315400                                                                  24570000
315500***********************************************************       24580000
315600***  CALCULATE TOTALS FOR OPERATING  ADD ON FOR TECH              24590000
315700***  CALCULATE TOTALS FOR OPERATING  ADD ON FOR TECH              24600000
315800                                                                  24610000
315900     COMPUTE PPS-OPER-HSP-PART ROUNDED =                          24620000
316000         H-OPER-HSP-PCT * H-OPER-HSP-PART.                        24630000
316100                                                                  24640000
316200     COMPUTE PPS-OPER-FSP-PART ROUNDED =                          24650000
316300         H-OPER-FSP-PCT * H-OPER-FSP-PART.                        24660000
316400                                                                  24670000
316500     MOVE ZERO TO PPS-OPER-DSH-ADJ.                               24680000
316600                                                                  24690000
316700     IF  H-OPER-DSH NUMERIC                                       24700000
316800             COMPUTE PPS-OPER-DSH-ADJ ROUNDED =                   24710000
316900              PPS-OPER-FSP-PART                                   24720000
317000              * H-OPER-DSH.                                       24730000
317100                                                                  24740000
317200     COMPUTE PPS-OPER-IME-ADJ ROUNDED =                           24750000
317300             PPS-OPER-FSP-PART *                                  24760000
317400             H-OPER-IME-TEACH.                                    24770000
317500                                                                  24780000
317600     COMPUTE H-BASE-DRG-PAYMENT ROUNDED =                         24790000
317700             PPS-OPER-HSP-PART + PPS-OPER-FSP-PART +              24800000
317800             PPS-OPER-DSH-ADJ + PPS-OPER-IME-ADJ.                 24810000
317900                                                                  24820000
318000***********************************************************       24830000
318100****      NEUROSTIMULATOR CASES                                   24840000
318200***********************************************************       24850000
318300*                                                                 24860000
318400*    IF '8698   ' =  B-PRIN-PROC-CODE   OR                        24870000
318500*                    B-OTHER-PROC-CODE1 OR                        24880000
318600*                    B-OTHER-PROC-CODE2 OR                        24890000
318700*                    B-OTHER-PROC-CODE3 OR                        24900000
318800*                    B-OTHER-PROC-CODE4 OR                        24910000
318900*                    B-OTHER-PROC-CODE5                           24920000
319000*          NEXT SENTENCE                                          24930000
319100*    ELSE                                                         24940000
319200*          MOVE ZEROES TO H-NEW-TECH-ADDON-NEURO                  24950000
319300*          GO TO 4000-CHECK-GRAFT-CASES.                          24960000
319400*                                                                 24970000
319500*    MOVE 18640.00 TO H-CSTMED-NEURO.                             24980000
319600*                                                                 24990000
319700*    COMPUTE H-LESSER-NEURO-1 ROUNDED =                           25000000
319800*            .5   H-CSTMED-NEURO.                                 25010000
319900*                                                                 25020000
320000*    COMPUTE H-LESSER-NEURO-2 ROUNDED =                           25030000
320100*          ((B-CHARGES-CLAIMED   P-NEW-OPER-CSTCHG-RATIO) -       25040000
320200*                    H-BASE-DRG-PAYMENT)   .5.                    25050000
320300*                                                                 25060000
320400*    IF H-LESSER-NEURO-2 > 0                                      25070000
320500*       IF H-LESSER-NEURO-1 < H-LESSER-NEURO-2                    25080000
320600*          MOVE H-LESSER-NEURO-1 TO H-NEW-TECH-ADDON-NEURO        25090000
320700*       ELSE                                                      25100000
320800*          MOVE H-LESSER-NEURO-2 TO H-NEW-TECH-ADDON-NEURO        25110000
320900*    ELSE                                                         25120000
321000*       MOVE ZEROES          TO H-NEW-TECH-ADDON-NEURO.           25130000
321100*                                                                 25140000
321200*4000-CHECK-GRAFT-CASES.                                          25150000
321300*                                                                 25160000
321400***********************************************************       25170000
321500***      GRAFT*(GORE*TAG)*CASES                                   25180000
321600***********************************************************       25190000
321700*                                                                 25200000
321800*    IF '3973   ' =  B-PRIN-PROC-CODE   OR                        25210000
321900*                    B-OTHER-PROC-CODE1 OR                        25220000
322000*                    B-OTHER-PROC-CODE2 OR                        25230000
322100*                    B-OTHER-PROC-CODE3 OR                        25240000
322200*                    B-OTHER-PROC-CODE4 OR                        25250000
322300*                    B-OTHER-PROC-CODE5                           25260000
322400*          NEXT SENTENCE                                          25270000
322500*    ELSE                                                         25280000
322600*          MOVE ZEROES TO H-NEW-TECH-ADDON-GRAFT                  25290000
322700*          GO TO 4000-CHECK-X-STOP.                               25300000
322800*                                                                 25310000
322900*    MOVE 21198.00 TO H-CSTMED-GRAFT.                             25320000
323000*                                                                 25330000
323100*    COMPUTE H-LESSER-GRAFT-1 ROUNDED =                           25340000
323200*            .5   H-CSTMED-GRAFT.                                 25350000
323300*                                                                 25360000
323400*    COMPUTE H-LESSER-GRAFT-2 ROUNDED =                           25370000
323500*          ((B-CHARGES-CLAIMED   P-NEW-OPER-CSTCHG-RATIO) -       25380000
323600*                    H-BASE-DRG-PAYMENT)   .5.                    25390000
323700*                                                                 25400000
323800*    IF H-LESSER-GRAFT-2 > 0                                      25410000
323900*       IF H-LESSER-GRAFT-1 < H-LESSER-GRAFT-2                    25420000
324000*          MOVE H-LESSER-GRAFT-1 TO H-NEW-TECH-ADDON-GRAFT        25430000
324100*       ELSE                                                      25440000
324200*          MOVE H-LESSER-GRAFT-2 TO H-NEW-TECH-ADDON-GRAFT        25450000
324300*    ELSE                                                         25460000
324400*       MOVE ZEROES          TO H-NEW-TECH-ADDON-GRAFT.           25470000
324500*                                                                 25480000
324600*4000-CHECK-X-STOP.                                               25490000
324700*                                                                 25500000
324800***********************************************************       25510000
324900*****    X-STOP INTERSPINOUS PROCESS DECOMPRESSION SYSTEM         25520000
325000***********************************************************       25530000
325100*                                                                 25540000
325200*    IF '8458   ' =  B-PRIN-PROC-CODE   OR                        25550000
325300*                    B-OTHER-PROC-CODE1 OR                        25560000
325400*                    B-OTHER-PROC-CODE2 OR                        25570000
325500*                    B-OTHER-PROC-CODE3 OR                        25580000
325600*                    B-OTHER-PROC-CODE4 OR                        25590000
325700*                    B-OTHER-PROC-CODE5                           25600000
325800*          NEXT SENTENCE                                          25610000
325900*    ELSE                                                         25620000
326000*          MOVE ZEROES TO H-NEW-TECH-ADDON-X-STOP                 25630000
326100*          GO TO 4000-ADD-TECH-CASES.                             25640000
326200*                                                                 25650000
326300*    MOVE 8800.00 TO H-CSTMED-X-STOP.                             25660000
326400*                                                                 25670000
326500*    COMPUTE H-LESSER-HRTIMP-STOP-1 ROUNDED =                     25680000
326600*            .5   H-CSTMED-X-STOP.                                25690000
326700*                                                                 25700000
326800*    COMPUTE H-LESSER-HRTIMP-STOP-2 ROUNDED =                     25710000
326900*          ((B-CHARGES-CLAIMED   P-NEW-OPER-CSTCHG-RATIO) -       25720000
327000*                    H-BASE-DRG-PAYMENT)   .5.                    25730000
327100*                                                                 25740000
327200*    IF H-LESSER-HRTIMP-STOP-2 > 0                                25750000
327300*       IF H-LESSER-HRTIMP-STOP-1 < H-LESSER-HRTIMP-STOP-2        25760000
327400*        MOVE H-LESSER-HRTIMP-STOP-1 TO H-NEW-TECH-ADDON-X-STOP   25770000
327500*       ELSE                                                      25780000
327600*        MOVE H-LESSER-HRTIMP-STOP-2 TO H-NEW-TECH-ADDON-X-STOP   25790000
327700*    ELSE                                                         25800000
327800*       MOVE ZEROES          TO H-NEW-TECH-ADDON-X-STOP.          25810000
327900*                                                                 25820000
328000*                                                                 25830000
328100*4000-ADD-TECH-CASES.                                             25840000
328200*                                                                 25850000
328300*    COMPUTE H-NEW-TECH-PAY-ADD-ON ROUNDED =                      25860000
328400*            H-NEW-TECH-ADDON-NEURO  +                            25870000
328500*            H-NEW-TECH-ADDON-GRAFT +                             25880000
328600*            H-NEW-TECH-ADDON-X-STOP.                             25890000
328700*                                                                 25900000
328800***********************************************************       25510000
328900***** HRTIMP-STOP INTERSPINOUS PROCESS DECOMPRESSION SYSTEM       25520000
329000***********************************************************       25530000
329100                                                                  25540000
329200     IF '3752   ' =  B-PRIN-PROC-CODE   OR                        25550000
329300                     B-OTHER-PROC-CODE1 OR                        25560000
329400                     B-OTHER-PROC-CODE2 OR                        25570000
329500                     B-OTHER-PROC-CODE3 OR                        25580000
329600                     B-OTHER-PROC-CODE4 OR                        25590000
329700                     B-OTHER-PROC-CODE5                           25600000
329800           NEXT SENTENCE                                          25610000
329900     ELSE                                                         25620000
330000           MOVE ZEROES TO H-NEW-TECH-ADDON-HRTIMP-STOP            25630000
330100           GO TO 4000-ADD-TECH-CASES.                             25640000
330200                                                                  25650000
330300     MOVE 53000.00 TO H-CSTMED-HRTIMP-STOP.                       25660000
330400                                                                  25670000
330500     COMPUTE H-LESSER-HRTIMP-STOP-1 ROUNDED =                     25680000
330600                  H-CSTMED-HRTIMP-STOP.                           25690000
330700                                                                  25700000
330800     COMPUTE H-LESSER-HRTIMP-STOP-2 ROUNDED =                     25710000
330900          (((B-CHARGES-CLAIMED * P-NEW-OPER-CSTCHG-RATIO) -       25720000
331000                     H-BASE-DRG-PAYMENT)) * .5.                   25730000
331100                                                                  25740000
331200     IF H-LESSER-HRTIMP-STOP-2 > 0                                25750000
331300        IF H-LESSER-HRTIMP-STOP-1 < H-LESSER-HRTIMP-STOP-2        25760000
331400         MOVE H-LESSER-HRTIMP-STOP-1 TO
331500                                  H-NEW-TECH-ADDON-HRTIMP-STOP
331600        ELSE                                                      25780000
331700         MOVE H-LESSER-HRTIMP-STOP-2 TO
331800                                  H-NEW-TECH-ADDON-HRTIMP-STOP
331900     ELSE                                                         25800000
332000        MOVE ZEROES          TO H-NEW-TECH-ADDON-HRTIMP-STOP.     25810000
332100                                                                  25820000
332200                                                                  25830000
332300 4000-ADD-TECH-CASES.                                             25840000
332400                                                                  25850000
332500     COMPUTE H-NEW-TECH-PAY-ADD-ON ROUNDED =                      25860000
332600             H-NEW-TECH-ADDON-HRTIMP-STOP.                        25890000
332700*                                                                 25900000
332800***********************************************************       23070000
332900* PUT NEW CHECK HERE IF H-NEW-TECH ZERO PERFORM                   23080000
333000                                                                  23090000
333100     IF   H-NEW-TECH-PAY-ADD-ON = 0 AND                           23100000
333200          B-DRG-SPIRATN-DRG
333300        PERFORM 4300-SPIRAT-TECH-ADD-ON THRU 4300-EXIT.           23140000
333400                                                                  23130000
333500     COMPUTE PPS-NEW-TECH-PAY-ADD-ON ROUNDED =                    26009200
333600             H-NEW-TECH-PAY-ADD-ON.                               26009300
333700                                                                  26009400
333800*                                                                 25900000
333900 4000-EXIT.    EXIT.                                              25910000
334000***********************************************************       25920000
334100                                                                  25930000
334200 4100-ISLET-ISOLATION-ADD-ON.                                     25940000
334300***********************************************************       25950000
334400***  TECHNICAL TRANSPLANTATION OF CELLS                           25960000
334500***                                                               25970000
334600*** CODE 52.85 (ALLTRANSPLANTATION OF CELLS OF ISLETS OF          25980000
334700*** ISLETS OF LANGERHAUS) AND                                     25990000
334800*** V70.7 (EXAMINATION OF PARTICIPANT IN CLINICAL TRIAL).         25991000
334900*** V70.7 ONE OR MORE TIMES IN PROC-CODES AND 52.85 ONE OR MORE   25992000
335000*** TIMES IN ANY OTHER PROC-CODE                                  25993000
335100***********************************************************       25994000
335200*** IT WAS DECIDED ON 3/12/07 TO ONLY CHECK FOR 52.85 AND NOT     25995000
335300*** V70.7                                                         25995100
335400***********************************************************       25995200
335500                                                                  25995300
335600     MOVE 0 TO H-TECH-ADDON-ISLET-CNTR                            25995400
335700               H-TECH-ADDON-ISLET-CNTR2.                          25995500
335800                                                                  25995600
335900*    IF 'V707   ' =  B-PRIN-PROC-CODE   OR                        25995700
336000*                    B-OTHER-PROC-CODE1 OR                        25995800
336100*                    B-OTHER-PROC-CODE2 OR                        25995900
336200*                    B-OTHER-PROC-CODE3 OR                        25996000
336300*                    B-OTHER-PROC-CODE4 OR                        25997000
336400*                    B-OTHER-PROC-CODE5                           25998000
336500*          NEXT SENTENCE                                          25999000
336600*    ELSE                                                         25999100
336700*          MOVE ZEROES TO H-NEW-TECH-ADDON-ISLET                  25999200
336800*          GO TO 4100-ADD-TECH-CASES.                             25999300
336900                                                                  25999400
337000     IF '5285   ' =  B-PRIN-PROC-CODE   OR                        25999500
337100                     B-OTHER-PROC-CODE1 OR                        25999600
337200                     B-OTHER-PROC-CODE2 OR                        25999700
337300                     B-OTHER-PROC-CODE3 OR                        25999800
337400                     B-OTHER-PROC-CODE4 OR                        25999900
337500                     B-OTHER-PROC-CODE5                           26000000
337600           NEXT SENTENCE                                          26000100
337700     ELSE                                                         26000200
337800           MOVE ZEROES TO H-NEW-TECH-ADDON-ISLET                  26000300
337900           GO TO 4100-ADD-TECH-CASES.                             26000400
338000                                                                  26000500
338100     IF '5285   ' =  B-PRIN-PROC-CODE                             26000600
338200      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26000700
338300                       H-TECH-ADDON-ISLET-CNTR + 1.               26000800
338400                                                                  26000900
338500     IF '5285   ' =  B-OTHER-PROC-CODE1                           26001000
338600      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26001100
338700                       H-TECH-ADDON-ISLET-CNTR + 1.               26001200
338800                                                                  26001300
338900     IF '5285   ' =  B-OTHER-PROC-CODE2                           26001400
339000      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26001500
339100                       H-TECH-ADDON-ISLET-CNTR + 1.               26001600
339200                                                                  26001700
339300     IF '5285   ' =  B-OTHER-PROC-CODE3                           26001800
339400      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26001900
339500                       H-TECH-ADDON-ISLET-CNTR + 1.               26002000
339600                                                                  26002100
339700     IF '5285   ' =  B-OTHER-PROC-CODE4                           26002200
339800      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26002300
339900                       H-TECH-ADDON-ISLET-CNTR + 1.               26002400
340000                                                                  26002500
340100                                                                  26002600
340200     IF '5285   ' =  B-OTHER-PROC-CODE5                           26002700
340300      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26002800
340400                       H-TECH-ADDON-ISLET-CNTR + 1.               26002900
340500                                                                  26003000
340600*    IF 'V707   ' =  B-PRIN-PROC-CODE                             26003100
340700*     COMPUTE H-TECH-ADDON-ISLET-CNTR2 =                          26003200
340800*                      H-TECH-ADDON-ISLET-CNTR2 + 1.              26003300
340900*                                                                 26003400
341000*    IF 'V707   ' =  B-OTHER-PROC-CODE1                           26003500
341100*     COMPUTE H-TECH-ADDON-ISLET-CNTR2 =                          26003600
341200*                      H-TECH-ADDON-ISLET-CNTR2 + 1.              26003700
341300*                                                                 26003800
341400*    IF 'V707   ' =  B-OTHER-PROC-CODE2                           26003900
341500*     COMPUTE H-TECH-ADDON-ISLET-CNTR2 =                          26004000
341600*                      H-TECH-ADDON-ISLET-CNTR2 + 1.              26004100
341700*                                                                 26004200
341800*    IF 'V707   ' =  B-OTHER-PROC-CODE3                           26004300
341900*     COMPUTE H-TECH-ADDON-ISLET-CNTR2 =                          26004400
342000*                      H-TECH-ADDON-ISLET-CNTR2 + 1.              26004500
342100*                                                                 26004600
342200*    IF 'V707   ' =  B-OTHER-PROC-CODE4                           26004700
342300*     COMPUTE H-TECH-ADDON-ISLET-CNTR2 =                          26004800
342400*                      H-TECH-ADDON-ISLET-CNTR2 + 1.              26004900
342500*                                                                 26005000
342600*    IF 'V707   ' =  B-OTHER-PROC-CODE5                           26005100
342700*     COMPUTE H-TECH-ADDON-ISLET-CNTR2 =                          26005200
342800*                    H-TECH-ADDON-ISLET-CNTR2 + 1.                26005300
342900*                                                                 26005400
343000*    IF  H-TECH-ADDON-ISLET-CNTR2 > 0                             26005500
343100*          NEXT SENTENCE                                          26005600
343200*    ELSE                                                         26005700
343300*          MOVE ZEROES TO H-NEW-TECH-ADDON-ISLET                  26005800
343400*          GO TO 4100-ADD-TECH-CASES.                             26005900
343500                                                                  26006000
343600     IF  H-TECH-ADDON-ISLET-CNTR = 1                              26006100
343700     MOVE 18848.00 TO H-NEW-TECH-ADDON-ISLET                      26006200
343800           GO TO 4100-ADD-TECH-CASES.                             26006300
343900                                                                  26006400
344000     IF  H-TECH-ADDON-ISLET-CNTR > 1                              26006500
344100     MOVE 37696.00 TO H-NEW-TECH-ADDON-ISLET                      26006600
344200           GO TO 4100-ADD-TECH-CASES.                             26006700
344300                                                                  26006800
344400     MOVE 0 TO H-NEW-TECH-ADDON-ISLET.                            26006900
344500                                                                  26007000
344600                                                                  26008000
344700 4100-ADD-TECH-CASES.                                             26009000
344800                                                                  26009100
344900     COMPUTE H-NEW-TECH-PAY-ADD-ON ROUNDED =                      26009200
345000             H-NEW-TECH-ADDON-ISLET.                              26009300
345100                                                                  26009400
345200 4100-EXIT.    EXIT.                                              26009500
345300                                                                  26009600
345400
345500 4200-SSRFBN-CODE-RTN.
345600     SET SSRFBN-IDX TO 1.
345700     SEARCH SSRFBN-TAB VARYING SSRFBN-IDX
345800         AT END
345900           MOVE ' NO SSRFBN MESSAGE FOUND' TO MES-SSRFBN
346000       WHEN WK-SSRFBN-STATE(SSRFBN-IDX) = MES-PPS-STATE
346100         MOVE WK-SSRFBN-REASON-ALL (SSRFBN-IDX) TO MES-SSRFBN.
346200
346300 4200-EXIT.   EXIT.
346400
346500 4300-SPIRAT-TECH-ADD-ON.                                         25940000
346600***********************************************************       25510000
346700***** SPIRAT-STOP INTERSPINOUS PROCESS DECOMPRESSION SYSTEM       25520000
346800***********************************************************       25530000
346900                                                                  25540000
347000     IF '3371   ' =  B-PRIN-PROC-CODE   OR                        25550000
347100                     B-OTHER-PROC-CODE1 OR                        25560000
347200                     B-OTHER-PROC-CODE2 OR                        25570000
347300                     B-OTHER-PROC-CODE3 OR                        25580000
347400                     B-OTHER-PROC-CODE4 OR                        25590000
347500                     B-OTHER-PROC-CODE5                           25600000
347600        IF '3222   ' =  B-PRIN-PROC-CODE   OR                     25550000
347700                        B-OTHER-PROC-CODE1 OR                     25560000
347800                        B-OTHER-PROC-CODE2 OR                     25570000
347900                        B-OTHER-PROC-CODE3 OR                     25580000
348000                        B-OTHER-PROC-CODE4 OR                     25590000
348100                        B-OTHER-PROC-CODE5                        25600000
348200           GO TO 4300-COMPUTE-SPIRAT                              25610000
348300        ELSE                                                      25620000
348400        IF '3230   ' =  B-PRIN-PROC-CODE   OR                     25550000
348500                        B-OTHER-PROC-CODE1 OR                     25560000
348600                        B-OTHER-PROC-CODE2 OR                     25570000
348700                        B-OTHER-PROC-CODE3 OR                     25580000
348800                        B-OTHER-PROC-CODE4 OR                     25590000
348900                        B-OTHER-PROC-CODE5                        25600000
349000           GO TO 4300-COMPUTE-SPIRAT                              25610000
349100        ELSE                                                      25620000
349200        IF '3239   ' =  B-PRIN-PROC-CODE   OR                     25550000
349300                        B-OTHER-PROC-CODE1 OR                     25560000
349400                        B-OTHER-PROC-CODE2 OR                     25570000
349500                        B-OTHER-PROC-CODE3 OR                     25580000
349600                        B-OTHER-PROC-CODE4 OR                     25590000
349700                        B-OTHER-PROC-CODE5                        25600000
349800           GO TO 4300-COMPUTE-SPIRAT                              25610000
349900        ELSE                                                      25620000
350000        IF '3241   ' =  B-PRIN-PROC-CODE   OR                     25550000
350100                        B-OTHER-PROC-CODE1 OR                     25560000
350200                        B-OTHER-PROC-CODE2 OR                     25570000
350300                        B-OTHER-PROC-CODE3 OR                     25580000
350400                        B-OTHER-PROC-CODE4 OR                     25590000
350500                        B-OTHER-PROC-CODE5                        25600000
350600           GO TO 4300-COMPUTE-SPIRAT                              25610000
350700        ELSE                                                      25620000
350800        IF '3249   ' =  B-PRIN-PROC-CODE   OR                     25550000
350900                        B-OTHER-PROC-CODE1 OR                     25560000
351000                        B-OTHER-PROC-CODE2 OR                     25570000
351100                        B-OTHER-PROC-CODE3 OR                     25580000
351200                        B-OTHER-PROC-CODE4 OR                     25590000
351300                        B-OTHER-PROC-CODE5                        25600000
351400           GO TO 4300-COMPUTE-SPIRAT                              25610000
351500     ELSE                                                         25620000
351600           NEXT SENTENCE.                                         25610000
351700                                                                  25620000
351800     IF '3373   ' =  B-PRIN-PROC-CODE   OR                        25550000
351900                     B-OTHER-PROC-CODE1 OR                        25560000
352000                     B-OTHER-PROC-CODE2 OR                        25570000
352100                     B-OTHER-PROC-CODE3 OR                        25580000
352200                     B-OTHER-PROC-CODE4 OR                        25590000
352300                     B-OTHER-PROC-CODE5                           25600000
352400        IF '3222   ' =  B-PRIN-PROC-CODE   OR                     25550000
352500                        B-OTHER-PROC-CODE1 OR                     25560000
352600                        B-OTHER-PROC-CODE2 OR                     25570000
352700                        B-OTHER-PROC-CODE3 OR                     25580000
352800                        B-OTHER-PROC-CODE4 OR                     25590000
352900                        B-OTHER-PROC-CODE5                        25600000
353000           GO TO 4300-COMPUTE-SPIRAT                              25610000
353100        ELSE                                                      25620000
353200        IF '3230   ' =  B-PRIN-PROC-CODE   OR                     25550000
353300                        B-OTHER-PROC-CODE1 OR                     25560000
353400                        B-OTHER-PROC-CODE2 OR                     25570000
353500                        B-OTHER-PROC-CODE3 OR                     25580000
353600                        B-OTHER-PROC-CODE4 OR                     25590000
353700                        B-OTHER-PROC-CODE5                        25600000
353800           GO TO 4300-COMPUTE-SPIRAT                              25610000
353900        ELSE                                                      25620000
354000        IF '3239   ' =  B-PRIN-PROC-CODE   OR                     25550000
354100                        B-OTHER-PROC-CODE1 OR                     25560000
354200                        B-OTHER-PROC-CODE2 OR                     25570000
354300                        B-OTHER-PROC-CODE3 OR                     25580000
354400                        B-OTHER-PROC-CODE4 OR                     25590000
354500                        B-OTHER-PROC-CODE5                        25600000
354600           GO TO 4300-COMPUTE-SPIRAT                              25610000
354700        ELSE                                                      25620000
354800        IF '3241   ' =  B-PRIN-PROC-CODE   OR                     25550000
354900                        B-OTHER-PROC-CODE1 OR                     25560000
355000                        B-OTHER-PROC-CODE2 OR                     25570000
355100                        B-OTHER-PROC-CODE3 OR                     25580000
355200                        B-OTHER-PROC-CODE4 OR                     25590000
355300                        B-OTHER-PROC-CODE5                        25600000
355400           GO TO 4300-COMPUTE-SPIRAT                              25610000
355500        ELSE                                                      25620000
355600        IF '3249   ' =  B-PRIN-PROC-CODE   OR                     25550000
355700                        B-OTHER-PROC-CODE1 OR                     25560000
355800                        B-OTHER-PROC-CODE2 OR                     25570000
355900                        B-OTHER-PROC-CODE3 OR                     25580000
356000                        B-OTHER-PROC-CODE4 OR                     25590000
356100                        B-OTHER-PROC-CODE5                        25600000
356200           GO TO 4300-COMPUTE-SPIRAT.                             25610000
356300                                                                        00
356400           MOVE ZEROES TO H-NEW-TECH-ADDON-SPIRAT-STOP.           25630000
356500           GO TO 4300-ADD-TECH-CASES.                             25640000
356600                                                                  25650000
356700 4300-COMPUTE-SPIRAT.                                             25840000
356800                                                                  25650000
356900     MOVE  3437.50 TO H-CSTMED-SPIRAT-STOP.                       25660000
357000                                                                  25670000
357100     COMPUTE H-LESSER-SPIRAT-STOP-1 ROUNDED =                     25680000
357200                  H-CSTMED-SPIRAT-STOP.                           25690000
357300                                                                  25700000
357400     COMPUTE H-LESSER-SPIRAT-STOP-2 ROUNDED =                     25710000
357500          (((B-CHARGES-CLAIMED * P-NEW-OPER-CSTCHG-RATIO) -       25720000
357600                     H-BASE-DRG-PAYMENT)) * .5.                   25730000
357700                                                                  25740000
357800     IF H-LESSER-SPIRAT-STOP-2 > 0                                25750000
357900        IF H-LESSER-SPIRAT-STOP-1 < H-LESSER-SPIRAT-STOP-2        25760000
358000         MOVE H-LESSER-SPIRAT-STOP-1 TO
358100                                  H-NEW-TECH-ADDON-SPIRAT-STOP
358200        ELSE                                                      25780000
358300         MOVE H-LESSER-SPIRAT-STOP-2 TO
358400                                  H-NEW-TECH-ADDON-SPIRAT-STOP
358500     ELSE                                                         25800000
358600        MOVE ZEROES          TO H-NEW-TECH-ADDON-SPIRAT-STOP.     25810000
358700                                                                  25820000
358800                                                                  25830000
358900 4300-ADD-TECH-CASES.                                             25840000
359000                                                                  25850000
359100     COMPUTE H-NEW-TECH-PAY-ADD-ON ROUNDED =                      25860000
359200             H-NEW-TECH-ADDON-SPIRAT-STOP.                        25890000
359300*                                                                 25900000
359400 4300-EXIT.    EXIT.                                              25910000
359500***********************************************************       25920000
359600******        L A S T   S O U R C E   S T A T E M E N T   *****   26009700
