P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2025-07-12 06:21:57 +02:00
Code Releases Activity

support ab selectors for manual AB codes

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2022-10-11 10:49:55 +02:00
parent 955f9d7020
commit 33227a5d90
6 changed files with 84 additions and 21 deletions
Download Patch File Download Diff File Expand all files Collapse all files

46
R/ab_selectors.R
View File

@ -216,7 +216,7 @@ ab_selector <- function(filter,
sort = FALSE, fn = "ab_selector"
)
call <- substitute(filter)
agents <- tryCatch(AMR::antibiotics[which(eval(call, envir = AMR::antibiotics)), "ab", drop = TRUE],
agents <- tryCatch(AB_lookup[which(eval(call, envir = AB_lookup)), "ab", drop = TRUE],
error = function(e) stop_(e$message, call = -5)
)
agents <- ab_in_data[ab_in_data %in% agents]
@ -424,8 +424,8 @@ administrable_per_os <- function(only_rsi_columns = FALSE, ...) {
info = FALSE, only_rsi_columns = only_rsi_columns,
sort = FALSE, fn = "administrable_per_os"
)
agents_all <- AMR::antibiotics[which(!is.na(AMR::antibiotics$oral_ddd)), "ab", drop = TRUE]
agents <- AMR::antibiotics[which(AMR::antibiotics$ab %in% ab_in_data & !is.na(AMR::antibiotics$oral_ddd)), "ab", drop = TRUE]
agents_all <- AB_lookup[which(!is.na(AB_lookup$oral_ddd)), "ab", drop = TRUE]
agents <- AB_lookup[which(AB_lookup$ab %in% ab_in_data & !is.na(AB_lookup$oral_ddd)), "ab", drop = TRUE]
agents <- ab_in_data[ab_in_data %in% agents]
message_agent_names(
function_name = "administrable_per_os",
@ -462,8 +462,8 @@ administrable_iv <- function(only_rsi_columns = FALSE, ...) {
info = FALSE, only_rsi_columns = only_rsi_columns,
sort = FALSE, fn = "administrable_iv"
)
agents_all <- AMR::antibiotics[which(!is.na(AMR::antibiotics$iv_ddd)), "ab", drop = TRUE]
agents <- AMR::antibiotics[which(AMR::antibiotics$ab %in% ab_in_data & !is.na(AMR::antibiotics$iv_ddd)), "ab", drop = TRUE]
agents_all <- AB_lookup[which(!is.na(AB_lookup$iv_ddd)), "ab", drop = TRUE]
agents <- AB_lookup[which(AB_lookup$ab %in% ab_in_data & !is.na(AB_lookup$iv_ddd)), "ab", drop = TRUE]
agents <- ab_in_data[ab_in_data %in% agents]
message_agent_names(
function_name = "administrable_iv",
@ -541,9 +541,10 @@ ab_select_exec <- function(function_name,
info = FALSE, only_rsi_columns = only_rsi_columns,
sort = FALSE, fn = function_name
)
# untreatable drugs
if (only_treatable == TRUE) {
untreatable <- AMR::antibiotics[which(AMR::antibiotics$name %like% "-high|EDTA|polysorbate|macromethod|screening|/nacubactam"), "ab", drop = TRUE]
untreatable <- AB_lookup[which(AB_lookup$name %like% "-high|EDTA|polysorbate|macromethod|screening|/nacubactam"), "ab", drop = TRUE]
if (any(untreatable %in% names(ab_in_data))) {
if (message_not_thrown_before(function_name, "ab_class", "untreatable", entire_session = TRUE)) {
warning_(
@ -570,13 +571,26 @@ ab_select_exec <- function(function_name,
if (is.null(ab_class_args) || isTRUE(function_name %in% c("antifungals", "antimycobacterials"))) {
ab_group <- NULL
if (isTRUE(function_name == "antifungals")) {
abx <- antibiotics$ab[which(antibiotics$group == "Antifungals")]
abx <- AB_lookup$ab[which(AB_lookup$group == "Antifungals")]
} else if (isTRUE(function_name == "antimycobacterials")) {
abx <- antibiotics$ab[which(antibiotics$group == "Antimycobacterials")]
abx <- AB_lookup$ab[which(AB_lookup$group == "Antimycobacterials")]
} else {
# their upper case equivalent are vectors with class <ab>, created in data-raw/_pre_commit_hook.R
# carbapenems() gets its codes from AMR:::AB_CARBAPENEMS
abx <- get(paste0("AB_", toupper(function_name)), envir = asNamespace("AMR"))
# manually added codes from add_custom_antimicrobials() must also be supported
if (length(AMR_env$custom_ab_codes) > 0) {
custom_ab <- AB_lookup[which(AB_lookup$ab %in% AMR_env$custom_ab_codes), ]
check_string <- paste0(custom_ab$group, custom_ab$atc_group1, custom_ab$atc_group2)
if (function_name == "betalactams") {
find_group <- "beta-lactams"
} else if (function_name %like% "cephalosporins_") {
find_group <- gsub("_(.*)$", paste0(" (\\1 gen.)"), function_name)
} else {
find_group <- function_name
}
abx <- c(abx, custom_ab$ab[which(check_string %like% find_group)])
}
ab_group <- function_name
}
examples <- paste0(" (such as ", vector_or(ab_name(sample(abx, size = min(2, length(abx)), replace = FALSE),
@ -793,16 +807,16 @@ find_ab_names <- function(ab_group, n = 3) {
ab_group <- gsub("[^a-zA-Z|0-9]", ".*", ab_group)
# try popular first, they have DDDs
drugs <- AMR::antibiotics[which((!is.na(AMR::antibiotics$iv_ddd) | !is.na(AMR::antibiotics$oral_ddd)) &
AMR::antibiotics$name %unlike% " " &
AMR::antibiotics$group %like% ab_group &
AMR::antibiotics$ab %unlike% "[0-9]$"), ]$name
drugs <- AB_lookup[which((!is.na(AB_lookup$iv_ddd) | !is.na(AB_lookup$oral_ddd)) &
AB_lookup$name %unlike% " " &
AB_lookup$group %like% ab_group &
AB_lookup$ab %unlike% "[0-9]$"), ]$name
if (length(drugs) < n) {
# now try it all
drugs <- antibiotics[which((AMR::antibiotics$group %like% ab_group |
AMR::antibiotics$atc_group1 %like% ab_group |
AMR::antibiotics$atc_group2 %like% ab_group) &
AMR::antibiotics$ab %unlike% "[0-9]$"), ]$name
drugs <- AB_lookup[which((AB_lookup$group %like% ab_group |
AB_lookup$atc_group1 %like% ab_group |
AB_lookup$atc_group2 %like% ab_group) &
AB_lookup$ab %unlike% "[0-9]$"), ]$name
}
if (length(drugs) == 0) {
return("??")