[628] | 1 | ICDTBL7 ;ALB/EG/MRY - GROUPER UTILITY FUNCTIONS ; 11/13/07 3:47pm
|
---|
| 2 | ;;18.0;DRG Grouper;**31**;Oct 20, 2000;Build 7
|
---|
| 3 | DRG700 S ICDRG=$S(ICDMCC=2:698,ICDMCC=1:699,1:700) Q
|
---|
| 4 | DRG707 ;
|
---|
| 5 | DRG708 S ICDRG=$S(ICDMCC>0:707,1:708) Q
|
---|
| 6 | DRG709 ;
|
---|
| 7 | DRG710 S ICDRG=$S(ICDMCC>0:709,1:710) Q
|
---|
| 8 | DRG711 ;
|
---|
| 9 | DRG712 S ICDRG=$S(ICDMCC>0:711,1:712) Q
|
---|
| 10 | DRG713 ;
|
---|
| 11 | DRG714 S ICDRG=$S(ICDMCC>0:713,1:714) Q
|
---|
| 12 | DRG715 ;
|
---|
| 13 | DRG716 I ICDPD["M" S ICDRG=$S(ICDMCC>0:715,1:716) Q
|
---|
| 14 | DRG717 ;
|
---|
| 15 | DRG718 I ICDPD["M" S ICDRG=$S(ICDMCC>0:715,1:716) Q
|
---|
| 16 | S ICDRG=$S(ICDMCC>0:717,1:718) Q
|
---|
| 17 | DRG722 ;
|
---|
| 18 | DRG723 ;
|
---|
| 19 | DRG724 S ICDRG=$S(ICDMCC=2:722,ICDMCC=1:723,1:724) Q
|
---|
| 20 | DRG725 ;
|
---|
| 21 | DRG726 S ICDRG=$S(ICDMCC=2:725,1:726) Q
|
---|
| 22 | DRG727 ;DRGs 727-728,757-759
|
---|
| 23 | S ICDRG=999
|
---|
| 24 | S ICDRG=$S(SEX="M":728,1:759) I SEX="" S ICDRG=999,ICDRTC=4 Q
|
---|
| 25 | I ICDRG=728 S ICDRG=$S(ICDMCC=2:727,1:728) Q
|
---|
| 26 | I ICDRG=759 S ICDRG=$S(ICDMCC=2:757,ICDMCC=1:758,1:759)
|
---|
| 27 | Q
|
---|
| 28 | DRG728 D DRG727 Q
|
---|
| 29 | DRG729 ;
|
---|
| 30 | DRG730 S ICDRG=$S(ICDMCC>0:729,1:730) Q
|
---|
| 31 | DRG734 ;
|
---|
| 32 | DRG735 S ICDRG=$S(ICDMCC>0:734,1:735) Q
|
---|
| 33 | DRG736 ;DRGs 736-743
|
---|
| 34 | S ICDRG=999
|
---|
| 35 | S ICDRG=$S(ICDPD["M":$S(ICDPD["o":738,ICDMCC=2:739,1:741),1:743)
|
---|
| 36 | I ICDRG=738 S ICDRG=$S(ICDMCC=2:736,ICDMCC=1:737,1:738) Q
|
---|
| 37 | I ICDRG=741 S ICDRG=$S(ICDMCC=1:740,1:741) Q
|
---|
| 38 | I ICDRG=743 S ICDRG=$S(ICDMCC>0:742,1:743)
|
---|
| 39 | Q
|
---|
| 40 | DRG737 D DRG736 Q
|
---|
| 41 | DRG738 D DRG736 Q
|
---|
| 42 | DRG739 D DRG736 Q
|
---|
| 43 | DRG740 D DRG736 Q
|
---|
| 44 | DRG741 D DRG736 Q
|
---|
| 45 | DRG742 D DRG736 Q
|
---|
| 46 | DRG743 D DRG736 Q
|
---|
| 47 | DRG744 ;
|
---|
| 48 | DRG745 S ICDRG=$S(ICDMCC>0:744,1:745) Q
|
---|
| 49 | DRG746 ;
|
---|
| 50 | DRG747 S ICDRG=$S(ICDMCC>0:746,1:747) Q
|
---|
| 51 | DRG748 S ICDRG=748 Q
|
---|
| 52 | DRG749 ;
|
---|
| 53 | DRG750 S ICDRG=$S(ICDMCC>0:749,1:750) Q
|
---|
| 54 | DRG754 ;
|
---|
| 55 | DRG755 ;
|
---|
| 56 | DRG756 S ICDRG=$S(ICDMCC=2:754,ICDMCC=1:755,1:756) Q
|
---|
| 57 | DRG757 D DRG727 Q
|
---|
| 58 | DRG758 D DRG727 Q
|
---|
| 59 | DRG759 D DRG727 Q
|
---|
| 60 | DRG760 ;
|
---|
| 61 | DRG761 S ICDRG=$S(ICDMCC>0:760,1:761) Q
|
---|
| 62 | DRG765 ;
|
---|
| 63 | DRG766 I ICDPD["D" S ICDRG=$S(ICDMCC>0:765,1:766) Q
|
---|
| 64 | S ICDRG=""
|
---|
| 65 | DRG767 I ICDPD["D",ICDOR["s" S ICDRG=767 Q
|
---|
| 66 | DRG768 I ICDPD["D" S ICDRG=768 Q
|
---|
| 67 | Q
|
---|
| 68 | DRG769 S ICDRG=769 Q
|
---|
| 69 | DRG770 S ICDRG=770 Q
|
---|
| 70 | DRG774 ;
|
---|
| 71 | I ICDPD["v" S DRG=774 Q
|
---|
| 72 | I ICDPD'["v" Q
|
---|
| 73 | I ICDPD["v",ICDOR'["O" S DRG=774
|
---|
| 74 | D ONLY
|
---|
| 75 | N I,J S I="",J=0 F S I=$O(ICDOP(I)) Q:I']"" D
|
---|
| 76 | . I '$D(A(I)) S J=1
|
---|
| 77 | I J=0 S ICDRG=774 Q
|
---|
| 78 | Q
|
---|
| 79 | DRG775 ;S ICDRG=775 Q
|
---|
| 80 | I ICDPD'["v" S DRG=775 Q
|
---|
| 81 | I ICDPD["v" Q
|
---|
| 82 | I ICDPD'["v",ICDOR'["O" S DRG=775
|
---|
| 83 | D ONLY
|
---|
| 84 | N I,J S I="",J=0 F S I=$O(ICDOP(I)) Q:I']"" D
|
---|
| 85 | . I '$D(A(I)) S J=1
|
---|
| 86 | I J=0 S ICDRG=775 Q
|
---|
| 87 | Q
|
---|
| 88 | DRG776 S ICDRG=776 Q
|
---|
| 89 | DRG777 S ICDRG=777 Q
|
---|
| 90 | DRG778 S ICDRG=778 Q
|
---|
| 91 | DRG779 S ICDRG=779
|
---|
| 92 | I $D(ICDOP(" 69.01")) S ICDRG=770 Q
|
---|
| 93 | I $D(ICDOP(" 69.02")) S ICDRG=770 Q
|
---|
| 94 | I $D(ICDOP(" 69.09")) S ICDRG=770 Q
|
---|
| 95 | I $D(ICDOP(" 69.51")) S ICDRG=770 Q
|
---|
| 96 | I $D(ICDOP(" 69.52")) S ICDRG=770 Q
|
---|
| 97 | I $D(ICDOP(" 74.91")) S ICDRG=770 Q
|
---|
| 98 | Q
|
---|
| 99 | DRG780 S ICDRG=780 Q
|
---|
| 100 | DRG781 I ICDPD["u"!(ICDSD["u") S ICDRG=781 Q
|
---|
| 101 | DRG782 S ICDRG=782 Q
|
---|
| 102 | DRG789 S ICDRG=789 Q
|
---|
| 103 | DRG790 S ICDRG=790 Q
|
---|
| 104 | DRG791 S ICDRG=791 Q
|
---|
| 105 | DRG792 S ICDRG=792 Q
|
---|
| 106 | DRG793 S ICDRG=793 Q
|
---|
| 107 | DRG794 S ICDRG=794 Q
|
---|
| 108 | DRG795 S ICDRG=795 Q
|
---|
| 109 | DRG799 S ICDRG=$S(ICDMCC=2:799,ICDMCC=1:800,1:801) Q
|
---|
| 110 | Q
|
---|
| 111 | ONLY ;this is a list of op for 774 and 775 to usee
|
---|
| 112 | N A
|
---|
| 113 | S A(" 48.71")=""
|
---|
| 114 | S A(" 49.59")=""
|
---|
| 115 | S A(" 67.51")=""
|
---|
| 116 | S A(" 67.59")=""
|
---|
| 117 | S A(" 67.61")=""
|
---|
| 118 | S A(" 67.69")=""
|
---|
| 119 | S A(" 70.13")=""
|
---|
| 120 | S A(" 70.14")=""
|
---|
| 121 | S A(" 70.24")=""
|
---|
| 122 | S A(" 70.31")=""
|
---|
| 123 | S A(" 70.33")=""
|
---|
| 124 | S A(" 70.71")=""
|
---|
| 125 | S A(" 70.79")=""
|
---|
| 126 | S A(" 71.01")=""
|
---|
| 127 | S A(" 71.09")=""
|
---|
| 128 | S A(" 71.11")=""
|
---|
| 129 | S A(" 77.19")=""
|
---|
| 130 | S A(" 71.3")=""
|
---|
| 131 | S A(" 71.71")=""
|
---|
| 132 | S A(" 71.79")=""
|
---|
| 133 | S A(" 73.99")=""
|
---|
| 134 | S A(" 75.50")=""
|
---|
| 135 | S A(" 75.51")=""
|
---|
| 136 | S A(" 75.61")=""
|
---|
| 137 | Q
|
---|