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

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

WorldVistAEHR overlayed on FOIAVistA

File size: 3.9 KB
Line 
1ICDTLB4B ;ALB/EG - GROUPER UTILITY FUNCTIONS FY 2006; 10/23/00 11:48am ; 6/28/05 4:04pm
2 ;;18.0;DRG Grouper;**20**;Oct 20, 2000;Build 1
3DRG263 S ICDRG=$S(ICDPD["U"&(ICDCC):263,ICDPD["U":264,ICDCC:265,1:266) Q
4DRG264 S ICDRG=$S(ICDPD["U"&(ICDCC):263,ICDPD["U":264,ICDCC:265,1:266) Q
5DRG265 S ICDRG=$S(ICDPD["U"&(ICDCC):263,ICDPD["U":264,ICDCC:265,1:266) Q
6DRG266 S ICDRG=$S(ICDPD["U"&(ICDCC):263,ICDPD["U":264,ICDCC:265,1:266) Q
7DRG269 S ICDRG=$S(ICDCC:269,1:270) Q
8DRG270 S ICDRG=$S(ICDCC:269,1:270) Q
9DRG272 S ICDRG=$S(ICDCC:272,1:273) Q
10DRG273 S ICDRG=$S(ICDCC:272,1:273) Q
11DRG274 S ICDRG=$S(ICDCC:274,1:275) Q
12DRG275 S ICDRG=$S(ICDCC:274,1:275) Q
13DRG277 S ICDRG=$S(AGE<18:279,ICDCC:277,1:278) I AGE="" S ICDRG=470,ICDRTC=3
14 Q
15DRG278 D DRG277 Q
16 Q
17DRG279 D DRG277 Q
18 Q
19DRG280 S ICDRG=$S(AGE<18:282,ICDCC:280,1:281) I AGE="" S ICDRG=470,ICDRTC=3
20 Q
21DRG281 S ICDRG=$S(AGE<18:282,ICDCC:280,1:281) I AGE="" S ICDRG=470,ICDRTC=3
22 Q
23DRG282 S ICDRG=$S(AGE<18:282,ICDCC:280,1:281) I AGE="" S ICDRG=470,ICDRTC=3
24 Q
25DRG283 S ICDRG=$S('$D(ICDODRG)&(ICDORNR>0):468,ICDCC=1:283,1:284) Q
26DRG284 S ICDRG=$S('$D(ICDODRG)&(ICDORNR>0):468,ICDCC:283,1:284) Q
27DRG292 S ICDRG=$S($D(ICDOP(" 55.69")):302,ICDCC:292,1:293) Q
28DRG293 S ICDRG=$S($D(ICDOP(" 55.69")):302,ICDCC:292,1:293) Q
29DRG294 S ICDRG=$S(AGE<36:295,1:294) I AGE="" S ICDRG=470,ICDRTC=3
30 Q
31DRG295 S ICDRG=$S(AGE<36:295,1:294) I AGE="" S ICDRG=470,ICDRTC=3
32 Q
33DRG296 S ICDRG=$S(AGE<18:298,ICDCC:296,1:297) I AGE="" S ICDRG=470,ICDRTC=3
34 Q
35DRG297 S ICDRG=$S(AGE<18:298,ICDCC:296,1:297) I AGE="" S ICDRG=470,ICDRTC=3
36 Q
37DRG298 S ICDRG=$S(AGE<18:298,ICDCC:296,1:297) I AGE="" S ICDRG=470,ICDRTC=3
38 Q
39DRG299 S ICDRG=299 Q
40DRG300 S ICDRG=$S(ICDCC:300,1:301) Q
41DRG301 S ICDRG=$S(ICDCC:300,1:301) Q
42DRG302 S ICDRG=$S($D(ICDOP(" 55.69")):302,1:ICDRG) Q
43DRG303 S ICDRG=$S(ICDPD["M":303,ICDCC:304,1:305) Q
44DRG304 S ICDRG=$S(ICDPD["M":303,ICDCC:304,1:305) Q
45DRG305 S ICDRG=$S(ICDPD["M":303,ICDCC:304,1:305) Q
46DRG306 S ICDRG=$S($D(ICDODRG(308))!($D(ICDODRG(309))):$S(ICDCC:308,1:309),ICDCC:306,1:307) Q
47DRG307 S ICDRG=$S($D(ICDODRG(308))!($D(ICDODRG(309))):$S(ICDCC:308,1:309),ICDCC:306,1:307) Q
48DRG308 S ICDRG=$S($D(ICDODRG(308))!($D(ICDODRG(309))):$S(ICDCC:308,1:309),ICDCC:306,1:307) Q
49DRG309 S ICDRG=$S($D(ICDODRG(308))!($D(ICDODRG(309))):$S(ICDCC:308,1:309),ICDCC:306,1:307) Q
50DRG310 S ICDRG=$S(ICDCC:310,1:311) Q
51DRG311 S ICDRG=$S(ICDCC:310,1:311) Q
52DRG312 S ICDRG=$S(AGE<18:314,ICDCC:312,1:313) I AGE="" S ICDRG=470,ICDRTC=3
53 Q
54DRG313 S ICDRG=$S(AGE<18:314,ICDCC:312,1:313) I AGE="" S ICDRG=470,ICDRTC=3
55 Q
56DRG314 S ICDRG=$S(AGE<18:314,ICDCC:312,1:313) I AGE="" S ICDRG=470,ICDRTC=3
57 Q
58DRG315 I ICDORNI["V"&($D(ICDOP(" 86.07")))!((ICDDX(1)=$O(^ICD9("AB","250.41 ",0))!(ICDDX(1)=$O(^ICD9("AB","250.43 ",0))))&($D(ICDOP(" 52.84"))!$D(ICDOP(" 52.85")))) S ICDDRG=315
59 Q
60DRG318 S ICDRG=$S(ICDCC:318,1:319) Q
61DRG319 S ICDRG=$S(ICDCC:318,1:319) Q
62DRG320 S ICDRG=$S(AGE<18:322,ICDCC:320,1:321) I AGE="" S ICDRG=470,ICDRTC=3
63 Q
64DRG321 S ICDRG=$S(AGE<18:322,ICDCC:320,1:321) I AGE="" S ICDRG=470,ICDRTC=3
65 Q
66DRG322 S ICDRG=$S(AGE<18:322,ICDCC:320,1:321) I AGE="" S ICDRG=470,ICDRTC=3
67 Q
68DRG323 S ICDRG=$S('$D(ICDPDRG(323)):"",ICDCC!($D(ICDOP(" 98.51")))!($D(ICDSDRG(323))):323,1:324) Q
69DRG324 S ICDRG=$S(ICDCC!($D(ICDOP(" 98.51")))!($D(ICDSDRG(323))):323,1:324) Q
70DRG325 S ICDRG=$S(AGE<18:327,ICDCC:325,1:326) I AGE="" S ICDRG=470,ICDRTC=3
71 Q
72DRG326 S ICDRG=$S(AGE<18:327,ICDCC:325,1:326) I AGE="" S ICDRG=470,ICDRTC=3
73 Q
74DRG327 S ICDRG=$S(AGE<18:327,ICDCC:325,1:326) I AGE="" S ICDRG=470,ICDRTC=3
75 Q
76DRG328 S ICDRG=$S(AGE<18:330,ICDCC:328,1:329) I AGE="" S ICDRG=470,ICDRTC=3
77 Q
78DRG329 S ICDRG=$S(AGE<18:330,ICDCC:328,1:329) I AGE="" S ICDRG=470,ICDRTC=3
79 Q
80DRG330 S ICDRG=$S(AGE<18:330,ICDCC:328,1:329) I AGE="" S ICDRG=470,ICDRTC=3
81 Q
82DRG331 S ICDRG=$S(AGE<18:333,ICDCC:331,1:332) I AGE="" S ICDRG=470,ICDRTC=3
83 Q
84DRG332 S ICDRG=$S(AGE<18:333,ICDCC:331,1:332) I AGE="" S ICDRG=470,ICDRTC=3
85 Q
86DRG333 S ICDRG=$S(AGE<18:333,ICDCC:331,1:332) I AGE="" S ICDRG=470,ICDRTC=3
87 Q
Note: See TracBrowser for help on using the repository browser.