-
Notifications
You must be signed in to change notification settings - Fork 0
/
DoubleAttribution_com_2019.R
371 lines (339 loc) · 19.9 KB
/
DoubleAttribution_com_2019.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
################################################################################
#### merge attributions (patientAttribution & provider attribution)
################################################################################
### prerequisite
library(data.table)
library(lubridate)
library(tidyverse)
library(zoo)## server <- (Sys.info()[4] == 'LAZ-DEID1') ## logical value
## if (!server) stop('please run in LAZ-DEID1 server!')
source('E:/CT_APCD/Sai/2019spring/data-organization/R/utils.R')
dir_code <- input_dir('E:/CT_APCD/Sai/lds2021/lds2021code/Attribution_2018_2019/')
dir.out <- output_dir('E:/CT_APCD/Sai/lds2021/lds2021file/Attribution_result/output/Double-Attribution_2019/')
dir.in.patAttri <- input_dir('E:/CT_APCD/Sai/lds2021/lds2021file/Attribution_result/InProcess_2019/')
dir.in.NPIAttri <- input_dir("E:/CT_APCD/Sai/lds2021/lds2021code/Attribution_2018_2019/NPI-Attribution/")
dir.demo <- output_dir('E:/CT_APCD/Sai/lds2021/lds2021file/Attribution_result/output/demo_2019/')
source(file.path(dir_code, "myDoc.R"))
date_attribution <- Sys.Date()
overlap <- TRUE # TRUE: consider overlap between ANs; or FALSE: consider only NPI who serves for unique AN.
## start from here ##
patAttri <- fread(paste0(dir.in.patAttri, 'PatAttri_detail.csv'),
header = TRUE, colClasses = 'character', encoding = 'UTF-8')
uniqueN(patAttri$internal_member_id) # 642219
patAttriValid <- patAttri[!Identify %in% c('Unattributed', '')] # '' refers to Tie
uniqueN(patAttriValid$internal_member_id) #634209
uniqueN(patAttri[Identify %in% c('Unattributed')]$internal_member_id) #39755
uniqueN(patAttri[Identify %in% c('')]$internal_member_id) #689
npiAttri <- fread(paste0(dir.in.NPIAttri, 'NPI_WholeSet_2019_com.csv'),
header = TRUE, colClasses = 'character', encoding = 'UTF-8')
if (overlap) {
npiAttrivalid = npiAttri
} else npiAttrivalid <- npiAttri[Total == 1] # if consider only NPI who is assigned to unique AN.
# Attri2 <- npiAttrivalid[patAttri[, -c("Specialty", "Taxonomy1")], on = 'NPI']
Attri2 <- npiAttrivalid[patAttri, on = 'NPI']
uniqueN(Attri2$internal_member_id) #642219
Attri2valid <- Attri2[!is.na(Total)]
uniqueN(Attri2valid$internal_member_id) # 351734
fwrite(Attri2, paste0(dir.out, 'Attri2.csv'))
fwrite(Attri2valid, paste0(dir.out, 'Attri2valid.csv'))
## Attri2valid <- fread(file.path(dir.out, "Attri2valid.csv"), colClasses = 'character')
entityNameList <- names(npiAttri)[4:22]
### provider info (only include those providers who are assigned to at least 1 patient)
npiAttrivalid <- unique(
Attri2valid[, Npat := .N, by = NPI][, eval(
parse(
text = paste0('.(NPI, Taxonomy1, ', paste0(entityNameList, collapse = ", "), ', Npat)')
)
)]
)
uniqueN(npiAttrivalid$NPI) # 2602 providers are attributed to at least 1 patients
fwrite(npiAttrivalid, file.path(dir.out, 'npiAttrivalid.csv'))
### NPI tables
npitable <- data.table(entityName = entityNameList,
provider.total = apply(apply(npiAttri[, eval(parse(text = paste0('.(', paste0(entityNameList, collapse = ", "), ')')))],
2, as.numeric), 2, sum),
provider.PCP = apply(apply(npiAttri[Taxonomy1 %in% taxo_PCP,
eval(parse(text = paste0('.(', paste0(entityNameList, collapse = ", "), ')')))],
2, as.numeric), 2, sum),
provider.ObGyn = apply(apply(npiAttri[Taxonomy1 %in% taxo_OBGYN,
eval(parse(text = paste0('.(', paste0(entityNameList, collapse = ", "), ')')))],
2, as.numeric), 2, sum),
provider.NP = apply(apply(npiAttri[Taxonomy1 %in% taxo_NP,
eval(parse(text = paste0('.(', paste0(entityNameList, collapse = ", "), ')')))],
2, as.numeric), 2, sum),
provier.PA = apply(apply(npiAttri[Taxonomy1 %in% taxo_PA,
eval(parse(text = paste0('.(', paste0(entityNameList, collapse = ", "), ')')))],
2, as.numeric), 2, sum),
provider.PedM = apply(apply(npiAttri[Taxonomy1 %in% taxo_PedM,
eval(parse(text = paste0('.(', paste0(entityNameList, collapse = ", "), ')')))],
2, as.numeric), 2, sum),
provider.ineffect.total = apply(apply(npiAttrivalid[, eval(parse(text = paste0('.(', paste0(entityNameList, collapse = ", "), ')')))],
2, as.numeric), 2, sum),
provider.ineffect.PCP = apply(apply(npiAttrivalid[Taxonomy1 %in% taxo_PCP,
eval(parse(text = paste0('.(', paste0(entityNameList, collapse = ", "), ')')))],
2, as.numeric), 2, sum),
provider.ineffect.ObGyn = apply(apply(npiAttrivalid[Taxonomy1 %in% taxo_OBGYN,
eval(parse(text = paste0('.(', paste0(entityNameList, collapse = ", "), ')')))],
2, as.numeric), 2, sum),
provider.ineffect.NP = apply(apply(npiAttrivalid[Taxonomy1 %in% taxo_NP,
eval(parse(text = paste0('.(', paste0(entityNameList, collapse = ", "), ')')))],
2, as.numeric), 2, sum),
provider.ineffect.PA = apply(apply(npiAttrivalid[Taxonomy1 %in% taxo_PA,
eval(parse(text = paste0('.(', paste0(entityNameList, collapse = ", "), ')')))],
2, as.numeric), 2, sum),
provider.ineffect.PedM = apply(apply(npiAttrivalid[Taxonomy1 %in% taxo_PedM,
eval(parse(text = paste0('.(', paste0(entityNameList, collapse = ", "), ')')))],
2, as.numeric), 2, sum),
provider.ineffect.CCNS = apply(apply(npiAttrivalid[Taxonomy1 %in% taxo_CCNS,
eval(parse(text = paste0('.(', paste0(entityNameList, collapse = ", "), ')')))],
2, as.numeric), 2, sum),
provider.ineffect.FP = apply(apply(npiAttrivalid[Taxonomy1 %in% taxo_FP,
eval(parse(text = paste0('.(', paste0(entityNameList, collapse = ", "), ')')))],
2, as.numeric), 2, sum),
provider.ineffect.IM = apply(apply(npiAttrivalid[Taxonomy1 %in% taxo_IM,
eval(parse(text = paste0('.(', paste0(entityNameList, collapse = ", "), ')')))],
2, as.numeric), 2, sum),
provider.ineffect.GP = apply(apply(npiAttrivalid[Taxonomy1 %in% taxo_GP,
eval(parse(text = paste0('.(', paste0(entityNameList, collapse = ", "), ')')))],
2, as.numeric), 2, sum)
)
fwrite(npitable,
file.path(dir.demo, 'demo_provider.csv'))
### NPI lists and ineffect indicator for each entity
dir.out2 <- output_dir(paste0(dir.out, 'ANLists_final', date_attribution))
for (entityName in entityNameList){
npi_AN <- npiAttri[eval(parse(text = entityName)) == 1,
.(NPI, Taxonomy1)]
## npi_AN.ineffect <- npiAttrivalid[eval(parse(text = entityName)) == 1]$NPI
npi_AN.ineffect <- npiAttrivalid[eval(parse(text = entityName)) == 1][, .N, by = NPI]
npi_AN <- npiAttrivalid[, .(NPI, Npat)][npi_AN, on = 'NPI']
npi_AN[is.na(Npat), Npat := 0]
## table(npi_AN.ineffect$Npat)
fwrite(npi_AN,
paste0(dir.out2, '/', entityName, '.csv'))
cat(entityName, dim(npi_AN)[1], dim(npi_AN[Npat > 0])[1], '\n')
}
pattable <- data.table(entityName = entityNameList,
pat.total = apply(apply(Attri2valid[, eval(parse(text = paste0('.(', paste0(entityNameList, collapse = ", "), ')')))],
2, as.numeric), 2, sum),
pat.to.pcp = apply(apply(Attri2valid[Taxonomy1 %in% taxo_PCP, eval(parse(text = paste0('.(', paste0(entityNameList, collapse = ", "), ')')))],
2, as.numeric), 2, sum),
pat.to.obgyn = apply(apply(Attri2valid[Taxonomy1 %in% taxo_OBGYN, eval(parse(text = paste0('.(', paste0(entityNameList, collapse = ", "), ')')))],
2, as.numeric), 2, sum))
fwrite(pattable,
paste0(dir.out, 'PATtable.csv'))
##### Tie cases
Patient_Tie <- fread(paste0(dir.in.patAttri, 'PatientTie.csv'),
header = TRUE, colClasses = "character", encoding = 'UTF-8')
NPI_WholeSet <- fread(paste0(dir.in.NPIAttri, 'NPI_WholeSet_2019_com.csv'),
header = TRUE, colClasses = "character", encoding = 'UTF-8')
Patient_Tie <- NPI_WholeSet[Patient_Tie, on = "NPI"]
Patient_Tie2 <- Patient_Tie[
, c(4:22, # corresponds to AN indicators
24 # internal_member_id
)][
, lapply(.SD, function(x) sum(as.numeric(x), na.rm = T)), by = .(internal_member_id)
]
Patient_Tie2[, AN_max := do.call(pmax, .SD), .SDcols = 2:20]
fwrite(Patient_Tie2, paste0(dir.out, 'PatientTie2.csv'))
## indicator of whether the ANs have most No. of NPI who are assigned for each tie patient.
Patient_Tie3 <- cbind(
data.table(internal_member_id = Patient_Tie2[!AN_max == 0]$internal_member_id),
Patient_Tie2[!AN_max == 0, ifelse(.SD == AN_max, 1, 0), .SDcols = 2:20]
)
uniqueN(Patient_Tie2$internal_member_id)[1] # 652
uniqueN(Patient_Tie3$internal_member_id) #435 have AN
Attri2_toAN <- rbind(
Attri2valid,
Patient_Tie3,
fill = TRUE
)
Attri2_toAN <- Attri2_toAN[, Total := eval(parse(text = paste(paste0('as.numeric(', entityNameList, ')'), collapse = "+")))]
uniqueN(Attri2_toAN$internal_member_id) # 352169
fwrite(Attri2_toAN, paste0(dir.out, "Attri2_toAN.csv"))
## discovery on providers's specialty
## npitable2 <- data.table(entityName = entityNameList,
## provider.total = apply(apply(npiAttri[, eval(parse(text = paste0('.(', paste0(entityNameList, collapse = ", "), ')')))],
## 2, as.numeric), 2, sum),
## provider.pcp = apply(apply(npiAttri[taxo %in% taxo_PCP,
## eval(parse(text = paste0('.(', paste0(entityNameList, collapse = ", "), ')')))],
## 2, as.numeric), 2, sum),
## provider.obgyn = apply(apply(npiAttri[taxo %in% taxo_OBGYN,
## eval(parse(text = paste0('.(', paste0(entityNameList, collapse = ", "), ')')))],
## 2, as.numeric), 2, sum),
## provider.ineffect.total = apply(apply(npiAttrivalid[, eval(parse(text = paste0('.(', paste0(entityNameList, collapse = ", "), ')')))],
## 2, as.numeric), 2, sum),
## provider.ineffect.pcp = apply(apply(npiAttrivalid[taxo %in% taxo_PCP,
## eval(parse(text = paste0('.(', paste0(entityNameList, collapse = ", "), ')')))],
## 2, as.numeric), 2, sum),
## provider.ineffect.obgyn = apply(apply(npiAttrivalid[taxo %in% taxo_OBGYN,
## eval(parse(text = paste0('.(', paste0(entityNameList, collapse = ", "), ')')))],
## 2, as.numeric), 2, sum))
### discovery on patients who get attributed to NPI but not ANs
outAN_part1 <- Attri2[!Identify %in% 'Unattributed' & is.na(Total) & !internal_member_id %in% Patient_Tie$internal_member_id]
outAN_part2 <- Patient_Tie2[AN_max == 0][, AN_max := NULL]
Attri2_outAN <- rbind(
outAN_part1,
outAN_part2,
fill = TRUE
)
uniqueN(Attri2_outAN$internal_member_id) # 250295
fwrite(outAN_part1, paste0(dir.out, 'Attri2_outAN_part1.csv'))
fwrite(Attri2_outAN, paste0(dir.out, 'Attri2_outAN.csv'))
### Attri2_final
Attri2_final <- rbind(
Attri2_toAN,
Attri2_outAN,
fill = T
)
uniqueN(Attri2_final$internal_member_id) # 602464
elig <- fread("E:/CT_APCD/Beth/data6/Eligibility/By_Calendar_Year/MEDICAL_ELIGIBILITY_ALLRECORDS14_19_6b.csv",
select = c("INTERNAL_MEMBER_ID",
"GENDER_CODE",
"birth_dt"),
colClasses = "character") %>% unique()
elig[, `:=`(birth_year = year(as.yearmon(birth_dt, "%Y%m")))]
elig[, age:= 2019 - as.integer(birth_year)]
elig <- elig[age < 65]
names(elig) <- tolower(names(elig))
elig.patient <- elig[, .(internal_member_id, gender_code, age)] %>%
unique(use.key = FALSE)
sum(!Attri2_final$internal_member_id %in% elig$internal_member_id)
Attri2_final <- elig[Attri2_final, on = c('internal_member_id')]
fwrite(Attri2_final, paste0(dir.out, 'Attri2_final.csv'))
### summary table for patientwise AN v.s. Specialty
# nppes <- fread("E:/CT_APCD/Sai/lds2021/lds2021file/nppes/nppes_lds_com_2019_short.csv",
# colClasses = "character",
# header = TRUE,
# encoding = "UTF-8")
# outAN_part1 <- nppes[outAN_part1, on = c("NPI")]
# spec.order <- c("NP", "CCNS", "PA", "OBGYN", "IM", "FP", "GP", "PedM")
# split_by_specialty <- function(dat, # data.table format with `NPI` column
# row.name){
# dat1 <- nppes[dat[!is.na(NPI), .(NPI, internal_member_id)], on = "NPI"]
# dat2 <- taxo_info[, .(taxo, spec1)][dat1, on = c("taxo" = "Taxonomy1")]
# freq <- table(factor(dat2$spec1, levels = spec.order))
# freq1 <- matrix(freq, nrow = 1)
# freq.tb <- data.table(AN = row.name, freq1)
# colnames(freq.tb) <- c("AN", names(freq))
# return(freq.tb)
# }
# AN_spec <- data.table()
# for (entityName in entityNameList){
# AN_spec <- rbind(
# AN_spec,
# split_by_specialty(
# Attri2_toAN[eval(parse(
# text = paste0(entityName, " == 1")
# ))],
# entityName
# )
# )
# cat(entityName, '\n')
# }
# AN_spec <- rbind(
# AN_spec,
# split_by_specialty(outAN_part1, "Non Attributed")
# )
# fwrite(AN_spec, paste0(dir.out, "AN_spec.csv"))
### discover those
Attri2valid <- fread(file.path(dir.out, "Attri2valid.csv"), colClasses = 'character')
length(unique(Attri2valid$NPI)) # 2674
npiAttri <- fread(paste0(dir.in.NPIAttri, 'NPI_WholeSet_2019_com.csv'),
header = TRUE, colClasses = 'character', encoding = 'UTF-8')
uniqueN(npiAttri$NPI) # 3288
npiAttri[, get.patient := as.numeric(NPI %in% unique(Attri2valid$NPI))]
npi.no.patient <- npiAttri[get.patient == 0]$NPI
## source("E:/CT_APCD/Yaqiong/myfunction.R")
## MC_2016_OutP <- get_medical_vs(
## vs.list = 'Outpatient',
## year.list = 2016
## )
## MC_2019_OutP <- get_medical_vs(
## vs.list = 'Outpatient',
## ## code.sys = c("procedure_code"), #, "revenue_code"),
## year.list = 2019,
## # select = c(
## # 'INTERNAL_MEMBER_ID',
## # 'RENDERING_PROVIDER_ID',
## # 'submitter_id',
## # 'PROCEDURE_CODE'
## # )
## )
## MC_2019_OutP <- MC_2019_OutP[, .(internal_member_id, submitter_id, procedure_code, rendering_provider_id)]
## MC_2016_OutP <- MC_2016_OutP[, .(internal_member_id, submitter_id, procedure_code, rendering_provider_id)]
## ## modified provider file
## provider <- fread('E:/CT_APCD/shared/intermediate_data/APCD_modified/provider/provider_new.csv',
## header = TRUE,
## colClasses = 'character',
## encoding = 'UTF-8')
## ## modified eligibility file
## elig.patient <- fread("E:/CT_APCD/shared/intermediate_data/APCD_modified/eligibility/eligibility_patient.csv",
## header = TRUE, colClasses = 'character', encoding = 'UTF-8',
## select = c(
## "INTERNAL_MEMBER_ID",
## "birth_dt"
## )
## ) ## need MEDICAL COVERAGE?????
##
## ## identify patients whose ages more than 64
## patient_age0064 <- elig.patient[birth_dt >= 2019 - 64]$INTERNAL_MEMBER_ID
##
## ## Add NPI to raw dataset
## MC_2019_OutP <- provider[MC_2019_OutP, on = c(PROVIDER_ID = 'rendering_provider_id')]
## MC_2016_OutP <- provider[MC_2016_OutP, on = c(PROVIDER_ID = 'rendering_provider_id')]
##
## ## Exclude patients with age 65 more
## MC_2019_OutP <- MC_2019_OutP[internal_member_id %in% patient_age0064]
## MC_2016_OutP <- MC_2016_OutP[internal_member_id %in% patient_age0064]
##
## ## Exclude Medicare claims
## MC_2019_OutP <- MC_2019_OutP[!submitter_id == 15227]
## MC_2016_OutP <- MC_2016_OutP[!submitter_id == 15227]
##
## ## MC to MC_EM & MC_NotEM datasets
## MC_2019_OutP_EM <- MC_2019_OutP[procedure_code %in% CPTList]
## MC_2016_OutP_EM <- MC_2016_OutP[procedure_code %in% CPTList]
##
## MC_2019_npi.no.patient <- MC_2019_OutP_EM[NPI %in% npi.no.patient]
## dim(MC_2019_npi.no.patient)
## # claims that associate with those NPI who get no patient attributed to: 51659 (dt: 2019-04-14)
## length(unique(MC_2019_npi.no.patient$NPI))
## # npi who associate with at least 1 claim in 2019: 364 (dt: 2019-04-14)
## length(unique(MC_2019_npi.no.patient$internal_member_id))
## # patients who associate with those NPI who get no patient attributed to: 29010 (dt: 2019-04-14)
## MC_2016_npi.no.patient <- MC_2016_OutP_EM[NPI %in% npi.no.patient]
## dim(MC_2016_npi.no.patient)
## # claims that associate with those NPI who get no patient attributed to: 42581 (dt: 2019-04-14)
## length(unique(MC_2016_npi.no.patient$NPI))
## # npi who associate with at least 1 claim in 2016: 276 (dt: 2019-04-14)
## length(unique(MC_2016_npi.no.patient$internal_member_id))
## # patients who associate with those NPI who get no patient attributed to: 23625 (dt: 2019-04-14)
##
## ## 16-17 overlap
## length(unique(c(MC_2019_npi.no.patient$NPI, MC_2016_npi.no.patient)))
## # 370 (dt: 2019-04-14)
## length(unique(c(MC_2019_npi.no.patient$internal_member_id, MC_2016_npi.no.patient$internal_member_id)))
## # 41825 (dt: 2019-04-14)
## patient.target <- unique(MC_2019_npi.no.patient$internal_member_id)
## table(Attri2_final[INTERNAL_MEMBER_ID %in% patient.target]$Total)
Attri2_final[, Total := as.numeric(Total)]
Attri2_final_tmp <- Attri2_final[, lapply(.SD, sum),
by = .(internal_member_id),
.SDcol = "Total"]
table(Attri2_final_tmp$Total) # patients with npi to 1,2,3 AN
# 1 2 3
#336193 14911 1065
Attri2valid[, Total := as.numeric(Total)]
Attri2valid_tmp <- Attri2valid[, lapply(.SD, sum),
by = .(internal_member_id),
.SDcol = "Total"]
table(Attri2valid_tmp$Total) # patients (with npi and no tie) to 1,2,3 AN
# 1 2 3
# 335784 14885 1065
Patient_Tie4 <- Patient_Tie3
Patient_Tie4[, Total := rowSums(.SD, na.rm = T),
.SDcols = names(Patient_Tie4)[-1]]
table(Patient_Tie4$Total) # patients (with npi and tie) to 1,2,3 AN
# 1 2
# 409 26