[628] | 1 | ICDTBL8 ;ALB/EG/MRY - GROUPER UTILITY FUNCTIONS ; 11/9/07 1:01pm
|
---|
| 2 | ;;18.0;DRG Grouper;**31**;Oct 20, 2000;Build 7
|
---|
| 3 | DRG800 ;
|
---|
| 4 | DRG801 S ICDRG=$S(ICDMCC=2:799,ICDMCC=1:800,1:801) Q
|
---|
| 5 | DRG802 ;
|
---|
| 6 | DRG803 ;
|
---|
| 7 | DRG804 S ICDRG=$S(ICDMCC=2:802,ICDMCC=1:803,1:804) Q
|
---|
| 8 | DRG808 ;
|
---|
| 9 | DRG809 ;
|
---|
| 10 | DRG810 S ICDRG=$S(ICDMCC=2:808,ICDMCC=1:809,1:810) Q
|
---|
| 11 | DRG811 ;
|
---|
| 12 | DRG812 S ICDRG=$S(ICDMCC=2:811,1:812) Q
|
---|
| 13 | DRG813 S ICDRG=813 Q
|
---|
| 14 | DRG814 ;
|
---|
| 15 | DRG815 ;
|
---|
| 16 | DRG816 S ICDRG=$S(ICDMCC=2:814,ICDMCC=1:815,1:816) Q
|
---|
| 17 | DRG820 ;DRG 20-22
|
---|
| 18 | ;removed check I ICDPD["L"&('$G(ICDMAJ))
|
---|
| 19 | I ICDPD["L"&('$G(ICDMAJ)) D DRG825 Q:"823^824^825^840^841^842^834^835^836"[ICDRG
|
---|
| 20 | ;removed check I ICDPD["L"
|
---|
| 21 | I ICDPD["L"&($G(ICDMAJ)) D Q
|
---|
| 22 | .S ICDRG=$S(ICDMCC=2:820,ICDMCC=1:821,1:822)
|
---|
| 23 | S ICDRG=$S(ICDMCC=2:826,ICDMCC=1:827,1:828)
|
---|
| 24 | Q
|
---|
| 25 | DRG821 D DRG820 Q
|
---|
| 26 | DRG822 D DRG820 Q
|
---|
| 27 | DRG823 ;DRGs 823-825
|
---|
| 28 | S ICDRG=$S(ICDPD["l":836,ICDOR["O"!(ICDORNI["O"):825,1:842)
|
---|
| 29 | I ICDRG=836 S ICDRG=$S(ICDMCC=2:834,ICDMCC=1:835,1:836) Q
|
---|
| 30 | I ICDRG=825 S ICDRG=$S(ICDMCC=2:823,ICDMCC=1:824,1:825) Q
|
---|
| 31 | I ICDRG=842 D Q
|
---|
| 32 | .I ICDPD["L"&($D(ICDOP(" 92.30"))!$D(ICDOP(" 92.31"))!$D(ICDOP(" 92.32"))!$D(ICDOP(" 92.33"))!$D(ICDOP(" 92.39"))) S ICDRG=$S(ICDMCC=2:823,ICDMCC=1:824,1:825) Q
|
---|
| 33 | .I $D(ICDOP(" 92.30"))!$D(ICDOP(" 92.31"))!$D(ICDOP(" 92.32"))!$D(ICDOP(" 92.33"))!$D(ICDOP(" 92.39")) S ICDRG=$S(ICDMCC>0:829,1:830) Q
|
---|
| 34 | .S ICDRG=$S(ICDMCC=2:840,ICDMCC=1:841,1:842)
|
---|
| 35 | Q
|
---|
| 36 | DRG824 D DRG823 Q
|
---|
| 37 | DRG825 D DRG823 Q
|
---|
| 38 | DRG826 ;DRGs 826-828
|
---|
| 39 | I ICDOCNT>0!(ICDOR["O") D Q
|
---|
| 40 | .S ICDRG=$S(ICDMCC=2:826,ICDMCC=1:827,1:828)
|
---|
| 41 | S ICDRG=$S(ICDMCC=2:843,ICDMCC=1:844,1:845)
|
---|
| 42 | Q
|
---|
| 43 | DRG827 ;
|
---|
| 44 | DRG828 S ICDRG=$S(ICDMCC=2:826,ICDMCC=1:827,1:828) Q
|
---|
| 45 | DRG829 ;
|
---|
| 46 | DRG830 S ICDRG=$S(ICDMCC>0:829,1:830) Q
|
---|
| 47 | DRG834 ;DRGs 834-836
|
---|
| 48 | DRG835 ;
|
---|
| 49 | DRG836 D DRG840 Q
|
---|
| 50 | DRG837 ;DRGs 837-839
|
---|
| 51 | DRG838 ;
|
---|
| 52 | DRG839 I ICDSD["l",ICDMCC=2 S ICDRG=837 Q
|
---|
| 53 | I ICDSD'["l",$D(ICDOP(" 00.15")),ICDMCC=2 S ICDRG=837 Q
|
---|
| 54 | I ICDSD["l",'$D(ICDOP(" 00.15")),ICDMCC=1 S ICDRG=838 Q
|
---|
| 55 | I ICDSD'["l",$D(ICDOP(" 00.15")) S ICDRG=838 Q
|
---|
| 56 | I ICDSD["l",'$D(ICDOP(" 00.15")) S ICDRG=839 Q
|
---|
| 57 | D DRG846 Q
|
---|
| 58 | DRG840 ;DRGs 840-842
|
---|
| 59 | S ICDRG=$S(ICDPD["l":836,ICDOR["O"!ICDORNI["O":825,1:842)
|
---|
| 60 | I ICDRG=836 S ICDRG=$S(ICDMCC=2:834,ICDMCC=1:835,1:836) Q
|
---|
| 61 | I ICDRG=825 S ICDRG=$S(ICDMCC=2:823,ICDMCC=1:824,1:825) Q
|
---|
| 62 | S ICDRG=$S(ICDMCC=2:840,ICDMCC=1:841,1:842)
|
---|
| 63 | Q
|
---|
| 64 | DRG841 D DRG840 Q
|
---|
| 65 | DRG842 D DRG840 Q
|
---|
| 66 | DRG843 ;
|
---|
| 67 | DRG844 ;
|
---|
| 68 | DRG845 S ICDRG=$S(ICDMCC=2:843,ICDMCC=1:844,1:845) Q
|
---|
| 69 | DRG846 ;
|
---|
| 70 | DRG847 ;
|
---|
| 71 | DRG848 S ICDRG=$S(ICDMCC=2:846,ICDMCC=1:847,1:848) Q
|
---|
| 72 | DRG849 S ICSDRG=849 Q
|
---|
| 73 | DRG853 ;
|
---|
| 74 | DRG854 ;
|
---|
| 75 | DRG855 I ICDDX(1)=7322 D DRG856 Q
|
---|
| 76 | I ICDDX(1)=13271 D DRG856 Q
|
---|
| 77 | I ICDDX(1)=13272 D DRG856 Q
|
---|
| 78 | I ICDDX(1)=14543 D DRG856 Q
|
---|
| 79 | I ICDOR["O" S ICDRG=$S(ICDMCC=2:853,ICDMCC=1:854,1:855) Q
|
---|
| 80 | Q
|
---|
| 81 | DRG856 ;
|
---|
| 82 | DRG857 ;
|
---|
| 83 | DRG858 I ICDOR["O" S ICDRG=$S(ICDMCC=2:856,ICDMCC=1:857,1:858) Q
|
---|
| 84 | Q
|
---|
| 85 | DRG862 ;
|
---|
| 86 | DRG863 S ICDRG=$S(ICDMCC=2:862,1:863) D DRG853 Q
|
---|
| 87 | DRG864 S ICDRG=864 D DRG853 Q
|
---|
| 88 | DRG865 ;
|
---|
| 89 | DRG866 S ICDRG=$S(ICDMCC=2:865,1:866) D DRG853 Q
|
---|
| 90 | DRG867 ;
|
---|
| 91 | DRG868 ;
|
---|
| 92 | DRG869 S ICDRG=$S(ICDMCC=2:867,ICDMCC=1:868,1:869) D DRG853 Q
|
---|
| 93 | DRG870 ;DRGs 870-872
|
---|
| 94 | S ICDRG=$S(ICDOR["O":855,1:872) I ICDRG=872&($D(ICDOP(" 96.72"))) S ICDRG=870
|
---|
| 95 | I ICDRG=855 S ICDRG=$S(ICDMCC=2:853,ICDMCC=1:854,1:855) Q
|
---|
| 96 | I ICDRG=872 S ICDRG=$S(ICDMCC=2:871,1:872) Q
|
---|
| 97 | Q
|
---|
| 98 | DRG871 D DRG870 Q
|
---|
| 99 | DRG872 D DRG870 Q
|
---|
| 100 | DRG876 I ICDOR["O" S ICDRG=876 Q
|
---|
| 101 | Q
|
---|
| 102 | DRG880 S ICDRG=880 I ICDOR["O" S ICDRG=876 Q
|
---|
| 103 | Q
|
---|
| 104 | DRG881 S ICDRG=881 I ICDOR["O" S ICDRG=876 Q
|
---|
| 105 | Q
|
---|
| 106 | DRG882 S ICDRG=882 I ICDOR["O" S ICDRG=876 Q
|
---|
| 107 | Q
|
---|
| 108 | DRG883 S ICDRG=883 I ICDOR["O" S ICDRG=876 Q
|
---|
| 109 | Q
|
---|
| 110 | DRG884 S ICDRG=884 I ICDOR["O" S ICDRG=876 Q
|
---|
| 111 | Q
|
---|
| 112 | DRG885 S ICDRG=885 I ICDOR["O" S ICDRG=876 Q
|
---|
| 113 | Q
|
---|
| 114 | DRG886 S ICDRG=886 I ICDOR["O" S ICDRG=876 Q
|
---|
| 115 | Q
|
---|
| 116 | DRG887 S ICDRG=887 I ICDOR["O" S ICDRG=876 Q
|
---|
| 117 | Q
|
---|
| 118 | DRG894 S ICDRG=894 I ICDOR["O" S ICDRG=876 Q
|
---|
| 119 | Q
|
---|
| 120 | DRG895 I (ICDOR["ND")!(ICDOR["NR") S ICDRG=895 Q
|
---|
| 121 | DRG896 ;
|
---|
| 122 | DRG897 S ICDRG=$S(ICDMCC=2:896,1:897) Q
|
---|
| 123 | Q
|
---|