source: FOIAVistA/tag/r/DRG_GROUPER-ICD--ICPT/ICDTBL1.m@ 636

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

initial load of FOIAVistA 6/30/08 version

File size: 1.9 KB
Line 
1ICDTBL1 ;ALB/EG/MRY - GROUPER UTILITY FUNCTIONS ; 11/5/07 11:07am
2 ;;18.0;DRG Grouper;**31**;Oct 20, 2000;Build 7
3DRG100 ;100-101
4DRG101 ;
5 S ICDRG=$S(ICDMCC=2:100,1:101) Q
6DRG102 ;102-103
7DRG103 ;
8 S ICDRG=$S(ICDMCC=2:102,1:103) Q
9DRG113 ;113-114
10DRG114 ;
11 S ICDRG=$S(ICDMCC>0:113,1:114) Q
12DRG115 S ICDRG=115 Q
13DRG116 ;
14DRG117 S ICDRG=$S(ICDMCC>0:116,1:117) Q
15DRG121 ;
16DRG122 S ICDRG=$S(ICDMCC>0:121,1:122) Q
17DRG123 S ICDRG=123 Q
18DRG124 ;
19DRG125 S ICDRG=$S(ICDMCC=2:124,1:125) Q
20DRG129 ;
21DRG130 S ICDRG=$S(ICDMCC>0:129,1:130)
22 I $D(ICDOP(" 20.96"))!$D(ICDOP(" 20.97"))!$D(ICDOP(" 20.98")) S ICDRG=129
23 Q
24DRG131 ;
25DRG132 S ICDRG=$S(ICDMCC>0:131,1:132) Q
26DRG133 ;
27DRG134 S ICDRG=$S(ICDMCC>0:133,1:134) Q
28DRG135 ;
29DRG136 S ICDRG=$S(ICDMCC>0:135,1:136) Q
30DRG137 ;
31DRG138 S ICDRG=$S(ICDMCC>0:137,1:138) Q
32DRG139 S ICDRG=139 Q
33DRG146 ;
34DRG147 ;
35DRG148 S ICDRG=$S(ICDMCC=2:146,ICDMCC=1:147,1:148) Q
36DRG149 S ICDRG=149 Q
37DRG150 ;
38DRG151 S ICDRG=$S(ICDMCC=2:150,1:151) Q
39DRG152 ;
40DRG153 S ICDRG=$S(ICDMCC=2:152,1:153) Q
41DRG154 ;
42DRG155 ;
43DRG156 S ICDRG=$S(ICDMCC=2:154,ICDMCC=1:155,1:156) Q
44DRG157 ;
45DRG158 ;
46DRG159 S ICDRG=$S(ICDMCC=2:157,ICDMCC=1:158,1:159) Q
47DRG163 ;
48DRG164 ;
49DRG165 S ICDRG=$S(ICDMCC=2:163,ICDMCC=1:164,1:165) Q
50DRG166 ;
51DRG167 ;
52DRG168 S ICDRG=$S(ICDMCC=2:166,ICDMCC=1:167,1:168) Q
53DRG175 ;
54DRG176 S ICDRG=$S(ICDMCC=2:175,1:176) Q
55DRG177 ;
56DRG178 ;
57DRG179 S ICDRG=$S(ICDMCC=2:177,ICDMCC=1:178,1:179) Q
58DRG180 ;
59DRG181 ;
60DRG182 S ICDRG=$S(ICDMCC=2:180,ICDMCC=1:181,1:182) Q
61DRG183 ;
62DRG184 ;
63DRG185 S ICDRG=$S(ICDMCC=2:183,ICDMCC=1:184,1:185) Q
64DRG186 ;
65DRG187 ;
66DRG188 S ICDRG=$S(ICDMCC=2:186,ICDMCC=1:187,1:188) Q
67DRG189 S ICDRG=189 Q
68DRG190 ;
69DRG191 ;
70DRG192 S ICDRG=$S(ICDMCC=2:190,ICDMCC=1:191,1:192) Q
71DRG193 ;
72DRG194 ;
73DRG195 S ICDRG=$S(ICDMCC=2:193,ICDMCC=1:194,1:195) Q
74DRG196 ;
75DRG197 ;
76DRG198 S ICDRG=$S(ICDMCC=2:196,ICDMCC=1:197,1:198) Q
77DRG199 S ICDRG=$S(ICDMCC=2:199,ICDMCC=1:200,1:201) Q
78 Q
Note: See TracBrowser for help on using the repository browser.