- ICDTBL8G ;ALB/JDG - GROUPER UTILITY FUNCTIONS;08/09/2010
- ;;18.0;DRG Grouper;**77,78**;Oct 20, 2000;Build 15
- DRG800 ;
- DRG801 S ICDRG=$S(ICDMCC=2:799,ICDMCC=1:800,1:801) Q
- DRG802 ;
- DRG803 ;
- DRG804 S ICDRG=$S(ICDMCC=2:802,ICDMCC=1:803,1:804) Q
- DRG808 ;
- DRG809 ;
- DRG810 I ICDDX(1)=$O(^ICD9("AB","288.00 ",0)),$D(ICDDXT("284.11")),ICDMCC=2 S ICDRG=809 Q
- S ICDRG=$S(ICDMCC=2:808,ICDMCC=1:809,1:810) Q
- DRG811 ;
- DRG812 S ICDRG=$S(ICDMCC=2:811,1:812) Q
- DRG813 S ICDRG=813 Q
- DRG814 ;
- DRG815 ;
- DRG816 S ICDRG=$S(ICDMCC=2:814,ICDMCC=1:815,1:816) Q
- DRG820 ;DRG 820-822
- ;removed check I ICDPD["L"&('$G(ICDMAJ))
- I ICDPD["L"&('$G(ICDMAJ)) D DRG825 Q:"823^824^825^840^841^842^834^835^836"[ICDRG
- ;removed check I ICDPD["L"
- I ICDPD["L"&($G(ICDMAJ)) D Q
- .S ICDRG=$S(ICDMCC=2:820,ICDMCC=1:821,1:822)
- S ICDRG=$S(ICDMCC=2:826,ICDMCC=1:827,1:828)
- Q
- DRG821 D DRG820 Q
- DRG822 D DRG820 Q
- DRG823 ;DRGs 823-825
- S ICDRG=$S(ICDPD["l":836,ICDOR["O"!(ICDORNI["O"):825,1:842)
- I ICDRG=836 S ICDRG=$S(ICDMCC=2:834,ICDMCC=1:835,1:836) Q
- I ICDRG=825 S ICDRG=$S(ICDMCC=2:823,ICDMCC=1:824,1:825) Q
- I ICDRG=842 D Q
- .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
- .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
- .S ICDRG=$S(ICDMCC=2:840,ICDMCC=1:841,1:842)
- Q
- DRG824 D DRG823 Q
- DRG825 D DRG823 Q
- DRG826 ;DRGs 826-828
- I $G(ICDMAJ)="^"!'($G(ICDMAJ)) D DRG829 Q
- I ICDOCNT>0!(ICDOR["O") D Q
- .S ICDRG=$S(ICDMCC=2:826,ICDMCC=1:827,1:828) Q
- S ICDRG=$S(ICDMCC=2:843,ICDMCC=1:844,1:845)
- Q
- DRG827 ;
- DRG828 ;S ICDRG=$S(ICDMCC=2:826,ICDMCC=1:827,1:828) Q
- DRG829 I ICDPD["L"!($G(ICDMAJ)),('$D(ICDOP(" 92.30"))),('$D(ICDOP(" 92.31"))),('$D(ICDOP(" 92.32"))),('$D(ICDOP(" 92.33"))),('$D(ICDOP(" 92.39"))) D DRG826 Q
- I ICDSD["l" D DRG837 Q
- I ICDSD'["l"&(ICDOR'["O"),('$D(ICDOP(" 92.30"))),('$D(ICDOP(" 92.31"))),('$D(ICDOP(" 92.32"))),('$D(ICDOP(" 92.33"))),('$D(ICDOP(" 92.39"))) D DRG846 Q
- DRG830 S ICDRG=$S(ICDMCC>0:829,1:830) Q
- DRG834 ;DRGs 834-836
- DRG835 ;
- DRG836 D DRG840 Q
- DRG837 ;DRGs 837-839
- DRG838 ;
- DRG839 I ICDSD["l",ICDMCC=2 S ICDRG=837 Q
- I ICDSD["l"&(ICDSD["2") S ICDRG=$S(ICDMCC=2:837,ICDMCC=1:838,1:839)
- I ICDDX(1)=$O(^ICD9("AB","V58.11 ",0))!(ICDDX(1)=$O(^ICD9("AB","V58.12 ",0)))!(ICDDX(1)=$O(^ICD9("AB","V67.2 ",0))),$D(ICDDXT("208.00"))!($D(ICDDXT("205.02"))),ICDMCC=1 S ICDRG=839 Q
- I ICDSD'["l",$D(ICDOP(" 00.15")),ICDMCC=2 S ICDRG=837 Q
- I ICDSD["l",'$D(ICDOP(" 00.15")),ICDMCC=1 S ICDRG=838 Q
- I ICDSD'["l",$D(ICDOP(" 00.15")) S ICDRG=838 Q
- I ICDSD["l",'$D(ICDOP(" 00.15")) S ICDRG=839 Q
- I ICDSD'["l"&(ICDOR'["O") D DRG846 Q
- D DRG846 Q
- DRG840 ;DRGs 840-842
- S ICDRG=$S(ICDPD["l":836,ICDOR["O"!(ICDORNI["O"):825,1:842)
- I ICDRG=836 S ICDRG=$S(ICDMCC=2:834,ICDMCC=1:835,1:836) Q
- I ICDRG=825 S ICDRG=$S(ICDMCC=2:823,ICDMCC=1:824,1:825) Q
- S ICDRG=$S(ICDMCC=2:840,ICDMCC=1:841,1:842)
- Q
- DRG841 D DRG840 Q
- DRG842 D DRG840 Q
- DRG843 ;
- DRG844 ;
- DRG845 I ICDPD["L" D DRG840 Q
- I ICDDX(1)=$O(^ICD9("AB","V58.0 ",0)) S ICDRG=849 Q
- I ICDDX(1)=$O(^ICD9("AB","V67.1 ",0)) S ICDRG=849 Q
- I $D(ICDDX(1))&(ICDOPCT=0) D Q:"837^838^839^846^847^848"[ICDRG
- .I ICDDX(1)=$O(^ICD9("AB","V58.11 ",0))!(ICDDX(1)=$O(^ICD9("AB","V58.12 ",0)))!(ICDDX(1)=$O(^ICD9("AB","V67.2 ",0))) D
- ..I ICDSD["2" D DRG837 Q
- ..I ICDSD'["2" D DRG846 Q
- I ICDPD["L" D DRG820 Q
- I ICDOR["N"&(ICDOR'["V")&($D(ICDPDRG(844))) S ICDRG=844 Q
- S ICDRG=$S(ICDMCC=2:843,ICDMCC=1:844,1:845) Q
- Q
- DRG846 ;
- DRG847 ;
- DRG848 I ICDDX(1)=$O(^ICD9("AB","V58.11 ",0))!(ICDDX(1)=$O(^ICD9("AB","V58.12 ",0)))!(ICDDX(1)=$O(^ICD9("AB","V67.2 ",0))) S ICDRG=$S(ICDMCC=2:846,ICDMCC=1:847,1:848) Q
- D DRG844 Q
- DRG849 I ICDDX(1)=$O(^ICD9("AB","V58.0 ",0)) S ICDRG=849 Q
- I ICDDX(1)=$O(^ICD9("AB","V67.1 ",0)) S ICDRG=849 Q
- D DRG844 Q
- DRG853 ;
- DRG854 ;
- DRG855 I ICDOR="",ICDDX(1)=7322!(ICDDX(1)=13271)!(ICDDX(1)=13272) D DRG862 Q
- I ICDOR["O" S ICDRG=$S(ICDMCC=2:853,ICDMCC=1:854,1:855) Q
- I ICDDX(1)=7322 D DRG856 Q
- I ICDDX(1)=13271 D DRG856 Q
- I ICDDX(1)=13272 D DRG856 Q
- I ICDDX(1)=14543 D DRG856 Q
- Q
- DRG856 ;
- DRG857 ;
- DRG858 I ICDOR'["O" D DRG862 Q
- I ICDOR["O" S ICDRG=$S(ICDMCC=2:856,ICDMCC=1:857,1:858) Q
- Q
- DRG862 ;
- DRG863 I ICDDX(1)'=7322&(ICDDX(1)'=13271)&(ICDDX(1)'=13272) D DRG867 Q
- S ICDRG=$S(ICDMCC=2:862,1:863) Q
- DRG864 S ICDRG=864 Q
- DRG865 ;
- DRG866 ;
- S ICDRG=$S(ICDMCC=2:865,1:866) Q
- DRG867 ;
- DRG868 ;
- DRG869 I ICDOR["O",$D(ICDOP)>10,ICDDX(1)'=7322!(ICDDX(1)'=13271)!(ICDDX(1)'=13272)!(ICDDX(1)'=14543) D DRG853 Q
- S ICDRG=$S(ICDMCC=2:867,ICDMCC=1:868,1:869) Q
- DRG870 ;DRGs 870-872
- S ICDRG=$S(ICDOR["O":855,1:872) I ICDRG=872&($D(ICDOP(" 96.72"))) S ICDRG=870
- I ICDRG=855 S ICDRG=$S(ICDMCC=2:853,ICDMCC=1:854,1:855) Q
- I ICDRG=872 S ICDRG=$S(ICDMCC=2:871,1:872) Q
- Q
- DRG871 D DRG870 Q
- DRG872 D DRG870 Q
- DRG876 I ICDOR["O" S ICDRG=876 Q
- Q
- DRG880 S ICDRG=880 I ICDOR["O" S ICDRG=876 Q
- Q
- DRG881 S ICDRG=881 I ICDOR["O" S ICDRG=876 Q
- Q
- DRG882 S ICDRG=882 I ICDOR["O" S ICDRG=876 Q
- Q
- DRG883 S ICDRG=883 I ICDOR["O" S ICDRG=876 Q
- Q
- DRG884 S ICDRG=884 I ICDOR["O" S ICDRG=876 Q
- Q
- DRG885 S ICDRG=885 I ICDOR["O" S ICDRG=876 Q
- Q
- DRG886 S ICDRG=886 I ICDOR["O" S ICDRG=876 Q
- Q
- DRG887 S ICDRG=887 I ICDOR["O" S ICDRG=876 Q
- Q
- DRG894 S ICDRG=894 I ICDOR["O" S ICDRG=876 Q
- Q
- DRG895 I (ICDOR["ND")!(ICDOR["NR") S ICDRG=895 Q
- I ICDOR["O" S ICDRG=983 Q
- DRG896 ;
- DRG897 S ICDRG=$S(ICDMCC=2:896,1:897) Q
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HICDTBL8G 5613 printed Feb 18, 2025@23:18:35 Page 2
- ICDTBL8G ;ALB/JDG - GROUPER UTILITY FUNCTIONS;08/09/2010
- +1 ;;18.0;DRG Grouper;**77,78**;Oct 20, 2000;Build 15
- DRG800 ;
- DRG801 SET ICDRG=$SELECT(ICDMCC=2:799,ICDMCC=1:800,1:801)
- QUIT
- DRG802 ;
- DRG803 ;
- DRG804 SET ICDRG=$SELECT(ICDMCC=2:802,ICDMCC=1:803,1:804)
- QUIT
- DRG808 ;
- DRG809 ;
- DRG810 IF ICDDX(1)=$ORDER(^ICD9("AB","288.00 ",0))
- IF $DATA(ICDDXT("284.11"))
- IF ICDMCC=2
- SET ICDRG=809
- QUIT
- +1 SET ICDRG=$SELECT(ICDMCC=2:808,ICDMCC=1:809,1:810)
- QUIT
- DRG811 ;
- DRG812 SET ICDRG=$SELECT(ICDMCC=2:811,1:812)
- QUIT
- DRG813 SET ICDRG=813
- QUIT
- DRG814 ;
- DRG815 ;
- DRG816 SET ICDRG=$SELECT(ICDMCC=2:814,ICDMCC=1:815,1:816)
- QUIT
- DRG820 ;DRG 820-822
- +1 ;removed check I ICDPD["L"&('$G(ICDMAJ))
- +2 IF ICDPD["L"&('$GET(ICDMAJ))
- DO DRG825
- if "823^824^825^840^841^842^834^835^836"[ICDRG
- QUIT
- +3 ;removed check I ICDPD["L"
- +4 IF ICDPD["L"&($GET(ICDMAJ))
- Begin DoDot:1
- +5 SET ICDRG=$SELECT(ICDMCC=2:820,ICDMCC=1:821,1:822)
- End DoDot:1
- QUIT
- +6 SET ICDRG=$SELECT(ICDMCC=2:826,ICDMCC=1:827,1:828)
- +7 QUIT
- DRG821 DO DRG820
- QUIT
- DRG822 DO DRG820
- QUIT
- DRG823 ;DRGs 823-825
- +1 SET ICDRG=$SELECT(ICDPD["l":836,ICDOR["O"!(ICDORNI["O"):825,1:842)
- +2 IF ICDRG=836
- SET ICDRG=$SELECT(ICDMCC=2:834,ICDMCC=1:835,1:836)
- QUIT
- +3 IF ICDRG=825
- SET ICDRG=$SELECT(ICDMCC=2:823,ICDMCC=1:824,1:825)
- QUIT
- +4 IF ICDRG=842
- Begin DoDot:1
- +5 IF ICDPD["L"&($DATA(ICDOP(" 92.30"))!$DATA(ICDOP(" 92.31"))!$DATA(ICDOP(" 92.32"))!$DATA(ICDOP(" 92.33"))!$DATA(ICDOP(" 92.39")))
- SET ICDRG=$SELECT(ICDMCC=2:823,ICDMCC=1:824,1:825)
- QUIT
- +6 IF $DATA(ICDOP(" 92.30"))!$DATA(ICDOP(" 92.31"))!$DATA(ICDOP(" 92.32"))!$DATA(ICDOP(" 92.33"))!$DATA(ICDOP(" 92.39"))
- SET ICDRG=$SELECT(ICDMCC>0:829,1:830)
- QUIT
- +7 SET ICDRG=$SELECT(ICDMCC=2:840,ICDMCC=1:841,1:842)
- End DoDot:1
- QUIT
- +8 QUIT
- DRG824 DO DRG823
- QUIT
- DRG825 DO DRG823
- QUIT
- DRG826 ;DRGs 826-828
- +1 IF $GET(ICDMAJ)="^"!'($GET(ICDMAJ))
- DO DRG829
- QUIT
- +2 IF ICDOCNT>0!(ICDOR["O")
- Begin DoDot:1
- +3 SET ICDRG=$SELECT(ICDMCC=2:826,ICDMCC=1:827,1:828)
- QUIT
- End DoDot:1
- QUIT
- +4 SET ICDRG=$SELECT(ICDMCC=2:843,ICDMCC=1:844,1:845)
- +5 QUIT
- DRG827 ;
- DRG828 ;S ICDRG=$S(ICDMCC=2:826,ICDMCC=1:827,1:828) Q
- DRG829 IF ICDPD["L"!($GET(ICDMAJ))
- IF ('$DATA(ICDOP(" 92.30")))
- IF ('$DATA(ICDOP(" 92.31")))
- IF ('$DATA(ICDOP(" 92.32")))
- IF ('$DATA(ICDOP(" 92.33")))
- IF ('$DATA(ICDOP(" 92.39")))
- DO DRG826
- QUIT
- +1 IF ICDSD["l"
- DO DRG837
- QUIT
- +2 IF ICDSD'["l"&(ICDOR'["O")
- IF ('$DATA(ICDOP(" 92.30")))
- IF ('$DATA(ICDOP(" 92.31")))
- IF ('$DATA(ICDOP(" 92.32")))
- IF ('$DATA(ICDOP(" 92.33")))
- IF ('$DATA(ICDOP(" 92.39")))
- DO DRG846
- QUIT
- DRG830 SET ICDRG=$SELECT(ICDMCC>0:829,1:830)
- QUIT
- DRG834 ;DRGs 834-836
- DRG835 ;
- DRG836 DO DRG840
- QUIT
- DRG837 ;DRGs 837-839
- DRG838 ;
- DRG839 IF ICDSD["l"
- IF ICDMCC=2
- SET ICDRG=837
- QUIT
- +1 IF ICDSD["l"&(ICDSD["2")
- SET ICDRG=$SELECT(ICDMCC=2:837,ICDMCC=1:838,1:839)
- +2 IF ICDDX(1)=$ORDER(^ICD9("AB","V58.11 ",0))!(ICDDX(1)=$ORDER(^ICD9("AB","V58.12 ",0)))!(ICDDX(1)=$ORDER(^ICD9("AB","V67.2 ",0)))
- IF $DATA(ICDDXT("208.00"))!($DATA(ICDDXT("205.02")))
- IF ICDMCC=1
- SET ICDRG=839
- QUIT
- +3 IF ICDSD'["l"
- IF $DATA(ICDOP(" 00.15"))
- IF ICDMCC=2
- SET ICDRG=837
- QUIT
- +4 IF ICDSD["l"
- IF '$DATA(ICDOP(" 00.15"))
- IF ICDMCC=1
- SET ICDRG=838
- QUIT
- +5 IF ICDSD'["l"
- IF $DATA(ICDOP(" 00.15"))
- SET ICDRG=838
- QUIT
- +6 IF ICDSD["l"
- IF '$DATA(ICDOP(" 00.15"))
- SET ICDRG=839
- QUIT
- +7 IF ICDSD'["l"&(ICDOR'["O")
- DO DRG846
- QUIT
- +8 DO DRG846
- QUIT
- DRG840 ;DRGs 840-842
- +1 SET ICDRG=$SELECT(ICDPD["l":836,ICDOR["O"!(ICDORNI["O"):825,1:842)
- +2 IF ICDRG=836
- SET ICDRG=$SELECT(ICDMCC=2:834,ICDMCC=1:835,1:836)
- QUIT
- +3 IF ICDRG=825
- SET ICDRG=$SELECT(ICDMCC=2:823,ICDMCC=1:824,1:825)
- QUIT
- +4 SET ICDRG=$SELECT(ICDMCC=2:840,ICDMCC=1:841,1:842)
- +5 QUIT
- DRG841 DO DRG840
- QUIT
- DRG842 DO DRG840
- QUIT
- DRG843 ;
- DRG844 ;
- DRG845 IF ICDPD["L"
- DO DRG840
- QUIT
- +1 IF ICDDX(1)=$ORDER(^ICD9("AB","V58.0 ",0))
- SET ICDRG=849
- QUIT
- +2 IF ICDDX(1)=$ORDER(^ICD9("AB","V67.1 ",0))
- SET ICDRG=849
- QUIT
- +3 IF $DATA(ICDDX(1))&(ICDOPCT=0)
- Begin DoDot:1
- +4 IF ICDDX(1)=$ORDER(^ICD9("AB","V58.11 ",0))!(ICDDX(1)=$ORDER(^ICD9("AB","V58.12 ",0)))!(ICDDX(1)=$ORDER(^ICD9("AB","V67.2 ",0)))
- Begin DoDot:2
- +5 IF ICDSD["2"
- DO DRG837
- QUIT
- +6 IF ICDSD'["2"
- DO DRG846
- QUIT
- End DoDot:2
- End DoDot:1
- if "837^838^839^846^847^848"[ICDRG
- QUIT
- +7 IF ICDPD["L"
- DO DRG820
- QUIT
- +8 IF ICDOR["N"&(ICDOR'["V")&($DATA(ICDPDRG(844)))
- SET ICDRG=844
- QUIT
- +9 SET ICDRG=$SELECT(ICDMCC=2:843,ICDMCC=1:844,1:845)
- QUIT
- +10 QUIT
- DRG846 ;
- DRG847 ;
- DRG848 IF ICDDX(1)=$ORDER(^ICD9("AB","V58.11 ",0))!(ICDDX(1)=$ORDER(^ICD9("AB","V58.12 ",0)))!(ICDDX(1)=$ORDER(^ICD9("AB","V67.2 ",0)))
- SET ICDRG=$SELECT(ICDMCC=2:846,ICDMCC=1:847,1:848)
- QUIT
- +1 DO DRG844
- QUIT
- DRG849 IF ICDDX(1)=$ORDER(^ICD9("AB","V58.0 ",0))
- SET ICDRG=849
- QUIT
- +1 IF ICDDX(1)=$ORDER(^ICD9("AB","V67.1 ",0))
- SET ICDRG=849
- QUIT
- +2 DO DRG844
- QUIT
- DRG853 ;
- DRG854 ;
- DRG855 IF ICDOR=""
- IF ICDDX(1)=7322!(ICDDX(1)=13271)!(ICDDX(1)=13272)
- DO DRG862
- QUIT
- +1 IF ICDOR["O"
- SET ICDRG=$SELECT(ICDMCC=2:853,ICDMCC=1:854,1:855)
- QUIT
- +2 IF ICDDX(1)=7322
- DO DRG856
- QUIT
- +3 IF ICDDX(1)=13271
- DO DRG856
- QUIT
- +4 IF ICDDX(1)=13272
- DO DRG856
- QUIT
- +5 IF ICDDX(1)=14543
- DO DRG856
- QUIT
- +6 QUIT
- DRG856 ;
- DRG857 ;
- DRG858 IF ICDOR'["O"
- DO DRG862
- QUIT
- +1 IF ICDOR["O"
- SET ICDRG=$SELECT(ICDMCC=2:856,ICDMCC=1:857,1:858)
- QUIT
- +2 QUIT
- DRG862 ;
- DRG863 IF ICDDX(1)'=7322&(ICDDX(1)'=13271)&(ICDDX(1)'=13272)
- DO DRG867
- QUIT
- +1 SET ICDRG=$SELECT(ICDMCC=2:862,1:863)
- QUIT
- DRG864 SET ICDRG=864
- QUIT
- DRG865 ;
- DRG866 ;
- +1 SET ICDRG=$SELECT(ICDMCC=2:865,1:866)
- QUIT
- DRG867 ;
- DRG868 ;
- DRG869 IF ICDOR["O"
- IF $DATA(ICDOP)>10
- IF ICDDX(1)'=7322!(ICDDX(1)'=13271)!(ICDDX(1)'=13272)!(ICDDX(1)'=14543)
- DO DRG853
- QUIT
- +1 SET ICDRG=$SELECT(ICDMCC=2:867,ICDMCC=1:868,1:869)
- QUIT
- DRG870 ;DRGs 870-872
- +1 SET ICDRG=$SELECT(ICDOR["O":855,1:872)
- IF ICDRG=872&($DATA(ICDOP(" 96.72")))
- SET ICDRG=870
- +2 IF ICDRG=855
- SET ICDRG=$SELECT(ICDMCC=2:853,ICDMCC=1:854,1:855)
- QUIT
- +3 IF ICDRG=872
- SET ICDRG=$SELECT(ICDMCC=2:871,1:872)
- QUIT
- +4 QUIT
- DRG871 DO DRG870
- QUIT
- DRG872 DO DRG870
- QUIT
- DRG876 IF ICDOR["O"
- SET ICDRG=876
- QUIT
- +1 QUIT
- DRG880 SET ICDRG=880
- IF ICDOR["O"
- SET ICDRG=876
- QUIT
- +1 QUIT
- DRG881 SET ICDRG=881
- IF ICDOR["O"
- SET ICDRG=876
- QUIT
- +1 QUIT
- DRG882 SET ICDRG=882
- IF ICDOR["O"
- SET ICDRG=876
- QUIT
- +1 QUIT
- DRG883 SET ICDRG=883
- IF ICDOR["O"
- SET ICDRG=876
- QUIT
- +1 QUIT
- DRG884 SET ICDRG=884
- IF ICDOR["O"
- SET ICDRG=876
- QUIT
- +1 QUIT
- DRG885 SET ICDRG=885
- IF ICDOR["O"
- SET ICDRG=876
- QUIT
- +1 QUIT
- DRG886 SET ICDRG=886
- IF ICDOR["O"
- SET ICDRG=876
- QUIT
- +1 QUIT
- DRG887 SET ICDRG=887
- IF ICDOR["O"
- SET ICDRG=876
- QUIT
- +1 QUIT
- DRG894 SET ICDRG=894
- IF ICDOR["O"
- SET ICDRG=876
- QUIT
- +1 QUIT
- DRG895 IF (ICDOR["ND")!(ICDOR["NR")
- SET ICDRG=895
- QUIT
- +1 IF ICDOR["O"
- SET ICDRG=983
- QUIT
- DRG896 ;
- DRG897 SET ICDRG=$SELECT(ICDMCC=2:896,1:897)
- QUIT
- +1 QUIT