ICD10TB8 ;KUM - GROUPER UTILITY FUNCTIONS;05/04/2012
;;18.0;DRG Grouper;**64,82**;Oct 20, 2000;Build 21
;
;DRG800 ; D DRG800^ICDTBL8D - See ICD10TB7
;DRG801 S ICDRG=$S(ICDMCC=2:799,ICDMCC=1:800,1:801) Q - See ICD10TB7
DRG802 ;
DRG803 ;
DRG804 S ICDRG=$S(ICDMCC=2:802,ICDMCC=1:803,1:804) Q
DRG805 ;
DRG806 ;
DRG807 ;
Q
DRG808 ;
DRG809 ;
DRG810 S ICDRG=$S(ICDMCC=2:808,ICDMCC=1:809,1:810) Q
DRG811 ;
DRG812 S ICDRG=$S(ICDMCC=2:811,1:812) Q
DRG813 ;
Q
DRG814 ;
DRG815 ;
DRG816 S ICDRG=$S(ICDMCC=2:814,ICDMCC=1:815,1:816) Q
DRG817 ;
DRG818 ;
DRG819 ;
Q
DRG820 ;
DRG821 ;
DRG822 ;
Q
DRG823 ;
DRG824 ;
DRG825 ;
Q
DRG826 ;
DRG827 ;
DRG828 ;
DRG829 ;
DRG830 ;
Q
DRG831 ;
DRG832 ;
DRG833 ;
Q
DRG834 ;
DRG835 ;
DRG836 ;
Q
DRG837 ;
DRG838 ;
DRG839 ;
Q
DRG840 ;
DRG841 ;
DRG842 ;
S ICDRG=$S(ICDMCC=2:840,ICDMCC=1:841,1:842)
DRG843 ;
DRG844 ;
DRG845 ;
Q
DRG846 ;
DRG847 ;
DRG848 ;
S ICDRG=$S(ICDMCC=2:846,ICDMCC=1:847,1:848) Q
DRG849 ;
DRG850 ;
DRG851 ;
DRG852 ;
Q
DRG853 ;
DRG854 ;
DRG855 ;
Q
DRG856 ;
DRG857 ;
DRG858 ;
Q
DRG859 ;
DRG860 ;
DRG861 ;
Q
DRG862 ;
DRG863 ;
S ICDRG=$S(ICDMCC=2:862,1:863) Q
DRG864 ;
Q
DRG865 ;
DRG866 ;
S ICDRG=$S(ICDMCC=2:865,1:866) Q
DRG867 ;
DRG868 ;
DRG869 S ICDRG=$S(ICDMCC=2:867,ICDMCC=1:868,1:869) Q
DRG870 ;
DRG871 ;
DRG872 ;
Q
DRG876 I $D(ICD10OR("O")) S ICDRG=876 Q
Q
DRG880 S ICDRG=880 I $D(ICD10OR("O")) S ICDRG=876 Q
Q
DRG881 S ICDRG=881 I $D(ICD10OR("O")) S ICDRG=876 Q
Q
DRG882 S ICDRG=882 I $D(ICD10OR("O")) S ICDRG=876 Q
Q
DRG883 S ICDRG=883 I $D(ICD10OR("O")) S ICDRG=876 Q
Q
DRG884 S ICDRG=884 I $D(ICD10OR("O")) S ICDRG=876 Q
Q
DRG885 S ICDRG=885 I $D(ICD10OR("O")) S ICDRG=876 Q
Q
DRG886 S ICDRG=886 I $D(ICD10OR("O")) S ICDRG=876 Q
Q
DRG887 S ICDRG=887 I $D(ICD10OR("O")) S ICDRG=876 Q
Q
DRG888 ;
DRG889 ;
DRG890 ;
DRG891 ;
DRG892 ;
DRG893 ;
DRG894 I ICDDX(1)=503659,ICDMDC=20,$D(ICDOP(" 06743DZ")) D DRG981^ICD10TB9 Q
I ICDDX(1)=504018,ICDMDC=20,$D(ICDOP(" 0BBK4ZZ")) D DRG981^ICD10TB9 Q
Q
DRG895 ;
DRG896 ;
DRG897 ;
Q
DRG898 ;
DRG899 ;
DRG900 ;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HICD10TB8 2157 printed Dec 13, 2024@01:47:06 Page 2
ICD10TB8 ;KUM - GROUPER UTILITY FUNCTIONS;05/04/2012
+1 ;;18.0;DRG Grouper;**64,82**;Oct 20, 2000;Build 21
+2 ;
+3 ;DRG800 ; D DRG800^ICDTBL8D - See ICD10TB7
+4 ;DRG801 S ICDRG=$S(ICDMCC=2:799,ICDMCC=1:800,1:801) Q - See ICD10TB7
DRG802 ;
DRG803 ;
DRG804 SET ICDRG=$SELECT(ICDMCC=2:802,ICDMCC=1:803,1:804)
QUIT
DRG805 ;
DRG806 ;
DRG807 ;
+1 QUIT
DRG808 ;
DRG809 ;
DRG810 SET ICDRG=$SELECT(ICDMCC=2:808,ICDMCC=1:809,1:810)
QUIT
DRG811 ;
DRG812 SET ICDRG=$SELECT(ICDMCC=2:811,1:812)
QUIT
DRG813 ;
+1 QUIT
DRG814 ;
DRG815 ;
DRG816 SET ICDRG=$SELECT(ICDMCC=2:814,ICDMCC=1:815,1:816)
QUIT
DRG817 ;
DRG818 ;
DRG819 ;
+1 QUIT
DRG820 ;
DRG821 ;
DRG822 ;
+1 QUIT
DRG823 ;
DRG824 ;
DRG825 ;
+1 QUIT
DRG826 ;
DRG827 ;
DRG828 ;
DRG829 ;
DRG830 ;
+1 QUIT
DRG831 ;
DRG832 ;
DRG833 ;
+1 QUIT
DRG834 ;
DRG835 ;
DRG836 ;
+1 QUIT
DRG837 ;
DRG838 ;
DRG839 ;
+1 QUIT
DRG840 ;
DRG841 ;
DRG842 ;
+1 SET ICDRG=$SELECT(ICDMCC=2:840,ICDMCC=1:841,1:842)
DRG843 ;
DRG844 ;
DRG845 ;
+1 QUIT
DRG846 ;
DRG847 ;
DRG848 ;
+1 SET ICDRG=$SELECT(ICDMCC=2:846,ICDMCC=1:847,1:848)
QUIT
DRG849 ;
DRG850 ;
DRG851 ;
DRG852 ;
+1 QUIT
DRG853 ;
DRG854 ;
DRG855 ;
+1 QUIT
DRG856 ;
DRG857 ;
DRG858 ;
+1 QUIT
DRG859 ;
DRG860 ;
DRG861 ;
+1 QUIT
DRG862 ;
DRG863 ;
+1 SET ICDRG=$SELECT(ICDMCC=2:862,1:863)
QUIT
DRG864 ;
+1 QUIT
DRG865 ;
DRG866 ;
+1 SET ICDRG=$SELECT(ICDMCC=2:865,1:866)
QUIT
DRG867 ;
DRG868 ;
DRG869 SET ICDRG=$SELECT(ICDMCC=2:867,ICDMCC=1:868,1:869)
QUIT
DRG870 ;
DRG871 ;
DRG872 ;
+1 QUIT
DRG876 IF $DATA(ICD10OR("O"))
SET ICDRG=876
QUIT
+1 QUIT
DRG880 SET ICDRG=880
IF $DATA(ICD10OR("O"))
SET ICDRG=876
QUIT
+1 QUIT
DRG881 SET ICDRG=881
IF $DATA(ICD10OR("O"))
SET ICDRG=876
QUIT
+1 QUIT
DRG882 SET ICDRG=882
IF $DATA(ICD10OR("O"))
SET ICDRG=876
QUIT
+1 QUIT
DRG883 SET ICDRG=883
IF $DATA(ICD10OR("O"))
SET ICDRG=876
QUIT
+1 QUIT
DRG884 SET ICDRG=884
IF $DATA(ICD10OR("O"))
SET ICDRG=876
QUIT
+1 QUIT
DRG885 SET ICDRG=885
IF $DATA(ICD10OR("O"))
SET ICDRG=876
QUIT
+1 QUIT
DRG886 SET ICDRG=886
IF $DATA(ICD10OR("O"))
SET ICDRG=876
QUIT
+1 QUIT
DRG887 SET ICDRG=887
IF $DATA(ICD10OR("O"))
SET ICDRG=876
QUIT
+1 QUIT
DRG888 ;
DRG889 ;
DRG890 ;
DRG891 ;
DRG892 ;
DRG893 ;
DRG894 IF ICDDX(1)=503659
IF ICDMDC=20
IF $DATA(ICDOP(" 06743DZ"))
DO DRG981^ICD10TB9
QUIT
+1 IF ICDDX(1)=504018
IF ICDMDC=20
IF $DATA(ICDOP(" 0BBK4ZZ"))
DO DRG981^ICD10TB9
QUIT
+2 QUIT
DRG895 ;
DRG896 ;
DRG897 ;
+1 QUIT
DRG898 ;
DRG899 ;
DRG900 ;
+1 QUIT
