三种DRGs的实现

被领导要求着看了些drgs的东西，找了2个分组方法和单位自己的进行比较。

第一个是最早的drgs分组方法，来自yale大学的，流程如下

用R实现：

library(rpart)
library(rpart.plot)
library(rattle)
library(RColorBrewer)

setwd("D://test//data//")
filename<-c('a','b','c','d','e','f','g','h','i','j','k','l','m','n','o','p','q','r','s','t','z')

sink("D://test//log.txt")
for(i in filename){
	dt<- read.csv(paste(i,'.csv',sep=""),header = TRUE,sep='\t');
	dt$xb<-as.factor(dt$xb);
	dt$opr1<-substring(dt$opr1,1,1);
	fit <- rpart(fee ~age + xb + dg1 + dg2 + flg_dg2 + opr1 + flg_opr,data=dt, method="anova")  
	print(dt$mdc[1]);
	summary(fit);
}
sink()

第二种是北京的 参考《北京drgs系统的研究与应用 》 邓小红

流程如下：

也用R实现了下：

setwd("D://test//data//")
filename<-c('a','b','c','d','e','f','g','h','i','j','k','l','m','n','o','p','q','r','s','t','z')

sink("D://test//log.txt")
for(i in filename){
	dt<- read.csv(paste(i,'.csv',sep=""),header = TRUE,sep='\t');
	dt$xb<-as.factor(dt$xb);
	dt$opr1<-substring(dt$opr1,1,1);
	dt$opr1<-as.factor(dt$opr1)
	
	dt$age_seg<-"n"
	dt[which(dt$age<18,arr.ind=TRUE),12]<- "a"
	dt[which(dt$age>=18 & dt$age<= 60),12]<- "b"
	dt[which(dt$age>60,arr.ind=TRUE),12]<- "c"
	dt$age_seg<- as.factor(dt$age_seg)

	dt$dig_seg<-"none"
	dt[which(dt$cnt_dg>0 & dt$cnt_dg<= 3),13]<- "ordi"
	dt[which(dt$cnt_dg>3),13]<- "serv"
	dt$dig_seg<- as.factor(dt$dig_seg)
	print(i)
	for(op in levels(dt$opr1)){
		tmp_dt<- dt[which(dt$opr1==op),]
		if(dim(tmp_dt)[1]>=2){
			tmp_cv<- sd(as.double(tmp_dt$fee))/mean(as.double(tmp_dt$fee))
			if(tmp_cv<0.8) print(paste(op,tmp_cv,dim(tmp_dt)[1],sep=","))
			
			if(tmp_cv>=0.8){
				for(ag in levels(dt$age_seg)){
					tmp_age_dt<- dt[which(tmp_dt$age_seg==ag),]
					if(dim(tmp_age_dt)[1]>=2){
						tmp_age_cv<- sd(as.double(tmp_age_dt$fee))/mean(as.double(tmp_age_dt$fee))
						if(tmp_age_cv<0.8) print(paste(ag,tmp_age_cv,dim(tmp_age_dt)[1],sep=","))
						
						if(tmp_age_cv>=0.8){
							for(cb in levels(dt$dig_seg)){
								tmp_cb_dt<- dt[which(tmp_age_dt$dig_seg==cb),]
								if(dim(tmp_cb_dt)[1]>=2){
									tmp_cb_cv<- sd(as.double(tmp_cb_dt$fee))/mean(as.double(tmp_cb_dt$fee))
									print(paste(cb,tmp_cb_cv,dim(tmp_cb_dt)[1],sep=","))
								}
								
							}
						}
					}				
					
					
				}
			}
		}	
			
	}
}
sink()

最后是上海的，简单的二二组合，用sql就实现了。

select dg1,
       opr1,
       avg(fee) avgfee,
       count(*) cnt,
       stddev(fee) / avg(fee) cvfee
  from tmp_tianwq_yaledrgs1
 group by dg1, opr1;

残留的问题…… 可能是对R包有所误解…… 居然叶子加起来的误差比原来的总误差还大……