source: FOIAVistA/trunk/r/DRG_GROUPER-ICD--ICPT/ICDTBL5.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: 1.9 KB
Line 
1ICDTBL5 ;ALB/EG/MRY - GROUPER UTILITY FUNCTIONS ; 11/8/07 1:44pm
2 ;;18.0;DRG Grouper;**31,32**;Oct 20, 2000;Build 9
3DRG500 ;
4DRG501 ;
5DRG502 S ICDRG=$S(ICDMCC=2:500,ICDMCC=1:501,1:502) Q
6DRG503 ;
7DRG504 ;
8DRG505 S ICDRG=$S(ICDMCC=2:503,ICDMCC=1:504,1:505) Q
9DRG506 S ICDRG=506 Q
10DRG507 ;
11DRG508 S ICDRG=$S(ICDMCC>0:507,1:508) Q
12DRG509 S ICDRG=509 Q
13DRG510 ;
14DRG511 ;
15DRG512 S ICDRG=$S(ICDMCC=2:510,ICDMCC=1:511,1:512) Q
16DRG513 ;
17DRG514 S ICDRG=$S(ICDMCC>0:513,1:514) Q
18DRG515 ;
19DRG516 ;
20DRG517 S ICDRG=$S(ICDMCC=2:515,ICDMCC=1:516,1:517) Q
21DRG533 ;
22DRG534 S ICDRG=$S(ICDMCC=2:533,1:534) Q
23DRG535 ;
24DRG536 S ICDRG=$S(ICDMCC=2:535,1:536) Q
25DRG537 ;
26DRG538 S ICDRG=$S(ICDMCC>0:537,1:538) Q
27DRG539 ;
28DRG540 ;
29DRG541 S ICDRG=$S(ICDMCC=2:539,ICDMCC=1:540,1:541) Q
30DRG542 ;
31DRG543 ;
32DRG544 S ICDRG=$S(ICDMCC=2:542,ICDMCC=1:543,1:544) Q
33DRG545 ;
34DRG546 ;
35DRG547 S ICDRG=$S(ICDMCC=2:545,ICDMCC=1:546,1:547) Q
36DRG548 ;
37DRG549 ;
38DRG550 S ICDRG=$S(ICDMCC=2:548,ICDMCC=1:549,1:550) Q
39DRG551 ;
40DRG552 S ICDRG=$S(ICDMCC=2:551,1:552) Q
41DRG553 ;
42DRG554 S ICDRG=$S(ICDMCC=2:553,1:554) Q
43DRG555 ;
44DRG556 S ICDRG=$S(ICDMCC=2:555,1:556) Q
45DRG557 ;
46DRG558 S ICDRG=$S(ICDMCC=2:557,1:558) Q
47DRG559 ;
48DRG560 ;
49DRG561 S ICDRG=$S(ICDMCC=2:559,ICDMCC=1:560,1:561) Q
50DRG562 ;
51DRG563 S ICDRG=$S(ICDMCC=2:562,1:563) Q
52DRG564 ;
53DRG565 ;
54DRG566 S ICDRG=$S(ICDMCC=2:564,ICDMCC=1:565,1:566) Q
55DRG573 ;
56DRG574 ;
57DRG575 I ICDPD["U" S ICDRG=$S(ICDMCC=2:573,ICDMCC=1:574,1:575) Q
58DRG576 ;
59DRG577 ;
60DRG578 S ICDRG=$S(ICDMCC=2:576,ICDMCC=1:577,1:578) Q
61DRG579 ;
62DRG580 ;
63DRG581 S ICDRG=$S(ICDMCC=2:579,ICDMCC=1:580,1:581) Q
64DRG582 ;
65DRG583 I ICDPD["M"!(ICDSD["M") S ICDRG=$S(ICDMCC>0:582,1:583) Q
66 E G DRG584
67DRG584 ;
68DRG585 I ICDOR["M"!(ICDOR["m") S ICDRG=$S(ICDMCC>0:584,1:585) Q
69 E S ICDRG="" Q
70DRG592 ;
71DRG593 ;
72DRG594 S ICDRG=$S(ICDMCC=2:592,ICDMCC=1:593,1:594) Q
73DRG595 ;
74DRG596 S ICDRG=$S(ICDMCC=2:595,1:596) Q
75DRG597 ;
76DRG598 ;
77DRG599 I ICDPD["r" S ICDRG=$S(ICDMCC=2:597,ICDMCC=1:598,1:599) Q
78 Q
Note: See TracBrowser for help on using the repository browser.