source: FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICD1831U.m@ 1008

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

initial load of FOIAVistA 6/30/08 version

File size: 2.6 KB
Line 
1ICD1831U ; ALB/DHH - FY 2008 UPDATE; 7/27/05 14:50;
2 ;;18.0;DRG Grouper;**31**;Oct 13,2000;Build 7
3 Q
4 ;
5DIAG ; - update diagnosis codes
6 ; from Table 6A in Fed Reg - assumes new codes already added by Lexicon
7 D BMES^XPDUTL(">>>Modifying new diagnosis codes - file 80")
8 N LINE,X,ICDDIAG,ENTRY,DA,DIE,DR,IDENT,MDC,MDC25,FDA
9 F LINE=1:1 S X=$T(REVD+LINE) S ICDDIAG=$P(X,";;",2) Q:ICDDIAG="EXIT" D
10 .S ENTRY=+$O(^ICD9("BA",$P(ICDDIAG,U)_" ",0))
11 .I ENTRY D
12 ..;check for possible inactive dupe
13 ..I $P($G(^ICD9(ENTRY,0)),U,9)=1 S ENTRY=+$O(^ICD9("BA",$P(ICDDIAG,U)_" ",ENTRY)) I 'ENTRY Q
14 ..S DA=ENTRY,DIE="^ICD9("
15 ..S IDENT=$P(ICDDIAG,U,2)
16 ..S MDC=$P(ICDDIAG,U,3)
17 ..;this would only apply to diagnoses who have no other MDC than a pre-MDC
18 ..I MDC="PRE" S MDC=98
19 ..S MDC25=$P(ICDDIAG,U,4)
20 ..S MDC24=$P(ICDDIAG,U,5)
21 ..S DR="2///^S X=IDENT;5///^S X=MDC;5.9///^S X=MDC25;5.7///^S X=MDC24"
22 ..D ^DIE
23 ..Q:$D(^ICD9(ENTRY,4,"B",3071001))
24 ..N FDA
25 ..S FDA(1820,80,"?1,",.01)="`"_ENTRY
26 ..S FDA(1820,80.072,"+3,?1,",.01)=3071001
27 ..S FDA(1820,80.072,"+3,?1,",1)=$P(ICDDIAG,U,3)
28 ..D UPDATE^DIE("","FDA(1820)") K FDA(1820)
29 Q
30 ;
31REVD ;DIAG^IDEN^MDC^MDC25
32 ;;338.0^^1
33 ;;338.21^^1
34 ;;338.22^^1
35 ;;338.28^^1
36 ;;338.29^^1
37 ;;807.14^^4^^0
38 ;;807.15^^4^^0
39 ;;807.16^^4^^0
40 ;;807.17^^4^^0
41 ;;807.18^^4^^0
42 ;;807.19^^4^^0
43 ;;807.3^^4^^0
44 ;;807.4^^4^^0
45 ;;839.71^^4^^0
46 ;;861.22^^4^^0
47 ;;861.32^^4^^0
48 ;;862.0^^4^^0
49 ;;862.1^^4^^0
50 ;;862.21^^4^^0
51 ;;862.31^^4^^0
52 ;;874.12^^4^^0
53 ;;860.0^^4^^0
54 ;;860.1^^4^^0
55 ;;860.3^^4^^0
56 ;;860.5^^4^^0
57 ;;015.02^6^8
58 ;;015.04^6^8
59 ;;015.05^6^8
60 ;;730.28^6^8
61 ;;737.40^6^8
62 ;;737.41^6^8
63 ;;737.42^6^8
64 ;;737.43^6^8
65 ;;V58.11^^17
66 ;;V58.12^^17
67 ;;V67.2^^17
68 ;;V58.0^^17
69 ;;V67.1^^17
70 ;;200.30^L^17^2
71 ;;200.31^L^17^2
72 ;;200.32^L^17^2
73 ;;200.33^L^17^2
74 ;;200.34^L^17^2
75 ;;200.35^L^17^2
76 ;;200.36^L^17^2
77 ;;200.37^L^17^2
78 ;;200.38^L^17^2
79 ;;200.40^L^17^2
80 ;;200.41^L^17^2
81 ;;200.42^L^17^2
82 ;;200.43^L^17^2
83 ;;200.44^L^17^2
84 ;;200.45^L^17^2
85 ;;200.46^L^17^2
86 ;;200.47^L^17^2
87 ;;200.48^L^17^2
88 ;;200.50^L^17^2
89 ;;200.51^L^17^2
90 ;;200.52^L^17^2
91 ;;200.53^L^17^2
92 ;;200.54^L^17^2
93 ;;200.55^L^17^2
94 ;;200.56^L^17^2
95 ;;200.57^L^17^2
96 ;;200.58^L^17^2
97 ;;200.60^L^17^2
98 ;;200.61^L^17^2
99 ;;200.62^L^17^2
100 ;;200.63^L^17^2
101 ;;200.64^L^17^2
102 ;;200.65^L^17^2
103 ;;200.66^L^17^2
104 ;;200.67^L^17^2
105 ;;200.68^L^17^2
106 ;;200.70^L^17^2
107 ;;200.71^L^17^2
108 ;;200.72^L^17^2
109 ;;200.73^L^17^2
110 ;;200.74^L^17^2
111 ;;200.75^L^17^2
112 ;;200.76^L^17^2
113 ;;200.77^L^17^2
114 ;;200.78^L^17^2
115 ;;202.70^L^17^2
116 ;;202.71^L^17^2
117 ;;202.72^L^17^2
118 ;;202.73^L^17^2
119 ;;202.74^L^17^2
120 ;;202.75^L^17^2
121 ;;202.76^L^17^2
122 ;;202.77^L^17^2
123 ;;202.78^L^17^2
124 ;;058.21^Q^1
125 ;;058.29^Q^1
126 ;;EXIT
Note: See TracBrowser for help on using the repository browser.