2018-04-18 12:24:54 +02:00
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Analysis #
# #
2019-01-02 23:24:07 +01:00
# SOURCE #
# https://gitlab.com/msberends/AMR #
2018-04-18 12:24:54 +02:00
# #
# LICENCE #
2019-01-02 23:24:07 +01:00
# (c) 2019 Berends MS (m.s.berends@umcg.nl), Luz CF (c.f.luz@umcg.nl) #
2018-04-18 12:24:54 +02:00
# #
2019-01-02 23:24:07 +01:00
# 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. #
2019-04-05 18:47:39 +02:00
# Visit our website for more info: https://msberends.gitlab.io/AMR. #
2018-04-18 12:24:54 +02:00
# ==================================================================== #
#' Determine multidrug-resistant organisms (MDRO)
#'
2019-07-04 15:26:07 +02:00
#' Determine which isolates are multidrug-resistant organisms (MDRO) according to (country-specific) guidelines.
2019-05-10 16:44:59 +02:00
#' @param x table with antibiotic columns, like e.g. \code{AMX} and \code{AMC}
2019-10-26 21:56:41 +02:00
#' @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.
2018-04-18 12:24:54 +02:00
#' @param info print progress
2018-11-16 20:50:50 +01:00
#' @inheritParams eucast_rules
2019-04-09 14:59:17 +02:00
#' @param verbose print additional info: missing antibiotic columns per parameter
2018-11-16 20:50:50 +01:00
#' @inheritSection eucast_rules Antibiotics
2019-10-07 14:32:06 +02:00
#' @details Currently supported guidelines are (case-insensitive):
2019-05-23 16:58:59 +02:00
#' \itemize{
2019-10-26 21:56:41 +02:00
#' \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})}
2019-10-07 14:32:06 +02:00
#' \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})}
2019-05-23 16:58:59 +02:00
#' }
#'
2019-07-04 15:26:07 +02:00
#' Please suggest your own (country-specific) guidelines by letting us know: \url{https://gitlab.com/msberends/AMR/issues/new}.
2019-10-07 14:32:06 +02:00
#' @return \itemize{
2019-10-26 21:56:41 +02:00
#' \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}}
2019-10-07 14:32:06 +02:00
#' \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}
#' }
2018-11-16 20:50:50 +01:00
#' @rdname mdro
2019-10-26 21:56:41 +02:00
#' @importFrom dplyr %>% filter_all
#' @importFrom crayon blue bold italic
2018-04-18 12:24:54 +02:00
#' @export
2019-01-02 23:24:07 +01:00
#' @inheritSection AMR Read more on our website!
2019-07-04 15:26:07 +02:00
#' @source
2019-10-26 21:56:41 +02:00
#' Please see Details for the list of publications used for this function.
2018-04-25 15:33:58 +02:00
#' @examples
#' library(dplyr)
2019-10-26 21:56:41 +02:00
#'
#' example_isolates %>%
#' mdro() %>%
#' freq()
#'
#' \donttest{
2019-08-27 16:45:42 +02:00
#' example_isolates %>%
2018-11-16 20:50:50 +01:00
#' mutate(EUCAST = mdro(.),
2019-10-07 14:32:06 +02:00
#' BRMO = brmo(.),
#' MRGN = mrgn(.))
#'
#' example_isolates %>%
2019-10-07 14:57:27 +02:00
#' rename(PIP = TZP) %>% # no piperacillin, so take piperacillin/tazobactam
#' mrgn() %>% # check German guideline
#' freq() # check frequencies
2019-10-26 21:56:41 +02:00
#' }
2019-05-10 16:44:59 +02:00
mdro <- function ( x ,
2019-05-23 16:58:59 +02:00
guideline = NULL ,
2018-10-23 11:15:05 +02:00
col_mo = NULL ,
2018-04-18 12:24:54 +02:00
info = TRUE ,
2019-05-10 16:44:59 +02:00
verbose = FALSE ,
... ) {
2019-05-23 16:58:59 +02:00
if ( ! is.data.frame ( x ) ) {
2019-05-10 16:44:59 +02:00
stop ( " `x` must be a data frame." , call. = FALSE )
2018-10-23 11:15:05 +02:00
}
2019-07-04 15:26:07 +02:00
if ( ! is.null ( list ( ... ) $ country ) ) {
warning ( " Using `country` is deprecated, use `guideline` instead. Please see ?mdro." , call. = FALSE )
guideline <- list ( ... ) $ country
}
2019-05-23 16:58:59 +02:00
if ( length ( guideline ) > 1 ) {
stop ( " `guideline` must be a length one character string." , call. = FALSE )
}
2019-07-04 15:26:07 +02:00
2019-05-23 16:58:59 +02:00
if ( is.null ( guideline ) ) {
2019-10-26 21:56:41 +02:00
# default to the paper by Magiorakos et al. (2012)
guideline <- " cmi2012"
2019-05-23 16:58:59 +02:00
}
2019-07-04 15:26:07 +02:00
if ( tolower ( guideline ) == " nl" ) {
guideline <- " BRMO"
}
if ( tolower ( guideline ) == " de" ) {
guideline <- " MRGN"
}
2019-10-26 21:56:41 +02:00
if ( ! tolower ( guideline ) %in% c ( " brmo" , " mrgn" , " eucast" , " tb" , " cmi2012" ) ) {
2019-05-23 16:58:59 +02:00
stop ( " invalid guideline: " , guideline , call. = FALSE )
}
guideline <- list ( code = tolower ( guideline ) )
2018-10-23 11:15:05 +02:00
# try to find columns based on type
# -- mo
2019-01-15 12:45:24 +01:00
if ( is.null ( col_mo ) ) {
2019-05-23 16:58:59 +02:00
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`," ,
2019-07-04 15:26:07 +02:00
bold ( " assuming all records contain" , italic ( " Mycobacterium tuberculosis.\n" ) ) ) )
2019-05-23 16:58:59 +02:00
x $ mo <- AMR :: as.mo ( " Mycobacterium tuberculosis" )
col_mo <- " mo"
2018-12-22 22:39:34 +01:00
}
if ( is.null ( col_mo ) ) {
stop ( " `col_mo` must be set." , call. = FALSE )
2018-04-25 15:33:58 +02:00
}
2018-04-18 12:24:54 +02:00
2019-10-26 21:56:41 +02:00
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" ) {
2019-05-20 19:12:41 +02:00
guideline $ name <- " EUCAST Expert Rules, \"Intrinsic Resistance and Exceptional Phenotypes Tables\""
2019-05-23 16:58:59 +02:00
guideline $ author <- " EUCAST (European Committee on Antimicrobial Susceptibility Testing)"
guideline $ version <- " 3.1"
2019-05-20 19:12:41 +02:00
guideline $ source <- " http://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/Expert_rules_intrinsic_exceptional_V3.1.pdf"
2019-05-23 16:58:59 +02:00
} 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/"
2018-04-25 15:33:58 +02:00
# support per country:
2019-07-04 15:26:07 +02:00
} else if ( guideline $ code == " mrgn" ) {
2019-10-07 14:32:06 +02:00
guideline $ name <- " Cross-border comparison of the Dutch and German guidelines on multidrug-resistant Gram-negative microorganisms"
2019-10-26 21:56:41 +02:00
guideline $ author <- " M\u00fcller J, Voss A, K\u00f6ck R, ..., Kern WV, Wendt C, Friedrich AW"
2019-10-07 14:32:06 +02:00
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"
2019-10-26 21:56:41 +02:00
2019-07-04 15:26:07 +02:00
} else if ( guideline $ code == " brmo" ) {
2019-05-23 16:58:59 +02:00
guideline $ name <- " WIP-Richtlijn Bijzonder Resistente Micro-organismen (BRMO)"
guideline $ author <- " RIVM (Rijksinstituut voor de Volksgezondheid)"
2019-05-20 19:12:41 +02:00
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"
2018-04-18 12:24:54 +02:00
} else {
2019-05-23 16:58:59 +02:00
stop ( " This guideline is currently unsupported: " , guideline $ code , call. = FALSE )
2018-04-18 12:24:54 +02:00
}
2019-10-26 21:56:41 +02:00
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" ) {
2019-05-23 16:58:59 +02:00
cols_ab <- get_column_abx ( x = x ,
soft_dependencies = c ( " CAP" ,
" ETH" ,
" GAT" ,
" INH" ,
" PZA" ,
" RIF" ,
" RIB" ,
" RFP" ) ,
verbose = verbose , ... )
2019-10-07 14:32:06 +02:00
} else if ( guideline $ code == " mrgn" ) {
cols_ab <- get_column_abx ( x = x ,
soft_dependencies = c ( " PIP" ,
" CTX" ,
" CAZ" ,
" IPM" ,
" MEM" ,
" CIP" ) ,
verbose = verbose , ... )
2019-05-23 16:58:59 +02:00
} else {
cols_ab <- get_column_abx ( x = x , verbose = verbose , ... )
}
2019-05-20 19:12:41 +02:00
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" ]
2019-10-26 21:56:41 +02:00
CPT <- cols_ab [ " CPT" ]
2019-05-20 19:12:41 +02:00
CRO <- cols_ab [ " CRO" ]
2019-10-26 21:56:41 +02:00
CTT <- cols_ab [ " CTT" ]
2019-05-20 19:12:41 +02:00
CTX <- cols_ab [ " CTX" ]
CXM <- cols_ab [ " CXM" ]
CZO <- cols_ab [ " CZO" ]
DAP <- cols_ab [ " DAP" ]
2019-10-26 21:56:41 +02:00
DOR <- cols_ab [ " DOR" ]
2019-05-20 19:12:41 +02:00
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" ]
2019-10-26 21:56:41 +02:00
GEH <- cols_ab [ " GEH" ]
2019-05-20 19:12:41 +02:00
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" ]
2019-10-26 21:56:41 +02:00
OXA <- cols_ab [ " OXA" ]
2019-05-20 19:12:41 +02:00
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" ]
2019-10-26 21:56:41 +02:00
SAM <- cols_ab [ " SAM" ]
2019-05-20 19:12:41 +02:00
SIS <- cols_ab [ " SIS" ]
2019-10-26 21:56:41 +02:00
STH <- cols_ab [ " STH" ]
2019-05-20 19:12:41 +02:00
SXT <- cols_ab [ " SXT" ]
2019-10-26 21:56:41 +02:00
TCC <- cols_ab [ " TCC" ]
2019-05-20 19:12:41 +02:00
TCY <- cols_ab [ " TCY" ]
TEC <- cols_ab [ " TEC" ]
TGC <- cols_ab [ " TGC" ]
TIC <- cols_ab [ " TIC" ]
2019-10-26 21:56:41 +02:00
TLV <- cols_ab [ " TLV" ]
2019-05-20 19:12:41 +02:00
TMP <- cols_ab [ " TMP" ]
TOB <- cols_ab [ " TOB" ]
TZP <- cols_ab [ " TZP" ]
VAN <- cols_ab [ " VAN" ]
2019-05-23 16:58:59 +02:00
# 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 )
}
2019-10-26 21:56:41 +02:00
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 = " " )
}
2018-04-25 15:33:58 +02:00
2019-04-09 14:59:17 +02:00
ab_missing <- function ( ab ) {
isTRUE ( ab %in% c ( NULL , NA ) ) | length ( ab ) == 0
}
2019-10-26 21:56:41 +02:00
ab_NA <- function ( x ) {
x [ ! is.na ( x ) ]
}
2019-04-09 14:59:17 +02:00
2018-04-25 15:33:58 +02:00
# antibiotic classes
2019-05-10 16:44:59 +02:00
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 )
2018-04-25 15:33:58 +02:00
# helper function for editing the table
2018-11-16 20:50:50 +01:00
trans_tbl <- function ( to , rows , cols , any_all ) {
2019-04-09 14:59:17 +02:00
cols <- cols [ ! ab_missing ( cols ) ]
2019-05-10 16:44:59 +02:00
cols <- cols [ ! is.na ( cols ) ]
2018-04-25 15:33:58 +02:00
if ( length ( rows ) > 0 & length ( cols ) > 0 ) {
2018-11-16 20:50:50 +01:00
if ( any_all == " any" ) {
2019-05-23 16:58:59 +02:00
row_filter <- which ( x [ , cols ] == " R" )
2018-11-16 20:50:50 +01:00
} else if ( any_all == " all" ) {
2019-05-23 16:58:59 +02:00
row_filter <- x %>%
2019-10-11 17:21:02 +02:00
mutate ( index = seq_len ( nrow ( .) ) ) %>%
2018-11-16 20:50:50 +01:00
filter_at ( vars ( cols ) , all_vars ( . == " R" ) ) %>%
pull ( ( index ) )
}
2019-05-20 19:12:41 +02:00
rows <- rows [rows %in% row_filter ]
2019-05-23 16:58:59 +02:00
x [rows , " MDRO" ] <<- to
2018-04-25 15:33:58 +02:00
}
}
2019-10-26 21:56:41 +02:00
trans_tbl2 <- function ( txt , rows , lst ) {
2019-10-30 23:02:50 +01:00
if ( info == TRUE ) {
message ( blue ( txt , " ..." ) , appendLF = FALSE )
}
2019-10-26 21:56:41 +02:00
# 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
2019-10-30 23:02:50 +01:00
x [which ( x $ row_number %in% rows & ( x $ total_groups - x $ affected_groups ) <= 2 ) , " MDRO" ] <<- 3
2019-10-26 21:56:41 +02:00
# PDR (=4): all agents are R
x [filter_at ( x [rows , ] ,
vars ( lst_vector ) ,
all_vars ( . %in% c ( " R" , " I" ) ) ) $ row_number ,
" MDRO" ] <<- 4
2019-10-30 23:02:50 +01:00
if ( info == TRUE ) {
message ( blue ( " OK" ) )
}
2019-10-26 21:56:41 +02:00
}
2019-05-23 16:58:59 +02:00
x <- x %>%
2018-12-22 22:39:34 +01:00
mutate_at ( vars ( col_mo ) , as.mo ) %>%
2018-10-23 11:15:05 +02:00
# join to microorganisms data set
left_join_microorganisms ( by = col_mo ) %>%
# add unconfirmed to where genus is available
2019-10-26 21:56:41 +02:00
mutate ( MDRO = ifelse ( ! is.na ( genus ) , 1 , NA_integer_ ) ,
2019-10-30 23:02:50 +01:00
row_number = seq_len ( nrow ( .) ) ) %>%
2019-10-07 14:32:06 +02:00
# 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 )
2019-10-26 21:56:41 +02:00
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 ) ) )
2019-10-30 23:02:50 +01:00
trans_tbl2 ( paste ( " Table 2 -" , italic ( " Enterococcus" ) , " spp." ) ,
2019-10-26 21:56:41 +02:00
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 ) ) )
2019-10-30 23:02:50 +01:00
trans_tbl2 ( paste0 ( " Table 3 - " , italic ( " Enterobacteriaceae" ) ,
" (before the taxonomic reclassification by Adeolu " , italic ( " et al." ) , " , 2016)" ) ,
# this new order was previously 'Enterobacteriales' and contained only the family 'Enterobacteriaceae':
which ( x $ order == " Enterobacterales" ) ,
2019-10-26 21:56:41 +02:00
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 ) ) )
2019-10-30 23:02:50 +01:00
trans_tbl2 ( paste ( " Table 5 -" , italic ( " Acinetobacter" ) , " spp." ) ,
2019-10-26 21:56:41 +02:00
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 ) ) )
}
2019-05-23 16:58:59 +02:00
if ( guideline $ code == " eucast" ) {
2018-04-25 15:33:58 +02:00
# EUCAST ------------------------------------------------------------------
# Table 5
2018-11-16 20:50:50 +01:00
trans_tbl ( 3 ,
2019-10-30 23:02:50 +01:00
which ( x $ order == " Enterobacterales"
2019-05-23 16:58:59 +02:00
| x $ fullname %like% " ^Pseudomonas aeruginosa"
| x $ genus == " Acinetobacter" ) ,
2019-05-10 16:44:59 +02:00
COL ,
2018-11-16 20:50:50 +01:00
" all" )
trans_tbl ( 3 ,
2019-05-23 16:58:59 +02:00
which ( x $ fullname %like% " ^Salmonella Typhi" ) ,
2018-11-16 20:50:50 +01:00
c ( carbapenems , fluoroquinolones ) ,
" any" )
trans_tbl ( 3 ,
2019-05-23 16:58:59 +02:00
which ( x $ fullname %like% " ^Haemophilus influenzae" ) ,
2018-11-16 20:50:50 +01:00
c ( cephalosporins_3rd , carbapenems , fluoroquinolones ) ,
" any" )
trans_tbl ( 3 ,
2019-05-23 16:58:59 +02:00
which ( x $ fullname %like% " ^Moraxella catarrhalis" ) ,
2018-11-16 20:50:50 +01:00
c ( cephalosporins_3rd , fluoroquinolones ) ,
" any" )
trans_tbl ( 3 ,
2019-05-23 16:58:59 +02:00
which ( x $ fullname %like% " ^Neisseria meningitidis" ) ,
2018-11-16 20:50:50 +01:00
c ( cephalosporins_3rd , fluoroquinolones ) ,
" any" )
trans_tbl ( 3 ,
2019-05-23 16:58:59 +02:00
which ( x $ fullname %like% " ^Neisseria gonorrhoeae" ) ,
2019-05-10 16:44:59 +02:00
AZM ,
2018-11-16 20:50:50 +01:00
" any" )
2018-04-25 15:33:58 +02:00
# Table 6
2018-11-16 20:50:50 +01:00
trans_tbl ( 3 ,
2019-10-07 14:32:06 +02:00
which ( x $ fullname %like% " ^(Coagulase-negative|Staphylococcus (aureus|epidermidis|hominis|haemolyticus|intermedius|pseudointermedius))" ) ,
2019-05-10 16:44:59 +02:00
c ( VAN , TEC , DAP , LNZ , QDA , TGC ) ,
2018-11-16 20:50:50 +01:00
" any" )
trans_tbl ( 3 ,
2019-05-23 16:58:59 +02:00
which ( x $ genus == " Corynebacterium" ) ,
2019-05-10 16:44:59 +02:00
c ( VAN , TEC , DAP , LNZ , QDA , TGC ) ,
2018-11-16 20:50:50 +01:00
" any" )
trans_tbl ( 3 ,
2019-05-23 16:58:59 +02:00
which ( x $ fullname %like% " ^Streptococcus pneumoniae" ) ,
2019-05-10 16:44:59 +02:00
c ( carbapenems , VAN , TEC , DAP , LNZ , QDA , TGC , RIF ) ,
2018-11-16 20:50:50 +01:00
" any" )
trans_tbl ( 3 , # Sr. groups A/B/C/G
2019-10-07 14:32:06 +02:00
which ( x $ fullname %like% " ^Streptococcus (group (A|B|C|G)|pyogenes|agalactiae|equisimilis|equi|zooepidemicus|dysgalactiae|anginosus)" ) ,
2019-05-10 16:44:59 +02:00
c ( PEN , cephalosporins , VAN , TEC , DAP , LNZ , QDA , TGC ) ,
2018-11-16 20:50:50 +01:00
" any" )
trans_tbl ( 3 ,
2019-05-23 16:58:59 +02:00
which ( x $ genus == " Enterococcus" ) ,
2019-05-10 16:44:59 +02:00
c ( DAP , LNZ , TGC , TEC ) ,
2018-11-16 20:50:50 +01:00
" any" )
trans_tbl ( 3 ,
2019-05-23 16:58:59 +02:00
which ( x $ fullname %like% " ^Enterococcus faecalis" ) ,
2019-05-10 16:44:59 +02:00
c ( AMP , AMX ) ,
2018-11-16 20:50:50 +01:00
" any" )
2018-04-25 15:33:58 +02:00
# Table 7
2018-11-16 20:50:50 +01:00
trans_tbl ( 3 ,
2019-05-23 16:58:59 +02:00
which ( x $ genus == " Bacteroides" ) ,
2019-05-10 16:44:59 +02:00
MTR ,
2018-11-16 20:50:50 +01:00
" any" )
trans_tbl ( 3 ,
2019-05-23 16:58:59 +02:00
which ( x $ fullname %like% " ^Clostridium difficile" ) ,
2019-05-20 19:12:41 +02:00
c ( MTR , VAN ) ,
2018-11-16 20:50:50 +01:00
" any" )
2018-04-25 15:33:58 +02:00
}
2018-04-18 12:24:54 +02:00
2019-07-04 15:26:07 +02:00
if ( guideline $ code == " mrgn" ) {
2018-04-25 15:33:58 +02:00
# Germany -----------------------------------------------------------------
2019-10-07 14:32:06 +02:00
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
2019-10-30 23:02:50 +01:00
x [which ( ( x $ order == " Enterobacterales" | # following in fact the old Enterobacteriaceae classification
2019-10-07 14:32:06 +02:00
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
2019-10-30 23:02:50 +01:00
x [which ( ( x $ order == " Enterobacterales" | # following in fact the old Enterobacteriaceae classification
2019-10-07 14:32:06 +02:00
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
2019-10-30 23:02:50 +01:00
x [which ( ( x $ order == " Enterobacterales" | # following in fact the old Enterobacteriaceae classification
2019-10-07 14:32:06 +02:00
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
2018-04-19 14:10:57 +02:00
}
2019-07-04 15:26:07 +02:00
if ( guideline $ code == " brmo" ) {
2018-04-25 15:33:58 +02:00
# Netherlands -------------------------------------------------------------
2019-05-20 19:12:41 +02:00
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 )
}
2018-04-18 12:24:54 +02:00
# Table 1
2018-11-16 20:50:50 +01:00
trans_tbl ( 3 ,
2019-10-30 23:02:50 +01:00
which ( x $ order == " Enterobacterales" ) , # following in fact the old Enterobacteriaceae classification
2018-11-16 20:50:50 +01:00
c ( aminoglycosides , fluoroquinolones ) ,
" all" )
trans_tbl ( 2 ,
2019-10-30 23:02:50 +01:00
which ( x $ order == " Enterobacterales" ) , # following in fact the old Enterobacteriaceae classification
2019-05-20 19:12:41 +02:00
carbapenems ,
2018-11-16 20:50:50 +01:00
" any" )
2018-04-18 12:24:54 +02:00
2019-05-20 19:12:41 +02:00
trans_tbl ( 2 ,
2019-10-30 23:02:50 +01:00
which ( x $ order == " Enterobacterales" ) , # following in fact the old Enterobacteriaceae classification
2019-05-20 19:12:41 +02:00
ESBLs ,
" all" )
2018-04-18 12:24:54 +02:00
# Table 2
2018-11-16 20:50:50 +01:00
trans_tbl ( 2 ,
2019-05-23 16:58:59 +02:00
which ( x $ genus == " Acinetobacter" ) ,
2018-11-16 20:50:50 +01:00
c ( carbapenems ) ,
" any" )
trans_tbl ( 3 ,
2019-05-23 16:58:59 +02:00
which ( x $ genus == " Acinetobacter" ) ,
2018-11-16 20:50:50 +01:00
c ( aminoglycosides , fluoroquinolones ) ,
" all" )
2018-04-18 12:24:54 +02:00
2018-11-16 20:50:50 +01:00
trans_tbl ( 3 ,
2019-05-23 16:58:59 +02:00
which ( x $ fullname %like% " ^Stenotrophomonas maltophilia" ) ,
2019-05-10 16:44:59 +02:00
SXT ,
2018-11-16 20:50:50 +01:00
" all" )
2018-04-18 12:24:54 +02:00
2019-05-10 16:44:59 +02:00
if ( ! ab_missing ( MEM ) & ! ab_missing ( IPM )
& ! ab_missing ( GEN ) & ! ab_missing ( TOB )
& ! ab_missing ( CIP )
& ! ab_missing ( CAZ )
2019-10-11 17:21:02 +02:00
& ! ab_missing ( TZP ) ) {
2019-05-23 16:58:59 +02:00
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" ]
2018-11-16 20:50:50 +01:00
} else {
2019-05-23 16:58:59 +02:00
x $ psae <- 0
2018-11-16 20:50:50 +01:00
}
2019-05-23 16:58:59 +02:00
x [which (
x $ fullname %like% " Pseudomonas aeruginosa"
& x $ psae >= 3
2019-05-20 19:12:41 +02:00
) , " MDRO" ] <- 3
2018-04-18 12:24:54 +02:00
# Table 3
2018-11-16 20:50:50 +01:00
trans_tbl ( 3 ,
2019-05-23 16:58:59 +02:00
which ( x $ fullname %like% " Streptococcus pneumoniae" ) ,
2019-05-10 16:44:59 +02:00
PEN ,
2018-11-16 20:50:50 +01:00
" all" )
trans_tbl ( 3 ,
2019-05-23 16:58:59 +02:00
which ( x $ fullname %like% " Streptococcus pneumoniae" ) ,
2019-05-10 16:44:59 +02:00
VAN ,
2018-11-16 20:50:50 +01:00
" all" )
trans_tbl ( 3 ,
2019-05-23 16:58:59 +02:00
which ( x $ fullname %like% " Enterococcus faecium" ) ,
2019-05-10 16:44:59 +02:00
c ( PEN , VAN ) ,
2018-11-16 20:50:50 +01:00
" all" )
2018-04-18 12:24:54 +02:00
}
2019-05-23 16:58:59 +02:00
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 ) ) %>%
2019-10-26 21:56:41 +02:00
mutate ( MDRO = case_when ( xdr ~ 5 ,
2019-05-23 16:58:59 +02:00
mdr ~ 4 ,
poly ~ 3 ,
mono ~ 2 ,
TRUE ~ 1 ) ,
# keep all real TB, make other species NA
2019-10-26 21:56:41 +02:00
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 ) ) ) , " )" ) ) )
2019-05-23 16:58:59 +02:00
}
# return results
2019-10-26 21:56:41 +02:00
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 ,
2019-05-23 16:58:59 +02:00
levels = 1 : 5 ,
2019-10-26 21:56:41 +02:00
labels = c ( " Negative" , " Mono-resistant" , " Poly-resistant" ,
" Multi-drug-resistant" , " Extensively drug-resistant" ) ,
2019-05-23 16:58:59 +02:00
ordered = TRUE )
2019-10-07 14:32:06 +02:00
} else if ( guideline $ code == " mrgn" ) {
factor ( x = x $ MDRO ,
levels = 1 : 3 ,
labels = c ( " Negative" , " 3MRGN" , " 4MRGN" ) ,
ordered = TRUE )
2019-05-23 16:58:59 +02:00
} else {
factor ( x = x $ MDRO ,
levels = 1 : 3 ,
labels = c ( " Negative" , " Positive, unconfirmed" , " Positive" ) ,
ordered = TRUE )
}
2018-04-18 12:24:54 +02:00
}
2018-11-16 20:50:50 +01:00
#' @rdname mdro
2018-04-18 12:24:54 +02:00
#' @export
2019-07-09 11:22:46 +02:00
brmo <- function ( x , guideline = " BRMO" , ... ) {
mdro ( x , guideline = " BRMO" , ... )
2018-04-18 12:24:54 +02:00
}
2018-11-16 20:50:50 +01:00
#' @rdname mdro
2018-04-18 12:24:54 +02:00
#' @export
2019-07-04 15:26:07 +02:00
mrgn <- function ( x , guideline = " MRGN" , ... ) {
mdro ( x = x , guideline = " MRGN" , ... )
2018-04-25 15:33:58 +02:00
}
2018-11-16 20:50:50 +01:00
#' @rdname mdro
2018-04-25 15:33:58 +02:00
#' @export
2019-05-23 16:58:59 +02:00
mdr_tb <- function ( x , guideline = " TB" , ... ) {
mdro ( x = x , guideline = " TB" , ... )
}
2019-10-26 21:56:41 +02:00
#' @rdname mdro
#' @export
mdr_cmi2012 <- function ( x , guideline = " CMI2012" , ... ) {
mdro ( x = x , guideline = " CMI2012" , ... )
}
2019-05-23 16:58:59 +02:00
#' @rdname mdro
#' @export
eucast_exceptional_phenotypes <- function ( x , guideline = " EUCAST" , ... ) {
mdro ( x = x , guideline = " EUCAST" , ... )
2018-04-18 12:24:54 +02:00
}