mirror of
https://github.com/msberends/AMR.git
synced 2025-07-08 11:11:54 +02:00
EUCAST rules for MDRO
This commit is contained in:
84
R/atc.R
84
R/atc.R
@ -367,3 +367,87 @@ guess_bactid <- function(x) {
|
||||
}
|
||||
x
|
||||
}
|
||||
|
||||
#' Find ATC code based on antibiotic property
|
||||
#'
|
||||
#' Use this function to determine the ATC code of one or more antibiotics. The dataset \code{\link{antibiotics}} will be searched for abbreviations, official names and trade names.
|
||||
#' @param x character vector to determine \code{ATC} code
|
||||
#' @export
|
||||
#' @importFrom dplyr %>% filter slice pull
|
||||
#' @details In the ATC classification system, the active substances are classified in a hierarchy with five different levels. The system has fourteen main anatomical/pharmacological groups or 1st levels. Each ATC main group is divided into 2nd levels which could be either pharmacological or therapeutic groups. The 3rd and 4th levels are chemical, pharmacological or therapeutic subgroups and the 5th level is the chemical substance. The 2nd, 3rd and 4th levels are often used to identify pharmacological subgroups when that is considered more appropriate than therapeutic or chemical subgroups.
|
||||
#' Source: \url{https://www.whocc.no/atc/structure_and_principles/}
|
||||
#' @return Character (vector).
|
||||
#' @seealso \code{\link{antibiotics}} for the dataframe that is being used to determine ATC's.
|
||||
#' @examples
|
||||
#' # These examples all return "J01FA01", the ATC code of Erythromycin:
|
||||
#' guess_atc("J01FA01")
|
||||
#' guess_atc("Erythromycin")
|
||||
#' guess_atc("eryt")
|
||||
#' guess_atc("ERYT")
|
||||
#' guess_atc("ERY")
|
||||
#' guess_atc("Erythrocin") # Trade name
|
||||
#' guess_atc("Eryzole") # Trade name
|
||||
#' guess_atc("Pediamycin") # Trade name
|
||||
guess_atc <- function(x) {
|
||||
|
||||
# use this later to further fill AMR::antibiotics
|
||||
|
||||
# drug <- "Ciprofloxacin"
|
||||
# url <- xml2::read_html(paste0("https://www.ncbi.nlm.nih.gov/pccompound?term=", drug)) %>%
|
||||
# html_nodes(".rslt") %>%
|
||||
# .[[1]] %>%
|
||||
# html_nodes(".title a") %>%
|
||||
# html_attr("href") %>%
|
||||
# gsub("/compound/", "/rest/pug_view/data/compound/", ., fixed = TRUE) %>%
|
||||
# paste0("/XML/?response_type=display")
|
||||
# synonyms <- url %>%
|
||||
# read_xml() %>%
|
||||
# xml_contents() %>% .[[6]] %>%
|
||||
# xml_contents() %>% .[[8]] %>%
|
||||
# xml_contents() %>% .[[3]] %>%
|
||||
# xml_contents() %>% .[[3]] %>%
|
||||
# xml_contents() %>%
|
||||
# paste() %>%
|
||||
# .[. %like% "StringValueList"] %>%
|
||||
# gsub("[</]+StringValueList[>]", "", .)
|
||||
|
||||
|
||||
for (i in 1:length(x)) {
|
||||
|
||||
# first try atc
|
||||
found <- AMR::antibiotics %>% filter(atc == x[i])
|
||||
|
||||
if (nrow(found) == 0) {
|
||||
# try abbreviation of molis and glims
|
||||
found <- AMR::antibiotics %>% filter(molis == x[i] | umcg == x[i])
|
||||
}
|
||||
|
||||
if (nrow(found) == 0) {
|
||||
# try exact official name
|
||||
found <- AMR::antibiotics[which(AMR::antibiotics$official == x[i]),]
|
||||
}
|
||||
|
||||
if (nrow(found) == 0) {
|
||||
# try trade name
|
||||
found <- AMR::antibiotics[which(paste0("(", AMR::antibiotics$trade_name, ")") %like% x[i]),]
|
||||
}
|
||||
|
||||
if (nrow(found) == 0) {
|
||||
# try abbreviation
|
||||
found <- AMR::antibiotics[which(paste0("(", AMR::antibiotics$abbr, ")") %like% x[i]),]
|
||||
}
|
||||
# if (nrow(found) == 0) {
|
||||
# # loosely try official name
|
||||
# found <- AMR::antibiotics[which(AMR::antibiotics$official %like% x[i]),]
|
||||
# }
|
||||
|
||||
if (nrow(found) != 0) {
|
||||
x[i] <- found %>%
|
||||
slice(1) %>%
|
||||
pull(atc)
|
||||
} else {
|
||||
x[i] <- NA
|
||||
}
|
||||
}
|
||||
x
|
||||
}
|
||||
|
23
R/classes.R
23
R/classes.R
@ -21,7 +21,7 @@
|
||||
#' This transforms a vector to a new class \code{rsi}, which is an ordered factor with levels \code{S < I < R}. Invalid antimicrobial interpretations will be translated as \code{NA} with a warning.
|
||||
#' @rdname as.rsi
|
||||
#' @param x vector
|
||||
#' @return New class \code{rsi}
|
||||
#' @return Ordered factor with new class \code{rsi} and new attributes \code{package} and \code{package.version}
|
||||
#' @export
|
||||
#' @importFrom dplyr %>%
|
||||
#' @importFrom utils packageDescription
|
||||
@ -92,20 +92,13 @@ print.rsi <- function(x, ...) {
|
||||
I <- x[x == 'I'] %>% length()
|
||||
R <- x[x == 'R'] %>% length()
|
||||
IR <- x[x %in% c('I', 'R')] %>% length()
|
||||
cat("Class 'rsi': ", n, " isolates\n", sep = '')
|
||||
cat("Class 'rsi'\n")
|
||||
cat(n, " results (missing: ", n_total - n, ' = ', percent((n_total - n) / n, force_zero = TRUE), ')\n', sep = "")
|
||||
cat('\n')
|
||||
cat('<NA>: ', n_total - n, '\n')
|
||||
cat('Sum of S: ', S, '\n')
|
||||
cat('Sum of IR: ', IR, '\n')
|
||||
cat('- Sum of R:', R, '\n')
|
||||
cat('- Sum of I:', I, '\n')
|
||||
cat('\n')
|
||||
print(c(
|
||||
`%S` = round((S / n) * 100, 1),
|
||||
`%IR` = round((IR / n) * 100, 1),
|
||||
`%I` = round((I / n) * 100, 1),
|
||||
`%R` = round((R / n) * 100, 1)
|
||||
))
|
||||
cat('Sum of S: ', S, ' (', percent(S / n, force_zero = TRUE), ')\n', sep = "")
|
||||
cat('Sum of IR: ', IR, ' (', percent(IR / n, force_zero = TRUE), ')\n', sep = "")
|
||||
cat('- Sum of R: ', R, ' (', percent(R / n, force_zero = TRUE), ')\n', sep = "")
|
||||
cat('- Sum of I: ', I, ' (', percent(I / n, force_zero = TRUE), ')\n', sep = "")
|
||||
}
|
||||
|
||||
#' @exportMethod summary.rsi
|
||||
@ -197,7 +190,7 @@ barplot.rsi <- function(height, ...) {
|
||||
#' @rdname as.mic
|
||||
#' @param x vector
|
||||
#' @param na.rm a logical indicating whether missing values should be removed
|
||||
#' @return New class \code{mic}
|
||||
#' @return Ordered factor with new class \code{mic} and new attributes \code{package} and \code{package.version}
|
||||
#' @export
|
||||
#' @importFrom dplyr %>%
|
||||
#' @importFrom utils packageDescription
|
||||
|
173
R/data.R
173
R/data.R
@ -24,9 +24,11 @@
|
||||
#' \item{\code{atc}}{ATC code, like \code{J01CR02}}
|
||||
#' \item{\code{molis}}{MOLIS code, like \code{amcl}}
|
||||
#' \item{\code{umcg}}{UMCG code, like \code{AMCL}}
|
||||
#' \item{\code{abbr}}{Abbreviation as used by many countries, to be used for \code{\link{guess_atc}}}
|
||||
#' \item{\code{official}}{Official name by the WHO, like \code{"Amoxicillin and enzyme inhibitor"}}
|
||||
#' \item{\code{official_nl}}{Official name in the Netherlands, like \code{"Amoxicilline met enzymremmer"}}
|
||||
#' \item{\code{trivial_nl}}{Trivial name in Dutch, like \code{"Amoxicilline/clavulaanzuur"}}
|
||||
#' \item{\code{trade_name}}{Trade name as used by many countries, to be used for \code{\link{guess_atc}}}
|
||||
#' \item{\code{oral_ddd}}{Defined Daily Dose (DDD), oral treatment}
|
||||
#' \item{\code{oral_units}}{Units of \code{ddd_units}}
|
||||
#' \item{\code{iv_ddd}}{Defined Daily Dose (DDD), parenteral treatment}
|
||||
@ -40,6 +42,177 @@
|
||||
#' }
|
||||
#' @source - World Health Organization: \url{https://www.whocc.no/atc_ddd_index/} \cr - EUCAST - Expert rules intrinsic exceptional V3.1 \cr - MOLIS (LIS of Certe): \url{https://www.certe.nl} \cr - GLIMS (LIS of UMCG): \url{https://www.umcg.nl}
|
||||
#' @seealso \code{\link{microorganisms}}
|
||||
# abbr and trade_name created with:
|
||||
# https://hs.unr.edu/Documents/dhs/chs/NVPHTC/antibiotic_refeference_guide.pdf
|
||||
# antibiotics %>%
|
||||
# mutate(abbr =
|
||||
# case_when(
|
||||
# official == 'Amikacin' ~ 'Ak|AN|AMI|AMK',
|
||||
# official == 'Amoxicillin' ~ 'AMX|AMOX|AC',
|
||||
# official == 'Amoxicillin and beta-lactamase inhibitor' ~ 'AUG|A/C|XL|AML',
|
||||
# official == 'Ampicillin' ~ 'AM|AMP',
|
||||
# official == 'Ampicillin and beta-lactamase inhibitor' ~ 'A/S|SAM|AMS|AB',
|
||||
# official == 'Azithromycin' ~ 'Azi|AZM|AZ',
|
||||
# official == 'Azlocillin' ~ 'AZ|AZL',
|
||||
# official == 'Aztreonam' ~ 'Azt|ATM|AT|AZM',
|
||||
# official == 'Carbenicillin' ~ 'Cb|BAR',
|
||||
# official == 'Cefaclor' ~ 'Ccl|CEC|Cfr|FAC|CF',
|
||||
# official == 'Cefadroxil' ~ 'CFR|FAD',
|
||||
# official == 'Cefazolin' ~ 'Cfz|CZ|FAZ|KZ',
|
||||
# official == 'Cefdinir' ~ 'Cdn|CDR|DIN|CD|CFD',
|
||||
# official == 'Cefditoren' ~ 'CDN',
|
||||
# official == 'Cefepime' ~ 'Cpe|FEP|PM|CPM',
|
||||
# official == 'Cefixime' ~ 'Cfe|DCFM|FIX|IX',
|
||||
# official == 'Cefoperazone' ~ 'Cfp|CPZ|PER|FOP|CP',
|
||||
# official == 'Cefotaxime' ~ 'Cft|CTX|TAX|FOT|CT',
|
||||
# official == 'Cefotetan' ~ 'Ctn|CTT|CTE|TANS|CN',
|
||||
# official == 'Cefoxitin' ~ 'Cfx|FOX|CX|FX',
|
||||
# official == 'Cefpodoxime' ~ 'Cpd|POD|PX',
|
||||
# official == 'Cefprozil' ~ 'Cpz|CPR|FP',
|
||||
# official == 'Ceftaroline' ~ 'CPT',
|
||||
# official == 'Ceftazidime' ~ 'Caz|TAZ|TZ',
|
||||
# official == 'Ceftibuten' ~ 'CTB|TIB|CB',
|
||||
# official == 'Ceftizoxime' ~ 'Cz|ZOX|CZX|CZ|CTZ|TIZ',
|
||||
# official == 'Ceftriaxone' ~ 'Cax|CRO|CTR|FRX|AXO|TX',
|
||||
# official == 'Cefuroxime' ~ 'Crm|CXM|CFX|ROX|FUR|XM',
|
||||
# official == 'Cephalexin' ~ 'CN|LX|CFL',
|
||||
# official == 'Cephalothin' ~ 'Cf',
|
||||
# official == 'Chloramphenicol' ~ 'C|CHL|CL',
|
||||
# official == 'Ciprofloxacin' ~ 'Cp|CIP|CI',
|
||||
# official == 'Clarithromycin' ~ 'Cla|CLR|CLM|CH',
|
||||
# official == 'Clindamycin' ~ 'Cd|CC|CM|CLI|DA',
|
||||
# official == 'Colistin' ~ 'CL|CS|CT',
|
||||
# official == 'Daptomycin' ~ 'Dap',
|
||||
# official == 'Doxycycline' ~ 'Dox',
|
||||
# official == 'Doripenem' ~ 'DOR|Dor',
|
||||
# official == 'Ertapenem' ~ 'Etp',
|
||||
# official == 'Erythromycin' ~ 'E|ERY|EM',
|
||||
# official == 'Fosfomycin' ~ 'FOS|FF|FO|FM',
|
||||
# official == 'Flucloxacillin' ~ 'CLOX',
|
||||
# official == 'Gentamicin' ~ 'Gm|CN|GEN',
|
||||
# official == 'Imipenem' ~ 'Imp|IPM|IMI|IP',
|
||||
# official == 'Kanamycin' ~ 'K|KAN|HLK|KM',
|
||||
# official == 'Levofloxacin' ~ 'Lvx|LEV|LEVO|LE',
|
||||
# official == 'Linezolid' ~ 'Lzd|LNZ|LZ',
|
||||
# official == 'Lomefloxacin' ~ 'Lmf|LOM',
|
||||
# official == 'Meropenem' ~ 'Mer|MEM|MERO|MRP|MP',
|
||||
# official == 'Metronidazole' ~ 'MNZ',
|
||||
# official == 'Mezlocillin' ~ 'Mz|MEZ',
|
||||
# official == 'Minocycline' ~ 'Min|MI|MN|MNO|MC|MH',
|
||||
# official == 'Moxifloxacin' ~ 'Mox|MXF',
|
||||
# official == 'Mupirocin' ~ 'MUP',
|
||||
# official == 'Nafcillin' ~ 'Naf|NF',
|
||||
# official == 'Nalidixic acid' ~ 'NA|NAL',
|
||||
# official == 'Nitrofurantoin' ~ 'Fd|F/M|FT|NIT|NI|F',
|
||||
# official == 'Norfloxacin' ~ 'Nxn|NOR|NX',
|
||||
# official == 'Ofloxacin' ~ 'Ofl|OFX|OF',
|
||||
# official == 'Oxacillin' ~ 'Ox|OXS|OXA',
|
||||
# official == 'Benzylpenicillin' ~ 'P|PEN|PV',
|
||||
# official == 'Penicillins, combinations with other antibacterials' ~ 'P|PEN|PV',
|
||||
# official == 'Piperacillin' ~ 'Pi|PIP|PP',
|
||||
# official == 'Piperacillin and beta-lactamase inhibitor' ~ 'PT|TZP|PTZ|P/T|PTc',
|
||||
# official == 'Polymyxin B' ~ 'PB',
|
||||
# official == 'Quinupristin/dalfopristin' ~ 'Syn|Q/D|QDA|RP',
|
||||
# official == 'Rifampin' ~ 'Rif|RA|RI|RD',
|
||||
# official == 'Spectinomycin' ~ 'SPT|SPE|SC',
|
||||
# official == 'Streptomycin' ~ 'S|STR',
|
||||
# official == 'Teicoplanin' ~ 'Tei|TEC|TPN|TP|TPL',
|
||||
# official == 'Telavancin' ~ 'TLV',
|
||||
# official == 'Telithromcyin' ~ 'Tel',
|
||||
# official == 'Tetracycline' ~ 'Te|TET|TC',
|
||||
# official == 'Ticarcillin' ~ 'Ti|TIC|TC',
|
||||
# official == 'Ticarcillin and beta-lactamase inhibitor' ~ 'Tim|T/C|TCC|TLc',
|
||||
# official == 'Tigecycline' ~ 'TGC',
|
||||
# official == 'Tobramycin' ~ 'To|NN|TM|TOB',
|
||||
# official == 'Trimethoprim' ~ 'T|TMP|TR|W',
|
||||
# official == 'Sulfamethoxazole and trimethoprim' ~ 'T/S|SXT|SxT|TS|COT',
|
||||
# official == 'Vancomycin' ~ 'Va|VAN',
|
||||
# TRUE ~ NA_character_),
|
||||
#
|
||||
# trade_name =
|
||||
# case_when(
|
||||
# official == 'Amikacin' ~ 'Amikin',
|
||||
# official == 'Amoxicillin' ~ 'Amoxil|Dispermox|Larotid|Trimox',
|
||||
# official == 'Amoxicillin and beta-lactamase inhibitor' ~ 'Augmentin',
|
||||
# official == 'Ampicillin' ~ 'Pfizerpen-A|Principen',
|
||||
# official == 'Ampicillin and beta-lactamase inhibitor' ~ 'Unasyn',
|
||||
# official == 'Azithromycin' ~ 'Zithromax',
|
||||
# official == 'Azlocillin' ~ 'Azlin',
|
||||
# official == 'Aztreonam' ~ 'Azactam',
|
||||
# official == 'Carbenicillin' ~ 'Geocillin',
|
||||
# official == 'Cefaclor' ~ 'Ceclor',
|
||||
# official == 'Cefadroxil' ~ 'Duricef',
|
||||
# official == 'Cefazolin' ~ 'Ancef',
|
||||
# official == 'Cefdinir' ~ 'Omnicef',
|
||||
# official == 'Cefditoren' ~ 'Spectracef',
|
||||
# official == 'Cefepime' ~ 'Maxipime',
|
||||
# official == 'Cefixime' ~ 'Suprax',
|
||||
# official == 'Cefoperazone' ~ 'Cefobid',
|
||||
# official == 'Cefotaxime' ~ 'Claforan',
|
||||
# official == 'Cefotetan' ~ 'Cefotan',
|
||||
# official == 'Cefoxitin' ~ 'Mefoxin',
|
||||
# official == 'Cefpodoxime' ~ 'Vantin',
|
||||
# official == 'Cefprozil' ~ 'Cefzil',
|
||||
# official == 'Ceftaroline' ~ 'Teflaro',
|
||||
# official == 'Ceftazidime' ~ 'Fortaz|Tazicef|Tazidime',
|
||||
# official == 'Ceftibuten' ~ 'Cedax',
|
||||
# official == 'Ceftizoxime' ~ 'Cefizox',
|
||||
# official == 'Ceftriaxone' ~ 'Rocephin',
|
||||
# official == 'Cefuroxime' ~ 'Ceftin|Zinacef',
|
||||
# official == 'Cephalexin' ~ 'Keflex|Panixine',
|
||||
# official == 'Cephalothin' ~ 'Keflin',
|
||||
# official == 'Chloramphenicol' ~ 'Chloromycetin',
|
||||
# official == 'Ciprofloxacin' ~ 'Cipro|Ciloxan|Ciproxin',
|
||||
# official == 'Clarithromycin' ~ 'Biaxin',
|
||||
# official == 'Clindamycin' ~ 'Cleocin|Clinda-Derm|Clindagel|Clindesse|Clindets|Evoclin',
|
||||
# official == 'Colistin' ~ 'Coly-Mycin',
|
||||
# official == 'Daptomycin' ~ 'Cubicin',
|
||||
# official == 'Doxycycline' ~ 'Doryx|Monodox|Vibramycin|Atridox|Oracea|Periostat|Vibra-Tabs',
|
||||
# official == 'Doripenem' ~ 'Doribax',
|
||||
# official == 'Ertapenem' ~ 'Invanz',
|
||||
# official == 'Erythromycin' ~ 'Eryc|EryPed|Erythrocin|E-Base|E-Glades|E-Mycin|E.E.S.|Ery-Tab|Eryderm|Erygel|Erythra-derm|Eryzole|Pediamycin',
|
||||
# official == 'Fosfomycin' ~ 'Monurol',
|
||||
# official == 'Flucloxacillin' ~ 'Flopen|Floxapen|Fluclox|Sesamol|Softapen|Staphylex',
|
||||
# official == 'Gentamicin' ~ 'Garamycin|Genoptic',
|
||||
# official == 'Imipenem' ~ 'Primaxin',
|
||||
# official == 'Kanamycin' ~ 'Kantrex',
|
||||
# official == 'Levofloxacin' ~ 'Levaquin|Quixin',
|
||||
# official == 'Linezolid' ~ 'Zyvox',
|
||||
# official == 'Lomefloxacin' ~ 'Maxaquin',
|
||||
# official == 'Meropenem' ~ 'Merrem',
|
||||
# official == 'Metronidazole' ~ 'Flagyl|MetroGel|MetroCream|MetroLotion',
|
||||
# official == 'Mezlocillin' ~ 'Mezlin',
|
||||
# official == 'Minocycline' ~ 'Arestin|Solodyn',
|
||||
# official == 'Moxifloxacin' ~ 'Avelox|Vigamox',
|
||||
# official == 'Mupirocin' ~ 'Bactroban|Centany',
|
||||
# official == 'Nafcillin' ~ 'Unipen',
|
||||
# official == 'Nalidixic acid' ~ 'NegGram',
|
||||
# official == 'Nitrofurantoin' ~ 'Furadantin|Macrobid|Macrodantin',
|
||||
# official == 'Norfloxacin' ~ 'Noroxin',
|
||||
# official == 'Ofloxacin' ~ 'Floxin|Ocuflox|Ophthalmic',
|
||||
# official == 'Oxacillin' ~ 'Bactocill',
|
||||
# official == 'Benzylpenicillin' ~ 'Permapen|Pfizerpen|Veetids',
|
||||
# official == 'Penicillins, combinations with other antibacterials' ~ 'Permapen|Pfizerpen|Veetids',
|
||||
# official == 'Piperacillin' ~ 'Pipracil',
|
||||
# official == 'Piperacillin and beta-lactamase inhibitor' ~ 'Zosyn',
|
||||
# official == 'Polymyxin B' ~ 'Poly-RX',
|
||||
# official == 'Quinupristin/dalfopristin' ~ 'Synercid',
|
||||
# official == 'Rifampin' ~ 'Rifadin|Rifamate|Rimactane',
|
||||
# official == 'Spectinomycin' ~ 'Trobicin',
|
||||
# official == 'Streptomycin' ~ 'Streptomycin Sulfate',
|
||||
# official == 'Teicoplanin' ~ 'Targocid',
|
||||
# official == 'Telavancin' ~ 'Vibativ',
|
||||
# official == 'Telithromcyin' ~ 'Ketek',
|
||||
# official == 'Tetracycline' ~ 'Sumycin|Bristacycline|Tetrex',
|
||||
# official == 'Ticarcillin' ~ 'Ticar',
|
||||
# official == 'Ticarcillin and beta-lactamase inhibitor' ~ 'Timentin',
|
||||
# official == 'Tigecycline' ~ 'Tygacil',
|
||||
# official == 'Tobramycin' ~ 'Tobi|Aktob|Tobre',
|
||||
# official == 'Trimethoprim' ~ 'Primsol|Proloprim',
|
||||
# official == 'Sulfamethoxazole and trimethoprim' ~ 'Bactrim|Septra|Sulfatrim',
|
||||
# official == 'Vancomycin' ~ 'Vancocin|Vancomycin Hydrochloride',
|
||||
# TRUE ~ NA_character_)
|
||||
# )
|
||||
# last two columns created with:
|
||||
# antibiotics %>%
|
||||
# mutate(useful_gramnegative =
|
||||
|
143
R/eucast.R
143
R/eucast.R
@ -116,7 +116,7 @@ EUCAST_rules <- function(tbl,
|
||||
EUCAST_VERSION <- "3.1"
|
||||
|
||||
if (!col_bactid %in% colnames(tbl)) {
|
||||
stop('Column ', col_bactid, ' not found.')
|
||||
stop('Column ', col_bactid, ' not found.', call. = FALSE)
|
||||
}
|
||||
|
||||
# check columns
|
||||
@ -126,88 +126,65 @@ EUCAST_rules <- function(tbl,
|
||||
levo, linc, line, mero, mino, moxi, nali, neom, neti, nitr,
|
||||
novo, norf, oflo, peni, pita, poly, qida, rifa, roxi, siso,
|
||||
teic, tetr, tica, tige, tobr, trim, trsu, vanc)
|
||||
col.list <- col.list[!is.na(col.list)]
|
||||
col.list.bak <- col.list
|
||||
# are they available as upper case or lower case then?
|
||||
for (i in 1:length(col.list)) {
|
||||
if (toupper(col.list[i]) %in% colnames(tbl)) {
|
||||
col.list[i] <- toupper(col.list[i])
|
||||
} else if (tolower(col.list[i]) %in% colnames(tbl)) {
|
||||
col.list[i] <- tolower(col.list[i])
|
||||
} else if (!col.list[i] %in% colnames(tbl)) {
|
||||
col.list[i] <- NA
|
||||
}
|
||||
}
|
||||
if (!all(col.list %in% colnames(tbl))) {
|
||||
if (info == TRUE) {
|
||||
cat('\n')
|
||||
}
|
||||
if (info == TRUE) {
|
||||
warning('These columns do not exist and will be ignored: ',
|
||||
col.list.bak[!(col.list %in% colnames(tbl))] %>% toString(),
|
||||
immediate. = TRUE,
|
||||
call. = FALSE)
|
||||
}
|
||||
}
|
||||
|
||||
amcl <- col.list[1]
|
||||
amik <- col.list[2]
|
||||
amox <- col.list[3]
|
||||
ampi <- col.list[4]
|
||||
azit <- col.list[5]
|
||||
aztr <- col.list[6]
|
||||
cefa <- col.list[7]
|
||||
cfra <- col.list[8]
|
||||
cfep <- col.list[9]
|
||||
cfot <- col.list[10]
|
||||
cfox <- col.list[11]
|
||||
cfta <- col.list[12]
|
||||
cftr <- col.list[13]
|
||||
cfur <- col.list[14]
|
||||
chlo <- col.list[15]
|
||||
cipr <- col.list[16]
|
||||
clar <- col.list[17]
|
||||
clin <- col.list[18]
|
||||
clox <- col.list[19]
|
||||
coli <- col.list[20]
|
||||
czol <- col.list[21]
|
||||
dapt <- col.list[22]
|
||||
doxy <- col.list[23]
|
||||
erta <- col.list[24]
|
||||
eryt <- col.list[25]
|
||||
fosf <- col.list[26]
|
||||
fusi <- col.list[27]
|
||||
gent <- col.list[28]
|
||||
imip <- col.list[29]
|
||||
kana <- col.list[30]
|
||||
levo <- col.list[31]
|
||||
linc <- col.list[32]
|
||||
line <- col.list[33]
|
||||
mero <- col.list[34]
|
||||
mino <- col.list[35]
|
||||
moxi <- col.list[36]
|
||||
nali <- col.list[37]
|
||||
neom <- col.list[38]
|
||||
neti <- col.list[39]
|
||||
nitr <- col.list[40]
|
||||
novo <- col.list[41]
|
||||
norf <- col.list[42]
|
||||
oflo <- col.list[43]
|
||||
peni <- col.list[44]
|
||||
pita <- col.list[45]
|
||||
poly <- col.list[46]
|
||||
qida <- col.list[47]
|
||||
rifa <- col.list[48]
|
||||
roxi <- col.list[49]
|
||||
siso <- col.list[50]
|
||||
teic <- col.list[51]
|
||||
tetr <- col.list[52]
|
||||
tica <- col.list[53]
|
||||
tige <- col.list[54]
|
||||
tobr <- col.list[55]
|
||||
trim <- col.list[56]
|
||||
trsu <- col.list[57]
|
||||
vanc <- col.list[58]
|
||||
col.list <- check_available_columns(tbl = tbl, col.list = col.list, info = info)
|
||||
amcl <- col.list[amcl]
|
||||
amik <- col.list[amik]
|
||||
amox <- col.list[amox]
|
||||
ampi <- col.list[ampi]
|
||||
azit <- col.list[azit]
|
||||
aztr <- col.list[aztr]
|
||||
cefa <- col.list[cefa]
|
||||
cfra <- col.list[cfra]
|
||||
cfep <- col.list[cfep]
|
||||
cfot <- col.list[cfot]
|
||||
cfox <- col.list[cfox]
|
||||
cfta <- col.list[cfta]
|
||||
cftr <- col.list[cftr]
|
||||
cfur <- col.list[cfur]
|
||||
chlo <- col.list[chlo]
|
||||
cipr <- col.list[cipr]
|
||||
clar <- col.list[clar]
|
||||
clin <- col.list[clin]
|
||||
clox <- col.list[clox]
|
||||
coli <- col.list[coli]
|
||||
czol <- col.list[czol]
|
||||
dapt <- col.list[dapt]
|
||||
doxy <- col.list[doxy]
|
||||
erta <- col.list[erta]
|
||||
eryt <- col.list[eryt]
|
||||
fosf <- col.list[fosf]
|
||||
fusi <- col.list[fusi]
|
||||
gent <- col.list[gent]
|
||||
imip <- col.list[imip]
|
||||
kana <- col.list[kana]
|
||||
levo <- col.list[levo]
|
||||
linc <- col.list[linc]
|
||||
line <- col.list[line]
|
||||
mero <- col.list[mero]
|
||||
mino <- col.list[mino]
|
||||
moxi <- col.list[moxi]
|
||||
nali <- col.list[nali]
|
||||
neom <- col.list[neom]
|
||||
neti <- col.list[neti]
|
||||
nitr <- col.list[nitr]
|
||||
novo <- col.list[novo]
|
||||
norf <- col.list[norf]
|
||||
oflo <- col.list[oflo]
|
||||
peni <- col.list[peni]
|
||||
pita <- col.list[pita]
|
||||
poly <- col.list[poly]
|
||||
qida <- col.list[qida]
|
||||
rifa <- col.list[rifa]
|
||||
roxi <- col.list[roxi]
|
||||
siso <- col.list[siso]
|
||||
teic <- col.list[teic]
|
||||
tetr <- col.list[tetr]
|
||||
tica <- col.list[tica]
|
||||
tige <- col.list[tige]
|
||||
tobr <- col.list[tobr]
|
||||
trim <- col.list[trim]
|
||||
trsu <- col.list[trsu]
|
||||
vanc <- col.list[vanc]
|
||||
|
||||
total <- 0
|
||||
total_rows <- integer(0)
|
||||
|
@ -436,6 +436,10 @@ key_antibiotics <- function(tbl,
|
||||
|
||||
keylist <- character(length = nrow(tbl))
|
||||
|
||||
if (!col_bactid %in% colnames(tbl)) {
|
||||
stop('Column ', col_bactid, ' not found.', call. = FALSE)
|
||||
}
|
||||
|
||||
# check columns
|
||||
col.list <- c(amox, cfot, cfta, cftr, cfur, cipr, clar,
|
||||
clin, clox, doxy, gent, line, mero, peni,
|
||||
|
@ -17,6 +17,7 @@
|
||||
# ==================================================================== #
|
||||
|
||||
globalVariables(c('abname',
|
||||
'atc',
|
||||
'bactid',
|
||||
'cnt',
|
||||
'Count',
|
||||
@ -35,6 +36,7 @@ globalVariables(c('abname',
|
||||
'key_ab_other',
|
||||
'mic',
|
||||
'mocode',
|
||||
'molis',
|
||||
'n',
|
||||
'other_pat_or_mo',
|
||||
'patient_id',
|
||||
@ -42,5 +44,6 @@ globalVariables(c('abname',
|
||||
'quantile',
|
||||
'real_first_isolate',
|
||||
'species',
|
||||
'umcg',
|
||||
'y',
|
||||
'.'))
|
||||
|
295
R/mdro.R
295
R/mdro.R
@ -20,42 +20,112 @@
|
||||
#'
|
||||
#' Determine which isolates are multidrug-resistant organisms (MDRO) according to country-specific guidelines.
|
||||
#' @param tbl table with antibiotic columns, like e.g. \code{amox} and \code{amcl}
|
||||
#' @param country country to determine guidelines. Should be a code from the \href{https://en.wikipedia.org/wiki/ISO_3166-1_alpha-2#Officially_assigned_code_elements}{list of ISO 3166-1 alpha-2 country codes}. Case-insensitive. Currently supported are \code{de} (Germany) and \code{nl} (the Netherlands).
|
||||
#' @param country country code to determine guidelines. EUCAST rules will be used when left empty, see Details. Should be or a code from the \href{https://en.wikipedia.org/wiki/ISO_3166-1_alpha-2#Officially_assigned_code_elements}{list of ISO 3166-1 alpha-2 country codes}. Case-insensitive. Currently supported are \code{de} (Germany) and \code{nl} (the Netherlands).
|
||||
#' @param col_bactid column name of the bacteria ID in \code{tbl} - values of this column should be present in \code{microorganisms$bactid}, see \code{\link{microorganisms}}
|
||||
#' @param info print progress
|
||||
#' @param aminoglycosides,quinolones,carbapenems character vector with column names of antibiotics
|
||||
#' @param ceftazidime,piperacillin,trimethoprim_sulfa,penicillin,vancomycin column names of antibiotics
|
||||
#' @param ... parameters that are passed on to \code{MDR}
|
||||
#' @return Ordered factor with values \code{Positive}, \code{Unconfirmed}, \code{Negative}.
|
||||
#' @param amcl,amik,amox,ampi,azit,aztr,cefa,cfra,cfep,cfot,cfox,cfta,cftr,cfur,chlo,cipr,clar,clin,clox,coli,czol,dapt,doxy,erta,eryt,fosf,fusi,gent,imip,kana,levo,linc,line,mero,metr,mino,moxi,nali,neom,neti,nitr,novo,norf,oflo,peni,pita,poly,qida,rifa,roxi,siso,teic,tetr,tica,tige,tobr,trim,trsu,vanc column names of antibiotics. column names of antibiotics
|
||||
#' @param ... parameters that are passed on to methods
|
||||
#' @details When \code{country} will be left blank, guidelines will be taken from EUCAST Expert Rules Version 3.1 "Intrinsic Resistance and Exceptional Phenotypes Tables" (\url{http://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/Expert_rules_intrinsic_exceptional_V3.1.pdf}).
|
||||
#' @return Ordered factor with levels \code{Unknown < Negative < Unconfirmed < Positive}.
|
||||
#' @rdname MDRO
|
||||
#' @export
|
||||
#' @examples
|
||||
#' library(dplyr)
|
||||
#'
|
||||
#' septic_patients %>%
|
||||
#' mutate(EUCAST = MDRO(.),
|
||||
#' BRMO = MDRO(., "nl"))
|
||||
MDRO <- function(tbl,
|
||||
country,
|
||||
country = NULL,
|
||||
col_bactid = 'bactid',
|
||||
info = TRUE,
|
||||
aminoglycosides = c('gent', 'tobr', 'kana'),
|
||||
quinolones = c('cipr', 'norf'),
|
||||
carbapenems = c('imip', 'mero', 'erta'),
|
||||
ceftazidime = 'cfta',
|
||||
piperacillin = 'pita',
|
||||
trimethoprim_sulfa = 'trsu',
|
||||
penicillin = 'peni',
|
||||
vancomycin = 'vanc') {
|
||||
amcl = 'amcl',
|
||||
amik = 'amik',
|
||||
amox = 'amox',
|
||||
ampi = 'ampi',
|
||||
azit = 'azit',
|
||||
aztr = 'aztr',
|
||||
cefa = 'cefa',
|
||||
cfra = 'cfra',
|
||||
cfep = 'cfep',
|
||||
cfot = 'cfot',
|
||||
cfox = 'cfox',
|
||||
cfta = 'cfta',
|
||||
cftr = 'cftr',
|
||||
cfur = 'cfur',
|
||||
chlo = 'chlo',
|
||||
cipr = 'cipr',
|
||||
clar = 'clar',
|
||||
clin = 'clin',
|
||||
clox = 'clox',
|
||||
coli = 'coli',
|
||||
czol = 'czol',
|
||||
dapt = 'dapt',
|
||||
doxy = 'doxy',
|
||||
erta = 'erta',
|
||||
eryt = 'eryt',
|
||||
fosf = 'fosf',
|
||||
fusi = 'fusi',
|
||||
gent = 'gent',
|
||||
imip = 'imip',
|
||||
kana = 'kana',
|
||||
levo = 'levo',
|
||||
linc = 'linc',
|
||||
line = 'line',
|
||||
mero = 'mero',
|
||||
metr = 'metr',
|
||||
mino = 'mino',
|
||||
moxi = 'moxi',
|
||||
nali = 'nali',
|
||||
neom = 'neom',
|
||||
neti = 'neti',
|
||||
nitr = 'nitr',
|
||||
novo = 'novo',
|
||||
norf = 'norf',
|
||||
oflo = 'oflo',
|
||||
peni = 'peni',
|
||||
pita = 'pita',
|
||||
poly = 'poly',
|
||||
qida = 'qida',
|
||||
rifa = 'rifa',
|
||||
roxi = 'roxi',
|
||||
siso = 'siso',
|
||||
teic = 'teic',
|
||||
tetr = 'tetr',
|
||||
tica = 'tica',
|
||||
tige = 'tige',
|
||||
tobr = 'tobr',
|
||||
trim = 'trim',
|
||||
trsu = 'trsu',
|
||||
vanc = 'vanc') {
|
||||
|
||||
if (!col_bactid %in% colnames(tbl)) {
|
||||
stop('Column ', col_bactid, ' not found.', call. = FALSE)
|
||||
}
|
||||
|
||||
# strip whitespaces
|
||||
country <- trimws(country)
|
||||
if (length(country) > 1) {
|
||||
stop('`country` must be a length one character string.', call. = FALSE)
|
||||
}
|
||||
if (!country %like% '^[a-z]{2}$') {
|
||||
|
||||
if (is.null(country)) {
|
||||
country <- 'EUCAST'
|
||||
}
|
||||
country <- trimws(country)
|
||||
if (country != 'EUCAST' & !country %like% '^[a-z]{2}$') {
|
||||
stop('This is not a valid ISO 3166-1 alpha-2 country code: "', country, '". Please see ?MDRO.', call. = FALSE)
|
||||
}
|
||||
|
||||
# create list and make country code case-independent
|
||||
guideline <- list(country = list(code = tolower(country)))
|
||||
|
||||
# support per country
|
||||
if (guideline$country$code == 'de') {
|
||||
if (guideline$country$code == 'eucast') {
|
||||
guideline$country$name <- '(European guidelines)'
|
||||
guideline$name <- 'EUCAST Expert Rules, "Intrinsic Resistance and Exceptional Phenotypes Tables"'
|
||||
guideline$version <- 'Version 3.1'
|
||||
guideline$source <- 'http://www.eucast.org/fileadmin/src/media/PDFs/EUCAST_files/Expert_Rules/Expert_rules_intrinsic_exceptional_V3.1.pdf'
|
||||
# support per country:
|
||||
} else if (guideline$country$code == 'de') {
|
||||
guideline$country$name <- 'Germany'
|
||||
guideline$name <- ''
|
||||
guideline$version <- ''
|
||||
@ -79,38 +149,177 @@ MDRO <- function(tbl,
|
||||
ANSI_reset <- "\033[0m"
|
||||
|
||||
if (info == TRUE) {
|
||||
cat("Determining Highly Resistant Microorganisms (MDRO), according to:\n",
|
||||
cat("Determining multidrug-resistant organisms (MDRO), according to:\n",
|
||||
"Guideline: ", ANSI_red, guideline$name, ", ", guideline$version, ANSI_reset, "\n",
|
||||
"Country : ", ANSI_red, guideline$country$name, ANSI_reset, "\n",
|
||||
"Source : ", ANSI_blue, guideline$source, ANSI_reset, "\n",
|
||||
"\n", sep = "")
|
||||
}
|
||||
|
||||
# check columns
|
||||
col.list <- c(amcl, amik, amox, ampi, azit, aztr, cefa, cfra, cfep, cfot,
|
||||
cfox, cfta, cftr, cfur, chlo, cipr, clar, clin, clox, coli,
|
||||
czol, dapt, doxy, erta, eryt, fosf, fusi, gent, imip, kana,
|
||||
levo, linc, line, mero, metr, mino, moxi, nali, neom, neti, nitr,
|
||||
novo, norf, oflo, peni, pita, poly, qida, rifa, roxi, siso,
|
||||
teic, tetr, tica, tige, tobr, trim, trsu, vanc)
|
||||
col.list <- check_available_columns(tbl = tbl, col.list = col.list, info = info)
|
||||
amcl <- col.list[amcl]
|
||||
amik <- col.list[amik]
|
||||
amox <- col.list[amox]
|
||||
ampi <- col.list[ampi]
|
||||
azit <- col.list[azit]
|
||||
aztr <- col.list[aztr]
|
||||
cefa <- col.list[cefa]
|
||||
cfra <- col.list[cfra]
|
||||
cfep <- col.list[cfep]
|
||||
cfot <- col.list[cfot]
|
||||
cfox <- col.list[cfox]
|
||||
cfta <- col.list[cfta]
|
||||
cftr <- col.list[cftr]
|
||||
cfur <- col.list[cfur]
|
||||
chlo <- col.list[chlo]
|
||||
cipr <- col.list[cipr]
|
||||
clar <- col.list[clar]
|
||||
clin <- col.list[clin]
|
||||
clox <- col.list[clox]
|
||||
coli <- col.list[coli]
|
||||
czol <- col.list[czol]
|
||||
dapt <- col.list[dapt]
|
||||
doxy <- col.list[doxy]
|
||||
erta <- col.list[erta]
|
||||
eryt <- col.list[eryt]
|
||||
fosf <- col.list[fosf]
|
||||
fusi <- col.list[fusi]
|
||||
gent <- col.list[gent]
|
||||
imip <- col.list[imip]
|
||||
kana <- col.list[kana]
|
||||
levo <- col.list[levo]
|
||||
linc <- col.list[linc]
|
||||
line <- col.list[line]
|
||||
mero <- col.list[mero]
|
||||
metr <- col.list[metr]
|
||||
mino <- col.list[mino]
|
||||
moxi <- col.list[moxi]
|
||||
nali <- col.list[nali]
|
||||
neom <- col.list[neom]
|
||||
neti <- col.list[neti]
|
||||
nitr <- col.list[nitr]
|
||||
novo <- col.list[novo]
|
||||
norf <- col.list[norf]
|
||||
oflo <- col.list[oflo]
|
||||
peni <- col.list[peni]
|
||||
pita <- col.list[pita]
|
||||
poly <- col.list[poly]
|
||||
qida <- col.list[qida]
|
||||
rifa <- col.list[rifa]
|
||||
roxi <- col.list[roxi]
|
||||
siso <- col.list[siso]
|
||||
teic <- col.list[teic]
|
||||
tetr <- col.list[tetr]
|
||||
tica <- col.list[tica]
|
||||
tige <- col.list[tige]
|
||||
tobr <- col.list[tobr]
|
||||
trim <- col.list[trim]
|
||||
trsu <- col.list[trsu]
|
||||
vanc <- col.list[vanc]
|
||||
|
||||
# antibiotic classes
|
||||
aminoglycosides <- c(tobr, gent, kana, neom, neti, siso)
|
||||
tetracyclines <- c(doxy, mino, tetr) # since EUCAST v3.1 tige(cycline) is set apart
|
||||
polymyxins <- c(poly, coli)
|
||||
macrolides <- c(eryt, azit, roxi, clar) # since EUCAST v3.1 clin(damycin) is set apart
|
||||
glycopeptides <- c(vanc, teic)
|
||||
streptogramins <- qida # should officially also be pristinamycin and quinupristin/dalfopristin
|
||||
cephalosporins <- c(cfep, cfot, cfox, cfra, cfta, cftr, cfur, czol)
|
||||
cephalosporins_3rd <- c(cfot, cftr, cfta)
|
||||
carbapenems <- c(erta, imip, mero)
|
||||
aminopenicillins <- c(ampi, amox)
|
||||
ureidopenicillins <- pita # should officially also be azlo and mezlo
|
||||
fluoroquinolones <- c(oflo, cipr, norf, levo, moxi)
|
||||
|
||||
# helper function for editing the table
|
||||
trans_tbl <- function(to, rows, cols) {
|
||||
cols <- cols[!is.na(cols)]
|
||||
if (length(rows) > 0 & length(cols) > 0) {
|
||||
col_filter <- which(tbl[, cols] == 'R')
|
||||
rows <- rows[rows %in% col_filter]
|
||||
tbl[rows, 'MDRO'] <<- to
|
||||
}
|
||||
}
|
||||
|
||||
# join microorganisms
|
||||
tbl <- tbl %>% left_join_microorganisms(col_bactid)
|
||||
|
||||
tbl$MDRO <- 1
|
||||
tbl$MDRO <- NA_integer_
|
||||
|
||||
if (guideline$country$code == 'eucast') {
|
||||
# EUCAST ------------------------------------------------------------------
|
||||
# Table 5
|
||||
trans_tbl(4,
|
||||
which(tbl$family == 'Enterobacteriaceae'
|
||||
| tbl$fullname %like% '^Pseudomonas aeruginosa'
|
||||
| tbl$genus == 'Acinetobacter'),
|
||||
coli)
|
||||
trans_tbl(4,
|
||||
which(tbl$fullname %like% '^Salmonella Typhi'),
|
||||
c(carbapenems, fluoroquinolones))
|
||||
trans_tbl(4,
|
||||
which(tbl$fullname %like% '^Haemophilus influenzae'),
|
||||
c(cephalosporins_3rd, carbapenems, fluoroquinolones))
|
||||
trans_tbl(4,
|
||||
which(tbl$fullname %like% '^Moraxella catarrhalis'),
|
||||
c(cephalosporins_3rd, fluoroquinolones))
|
||||
trans_tbl(4,
|
||||
which(tbl$fullname %like% '^Neisseria meningitidis'),
|
||||
c(cephalosporins_3rd, fluoroquinolones))
|
||||
trans_tbl(4,
|
||||
which(tbl$fullname %like% '^Neisseria gonorrhoeae'),
|
||||
azit)
|
||||
# Table 6
|
||||
trans_tbl(4,
|
||||
which(tbl$fullname %like% '^Staphylococcus (aureus|epidermidis|coagulase negatief|hominis|haemolyticus|intermedius|pseudointermedius)'),
|
||||
c(vanc, teic, dapt, line, qida, tige))
|
||||
trans_tbl(4,
|
||||
which(tbl$genus == 'Corynebacterium'),
|
||||
c(vanc, teic, dapt, line, qida, tige))
|
||||
trans_tbl(4,
|
||||
which(tbl$fullname %like% '^Streptococcus pneumoniae'),
|
||||
c(carbapenems, vanc, teic, dapt, line, qida, tige, rifa))
|
||||
trans_tbl(4, # Sr. groups A/B/C/G
|
||||
which(tbl$fullname %like% '^Streptococcus (pyogenes|agalactiae|equisimilis|equi|zooepidemicus|dysgalactiae|anginosus)'),
|
||||
c(peni, cephalosporins, vanc, teic, dapt, line, qida, tige))
|
||||
trans_tbl(4,
|
||||
which(tbl$genus == 'Enterococcus'),
|
||||
c(dapt, line, tige, teic))
|
||||
trans_tbl(4,
|
||||
which(tbl$fullname %like% '^Enterococcus faecalis'),
|
||||
c(ampi, amox))
|
||||
# Table 7
|
||||
trans_tbl(4,
|
||||
which(tbl$genus == 'Bacteroides'),
|
||||
metr)
|
||||
trans_tbl(4,
|
||||
which(tbl$fullname %like% '^Clostridium difficile'),
|
||||
c(metr, vanc))
|
||||
}
|
||||
|
||||
if (guideline$country$code == 'de') {
|
||||
# Germany -----------------------------------------------------------------
|
||||
stop("We are still working on German guidelines in this beta version.", call. = FALSE)
|
||||
}
|
||||
|
||||
if (guideline$country$code == 'nl') {
|
||||
# BRMO; Bijzonder Resistente Micro-Organismen
|
||||
aminoglycosides <- aminoglycosides[aminoglycosides %in% colnames(tbl)]
|
||||
quinolones <- quinolones[quinolones %in% colnames(tbl)]
|
||||
carbapenems <- carbapenems[carbapenems %in% colnames(tbl)]
|
||||
if (!ceftazidime %in% colnames(tbl)) { ceftazidime <- NA }
|
||||
if (!piperacillin %in% colnames(tbl)) { piperacillin <- NA }
|
||||
if (!trimethoprim_sulfa %in% colnames(tbl)) { trimethoprim_sulfa <- NA }
|
||||
if (!penicillin %in% colnames(tbl)) { penicillin <- NA }
|
||||
if (!vancomycin %in% colnames(tbl)) { vancomycin <- NA }
|
||||
# Netherlands -------------------------------------------------------------
|
||||
aminoglycosides <- aminoglycosides[!is.na(aminoglycosides)]
|
||||
fluoroquinolones <- fluoroquinolones[!is.na(fluoroquinolones)]
|
||||
carbapenems <- carbapenems[!is.na(carbapenems)]
|
||||
|
||||
# Table 1
|
||||
tbl[which(
|
||||
tbl$family == 'Enterobacteriaceae'
|
||||
& rowSums(tbl[, aminoglycosides] == 'R', na.rm = TRUE) >= 1
|
||||
& rowSums(tbl[, quinolones] == 'R', na.rm = TRUE) >= 1
|
||||
& rowSums(tbl[, fluoroquinolones] == 'R', na.rm = TRUE) >= 1
|
||||
), 'MDRO'] <- 4
|
||||
tbl[which(
|
||||
tbl$family == 'Enterobacteriaceae'
|
||||
@ -130,7 +339,7 @@ MDRO <- function(tbl,
|
||||
tbl[which(
|
||||
tbl$genus == 'Acinetobacter'
|
||||
& rowSums(tbl[, aminoglycosides] == 'R', na.rm = TRUE) >= 1
|
||||
& rowSums(tbl[, quinolones] == 'R', na.rm = TRUE) >= 1
|
||||
& rowSums(tbl[, fluoroquinolones] == 'R', na.rm = TRUE) >= 1
|
||||
), 'MDRO'] <- 4
|
||||
# rest of Acinetobacter is negative
|
||||
tbl[which(
|
||||
@ -140,7 +349,7 @@ MDRO <- function(tbl,
|
||||
|
||||
tbl[which(
|
||||
tbl$fullname %like% 'Stenotrophomonas maltophilia'
|
||||
& tbl[, trimethoprim_sulfa] == 'R'
|
||||
& tbl[, trsu] == 'R'
|
||||
), 'MDRO'] <- 4
|
||||
# rest of Stenotrophomonas is negative
|
||||
tbl[which(
|
||||
@ -152,9 +361,9 @@ MDRO <- function(tbl,
|
||||
tbl$fullname %like% 'Pseudomonas aeruginosa'
|
||||
& sum(rowSums(tbl[, carbapenems] == 'R', na.rm = TRUE) >= 1,
|
||||
rowSums(tbl[, aminoglycosides] == 'R', na.rm = TRUE) >= 1,
|
||||
rowSums(tbl[, quinolones] == 'R', na.rm = TRUE) >= 1,
|
||||
tbl[, ceftazidime] == 'R',
|
||||
tbl[, piperacillin] == 'R') >= 3
|
||||
rowSums(tbl[, fluoroquinolones] == 'R', na.rm = TRUE) >= 1,
|
||||
tbl[, cfta] == 'R',
|
||||
tbl[, pita] == 'R') >= 3
|
||||
), 'MDRO'] <- 4
|
||||
# rest of Pseudomonas is negative
|
||||
tbl[which(
|
||||
@ -165,11 +374,11 @@ MDRO <- function(tbl,
|
||||
# Table 3
|
||||
tbl[which(
|
||||
tbl$fullname %like% 'Streptococcus pneumoniae'
|
||||
& tbl[, penicillin] == 'R'
|
||||
& tbl[, peni] == 'R'
|
||||
), 'MDRO'] <- 4
|
||||
tbl[which(
|
||||
tbl$fullname %like% 'Streptococcus pneumoniae'
|
||||
& tbl[, vancomycin] == 'R'
|
||||
& tbl[, vanc] == 'R'
|
||||
), 'MDRO'] <- 4
|
||||
# rest of Streptococcus pneumoniae is negative
|
||||
tbl[which(
|
||||
@ -179,7 +388,7 @@ MDRO <- function(tbl,
|
||||
|
||||
tbl[which(
|
||||
tbl$fullname %like% 'Enterococcus faecium'
|
||||
& rowSums(tbl[, c(penicillin, vancomycin)] == 'R', na.rm = TRUE) >= 1
|
||||
& rowSums(tbl[, c(peni, vanc)] == 'R', na.rm = TRUE) >= 1
|
||||
), 'MDRO'] <- 4
|
||||
# rest of Enterococcus faecium is negative
|
||||
tbl[which(
|
||||
@ -197,11 +406,17 @@ MDRO <- function(tbl,
|
||||
#' @rdname MDRO
|
||||
#' @export
|
||||
BRMO <- function(tbl, country = "nl", ...) {
|
||||
MDRO(tbl = tbl, country = country, ...)
|
||||
MDRO(tbl = tbl, country = "nl", ...)
|
||||
}
|
||||
|
||||
#' @rdname MDRO
|
||||
#' @export
|
||||
MRGN <- function(tbl, country = "de", ...) {
|
||||
MDRO(tbl = tbl, country = country, ...)
|
||||
MDRO(tbl = tbl, country = "de", ...)
|
||||
}
|
||||
|
||||
#' @rdname MDRO
|
||||
#' @export
|
||||
EUCAST_exceptional_phenotypes <- function(tbl, country = "EUCAST", ...) {
|
||||
MDRO(tbl = tbl, country = "EUCAST", ...)
|
||||
}
|
||||
|
1
R/misc.R
1
R/misc.R
@ -73,6 +73,7 @@ check_available_columns <- function(tbl, col.list, info = TRUE) {
|
||||
if (info == TRUE) {
|
||||
warning('These columns do not exist and will be ignored: ',
|
||||
col.list.bak[!(col.list %in% colnames(tbl))] %>% toString(),
|
||||
'.\nTHIS MAY STRONGLY INFLUENCE THE OUTCOME.',
|
||||
immediate. = TRUE,
|
||||
call. = FALSE)
|
||||
}
|
||||
|
Reference in New Issue
Block a user