####
# Author: Martin W. Goros
# UT Health San Antonio
showOutcomes <- function(rc_url,rc_token,user=NA,record=NA,start_date=NA,stop_date=NA){
if(!("RCurl" %in% rownames(installed.packages()))){
install.packages('RCurl')
}
if(!("redcapAPI" %in% rownames(installed.packages()))){
install.packages('redcapAPI')
}
library(RCurl)
library(redcapAPI)
# read redcap data--------------------------------------------------------------
read_redcap <- function(redcap_url,secret_token){
out <- RCurl::postForm(uri=redcap_url,
token=secret_token,
content="record",
type="flat",
format="csv",
.opts=curlOptions(ssl.verifypeer=FALSE))
if(any(out[1]!="\n")){
tf <- tempfile()
write(out,file=tf)
dataout <- read.csv(tf)
return(dataout)
}else{
return(NULL)
}
}
pull_data <- function(rc_url,rc_token){
full_data <- read_redcap(redcap_url=rc_url,secret_token=rc_token)
full_data[full_data==""] <- NA
rcon <- redcapAPI::redcapConnection(url=rc_url, token=rc_token)
job_names <- c('job_title','job_alias','job_description','job_start_date','job_end_date','assigned_faculty','assigned_staff','pi_name','pi_department','data_source','funding_type','importance','h_index','modifier_job')
job_phase_names <- names(redcapAPI::exportRecords(rcon,forms='job_phase'))
work_names <- names(redcapAPI::exportRecords(rcon,forms='work'))
research_outcome_names <- names(redcapAPI::exportRecords(rcon,forms='research_outcome'))
appt_names <- names(redcapAPI::exportRecords(rcon,forms='appointments'))
job <- subset(full_data,select=c('record_id',job_names))
job <- job[rowSums(is.na(job[,-1]))!=ncol(job[,-1]), ]
job_phase <- subset(full_data,select=c('record_id',setdiff(job_phase_names,c('','redcap_survey_identifier'))))
job_phase <- job_phase[rowSums(is.na(job_phase[,-1]))!=ncol(job_phase[,-1]), ]
work <- subset(full_data,select=c('record_id',setdiff(work_names,c('work_complete','redcap_survey_identifier'))))
work <- work[rowSums(is.na(work[,-1]))!=ncol(work[,-1]), ]
research_outcome <- subset(full_data,select=c('record_id',setdiff(research_outcome_names,c('research_outcome_complete','redcap_survey_identifier'))))
research_outcome <- research_outcome[rowSums(is.na(research_outcome[,-1]))!=ncol(research_outcome[,-1]), ]
appointments <- subset(full_data,select=c('record_id',setdiff(appt_names,c('appointments_complete','redcap_survey_identifier'))))
appointments <- appointments[rowSums(is.na(appointments[,-c(1,length(appt_names))]))!=ncol(appointments[,-c(1,length(appt_names))]), ]
return(list(job=job,job_phase=job_phase,work=work,research_outcome=research_outcome,appointments=appointments))
}
rc_url <- rc_url
rc_token <- rc_token
data <- pull_data(rc_url,rc_token)$research_outcome
data$entry_date <- as.Date(as.character(data$entry_date),format='%Y-%m-%d')
if(!is.na(user)){
data <- subset(data,modifier_outcome %in% user)
}
if(!is.na(record)){
data <- subset(data,record_id %in% record)
}
if(!is.na(start_date) | !is.na(stop_date)){
data$entry_date <- as.Date(data$entry_date,format='%Y-%m-%d')
if(!is.na(start_date) & is.na(stop_date)){
data <- subset(data,entry_date >= start_date)
}
if(is.na(start_date) & !is.na(stop_date)){
data <- subset(data,entry_date <= stop_date)
}
if(!is.na(start_date) & !is.na(stop_date)){
data <- subset(data,entry_date >= start_date & entry_date <= stop_date)
}
}
return(data)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.