Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ICDTBL9C

ICDTBL9C.m

Go to the documentation of this file.
  1. ICDTBL9C ;ALB/MJB/KUM - GROUPER UTILITY FUNCTIONS;08/09/2010
  1. ;;18.0;DRG Grouper;**50,54,64,78**;Oct 20, 2000;Build 15
  1. ;
  1. DRG901 ;
  1. DRG902 ;
  1. DRG903 S ICDRG=$S(ICDMCC=2:901,ICDMCC=1:902,1:903) Q
  1. DRG904 ;
  1. DRG905 S ICDRG=$S(ICDMCC>0:904,1:905) Q
  1. DRG906 S ICDRG=906 Q
  1. DRG907 ;
  1. DRG908 ;
  1. DRG909 S ICDRG=$S(ICDMCC=2:907,ICDMCC=1:908,1:909) Q
  1. DRG913 ;
  1. DRG914 S ICDRG=$S(ICDMCC=2:913,1:914) Q
  1. DRG915 ;
  1. DRG916 S ICDRG=$S(ICDMCC=2:915,1:916) Q
  1. DRG917 ;
  1. DRG918 S ICDRG=$S(ICDMCC=2:917,1:918) Q
  1. DRG919 ;
  1. DRG920 ;
  1. DRG921 S ICDRG=$S(ICDMCC=2:919,ICDMCC=1:920,1:921) Q
  1. DRG922 ;
  1. DRG923 S ICDRG=$S(ICDMCC=2:922,1:923) Q
  1. DRG927 S ICDRG=927 Q
  1. DRG928 ;
  1. DRG929 S ICDRG=$S(ICDMCC>0:928,1:929) Q
  1. DRG933 S ICDRG=933 Q
  1. DRG934 S ICDRG=934 Q
  1. DRG935 S ICDRG=935 Q
  1. DRG939 ;
  1. DRG940 ;
  1. DRG941 I ICDOR["O" S ICDRG=$S(ICDMCC=2:939,ICDMCC=1:940,1:941) Q
  1. Q
  1. DRG945 ;
  1. DRG946 S ICDRG=$S(ICDMCC>0:945,1:946) D DRG941 Q
  1. DRG947 ;
  1. DRG948 S ICDRG=$S(ICDMCC=2:947,1:948) D DRG941 Q
  1. DRG949 ;
  1. DRG950 S ICDRG=$S(ICDMCC>0:949,1:950) D DRG941 Q
  1. DRG951 S ICDRG=951 D DRG941 Q
  1. DRG955 S ICDRG=955 Q
  1. DRG956 S ICDRG=956 Q
  1. DRG957 ;
  1. DRG958 ;
  1. DRG959 S ICDRG=$S(ICDMCC=2:957,ICDMCC=1:958,1:959) Q
  1. DRG963 ;
  1. DRG964 ;
  1. DRG965 S ICDRG=$S(ICDMCC=2:963,ICDMCC=1:964,1:965) Q
  1. DRG969 ;
  1. DRG970 S ICDRG=$S(ICDMCC=2:969,1:970) Q
  1. DRG974 ;
  1. DRG975 ;
  1. DRG976 I ICDDX(1)=9118!(ICDDX(1)=9114),ICDMCC=2 D
  1. .I $D(ICDDXT("042.")),$D(ICDDXT("584.9")) S ICDMCC=1 Q
  1. .I $D(ICDDXT("042.")) S ICDMCC=0 Q
  1. I ICDDX(1)=12953,ICDMCC=2 D
  1. .I $D(ICDDXT("344.1")),$D(ICDDXT("348.39")),$D(ICDDXT("070.32")),$D(ICDDXT("345.80")) S ICDMCC=1 Q
  1. .I $D(ICDDXT("136.3")) S ICDMCC=0 Q
  1. S ICDRG=$S(ICDMCC=2:974,ICDMCC=1:975,1:976) Q
  1. DRG977 S ICDRG=977 Q
  1. DRG981 ;
  1. DRG982 ;
  1. DRG983 I ICDDX(1)=$$CODEBA^ICDEX("V278.01",80)&($D(ICDDXT("V85.43"))) S ICDRG=983 Q
  1. S ICDRG=$S(ICDMCC=2:981,ICDMCC=1:982,1:983) Q
  1. DRG984 ;
  1. DRG985 ;
  1. DRG986 S ICDRG=$S(ICDMCC=2:984,ICDMCC=1:985,1:986) Q
  1. DRG987 ;
  1. DRG988 ;
  1. DRG989 S ICDRG=$S(ICDMCC=2:987,ICDMCC=1:988,1:989) Q
  1. DRG998 S ICDRG=998 Q
  1. DRG999 S ICDRG=999 Q
  1. Q