2018-04-18 12:24:54 +02:00
# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Analysis #
# #
2019-01-02 23:24:07 +01:00
# SOURCE #
2020-07-08 14:48:06 +02:00
# https://github.com/msberends/AMR #
2018-04-18 12:24:54 +02:00
# #
# LICENCE #
2020-01-05 17:22:09 +01:00
# (c) 2018-2020 Berends MS, Luz CF et al. #
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. #
# #
2020-01-05 17:22:09 +01:00
# We created this package for both routine data analysis and academic #
# research and it was publicly released in the hope that it will be #
# useful, but it comes WITHOUT ANY WARRANTY OR LIABILITY. #
2020-07-08 14:48:06 +02:00
# Visit our website for more info: https://msberends.github.io/AMR. #
2018-04-18 12:24:54 +02:00
# ==================================================================== #
#' Determine multidrug-resistant organisms (MDRO)
#'
2019-11-10 15:50:18 +01:00
#' Determine which isolates are multidrug-resistant organisms (MDRO) according to international and national guidelines.
2020-01-05 17:22:09 +01:00
#' @inheritSection lifecycle Maturing lifecycle
2019-11-28 22:32:17 +01:00
#' @param guideline a specific guideline to follow. When left empty, the publication by Magiorakos *et al.* (2012, Clinical Microbiology and Infection) will be followed, please see *Details*.
#' @param info a logical to indicate whether progress should be printed to the console
2018-11-16 20:50:50 +01:00
#' @inheritParams eucast_rules
2019-11-28 22:32:17 +01:00
#' @param pct_required_classes minimal required percentage of antimicrobial classes that must be available per isolate, rounded down. For example, with the default guideline, 17 antimicrobial classes must be available for *S. aureus*. Setting this `pct_required_classes` argument to `0.5` (default) means that for every *S. aureus* isolate at least 8 different classes must be available. Any lower number of available classes will return `NA` for that isolate.
#' @param combine_SI a logical to indicate whether all values of S and I must be merged into one, so resistance is only considered when isolates are R, not I. As this is the default behaviour of the [mdro()] function, it follows the redefinition by EUCAST about the interpretion of I (increased exposure) in 2019, see section 'Interpretation of S, I and R' below. When using `combine_SI = FALSE`, resistance is considered when isolates are R or I.
2019-11-03 22:24:42 +01:00
#' @param verbose a logical to turn Verbose mode on and off (default is off). In Verbose mode, the function does not return the MDRO results, but instead returns a data set in logbook form with extensive info about which isolates would be MDRO-positive, or why they are not.
2018-11-16 20:50:50 +01:00
#' @inheritSection eucast_rules Antibiotics
2019-11-03 22:24:42 +01:00
#' @details
2019-11-28 22:32:17 +01:00
#' For the `pct_required_classes` argument, values above 1 will be divided by 100. This is to support both fractions (`0.75` or `3/4`) and percentages (`75`).
2019-11-05 21:52:58 +01:00
#'
2019-11-03 22:24:42 +01:00
#' Currently supported guidelines are (case-insensitive):
2019-11-28 22:32:17 +01:00
#'
#' - `guideline = "CMI2012"`\cr
#' Magiorakos AP, Srinivasan A *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) ([link](https://www.clinicalmicrobiologyandinfection.com/article/S1198-743X(14)61632-3/fulltext))
#' - `guideline = "EUCAST"`\cr
#' The European international guideline - EUCAST Expert Rules Version 3.1 "Intrinsic Resistance and Exceptional Phenotypes Tables" ([link](http://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/Expert_rules_intrinsic_exceptional_V3.1.pdf))
#' - `guideline = "TB"`\cr
#' 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" ([link](https://www.who.int/tb/publications/pmdt_companionhandbook/en/))
#' - `guideline = "MRGN"`\cr
#' The German national guideline - Mueller et al. (2015) Antimicrobial Resistance and Infection Control 4:7. DOI: 10.1186/s13756-015-0047-6
#' - `guideline = "BRMO"`\cr
2019-11-28 23:00:37 +01:00
#' The Dutch national guideline - Rijksinstituut voor Volksgezondheid en Milieu "WIP-richtlijn BRMO (Bijzonder Resistente Micro-Organismen) (ZKH)" ([link](https://www.rivm.nl/Documenten_en_publicaties/Professioneel_Praktisch/Richtlijnen/Infectieziekten/WIP_Richtlijnen/WIP_Richtlijnen/Ziekenhuizen/WIP_richtlijn_BRMO_Bijzonder_Resistente_Micro_Organismen_ZKH))
2019-05-23 16:58:59 +02:00
#'
2020-07-08 14:48:06 +02:00
#' Please suggest your own (country-specific) guidelines by letting us know: <https://github.com/msberends/AMR/issues/new>.
2019-11-03 22:24:42 +01:00
#'
2019-11-28 22:32:17 +01:00
#' **Note:** Every test that involves the Enterobacteriaceae family, will internally be performed using its newly named order Enterobacterales, since the Enterobacteriaceae family has been taxonomically reclassified by Adeolu *et al.* in 2016. Before that, Enterobacteriaceae was the only family under the Enterobacteriales (with an i) order. All species under the old Enterobacteriaceae family are still under the new Enterobacterales (without an i) order, but divided into multiple families. The way tests are performed now by this [mdro()] function makes sure that results from before 2016 and after 2016 are identical.
2019-11-29 19:43:23 +01:00
#' @inheritSection as.rsi Interpretation of R and S/I
2019-11-28 22:32:17 +01:00
#' @return
#' - CMI 2012 paper - function [mdr_cmi2012()] or [mdro()]:\cr
#' Ordered [`factor`] with levels `Negative` < `Multi-drug-resistant (MDR)` < `Extensively drug-resistant (XDR)` < `Pandrug-resistant (PDR)`
#' - TB guideline - function [mdr_tb()] or [`mdro(..., guideline = "TB")`][mdro()]:\cr
#' Ordered [`factor`] with levels `Negative` < `Mono-resistant` < `Poly-resistant` < `Multi-drug-resistant` < `Extensively drug-resistant`
#' - German guideline - function [mrgn()] or [`mdro(..., guideline = "MRGN")`][mdro()]:\cr
#' Ordered [`factor`] with levels `Negative` < `3MRGN` < `4MRGN`
#' - Everything else:\cr
#' Ordered [`factor`] with levels `Negative` < `Positive, unconfirmed` < `Positive`. The value `"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-11-06 14:43:23 +01:00
#' @aliases MDR XDR PDR BRMO 3MRGN 4MRGN
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-11-28 22:32:17 +01:00
#' Please see *Details* for the list of publications used for this function.
2018-04-25 15:33:58 +02:00
#' @examples
2020-05-16 21:40:50 +02:00
#' \dontrun{
2018-04-25 15:33:58 +02:00
#' library(dplyr)
2020-05-19 14:16:45 +02:00
#' library(cleaner)
2019-10-26 21:56:41 +02:00
#'
2019-11-03 22:24:42 +01:00
#' example_isolates %>%
#' mdro() %>%
2019-10-26 21:56:41 +02:00
#' freq()
#'
2019-08-27 16:45:42 +02:00
#' example_isolates %>%
2019-11-03 22:24:42 +01:00
#' mutate(EUCAST = eucast_exceptional_phenotypes(.),
2019-10-07 14:32:06 +02:00
#' BRMO = brmo(.),
#' MRGN = mrgn(.))
2019-10-26 21:56:41 +02:00
#' }
2019-05-10 16:44:59 +02:00
mdro <- function ( x ,
2019-11-28 22:32:17 +01:00
guideline = " CMI2012" ,
2018-10-23 11:15:05 +02:00
col_mo = NULL ,
2020-02-21 21:13:38 +01:00
info = interactive ( ) ,
2019-11-03 22:24:42 +01:00
pct_required_classes = 0.5 ,
2019-11-06 14:43:23 +01:00
combine_SI = TRUE ,
verbose = FALSE ,
2019-05-10 16:44:59 +02:00
... ) {
2019-11-03 22:24:42 +01:00
2020-02-14 19:54:13 +01:00
check_dataset_integrity ( )
2019-11-03 22:24:42 +01:00
if ( verbose == TRUE & interactive ( ) ) {
txt <- paste0 ( " WARNING: In Verbose mode, the mdro() function does not return the MDRO results, but instead returns a data set in logbook form with extensive info about which isolates would be MDRO-positive, or why they are not." ,
" \n\nThis may overwrite your existing data if you use e.g.:" ,
" \ndata <- mdro(data, verbose = TRUE)\n\nDo you want to continue?" )
if ( " rstudioapi" %in% rownames ( utils :: installed.packages ( ) ) ) {
2020-06-17 15:14:37 +02:00
showQuestion <- import_fn ( " showQuestion" , " rstudioapi" )
2020-05-16 21:40:50 +02:00
q_continue <- showQuestion ( " Using verbose = TRUE with mdro()" , txt )
2019-11-03 22:24:42 +01:00
} else {
2020-05-16 13:05:47 +02:00
q_continue <- utils :: menu ( choices = c ( " OK" , " Cancel" ) , graphics = FALSE , title = txt )
2019-11-03 22:24:42 +01:00
}
if ( q_continue %in% c ( FALSE , 2 ) ) {
message ( " Cancelled, returning original data" )
return ( x )
}
}
2020-06-22 11:18:40 +02:00
stop_ifnot ( is.data.frame ( x ) , " `x` must be a data.frame" )
stop_if ( any ( dim ( x ) == 0 ) , " `x` must contain rows and columns" )
2020-05-16 13:05:47 +02:00
# force regular data.frame, not a tibble or data.table
x <- as.data.frame ( x , stringsAsFactors = FALSE )
2020-06-22 11:18:40 +02:00
stop_ifnot ( is.numeric ( pct_required_classes ) , " `pct_required_classes` must be numeric" )
2019-11-03 22:24:42 +01:00
if ( pct_required_classes > 1 ) {
# allow pct_required_classes = 75 -> pct_required_classes = 0.75
pct_required_classes <- pct_required_classes / 100
}
2020-07-13 09:17:24 +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
}
2020-06-22 11:18:40 +02:00
stop_ifnot ( length ( guideline ) == 1 , " `guideline` must be of length 1" )
2019-11-03 22:24:42 +01: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"
}
2020-06-22 11:18:40 +02:00
stop_ifnot ( tolower ( guideline ) %in% c ( " brmo" , " mrgn" , " eucast" , " tb" , " cmi2012" ) ,
" invalid guideline: " , guideline )
2019-05-23 16:58:59 +02:00
guideline <- list ( code = tolower ( guideline ) )
2019-11-03 22:24:42 +01:00
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" ) {
2020-05-16 13:05:47 +02:00
message ( font_blue ( " NOTE: No column found as input for `col_mo`," ,
2020-07-13 09:17:24 +02:00
font_bold ( " assuming all records contain" , font_italic ( " Mycobacterium tuberculosis." ) ) ) )
2020-02-14 19:54:13 +01:00
x $ mo <- as.mo ( " Mycobacterium tuberculosis" )
2019-05-23 16:58:59 +02:00
col_mo <- " mo"
2018-12-22 22:39:34 +01:00
}
2020-06-22 11:18:40 +02:00
stop_if ( is.null ( col_mo ) , " `col_mo` must be set" )
2019-11-03 22:24:42 +01: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"
2019-11-18 12:10:47 +01:00
guideline $ source <- " Clinical Microbiology and Infection 18:3, 2012. DOI: 10.1111/j.1469-0691.2011.03570.x"
2019-10-26 21:56:41 +02:00
} 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-11-03 22:24:42 +01:00
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/"
2019-11-03 22:24:42 +01:00
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"
2019-11-18 12:10:47 +01:00
guideline $ source <- " Antimicrobial Resistance and Infection Control 4:7, 2015. 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-11-03 22:24:42 +01: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" ,
2019-11-05 22:23:45 +01:00
" MNO" ) ,
2019-10-26 21:56:41 +02:00
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-11-03 22:24:42 +01:00
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 ) ]
2020-06-22 11:18:40 +02:00
stop_if ( guideline $ code == " tb" & length ( abx_tb ) == 0 , " no antimycobacterials found in data set" )
2020-05-16 13:05:47 +02:00
2019-11-06 14:43:23 +01:00
if ( combine_SI == TRUE ) {
search_result <- " R"
} else {
search_result <- c ( " R" , " I" )
}
2019-10-26 21:56:41 +02:00
if ( info == TRUE ) {
2019-11-06 14:43:23 +01:00
if ( combine_SI == TRUE ) {
2020-05-16 13:05:47 +02:00
cat ( font_red ( " \nOnly results with 'R' are considered as resistance. Use `combine_SI = FALSE` to also consider 'I' as resistance.\n" ) )
2019-11-06 14:43:23 +01:00
} else {
2020-05-16 13:05:47 +02:00
cat ( font_red ( " \nResults with 'R' or 'I' are considered as resistance. Use `combine_SI = TRUE` to only consider 'R' as resistance.\n" ) )
2019-11-06 14:43:23 +01:00
}
2019-10-26 21:56:41 +02:00
cat ( " \nDetermining multidrug-resistant organisms (MDRO), according to:\n" ,
2020-05-16 13:05:47 +02:00
font_bold ( " Guideline: " ) , font_italic ( guideline $ name ) , " \n" ,
font_bold ( " Version: " ) , guideline $ version , " \n" ,
font_bold ( " Author: " ) , guideline $ author , " \n" ,
font_bold ( " Source: " ) , guideline $ source , " \n" ,
2019-10-26 21:56:41 +02:00
" \n" , sep = " " )
}
2019-11-03 22:24:42 +01: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-11-03 22:24:42 +01:00
verbose_df <- NULL
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 )
2019-11-03 22:24:42 +01:00
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 ) {
2020-05-16 13:05:47 +02:00
x [ , cols ] <- as.data.frame ( lapply ( x [ , cols , drop = FALSE ] , function ( col ) as.rsi ( col ) ) )
2019-11-05 11:28:52 +01:00
x [rows , " columns_nonsusceptible" ] <<- sapply ( rows ,
function ( row , group_vct = cols ) {
2019-11-06 14:43:23 +01:00
cols_nonsus <- sapply ( x [row , group_vct , drop = FALSE ] ,
function ( y ) y %in% search_result )
2019-11-05 11:28:52 +01:00
paste ( sort ( c ( unlist ( strsplit ( x [row , " columns_nonsusceptible" , drop = TRUE ] , " , " ) ) ,
names ( cols_nonsus ) [cols_nonsus ] ) ) ,
collapse = " , " )
} )
2019-11-06 14:43:23 +01:00
2018-11-16 20:50:50 +01:00
if ( any_all == " any" ) {
2020-05-16 13:05:47 +02:00
search_function <- any
2018-11-16 20:50:50 +01:00
} else if ( any_all == " all" ) {
2020-05-16 13:05:47 +02:00
search_function <- all
2018-11-16 20:50:50 +01:00
}
2020-07-12 11:43:31 +02:00
x_transposed <- as.list ( as.data.frame ( t ( x [ , cols , drop = FALSE ] ) ) )
row_filter <- sapply ( x_transposed , function ( y ) search_function ( y %in% search_result , na.rm = TRUE ) )
2020-07-13 09:17:24 +02:00
row_filter <- x [which ( row_filter ) , " row_number" , drop = TRUE ]
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
2019-11-05 11:28:52 +01:00
x [rows , " reason" ] <<- paste0 ( any_all , " of the required antibiotics " , ifelse ( any_all == " any" , " is" , " are" ) , " R" )
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 ) {
2020-05-16 13:05:47 +02:00
message ( font_blue ( txt , " ..." ) , appendLF = FALSE )
2019-10-30 23:02:50 +01:00
}
2019-11-03 22:24:42 +01:00
if ( length ( rows ) > 0 ) {
# function specific for the CMI paper of 2012 (Magiorakos et al.)
lst_vector <- unlist ( lst ) [ ! is.na ( unlist ( lst ) ) ]
2020-05-16 13:05:47 +02:00
x [ , lst_vector ] <- as.data.frame ( lapply ( x [ , lst_vector , drop = FALSE ] , function ( col ) as.rsi ( col ) ) )
2019-11-03 22:24:42 +01:00
x [rows , " classes_in_guideline" ] <<- length ( lst )
x [rows , " classes_available" ] <<- sapply ( rows ,
2019-11-05 11:28:52 +01:00
function ( row , group_tbl = lst ) {
sum ( sapply ( group_tbl , function ( group ) any ( unlist ( x [row , group [ ! is.na ( group ) ] , drop = TRUE ] ) %in% c ( " S" , " I" , " R" ) ) ) )
} )
if ( verbose == TRUE ) {
x [rows , " columns_nonsusceptible" ] <<- sapply ( rows ,
2020-07-13 09:17:24 +02:00
function ( row , group_vct = lst_vector ) {
cols_nonsus <- sapply ( x [row , group_vct , drop = FALSE ] , function ( y ) y %in% search_result )
paste ( sort ( names ( cols_nonsus ) [cols_nonsus ] ) , collapse = " , " )
} )
2019-11-05 11:28:52 +01:00
}
2019-11-03 22:24:42 +01:00
x [rows , " classes_affected" ] <<- sapply ( rows ,
2020-07-13 09:17:24 +02:00
function ( row , group_tbl = lst ) {
sum ( sapply ( group_tbl ,
function ( group ) {
any ( unlist ( x [row , group [ ! is.na ( group ) ] , drop = TRUE ] ) %in% search_result , na.rm = TRUE )
} ) ,
na.rm = TRUE )
} )
2019-11-06 14:43:23 +01:00
# for PDR; all agents are R (or I if combine_SI = FALSE)
2020-07-12 11:43:31 +02:00
x_transposed <- as.list ( as.data.frame ( t ( x [rows , lst_vector , drop = FALSE ] ) ) )
row_filter <- sapply ( x_transposed , function ( y ) all ( y %in% search_result , na.rm = TRUE ) )
2020-07-13 09:17:24 +02:00
x [which ( row_filter ) , " classes_affected" ] <<- 999
2019-11-03 22:24:42 +01:00
}
2019-10-30 23:02:50 +01:00
if ( info == TRUE ) {
2020-05-16 13:05:47 +02:00
message ( font_blue ( " OK" ) )
2019-10-30 23:02:50 +01:00
}
2019-10-26 21:56:41 +02:00
}
2020-05-16 13:05:47 +02:00
x [ , col_mo ] <- as.mo ( x [ , col_mo , drop = TRUE ] )
# join to microorganisms data set
x <- left_join_microorganisms ( x , by = col_mo )
x $ MDRO <- ifelse ( ! is.na ( x $ genus ) , 1 , NA_integer_ )
x $ row_number <- seq_len ( nrow ( x ) )
x $ reason <- paste0 ( " not covered by " , toupper ( guideline $ code ) , " guideline" )
x $ columns_nonsusceptible <- " "
2020-07-13 09:17:24 +02:00
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)
2019-11-03 22:24:42 +01:00
2019-10-26 21:56:41 +02:00
# take amoxicillin if ampicillin is unavailable
2019-11-03 22:24:42 +01:00
if ( is.na ( AMP ) & ! is.na ( AMX ) ) {
if ( verbose == TRUE ) {
2020-05-16 13:05:47 +02:00
message ( font_blue ( " NOTE: Filling ampicillin (AMP) results with amoxicillin (AMX) results" ) )
2019-11-03 22:24:42 +01:00
}
AMP <- AMX
}
2019-10-26 21:56:41 +02:00
# take ceftriaxone if cefotaxime is unavailable and vice versa
2019-11-03 22:24:42 +01:00
if ( is.na ( CRO ) & ! is.na ( CTX ) ) {
if ( verbose == TRUE ) {
2020-05-16 13:05:47 +02:00
message ( font_blue ( " NOTE: Filling ceftriaxone (CRO) results with cefotaxime (CTX) results" ) )
2019-11-03 22:24:42 +01:00
}
CRO <- CTX
}
if ( is.na ( CTX ) & ! is.na ( CRO ) ) {
if ( verbose == TRUE ) {
2020-05-16 13:05:47 +02:00
message ( font_blue ( " NOTE: Filling cefotaxime (CTX) results with ceftriaxone (CRO) results" ) )
2019-11-03 22:24:42 +01:00
}
CTX <- CRO
}
2019-10-26 21:56:41 +02:00
# 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" )
2019-11-03 22:24:42 +01:00
| ( x $ genus == " Providencia" & x $ species == " stuartii" ) ) , ab_NA ( c ( GEN , TOB , NET ) ) ] <- NA
2019-10-26 21:56:41 +02:00
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
2019-11-03 22:24:42 +01:00
x $ classes_in_guideline <- NA_integer_
x $ classes_available <- NA_integer_
x $ classes_affected <- NA_integer_
2019-10-26 21:56:41 +02:00
# now add the MDR levels to the data
trans_tbl ( 2 ,
which ( x $ genus == " Staphylococcus" & x $ species == " aureus" ) ,
c ( OXA , FOX ) ,
" any" )
2020-05-16 13:05:47 +02:00
trans_tbl2 ( paste ( " Table 1 -" , font_italic ( " Staphylococcus aureus" ) ) ,
2019-10-26 21:56:41 +02:00
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 ) ) )
2020-05-16 13:05:47 +02:00
trans_tbl2 ( paste ( " Table 2 -" , font_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 ) ) )
2020-05-16 13:05:47 +02:00
trans_tbl2 ( paste0 ( " Table 3 - " , font_italic ( " Enterobacteriaceae" ) ) ,
2019-10-30 23:02:50 +01:00
# 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 ) ) )
2020-05-16 13:05:47 +02:00
trans_tbl2 ( paste ( " Table 4 -" , font_italic ( " Pseudomonas aeruginosa" ) ) ,
2019-10-26 21:56:41 +02:00
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 ) ) )
2020-05-16 13:05:47 +02:00
trans_tbl2 ( paste ( " Table 5 -" , font_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-11-03 22:24:42 +01:00
# now set MDROs:
# MDR (=2): >=3 classes affected
x [which ( x $ classes_affected >= 3 ) , " MDRO" ] <- 2
if ( verbose == TRUE ) {
x [which ( x $ classes_affected >= 3 ) , " reason" ] <- paste0 ( " at least 3 classes contain R or I: " , x $ classes_affected [which ( x $ classes_affected >= 3 ) ] ,
" out of " , x $ classes_available [which ( x $ classes_affected >= 3 ) ] , " available classes" )
}
2019-11-05 11:28:52 +01:00
2019-11-03 22:24:42 +01:00
# XDR (=3): all but <=2 classes affected
x [which ( ( x $ classes_in_guideline - x $ classes_affected ) <= 2 ) , " MDRO" ] <- 3
if ( verbose == TRUE ) {
2019-11-05 11:28:52 +01:00
x [which ( x $ MDRO == 3 ) , " reason" ] <- paste0 ( " less than 3 classes remain susceptible (" , x $ classes_in_guideline [which ( ( x $ classes_in_guideline - x $ classes_affected ) <= 2 ) ] - x $ classes_affected [which ( x $ MDRO == 3 ) ] ,
2020-07-13 09:17:24 +02:00
" out of " , x $ classes_in_guideline [which ( x $ MDRO == 3 ) ] , " classes)" )
2019-11-03 22:24:42 +01:00
}
2019-11-05 11:28:52 +01:00
2019-11-03 22:24:42 +01:00
# PDR (=4): all agents are R
x [which ( x $ classes_affected == 999 & x $ classes_in_guideline == x $ classes_available ) , " MDRO" ] <- 4
if ( verbose == TRUE ) {
2019-11-05 11:28:52 +01:00
x [which ( x $ MDRO == 4 ) , " reason" ] <- paste ( " all antibiotics in all" , x $ classes_in_guideline [which ( x $ MDRO == 4 ) ] , " classes were tested R or I" )
2019-11-03 22:24:42 +01:00
}
# not enough classes available
2019-11-05 11:28:52 +01:00
x [which ( x $ MDRO %in% c ( 1 , 3 ) & x $ classes_available < base :: floor ( x $ classes_in_guideline * pct_required_classes ) ) , " MDRO" ] <- -1
2019-11-03 22:24:42 +01:00
if ( verbose == TRUE ) {
2019-11-05 11:28:52 +01:00
x [which ( x $ MDRO == -1 ) , " reason" ] <- paste0 ( " not enough classes available: " , x $ classes_available [which ( x $ MDRO == -1 ) ] ,
" of required " , ( base :: floor ( x $ classes_in_guideline * pct_required_classes ) ) [which ( x $ MDRO == -1 ) ] ,
" (~" , percentage ( pct_required_classes ) , " of " , x $ classes_in_guideline [which ( x $ MDRO == -1 ) ] , " )" )
2019-11-03 22:24:42 +01:00
}
2019-11-05 11:28:52 +01:00
# add antibiotic names of resistant ones to verbose output
2019-10-26 21:56:41 +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-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-11-03 22:24:42 +01: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
}
2019-11-03 22:24:42 +01: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-11-03 22:24:42 +01:00
x $ fullname %like% " ^Acinetobacter baumannii" ) &
2019-10-07 14:32:06 +02:00
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-11-03 22:24:42 +01: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 )
}
2019-11-03 22:24:42 +01:00
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" )
2019-11-03 22:24:42 +01:00
2018-11-16 20:50:50 +01: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
carbapenems ,
2018-11-16 20:50:50 +01:00
" any" )
2019-11-03 22:24:42 +01: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" )
2019-11-03 22:24:42 +01:00
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" )
2019-11-03 22:24:42 +01: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" )
2019-11-03 22:24:42 +01: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"
2019-11-05 22:23:45 +01:00
& x $ psae >= 3 ) , " MDRO" ] <- 3
2019-11-03 22:24:42 +01:00
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-11-03 22:24:42 +01:00
2020-05-16 13:05:47 +02:00
if ( guideline $ code == " tb" ) {
# Tuberculosis ------------------------------------------------------------
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 <- x [ , ab , drop = TRUE ]
}
2019-05-23 16:58:59 +02:00
}
2020-05-16 13:05:47 +02:00
ab <- as.character ( as.rsi ( ab ) )
ab [is.na ( ab ) ] <- " "
ab
2019-05-23 16:58:59 +02:00
}
2020-05-16 13:05:47 +02:00
drug_is_R <- function ( ab ) {
# returns logical vector
ab <- prepare_drug ( ab )
if ( length ( ab ) == 0 ) {
rep ( FALSE , NROW ( x ) )
} else if ( length ( ab ) == 1 ) {
rep ( ab , NROW ( x ) ) == " R"
} else {
ab == " R"
}
2019-05-23 16:58:59 +02:00
}
2020-05-16 13:05:47 +02:00
drug_is_not_R <- function ( ab ) {
# returns logical vector
ab <- prepare_drug ( ab )
if ( length ( ab ) == 0 ) {
rep ( TRUE , NROW ( x ) )
} else if ( length ( ab ) == 1 ) {
rep ( ab , NROW ( x ) ) != " R"
} else {
ab != " R"
}
2019-05-23 16:58:59 +02:00
}
2020-07-13 09:17:24 +02:00
2020-05-16 13:05:47 +02:00
x $ mono_count <- 0
2020-07-22 10:24:23 +02:00
x [drug_is_R ( INH ) , " mono_count" ] <- x [drug_is_R ( INH ) , " mono_count" , drop = TRUE ] + 1
x [drug_is_R ( RIF ) , " mono_count" ] <- x [drug_is_R ( RIF ) , " mono_count" , drop = TRUE ] + 1
x [drug_is_R ( ETH ) , " mono_count" ] <- x [drug_is_R ( ETH ) , " mono_count" , drop = TRUE ] + 1
x [drug_is_R ( PZA ) , " mono_count" ] <- x [drug_is_R ( PZA ) , " mono_count" , drop = TRUE ] + 1
x [drug_is_R ( RIB ) , " mono_count" ] <- x [drug_is_R ( RIB ) , " mono_count" , drop = TRUE ] + 1
x [drug_is_R ( RFP ) , " mono_count" ] <- x [drug_is_R ( RFP ) , " mono_count" , drop = TRUE ] + 1
2020-05-16 13:05:47 +02:00
x $ mono <- x $ mono_count > 0
x $ poly <- x $ mono_count > 1 & drug_is_not_R ( RIF ) & drug_is_not_R ( INH )
x $ mdr <- drug_is_R ( RIF ) & drug_is_R ( INH )
x $ xdr <- drug_is_R ( LVX ) | drug_is_R ( MFX ) | drug_is_R ( GAT )
x $ second <- drug_is_R ( CAP ) | drug_is_R ( KAN ) | drug_is_R ( AMK )
x $ xdr <- x $ mdr & x $ xdr & x $ second
x $ MDRO <- ifelse ( x $ xdr , 5 ,
ifelse ( x $ mdr , 4 ,
ifelse ( x $ poly , 3 ,
ifelse ( x $ mono , 2 ,
1 ) ) ) )
# keep all real TB, make other species NA
x $ MDRO <- ifelse ( x $ fullname == " Mycobacterium tuberculosis" , x $ MDRO , NA_real_ )
2019-10-26 21:56:41 +02:00
}
if ( info == TRUE ) {
2020-05-16 13:05:47 +02:00
if ( sum ( ! is.na ( x $ MDRO ) == 0 ) ) {
cat ( font_bold ( paste0 ( " => Found 0 MDROs since no isolates are covered by the guideline" ) ) )
} else {
cat ( font_bold ( paste0 ( " => Found " , sum ( x $ MDRO %in% c ( 2 : 5 ) , na.rm = TRUE ) , " MDROs out of " , sum ( ! is.na ( x $ MDRO ) ) ,
" isolates (" , trimws ( percentage ( sum ( x $ MDRO %in% c ( 2 : 5 ) , na.rm = TRUE ) / sum ( ! is.na ( x $ MDRO ) ) ) ) , " )\n" ) ) )
}
2019-05-23 16:58:59 +02:00
}
2019-11-03 22:24:42 +01:00
2019-11-05 11:28:52 +01:00
# some more info on negative results
2019-11-05 22:23:45 +01:00
if ( verbose == TRUE ) {
2019-11-05 11:28:52 +01:00
if ( guideline $ code == " cmi2012" ) {
2020-07-13 09:17:24 +02:00
x [which ( x $ MDRO == 1 & ! is.na ( x $ classes_affected ) ) , " reason" ] <- paste0 ( x $ classes_affected [which ( x $ MDRO == 1 & ! is.na ( x $ classes_affected ) ) ] , " of " , x $ classes_available [which ( x $ MDRO == 1 & ! is.na ( x $ classes_affected ) ) ] , " available classes contain R or I (3 required for MDR)" )
2019-11-05 11:28:52 +01:00
} else {
x [which ( x $ MDRO == 1 ) , " reason" ] <- " too few antibiotics are R"
}
}
2019-11-03 22:24:42 +01:00
# Results ----
2019-10-26 21:56:41 +02:00
if ( guideline $ code == " cmi2012" ) {
2019-11-04 11:35:34 +01:00
if ( any ( x $ MDRO == -1 , na.rm = TRUE ) ) {
2019-11-03 22:24:42 +01:00
warning ( " NA introduced for isolates where the available percentage of antimicrobial classes was below " ,
percentage ( pct_required_classes ) , " (set with `pct_required_classes`)" )
# set these -1s to NA
x [which ( x $ MDRO == -1 ) , " MDRO" ] <- NA_integer_
}
x $ MDRO <- factor ( x = x $ MDRO ,
levels = 1 : 4 ,
labels = c ( " Negative" , " Multi-drug-resistant (MDR)" ,
" Extensively drug-resistant (XDR)" , " Pandrug-resistant (PDR)" ) ,
ordered = TRUE )
2019-10-26 21:56:41 +02:00
} else if ( guideline $ code == " tb" ) {
2019-11-03 22:24:42 +01:00
x $ MDRO <- factor ( x = x $ MDRO ,
levels = 1 : 5 ,
labels = c ( " Negative" , " Mono-resistant" , " Poly-resistant" ,
" Multi-drug-resistant" , " Extensively drug-resistant" ) ,
ordered = TRUE )
2019-10-07 14:32:06 +02:00
} else if ( guideline $ code == " mrgn" ) {
2019-11-03 22:24:42 +01:00
x $ MDRO <- factor ( x = x $ MDRO ,
levels = 1 : 3 ,
labels = c ( " Negative" , " 3MRGN" , " 4MRGN" ) ,
ordered = TRUE )
2019-05-23 16:58:59 +02:00
} else {
2019-11-03 22:24:42 +01:00
x $ MDRO <- factor ( x = x $ MDRO ,
levels = 1 : 3 ,
labels = c ( " Negative" , " Positive, unconfirmed" , " Positive" ) ,
ordered = TRUE )
2019-05-23 16:58:59 +02:00
}
2019-11-03 22:24:42 +01:00
if ( verbose == TRUE ) {
x [ , c ( " row_number" ,
col_mo ,
" MDRO" ,
2019-11-05 11:28:52 +01:00
" reason" ,
" columns_nonsusceptible" ) ]
#x
2019-11-03 22:24:42 +01:00
} else {
x $ MDRO
}
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
}