source: FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICD1831O.m@ 1374

Last change on this file since 1374 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.4 KB
Line 
1ICD1831O ;ALB/ESD/JAT - FY 2007 UPDATE; 6/22/01 2:43pm ; 12/4/07 2:23pm
2 ;;18.0;DRG Grouper;**31**;Oct 13,2000;Build 7
3 Q
4 ;
5INACTDRG ;
6 N LINE,X,ICDDRG,DESC,DA,DIE,DR,MDC,SURG,ICDFDA
7 D BMES^XPDUTL(">>> Inactivating 108 DRGs...")
8 F LINE=1:1 S X=$T(INAC+LINE) S ICDDRG=$P(X,";;",2) Q:ICDDRG="EXIT" D
9 .S DESC="NO LONGER VALID"
10 .S DA(1)=$P(ICDDRG,U)
11 .S DA=1
12 .S DIE="^ICD("_DA(1)_",1,"
13 .S DR=".01///^S X=DESC"
14 .D ^DIE
15 .; check if already done in case patch being re-installed
16 .Q:$D(^ICD($P(ICDDRG,U),66,"B",3071001))
17 .; add entry to 80.266
18 .S MDC=$P(ICDDRG,U,2)
19 .S SURG=$P(ICDDRG,U,3)
20 .S ICDDRG=$P(ICDDRG,U)
21 .S ICDFDA(80.2,"?1,",.01)=ICDDRG
22 .S ICDFDA(80.266,"+2,?1,",.01)=3071001
23 .S ICDFDA(80.266,"+2,?1,",.03)=0
24 .S ICDFDA(80.266,"+2,?1,",.05)=MDC
25 .S ICDFDA(80.266,"+2,?1,",.06)=SURG
26 .D UPDATE^DIE("","ICDFDA") K ICDFDA
27 .; add entry to 80.268 and 80.2681
28 .S ICDFDA(80.2,"?1,",.01)=ICDDRG
29 .S ICDFDA(80.268,"+2,?1,",.01)=3071001
30 .D UPDATE^DIE("","ICDFDA") K ICDFDA
31 .S ICDFDA(80.2,"?1,",.01)=ICDDRG
32 .S ICDFDA(80.268,"?2,?1,",.01)=3071001
33 .S ICDFDA(80.2681,"+3,?2,?1,",.01)=DESC
34 .D UPDATE^DIE("","ICDFDA") K ICDFDA
35 Q
36 ;
37INAC ;
38 ;;14^1^0
39 ;;15^1^0
40 ;;16^1^0
41 ;;17^1^0
42 ;;18^1^0
43 ;;19^1^0
44 ;;43^2^0
45 ;;44^2^0
46 ;;45^2^0
47 ;;46^2^0
48 ;;47^2^0
49 ;;48^2^0
50 ;;49^3^1
51 ;;50^3^1
52 ;;51^3^1
53 ;;104^5^1
54 ;;105^5^1
55 ;;106^5^1
56 ;;108^5^1
57 ;;110^5^1
58 ;;111^5^1
59 ;;118^5^1
60 ;;115^5^1
61 ;;120^5^1
62 ;;126^5^0
63 ;;127^5^0
64 ;;128^5^0
65 ;;140^5^0
66 ;;141^5^0
67 ;;142^5^0
68 ;;143^5^0
69 ;;144^5^0
70 ;;145^5^0
71 ;;160^6^0
72 ;;161^6^1
73 ;;162^6^1
74 ;;169^3^1
75 ;;170^6^1
76 ;;171^6^0
77 ;;172^6^0
78 ;;173^6^0
79 ;;174^6^0
80 ;;210^8^0
81 ;;211^8^0
82 ;;212^8^0
83 ;;213^8^0
84 ;;265^9^0
85 ;;266^9^0
86 ;;267^9^0
87 ;;268^9^0
88 ;;269^9^0
89 ;;270^9^0
90 ;;271^9^0
91 ;;272^9^0
92 ;;273^9^0
93 ;;274^9^0
94 ;;275^9^0
95 ;;276^9^0
96 ;;277^9^0
97 ;;278^9^0
98 ;;279^9^0
99 ;;317^11^0
100 ;;318^11^0
101 ;;319^11^0
102 ;;320^11^0
103 ;;321^11^0
104 ;;322^11^0
105 ;;323^11^0
106 ;;324^11^0
107 ;;325^11^0
108 ;;359^13^1
109 ;;360^13^1
110 ;;361^13^1
111 ;;362^13^1
112 ;;363^13^1
113 ;;364^13^1
114 ;;365^13^1
115 ;;366^13^0
116 ;;367^13^0
117 ;;396^16^0
118 ;;397^16^0
119 ;;398^16^0
120 ;;399^16^0
121 ;;401^17^1
122 ;;402^17^1
123 ;;403^17^0
124 ;;404^17^0
125 ;;426^19^0
126 ;;427^19^0
127 ;;428^19^0
128 ;;429^19^0
129 ;;430^19^0
130 ;;431^19^0
131 ;;447^21^0
132 ;;448^21^0
133 ;;449^21^0
134 ;;450^21^0
135 ;;451^21^0
136 ;;452^21^0
137 ;;518^5^1
138 ;;519^8^1
139 ;;520^8^1
140 ;;521^20^0
141 ;;522^20^0
142 ;;523^20^0
143 ;;524^1^0
144 ;;525^5^1
145 ;;528^1^1
146 ;;529^1^1
147 ;;530^1^1
148 ;;531^1^1
149 ;;532^1^1
150 ;;567^6^1
151 ;;568^6^1
152 ;;569^6^1
153 ;;570^6^1
154 ;;571^6^1
155 ;;572^8^0
156 ;;EXIT
Note: See TracBrowser for help on using the repository browser.