Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SR174UTL

SR174UTL.m

Go to the documentation of this file.
SR174UTL ;BIR/ADM - FY10 CPT EXCLUSION UTILITY ;04/30/10
 ;;3.0; Surgery ;**174**;24 Jun 93;Build 8
 Q
PEX ; populate file 137
 D POST^SR174UT1
 N SRI,SRJ,SRL,SRLIST,SRX,SRY,X
 D MES^XPDUTL("  Populating CPT EXCLUSIONS file...")
 K ^SRO(137) S ^SRO(137,0)="CPT EXCLUSIONS^137P^^"
 F SRJ=0:1 S SRLIST=$P($T(LIST+SRJ)," ;;",2) Q:SRLIST=""  F SRI=1:1 S SRX=$P(SRLIST,",",SRI) Q:SRX=""  I $D(^ICPT("B",SRX)) D INT
 D PEX^SR174UT0
 S SRX="00000" F  S SRX=$O(^ICPT("B",SRX)) Q:SRX=$O(^ICPT("B","01999"))  D INT
 S SRX="69999" F  S SRX=$O(^ICPT("B",SRX)) Q:SRX=$O(^ICPT("B","79999"))  D INT
 S SRX="79999" F  S SRX=$O(^ICPT("B",SRX)) Q:SRX=$O(^ICPT("B","89999"))  D INT
 S SRX="89999" F  S SRX=$O(^ICPT("B",SRX)) Q:SRX=$O(^ICPT("B","99999"))  D INT
 S SRX="A" F  S SRX=$O(^ICPT("B",SRX)) Q:SRX=""  D INT
 S SRX="" F  S SRX=$O(^ICPT("B",SRX)) Q:SRX=""  I "0123456789"'[$E(SRX,5) D INT
DEL ; delete routines SR174UT1 and SR174UT0
 F X="SR174UT1","SR174UT0" X ^%ZOSF("TEST") I $T D
 .D MES^XPDUTL(" Deleting routine "_X_"...")
 .X ^%ZOSF("DEL")
 K DA,DIC,DD,DO,DINUM,X
 Q
INT S SRY=0,SRY=$O(^ICPT("B",SRX,SRY)) Q:SRY=""
 K DA,DIC,DD,DO,DINUM S (DINUM,X)=SRY,DIC="^SRO(137,",DIC(0)="L" D FILE^DICN
 Q
LIST ;;0199T,0200T,0201T,0202T,0203T,0204T,0205T,0206T,0207T,10021,10022,10040,10060,10061,10080,10081,10120,11000,11010,11011
 ;;11012,11040,11041,11042,11043,11044,11055,11056,11057,11100,11101,11200,11201,11300,11301,11302,11303,11305,11306,11307
 ;;11308,11310,11311,11312,11313,11400,11401,11402,11403,11404,11406,11420,11421,11422,11423,11424,11426,11440,11441,11442
 ;;11443,11444,11446,11450,11451,11462,11463,11470,11471,11600,11601,11602,11603,11604,11606,11620,11621,11622,11623,11624
 ;;11626,11640,11641,11642,11643,11644,11646,11719,11720,11721,11730,11732,11740,11750,11752,11755,11760,11762,11765,11770
 ;;11771,11772,11900,11901,11920,11921,11922,11950,11951,11952,11954,11970,11971,11975,11976,11977,11980,11981,11982,11983
 ;;12001,12002,12004,12005,12006,12007,12011,12013,12014,12015,12016,12017,12018,12020,12021,12031,12032,12034,12035,12036
 ;;12037,12041,12042,12044,12045,12046,12047,12051,12052,12053,12054,12055,12056,12057,13100,13101,13102,13120,13121,13122
 ;;13131,13132,13133,13150,13151,13152,13153,13160,14000,14001,14020,14021,14040,14041,14060,14061,14300,14301,14302,14350
 ;;15050,15100,15101,15110,15111,15115,15116,15120,15121,15130,15131,15135,15136,15150,15151,15152,15155,15156,15157,15170
 ;;15171,15175,15176,15200,15201,15220,15221,15240,15241,15260,15261,15300,15301,15320,15321,15330,15331,15335,15336,15340
 ;;15341,15360,15361,15365,15366,15400,15401,15420,15421,15430,15431,15775,15776,15780,15781,15782,15783,15786,15787,15788
 ;;15789,15792,15793,15819,15820,15821,15822,15823,15824,15825,15826,15828,15829,15832,15833,15834,15835,15836,15837,15838
 ;;15839,15850,15851,15852,15860,16000,16020,16025,16030,16035,16036,17000,17003,17106,17110,17250,17260,17261,17262,17263
 ;;17264,17266,17270,17271,17272,17273,17274,17276,17280,17281,17282,17283,17284,17286,17340,17360,17380,17999,19000,19001
 ;;19030,19100,19101,19102,19103,19112,19290,19291,19295,20200,20205,20206,20220,20225,20240,20245,20250,20251,20500,20501
 ;;20520,20525,20526,20550,20551,20552,20553,20555,20600,20605,20610,20612,20615,20650,20660,20661,20662,20663,20664,20665
 ;;20670,20680,20690,20692,20693,20694,20696,20697,20912,20924,20950,20974,20979,20982,20985,20986,20987,21011,21012,21013
 ;;21014,21016,21030,21031,21032,21073,21076,21077,21079,21080,21081,21082,21083,21084,21085,21086,21087,21088,21089,21116
 ;;21210,21310,21315,21320,21325,21330,21335,21336,21337,21338,21339,21340,21345,21400,21401,21421,21431,21440,21450,21451
 ;;21452,21453,21480,21485,21497,21550,21552,21554,21555,21556,21800,21820,21920,21925,21930,21931,21932,21933,22305,22310
 ;;22315,22505,22520,22521,22522,22900,22901,22902,22903,23065,23066,23071,23073,23075,23076,23100,23330,23331,23350,23500
 ;;23505,23520,23525,23540,23545,23570,23575,23600,23605,23620,23625,23650,23655,23665,23675,23700,23930,23931,24065,24066
 ;;24071,24073,24075,24076,24100,24101,24147,24160,24164,24200,24220,24300,24343,24470,24500,24505,24530,24535,24560,24565
 ;;24576,24577,24600,24605,24620,24640,24650,24655,24670,24675,25028,25031,25065,25066,25071,25073,25075,25076,25100,25246
 ;;25250,25251,25259,25500,25505,25520,25530,25535,25560,25565,25600,25605,25622,25624,25630,25635,25650,25651,25660,25671
 ;;25675,25680,25690,25800,25805,25810,25820,25825,25830,26010,26011,26020,26025,26030,26034,26035,26037,26040,26045,26055
 ;;26060,26070,26075,26080,26100,26105,26110,26111,26113,26115,26116,26140,26160,26200,26210,26262,26320,26340,26416,26432
 ;;26508,26516,26517,26518,26600,26605,26607,26608,26641,26645,26670,26675,26700,26705,26720,26725,26740,26742,26750,26755
 ;;26756,26770,26775,26820,26841,26842,26843,26844,26850,26852,26860,26861,26862,26863,26910,26951,27003,27040,27041,27043
 ;;27045,27047,27048,27050,27052,27065,27090,27091,27093,27095,27096,27175,27178,27193,27194,27200,27216,27220,27222,27230
 ;;27232,27238,27240,27246,27250,27252,27256,27257,27265,27266,27267,27268,27275,27306,27323,27324,27330,27337,27339,27370
 ;;27500,27501,27502,27503,27508,27510,27516,27517,27520,27530,27532,27538,27550,27552,27560,27562,27570,27613,27614,27618
 ;;27619,27632,27634,27648,27690,27691,27750,27752,27760,27762,27767,27768,27780,27781,27786,27788,27808,27810,27816,27818
 ;;27824,27825,27830,27831,27840,27842,27860,27870,27871,28001,28005,28008,28010,28011,28020,28022,28024,28035,28039,28041
 ;;28043,28045,28046,28050,28052,28054,28055,28060,28062,28070,28072,28080,28086,28088,28090,28092,28100,28102,28103,28104
 ;;28106,28107,28108,28110,28111,28112,28113,28114,28116,28118,28119,28120,28122,28124,28126,28130,28140,28150,28153,28160
 ;;28171,28173,28175,28190,28192,28193,28200,28202,28208,28210,28220,28222,28225,28226,28230,28232,28234,28238,28240,28250
 ;;28260,28261,28262,28264,28270,28272,28280,28285,28286,28288,28289,28290,28292,28293,28294,28296,28297,28298,28299,28300
 ;;28302,28304,28305,28306,28307,28308,28309,28310,28312,28313,28315,28320,28322,28340,28341,28344,28345,28360,28400,28405
 ;;28406,28415,28430,28435,28436,28450,28455,28456,28465,28470,28475,28476,28485,28490,28495,28496,28505,28510,28515,28525
 ;;28530,28531,28540,28545,28546,28555,28570,28575,28576,28585,28600,28605,28606,28615,28630,28635,28636,28645,28660,28665
 ;;28666,28675,28705,28715,28725,28730,28735,28737,28740,28750,28755,28760,28810,28820,28825,28890,28899,29000,29010,29015
 ;;29020,29025,29035,29040,29044,29046,29049,29055,29058,29065,29075,29085,29086,29105,29125,29126,29130,29131,29200,29220
 ;;29240,29260,29280,29305,29325,29345,29355,29358,29365,29405,29425,29435,29440,29445,29450,29505,29515,29520,29530,29540
 ;;29550,29580,29581,29590,29700,29705,29710,29715,29720,29730,29740,29750,29799,29800,29804,29805,29830,29836,29840,29843
 ;;29845,29848,29856,29860,29863,29870,29900,29901,29902,30000,30020,30100,30110,30115,30117,30118,30120,30124,30125,30130
 ;;30140,30150,30160,30200,30210,30220,30300,30310,30320,30400,30410,30420,30430,30435,30450,30460,30462,30465,30520,30540
 ;;30545,30560,30580,30600,30620,30630,30801,30802,30901,30903,30905,30906,30915,30920,30930,30999,31000,31002,31020,31030
 ;;31032,31040,31050,31051,31070,31075,31080,31081,31084,31085,31086,31087,31090,31200,31201,31205,31225,31230,31231,31233
 ;;31235,31237,31238,31239,31240,31254,31255,31256,31267,31276,31287,31288,31290,31291,31292,31293,31294,31299,31500,31502
 ;;31505,31510,31511,31512,31513,31515,31520,31525,31526,31527,31528,31529,31530,31531,31535,31536,31540,31541,31545,31546
 ;;31560,31561,31570,31571,31575,31576,31577,31578,31579,31582,31584,31588,31600,31601,31603,31605,31610,31612,31613,31615
 ;;31620,31622,31623,31624,31625,31626,31627,31628,31629,31630,31631,31632,31633,31635,31636,31637,31638,31640,31641,31643
 ;;31645,31646,31656,31715,31717,31720,31725,31730,31830,32000,32002,32005,32019,32020,32400,32405,32420,32421,32422,32550
 ;;32551,32552,32553,32560,32561,32562,32601,32602,32603,32604,32605,32606,32850,32855,32856,32960,33206,33207,33208,33210
 ;;33211,33212,33213,33214,33215,33216,33217,33218,33220,33222,33223,33224,33225,33226,33233,33234,33235,33236,33237,33238
 ;;33240,33241,33243,33244,33249,33282,33284,33420,33470,33471,33930,33933,33940,33944,33960,33961,33967,33968,33970,33971
 ;;33973,33974,33975,33976,33977,33978,33979,33980,33981,33982,33983,35400,35450,35452,35454,35456,35458,35459,35460,35470
 ;;35471,35472,35473,35474,35475,35476,35480,35481,35482,35483,35484,35485,35490,35491,35492,35493,35494,35495,36000,36002
 ;;36005,36010,36011,36012,36013,36014,36015,36100,36120,36140,36145,36147,36148,36160,36200,36215,36216,36217,36218,36245
 ;;36246,36247,36248,36260,36261,36262,36299,36400,36405,36406,36410,36415,36416,36420,36425,36430,36440,36450,36455,36460
 ;;36468,36469,36470,36471,36481,36500,36510,36511,36512,36513,36514,36515,36516,36522,36540,36550,36555,36556,36557,36558
 ;;36560,36561,36563,36565,36566,36568,36569,36570,36571,36575,36576,36578,36580,36581,36582,36583,36584,36585,36589,36590
 ;;36591,36592,36593,36595,36596,36597,36600,36620,36625,36640,36660,36680,36800,36810,36815,36818,36819,36820,36821,36822
 ;;36823,36825,36830,36831,36832,36833,36835,36870,37183,37195,37200,37209,37250,37251,37501,37607,37609,37620,37785,38200
 ;;38204,38205,38206,38207,38208,38209,38210,38211,38212,38213,38214,38215,38220,38221,38230,38240,38241,38242,38500,38505