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-07-04 15:26:07 +02:00
#' @param guideline a specific guideline to mention, see Details. EUCAST guidelines will be used when left empty, 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-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{
#' \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 < Extensive 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}
#' }
2018-11-16 20:50:50 +01:00
#' @rdname mdro
2018-10-23 11:15:05 +02:00
#' @importFrom dplyr %>%
2018-12-22 22:39:34 +01:00
#' @importFrom crayon red blue bold
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
#' 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})
#'
#' 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})
#'
#' 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})
2018-04-25 15:33:58 +02:00
#' @examples
#' library(dplyr)
#'
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-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 ) ) {
guideline <- " eucast"
}
2019-07-04 15:26:07 +02:00
if ( tolower ( guideline ) == " nl" ) {
guideline <- " BRMO"
}
if ( tolower ( guideline ) == " de" ) {
guideline <- " MRGN"
}
if ( ! tolower ( guideline ) %in% c ( " brmo" , " mrgn" , " eucast" , " tb" ) ) {
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-05-23 16:58:59 +02:00
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"
guideline $ author <- " J. M\u00fcller, A. Voss, R. K\u00f6ck, ..., W.V. Kern, C. Wendt, A.W. Friedrich"
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-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
}
if ( info == TRUE ) {
2018-04-25 15:33:58 +02:00
cat ( " Determining multidrug-resistant organisms (MDRO), according to:\n" ,
2019-05-23 16:58:59 +02:00
" Guideline: " , red ( guideline $ name ) , " \n" ,
" Version: " , red ( guideline $ version ) , " \n" ,
" Author: " , red ( guideline $ author ) , " \n" ,
" Source: " , blue ( guideline $ source ) , " \n" ,
2018-04-18 12:24:54 +02:00
" \n" , sep = " " )
}
2019-05-23 16:58:59 +02:00
if ( guideline $ code == " tb" ) {
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" ]
CRO <- cols_ab [ " CRO" ]
CTX <- cols_ab [ " CTX" ]
CXM <- cols_ab [ " CXM" ]
CZO <- cols_ab [ " CZO" ]
DAP <- cols_ab [ " DAP" ]
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" ]
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" ]
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" ]
SIS <- cols_ab [ " SIS" ]
SXT <- cols_ab [ " SXT" ]
TCY <- cols_ab [ " TCY" ]
TEC <- cols_ab [ " TEC" ]
TGC <- cols_ab [ " TGC" ]
TIC <- cols_ab [ " TIC" ]
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 )
}
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
}
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 %>%
2018-11-16 20:50:50 +01:00
mutate ( index = 1 : nrow ( .) ) %>%
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-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-07 14:32:06 +02:00
mutate ( MDRO = ifelse ( ! is.na ( genus ) , 1 , NA_integer_ ) ) %>%
# 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 )
2018-04-25 15:33:58 +02:00
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-05-23 16:58:59 +02:00
which ( x $ family == " Enterobacteriaceae"
| 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
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
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-05-23 16:58:59 +02:00
which ( x $ family == " Enterobacteriaceae" ) ,
2018-11-16 20:50:50 +01:00
c ( aminoglycosides , fluoroquinolones ) ,
" all" )
trans_tbl ( 2 ,
2019-05-23 16:58:59 +02:00
which ( x $ family == " Enterobacteriaceae" ) ,
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-05-23 16:58:59 +02:00
which ( x $ family == " Enterobacteriaceae" ) ,
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 )
& ! 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 ) ) %>%
mutate ( mdr_tb = case_when ( xdr ~ 5 ,
mdr ~ 4 ,
poly ~ 3 ,
mono ~ 2 ,
TRUE ~ 1 ) ,
# keep all real TB, make other species NA
mdr_tb = ifelse ( x $ fullname == " Mycobacterium tuberculosis" , mdr_tb , NA_real_ ) )
}
# return results
if ( guideline $ code == " tb" ) {
factor ( x = x $ mdr_tb ,
levels = 1 : 5 ,
2019-09-26 21:58:06 +02:00
labels = c ( " Negative" , " Mono-resistant" , " Poly-resistant" , " Multi-drug-resistant" , " Extensive 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" , ... )
}
#' @rdname mdro
#' @export
eucast_exceptional_phenotypes <- function ( x , guideline = " EUCAST" , ... ) {
mdro ( x = x , guideline = " EUCAST" , ... )
2018-04-18 12:24:54 +02:00
}