R/CCStat.R

In sontron/ZJDRG: ZJDRG deal the data grouping using ZJ-DRG rules

#' CCStat
#' 
#' CCStat is a function that return the CCstatus of data
#' 
#' @export

CCStat<-function(data,ccStatus=CCStatusCHS){
  require(data.table)
   paste("ADX",1:15,sep='')->ADXData
   
   if(is.character(ccStatus)){
     eval(as.name(ccStatus))->CCStatus
   } else {ccStatus->CCStatus}
  
   CCStatus$ICDCode[CCStatus$CCStat=='MCC']->MCCCodes
   CCStatus$ICDCode[CCStatus$CCStat=='CC']->CCCodes
  
  apply(data[,ADXData,with=F],1,function(x){
    ifelse(any(is.element(x,MCCCodes),na.rm=T),2,ifelse(
      any(is.element(x,CCCodes)&!any(is.element(x,MCCCodes),na.rm=T)),1,0
    ))
    
  })->data$CCStatus
  
  
  return(data)
  
}



#' CCStat2
#' 
#' CCStat2 is a function that return the CCstatus of data
#' 
#' @export

CCStat2<-function(data,ccmat=CCMat){
  require(data.table)
  as.data.frame(data)->data
  
  CCMat[data$ADX1,,drop=F]->CCStatADX1
  
  for(i in 2:15){
    CCStatADX1|CCMat[data[,paste0('ADX',i)],,drop=F]->CCStatADX1
  }  
  
  
  apply(CCStatADX1[,,drop=F],1,function(i){
    ifelse(i[3],'MCC',ifelse(i[2],'CC','noCC'))
  })->CCss
  
  data$CCStatus<-CCss
  
  
  return(data)
  
}