Nothing
#' OralOpioids: Obtain the latest information on Morphine equivalent doses provided by HealthCanada and the FDA
#'
#' This package provides details on Oral Opioids approved for sale by Health Canada and the FDA.
#' Please note that the output generated by the package should not be substituted for clinical
#' advise and any medication should be only consumed at the advise of a licensed healthcare provider.
#'
#' @docType package
#' @name OralOpioids
#' @aliases OralOpioids-package
NULL
## Version 2.0.3
#'Obtain the latest Opioid data from Health Canada
#'
#'\code{load_HealthCanada_Opioid_Table} compares the date of the local HealthCanada_Opioid_Table and compares
#'it with the latest date of data provided Health Canada. In case the local file is outdated,
#'an updated file will be generated.
#'
#' @param filelocation String. The directory on your system where you want the dataset to be downloaded.
#' If "", filelocation will be set to the download path within the OralOpioids
#' package installation directory.
#@param country String. Either "canada" (Canada), or "usa" (USA). Default: \code{"ca"}.
#' @param no_download Logical. If set to TRUE, no downloads will be executed and no user input is required. Default: \code{FALSE}.
#' @param verbose Logical. Indicates whether messages will be printed in the console. Default: \code{TRUE}.
#'
#'
#'@return The function returns the HealthCanada_Opioid_Table as a data.frame. Comments on the data.frame
#'include a status message (msg), the HealthCanada_Opioid_Table save path (path),
#'a disclaimer, and the source for the retrieved data (source_url_data and source_url_dosing).
#'
#' @import utils
#' @rawNamespace import(dplyr, except = rename)
#' @importFrom openxlsx read.xlsx write.xlsx
#' @importFrom stringr str_split str_sub word
#' @importFrom reshape2 dcast
#' @importFrom tidyr unnest
#' @importFrom jsonlite fromJSON
#' @importFrom readr parse_number
#' @importFrom plyr rename
#' @importFrom rvest html_table
#' @importFrom rlang .data
#' @rawNamespace import (xml2, except= as_list)
#' @rawNamespace import (purrr,except= c(invoke,flatten_raw,flatten))
#' @examples
#' HealthCanada_Opioid_Table <- load_HealthCanada_Opioid_Table(no_download = TRUE)
#' head(HealthCanada_Opioid_Table)
#' @export
load_HealthCanada_Opioid_Table <- function(filelocation = "", no_download = FALSE, verbose = TRUE){
if (filelocation == ""){
filelocation <- paste0(system.file(package = "OralOpioids"),"/download")
}
## 1) Get HealthCanada data date and compare with HealthCanada_Opioid_Table date
## Get HealthCanada data date ------------------------
content <- xml2::read_html("https://www.canada.ca/en/health-canada/services/drugs-health-products/drug-products/drug-product-database/what-data-extract-drug-product-database.html")
tables <- content %>%
rvest::html_table(fill = TRUE)
second_table <- tables[[2]]
second_table_date <- second_table$`Last Updated`[[1]]
second_table_date <- as.Date(as.character(second_table_date))
HealthCanada_Opioid_Table_is_old <- TRUE
HealthCanada_Opioid_Table_files_exist <- FALSE
## List all files in filelocation
downloaded_files <- list.files(filelocation)
## check if HealthCanada_Opioid_Table file is among files
HealthCanada_Opioid_Table_file_indices <- grep("HealthCanada_Opioid_Table",downloaded_files)
if (length(HealthCanada_Opioid_Table_file_indices) > 0) {
HealthCanada_Opioid_Table_files_exist <- TRUE
list_of_dates <- NULL
list_of_HealthCanada_Opioid_Table_files <- NULL
for (i in HealthCanada_Opioid_Table_file_indices){
file_date <- as.Date(as.character(substr(downloaded_files[i],1,10)))
if (length(list_of_dates) == 0){
list_of_dates <- file_date
} else {
list_of_dates <- c(list_of_dates,file_date)
}
list_of_HealthCanada_Opioid_Table_files <- c(list_of_HealthCanada_Opioid_Table_files,downloaded_files[i])
##if a file is has the same or a newer date than the second_table_date
##the HealthCanada_Opioid_Table is up to date
if (!second_table_date > file_date){
HealthCanada_Opioid_Table_is_old <- FALSE
break
}
}
}
if (HealthCanada_Opioid_Table_is_old == FALSE){
out_msg <- "The HealthCanada_Opioid_Table is up to date."
## get Big data form from downloaded_files[i]
HealthCanada_Opioid_Table_path <- paste0(filelocation,"/",downloaded_files[i])
HealthCanada_Opioid_Table <- openxlsx::read.xlsx(HealthCanada_Opioid_Table_path,sep.names = " ")
HealthCanada_Opioid_Table$Drug_ID <- readr::parse_number(HealthCanada_Opioid_Table$Drug_ID)
out <- as.data.frame(HealthCanada_Opioid_Table)
disclaimer <- paste0("Not a substitute for medical advise. ",
"Please note that the output generated by ",
"the package should not be substituted for clinical ",
"advise and any medication should be only consumed at ",
"the advise of a licensed healthcare provider.")
source_url_data <- "https://www.canada.ca/en/health-canada/services/drugs-health-products/drug-products/drug-product-database/what-data-extract-drug-product-database.html"
source_url_dosing <- "https://www.cihi.ca/sites/default/files/document/opioid-prescribing-canada-trends-en-web.pdf"
comment(out) <- c(msg = out_msg,path=HealthCanada_Opioid_Table_path,disclaimer= disclaimer,
source_url_data=source_url_data,source_url_dosing=source_url_dosing)
## if verbose is set to TRUE the message will be printed (cat) in the console
if (verbose) cat(utils::tail(out_msg,1),
paste0("DISCLAIMER: ",disclaimer),
"",
paste0("Source url of the data: ",source_url_data),
paste0("Source url used for dosing: ",source_url_dosing), sep="\n")
} else {
if (no_download == TRUE){
downloadq <- FALSE
} else{
if (HealthCanada_Opioid_Table_files_exist == FALSE){
downloadq <- utils::menu(c("Y", "N"),
title=paste("No HealthCanada_Opioid_Tables are currently in the filelocation. Do you want to download ",
"the latest data from Health Canada? (y/n)")) == 1
} else {
downloadq <- utils::menu(c("Y", "N"),
title=paste("Your HealthCanada_Opioid_Table is outdated. Do you want to download ",
"the latest data from Health Canada? (y/n)")) == 1
}
}
if (downloadq == FALSE && HealthCanada_Opioid_Table_files_exist == FALSE){
out_msg <- "No updated files were downloaded."
## if verbose is set to TRUE the message will be printed (cat) in the console
## return empty variables
HealthCanada_Opioid_Table_path <- ""
HealthCanada_Opioid_Table <- ""
disclaimer <- ""
source_url_data <- ""
source_url_dosing <- ""
out <- ""
comment(out) <- c(msg = out_msg,path=HealthCanada_Opioid_Table_path,disclaimer= disclaimer,
source_url_data=source_url_data,source_url_dosing=source_url_dosing)
## if verbose is set to TRUE the message will be printed (cat) in the console
if (verbose) cat(utils::tail(out_msg,1),sep="\n")
} else if (downloadq == FALSE && HealthCanada_Opioid_Table_files_exist == TRUE){
latest_date <- max(list_of_dates)
latest_Big_data_from_file <- list_of_HealthCanada_Opioid_Table_files[latest_date == list_of_dates]
out_msg <- paste0("No updated files were downloaded. ",
"The latest HealthCanada_Opioid_Table was from ",latest_date)
## get Big data form from latest_Big_data_from_file
HealthCanada_Opioid_Table_path <- paste0(filelocation,"/",latest_Big_data_from_file)
HealthCanada_Opioid_Table <- openxlsx::read.xlsx(HealthCanada_Opioid_Table_path,sep.names = " ")
HealthCanada_Opioid_Table$Drug_ID <- readr::parse_number(HealthCanada_Opioid_Table$Drug_ID)
out <- as.data.frame(HealthCanada_Opioid_Table)
disclaimer <- paste0("Not a substitute for medical advise. ",
"Please note that the output generated by ",
"the package should not be substituted for clinical ",
"advise and any medication should be only consumed at ",
"the advise of a licensed healthcare provider.")
source_url_data <- "https://www.canada.ca/en/health-canada/services/drugs-health-products/drug-products/drug-product-database/what-data-extract-drug-product-database.html"
source_url_dosing <- "https://www.cihi.ca/sites/default/files/document/opioid-prescribing-canada-trends-en-web.pdf"
comment(out) <- c(msg = out_msg,path=HealthCanada_Opioid_Table_path,disclaimer= disclaimer,
source_url_data=source_url_data,source_url_dosing=source_url_dosing)
## if verbose is set to TRUE the message will be printed (cat) in the console
if (verbose) cat(utils::tail(out_msg,1),
paste0("DISCLAIMER: ",disclaimer),
"",
paste0("Source url of the data: ",source_url_data),
paste0("Source url used for dosing: ",source_url_dosing), sep="\n")
## if the user agreed to download
} else {
## if the filelocation directory does not exist, create it
if (!dir.exists(filelocation)){
dir.create(filelocation, recursive = TRUE)
}
#filelocation <- paste0(system.file(package = "OralOpioids"),"/download")
tempdownload_location <- tempdir()
temp <- tempfile()
suppressWarnings(dir.create(dirname(temp)))
utils::download.file("https://www.canada.ca/content/dam/hc-sc/documents/services/drug-product-database/allfiles.zip",temp)
unzip(temp,exdir= paste0(tempdownload_location,"/txtfiles"))
schedule <- utils::read.csv(paste0(tempdownload_location,"/txtfiles/schedule.txt"),header=F)
drug <- utils::read.csv(paste0(tempdownload_location,"/txtfiles/drug.txt"),header=F)
ther <- utils::read.csv(paste0(tempdownload_location,"/txtfiles/ther.txt"),header=F)
status <- utils::read.csv(paste0(tempdownload_location,"/txtfiles/status.txt"),header=F)
ingred <- utils::read.csv(paste0(tempdownload_location,"/txtfiles/ingred.txt"),header=F)
route <- utils::read.csv(paste0(tempdownload_location,"/txtfiles/route.txt"),header=F)
form <- utils::read.csv(paste0(tempdownload_location,"/txtfiles/form.txt"),header=F)
unlink(temp,recursive = TRUE)
temp1 <- tempfile()
utils::download.file("https://www.canada.ca/content/dam/hc-sc/documents/services/drug-product-database/allfiles_ap.zip",temp1)
unzip(temp1,exdir= paste0(tempdownload_location,"/txtfiles"))
schedule_ap <- utils::read.csv(paste0(tempdownload_location,"/txtfiles/schedule_ap.txt"),header=F)
drug_ap <- utils::read.csv(paste0(tempdownload_location,"/txtfiles/drug_ap.txt"),header=F)
ther_ap <- utils::read.csv(paste0(tempdownload_location,"/txtfiles/ther_ap.txt"),header=F)
status_ap <- utils::read.csv(paste0(tempdownload_location,"/txtfiles/status_ap.txt"),header=F)
ingred_ap <- utils::read.csv(paste0(tempdownload_location,"/txtfiles/ingred_ap.txt"),header=F)
route_ap <- utils::read.csv(paste0(tempdownload_location,"/txtfiles/route_ap.txt"),header=F)
form_ap <- utils::read.csv(paste0(tempdownload_location,"/txtfiles/form_ap.txt"),header=F)
unlink(temp1,recursive = TRUE)
temp <- tempfile()
utils::download.file("https://www.canada.ca/content/dam/hc-sc/documents/services/drug-product-database/allfiles_dr.zip",temp)
unzip(temp,exdir= paste0(tempdownload_location,"/txtfiles"))
schedule_dr <- utils::read.csv(paste0(tempdownload_location,"/txtfiles/schedule_dr.txt"),header=F)
drug_dr <- utils::read.csv(paste0(tempdownload_location,"/txtfiles/drug_dr.txt"),header=F)
ther_dr <- utils::read.csv(paste0(tempdownload_location,"/txtfiles/ther_dr.txt"),header=F)
status_dr <- utils::read.csv(paste0(tempdownload_location,"/txtfiles/status_dr.txt"),header=F)
ingred_dr <- utils::read.csv(paste0(tempdownload_location,"/txtfiles/ingred_dr.txt"),header=F)
route_dr <- utils::read.csv(paste0(tempdownload_location,"/txtfiles/route_dr.txt"),header=F)
form_dr <- utils::read.csv(paste0(tempdownload_location,"/txtfiles/form_dr.txt"),header=F)
unlink(temp,recursive = TRUE)
temp <- tempfile()
utils::download.file("https://www.canada.ca/content/dam/hc-sc/documents/services/drug-product-database/allfiles_ia.zip",temp)
unzip(temp,exdir= paste0(tempdownload_location,"/txtfiles"))
schedule_ia <- utils::read.csv(paste0(tempdownload_location,"/txtfiles/schedule_ia.txt"),header=F)
drug_ia <- utils::read.csv(paste0(tempdownload_location,"/txtfiles/drug_ia.txt"),header=F)
ther_ia <- utils::read.csv(paste0(tempdownload_location,"/txtfiles/ther_ia.txt"),header=F)
status_ia <- utils::read.csv(paste0(tempdownload_location,"/txtfiles/status_ia.txt"),header=F)
ingred_ia <- utils::read.csv(paste0(tempdownload_location,"/txtfiles/ingred_ia.txt"),header=F)
route_ia <- utils::read.csv(paste0(tempdownload_location,"/txtfiles/route_ia.txt"),header=F)
form_ia <- utils::read.csv(paste0(tempdownload_location,"/txtfiles/form_ia.txt"),header=F)
unlink(temp,recursive = TRUE)
schedule <- rbind (schedule, schedule_ap, schedule_dr, schedule_ia)
rm (schedule_ap, schedule_dr, schedule_ia)
drug <- rbind (drug, drug_ap, drug_dr, drug_ia)
rm (drug_ap, drug_dr, drug_ia)
drug <- drug[,c(1,4,5)]
colnames(drug) <- c("ID","Drug_ID","Brand")
ther <- rbind (ther, ther_ap, ther_dr, ther_ia)
rm (ther_ap, ther_dr, ther_ia)
ther <- ther [c(1:3)]
colnames (ther) <- c("ID","ATC_Number","ATC")
status <- rbind (status,status_ap, status_dr, status_ia)
rm (status_ap, status_dr, status_ia)
status <- status [ ,c(1,3,4)]
colnames (status) <- c("ID","Status","Date")
ingred <- rbind (ingred,ingred_ap,ingred_dr, ingred_ia)
rm (ingred_ap,ingred_dr, ingred_ia)
ingred <- ingred [ ,c(1,2,3,5,6,8,9,10)]
colnames (ingred) <- c("ID","Drug_Code","Ingred","Dose","Value","Base1","Base2","Base3")
form <- rbind (form,form_ap,form_dr,form_ia)
rm (form_ap,form_dr,form_ia)
form <- form [ c(1,3)]
colnames(form) <- c("ID", "Form")
route <- rbind (route, route_ap,route_dr,route_ia)
route <- route [, c(1,3)]
colnames (route) <- c("ID","Route")
rm (route_ap,route_dr,route_ia)
schedule <- schedule [,-3]
colnames (schedule) <- c("ID","Schedule")
drug <- merge (drug,schedule, by= "ID")
drug$Opioid_Query <- ifelse((grepl("Narcotic", drug$Schedule)), "1", "0")
Opioid_Query <- subset (drug, Opioid_Query==1)
Opioid_Query <- Opioid_Query[,c(2,3,4)]
Opioid_Query <- unique (Opioid_Query)
Opioid_Query$Drug_ID <- suppressWarnings(as.numeric(Opioid_Query$Drug_ID))
drug$keep <- ifelse (((grepl("Narcotic", drug$Schedule))), "1", "0")
Opioids <- subset (drug,keep=="1")
Opioids <- merge (Opioids,route, by= "ID")
Unique_route <- as.data.frame(unique(Opioids$Route))
Opioids <- Opioids[Opioids$Route %in% c("ORAL","TRANSDERMAL","RECTAL","BUCCAL", "SUBLINGUAL"),]
Opioids_1 <- Opioids [,c(1:3)]
Opioids_1 <- unique(Opioids_1)
Opioids_1 <- merge (Opioids_1,ingred, by= "ID")
Unique_Ingred <- as.data.frame(unique(Opioids_1$Ingred))
Opioids_1<- subset (Opioids_1,Opioids_1$Ingred!="CHLORZOXAZONE")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="PHENOBARBITAL")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="METHOCARBAMOL")
Opioids_1$Caffeine <- ifelse (grepl("CAFFEINE", Opioids_1$Ingred), "1", "0")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="BUTALBITAL")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="CAFFEINE")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="ACETYLSALICYLIC ACID")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="ACETAMINOPHEN")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="DROPERIDOL")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="CAMPHOR")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="BENZOIC ACID")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="ANTIPYRINE")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="SODIUM SALICYLATE")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="MAGNESIUM HYDROXIDE")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="ALUMINUM HYDROXIDE")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="DIPHENYLPYRALINE HYDROCHLORIDE")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="PHENYLPROPANOLAMINE HYDROCHLORIDE")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="BELLADONNA")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="DOXYLAMINE SUCCINATE")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="HYOSCYAMINE SULFATE")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="PECTIN")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="ATTAPULGITE (ACTIVATED)")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="ATROPINE SULFATE")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="SCOPOLAMINE HYDROBROMIDE")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="IBUPROFEN")
Opioids_1 <- subset (Opioids_1,Opioids_1$Caffeine=="0")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="SQUILL")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="POTASSIUM CITRATE")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="IPECAC")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="TERPIN HYDRATE")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="P-HYDROXYEPHEDRINE HYDROCHLORIDE")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="EMETINE HYDROCHLORIDE")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="DIPHENOXYLATE HYDROCHLORIDE")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="PSEUDOEPHEDRINE HYDROCHLORIDE")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="TRIPROLIDINE HYDROCHLORIDE")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="GUAIFENESIN")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="MEPROBAMATE")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="AMMONIUM CHLORIDE")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="BROMODIPHENHYDRAMINE HYDROCHLORIDE")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="DIPHENHYDRAMINE HYDROCHLORIDE")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="POTASSIUM GUAIACOL SULPHONATE")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="CHLORPHENIRAMINE MALEATE")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="ETAFEDRIN HYDROCHLORIDE")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="SODIUM CITRATE")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="PHENIRAMINE MALEATE")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="PYRILAMINE MALEATE")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="NABILONE")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="ALCOHOL ANHYDROUS")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="COCILLANA")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="WILD LETTUCE")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="SENEGA")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="EUPHORBIA")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="PHENYLEPHRINE HYDROCHLORIDE")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="MENTHOL")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="TANNIC ACID")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="GUMWEED")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="AMMONIUM ACETATE")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="EPHEDRINE AS RESIN COMPLEX")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="CHLORPHENIRAMINE")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="GUAIACOL CARBONATE")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="PHENYLTOLOXAMINE")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="BROMPHENIRAMINE MALEATE")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="PROMETHAZINE HYDROCHLORIDE")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="KAOLIN")
Opioids_1 <- subset (Opioids_1,Opioids_1$Ingred!="DRONABINOL")
#str (status)
status$Date <- as.Date(status$Date,"%d-%b-%Y")
status <- status %>%
dplyr::arrange(status$ID,desc(status$Date)) %>%
dplyr::group_by(status$ID) %>%
dplyr::mutate(ranks=order(.data$ID))
status <- status[,-1]
names(status)[3] <- "ID"
status <- reshape2::dcast (status,ID~ ranks, value.var= "Status")
x <- paste ("Status",1:(ncol(status)-1), sep= "_")
colnames (status) <- c("ID",x)
Opioids_1 <- merge (Opioids_1,status, by= "ID")
#colnames (Opioids_1)
Opioids_1 <- merge (Opioids_1, form, by= "ID")
Opioids_1 <- merge (Opioids_1,route, by= "ID")
Opioids_1$Drug_ID <- suppressWarnings(as.numeric(Opioids_1$Drug_ID))
Opioids_1$Opioid_1 <- stringr::word(Opioids_1$Ingred,1)
Opioids_1$Opioid <- paste (Opioids_1$Opioid_1, Opioids_1$Dose, Opioids_1$Value)
#colnames (Opioids_1)
Opioids_1$Brand <- as.character(Opioids_1$Brand)
Opioids_1$Form <- as.character(Opioids_1$Form)
Opioids_1$Route <- as.character(Opioids_1$Route)
#str(Opioids_1)
Opioids_2 <- as.data.frame (cbind(Opioids_1$Drug_ID, (Opioids_1$Brand), Opioids_1$Base1,Opioids_1$Base2, Opioids_1$Base3, Opioids_1$Opioid_1,
Opioids_1$Form, Opioids_1$Route, Opioids_1$Opioid))
colnames(Opioids_2) <- c("Drug_ID", "Brand","Base1","Base2","Base3","Opioid_1","Form","Route","Opioid")
Unique_Form <- as.data.frame(unique(Opioids_2$Form))
Opioids_2$Form <- as.character(Opioids_2$Form)
Opioids_2$Form_1 <- ifelse (((grepl("TABLET", Opioids_2$Form))|(grepl("CAPSULE", Opioids_2$Form))), "CAPTAB", Opioids_2$Form)
Opioids_2$Form_1 <- ifelse ((grepl("SYRUP|TINCTURE|ELIXIR|DROPS|SOLUTION|LIQUID|SUSPENSION",Opioids_2$Form)),"LIQUID", Opioids_2$Form_1)
Big_1 <- as.data.frame(utils::read.csv(paste0(system.file('extdata', package = 'OralOpioids'),"/old_data.csv")))
colnames(Big_1)[colnames(Big_1) == 'DIN'] <- 'Drug_ID'
Big_1 <- Big_1[,c(2,8)]
Big_1 <- unique (Big_1)
Big_1 <- Big_1%>%
dplyr::arrange(Big_1$Drug_ID,desc(Big_1$MED_per_dispensing_unit))%>%
dplyr::group_by(Big_1$Drug_ID)%>%
dplyr::mutate(ranks=order(.data$Drug_ID))
Big_2 <- reshape2::dcast (Big_1,Drug_ID~ ranks, value.var= "MED_per_dispensing_unit",margins="Drug_ID",fun.aggregate = toString)
Big_2$MED_per_dispensing_unit <- ifelse (Big_2$`1`=="Couldn't be calculated","Couldn't be calculated",Big_2$`1`)
Big_2$MED_per_dispensing_unit <- ifelse (is.na (Big_2$MED_per_dispensing_unit),Big_2$`1`,Big_2$MED_per_dispensing_unit)
Big_2 <- Big_2 [,c(1,4)]
Big_1 <- Big_2
#colnames (Opioids_2)
Complete <- merge (Big_1,Opioids_2,by= c("Drug_ID"), all.y= TRUE)
Complete_a <- subset (Complete, !is.na(Complete$MED_per_dispensing_unit))
#write.csv(Complete_a,"R:/Medical_Consultants_Counts/Opioids/Big_Opioids_New1.csv")
Incomplete <- subset (Complete, is.na(Complete$MED_per_dispensing_unit))
Complete1 <- subset (Complete, !is.na(Complete$MED_per_dispensing_unit))
#colnames (Complete1)
Complete1 <- Complete1 [,c(2,4:7,9,10,11)]
Complete2 <- unique(Complete1)
#colnames (Incomplete)
Incomplete1 <- Incomplete[,c(1,3,4:7,9,10,11)]
Incomplete1 <- merge (Incomplete1, Complete2, by= c("Base1","Base2","Base3","Opioid","Route","Form_1"), all.x= TRUE)
Incomplete_Done <- subset (Incomplete1,!is.na(Incomplete1$MED_per_dispensing_unit))
Incomplete2 <- subset (Incomplete1,is.na(Incomplete1$MED_per_dispensing_unit))
Incomplete2$Base1 <- ifelse ((is.na(Incomplete2$Base1)),1,Incomplete2$Base1)
#colnames (Incomplete2)
Incomplete3 <- Incomplete2 [ ,c(1:7)]
Incomplete3 <- unique(Incomplete3)
Incomplete3$Opioid_1 <- stringr::word(Incomplete3$Opioid,1)
Incomplete3$Opioid_2 <- stringr::word(Incomplete3$Opioid,2)
Incomplete3$MED_per_dispensing_unit <- 0
#str(Incomplete3)
Incomplete3$Opioid_2 <- suppressWarnings(as.numeric(Incomplete3$Opioid_2))
Incomplete3$MED_per_dispensing_unit<- ifelse (Incomplete3$Opioid_1 %in% c("BUPRENORPHINE","NALOXONE"),
"Couldn't be calculated",Incomplete3$MED_per_dispensing_unit)
#str(Incomplete3)
Incomplete3$Base1 <- suppressWarnings(as.numeric(Incomplete3$Base1))
Incomplete3$MED_per_dispensing_unit <- ifelse ((Incomplete3$Route %in% c("BUCCAL","SUBLINGUAL") & Incomplete3$Opioid_1=="FENTANYL"),
((Incomplete3$Opioid_2*0.13)/Incomplete3$Base1),Incomplete3$MED_per_dispensing_unit)
Incomplete3$MED_per_dispensing_unit <- ifelse ((Incomplete3$Route=="TRANSDERMAL" & Incomplete3$Opioid_1=="FENTANYL"),
((Incomplete3$Opioid_2*2.4)/Incomplete3$Base1),Incomplete3$MED_per_dispensing_unit)
Incomplete3$MED_per_dispensing_unit <- ifelse ((Incomplete3$Route== "ORAL" & Incomplete3$Opioid_1=="CODEINE"),
((Incomplete3$Opioid_2*0.15)/Incomplete3$Base1),Incomplete3$MED_per_dispensing_unit)
Incomplete3$MED_per_dispensing_unit <- ifelse ((Incomplete3$Route== "ORAL" & Incomplete3$Opioid_1=="HYDROCODONE"),
((Incomplete3$Opioid_2*1)/Incomplete3$Base1),Incomplete3$MED_per_dispensing_unit)
Incomplete3$MED_per_dispensing_unit <- ifelse ((Incomplete3$Route== "ORAL" & Incomplete3$Opioid_1=="OXYCODONE"),
((Incomplete3$Opioid_2*1.5)/Incomplete3$Base1),Incomplete3$MED_per_dispensing_unit)
Incomplete3$MED_per_dispensing_unit <- ifelse ((Incomplete3$Route== "ORAL" & Incomplete3$Opioid_1=="HYDROMORPHONE"),
((Incomplete3$Opioid_2*4)/Incomplete3$Base1),Incomplete3$MED_per_dispensing_unit)
Incomplete3$MED_per_dispensing_unit <- ifelse ((Incomplete3$Route== "RECTAL" & Incomplete3$Opioid_1=="MORPHINE"),
((Incomplete3$Opioid_2*3)/Incomplete3$Base1),Incomplete3$MED_per_dispensing_unit)
Incomplete3$MED_per_dispensing_unit <- ifelse ((Incomplete3$Route== "ORAL" & Incomplete3$Opioid_1=="MORPHINE"),
((Incomplete3$Opioid_2*1)/Incomplete3$Base1),Incomplete3$MED_per_dispensing_unit)
Incomplete3$MED_per_dispensing_unit <- ifelse ((Incomplete3$Route== "ORAL" & Incomplete3$Opioid_1=="OXYMORPHONE"),
((Incomplete3$Opioid_2*3)/Incomplete3$Base1),Incomplete3$MED_per_dispensing_unit)
Incomplete3$MED_per_dispensing_unit <- ifelse ((Incomplete3$Route== "ORAL" & Incomplete3$Opioid_1=="TAPENTADOL"),
((Incomplete3$Opioid_2*0.4)/Incomplete3$Base1),Incomplete3$MED_per_dispensing_unit)
#str(Incomplete3)
Incomplete3$MED_per_dispensing_unit <- suppressWarnings(as.numeric(Incomplete3$MED_per_dispensing_unit))
Incomplete3$MED_per_dispensing_unit <- round (Incomplete3$MED_per_dispensing_unit,1)
Incomplete3$MED_per_dispensing_unit <- as.character(Incomplete3$MED_per_dispensing_unit)
Incomplete3$MED_per_dispensing_unit <- ifelse (Incomplete3$MED_per_dispensing_unit== "0","Couldn't be calculated",Incomplete3$MED_per_dispensing_unit)
#colnames (Incomplete2)
Incomplete2 <- Incomplete2 [,c(1:10)]
names (Incomplete2)[9] <- "Opioid_1"
Incomplete2 <- Incomplete2[,c(-10)]
Incomplete_Done <- Incomplete_Done[ ,c(1:8,10)]
Incomplete4 <- merge (Incomplete2, Incomplete3,by= c("Base1","Base2","Base3","Opioid","Route","Form_1","Drug_ID"), all.x= TRUE)
Incomplete4 <- unique (Incomplete4)
#colnames (Incomplete4)
Incomplete4 <- Incomplete4 [ ,c(1:8,12)]
names(Incomplete4)[7] <- "Drug_ID"
#colnames (Incomplete_Done)
#colnames(Incomplete4)
Total_Incomplete <- rbind (Incomplete4, Incomplete_Done)
Total_Incomplete$Base1 <- ifelse ((is.na(Total_Incomplete$Base1)),1,Total_Incomplete$Base1)
Total_Incomplete$MED_per_dispensing_unit <- ifelse (Total_Incomplete$Opioid=="OXYCODONE 5 MG" & Total_Incomplete$Form_1=="CAPTAB" ,7.5,Total_Incomplete$MED_per_dispensing_unit )
Total_Incomplete$MED_per_dispensing_unit <- ifelse (Total_Incomplete$Opioid=="OXYCODONE 10 MG" & Total_Incomplete$Form_1=="CAPTAB" ,15,Total_Incomplete$MED_per_dispensing_unit )
Total_Incomplete$MED_per_dispensing_unit <- ifelse (Total_Incomplete$Opioid=="OXYCODONE 20 MG" & Total_Incomplete$Form_1=="CAPTAB" ,30,Total_Incomplete$MED_per_dispensing_unit )
Total_Incomplete$MED_per_dispensing_unit <- ifelse (Total_Incomplete$Opioid=="OXYCODONE 40 MG" & Total_Incomplete$Form_1=="CAPTAB" ,60,Total_Incomplete$MED_per_dispensing_unit )
Total_Incomplete$MED_per_dispensing_unit <- suppressWarnings(as.numeric (Total_Incomplete$MED_per_dispensing_unit))
Total_Incomplete$MED_50_day <- 50/(Total_Incomplete$MED_per_dispensing_unit)
Total_Incomplete$MED_50_day <- round(Total_Incomplete$MED_50_day, digits=0)
Total_Incomplete$MED_90_day <- 90/(Total_Incomplete$MED_per_dispensing_unit)
Total_Incomplete$MED_90_day <- round(Total_Incomplete$MED_90_day, digits=0)
Total_Incomplete$Threshold_7days <- 7*Total_Incomplete$MED_50_day
Total_Incomplete$Threshold_14days <- 14*Total_Incomplete$MED_50_day
Total_Incomplete$Threshold_30days <- 30*Total_Incomplete$MED_50_day
#colnames (Total_Incomplete)
names (Total_Incomplete) [10] <- "No_tabs/ml assuming 50 MED limit per day"
names (Total_Incomplete) [11] <- "No_tabs/ml assuming 90 MED limit per day"
names (Total_Incomplete) [12] <- "Maximum No_tabs/ml assuming 50 MED limit for 7 days"
names (Total_Incomplete) [13] <- "Maximum No_tabs/ml assuming 50 MED limit for 14 days"
names (Total_Incomplete) [14] <- "Maximum No_tabs/ml assuming 50 MED limit for 30 days"
drug$Drug_ID <- suppressWarnings(as.numeric(drug$Drug_ID))
status <- merge (status, drug, by= "ID")
#colnames(status)
status1 <- as.data.frame(cbind(status$ID,status$Status_1,status$Status_2,status$Status_3,status$Drug_ID))
status1 <- as.data.frame(status1)
colnames(status1) <- c("ID","Status_1","Status_2","Status_3","Drug_ID")
#colnames(status1)
Total_Incomplete <- merge (Total_Incomplete,status1, by= "Drug_ID")
Complete_a <- merge (Complete_a,status1, by= "Drug_ID")
Complete_a <- unique (Complete_a)
#colnames (Complete_a)
#colnames (Total_Incomplete)
Complete_a$MED_per_dispensing_unit <- suppressWarnings(as.numeric(Complete_a$MED_per_dispensing_unit))
Complete_a$MED_50_day <- 50/(Complete_a$MED_per_dispensing_unit)
Complete_a$MED_50_day <- round(Complete_a$MED_50_day, digits=0)
Complete_a$MED_90_day <- 90/(Complete_a$MED_per_dispensing_unit)
Complete_a$MED_90_day <- round(Complete_a$MED_90_day, digits=0)
Complete_a$Threshold_7days <- 7*Complete_a$MED_50_day
Complete_a$Threshold_14days <- 14*Complete_a$MED_50_day
Complete_a$Threshold_30days <- 30*Complete_a$MED_50_day
#colnames (Complete_a)
names (Complete_a) [16] <- "No_tabs/ml assuming 50 MED limit per day"
names (Complete_a) [17] <- "No_tabs/ml assuming 90 MED limit per day"
names (Complete_a) [18] <- "Maximum No_tabs/ml assuming 50 MED limit for 7 days"
names (Complete_a) [19] <- "Maximum No_tabs/ml assuming 50 MED limit for 14 days"
names (Complete_a) [20] <- "Maximum No_tabs/ml assuming 50 MED limit for 30 days"
Complete_a <- Complete_a[,c(1:6,9:20)]
Big_Data <- rbind (Total_Incomplete,Complete_a)
Big_Data <- unique(Big_Data)
Big_Data$Drug_ID <- as.character(Big_Data$Drug_ID)
Big_Data$Drug_ID <- as.numeric(Big_Data$Drug_ID)
Big_Data <- Big_Data%>%
dplyr::arrange(Big_Data$Drug_ID)%>%
dplyr::group_by(Big_Data$Drug_ID)%>%
dplyr::mutate(ranks=order(.data$Drug_ID))
Big_Data <- Big_Data[,-19]
Previous_Drug_ID <- as.data.frame(Big_1[,1])
Previous_Drug_ID <- unique(Previous_Drug_ID)
colnames(Previous_Drug_ID) <- "Drug_ID"
Previous_Drug_ID$Month <- "Previous"
Big_Data_Drug_ID <- Big_Data[,1]
Big_Data_Drug_ID <- unique(Big_Data_Drug_ID)
Big_Data_Drug_ID$Month <- "Recent"
a <- merge (Big_Data_Drug_ID, Previous_Drug_ID,by= "Drug_ID", all.x= TRUE, all.y= TRUE)
#Big_Data <- Big_Data[,c(1:11)]
Drug_ID_count <- Big_Data %>%
dplyr::group_by(Big_Data$Drug_ID,Big_Data$MED_per_dispensing_unit) %>%
dplyr::tally()
names(Drug_ID_count) <- c("Drug_ID","MED_per_dispensing_unit","n")
Big_Data <- merge(Big_Data, Drug_ID_count, by= c("Drug_ID","MED_per_dispensing_unit"))
#Big_Data <- Big_Data[,c(1:3,7,8,11,14:18)]
Big_Data1 <- as.data.frame(cbind(Big_Data$Drug_ID, as.character(Big_Data$Opioid))) #I want to keep just the Drug_ID and name of the Opioid
Big_Data1 <- unique(Big_Data1)
colnames(Big_Data1) <- c("Drug_ID","Opioid")
Big_Data1 <- as.data.frame(Big_Data1)
Big_Data1 <- Big_Data1 %>%
dplyr::group_by(Big_Data1$Drug_ID)%>%
dplyr::mutate(rank=order(.data$Drug_ID))
Big_Data2 <- reshape2::dcast(Big_Data1, Drug_ID ~ rank, value.var="Opioid")
colnames(Big_Data2) <- c("Drug_ID","Opioid1","Opioid2")
Big_Data2$Opioid <- ifelse(is.na(Big_Data2$Opioid2),paste(Big_Data2$Opioid1),
paste (Big_Data2$Opioid1, "/",Big_Data2$Opioid2))
Big_Data1 <- as.data.frame(cbind(Big_Data$Drug_ID, as.character(Big_Data$Route))) #I want to keep just the Drug_ID and route
Big_Data1 <- unique(Big_Data1)
colnames(Big_Data1) <- c("Drug_ID","Route")
Big_Data1 <- Big_Data1 %>%
dplyr::arrange (Big_Data1$Drug_ID,Big_Data1$Route)%>%
dplyr::group_by(Big_Data1$Drug_ID)%>%
dplyr::mutate(rank=order(.data$Drug_ID))
Big_Data3 <- reshape2::dcast(Big_Data1, Drug_ID ~ rank, value.var="Route")
colnames(Big_Data3) <- c("Drug_ID","Route1","Route2")
Big_Data3$Route <- ifelse(is.na(Big_Data3$Route2),paste(Big_Data3$Route1),
paste (Big_Data3$Route1, "/",Big_Data3$Route2))
Big_Data2 <- Big_Data2[,c(1,ncol(Big_Data2))]
Big_Data3 <- Big_Data3[,c(1,ncol(Big_Data3))]
Big_Data <- merge(Big_Data, Big_Data2, by= "Drug_ID")
Big_Data <- merge(Big_Data, Big_Data3, by= "Drug_ID")
Big_Data$MED_per_dispensing_unit <- ifelse (is.na(Big_Data$MED_per_dispensing_unit),"Couldn't be calculated",Big_Data$MED_per_dispensing_unit)
Big_Data$`No_tabs/ml assuming 50 MED limit per day` <- ifelse (is.na(Big_Data$`No_tabs/ml assuming 50 MED limit per day`),"Couldn't be calculated",Big_Data$`No_tabs/ml assuming 50 MED limit per day`)
Big_Data$`No_tabs/ml assuming 90 MED limit per day` <- ifelse (is.na(Big_Data$`No_tabs/ml assuming 90 MED limit per day`),"Couldn't be calculated",Big_Data$`No_tabs/ml assuming 90 MED limit per day`)
Big_Data$`Maximum No_tabs/ml assuming 50 MED limit for 7 days` <- ifelse (is.na(Big_Data$`Maximum No_tabs/ml assuming 50 MED limit for 7 days`),"Couldn't be calculated",Big_Data$`Maximum No_tabs/ml assuming 50 MED limit for 7 days`)
Big_Data$`Maximum No_tabs/ml assuming 50 MED limit for 14 days` <- ifelse (is.na(Big_Data$`Maximum No_tabs/ml assuming 50 MED limit for 14 days`),"Couldn't be calculated",Big_Data$`Maximum No_tabs/ml assuming 50 MED limit for 14 days`)
Big_Data$`Maximum No_tabs/ml assuming 50 MED limit for 30 days` <- ifelse (is.na(Big_Data$`Maximum No_tabs/ml assuming 50 MED limit for 30 days`),"Couldn't be calculated",Big_Data$`Maximum No_tabs/ml assuming 50 MED limit for 30 days`)
Previous_Data <- colnames(Big_1)
Big_Data <- Big_Data[,c(1:18)]
Big_Data <- plyr::rename(Big_Data, c("Opioid.x" = "Opioid"))
Big_Data <- plyr::rename(Big_Data, c("Route.x" = "Route"))
Big_Data <- unique(Big_Data)
HealthCanada_Opioid_Table <- merge(Big_Data,form,by= "ID")
HealthCanada_Opioid_Table$Drug_ID <- as.character(HealthCanada_Opioid_Table$Drug_ID)
unlink(paste0(tempdownload_location,"/txtfiles"),recursive = TRUE)
unlink(paste0(tempdownload_location,"/allfiles"),recursive = TRUE)
# FILES <- list.files(filelocation)
# files_to_be_deleted <- FILES[grepl("txt$",unlist(FILES))]
# suppressWarnings(file.remove(paste0(filelocation,"/",files_to_be_deleted)))
out_msg <- paste0("The HealthCanada_Opioid_Table was successfully updated to ",
second_table_date,".")
HealthCanada_Opioid_Table <- cbind(HealthCanada_Opioid_Table[,c(2:8,19,10:16)],last_updated = second_table_date)
## Write the new table
HealthCanada_Opioid_Table_path <- paste0(filelocation,"/",second_table_date,"_HealthCanada_Opioid_Table.xlsx")
openxlsx::write.xlsx(HealthCanada_Opioid_Table,HealthCanada_Opioid_Table_path)
out <- as.data.frame(HealthCanada_Opioid_Table)
disclaimer <- paste0("Not a substitute for medical advise. ",
"Please note that the output generated by ",
"the package should not be substituted for clinical ",
"advise and any medication should be only consumed at ",
"the advise of a licensed healthcare provider.")
source_url_data <- "https://www.canada.ca/en/health-canada/services/drugs-health-products/drug-products/drug-product-database/what-data-extract-drug-product-database.html"
source_url_dosing <- "https://www.cihi.ca/sites/default/files/document/opioid-prescribing-canada-trends-en-web.pdf"
comment(out) <- c(msg = out_msg,path=HealthCanada_Opioid_Table_path,disclaimer= disclaimer,
source_url_data=source_url_data,source_url_dosing=source_url_dosing)
colnames(out)
columns_to_keep <- c("Drug_ID", "Base1", "Base2", "Base3", "Brand", "Form",
"Route", "Opioid", "MED_per_dispensing_unit",
"No_tabs/ml assuming 50 MED limit per day",
"No_tabs/ml assuming 90 MED limit per day",
"Maximum No_tabs/ml assuming 50 MED limit for 7 days",
"Maximum No_tabs/ml assuming 50 MED limit for 14 days",
"Maximum No_tabs/ml assuming 50 MED limit for 30 days",
"last_updated")
# Subset the b data frame
out_subset <- out[, columns_to_keep, drop = FALSE]
out <- out_subset
## if verbose is set to TRUE the message will be printed (cat) in the console
if (verbose) cat(utils::tail(out_msg,1),
paste0("DISCLAIMER: ",disclaimer),
"",
paste0("Source url of the data: ",source_url_data),
paste0("Source url used for dosing: ",source_url_dosing), sep="\n")
}
}
return(out)
}
#'Obtain the latest Opioid data from the FDA
#'
#'\code{load_FDA_Opioid_Table} compares the date of the local FDA_Opioid_Table and compares
#'it with the latest date of data provided by FDA. In case the local file is outdated,
#'an updated file will be generated.
#'
#' @param filelocation String. The directory on your system where you want the dataset to be downloaded.
#' If "", filelocation will be set to the download path within the OralOpioids
#' package installation directory.
#' @param no_download Logical. If set to TRUE, no downloads will be executed and no user input is required. Default: \code{FALSE}.
#' @param verbose Logical. Indicates whether messages will be printed in the console. Default: \code{TRUE}.
#'
#'
#'@return The function returns the FDA_Opioid_Table as a data.frame. Comments on the data.frame
#'include a status message (msg), the FDA_Opioid_Table save path (path),
#'a disclaimer, and the source for the retrieved data (source_url_data and source_url_dosing).
#' @import utils
#' @importFrom magrittr "%>%"
#' @importFrom openxlsx read.xlsx write.xlsx
#' @importFrom rlang .data
#' @importFrom stringr str_split str_sub word
#' @importFrom readr parse_number
#' @importFrom reshape2 dcast
#' @importFrom tidyr unnest
#' @importFrom jsonlite fromJSON
#' @rawNamespace import(dplyr, except = rename)
#' @importFrom plyr rename
#' @importFrom rvest html_table
#' @rawNamespace import(xml2, except= as_list)
#' @rawNamespace import(purrr, except= c(invoke,flatten_raw))
#' @examples
#' FDA_Opioid_Table <- load_FDA_Opioid_Table(no_download = TRUE)
#' head(FDA_Opioid_Table)
#' @export
load_FDA_Opioid_Table <- function(filelocation = "", no_download = FALSE, verbose = TRUE){
if (filelocation == ""){
filelocation <- paste0(system.file(package = "OralOpioids"),"/download")
}
## 1) Get FDA data date and compare with FDAOpioid_Table date
second_table_date <- as.character(Sys.Date())
## Get FDAOpioid_Table date ---------------------
FDA_Opioid_Table_is_old <- TRUE
FDA_Opioid_Table_files_exist <- FALSE
## List all files in filelocation
downloaded_files <- list.files(filelocation)
## check if FDAOpioid_Table file is among files
FDA_Opioid_Table_file_indices <- grep("FDA_Opioid_Table",downloaded_files)
if (length(FDA_Opioid_Table_file_indices) > 0) {
FDA_Opioid_Table_files_exist <- TRUE
list_of_dates <- NULL
list_of_FDA_Opioid_Table_files <- NULL
for (i in FDA_Opioid_Table_file_indices){
file_date <- as.Date(as.character(substr(downloaded_files[i],1,10)))
if (length(list_of_dates) == 0){
list_of_dates <- file_date
} else {
list_of_dates <- c(list_of_dates,file_date)
}
file_date <- max(list_of_dates)
list_of_FDA_Opioid_Table_files <- c(list_of_FDA_Opioid_Table_files,downloaded_files[i])
##if a file is has the same or a newer date than the second_table_date
##the FDAOpioid_Table is up to date
if (!second_table_date > file_date){
FDA_Opioid_Table_is_old <- FALSE
break
}
}
}
if (FDA_Opioid_Table_is_old == FALSE){
out_msg <- "The FDA_Opioid_Table is up to date."
## get Big data form from downloaded_files[i]
FDA_Opioid_Table_path <- paste0(filelocation,"/",downloaded_files[i])
FDA_Opioid_Table <- openxlsx::read.xlsx(FDA_Opioid_Table_path,sep.names = " ")
out <- as.data.frame(FDA_Opioid_Table)
disclaimer <- paste0("Not a substitute for medical advise. ",
"Please note that the output generated by ",
"the package should not be substituted for clinical ",
"advise and any medication should be only consumed at ",
"the advise of a licensed healthcare provider.")
source_url_data <- "https://download.open.fda.gov/drug/ndc/drug-ndc-0001-of-0001.json.zip"
source_url_dosing <- "Von Korff M, Saunders K, Thomas Ray G, et al. De facto long-term opioid therapy for noncancer pain. Clin J Pain 2008; 24: 521-527. 2008/06/25. DOI: 10.1097/AJP.0b013e318169d03b."
comment(out) <- c(msg = out_msg,path=FDA_Opioid_Table_path,disclaimer= disclaimer,
source_url_data=source_url_data,source_url_dosing=source_url_dosing)
## if verbose is set to TRUE the message will be printed (cat) in the console
if (verbose) cat(utils::tail(out_msg,1),
paste0("DISCLAIMER: ",disclaimer),
"",
paste0("Source url of the data: ",source_url_data),
paste0("Source url used for dosing: ",source_url_dosing), sep="\n")
} else {
if (no_download == TRUE){
downloadq <- FALSE
} else{
if (FDA_Opioid_Table_files_exist == FALSE){
downloadq <- utils::menu(c("Y", "N"),
title=paste("No FDA_Opioid_Tables are currently in the filelocation. Do you want to download ",
"the latest data from FDA? (y/n)")) == 1
} else {
downloadq <- utils::menu(c("Y", "N"),
title=paste("Your FDA_Opioid_Table is outdated. Do you want to download ",
"the latest data from FDA? (y/n)")) == 1
}
}
if (downloadq == FALSE && FDA_Opioid_Table_files_exist == FALSE){
out_msg <- "No updated files were downloaded."
## if verbose is set to TRUE the message will be printed (cat) in the console
## return empty variables
FDA_Opioid_Table_path <- ""
FDA_Opioid_Table <- ""
disclaimer <- ""
source_url_data <- ""
source_url_dosing <- ""
out <- ""
comment(out) <- c(msg = out_msg,path=FDA_Opioid_Table_path,disclaimer= disclaimer,
source_url_data=source_url_data,source_url_dosing=source_url_dosing)
## if verbose is set to TRUE the message will be printed (cat) in the console
if (verbose) cat(utils::tail(out_msg,1),sep="\n")
} else if (downloadq == FALSE && FDA_Opioid_Table_files_exist == TRUE){
latest_date <- max(list_of_dates)
latest_Big_data_from_file <- list_of_FDA_Opioid_Table_files[latest_date == list_of_dates]
out_msg <- paste0("No updated files were downloaded. ",
"The latest Big_data_from was from ",latest_date)
## get Big data form from latest_Big_data_from_file
FDA_Opioid_Table_path <- paste0(filelocation,"/",latest_Big_data_from_file)
FDA_Opioid_Table <- openxlsx::read.xlsx(FDA_Opioid_Table_path,sep.names = " ")
out <- as.data.frame(FDA_Opioid_Table)
disclaimer <- paste0("Not a substitute for medical advise. ",
"Please note that the output generated by ",
"the package should not be substituted for clinical ",
"advise and any medication should be only consumed at ",
"the advise of a licensed healthcare provider.")
source_url_data <- "https://download.open.fda.gov/drug/ndc/drug-ndc-0001-of-0001.json.zip"
source_url_dosing <- "Von Korff M, Saunders K, Thomas Ray G, et al. De facto long-term opioid therapy for noncancer pain. Clin J Pain 2008; 24: 521-527. 2008/06/25. DOI: 10.1097/AJP.0b013e318169d03b."
comment(out) <- c(msg = out_msg,path=FDA_Opioid_Table_path,disclaimer= disclaimer,
source_url_data=source_url_data,source_url_dosing=source_url_dosing)
## if verbose is set to TRUE the message will be printed (cat) in the console
if (verbose) cat(utils::tail(out_msg,1),
paste0("DISCLAIMER: ",disclaimer),
"",
paste0("Source url of the data: ",source_url_data),
paste0("Source url used for dosing: ",source_url_dosing), sep="\n")
## if the user agreed to download
} else {
## if the filelocation directory does not exist, create it
if (!dir.exists(filelocation)){
dir.create(filelocation, recursive = TRUE)
}
## 1) Get FDA data
temp <- tempfile()
suppressWarnings(dir.create(dirname(temp)))
download.file("https://download.open.fda.gov/drug/ndc/drug-ndc-0001-of-0001.json.zip",destfile = temp,quiet = FALSE, mode = "wb",flatten=T,simplifyVector = TRUE)
tmp1 <- unzip(temp, exdir = dirname(temp))
result <- jsonlite::fromJSON(tmp1)
unlink(dirname(temp),recursive = TRUE)
drug <- result$results
g1 <- drug[,c("product_ndc","pharm_class")]
colnames(g1) <- c("colA","colB")
h1 <- g1 %>% tidyr::unnest(.data$colB)
h1 <- unique(h1)
h1$Opioids <- ifelse (((grepl("Opioid", h1$colB))), "1", "0")
Opioids <- subset (h1,h1$Opioids=="1")
Opioids <- Opioids[,-3]
colnames(Opioids) <- c("product_ndc","ATC")
Opioid_ndc <- Opioids[,1]
drug1 <- as.data.frame(drug)
b1 <- drug[,c("product_ndc","active_ingredients","brand_name")]
b1 <- merge(b1,Opioid_ndc,by="product_ndc")
colnames(b1) <- c("colA","colB","brand_name")
c <- b1 %>% tidyr::unnest(c(.data$colB, .data$brand_name))
c <- unique(c)
x1 <- stringr::str_split(c$strength, "/")
x1 <- as.data.frame(x1)
x1 <- t(x1)
colnames(x1) <- c("Base1","Base2")
x1 <- as.data.frame(x1)
c <- cbind(c,x1)
c$Base1 <- readr::parse_number(c$Base1)
c$Base2 <- suppressWarnings(readr::parse_number(c$Base2))
c$Base2 <- ifelse(is.na(c$Base2),1,c$Base2)
c$Base3 <- stringr::str_sub(c$strength,-2,-1)
c$Base3 <- gsub("[^a-z.-]", "", c$Base3)
unique_chemicals <- unique(c$name)
unique_chemicals <- as.data.frame(unique_chemicals)
c1 <- subset(c, !(c$name %in% c('ACETAMINOPHEN','BUTALBITAL','CAFFEINE','MEPERDINE','DIMETHICONE','GUAIFENESIN','PHENYLEPHRINE HYDROCHLORIDE',
'PROMETHAZINE HYDROCHLORIDE','HOMATROPINE METHYLBROMIDE','NALOXEGOL OXALATE','ASPIRIN','ALVIMOPAN','BROMPHENIRAMINE MALEATE',
"IBUPROFEN","CHLORPHENIRAMINE MALEATE","TRIPROLIDINE HYDROCHLORIDE","BUPROPION HYDROCHLORIDE","CARISOPRODOL","PSEUDOEPHEDRINE HYDROCHLORIDE",
"NALDEMEDINE TOSYLATE","ELUXADOLINE","CHLORPHENIRAMINE","METHYLNATREXONE BROMIDE","OLANZAPINE","CELECOXIB")))
colnames(c1)[1] <- "product_ndc"
form <- drug1[,c("product_ndc","dosage_form")]
c1 <- merge(form,c1,by= "product_ndc")
route <- drug1[,c("product_ndc","route")]
c1 <- merge(route,c1,by= "product_ndc")
c1 <- c1[c1$route %in% c("ORAL","TRANSDERMAL","RECTAL","BUCCAL", "SUBLINGUAL"),]
c1$ingred <- paste(c1$name,c1$strength," ")
c1 <- unique(c1)
d <- c1 %>%
dplyr::arrange(c1$product_ndc,c1$ingred)%>%
dplyr::group_by(c1$product_ndc)%>%
dplyr::mutate(ranks=order(.data$product_ndc))
e <- reshape2::dcast (d,product_ndc~ ranks, value.var= "ingred")
f <- e[,-1]
bar <- apply(cbind(f), 1,
function(x) paste(x[!is.na(x)], collapse = "+ "))
bar1 <- as.data.frame(bar)
bar1 <- cbind(e[,1],bar)
bar1 <- as.data.frame(bar1)
colnames(bar1) <- c("ndc","Ingredients")
drug2 <- merge(drug1,bar1,by.x="product_ndc",by.y="ndc",all.x=T,all.y=T)
drug2 <- subset(drug2,!is.na(drug2$Ingredients))
#drug2 <- drug2[,c(1,2,4,5,10,11,14,18,19,23)]
drug2 <- drug2[,c("product_ndc","generic_name","brand_name","active_ingredients","marketing_category","dosage_form","route",
"brand_name_base","pharm_class","Ingredients")]
drug2 <- unique(drug2)
forms1_list <- drug2 %>%
dplyr::group_by(drug2$dosage_form)%>%
dplyr::tally()
drug2 <- merge(d,drug2,by= "product_ndc")
drug2$Opioid_1 <- stringr::word(drug2$name, 1)
drug2 <- drug2[,c("product_ndc","name","strength","Base1",
"Base2","Base3","generic_name", "brand_name.y",
"active_ingredients","marketing_category",
"dosage_form.y","brand_name_base",
"pharm_class",
"Ingredients","Opioid_1","route.y")]
names(drug2)[c(8,11,16)] <- c("brand_name","dosage_form","route")
drug2$MED <- 0
drug2$MED <- ifelse (drug2$Opioid_1 %in% c("BUPRENORPHINE","NALOXONE"),
"Couldn't be calculated",drug2$MED)
drug2$MED <- ifelse ((drug2$route %in% c("BUCCAL","SUBLINGUAL") & drug2$Opioid_1=="FENTANYL"),
((drug2$Base1*0.13)/drug2$Base2),drug2$MED)
drug2$MED <- ifelse ((drug2$route=="ORAL" & drug2$Opioid_1=="CODEINE"),
((drug2$Base1*0.15)/drug2$Base2),drug2$MED)
drug2$MED <- ifelse ((drug2$route=="ORAL" & drug2$Opioid_1=="HYDROCODONE"),
((drug2$Base1*1)/drug2$Base2),drug2$MED)
drug2$MED <- ifelse ((drug2$route=="ORAL" & drug2$Opioid_1=="OXYCODONE"),
((drug2$Base1*1.5)/drug2$Base2),drug2$MED)
drug2$MED <- ifelse ((drug2$route=="ORAL" & drug2$Opioid_1=="HYDROMORPHONE"),
((drug2$Base1*4)/drug2$Base2),drug2$MED)
drug2$MED <- ifelse ((drug2$route=="RECTAL" & drug2$Opioid_1=="MORPHINE"),
((drug2$Base1*3)/drug2$Base2),drug2$MED)
drug2$MED <- ifelse ((drug2$route=="ORAL" & drug2$Opioid_1=="MORPHINE"),
((drug2$Base1*1)/drug2$Base2),drug2$MED)
drug2$MED <- ifelse ((drug2$route=="ORAL" & drug2$Opioid_1=="OXYMORPHONE"),
((drug2$Base1*3)/drug2$Base2),drug2$MED)
drug2$MED <- ifelse ((drug2$route=="ORAL" & drug2$Opioid_1=="METHADONE" & drug2$Base1 >0 & drug2$Base1 <=20),
((drug2$Base1*4)/drug2$Base2),drug2$MED)
drug2$MED <- ifelse ((drug2$route=="ORAL" & drug2$Opioid_1=="METHADONE" & drug2$Base1 >20 & drug2$Base1 <=40),
((drug2$Base1*8)/drug2$Base2),drug2$MED)
drug2$MED <- ifelse ((drug2$route=="ORAL" & drug2$Opioid_1=="METHADONE" & drug2$Base1 >40 & drug2$Base1 <=60),
((drug2$Base1*10)/drug2$Base2),drug2$MED)
drug2$MED <- ifelse ((drug2$route=="ORAL" & drug2$Opioid_1=="METHADONE" & drug2$Base1 >60),
((drug2$Base1*12)/drug2$Base2),drug2$MED)
drug2$MED <- ifelse ((drug2$route=="ORAL" & drug2$Opioid_1=="MEPERIDINE"),
((drug2$Base1*0.1)/drug2$Base2),drug2$MED)
drug2$MED <- ifelse ((drug2$route=="ORAL" & drug2$Opioid_1=="TRAMADOL"),
((drug2$Base1*0.1)/drug2$Base2),drug2$MED)
drug2$MED <- ifelse ((drug2$route=="TRANSDERMAL" & drug2$Opioid_1=="FENTANYL"),
((drug2$Base1*2.4)/drug2$Base2),drug2$MED)
drug2$MED <- ifelse ((drug2$route=="ORAL" & drug2$Opioid_1=="DIHYDROCODEINE"),
((drug2$Base1*0.25)/drug2$Base2),drug2$MED)
drug2$MED <- ifelse ((drug2$route=="ORAL" & drug2$Opioid_1=="TAPENTADOL"),
((drug2$Base1*0.4)/drug2$Base2),drug2$MED)
drug2$MED <- ifelse ((drug2$route=="ORAL" & drug2$Opioid_1=="PENTAZOCINE"),
((drug2$Base1*0.37)/drug2$Base2),drug2$MED)
Incomplete <- subset(drug2,MED ==0)
unique(Incomplete$Opioid_1)
drug2$MED <- ifelse(drug2$MED==0,"Couldn't be calculated",drug2$MED)
drug2$MED <- suppressWarnings(as.numeric(drug2$MED))
drug2$MED_50_day <- 50/(drug2$MED)
drug2$MED_50_day <- round(drug2$MED_50_day, digits=0)
drug2$MED_90_day <- 90/(drug2$MED)
drug2$MED_90_day <- round(drug2$MED_90_day, digits=0)
drug2$Threshold_7days <- 7*drug2$MED_50_day
drug2$Threshold_14days <- 14*drug2$MED_50_day
drug2$Threshold_30days <- 30*drug2$MED_50_day
colnames(drug2)[colnames(drug2) == "product_ndc"] <- "Drug_ID"
colnames(drug2)[colnames(drug2) == "MED"] <- "MED_per_dispensing_unit"
colnames(drug2)[colnames(drug2) == "Ingredients"] <- "Opioid"
colnames(drug2)[colnames(drug2) == "route"] <- "Route"
colnames(drug2)[colnames(drug2) == "dosage_form"] <- "Form"
colnames(drug2)[colnames(drug2) == "brand_name"] <- "Brand"
colnames(drug2)[colnames(drug2) == "MED_50_day"] <- "No_tabs/ml assuming 50 MED limit per day"
colnames(drug2)[colnames(drug2) == "MED_90_day"] <- "No_tabs/ml assuming 90 MED limit per day"
colnames(drug2)[colnames(drug2) == "Threshold_7days"] <- "Maximum No_tabs/ml assuming 50 MED limit for 7 days"
colnames(drug2)[colnames(drug2) == "Threshold_14days"] <- "Maximum No_tabs/ml assuming 50 MED limit for 14 days"
colnames(drug2)[colnames(drug2) == "Threshold_30days"] <- "Maximum No_tabs/ml assuming 50 MED limit for 30 days"
if (length(FDA_Opioid_Table_file_indices) == 0) {
# If empty, just assign second_table_date to the entire column
drug2$last_updated <- second_table_date
} else {
# If not empty, proceed with your original logic
drug2$last_updated <- ifelse(!is.na(length(FDA_Opioid_Table_file_indices)),
pmax(file_date, second_table_date),
second_table_date)
drug2$last_updated <- as.Date(drug2$last_updated, origin = "1970-01-01")
}
FDA_Opioid_Table <- drug2
out_msg <- paste0("The FDA_Opioid_Table was successfully updated to ",
second_table_date,".")
## Write the new table
FDA_Opioid_Table_path <- paste0(filelocation,"/",as.character(Sys.Date()),"_FDA_Opioid_Table.xlsx")
openxlsx::write.xlsx(FDA_Opioid_Table,FDA_Opioid_Table_path)
out <- as.data.frame(FDA_Opioid_Table)
disclaimer <- paste0("Not a substitute for medical advise. ",
"Please note that the output generated by ",
"the package should not be substituted for clinical ",
"advise and any medication should be only consumed at ",
"the advise of a licensed healthcare provider.")
source_url_data <- "https://download.open.fda.gov/drug/ndc/drug-ndc-0001-of-0001.json.zip"
source_url_dosing <- "Von Korff M, Saunders K, Thomas Ray G, et al. De facto long-term opioid therapy for noncancer pain. Clin J Pain 2008; 24: 521-527. 2008/06/25. DOI: 10.1097/AJP.0b013e318169d03b."
comment(out) <- c(msg = out_msg,path=FDA_Opioid_Table_path,disclaimer= disclaimer,
source_url_data=source_url_data,source_url_dosing=source_url_dosing)
columns_to_keep <- c("Drug_ID", "Base1", "Base2", "Base3", "Brand", "Form",
"Route", "Opioid", "MED_per_dispensing_unit",
"No_tabs/ml assuming 50 MED limit per day",
"No_tabs/ml assuming 90 MED limit per day",
"Maximum No_tabs/ml assuming 50 MED limit for 7 days",
"Maximum No_tabs/ml assuming 50 MED limit for 14 days",
"Maximum No_tabs/ml assuming 50 MED limit for 30 days",
"last_updated")
out_subset <- out[, columns_to_keep, drop = FALSE]
out <- out_subset
## if verbose is set to TRUE the message will be printed (cat) in the console
if (verbose) cat(utils::tail(out_msg,1),
paste0("DISCLAIMER: ",disclaimer),
"",
paste0("Source url of the data: ",source_url_data),
paste0("Source url used for dosing: ",source_url_dosing), sep="\n")
}
}
return(out)
}
#'Obtain the latest Opioid data
#'
#'\code{load_Opioid_Table} compares the date of the local Opioid_Table and compares
#'it with the latest date of data. In case the local file is outdated,
#'an updated file will be generated.
#'
#' @param filelocation String. The directory on your system where you want the dataset to be downloaded.
#' If "", filelocation will be set to the download path within the OralOpioids
#' package installation directory.
#' @param country String. Either "ca" (Canada), or "usa" (USA). Default: \code{"ca"}.
#' @param no_download Logical. If set to TRUE, no downloads will be executed and no user input is required. Default: \code{FALSE}.
#' @param verbose Logical. Indicates whether messages will be printed in the console. Default: \code{TRUE}.
#'
#'
#'@return The function returns the Opioid_Table as a data.frame. Comments on the data.frame
#'include a status message (msg), the Opioid_Table save path (path),
#'a disclaimer, and the source for the retrieved data (source_url_data and source_url_dosing).
#'
#' @examples
#' FDA_Opioid_Table <- load_Opioid_Table(no_download = TRUE, country = "usa")
#' head(FDA_Opioid_Table)
#'
#' @export
load_Opioid_Table <- function(filelocation = "", no_download = FALSE, verbose = TRUE, country = "ca"){
canada_terms <- c("ca","can","canada")
usa_terms <- c("us","USA")
out <- NULL
## if the given parameter is part of the candada term list
if (any(grepl(paste0("^",country,"$"),canada_terms,ignore.case = TRUE))){
out <- load_HealthCanada_Opioid_Table(filelocation = filelocation,
no_download = no_download,
verbose = verbose)
} else if (any(grepl(paste0("^",country,"$"),usa_terms,ignore.case = TRUE))){
out <- load_FDA_Opioid_Table(filelocation = filelocation,
no_download = no_download,
verbose = verbose)
}
if (is.null(out)){
out_msg <- "Please choose a valid country."
if (verbose) cat(utils::tail(out_msg,1))
}
return(out)
}
#'Get the Morphine Equivalent Dose (MED) by using the DIN or NDC
#'
#'\code{MED} retrieves the Morphine Equivalent Dose from the Opioid_Table.
#'
#'@param Drug_ID A numeric value for the DIN or NDC. Exclude all zeros in front.
#'@param Opioid_Table Opioid dataset which can be loaded by using
#'the \code{load_HealthCanada_Opioid_Table()} or \code{load_FDA_Opioid_Table()} function. The name you use to call the function should be input here.
#'
#' @return MED: Morphine Equivalent Dose
#' @rawNamespace import(dplyr, except = rename)
#' @examples
#'
#' FDA_Opioid_Table <- load_Opioid_Table(no_download = TRUE, country="US")
#' HealthCanada_Opioid_Table <- load_Opioid_Table(no_download = TRUE, country="Canada")
#' MED(786535, HealthCanada_Opioid_Table)
#' MED("0093-0058", FDA_Opioid_Table)
#' @export
MED <- function(Drug_ID,Opioid_Table){
if (Drug_ID %in% Opioid_Table$Drug_ID){
a <- Opioid_Table[which(Opioid_Table$Drug_ID == Drug_ID),]
out_MED_per_dispensing_unit <- suppressWarnings(as.numeric(a$MED_per_dispensing_unit))
if (is.na(out_MED_per_dispensing_unit[1])){
return("MED for this Drug_ID couldn't be calculated.")
}else {
return(out_MED_per_dispensing_unit)
}
}
else return("The Drug_ID could not be found in the Opioid_Table.")
}
#'Get the Opioid content from Health Canada by using the DIN or NDC
#'
#'\code{Opioid} retrieves the Opioid content from the Opioid_Table.
#'
#'@param Drug_ID A numeric value for the DIN or NDC. Exclude all zeros in front.
#'@param Opioid_Table Opioid dataset which can be loaded by using
#'the \code{load_HealthCanada_Opioid_Table()} or \code{load_FDA_Opioid_Table()} function. The name you use to call the function should be input here.
#'
#' @return Opioid content
#' @rawNamespace import(dplyr, except = rename)
#' @examples
#'
#' FDA_Opioid_Table <- load_Opioid_Table(no_download = TRUE, country="US")
#' HealthCanada_Opioid_Table <- load_Opioid_Table(no_download = TRUE, country="Canada")
#' Opioid(786535, HealthCanada_Opioid_Table)
#' Opioid("0093-0058", FDA_Opioid_Table)
#' @export
Opioid <- function(Drug_ID,Opioid_Table){
if (Drug_ID %in% Opioid_Table$Drug_ID)
{a <- Opioid_Table[which(Opioid_Table$Drug_ID == Drug_ID),]
return(a$Opioid)}
else return("The Drug_ID could not be found in the Opioid_Table.")
}
#'Get the Brand name from Health Canada by using the DIN or NDC
#'
#'\code{Brand} retrieves the Brand name for an Oral Opioid from the HealthCanada_Opioid_Table.
#'
#'@param Drug_ID A numeric value for the DIN or NDC. Exclude all zeros in front.
#'@param Opioid_Table Opioid dataset which can be loaded by using
#'the \code{load_HealthCanada_Opioid_Table()} or \code{load_FDA_Opioid_Table()} function. The name you use to call the function should be input here.
#'
#' @return Brand name
#' @rawNamespace import(dplyr, except = rename)
#' @examples
#'
#' FDA_Opioid_Table <- load_Opioid_Table(no_download = TRUE, country="US")
#' HealthCanada_Opioid_Table <- load_Opioid_Table(no_download = TRUE, country="Canada")
#' Brand(786535, HealthCanada_Opioid_Table)
#' Brand("0093-0058", FDA_Opioid_Table)
#' @export
Brand <- function(Drug_ID,Opioid_Table){
if (Drug_ID %in% Opioid_Table$Drug_ID)
{a <- Opioid_Table[which(Opioid_Table$Drug_ID == Drug_ID),]
return(a$Brand)}
else return("The Drug_ID could not be found in the Opioid_Table.")
}
#'Maximum number of units/millilitres of oral opioids allowed per day assuming a daily limit of 50 MED/day for a DIN or NDC from the Opioid Table by using the DIN or NDC
#'
#'\code{MED_50} gives us the maximum nuber of units (e.g. tablets or capsules for solid oral opioids and no. of millilitres for liquid oral opioids that are safe assuming a Morphine equivalent Dose of 50.)
#'
#'@param Drug_ID A numeric value for the DIN or NDC. Exclude all zeros in front.
#'@param Opioid_Table Opioid dataset which can be loaded by using
#'the \code{load_HealthCanada_Opioid_Table()} or \code{load_FDA_Opioid_Table()} function. The name you use to call the function should be input here.
#'
#' @return no. of units to reach 50 MED
#' @rawNamespace import(dplyr, except = rename)
#' @examples
#'
#' FDA_Opioid_Table <- load_Opioid_Table(no_download = TRUE, country="US")
#' HealthCanada_Opioid_Table <- load_Opioid_Table(no_download = TRUE, country="Canada")
#' MED_50(786535, HealthCanada_Opioid_Table)
#' MED_50("0093-0058", FDA_Opioid_Table)
#'
#' @export
MED_50 <- function(Drug_ID,Opioid_Table){
if (Drug_ID %in% Opioid_Table$Drug_ID){
a <- Opioid_Table[which(Opioid_Table$Drug_ID == Drug_ID),]
out_MED50_per_dispensing_unit <- suppressWarnings(as.numeric(a$`No_tabs/ml assuming 50 MED limit per day`))
if (is.na(out_MED50_per_dispensing_unit[1])){
return("MED_50 for this Drug_ID couldn't be calculated.")
}else {
return(out_MED50_per_dispensing_unit)
}
}
else return("The Drug_ID could not be found in the Opioid_Table.")
}
#'Maximum number of units/millilitres of oral opioids allowed per day assuming a daily limit of 90 MED/day for a DIN or NDC from the Opioid Table by using the DIN the NDC
#'
#'\code{MED_90} gives us the maximum number of units (e.g. tablets or capsules for solid oral opioids and no. of millilitres for liquid oral opioids that are safe assuming a Morphine equivalent Dose of 90.)
#'
#'@param Drug_ID A numeric value for the DIN or NDC. Exclude all zeros in front.
#'@param Opioid_Table Opioid dataset which can be loaded by using
#'the \code{load_HealthCanada_Opioid_Table()} or \code{load_FDA_Opioid_Table()} function. The name you use to call the function should be input here.
#'
#' @return no. of units to reach 90 MED
#' @rawNamespace import(dplyr, except = rename)
#' @examples
#'
#' FDA_Opioid_Table <- load_Opioid_Table(no_download = TRUE, country="US")
#' HealthCanada_Opioid_Table <- load_Opioid_Table(no_download = TRUE, country="Canada")
#' MED_90(786535, HealthCanada_Opioid_Table)
#' MED_90("0093-0058", FDA_Opioid_Table)
#' @export
MED_90 <- function(Drug_ID,Opioid_Table){
if (Drug_ID %in% Opioid_Table$Drug_ID){
a <- Opioid_Table[which(Opioid_Table$Drug_ID == Drug_ID),]
out_MED90_per_dispensing_unit <- suppressWarnings(as.numeric(a$`No_tabs/ml assuming 90 MED limit per day`))
if (is.na(out_MED90_per_dispensing_unit[1])){
return("MED_90 for this Drug_ID couldn't be calculated.")
}else {
return(out_MED90_per_dispensing_unit)
}
}
else return("The Drug_ID could not be found in the Opioid_Table.")
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.