被领导要求着看了些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包有所误解…… 居然叶子加起来的误差比原来的总误差还大……
今天的文章三种DRGs的实现分享到此就结束了,感谢您的阅读。
版权声明:本文内容由互联网用户自发贡献,该文观点仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 举报,一经查实,本站将立刻删除。
如需转载请保留出处:https://bianchenghao.cn/59861.html