R/DRGAll0.R

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

#' ZJGrouper
#' 
#' function that take PPROC as PROCs
#' 
#' @examples 
#' data(testdt)
#' CHSGrouper(testdt)->res
#' res
#' 
#' @export

ZJGrouper<-function(data,adrgVarsLst=ADRGVarsLst,drgRulesDf=DRGRulesDfZJ){
  if(!is.element('myRowID',names(data))){
    data$myRowID<-1:nrow(data)
  }
  
  names(data)->namesDt
  require('magrittr')
  as.numeric(data$bornWt)->data$bornWt
  as.numeric(data$age)->data$age
  as.numeric(data$LOS)->data$LOS
  ifelse(data$age==0,1e-10,data$age)->data$age
  ifelse(data$LOS==0,1e-10,data$LOS)->data$LOS
  data[data=='NA']<-NA
  as.data.frame(data)->data
  ifelse(data$PDX%in%adrgVarsLst$PDX,data$PDX,'OutOfRange')->data$PDX
  data$PDX[is.na(data$PDX)]<-'OutOfRange'
  for(i in 1:15){
    ifelse(data[,paste0('ADX',i)]%in%adrgVarsLst$PDX,data[,paste0('ADX',i)],'OutOfRange')->data[,paste0('ADX',i)]
    ifelse(is.na(data[,paste0('ADX',i)]),'OutOfRange',data[,paste0('ADX',i)])->data[,paste0('ADX',i)]
  }
  
  for(i in 1:8){
    ifelse(data[,paste0('PROC',i)]%in%adrgVarsLst$PPROC,data[,paste0('PROC',i)],'OutOfRange')->data[,paste0('PROC',i)]
    ifelse(is.na(data[,paste0('PROC',i)]),'OutOfRange',data[,paste0('PROC',i)])->data[,paste0('PROC',i)]
  }
  
  CCExcl(data=data,ccEcl=CCEclCHS) %>% CCStat2(data=.) %>%ADRGGrouper5(data=.,lstmat=lstMat) %>%  DRGGrouper(data=.,drgRulesDf=drgRulesDf) ->res
  
  merge(data,res[,c('myRowID','MDCCode','ADRGCode','DRGCode','CCStatus')],by='myRowID',all.x=T)->dtFinal
  
  ifelse(substr(dtFinal$DRGCode,4,5)%in%c('ZZ','BZ'),9,
         ifelse(substr(dtFinal$DRGCode,4,4)=='A',0,
                ifelse(substr(dtFinal$DRGCode,4,5)=='ZA','1',
                       ifelse(substr(dtFinal$DRGCode,4,5)=='ZC','3','5'))))->tail
  paste(dtFinal$ADRGCode,tail,sep='')->dtFinal$DRGCode
  dtFinal$DRGCode[dtFinal$DRGCode=='NANA']<-NA
  
  as.data.frame(dtFinal)->res
  
  ifelse(res$PDX%in%DRGChk$DXExcl,'PDX.Excl','Normal')->typepdx
  apply(res[,paste0('PROC',1:8)],1,function(i)ifelse(any(i%in%DRGChk$PROCIn,na.rm=T),'PROC.Inc','PROC.Excl'))->typeproc
  ifelse(substr(res$DRGCode,2,2)%in%LETTERS[18:26],'medical','others')->typeADRG
  ifelse(typepdx=='PDX.Excl','PDXNotInADRGs',ifelse(typeproc=='PROC.Inc'&typeADRG=='medical','PDXUnmatchProc','Normal'))->res$DRGVer
  
  return(res)
  
  
}