P281424/AMR
1
0
Fork 0
mirror of https://github.com/msberends/AMR.git synced 2025-07-09 08:52:15 +02:00
Code Releases Activity

mdro and 1st isolate improvements

Browse Source
This commit is contained in:
dr. M.S. (Matthijs) Berends
2018-10-23 11:15:05 +02:00
parent 299c5bea43
commit 7997de6a6d
8 changed files with 138 additions and 95 deletions
Download Patch File Download Diff File Expand all files Collapse all files

78
R/mdro.R
View File

@ -29,6 +29,8 @@
#' @details When \code{country} will be left blank, guidelines will be taken from EUCAST Expert Rules Version 3.1 "Intrinsic Resistance and Exceptional Phenotypes Tables" (\url{http://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/Expert_rules_intrinsic_exceptional_V3.1.pdf}).
#' @return Ordered factor with levels \code{Unknown < Negative < Unconfirmed < Positive}.
#' @rdname MDRO
#' @importFrom dplyr %>%
#' @importFrom crayon red blue
#' @export
#' @examples
#' library(dplyr)
@ -38,7 +40,7 @@
#' BRMO = BRMO(.))
MDRO <- function(tbl,
country = NULL,
col_mo = 'mo',
col_mo = NULL,
info = TRUE,
amcl = 'amcl',
amik = 'amik',
@ -99,13 +101,21 @@ MDRO <- function(tbl,
trim = 'trim',
trsu = 'trsu',
vanc = 'vanc',
col_bactid = 'bactid') {
col_bactid = NULL) {
if (col_bactid %in% colnames(tbl)) {
if (!is.data.frame(tbl)) {
stop("`tbl` must be a data frame.", call. = FALSE)
}
# try to find columns based on type
# -- mo
if (!is.null(col_bactid)) {
col_mo <- col_bactid
warning("Use of `col_bactid` is deprecated. Use `col_mo` instead.")
}
if (!col_mo %in% colnames(tbl)) {
} else if (is.null(col_mo) & "mo" %in% lapply(tbl, class)) {
col_mo <- colnames(tbl)[lapply(tbl, class) == "mo"]
message("NOTE: Using column `", col_mo, "` as input for `col_mo`.")
} else if (!col_mo %in% colnames(tbl)) {
stop('Column ', col_mo, ' not found.', call. = FALSE)
}
@ -142,23 +152,17 @@ MDRO <- function(tbl,
guideline$version <- 'Revision of December 2017'
guideline$source <- 'https://www.rivm.nl/Documenten_en_publicaties/Professioneel_Praktisch/Richtlijnen/Infectieziekten/WIP_Richtlijnen/WIP_Richtlijnen/Ziekenhuizen/WIP_richtlijn_BRMO_Bijzonder_Resistente_Micro_Organismen_ZKH'
# add here more countries like this:
# } else if (country$code == 'AA') {
# } else if (country$code == 'xx') {
# country$name <- 'country name'
} else {
stop('This country code is currently unsupported: ', guideline$country$code, call. = FALSE)
}
# Console colours
# source: http://www.tldp.org/HOWTO/Bash-Prompt-HOWTO/x329.html
ANSI_red <- "\033[31m"
ANSI_blue <- "\033[34m"
ANSI_reset <- "\033[0m"
if (info == TRUE) {
cat("Determining multidrug-resistant organisms (MDRO), according to:\n",
"Guideline: ", ANSI_red, guideline$name, ", ", guideline$version, ANSI_reset, "\n",
"Country : ", ANSI_red, guideline$country$name, ANSI_reset, "\n",
"Source : ", ANSI_blue, guideline$source, ANSI_reset, "\n",
"Guideline: ", red(paste0(guideline$name, ", ", guideline$version, "\n")),
"Country : ", red(paste0(guideline$country$name, "\n")),
"Source : ", blue(paste0(guideline$source, "\n")),
"\n", sep = "")
}
@ -231,18 +235,11 @@ MDRO <- function(tbl,
vanc <- col.list[vanc]
# antibiotic classes
aminoglycosides <- c(tobr, gent, kana, neom, neti, siso)
tetracyclines <- c(doxy, mino, tetr) # since EUCAST v3.1 tige(cycline) is set apart
polymyxins <- c(poly, coli)
macrolides <- c(eryt, azit, roxi, clar) # since EUCAST v3.1 clin(damycin) is set apart
glycopeptides <- c(vanc, teic)
streptogramins <- qida # should officially also be pristinamycin and quinupristin/dalfopristin
aminoglycosides <- c(tobr, gent) # can also be kana but that one is often intrinsic R
cephalosporins <- c(cfep, cfot, cfox, cfra, cfta, cftr, cfur, czol)
cephalosporins_3rd <- c(cfot, cftr, cfta)
carbapenems <- c(erta, imip, mero)
aminopenicillins <- c(ampi, amox)
ureidopenicillins <- pita # should officially also be azlo and mezlo
fluoroquinolones <- c(oflo, cipr, norf, levo, moxi)
fluoroquinolones <- c(oflo, cipr, levo, moxi)
# helper function for editing the table
trans_tbl <- function(to, rows, cols) {
@ -254,10 +251,15 @@ MDRO <- function(tbl,
}
}
# join microorganisms
tbl <- tbl %>% left_join_microorganisms(col_mo)
if (!tbl %>% pull(col_mo) %>% is.mo()) {
tbl[, col_mo] <- as.mo(tbl[, col_mo])
}
tbl$MDRO <- NA_integer_
tbl <- tbl %>%
# join to microorganisms data set
left_join_microorganisms(by = col_mo) %>%
# add unconfirmed to where genus is available
mutate(MDRO = ifelse(!is.na(genus), 1, NA_integer_))
if (guideline$country$code == 'eucast') {
# EUCAST ------------------------------------------------------------------
@ -327,6 +329,11 @@ MDRO <- function(tbl,
& rowSums(tbl[, aminoglycosides] == 'R', na.rm = TRUE) >= 1
& rowSums(tbl[, fluoroquinolones] == 'R', na.rm = TRUE) >= 1
), 'MDRO'] <- 4
a <<- tbl[which(
tbl$family == 'Enterobacteriaceae'
& rowSums(tbl[, aminoglycosides] == 'R', na.rm = TRUE) >= 1
& rowSums(tbl[, fluoroquinolones] == 'R', na.rm = TRUE) >= 1
), ]
tbl[which(
tbl$family == 'Enterobacteriaceae'
& rowSums(tbl[, carbapenems] == 'R', na.rm = TRUE) >= 1
@ -363,13 +370,18 @@ MDRO <- function(tbl,
& tbl$MDRO == 1
), 'MDRO'] <- 2
tbl <- tbl %>% mutate(
psae = 0,
psae = ifelse(mero == "R" | imip == "R", psae + 1, psae),
psae = ifelse(gent == "R" & tobr == "R", psae + 1, psae),
psae = ifelse(cipr == "R", psae + 1, psae),
psae = ifelse(cfta == "R", psae + 1, psae),
psae = ifelse(pita == "R", psae + 1, psae),
psae = ifelse(is.na(psae), 0, psae)
)
tbl[which(
tbl$fullname %like% 'Pseudomonas aeruginosa'
& sum(rowSums(tbl[, carbapenems] == 'R', na.rm = TRUE) >= 1,
rowSums(tbl[, aminoglycosides] == 'R', na.rm = TRUE) >= 1,
rowSums(tbl[, fluoroquinolones] == 'R', na.rm = TRUE) >= 1,
tbl[, cfta] == 'R',
tbl[, pita] == 'R') >= 3
& tbl$psae >= 3
), 'MDRO'] <- 4
# rest of Pseudomonas is negative
tbl[which(
@ -405,7 +417,7 @@ MDRO <- function(tbl,
factor(x = tbl$MDRO,
levels = c(1:4),
labels = c('Unknown', 'Negative', 'Unconfirmed', 'Positive'),
labels = c('Not evaluated', 'Negative', 'Unconfirmed', 'Positive'),
ordered = TRUE)
}