source: FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDTBL3.m@ 1800

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

initial load of FOIAVistA 6/30/08 version

File size: 2.1 KB
Line 
1ICDTBL3 ;ALB/EG/MRY - GROUPER UTILITY FUNCTIONS ; 11/7/07 5:35pm
2 ;;18.0;DRG Grouper;**31**;Oct 20, 2000;Build 7
3DRG300 ;
4DRG301 S ICDRG=$S(ICDMCC=2:299,ICDMCC=1:300,1:301) Q
5DRG302 ;
6DRG303 S ICDRG=$S(ICDMCC=2:302,1:303) Q
7DRG304 ;
8DRG305 S ICDRG=$S(ICDMCC=2:304,1:305) Q
9DRG306 ;
10DRG307 S ICDRG=$S(ICDMCC=2:306,1:307) Q
11DRG308 ;
12DRG309 ;
13DRG310 I (ICDDX(1)=2559!$D(ICDDXT("427.41"))),'ICDEXP S ICDMCC=2
14 S ICDRG=$S(ICDMCC=2:308,ICDMCC=1:309,1:310) Q
15DRG311 S ICDRG=311 Q
16DRG312 S ICDRG=312 Q
17DRG313 S ICDRG=313 Q
18DRG314 ;
19DRG315 ;
20DRG316 S ICDRG=$S(ICDMCC=2:314,ICDMCC=1:315,1:316) Q
21DRG326 ;
22DRG327 ;
23DRG328 S ICDRG=$S(ICDMCC=2:326,ICDMCC=1:327,1:328) Q
24DRG329 ;
25DRG330 ;
26DRG331 S ICDRG=$S(ICDMCC=2:329,ICDMCC=1:330,1:331) Q
27DRG332 ;
28DRG333 ;
29DRG334 S ICDRG=$S(ICDMCC=2:332,ICDMCC=1:333,1:334) Q
30DRG335 ;
31DRG336 ;
32DRG337 S ICDRG=$S(ICDMCC=2:335,ICDMCC=1:336,1:337) Q
33DRG338 ;
34DRG339 ;
35DRG340 I " 246 9197 2954 "'[ICDDX(1) W !,"DRG340" D DRG343 Q
36 S ICDRG=$S(ICDMCC=2:338,ICDMCC=1:339,1:340) Q
37DRG341 ;
38DRG342 ;
39DRG343 I " 246 9197 2954 "[ICDDX(1) W !,"DRG343",ICDDX(1) D DRG340 Q
40 S ICDRG=$S(ICDMCC=2:341,ICDMCC=1:342,1:343) Q
41DRG344 ;
42DRG345 ;
43DRG346 S ICDRG=$S(ICDMCC=2:344,ICDMCC=1:345,1:346) Q
44DRG347 ;
45DRG348 ;
46DRG349 S ICDRG=$S(ICDMCC=2:347,ICDMCC=1:348,1:349) Q
47DRG350 ;
48DRG351 ;
49DRG352 I ICDOR["J" S ICDRG=$S(ICDMCC=2:350,ICDMCC=1:351,1:352) Q
50DRG353 ;
51DRG354 ;
52DRG355 S ICDRG=$S(ICDMCC=2:353,ICDMCC=1:354,1:355) Q
53DRG356 ;
54DRG357 ;
55DRG358 S ICDRG=$S(ICDMCC=2:356,ICDMCC=1:357,1:358) Q
56DRG368 ;
57DRG369 ;
58DRG370 S ICDRG=$S(ICDMCC=2:368,ICDMCC=1:369,1:370) Q
59DRG371 ;
60DRG372 ;
61DRG373 S ICDRG=$S(ICDMCC=2:371,ICDMCC=1:372,1:373) Q
62DRG374 ;
63DRG375 ;
64DRG376 S ICDRG=$S(ICDMCC=2:374,ICDMCC=1:375,1:376) Q
65DRG377 ;
66DRG378 ;
67DRG379 S ICDRG=$S(ICDMCC=2:377,ICDMCC=1:378,1:379) Q
68DRG380 ;
69DRG381 ;
70DRG382 S ICDRG=$S(ICDMCC=2:380,ICDMCC=1:381,1:382) Q
71DRG383 ;
72DRG384 S ICDRG=$S(ICDMCC=2:383,1:384) Q
73DRG385 ;
74DRG386 ;
75DRG387 S ICDRG=$S(ICDMCC=2:385,ICDMCC=1:386,1:387) Q
76DRG388 ;
77DRG389 ;
78DRG390 S ICDRG=$S(ICDMCC=2:388,ICDMCC=1:389,1:390) Q
79DRG391 ;
80DRG392 S ICDRG=$S(ICDMCC=2:391,1:392) Q
81DRG393 ;
82DRG394 ;
83DRG395 S ICDRG=$S(ICDMCC=2:393,ICDMCC=1:394,1:395) Q
84 Q
Note: See TracBrowser for help on using the repository browser.