R/DRGGrouper.R

In sontron/CHSDRGs: CHSDRGs deal the data grouping using CHS DRG rules

#' DRGGrouper
#' 
#' DRG grouping 
#' 
#' @export


DRGGrouper<-function(data,drgRulesDf=DRGRulesDfCHS){
  as.data.frame(data)->data
  subset(data,is.na(ADRGCode))->datNoGroup
  subset(data,!is.na(ADRGCode))->datGroup
  
  if(is.character(drgRulesDf)){
    eval(as.name(drgRulesDf))->rulesDf
  } else {
    drgRulesDf->rulesDf
  }
  
  lapply(unique(datGroup$ADRGCode),function(i){
    datGroup[which(datGroup$ADRGCode==i),]->dati
    rulesDf[which(rulesDf$ADRGCode==i),]->rulesDfi
    
    if(rulesDfi$Fac1=='NULL'){
      dati$DRGCode1<-paste(dati$ADRGCode,'',sep='')
      
    } else {
      
      unlist(stri_split_fixed(rulesDfi$Fac1,'|'))->facs1
      
      sapply(facs1,function(i){
        validateVec(dati[,rulesDfi$type1],i)
      })->resMat
      
      if(is.vector(resMat)){
        which(resMat)->indi
      } else {
        apply(resMat,1,function(i)which(i))->indi
      }
      
      
      
      if(rulesDfi$type1=='age'){
        paste(dati$ADRGCode,LETTERS[indi],sep='')->dati$DRGCode1
      } else {
        paste(dati$ADRGCode,c('P','Q','R','S','T')[indi],sep='')->dati$DRGCode1
        
      }
      
    }
      
      if(rulesDfi$Fac2=='NULL'){
        dati$DRGCode<-paste(dati$DRGCode1,'9',sep='')
        
      } else {
        
        unlist(stri_split_fixed(rulesDfi$Fac2,'|'))->facs2
        
        sapply(facs2,function(i){
          validateVec(dati[,'CCStatus'],i)
        })->resMat
        
        if(is.vector(resMat)){
          which(resMat)->indi
        } else {
          apply(resMat,1,function(i)which(i))->indi
        }
        
        
        
        
        
        CCNames<-c('1','2','3','4','5')
        
        names(CCNames)<-c('[2]','[1,2]','[1]','[0,1]','[0]')
        
        dati$DRGCode<-paste(dati$DRGCode1,CCNames[facs2[indi]],sep='')
        
        
        
      }
      
      return(dati)
      
    
    
  })->lstRes
  
  do.call(rbind,lstRes)->dtGroupFinal
  if(nrow(datNoGroup)>0){
    datNoGroup[,'DRGCode1']<-NA
    datNoGroup[,'DRGCode']<-NA
    rbind(dtGroupFinal,datNoGroup)->ResFinal
  } else {
    ResFinal<-dtGroupFinal
  }
  
  
  return(ResFinal)
  
  
  
}