AMR/R/mdro.R

945 lines
39 KiB
R
Executable File

# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Analysis #
# #
# SOURCE #
# https://gitlab.com/msberends/AMR #
# #
# LICENCE #
# (c) 2019 Berends MS (m.s.berends@umcg.nl), Luz CF (c.f.luz@umcg.nl) #
# #
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
# the Free Software Foundation. #
# #
# This R package was created for academic research and was publicly #
# released in the hope that it will be useful, but it comes WITHOUT #
# ANY WARRANTY OR LIABILITY. #
# Visit our website for more info: https://msberends.gitlab.io/AMR. #
# ==================================================================== #
#' Determine multidrug-resistant organisms (MDRO)
#'
#' Determine which isolates are multidrug-resistant organisms (MDRO) according to (country-specific) guidelines.
#' @param x table with antibiotic columns, like e.g. \code{AMX} and \code{AMC}
#' @param guideline a specific guideline to follow. When left empty, the publication by Magiorakos \emph{et al.} (2012, Clinical Microbiology and Infection) will be followed, see Details.
#' @param info print progress
#' @inheritParams eucast_rules
#' @param verbose print additional info: missing antibiotic columns per parameter
#' @inheritSection eucast_rules Antibiotics
#' @details Currently supported guidelines are (case-insensitive):
#' \itemize{
#' \item{\code{guideline = "CMI2012"}: Magiorakos AP, Srinivasan A \emph{et al.} "Multidrug-resistant, extensively drug-resistant and pandrug-resistant bacteria: an international expert proposal for interim standard definitions for acquired resistance." Clinical Microbiology and Infection (2012) (\href{https://www.clinicalmicrobiologyandinfection.com/article/S1198-743X(14)61632-3/fulltext}{link})}
#' \item{\code{guideline = "EUCAST"}: The European international guideline - EUCAST Expert Rules Version 3.1 "Intrinsic Resistance and Exceptional Phenotypes Tables" (\href{http://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/Expert_rules_intrinsic_exceptional_V3.1.pdf}{link})}
#' \item{\code{guideline = "TB"}: The international guideline for multi-drug resistant tuberculosis - World Health Organization "Companion handbook to the WHO guidelines for the programmatic management of drug-resistant tuberculosis" (\href{https://www.who.int/tb/publications/pmdt_companionhandbook/en/}{link})}
#' \item{\code{guideline = "MRGN"}: The German national guideline - Mueller et al. (2015) Antimicrobial Resistance and Infection Control 4:7. DOI: 10.1186/s13756-015-0047-6}
#' \item{\code{guideline = "BRMO"}: The Dutch national guideline - Rijksinstituut voor Volksgezondheid en Milieu "WIP-richtlijn BRMO (Bijzonder Resistente Micro-Organismen) [ZKH]" (\href{https://www.rivm.nl/Documenten_en_publicaties/Professioneel_Praktisch/Richtlijnen/Infectieziekten/WIP_Richtlijnen/WIP_Richtlijnen/Ziekenhuizen/WIP_richtlijn_BRMO_Bijzonder_Resistente_Micro_Organismen_ZKH}{link})}
#' }
#'
#' Please suggest your own (country-specific) guidelines by letting us know: \url{https://gitlab.com/msberends/AMR/issues/new}.
#' @return \itemize{
#' \item{CMI 2012 paper - function \code{mdr_cmi2012()} or \code{mdro()}:\cr Ordered factor with levels \code{Negative < Multi-drug-resistant (MDR) < Extensively drug-resistant (XDR) < Pandrug-resistant (PDR)}}
#' \item{TB guideline - function \code{mdr_tb()} or \code{mdro(..., guideline = "TB")}:\cr Ordered factor with levels \code{Negative < Mono-resistant < Poly-resistant < Multi-drug-resistant < Extensively drug-resistant}}
#' \item{German guideline - function \code{mrgn()} or \code{mdro(..., guideline = "MRGN")}:\cr Ordered factor with levels \code{Negative < 3MRGN < 4MRGN}}
#' \item{Everything else:\cr Ordered factor with levels \code{Negative < Positive, unconfirmed < Positive}. The value \code{"Positive, unconfirmed"} means that, according to the guideline, it is not entirely sure if the isolate is multi-drug resistant and this should be confirmed with additional (e.g. molecular) tests}
#' }
#' @rdname mdro
#' @importFrom dplyr %>% filter_all
#' @importFrom crayon blue bold italic
#' @export
#' @inheritSection AMR Read more on our website!
#' @source
#' Please see Details for the list of publications used for this function.
#' @examples
#' library(dplyr)
#'
#' example_isolates %>%
#' mdro() %>%
#' freq()
#'
#' \donttest{
#' example_isolates %>%
#' mutate(EUCAST = mdro(.),
#' BRMO = brmo(.),
#' MRGN = mrgn(.))
#'
#' example_isolates %>%
#' rename(PIP = TZP) %>% # no piperacillin, so take piperacillin/tazobactam
#' mrgn() %>% # check German guideline
#' freq() # check frequencies
#' }
mdro <- function(x,
guideline = NULL,
col_mo = NULL,
info = TRUE,
verbose = FALSE,
...) {
if (!is.data.frame(x)) {
stop("`x` must be a data frame.", call. = FALSE)
}
if (!is.null(list(...)$country)) {
warning("Using `country` is deprecated, use `guideline` instead. Please see ?mdro.", call. = FALSE)
guideline <- list(...)$country
}
if (length(guideline) > 1) {
stop("`guideline` must be a length one character string.", call. = FALSE)
}
if (is.null(guideline)) {
# default to the paper by Magiorakos et al. (2012)
guideline <- "cmi2012"
}
if (tolower(guideline) == "nl") {
guideline <- "BRMO"
}
if (tolower(guideline) == "de") {
guideline <- "MRGN"
}
if (!tolower(guideline) %in% c("brmo", "mrgn", "eucast", "tb", "cmi2012")) {
stop("invalid guideline: ", guideline, call. = FALSE)
}
guideline <- list(code = tolower(guideline))
# try to find columns based on type
# -- mo
if (is.null(col_mo)) {
col_mo <- search_type_in_df(x = x, type = "mo")
}
if (is.null(col_mo) & guideline$code == "tb") {
message(blue("NOTE: No column found as input for `col_mo`,",
bold("assuming all records contain", italic("Mycobacterium tuberculosis.\n"))))
x$mo <- AMR::as.mo("Mycobacterium tuberculosis")
col_mo <- "mo"
}
if (is.null(col_mo)) {
stop("`col_mo` must be set.", call. = FALSE)
}
if (guideline$code == "cmi2012") {
guideline$name <- "Multidrug-resistant, extensively drug-resistant and pandrug-resistant bacteria: an international expert proposal for interim standard definitions for acquired resistance."
guideline$author <- "Magiorakos AP, Srinivasan A, Carey RB, ..., Vatopoulos A, Weber JT, Monnet DL"
guideline$version <- "N/A"
guideline$source <- "Magiorakos et al. (2012) Clinical Microbiology and Infection 18:3. DOI: 10.1111/j.1469-0691.2011.03570.x"
} else if (guideline$code == "eucast") {
guideline$name <- "EUCAST Expert Rules, \"Intrinsic Resistance and Exceptional Phenotypes Tables\""
guideline$author <- "EUCAST (European Committee on Antimicrobial Susceptibility Testing)"
guideline$version <- "3.1"
guideline$source <- "http://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/Expert_rules_intrinsic_exceptional_V3.1.pdf"
} else if (guideline$code == "tb") {
guideline$name <- "Companion handbook to the WHO guidelines for the programmatic management of drug-resistant tuberculosis"
guideline$author <- "WHO (World Health Organization)"
guideline$version <- "WHO/HTM/TB/2014.11"
guideline$source <- "https://www.who.int/tb/publications/pmdt_companionhandbook/en/"
# support per country:
} else if (guideline$code == "mrgn") {
guideline$name <- "Cross-border comparison of the Dutch and German guidelines on multidrug-resistant Gram-negative microorganisms"
guideline$author <- "M\u00fcller J, Voss A, K\u00f6ck R, ..., Kern WV, Wendt C, Friedrich AW"
guideline$version <- "N/A"
guideline$source <- "M\u00fcller et al. (2015) Antimicrobial Resistance and Infection Control 4:7. DOI: 10.1186/s13756-015-0047-6"
} else if (guideline$code == "brmo") {
guideline$name <- "WIP-Richtlijn Bijzonder Resistente Micro-organismen (BRMO)"
guideline$author <- "RIVM (Rijksinstituut voor de Volksgezondheid)"
guideline$version <- "Revision as 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"
} else {
stop("This guideline is currently unsupported: ", guideline$code, call. = FALSE)
}
if (guideline$code == "cmi2012") {
cols_ab <- get_column_abx(x = x,
soft_dependencies = c(
# table 1 (S aureus):
"GEN",
"RIF",
"CPT",
"OXA",
"CIP",
"MFX",
"SXT",
"FUS",
"VAN",
"TEC",
"TLV",
"TGC",
"CLI",
"DAP",
"ERY",
"LNZ",
"CHL",
"FOS",
"QDA",
"TCY",
"DOX",
"MNO",
# table 2 (Enterococcus)
"GEH",
"STH",
"IPM",
"MEM",
"DOR",
"CIP",
"LVX",
"MFX",
"VAN",
"TEC",
"TGC",
"DAP",
"LNZ",
"AMP",
"QDA",
"DOX",
"MNO",
# table 3 (Enterobacteriaceae)
"GEN",
"TOB",
"AMK",
"NET",
"CPT",
"TCC",
"TZP",
"ETP",
"IPM",
"MEM",
"DOR",
"CZO",
"CXM",
"CTX",
"CAZ",
"FEP",
"FOX",
"CTT",
"CIP",
"SXT",
"TGC",
"ATM",
"AMP",
"AMC",
"SAM",
"CHL",
"FOS",
"COL",
"TCY",
"DOX",
"MNO",
# table 4 (Pseudomonas)
"GEN",
"TOB",
"AMK",
"NET",
"IPM",
"MEM",
"DOR",
"CAZ",
"FEP",
"CIP",
"LVX",
"TCC",
"TZP",
"ATM",
"FOS",
"COL",
"PLB",
# table 5 (Acinetobacter)
"GEN",
"TOB",
"AMK",
"NET",
"IPM",
"MEM",
"DOR",
"CIP",
"LVX",
"TZP",
"TCC",
"CTX",
"CRO",
"CAZ",
"FEP",
"SXT",
"SAM",
"COL",
"PLB",
"TCY",
"DOX",
"MNO"
),
verbose = verbose, ...)
} else if (guideline$code == "tb") {
cols_ab <- get_column_abx(x = x,
soft_dependencies = c("CAP",
"ETH",
"GAT",
"INH",
"PZA",
"RIF",
"RIB",
"RFP"),
verbose = verbose, ...)
} else if (guideline$code == "mrgn") {
cols_ab <- get_column_abx(x = x,
soft_dependencies = c("PIP",
"CTX",
"CAZ",
"IPM",
"MEM",
"CIP"),
verbose = verbose, ...)
} else {
cols_ab <- get_column_abx(x = x, verbose = verbose, ...)
}
AMC <- cols_ab["AMC"]
AMK <- cols_ab["AMK"]
AMP <- cols_ab["AMP"]
AMX <- cols_ab["AMX"]
ATM <- cols_ab["ATM"]
AZL <- cols_ab["AZL"]
AZM <- cols_ab["AZM"]
CAZ <- cols_ab["CAZ"]
CED <- cols_ab["CED"]
CHL <- cols_ab["CHL"]
CIP <- cols_ab["CIP"]
CLI <- cols_ab["CLI"]
CLR <- cols_ab["CLR"]
COL <- cols_ab["COL"]
CPT <- cols_ab["CPT"]
CRO <- cols_ab["CRO"]
CTT <- cols_ab["CTT"]
CTX <- cols_ab["CTX"]
CXM <- cols_ab["CXM"]
CZO <- cols_ab["CZO"]
DAP <- cols_ab["DAP"]
DOR <- cols_ab["DOR"]
DOX <- cols_ab["DOX"]
ERY <- cols_ab["ERY"]
ETP <- cols_ab["ETP"]
FEP <- cols_ab["FEP"]
FLC <- cols_ab["FLC"]
FOS <- cols_ab["FOS"]
FOX <- cols_ab["FOX"]
FUS <- cols_ab["FUS"]
GEH <- cols_ab["GEH"]
GEN <- cols_ab["GEN"]
IPM <- cols_ab["IPM"]
KAN <- cols_ab["KAN"]
LIN <- cols_ab["LIN"]
LNZ <- cols_ab["LNZ"]
LVX <- cols_ab["LVX"]
MEM <- cols_ab["MEM"]
MEZ <- cols_ab["MEZ"]
MTR <- cols_ab["MTR"]
MFX <- cols_ab["MFX"]
MNO <- cols_ab["MNO"]
NAL <- cols_ab["NAL"]
NEO <- cols_ab["NEO"]
NET <- cols_ab["NET"]
NIT <- cols_ab["NIT"]
NOR <- cols_ab["NOR"]
NOV <- cols_ab["NOV"]
OFX <- cols_ab["OFX"]
OXA <- cols_ab["OXA"]
PEN <- cols_ab["PEN"]
PIP <- cols_ab["PIP"]
PLB <- cols_ab["PLB"]
PRI <- cols_ab["PRI"]
QDA <- cols_ab["QDA"]
RID <- cols_ab["RID"]
RIF <- cols_ab["RIF"]
RXT <- cols_ab["RXT"]
SAM <- cols_ab["SAM"]
SIS <- cols_ab["SIS"]
STH <- cols_ab["STH"]
SXT <- cols_ab["SXT"]
TCC <- cols_ab["TCC"]
TCY <- cols_ab["TCY"]
TEC <- cols_ab["TEC"]
TGC <- cols_ab["TGC"]
TIC <- cols_ab["TIC"]
TLV <- cols_ab["TLV"]
TMP <- cols_ab["TMP"]
TOB <- cols_ab["TOB"]
TZP <- cols_ab["TZP"]
VAN <- cols_ab["VAN"]
# additional for TB
CAP <- cols_ab["CAP"]
ETH <- cols_ab["ETH"]
GAT <- cols_ab["GAT"]
INH <- cols_ab["INH"]
PZA <- cols_ab["PZA"]
RIF <- cols_ab["RIF"]
RIB <- cols_ab["RIB"]
RFP <- cols_ab["RFP"]
abx_tb <- c(CAP, ETH, GAT, INH, PZA, RIF, RIB, RFP)
abx_tb <- abx_tb[!is.na(abx_tb)]
if (guideline$code == "tb" & length(abx_tb) == 0) {
stop("No antimycobacterials found in data set.", call. = FALSE)
}
if (info == TRUE) {
cat("\nDetermining multidrug-resistant organisms (MDRO), according to:\n",
bold("Guideline: "), italic(guideline$name), "\n",
bold("Version: "), guideline$version, "\n",
bold("Author: "), guideline$author, "\n",
bold("Source: "), guideline$source, "\n",
"\n", sep = "")
}
ab_missing <- function(ab) {
isTRUE(ab %in% c(NULL, NA)) | length(ab) == 0
}
ab_NA <- function(x) {
x[!is.na(x)]
}
# antibiotic classes
aminoglycosides <- c(TOB, GEN)
cephalosporins <- c(FEP, CTX, FOX, CED, CAZ, CRO, CXM, CZO)
cephalosporins_3rd <- c(CTX, CRO, CAZ)
carbapenems <- c(ETP, IPM, MEM)
fluoroquinolones <- c(OFX, CIP, LVX, MFX)
# helper function for editing the table
trans_tbl <- function(to, rows, cols, any_all) {
cols <- cols[!ab_missing(cols)]
cols <- cols[!is.na(cols)]
if (length(rows) > 0 & length(cols) > 0) {
if (any_all == "any") {
row_filter <- which(x[, cols] == "R")
} else if (any_all == "all") {
row_filter <- x %>%
mutate(index = seq_len(nrow(.))) %>%
filter_at(vars(cols), all_vars(. == "R")) %>%
pull((index))
}
rows <- rows[rows %in% row_filter]
x[rows, "MDRO"] <<- to
}
}
trans_tbl2 <- function(txt, rows, lst) {
# function specific for the CMI paper of 2012 (Magiorakos et al.)
lst_vector <- unlist(lst)[!is.na(unlist(lst))]
x$total_groups <- NA_integer_
x$affected_groups <- NA_integer_
x[rows, "total_groups"] <- length(lst)
# now the hard part - using two sapply()s for super fast results:
# [1] run through all `rows` with sapply()
# [2] within each row, run through all antibiotic groups with another sapply()
# [3] determine for each antibiotic group in that row if at least 1 drug is R of I
# [4] sum the number of TRUEs of this determination
x[rows, "affected_groups"] <- sapply(rows,
function(row, group_tbl = lst) {
sum(sapply(group_tbl,
function(group) {
any(x[row, group[!is.na(group)]] == "R") |
any(x[row, group[!is.na(group)]] == "I")
}),
na.rm = TRUE)
})
# now set MDROs:
# MDR (=2): >=3 groups affected
x[which(x$row_number %in% rows & x$affected_groups >= 3), "MDRO"] <<- 2
# XDR (=3): all but <=2 groups affected
x[which(x$row_number %in% rows & x$total_groups - x$affected_groups <= 2), "MDRO"] <<- 3
# PDR (=4): all agents are R
x[filter_at(x[rows, ],
vars(lst_vector),
all_vars(. %in% c("R", "I")))$row_number,
"MDRO"] <<- 4
}
x <- x %>%
mutate_at(vars(col_mo), as.mo) %>%
# 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_),
row_number = seq_len(nrow(x))) %>%
# transform to data.frame so subsetting is possible with x[y, z] (might not be the case with tibble/data.table/...)
as.data.frame(stringsAsFactors = FALSE)
if (guideline$code == "cmi2012") {
# CMI, 2012 ---------------------------------------------------------------
# Non-susceptible = R and I
# (see header 'Approaches to Creating Definitions for MDR, XDR and PDR' in paper)
# take amoxicillin if ampicillin is unavailable
if (is.na(AMP) & !is.na(AMX)) AMP <- AMX
# take ceftriaxone if cefotaxime is unavailable and vice versa
if (is.na(CRO) & !is.na(CTX)) CRO <- CTX
if (is.na(CTX) & !is.na(CRO)) CTX <- CRO
# intrinsic resistant must not be considered for the determination of MDR,
# so let's just remove them, meticulously following the paper
x[which(x$genus == "Enterococcus" & x$species == "faecium"), ab_NA(IPM)] <- NA
x[which(x$genus == "Enterococcus" & x$species == "faecalis"), ab_NA(QDA)] <- NA
x[which((x$genus == "Providencia" & x$species == "rettgeri")
| (x$genus == "Providencia" & x$species == "stuartii")), ab_NA(c(GEN, TOB, NET))] <- NA
x[which(x$genus == "Escherichia" & x$species == "hermannii"), ab_NA(c(TCC, TZP))] <- NA
x[which((x$genus == "Citrobacter" & x$species == "freundii")
| (x$genus == "Enterobacter" & x$species == "aerogenes")
| (x$genus == "Enterobacter" & x$species == "cloacae")
| (x$genus == "Hafnia" & x$species == "alvei")
| (x$genus == "Morganella" & x$species == "morganii")
| (x$genus == "Proteus" & x$species == "penneri")
| (x$genus == "Proteus" & x$species == "vulgaris")
| (x$genus == "Serratia" & x$species == "marcescens")), ab_NA(CZO)] <- NA
x[which((x$genus == "Morganella" & x$species == "morganii")
| (x$genus == "Proteus" & x$species == "penneri")
| (x$genus == "Proteus" & x$species == "vulgaris")
| (x$genus == "Serratia" & x$species == "marcescens")), ab_NA(CXM)] <- NA
x[which((x$genus == "Morganella" & x$species == "morganii")
| (x$genus == "Proteus" & x$species == "mirabilis")
| (x$genus == "Proteus" & x$species == "penneri")
| (x$genus == "Proteus" & x$species == "vulgaris")
| (x$genus == "Providencia" & x$species == "rettgeri")
| (x$genus == "Providencia" & x$species == "stuartii")), ab_NA(TGC)] <- NA
x[which((x$genus == "Citrobacter" & x$species == "koseri")
| (x$genus == "Citrobacter" & x$species == "freundii")
| (x$genus == "Enterobacter" & x$species == "aerogenes")
| (x$genus == "Enterobacter" & x$species == "cloacae")
| (x$genus == "Escherichia" & x$species == "hermannii")
| (x$genus == "Hafnia" & x$species == "alvei")
| (x$genus == "Klebsiella")
| (x$genus == "Morganella" & x$species == "morganii")
| (x$genus == "Proteus" & x$species == "penneri")
| (x$genus == "Proteus" & x$species == "vulgaris")
| (x$genus == "Providencia" & x$species == "rettgeri")
| (x$genus == "Providencia" & x$species == "stuartii")
| (x$genus == "Serratia" & x$species == "marcescens")), ab_NA(AMP)] <- NA
x[which((x$genus == "Citrobacter" & x$species == "freundii")
| (x$genus == "Enterobacter" & x$species == "aerogenes")
| (x$genus == "Enterobacter" & x$species == "cloacae")
| (x$genus == "Hafnia" & x$species == "alvei")
| (x$genus == "Morganella" & x$species == "morganii")
| (x$genus == "Providencia" & x$species == "rettgeri")
| (x$genus == "Providencia" & x$species == "stuartii")
| (x$genus == "Serratia" & x$species == "marcescens")), ab_NA(AMC)] <- NA
x[which((x$genus == "Citrobacter" & x$species == "freundii")
| (x$genus == "Citrobacter" & x$species == "koseri")
| (x$genus == "Enterobacter" & x$species == "aerogenes")
| (x$genus == "Enterobacter" & x$species == "cloacae")
| (x$genus == "Hafnia" & x$species == "alvei")
| (x$genus == "Providencia" & x$species == "rettgeri")
| (x$genus == "Serratia" & x$species == "marcescens")), ab_NA(SAM)] <- NA
x[which((x$genus == "Morganella" & x$species == "morganii")
| (x$genus == "Proteus" & x$species == "mirabilis")
| (x$genus == "Proteus" & x$species == "penneri")
| (x$genus == "Proteus" & x$species == "vulgaris")
| (x$genus == "Providencia" & x$species == "rettgeri")
| (x$genus == "Providencia" & x$species == "stuartii")
| (x$genus == "Serratia" & x$species == "marcescens")), ab_NA(COL)] <- NA
x[which((x$genus == "Morganella" & x$species == "morganii")
| (x$genus == "Proteus" & x$species == "mirabilis")
| (x$genus == "Proteus" & x$species == "penneri")
| (x$genus == "Proteus" & x$species == "vulgaris")
| (x$genus == "Providencia" & x$species == "rettgeri")
| (x$genus == "Providencia" & x$species == "stuartii")), ab_NA(TCY)] <- NA
x[which((x$genus == "Morganella" & x$species == "morganii")
| (x$genus == "Proteus" & x$species == "penneri")
| (x$genus == "Proteus" & x$species == "vulgaris")
| (x$genus == "Providencia" & x$species == "rettgeri")
| (x$genus == "Providencia" & x$species == "stuartii")), ab_NA(c(DOX, MNO))] <- NA
# now add the MDR levels to the data
trans_tbl(2,
which(x$genus == "Staphylococcus" & x$species == "aureus"),
c(OXA, FOX),
"any")
trans_tbl2(paste("Table 1 -", italic("S. aureus")),
which(x$genus == "Staphylococcus" & x$species == "aureus"),
list(GEN,
RIF,
CPT,
c(OXA, FOX),
c(CIP, MFX),
SXT,
FUS,
c(VAN, TEC, TLV),
TGC,
CLI,
DAP,
ERY,
LNZ,
CHL,
FOS,
QDA,
c(TCY, DOX, MNO)))
trans_tbl2(paste("Table 2 -", italic("Enterococcus"), "spp"),
which(x$genus == "Enterococcus"),
list(GEH,
STH,
c(IPM, MEM, DOR),
c(CIP, LVX, MFX),
c(VAN, TEC),
TGC,
DAP,
LNZ,
AMP,
QDA,
c(DOX, MNO)))
trans_tbl2(paste("Table 3 -", italic("Enterobacteriaceae")),
which(x$family == "Enterobacteriaceae"),
list(c(GEN, TOB, AMK, NET),
CPT,
c(TCC, TZP),
c(ETP, IPM, MEM, DOR),
CZO,
CXM,
c(CTX, CAZ, FEP),
c(FOX, CTT),
CIP,
SXT,
TGC,
ATM,
AMP,
c(AMC, SAM),
CHL,
FOS,
COL,
c(TCY, DOX, MNO)))
trans_tbl2(paste("Table 4 -", italic("Pseudomonas aeruginosa")),
which(x$genus == "Pseudomonas" & x$species == "aeruginosa"),
list(c(GEN, TOB, AMK, NET),
c(IPM, MEM, DOR),
c(CAZ, FEP),
c(CIP, LVX),
c(TCC, TZP),
ATM,
FOS,
c(COL, PLB)))
trans_tbl2(paste("Table 5 -", italic("Acinetobacter"), "spp"),
which(x$genus == "Acinetobacter"),
list(c(GEN, TOB, AMK, NET),
c(IPM, MEM, DOR),
c(CIP, LVX),
c(TZP, TCC),
c(CTX, CRO, CAZ, FEP),
SXT,
SAM,
c(COL, PLB),
c(TCY, DOX, MNO)))
}
if (guideline$code == "eucast") {
# EUCAST ------------------------------------------------------------------
# Table 5
trans_tbl(3,
which(x$family == "Enterobacteriaceae"
| x$fullname %like% "^Pseudomonas aeruginosa"
| x$genus == "Acinetobacter"),
COL,
"all")
trans_tbl(3,
which(x$fullname %like% "^Salmonella Typhi"),
c(carbapenems, fluoroquinolones),
"any")
trans_tbl(3,
which(x$fullname %like% "^Haemophilus influenzae"),
c(cephalosporins_3rd, carbapenems, fluoroquinolones),
"any")
trans_tbl(3,
which(x$fullname %like% "^Moraxella catarrhalis"),
c(cephalosporins_3rd, fluoroquinolones),
"any")
trans_tbl(3,
which(x$fullname %like% "^Neisseria meningitidis"),
c(cephalosporins_3rd, fluoroquinolones),
"any")
trans_tbl(3,
which(x$fullname %like% "^Neisseria gonorrhoeae"),
AZM,
"any")
# Table 6
trans_tbl(3,
which(x$fullname %like% "^(Coagulase-negative|Staphylococcus (aureus|epidermidis|hominis|haemolyticus|intermedius|pseudointermedius))"),
c(VAN, TEC, DAP, LNZ, QDA, TGC),
"any")
trans_tbl(3,
which(x$genus == "Corynebacterium"),
c(VAN, TEC, DAP, LNZ, QDA, TGC),
"any")
trans_tbl(3,
which(x$fullname %like% "^Streptococcus pneumoniae"),
c(carbapenems, VAN, TEC, DAP, LNZ, QDA, TGC, RIF),
"any")
trans_tbl(3, # Sr. groups A/B/C/G
which(x$fullname %like% "^Streptococcus (group (A|B|C|G)|pyogenes|agalactiae|equisimilis|equi|zooepidemicus|dysgalactiae|anginosus)"),
c(PEN, cephalosporins, VAN, TEC, DAP, LNZ, QDA, TGC),
"any")
trans_tbl(3,
which(x$genus == "Enterococcus"),
c(DAP, LNZ, TGC, TEC),
"any")
trans_tbl(3,
which(x$fullname %like% "^Enterococcus faecalis"),
c(AMP, AMX),
"any")
# Table 7
trans_tbl(3,
which(x$genus == "Bacteroides"),
MTR,
"any")
trans_tbl(3,
which(x$fullname %like% "^Clostridium difficile"),
c(MTR, VAN),
"any")
}
if (guideline$code == "mrgn") {
# Germany -----------------------------------------------------------------
CTX_or_CAZ <- CTX %or% CAZ
IPM_or_MEM <- IPM %or% MEM
x$missing <- NA_character_
if (is.na(PIP)) PIP <- "missing"
if (is.na(CTX_or_CAZ)) CTX_or_CAZ <- "missing"
if (is.na(IPM_or_MEM)) IPM_or_MEM <- "missing"
if (is.na(IPM)) IPM <- "missing"
if (is.na(MEM)) MEM <- "missing"
if (is.na(CIP)) CIP <- "missing"
# Table 1
x[which((x$family == "Enterobacteriaceae" |
x$fullname %like% "^Acinetobacter baumannii") &
x[, PIP] == "R" &
x[, CTX_or_CAZ] == "R" &
x[, IPM_or_MEM] == "S" &
x[, CIP] == "R"),
"MDRO"] <- 2 # 2 = 3MRGN
x[which((x$family == "Enterobacteriaceae" |
x$fullname %like% "^Acinetobacter baumannii") &
x[, PIP] == "R" &
x[, CTX_or_CAZ] == "R" &
x[, IPM_or_MEM] == "R" &
x[, CIP] == "R"),
"MDRO"] <- 3 # 3 = 4MRGN, overwrites 3MRGN if applicable
x[which((x$family == "Enterobacteriaceae" |
x$fullname %like% "^Acinetobacter baumannii") &
x[, IPM] == "R" | x[, MEM] == "R"),
"MDRO"] <- 3 # 3 = 4MRGN, always when imipenem or meropenem is R
x[which(x$fullname %like% "^Pseudomonas aeruginosa" &
(x[, PIP] == "S") +
(x[, CTX_or_CAZ] == "S") +
(x[, IPM_or_MEM] == "S") +
(x[, CIP] == "S") == 1),
"MDRO"] <- 2 # 2 = 3MRGN, if only 1 group is S
x[which((x$fullname %like% "^Pseudomonas aeruginosa") &
x[, PIP] == "R" &
x[, CTX_or_CAZ] == "R" &
x[, IPM_or_MEM] == "R" &
x[, CIP] == "R"),
"MDRO"] <- 3 # 3 = 4MRGN
}
if (guideline$code == "brmo") {
# Netherlands -------------------------------------------------------------
aminoglycosides <- aminoglycosides[!is.na(aminoglycosides)]
fluoroquinolones <- fluoroquinolones[!is.na(fluoroquinolones)]
carbapenems <- carbapenems[!is.na(carbapenems)]
amino <- AMX %or% AMP
third <- CAZ %or% CTX
ESBLs <- c(amino, third)
ESBLs <- ESBLs[!is.na(ESBLs)]
if (length(ESBLs) != 2) {
ESBLs <- character(0)
}
# Table 1
trans_tbl(3,
which(x$family == "Enterobacteriaceae"),
c(aminoglycosides, fluoroquinolones),
"all")
trans_tbl(2,
which(x$family == "Enterobacteriaceae"),
carbapenems,
"any")
trans_tbl(2,
which(x$family == "Enterobacteriaceae"),
ESBLs,
"all")
# Table 2
trans_tbl(2,
which(x$genus == "Acinetobacter"),
c(carbapenems),
"any")
trans_tbl(3,
which(x$genus == "Acinetobacter"),
c(aminoglycosides, fluoroquinolones),
"all")
trans_tbl(3,
which(x$fullname %like% "^Stenotrophomonas maltophilia"),
SXT,
"all")
if (!ab_missing(MEM) & !ab_missing(IPM)
& !ab_missing(GEN) & !ab_missing(TOB)
& !ab_missing(CIP)
& !ab_missing(CAZ)
& !ab_missing(TZP)) {
x$psae <- 0
x[which(x[, MEM] == "R" | x[, IPM] == "R"), "psae"] <- 1 + x[which(x[, MEM] == "R" | x[, IPM] == "R"), "psae"]
x[which(x[, GEN] == "R" & x[, TOB] == "R"), "psae"] <- 1 + x[which(x[, GEN] == "R" & x[, TOB] == "R"), "psae"]
x[which(x[, CIP] == "R"), "psae"] <- 1 + x[which(x[, CIP] == "R"), "psae"]
x[which(x[, CAZ] == "R"), "psae"] <- 1 + x[which(x[, CAZ] == "R"), "psae"]
x[which(x[, TZP] == "R"), "psae"] <- 1 + x[which(x[, TZP] == "R"), "psae"]
} else {
x$psae <- 0
}
x[which(
x$fullname %like% "Pseudomonas aeruginosa"
& x$psae >= 3
), "MDRO"] <- 3
# Table 3
trans_tbl(3,
which(x$fullname %like% "Streptococcus pneumoniae"),
PEN,
"all")
trans_tbl(3,
which(x$fullname %like% "Streptococcus pneumoniae"),
VAN,
"all")
trans_tbl(3,
which(x$fullname %like% "Enterococcus faecium"),
c(PEN, VAN),
"all")
}
prepare_drug <- function(ab) {
# returns vector values of drug
# if `ab` is a column name, looks up the values in `x`
if (length(ab) == 1 & is.character(ab)) {
if (ab %in% colnames(x)) {
ab <- as.data.frame(x)[, ab]
}
}
ab <- as.character(as.rsi(ab))
ab[is.na(ab)] <- ""
ab
}
drug_is_R <- function(ab) {
# returns logical vector
ab <- prepare_drug(ab)
if (length(ab) == 1) {
rep(ab, NROW(x)) == "R"
} else {
ab == "R"
}
}
drug_is_not_R <- function(ab) {
# returns logical vector
ab <- prepare_drug(ab)
if (length(ab) == 1) {
rep(ab, NROW(x)) != "R"
} else {
ab != "R"
}
}
if (guideline$code == "tb") {
# Tuberculosis ------------------------------------------------------------
x <- x %>%
mutate(mono_count = 0,
mono_count = ifelse(drug_is_R(INH), mono_count + 1, mono_count),
mono_count = ifelse(drug_is_R(RIF), mono_count + 1, mono_count),
mono_count = ifelse(drug_is_R(ETH), mono_count + 1, mono_count),
mono_count = ifelse(drug_is_R(PZA), mono_count + 1, mono_count),
mono_count = ifelse(drug_is_R(RIB), mono_count + 1, mono_count),
mono_count = ifelse(drug_is_R(RFP), mono_count + 1, mono_count),
# from here on logicals
mono = mono_count > 0,
poly = ifelse(mono_count > 1 & drug_is_not_R(RIF) & drug_is_not_R(INH),
TRUE, FALSE),
mdr = ifelse(drug_is_R(RIF) & drug_is_R(INH),
TRUE, FALSE),
xdr = ifelse(drug_is_R(LVX) | drug_is_R(MFX) | drug_is_R(GAT),
TRUE, FALSE),
second = ifelse(drug_is_R(CAP) | drug_is_R(KAN) | drug_is_R(AMK),
TRUE, FALSE),
xdr = ifelse(mdr & xdr & second, TRUE, FALSE)) %>%
mutate(MDRO = case_when(xdr ~ 5,
mdr ~ 4,
poly ~ 3,
mono ~ 2,
TRUE ~ 1),
# keep all real TB, make other species NA
MDRO = ifelse(x$fullname == "Mycobacterium tuberculosis", MDRO, NA_real_))
}
if (info == TRUE) {
cat(bold(paste0("=> Found ", sum(x$MDRO %in% c(2:5), na.rm = TRUE), " MDROs out of ", sum(!is.na(x$MDRO)),
" possible cases (", percentage(sum(x$MDRO %in% c(2:5), na.rm = TRUE) / sum(!is.na(x$MDRO))), ")")))
}
# return results
if (guideline$code == "cmi2012") {
factor(x = x$MDRO,
levels = 1:4,
labels = c("Negative", "Multi-drug-resistant (MDR)",
"Extensively drug-resistant (XDR)", "Pandrug-resistant (PDR)"),
ordered = TRUE)
} else if (guideline$code == "tb") {
factor(x = x$MDRO,
levels = 1:5,
labels = c("Negative", "Mono-resistant", "Poly-resistant",
"Multi-drug-resistant", "Extensively drug-resistant"),
ordered = TRUE)
} else if (guideline$code == "mrgn") {
factor(x = x$MDRO,
levels = 1:3,
labels = c("Negative", "3MRGN", "4MRGN"),
ordered = TRUE)
} else {
factor(x = x$MDRO,
levels = 1:3,
labels = c("Negative", "Positive, unconfirmed", "Positive"),
ordered = TRUE)
}
}
#' @rdname mdro
#' @export
brmo <- function(x, guideline = "BRMO", ...) {
mdro(x, guideline = "BRMO", ...)
}
#' @rdname mdro
#' @export
mrgn <- function(x, guideline = "MRGN", ...) {
mdro(x = x, guideline = "MRGN", ...)
}
#' @rdname mdro
#' @export
mdr_tb <- function(x, guideline = "TB", ...) {
mdro(x = x, guideline = "TB", ...)
}
#' @rdname mdro
#' @export
mdr_cmi2012 <- function(x, guideline = "CMI2012", ...) {
mdro(x = x, guideline = "CMI2012", ...)
}
#' @rdname mdro
#' @export
eucast_exceptional_phenotypes <- function(x, guideline = "EUCAST", ...) {
mdro(x = x, guideline = "EUCAST", ...)
}