000100 IDENTIFICATION DIVISION.                                         00010000
000200 PROGRAM-ID.           PPCAL124.                                  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     'PPCAL124      - W O R K I N G   S T O R A G E'.             00180000
001900 01  CAL-VERSION                    PIC X(05)  VALUE 'C12.4'.     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 99V999999 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 2012.0 *******************************   00341001
003700* TABLE 1                                                     *   00350000
003800*    (68.8% LABOR SHARE/31.2% 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 20101001 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 '20101001'.                   00480000
005100         05  TB1-NAT    PIC X(30) VALUE                           00490000
005200            ' 0358430 162544 0358430 162544'.                     00500000
005300         05  TB1-PR     PIC X(30) VALUE                           00510000
005400            ' 0155329 094798 0155329 094798'.                     00520000
005500         05  TB1-NATPR  PIC X(30) VALUE                           00530000
005600            ' 0358430 162544 0358430 162544'.                     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 2012.0 *********************************   00670000
007000* TABLE 2                                                     *   00680000
007100*    (68.8% LABOR SHARE/31.2% 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 20101001 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 '20101001'.                   00810000
008400         05  TB2-NAT    PIC X(30) VALUE                           00820000
008500            ' 0351395 159354 0351395 159354'.                     00830000
008600         05  TB2-PR     PIC X(30) VALUE                           00840000
008700            ' 0155329 094798 0155329 094798'.                     00850000
008800         05  TB2-NATPR  PIC X(30) VALUE                           00860000
008900            ' 0358430 155329 0358430 155329'.                     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 2012.0 *********************************   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 20101001 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 '20101001'.                   01130000
011600         05  TB3-NAT    PIC X(30) VALUE                           01140000
011700            ' 0323004 197970 0323004 197970'.                     01150000
011800         05  TB3-PR     PIC X(30) VALUE                           01160000
011900            ' 0155079 095048 0155079 095048'.                           00
012000         05  TB3-NATPR  PIC X(30) VALUE                                 00
012100            ' 0323004 197970 0323004 197970'.                     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 2012.0 ***********************************   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 20101001 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 '20101001'.                   01460000
014900         05  TB4-NAT    PIC X(30) VALUE                           01470000
015000            ' 0316664 194085 0316664 194085'.                     01480001
015100         05  TB4-PR     PIC X(30) VALUE                           01490000
015200            ' 0155079 095048 0155079 095048'.                     01500000
015300         05  TB4-NATPR  PIC X(30) VALUE                           01510000
015400            ' 0323004 197970 0323004 197970'.                     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       '20111001'.
017000         10  FILLER                  PIC X(56) VALUE
017100       '24279428600374139700167002131799272910035310925121400260'.
017200         10  FILLER                  PIC X(56) VALUE
017300       '10481415900209051059082000940987101540018905117610100120'.
017400         10  FILLER                  PIC X(56) VALUE
017500       '00000000000000038900085000990499671210015203095708500100'.
017600         10  FILLER                  PIC X(56) VALUE
017700       '01898305600064102792180002480000000000000006312718100198'.
017800         10  FILLER                  PIC X(56) VALUE
017900       '04322411600146000000000000000000000000000008503313400168'.
018000         10  FILLER                  PIC X(56) VALUE
018100       '06436912600143041500056000760536250840011703632705400075'.
018200         10  FILLER                  PIC X(56) VALUE
018300       '04692708500109029770055000700213170290003705647610100130'.
018400         10  FILLER                  PIC X(56) VALUE
018500       '02830804500062016924024000310445290870012501949103500052'.
018600         10  FILLER                  PIC X(56) VALUE
018700       '01408502000026035003045000690214590210003101655001300015'.
018800         10  FILLER                  PIC X(56) VALUE
018900       '03084505600080015804024000350103050140001704033108900120'.
019000         10  FILLER                  PIC X(56) VALUE
019100       '02177505100066017442025000330000000000000000000000000000'.
019200         10  FILLER                  PIC X(56) VALUE
019300       '00000000000000000000000000000000000000000000000000000000'.
019400         10  FILLER                  PIC X(56) VALUE
019500       '00000000000000000000000000000000000000000001539004300057'.
019600         10  FILLER                  PIC X(56) VALUE
019700       '00855402700033014680044000600107600330004501765605500073'.
019800         10  FILLER                  PIC X(56) VALUE
019900       '00965203800049015223053000680101810400004800761803100037'.
020000         10  FILLER                  PIC X(56) VALUE
020100       '02880406200080019506046000540153610330003801855504900068'.
020200         10  FILLER                  PIC X(56) VALUE
020300       '01148503800046008105026000310144750420005400890102600032'.
020400         10  FILLER                  PIC X(56) VALUE
020500       '00734702200027018030053000700105780390004900723702400030'.
020600         10  FILLER                  PIC X(56) VALUE
020700       '01295504100054008644032000400171960540006800875103200038'.
020800         10  FILLER                  PIC X(56) VALUE
020900       '01658704700060010200035000420072180240002901186503600049'.
021000         10  FILLER                  PIC X(56) VALUE
021100       '00737402600033020265035000600135670350004600842202100026'.
021200         10  FILLER                  PIC X(56) VALUE
021300       '02148305200072011759035000440078340230002801617704100054'.
021400         10  FILLER                  PIC X(56) VALUE
021500       '00980902800036007297019000230162380430005900924703200040'.
021600         10  FILLER                  PIC X(56) VALUE
021700       '00675102200028034244087001150237620620007701906904500056'.
021800         10  FILLER                  PIC X(56) VALUE
021900       '03213908700111018279060000760122990400005101525404300058'.
022000         10  FILLER                  PIC X(56) VALUE
022100       '00762002700033010129031000430066770230002900000000000000'.
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       '01884104300057009275020000260122460330004401298203000045'.
022800         10  FILLER                  PIC X(56) VALUE
022900       '00765701800024000000000000000000000000000000000000000000'.
023000         10  FILLER                  PIC X(56) VALUE
023100       '01044004100053006304031000370071350210002601170203600051'.
023200         10  FILLER                  PIC X(56) VALUE
023300       '00691802500032000000000000000000000000000000000000000000'.
023400         10  FILLER                  PIC X(56) VALUE
023500       '02214303700054011858023000280225580410005701197402100027'.
023600         10  FILLER                  PIC X(56) VALUE
023700       '01724103700054008722017000210199630430006501011401700023'.
023800         10  FILLER                  PIC X(56) VALUE
023900       '01316003800050007784018000240090090140001700000000000000'.
024000         10  FILLER                  PIC X(56) VALUE
024100       '00000000000000000000000000000000000000000000000000000000'.
024200         10  FILLER                  PIC X(56) VALUE
024300       '00000000000000020669059000840122680410005600752102200032'.
024400         10  FILLER                  PIC X(56) VALUE
024500       '00635002100025013103038000520066010230002800957003200041'.
024600         10  FILLER                  PIC X(56) VALUE
024700       '00629602400030014235042000560089850320004100619202300028'.
024800         10  FILLER                  PIC X(56) VALUE
024900       '01609204900067008971032000420058010210002600000000000000'.
025000         10  FILLER                  PIC X(56) VALUE
025100       '00000000000000000000000000000509101140013902602905900071'.
025200         10  FILLER                  PIC X(56) VALUE
025300       '01785403600043037322092001170205750560007101279103200042'.
025400         10  FILLER                  PIC X(56) VALUE
025500       '00000000000000000000000000000000000000000000000000000000'.
025600         10  FILLER                  PIC X(56) VALUE
025700       '00000000000000000000000000000162120560006701048504000047'.
025800         10  FILLER                  PIC X(56) VALUE
025900       '02065306700083014653054000650100250400004801740305600073'.
026000         10  FILLER                  PIC X(56) VALUE
026100       '01223704000053008446027000360146950510006201008603500043'.
026200         10  FILLER                  PIC X(56) VALUE
026300       '00701302500030015824051000660111230370004800769902700034'.
026400         10  FILLER                  PIC X(56) VALUE
026500       '01269404200053011684044000530096280370004500708103000035'.
026600         10  FILLER                  PIC X(56) VALUE
026700       '01494805200064010026040000480070370300003601657105600070'.
026800         10  FILLER                  PIC X(56) VALUE
026900       '01094304000049007839029000360181450610007800989203500045'.
027000         10  FILLER                  PIC X(56) VALUE
027100       '00712102700035008519033000410061330260003100656402100026'.
027200         10  FILLER                  PIC X(56) VALUE
027300       '01332403900053007565025000320529331260014702270405000070'.
027400         10  FILLER                  PIC X(56) VALUE
027500       '00000000000000000000000000000000000000000000000000000000'.
027600         10  FILLER                  PIC X(56) VALUE
027700       '00000000000000000000000000001376290750013409692214100167'.
027800         10  FILLER                  PIC X(56) VALUE
027900       '06498709400106051734070000780808151040012805260206900076'.
028000         10  FILLER                  PIC X(56) VALUE
028100       '04366305200057086807098001200633090450006207715408000099'.
028200         10  FILLER                  PIC X(56) VALUE
028300       '05951104100051067895060000870515000210003107344511200135'.
028400         10  FILLER                  PIC X(56) VALUE
028500       '04655207200081036603046000540790841080012805669008000088'.
028600         10  FILLER                  PIC X(56) VALUE
028700       '07141811800133048314082000880590630930010803772006000065'.
028800         10  FILLER                  PIC X(56) VALUE
028900       '05122107100102030979028000400474011120014302606307500092'.
029000         10  FILLER                  PIC X(56) VALUE
029100       '01493904800058036835061000780263630380004802053802300028'.
029200         10  FILLER                  PIC X(56) VALUE
029300       '04196702700039031727036000510198280190002402939604500061'.
029400         10  FILLER                  PIC X(56) VALUE
029500       '01813202300029028921050000680184470220002902986505100077'.
029600         10  FILLER                  PIC X(56) VALUE
029700       '02443204400060016521021000270251920670009001603505600069'.
029800         10  FILLER                  PIC X(56) VALUE
029900       '00907103100041029714053000700182170250003303629707600105'.
030000         10  FILLER                  PIC X(56) VALUE
030100       '01675003200043011756021000260162260320004802558005400080'.
030200         10  FILLER                  PIC X(56) VALUE
030300       '02313302400035000000000000000000000000000000000000000000'.
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       '00000000000000000000000000000000000000000001790105000063'.
031000         10  FILLER                  PIC X(56) VALUE
031100       '01147803400042007856022000270171180320005000840002000028'.
031200         10  FILLER                  PIC X(56) VALUE
031300       '00540101400017020360049000650107430240003102865408300103'.
031400         10  FILLER                  PIC X(56) VALUE
031500       '01850206100074011141041000500150100470006101021403900047'.
031600         10  FILLER                  PIC X(56) VALUE
031700       '00675602700032009916044000530069920350004101289501900030'.
031800         10  FILLER                  PIC X(56) VALUE
031900       '00657401300016004048011000110137190460005800969703800047'.
032000         10  FILLER                  PIC X(56) VALUE
032100       '00664602800034010029030000400057370190002400979703200042'.
032200         10  FILLER                  PIC X(56) VALUE
032300       '00613002100026013321040000530077320260003201228304000051'.
032400         10  FILLER                  PIC X(56) VALUE
032500       '00815502900036005608020000240050670180002200713902300029'.
032600         10  FILLER                  PIC X(56) VALUE
032700       '00543401700020018386050000680096120320004100606802100025'.
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       '00000000000000056803122001550274700670008601384802600035'.
033400         10  FILLER                  PIC X(56) VALUE
033500       '05321512300151025911076000890162540460005104869111200137'.
033600         10  FILLER                  PIC X(56) VALUE
033700       '02475806800079016038041000480428761130013602339207100086'.
033800         10  FILLER                  PIC X(56) VALUE
033900       '01495604000050032639083001010184840540006301230803200037'.
034000         10  FILLER                  PIC X(56) VALUE
034100       '02357005000068013477029000370095870170001903274008800112'.
034200         10  FILLER                  PIC X(56) VALUE
034300       '01698605700067011679040000450253300640008801403104100054'.
034400         10  FILLER                  PIC X(56) VALUE
034500       '00807502200028025207059000790138370350004500862501900023'.
034600         10  FILLER                  PIC X(56) VALUE
034700       '02843306300083015691039000490107430230002803962809000120'.
034800         10  FILLER                  PIC X(56) VALUE
034900       '02183805600072013062030000390000000000000000000000000000'.
035000         10  FILLER                  PIC X(56) VALUE
035100       '00000000000000000000000000000000000000000000000000000000'.
035200         10  FILLER                  PIC X(56) VALUE
035300       '00000000000000000000000000000000000000000001852605100066'.
035400         10  FILLER                  PIC X(56) VALUE
035500       '01088203600044007469025000310203640660008501281105100062'.
035600         10  FILLER                  PIC X(56) VALUE
035700       '00843703700044020951062000840128510430005600871502800036'.
035800         10  FILLER                  PIC X(56) VALUE
035900       '01764004900063010238034000410070670250002901885505500071'.
036000         10  FILLER                  PIC X(56) VALUE
036100       '01131103800046008023027000330125090420005200847403000036'.
036200         10  FILLER                  PIC X(56) VALUE
036300       '01852506100080010598041000520077470320003901660305400071'.
036400         10  FILLER                  PIC X(56) VALUE
036500       '00934503800047006399028000330118440390005100724102700034'.
036600         10  FILLER                  PIC X(56) VALUE
036700       '01675004800067009898036000450066430250003000000000000000'.
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       '05716711600155026577062000790185570400005104019710500131'.
037400         10  FILLER                  PIC X(56) VALUE
037500       '02312006800082015243046000550358210970011702398506700078'.
037600         10  FILLER                  PIC X(56) VALUE
037700       '01740904300051036689091001100206370610007001358803700044'.
037800         10  FILLER                  PIC X(56) VALUE
037900       '02531906200078016909043000520118140250003003810808600117'.
038000         10  FILLER                  PIC X(56) VALUE
038100       '01908104900066012324029000370419921030013702441106900089'.
038200         10  FILLER                  PIC X(56) VALUE
038300       '01702403700050000000000000000000000000000000000000000000'.
038400         10  FILLER                  PIC X(56) VALUE
038500       '00000000000000000000000000000000000000000001673704800064'.
038600         10  FILLER                  PIC X(56) VALUE
038700       '00942403500044006084024000290179500550007101196504100052'.
038800         10  FILLER                  PIC X(56) VALUE
038900       '00930902700036017781053000730098640390004800677202800034'.
039000         10  FILLER                  PIC X(56) VALUE
039100       '01887305200071009596036000460065430260003301608304700062'.
039200         10  FILLER                  PIC X(56) VALUE
039300       '01067803500044007222024000290000000000000000000000000000'.
039400         10  FILLER                  PIC X(56) VALUE
039500       '00000000000000000000000000000000000000000000000000000000'.
039600         10  FILLER                  PIC X(56) VALUE
039700       '10919310500132073268053000630564490310003609815210600133'.
039800         10  FILLER                  PIC X(56) VALUE
039900       '06342505800067050565034000390649200720008903858003200038'.
040000         10  FILLER                  PIC X(56) VALUE
040100       '05398506700086033359036000390504381100014702965806700085'.
040200         10  FILLER                  PIC X(56) VALUE
040300       '01740603900048049812072000880324370420004802570003200034'.
040400         10  FILLER                  PIC X(56) VALUE
040500       '03441806500077020866033000360454440640008902790602600038'.
040600         10  FILLER                  PIC X(56) VALUE
040700       '02081201500018036088089001180197280580007401055803200040'.
040800         10  FILLER                  PIC X(56) VALUE
040900       '03459609000112022781054000690168270290003803055707400088'.
041000         10  FILLER                  PIC X(56) VALUE
041100       '01909305000054015498040000440240120290003601993901900021'.
041200         10  FILLER                  PIC X(56) VALUE
041300       '03142508700107020641060000700149250440005001718403700045'.
041400         10  FILLER                  PIC X(56) VALUE
041500       '01228402400028017987030000420100670170002103049806700083'.
041600         10  FILLER                  PIC X(56) VALUE
041700       '01877104000048013518026000310289910750009901640304000052'.
041800         10  FILLER                  PIC X(56) VALUE
041900       '01090801900025020297052000710094120210002703169608000108'.
042000         10  FILLER                  PIC X(56) VALUE
042100       '01570404500058010373023000280230220650008401545705000061'.
042200         10  FILLER                  PIC X(56) VALUE
042300       '01129702500032011621025000350187300390005401207401700021'.
042400         10  FILLER                  PIC X(56) VALUE
042500       '01398602600038022506049000640150090310003801078101800022'.
042600         10  FILLER                  PIC X(56) VALUE
042700       '01327603600048008295021000260323360770009801980104700058'.
042800         10  FILLER                  PIC X(56) VALUE
042900       '01555602700034000000000000000000000000000000000000000000'.
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       '01614804600063007553031000380132670430005500725603100036'.
043800         10  FILLER                  PIC X(56) VALUE
043900       '00842203400040006270026000310199030670008701337305200064'.
044000         10  FILLER                  PIC X(56) VALUE
044100       '00880603700048020419063000820117190440005500766003300039'.
044200         10  FILLER                  PIC X(56) VALUE
044300       '02473706000085011849041000520074350290003501886106500082'.
044400         10  FILLER                  PIC X(56) VALUE
044500       '01240004700059007363033000400167510520006700841003300039'.
044600         10  FILLER                  PIC X(56) VALUE
044700       '01190304400055006994029000360118240360004900668802500031'.
044800         10  FILLER                  PIC X(56) VALUE
044900       '01533905300065008979036000430188390520007001023403500045'.
045000         10  FILLER                  PIC X(56) VALUE
045100       '00610402000025014004045000580073920300003501480304800063'.
045200         10  FILLER                  PIC X(56) VALUE
045300       '00949803800047006371026000320000000000000000000000000000'.
045400         10  FILLER                  PIC X(56) VALUE
045500       '00000000000000025158076001010154270570006900987203900047'.
045600         10  FILLER                  PIC X(56) VALUE
045700       '03424908400125026984077001080122710400005203493607100107'.
045800         10  FILLER                  PIC X(56) VALUE
045900       '01811803900058010684023000310269350730009701480103600051'.
046000         10  FILLER                  PIC X(56) VALUE
046100       '00949701800024011504021000270087620150001701648803700053'.
046200         10  FILLER                  PIC X(56) VALUE
046300       '01100401700022000000000000000000000000000000000000000000'.
046400         10  FILLER                  PIC X(56) VALUE
046500       '00000000000000000000000000000000000000000001475305400070'.
046600         10  FILLER                  PIC X(56) VALUE
046700       '01027904400054006981033000410196360570007900892403600046'.
046800         10  FILLER                  PIC X(56) VALUE
046900       '01659005500075011630039000540067980240003400978803900049'.
047000         10  FILLER                  PIC X(56) VALUE
047100       '00608602800034014597052000650084440370004401302504000054'.
047200         10  FILLER                  PIC X(56) VALUE
047300       '00738802600032013600043000590069520280003600000000000000'.
047400         10  FILLER                  PIC X(56) VALUE
047500       '00000000000000000000000000000000000000000000000000000000'.
047600         10  FILLER                  PIC X(56) VALUE
047700       '00000000000000024580045000610143190240002804393311700145'.
047800         10  FILLER                  PIC X(56) VALUE
047900       '02018806300077011616036000490349530450007601838402500031'.
048000         10  FILLER                  PIC X(56) VALUE
048100       '01483501600019038339100001390185420600007600996503500043'.
048200         10  FILLER                  PIC X(56) VALUE
048300       '02258704400065011682020000290080080120001403252606800098'.
048400         10  FILLER                  PIC X(56) VALUE
048500       '02207706300078013128032000430000000000000000000000000000'.
048600         10  FILLER                  PIC X(56) VALUE
048700       '00000000000000000000000000000000000000000000000000000000'.
048800         10  FILLER                  PIC X(56) VALUE
048900       '01439804400058008167031000390055030220002701112503400048'.
049000         10  FILLER                  PIC X(56) VALUE
049100       '00698802800035011212035000480170570560007101058304000050'.
049200         10  FILLER                  PIC X(56) VALUE
049300       '00725202800035000000000000000000000000000000000000000000'.
049400         10  FILLER                  PIC X(56) VALUE
049500       '00000000000000000000000000000000000000000003050706000071'.
049600         10  FILLER                  PIC X(56) VALUE
049700       '05924913300161030568080000920199340460005503635907500099'.
049800         10  FILLER                  PIC X(56) VALUE
049900       '02012704700056014698029000330346340790010801885104400059'.
050000         10  FILLER                  PIC X(56) VALUE
050100       '01302002300028029733076001020147910360005101126901500019'.
050200         10  FILLER                  PIC X(56) VALUE
050300       '03377509500122015904044000630081280180002302551206600089'.
050400         10  FILLER                  PIC X(56) VALUE
050500       '01270203100042007806018000220148000380005400844301800023'.
050600         10  FILLER                  PIC X(56) VALUE
050700       '02987506200095021338048000670134250170002400000000000000'.
050800         10  FILLER                  PIC X(56) VALUE
050900       '00000000000000000000000000000000000000000000000000000000'.
051000         10  FILLER                  PIC X(56) VALUE
051100       '00000000000000016410050000670101830390004800640902700032'.
051200         10  FILLER                  PIC X(56) VALUE
051300       '00890502500034017795056000780104580370004800648202100027'.
051400         10  FILLER                  PIC X(56) VALUE
051500       '01199704500056007870033000400152890300004001090301700020'.
051600         10  FILLER                  PIC X(56) VALUE
051700       '01350503900051007090020000250126080420005600644902500031'.
051800         10  FILLER                  PIC X(56) VALUE
051900       '00809902400032016066052000660099980360004500678302600032'.
052000         10  FILLER                  PIC X(56) VALUE
052100       '00000000000000000000000000000000000000000000000000000000'.
052200         10  FILLER                  PIC X(56) VALUE
052300       '00000000000000000000000000000182490320004301275701600018'.
052400         10  FILLER                  PIC X(56) VALUE
052500       '01929903600059012640014000170189780500007300790102000027'.
052600         10  FILLER                  PIC X(56) VALUE
052700       '01205602900041006710016000180175560400005900870401200014'.
052800         10  FILLER                  PIC X(56) VALUE
052900       '01634804400061008146020000250000000000000000000000000000'.
053000         10  FILLER                  PIC X(56) VALUE
053100       '00000000000000015734052000710101780390005000672402100028'.
053200         10  FILLER                  PIC X(56) VALUE
053300       '01245704600060007279028000350142440510006500784803300041'.
053400         10  FILLER                  PIC X(56) VALUE
053500       '01090303600050006256022000280000000000000000000000000000'.
053600         10  FILLER                  PIC X(56) VALUE
053700       '00000000000000024618050000690122080210002504527610600131'.
053800         10  FILLER                  PIC X(56) VALUE
053900       '02022105600065012170031000350336720730009901543103500043'.
054000         10  FILLER                  PIC X(56) VALUE
054100       '01120102000023014262030000400093060180002001478503900055'.
054200         10  FILLER                  PIC X(56) VALUE
054300       '00795601900023012993028000400090380150001700944701400017'.
054400         10  FILLER                  PIC X(56) VALUE
054500       '02528306200085010799022000290000000000000000000000000000'.
054600         10  FILLER                  PIC X(56) VALUE
054700       '00000000000000020512064000880115600390005200620202200030'.
054800         10  FILLER                  PIC X(56) VALUE
054900       '01558505900074010657046000550073240320004000789202800036'.
055000         10  FILLER                  PIC X(56) VALUE
055100       '00515001800023000000000000000000000000000000000000000000'.
055200         10  FILLER                  PIC X(56) VALUE
055300       '01225504000052008497029000300085470230002601818004700058'.
055400         10  FILLER                  PIC X(56) VALUE
055500       '01525903400049006353015000190000000000000000000000000000'.
055600         10  FILLER                  PIC X(56) VALUE
055700       '00000000000000007406027000340052830210002300643602500033'.
055800         10  FILLER                  PIC X(56) VALUE
055900       '00813301700020004646019000270051340170002200194701200013'.
056000         10  FILLER                  PIC X(56) VALUE
056100       '00667402600038003175015000180000000000000000000000000000'.
056200         10  FILLER                  PIC X(56) VALUE
056300       '00000000000000000000000000000000000000000000000000000000'.
056400         10  FILLER                  PIC X(56) VALUE
056500       '01493301800018049243179001790336311330013302029308600086'.
056600         10  FILLER                  PIC X(56) VALUE
056700       '03454704700047012227034000340016560310003100000000000000'.
056800         10  FILLER                  PIC X(56) VALUE
056900       '00000000000000000000000000000502010980013002537505700072'.
057000         10  FILLER                  PIC X(56) VALUE
057100       '01513803100039034676084001150172770450005901029302200029'.
057200         10  FILLER                  PIC X(56) VALUE
057300       '00000000000000000000000000000000000000000002090706000079'.
057400         10  FILLER                  PIC X(56) VALUE
057500       '01211403900050008718028000350121820370005000792002700035'.
057600         10  FILLER                  PIC X(56) VALUE
057700       '01509803600050016769050000670098110350004500718702600032'.
057800         10  FILLER                  PIC X(56) VALUE
057900       '00000000000000000000000000000000000000000006071713100172'.
058000         10  FILLER                  PIC X(56) VALUE
058100       '02366605000071012183023000300445981190015502319306400084'.
058200         10  FILLER                  PIC X(56) VALUE
058300       '01276202900041050537111001420226580550007201308202700034'.
058400         10  FILLER                  PIC X(56) VALUE
058500       '02856006600098011616023000310000000000000000000000000000'.
058600         10  FILLER                  PIC X(56) VALUE
058700       '00000000000000053606105001700236400530008901096702900043'.
058800         10  FILLER                  PIC X(56) VALUE
058900       '06505517500229032689081001210126230470005603035007800108'.
059000         10  FILLER                  PIC X(56) VALUE
059100       '01634205000066010133031000410188990580007801175004200054'.
059200         10  FILLER                  PIC X(56) VALUE
059300       '00796602800036022853056000800101460280003400764302300029'.
059400         10  FILLER                  PIC X(56) VALUE
059500       '01312704300058000000000000000000000000000000000000000000'.
059600         10  FILLER                  PIC X(56) VALUE
059700       '05466811600150026551078000940160080380005504958810900145'.
059800         10  FILLER                  PIC X(56) VALUE
059900       '02072606000076013212041000500000000000000000000000000000'.
060000         10  FILLER                  PIC X(56) VALUE
060100       '00000000000000019223057000750099430390004800833703000037'.
060200         10  FILLER                  PIC X(56) VALUE
060300       '01580904400062007446028000350255230690009301081604000050'.
060400         10  FILLER                  PIC X(56) VALUE
060500       '00672402800034058339127001490190900530007001133904300052'.
060600         10  FILLER                  PIC X(56) VALUE
060700       '00000000000000000000000000000000000000000002831907600123'.
060800         10  FILLER                  PIC X(56) VALUE
060900       '00000000000000000000000000000000000000000000633702300030'.
061000         10  FILLER                  PIC X(56) VALUE
061100       '00615603200042006566033000460118640480007900952904000053'.
061200         10  FILLER                  PIC X(56) VALUE
061300       '00920905400073007466039000570081890290004500000000000000'.
061400         10  FILLER                  PIC X(56) VALUE
061500       '00000000000000000000000000000000000000000000000000000000'.
061600         10  FILLER                  PIC X(56) VALUE
061700       '00000000000000004304021000300109520920011901455504700064'.
061800         10  FILLER                  PIC X(56) VALUE
061900       '00668703200040000000000000000000000000000000000000000000'.
062000         10  FILLER                  PIC X(56) VALUE
062100       '04103009200144017938054000750105620310004103105707000107'.
062200         10  FILLER                  PIC X(56) VALUE
062300       '01170203400045010566023000330396610780011301929804600060'.
062400         10  FILLER                  PIC X(56) VALUE
062500       '01161202500033000000000000000000000000000000000000000000'.
062600         10  FILLER                  PIC X(56) VALUE
062700       '01245803900052007097025000320146000350005000483601700021'.
062800         10  FILLER                  PIC X(56) VALUE
062900       '01497703600051006228021000270162820440006100962903100041'.
063000         10  FILLER                  PIC X(56) VALUE
063100       '00633202200028014748039000570067410230003000000000000000'.
063200         10  FILLER                  PIC X(56) VALUE
063300       '00000000000000000000000000001210332000027304890910900153'.
063400         10  FILLER                  PIC X(56) VALUE
063500       '02177904900072000000000000000000000000000000000000000000'.
063600         10  FILLER                  PIC X(56) VALUE
063700       '02285002600054013998040000570125720320004800000000000000'.
063800         10  FILLER                  PIC X(56) VALUE
063900       '00000000000000000000000000000306560690010301767803500052'.
064000         10  FILLER                  PIC X(56) VALUE
064100       '01149202000026000000000000000000000000000000000000000000'.
064200         10  FILLER                  PIC X(56) VALUE
064300       '01331208300100012889068000760113090370004900692302700034'.
064400         10  FILLER                  PIC X(56) VALUE
064500       '00950502800045005175023000330072450210004700000000000000'.
064600         10  FILLER                  PIC X(56) VALUE
064700       '00000000000000000000000000000545290820011703632206900085'.
064800         10  FILLER                  PIC X(56) VALUE
064900       '06601710000145037491075000920247110450005700000000000000'.
065000         10  FILLER                  PIC X(56) VALUE
065100       '00000000000000000000000000000282940590008501516504400055'.
065200         10  FILLER                  PIC X(56) VALUE
065300       '01011403000037000000000000000000000000000000000000000000'.
065400         10  FILLER                  PIC X(56) VALUE
065500       '05615812800172023655058000830000000000000000000000000000'.
065600         10  FILLER                  PIC X(56) VALUE
065700       '00000000000000027063069000980134550490006400864903400043'.
065800         10  FILLER                  PIC X(56) VALUE
065900       '01078303600049000000000000000000000000000000000000000000'.
066000         10  FILLER                  PIC X(56) VALUE
066100       '05067310800139029352063000810174040300004103529410800139'.
066200         10  FILLER                  PIC X(56) VALUE
066300       '02124006400087010980026000380340390890011701856705300070'.
066400         10  FILLER                  PIC X(56) VALUE
066500       '01058302400033000000000000000000000000000000000000000000'.
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 ** NOT USED IN 2012 ****************       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 2012.0 ************************************       20110000
084300                                                                  20110000
084400 01  LOWVOL-PROV-TABLE.
084500     05 LOWVOL-PROV-DISCHG-DATA.
084600         10  FILLER      PIC X(13) VALUE '010007   1209'.
084700         10  FILLER      PIC X(13) VALUE '010008   0395'.
084800         10  FILLER      PIC X(13) VALUE '010009   0802'.
084900         10  FILLER      PIC X(13) VALUE '010015   0461'.
085000         10  FILLER      PIC X(13) VALUE '010018   0058'.
085100         10  FILLER      PIC X(13) VALUE '010021   0872'.
085200         10  FILLER      PIC X(13) VALUE '010022   0632'.
085300         10  FILLER      PIC X(13) VALUE '010025   1495'.
085400         10  FILLER      PIC X(13) VALUE '010027   0327'.
085500         10  FILLER      PIC X(13) VALUE '010032   0474'.
085600         10  FILLER      PIC X(13) VALUE '010034   1119'.
085700         10  FILLER      PIC X(13) VALUE '010043   0250'.
085800         10  FILLER      PIC X(13) VALUE '010044   0632'.
085900         10  FILLER      PIC X(13) VALUE '010045   0738'.
086000         10  FILLER      PIC X(13) VALUE '010047   0924'.
086100         10  FILLER      PIC X(13) VALUE '010050   1091'.
086200         10  FILLER      PIC X(13) VALUE '010051   0296'.
086300         10  FILLER      PIC X(13) VALUE '010052   0474'.
086400         10  FILLER      PIC X(13) VALUE '010058   0155'.
086500         10  FILLER      PIC X(13) VALUE '010059   1041'.
086600         10  FILLER      PIC X(13) VALUE '010062   0880'.
086700         10  FILLER      PIC X(13) VALUE '010066   0327'.
086800         10  FILLER      PIC X(13) VALUE '010069   0767'.
086900         10  FILLER      PIC X(13) VALUE '010073   0713'.
087000         10  FILLER      PIC X(13) VALUE '010086   1340'.
087100         10  FILLER      PIC X(13) VALUE '010087   1530'.
087200         10  FILLER      PIC X(13) VALUE '010091   0342'.
087300         10  FILLER      PIC X(13) VALUE '010095   0328'.
087400         10  FILLER      PIC X(13) VALUE '010097   0719'.
087500         10  FILLER      PIC X(13) VALUE '010099   1159'.
087600         10  FILLER      PIC X(13) VALUE '010101   1264'.
087700         10  FILLER      PIC X(13) VALUE '010102   0151'.
087800         10  FILLER      PIC X(13) VALUE '010108   1145'.
087900         10  FILLER      PIC X(13) VALUE '010109   0722'.
088000         10  FILLER      PIC X(13) VALUE '010110   0627'.
088100         10  FILLER      PIC X(13) VALUE '010112   1482'.
088200         10  FILLER      PIC X(13) VALUE '010120   0895'.
088300         10  FILLER      PIC X(13) VALUE '010125   1064'.
088400         10  FILLER      PIC X(13) VALUE '010126   0998'.
088500         10  FILLER      PIC X(13) VALUE '010128   0421'.
088600         10  FILLER      PIC X(13) VALUE '010129   0568'.
088700         10  FILLER      PIC X(13) VALUE '010130   0879'.
088800         10  FILLER      PIC X(13) VALUE '010137   0447'.
088900         10  FILLER      PIC X(13) VALUE '010138   0248'.
089000         10  FILLER      PIC X(13) VALUE '010145   1516'.
089100         10  FILLER      PIC X(13) VALUE '010146   0777'.
089200         10  FILLER      PIC X(13) VALUE '010148   1181'.
089300         10  FILLER      PIC X(13) VALUE '010150   0901'.
089400         10  FILLER      PIC X(13) VALUE '010152   1041'.
089500         10  FILLER      PIC X(13) VALUE '010157   0779'.
089600         10  FILLER      PIC X(13) VALUE '010158   1459'.
089700         10  FILLER      PIC X(13) VALUE '010168   1209'.
089800         10  FILLER      PIC X(13) VALUE '010169   0900'.
089900         10  FILLER      PIC X(13) VALUE '010170   0011'.
090000         10  FILLER      PIC X(13) VALUE '020006   1476'.
090100         10  FILLER      PIC X(13) VALUE '020008   0559'.
090200         10  FILLER      PIC X(13) VALUE '020012   1200'.
090300         10  FILLER      PIC X(13) VALUE '020017   1535'.
090400         10  FILLER      PIC X(13) VALUE '020018   0319'.
090500         10  FILLER      PIC X(13) VALUE '020024   0771'.
090600         10  FILLER      PIC X(13) VALUE '020026   1506'.
090700         10  FILLER      PIC X(13) VALUE '020027   0287'.
090800         10  FILLER      PIC X(13) VALUE '030022   1566'.
090900         10  FILLER      PIC X(13) VALUE '030033   1503'.
091000         10  FILLER      PIC X(13) VALUE '030062   1292'.
091100         10  FILLER      PIC X(13) VALUE '030067   0638'.
091200         10  FILLER      PIC X(13) VALUE '030068   0903'.
091300         10  FILLER      PIC X(13) VALUE '030071   0439'.
091400         10  FILLER      PIC X(13) VALUE '030073   0718'.
091500         10  FILLER      PIC X(13) VALUE '030074   0050'.
091600         10  FILLER      PIC X(13) VALUE '030077   0018'.
091700         10  FILLER      PIC X(13) VALUE '030078   0236'.
091800         10  FILLER      PIC X(13) VALUE '030084   0421'.
091900         10  FILLER      PIC X(13) VALUE '030107   0447'.
092000         10  FILLER      PIC X(13) VALUE '030108   0390'.
092100         10  FILLER      PIC X(13) VALUE '030112   0303'.
092200         10  FILLER      PIC X(13) VALUE '030113   0233'.
092300         10  FILLER      PIC X(13) VALUE '030118   1414'.
092400         10  FILLER      PIC X(13) VALUE '030120   0654'.
092500         10  FILLER      PIC X(13) VALUE '030126   1061'.
092600         10  FILLER      PIC X(13) VALUE '030128   0841'.
092700         10  FILLER      PIC X(13) VALUE '030129   0001'.
092800         10  FILLER      PIC X(13) VALUE '040001   1139'.
092900         10  FILLER      PIC X(13) VALUE '040002   0924'.
093000         10  FILLER      PIC X(13) VALUE '040011   1335'.
093100         10  FILLER      PIC X(13) VALUE '040015   0506'.
093200         10  FILLER      PIC X(13) VALUE '040018   0916'.
093300         10  FILLER      PIC X(13) VALUE '040019   0761'.
093400         10  FILLER      PIC X(13) VALUE '040047   0688'.
093500         10  FILLER      PIC X(13) VALUE '040050   1114'.
093600         10  FILLER      PIC X(13) VALUE '040051   0985'.
093700         10  FILLER      PIC X(13) VALUE '040067   0925'.
093800         10  FILLER      PIC X(13) VALUE '040069   0480'.
093900         10  FILLER      PIC X(13) VALUE '040072   1045'.
094000         10  FILLER      PIC X(13) VALUE '040074   0827'.
094100         10  FILLER      PIC X(13) VALUE '040076   1183'.
094200         10  FILLER      PIC X(13) VALUE '040080   1121'.
094300         10  FILLER      PIC X(13) VALUE '040081   0024'.
094400         10  FILLER      PIC X(13) VALUE '040085   1313'.
094500         10  FILLER      PIC X(13) VALUE '040091   0968'.
094600         10  FILLER      PIC X(13) VALUE '040137   1375'.
094700         10  FILLER      PIC X(13) VALUE '040142   0570'.
094800         10  FILLER      PIC X(13) VALUE '040147   1547'.
094900         10  FILLER      PIC X(13) VALUE '040152   0300'.
095000         10  FILLER      PIC X(13) VALUE '050008   1286'.
095100         10  FILLER      PIC X(13) VALUE '050014   1140'.
095200         10  FILLER      PIC X(13) VALUE '050016   1441'.
095300         10  FILLER      PIC X(13) VALUE '050018   1404'.
095400         10  FILLER      PIC X(13) VALUE '050028   0719'.
095500         10  FILLER      PIC X(13) VALUE '050040   0738'.
095600         10  FILLER      PIC X(13) VALUE '050042   1325'.
095700         10  FILLER      PIC X(13) VALUE '050046   0358'.
095800         10  FILLER      PIC X(13) VALUE '050054   0889'.
095900         10  FILLER      PIC X(13) VALUE '050055   1403'.
096000         10  FILLER      PIC X(13) VALUE '050067   0598'.
096100         10  FILLER      PIC X(13) VALUE '050070   0274'.
096200         10  FILLER      PIC X(13) VALUE '050089   1519'.
096300         10  FILLER      PIC X(13) VALUE '050090   0821'.
096400         10  FILLER      PIC X(13) VALUE '050091   0870'.
096500         10  FILLER      PIC X(13) VALUE '050096   0079'.
096600         10  FILLER      PIC X(13) VALUE '050110   1043'.
096700         10  FILLER      PIC X(13) VALUE '050113   0504'.
096800         10  FILLER      PIC X(13) VALUE '050127   1397'.
096900         10  FILLER      PIC X(13) VALUE '050131   1006'.
097000         10  FILLER      PIC X(13) VALUE '050136   1386'.
097100         10  FILLER      PIC X(13) VALUE '050158   1285'.
097200         10  FILLER      PIC X(13) VALUE '050159   1370'.
097300         10  FILLER      PIC X(13) VALUE '050167   0971'.
097400         10  FILLER      PIC X(13) VALUE '050189   0321'.
097500         10  FILLER      PIC X(13) VALUE '050192   0346'.
097600         10  FILLER      PIC X(13) VALUE '050196   0711'.
097700         10  FILLER      PIC X(13) VALUE '050205   0677'.
097800         10  FILLER      PIC X(13) VALUE '050211   1327'.
097900         10  FILLER      PIC X(13) VALUE '050219   1289'.
098000         10  FILLER      PIC X(13) VALUE '050248   0803'.
098100         10  FILLER      PIC X(13) VALUE '050257   1249'.
098200         10  FILLER      PIC X(13) VALUE '050276   1126'.
098300         10  FILLER      PIC X(13) VALUE '050279   1484'.
098400         10  FILLER      PIC X(13) VALUE '050291   1540'.
098500         10  FILLER      PIC X(13) VALUE '050296   0912'.
098600         10  FILLER      PIC X(13) VALUE '050298   1084'.
098700         10  FILLER      PIC X(13) VALUE '050315   0779'.
098800         10  FILLER      PIC X(13) VALUE '050320   1221'.
098900         10  FILLER      PIC X(13) VALUE '050349   0093'.
099000         10  FILLER      PIC X(13) VALUE '050352   0673'.
099100         10  FILLER      PIC X(13) VALUE '050357   0647'.
099200         10  FILLER      PIC X(13) VALUE '050366   0840'.
099300         10  FILLER      PIC X(13) VALUE '050376   1505'.
099400         10  FILLER      PIC X(13) VALUE '050378   1218'.
099500         10  FILLER      PIC X(13) VALUE '050385   0746'.
099600         10  FILLER      PIC X(13) VALUE '050397   0196'.
099700         10  FILLER      PIC X(13) VALUE '050407   0966'.
099800         10  FILLER      PIC X(13) VALUE '050417   0997'.
099900         10  FILLER      PIC X(13) VALUE '050423   0402'.
100000         10  FILLER      PIC X(13) VALUE '050434   0419'.
100100         10  FILLER      PIC X(13) VALUE '050435   1281'.
100200         10  FILLER      PIC X(13) VALUE '050448   1025'.
100300         10  FILLER      PIC X(13) VALUE '050517   1424'.
100400         10  FILLER      PIC X(13) VALUE '050528   0409'.
100500         10  FILLER      PIC X(13) VALUE '050531   0986'.
100600         10  FILLER      PIC X(13) VALUE '050537   0923'.
100700         10  FILLER      PIC X(13) VALUE '050543   0418'.
100800         10  FILLER      PIC X(13) VALUE '050545   0061'.
100900         10  FILLER      PIC X(13) VALUE '050546   0054'.
101000         10  FILLER      PIC X(13) VALUE '050547   0106'.
101100         10  FILLER      PIC X(13) VALUE '050548   0083'.
101200         10  FILLER      PIC X(13) VALUE '050552   0199'.
101300         10  FILLER      PIC X(13) VALUE '050568   1325'.
101400         10  FILLER      PIC X(13) VALUE '050588   1598'.
101500         10  FILLER      PIC X(13) VALUE '050608   1001'.
101600         10  FILLER      PIC X(13) VALUE '050618   0144'.
101700         10  FILLER      PIC X(13) VALUE '050641   0845'.
101800         10  FILLER      PIC X(13) VALUE '050644   1262'.
101900         10  FILLER      PIC X(13) VALUE '050668   0079'.
102000         10  FILLER      PIC X(13) VALUE '050680   1474'.
102100         10  FILLER      PIC X(13) VALUE '050688   1501'.
102200         10  FILLER      PIC X(13) VALUE '050697   0087'.
102300         10  FILLER      PIC X(13) VALUE '050708   1016'.
102400         10  FILLER      PIC X(13) VALUE '050714   0175'.
102500         10  FILLER      PIC X(13) VALUE '050717   0227'.
102600         10  FILLER      PIC X(13) VALUE '050722   0008'.
102700         10  FILLER      PIC X(13) VALUE '050723   0475'.
102800         10  FILLER      PIC X(13) VALUE '050726   0361'.
102900         10  FILLER      PIC X(13) VALUE '050727   1519'.
103000         10  FILLER      PIC X(13) VALUE '050732   1581'.
103100         10  FILLER      PIC X(13) VALUE '050736   1149'.
103200         10  FILLER      PIC X(13) VALUE '050738   0700'.
103300         10  FILLER      PIC X(13) VALUE '050744   0703'.
103400         10  FILLER      PIC X(13) VALUE '050745   0735'.
103500         10  FILLER      PIC X(13) VALUE '050747   0841'.
103600         10  FILLER      PIC X(13) VALUE '050748   0217'.
103700         10  FILLER      PIC X(13) VALUE '050749   0319'.
103800         10  FILLER      PIC X(13) VALUE '050751   0078'.
103900         10  FILLER      PIC X(13) VALUE '050754   0034'.
104000         10  FILLER      PIC X(13) VALUE '050758   1117'.
104100         10  FILLER      PIC X(13) VALUE '050760   0351'.
104200         10  FILLER      PIC X(13) VALUE '050765   0659'.
104300         10  FILLER      PIC X(13) VALUE '050766   0269'.
104400         10  FILLER      PIC X(13) VALUE '050767   0115'.
104500         10  FILLER      PIC X(13) VALUE '050768   0007'.
104600         10  FILLER      PIC X(13) VALUE '060004   0955'.
104700         10  FILLER      PIC X(13) VALUE '060006   1353'.
104800         10  FILLER      PIC X(13) VALUE '060008   0844'.
104900         10  FILLER      PIC X(13) VALUE '060016   1150'.
105000         10  FILLER      PIC X(13) VALUE '060036   0930'.
105100         10  FILLER      PIC X(13) VALUE '060043   0122'.
105200         10  FILLER      PIC X(13) VALUE '060044   0464'.
105300         10  FILLER      PIC X(13) VALUE '060049   0372'.
105400         10  FILLER      PIC X(13) VALUE '060054   0967'.
105500         10  FILLER      PIC X(13) VALUE '060065   1576'.
105600         10  FILLER      PIC X(13) VALUE '060071   1390'.
105700         10  FILLER      PIC X(13) VALUE '060075   0772'.
105800         10  FILLER      PIC X(13) VALUE '060076   0717'.
105900         10  FILLER      PIC X(13) VALUE '060096   0389'.
106000         10  FILLER      PIC X(13) VALUE '060103   0769'.
106100         10  FILLER      PIC X(13) VALUE '060107   0006'.
106200         10  FILLER      PIC X(13) VALUE '060117   0157'.
106300         10  FILLER      PIC X(13) VALUE '060118   0243'.
106400         10  FILLER      PIC X(13) VALUE '060124   0060'.
106500         10  FILLER      PIC X(13) VALUE '070004   1161'.
106600         10  FILLER      PIC X(13) VALUE '070015   1123'.
106700         10  FILLER      PIC X(13) VALUE '070038   0004'.
106800         10  FILLER      PIC X(13) VALUE '070039   0779'.
106900         10  FILLER      PIC X(13) VALUE '070040   0233'.
107000         10  FILLER      PIC X(13) VALUE '090008   1472'.
107100         10  FILLER      PIC X(13) VALUE '100024   0160'.
107200         10  FILLER      PIC X(13) VALUE '100048   0675'.
107300         10  FILLER      PIC X(13) VALUE '100054   1289'.
107400         10  FILLER      PIC X(13) VALUE '100069   1379'.
107500         10  FILLER      PIC X(13) VALUE '100081   0612'.
107600         10  FILLER      PIC X(13) VALUE '100106   0634'.
107700         10  FILLER      PIC X(13) VALUE '100130   0510'.
107800         10  FILLER      PIC X(13) VALUE '100134   0012'.
107900         10  FILLER      PIC X(13) VALUE '100139   0148'.
108000         10  FILLER      PIC X(13) VALUE '100140   1254'.
108100         10  FILLER      PIC X(13) VALUE '100150   1504'.
108200         10  FILLER      PIC X(13) VALUE '100160   0232'.
108300         10  FILLER      PIC X(13) VALUE '100175   1120'.
108400         10  FILLER      PIC X(13) VALUE '100240   0050'.
108500         10  FILLER      PIC X(13) VALUE '100277   0172'.
108600         10  FILLER      PIC X(13) VALUE '100298   0045'.
108700         10  FILLER      PIC X(13) VALUE '100311   0005'.
108800         10  FILLER      PIC X(13) VALUE '100312   0027'.
108900         10  FILLER      PIC X(13) VALUE '100313   0111'.
109000         10  FILLER      PIC X(13) VALUE '110004   1450'.
109100         10  FILLER      PIC X(13) VALUE '110015   0992'.
109200         10  FILLER      PIC X(13) VALUE '110026   0551'.
109300         10  FILLER      PIC X(13) VALUE '110027   0682'.
109400         10  FILLER      PIC X(13) VALUE '110040   0712'.
109500         10  FILLER      PIC X(13) VALUE '110041   1144'.
109600         10  FILLER      PIC X(13) VALUE '110042   1070'.
109700         10  FILLER      PIC X(13) VALUE '110044   0660'.
109800         10  FILLER      PIC X(13) VALUE '110045   0952'.
109900         10  FILLER      PIC X(13) VALUE '110050   0506'.
110000         10  FILLER      PIC X(13) VALUE '110051   0914'.
110100         10  FILLER      PIC X(13) VALUE '110059   0616'.
110200         10  FILLER      PIC X(13) VALUE '110071   0756'.
110300         10  FILLER      PIC X(13) VALUE '110073   0984'.
110400         10  FILLER      PIC X(13) VALUE '110086   0835'.
110500         10  FILLER      PIC X(13) VALUE '110092   1076'.
110600         10  FILLER      PIC X(13) VALUE '110100   0608'.
110700         10  FILLER      PIC X(13) VALUE '110101   0479'.
110800         10  FILLER      PIC X(13) VALUE '110104   1123'.
110900         10  FILLER      PIC X(13) VALUE '110109   0717'.
111000         10  FILLER      PIC X(13) VALUE '110111   0504'.
111100         10  FILLER      PIC X(13) VALUE '110112   0277'.
111200         10  FILLER      PIC X(13) VALUE '110113   0674'.
111300         10  FILLER      PIC X(13) VALUE '110121   0502'.
111400         10  FILLER      PIC X(13) VALUE '110124   1506'.
111500         10  FILLER      PIC X(13) VALUE '110130   0278'.
111600         10  FILLER      PIC X(13) VALUE '110132   0886'.
111700         10  FILLER      PIC X(13) VALUE '110135   0754'.
111800         10  FILLER      PIC X(13) VALUE '110142   0722'.
111900         10  FILLER      PIC X(13) VALUE '110146   0517'.
112000         10  FILLER      PIC X(13) VALUE '110153   0967'.
112100         10  FILLER      PIC X(13) VALUE '110183   0788'.
112200         10  FILLER      PIC X(13) VALUE '110187   0680'.
112300         10  FILLER      PIC X(13) VALUE '110189   1234'.
112400         10  FILLER      PIC X(13) VALUE '110190   0332'.
112500         10  FILLER      PIC X(13) VALUE '110194   0606'.
112600         10  FILLER      PIC X(13) VALUE '110200   0958'.
112700         10  FILLER      PIC X(13) VALUE '110203   0620'.
112800         10  FILLER      PIC X(13) VALUE '110205   0470'.
112900         10  FILLER      PIC X(13) VALUE '110209   1542'.
113000         10  FILLER      PIC X(13) VALUE '110212   1099'.
113100         10  FILLER      PIC X(13) VALUE '110225   1534'.
113200         10  FILLER      PIC X(13) VALUE '110226   1395'.
113300         10  FILLER      PIC X(13) VALUE '110230   1508'.
113400         10  FILLER      PIC X(13) VALUE '120004   0895'.
113500         10  FILLER      PIC X(13) VALUE '120010   1290'.
113600         10  FILLER      PIC X(13) VALUE '120014   1082'.
113700         10  FILLER      PIC X(13) VALUE '120019   0638'.
113800         10  FILLER      PIC X(13) VALUE '120027   1590'.
113900         10  FILLER      PIC X(13) VALUE '120028   0362'.
114000         10  FILLER      PIC X(13) VALUE '130024   0850'.
114100         10  FILLER      PIC X(13) VALUE '130025   0649'.
114200         10  FILLER      PIC X(13) VALUE '130062   0001'.
114300         10  FILLER      PIC X(13) VALUE '130063   0103'.
114400         10  FILLER      PIC X(13) VALUE '130065   0365'.
114500         10  FILLER      PIC X(13) VALUE '130066   0164'.
114600         10  FILLER      PIC X(13) VALUE '130067   0011'.
114700         10  FILLER      PIC X(13) VALUE '140001   1239'.
114800         10  FILLER      PIC X(13) VALUE '140019   0662'.
114900         10  FILLER      PIC X(13) VALUE '140059   0796'.
115000         10  FILLER      PIC X(13) VALUE '140068   1319'.
115100         10  FILLER      PIC X(13) VALUE '140077   0872'.
115200         10  FILLER      PIC X(13) VALUE '140089   1160'.
115300         10  FILLER      PIC X(13) VALUE '140095   1483'.
115400         10  FILLER      PIC X(13) VALUE '140100   0298'.
115500         10  FILLER      PIC X(13) VALUE '140110   1350'.
115600         10  FILLER      PIC X(13) VALUE '140137   0390'.
115700         10  FILLER      PIC X(13) VALUE '140143   1556'.
115800         10  FILLER      PIC X(13) VALUE '140145   0826'.
115900         10  FILLER      PIC X(13) VALUE '140147   1149'.
116000         10  FILLER      PIC X(13) VALUE '140151   1541'.
116100         10  FILLER      PIC X(13) VALUE '140161   0694'.
116200         10  FILLER      PIC X(13) VALUE '140167   1161'.
116300         10  FILLER      PIC X(13) VALUE '140210   1376'.
116400         10  FILLER      PIC X(13) VALUE '140234   1594'.
116500         10  FILLER      PIC X(13) VALUE '140294   1064'.
116600         10  FILLER      PIC X(13) VALUE '140300   0902'.
116700         10  FILLER      PIC X(13) VALUE '140301   0235'.
116800         10  FILLER      PIC X(13) VALUE '140303   0044'.
116900         10  FILLER      PIC X(13) VALUE '140305   0043'.
117000         10  FILLER      PIC X(13) VALUE '150001   1283'.
117100         10  FILLER      PIC X(13) VALUE '150022   1079'.
117200         10  FILLER      PIC X(13) VALUE '150038   0897'.
117300         10  FILLER      PIC X(13) VALUE '150045   0703'.
117400         10  FILLER      PIC X(13) VALUE '150061   0999'.
117500         10  FILLER      PIC X(13) VALUE '150064   1080'.
117600         10  FILLER      PIC X(13) VALUE '150065   1348'.
117700         10  FILLER      PIC X(13) VALUE '150072   0874'.
117800         10  FILLER      PIC X(13) VALUE '150076   1250'.
117900         10  FILLER      PIC X(13) VALUE '150091   0806'.
118000         10  FILLER      PIC X(13) VALUE '150097   1410'.
118100         10  FILLER      PIC X(13) VALUE '150101   0654'.
118200         10  FILLER      PIC X(13) VALUE '150102   0419'.
118300         10  FILLER      PIC X(13) VALUE '150104   1070'.
118400         10  FILLER      PIC X(13) VALUE '150129   0806'.
118500         10  FILLER      PIC X(13) VALUE '150146   0897'.
118600         10  FILLER      PIC X(13) VALUE '150149   0047'.
118700         10  FILLER      PIC X(13) VALUE '150150   1114'.
118800         10  FILLER      PIC X(13) VALUE '150157   1496'.
118900         10  FILLER      PIC X(13) VALUE '150160   0976'.
119000         10  FILLER      PIC X(13) VALUE '150163   0518'.
119100         10  FILLER      PIC X(13) VALUE '150164   0663'.
119200         10  FILLER      PIC X(13) VALUE '150165   0466'.
119300         10  FILLER      PIC X(13) VALUE '150166   0408'.
119400         10  FILLER      PIC X(13) VALUE '150167   0972'.
119500         10  FILLER      PIC X(13) VALUE '150168   0875'.
119600         10  FILLER      PIC X(13) VALUE '150170   0023'.
119700         10  FILLER      PIC X(13) VALUE '150172   0169'.
119800         10  FILLER      PIC X(13) VALUE '150175   0968'.
119900         10  FILLER      PIC X(13) VALUE '150176   0951'.
120000         10  FILLER      PIC X(13) VALUE '150177   0280'.
120100         10  FILLER      PIC X(13) VALUE '160001   1350'.
120200         10  FILLER      PIC X(13) VALUE '160005   0902'.
120300         10  FILLER      PIC X(13) VALUE '160008   1101'.
120400         10  FILLER      PIC X(13) VALUE '160013   0694'.
120500         10  FILLER      PIC X(13) VALUE '160032   1016'.
120600         10  FILLER      PIC X(13) VALUE '160040   0654'.
120700         10  FILLER      PIC X(13) VALUE '160101   0381'.
120800         10  FILLER      PIC X(13) VALUE '160104   1473'.
120900         10  FILLER      PIC X(13) VALUE '160112   1462'.
121000         10  FILLER      PIC X(13) VALUE '160122   1017'.
121100         10  FILLER      PIC X(13) VALUE '160124   0509'.
121200         10  FILLER      PIC X(13) VALUE '160147   0723'.
121300         10  FILLER      PIC X(13) VALUE '170001   1417'.
121400         10  FILLER      PIC X(13) VALUE '170009   0870'.
121500         10  FILLER      PIC X(13) VALUE '170010   0600'.
121600         10  FILLER      PIC X(13) VALUE '170014   0707'.
121700         10  FILLER      PIC X(13) VALUE '170017   0721'.
121800         10  FILLER      PIC X(13) VALUE '170023   1037'.
121900         10  FILLER      PIC X(13) VALUE '170027   0754'.
122000         10  FILLER      PIC X(13) VALUE '170033   0472'.
122100         10  FILLER      PIC X(13) VALUE '170039   0237'.
122200         10  FILLER      PIC X(13) VALUE '170058   0870'.
122300         10  FILLER      PIC X(13) VALUE '170068   0488'.
122400         10  FILLER      PIC X(13) VALUE '170074   0709'.
122500         10  FILLER      PIC X(13) VALUE '170075   0154'.
122600         10  FILLER      PIC X(13) VALUE '170094   0534'.
122700         10  FILLER      PIC X(13) VALUE '170105   0603'.
122800         10  FILLER      PIC X(13) VALUE '170109   0346'.
122900         10  FILLER      PIC X(13) VALUE '170110   0269'.
123000         10  FILLER      PIC X(13) VALUE '170120   1424'.
123100         10  FILLER      PIC X(13) VALUE '170133   0801'.
123200         10  FILLER      PIC X(13) VALUE '170145   1541'.
123300         10  FILLER      PIC X(13) VALUE '170150   0512'.
123400         10  FILLER      PIC X(13) VALUE '170166   0548'.
123500         10  FILLER      PIC X(13) VALUE '170175   1034'.
123600         10  FILLER      PIC X(13) VALUE '170183   0721'.
123700         10  FILLER      PIC X(13) VALUE '170186   1289'.
123800         10  FILLER      PIC X(13) VALUE '170187   0316'.
123900         10  FILLER      PIC X(13) VALUE '170188   0289'.
124000         10  FILLER      PIC X(13) VALUE '170190   0044'.
124100         10  FILLER      PIC X(13) VALUE '170191   0659'.
124200         10  FILLER      PIC X(13) VALUE '170194   0312'.
124300         10  FILLER      PIC X(13) VALUE '170195   0260'.
124400         10  FILLER      PIC X(13) VALUE '170196   0635'.
124500         10  FILLER      PIC X(13) VALUE '170197   1547'.
124600         10  FILLER      PIC X(13) VALUE '170198   0137'.
124700         10  FILLER      PIC X(13) VALUE '170199   0085'.
124800         10  FILLER      PIC X(13) VALUE '170200   0025'.
124900         10  FILLER      PIC X(13) VALUE '180004   1036'.
125000         10  FILLER      PIC X(13) VALUE '180016   1423'.
125100         10  FILLER      PIC X(13) VALUE '180019   1452'.
125200         10  FILLER      PIC X(13) VALUE '180020   1118'.
125300         10  FILLER      PIC X(13) VALUE '180024   0902'.
125400         10  FILLER      PIC X(13) VALUE '180025   1290'.
125500         10  FILLER      PIC X(13) VALUE '180043   1361'.
125600         10  FILLER      PIC X(13) VALUE '180046   0465'.
125700         10  FILLER      PIC X(13) VALUE '180049   1400'.
125800         10  FILLER      PIC X(13) VALUE '180053   0888'.
125900         10  FILLER      PIC X(13) VALUE '180064   1019'.
126000         10  FILLER      PIC X(13) VALUE '180066   1031'.
126100         10  FILLER      PIC X(13) VALUE '180070   0976'.
126200         10  FILLER      PIC X(13) VALUE '180079   0901'.
126300         10  FILLER      PIC X(13) VALUE '180087   1546'.
126400         10  FILLER      PIC X(13) VALUE '180092   0888'.
126500         10  FILLER      PIC X(13) VALUE '180095   0880'.
126600         10  FILLER      PIC X(13) VALUE '180101   0879'.
126700         10  FILLER      PIC X(13) VALUE '180105   1298'.
126800         10  FILLER      PIC X(13) VALUE '180106   1335'.
126900         10  FILLER      PIC X(13) VALUE '180115   0808'.
127000         10  FILLER      PIC X(13) VALUE '180117   0605'.
127100         10  FILLER      PIC X(13) VALUE '180138   1357'.
127200         10  FILLER      PIC X(13) VALUE '180149   1181'.
127300         10  FILLER      PIC X(13) VALUE '190001   0969'.
127400         10  FILLER      PIC X(13) VALUE '190003   1121'.
127500         10  FILLER      PIC X(13) VALUE '190005   1276'.
127600         10  FILLER      PIC X(13) VALUE '190006   0515'.
127700         10  FILLER      PIC X(13) VALUE '190007   1265'.
127800         10  FILLER      PIC X(13) VALUE '190009   0232'.
127900         10  FILLER      PIC X(13) VALUE '190011   0614'.
128000         10  FILLER      PIC X(13) VALUE '190013   1548'.
128100         10  FILLER      PIC X(13) VALUE '190014   1290'.
128200         10  FILLER      PIC X(13) VALUE '190025   1020'.
128300         10  FILLER      PIC X(13) VALUE '190034   1102'.
128400         10  FILLER      PIC X(13) VALUE '190037   0009'.
128500         10  FILLER      PIC X(13) VALUE '190044   1422'.
128600         10  FILLER      PIC X(13) VALUE '190050   1247'.
128700         10  FILLER      PIC X(13) VALUE '190078   0505'.
128800         10  FILLER      PIC X(13) VALUE '190079   0647'.
128900         10  FILLER      PIC X(13) VALUE '190081   0805'.
129000         10  FILLER      PIC X(13) VALUE '190088   0694'.
129100         10  FILLER      PIC X(13) VALUE '190090   0640'.
129200         10  FILLER      PIC X(13) VALUE '190099   0935'.
129300         10  FILLER      PIC X(13) VALUE '190106   0553'.
129400         10  FILLER      PIC X(13) VALUE '190114   0885'.
129500         10  FILLER      PIC X(13) VALUE '190115   0111'.
129600         10  FILLER      PIC X(13) VALUE '190116   0798'.
129700         10  FILLER      PIC X(13) VALUE '190118   0679'.
129800         10  FILLER      PIC X(13) VALUE '190122   0480'.
129900         10  FILLER      PIC X(13) VALUE '190128   0280'.
130000         10  FILLER      PIC X(13) VALUE '190133   0224'.
130100         10  FILLER      PIC X(13) VALUE '190140   0821'.
130200         10  FILLER      PIC X(13) VALUE '190145   0717'.
130300         10  FILLER      PIC X(13) VALUE '190151   0659'.
130400         10  FILLER      PIC X(13) VALUE '190161   0136'.
130500         10  FILLER      PIC X(13) VALUE '190175   0865'.
130600         10  FILLER      PIC X(13) VALUE '190183   0750'.
130700         10  FILLER      PIC X(13) VALUE '190184   0340'.
130800         10  FILLER      PIC X(13) VALUE '190190   0460'.
130900         10  FILLER      PIC X(13) VALUE '190199   0016'.
131000         10  FILLER      PIC X(13) VALUE '190201   0322'.
131100         10  FILLER      PIC X(13) VALUE '190202   1551'.
131200         10  FILLER      PIC X(13) VALUE '190208   0402'.
131300         10  FILLER      PIC X(13) VALUE '190218   0735'.
131400         10  FILLER      PIC X(13) VALUE '190241   0037'.
131500         10  FILLER      PIC X(13) VALUE '190242   1293'.
131600         10  FILLER      PIC X(13) VALUE '190245   0103'.
131700         10  FILLER      PIC X(13) VALUE '190246   0578'.
131800         10  FILLER      PIC X(13) VALUE '190251   0065'.
131900         10  FILLER      PIC X(13) VALUE '190255   0007'.
132000         10  FILLER      PIC X(13) VALUE '190256   0011'.
132100         10  FILLER      PIC X(13) VALUE '190257   0240'.
132200         10  FILLER      PIC X(13) VALUE '190259   0241'.
132300         10  FILLER      PIC X(13) VALUE '190261   0007'.
132400         10  FILLER      PIC X(13) VALUE '190263   1244'.
132500         10  FILLER      PIC X(13) VALUE '190266   0125'.
132600         10  FILLER      PIC X(13) VALUE '190267   0070'.
132700         10  FILLER      PIC X(13) VALUE '190268   0028'.
132800         10  FILLER      PIC X(13) VALUE '190270   0419'.
132900         10  FILLER      PIC X(13) VALUE '190273   0056'.
133000         10  FILLER      PIC X(13) VALUE '190278   0236'.
133100         10  FILLER      PIC X(13) VALUE '190297   0277'.
133200         10  FILLER      PIC X(13) VALUE '190298   0065'.
133300         10  FILLER      PIC X(13) VALUE '200002   0949'.
133400         10  FILLER      PIC X(13) VALUE '200018   1251'.
133500         10  FILLER      PIC X(13) VALUE '200025   0700'.
133600         10  FILLER      PIC X(13) VALUE '200031   0954'.
133700         10  FILLER      PIC X(13) VALUE '200032   1058'.
133800         10  FILLER      PIC X(13) VALUE '200037   1259'.
133900         10  FILLER      PIC X(13) VALUE '200040   1395'.
134000         10  FILLER      PIC X(13) VALUE '200041   0737'.
134100         10  FILLER      PIC X(13) VALUE '200050   1476'.
134200         10  FILLER      PIC X(13) VALUE '200052   0730'.
134300         10  FILLER      PIC X(13) VALUE '210017   1184'.
134400         10  FILLER      PIC X(13) VALUE '210025   0498'.
134500         10  FILLER      PIC X(13) VALUE '210045   0381'.
134600         10  FILLER      PIC X(13) VALUE '210060   1322'.
134700         10  FILLER      PIC X(13) VALUE '220019   1294'.
134800         10  FILLER      PIC X(13) VALUE '220050   0766'.
134900         10  FILLER      PIC X(13) VALUE '220051   1250'.
135000         10  FILLER      PIC X(13) VALUE '220058   0459'.
135100         10  FILLER      PIC X(13) VALUE '220065   1584'.
135200         10  FILLER      PIC X(13) VALUE '220075   0453'.
135300         10  FILLER      PIC X(13) VALUE '220083   1449'.
135400         10  FILLER      PIC X(13) VALUE '220095   1565'.
135500         10  FILLER      PIC X(13) VALUE '220098   0944'.
135600         10  FILLER      PIC X(13) VALUE '220177   0145'.
135700         10  FILLER      PIC X(13) VALUE '230003   1037'.
135800         10  FILLER      PIC X(13) VALUE '230013   1096'.
135900         10  FILLER      PIC X(13) VALUE '230015   0705'.
136000         10  FILLER      PIC X(13) VALUE '230034   0763'.
136100         10  FILLER      PIC X(13) VALUE '230035   1401'.
136200         10  FILLER      PIC X(13) VALUE '230037   1506'.
136300         10  FILLER      PIC X(13) VALUE '230040   1513'.
136400         10  FILLER      PIC X(13) VALUE '230055   1499'.
136500         10  FILLER      PIC X(13) VALUE '230071   0462'.
136600         10  FILLER      PIC X(13) VALUE '230078   0399'.
136700         10  FILLER      PIC X(13) VALUE '230080   1599'.
136800         10  FILLER      PIC X(13) VALUE '230085   0411'.
136900         10  FILLER      PIC X(13) VALUE '230093   0931'.
137000         10  FILLER      PIC X(13) VALUE '230096   0951'.
137100         10  FILLER      PIC X(13) VALUE '230100   1236'.
137200         10  FILLER      PIC X(13) VALUE '230101   1216'.
137300         10  FILLER      PIC X(13) VALUE '230106   1302'.
137400         10  FILLER      PIC X(13) VALUE '230108   0875'.
137500         10  FILLER      PIC X(13) VALUE '230110   1189'.
137600         10  FILLER      PIC X(13) VALUE '230118   0753'.
137700         10  FILLER      PIC X(13) VALUE '230133   0970'.
137800         10  FILLER      PIC X(13) VALUE '230135   0193'.
137900         10  FILLER      PIC X(13) VALUE '230144   0036'.
138000         10  FILLER      PIC X(13) VALUE '230174   0927'.
138100         10  FILLER      PIC X(13) VALUE '230180   1200'.
138200         10  FILLER      PIC X(13) VALUE '230204   1381'.
138300         10  FILLER      PIC X(13) VALUE '230208   0675'.
138400         10  FILLER      PIC X(13) VALUE '230212   0378'.
138500         10  FILLER      PIC X(13) VALUE '230239   1329'.
138600         10  FILLER      PIC X(13) VALUE '230241   1188'.
138700         10  FILLER      PIC X(13) VALUE '230257   0051'.
138800         10  FILLER      PIC X(13) VALUE '230259   1279'.
138900         10  FILLER      PIC X(13) VALUE '230264   0034'.
139000         10  FILLER      PIC X(13) VALUE '230275   0083'.
139100         10  FILLER      PIC X(13) VALUE '230279   0096'.
139200         10  FILLER      PIC X(13) VALUE '230297   1211'.
139300         10  FILLER      PIC X(13) VALUE '230301   0241'.
139400         10  FILLER      PIC X(13) VALUE '240006   0491'.
139500         10  FILLER      PIC X(13) VALUE '240014   0658'.
139600         10  FILLER      PIC X(13) VALUE '240018   0925'.
139700         10  FILLER      PIC X(13) VALUE '240019   1217'.
139800         10  FILLER      PIC X(13) VALUE '240020   1352'.
139900         10  FILLER      PIC X(13) VALUE '240022   0462'.
140000         10  FILLER      PIC X(13) VALUE '240040   1572'.
140100         10  FILLER      PIC X(13) VALUE '240043   1434'.
140200         10  FILLER      PIC X(13) VALUE '240044   1395'.
140300         10  FILLER      PIC X(13) VALUE '240052   1174'.
140400         10  FILLER      PIC X(13) VALUE '240059   0722'.
140500         10  FILLER      PIC X(13) VALUE '240064   0880'.
140600         10  FILLER      PIC X(13) VALUE '240066   1509'.
140700         10  FILLER      PIC X(13) VALUE '240069   0882'.
140800         10  FILLER      PIC X(13) VALUE '240071   0712'.
140900         10  FILLER      PIC X(13) VALUE '240076   1174'.
141000         10  FILLER      PIC X(13) VALUE '240084   1073'.
141100         10  FILLER      PIC X(13) VALUE '240088   1398'.
141200         10  FILLER      PIC X(13) VALUE '240101   0746'.
141300         10  FILLER      PIC X(13) VALUE '240117   1416'.
141400         10  FILLER      PIC X(13) VALUE '240141   0923'.
141500         10  FILLER      PIC X(13) VALUE '240166   0910'.
141600         10  FILLER      PIC X(13) VALUE '240187   0837'.
141700         10  FILLER      PIC X(13) VALUE '240196   0197'.
141800         10  FILLER      PIC X(13) VALUE '240206   0074'.
141900         10  FILLER      PIC X(13) VALUE '240214   0241'.
142000         10  FILLER      PIC X(13) VALUE '250002   0618'.
142100         10  FILLER      PIC X(13) VALUE '250006   1386'.
142200         10  FILLER      PIC X(13) VALUE '250010   0524'.
142300         10  FILLER      PIC X(13) VALUE '250012   0384'.
142400         10  FILLER      PIC X(13) VALUE '250015   1466'.
142500         10  FILLER      PIC X(13) VALUE '250017   0656'.
142600         10  FILLER      PIC X(13) VALUE '250018   0020'.
142700         10  FILLER      PIC X(13) VALUE '250020   0973'.
142800         10  FILLER      PIC X(13) VALUE '250023   0065'.
142900         10  FILLER      PIC X(13) VALUE '250027   0313'.
143000         10  FILLER      PIC X(13) VALUE '250036   0891'.
143100         10  FILLER      PIC X(13) VALUE '250038   0524'.
143200         10  FILLER      PIC X(13) VALUE '250043   0484'.
143300         10  FILLER      PIC X(13) VALUE '250044   0945'.
143400         10  FILLER      PIC X(13) VALUE '250049   0790'.
143500         10  FILLER      PIC X(13) VALUE '250050   1148'.
143600         10  FILLER      PIC X(13) VALUE '250051   0187'.
143700         10  FILLER      PIC X(13) VALUE '250057   1360'.
143800         10  FILLER      PIC X(13) VALUE '250059   0951'.
143900         10  FILLER      PIC X(13) VALUE '250060   0276'.
144000         10  FILLER      PIC X(13) VALUE '250061   0482'.
144100         10  FILLER      PIC X(13) VALUE '250067   0921'.
144200         10  FILLER      PIC X(13) VALUE '250077   1086'.
144300         10  FILLER      PIC X(13) VALUE '250079   0228'.
144400         10  FILLER      PIC X(13) VALUE '250081   1338'.
144500         10  FILLER      PIC X(13) VALUE '250084   1287'.
144600         10  FILLER      PIC X(13) VALUE '250085   0703'.
144700         10  FILLER      PIC X(13) VALUE '250095   0647'.
144800         10  FILLER      PIC X(13) VALUE '250117   1029'.
144900         10  FILLER      PIC X(13) VALUE '250124   0990'.
145000         10  FILLER      PIC X(13) VALUE '250126   0645'.
145100         10  FILLER      PIC X(13) VALUE '250127   0023'.
145200         10  FILLER      PIC X(13) VALUE '250128   1152'.
145300         10  FILLER      PIC X(13) VALUE '250134   0171'.
145400         10  FILLER      PIC X(13) VALUE '250136   0095'.
145500         10  FILLER      PIC X(13) VALUE '250149   0300'.
145600         10  FILLER      PIC X(13) VALUE '250151   0093'.
145700         10  FILLER      PIC X(13) VALUE '250152   0004'.
145800         10  FILLER      PIC X(13) VALUE '250162   0855'.
145900         10  FILLER      PIC X(13) VALUE '260004   0222'.
146000         10  FILLER      PIC X(13) VALUE '260015   1527'.
146100         10  FILLER      PIC X(13) VALUE '260021   0395'.
146200         10  FILLER      PIC X(13) VALUE '260024   0707'.
146300         10  FILLER      PIC X(13) VALUE '260034   0808'.
146400         10  FILLER      PIC X(13) VALUE '260050   0569'.
146500         10  FILLER      PIC X(13) VALUE '260057   0904'.
146600         10  FILLER      PIC X(13) VALUE '260059   1245'.
146700         10  FILLER      PIC X(13) VALUE '260061   0519'.
146800         10  FILLER      PIC X(13) VALUE '260070   1159'.
146900         10  FILLER      PIC X(13) VALUE '260074   1205'.
147000         10  FILLER      PIC X(13) VALUE '260080   0392'.
147100         10  FILLER      PIC X(13) VALUE '260097   1105'.
147200         10  FILLER      PIC X(13) VALUE '260102   0849'.
147300         10  FILLER      PIC X(13) VALUE '260115   0818'.
147400         10  FILLER      PIC X(13) VALUE '260116   1395'.
147500         10  FILLER      PIC X(13) VALUE '260142   0928'.
147600         10  FILLER      PIC X(13) VALUE '260147   0306'.
147700         10  FILLER      PIC X(13) VALUE '260160   0749'.
147800         10  FILLER      PIC X(13) VALUE '260162   1415'.
147900         10  FILLER      PIC X(13) VALUE '260175   1320'.
148000         10  FILLER      PIC X(13) VALUE '260178   0669'.
148100         10  FILLER      PIC X(13) VALUE '260195   1439'.
148200         10  FILLER      PIC X(13) VALUE '260207   0574'.
148300         10  FILLER      PIC X(13) VALUE '260209   0339'.
148400         10  FILLER      PIC X(13) VALUE '260211   0173'.
148500         10  FILLER      PIC X(13) VALUE '260214   0997'.
148600         10  FILLER      PIC X(13) VALUE '260219   1007'.
148700         10  FILLER      PIC X(13) VALUE '260223   0001'.
148800         10  FILLER      PIC X(13) VALUE '260224   0019'.
148900         10  FILLER      PIC X(13) VALUE '270002   0529'.
149000         10  FILLER      PIC X(13) VALUE '270032   0679'.
149100         10  FILLER      PIC X(13) VALUE '270074   0248'.
149200         10  FILLER      PIC X(13) VALUE '270086   0259'.
149300         10  FILLER      PIC X(13) VALUE '270087   0371'.
149400         10  FILLER      PIC X(13) VALUE '280105   1276'.
149500         10  FILLER      PIC X(13) VALUE '280111   1085'.
149600         10  FILLER      PIC X(13) VALUE '280119   0058'.
149700         10  FILLER      PIC X(13) VALUE '280127   0293'.
149800         10  FILLER      PIC X(13) VALUE '280129   0546'.
149900         10  FILLER      PIC X(13) VALUE '280131   0250'.
150000         10  FILLER      PIC X(13) VALUE '280132   0272'.
150100         10  FILLER      PIC X(13) VALUE '280133   0005'.
150200         10  FILLER      PIC X(13) VALUE '290002   0163'.
150300         10  FILLER      PIC X(13) VALUE '290006   0970'.
150400         10  FILLER      PIC X(13) VALUE '290008   0758'.
150500         10  FILLER      PIC X(13) VALUE '290020   0087'.
150600         10  FILLER      PIC X(13) VALUE '290027   0032'.
150700         10  FILLER      PIC X(13) VALUE '290042   0018'.
150800         10  FILLER      PIC X(13) VALUE '290051   0364'.
150900         10  FILLER      PIC X(13) VALUE '310058   0762'.
151000         10  FILLER      PIC X(13) VALUE '310116   0813'.
151100         10  FILLER      PIC X(13) VALUE '310118   1258'.
151200         10  FILLER      PIC X(13) VALUE '310120   0654'.
151300         10  FILLER      PIC X(13) VALUE '310128   0038'.
151400         10  FILLER      PIC X(13) VALUE '310129   0016'.
151500         10  FILLER      PIC X(13) VALUE '320003   0875'.
151600         10  FILLER      PIC X(13) VALUE '320011   0821'.
151700         10  FILLER      PIC X(13) VALUE '320013   1007'.
151800         10  FILLER      PIC X(13) VALUE '320014   0924'.
151900         10  FILLER      PIC X(13) VALUE '320016   1156'.
152000         10  FILLER      PIC X(13) VALUE '320017   1307'.
152100         10  FILLER      PIC X(13) VALUE '320022   1571'.
152200         10  FILLER      PIC X(13) VALUE '320030   0462'.
152300         10  FILLER      PIC X(13) VALUE '320033   0438'.
152400         10  FILLER      PIC X(13) VALUE '320037   0292'.
152500         10  FILLER      PIC X(13) VALUE '320038   1043'.
152600         10  FILLER      PIC X(13) VALUE '320057   0051'.
152700         10  FILLER      PIC X(13) VALUE '320058   0057'.
152800         10  FILLER      PIC X(13) VALUE '320059   0740'.
152900         10  FILLER      PIC X(13) VALUE '320060   0131'.
153000         10  FILLER      PIC X(13) VALUE '320061   0809'.
153100         10  FILLER      PIC X(13) VALUE '320062   0191'.
153200         10  FILLER      PIC X(13) VALUE '320065   1033'.
153300         10  FILLER      PIC X(13) VALUE '320067   0114'.
153400         10  FILLER      PIC X(13) VALUE '320069   0484'.
153500         10  FILLER      PIC X(13) VALUE '320070   0104'.
153600         10  FILLER      PIC X(13) VALUE '320074   1255'.
153700         10  FILLER      PIC X(13) VALUE '320084   0622'.
153800         10  FILLER      PIC X(13) VALUE '320086   0724'.
153900         10  FILLER      PIC X(13) VALUE '320087   0099'.
154000         10  FILLER      PIC X(13) VALUE '330008   0688'.
154100         10  FILLER      PIC X(13) VALUE '330029   0113'.
154200         10  FILLER      PIC X(13) VALUE '330033   1122'.
154300         10  FILLER      PIC X(13) VALUE '330037   0572'.
154400         10  FILLER      PIC X(13) VALUE '330049   1429'.
154500         10  FILLER      PIC X(13) VALUE '330053   0924'.
154600         10  FILLER      PIC X(13) VALUE '330079   1174'.
154700         10  FILLER      PIC X(13) VALUE '330084   1281'.
154800         10  FILLER      PIC X(13) VALUE '330088   0948'.
154900         10  FILLER      PIC X(13) VALUE '330096   0917'.
155000         10  FILLER      PIC X(13) VALUE '330100   0182'.
155100         10  FILLER      PIC X(13) VALUE '330111   0763'.
155200         10  FILLER      PIC X(13) VALUE '330115   1406'.
155300         10  FILLER      PIC X(13) VALUE '330132   1208'.
155400         10  FILLER      PIC X(13) VALUE '330144   0552'.
155500         10  FILLER      PIC X(13) VALUE '330151   1116'.
155600         10  FILLER      PIC X(13) VALUE '330166   0087'.
155700         10  FILLER      PIC X(13) VALUE '330177   0522'.
155800         10  FILLER      PIC X(13) VALUE '330189   0007'.
155900         10  FILLER      PIC X(13) VALUE '330197   1530'.
156000         10  FILLER      PIC X(13) VALUE '330205   1142'.
156100         10  FILLER      PIC X(13) VALUE '330211   1349'.
156200         10  FILLER      PIC X(13) VALUE '330213   0625'.
156300         10  FILLER      PIC X(13) VALUE '330223   1307'.
156400         10  FILLER      PIC X(13) VALUE '330229   1064'.
156500         10  FILLER      PIC X(13) VALUE '330238   1367'.
156600         10  FILLER      PIC X(13) VALUE '330249   1278'.
156700         10  FILLER      PIC X(13) VALUE '330263   0652'.
156800         10  FILLER      PIC X(13) VALUE '330268   0366'.
156900         10  FILLER      PIC X(13) VALUE '330385   1210'.
157000         10  FILLER      PIC X(13) VALUE '330390   1430'.
157100         10  FILLER      PIC X(13) VALUE '330403   0002'.
157200         10  FILLER      PIC X(13) VALUE '330404   0815'.
157300         10  FILLER      PIC X(13) VALUE '330405   0542'.
157400         10  FILLER      PIC X(13) VALUE '330406   0870'.
157500         10  FILLER      PIC X(13) VALUE '340011   1259'.
157600         10  FILLER      PIC X(13) VALUE '340036   0861'.
157700         10  FILLER      PIC X(13) VALUE '340037   1143'.
157800         10  FILLER      PIC X(13) VALUE '340038   1520'.
157900         10  FILLER      PIC X(13) VALUE '340049   0583'.
158000         10  FILLER      PIC X(13) VALUE '340055   1181'.
158100         10  FILLER      PIC X(13) VALUE '340084   0579'.
158200         10  FILLER      PIC X(13) VALUE '340085   1507'.
158300         10  FILLER      PIC X(13) VALUE '340087   0895'.
158400         10  FILLER      PIC X(13) VALUE '340104   0040'.
158500         10  FILLER      PIC X(13) VALUE '340120   0819'.
158600         10  FILLER      PIC X(13) VALUE '340121   0112'.
158700         10  FILLER      PIC X(13) VALUE '340127   1308'.
158800         10  FILLER      PIC X(13) VALUE '340133   1350'.
158900         10  FILLER      PIC X(13) VALUE '340145   1503'.
159000         10  FILLER      PIC X(13) VALUE '340148   0376'.
159100         10  FILLER      PIC X(13) VALUE '340156   0193'.
159200         10  FILLER      PIC X(13) VALUE '340159   0899'.
159300         10  FILLER      PIC X(13) VALUE '340160   1499'.
159400         10  FILLER      PIC X(13) VALUE '340168   0036'.
159500         10  FILLER      PIC X(13) VALUE '340185   0031'.
159600         10  FILLER      PIC X(13) VALUE '350063   0219'.
159700         10  FILLER      PIC X(13) VALUE '360002   1341'.
159800         10  FILLER      PIC X(13) VALUE '360013   1132'.
159900         10  FILLER      PIC X(13) VALUE '360014   1323'.
160000         10  FILLER      PIC X(13) VALUE '360029   1573'.
160100         10  FILLER      PIC X(13) VALUE '360032   1226'.
160200         10  FILLER      PIC X(13) VALUE '360038   0210'.
160300         10  FILLER      PIC X(13) VALUE '360044   1455'.
160400         10  FILLER      PIC X(13) VALUE '360046   1040'.
160500         10  FILLER      PIC X(13) VALUE '360058   0853'.
160600         10  FILLER      PIC X(13) VALUE '360071   0718'.
160700         10  FILLER      PIC X(13) VALUE '360089   1233'.
160800         10  FILLER      PIC X(13) VALUE '360092   0614'.
160900         10  FILLER      PIC X(13) VALUE '360107   0772'.
161000         10  FILLER      PIC X(13) VALUE '360109   1046'.
161100         10  FILLER      PIC X(13) VALUE '360116   0704'.
161200         10  FILLER      PIC X(13) VALUE '360121   1544'.
161300         10  FILLER      PIC X(13) VALUE '360130   0453'.
161400         10  FILLER      PIC X(13) VALUE '360148   0484'.
161500         10  FILLER      PIC X(13) VALUE '360153   0524'.
161600         10  FILLER      PIC X(13) VALUE '360156   0840'.
161700         10  FILLER      PIC X(13) VALUE '360170   1236'.
161800         10  FILLER      PIC X(13) VALUE '360189   0540'.
161900         10  FILLER      PIC X(13) VALUE '360195   1518'.
162000         10  FILLER      PIC X(13) VALUE '360197   1138'.
162100         10  FILLER      PIC X(13) VALUE '360210   1112'.
162200         10  FILLER      PIC X(13) VALUE '360245   0281'.
162300         10  FILLER      PIC X(13) VALUE '360247   0324'.
162400         10  FILLER      PIC X(13) VALUE '360259   1560'.
162500         10  FILLER      PIC X(13) VALUE '360261   0017'.
162600         10  FILLER      PIC X(13) VALUE '360263   0316'.
162700         10  FILLER      PIC X(13) VALUE '360269   0097'.
162800         10  FILLER      PIC X(13) VALUE '360270   0899'.
162900         10  FILLER      PIC X(13) VALUE '360271   0018'.
163000         10  FILLER      PIC X(13) VALUE '360274   0099'.
163100         10  FILLER      PIC X(13) VALUE '360347   0327'.
163200         10  FILLER      PIC X(13) VALUE '360348   1499'.
163300         10  FILLER      PIC X(13) VALUE '360350   0109'.
163400         10  FILLER      PIC X(13) VALUE '360352   0120'.
163500         10  FILLER      PIC X(13) VALUE '360355   0200'.
163600         10  FILLER      PIC X(13) VALUE '360356   0097'.
163700         10  FILLER      PIC X(13) VALUE '360357   0019'.
163800         10  FILLER      PIC X(13) VALUE '360358   0004'.
163900         10  FILLER      PIC X(13) VALUE '370002   0801'.
164000         10  FILLER      PIC X(13) VALUE '370004   1590'.
164100         10  FILLER      PIC X(13) VALUE '370007   0231'.
164200         10  FILLER      PIC X(13) VALUE '370011   0295'.
164300         10  FILLER      PIC X(13) VALUE '370015   0510'.
164400         10  FILLER      PIC X(13) VALUE '370019   0981'.
164500         10  FILLER      PIC X(13) VALUE '370029   0706'.
164600         10  FILLER      PIC X(13) VALUE '370030   0543'.
164700         10  FILLER      PIC X(13) VALUE '370036   0419'.
164800         10  FILLER      PIC X(13) VALUE '370039   1169'.
164900         10  FILLER      PIC X(13) VALUE '370040   1154'.
165000         10  FILLER      PIC X(13) VALUE '370041   0184'.
165100         10  FILLER      PIC X(13) VALUE '370048   0959'.
165200         10  FILLER      PIC X(13) VALUE '370051   0446'.
165300         10  FILLER      PIC X(13) VALUE '370054   1010'.
165400         10  FILLER      PIC X(13) VALUE '370057   0586'.
165500         10  FILLER      PIC X(13) VALUE '370065   0913'.
165600         10  FILLER      PIC X(13) VALUE '370072   0386'.
165700         10  FILLER      PIC X(13) VALUE '370080   0263'.
165800         10  FILLER      PIC X(13) VALUE '370083   0673'.
165900         10  FILLER      PIC X(13) VALUE '370084   0384'.
166000         10  FILLER      PIC X(13) VALUE '370097   1466'.
166100         10  FILLER      PIC X(13) VALUE '370099   1317'.
166200         10  FILLER      PIC X(13) VALUE '370100   1153'.
166300         10  FILLER      PIC X(13) VALUE '370103   0365'.
166400         10  FILLER      PIC X(13) VALUE '370112   0471'.
166500         10  FILLER      PIC X(13) VALUE '370138   0336'.
166600         10  FILLER      PIC X(13) VALUE '370139   0364'.
166700         10  FILLER      PIC X(13) VALUE '370148   0613'.
166800         10  FILLER      PIC X(13) VALUE '370153   0619'.
166900         10  FILLER      PIC X(13) VALUE '370156   0773'.
167000         10  FILLER      PIC X(13) VALUE '370158   0743'.
167100         10  FILLER      PIC X(13) VALUE '370166   0776'.
167200         10  FILLER      PIC X(13) VALUE '370169   0094'.
167300         10  FILLER      PIC X(13) VALUE '370170   0059'.
167400         10  FILLER      PIC X(13) VALUE '370171   0433'.
167500         10  FILLER      PIC X(13) VALUE '370172   0199'.
167600         10  FILLER      PIC X(13) VALUE '370173   0136'.
167700         10  FILLER      PIC X(13) VALUE '370178   0886'.
167800         10  FILLER      PIC X(13) VALUE '370180   0443'.
167900         10  FILLER      PIC X(13) VALUE '370183   0450'.
168000         10  FILLER      PIC X(13) VALUE '370190   0169'.
168100         10  FILLER      PIC X(13) VALUE '370192   0117'.
168200         10  FILLER      PIC X(13) VALUE '370199   0021'.
168300         10  FILLER      PIC X(13) VALUE '370201   0104'.
168400         10  FILLER      PIC X(13) VALUE '370203   0605'.
168500         10  FILLER      PIC X(13) VALUE '370206   0349'.
168600         10  FILLER      PIC X(13) VALUE '370210   1292'.
168700         10  FILLER      PIC X(13) VALUE '370211   1123'.
168800         10  FILLER      PIC X(13) VALUE '370212   0163'.
168900         10  FILLER      PIC X(13) VALUE '370214   0051'.
169000         10  FILLER      PIC X(13) VALUE '370216   0743'.
169100         10  FILLER      PIC X(13) VALUE '370218   1140'.
169200         10  FILLER      PIC X(13) VALUE '370220   0082'.
169300         10  FILLER      PIC X(13) VALUE '370222   1571'.
169400         10  FILLER      PIC X(13) VALUE '370225   0049'.
169500         10  FILLER      PIC X(13) VALUE '370227   0508'.
169600         10  FILLER      PIC X(13) VALUE '370228   0519'.
169700         10  FILLER      PIC X(13) VALUE '370229   0432'.
169800         10  FILLER      PIC X(13) VALUE '370232   0841'.
169900         10  FILLER      PIC X(13) VALUE '370234   1152'.
170000         10  FILLER      PIC X(13) VALUE '380001   0955'.
170100         10  FILLER      PIC X(13) VALUE '380005   0694'.
170200         10  FILLER      PIC X(13) VALUE '380021   1259'.
170300         10  FILLER      PIC X(13) VALUE '380022   1556'.
170400         10  FILLER      PIC X(13) VALUE '380029   0905'.
170500         10  FILLER      PIC X(13) VALUE '380033   0651'.
170600         10  FILLER      PIC X(13) VALUE '380037   0897'.
170700         10  FILLER      PIC X(13) VALUE '380038   1462'.
170800         10  FILLER      PIC X(13) VALUE '380040   0948'.
170900         10  FILLER      PIC X(13) VALUE '380052   1381'.
171000         10  FILLER      PIC X(13) VALUE '380056   0489'.
171100         10  FILLER      PIC X(13) VALUE '380082   1455'.
171200         10  FILLER      PIC X(13) VALUE '390003   1161'.
171300         10  FILLER      PIC X(13) VALUE '390008   1175'.
171400         10  FILLER      PIC X(13) VALUE '390019   1053'.
171500         10  FILLER      PIC X(13) VALUE '390025   0058'.
171600         10  FILLER      PIC X(13) VALUE '390035   1122'.
171700         10  FILLER      PIC X(13) VALUE '390043   1193'.
171800         10  FILLER      PIC X(13) VALUE '390056   0972'.
171900         10  FILLER      PIC X(13) VALUE '390062   0888'.
172000         10  FILLER      PIC X(13) VALUE '390068   1052'.
172100         10  FILLER      PIC X(13) VALUE '390071   1010'.
172200         10  FILLER      PIC X(13) VALUE '390084   1238'.
172300         10  FILLER      PIC X(13) VALUE '390093   1506'.
172400         10  FILLER      PIC X(13) VALUE '390095   1200'.
172500         10  FILLER      PIC X(13) VALUE '390104   0618'.
172600         10  FILLER      PIC X(13) VALUE '390112   1084'.
172700         10  FILLER      PIC X(13) VALUE '390117   1011'.
172800         10  FILLER      PIC X(13) VALUE '390118   1579'.
172900         10  FILLER      PIC X(13) VALUE '390122   1047'.
173000         10  FILLER      PIC X(13) VALUE '390128   0516'.
173100         10  FILLER      PIC X(13) VALUE '390130   0626'.
173200         10  FILLER      PIC X(13) VALUE '390138   1374'.
173300         10  FILLER      PIC X(13) VALUE '390146   1202'.
173400         10  FILLER      PIC X(13) VALUE '390150   1456'.
173500         10  FILLER      PIC X(13) VALUE '390183   1039'.
173600         10  FILLER      PIC X(13) VALUE '390184   0613'.
173700         10  FILLER      PIC X(13) VALUE '390189   1505'.
173800         10  FILLER      PIC X(13) VALUE '390192   0900'.
173900         10  FILLER      PIC X(13) VALUE '390194   1290'.
174000         10  FILLER      PIC X(13) VALUE '390198   1145'.
174100         10  FILLER      PIC X(13) VALUE '390199   1141'.
174200         10  FILLER      PIC X(13) VALUE '390236   0620'.
174300         10  FILLER      PIC X(13) VALUE '390266   0726'.
174400         10  FILLER      PIC X(13) VALUE '390272   0155'.
174500         10  FILLER      PIC X(13) VALUE '390278   0588'.
174600         10  FILLER      PIC X(13) VALUE '390307   0053'.
174700         10  FILLER      PIC X(13) VALUE '390312   0272'.
174800         10  FILLER      PIC X(13) VALUE '390313   0663'.
174900         10  FILLER      PIC X(13) VALUE '390314   0371'.
175000         10  FILLER      PIC X(13) VALUE '390316   0220'.
175100         10  FILLER      PIC X(13) VALUE '390318   0277'.
175200         10  FILLER      PIC X(13) VALUE '390321   0163'.
175300         10  FILLER      PIC X(13) VALUE '390322   0067'.
175400         10  FILLER      PIC X(13) VALUE '390323   0017'.
175500         10  FILLER      PIC X(13) VALUE '410010   0731'.
175600         10  FILLER      PIC X(13) VALUE '420005   1345'.
175700         10  FILLER      PIC X(13) VALUE '420011   0656'.
175800         10  FILLER      PIC X(13) VALUE '420016   0491'.
175900         10  FILLER      PIC X(13) VALUE '420019   1014'.
176000         10  FILLER      PIC X(13) VALUE '420033   1548'.
176100         10  FILLER      PIC X(13) VALUE '420037   0861'.
176200         10  FILLER      PIC X(13) VALUE '420038   1539'.
176300         10  FILLER      PIC X(13) VALUE '420039   1235'.
176400         10  FILLER      PIC X(13) VALUE '420053   0831'.
176500         10  FILLER      PIC X(13) VALUE '420054   0599'.
176600         10  FILLER      PIC X(13) VALUE '420056   0440'.
176700         10  FILLER      PIC X(13) VALUE '420057   0378'.
176800         10  FILLER      PIC X(13) VALUE '420062   1147'.
176900         10  FILLER      PIC X(13) VALUE '420066   0411'.
177000         10  FILLER      PIC X(13) VALUE '420069   0963'.
177100         10  FILLER      PIC X(13) VALUE '420072   0540'.
177200         10  FILLER      PIC X(13) VALUE '420089   1515'.
177300         10  FILLER      PIC X(13) VALUE '420101   0685'.
177400         10  FILLER      PIC X(13) VALUE '420102   0519'.
177500         10  FILLER      PIC X(13) VALUE '420103   0667'.
177600         10  FILLER      PIC X(13) VALUE '430008   0537'.
177700         10  FILLER      PIC X(13) VALUE '430013   1318'.
177800         10  FILLER      PIC X(13) VALUE '430015   0723'.
177900         10  FILLER      PIC X(13) VALUE '430048   0640'.
178000         10  FILLER      PIC X(13) VALUE '430060   0010'.
178100         10  FILLER      PIC X(13) VALUE '430081   0154'.
178200         10  FILLER      PIC X(13) VALUE '430082   0008'.
178300         10  FILLER      PIC X(13) VALUE '430083   0021'.
178400         10  FILLER      PIC X(13) VALUE '430084   0167'.
178500         10  FILLER      PIC X(13) VALUE '430089   0364'.
178600         10  FILLER      PIC X(13) VALUE '430090   0435'.
178700         10  FILLER      PIC X(13) VALUE '430091   0623'.
178800         10  FILLER      PIC X(13) VALUE '430092   0197'.
178900         10  FILLER      PIC X(13) VALUE '430093   0062'.
179000         10  FILLER      PIC X(13) VALUE '430094   0027'.
179100         10  FILLER      PIC X(13) VALUE '430096   0122'.
179200         10  FILLER      PIC X(13) VALUE '440001   0917'.
179300         10  FILLER      PIC X(13) VALUE '440007   0733'.
179400         10  FILLER      PIC X(13) VALUE '440008   0982'.
179500         10  FILLER      PIC X(13) VALUE '440010   0444'.
179600         10  FILLER      PIC X(13) VALUE '440016   0593'.
179700         10  FILLER      PIC X(13) VALUE '440020   0857'.
179800         10  FILLER      PIC X(13) VALUE '440031   1433'.
179900         10  FILLER      PIC X(13) VALUE '440032   0680'.
180000         10  FILLER      PIC X(13) VALUE '440033   1598'.
180100         10  FILLER      PIC X(13) VALUE '440040   0724'.
180200         10  FILLER      PIC X(13) VALUE '440047   0342'.
180300         10  FILLER      PIC X(13) VALUE '440050   0958'.
180400         10  FILLER      PIC X(13) VALUE '440051   1013'.
180500         10  FILLER      PIC X(13) VALUE '440054   0784'.
180600         10  FILLER      PIC X(13) VALUE '440057   1130'.
180700         10  FILLER      PIC X(13) VALUE '440060   0180'.
180800         10  FILLER      PIC X(13) VALUE '440061   1382'.
180900         10  FILLER      PIC X(13) VALUE '440064   1066'.
181000         10  FILLER      PIC X(13) VALUE '440067   1272'.
181100         10  FILLER      PIC X(13) VALUE '440068   1314'.
181200         10  FILLER      PIC X(13) VALUE '440070   0700'.
181300         10  FILLER      PIC X(13) VALUE '440081   1591'.
181400         10  FILLER      PIC X(13) VALUE '440083   1442'.
181500         10  FILLER      PIC X(13) VALUE '440084   1511'.
181600         10  FILLER      PIC X(13) VALUE '440102   0789'.
181700         10  FILLER      PIC X(13) VALUE '440105   0063'.
181800         10  FILLER      PIC X(13) VALUE '440109   0741'.
181900         10  FILLER      PIC X(13) VALUE '440110   1323'.
182000         10  FILLER      PIC X(13) VALUE '440111   0730'.
182100         10  FILLER      PIC X(13) VALUE '440115   0412'.
182200         10  FILLER      PIC X(13) VALUE '440130   1264'.
182300         10  FILLER      PIC X(13) VALUE '440131   0662'.
182400         10  FILLER      PIC X(13) VALUE '440141   0438'.
182500         10  FILLER      PIC X(13) VALUE '440148   0819'.
182600         10  FILLER      PIC X(13) VALUE '440152   1349'.
182700         10  FILLER      PIC X(13) VALUE '440153   1117'.
182800         10  FILLER      PIC X(13) VALUE '440159   0765'.
182900         10  FILLER      PIC X(13) VALUE '440168   0330'.
183000         10  FILLER      PIC X(13) VALUE '440174   0622'.
183100         10  FILLER      PIC X(13) VALUE '440175   1579'.
183200         10  FILLER      PIC X(13) VALUE '440180   0870'.
183300         10  FILLER      PIC X(13) VALUE '440181   0298'.
183400         10  FILLER      PIC X(13) VALUE '440182   0779'.
183500         10  FILLER      PIC X(13) VALUE '440184   0787'.
183600         10  FILLER      PIC X(13) VALUE '440186   0711'.
183700         10  FILLER      PIC X(13) VALUE '440192   0771'.
183800         10  FILLER      PIC X(13) VALUE '440200   0414'.
183900         10  FILLER      PIC X(13) VALUE '440218   0453'.
184000         10  FILLER      PIC X(13) VALUE '440226   1126'.
184100         10  FILLER      PIC X(13) VALUE '440227   1530'.
184200         10  FILLER      PIC X(13) VALUE '450005   0855'.
184300         10  FILLER      PIC X(13) VALUE '450008   0205'.
184400         10  FILLER      PIC X(13) VALUE '450032   1517'.
184500         10  FILLER      PIC X(13) VALUE '450052   0593'.
184600         10  FILLER      PIC X(13) VALUE '450055   0656'.
184700         10  FILLER      PIC X(13) VALUE '450073   0516'.
184800         10  FILLER      PIC X(13) VALUE '450078   0421'.
184900         10  FILLER      PIC X(13) VALUE '450080   1467'.
185000         10  FILLER      PIC X(13) VALUE '450082   0842'.
185100         10  FILLER      PIC X(13) VALUE '450085   0535'.
185200         10  FILLER      PIC X(13) VALUE '450090   0914'.
185300         10  FILLER      PIC X(13) VALUE '450099   0905'.
185400         10  FILLER      PIC X(13) VALUE '450108   0586'.
185500         10  FILLER      PIC X(13) VALUE '450123   0562'.
185600         10  FILLER      PIC X(13) VALUE '450143   0424'.
185700         10  FILLER      PIC X(13) VALUE '450144   0311'.
185800         10  FILLER      PIC X(13) VALUE '450154   1209'.
185900         10  FILLER      PIC X(13) VALUE '450155   0192'.
186000         10  FILLER      PIC X(13) VALUE '450162   0769'.
186100         10  FILLER      PIC X(13) VALUE '450165   1070'.
186200         10  FILLER      PIC X(13) VALUE '450177   0903'.
186300         10  FILLER      PIC X(13) VALUE '450178   0465'.
186400         10  FILLER      PIC X(13) VALUE '450187   0718'.
186500         10  FILLER      PIC X(13) VALUE '450188   1028'.
186600         10  FILLER      PIC X(13) VALUE '450192   0952'.
186700         10  FILLER      PIC X(13) VALUE '450194   1030'.
186800         10  FILLER      PIC X(13) VALUE '450210   0659'.
186900         10  FILLER      PIC X(13) VALUE '450214   0990'.
187000         10  FILLER      PIC X(13) VALUE '450219   0583'.
187100         10  FILLER      PIC X(13) VALUE '450221   0413'.
187200         10  FILLER      PIC X(13) VALUE '450224   0323'.
187300         10  FILLER      PIC X(13) VALUE '450234   0751'.
187400         10  FILLER      PIC X(13) VALUE '450235   0560'.
187500         10  FILLER      PIC X(13) VALUE '450236   1212'.
187600         10  FILLER      PIC X(13) VALUE '450239   0038'.
187700         10  FILLER      PIC X(13) VALUE '450241   0255'.
187800         10  FILLER      PIC X(13) VALUE '450243   0151'.
187900         10  FILLER      PIC X(13) VALUE '450253   0392'.
188000         10  FILLER      PIC X(13) VALUE '450270   0692'.
188100         10  FILLER      PIC X(13) VALUE '450271   1335'.
188200         10  FILLER      PIC X(13) VALUE '450283   0421'.
188300         10  FILLER      PIC X(13) VALUE '450292   1172'.
188400         10  FILLER      PIC X(13) VALUE '450293   0227'.
188500         10  FILLER      PIC X(13) VALUE '450296   1063'.
188600         10  FILLER      PIC X(13) VALUE '450306   0186'.
188700         10  FILLER      PIC X(13) VALUE '450315   0095'.
188800         10  FILLER      PIC X(13) VALUE '450348   0355'.
188900         10  FILLER      PIC X(13) VALUE '450351   1146'.
189000         10  FILLER      PIC X(13) VALUE '450369   0476'.
189100         10  FILLER      PIC X(13) VALUE '450370   0542'.
189200         10  FILLER      PIC X(13) VALUE '450373   0404'.
189300         10  FILLER      PIC X(13) VALUE '450379   0760'.
189400         10  FILLER      PIC X(13) VALUE '450395   1408'.
189500         10  FILLER      PIC X(13) VALUE '450399   0430'.
189600         10  FILLER      PIC X(13) VALUE '450400   1059'.
189700         10  FILLER      PIC X(13) VALUE '450411   0671'.
189800         10  FILLER      PIC X(13) VALUE '450419   0999'.
189900         10  FILLER      PIC X(13) VALUE '450422   0031'.
190000         10  FILLER      PIC X(13) VALUE '450438   0549'.
190100         10  FILLER      PIC X(13) VALUE '450446   0523'.
190200         10  FILLER      PIC X(13) VALUE '450451   0464'.
190300         10  FILLER      PIC X(13) VALUE '450460   0536'.
190400         10  FILLER      PIC X(13) VALUE '450465   1243'.
190500         10  FILLER      PIC X(13) VALUE '450475   0781'.
190600         10  FILLER      PIC X(13) VALUE '450488   0058'.
190700         10  FILLER      PIC X(13) VALUE '450489   0237'.
190800         10  FILLER      PIC X(13) VALUE '450497   0568'.
190900         10  FILLER      PIC X(13) VALUE '450498   0453'.
191000         10  FILLER      PIC X(13) VALUE '450539   0666'.
191100         10  FILLER      PIC X(13) VALUE '450547   0704'.
191200         10  FILLER      PIC X(13) VALUE '450565   0914'.
191300         10  FILLER      PIC X(13) VALUE '450573   0831'.
191400         10  FILLER      PIC X(13) VALUE '450578   0067'.
191500         10  FILLER      PIC X(13) VALUE '450580   1073'.
191600         10  FILLER      PIC X(13) VALUE '450584   0361'.
191700         10  FILLER      PIC X(13) VALUE '450586   0389'.
191800         10  FILLER      PIC X(13) VALUE '450591   0747'.
191900         10  FILLER      PIC X(13) VALUE '450596   1315'.
192000         10  FILLER      PIC X(13) VALUE '450597   1080'.
192100         10  FILLER      PIC X(13) VALUE '450605   0418'.
192200         10  FILLER      PIC X(13) VALUE '450615   0947'.
192300         10  FILLER      PIC X(13) VALUE '450620   0276'.
192400         10  FILLER      PIC X(13) VALUE '450630   1432'.
192500         10  FILLER      PIC X(13) VALUE '450641   0509'.
192600         10  FILLER      PIC X(13) VALUE '450653   1266'.
192700         10  FILLER      PIC X(13) VALUE '450654   0824'.
192800         10  FILLER      PIC X(13) VALUE '450658   0494'.
192900         10  FILLER      PIC X(13) VALUE '450661   1362'.
193000         10  FILLER      PIC X(13) VALUE '450674   0199'.
193100         10  FILLER      PIC X(13) VALUE '450683   0840'.
193200         10  FILLER      PIC X(13) VALUE '450690   1388'.
193300         10  FILLER      PIC X(13) VALUE '450694   0488'.
193400         10  FILLER      PIC X(13) VALUE '450698   0320'.
193500         10  FILLER      PIC X(13) VALUE '450746   0128'.
193600         10  FILLER      PIC X(13) VALUE '450749   0353'.
193700         10  FILLER      PIC X(13) VALUE '450754   1074'.
193800         10  FILLER      PIC X(13) VALUE '450755   0355'.
193900         10  FILLER      PIC X(13) VALUE '450770   0545'.
194000         10  FILLER      PIC X(13) VALUE '450774   0172'.
194100         10  FILLER      PIC X(13) VALUE '450780   0202'.
194200         10  FILLER      PIC X(13) VALUE '450795   0474'.
194300         10  FILLER      PIC X(13) VALUE '450796   0047'.
194400         10  FILLER      PIC X(13) VALUE '450797   0006'.
194500         10  FILLER      PIC X(13) VALUE '450803   1375'.
194600         10  FILLER      PIC X(13) VALUE '450804   1105'.
194700         10  FILLER      PIC X(13) VALUE '450808   0156'.
194800         10  FILLER      PIC X(13) VALUE '450813   0358'.
194900         10  FILLER      PIC X(13) VALUE '450822   0990'.
195000         10  FILLER      PIC X(13) VALUE '450825   0293'.
195100         10  FILLER      PIC X(13) VALUE '450827   0930'.
195200         10  FILLER      PIC X(13) VALUE '450828   1505'.
195300         10  FILLER      PIC X(13) VALUE '450831   0049'.
195400         10  FILLER      PIC X(13) VALUE '450833   0935'.
195500         10  FILLER      PIC X(13) VALUE '450834   0196'.
195600         10  FILLER      PIC X(13) VALUE '450839   0445'.
195700         10  FILLER      PIC X(13) VALUE '450840   1076'.
195800         10  FILLER      PIC X(13) VALUE '450841   0395'.
195900         10  FILLER      PIC X(13) VALUE '450845   0341'.
196000         10  FILLER      PIC X(13) VALUE '450848   1115'.
196100         10  FILLER      PIC X(13) VALUE '450851   1237'.
196200         10  FILLER      PIC X(13) VALUE '450853   0490'.
196300         10  FILLER      PIC X(13) VALUE '450856   0362'.
196400         10  FILLER      PIC X(13) VALUE '450860   0110'.
196500         10  FILLER      PIC X(13) VALUE '450864   0792'.
196600         10  FILLER      PIC X(13) VALUE '450865   0153'.
196700         10  FILLER      PIC X(13) VALUE '450871   0318'.
196800         10  FILLER      PIC X(13) VALUE '450872   0588'.
196900         10  FILLER      PIC X(13) VALUE '450874   0052'.
197000         10  FILLER      PIC X(13) VALUE '450875   0538'.
197100         10  FILLER      PIC X(13) VALUE '450877   1197'.
197200         10  FILLER      PIC X(13) VALUE '450880   0361'.
197300         10  FILLER      PIC X(13) VALUE '450883   0050'.
197400         10  FILLER      PIC X(13) VALUE '450884   0426'.
197500         10  FILLER      PIC X(13) VALUE '450886   0034'.
197600         10  FILLER      PIC X(13) VALUE '450888   0342'.
197700         10  FILLER      PIC X(13) VALUE '450889   0040'.
197800         10  FILLER      PIC X(13) VALUE '450891   0105'.
197900         10  FILLER      PIC X(13) VALUE '450893   0098'.
198000         10  FILLER      PIC X(13) VALUE '450894   0192'.
198100         10  FILLER      PIC X(13) VALUE '460003   1352'.
198200         10  FILLER      PIC X(13) VALUE '460007   0802'.
198300         10  FILLER      PIC X(13) VALUE '460011   0730'.
198400         10  FILLER      PIC X(13) VALUE '460013   1075'.
198500         10  FILLER      PIC X(13) VALUE '460014   0639'.
198600         10  FILLER      PIC X(13) VALUE '460015   1478'.
198700         10  FILLER      PIC X(13) VALUE '460017   0248'.
198800         10  FILLER      PIC X(13) VALUE '460019   0332'.
198900         10  FILLER      PIC X(13) VALUE '460023   1393'.
199000         10  FILLER      PIC X(13) VALUE '460026   0360'.
199100         10  FILLER      PIC X(13) VALUE '460030   0356'.
199200         10  FILLER      PIC X(13) VALUE '460033   0179'.
199300         10  FILLER      PIC X(13) VALUE '460035   0135'.
199400         10  FILLER      PIC X(13) VALUE '460039   0128'.
199500         10  FILLER      PIC X(13) VALUE '460041   1450'.
199600         10  FILLER      PIC X(13) VALUE '460043   0006'.
199700         10  FILLER      PIC X(13) VALUE '460044   1304'.
199800         10  FILLER      PIC X(13) VALUE '460049   0639'.
199900         10  FILLER      PIC X(13) VALUE '460052   1150'.
200000         10  FILLER      PIC X(13) VALUE '460054   0309'.
200100         10  FILLER      PIC X(13) VALUE '460056   0077'.
200200         10  FILLER      PIC X(13) VALUE '460057   0269'.
200300         10  FILLER      PIC X(13) VALUE '460058   0224'.
200400         10  FILLER      PIC X(13) VALUE '470001   1427'.
200500         10  FILLER      PIC X(13) VALUE '470011   0857'.
200600         10  FILLER      PIC X(13) VALUE '470024   0842'.
200700         10  FILLER      PIC X(13) VALUE '480001   0982'.
200800         10  FILLER      PIC X(13) VALUE '480002   0971'.
200900         10  FILLER      PIC X(13) VALUE '490002   1518'.
201000         10  FILLER      PIC X(13) VALUE '490012   1578'.
201100         10  FILLER      PIC X(13) VALUE '490027   1124'.
201200         10  FILLER      PIC X(13) VALUE '490033   0978'.
201300         10  FILLER      PIC X(13) VALUE '490038   1285'.
201400         10  FILLER      PIC X(13) VALUE '490084   1108'.
201500         10  FILLER      PIC X(13) VALUE '490088   0941'.
201600         10  FILLER      PIC X(13) VALUE '490089   1096'.
201700         10  FILLER      PIC X(13) VALUE '490092   1325'.
201800         10  FILLER      PIC X(13) VALUE '490094   1004'.
201900         10  FILLER      PIC X(13) VALUE '490097   1323'.
202000         10  FILLER      PIC X(13) VALUE '490104   0002'.
202100         10  FILLER      PIC X(13) VALUE '490105   0025'.
202200         10  FILLER      PIC X(13) VALUE '490106   0004'.
202300         10  FILLER      PIC X(13) VALUE '490108   0040'.
202400         10  FILLER      PIC X(13) VALUE '490109   0092'.
202500         10  FILLER      PIC X(13) VALUE '490111   1184'.
202600         10  FILLER      PIC X(13) VALUE '490114   1308'.
202700         10  FILLER      PIC X(13) VALUE '490117   0557'.
202800         10  FILLER      PIC X(13) VALUE '490123   0941'.
202900         10  FILLER      PIC X(13) VALUE '490127   1128'.
203000         10  FILLER      PIC X(13) VALUE '490134   0012'.
203100         10  FILLER      PIC X(13) VALUE '490135   0212'.
203200         10  FILLER      PIC X(13) VALUE '490140   1157'.
203300         10  FILLER      PIC X(13) VALUE '490141   0278'.
203400         10  FILLER      PIC X(13) VALUE '490142   0002'.
203500         10  FILLER      PIC X(13) VALUE '500033   0940'.
203600         10  FILLER      PIC X(13) VALUE '500037   0393'.
203700         10  FILLER      PIC X(13) VALUE '500049   0714'.
203800         10  FILLER      PIC X(13) VALUE '500052   0003'.
203900         10  FILLER      PIC X(13) VALUE '500060   0699'.
204000         10  FILLER      PIC X(13) VALUE '500084   0661'.
204100         10  FILLER      PIC X(13) VALUE '500148   0345'.
204200         10  FILLER      PIC X(13) VALUE '510012   1556'.
204300         10  FILLER      PIC X(13) VALUE '510013   1377'.
204400         10  FILLER      PIC X(13) VALUE '510018   1015'.
204500         10  FILLER      PIC X(13) VALUE '510026   0011'.
204600         10  FILLER      PIC X(13) VALUE '510038   1479'.
204700         10  FILLER      PIC X(13) VALUE '510053   0523'.
204800         10  FILLER      PIC X(13) VALUE '510072   0689'.
204900         10  FILLER      PIC X(13) VALUE '510077   1183'.
205000         10  FILLER      PIC X(13) VALUE '510082   1021'.
205100         10  FILLER      PIC X(13) VALUE '510085   1576'.
205200         10  FILLER      PIC X(13) VALUE '510086   0304'.
205300         10  FILLER      PIC X(13) VALUE '520011   1274'.
205400         10  FILLER      PIC X(13) VALUE '520017   1029'.
205500         10  FILLER      PIC X(13) VALUE '520019   1162'.
205600         10  FILLER      PIC X(13) VALUE '520028   1470'.
205700         10  FILLER      PIC X(13) VALUE '520033   0983'.
205800         10  FILLER      PIC X(13) VALUE '520034   1179'.
205900         10  FILLER      PIC X(13) VALUE '520038   1068'.
206000         10  FILLER      PIC X(13) VALUE '520041   0898'.
206100         10  FILLER      PIC X(13) VALUE '520057   1075'.
206200         10  FILLER      PIC X(13) VALUE '520063   1396'.
206300         10  FILLER      PIC X(13) VALUE '520071   1318'.
206400         10  FILLER      PIC X(13) VALUE '520076   1229'.
206500         10  FILLER      PIC X(13) VALUE '520091   1311'.
206600         10  FILLER      PIC X(13) VALUE '520095   0986'.
206700         10  FILLER      PIC X(13) VALUE '520109   0954'.
206800         10  FILLER      PIC X(13) VALUE '520116   1023'.
206900         10  FILLER      PIC X(13) VALUE '520194   0295'.
207000         10  FILLER      PIC X(13) VALUE '520195   0001'.
207100         10  FILLER      PIC X(13) VALUE '520196   0117'.
207200         10  FILLER      PIC X(13) VALUE '520198   1299'.
207300         10  FILLER      PIC X(13) VALUE '520204   0377'.
207400         10  FILLER      PIC X(13) VALUE '520205   0412'.
207500         10  FILLER      PIC X(13) VALUE '520206   0356'.
207600         10  FILLER      PIC X(13) VALUE '530002   0661'.
207700         10  FILLER      PIC X(13) VALUE '530006   0963'.
207800         10  FILLER      PIC X(13) VALUE '530008   0613'.
207900         10  FILLER      PIC X(13) VALUE '530009   0275'.
208000         10  FILLER      PIC X(13) VALUE '530010   0677'.
208100         10  FILLER      PIC X(13) VALUE '530011   0520'.
208200         10  FILLER      PIC X(13) VALUE '530015   0555'.
208300         10  FILLER      PIC X(13) VALUE '530025   0780'.
208400         10  FILLER      PIC X(13) VALUE '530032   0388'.
208500         10  FILLER      PIC X(13) VALUE '530033   0420'.
208600         10  FILLER      PIC X(13) VALUE '640001   0384'.
208700         10  FILLER      PIC X(13) VALUE '650001   1489'.
208800         10  FILLER      PIC X(13) VALUE '660001   0377'.
208900         10  FILLER      PIC X(13) VALUE '670002   0856'.
209000         10  FILLER      PIC X(13) VALUE '670004   1018'.
209100         10  FILLER      PIC X(13) VALUE '670005   0048'.
209200         10  FILLER      PIC X(13) VALUE '670006   0586'.
209300         10  FILLER      PIC X(13) VALUE '670008   0248'.
209400         10  FILLER      PIC X(13) VALUE '670010   0006'.
209500         10  FILLER      PIC X(13) VALUE '670011   0340'.
209600         10  FILLER      PIC X(13) VALUE '670012   0790'.
209700         10  FILLER      PIC X(13) VALUE '670018   0092'.
209800         10  FILLER      PIC X(13) VALUE '670019   0710'.
209900         10  FILLER      PIC X(13) VALUE '670027   0034'.
210000         10  FILLER      PIC X(13) VALUE '670029   0107'.
210100         10  FILLER      PIC X(13) VALUE '670031   1594'.
210200         10  FILLER      PIC X(13) VALUE '670043   1016'.
210300         10  FILLER      PIC X(13) VALUE '670044   1433'.
210400         10  FILLER      PIC X(13) VALUE '670046   0176'.
210500         10  FILLER      PIC X(13) VALUE '670049   0231'.
210600         10  FILLER      PIC X(13) VALUE '670050   0396'.
210700         10  FILLER      PIC X(13) VALUE '670052   0451'.
210800         10  FILLER      PIC X(13) VALUE '670053   1348'.
210900         10  FILLER      PIC X(13) VALUE '670054   0133'.
211000         10  FILLER      PIC X(13) VALUE '670056   1264'.
211100         10  FILLER      PIC X(13) VALUE '670059   0296'.
211200         10  FILLER      PIC X(13) VALUE '670060   0816'.
211300         10  FILLER      PIC X(13) VALUE '670061   0136'.
211400         10  FILLER      PIC X(13) VALUE '670063   0074'.
211500         10  FILLER      PIC X(13) VALUE '670064   0047'.
211600         10  FILLER      PIC X(13) VALUE '670066   0047'.
211700         10  FILLER      PIC X(13) VALUE '670067   0088'.
211800         10  FILLER      PIC X(13) VALUE '670068   0178'.
211900         10  FILLER      PIC X(13) VALUE '670069   0010'.
212000         10  FILLER      PIC X(13) VALUE '670070   0008'.
212100         10  FILLER      PIC X(13) VALUE '670899   0142'.
212200      02  WK-LOWVOL-DATA2 REDEFINES LOWVOL-PROV-DISCHG-DATA.
212300         05  LOWVOL-TAB OCCURS 1276
212400                        ASCENDING KEY IS WK-LOWVOL-PROV
212500                        INDEXED BY LOWVOL-IDX.
212600           10  WK-LOWVOL-COUNT-ALL.
212700              15  WK-LOWVOL-PROV           PIC X(6).
212800              15  FILLER                   PIC XXX.
212900              15  WK-LOWVOL-PROV-DISCHG    PIC 9999.
213000
213100                                                                  20110000
213200*****YEARCHANGE 2012.0 ************************************       20110000
213300
213400
213500 01  MES-ADD-PROV                   PIC X(53) VALUE SPACES.
213600 01  MES-CHG-PROV                   PIC X(53) VALUE SPACES.
213700 01  MES-PPS-PROV                   PIC X(06).
213800 01  MES-PPS-STATE                  PIC X(02).
213900 01  MES-INTRO                      PIC X(53) VALUE SPACES.
214000 01  MES-TOT-PAY                    PIC 9(07)V9(02) VALUE 0.
214100 01  MES-SSRFBN.
214200     05 MES-SSRFBN-STATE PIC 99.
214300     05 FILLER           PIC XX.
214400     05 MES-SSRFBN-RATE  PIC 9(1)V9(5).
214500     05 FILLER           PIC XX.
214600     05 MES-SSRFBN-CODE2 PIC 99.
214700     05 FILLER           PIC XX.
214800     05 MES-SSRFBN-STNAM PIC X(20).
214900     05 MES-SSRFBN-REST  PIC X(22).
215000
215100                                                                  04620000
215200 01  MES-LOWVOL.
215300     05  MES-LOWVOL-PROV             PIC X(6).
215400     05  FILLER                      PIC XXX.
215500     05  MESWK-LOWVOL-PROV-DISCHG    PIC 9999.
215600
215700
215800 01  HOLD-AREA.                                                   04630000
215900     02  HOLD-PPS-COMPONENTS.                                     04640000
216000         05  H-OPER-SHARE-DOLL-THRESHOLD  PIC 9(07)V9(09).        04650000
216100         05  H-CAPI-SHARE-DOLL-THRESHOLD  PIC 9(07)V9(09).        04660000
216200                                                                  04670000
216300         05  H-OPER-HSP-PART              PIC 9(06)V9(09).        04680000
216400         05  H-CAPI-HSP-PART              PIC 9(06)V9(09).        04690000
216500                                                                  04700000
216600         05  H-OPER-FSP-PART              PIC 9(06)V9(09).        04710000
216700         05  H-CAPI-FSP-PART              PIC 9(06)V9(09).        04720000
216800         05  H-CAPI2-B-FSP-PART           PIC 9(06)V9(09).        04730000
216900                                                                  04740000
217000         05  H-OPER-OUTLIER-PART          PIC 9(07)V9(09).        04750000
217100         05  H-CAPI-OUTLIER-PART          PIC 9(07)V9(09).        04760000
217200         05  H-CAPI2-B-OUTLIER-PART       PIC 9(07)V9(09).        04770000
217300                                                                  04780000
217400         05  H-OPER-OUTDAY-PART           PIC 9(07)V9(09).        04790000
217500         05  H-CAPI-OUTDAY-PART           PIC 9(07)V9(09).        04800000
217600                                                                  04810000
217700         05  H-OPER-OUTCST-PART           PIC 9(07)V9(09).        04820000
217800         05  H-CAPI-OUTCST-PART           PIC 9(07)V9(09).        04830000
217900                                                                  04840000
218000         05  H-OPER-CSTCHG-RATIO          PIC 9(01)V9(03).        04850000
218100         05  H-CAPI-CSTCHG-RATIO          PIC 9(01)V9(03).        04860000
218200                                                                  04870000
218300         05  H-OPER-IME-TEACH             PIC 9(06)V9(09).        04880000
218400         05  H-CAPI-PAYCDE-PCT1           PIC 9(01)V9(02).        04890000
218500         05  H-CAPI-PAYCDE-PCT2           PIC 9(01)V9(02).        04900000
218600         05  H-CAPI-COST-OUTLIER          PIC 9(07)V9(09).        04910000
218700         05  H-CAPI-BILL-COSTS            PIC 9(07)V9(09).        04920000
218800         05  H-CAPI-DOLLAR-THRESHOLD      PIC 9(07)V9(09).        04930000
218900         05  H-CAPI-COLA                  PIC 9(01)V9(03).        04940000
219000         05  H-CAPI-SCH                   PIC 9(05)V9(02).        04950000
219100         05  H-CAPI-BUD-NEUTRALITY        PIC 9(01)V9(04).        04960000
219200         05  H-CAPI-OLD-HARMLESS          PIC 9(09)V9(02).        04970000
219300         05  H-CAPI-FED-RATE              PIC 9(05)V9(04).        04980000
219400         05  H-CAPI-FULL-PROS             PIC 9(05)V9(04).        04990000
219500         05  H-CAPI-LARG-URBAN            PIC 9(01)V9(02).        05000000
219600         05  H-CAPI-GAF                   PIC 9(05)V9(04).        05010000
219700         05  H-PR-CAPI-GAF                PIC 9(05)V9(04).        05020000
219800         05  H-BLEND-GAF                  PIC 9(05)V9(04).        05030000
219900         05  H-WAGE-INDEX                 PIC 9(02)V9(04).        05040000
220000         05  H-COV-DAYS                   PIC 9(3).               05050000
220100         05  H-PERDIEM-DAYS               PIC 9(3).               05060000
220200         05  H-REG-DAYS                   PIC 9(3).               05070000
220300         05  H-LTR-DAYS                   PIC 9(3).               05080000
220400         05  H-DSCHG-FRCTN                PIC 9(3)V9999.          05090000
220500         05  H-DRG-WT-FRCTN               PIC 9(2)V9999.          05100000
220600         05  H-ALOS                       PIC 9(02)V9(01).        05110000
220700         05  H-DAYS-CUTOFF                PIC 9(02)V9(01).        05120000
220800         05  H-DAYOUT-PCT                 PIC 9(01)V9(02).        05130000
220900         05  H-CSTOUT-PCT                 PIC 9(01)V9(02).        05140000
221000         05  H-CST-THRESH                 PIC 9(05)V9(02).        05150000
221100         05  H-PRE-CAPI-THRESH            PIC 9(05)V9(02).        05160000
221200         05  H-BUDG-NUTR01                PIC 9(01)V9(06).        05170000
221300         05  H-BUDG-NUTR02                PIC 9(01)V9(06).        05180000
221400         05  H-BUDG-NUTR03                PIC 9(01)V9(06).        05190000
221500         05  H-BUDG-NUTR04                PIC 9(01)V9(06).        05200000
221600         05  H-BUDG-NUTR05                PIC 9(01)V9(06).        05210000
221700         05  H-BUDG-NUTR06                PIC 9(01)V9(06).        05220000
221800         05  H-BUDG-NUTR07                PIC 9(01)V9(06).        05230000
221900         05  H-BUDG-NUTR08                PIC 9(01)V9(06).        05240000
222000         05  H-BUDG-NUTR09                PIC 9(01)V9(06).        05240000
222100         05  H-BUDG-NUTR10                PIC 9(01)V9(06).        05240000
222200         05  H-BUDG-NUTR109               PIC 9(01)V9(06).        05240000
222300         05  H-BUDG-NUTR113               PIC 9(01)V9(06).        05240000
222400         05  H-BUDG-NUTR120               PIC 9(01)V9(06).        05240000
222500         05  H-CASE-MIX-ADJ               PIC 9(01)V9(04).        05250000
222600         05  H-HSP-CAPECOD-ADJ            PIC 9(01)V9(04).        05250000
222700         05  H-UPDATE-01                  PIC 9(01)V9(04).        05250000
222800         05  H-UPDATE-02                  PIC 9(01)V9(04).        05260000
222900         05  H-UPDATE-03                  PIC 9(01)V9(04).        05270000
223000         05  H-UPDATE-04                  PIC 9(01)V9(04).        05280000
223100         05  H-UPDATE-05                  PIC 9(01)V9(04).        05290000
223200         05  H-UPDATE-06                  PIC 9(01)V9(04).        05300000
223300         05  H-UPDATE-07                  PIC 9(01)V9(04).        05310000
223400         05  H-UPDATE-08                  PIC 9(01)V9(04).        05320000
223500         05  H-UPDATE-09                  PIC 9(01)V9(04).        05320000
223600         05  H-UPDATE-10                  PIC 9(01)V9(04).        05320000
223700         05  H-UPDATE-109                 PIC 9(01)V9(04).        05320000
223800         05  H-UPDATE-113                 PIC 9(01)V9(04).        05320000
223900         05  H-UPDATE-120                 PIC 9(01)V9(04).        05320000
224000         05  H-ACCUM-TO-HSP               PIC 9(01)V9(04).        05330000
224100         05  H-HSP-UPDATE94               PIC 9(01)V9(04).        05340000
224200         05  H-HSP-UPDATE95               PIC 9(01)V9(04).        05350000
224300         05  H-HSP-UPDATE96               PIC 9(01)V9(04).        05360000
224400         05  H-HSP-UPDATE97               PIC 9(01)V9(04).        05370000
224500         05  H-HSP-UPDATE98               PIC 9(01)V9(04).        05380000
224600         05  H-HSP-UPDATE99               PIC 9(01)V9(04).        05390000
224700         05  H-HSP-UPDATE00               PIC 9(01)V9(04).        05400000
224800         05  H-HSP-UPDATE01               PIC 9(01)V9(04).        05410000
224900         05  H-PUERTO-RICO-RATE           PIC 9(04)V9(02).        05420000
225000         05  H-FEDERAL-RATE               PIC 9(04)V9(02).        05430000
225100         05  H-LABOR-PCT                  PIC 9(01)V9(04).        05440000
225200         05  H-NONLABOR-PCT               PIC 9(01)V9(04).        05450000
225300         05  H-PR-LABOR-PCT               PIC 9(01)V9(04).        05460000
225400         05  H-PR-NONLABOR-PCT            PIC 9(01)V9(04).        05470000
225500         05  H-HSP-RATE                   PIC 9(08)V9(09).        05480000
225600         05  H-FSP-RATE                   PIC 9(08)V9(09).        05490000
225700         05  H-OUTLIER-OFFSET-NAT         PIC 9(01)V9(06).        05500000
225800         05  H-OUTLIER-OFFSET-PR          PIC 9(01)V9(06).        05510000
225900         05  H-WK-OPER-DSH                PIC 9(01)V9(04).        05520000
226000         05  H-WK-CAPI-IME-TEACH          PIC 9(06)V9(09).        05530000
226100         05  H-OPER-PR-DOLLAR-THRESHOLD   PIC 9(07)V9(09).        05540000
226200         05  H-CAPI-PR-DOLLAR-THRESHOLD   PIC 9(07)V9(09).        05550000
226300         05  H-DSH-REDUCT-FACTOR          PIC 9(01)V9(04).        05560000
226400         05  H-WK-PASS-AMT-PLUS-MISC      PIC 9(06)V99.           05570000
226500         05  H-BASE-DRG-PAYMENT           PIC S9(07)V99.          05580000
226600         05  H-NEW-TECH-ADDON-NEURO       PIC S9(07)V99.          05590000
226700         05  H-NEW-TECH-ADDON-GRAFT       PIC S9(07)V99.          05600000
226800         05  H-NEW-TECH-ADDON-X-STOP      PIC S9(07)V99.          05610000
226900         05  H-NEW-TECH-ADDON-HRTIMP-STOP PIC S9(07)V99.          05610000
227000         05  H-NEW-TECH-ADDON-ISLET       PIC S9(07)V99.          05620000
227100         05  H-NEW-TECH-ADDON-SPIRAT-STOP PIC S9(07)V99.          05620000
227200         05  H-NEW-TECH-ADDON-AUTOLITT-STOP PIC S9(07)V99.        05620000
227300         05  H-TECH-ADDON-ISLET-CNTR      PIC S9(02).             05630000
227400         05  H-TECH-ADDON-ISLET-CNTR2     PIC S9(02).             05631000
227500                                                                  05632000
227600         05  H-LESSER-NEURO-1             PIC S9(07)V99.          05633000
227700         05  H-LESSER-NEURO-2             PIC S9(07)V99.          05634000
227800                                                                  05635000
227900         05  H-LESSER-GRAFT-1             PIC S9(07)V99.          05636000
228000         05  H-LESSER-GRAFT-2             PIC S9(07)V99.          05637000
228100                                                                  05638000
228200         05  H-LESSER-X-STOP-1            PIC S9(07)V99.          05639000
228300         05  H-LESSER-X-STOP-2            PIC S9(07)V99.          05640000
228400
228500         05  H-LESSER-HRTIMP-STOP-1       PIC S9(07)V99.
228600         05  H-LESSER-HRTIMP-STOP-2       PIC S9(07)V99.
228700                                                                  05660000
228800         05  H-LESSER-SPIRAT-STOP-1       PIC S9(07)V99.
228900         05  H-LESSER-SPIRAT-STOP-2       PIC S9(07)V99.
229000                                                                  05660000
229100         05  H-LESSER-AUTOLITT-STOP-1     PIC S9(07)V99.
229200         05  H-LESSER-AUTOLITT-STOP-2     PIC S9(07)V99.
229300                                                                  05660000
229400         05  H-CSTMED-NEURO               PIC S9(07)V99.          05670000
229500         05  H-CSTMED-GRAFT               PIC S9(07)V99.          05680000
229600         05  H-CSTMED-X-STOP              PIC S9(07)V99.          05690000
229700         05  H-CSTMED-HRTIMP-STOP         PIC S9(07)V99.          05690000
229800         05  H-CSTMED-SPIRAT-STOP         PIC S9(07)V99.          05690000
229900         05  H-CSTMED-AUTOLITT-STOP       PIC S9(07)V99.          05690000
230000                                                                  05700000
230100                                                                  05710000
230200     02  HOLD-ADDITIONAL-VARIABLES.                               05720000
230300         05  H-OPER-HSP-PCT               PIC 9(01)V9(02).        05730000
230400         05  H-OPER-FSP-PCT               PIC 9(01)V9(02).        05740000
230500         05  H-NAT-PCT                    PIC 9(01)V9(02).        05750000
230600         05  H-REG-PCT                    PIC 9(01)V9(02).        05760000
230700         05  H-FAC-SPEC-RATE              PIC 9(05)V9(02).        05770000
230800         05  H-UPDATE-FACTOR              PIC 9(01)V9(05).        05780000
230900         05  H-DRG-WT                     PIC 9(02)V9(04).        05790000
231000         05  H-NAT-LABOR                  PIC 9(05)V9(02).        05800000
231100         05  H-NAT-NONLABOR               PIC 9(05)V9(02).        05810000
231200         05  H-REG-LABOR                  PIC 9(05)V9(02).        05820000
231300         05  H-REG-NONLABOR               PIC 9(05)V9(02).        05830000
231400         05  H-OPER-COLA                  PIC 9(01)V9(03).        05840000
231500         05  H-INTERN-RATIO               PIC 9(01)V9(04).        05850000
231600         05  H-OPER-COST-OUTLIER          PIC 9(07)V9(09).        05860000
231700         05  H-OPER-BILL-COSTS            PIC 9(07)V9(09).        05870000
231800         05  H-OPER-DOLLAR-THRESHOLD      PIC 9(07)V9(09).        05880000
231900                                                                  05890000
232000     02  HOLD-CAPITAL-VARIABLES.                                  05900000
232100         05  H-CAPI-TOTAL-PAY             PIC 9(07)V9(02).        05910000
232200         05  H-CAPI-HSP                   PIC 9(07)V9(02).        05920000
232300         05  H-CAPI-FSP                   PIC 9(07)V9(02).        05930000
232400         05  H-CAPI-OUTLIER               PIC 9(07)V9(02).        05940000
232500         05  H-CAPI-OLD-HARM              PIC 9(07)V9(02).        05950000
232600         05  H-CAPI-DSH-ADJ               PIC 9(07)V9(02).        05960000
232700         05  H-CAPI-IME-ADJ               PIC 9(07)V9(02).        05970000
232800         05  H-CAPI-EXCEPTIONS            PIC 9(07)V9(02).        05980000
232900                                                                  05990000
233000     02  HOLD-CAPITAL2-VARIABLES.                                 06000000
233100         05  H-CAPI2-PAY-CODE             PIC X(1).               06010000
233200         05  H-CAPI2-B-FSP                PIC 9(07)V9(02).        06020000
233300         05  H-CAPI2-B-OUTLIER            PIC 9(07)V9(02).        06030000
233400                                                                  06040000
233500     02  HOLD-OTHER-VARIABLES.                                    06050000
233600         05  H-NON-TEMP-RELIEF-PAYMENT    PIC 9(07)V9(02).        06060000
233700         05  H-NEW-TECH-PAY-ADD-ON        PIC 9(07)V9(02).        06070000
233800         05  H-LOW-VOL-PAYMENT            PIC 9(07)V9(02).
233900         05  H-VAL-BASED-PURCH-PARTIPNT   PIC X.
234000         05  H-VAL-BASED-PURCH-ADJUST     PIC 9V9(11).
234100         05  H-HOSP-READMISSION-REDU      PIC X.
234200         05  H-HOSP-HRR-ADJUSTMT          PIC 9V9(4).
234300         05  H-OPERATNG-DATA.
234400             10  H-MODEL1-BUNDLE-DISPRCNT    PIC V999.
234500             10  H-OPER-BASE-DRG-PAY         PIC 9(08)V99.
234600             10  H-OPER-HSP-AMT              PIC 9(08)V99.
234700                                                                  06090000
234800     02  HOLD-PC-OTH-VARIABLES.                                   06100000
234900         05  H-OPER-DSH                   PIC 9(01)V9(04).        06110000
235000         05  H-CAPI-DSH                   PIC 9(01)V9(04).        06120000
235100         05  H-CAPI-HSP-PCT               PIC 9(01)V9(02).        06130000
235200         05  H-CAPI-FSP-PCT               PIC 9(01)V9(04).        06140000
235300         05  H-ARITH-ALOS                 PIC 9(02)V9(01).        06150000
235400         05  H-PR-WAGE-INDEX              PIC 9(02)V9(04).        06160000
235500         05  H-TRANSFER-ADJ               PIC 9(01)V9(05).        06170000
235600         05  H-PC-HMO-FLAG                PIC X(01).              06180000
235700         05  H-PC-COT-FLAG                PIC X(01).              06190000
235800         05  H-FILLER                     PIC X(0998).
235900                                                                  06210000
236000 01  HLD-PPS-DATA.                                                06220000
236100         10  HLD-PPS-RTC                PIC 9(02).                06230000
236200         10  HLD-PPS-WAGE-INDX          PIC 9(02)V9(04).          06240000
236300         10  HLD-PPS-OUTLIER-DAYS       PIC 9(03).                06250000
236400         10  HLD-PPS-AVG-LOS            PIC 9(02)V9(01).          06260000
236500         10  HLD-PPS-DAYS-CUTOFF        PIC 9(02)V9(01).          06270000
236600         10  HLD-PPS-OPER-IME-ADJ       PIC 9(06)V9(02).          06280000
236700         10  HLD-PPS-TOTAL-PAYMENT      PIC 9(07)V9(02).          06290000
236800         10  HLD-PPS-OPER-HSP-PART      PIC 9(06)V9(02).          06300000
236900         10  HLD-PPS-OPER-FSP-PART      PIC 9(06)V9(02).          06310000
237000         10  HLD-PPS-OPER-OUTLIER-PART  PIC 9(07)V9(02).          06320000
237100         10  HLD-PPS-REG-DAYS-USED      PIC 9(03).                06330000
237200         10  HLD-PPS-LTR-DAYS-USED      PIC 9(02).                06340000
237300         10  HLD-PPS-OPER-DSH-ADJ       PIC 9(06)V9(02).          06350000
237400         10  HLD-PPS-CALC-VERS          PIC X(05).                06360000
237500                                                                  06370000
237600 LINKAGE SECTION.                                                 06380000
237700***************************************************************   06390000
237800*                 * * * * * * * * *                           *   06400000
237900*    REVIEW CODES ARE USED TO DIRECT THE PPCAL  SUBROUTINE    *   06410000
238000*    IN HOW TO PAY THE BILL.                                  *   06420000
238100*                         *****                               *   06430000
238200*    COMMENTS  ** CLAIMS RECEIVED WITH CONDITION CODE 66      *   06440000
238300*                 SHOULD BE PROCESSED UNDER REVIEW CODE 06,   *   06450000
238400*                 07 OR 11 AS APPROPRIATE TO EXCLUDE ANY      *   06460000
238500*                 OUTLIER COMPUTATION.                        *   06470000
238600*                         *****                               *   06480000
238700*         REVIEW-CODE:                                        *   06490000
238800*            00 = PAY-WITH-OUTLIER.                           *   06500000
238900*                 WILL CALCULATE THE STANDARD PAYMENT.        *   06510000
239000*                 WILL ALSO ATTEMPT TO PAY ONLY COST          *   06520000
239100*                 OUTLIERS, DAY OUTLIERS EXPIRED 10/01/97     *   06530000
239200*            03 = PAY-PERDIEM-DAYS.                           *   06540000
239300*                 WILL CALCULATE A PERDIEM PAYMENT BASED ON   *   06550000
239400*                 THE STANDARD PAYMENT IF THE COVERED DAYS    *   06560000
239500*                 ARE LESS THAN THE AVERAGE LENGTH OF STAY    *   06570000
239600*                 FOR THE DRG. IF COVERED DAYS EQUAL OR       *   06580000
239700*                 EXCEED THE AVERAGE LENGTH OF STAY, THE      *   06590000
239800*                 STANDARD PAYMENT IS CALCULATED. WILL ALSO   *   06600000
239900*                 CALCULATE THE COST OUTLIER PORTION OF THE   *   06610000
240000*                 PAYMENT IF THE ADJUSTED CHARGES ON THE      *   06620000
240100*                 BILL EXCEED THE COST THRESHOLD.             *   06630000
240200*            06 = PAY-XFER-NO-COST                            *   06640000
240300*                 WILL CALCULATE A PERDIEM PAYMENT BASED ON   *   06650000
240400*                 THE STANDARD PAYMENT IF THE COVERED DAYS    *   06660000
240500*                 ARE LESS THAN THE AVERAGE LENGTH OF STAY    *   06670000
240600*                 FOR THE DRG.  IF COVERED DAYS EQUAL OR      *   06680000
240700*                 EXCEED THE AVERAGE LENGTH OF STAY, THE      *   06690000
240800*                 STANDARD PAYMENT IS CALCULATED. WILL NOT    *   06700000
240900*                 CALCULATE ANY COST OUTLIER PORTION          *   06710000
241000*                 OF THE PAYMENT.                             *   06720000
241100*            07 = PAY-WITHOUT-COST.                           *   06730000
241200*                 WILL CALCULATE THE STANDARD PAYMENT         *   06740000
241300*                 WITHOUT COST PORTION.                       *   06750000
241400*            09 = PAY-XFER-SPEC-DRG - POST-ACUTE TRANSFERS    *   06760000
241500*                 50-50> 28  29  30  40  41  42  219              06770000
241600*                        220 221 477 478 479 480 481              06780000
241700*                        482 492 493 494 500 501 502              06790000
241800*                        515 516 517 495 496 497                  06800000
241900* =======================================================         06801000
242000* THE 50/50 DRG'S DO NOT REPEAT WITH THE FULL PERDIEM DRG'S       06801000
242100* =======================================================         06801000
242200*                                                                 06801000
242300*                                                                 06801000
242400*     FULL PERDIEM >   3   4   25  26  27  28          31         06802000
242500*                      32  33              54  55  56  57         06803000
242600*                      64  65  66  70  71  72  85  86  87         06804000
242700*                      91  92  93  100 101 163 164 165 166        06805000
242800*                      167 168 175 176 177 178 179 186 187        06806000
242900*                      188 190 191 192 193 194 195 196 197        06807000
243000*                      198 205 206 207 216 217 218                06808000
243100*                          228 229 230 233 234 235 236 239        06809000
243200*                      240 241 242 243 244 255 256 257 264        06809100
243300*                      280 281 282 288 289 290 291 292 293        06809200
243400*                      299 300 301 314 315 316 326 327 328        06809300
243500*                      329 330 331 332 333 334 335 336 337        06809400
243600*                      356 357 358 371 372 373 374 375 376        06809500
243700*                      377 378 379 380 381 382 388 389 390        06809600
243800*                      405 406 407 414 415 416 441 442 443        06809700
243900*                      459 460 463 464 465 466 467 468 469        06809800
244000*                      470 474 475 476                            06809900
244100*                          483 484 488 489                        06810000
244200*                                          510 511 512            06810100
244300*                              533 534 535 536 539 540 541        06810200
244400*                      542 543 544 545 546 547 551 552 557        06810300
244500*                      558 559 560 561 562 563 573 574 575        06810400
244600*                      579 580 581 592 593 594 602 603 616        06810500
244700*                      617 618 622 623 624 628 629 630 637        06810600
244800*                      638 639 640 641 643 644 645 653 654        06810700
244900*                      655 659 660 661 682 683 684 689 690        06810800
245000*                      698 699 700 840 841 842 853 854 855        06810900
245100*                      856 857 858 862 863 867 868 869 870        06811000
245200*                      871 872 884 896 897 907 908 909 917        06811100
245300*                      918 945 946 947 948 956 981 982 983        06811200
245400*                      987 988 989                                06811300
245500*                                                                 06811400
245600*                               POST-ACUTE TRANSFERS          *   06811500
245700*                 WILL CALCULATE A PERDIEM PAYMENT BASED ON   *   06811600
245800*                 THE STANDARD DRG PAYMENT IF THE COVERED DAYS*   06811700
245900*                 ARE LESS THAN THE AVERAGE LENGTH OF STAY    *   06811800
246000*                 FOR THE DRG. IF COVERED DAYS EQUAL OR       *   06811900
246100*                 EXCEED THE AVERAGE LENGTH OF STAY, THE      *   06812000
246200*                 STANDARD PAYMENT IS CALCULATED. WILL ALSO   *   06813000
246300*                 CALCULATE THE COST OUTLIER PORTION OF THE   *   06814000
246400*                 PAYMENT IF THE ADJUSTED CHARGES ON THE      *   06815000
246500*                 BILL EXCEED THE COST THRESHOLD.             *   06816000
246600*            11 = PAY-XFER-SPEC-DRG-NO-COST                   *   06817000
246700*                 POST-ACUTE TRANSFERS                        *   06818000
246800*                 50-50> 28  29  30  40  41  42  219              06819000
246900*                        216 217 218                              07530000
247000*                        220 221 477 478 479 480 481              06820000
247100*                        482 492 493 494 500 501 502              06830000
247200*                        515 516 517 495 496 497                  06840000
247300*                                                                 06850000
247400* =======================================================         06801000
247500* THE 50/50 DRG'S DO NOT REPEAT WITH THE FULL PERDIEM DRG'S       06801000
247600* =======================================================         06801000
247700*                                                                 06860000
247800*     FULL PERDIEM >     3   4   25  26  27              31       06870000
247900*                        32  33              54  55  56  57       06880000
248000*                        64  65  66  70  71  72  85  86  87       06890000
248100*                        91  92  93  100 101 163 164 165 166      06900000
248200*                        167 168 175 176 177 178 179 186 187      06910000
248300*                        188 190 191 192 193 194 195 196 197      06920000
248400*                        198 205 206 207                          06930000
248500*                            228 229 230 233 234 235 236 239      06940000
248600*                        240 241 242 243 244 255 256 257 264      06950000
248700*                        280 281 282 288 289 290 291 292 293      06960000
248800*                        299 300 301 314 315 316 326 327 328      06970000
248900*                        329 330 331 332 333 334 335 336 337      06980000
249000*                        356 357 358 371 372 373 374 375 376      06990000
249100*                        377 378 379 380 381 382 388 389 390      07000000
249200*                        405 406 407 414 415 416 441 442 443      07010000
249300*                        459 460 463 464 465 466 467 468 469      07020000
249400*                        470 474 475 476                          07030000
249500*                            483 484 488 489                      07040000
249600*                                            510 511 512          07050000
249700*                                533 534 535 536 539 540 541      07060000
249800*                        542 543 544 545 546 547 551 552 557      07070000
249900*                        558 559 560 561 562 563 573 574 575      07080000
250000*                        579 580 581 592 593 594 602 603 616      07090000
250100*                        617 618 622 623 624 628 629 630 637      07100000
250200*                        638 639 640 641 643 644 645 653 654      07110000
250300*                        655 659 660 661 682 683 684 689 690      07120000
250400*                        698 699 700 840 841 842 853 854 855      07130000
250500*                        856 857 858 862 863 867 868 869 870      07140000
250600*                        871 872 884 896 897 907 908 909 917      07150000
250700*                        918 945 946 947 948 956 981 982 983      07160000
250800*                        987 988 989                              07170000
250900*                                                                 07180000
251000*                                                                 07190000
251100*                               POST-ACUTE TRANSFERS          *   07200000
251200*                 WILL CALCULATE A PERDIEM PAYMENT BASED ON   *   07210000
251300*                 THE STANDARD DRG PAYMENT IF THE COVERED DAYS*   07220000
251400*                 ARE LESS THAN THE AVERAGE LENGTH OF STAY    *   07230000
251500*                 FOR THE DRG. IF COVERED DAYS EQUAL OR       *   07240000
251600*                 EXCEED THE AVERAGE LENGTH OF STAY, THE      *   07250000
251700*                 STANDARD PAYMENT IS CALCULATED. WILL NOT    *   07260000
251800*                 CALCULATE THE COST OUTLIER PORTION OF THE   *   07270000
251900*                 PAYMENT.                                    *   07280000
252000***************************************************************   07290000
252100                                                                  07300000
252200**************************************************************    07310000
252300*      MILLINNIUM COMPATIBLE                                 *    07320000
252400*      THIS IS THE BILL-RECORD THAT WILL BE PASSED BACK FROM *    07330000
252500*      THE PPCAL001 PROGRAM AND AFTER FOR PROCESSING         *    07340000
252600*      IN THE NEW FORMAT                                     *    07350000
252700**************************************************************    07360000
252800 01  BILL-NEW-DATA.                                               07370000
252900         10  B-NPI10.                                             07380000
253000             15  B-NPI8             PIC X(08).                    07390000
253100             15  B-NPI-FILLER       PIC X(02).                    07400000
253200         10  B-PROVIDER-NO          PIC X(06).                    07410000
253300         10  B-REVIEW-CODE          PIC 9(02).                    07420000
253400             88  VALID-REVIEW-CODE    VALUE 00 03 06 07 09 11.    07430000
253500             88  PAY-WITH-OUTLIER     VALUE 00 07.                07440000
253600             88  PAY-PERDIEM-DAYS     VALUE 03.                   07450000
253700             88  PAY-XFER-NO-COST     VALUE 06.                   07460000
253800             88  PAY-WITHOUT-COST     VALUE 07.                   07470000
253900             88  PAY-XFER-SPEC-DRG    VALUE 09 11.                07480000
254000             88  PAY-XFER-SPEC-DRG-NO-COST VALUE 11.              07490000
254100         10  B-DRG                  PIC 9(03).                    07500000
254200             88  B-DRG-POSTACUTE-50-50                            07510000
254300                   VALUE 28  29  30  40  41  42  219              07520000
254400                         216 217 218                              07530000
254500                         220 221 477 478 479 480 481              07530000
254600                         482 492 493 494 495 496 497
254700                         500 501 502 515 516 517.                 07550000
254800                                                                  07560000
254900             88  B-DRG-SPIRATN-DRG                                07510000
255000                   VALUE 163 164 165.                             07520000
255100                                                                  07560000
255200             88  B-DRG-SPIRATN-DRG11                              07510000
255300                   VALUE 199 200 201.                             07520000
255400                                                                  07560000
255500                                                                  07560000
255600             88  B-DRG-AUTOLITT-DRG                               07510000
255700                   VALUE 25 26 27.                                07520000
255800                                                                  07560000
255900* =======================================================         06801000
256000* THE 50/50 DRG'S DO NOT REPEAT WITH THE POSTACUTE  DRG'S         06801000
256100* =======================================================         06801000
256200*                                                                 06860000
256300             88  B-DRG-POSTACUTE-PERDIEM                          07570000
256400                   VALUE 3   4   25  26  27  23  24      31       07580000
256500                         32  33              54  55  56  57       07590000
256600                         64  65  66  70  71  72  85  86  87       07600000
256700                         91  92  93  100 101 163 164 165 166      07610000
256800                         167 168 175 176 177 178 179 186 187      07620000
256900                         188 190 191 192 193 194 195 196 197      07630000
257000                         198 205 206 207                          07640000
257100                                         233 234 235 236 239      07650000
257200                         240 241 242 243 244 255 256 257 264      07660000
257300                         280 281 282 288 289 290 291 292 293      07670000
257400                         299 300 301 314 315 316 326 327 328      07680000
257500                         329 330 331 332 333 334 335 336 337      07690000
257600                         356 357 358 371 372 373 374 375 376      07700000
257700                         377 378 379 380 381 382 388 389 390      07710000
257800                         405 406 407 414 415 416 441 442 443      07720000
257900                         459 460 463 464 465 466 467 468 469      07730000
258000                         470 474 475 476                          07740000
258100                             483 484 488 489                      07750000
258200                                             510 511 512          07760000
258300                                             570 571 572          07760000
258400                                 533 534 535 536 539 540 541      07770000
258500                         542 543 544 545 546 547 551 552 557      07780000
258600                         558 559 560 561 562 563 573 574 575      07790000
258700                         579 580 581 592 593 594 602 603 616      07800000
258800                         617 618 622 623 624 628 629 630 637      07810000
258900                         638 639 640 641 643 644 645 653 654      07820000
259000                         655 659 660 661 682 683 684 689 690      07830000
259100                         698 699 700 840 841 842 853 854 855      07840000
259200                         856 857 858 862 863 867 868 869 870      07850000
259300                         871 872 884 896 897 907 908 909 917      07860000
259400                         918 945 946 947 948 956 981 982 983      07870000
259500                         987 988 989.                             07880000
259600                                                                  07890000
259700         10  B-LOS                  PIC 9(03).                    07900000
259800         10  B-COVERED-DAYS         PIC 9(03).                    07910000
259900         10  B-LTR-DAYS             PIC 9(02).                    07920000
260000         10  B-DISCHARGE-DATE.                                    07930000
260100             15  B-DISCHG-CC        PIC 9(02).                    07940000
260200             15  B-DISCHG-YY        PIC 9(02).                    07950000
260300             15  B-DISCHG-MM        PIC 9(02).                    07960000
260400             15  B-DISCHG-DD        PIC 9(02).                    07970000
260500         10  B-CHARGES-CLAIMED      PIC 9(07)V9(02).              07980000
260600         10  B-PRIN-PROC-CODE       PIC X(07).                    07990000
260700         10  B-OTHER-PROC-CODE1     PIC X(07).                    08000000
260800         10  B-OTHER-PROC-CODE2     PIC X(07).                    08010000
260900         10  B-OTHER-PROC-CODE3     PIC X(07).                    08020000
261000         10  B-OTHER-PROC-CODE4     PIC X(07).                    08030000
261100         10  B-OTHER-PROC-CODE5     PIC X(07).                    08040000
261200         10  B-OTHER-PROC-CODE6     PIC X(07).
261300         10  B-OTHER-PROC-CODE7     PIC X(07).
261400         10  B-OTHER-PROC-CODE8     PIC X(07).
261500         10  B-OTHER-PROC-CODE9     PIC X(07).
261600         10  B-OTHER-PROC-CODE10    PIC X(07).
261700         10  B-OTHER-PROC-CODE11    PIC X(07).
261800         10  B-OTHER-PROC-CODE12    PIC X(07).
261900         10  B-OTHER-PROC-CODE13    PIC X(07).
262000         10  B-OTHER-PROC-CODE14    PIC X(07).
262100         10  B-OTHER-PROC-CODE15    PIC X(07).
262200         10  B-OTHER-PROC-CODE16    PIC X(07).
262300         10  B-OTHER-PROC-CODE17    PIC X(07).
262400         10  B-OTHER-PROC-CODE18    PIC X(07).
262500         10  B-OTHER-PROC-CODE19    PIC X(07).
262600         10  B-OTHER-PROC-CODE20    PIC X(07).
262700         10  B-OTHER-PROC-CODE21    PIC X(07).
262800         10  B-OTHER-PROC-CODE22    PIC X(07).
262900         10  B-OTHER-PROC-CODE23    PIC X(07).
263000         10  B-OTHER-PROC-CODE24    PIC X(07).
263100         10  B-OTHER-DIAG-CODE1     PIC X(07).                    06012000
263200             88  B-DIAG-AUTOLITT-DIAG                             07510000
263300                   VALUE '1910   ' '1911   ' '1912   ' '1913  '
263400                         '1914   ' '1916   ' '1917   ' '1918  '
263500                         '1919   ' '1915   '.                     07560000
263600         10  B-OTHER-DIAG-CODE2     PIC X(07).                    06013000
263700         10  B-OTHER-DIAG-CODE3     PIC X(07).                    06014000
263800         10  B-OTHER-DIAG-CODE4     PIC X(07).                    06015000
263900         10  B-OTHER-DIAG-CODE5     PIC X(07).                    06016000
264000         10  B-OTHER-DIAG-CODE6     PIC X(07).                    06017000
264100         10  B-OTHER-DIAG-CODE7     PIC X(07).                    06018000
264200         10  B-OTHER-DIAG-CODE8     PIC X(07).                    06019000
264300         10  B-OTHER-DIAG-CODE9     PIC X(07).                    06019100
264400         10  B-OTHER-DIAG-CODE10    PIC X(07).                    06019200
264500         10  B-OTHER-DIAG-CODE11    PIC X(07).                    06019300
264600         10  B-OTHER-DIAG-CODE12    PIC X(07).                    06019400
264700         10  B-OTHER-DIAG-CODE13    PIC X(07).                    06019500
264800         10  B-OTHER-DIAG-CODE14    PIC X(07).                    06019600
264900         10  B-OTHER-DIAG-CODE15    PIC X(07).                    06019700
265000         10  B-OTHER-DIAG-CODE16    PIC X(07).                    06019800
265100         10  B-OTHER-DIAG-CODE17    PIC X(07).                    06019900
265200         10  B-OTHER-DIAG-CODE18    PIC X(07).                    06020000
265300         10  B-OTHER-DIAG-CODE19    PIC X(07).                    06020100
265400         10  B-OTHER-DIAG-CODE20    PIC X(07).                    06020200
265500         10  B-OTHER-DIAG-CODE21    PIC X(07).                    06020300
265600         10  B-OTHER-DIAG-CODE22    PIC X(07).                    06020400
265700         10  B-OTHER-DIAG-CODE23    PIC X(07).                    06020500
265800         10  B-OTHER-DIAG-CODE24    PIC X(07).                    06020600
265900         10  B-OTHER-DIAG-CODE25    PIC X(07).                    06020700
266000         10  BILL-DEMO-DATA.
266100             15  BILL-DEMO-CODE1        PIC X(02).
266200             15  BILL-DEMO-CODE2        PIC X(02).
266300             15  BILL-DEMO-CODE3        PIC X(02).
266400             15  BILL-DEMO-CODE4        PIC X(02).
266500         10  BILL-NDC-DATA.
266600             15  BILL-NDC-NUMBER        PIC X(11).
266700         10  FILLER                     PIC X(73).
266800                                                                  06020800
266900                                                                  08050000
267000***************************************************************   08060000
267100*    THIS DATA IS CALCULATED BY THIS PPCAL  SUBROUTINE        *   08070000
267200*    AND PASSED BACK TO THE CALLING PROGRAM                   *   08080000
267300*            RETURN CODE VALUES (PPS-RTC)                     *   08090000
267400*                                                             *   08100000
267500*            PPS-RTC 00-49 = HOW THE BILL WAS PAID            *   08110000
267600*                                                             *   08120000
267700*      PPS-RTC 30,33,40,42,44  = OUTLIER RECONCILIATION       *   08130000
267800*                                                             *   08140000
267900*           30,00 = PAID NORMAL DRG PAYMENT                   *   08150000
268000*                                                             *   08160000
268100*              01 = PAID AS A DAY-OUTLIER.                    *   08170000
268200*                   NOTE:                                     *   08180000
268300*                     DAY-OUTLIER NO LONGER BEING PAID        *   08190000
268400*                         AS OF 10/01/97                      *   08200000
268500*                                                             *   08210000
268600*              02 = PAID AS A COST-OUTLIER.                   *   08220000
268700*                                                             *   08230000
268800*           33,03 = TRANSFER PAID ON A PERDIEM BASIS UP TO    *   08240000
268900*                   AND INCLUDING THE FULL DRG.               *   08250000
269000*              05 = TRANSFER PAID ON A PERDIEM BASIS UP TO    *   08260000
269100*                   AND INCLUDING THE FULL DRG WHICH ALSO     *   08270000
269200*                   QUALIFIED FOR A COST OUTLIER PAYMENT.     *   08280000
269300*              06 = TRANSFER PAID ON A PERDIEM BASIS UP TO    *   08290000
269400*                   AND INCLUDING THE FULL DRG. PROVIDER      *   08300000
269500*                   REFUSED COST OUTLIER.                     *   08310000
269600*           40,10 = POST-ACUTE TRANSFER                       *   08320000
269700*                   DRG = 28  29  30  40  41  42  219             08330000
269800*                         220 221 477 478 479 480 481             08340000
269900*                         482 492 493 494 500 501 502             08350000
270000*                         515 516 517                             08360000
270100*                                                                 08370000
270200* =======================================================         06801000
270300* THE 50/50 DRG'S DO NOT REPEAT WITH THE POSTACUTE  DRG'S         06801000
270400* =======================================================         06801000
270500*                                                                 06860000
270600*           42,12 = POST-ACAUTE TRANSFER WITH SPECIFIC DRGS   *   08380000
270700*                       THE FOLLOWING DRG'S                   *   08390000
270800*                   DRG = 3   4   25  26  27              31      08400000
270900*                         32  33              54  55  56  57      08410000
271000*                         64  65  66  70  71  72  85  86  87      08420000
271100*                         91  92  93  100 101 163 164 165 166     08430000
271200*                         167 168 175 176 177 178 179 186 187     08440000
271300*                         188 190 191 192 193 194 195 196 197     08450000
271400*                         198 205 206 207 216 217 218             08460000
271500*                             228 229 230 233 234 235 236 239     08470000
271600*                         240 241 242 243 244 255 256 257 264     08480000
271700*                         280 281 282 288 289 290 291 292 293     08490000
271800*                         299 300 301 314 315 316 326 327 328     08500000
271900*                         329 330 331 332 333 334 335 336 337     08510000
272000*                         356 357 358 371 372 373 374 375 376     08520000
272100*                         377 378 379 380 381 382 388 389 390     08530000
272200*                         405 406 407 414 415 416 441 442 443     08540000
272300*                         459 460 463 464 465 466 467 468 469     08550000
272400*                         470 474 475 476                         08560000
272500*                             483 484 488 489             495     08570000
272600*                         496 497             510 511 512         08580000
272700*                                 533 534 535 536 539 540 541     08590000
272800*                         542 543 544 545 546 547 551 552 557     08600000
272900*                         558 559 560 561 562 563 573 574 575     08610000
273000*                         579 580 581 592 593 594 602 603 616     08620000
273100*                         617 618 622 623 624 628 629 630 637     08630000
273200*                         638 639 640 641 643 644 645 653 654     08640000
273300*                         655 659 660 661 682 683 684 689 690     08650000
273400*                         698 699 700 840 841 842 853 854 855     08660000
273500*                         856 857 858 862 863 867 868 869 870     08670000
273600*                         871 872 884 896 897 907 908 909 917     08680000
273700*                         918 945 946 947 948 956 981 982 983     08690000
273800*                         987 988 989                             08700000
273900*                                                                 08710000
274000*           44,14 = PAID NORMAL DRG PAYMENT WITH              *   08720000
274100*                    PERDIEM DAYS = OR > GM  ALOS             *   08730000
274200*              16 = PAID AS A COST-OUTLIER WITH               *   08740000
274300*                    PERDIEM DAYS = OR > GM  ALOS             *   08750000
274400*                                                             *   08760000
274500*            PPS-RTC 50-99 = WHY THE BILL WAS NOT PAID        *   08770000
274600*              51 = NO PROVIDER SPECIFIC INFO FOUND           *   08780000
274700*              52 = INVALID CBSA# IN PROVIDER FILE            *   08790000
274800*                   OR INVALID WAGE INDEX                     *   08800000
274900*              53 = WAIVER STATE - NOT CALCULATED BY PPS      *   08810000
275000*              54 = INVALID DRG                               *   08820000
275100*              55 = DISCHARGE DATE < PROVIDER EFF START DATE  *   08830000
275200*                                      OR                     *   08840000
275300*                   DISCHARGE DATE < CBSA EFF START DATE      *   08850000
275400*                   FOR PPS                                   *   08860000
275500*                                      OR                     *   08870000
275600*                   PROVIDER HAS BEEN TERMINATED ON OR BEFORE *   08880000
275700*                   DISCHARGE DATE                            *   08890000
275800*              56 = INVALID LENGTH OF STAY                    *   08900000
275900*              57 = REVIEW CODE INVALID (NOT 00 03 06 07 09   *   08910000
276000*                                        NOT 11)              *   08920000
276100*              58 = TOTAL CHARGES NOT NUMERIC                 *   08930000
276200*              61 = LIFETIME RESERVE DAYS NOT NUMERIC         *   08940000
276300*                   OR BILL-LTR-DAYS > 60                     *   08950000
276400*              62 = INVALID NUMBER OF COVERED DAYS            *   08960000
276500*              65 = PAY-CODE NOT = A,B OR C ON PROVIDER       *   08970000
276600*                   SPECIFIC FILE FOR CAPITAL                 *   08980000
276700*              67 = COST OUTLIER WITH LOS > COVERED DAYS      *   08990000
276800*                   OR COST OUTLIER THRESHOLD CALUCULATION    *   09000000
276900*              98 = CANNOT PROCESS BILL OLDER THAN 5 YEARS    *   09010000
277000***************************************************************   09020000
277100 01  PPS-DATA.                                                    09030000
277200         10  PPS-RTC                PIC 9(02).                    09040000
277300         10  PPS-WAGE-INDX          PIC 9(02)V9(04).              09050000
277400         10  PPS-OUTLIER-DAYS       PIC 9(03).                    09060000
277500         10  PPS-AVG-LOS            PIC 9(02)V9(01).              09070000
277600         10  PPS-DAYS-CUTOFF        PIC 9(02)V9(01).              09080000
277700         10  PPS-OPER-IME-ADJ       PIC 9(06)V9(02).              09090000
277800         10  PPS-TOTAL-PAYMENT      PIC 9(07)V9(02).              09100000
277900         10  PPS-OPER-HSP-PART      PIC 9(06)V9(02).              09110000
278000         10  PPS-OPER-FSP-PART      PIC 9(06)V9(02).              09120000
278100         10  PPS-OPER-OUTLIER-PART  PIC 9(07)V9(02).              09130000
278200         10  PPS-REG-DAYS-USED      PIC 9(03).                    09140000
278300         10  PPS-LTR-DAYS-USED      PIC 9(02).                    09150000
278400         10  PPS-OPER-DSH-ADJ       PIC 9(06)V9(02).              09160000
278500         10  PPS-CALC-VERS          PIC X(05).                    09170000
278600                                                                  09180000
278700******************************************************************09190000
278800*            THESE ARE THE VERSIONS OF THE PPCAL                  09200000
278900*           PROGRAMS THAT WILL BE PASSED BACK----                 09210000
279000*          ASSOCIATED WITH THE BILL BEING PROCESSED               09220000
279100******************************************************************09230000
279200 01  PRICER-OPT-VERS-SW.                                          09240000
279300     02  PRICER-OPTION-SW          PIC X(01).                     09250000
279400         88  ALL-TABLES-PASSED          VALUE 'A'.                09260000
279500         88  PROV-RECORD-PASSED         VALUE 'P'.                09270000
279600         88  ADDITIONAL-VARIABLES       VALUE 'M'.                09280000
279700         88  PC-PRICER                  VALUE 'C'.                09290000
279800     02  PPS-VERSIONS.                                            09300000
279900         10  PPDRV-VERSION         PIC X(05).                     09310000
280000                                                                  09320000
280100******************************************************************09330000
280200*        THIS IS THE VARIABLES THAT WILL BE PASSED BACK           09340000
280300*          ASSOCIATED WITH THE BILL BEING PROCESSED               09350000
280400******************************************************************09360000
280500 01  PPS-ADDITIONAL-VARIABLES.                                    09370000
280600     05  PPS-HSP-PCT                PIC 9(01)V9(02).              09380000
280700     05  PPS-FSP-PCT                PIC 9(01)V9(02).              09390000
280800     05  PPS-NAT-PCT                PIC 9(01)V9(02).              09400000
280900     05  PPS-REG-PCT                PIC 9(01)V9(02).              09410000
281000     05  PPS-FAC-SPEC-RATE          PIC 9(05)V9(02).              09420000
281100     05  PPS-UPDATE-FACTOR          PIC 9(01)V9(05).              09430000
281200     05  PPS-DRG-WT                 PIC 9(02)V9(04).              09440000
281300     05  PPS-NAT-LABOR              PIC 9(05)V9(02).              09450000
281400     05  PPS-NAT-NLABOR             PIC 9(05)V9(02).              09460000
281500     05  PPS-REG-LABOR              PIC 9(05)V9(02).              09470000
281600     05  PPS-REG-NLABOR             PIC 9(05)V9(02).              09480000
281700     05  PPS-OPER-COLA              PIC 9(01)V9(03).              09490000
281800     05  PPS-INTERN-RATIO           PIC 9(01)V9(04).              09500000
281900     05  PPS-COST-OUTLIER           PIC 9(07)V9(09).              09510000
282000     05  PPS-BILL-COSTS             PIC 9(07)V9(09).              09520000
282100     05  PPS-DOLLAR-THRESHOLD       PIC 9(07)V9(09).              09530000
282200     05  PPS-DSCHG-FRCTN            PIC 9(1)V9999.                09540000
282300     05  PPS-DRG-WT-FRCTN           PIC 9(2)V9999.                09550000
282400     05  PPS-CAPITAL-VARIABLES.                                   09560000
282500         10  PPS-CAPI-TOTAL-PAY           PIC 9(07)V9(02).        09570000
282600         10  PPS-CAPI-HSP                 PIC 9(07)V9(02).        09580000
282700         10  PPS-CAPI-FSP                 PIC 9(07)V9(02).        09590000
282800         10  PPS-CAPI-OUTLIER             PIC 9(07)V9(02).        09600000
282900         10  PPS-CAPI-OLD-HARM            PIC 9(07)V9(02).        09610000
283000         10  PPS-CAPI-DSH-ADJ             PIC 9(07)V9(02).        09620000
283100         10  PPS-CAPI-IME-ADJ             PIC 9(07)V9(02).        09630000
283200         10  PPS-CAPI-EXCEPTIONS          PIC 9(07)V9(02).        09640000
283300     05  PPS-CAPITAL2-VARIABLES.                                  09650000
283400         10  PPS-CAPI2-PAY-CODE             PIC X(1).             09660000
283500         10  PPS-CAPI2-B-FSP                PIC 9(07)V9(02).      09670000
283600         10  PPS-CAPI2-B-OUTLIER            PIC 9(07)V9(02).      09680000
283700                                                                  09690000
283800     05  PPS-OTHER-VARIABLES.                                     09700000
283900         10  PPS-NON-TEMP-RELIEF-PAYMENT    PIC 9(07)V9(02).      09710000
284000         10  PPS-NEW-TECH-PAY-ADD-ON        PIC 9(07)V9(02).      09720000
284100         10  PPS-LOW-VOL-PAYMENT            PIC 9(07)V9(02).
284200         10  PPS-VAL-BASED-PURCH-PARTIPNT   PIC X.
284300         10  PPS-VAL-BASED-PURCH-ADJUST     PIC 9V9(11).
284400         10  PPS-HOSP-READMISSION-REDU      PIC X.
284500         10  PPS-OSP-HRR-ADJUSTMT          PIC 9V9(4).
284600         10  PPS-OPERATNG-DATA.
284700             15  PPS-MODEL1-BUNDLE-DISPRCNT  PIC V999.
284800             15  PPS-OPER-BASE-DRG-PAY       PIC 9(08)V99.
284900             15  PPS-OPER-HSP-AMT            PIC 9(08)V99.
285000                                                                  09740000
285100     05  PPS-PC-OTH-VARIABLES.                                    09750000
285200         10  PPS-OPER-DSH                   PIC 9(01)V9(04).      09760000
285300         10  PPS-CAPI-DSH                   PIC 9(01)V9(04).      09770000
285400         10  PPS-CAPI-HSP-PCT               PIC 9(01)V9(02).      09780000
285500         10  PPS-CAPI-FSP-PCT               PIC 9(01)V9(04).      09790000
285600         10  PPS-ARITH-ALOS                 PIC 9(02)V9(01).      09800000
285700         10  PPS-PR-WAGE-INDEX              PIC 9(02)V9(04).      09810000
285800         10  PPS-TRANSFER-ADJ               PIC 9(01)V9(05).      09820000
285900         10  PPS-PC-HMO-FLAG                PIC X(01).            09830000
286000         10  PPS-PC-COT-FLAG                PIC X(01).            09840000
286100         10  FILLER                         PIC X(0998).
286200                                                                  09860000
286300 01  PROV-NEW-HOLD.                                               09870000
286400     02  PROV-NEWREC-HOLD1.                                       09880000
286500         05  P-NEW-NPI10.                                         09890000
286600             10  P-NEW-NPI8             PIC X(08).                09900000
286700             10  P-NEW-NPI-FILLER       PIC X(02).                09910000
286800         05  P-NEW-PROVIDER-NO.                                   09920000
286900             88  P-NEW-DSH-ADJ-PROVIDERS                          09930000
287000                             VALUE '180049' '190044' '190144'     09940000
287100                                   '190191' '330047' '340085'     09950000
287200                                   '370016' '370149' '420043'.    09960000
287300             10  P-NEW-STATE            PIC 9(02).                09970000
287400             10  FILLER                 PIC X(04).                09980000
287500         05  P-NEW-DATE-DATA.                                     09990000
287600             10  P-NEW-EFF-DATE.                                  10000000
287700                 15  P-NEW-EFF-DT-CC    PIC 9(02).                10010000
287800                 15  P-NEW-EFF-DT-YY    PIC 9(02).                10020000
287900                 15  P-NEW-EFF-DT-MM    PIC 9(02).                10030000
288000                 15  P-NEW-EFF-DT-DD    PIC 9(02).                10040000
288100             10  P-NEW-FY-BEGIN-DATE.                             10050000
288200                 15  P-NEW-FY-BEG-DT-CC PIC 9(02).                10060000
288300                 15  P-NEW-FY-BEG-DT-YY PIC 9(02).                10070000
288400                 15  P-NEW-FY-BEG-DT-MM PIC 9(02).                10080000
288500                 15  P-NEW-FY-BEG-DT-DD PIC 9(02).                10090000
288600             10  P-NEW-REPORT-DATE.                               10100000
288700                 15  P-NEW-REPORT-DT-CC PIC 9(02).                10110000
288800                 15  P-NEW-REPORT-DT-YY PIC 9(02).                10120000
288900                 15  P-NEW-REPORT-DT-MM PIC 9(02).                10130000
289000                 15  P-NEW-REPORT-DT-DD PIC 9(02).                10140000
289100             10  P-NEW-TERMINATION-DATE.                          10150000
289200                 15  P-NEW-TERM-DT-CC   PIC 9(02).                10160000
289300                 15  P-NEW-TERM-DT-YY   PIC 9(02).                10170000
289400                 15  P-NEW-TERM-DT-MM   PIC 9(02).                10180000
289500                 15  P-NEW-TERM-DT-DD   PIC 9(02).                10190000
289600         05  P-NEW-WAIVER-CODE          PIC X(01).                10200000
289700             88  P-NEW-WAIVER-STATE       VALUE 'Y'.              10210000
289800         05  P-NEW-INTER-NO             PIC 9(05).                10220000
289900         05  P-NEW-PROVIDER-TYPE        PIC X(02).                10230000
290000             88  P-N-SOLE-COMMUNITY-PROV    VALUE '01' '11'.      10240000
290100             88  P-N-REFERRAL-CENTER        VALUE '07' '11'       10250000
290200                                                  '15' '17'       10260000
290300                                                  '22'.           10270000
290400             88  P-N-INDIAN-HEALTH-SERVICE  VALUE '08'.           10280000
290500             88  P-N-REDESIGNATED-RURAL-YR1 VALUE '09'.           10290000
290600             88  P-N-REDESIGNATED-RURAL-YR2 VALUE '10'.           10300000
290700             88  P-N-SOLE-COM-REF-CENT      VALUE '11'.           10310000
290800             88  P-N-MDH-REBASED-FY90       VALUE '14' '15'.      10320000
290900             88  P-N-MDH-RRC-REBASED-FY90   VALUE '15'.           10330000
291000             88  P-N-SCH-REBASED-FY90       VALUE '16' '17'.      10340000
291100             88  P-N-SCH-RRC-REBASED-FY90   VALUE '17'.           10350000
291200             88  P-N-MEDICAL-ASSIST-FACIL   VALUE '18'.           10360000
291300             88  P-N-EACH                   VALUE '21' '22'.      10370000
291400             88  P-N-EACH-REFERRAL-CENTER   VALUE '22'.           10380000
291500             88  P-N-NHCMQ-II-SNF           VALUE '32'.           10390000
291600             88  P-N-NHCMQ-III-SNF          VALUE '33'.           10400000
291700         05  P-NEW-CURRENT-CENSUS-DIV   PIC 9(01).                10410000
291800             88  P-N-NEW-ENGLAND            VALUE  1.             10420000
291900             88  P-N-MIDDLE-ATLANTIC        VALUE  2.             10430000
292000             88  P-N-SOUTH-ATLANTIC         VALUE  3.             10440000
292100             88  P-N-EAST-NORTH-CENTRAL     VALUE  4.             10450000
292200             88  P-N-EAST-SOUTH-CENTRAL     VALUE  5.             10460000
292300             88  P-N-WEST-NORTH-CENTRAL     VALUE  6.             10470000
292400             88  P-N-WEST-SOUTH-CENTRAL     VALUE  7.             10480000
292500             88  P-N-MOUNTAIN               VALUE  8.             10490000
292600             88  P-N-PACIFIC                VALUE  9.             10500000
292700         05  P-NEW-CURRENT-DIV   REDEFINES                        10510000
292800                    P-NEW-CURRENT-CENSUS-DIV   PIC 9(01).         10520000
292900             88  P-N-VALID-CENSUS-DIV    VALUE 1 THRU 9.          10530000
293000         05  P-NEW-MSA-DATA.                                      10540000
293100             10  P-NEW-CHG-CODE-INDEX       PIC X.                10550000
293200             10  P-NEW-GEO-LOC-MSAX         PIC X(04) JUST RIGHT. 10560000
293300             10  P-NEW-GEO-LOC-MSA9   REDEFINES                   10570000
293400                             P-NEW-GEO-LOC-MSAX  PIC 9(04).       10580000
293500             10  P-NEW-WAGE-INDEX-LOC-MSA   PIC X(04) JUST RIGHT. 10590000
293600             10  P-NEW-STAND-AMT-LOC-MSA    PIC X(04) JUST RIGHT. 10600000
293700             10  P-NEW-STAND-AMT-LOC-MSA9                         10610000
293800       REDEFINES P-NEW-STAND-AMT-LOC-MSA.                         10620000
293900                 15  P-NEW-RURAL-1ST.                             10630000
294000                     20  P-NEW-STAND-RURAL  PIC XX.               10640000
294100                         88  P-NEW-STD-RURAL-CHECK VALUE '  '.    10650000
294200                 15  P-NEW-RURAL-2ND        PIC XX.               10660000
294300         05  P-NEW-SOL-COM-DEP-HOSP-YR PIC XX.                    10670000
294400                 88  P-NEW-SCH-YRBLANK    VALUE   '  '.           10680000
294500                 88  P-NEW-SCH-YR82       VALUE   '82'.           10690000
294600                 88  P-NEW-SCH-YR87       VALUE   '87'.           10700000
294700         05  P-NEW-LUGAR                    PIC X.                10710000
294800         05  P-NEW-TEMP-RELIEF-IND          PIC X.                10720000
294900         05  P-NEW-FED-PPS-BLEND-IND        PIC X.                10730000
295000         05  FILLER                         PIC X(05).            10740000
295100     02  PROV-NEWREC-HOLD2.                                       10750000
295200         05  P-NEW-VARIABLES.                                     10760000
295300             10  P-NEW-FAC-SPEC-RATE     PIC  9(05)V9(02).        10770000
295400             10  P-NEW-COLA              PIC  9(01)V9(03).        10780000
295500             10  P-NEW-INTERN-RATIO      PIC  9(01)V9(04).        10790000
295600             10  P-NEW-BED-SIZE          PIC  9(05).              10800000
295700             10  P-NEW-OPER-CSTCHG-RATIO PIC  9(01)V9(03).        10810000
295800             10  P-NEW-CMI               PIC  9(01)V9(04).        10820000
295900             10  P-NEW-SSI-RATIO         PIC  V9(04).             10830000
296000             10  P-NEW-MEDICAID-RATIO    PIC  V9(04).             10840000
296100             10  P-NEW-PPS-BLEND-YR-IND  PIC  9(01).              10850000
296200             10  P-NEW-PRUF-UPDTE-FACTOR PIC  9(01)V9(05).        10860000
296300             10  P-NEW-DSH-PERCENT       PIC  V9(04).             10870000
296400             10  P-NEW-FYE-DATE          PIC  X(08).              10880000
296500         05  P-NEW-CBSA-DATA.                                     10890000
296600             10  P-NEW-CBSA-SPEC-PAY-IND    PIC X.                10900000
296700             10  P-NEW-CBSA-HOSP-QUAL-IND   PIC X.                10900000
296800             10  P-NEW-CBSA-GEO-LOC         PIC X(05) JUST RIGHT. 10900000
296900             10  P-NEW-CBSA-GEO-RURAL REDEFINES                   10900000
297000                 P-NEW-CBSA-GEO-LOC.                              10900000
297100                 15  P-NEW-CBSA-GEO-RURAL1ST PIC XXX.             10900000
297200                     88  P-NEW-CBSA-GEO-RURAL1    VALUE '   '.    10900000
297300                 15  P-NEW-CBSA-GEO-RURAL2ND PIC XX.              10900000
297400                                                                  10900000
297500             10  P-NEW-CBSA-RECLASS-LOC     PIC X(05) JUST RIGHT. 10900000
297600             10  P-NEW-CBSA-STAND-AMT-LOC   PIC X(05) JUST RIGHT. 10900000
297700             10  P-NEW-CBSA-SPEC-WAGE-INDEX    PIC 9(02)V9(04).   10900000
297800     02  PROV-NEWREC-HOLD3.                                       10930000
297900         05  P-NEW-PASS-AMT-DATA.                                 10940000
298000             10  P-NEW-PASS-AMT-CAPITAL    PIC 9(04)V99.          10950000
298100             10  P-NEW-PASS-AMT-DIR-MED-ED PIC 9(04)V99.          10960000
298200             10  P-NEW-PASS-AMT-ORGAN-ACQ  PIC 9(04)V99.          10970000
298300             10  P-NEW-PASS-AMT-PLUS-MISC  PIC 9(04)V99.          10980000
298400         05  P-NEW-CAPI-DATA.                                     10990000
298500             15  P-NEW-CAPI-PPS-PAY-CODE   PIC X.                 11000000
298600             15  P-NEW-CAPI-HOSP-SPEC-RATE PIC 9(04)V99.          11010000
298700             15  P-NEW-CAPI-OLD-HARM-RATE  PIC 9(04)V99.          11020000
298800             15  P-NEW-CAPI-NEW-HARM-RATIO PIC 9(01)V9999.        11030000
298900             15  P-NEW-CAPI-CSTCHG-RATIO   PIC 9V999.             11040000
299000             15  P-NEW-CAPI-NEW-HOSP       PIC X.                 11050000
299100             15  P-NEW-CAPI-IME            PIC 9V9999.            11060000
299200             15  P-NEW-CAPI-EXCEPTIONS     PIC 9(04)V99.          11070000
299300         05  P-HVBP-HRR-DATA.
299400             15  P-VAL-BASED-PURCH-PARTIPNT PIC X.
299500             15  P-VAL-BASED-PURCH-ADJUST   PIC 9V9(11).
299600             15  P-HOSP-READMISSION-REDU    PIC X.
299700             15  P-HOSP-HRR-ADJUSTMT        PIC 9V9(4).
299800         05  P-MODEL1-BUNDLE-DATA.                                      08
299900             15  P-MODEL1-BUNDLE-DISPRCNT   PIC V999.                   08
299910             15  P-HAC-REDUC-IND            PIC X.
299920             15  P-UNCOMP-CARE-AMOUNT       PIC 9(07)V99.
299930             15  P-EHR-REDUC-IND            PIC X.
299940         05  FILLER                         PIC X(09).
300100
300200************************************************************      ******
300300
300400******************************************************************11090000
300500 01  WAGE-NEW-CBSA-INDEX-RECORD.                                  11100000
300600     05  W-CBSA                        PIC X(5).                  11110000
300700     05  W-CBSA-SIZE                   PIC X.                     11120000
300800         88  LARGE-URBAN       VALUE 'L'.                         11130000
300900         88  OTHER-URBAN       VALUE 'O'.                         11140000
301000         88  ALL-RURAL         VALUE 'R'.                         11150000
301100     05  W-CBSA-EFF-DATE               PIC X(8).                  11160000
301200     05  FILLER                        PIC X.                     11170000
301300     05  W-CBSA-INDEX-RECORD           PIC S9(02)V9(04).          11180000
301400     05  W-CBSA-PR-INDEX-RECORD        PIC S9(02)V9(04).          11190000
301500                                                                  11200000
301600                                                                  11210000
301700 PROCEDURE DIVISION  USING BILL-NEW-DATA                          11220000
301800                           PPS-DATA                               11230000
301900                           PRICER-OPT-VERS-SW                     11240000
302000                           PPS-ADDITIONAL-VARIABLES               11250000
302100                           PROV-NEW-HOLD                          11260000
302200                           WAGE-NEW-CBSA-INDEX-RECORD.            11270000
302300                                                                  11280000
302400***************************************************************   11290000
302500*    PROCESSING:                                              *   11300000
302600*        A. WILL PROCESS CASES BASED ON DISCHARGE DATE            11310000
302700*        B. INITIALIZE PPCAL  HOLD VARIABLES.                 *   11320000
302800*        C. EDIT THE DATA PASSED FROM THE BILL BEFORE         *   11330000
302900*           ATTEMPTING TO CALCULATE PPS. IF THIS BILL         *   11340000
303000*           CANNOT BE PROCESSED, SET A RETURN CODE AND        *   11350000
303100*           GOBACK.                                           *   11360000
303200*        D. ASSEMBLE PRICING COMPONENTS.                      *   11370000
303300*        E. CALCULATE THE PRICE.                              *   11380000
303400***************************************************************   11390000
303500                                                                  11400000
303600     MOVE ZEROES TO NON-TEMP-RELIEF-PAYMENT.                      11410000
303700     MOVE 'N' TO TEMP-RELIEF-FLAG.                                11420000
303800     MOVE 'N' TO OUTLIER-RECON-FLAG.                              11430000
303900                                                                  11440000
304000     PERFORM 0200-MAINLINE-CONTROL THRU 0200-EXIT.                11450000
304100                                                                  11460000
304200     MOVE HOLD-ADDITIONAL-VARIABLES TO  PPS-ADDITIONAL-VARIABLES. 11470000
304300     MOVE H-DSCHG-FRCTN             TO  PPS-DSCHG-FRCTN.          11480000
304400     MOVE H-DRG-WT-FRCTN            TO  PPS-DRG-WT-FRCTN.         11490000
304500     MOVE HOLD-CAPITAL-VARIABLES    TO  PPS-CAPITAL-VARIABLES.    11500000
304600     MOVE HOLD-CAPITAL2-VARIABLES   TO  PPS-CAPITAL2-VARIABLES.   11510000
304700     MOVE CAL-VERSION               TO  PPS-CALC-VERS.            11520000
304800     MOVE HOLD-OTHER-VARIABLES      TO  PPS-OTHER-VARIABLES.      11530000
304900     MOVE HOLD-PC-OTH-VARIABLES     TO  PPS-PC-OTH-VARIABLES.     11540000
305000                                                                  11550000
305100     IF (PPS-RTC = '00' OR '03' OR '10' OR                        11560000
305200                   '12' OR '14')                                  11570000
305300        MOVE 'Y' TO OUTLIER-RECON-FLAG                            11580000
305400        MOVE PPS-DATA TO HLD-PPS-DATA                             11590000
305500        PERFORM 0200-MAINLINE-CONTROL THRU 0200-EXIT              11600000
305600        MOVE HLD-PPS-DATA TO PPS-DATA.                            11610000
305700                                                                  11620000
305800     GOBACK.                                                      11630000
305900                                                                  11640000
306000 0200-MAINLINE-CONTROL.                                           11650000
306100                                                                  11660000
306200     MOVE 'N' TO HMO-TAG.                                         11670000
306300                                                                  11680000
306400     IF PPS-PC-HMO-FLAG = 'Y' OR                                  11690000
306500               HMO-FLAG = 'Y'                                     11700000
306600        MOVE 'Y' TO HMO-TAG.                                      11710000
306700                                                                  11720000
306800     IF P-NEW-STATE NOT = 40                                      11730000
306900        MOVE ZEROES TO W-CBSA-PR-INDEX-RECORD.                    11740000
307000                                                                  11750000
307100     MOVE ALL '0' TO PPS-DATA                                     11760000
307200                     H-OPER-DSH-SCH                               11770000
307300                     H-OPER-DSH-RRC                               11780000
307400                     HOLD-PPS-COMPONENTS                          11790000
307500                     HOLD-PPS-COMPONENTS                          11800000
307600                     HOLD-ADDITIONAL-VARIABLES                    11810000
307700                     HOLD-CAPITAL-VARIABLES                       11820000
307800                     HOLD-CAPITAL2-VARIABLES                      11830000
307900                     HOLD-OTHER-VARIABLES                         11840000
308000                     HOLD-PC-OTH-VARIABLES.                       11850000
308100                                                                  11860000
308200     IF P-NEW-CAPI-HOSP-SPEC-RATE NOT NUMERIC                     11870000
308300        MOVE 0 TO P-NEW-CAPI-HOSP-SPEC-RATE.                      11880000
308400                                                                  11890000
308500     IF P-NEW-CAPI-OLD-HARM-RATE  NOT NUMERIC                     11900000
308600        MOVE 0 TO P-NEW-CAPI-OLD-HARM-RATE.                       11910000
308700                                                                  11920000
308800     IF P-NEW-CAPI-NEW-HARM-RATIO NOT NUMERIC                     11930000
308900        MOVE 0 TO P-NEW-CAPI-NEW-HARM-RATIO.                      11940000
309000                                                                  11950000
309100     IF P-NEW-CAPI-CSTCHG-RATIO NOT NUMERIC                       11960000
309200        MOVE 0 TO P-NEW-CAPI-CSTCHG-RATIO.                        11970000
309300                                                                  11980000
309400                                                                  11990000
309500     PERFORM 1000-EDIT-THE-BILL-INFO.                             12000000
309600                                                                  12010000
309700     IF  PPS-RTC = 00                                             12020000
309800         PERFORM 2000-ASSEMBLE-PPS-VARIABLES                      12030000
309900         PERFORM 3000-CALC-PAYMENT THRU 3000-EXIT.                12040000
310000                                                                  12050000
310100     IF OUTLIER-RECON-FLAG = 'Y'                                  12060000
310200        MOVE 'N' TO OUTLIER-RECON-FLAG                            12070000
310300        GO TO 0200-EXIT.                                          12080000
310400                                                                  12090000
310500     IF PPS-RTC = 00                                              12100000
310600        IF H-PERDIEM-DAYS = H-ALOS OR                             12110000
310700           H-PERDIEM-DAYS > H-ALOS                                12120000
310800           MOVE 14 TO PPS-RTC.                                    12130000
310900                                                                  12140000
311000     IF PPS-RTC = 02                                              12150000
311100        IF H-PERDIEM-DAYS = H-ALOS OR                             12160000
311200           H-PERDIEM-DAYS > H-ALOS                                12170000
311300           MOVE 16 TO PPS-RTC.                                    12180000
311400                                                                  12190000
311500 0200-EXIT.   EXIT.                                               12200000
311600                                                                  12210000
311700 1000-EDIT-THE-BILL-INFO.                                         12220000
311800                                                                  12230000
311900     MOVE 1.00 TO H-CAPI-PAYCDE-PCT1.                             12240000
312000     MOVE 0.00 TO H-CAPI-PAYCDE-PCT2.                             12250000
312100                                                                  12260000
312200     IF  PPS-RTC = 00                                             12270000
312300         IF  P-NEW-WAIVER-STATE                                   12280000
312400             MOVE 53 TO PPS-RTC.                                  12290000
312500                                                                  12300000
312600     IF  PPS-RTC = 00                                             12310000
312700         IF  B-DRG < 001                                                00
312800               OR = 009 OR = 015                                  12330000
312900               OR = 018 OR = 019 OR = 043 OR = 044                12340000
313000               OR = 045 OR = 046 OR = 047 OR = 048                12350000
313100               OR = 049 OR = 050 OR = 051 OR = 104                12360000
313200               OR = 105 OR = 106 OR = 107 OR = 108                12370000
313300               OR = 109 OR = 110 OR = 111 OR = 112                12380000
313400               OR = 118 OR = 119 OR = 120 OR = 126                12390000
313500               OR = 127 OR = 128 OR = 140 OR = 141                12400000
313600               OR = 142 OR = 143 OR = 144 OR = 145                12410000
313700               OR = 160 OR = 161 OR = 162 OR = 169                12420000
313800               OR = 170 OR = 171 OR = 172 OR = 173                12430000
313900               OR = 174 OR = 209 OR = 210 OR = 211                12440000
314000               OR = 212 OR = 213 OR = 214                         12450000
314100               OR = 266 OR = 267 OR = 268 OR = 269                12460000
314200               OR = 270 OR = 271 OR = 272 OR = 273                12470000
314300               OR = 274 OR = 275 OR = 276 OR = 277                12480000
314400               OR = 278 OR = 279 OR = 317 OR = 318                12490000
314500               OR = 319 OR = 320 OR = 321 OR = 322                12500000
314600               OR = 323 OR = 324 OR = 325 OR = 359                12510000
314700               OR = 360 OR = 361 OR = 362 OR = 363                12520000
314800               OR = 364 OR = 365 OR = 366 OR = 367                12530000
314900               OR = 396 OR = 397 OR = 398 OR = 399                12540000
315000               OR = 400 OR = 401 OR = 402 OR = 403                12550000
315100               OR = 404 OR = 426 OR = 427 OR = 428                12560000
315200               OR = 429 OR = 430 OR = 431 OR = 447                12570000
315300               OR = 448 OR = 449 OR = 450 OR = 451                12580000
315400               OR = 452 OR = 518 OR = 519 OR = 520                12590000
315500               OR = 521 OR = 522 OR = 523 OR = 524                12600000
315600               OR = 525 OR = 526 OR = 527 OR = 528                12610000
315700               OR = 529 OR = 530 OR = 531 OR = 532                12620000
315800               OR = 567 OR = 568 OR = 569                         12630000
315900               OR = 586 OR = 587                                  12640000
316000               OR = 588 OR = 589 OR = 590 OR = 591                12650000
316100               OR = 608 OR = 609 OR = 610 OR = 611                12660000
316200               OR = 612 OR = 613 OR = 631 OR = 632                12670000
316300               OR = 633 OR = 634 OR = 635 OR = 636                12680000
316400               OR = 646 OR = 647 OR = 648 OR = 649                12690000
316500               OR = 650 OR = 651 OR = 676 OR = 677                12700000
316600               OR = 678 OR = 679 OR = 680 OR = 681                12710000
316700               OR = 701 OR = 702 OR = 703 OR = 704                12720000
316800               OR = 705 OR = 706 OR = 719 OR = 720                12730000
316900               OR = 721 OR = 731 OR = 732 OR = 733                12740000
317000               OR = 751 OR = 752 OR = 753 OR = 762                12750000
317100               OR = 763 OR = 764 OR = 771 OR = 772                12760000
317200               OR = 773 OR = 783 OR = 784 OR = 785                12770000
317300               OR = 786 OR = 787 OR = 788 OR = 796                12780000
317400               OR = 797 OR = 798 OR = 805 OR = 806                12790000
317500               OR = 807 OR = 817 OR = 818 OR = 819                12800000
317600               OR = 831 OR = 832 OR = 833 OR = 850                12810000
317700               OR = 851 OR = 852 OR = 859 OR = 860                12820000
317800               OR = 861 OR = 873 OR = 874 OR = 875                12830000
317900               OR = 877 OR = 878 OR = 879                               00
318000               OR = 888 OR = 889 OR = 890                               00
318100               OR = 891 OR = 892                                  12850000
318200               OR = 893 OR = 898 OR = 899 OR = 900                12860000
318300               OR = 910 OR = 911 OR = 912 OR = 924                12870000
318400               OR = 925 OR = 926 OR = 930 OR = 931                12880000
318500               OR = 932 OR = 936 OR = 937 OR = 938                12890000
318600               OR = 942 OR = 943 OR = 944 OR = 952                12900000
318700               OR = 953 OR = 954 OR = 960 OR = 961                12910000
318800               OR = 962 OR = 966 OR = 967 OR = 968                12920000
318900               OR = 971 OR = 972 OR = 973 OR = 978                12930000
319000               OR = 979 OR = 980 OR = 990 OR = 991                12940000
319100               OR = 992 OR = 993 OR = 994 OR = 995                12950000
319200               OR = 996 OR = 997                                  12960000
319300             MOVE 54 TO PPS-RTC.                                  12970000
319400                                                                  12980000
319500     IF  PPS-RTC = 00                                             12990000
319600            IF  ((B-DISCHARGE-DATE < P-NEW-EFF-DATE) OR           13000000
319700                 (B-DISCHARGE-DATE < W-CBSA-EFF-DATE))            13010000
319800                MOVE 55 TO PPS-RTC.                               13020000
319900                                                                  13030000
320000     IF  PPS-RTC = 00                                             13040000
320100         IF P-NEW-TERMINATION-DATE > 00000000                     13050000
320200            IF  ((B-DISCHARGE-DATE = P-NEW-TERMINATION-DATE) OR   13060000
320300                 (B-DISCHARGE-DATE > P-NEW-TERMINATION-DATE))     13070000
320400                  MOVE 55 TO PPS-RTC.                             13080000
320500                                                                  13090000
320600     IF  PPS-RTC = 00                                             13100000
320700         IF  B-LOS NOT NUMERIC                                    13110000
320800             MOVE 56 TO PPS-RTC                                   13120000
320900         ELSE                                                     13130000
321000         IF  B-LOS = 0                                            13140000
321100             IF B-REVIEW-CODE NOT = 00 AND                        13150000
321200                              NOT = 03 AND                        13160000
321300                              NOT = 06 AND                        13170000
321400                              NOT = 07 AND                        13180000
321500                              NOT = 09 AND                        13190000
321600                              NOT = 11                            13200000
321700             MOVE 56 TO PPS-RTC.                                  13210000
321800                                                                  13220000
321900     IF  PPS-RTC = 00                                             13230000
322000         IF  B-LTR-DAYS NOT NUMERIC OR B-LTR-DAYS > 60            13240000
322100             MOVE 61 TO PPS-RTC                                   13250000
322200         ELSE                                                     13260000
322300             MOVE B-LTR-DAYS TO H-LTR-DAYS.                       13270000
322400                                                                  13280000
322500     IF  PPS-RTC = 00                                             13290000
322600         IF  B-COVERED-DAYS NOT NUMERIC                           13300000
322700             MOVE 62 TO PPS-RTC                                   13310000
322800         ELSE                                                     13320000
322900         IF  B-COVERED-DAYS = 0 AND B-LOS > 0                     13330000
323000             MOVE 62 TO PPS-RTC                                   13340000
323100         ELSE                                                     13350000
323200             MOVE B-COVERED-DAYS TO H-COV-DAYS.                   13360000
323300                                                                  13370000
323400     IF  PPS-RTC = 00                                             13380000
323500         IF  H-LTR-DAYS  > H-COV-DAYS                             13390000
323600             MOVE 62 TO PPS-RTC                                   13400000
323700         ELSE                                                     13410000
323800             COMPUTE H-REG-DAYS = H-COV-DAYS - H-LTR-DAYS.        13420000
323900                                                                  13430000
324000     IF  PPS-RTC = 00                                             13440000
324100         IF  NOT VALID-REVIEW-CODE                                13450000
324200             MOVE 57 TO PPS-RTC.                                  13460000
324300                                                                  13470000
324400     IF  PPS-RTC = 00                                             13480000
324500         IF  B-CHARGES-CLAIMED NOT NUMERIC                        13490000
324600             MOVE 58 TO PPS-RTC.                                  13500000
324700                                                                  13510000
324800     IF PPS-RTC = 00                                              13520000
324900           IF P-NEW-CAPI-NEW-HOSP NOT = 'Y'                       13530000
325000                 IF P-NEW-CAPI-PPS-PAY-CODE NOT = 'A' AND         13540000
325100                                            NOT = 'B' AND         13550000
325200                                            NOT = 'C'             13560000
325300                 MOVE 65 TO PPS-RTC.                              13570000
325400                                                                  13580000
325500 2000-ASSEMBLE-PPS-VARIABLES.                                     13590000
325600***  GET THE PROVIDER SPECIFIC VARIABLES.                         13600000
325700***  GET THE PROVIDER SPECIFIC VARIABLES.                         13610000
325800                                                                  13620000
325900     MOVE P-NEW-FAC-SPEC-RATE TO H-FAC-SPEC-RATE.                 13630000
326000     MOVE P-NEW-INTERN-RATIO TO H-INTERN-RATIO.                   13640000
326100                                                                  13650000
326200     IF  (P-NEW-STATE = 02 OR 12)                                 13660000
326300         MOVE P-NEW-COLA TO H-OPER-COLA                           13670000
326400     ELSE                                                         13680000
326500         MOVE 1.000  TO H-OPER-COLA.                              13690000
326600                                                                  13700000
326700***************************************************************   13710000
326800***  GET THE DRG RELATIVE WEIGHTS, ALOS, DAYS CUTOFF              13720000
326900***  GET THE DRG RELATIVE WEIGHTS, ALOS, DAYS CUTOFF              13730000
327000                                                                  13740000
327100     PERFORM 2600-GET-DRG-WEIGHT                                  13750000
327200             VARYING DX5 FROM 1 BY 1 UNTIL DX5 > 1.               13760000
327300                                                                  13770000
327400***************************************************************   13780000
327500***  GET THE WAGE-INDEX                                           13790000
327600***  GET THE WAGE-INDEX                                           13800000
327700                                                                  13810000
327800     MOVE W-CBSA-INDEX-RECORD TO H-WAGE-INDEX.                    13820000
327900     MOVE W-CBSA-PR-INDEX-RECORD TO H-PR-WAGE-INDEX.              13830000
328000     MOVE P-NEW-STATE            TO MES-PPS-STATE.                13830000
328100*****YEARCHANGE 2011.0 ** NOT USED 2012 *******************       16570000
328200** USING THE STATE FACTORS TO ALTER THE WAGE INDEX WAS STOPPED*   13850000
328300** FOR FY 2011                                                    13850000
328400***************************************************************   13850000
328500*    PERFORM 4200-SSRFBN-CODE-RTN THRU 4200-EXIT.
328600*****YEARCHANGE 2011.0 ** NOT USED 2012 *******************       16570000
328700
328800*    IF  P-NEW-CBSA-SPEC-PAY-IND = '1' OR '2'                           00
328900       COMPUTE H-WAGE-INDEX ROUNDED =
329000                         H-WAGE-INDEX * 1
329100*    ELSE                                                         13910000
329200*      COMPUTE H-WAGE-INDEX ROUNDED =
329300*                        H-WAGE-INDEX * MES-SSRFBN-RATE.
329400
329500*****YEARCHANGE 2011.0 ** NOT USED 2012 *******************       16570000
329600
329700***************************************************************   13850000
329800***  GET THE LABOR, NON-LABOR STANDARD RATES                      13860000
329900                                                                  13870000
330000     IF  P-NEW-STATE = 40                                         13880000
330100         MOVE 2 TO R2                                             13890000
330200         MOVE 3 TO R4                                             13900000
330300     ELSE                                                         13910000
330400         MOVE 1 TO R2                                             13920000
330500         MOVE 1 TO R4.                                            13930000
330600                                                                  13940000
330700     IF  LARGE-URBAN                                              13950000
330800         MOVE 1 TO R3                                             13960000
330900     ELSE                                                         13970000
331000         MOVE 2 TO R3.                                            13980000
331100                                                                  13990000
331200     IF ((P-NEW-CBSA-HOSP-QUAL-IND = '1') AND                     14000000
331300        (H-WAGE-INDEX > 01.0000))                                 14010000
331400        PERFORM 2300-GET-LAB-NONLAB-TB1-RATES                     14020000
331500             VARYING R1 FROM 1 BY 1 UNTIL R1 > 1.                 14030000
331600                                                                  14040000
331700     IF ((P-NEW-CBSA-HOSP-QUAL-IND NOT = '1') AND                 14050000
331800         (H-WAGE-INDEX > 01.0000))                                14060000
331900        PERFORM 2300-GET-LAB-NONLAB-TB2-RATES                     14070000
332000             VARYING R1 FROM 1 BY 1 UNTIL R1 > 1.                 14080000
332100                                                                  14090000
332200     IF ((P-NEW-CBSA-HOSP-QUAL-IND  = '1') AND                    14100000
332300         (H-WAGE-INDEX < 01.0000 OR H-WAGE-INDEX = 01.0000))      14110000
332400        PERFORM 2300-GET-LAB-NONLAB-TB3-RATES                     14120000
332500             VARYING R1 FROM 1 BY 1 UNTIL R1 > 1.                 14130000
332600                                                                  14140000
332700     IF ((P-NEW-CBSA-HOSP-QUAL-IND NOT = '1') AND                 14150000
332800         (H-WAGE-INDEX < 01.0000 OR H-WAGE-INDEX = 01.0000))      14160000
332900        PERFORM 2300-GET-LAB-NONLAB-TB4-RATES                     14170000
333000             VARYING R1 FROM 1 BY 1 UNTIL R1 > 1.                 14180000
333100                                                                  14190000
333200     IF P-NEW-STATE = 40                                          14200000
333300        IF ((P-NEW-CBSA-HOSP-QUAL-IND = '1') AND                  14210000
333400            (H-PR-WAGE-INDEX > 01.0000))                          14220000
333500             PERFORM 2300-GET-PR-LAB-TB1-RATES                    14230000
333600             VARYING R1 FROM 1 BY 1 UNTIL R1 > 1.                 14240000
333700                                                                  14250000
333800                                                                  14260000
333900     IF P-NEW-STATE = 40                                          14270000
334000        IF ((P-NEW-CBSA-HOSP-QUAL-IND NOT = '1') AND              14280000
334100             (H-PR-WAGE-INDEX > 01.0000))                         14290000
334200              PERFORM 2300-GET-PR-LAB-TB2-RATES                   14300000
334300                  VARYING R1 FROM 1 BY 1 UNTIL R1 > 1.            14310000
334400                                                                  14320000
334500     IF P-NEW-STATE = 40                                          14330000
334600        IF ((P-NEW-CBSA-HOSP-QUAL-IND  = '1') AND                 14340000
334700         (H-PR-WAGE-INDEX < 01.0000 OR H-PR-WAGE-INDEX = 01.0000))14350000
334800          PERFORM 2300-GET-PR-LAB-TB3-RATES                       14360000
334900              VARYING R1 FROM 1 BY 1 UNTIL R1 > 1.                14370000
335000                                                                  14380000
335100     IF P-NEW-STATE = 40                                          14390000
335200        IF ((P-NEW-CBSA-HOSP-QUAL-IND NOT = '1') AND              14400000
335300         (H-PR-WAGE-INDEX < 01.0000 OR H-PR-WAGE-INDEX = 01.0000))14410000
335400          PERFORM 2300-GET-PR-LAB-TB4-RATES                       14420000
335500              VARYING R1 FROM 1 BY 1 UNTIL R1 > 1.                14430000
335600                                                                  14440000
335700***************************************************************   14450000
335800***  GET THE HSP & FSP BLEND PERCENTS FOR THIS BILL               14460000
335900***  GET THE HSP & FSP BLEND PERCENTS FOR THIS BILL               14470000
336000                                                                  14480000
336100     MOVE 0.00  TO H-OPER-HSP-PCT.                                14490000
336200     MOVE 1.00  TO H-OPER-FSP-PCT.                                14500000
336300                                                                  14510000
336400***************************************************************   14520000
336500***  GET THE NATIONAL & REGIONAL BLEND PERCENTS FOR THIS BILL     14530000
336600***  GET THE NATIONAL & REGIONAL BLEND PERCENTS FOR THIS BILL     14540000
336700                                                                  14550000
336800      MOVE 1.00 TO H-NAT-PCT.                                     14560000
336900      MOVE 0.00 TO H-REG-PCT.                                     14570000
337000                                                                  14580000
337100     IF  P-NEW-STATE = 40                                         14590000
337200         MOVE 0.75 TO H-NAT-PCT                                   14600000
337300         MOVE 0.25 TO H-REG-PCT.                                  14610000
337400                                                                  14620000
337500     IF  P-N-SCH-REBASED-FY90 OR                                  14630000
337600         P-N-EACH OR                                              14640000
337700         P-N-MDH-REBASED-FY90                                     14650000
337800         MOVE 1.00 TO H-OPER-HSP-PCT.                             14660000
337900                                                                  14670000
338000 2300-GET-LAB-NONLAB-TB1-RATES.                                   14680000
338100                                                                  14690000
338200     IF  B-DISCHARGE-DATE NOT < TB1-RATE-EFF-DATE (R1)            14700000
338300         MOVE TB1-REG-LABOR  (R1 R2 R3) TO H-REG-LABOR            14710000
338400         MOVE TB1-REG-NLABOR (R1 R2 R3) TO H-REG-NONLABOR         14720000
338500         MOVE TB1-REG-LABOR  (R1 R4 R3) TO H-NAT-LABOR            14730000
338600         MOVE TB1-REG-NLABOR (R1 R4 R3) TO H-NAT-NONLABOR.        14740000
338700                                                                  14750000
338800 2300-GET-LAB-NONLAB-TB2-RATES.                                   14760000
338900                                                                  14770000
339000     IF  B-DISCHARGE-DATE NOT < TB2-RATE-EFF-DATE (R1)            14780000
339100         MOVE TB2-REG-LABOR  (R1 R2 R3) TO H-REG-LABOR            14790000
339200         MOVE TB2-REG-NLABOR (R1 R2 R3) TO H-REG-NONLABOR         14800000
339300         MOVE TB2-REG-LABOR  (R1 R4 R3) TO H-NAT-LABOR            14810000
339400         MOVE TB2-REG-NLABOR (R1 R4 R3) TO H-NAT-NONLABOR.        14820000
339500                                                                  14830000
339600 2300-GET-LAB-NONLAB-TB3-RATES.                                   14840000
339700                                                                  14850000
339800     IF  B-DISCHARGE-DATE NOT < TB3-RATE-EFF-DATE (R1)            14860000
339900         MOVE TB3-REG-LABOR  (R1 R2 R3) TO H-REG-LABOR            14870000
340000         MOVE TB3-REG-NLABOR (R1 R2 R3) TO H-REG-NONLABOR         14880000
340100         MOVE TB3-REG-LABOR  (R1 R4 R3) TO H-NAT-LABOR            14890000
340200         MOVE TB3-REG-NLABOR (R1 R4 R3) TO H-NAT-NONLABOR.        14900000
340300                                                                  14910000
340400 2300-GET-LAB-NONLAB-TB4-RATES.                                   14920000
340500                                                                  14930000
340600     IF  B-DISCHARGE-DATE NOT < TB4-RATE-EFF-DATE (R1)            14940000
340700         MOVE TB4-REG-LABOR  (R1 R2 R3) TO H-REG-LABOR            14950000
340800         MOVE TB4-REG-NLABOR (R1 R2 R3) TO H-REG-NONLABOR         14960000
340900         MOVE TB4-REG-LABOR  (R1 R4 R3) TO H-NAT-LABOR            14970000
341000         MOVE TB4-REG-NLABOR (R1 R4 R3) TO H-NAT-NONLABOR.        14980000
341100                                                                  14990000
341200 2300-GET-PR-LAB-TB1-RATES.                                       15000000
341300                                                                  15010000
341400     IF  B-DISCHARGE-DATE NOT < TB1-RATE-EFF-DATE (R1)            15020000
341500         MOVE TB1-REG-LABOR  (R1 R2 R3) TO H-REG-LABOR            15030000
341600         MOVE TB1-REG-NLABOR (R1 R2 R3) TO H-REG-NONLABOR.        15040000
341700                                                                  15050000
341800 2300-GET-PR-LAB-TB2-RATES.                                       15060000
341900                                                                  15070000
342000     IF  B-DISCHARGE-DATE NOT < TB2-RATE-EFF-DATE (R1)            15080000
342100         MOVE TB2-REG-LABOR  (R1 R2 R3) TO H-REG-LABOR            15090000
342200         MOVE TB2-REG-NLABOR (R1 R2 R3) TO H-REG-NONLABOR.        15100000
342300                                                                  15110000
342400 2300-GET-PR-LAB-TB3-RATES.                                       15120000
342500                                                                  15130000
342600     IF  B-DISCHARGE-DATE NOT < TB3-RATE-EFF-DATE (R1)            15140000
342700         MOVE TB3-REG-LABOR  (R1 R2 R3) TO H-REG-LABOR            15150000
342800         MOVE TB3-REG-NLABOR (R1 R2 R3) TO H-REG-NONLABOR.        15160000
342900                                                                  15170000
343000 2300-GET-PR-LAB-TB4-RATES.                                       15180000
343100                                                                  15190000
343200     IF  B-DISCHARGE-DATE NOT < TB4-RATE-EFF-DATE (R1)            15200000
343300         MOVE TB4-REG-LABOR  (R1 R2 R3) TO H-REG-LABOR            15210000
343400         MOVE TB4-REG-NLABOR (R1 R2 R3) TO H-REG-NONLABOR.        15220000
343500                                                                  15230000
343600                                                                  15240000
343700 2600-GET-DRG-WEIGHT.                                             15250000
343800                                                                  15260000
343900     IF  B-DISCHARGE-DATE NOT < DRGX-EFF-DATE (DX5)               15270000
344000         SET DX6 TO B-DRG                                         15280000
344100         MOVE DRG-WT (DX5 DX6)         TO H-DRG-WT                15290000
344200         MOVE DRG-ALOS (DX5 DX6)       TO H-ALOS                  15300000
344300         MOVE ZEROES                   TO H-DAYS-CUTOFF           15310000
344400         MOVE DRG-ARITH-ALOS (DX5 DX6) TO H-ARITH-ALOS.           15320000
344500                                                                  15330000
344600 3000-CALC-PAYMENT.                                               15340000
344700***************************************************************   15350000
344800                                                                  15360000
344900     PERFORM 3100-CALC-STAY-UTILIZATION.                          15370000
345000     PERFORM 3300-CALC-OPER-FSP-AMT.                              15380000
345100     PERFORM 3900A-CALC-OPER-DSH THRU 3900A-EXIT.                 15390000
345200                                                                  15400000
345300***********************************************************       15410000
345400***  OPERATING IME CALCULATION                                    15420000
345500***  OPERATING IME CALCULATION                                    15430000
345600                                                                  15440000
345700     COMPUTE H-OPER-IME-TEACH ROUNDED =                           15450000
345800            1.35 * ((1 + H-INTERN-RATIO) ** .405  - 1).           15460000
345900                                                                  15470000
346000***********************************************************       15480000
346100*                                                                 15490000
346200*    IF P-N-SCH-REBASED-FY90 OR                                   15500000
346300*       P-N-EACH OR                                               15510000
346400*       P-N-MDH-REBASED-FY90                                      15520000
346500*        PERFORM 3450-CALC-ADDITIONAL-HSP.                        15530000
346600*                                                                 15540000
346700     MOVE 00                 TO  PPS-RTC.                         15550000
346800     MOVE H-WAGE-INDEX       TO  PPS-WAGE-INDX.                   15560000
346900     MOVE H-ALOS             TO  PPS-AVG-LOS.                     15570000
347000     MOVE H-DAYS-CUTOFF      TO  PPS-DAYS-CUTOFF.                 15580000
347100                                                                  15590000
347200     MOVE B-LOS TO H-PERDIEM-DAYS.                                15600000
347300     IF H-PERDIEM-DAYS < 1                                        15610000
347400         MOVE 1 TO H-PERDIEM-DAYS.                                15620000
347500     ADD 1 TO H-PERDIEM-DAYS.                                     15630000
347600                                                                  15640000
347700     MOVE 1 TO H-DSCHG-FRCTN.                                     15650000
347800                                                                  15660000
347900     COMPUTE H-DRG-WT-FRCTN ROUNDED = H-DSCHG-FRCTN * H-DRG-WT.   15670000
348000                                                                  15680000
348100     IF (PAY-PERDIEM-DAYS  OR                                     15690000
348200         PAY-XFER-NO-COST) OR                                     15700000
348300        (PAY-XFER-SPEC-DRG AND                                    15710000
348400         B-DRG-POSTACUTE-PERDIEM)                                 15720000
348500         COMPUTE H-TRANSFER-ADJ ROUNDED = H-PERDIEM-DAYS / H-ALOS 15730000
348600         COMPUTE H-DSCHG-FRCTN  ROUNDED = H-PERDIEM-DAYS / H-ALOS 15740000
348700         IF H-DSCHG-FRCTN > 1                                     15750000
348800              MOVE 1 TO H-DSCHG-FRCTN                             15760000
348900              MOVE 1 TO H-TRANSFER-ADJ                            15770000
349000         ELSE                                                     15780000
349100              COMPUTE H-DRG-WT-FRCTN ROUNDED =                    15790000
349200                  (H-PERDIEM-DAYS / H-ALOS) * H-DRG-WT.           15800000
349300                                                                  15810000
349400     IF (PAY-XFER-SPEC-DRG AND                                    15820000
349500         B-DRG-POSTACUTE-50-50)                                   15830000
349600         COMPUTE H-TRANSFER-ADJ ROUNDED = H-PERDIEM-DAYS / H-ALOS 15840000
349700         COMPUTE H-DSCHG-FRCTN  ROUNDED =                         15850000
349800                        .5 + ((.5 * H-PERDIEM-DAYS) / H-ALOS)     15860000
349900         IF H-DSCHG-FRCTN > 1                                     15870000
350000              MOVE 1 TO H-DSCHG-FRCTN                             15880000
350100              MOVE 1 TO H-TRANSFER-ADJ                            15890000
350200         ELSE                                                     15900000
350300              COMPUTE H-DRG-WT-FRCTN ROUNDED =                    15910000
350400            (.5 + ((.5 * H-PERDIEM-DAYS) / H-ALOS)) * H-DRG-WT.   15920000
350500                                                                  15930000
350600                                                                  15940000
350700***********************************************************       15950000
350800***  CAPITAL DSH CALCULATION                                      15960000
350900***  CAPITAL DSH CALCULATION                                      15970000
351000                                                                  15980000
351100     MOVE 0 TO H-CAPI-DSH.                                        15990000
351200                                                                  16000000
351300     IF P-NEW-BED-SIZE NOT NUMERIC                                16010000
351400         MOVE 0 TO P-NEW-BED-SIZE.                                16020000
351500                                                                  16030000
351600     IF (W-CBSA-SIZE = 'O' OR 'L') AND P-NEW-BED-SIZE > 99        16040000
351700         COMPUTE H-CAPI-DSH ROUNDED = 2.7183 **                   16050000
351800                  (.2025 * (P-NEW-SSI-RATIO                       16060000
351900                          + P-NEW-MEDICAID-RATIO)) - 1.           16070000
352000                                                                  16080000
352100***********************************************************       16090000
352200***  CAPITAL IME TEACH CALCULATION                                16100000
352300***  CAPITAL IME TEACH CALCULATION                                16110000
352400                                                                  16120000
352500     MOVE 0 TO H-WK-CAPI-IME-TEACH.                               16130000
352600                                                                  16140000
352700     IF P-NEW-CAPI-IME NUMERIC                                    16150000
352800        IF P-NEW-CAPI-IME > 1.5000                                16160000
352900           MOVE 1.5000 TO P-NEW-CAPI-IME.                         16170000
353000                                                                  16180000
353100*****YEARCHANGE 2009.5 ****************************************   18470000
353200***                                                               16230000
353300***  PER POLICY, WE REMOVED THE .5 MULTIPLER                      16230000
353400***                                                               16230000
353500***********************************************************       16230000
353600     IF P-NEW-CAPI-IME NUMERIC                                    16190000
353700        COMPUTE H-WK-CAPI-IME-TEACH ROUNDED =                     16200000
353800         ((2.7183 ** (.2822 * P-NEW-CAPI-IME)) - 1).              16210000
353900                                                                  16220000
354000*****YEARCHANGE 2009.5 ****************************************   18470000
354100***********************************************************       16230000
354200     MOVE 0.00 TO H-DAYOUT-PCT.                                   16240000
354300     MOVE 0.80 TO H-CSTOUT-PCT.                                   16250000
354400                                                                  16260000
354500******************************************************************16270000
354600**                                                                16280000
354700** BURN DRGS FOR FY09 ARE 927, 928, 929, 933, 934 AND 935.        16281000
354800**                                                                16282000
354900******************************************************************16283000
355000                                                                  16284000
355100     IF  B-DRG = 927 OR 928 OR 929 OR 933 OR 934 OR 935           16285000
355200             MOVE 0.90 TO H-CSTOUT-PCT.                           16286000
355300                                                                  16287000
355400***     NATIONAL PERCENTAGE                                       16288000
355500     MOVE 0.6880   TO H-LABOR-PCT.                                16289000
355600     MOVE 0.3120   TO H-NONLABOR-PCT.                             16290000
355700                                                                  16300000
355800***     PUERTO RICO PERCENTAGE                                    16310000
355900     MOVE 0.6210   TO H-PR-LABOR-PCT.                             16320000
356000     MOVE 0.3790   TO H-PR-NONLABOR-PCT.                          16330000
356100                                                                  16340000
356200     IF (H-WAGE-INDEX < 01.0000 OR                                16350000
356300         H-WAGE-INDEX = 01.0000)                                  16360000
356400        MOVE 0.6200 TO H-LABOR-PCT                                16370000
356500        MOVE 0.3800 TO H-NONLABOR-PCT.                            16380000
356600***                                                               16390000
356700     IF P-NEW-STATE = 40                                          16400000
356800       IF (H-PR-WAGE-INDEX < 01.0000 OR                           16410000
356900           H-PR-WAGE-INDEX = 01.0000)                             16420000
357000          MOVE 0.6200 TO H-PR-LABOR-PCT                           16430000
357100          MOVE 0.3800 TO H-PR-NONLABOR-PCT.                       16440000
357200                                                                  16450000
357300                                                                  16460000
357400     IF  P-NEW-OPER-CSTCHG-RATIO NUMERIC                          16470000
357500             MOVE P-NEW-OPER-CSTCHG-RATIO TO H-OPER-CSTCHG-RATIO  16480000
357600     ELSE                                                         16490000
357700             MOVE 0.000 TO H-OPER-CSTCHG-RATIO.                   16500000
357800                                                                  16510000
357900     IF P-NEW-CAPI-CSTCHG-RATIO NUMERIC                           16520000
358000             MOVE P-NEW-CAPI-CSTCHG-RATIO TO H-CAPI-CSTCHG-RATIO  16530000
358100     ELSE                                                         16540000
358200             MOVE 0.000 TO H-CAPI-CSTCHG-RATIO.                   16550000
358300                                                                  16560000
358400***********************************************************       16570000
358500*****YEARCHANGE 2010.0 ************************************       16570000
358600***  CAPITAL PAYMENT METHOD B - YEARCHNG                          16580000
358700***  CAPITAL PAYMENT METHOD B                                     16590000
358800                                                                  16600000
358900     IF W-CBSA-SIZE = 'L'                                         16610000
359000        MOVE 1.00 TO H-CAPI-LARG-URBAN                            16620000
359100     ELSE                                                         16630000
359200        MOVE 1.00 TO H-CAPI-LARG-URBAN.                           16640000
359300                                                                  16650000
359400     COMPUTE H-CAPI-GAF    ROUNDED = (H-WAGE-INDEX ** .6848).     16660000
359500     COMPUTE H-PR-CAPI-GAF ROUNDED = (H-PR-WAGE-INDEX ** .6848).  16670000
359600                                                                  16680000
359700*****YEARCHANGE 2012.0 ************************************       16570000
359800     COMPUTE H-FEDERAL-RATE ROUNDED =                             16690000
359900                                 (0421.42 * H-CAPI-GAF).          16700000
360000     COMPUTE H-PUERTO-RICO-RATE ROUNDED =                         16710000
360100                                 (0203.86 * H-PR-CAPI-GAF).       16720000
360200*****YEARCHANGE 2012.0 ************************************       16570000
360300                                                                  16730000
360400     COMPUTE H-CAPI-COLA ROUNDED =                                16740000
360500                     (.3152 * (H-OPER-COLA - 1) + 1).             16750000
360600                                                                  16760000
360700     MOVE H-FEDERAL-RATE TO H-CAPI-FED-RATE.                      16770000
360800                                                                  16780000
360900     IF P-NEW-STATE = 40                                          16790000
361000        COMPUTE  H-CAPI-FED-RATE ROUNDED =                        16800000
361100                 (H-NAT-PCT * H-FEDERAL-RATE) +                   16810000
361200                 (H-REG-PCT * H-PUERTO-RICO-RATE).                16820000
361300***********************************************************       16830000
361400***  CAPITAL FSP CALCULATION                                      16840000
361500***  CAPITAL FSP CALCULATION                                      16850000
361600                                                                  16860000
361700     COMPUTE H-CAPI-FSP-PART ROUNDED =                            16870000
361800                               H-DRG-WT * H-CAPI-FED-RATE *       16880000
361900                               H-CAPI-COLA *                      16890000
362000                               H-CAPI-LARG-URBAN.                 16900000
362100                                                                  16910000
362200***********************************************************       16920000
362300***  CAPITAL PAYMENT METHOD A                                     16930000
362400***  CAPITAL PAYMENT METHOD A                                     16940000
362500                                                                  16950000
362600     IF P-N-SCH-REBASED-FY90 OR P-N-EACH                          16960000
362700        MOVE 1.00 TO H-CAPI-SCH                                   16970000
362800     ELSE                                                         16980000
362900        MOVE 0.85 TO H-CAPI-SCH.                                  16990000
363000                                                                  17000000
363100***********************************************************       17010000
363200***********  CAPITAL OLD-HOLD-HARMLESS CALCULATION ***********    17020000
363300***********  CAPITAL OLD-HOLD-HARMLESS CALCULATION ***********    17030000
363400                                                                  17040000
363500     COMPUTE H-CAPI-OLD-HARMLESS ROUNDED =                        17050000
363600                    (P-NEW-CAPI-OLD-HARM-RATE *                   17060000
363700                    H-CAPI-SCH).                                  17070000
363800                                                                  17080000
363900***********************************************************       17090000
364000        IF PAY-PERDIEM-DAYS                                       17100000
364100            IF  H-PERDIEM-DAYS < H-ALOS                           17110000
364200                IF  NOT (B-DRG = 789)                             17120000
364300                    PERFORM 3500-CALC-PERDIEM-AMT                 17130000
364400                    MOVE 03 TO PPS-RTC.                           17140000
364500                                                                  17150000
364600        IF PAY-XFER-SPEC-DRG                                      17160000
364700            IF  H-PERDIEM-DAYS < H-ALOS                           17170000
364800                IF  NOT (B-DRG = 789)                             17180000
364900                    PERFORM 3550-CALC-PERDIEM-AMT.                17190000
365000                                                                  17200000
365100        IF  PAY-XFER-NO-COST                                      17210000
365200            MOVE 00 TO PPS-RTC                                    17220000
365300            IF H-PERDIEM-DAYS < H-ALOS                            17230000
365400               IF  NOT (B-DRG = 789)                              17240000
365500                   PERFORM 3500-CALC-PERDIEM-AMT                  17250000
365600                   MOVE 06 TO PPS-RTC.                            17260000
365700                                                                  17270000
365800     PERFORM 4000-CALC-TECH-ADDON THRU 4000-EXIT.                 17280000
365900                                                                  17290000
366000     PERFORM 3600-CALC-OUTLIER THRU 3600-EXIT.                    17300000
366100                                                                  17310000
366200     IF OUTLIER-RECON-FLAG = 'Y' GO TO 3000-EXIT.                 17320000
366300                                                                  17330000
366400     IF PPS-RTC = 67  GO TO 3000-CONTINUE.                        17340000
366500                                                                  17350000
366600        IF PAY-XFER-SPEC-DRG                                      17360000
366700            IF  H-PERDIEM-DAYS < H-ALOS                           17370000
366800                IF  NOT (B-DRG = 789)                             17380000
366900                    PERFORM 3560-CHECK-RTN-CODE THRU 3560-EXIT.   17390000
367000                                                                  17400000
367100                                                                  17410000
367200        IF  PAY-PERDIEM-DAYS                                      17420000
367300            IF  H-OPER-OUTCST-PART > 0                            17430000
367400                MOVE H-OPER-OUTCST-PART TO                        17440000
367500                     H-OPER-OUTLIER-PART                          17450000
367600                MOVE 05 TO PPS-RTC                                17460000
367700            ELSE                                                  17470000
367800            IF  PPS-RTC NOT = 03                                  17480000
367900                MOVE 00 TO PPS-RTC                                17490000
368000                MOVE 0  TO H-OPER-OUTLIER-PART.                   17500000
368100                                                                  17510000
368200        IF  PAY-PERDIEM-DAYS                                      17520000
368300            IF  H-CAPI-OUTCST-PART > 0                            17530000
368400                MOVE H-CAPI-OUTCST-PART TO                        17540000
368500                     H-CAPI-OUTLIER-PART                          17550000
368600                MOVE 05 TO PPS-RTC                                17560000
368700            ELSE                                                  17570000
368800            IF  PPS-RTC NOT = 03                                  17580000
368900                MOVE 0  TO H-CAPI-OUTLIER-PART.                   17590000
369000                                                                  17600000
369100                                                                  15490000
369200     IF P-N-SCH-REBASED-FY90 OR                                   15500000
369300        P-N-EACH OR                                               15510000
369400        P-N-MDH-REBASED-FY90                                      15520000
369500         PERFORM 3450-CALC-ADDITIONAL-HSP.                        15530000
369600                                                                  15540000
369700                                                                  17610000
369800 3000-CONTINUE.                                                   17620000
369900                                                                  17630000
370000***********************************************************       17640000
370100***  DETERMINES THE FEDERAL AMOUNT THAT WOULD BE PAID IF          17650000
370200***  THE PROVIDER WAS TYPE B-HOLD-HARMLESS 100% FED RATE          17660000
370300                                                                  17670000
370400     COMPUTE H-CAPI2-B-FSP-PART ROUNDED = H-CAPI-FSP-PART.        17680000
370500                                                                  17690000
370600***********************************************************       17700000
370700                                                                  17710000
370800     IF  PPS-RTC = 67                                             17720000
370900         MOVE H-OPER-DOLLAR-THRESHOLD TO                          17730000
371000              WK-H-OPER-DOLLAR-THRESHOLD.                         17740000
371100                                                                  17750000
371200     IF  PPS-RTC < 50                                             17760000
371300         PERFORM 3800-CALC-TOT-AMT THRU 3800-EXIT                 17770000
371400     ELSE                                                         17780000
371500         MOVE ALL '0' TO PPS-OPER-HSP-PART                        17790000
371600                         PPS-OPER-FSP-PART                        17800000
371700                         PPS-OPER-OUTLIER-PART                    17810000
371800                         PPS-OUTLIER-DAYS                         17820000
371900                         PPS-REG-DAYS-USED                        17830000
372000                         PPS-LTR-DAYS-USED                        17840000
372100                         PPS-TOTAL-PAYMENT                        17850000
372200                         PPS-OPER-DSH-ADJ                         17860000
372300                         PPS-OPER-IME-ADJ                         17870000
372400                         H-DSCHG-FRCTN                            17880000
372500                         H-DRG-WT-FRCTN                           17890000
372600                         HOLD-ADDITIONAL-VARIABLES                17900000
372700                         HOLD-CAPITAL-VARIABLES                   17910000
372800                         HOLD-CAPITAL2-VARIABLES                  17920000
372900                         HOLD-OTHER-VARIABLES                     17930000
373000                         HOLD-PC-OTH-VARIABLES.                   17940000
373100                                                                  17950000
373200     IF  PPS-RTC = 67                                             17960000
373300         MOVE WK-H-OPER-DOLLAR-THRESHOLD TO                       17970000
373400                 H-OPER-DOLLAR-THRESHOLD.                         17980000
373500                                                                  17990000
373600 3000-EXIT.  EXIT.                                                18000000
373700                                                                  18010000
373800 3100-CALC-STAY-UTILIZATION.                                      18020000
373900                                                                  18030000
374000     MOVE 0 TO PPS-REG-DAYS-USED.                                 18040000
374100     MOVE 0 TO PPS-LTR-DAYS-USED.                                 18050000
374200                                                                  18060000
374300     IF H-REG-DAYS > 0                                            18070000
374400        IF H-REG-DAYS > B-LOS                                     18080000
374500           MOVE B-LOS TO PPS-REG-DAYS-USED                        18090000
374600        ELSE                                                      18100000
374700           MOVE H-REG-DAYS TO PPS-REG-DAYS-USED                   18110000
374800     ELSE                                                         18120000
374900        IF H-LTR-DAYS > B-LOS                                     18130000
375000           MOVE B-LOS TO PPS-LTR-DAYS-USED                        18140000
375100        ELSE                                                      18150000
375200           MOVE H-LTR-DAYS TO PPS-LTR-DAYS-USED.                  18160000
375300                                                                  18170000
375400                                                                  18180000
375500                                                                  18190000
375600 3300-CALC-OPER-FSP-AMT.                                          18200000
375700***********************************************************       18210000
375800***  OPERATING FSP CALCULATION                                    18220000
375900***  OPERATING FSP CALCULATION                                    18230000
376000                                                                  18240000
376100     COMPUTE H-OPER-FSP-PART ROUNDED =                            18250000
376200           (H-NAT-PCT * (H-NAT-LABOR * H-WAGE-INDEX +             18260000
376300            H-NAT-NONLABOR * H-OPER-COLA) * H-DRG-WT)             18270000
376400                   ON SIZE ERROR MOVE 0 TO H-OPER-FSP-PART.       18280000
376500                                                                  18290000
376600     IF P-NEW-STATE = 40                                          18300000
376700       COMPUTE H-OPER-FSP-PART ROUNDED =                          18310000
376800           (H-NAT-PCT * (H-NAT-LABOR * H-WAGE-INDEX +             18320000
376900            H-NAT-NONLABOR * H-OPER-COLA) * H-DRG-WT)             18330000
377000                           +                                      18340000
377100           (H-REG-PCT * (H-REG-LABOR * H-PR-WAGE-INDEX +          18350000
377200            H-REG-NONLABOR * H-OPER-COLA) * H-DRG-WT)             18360000
377300                   ON SIZE ERROR MOVE 0 TO H-OPER-FSP-PART.       18370000
377400                                                                  18380000
377500                                                                  18390000
377600 3500-CALC-PERDIEM-AMT.                                           19020000
377700***********************************************************       19030000
377800***  REVIEW CODE = 03 OR 06                                       19040000
377900***  OPERATING PERDIEM-AMT CALCULATION                            19050000
378000***  OPERATING HSP AND FSP CALCULATION FOR TRANSFERS              19060000
378100                                                                  19070000
378200        COMPUTE H-OPER-FSP-PART ROUNDED =                         19080000
378300        H-OPER-FSP-PART * H-TRANSFER-ADJ                          19090000
378400        ON SIZE ERROR MOVE 0 TO H-OPER-FSP-PART.                  19100000
378500                                                                  19110000
378600***********************************************************       19120000
378700***********************************************************       19130000
378800***  REVIEW CODE = 03 OR 06                                       19140000
378900***  CAPITAL   PERDIEM-AMT CALCULATION                            19150000
379000***  CAPITAL   HSP AND FSP CALCULATION FOR TRANSFERS              19160000
379100                                                                  19170000
379200        COMPUTE H-CAPI-FSP-PART ROUNDED =                         19180000
379300        H-CAPI-FSP-PART * H-TRANSFER-ADJ                          19190000
379400        ON SIZE ERROR MOVE 0 TO H-CAPI-FSP-PART.                  19200000
379500                                                                  19210000
379600***********************************************************       19220000
379700***  REVIEW CODE = 03 OR 06                                       19230000
379800***  CAPITAL PERDIEM-AMT, OLD-HARMLESS CALCULATION                19240000
379900***  CAPITAL PERDIEM-AMT, OLD-HARMLESS CALCULATION                19250000
380000                                                                  19260000
380100        COMPUTE H-CAPI-OLD-HARMLESS ROUNDED =                     19270000
380200        H-CAPI-OLD-HARMLESS * H-TRANSFER-ADJ                      19280000
380300        ON SIZE ERROR MOVE 0 TO H-CAPI-OLD-HARMLESS.              19290000
380400                                                                  19300000
380500 3550-CALC-PERDIEM-AMT.                                           19310000
380600***********************************************************       19320000
380700***  REVIEW CODE = 09  OR 11 TRANSFER WITH SPECIAL DRG            19330000
380800***  OPERATING PERDIEM-AMT CALCULATION                            19340000
380900***  OPERATING HSP AND FSP CALCULATION FOR TRANSFERS              19350000
381000                                                                  19360000
381100     IF (B-DRG-POSTACUTE-50-50)                                   19370000
381200        MOVE 10 TO PPS-RTC                                        19380000
381300        COMPUTE H-OPER-FSP-PART ROUNDED =                         19390000
381400        H-OPER-FSP-PART * (.5 * (1 + H-TRANSFER-ADJ))             19400000
381500        ON SIZE ERROR MOVE 0 TO H-OPER-FSP-PART.                  19410000
381600                                                                  19420000
381700     IF (B-DRG-POSTACUTE-PERDIEM)                                 19430000
381800        MOVE 12 TO PPS-RTC                                        19440000
381900        COMPUTE H-OPER-FSP-PART ROUNDED =                         19450000
382000        H-OPER-FSP-PART *  H-TRANSFER-ADJ                         19460000
382100        ON SIZE ERROR MOVE 0 TO H-OPER-FSP-PART.                  19470000
382200                                                                  19480000
382300***********************************************************       19490000
382400***  CAPITAL PERDIEM-AMT CALCULATION                              19500000
382500***  CAPITAL HSP AND FSP CALCULATION FOR TRANSFERS                19510000
382600                                                                  19520000
382700     IF (B-DRG-POSTACUTE-50-50)                                   19530000
382800        MOVE 10 TO PPS-RTC                                        19540000
382900        COMPUTE H-CAPI-FSP-PART ROUNDED =                         19550000
383000        H-CAPI-FSP-PART * (.5 * (1 + H-TRANSFER-ADJ))             19560000
383100        ON SIZE ERROR MOVE 0 TO H-CAPI-FSP-PART.                  19570000
383200                                                                  19580000
383300     IF (B-DRG-POSTACUTE-PERDIEM)                                 19590000
383400        MOVE 12 TO PPS-RTC                                        19600000
383500        COMPUTE H-CAPI-FSP-PART ROUNDED =                         19610000
383600        H-CAPI-FSP-PART *  H-TRANSFER-ADJ                         19620000
383700        ON SIZE ERROR MOVE 0 TO H-CAPI-FSP-PART.                  19630000
383800                                                                  19640000
383900***********************************************************       19650000
384000***  CAPITAL PERDIEM-AMT, OLD-HARMLESS CALCULATION                19660000
384100***  CAPITAL PERDIEM-AMT, OLD-HARMLESS CALCULATION                19670000
384200                                                                  19680000
384300     IF (B-DRG-POSTACUTE-50-50)                                   19690000
384400        MOVE 10 TO PPS-RTC                                        19700000
384500        COMPUTE H-CAPI-OLD-HARMLESS ROUNDED =                     19710000
384600        H-CAPI-OLD-HARMLESS * (.5 * (1 + H-TRANSFER-ADJ))         19720000
384700        ON SIZE ERROR MOVE 0 TO H-CAPI-OLD-HARMLESS.              19730000
384800                                                                  19740000
384900     IF (B-DRG-POSTACUTE-PERDIEM)                                 19750000
385000        MOVE 12 TO PPS-RTC                                        19760000
385100        COMPUTE H-CAPI-OLD-HARMLESS ROUNDED =                     19770000
385200        H-CAPI-OLD-HARMLESS *  H-TRANSFER-ADJ                     19780000
385300        ON SIZE ERROR MOVE 0 TO H-CAPI-OLD-HARMLESS.              19790000
385400                                                                  19800000
385500 3560-CHECK-RTN-CODE.                                             19810000
385600                                                                  19820000
385700     IF (B-DRG-POSTACUTE-50-50)                                   19830000
385800        MOVE 10 TO PPS-RTC.                                       19840000
385900     IF (B-DRG-POSTACUTE-PERDIEM)                                 19850000
386000        MOVE 12 TO PPS-RTC.                                       19860000
386100                                                                  19870000
386200 3560-EXIT.    EXIT.                                              19880000
386300                                                                  19890000
386400 3600-CALC-OUTLIER.                                               19900000
386500***********************************************************       19910000
386600***  COST OUTLIER OPERATING AND CAPITAL CALCULATION               19920000
386700***  COST OUTLIER OPERATING AND CAPITAL CALCULATION               19930000
386800                                                                  19940000
386900     IF OUTLIER-RECON-FLAG = 'Y'                                  19950000
387000        COMPUTE H-OPER-CSTCHG-RATIO ROUNDED =                     19960000
387100               (H-OPER-CSTCHG-RATIO + .2).                        19970000
387200                                                                  19980000
387300     IF H-CAPI-CSTCHG-RATIO > 0 OR                                19990000
387400       H-OPER-CSTCHG-RATIO > 0                                    20000000
387500        COMPUTE H-OPER-SHARE-DOLL-THRESHOLD ROUNDED =             20010000
387600                H-OPER-CSTCHG-RATIO /                             20020000
387700               (H-OPER-CSTCHG-RATIO + H-CAPI-CSTCHG-RATIO)        20030000
387800        COMPUTE H-CAPI-SHARE-DOLL-THRESHOLD ROUNDED =             20040000
387900                H-CAPI-CSTCHG-RATIO /                             20050000
388000               (H-OPER-CSTCHG-RATIO + H-CAPI-CSTCHG-RATIO)        20060000
388100     ELSE                                                         20070000
388200         MOVE 0 TO H-OPER-SHARE-DOLL-THRESHOLD                    20080000
388300                   H-CAPI-SHARE-DOLL-THRESHOLD.                   20090000
388400                                                                  20100000
388500***********************************************************       20110000
388600*****YEARCHANGE 2012.0 ************************************       20110000
388700***  OUTLIER THRESHOLD AMOUNTS                                    20120000
388800***  OUTLIER THRESHOLD AMOUNTS                                    20130000
388900                                                                  20140000
389000*****YEARCHANGE 2012.0 ************************************       20110000
389100                                                                  20140000
389200     MOVE 22385.00 TO H-CST-THRESH.                               20150000
389300                                                                  20140000
389400*****YEARCHANGE 2012.0 ************************************       20110000
389500                                                                  20160000
389600     IF (B-REVIEW-CODE = '03') AND                                20170000
389700         H-PERDIEM-DAYS < H-ALOS                                  20180000
389800        COMPUTE H-CST-THRESH ROUNDED =                            20190000
389900                      (H-CST-THRESH * H-TRANSFER-ADJ)             20200000
390000                ON SIZE ERROR MOVE 0 TO H-CST-THRESH.             20210000
390100                                                                  20220000
390200     IF ((B-REVIEW-CODE = '09') AND                               20230000
390300         (H-PERDIEM-DAYS < H-ALOS))                               20240000
390400         IF (B-DRG-POSTACUTE-PERDIEM)                             20250000
390500            COMPUTE H-CST-THRESH ROUNDED =                        20260000
390600                      (H-CST-THRESH * H-TRANSFER-ADJ)             20270000
390700                ON SIZE ERROR MOVE 0 TO H-CST-THRESH.             20280000
390800                                                                  20290000
390900     IF ((B-REVIEW-CODE = '09') AND                               20300000
391000         (H-PERDIEM-DAYS < H-ALOS))                               20310000
391100         IF (B-DRG-POSTACUTE-50-50)                               20320000
391200           COMPUTE H-CST-THRESH ROUNDED =                         20330000
391300          (H-CST-THRESH * (.5 * (1 + H-TRANSFER-ADJ)))            20340000
391400                ON SIZE ERROR MOVE 0 TO H-CST-THRESH.             20350000
391500                                                                  20360000
391600     COMPUTE H-OPER-DOLLAR-THRESHOLD ROUNDED =                    20370000
391700        ((H-CST-THRESH * H-LABOR-PCT * H-WAGE-INDEX) +            20380000
391800         (H-CST-THRESH * H-NONLABOR-PCT * H-OPER-COLA)) *         20390000
391900          H-OPER-SHARE-DOLL-THRESHOLD.                            20400000
392000                                                                  20410000
392100     IF P-NEW-STATE = 40                                          20420000
392200        COMPUTE H-OPER-PR-DOLLAR-THRESHOLD ROUNDED =              20430000
392300           ((H-CST-THRESH * H-PR-LABOR-PCT * H-PR-WAGE-INDEX) +   20440000
392400            (H-CST-THRESH * H-PR-NONLABOR-PCT * H-OPER-COLA)) *   20450000
392500             H-OPER-SHARE-DOLL-THRESHOLD                          20460000
392600        COMPUTE H-OPER-DOLLAR-THRESHOLD ROUNDED =                 20470000
392700               (H-OPER-DOLLAR-THRESHOLD * H-NAT-PCT) +            20480000
392800               (H-OPER-PR-DOLLAR-THRESHOLD * H-REG-PCT).          20490000
392900                                                                  20500000
393000***********************************************************       20510000
393100                                                                  20520000
393200     COMPUTE H-CAPI-DOLLAR-THRESHOLD ROUNDED =                    20530000
393300          H-CST-THRESH * H-CAPI-GAF * H-CAPI-LARG-URBAN *         20540000
393400          H-CAPI-SHARE-DOLL-THRESHOLD * H-CAPI-COLA.              20550000
393500                                                                  20560000
393600                                                                  20570000
393700     IF P-NEW-STATE = 40                                          20580000
393800        COMPUTE H-CAPI-PR-DOLLAR-THRESHOLD ROUNDED =              20590000
393900           H-CST-THRESH * H-PR-CAPI-GAF * H-CAPI-LARG-URBAN *     20600000
394000           H-CAPI-SHARE-DOLL-THRESHOLD * H-CAPI-COLA              20610000
394100        COMPUTE H-CAPI-DOLLAR-THRESHOLD ROUNDED =                 20620000
394200               (H-CAPI-DOLLAR-THRESHOLD * H-NAT-PCT) +            20630000
394300               (H-CAPI-PR-DOLLAR-THRESHOLD * H-REG-PCT).          20640000
394400                                                                  20650000
394500                                                                  20660000
394600     COMPUTE H-OPER-COST-OUTLIER ROUNDED =                        20670000
394700      (H-OPER-FSP-PART * (1 + H-OPER-IME-TEACH + H-OPER-DSH))     20680000
394800                       +                                          20690000
394900             H-OPER-DOLLAR-THRESHOLD                              20700000
395000                       +                                          20710000
395100                 H-NEW-TECH-PAY-ADD-ON.                           20720000
395200                                                                  20730000
395300     COMPUTE H-CAPI-COST-OUTLIER ROUNDED =                        20740000
395400      (H-CAPI-FSP-PART * (1 + H-WK-CAPI-IME-TEACH + H-CAPI-DSH))  20750000
395500                       +                                          20760000
395600             H-CAPI-DOLLAR-THRESHOLD.                             20770000
395700                                                                  20780000
395800     IF (P-NEW-CAPI-NEW-HOSP = 'Y')                               20790000
395900         MOVE 0 TO H-CAPI-COST-OUTLIER.                           20800000
396000                                                                  20810000
396100                                                                  20820000
396200***********************************************************       20830000
396300***  OPERATING COST CALCULATION                                   20840000
396400***  OPERATING COST CALCULATION                                   20850000
396500                                                                  20860000
396600     COMPUTE H-OPER-BILL-COSTS ROUNDED =                          20870000
396700         B-CHARGES-CLAIMED * H-OPER-CSTCHG-RATIO                  20880000
396800         ON SIZE ERROR MOVE 0 TO H-OPER-BILL-COSTS.               20890000
396900                                                                  20900000
397000                                                                  20910000
397100     IF  H-OPER-BILL-COSTS > H-OPER-COST-OUTLIER                  20920000
397200         COMPUTE H-OPER-OUTCST-PART ROUNDED =                     20930000
397300         H-CSTOUT-PCT * (H-OPER-BILL-COSTS -                      20940000
397400                         H-OPER-COST-OUTLIER).                    20950000
397500                                                                  20960000
397600     IF PAY-WITHOUT-COST OR                                       20970000
397700        PAY-XFER-NO-COST OR                                       20980000
397800        PAY-XFER-SPEC-DRG-NO-COST                                 20990000
397900         MOVE 0 TO H-OPER-OUTCST-PART.                            21000000
398000                                                                  21010000
398100***********************************************************       21020000
398200***  CAPITAL COST CALCULATION                                     21030000
398300***  CAPITAL COST CALCULATION                                     21040000
398400                                                                  21050000
398500     COMPUTE H-CAPI-BILL-COSTS ROUNDED =                          21060000
398600             B-CHARGES-CLAIMED * H-CAPI-CSTCHG-RATIO              21070000
398700         ON SIZE ERROR MOVE 0 TO H-CAPI-BILL-COSTS.               21080000
398800                                                                  21090000
398900     IF  H-CAPI-BILL-COSTS > H-CAPI-COST-OUTLIER                  21100000
399000         COMPUTE H-CAPI-OUTCST-PART ROUNDED =                     21110000
399100         H-CSTOUT-PCT * (H-CAPI-BILL-COSTS -                      21120000
399200                         H-CAPI-COST-OUTLIER).                    21130000
399300                                                                  21140000
399400     IF P-NEW-CAPI-PPS-PAY-CODE = 'A'                             21150000
399500       COMPUTE H-CAPI-OUTCST-PART ROUNDED =                       21160000
399600              (H-CAPI-OUTCST-PART * P-NEW-CAPI-NEW-HARM-RATIO).   21170000
399700                                                                  21180000
399800     IF P-NEW-CAPI-PPS-PAY-CODE = 'C'                             21190000
399900        COMPUTE H-CAPI-OUTCST-PART ROUNDED =                      21200000
400000               (H-CAPI-OUTCST-PART * H-CAPI-PAYCDE-PCT1).         21210000
400100                                                                  21220000
400200     IF (H-CAPI-BILL-COSTS   + H-OPER-BILL-COSTS) <               21230000
400300        (H-CAPI-COST-OUTLIER + H-OPER-COST-OUTLIER)               21240000
400400        MOVE 0 TO H-CAPI-OUTCST-PART                              21250000
400500                  H-OPER-OUTCST-PART.                             21260000
400600                                                                  21270000
400700     IF PAY-WITHOUT-COST OR                                       21280000
400800        PAY-XFER-NO-COST OR                                       21290000
400900        PAY-XFER-SPEC-DRG-NO-COST                                 21300000
401000         MOVE 0 TO H-CAPI-OUTCST-PART.                            21310000
401100                                                                  21320000
401200***********************************************************       21330000
401300***  DETERMINES THE BILL TO BE COST  OUTLIER                      21340000
401400                                                                  21350000
401500     IF (P-NEW-CAPI-NEW-HOSP = 'Y')                               21360000
401600         MOVE 0 TO H-CAPI-OUTDAY-PART                             21370000
401700                   H-CAPI-OUTCST-PART.                            21380000
401800                                                                  21390000
401900     IF (H-OPER-OUTCST-PART + H-CAPI-OUTCST-PART) > 0             21400000
402000                 MOVE H-OPER-OUTCST-PART TO                       21410000
402100                      H-OPER-OUTLIER-PART                         21420000
402200                 MOVE H-CAPI-OUTCST-PART TO                       21430000
402300                      H-CAPI-OUTLIER-PART                         21440000
402400                 MOVE 02 TO PPS-RTC.                              21450000
402500                                                                  21460000
402600     IF OUTLIER-RECON-FLAG = 'Y'                                  21470000
402700        IF (H-OPER-OUTCST-PART + H-CAPI-OUTCST-PART) > 0          21480000
402800           COMPUTE HLD-PPS-RTC = HLD-PPS-RTC + 30                 21490000
402900           GO TO 3600-EXIT                                        21500000
403000        ELSE                                                      21510000
403100           GO TO 3600-EXIT                                        21520000
403200     ELSE                                                         21530000
403300        NEXT SENTENCE.                                            21540000
403400                                                                  21550000
403500                                                                  21560000
403600***********************************************************       21570000
403700***  DETERMINES IF COST OUTLIER                                   21580000
403800***  RECOMPUTES DOLLAR THRESHOLD TO BE SENT BACK WITH             21590000
403900***         RETURN CODE OF 02                                     21600000
404000                                                                  21610000
404100     MOVE 0 TO H-OPER-DOLLAR-THRESHOLD.                           21620000
404200                                                                  21630000
404300     IF PPS-RTC = 02                                              21640000
404400             COMPUTE H-OPER-DOLLAR-THRESHOLD ROUNDED =            21650000
404500                     (H-CAPI-COST-OUTLIER  +                      21660000
404600                      H-OPER-COST-OUTLIER)                        21670000
404700                             /                                    21680000
404800                    (H-CAPI-CSTCHG-RATIO  +                       21690000
404900                     H-OPER-CSTCHG-RATIO)                         21700000
405000             ON SIZE ERROR MOVE 0 TO H-OPER-DOLLAR-THRESHOLD.     21710000
405100                                                                  21720000
405200***********************************************************       21730000
405300***  DETERMINES IF COST OUTLIER WITH LOS IS > COVERED  DAYS       21740000
405400***         RETURN CODE OF 67                                     21750000
405500                                                                  21760000
405600     IF PPS-RTC = 02                                              21770000
405700         IF ((H-REG-DAYS + H-LTR-DAYS) < B-LOS) OR                21780000
405800            PPS-PC-COT-FLAG = 'Y'                                 21790000
405900             MOVE 67 TO PPS-RTC.                                  21800000
406000***********************************************************       21810000
406100                                                                  21820000
406200***********************************************************       21830000
406300***  DETERMINES THE OUTLIER AMOUNT THAT WOULD BE PAID IF          21840000
406400***  THE PROVIDER WAS TYPE B-HOLD-HARMLESS 100% FED RATE          21850000
406500                                                                  21860000
406600     IF P-NEW-CAPI-PPS-PAY-CODE = 'A'                             21870000
406700        COMPUTE H-CAPI2-B-OUTLIER-PART ROUNDED =                  21880000
406800                H-CAPI-OUTLIER-PART / P-NEW-CAPI-NEW-HARM-RATIO   21890000
406900         ON SIZE ERROR MOVE 0 TO H-CAPI2-B-OUTLIER-PART.          21900000
407000                                                                  21910000
407100     IF P-NEW-CAPI-PPS-PAY-CODE = 'B'                             21920000
407200        COMPUTE H-CAPI2-B-OUTLIER-PART ROUNDED =                  21930000
407300                H-CAPI-OUTLIER-PART.                              21940000
407400                                                                  21950000
407500     IF P-NEW-CAPI-PPS-PAY-CODE = 'C'                             21960000
407600        COMPUTE H-CAPI2-B-OUTLIER-PART ROUNDED =                  21970000
407700                H-CAPI-OUTLIER-PART / H-CAPI-PAYCDE-PCT1          21980000
407800         ON SIZE ERROR MOVE 0 TO H-CAPI2-B-OUTLIER-PART.          21990000
407900                                                                  22000000
408000 3600-EXIT.   EXIT.                                               22010000
408100                                                                  22020000
408200 3450-CALC-ADDITIONAL-HSP.                                        18400000
408300***********************************************************       18410000
408400*    OBRA 89 CALCULATE ADDITIONAL HSP PAYMENT FOR                 18420000
408500*    SOLE COMMUNITY                                               18430000
408600*    AND ESSENTIAL ACCESS COMMUNITY HOSPITALS (EACH)              18440000
408700*    NOW REIMBURSED WITH 100% NATIONAL FEDERAL RATES              18450000
408800***********************************************************       18460000
408900***         GET THE UPDATING FACTOR                               18480000
409000***         GET THE UPDATING FACTOR                               18490000
409100                                                                  18500000
409200*****YEARCHANGE 2010.0 ****************************************   18470000
409300     MOVE 0.995743 TO H-BUDG-NUTR08.                              18510000
409400     MOVE 0.998795 TO H-BUDG-NUTR09.                              18510000
409500*****YEARCHANGE 2010.0 ****************************************   18470000
409600     MOVE 0.997941 TO H-BUDG-NUTR10.                              18510000
409700*****YEARCHANGE 2010.9 ****************************************   18470000
409800     MOVE 0.997935 TO H-BUDG-NUTR109.                             18510000
409900*****YEARCHANGE 2011.0 ****************************************   18470000
410000     MOVE 0.996731 TO H-BUDG-NUTR113.                             18510000
410100*****YEARCHANGE 2011.0 ****************************************   18470000
410200*****YEARCHANGE 2012.0 ****************************************   18470000
410300     MOVE 0.997903 TO H-BUDG-NUTR120.                             18510000
410400*****YEARCHANGE 2012.0 ****************************************   18470000
410500                                                                  18520000
410600     MOVE 1.0330 TO H-UPDATE-08.                                  18530000
410700
410800*****YEARCHANGE 2009.0 ****************************************   18470000
410900        MOVE 1.0360 TO H-UPDATE-09.
411000*****YEARCHANGE 2009.0 ****************************************   18470000
411100*****YEARCHANGE 2010.0 ****************************************   18470000
411200        MOVE 1.0210 TO H-UPDATE-10
411300*****YEARCHANGE 2010.0 ****************************************   18470000
411400*****YEARCHANGE 2010.9 ****************************************   18470000
411500        MOVE 1.0185 TO H-UPDATE-109
411600*****YEARCHANGE 2010.9 ****************************************   18470000
411700        MOVE 1.0235 TO H-UPDATE-113
411800
411900     IF P-NEW-CBSA-HOSP-QUAL-IND = '1'
412000*****YEARCHANGE 2012.0 ****************************************   18470000
412100        MOVE 1.0190 TO H-UPDATE-120
412200     ELSE
412300        MOVE 0.9990 TO H-UPDATE-120.
412400*****YEARCHANGE 2012.0 ****************************************   18470000
412500
412600     IF P-NEW-STATE = 40                                          16790000
412700*****YEARCHANGE 2010.96****************************************   18470000
412800        MOVE 1.0210 TO H-UPDATE-109.
412900*****YEARCHANGE 2010.9 ****************************************   18470000
413000
413100     IF P-NEW-STATE = 40                                          16790000
413200*****YEARCHANGE 2011.0 ****************************************   18470000
413300        MOVE 1.0235 TO H-UPDATE-113.
413400*****YEARCHANGE 2011.0 ****************************************   18470000
413500
413600     IF P-NEW-STATE = 40                                          16790000
413700*****YEARCHANGE 2011.0 ****************************************   18470000
413800        MOVE 1.0190 TO H-UPDATE-120.
413900*****YEARCHANGE 2011.0 ****************************************   18470000
414000
414100********YEARCHANGE 2012.0 *************************************   18590000
414200***         CASE MIX ADJUSTMENT - BROUGHT BACK FOR 2011           18480000
414300***         CASE MIX ADJUSTMENT - BROUGHT BACK FOR 2011           18480000
414400     MOVE 0.9528 TO H-CASE-MIX-ADJ.                                     00
414500     MOVE 1.0090 TO H-HSP-CAPECOD-ADJ.                                  00
414600
414700     COMPUTE H-UPDATE-FACTOR ROUNDED =
414800                       (H-UPDATE-08 * H-UPDATE-09 *
414900                        H-UPDATE-109 * H-UPDATE-113 *
415000                        H-UPDATE-120 *
415100                        H-BUDG-NUTR08 * H-BUDG-NUTR09 *
415200                        H-BUDG-NUTR109 * H-BUDG-NUTR113 *
415300                        H-BUDG-NUTR120 * H-HSP-CAPECOD-ADJ *
415400                        H-CASE-MIX-ADJ).                                00
415500
415600     COMPUTE H-HSP-RATE ROUNDED =
415700         H-FAC-SPEC-RATE * H-UPDATE-FACTOR * H-DRG-WT.
415800***************************************************************
415900*
416000*    IF P-NEW-CBSA-HOSP-QUAL-IND = '1'                            18537000
416100*       COMPUTE H-HSP-RATE ROUNDED =                              18538000
416200*        (H-FAC-SPEC-RATE * 1) * H-UPDATE-FACTOR                  18539000
416300*    ELSE                                                         18540000
416400*       COMPUTE H-HSP-RATE ROUNDED =                              18550000
416500*        ((H-FAC-SPEC-RATE / 1.036) * 1.016) * H-UPDATE-FACTOR.   18560000
416600*                                                                 18570000
416700***************************************************************   18580000
416800********YEARCHANGE 2011.0 *************************************   18590000
416900***     OUTLIER OFFSETS                                           18591000
417000***     OPERATING NATIONAL                                        18600000
417100***     OPERATING PUERTO RICO BLEND                               18610000
417200                                                                  18620000
417300********YEARCHANGE 2012.0 *************************************   18590000
417400                                                                  18620000
417500      MOVE 0.948999 TO H-OUTLIER-OFFSET-NAT                       18630000
417600      MOVE 0.953549 TO H-OUTLIER-OFFSET-PR.                       18640000
417700                                                                  18620000
417800********YEARCHANGE 2012.0 *************************************   18590000
417900***************************************************************   18660000
418000     COMPUTE H-FSP-RATE ROUNDED =                                 18670000
418100        ((H-NAT-PCT * (H-NAT-LABOR * H-WAGE-INDEX +               18680000
418200         H-NAT-NONLABOR * H-OPER-COLA)) * H-DRG-WT)               18690000
418300                           *                                      18700000
418400     (1 + H-OPER-IME-TEACH + H-OPER-DSH) +
418500                         H-OPER-OUTLIER-PART
418600                   ON SIZE ERROR MOVE 0 TO H-FSP-RATE.            18720000
418700                                                                  18730000
418800     IF P-NEW-STATE = 40                                          18740000
418900       COMPUTE H-FSP-RATE ROUNDED =                               18750000
419000         ((H-NAT-PCT * (H-NAT-LABOR * H-WAGE-INDEX +              18760000
419100         H-NAT-NONLABOR * H-OPER-COLA))  * H-DRG-WT)              18770000
419200                           *                                      18780000
419300         (1 + H-OPER-IME-TEACH + H-OPER-DSH) +                    187810
419400                            H-OPER-OUTLIER-PART                   187820
419500                               +                                  187830
419600        ((H-REG-PCT * (H-REG-LABOR * H-PR-WAGE-INDEX +            18790000
419700         H-REG-NONLABOR * H-OPER-COLA)) * H-DRG-WT)               18800000
419800                           *                                      18810000
419900       (1 + H-OPER-IME-TEACH + H-OPER-DSH)
420000                   ON SIZE ERROR MOVE 0 TO H-FSP-RATE.            18830000
420100                                                                  18840000
420200                                                                  18850000
420300     IF  H-HSP-RATE > H-FSP-RATE                                  18860000
420400           COMPUTE H-OPER-HSP-PART ROUNDED =                      18870000
420500             (H-HSP-RATE - H-FSP-RATE)                            18880000
420600                   ON SIZE ERROR MOVE 0 TO H-OPER-HSP-PART        18890000
420700     ELSE                                                         18900000
420800         MOVE 0 TO H-OPER-HSP-PART.                               18910000
420900                                                                  18920000
421000***************************************************************   18930000
421100***         GET THE MDH REBASE                                    18940000
421200                                                                  18950000
421300     IF  H-HSP-RATE > H-FSP-RATE                                  18960000
421400         IF P-NEW-PROVIDER-TYPE = '14' OR '15'                    18970000
421500           COMPUTE H-OPER-HSP-PART ROUNDED =                      18980000
421600             (H-HSP-RATE - H-FSP-RATE) * .75                      18990000
421700                   ON SIZE ERROR MOVE 0 TO H-OPER-HSP-PART.       19000000
421800                                                                  19010000
421900***********************************************************       22030000
422000 3800-CALC-TOT-AMT.                                               22040000
422100***********************************************************       22050000
422200***  CALCULATE TOTALS FOR CAPITAL                                 22060000
422300***  CALCULATE TOTALS FOR CAPITAL                                 22070000
422400                                                                  22080000
422500     MOVE P-NEW-CAPI-PPS-PAY-CODE  TO H-CAPI2-PAY-CODE.           22090000
422600                                                                  22100000
422700     IF P-NEW-CAPI-PPS-PAY-CODE = 'A'                             22110000
422800        MOVE P-NEW-CAPI-NEW-HARM-RATIO TO H-CAPI-FSP-PCT          22120000
422900        MOVE 0.00 TO H-CAPI-HSP-PCT.                              22130000
423000                                                                  22140000
423100     IF P-NEW-CAPI-PPS-PAY-CODE = 'B'                             22150000
423200        MOVE 0    TO H-CAPI-OLD-HARMLESS                          22160000
423300        MOVE 1.00 TO H-CAPI-FSP-PCT                               22170000
423400        MOVE 0.00 TO H-CAPI-HSP-PCT.                              22180000
423500                                                                  22190000
423600     IF P-NEW-CAPI-PPS-PAY-CODE = 'C'                             22200000
423700        MOVE 0    TO H-CAPI-OLD-HARMLESS                          22210000
423800        MOVE H-CAPI-PAYCDE-PCT1 TO H-CAPI-FSP-PCT                 22220000
423900        MOVE H-CAPI-PAYCDE-PCT2 TO H-CAPI-HSP-PCT.                22230000
424000                                                                  22240000
424100     COMPUTE H-CAPI-HSP ROUNDED =                                 22250000
424200         H-CAPI-HSP-PCT * H-CAPI-HSP-PART.                        22260000
424300                                                                  22270000
424400     COMPUTE H-CAPI-FSP ROUNDED =                                 22280000
424500         H-CAPI-FSP-PCT * H-CAPI-FSP-PART.                        22290000
424600                                                                  22300000
424700     MOVE P-NEW-CAPI-EXCEPTIONS TO H-CAPI-EXCEPTIONS.             22310000
424800                                                                  22320000
424900     MOVE H-CAPI-OLD-HARMLESS TO H-CAPI-OLD-HARM.                 22330000
425000                                                                  22340000
425100     COMPUTE H-CAPI-DSH-ADJ ROUNDED =                             22350000
425200             H-CAPI-FSP                                           22360000
425300              * H-CAPI-DSH.                                       22370000
425400                                                                  22380000
425500     COMPUTE H-CAPI-IME-ADJ ROUNDED =                             22390000
425600          H-CAPI-FSP *                                            22400000
425700                 H-WK-CAPI-IME-TEACH.                             22410000
425800                                                                  22420000
425900     COMPUTE H-CAPI-OUTLIER ROUNDED =                             22430000
426000             1.00 * H-CAPI-OUTLIER-PART.                          22440000
426100                                                                  22450000
426200     COMPUTE H-CAPI2-B-FSP ROUNDED =                              22460000
426300             1.00 * H-CAPI2-B-FSP-PART.                           22470000
426400                                                                  22480000
426500     COMPUTE H-CAPI2-B-OUTLIER ROUNDED =                          22490000
426600             1.00 * H-CAPI2-B-OUTLIER-PART.                       22500000
426700***********************************************************       22510000
426800***  IF CAPITAL IS NOT IN EFFECT FOR GIVEN PROVIDER               22520000
426900***        THIS ZEROES OUT ALL CAPITAL DATA                       22530000
427000                                                                  22540000
427100     IF (P-NEW-CAPI-NEW-HOSP = 'Y')                               22550000
427200        MOVE ALL '0' TO HOLD-CAPITAL-VARIABLES.                   22560000
427300***********************************************************       22570000
427400                                                                  22580000
427500***********************************************************       22590000
427600***  CALCULATE FINAL TOTALS FOR OPERATING                         22600000
427700***  CALCULATE FINAL TOTALS FOR OPERATING                         22610000
427800                                                                  22620000
427900     IF (H-CAPI-OUTLIER > 0 AND                                   22630000
428000         PPS-OPER-OUTLIER-PART = 0)                               22640000
428100            COMPUTE PPS-OPER-OUTLIER-PART =                       22650000
428200                    PPS-OPER-OUTLIER-PART + .01.                  22660000
428300                                                                  22670000
428400     MOVE 01.000 TO WK-LOW-VOL25PCT.                              22680000
428500                                                                  22690000
428600     IF P-NEW-TEMP-RELIEF-IND = 'Y'                               22700000
428700     MOVE P-NEW-PROVIDER-NO      TO MES-PPS-PROV                  13830000
428800     PERFORM 4400-LOWVOL-CODE-RTN THRU 4400-EXIT.
428900
429000*****SET THE LOW-VOLUME DISCHARGE PERCENT
429100**   ADD ON TO 25% FOR DISCHARGES
429200
429300     IF P-NEW-TEMP-RELIEF-IND = 'Y'
429400     AND MESWK-LOWVOL-PROV-DISCHG < 200
429500            MOVE 00.250 TO WK-LOW-VOL25PCT
429600            GO TO LOW-VOL-CALC.
429700
429800***  CALCULATE THE LOW VOLUME DISCHARGE PERCENT
429900***  SLIDING SCALE ADD ON FOR
430000
430100     IF P-NEW-TEMP-RELIEF-IND = 'Y'
430200        AND MESWK-LOWVOL-PROV-DISCHG > 200
430300        AND MESWK-LOWVOL-PROV-DISCHG < 1600
430400            COMPUTE  WK-LOW-VOL25PCT ROUNDED =
430500            ((4 / 14) - (MESWK-LOWVOL-PROV-DISCHG / 5600))
430600            GO TO LOW-VOL-CALC
430700     ELSE
430800           MOVE 01.000 TO WK-LOW-VOL25PCT.
430900
431000 LOW-VOL-CALC.
431100
431200     MOVE ZERO TO PPS-OPER-DSH-ADJ.                               22730000
431300                                                                  22740000
431400     IF  H-OPER-DSH NUMERIC                                       22750000
431500         COMPUTE PPS-OPER-DSH-ADJ ROUNDED =                       22760000
431600                          PPS-OPER-FSP-PART  * H-OPER-DSH.        22770000
431700                                                                  22780000
431800     COMPUTE PPS-OPER-IME-ADJ ROUNDED =                           22790000
431900                         PPS-OPER-FSP-PART * H-OPER-IME-TEACH.    22800000
432000                                                                  22810000
432100                                                                  22820000
432200     COMPUTE PPS-OPER-FSP-PART ROUNDED =                          22830000
432300                           H-OPER-FSP-PART * H-OPER-FSP-PCT.      22840000
432400                                                                  22850000
432500     COMPUTE PPS-OPER-HSP-PART ROUNDED =                          22860000
432600                           H-OPER-HSP-PART * H-OPER-HSP-PCT.      22870000
432700                                                                  22880000
432800     COMPUTE PPS-OPER-OUTLIER-PART ROUNDED =                      22890000
432900                         H-OPER-OUTLIER-PART * H-OPER-FSP-PCT.    22900000
433000                                                                  22910000
433100     COMPUTE PPS-NEW-TECH-PAY-ADD-ON ROUNDED =                    23040000
433200                                H-NEW-TECH-PAY-ADD-ON.            23050000
433300                                                                  23060000
433400     IF  WK-LOW-VOL25PCT < 1.000000                                     00
433500     COMPUTE WK-LOW-VOL-ADDON  ROUNDED =                          23040000
433600              (PPS-OPER-HSP-PART + PPS-OPER-FSP-PART +            23154000
433700               PPS-OPER-OUTLIER-PART + PPS-OPER-DSH-ADJ +         23155000
433800                      PPS-OPER-IME-ADJ                            23156000
433900                           +                                      23157000
434000             H-CAPI-HSP + H-CAPI-FSP + H-CAPI-EXCEPTIONS +        23000000
434100             H-CAPI-OUTLIER + H-CAPI-DSH-ADJ +                    23010000
434200             H-CAPI-IME-ADJ + H-CAPI-OLD-HARM +                   23020000
434300                 PPS-NEW-TECH-PAY-ADD-ON) *  WK-LOW-VOL25PCT      23158000
434400     ELSE
434500     COMPUTE WK-LOW-VOL-ADDON  ROUNDED = 0.000000.                23040000
434600                                                                  23060000
434700     COMPUTE H-LOW-VOL-PAYMENT ROUNDED = WK-LOW-VOL-ADDON.        23040000
434800                                                                  23060000
434900     IF HMO-TAG  = 'Y'                                            22920000
435000        PERFORM 3850-HMO-IME-ADJ.                                 22930000
435100                                                                  22940000
435200***********************************************************       22950000
435300***  CALCULATE FINAL TOTALS FOR CAPITAL AND OPERATING             22960000
435400***  CALCULATE FINAL TOTALS FOR CAPITAL AND OPERATING             22970000
435500                                                                  22980000
435600     COMPUTE H-CAPI-TOTAL-PAY ROUNDED =                           22990000
435700             H-CAPI-HSP + H-CAPI-FSP + H-CAPI-EXCEPTIONS +        23000000
435800             H-CAPI-OUTLIER + H-CAPI-DSH-ADJ +                    23010000
435900             H-CAPI-IME-ADJ + H-CAPI-OLD-HARM.                    23020000
436000                                                                  23030000
436100     COMPUTE   PPS-TOTAL-PAYMENT ROUNDED =                        23153000
436200               PPS-OPER-HSP-PART + PPS-OPER-FSP-PART +            23154000
436300               PPS-OPER-OUTLIER-PART + PPS-OPER-DSH-ADJ +         23155000
436400                      PPS-OPER-IME-ADJ                            23156000
436500                           +                                      23157000
436600                 PPS-NEW-TECH-PAY-ADD-ON                          23158000
436700                           +                                      23159000
436800                  WK-LOW-VOL-ADDON                                23159000
436900                           +                                      23159000
437000                 H-WK-PASS-AMT-PLUS-MISC                          23160000
437100                           +                                      23170000
437200                   H-CAPI-TOTAL-PAY.                              23180000
437300                                                                  23190000
437400     MOVE     P-VAL-BASED-PURCH-PARTIPNT TO
437500              H-VAL-BASED-PURCH-PARTIPNT.
437600     COMPUTE  H-VAL-BASED-PURCH-ADJUST   ROUNDED =
437700              P-VAL-BASED-PURCH-ADJUST.
437800     MOVE     P-HOSP-READMISSION-REDU    TO
437900              H-HOSP-READMISSION-REDU.
438000     COMPUTE  H-HOSP-HRR-ADJUSTMT        ROUNDED =
438100              P-HOSP-HRR-ADJUSTMT.
438200                                                                  23190000
438300 3800-EXIT.   EXIT.                                               24540000
438400                                                                  24550000
438500 3850-HMO-IME-ADJ.                                                23200000
438600***********************************************************       23210000
438700***  HMO CALC FOR PASS-THRU ADDON                                 23220000
438800***  HMO CALC FOR PASS-THRU ADDON                                 23230000
438900                                                                  23240000
439000     COMPUTE H-WK-PASS-AMT-PLUS-MISC ROUNDED =                    23250000
439100          (P-NEW-PASS-AMT-PLUS-MISC -                             23260000
439200          (P-NEW-PASS-AMT-ORGAN-ACQ +                             23270000
439300           P-NEW-PASS-AMT-DIR-MED-ED)) * B-LOS.                   23280000
439400                                                                  23290000
439500***********************************************************       23300000
439600***  HMO IME ADJUSTMENT --- NO LONGER PAID AS OF 10/01/2002       23310000
439700                                                                  23320000
439800     COMPUTE PPS-OPER-IME-ADJ ROUNDED =                           23330000
439900                   PPS-OPER-IME-ADJ * .0.                         23340000
440000                                                                  23350000
440100***********************************************************       23360000
440200                                                                  23370000
440300                                                                  23380000
440400 3900A-CALC-OPER-DSH.                                             23390000
440500                                                                  23400000
440600***  OPERATING DSH CALCULATION                                    23410000
440700***  OPERATING DSH CALCULATION                                    23420000
440800                                                                  23430000
440900      MOVE 0.0000 TO H-OPER-DSH.                                  23440000
441000                                                                  23450000
441100      COMPUTE H-WK-OPER-DSH ROUNDED  = (P-NEW-SSI-RATIO           23460000
441200                                     + P-NEW-MEDICAID-RATIO).     23470000
441300                                                                  23480000
441400***********************************************************       23490000
441500**1**    0-99 BEDS                                                23500000
441600***  NOT TO EXCEED 12%                                            23510000
441700                                                                  23520000
441800      IF (W-CBSA-SIZE = 'O' OR 'L') AND P-NEW-BED-SIZE < 100      23530000
441900                               AND H-WK-OPER-DSH > .1499          23540000
442000                               AND H-WK-OPER-DSH < .2020          23550000
442100        COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .15)        23560000
442200                                      * .65 + .025                23570000
442300        IF H-OPER-DSH > .1200  MOVE .1200 TO H-OPER-DSH.          23580000
442400                                                                  23590000
442500      IF (W-CBSA-SIZE = 'O' OR 'L') AND P-NEW-BED-SIZE < 100      23600000
442600                               AND H-WK-OPER-DSH > .2019          23610000
442700        COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .202)       23620000
442800                                      * .825 + .0588              23630000
442900        IF H-OPER-DSH > .1200  MOVE .1200 TO H-OPER-DSH.          23640000
443000                                                                  23650000
443100***********************************************************       23660000
443200**2**   100 + BEDS                                                23670000
443300***  NO CAP >> CAN EXCEED 12%                                     23680000
443400                                                                  23690000
443500      IF (W-CBSA-SIZE = 'O' OR 'L') AND P-NEW-BED-SIZE > 99       23700000
443600                               AND H-WK-OPER-DSH > .1499          23710000
443700                               AND H-WK-OPER-DSH < .2020          23720000
443800        COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .15)        23730000
443900                                      * .65 + .025.               23740000
444000                                                                  23750000
444100      IF (W-CBSA-SIZE = 'O' OR 'L') AND P-NEW-BED-SIZE > 99       23760000
444200                               AND H-WK-OPER-DSH > .2019          23770000
444300        COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .202)       23780000
444400                                      * .825 + .0588.             23790000
444500                                                                  23800000
444600***********************************************************       23810000
444700**3**   OTHER RURAL HOSPITALS LESS THEN 500 BEDS                  23820000
444800***  NOT TO EXCEED 12%                                            23830000
444900                                                                  23840000
445000      IF W-CBSA-SIZE = 'R'     AND P-NEW-BED-SIZE < 500           23850000
445100                               AND H-WK-OPER-DSH > .1499          23860000
445200                               AND H-WK-OPER-DSH < .2020          23870000
445300        COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .15)        23880000
445400                                 * .65 + .025                     23890000
445500        IF H-OPER-DSH > .1200                                     23900000
445600              MOVE .1200 TO H-OPER-DSH.                           23910000
445700                                                                  23920000
445800      IF W-CBSA-SIZE = 'R'     AND P-NEW-BED-SIZE < 500           23930000
445900                               AND H-WK-OPER-DSH > .2019          23940000
446000        COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .202)       23950000
446100                                 * .825 + .0588                   23960000
446200        IF H-OPER-DSH > .1200                                     23970000
446300                 MOVE .1200 TO H-OPER-DSH.                        23980000
446400***********************************************************       23990000
446500**4**   OTHER RURAL HOSPITALS 500 BEDS +                          24000000
446600***  NO CAP >> CAN EXCEED 12%                                     24010000
446700                                                                  24020000
446800      IF W-CBSA-SIZE = 'R'     AND P-NEW-BED-SIZE > 499           24030000
446900                               AND H-WK-OPER-DSH > .1499          24040000
447000                               AND H-WK-OPER-DSH < .2020          24050000
447100        COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .15)        24060000
447200                                 * .65 + .025.                    24070000
447300                                                                  24080000
447400      IF W-CBSA-SIZE = 'R'     AND P-NEW-BED-SIZE > 499           24090000
447500                               AND H-WK-OPER-DSH > .2019          24100000
447600        COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .202)       24110000
447700                                 * .825 + .0588.                  24120000
447800                                                                  24130000
447900***********************************************************       24140000
448000**7**   RURAL HOSPITALS SCH                                       24150000
448100***  NOT TO EXCEED 12%                                            24160000
448200                                                                  24170000
448300      IF W-CBSA-SIZE = 'R'                                        24180000
448400         IF (P-NEW-PROVIDER-TYPE = '16' OR '17' OR '21' OR '22')  24190000
448500                               AND H-WK-OPER-DSH > .1499          24200000
448600                               AND H-WK-OPER-DSH < .2020          24210000
448700         COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .15)       24220000
448800                                 * .65 + .025                     24230000
448900        IF H-OPER-DSH > .1200                                     24240000
449000                 MOVE .1200 TO H-OPER-DSH.                        24250000
449100                                                                  24260000
449200      IF W-CBSA-SIZE = 'R'                                        24270000
449300         IF (P-NEW-PROVIDER-TYPE = '16' OR '17' OR '21' OR '22')  24280000
449400                               AND H-WK-OPER-DSH > .2019          24290000
449500         COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .202)      24300000
449600                                 * .825 + .0588                   24310000
449700        IF H-OPER-DSH > .1200                                     24320000
449800                 MOVE .1200 TO H-OPER-DSH.                        24330000
449900                                                                  24340000
450000***********************************************************       24350000
450100**6**   RURAL HOSPITALS RRC   RULE 5 & 6 SAME                     24360000
450200***  RRC OVERRIDES SCH CAP                                        24370000
450300***  NO CAP >> CAN EXCEED 12%                                     24380000
450400                                                                  24390000
450500         IF (P-NEW-PROVIDER-TYPE = '07' OR '14' OR '15' OR        24400000
450600                                   '17' OR '22')                  24410000
450700                               AND H-WK-OPER-DSH > .1499          24420000
450800                               AND H-WK-OPER-DSH < .2020          24430000
450900         COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .15)       24440000
451000                                 * .65 + .025.                    24450000
451100                                                                  24450000
451200         IF (P-NEW-PROVIDER-TYPE = '07' OR '14' OR '15' OR        24460000
451300                                   '17' OR '22')                  24470000
451400                               AND H-WK-OPER-DSH > .2019          24480000
451500         COMPUTE H-OPER-DSH ROUNDED = (H-WK-OPER-DSH - .202)      24490000
451600                                 * .825 + .0588.                  24500000
451700                                                                  24510000
451800      COMPUTE H-OPER-DSH ROUNDED = H-OPER-DSH * 1.0000.           24520000
451900                                                                  24530000
452000 3900A-EXIT.   EXIT.                                              24540000
452100                                                                  24550000
452200 4000-CALC-TECH-ADDON.                                            24560000
452300                                                                  24570000
452400***********************************************************       24580000
452500***  CALCULATE TOTALS FOR OPERATING  ADD ON FOR TECH              24590000
452600***  CALCULATE TOTALS FOR OPERATING  ADD ON FOR TECH              24600000
452700                                                                  24610000
452800     COMPUTE PPS-OPER-HSP-PART ROUNDED =                          24620000
452900         H-OPER-HSP-PCT * H-OPER-HSP-PART.                        24630000
453000                                                                  24640000
453100     COMPUTE PPS-OPER-FSP-PART ROUNDED =                          24650000
453200         H-OPER-FSP-PCT * H-OPER-FSP-PART.                        24660000
453300                                                                  24670000
453400     MOVE ZERO TO PPS-OPER-DSH-ADJ.                               24680000
453500                                                                  24690000
453600     IF  H-OPER-DSH NUMERIC                                       24700000
453700             COMPUTE PPS-OPER-DSH-ADJ ROUNDED =                   24710000
453800              PPS-OPER-FSP-PART                                   24720000
453900              * H-OPER-DSH.                                       24730000
454000                                                                  24740000
454100     COMPUTE PPS-OPER-IME-ADJ ROUNDED =                           24750000
454200             PPS-OPER-FSP-PART *                                  24760000
454300             H-OPER-IME-TEACH.                                    24770000
454400                                                                  24780000
454500     COMPUTE H-BASE-DRG-PAYMENT ROUNDED =                         24790000
454600             PPS-OPER-HSP-PART + PPS-OPER-FSP-PART +              24800000
454700             PPS-OPER-DSH-ADJ + PPS-OPER-IME-ADJ.                 24810000
454800                                                                  24820000
454900***********************************************************       24830000
455000****      NEUROSTIMULATOR CASES                                   24840000
455100***********************************************************       24850000
455200*                                                                 24860000
455300*    IF '8698   ' =  B-PRIN-PROC-CODE   OR                        24870000
455400*                    B-OTHER-PROC-CODE1 OR                        24880000
455500*                    B-OTHER-PROC-CODE2 OR                        24890000
455600*                    B-OTHER-PROC-CODE3 OR                        24900000
455700*                    B-OTHER-PROC-CODE4 OR                        24910000
455800*                    B-OTHER-PROC-CODE5                           24920000
455900*          NEXT SENTENCE                                          24930000
456000*    ELSE                                                         24940000
456100*          MOVE ZEROES TO H-NEW-TECH-ADDON-NEURO                  24950000
456200*          GO TO 4000-CHECK-GRAFT-CASES.                          24960000
456300*                                                                 24970000
456400*    MOVE 18640.00 TO H-CSTMED-NEURO.                             24980000
456500*                                                                 24990000
456600*    COMPUTE H-LESSER-NEURO-1 ROUNDED =                           25000000
456700*            .5   H-CSTMED-NEURO.                                 25010000
456800*                                                                 25020000
456900*    COMPUTE H-LESSER-NEURO-2 ROUNDED =                           25030000
457000*          ((B-CHARGES-CLAIMED   P-NEW-OPER-CSTCHG-RATIO) -       25040000
457100*                    H-BASE-DRG-PAYMENT)   .5.                    25050000
457200*                                                                 25060000
457300*    IF H-LESSER-NEURO-2 > 0                                      25070000
457400*       IF H-LESSER-NEURO-1 < H-LESSER-NEURO-2                    25080000
457500*          MOVE H-LESSER-NEURO-1 TO H-NEW-TECH-ADDON-NEURO        25090000
457600*       ELSE                                                      25100000
457700*          MOVE H-LESSER-NEURO-2 TO H-NEW-TECH-ADDON-NEURO        25110000
457800*    ELSE                                                         25120000
457900*       MOVE ZEROES          TO H-NEW-TECH-ADDON-NEURO.           25130000
458000*                                                                 25140000
458100*4000-CHECK-GRAFT-CASES.                                          25150000
458200*                                                                 25160000
458300***********************************************************       25170000
458400***      GRAFT*(GORE*TAG)*CASES                                   25180000
458500***********************************************************       25190000
458600*                                                                 25200000
458700*    IF '3973   ' =  B-PRIN-PROC-CODE   OR                        25210000
458800*                    B-OTHER-PROC-CODE1 OR                        25220000
458900*                    B-OTHER-PROC-CODE2 OR                        25230000
459000*                    B-OTHER-PROC-CODE3 OR                        25240000
459100*                    B-OTHER-PROC-CODE4 OR                        25250000
459200*                    B-OTHER-PROC-CODE5                           25260000
459300*          NEXT SENTENCE                                          25270000
459400*    ELSE                                                         25280000
459500*          MOVE ZEROES TO H-NEW-TECH-ADDON-GRAFT                  25290000
459600*          GO TO 4000-CHECK-X-STOP.                               25300000
459700*                                                                 25310000
459800*    MOVE 21198.00 TO H-CSTMED-GRAFT.                             25320000
459900*                                                                 25330000
460000*    COMPUTE H-LESSER-GRAFT-1 ROUNDED =                           25340000
460100*            .5   H-CSTMED-GRAFT.                                 25350000
460200*                                                                 25360000
460300*    COMPUTE H-LESSER-GRAFT-2 ROUNDED =                           25370000
460400*          ((B-CHARGES-CLAIMED   P-NEW-OPER-CSTCHG-RATIO) -       25380000
460500*                    H-BASE-DRG-PAYMENT)   .5.                    25390000
460600*                                                                 25400000
460700*    IF H-LESSER-GRAFT-2 > 0                                      25410000
460800*       IF H-LESSER-GRAFT-1 < H-LESSER-GRAFT-2                    25420000
460900*          MOVE H-LESSER-GRAFT-1 TO H-NEW-TECH-ADDON-GRAFT        25430000
461000*       ELSE                                                      25440000
461100*          MOVE H-LESSER-GRAFT-2 TO H-NEW-TECH-ADDON-GRAFT        25450000
461200*    ELSE                                                         25460000
461300*       MOVE ZEROES          TO H-NEW-TECH-ADDON-GRAFT.           25470000
461400*                                                                 25480000
461500*4000-CHECK-X-STOP.                                               25490000
461600*                                                                 25500000
461700***********************************************************       25510000
461800*****    X-STOP INTERSPINOUS PROCESS DECOMPRESSION SYSTEM         25520000
461900***********************************************************       25530000
462000*                                                                 25540000
462100*    IF '8458   ' =  B-PRIN-PROC-CODE   OR                        25550000
462200*                    B-OTHER-PROC-CODE1 OR                        25560000
462300*                    B-OTHER-PROC-CODE2 OR                        25570000
462400*                    B-OTHER-PROC-CODE3 OR                        25580000
462500*                    B-OTHER-PROC-CODE4 OR                        25590000
462600*                    B-OTHER-PROC-CODE5                           25600000
462700*          NEXT SENTENCE                                          25610000
462800*    ELSE                                                         25620000
462900*          MOVE ZEROES TO H-NEW-TECH-ADDON-X-STOP                 25630000
463000*          GO TO 4000-ADD-TECH-CASES.                             25640000
463100*                                                                 25650000
463200*    MOVE 8800.00 TO H-CSTMED-X-STOP.                             25660000
463300*                                                                 25670000
463400*    COMPUTE H-LESSER-HRTIMP-STOP-1 ROUNDED =                     25680000
463500*            .5   H-CSTMED-X-STOP.                                25690000
463600*                                                                 25700000
463700*    COMPUTE H-LESSER-HRTIMP-STOP-2 ROUNDED =                     25710000
463800*          ((B-CHARGES-CLAIMED   P-NEW-OPER-CSTCHG-RATIO) -       25720000
463900*                    H-BASE-DRG-PAYMENT)   .5.                    25730000
464000*                                                                 25740000
464100*    IF H-LESSER-HRTIMP-STOP-2 > 0                                25750000
464200*       IF H-LESSER-HRTIMP-STOP-1 < H-LESSER-HRTIMP-STOP-2        25760000
464300*        MOVE H-LESSER-HRTIMP-STOP-1 TO H-NEW-TECH-ADDON-X-STOP   25770000
464400*       ELSE                                                      25780000
464500*        MOVE H-LESSER-HRTIMP-STOP-2 TO H-NEW-TECH-ADDON-X-STOP   25790000
464600*    ELSE                                                         25800000
464700*       MOVE ZEROES          TO H-NEW-TECH-ADDON-X-STOP.          25810000
464800*                                                                 25820000
464900*                                                                 25830000
465000*4000-ADD-TECH-CASES.                                             25840000
465100*                                                                 25850000
465200*    COMPUTE H-NEW-TECH-PAY-ADD-ON ROUNDED =                      25860000
465300*            H-NEW-TECH-ADDON-NEURO  +                            25870000
465400*            H-NEW-TECH-ADDON-GRAFT +                             25880000
465500*            H-NEW-TECH-ADDON-X-STOP.                             25890000
465600*                                                                 25900000
465700***********************************************************       25510000
465800***** HRTIMP-STOP INTERSPINOUS PROCESS DECOMPRESSION SYSTEM       25520000
465900***********************************************************       25530000
466000*                                                                 25540000
466100*    IF '3752   ' =  B-PRIN-PROC-CODE     OR                      25550000
466200*                    B-OTHER-PROC-CODE1   OR                      25560000
466300*                    B-OTHER-PROC-CODE2   OR                      25570000
466400*                    B-OTHER-PROC-CODE3   OR                      25580000
466500*                    B-OTHER-PROC-CODE4   OR                      25590000
466600*                    B-OTHER-PROC-CODE5   OR                      25590000
466700*                    B-OTHER-PROC-CODE6   OR                      25600000
466800*                    B-OTHER-PROC-CODE7   OR                      25600000
466900*                    B-OTHER-PROC-CODE8   OR                      25600000
467000*                    B-OTHER-PROC-CODE9   OR                      25600000
467100*                    B-OTHER-PROC-CODE10  OR                      25600000
467200*                    B-OTHER-PROC-CODE11  OR                      25600000
467300*                    B-OTHER-PROC-CODE12  OR                      25600000
467400*                    B-OTHER-PROC-CODE13  OR                      25600000
467500*                    B-OTHER-PROC-CODE14  OR                      25600000
467600*                    B-OTHER-PROC-CODE15  OR                      25600000
467700*                    B-OTHER-PROC-CODE16  OR                      25600000
467800*                    B-OTHER-PROC-CODE17  OR                      25600000
467900*                    B-OTHER-PROC-CODE18  OR                      25600000
468000*                    B-OTHER-PROC-CODE19  OR                      25600000
468100*                    B-OTHER-PROC-CODE20  OR                      25600000
468200*                    B-OTHER-PROC-CODE21  OR                      25600000
468300*                    B-OTHER-PROC-CODE22  OR                      25600000
468400*                    B-OTHER-PROC-CODE23  OR                      25600000
468500*                    B-OTHER-PROC-CODE24                          25600000
468600*          NEXT SENTENCE                                          25610000
468700*    ELSE                                                         25620000
468800*          MOVE ZEROES TO H-NEW-TECH-ADDON-HRTIMP-STOP            25630000
468900*          GO TO 4000-ADD-TECH-CASES.                             25640000
469000*                                                                 25650000
469100*    MOVE 53000.00 TO H-CSTMED-HRTIMP-STOP.                       25660000
469200*                                                                 25670000
469300*    COMPUTE H-LESSER-HRTIMP-STOP-1 ROUNDED =                     25680000
469400*                 H-CSTMED-HRTIMP-STOP.                           25690000
469500*                                                                 25700000
469600*    COMPUTE H-LESSER-HRTIMP-STOP-2 ROUNDED =                     25710000
469700*         (((B-CHARGES-CLAIMED * P-NEW-OPER-CSTCHG-RATIO) -       25720000
469800*                    H-BASE-DRG-PAYMENT)) * .5.                   25730000
469900*                                                                 25740000
470000*    IF H-LESSER-HRTIMP-STOP-2 > 0                                25750000
470100*       IF H-LESSER-HRTIMP-STOP-1 < H-LESSER-HRTIMP-STOP-2        25760000
470200*        MOVE H-LESSER-HRTIMP-STOP-1 TO                           25540000
470300*                                 H-NEW-TECH-ADDON-HRTIMP-STOP    25540000
470400*       ELSE                                                      25780000
470500*        MOVE H-LESSER-HRTIMP-STOP-2 TO                           25540000
470600*                                 H-NEW-TECH-ADDON-HRTIMP-STOP    25540000
470700*    ELSE                                                         25800000
470800*       MOVE ZEROES          TO H-NEW-TECH-ADDON-HRTIMP-STOP.     25810000
470900*                                                                 25820000
471000*                                                                 25830000
471100*4000-ADD-TECH-CASES.                                             25840000
471200*                                                                 25850000
471300*    COMPUTE H-NEW-TECH-PAY-ADD-ON ROUNDED =                      25860000
471400*            H-NEW-TECH-ADDON-HRTIMP-STOP.                        25890000
471500*                                                                 25900000
471600***********************************************************       23070000
471700* PUT NEW CHECK HERE IF H-NEW-TECH ZERO PERFORM                   23080000
471800                                                                  23110000
471900     IF   H-NEW-TECH-PAY-ADD-ON = 0                               23100000
472000     PERFORM 4100-ISLET-ISOLATION-ADD-ON THRU 4100-EXIT.          23120000
472100                                                                  23140000
472200     COMPUTE PPS-NEW-TECH-PAY-ADD-ON ROUNDED =                    26009200
472300             H-NEW-TECH-PAY-ADD-ON.                               26009300
472400*                                                                 23090000
472500*    IF   H-NEW-TECH-PAY-ADD-ON = 0 AND                           23100000
472600*         B-DRG-SPIRATN-DRG                                       23090000
472700*       PERFORM 4300-SPIRAT-TECH-ADD-ON THRU 4300-EXIT.           23140000
472800*                                                                 23090000
472900*    IF   H-NEW-TECH-PAY-ADD-ON = 0 AND                           23100000
473000*         B-DRG-SPIRATN-DRG11                                     23090000
473100*       PERFORM 4310-SPIRAT-TECH-ADD-ON THRU 4310-EXIT.           23140000
473200*                                                                 23130000
473300     IF   H-NEW-TECH-PAY-ADD-ON = 0 AND                           23100000
473400          B-DIAG-AUTOLITT-DIAG AND
473500          B-DRG-AUTOLITT-DRG
473600        PERFORM 4500-AUTOLIT-TECH-ADD-ON THRU 4500-EXIT.          23140000
473700                                                                  23130000
473800     COMPUTE PPS-NEW-TECH-PAY-ADD-ON ROUNDED =                    26009200
473900             H-NEW-TECH-PAY-ADD-ON.                               26009300
474000                                                                  26009400
474100*                                                                 25900000
474200 4000-EXIT.    EXIT.                                              25910000
474300***********************************************************       25920000
474400                                                                  25930000
474500 4100-ISLET-ISOLATION-ADD-ON.                                     25940000
474600***********************************************************       25950000
474700***  TECHNICAL TRANSPLANTATION OF CELLS                           25960000
474800***                                                               25970000
474900*** CODE 52.85 (ALLTRANSPLANTATION OF CELLS OF ISLETS OF          25980000
475000*** ISLETS OF LANGERHAUS) AND                                     25990000
475100*** V70.7 (EXAMINATION OF PARTICIPANT IN CLINICAL TRIAL).         25991000
475200*** V70.7 ONE OR MORE TIMES IN PROC-CODES AND 52.85 ONE OR MORE   25992000
475300*** TIMES IN ANY OTHER PROC-CODE                                  25993000
475400***********************************************************       25994000
475500*** IT WAS DECIDED ON 3/12/07 TO ONLY CHECK FOR 52.85 AND NOT     25995000
475600*** V70.7                                                         25995100
475700***********************************************************       25995200
475800                                                                  25995300
475900     MOVE 0 TO H-TECH-ADDON-ISLET-CNTR                            25995400
476000               H-TECH-ADDON-ISLET-CNTR2.                          25995500
476100                                                                  25995600
476200*    IF 'V707   ' =  B-PRIN-PROC-CODE   OR                        25995700
476300*                    B-OTHER-PROC-CODE1 OR                        25995800
476400*                    B-OTHER-PROC-CODE2 OR                        25995900
476500*                    B-OTHER-PROC-CODE3 OR                        25996000
476600*                    B-OTHER-PROC-CODE4 OR                        25997000
476700*                    B-OTHER-PROC-CODE5                           25998000
476800*          NEXT SENTENCE                                          25999000
476900*    ELSE                                                         25999100
477000*          MOVE ZEROES TO H-NEW-TECH-ADDON-ISLET                  25999200
477100*          GO TO 4100-ADD-TECH-CASES.                             25999300
477200                                                                  25999400
477300     IF '5285   ' =  B-PRIN-PROC-CODE     OR                      25999500
477400                     B-OTHER-PROC-CODE1   OR                      25999600
477500                     B-OTHER-PROC-CODE2   OR                      25999700
477600                     B-OTHER-PROC-CODE3   OR                      25999800
477700                     B-OTHER-PROC-CODE4   OR                      25999900
477800                     B-OTHER-PROC-CODE5   OR                      26000000
477900                     B-OTHER-PROC-CODE6   OR                      25600000
478000                     B-OTHER-PROC-CODE7   OR                      25600000
478100                     B-OTHER-PROC-CODE8   OR                      25600000
478200                     B-OTHER-PROC-CODE9   OR                      25600000
478300                     B-OTHER-PROC-CODE10  OR                      25600000
478400                     B-OTHER-PROC-CODE11  OR                      25600000
478500                     B-OTHER-PROC-CODE12  OR                      25600000
478600                     B-OTHER-PROC-CODE13  OR                      25600000
478700                     B-OTHER-PROC-CODE14  OR                      25600000
478800                     B-OTHER-PROC-CODE15  OR                      25600000
478900                     B-OTHER-PROC-CODE16  OR                      25600000
479000                     B-OTHER-PROC-CODE17  OR                      25600000
479100                     B-OTHER-PROC-CODE18  OR                      25600000
479200                     B-OTHER-PROC-CODE19  OR                      25600000
479300                     B-OTHER-PROC-CODE20  OR                      25600000
479400                     B-OTHER-PROC-CODE21  OR                      25600000
479500                     B-OTHER-PROC-CODE22  OR                      25600000
479600                     B-OTHER-PROC-CODE23  OR                      25600000
479700                     B-OTHER-PROC-CODE24                          25600000
479800           NEXT SENTENCE                                          26000100
479900     ELSE                                                         26000200
480000           MOVE ZEROES TO H-NEW-TECH-ADDON-ISLET                  26000300
480100           GO TO 4100-ADD-TECH-CASES.                             26000400
480200                                                                  26000500
480300     IF '5285   ' =  B-PRIN-PROC-CODE                             26000600
480400      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26000700
480500                       H-TECH-ADDON-ISLET-CNTR + 1.               26000800
480600                                                                  26000900
480700     IF '5285   ' =  B-OTHER-PROC-CODE1                           26001000
480800      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26001100
480900                       H-TECH-ADDON-ISLET-CNTR + 1.               26001200
481000                                                                  26001300
481100     IF '5285   ' =  B-OTHER-PROC-CODE2                           26001400
481200      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26001500
481300                       H-TECH-ADDON-ISLET-CNTR + 1.               26001600
481400                                                                  26001700
481500     IF '5285   ' =  B-OTHER-PROC-CODE3                           26001800
481600      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26001900
481700                       H-TECH-ADDON-ISLET-CNTR + 1.               26002000
481800                                                                  26002100
481900     IF '5285   ' =  B-OTHER-PROC-CODE4                           26002200
482000      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26002300
482100                       H-TECH-ADDON-ISLET-CNTR + 1.               26002400
482200                                                                  26002500
482300                                                                  26002600
482400     IF '5285   ' =  B-OTHER-PROC-CODE5                           26002700
482500      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26002800
482600                       H-TECH-ADDON-ISLET-CNTR + 1.               26002900
482700                                                                  26002600
482800     IF '5285   ' =  B-OTHER-PROC-CODE6                           25600000
482900      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26002800
483000                       H-TECH-ADDON-ISLET-CNTR + 1.               26002900
483100                                                                  26002600
483200     IF '5285   ' =  B-OTHER-PROC-CODE7                           25600000
483300      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26002800
483400                       H-TECH-ADDON-ISLET-CNTR + 1.               26002900
483500                                                                  26002600
483600     IF '5285   ' =  B-OTHER-PROC-CODE8                           25600000
483700      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26002800
483800                       H-TECH-ADDON-ISLET-CNTR + 1.               26002900
483900                                                                  26002600
484000     IF '5285   ' =  B-OTHER-PROC-CODE9                           25600000
484100      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26002800
484200                       H-TECH-ADDON-ISLET-CNTR + 1.               26002900
484300                                                                  26002600
484400     IF '5285   ' =  B-OTHER-PROC-CODE10                          25600000
484500      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26002800
484600                       H-TECH-ADDON-ISLET-CNTR + 1.               26002900
484700                                                                  26002600
484800     IF '5285   ' =  B-OTHER-PROC-CODE11                          25600000
484900      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26002800
485000                       H-TECH-ADDON-ISLET-CNTR + 1.               26002900
485100                                                                  26002600
485200     IF '5285   ' =  B-OTHER-PROC-CODE12                          25600000
485300      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26002800
485400                       H-TECH-ADDON-ISLET-CNTR + 1.               26002900
485500                                                                  26002600
485600     IF '5285   ' =  B-OTHER-PROC-CODE13                          25600000
485700      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26002800
485800                       H-TECH-ADDON-ISLET-CNTR + 1.               26002900
485900                                                                  26002600
486000     IF '5285   ' =  B-OTHER-PROC-CODE14                          25600000
486100      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26002800
486200                       H-TECH-ADDON-ISLET-CNTR + 1.               26002900
486300                                                                  26002600
486400     IF '5285   ' =  B-OTHER-PROC-CODE15                          25600000
486500      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26002800
486600                       H-TECH-ADDON-ISLET-CNTR + 1.               26002900
486700                                                                  26002600
486800     IF '5285   ' =  B-OTHER-PROC-CODE16                          25600000
486900      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26002800
487000                       H-TECH-ADDON-ISLET-CNTR + 1.               26002900
487100                                                                  26002600
487200     IF '5285   ' =  B-OTHER-PROC-CODE17                          25600000
487300      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26002800
487400                       H-TECH-ADDON-ISLET-CNTR + 1.               26002900
487500                                                                  26002600
487600     IF '5285   ' =  B-OTHER-PROC-CODE18                          25600000
487700      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26002800
487800                       H-TECH-ADDON-ISLET-CNTR + 1.               26002900
487900                                                                  26002600
488000     IF '5285   ' =  B-OTHER-PROC-CODE19                          25600000
488100      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26002800
488200                       H-TECH-ADDON-ISLET-CNTR + 1.               26002900
488300                                                                  26002600
488400     IF '5285   ' =  B-OTHER-PROC-CODE20                          25600000
488500      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26002800
488600                       H-TECH-ADDON-ISLET-CNTR + 1.               26002900
488700                                                                  26002600
488800     IF '5285   ' =  B-OTHER-PROC-CODE21                          25600000
488900      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26002800
489000                       H-TECH-ADDON-ISLET-CNTR + 1.               26002900
489100                                                                  26002600
489200     IF '5285   ' =  B-OTHER-PROC-CODE22                          25600000
489300      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26002800
489400                       H-TECH-ADDON-ISLET-CNTR + 1.               26002900
489500                                                                  26002600
489600     IF '5285   ' =  B-OTHER-PROC-CODE23                          25600000
489700      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26002800
489800                       H-TECH-ADDON-ISLET-CNTR + 1.               26002900
489900                                                                  26002600
490000     IF '5285   ' =  B-OTHER-PROC-CODE24                          25600000
490100      COMPUTE H-TECH-ADDON-ISLET-CNTR =                           26002800
490200                       H-TECH-ADDON-ISLET-CNTR + 1.               26002900
490300                                                                  26002600
490400                                                                  26003000
490500*    IF 'V707   ' =  B-PRIN-PROC-CODE                             26003100
490600*     COMPUTE H-TECH-ADDON-ISLET-CNTR2 =                          26003200
490700*                      H-TECH-ADDON-ISLET-CNTR2 + 1.              26003300
490800*                                                                 26003400
490900*    IF 'V707   ' =  B-OTHER-PROC-CODE1                           26003500
491000*     COMPUTE H-TECH-ADDON-ISLET-CNTR2 =                          26003600
491100*                      H-TECH-ADDON-ISLET-CNTR2 + 1.              26003700
491200*                                                                 26003800
491300*    IF 'V707   ' =  B-OTHER-PROC-CODE2                           26003900
491400*     COMPUTE H-TECH-ADDON-ISLET-CNTR2 =                          26004000
491500*                      H-TECH-ADDON-ISLET-CNTR2 + 1.              26004100
491600*                                                                 26004200
491700*    IF 'V707   ' =  B-OTHER-PROC-CODE3                           26004300
491800*     COMPUTE H-TECH-ADDON-ISLET-CNTR2 =                          26004400
491900*                      H-TECH-ADDON-ISLET-CNTR2 + 1.              26004500
492000*                                                                 26004600
492100*    IF 'V707   ' =  B-OTHER-PROC-CODE4                           26004700
492200*     COMPUTE H-TECH-ADDON-ISLET-CNTR2 =                          26004800
492300*                      H-TECH-ADDON-ISLET-CNTR2 + 1.              26004900
492400*                                                                 26005000
492500*    IF 'V707   ' =  B-OTHER-PROC-CODE5                           26005100
492600*     COMPUTE H-TECH-ADDON-ISLET-CNTR2 =                          26005200
492700*                    H-TECH-ADDON-ISLET-CNTR2 + 1.                26005300
492800*                                                                 26005400
492900*    IF  H-TECH-ADDON-ISLET-CNTR2 > 0                             26005500
493000*          NEXT SENTENCE                                          26005600
493100*    ELSE                                                         26005700
493200*          MOVE ZEROES TO H-NEW-TECH-ADDON-ISLET                  26005800
493300*          GO TO 4100-ADD-TECH-CASES.                             26005900
493400                                                                  26006000
493500     IF  H-TECH-ADDON-ISLET-CNTR = 1                              26006100
493600     MOVE 18848.00 TO H-NEW-TECH-ADDON-ISLET                      26006200
493700           GO TO 4100-ADD-TECH-CASES.                             26006300
493800                                                                  26006400
493900     IF  H-TECH-ADDON-ISLET-CNTR > 1                              26006500
494000     MOVE 37696.00 TO H-NEW-TECH-ADDON-ISLET                      26006600
494100           GO TO 4100-ADD-TECH-CASES.                             26006700
494200                                                                  26006800
494300     MOVE 0 TO H-NEW-TECH-ADDON-ISLET.                            26006900
494400                                                                  26007000
494500                                                                  26008000
494600 4100-ADD-TECH-CASES.                                             26009000
494700                                                                  26009100
494800     COMPUTE H-NEW-TECH-PAY-ADD-ON ROUNDED =                      26009200
494900             H-NEW-TECH-ADDON-ISLET.                              26009300
495000                                                                  26009400
495100 4100-EXIT.    EXIT.                                              26009500
495200                                                                  26009600
495300*
495400*4200-SSRFBN-CODE-RTN.
495500*    SET SSRFBN-IDX TO 1.
495600*    SEARCH SSRFBN-TAB VARYING SSRFBN-IDX
495700*        AT END
495800*          MOVE ' NO SSRFBN MESSAGE FOUND' TO MES-SSRFBN
495900*      WHEN WK-SSRFBN-STATE(SSRFBN-IDX) = MES-PPS-STATE
496000*        MOVE WK-SSRFBN-REASON-ALL (SSRFBN-IDX) TO MES-SSRFBN.
496100*
496200*4200-EXIT.   EXIT.
496300*
496400*4300-SPIRAT-TECH-ADD-ON.                                         25940000
496500***********************************************************       25510000
496600***** SPIRAT-STOP INTERSPINOUS PROCESS DECOMPRESSION SYSTEM       25520000
496700***********************************************************       25530000
496800*                                                                 25540000
496900*    IF '3371   ' =  B-PRIN-PROC-CODE     OR                      25550000
497000*                    B-OTHER-PROC-CODE1   OR                      25560000
497100*                    B-OTHER-PROC-CODE2   OR                      25570000
497200*                    B-OTHER-PROC-CODE3   OR                      25580000
497300*                    B-OTHER-PROC-CODE4   OR                      25590000
497400*                    B-OTHER-PROC-CODE5   OR                      25600000
497500*                    B-OTHER-PROC-CODE6   OR                      25600000
497600*                    B-OTHER-PROC-CODE7   OR                      25600000
497700*                    B-OTHER-PROC-CODE8   OR                      25600000
497800*                    B-OTHER-PROC-CODE9   OR                      25600000
497900*                    B-OTHER-PROC-CODE10  OR                      25600000
498000*                    B-OTHER-PROC-CODE11  OR                      25600000
498100*                    B-OTHER-PROC-CODE12  OR                      25600000
498200*                    B-OTHER-PROC-CODE13  OR                      25600000
498300*                    B-OTHER-PROC-CODE14  OR                      25600000
498400*                    B-OTHER-PROC-CODE15  OR                      25600000
498500*                    B-OTHER-PROC-CODE16  OR                      25600000
498600*                    B-OTHER-PROC-CODE17  OR                      25600000
498700*                    B-OTHER-PROC-CODE18  OR                      25600000
498800*                    B-OTHER-PROC-CODE19  OR                      25600000
498900*                    B-OTHER-PROC-CODE20  OR                      25600000
499000*                    B-OTHER-PROC-CODE21  OR                      25600000
499100*                    B-OTHER-PROC-CODE22  OR                      25600000
499200*                    B-OTHER-PROC-CODE23  OR                      25600000
499300*                    B-OTHER-PROC-CODE24                          25600000
499400*       IF '3222   ' =  B-PRIN-PROC-CODE     OR                   25550000
499500*                       B-OTHER-PROC-CODE1   OR                   25560000
499600*                       B-OTHER-PROC-CODE2   OR                   25570000
499700*                       B-OTHER-PROC-CODE3   OR                   25580000
499800*                       B-OTHER-PROC-CODE4   OR                   25590000
499900*                       B-OTHER-PROC-CODE5   OR                   25600000
500000*                       B-OTHER-PROC-CODE6   OR                   25600000
500100*                       B-OTHER-PROC-CODE7   OR                   25600000
500200*                       B-OTHER-PROC-CODE8   OR                   25600000
500300*                       B-OTHER-PROC-CODE9   OR                   25600000
500400*                       B-OTHER-PROC-CODE10  OR                   25600000
500500*                       B-OTHER-PROC-CODE11  OR                   25600000
500600*                       B-OTHER-PROC-CODE12  OR                   25600000
500700*                       B-OTHER-PROC-CODE13  OR                   25600000
500800*                       B-OTHER-PROC-CODE14  OR                   25600000
500900*                       B-OTHER-PROC-CODE15  OR                   25600000
501000*                       B-OTHER-PROC-CODE16  OR                   25600000
501100*                       B-OTHER-PROC-CODE17  OR                   25600000
501200*                       B-OTHER-PROC-CODE18  OR                   25600000
501300*                       B-OTHER-PROC-CODE19  OR                   25600000
501400*                       B-OTHER-PROC-CODE20  OR                   25600000
501500*                       B-OTHER-PROC-CODE21  OR                   25600000
501600*                       B-OTHER-PROC-CODE22  OR                   25600000
501700*                       B-OTHER-PROC-CODE23  OR                   25600000
501800*                       B-OTHER-PROC-CODE24                       25600000
501900*          GO TO 4300-COMPUTE-SPIRAT                              25610000
502000*       ELSE                                                      25620000
502100*       IF '3230   ' =  B-PRIN-PROC-CODE     OR                   25550000
502200*                       B-OTHER-PROC-CODE1   OR                   25560000
502300*                       B-OTHER-PROC-CODE2   OR                   25570000
502400*                       B-OTHER-PROC-CODE3   OR                   25580000
502500*                       B-OTHER-PROC-CODE4   OR                   25590000
502600*                       B-OTHER-PROC-CODE5   OR                   25600000
502700*                       B-OTHER-PROC-CODE6   OR                   25600000
502800*                       B-OTHER-PROC-CODE7   OR                   25600000
502900*                       B-OTHER-PROC-CODE8   OR                   25600000
503000*                       B-OTHER-PROC-CODE9   OR                   25600000
503100*                       B-OTHER-PROC-CODE10  OR                   25600000
503200*                       B-OTHER-PROC-CODE11  OR                   25600000
503300*                       B-OTHER-PROC-CODE12  OR                   25600000
503400*                       B-OTHER-PROC-CODE13  OR                   25600000
503500*                       B-OTHER-PROC-CODE14  OR                   25600000
503600*                       B-OTHER-PROC-CODE15  OR                   25600000
503700*                       B-OTHER-PROC-CODE16  OR                   25600000
503800*                       B-OTHER-PROC-CODE17  OR                   25600000
503900*                       B-OTHER-PROC-CODE18  OR                   25600000
504000*                       B-OTHER-PROC-CODE19  OR                   25600000
504100*                       B-OTHER-PROC-CODE20  OR                   25600000
504200*                       B-OTHER-PROC-CODE21  OR                   25600000
504300*                       B-OTHER-PROC-CODE22  OR                   25600000
504400*                       B-OTHER-PROC-CODE23  OR                   25600000
504500*                       B-OTHER-PROC-CODE24                       25600000
504600*          GO TO 4300-COMPUTE-SPIRAT                              25610000
504700*       ELSE                                                      25620000
504800*       IF '3239   ' =  B-PRIN-PROC-CODE     OR                   25550000
504900*                       B-OTHER-PROC-CODE1   OR                   25560000
505000*                       B-OTHER-PROC-CODE2   OR                   25570000
505100*                       B-OTHER-PROC-CODE3   OR                   25580000
505200*                       B-OTHER-PROC-CODE4   OR                   25590000
505300*                       B-OTHER-PROC-CODE5   OR                   25600000
505400*                       B-OTHER-PROC-CODE6   OR                   25600000
505500*                       B-OTHER-PROC-CODE7   OR                   25600000
505600*                       B-OTHER-PROC-CODE8   OR                   25600000
505700*                       B-OTHER-PROC-CODE9   OR                   25600000
505800*                       B-OTHER-PROC-CODE10  OR                   25600000
505900*                       B-OTHER-PROC-CODE11  OR                   25600000
506000*                       B-OTHER-PROC-CODE12  OR                   25600000
506100*                       B-OTHER-PROC-CODE13  OR                   25600000
506200*                       B-OTHER-PROC-CODE14  OR                   25600000
506300*                       B-OTHER-PROC-CODE15  OR                   25600000
506400*                       B-OTHER-PROC-CODE16  OR                   25600000
506500*                       B-OTHER-PROC-CODE17  OR                   25600000
506600*                       B-OTHER-PROC-CODE18  OR                   25600000
506700*                       B-OTHER-PROC-CODE19  OR                   25600000
506800*                       B-OTHER-PROC-CODE20  OR                   25600000
506900*                       B-OTHER-PROC-CODE21  OR                   25600000
507000*                       B-OTHER-PROC-CODE22  OR                   25600000
507100*                       B-OTHER-PROC-CODE23  OR                   25600000
507200*                       B-OTHER-PROC-CODE24                       25600000
507300*          GO TO 4300-COMPUTE-SPIRAT                              25610000
507400*       ELSE                                                      25620000
507500*       IF '3241   ' =  B-PRIN-PROC-CODE     OR                   25550000
507600*                       B-OTHER-PROC-CODE1   OR                   25560000
507700*                       B-OTHER-PROC-CODE2   OR                   25570000
507800*                       B-OTHER-PROC-CODE3   OR                   25580000
507900*                       B-OTHER-PROC-CODE4   OR                   25590000
508000*                       B-OTHER-PROC-CODE5   OR                   25600000
508100*                       B-OTHER-PROC-CODE6   OR                   25600000
508200*                       B-OTHER-PROC-CODE7   OR                   25600000
508300*                       B-OTHER-PROC-CODE8   OR                   25600000
508400*                       B-OTHER-PROC-CODE9   OR                   25600000
508500*                       B-OTHER-PROC-CODE10  OR                   25600000
508600*                       B-OTHER-PROC-CODE11  OR                   25600000
508700*                       B-OTHER-PROC-CODE12  OR                   25600000
508800*                       B-OTHER-PROC-CODE13  OR                   25600000
508900*                       B-OTHER-PROC-CODE14  OR                   25600000
509000*                       B-OTHER-PROC-CODE15  OR                   25600000
509100*                       B-OTHER-PROC-CODE16  OR                   25600000
509200*                       B-OTHER-PROC-CODE17  OR                   25600000
509300*                       B-OTHER-PROC-CODE18  OR                   25600000
509400*                       B-OTHER-PROC-CODE19  OR                   25600000
509500*                       B-OTHER-PROC-CODE20  OR                   25600000
509600*                       B-OTHER-PROC-CODE21  OR                   25600000
509700*                       B-OTHER-PROC-CODE22  OR                   25600000
509800*                       B-OTHER-PROC-CODE23  OR                   25600000
509900*                       B-OTHER-PROC-CODE24                       25600000
510000*          GO TO 4300-COMPUTE-SPIRAT                              25610000
510100*       ELSE                                                      25620000
510200*       IF '3249   ' =  B-PRIN-PROC-CODE     OR                   25550000
510300*                       B-OTHER-PROC-CODE1   OR                   25560000
510400*                       B-OTHER-PROC-CODE2   OR                   25570000
510500*                       B-OTHER-PROC-CODE3   OR                   25580000
510600*                       B-OTHER-PROC-CODE4   OR                   25590000
510700*                       B-OTHER-PROC-CODE5   OR                   25600000
510800*                       B-OTHER-PROC-CODE6   OR                   25600000
510900*                       B-OTHER-PROC-CODE7   OR                   25600000
511000*                       B-OTHER-PROC-CODE8   OR                   25600000
511100*                       B-OTHER-PROC-CODE9   OR                   25600000
511200*                       B-OTHER-PROC-CODE10  OR                   25600000
511300*                       B-OTHER-PROC-CODE11  OR                   25600000
511400*                       B-OTHER-PROC-CODE12  OR                   25600000
511500*                       B-OTHER-PROC-CODE13  OR                   25600000
511600*                       B-OTHER-PROC-CODE14  OR                   25600000
511700*                       B-OTHER-PROC-CODE15  OR                   25600000
511800*                       B-OTHER-PROC-CODE16  OR                   25600000
511900*                       B-OTHER-PROC-CODE17  OR                   25600000
512000*                       B-OTHER-PROC-CODE18  OR                   25600000
512100*                       B-OTHER-PROC-CODE19  OR                   25600000
512200*                       B-OTHER-PROC-CODE20  OR                   25600000
512300*                       B-OTHER-PROC-CODE21  OR                   25600000
512400*                       B-OTHER-PROC-CODE22  OR                   25600000
512500*                       B-OTHER-PROC-CODE23  OR                   25600000
512600*                       B-OTHER-PROC-CODE24                       25600000
512700*          GO TO 4300-COMPUTE-SPIRAT                              25610000
512800*    ELSE                                                         25620000
512900*          NEXT SENTENCE.                                         25610000
513000*                                                                 25620000
513100*    IF '3373   ' =  B-PRIN-PROC-CODE     OR                      25550000
513200*                    B-OTHER-PROC-CODE1   OR                      25560000
513300*                    B-OTHER-PROC-CODE2   OR                      25570000
513400*                    B-OTHER-PROC-CODE3   OR                      25580000
513500*                    B-OTHER-PROC-CODE4   OR                      25590000
513600*                    B-OTHER-PROC-CODE5   OR                      25600000
513700*                    B-OTHER-PROC-CODE6   OR                      25600000
513800*                    B-OTHER-PROC-CODE7   OR                      25600000
513900*                    B-OTHER-PROC-CODE8   OR                      25600000
514000*                    B-OTHER-PROC-CODE9   OR                      25600000
514100*                    B-OTHER-PROC-CODE10  OR                      25600000
514200*                    B-OTHER-PROC-CODE11  OR                      25600000
514300*                    B-OTHER-PROC-CODE12  OR                      25600000
514400*                    B-OTHER-PROC-CODE13  OR                      25600000
514500*                    B-OTHER-PROC-CODE14  OR                      25600000
514600*                    B-OTHER-PROC-CODE15  OR                      25600000
514700*                    B-OTHER-PROC-CODE16  OR                      25600000
514800*                    B-OTHER-PROC-CODE17  OR                      25600000
514900*                    B-OTHER-PROC-CODE18  OR                      25600000
515000*                    B-OTHER-PROC-CODE19  OR                      25600000
515100*                    B-OTHER-PROC-CODE20  OR                      25600000
515200*                    B-OTHER-PROC-CODE21  OR                      25600000
515300*                    B-OTHER-PROC-CODE22  OR                      25600000
515400*                    B-OTHER-PROC-CODE23  OR                      25600000
515500*                    B-OTHER-PROC-CODE24                          25600000
515600*       IF '3222   ' =  B-PRIN-PROC-CODE     OR                   25550000
515700*                       B-OTHER-PROC-CODE1   OR                   25560000
515800*                       B-OTHER-PROC-CODE2   OR                   25570000
515900*                       B-OTHER-PROC-CODE3   OR                   25580000
516000*                       B-OTHER-PROC-CODE4   OR                   25590000
516100*                       B-OTHER-PROC-CODE5   OR                   25600000
516200*                       B-OTHER-PROC-CODE6   OR                   25600000
516300*                       B-OTHER-PROC-CODE7   OR                   25600000
516400*                       B-OTHER-PROC-CODE8   OR                   25600000
516500*                       B-OTHER-PROC-CODE9   OR                   25600000
516600*                       B-OTHER-PROC-CODE10  OR                   25600000
516700*                       B-OTHER-PROC-CODE11  OR                   25600000
516800*                       B-OTHER-PROC-CODE12  OR                   25600000
516900*                       B-OTHER-PROC-CODE13  OR                   25600000
517000*                       B-OTHER-PROC-CODE14  OR                   25600000
517100*                       B-OTHER-PROC-CODE15  OR                   25600000
517200*                       B-OTHER-PROC-CODE16  OR                   25600000
517300*                       B-OTHER-PROC-CODE17  OR                   25600000
517400*                       B-OTHER-PROC-CODE18  OR                   25600000
517500*                       B-OTHER-PROC-CODE19  OR                   25600000
517600*                       B-OTHER-PROC-CODE20  OR                   25600000
517700*                       B-OTHER-PROC-CODE21  OR                   25600000
517800*                       B-OTHER-PROC-CODE22  OR                   25600000
517900*                       B-OTHER-PROC-CODE23  OR                   25600000
518000*                       B-OTHER-PROC-CODE24                       25600000
518100*          GO TO 4300-COMPUTE-SPIRAT                              25610000
518200*       ELSE                                                      25620000
518300*       IF '3230   ' =  B-PRIN-PROC-CODE     OR                   25550000
518400*                       B-OTHER-PROC-CODE1   OR                   25560000
518500*                       B-OTHER-PROC-CODE2   OR                   25570000
518600*                       B-OTHER-PROC-CODE3   OR                   25580000
518700*                       B-OTHER-PROC-CODE4   OR                   25590000
518800*                       B-OTHER-PROC-CODE5   OR                   25600000
518900*                       B-OTHER-PROC-CODE6   OR                   25600000
519000*                       B-OTHER-PROC-CODE7   OR                   25600000
519100*                       B-OTHER-PROC-CODE8   OR                   25600000
519200*                       B-OTHER-PROC-CODE9   OR                   25600000
519300*                       B-OTHER-PROC-CODE10  OR                   25600000
519400*                       B-OTHER-PROC-CODE11  OR                   25600000
519500*                       B-OTHER-PROC-CODE12  OR                   25600000
519600*                       B-OTHER-PROC-CODE13  OR                   25600000
519700*                       B-OTHER-PROC-CODE14  OR                   25600000
519800*                       B-OTHER-PROC-CODE15  OR                   25600000
519900*                       B-OTHER-PROC-CODE16  OR                   25600000
520000*                       B-OTHER-PROC-CODE17  OR                   25600000
520100*                       B-OTHER-PROC-CODE18  OR                   25600000
520200*                       B-OTHER-PROC-CODE19  OR                   25600000
520300*                       B-OTHER-PROC-CODE20  OR                   25600000
520400*                       B-OTHER-PROC-CODE21  OR                   25600000
520500*                       B-OTHER-PROC-CODE22  OR                   25600000
520600*                       B-OTHER-PROC-CODE23  OR                   25600000
520700*                       B-OTHER-PROC-CODE24                       25600000
520800*          GO TO 4300-COMPUTE-SPIRAT                              25610000
520900*       ELSE                                                      25620000
521000*       IF '3239   ' =  B-PRIN-PROC-CODE     OR                   25550000
521100*                       B-OTHER-PROC-CODE1   OR                   25560000
521200*                       B-OTHER-PROC-CODE2   OR                   25570000
521300*                       B-OTHER-PROC-CODE3   OR                   25580000
521400*                       B-OTHER-PROC-CODE4   OR                   25590000
521500*                       B-OTHER-PROC-CODE5   OR                   25600000
521600*                       B-OTHER-PROC-CODE6   OR                   25600000
521700*                       B-OTHER-PROC-CODE7   OR                   25600000
521800*                       B-OTHER-PROC-CODE8   OR                   25600000
521900*                       B-OTHER-PROC-CODE9   OR                   25600000
522000*                       B-OTHER-PROC-CODE10  OR                   25600000
522100*                       B-OTHER-PROC-CODE11  OR                   25600000
522200*                       B-OTHER-PROC-CODE12  OR                   25600000
522300*                       B-OTHER-PROC-CODE13  OR                   25600000
522400*                       B-OTHER-PROC-CODE14  OR                   25600000
522500*                       B-OTHER-PROC-CODE15  OR                   25600000
522600*                       B-OTHER-PROC-CODE16  OR                   25600000
522700*                       B-OTHER-PROC-CODE17  OR                   25600000
522800*                       B-OTHER-PROC-CODE18  OR                   25600000
522900*                       B-OTHER-PROC-CODE19  OR                   25600000
523000*                       B-OTHER-PROC-CODE20  OR                   25600000
523100*                       B-OTHER-PROC-CODE21  OR                   25600000
523200*                       B-OTHER-PROC-CODE22  OR                   25600000
523300*                       B-OTHER-PROC-CODE23  OR                   25600000
523400*                       B-OTHER-PROC-CODE24                       25600000
523500*          GO TO 4300-COMPUTE-SPIRAT                              25610000
523600*       ELSE                                                      25620000
523700*       IF '3241   ' =  B-PRIN-PROC-CODE     OR                   25550000
523800*                       B-OTHER-PROC-CODE1   OR                   25560000
523900*                       B-OTHER-PROC-CODE2   OR                   25570000
524000*                       B-OTHER-PROC-CODE3   OR                   25580000
524100*                       B-OTHER-PROC-CODE4   OR                   25590000
524200*                       B-OTHER-PROC-CODE5   OR                   25600000
524300*                       B-OTHER-PROC-CODE6   OR                   25600000
524400*                       B-OTHER-PROC-CODE7   OR                   25600000
524500*                       B-OTHER-PROC-CODE8   OR                   25600000
524600*                       B-OTHER-PROC-CODE9   OR                   25600000
524700*                       B-OTHER-PROC-CODE10  OR                   25600000
524800*                       B-OTHER-PROC-CODE11  OR                   25600000
524900*                       B-OTHER-PROC-CODE12  OR                   25600000
525000*                       B-OTHER-PROC-CODE13  OR                   25600000
525100*                       B-OTHER-PROC-CODE14  OR                   25600000
525200*                       B-OTHER-PROC-CODE15  OR                   25600000
525300*                       B-OTHER-PROC-CODE16  OR                   25600000
525400*                       B-OTHER-PROC-CODE17  OR                   25600000
525500*                       B-OTHER-PROC-CODE18  OR                   25600000
525600*                       B-OTHER-PROC-CODE19  OR                   25600000
525700*                       B-OTHER-PROC-CODE20  OR                   25600000
525800*                       B-OTHER-PROC-CODE21  OR                   25600000
525900*                       B-OTHER-PROC-CODE22  OR                   25600000
526000*                       B-OTHER-PROC-CODE23  OR                   25600000
526100*                       B-OTHER-PROC-CODE24                       25600000
526200*          GO TO 4300-COMPUTE-SPIRAT                              25610000
526300*       ELSE                                                      25620000
526400*       IF '3249   ' =  B-PRIN-PROC-CODE     OR                   25550000
526500*                       B-OTHER-PROC-CODE1   OR                   25560000
526600*                       B-OTHER-PROC-CODE2   OR                   25570000
526700*                       B-OTHER-PROC-CODE3   OR                   25580000
526800*                       B-OTHER-PROC-CODE4   OR                   25590000
526900*                       B-OTHER-PROC-CODE5   OR                   25600000
527000*                       B-OTHER-PROC-CODE6   OR                   25600000
527100*                       B-OTHER-PROC-CODE7   OR                   25600000
527200*                       B-OTHER-PROC-CODE8   OR                   25600000
527300*                       B-OTHER-PROC-CODE9   OR                   25600000
527400*                       B-OTHER-PROC-CODE10  OR                   25600000
527500*                       B-OTHER-PROC-CODE11  OR                   25600000
527600*                       B-OTHER-PROC-CODE12  OR                   25600000
527700*                       B-OTHER-PROC-CODE13  OR                   25600000
527800*                       B-OTHER-PROC-CODE14  OR                   25600000
527900*                       B-OTHER-PROC-CODE15  OR                   25600000
528000*                       B-OTHER-PROC-CODE16  OR                   25600000
528100*                       B-OTHER-PROC-CODE17  OR                   25600000
528200*                       B-OTHER-PROC-CODE18  OR                   25600000
528300*                       B-OTHER-PROC-CODE19  OR                   25600000
528400*                       B-OTHER-PROC-CODE20  OR                   25600000
528500*                       B-OTHER-PROC-CODE21  OR                   25600000
528600*                       B-OTHER-PROC-CODE22  OR                   25600000
528700*                       B-OTHER-PROC-CODE23  OR                   25600000
528800*                       B-OTHER-PROC-CODE24                       25600000
528900*          GO TO 4300-COMPUTE-SPIRAT.                             25610000
529000*                                                                       00
529100*          MOVE ZEROES TO H-NEW-TECH-ADDON-SPIRAT-STOP.           25630000
529200*          GO TO 4300-ADD-TECH-CASES.                             25640000
529300*                                                                 25650000
529400*4300-COMPUTE-SPIRAT.                                             25840000
529500*                                                                 25650000
529600*    MOVE  3437.50 TO H-CSTMED-SPIRAT-STOP.                       25660000
529700*                                                                 25670000
529800*    COMPUTE H-LESSER-SPIRAT-STOP-1 ROUNDED =                     25680000
529900*                 H-CSTMED-SPIRAT-STOP.                           25690000
530000*                                                                 25700000
530100*    COMPUTE H-LESSER-SPIRAT-STOP-2 ROUNDED =                     25710000
530200*         (((B-CHARGES-CLAIMED * P-NEW-OPER-CSTCHG-RATIO) -       25720000
530300*                    H-BASE-DRG-PAYMENT)) * .5.                   25730000
530400*                                                                 25740000
530500*    IF H-LESSER-SPIRAT-STOP-2 > 0                                25750000
530600*       IF H-LESSER-SPIRAT-STOP-1 < H-LESSER-SPIRAT-STOP-2        25760000
530700*        MOVE H-LESSER-SPIRAT-STOP-1 TO
530800*                                 H-NEW-TECH-ADDON-SPIRAT-STOP
530900*       ELSE                                                      25780000
531000*        MOVE H-LESSER-SPIRAT-STOP-2 TO
531100*                                 H-NEW-TECH-ADDON-SPIRAT-STOP
531200*    ELSE                                                         25800000
531300*       MOVE ZEROES          TO H-NEW-TECH-ADDON-SPIRAT-STOP.     25810000
531400*                                                                 25820000
531500*                                                                 25830000
531600*4300-ADD-TECH-CASES.                                             25840000
531700*                                                                 25850000
531800*    COMPUTE H-NEW-TECH-PAY-ADD-ON ROUNDED =                      25860000
531900*            H-NEW-TECH-ADDON-SPIRAT-STOP.                        25890000
532000*                                                                 25900000
532100*4300-EXIT.    EXIT.                                              25910000
532200*
532300*4310-SPIRAT-TECH-ADD-ON.                                         25940000
532400***********************************************************       25510000
532500***** SPIRAT-STOP INTERSPINOUS PROCESS DECOMPRESSION SYSTEM       25520000
532600***********************************************************       25530000
532700*                                                                 25540000
532800*    IF '3371   ' =  B-PRIN-PROC-CODE     OR                      25550000
532900*                    B-OTHER-PROC-CODE1   OR                      25560000
533000*                    B-OTHER-PROC-CODE2   OR                      25570000
533100*                    B-OTHER-PROC-CODE3   OR                      25580000
533200*                    B-OTHER-PROC-CODE4   OR                      25590000
533300*                    B-OTHER-PROC-CODE5   OR                      25600000
533400*                    B-OTHER-PROC-CODE6   OR                      25600000
533500*                    B-OTHER-PROC-CODE7   OR                      25600000
533600*                    B-OTHER-PROC-CODE8   OR                      25600000
533700*                    B-OTHER-PROC-CODE9   OR                      25600000
533800*                    B-OTHER-PROC-CODE10  OR                      25600000
533900*                    B-OTHER-PROC-CODE11  OR                      25600000
534000*                    B-OTHER-PROC-CODE12  OR                      25600000
534100*                    B-OTHER-PROC-CODE13  OR                      25600000
534200*                    B-OTHER-PROC-CODE14  OR                      25600000
534300*                    B-OTHER-PROC-CODE15  OR                      25600000
534400*                    B-OTHER-PROC-CODE16  OR                      25600000
534500*                    B-OTHER-PROC-CODE17  OR                      25600000
534600*                    B-OTHER-PROC-CODE18  OR                      25600000
534700*                    B-OTHER-PROC-CODE19  OR                      25600000
534800*                    B-OTHER-PROC-CODE20  OR                      25600000
534900*                    B-OTHER-PROC-CODE21  OR                      25600000
535000*                    B-OTHER-PROC-CODE22  OR                      25600000
535100*                    B-OTHER-PROC-CODE23  OR                      25600000
535200*                    B-OTHER-PROC-CODE24                          25600000
535300*          GO TO 4320-COMPUTE-SPIRAT.                             25610000
535400*                                                                 25540000
535500*                                                                 25540000
535600*     IF '3373   ' =  B-PRIN-PROC-CODE     OR                     25550000
535700*                     B-OTHER-PROC-CODE1   OR                     25560000
535800*                     B-OTHER-PROC-CODE2   OR                     25570000
535900*                     B-OTHER-PROC-CODE3   OR                     25580000
536000*                     B-OTHER-PROC-CODE4   OR                     25590000
536100*                     B-OTHER-PROC-CODE5   OR                     25600000
536200*                     B-OTHER-PROC-CODE6   OR                     25600000
536300*                     B-OTHER-PROC-CODE7   OR                     25600000
536400*                     B-OTHER-PROC-CODE8   OR                     25600000
536500*                     B-OTHER-PROC-CODE9   OR                     25600000
536600*                     B-OTHER-PROC-CODE10  OR                     25600000
536700*                     B-OTHER-PROC-CODE11  OR                     25600000
536800*                     B-OTHER-PROC-CODE12  OR                     25600000
536900*                     B-OTHER-PROC-CODE13  OR                     25600000
537000*                     B-OTHER-PROC-CODE14  OR                     25600000
537100*                     B-OTHER-PROC-CODE15  OR                     25600000
537200*                     B-OTHER-PROC-CODE16  OR                     25600000
537300*                     B-OTHER-PROC-CODE17  OR                     25600000
537400*                     B-OTHER-PROC-CODE18  OR                     25600000
537500*                     B-OTHER-PROC-CODE19  OR                     25600000
537600*                     B-OTHER-PROC-CODE20  OR                     25600000
537700*                     B-OTHER-PROC-CODE21  OR                     25600000
537800*                     B-OTHER-PROC-CODE22  OR                     25600000
537900*                     B-OTHER-PROC-CODE23  OR                     25600000
538000*                     B-OTHER-PROC-CODE24                         25600000
538100*          GO TO 4320-COMPUTE-SPIRAT.                             25610000
538200*                                                                 25620000
538300*     MOVE ZEROES TO H-NEW-TECH-ADDON-SPIRAT-STOP.                25630000
538400*        GO TO 4320-ADD-TECH-CASES.                               25640000
538500*                                                                 25650000
538600*4320-COMPUTE-SPIRAT.                                             25840000
538700*                                                                 25650000
538800*    MOVE  3437.50 TO H-CSTMED-SPIRAT-STOP.                       25660000
538900*                                                                 25670000
539000*    COMPUTE H-LESSER-SPIRAT-STOP-1 ROUNDED =                     25680000
539100*                 H-CSTMED-SPIRAT-STOP.                           25690000
539200*                                                                 25700000
539300*    COMPUTE H-LESSER-SPIRAT-STOP-2 ROUNDED =                     25710000
539400*         (((B-CHARGES-CLAIMED * P-NEW-OPER-CSTCHG-RATIO) -       25720000
539500*                    H-BASE-DRG-PAYMENT)) * .5.                   25730000
539600*                                                                 25740000
539700*    IF H-LESSER-SPIRAT-STOP-2 > 0                                25750000
539800*       IF H-LESSER-SPIRAT-STOP-1 < H-LESSER-SPIRAT-STOP-2        25760000
539900*        MOVE H-LESSER-SPIRAT-STOP-1 TO                           25540000
540000*                                 H-NEW-TECH-ADDON-SPIRAT-STOP    25540000
540100*       ELSE                                                      25780000
540200*        MOVE H-LESSER-SPIRAT-STOP-2 TO                           25540000
540300*                                 H-NEW-TECH-ADDON-SPIRAT-STOP    25540000
540400*    ELSE                                                         25800000
540500*       MOVE ZEROES          TO H-NEW-TECH-ADDON-SPIRAT-STOP.     25810000
540600*                                                                 25820000
540700*                                                                 25830000
540800*4320-ADD-TECH-CASES.                                             25840000
540900*                                                                 25850000
541000*    COMPUTE H-NEW-TECH-PAY-ADD-ON ROUNDED =                      25860000
541100*            H-NEW-TECH-ADDON-SPIRAT-STOP.                        25890000
541200*                                                                 25900000
541300*4310-EXIT.    EXIT.                                              25910000
541400*                                                                 25540000
541500***********************************************************       25510000
541600* THIS IS A SEARCH FOR LOW VOLUME PROVIDERS BASED ON THEIR        25520000
541700* DISCHARGE COUNTS.                                               25520000
541800***********************************************************       25530000
541900 4400-LOWVOL-CODE-RTN.
542000
542100     SET LOWVOL-IDX TO 1.
542200     SEARCH LOWVOL-TAB VARYING LOWVOL-IDX
542300         AT END
542400           MOVE ' NO LOWVOL PROVIDER FOUND' TO MES-LOWVOL
542500           MOVE 1600 TO  MESWK-LOWVOL-PROV-DISCHG
542600       WHEN WK-LOWVOL-PROV (LOWVOL-IDX) = MES-PPS-PROV
542700         MOVE WK-LOWVOL-PROV-DISCHG(LOWVOL-IDX)
542800                            TO MESWK-LOWVOL-PROV-DISCHG.
542900
543000 4400-EXIT.   EXIT.
543100
543200
543300 4500-AUTOLIT-TECH-ADD-ON.                                        25940000
543400***********************************************************       25510000
543500***** CASES INVOLVING AUTOLITT PROCESS DECOMPRESSION SYSTEM       25520000
543600***********************************************************       25530000
543700                                                                  25540000
543800     IF '1761   ' =  B-PRIN-PROC-CODE     OR                      25550000
543900                     B-OTHER-PROC-CODE1   OR                      25560000
544000                     B-OTHER-PROC-CODE2   OR                      25570000
544100                     B-OTHER-PROC-CODE3   OR                      25580000
544200                     B-OTHER-PROC-CODE4   OR                      25590000
544300                     B-OTHER-PROC-CODE5   OR                      25600000
544400                     B-OTHER-PROC-CODE6   OR                      25600000
544500                     B-OTHER-PROC-CODE7   OR                      25600000
544600                     B-OTHER-PROC-CODE8   OR                      25600000
544700                     B-OTHER-PROC-CODE9   OR                      25600000
544800                     B-OTHER-PROC-CODE10  OR                      25600000
544900                     B-OTHER-PROC-CODE11  OR                      25600000
545000                     B-OTHER-PROC-CODE12  OR                      25600000
545100                     B-OTHER-PROC-CODE13  OR                      25600000
545200                     B-OTHER-PROC-CODE14  OR                      25600000
545300                     B-OTHER-PROC-CODE15  OR                      25600000
545400                     B-OTHER-PROC-CODE16  OR                      25600000
545500                     B-OTHER-PROC-CODE17  OR                      25600000
545600                     B-OTHER-PROC-CODE18  OR                      25600000
545700                     B-OTHER-PROC-CODE19  OR                      25600000
545800                     B-OTHER-PROC-CODE20  OR                      25600000
545900                     B-OTHER-PROC-CODE21  OR                      25600000
546000                     B-OTHER-PROC-CODE22  OR                      25600000
546100                     B-OTHER-PROC-CODE23  OR                      25600000
546200                     B-OTHER-PROC-CODE24                          25600000
546300           GO TO 4500-COMPUTE-AUTOLITT                            25610000
546400     ELSE                                                         25620000
546500           NEXT SENTENCE.                                         25610000
546600                                                                        00
546700           MOVE ZEROES TO H-NEW-TECH-ADDON-AUTOLITT-STOP.         25630000
546800           GO TO 4500-ADD-TECH-CASES.                             25640000
546900                                                                  25650000
547000 4500-COMPUTE-AUTOLITT.                                           25840000
547100                                                                  25650000
547200     MOVE  5300.00 TO H-CSTMED-AUTOLITT-STOP.                     25660000
547300                                                                  25670000
547400     COMPUTE H-LESSER-AUTOLITT-STOP-1 ROUNDED =                   25680000
547500                  H-CSTMED-AUTOLITT-STOP.                         25690000
547600                                                                  25700000
547700     COMPUTE H-LESSER-AUTOLITT-STOP-2 ROUNDED =                   25710000
547800          (((B-CHARGES-CLAIMED * P-NEW-OPER-CSTCHG-RATIO) -       25720000
547900                     H-BASE-DRG-PAYMENT)) * .5.                   25730000
548000                                                                  25740000
548100     IF H-LESSER-AUTOLITT-STOP-2 > 0                              25750000
548200        IF H-LESSER-AUTOLITT-STOP-1 < H-LESSER-AUTOLITT-STOP-2    25760000
548300         MOVE H-LESSER-AUTOLITT-STOP-1 TO
548400                                H-NEW-TECH-ADDON-AUTOLITT-STOP
548500        ELSE                                                      25780000
548600         MOVE H-LESSER-AUTOLITT-STOP-2 TO
548700                                H-NEW-TECH-ADDON-AUTOLITT-STOP
548800     ELSE                                                         25800000
548900        MOVE ZEROES          TO H-NEW-TECH-ADDON-AUTOLITT-STOP.   25810000
549000                                                                  25820000
549100                                                                  25830000
549200 4500-ADD-TECH-CASES.                                             25840000
549300                                                                  25850000
549400     COMPUTE H-NEW-TECH-PAY-ADD-ON ROUNDED =                      25860000
549500             H-NEW-TECH-ADDON-AUTOLITT-STOP.                      25890000
549600*                                                                 25900000
549700 4500-EXIT.    EXIT.                                              25910000
549800
549900***********************************************************       25920000
550000******        L A S T   S O U R C E   S T A T E M E N T   *****   26009700
