In Monash-RISE/riseR:
setwd("C:/Users/RISE Fiji/Documents/GitHub/riseR/RISE_FJ/T1_child_sampling")
library (tidyverse)
library (lubridate)
library (kableExtra)
library (tinytex)
knitr::opts_chunk$set(echo = TRUE, warning=FALSE) #this stops warnings from displaying in html
source("O3_T1_FJ-summary.R")
Introduction
The objective 3 child sample survey commenced in Suva on r min(child$starttime) and the most recent survey was completed on r max(child$starttime). The report is divided into three components: child sampling, feces sampling and LIMS data. All parents/guardians who consented had their children's weight, height, and feces collected. If the child was over the age of six months, then the child also had their blood collected.
Each household was approached up to three separate times to collect children data.
Sampling Overview
Sampling Activities Per Site
r child_samples_summary_final <- child_samples_summary %>% select(-doctor, -gender, -diarrhea, -breastfed, -age) %>% rename(Visits = no_visits, 'No Children' = no_children, EDTA = edta, SST = serum, 'Blood Spots' = blood_spot)
kable(child_samples_summary_final) %>%
kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed", "responsive"), full_width = F)
Feces Sampling Summary
r feces_temp <- feces %>% group_by (settlement_barcode) %>% summarise (no_visits = n()) %>% mutate (test = 1)
r feces_temp2 <- feces_temp %>% group_by (test) %>% summarise (no_visits = sum(no_visits, na.rm = TRUE)) %>% rename (settlement_barcode = test) %>% mutate (settlement_barcode = "Totals")
r feces_temp$test <- NULL
r feces_temp3 <- rbind (feces_temp, feces_temp2)
r feces_summary_temp <- full_join (feces.summary, feces_temp3, by = "settlement_barcode") %>% select (-no_visits_feces) %>% rename (no_visits_feces = no_visits)
r feces_summary_final <- full_join (child_samples_summary, feces_summary_temp, by = c("settlement" = "settlement_barcode")) %>% select (settlement, no_children, no.feces.kits, no_visits_feces, no_samples) %>% rename (children = no_children, '# feces kits' = no.feces.kits, '# pickup visits' = no_visits_feces, '# samples collected' = no_samples)
kable(feces_summary_final) %>%
kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed", "responsive"), full_width = F)
Child Sampling Survey
A total of r nrow(child_samples) children have been visited, of which r sum(child_samples2$test) started the child survey, across all 12 settlements. Field workers have completed a total of r sum(child_samples$no_visits) visits (including all return/repeat visits), for an average of
r round((sum(child_samples$no_visits)/nrow(child_samples)), digits=1) visit(s) per child. Of the r sum(child_samples2$test) children who started the child survey, r sum(child_samples$edta, na.rm = T) edta blood samples were collected, r sum(child_samples$serum, na.rm = T) serum samples were collected, and r sum(child_samples$blood_spot, na.rm = T) bloodspot samples were collected. Addtionally, r sum(child_samples$weight, na.rm = T) had their weight taken and r sum(child_samples$height, na.rm = T) had their height taken. Finally, a total of r sum(feces.kits$no.feces.kits, na.rm = T) feces kits were handed out.
r sum(child$survey_status == 1) child sample surveys have been fully completed, r sum(child$survey_status == 2) have been fully completed but require a return visit for another child, and r sum(child$survey_status == 3) incomplete surveys. There have been r sum(child$survey_status == 5 | child$survey_status == 6) surveys that were not started because nobody was home or no one was available to complete the survey. r sum(child$survey_status == 4) child was over the age limit. There have been r sum(child$survey_status == 7) withdrawals so far. The remaining r sum(child$survey_status == -77) surveys have been recorded as 'other'.
r child_sampling_summary_hist <- subset(child_sampling_summary, settlement != "Totals")
ggplot (child_sampling_summary_hist, aes (x = settlement, y = survey)) +
geom_bar (stat = "identity") +
xlab ("Settlement") + ylab ("# child surveys completed") +
theme_minimal () + #remove grey background
theme (panel.grid = element_blank (), # No underlying grid lines
axis.text.x = element_text (angle = 90, vjust = 0.5, hjust = 0)) + # rotated x-axis text
ggtitle("Fig 1: # of children surveys - by community") # Number of children survyes completed in each community
Feces Sampling Survey
A total of r nrow(feces) feces collection visits have been done and r sum(visits_feces$no_samples) feces samples collected across all 12 settlements for an average of r round(nrow(feces)/sum(visits_feces$no_samples), digits=1) visit(s) per sample collection.
r feces.summary_hist <- subset(feces.summary, settlement_barcode != "Totals")
ggplot (feces.summary_hist, aes (x = settlement_barcode, y = no_samples)) +
geom_bar (stat = "identity") +
xlab ("Settlement") + ylab ("# feces samples") +
theme_minimal () + #remove grey background
theme (panel.grid = element_blank (), # No underlying grid lines
axis.text.x = element_text (angle = 90, vjust = 0.5, hjust = 0)) + # rotated x-axis text
ggtitle("Fig 2: # of feces samples collected - by community") # Number of feces samples collected in each community
Blood Sampling Statistics
“Eligible population”" includes children over the age of 6 months and less than 5 years. "Consented" are those children that gave consent for blood to be drawn. "Withdrawal" are household that have withdrawn from the RISE study. “Successful Draw” refers to any attempt resulting in blood that is returned to the laboratory (either EDTA, SST, or filter paper). “SST obtained” refers to the percentage of cases when an EDTA tube is successfuly filled and the SST fill is started (cases when both EDTA and SST blood volume are returned).
kable(child_sampling_summary5) %>%
kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed", "responsive"), full_width = F)
Visit Status and Presence of Primary Caregiver
Status of Surveys. Key: 1. Completed survey; no return visit required; 2. Completed survey; return visit required for at least one child; 3. Incomplete survey; 4. Child exceeded age cut-off of 5 years old; 5. No one home; 6. No one available to complete the survey; 7. Previously consented but refused to participate in the survey; 8. No previous consent and did not want to consent today; -77. Other
kable(table (child$settlement_barcode, child$survey_status)) %>%
kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed", "responsive"), full_width = F)
Caregiver Present Status Cases were primary caregiver was available. In cases where primary caregiver was not available, another caregiver may have completed the survey.
r caregiver_table <- child %>% select(settlement_barcode, caregiver_present) %>% group_by (settlement_barcode) %>% summarise (Present = sum(caregiver_present), Absent = (n() - sum(caregiver_present)), total = n())
kable(caregiver_table) %>%
kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed", "responsive"), full_width = F)
Demographics, Recent Symptoms, & Healthcare Utilization
The field team collected demographic information on r sum(child_samples$survey) children.
“Children aging out in 3 mon” refers to children who are projected to be 5 years or older at the next sampling period.
r child_sampling_summary2 <- child_samples2 %>% group_by (settlement) %>% summarise (Total = sum(test, na.rm = T), 'Mean Age' = mean(age, na.rm = T), '% Male' = round((sum(gender == 1, na.rm = T)/sum(survey == 1))*100, digits = 1), 'Children < 6 Months' = sum(age < 0.5, na.rm = T), 'Children Aging Out in 3 Months' = sum(age > 4.75, na.rm = T))
kable(child_sampling_summary2) %>%
kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed", "responsive"), full_width = F)
Parents/Guardians who said their children had either diarrhea (3+ loose or watery stools in a 24-hour period), a cough (lasted throughout the day), shortness of breath (breathing), a fever (fever) in the last week, swum or played in local water ways in the last three months (swimming), or eaten dirt/soil in the last week (dirt):
kable(sick_exposure) %>%
kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed", "responsive"), full_width = F)
Parents/Guardians who said they took their child for an outpatient visit to see a healthcare worker, such as a nurse or doctor, for any reason (Outpatient Visit) or because the child was sick or injured (Sick/Injured), and if the child received antibiotics (Antibiotics).
kable(healthcare) %>%
kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed", "responsive"), full_width = F)
For the children who had an outpatient visit, how many times did they go in the last 3 months:
r hospital_visits_long <- hospital_visits %>% gather (hospitalization_visits, na.rm = TRUE)
r hospital_visits_long$hospitalization_visits <- factor(hospital_visits_long$hospitalization_visits, levels = hospital_visits_long$hospitalization_visits)
ggplot (hospital_visits_long, aes (x = hospitalization_visits, y = value)) +
geom_bar (stat = "identity") +
xlab ("# of outpatient visits") + ylab ("Count") +
theme_minimal () + #remove grey background
theme (panel.grid = element_blank (), # No underlying grid lines
axis.text.x = element_text (angle = 90, vjust = 0.5, hjust = 0)) + # rotated x-axis text
ggtitle("Fig 3: Number of days of children who had an outpatient visit") # Of children who had an outpatient visit, how many outpatient visits did they have in the last 30 days
Symptoms resulting in healthcare visits:
r symptoms_long <- symptoms %>% gather (symptoms, na.rm = TRUE)
r symptoms_long$symptoms <- factor(symptoms_long$symptoms, levels = symptoms_long$symptoms)
ggplot (symptoms_long, aes (x = symptoms, y = value)) +
geom_bar (stat = "identity") +
xlab ("Symptoms") + ylab ("Count") +
theme_minimal () + #remove grey background
theme (panel.grid = element_blank (), # No underlying grid lines
axis.text.x = element_text (angle = 90, vjust = 0.5, hjust = 0)) + # rotated x-axis text
ggtitle("Fig 4: Number of children who had a healthcare visit by symptom") # Number of children who had a healthcare visit by symptom
There are r sum(child$hospital_yn > 0, na.rm = T) (r round((sum(child$hospital_yn > 0, na.rm = T)/sum(child$hospital_yn >= 0, na.rm = TRUE))*100, digits = 1)%) children who checked into the hospital overnight.
Hemloglobin Levels
There are r hemoglobin$'<7' children who have hemoglobin levels <7 and need a referral.
r hemoglobin_long <- hemoglobin %>% gather (hemoglobin, na.rm = TRUE)
r hemoglobin_long$hemoglobin <- factor(hemoglobin_long$hemoglobin, levels = hemoglobin_long$hemoglobin)
ggplot (hemoglobin_long, aes (x = hemoglobin, y = value)) +
geom_bar (stat = "identity") +
xlab ("Hemoglobin Level") + ylab ("Count") +
theme_minimal () + #remove grey background
theme (panel.grid = element_blank (), # No underlying grid lines
axis.text.x = element_text (angle = 90, vjust = 0.5, hjust = 0)) + # rotated x-axis text
ggtitle("Fig 5: Number of children at each hemoglobin level") # Number of children at each hemoglobin level
Z Scores:
There are r zscores_histogram$'<-3' children who have <-3 for their z scores levels and need a referral.
r zscores_long <- zscores_histogram %>% gather (zscores_histogram, na.rm = TRUE)
r zscores_long$zscores_histogram <- factor(zscores_long$zscores_histogram, levels = zscores_long$zscores_histogram)
ggplot (zscores_long, aes (x = zscores_histogram, y = value)) +
geom_bar (stat = "identity") +
xlab ("Z Score") + ylab ("Count") +
theme_minimal () + #remove grey background
theme (panel.grid = element_blank (), # No underlying grid lines
axis.text.x = element_text (angle = 90, vjust = 0.5, hjust = 0)) + # rotated x-axis text
ggtitle("Fig 6: Number of children at each Z Score") # Number of children at each Z Score
Helminth Data:
Number of children by settlement that tested positive for various worm species.
kable(feces_kk_summary) %>%
kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed", "responsive"), full_width = F, font_size = 7)
LIMS Data:
EDTA and SST QC Checks
Blood (EDTA and SST) QC: Checks if blood drawn in the field in either EDTA or SST Tube has been returned to the laboratory
I have found r nrow(edta_check[(edta_check$edta_yn == 2 | edta_check$serum_yn == 2) & is.na(edta_check$Date_receipt),]) cases where blood volume was drawn and not returned to the laboratory.
r edta_final <- edta_check %>% filter ((edta_yn == 2 | serum_yn == 2) & is.na(Date_receipt)) %>% rename (settlement = settlement_barcode, house_no = extract_house_no)
kable(edta_final) %>%
kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed", "responsive"), full_width = F, font_size = 8)
Blood (EDTA and SST) QC: Checks how often EDTA or SST are drawn alone based on SurveyCTO data. Because EDTA is normally drawn first, system only flags when SST tubes are drawn and no EDTA tubes are reported. In any tables, 1 means not collected; 2 means collected.
I have found r nrow(edta_check[edta_check$edta_yn != 3 & edta_check$serum_yn == 3,]) cases where an EDTA tube was drawn and no SST tube was drawn.
I have found r nrow(edta_check[edta_check$edta_yn == 3 & edta_check$serum_yn != 3,]) cases where an SST tube was drawn and no EDTA tube was drawn; these are printed below, if any:
r edta_final2 <- edta_check %>% filter (edta_yn == 3 & serum_yn != 3) %>% rename (Settlement = settlement_barcode, House_no = extract_house_no)
kable(edta_final2) %>%
kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed", "responsive"), full_width = F, font_size = 8)
LIMS blood samples QC: blood samples registered at sample reception but no corresponding edta aliquot sample.
I have found r sum(is.na(blood_aliquots$EDTA_date) & is.na(blood_aliquots$SST_date) & is.na(blood_aliquots$WholeBlood_date)) cases where a blood sample was registered at sample reception but no blood aliquot sample was found:
r blood_aliquots_final <- blood_aliquots %>% filter (is.na(EDTA_date) & is.na(SST_date) & is.na(WholeBlood_date))
kable(blood_aliquots_final) %>%
kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed", "responsive"), full_width = F, font_size = 5)
Blood Spots QC Check
Blood spots have been collected on r nrow(bloodspot_check) children, with an average of r round((sum(bloodspot_check$blood_spot_no, na.rm = TRUE)/nrow(bloodspot_check)), digits=1) spots collected per child. The lab has currently checked in r length(bloodspot_check$Date_receipt[!is.na(bloodspot_check$Date_receipt)]) blood spot samples from the field.
I have found r nrow(bloodspot_check[!is.na(bloodspot_check$barcode_bloodspot) & bloodspot_check$blood_spot_no != 0 & is.na(bloodspot_check$Date_receipt),]) cases where bloodspots were collected in the field and were not registered in the laboratory.
r bloodspot_check_final <- bloodspot_check %>% filter (!is.na(bloodspot_check$barcode_bloodspot) & bloodspot_check$blood_spot_no != 0 & is.na(bloodspot_check$Date_receipt)) %>% rename (settlement = settlement_barcode, house_no = extract_house_no)
kable(bloodspot_check_final) %>%
kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed", "responsive"), full_width = F)
Feces QC Check
Checking for kits that were given to one household and returned in another. This may occur when the caregiver gives the wrong household number when child is processed at a centralized location, the feces transporter enters the wrong house number at pick-up when houses are very close together, or caregivers switch feces kits by accident with another caregiver.
I found r nrow(feces.compare[duplicated(feces.compare$feces.kits),]) kits that appear to be mismatched:
kable(feces.compare_final) %>%
kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed", "responsive"), full_width = F)
Field and LIMS Feces QC: Feces given out in field, picked up, but never returned to lab. Consider if these feces samples were expired and never processed at laboratory.
I have found r nrow(feces_check[!is.na(feces_check$today.feces) & is.na(feces_check$Date_receipt),]) cases where feces kits were given out in the field, picked up with feces, but never returned to the lab.
r feces_check_final <- feces_check %>% filter (!is.na(feces_check$today.feces) & is.na(feces_check$Date_receipt)) %>% rename (Settlement = settlement_barcode, House_no = extract_house_no, Date_Out = today, Date_Collected = today.feces, Date_Lab = Date_receipt) %>% select (Settlement, House_no, Date_Out, feces_kit_barcode, Date_Collected, Date_Lab)
kable(feces_check_final) %>%
kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed", "responsive"), full_width = F)
Field and LIMS Feces QC: Feces kits given out in field, never reported picked up or returned to lab. Kits that have a distrubtion date near the date of this report may still be in circulation and are pending pick-up. Kits that are older than 5 days were likely returned empty and still appear on this list.
I have found r nrow(feces_check[!is.na(feces_check$today) & is.na(feces_check$today.feces) & is.na(feces_check$Date_receipt),]) cases where feces kits were given out in the field and never picked up or returned to the lab:
r feces_check_final2 <- feces_check %>% mutate (Days_Out = Sys.Date() - feces_check$today) %>% filter (!is.na(feces_check$today) & is.na(feces_check$today.feces) & is.na(feces_check$Date_receipt) & Days_Out <= 10) %>% rename (Date_Out = today, Date_Collected = today.feces, Date_Lab = Date_receipt) %>% rename(Settlement = settlement_barcode, House_no = extract_house_no) %>% select (Settlement, House_no, Date_Out, feces_kit_barcode, Date_Collected, Date_Lab, Days_Out)
kable(feces_check_final2) %>%
kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed", "responsive"), full_width = F)
Field and LIMS Feces QC: Feces returned to lab, never reported given out in field.
r feces_check3 <- feces_check2 %>% filter(duplicated(feces_check2$feces_kit_barcode, incomparables=NA) == "FALSE")
I have found r nrow(feces_check3[(is.na(feces_check3$today) & !is.na(feces_check3$Date_receipt) & !is.na(feces_check3$Date_receipt)) ,]) cases where feces kits were returned to the lab but reportedly never given out in the field:
r feces_check_final3 <- feces_check3 %>% filter(is.na(feces_check3$today) & !is.na(feces_check3$Date_receipt) & !is.na(feces_check3$Date_receipt)) %>% rename (Settlement = settlement_barcode, House_no = extract_house_no, Date_Out = today, Date_Collected = today.feces, Date_Lab = Date_receipt) %>% select (Settlement, House_no, Date_Out, feces_kit_barcode, Date_Collected, Date_Lab)
kable(feces_check_final3) %>%
kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed", "responsive"), full_width = F)
Field and LIMS Feces QC: Feces returned to lab, never reported picked up by transporter.
I have found r nrow(feces_check3[(!is.na(feces_check3$today) & is.na(feces_check3$Date_receipt) & !is.na(feces_check3$Date_receipt)) ,]) cases where feces kits were returned to the lab but reportedly never picked up by the transporter:
r feces_check_final4 <- feces_check3 %>% filter(!is.na(feces_check3$today) & is.na(feces_check3$Date_receipt) & !is.na(feces_check3$Date_receipt)) %>% rename (Settlement = settlement_barcode, House_no = extract_house_no, Date_Out = today, Date_Collected = today.feces, Date_Lab = Date_receipt) %>% select (Settlement, House_no, Date_Out, feces_kit_barcode, Date_Collected, Date_Lab)
kable(feces_check_final4) %>%
kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed", "responsive"), full_width = F)
LIMS Feces QC: human feces registered at sample reception but no corresponding feces aliquot sample.
I have found r sum(is.na(feces_aliquot$Date_process)) cases where a feces sample was registered at sample reception but no feces aliquot sample was found:
r feces_aliquot_final <- feces_aliquot %>% filter (is.na(Date_process)) %>% select (Barcode_sample, Date_receipt, Sample_type, Date_process, Barcode_aliquot1, Volume_aliquot1, Cryobox1) %>% rename (Sample_reception_date = Date_receipt)
kable(feces_aliquot_final) %>%
kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed", "responsive"), full_width = F, font_size = 8)
LIMS KK1 and KK2 QC: number of KK1 samples equal number of KK2 samples.
I have found r sum(is.na(feces_kk$date.kk1) | is.na(feces_kk$date.kk2)) cases where the number of KK1 samples does not equal the number KK2 samples:
r feces_kk_QC <- feces_kk %>% filter (is.na(feces_kk$date.kk1) | is.na(feces_kk$date.kk2)) %>% select (Barcode_sample, Date_receipt, Sample_type, Barcode_kk_slide, date.kk1, date.kk2) %>% rename (Sample_reception_date = Date_receipt, KK1_date = date.kk1, KK2_date = date.kk2)
kable(feces_kk_QC) %>%
kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed", "responsive"), full_width = F, font_size = 9)
LIMS KK1 and Mac1 QC: number of KK1 and Mac1 samples correspond to human feces aliquot entered into sample reception.
I have found r sum(is.na(aliquotQC$Barcode_kk_slide) | is.na(aliquotQC$Barcode_macconkey)) cases where there is no KK1 sample or Mac1 sample that corresponds with a feces aliquot barcode number:
r aliquotQC_final <- aliquotQC %>% filter(is.na(aliquotQC$Barcode_kk_slide) | is.na(aliquotQC$Barcode_macconkey))
kable(aliquotQC_final) %>%
kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed", "responsive"), full_width = F, font_size = 8)
LIMS Mac1 and Mac2 QC: number of Mac1 samples equal number of Mac2 samples.
I have found r sum((is.na(feces_mac$Date_process.y) | is.na(feces_mac$Date_process.x)) - (is.na(feces_mac$Date_process.y) & is.na(feces_mac$Date_process.x))) cases where the number of Mac1 samples does not equal the number Mac2 samples:
r mac_temp <- feces_mac %>% filter(is.na(feces_mac$Date_process.y) | is.na(feces_mac$Date_process.x))
r feces_mac_QC <- mac_temp %>% filter (!is.na(mac_temp$Date_process.x) | !is.na(mac_temp$Date_process.y)) %>% select (Barcode_sample, Date_receipt, Sample_type, Barcode_macconkey, Date_process.x, Date_process.y) %>% rename (Sample_reception_date = Date_receipt, Mac1_date = Date_process.x, Mac2_date = Date_process.y)
kable(feces_mac_QC) %>%
kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed", "responsive"), full_width = F, font_size = 8)
Monash-RISE/riseR documentation built on Dec. 11, 2019, 9:49 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
setwd("C:/Users/RISE Fiji/Documents/GitHub/riseR/RISE_FJ/T1_child_sampling") library (tidyverse) library (lubridate) library (kableExtra) library (tinytex) knitr::opts_chunk$set(echo = TRUE, warning=FALSE) #this stops warnings from displaying in html source("O3_T1_FJ-summary.R")
Introduction
The objective 3 child sample survey commenced in Suva on r min(child$starttime) and the most recent survey was completed on r max(child$starttime). The report is divided into three components: child sampling, feces sampling and LIMS data. All parents/guardians who consented had their children's weight, height, and feces collected. If the child was over the age of six months, then the child also had their blood collected.
Each household was approached up to three separate times to collect children data.
Sampling Overview
Sampling Activities Per Site
r child_samples_summary_final <- child_samples_summary %>% select(-doctor, -gender, -diarrhea, -breastfed, -age) %>% rename(Visits = no_visits, 'No Children' = no_children, EDTA = edta, SST = serum, 'Blood Spots' = blood_spot)
kable(child_samples_summary_final) %>% kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed", "responsive"), full_width = F)
Feces Sampling Summary
r feces_temp <- feces %>% group_by (settlement_barcode) %>% summarise (no_visits = n()) %>% mutate (test = 1)
r feces_temp2 <- feces_temp %>% group_by (test) %>% summarise (no_visits = sum(no_visits, na.rm = TRUE)) %>% rename (settlement_barcode = test) %>% mutate (settlement_barcode = "Totals")
r feces_temp$test <- NULL
r feces_temp3 <- rbind (feces_temp, feces_temp2)
r feces_summary_temp <- full_join (feces.summary, feces_temp3, by = "settlement_barcode") %>% select (-no_visits_feces) %>% rename (no_visits_feces = no_visits)
r feces_summary_final <- full_join (child_samples_summary, feces_summary_temp, by = c("settlement" = "settlement_barcode")) %>% select (settlement, no_children, no.feces.kits, no_visits_feces, no_samples) %>% rename (children = no_children, '# feces kits' = no.feces.kits, '# pickup visits' = no_visits_feces, '# samples collected' = no_samples)
kable(feces_summary_final) %>% kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed", "responsive"), full_width = F)
Child Sampling Survey
A total of r nrow(child_samples) children have been visited, of which r sum(child_samples2$test) started the child survey, across all 12 settlements. Field workers have completed a total of r sum(child_samples$no_visits) visits (including all return/repeat visits), for an average of
r round((sum(child_samples$no_visits)/nrow(child_samples)), digits=1) visit(s) per child. Of the r sum(child_samples2$test) children who started the child survey, r sum(child_samples$edta, na.rm = T) edta blood samples were collected, r sum(child_samples$serum, na.rm = T) serum samples were collected, and r sum(child_samples$blood_spot, na.rm = T) bloodspot samples were collected. Addtionally, r sum(child_samples$weight, na.rm = T) had their weight taken and r sum(child_samples$height, na.rm = T) had their height taken. Finally, a total of r sum(feces.kits$no.feces.kits, na.rm = T) feces kits were handed out.
r sum(child$survey_status == 1) child sample surveys have been fully completed, r sum(child$survey_status == 2) have been fully completed but require a return visit for another child, and r sum(child$survey_status == 3) incomplete surveys. There have been r sum(child$survey_status == 5 | child$survey_status == 6) surveys that were not started because nobody was home or no one was available to complete the survey. r sum(child$survey_status == 4) child was over the age limit. There have been r sum(child$survey_status == 7) withdrawals so far. The remaining r sum(child$survey_status == -77) surveys have been recorded as 'other'.
r child_sampling_summary_hist <- subset(child_sampling_summary, settlement != "Totals")
ggplot (child_sampling_summary_hist, aes (x = settlement, y = survey)) + geom_bar (stat = "identity") + xlab ("Settlement") + ylab ("# child surveys completed") + theme_minimal () + #remove grey background theme (panel.grid = element_blank (), # No underlying grid lines axis.text.x = element_text (angle = 90, vjust = 0.5, hjust = 0)) + # rotated x-axis text ggtitle("Fig 1: # of children surveys - by community") # Number of children survyes completed in each community
Feces Sampling Survey
A total of r nrow(feces) feces collection visits have been done and r sum(visits_feces$no_samples) feces samples collected across all 12 settlements for an average of r round(nrow(feces)/sum(visits_feces$no_samples), digits=1) visit(s) per sample collection.
r feces.summary_hist <- subset(feces.summary, settlement_barcode != "Totals")
ggplot (feces.summary_hist, aes (x = settlement_barcode, y = no_samples)) + geom_bar (stat = "identity") + xlab ("Settlement") + ylab ("# feces samples") + theme_minimal () + #remove grey background theme (panel.grid = element_blank (), # No underlying grid lines axis.text.x = element_text (angle = 90, vjust = 0.5, hjust = 0)) + # rotated x-axis text ggtitle("Fig 2: # of feces samples collected - by community") # Number of feces samples collected in each community
Blood Sampling Statistics
“Eligible population”" includes children over the age of 6 months and less than 5 years. "Consented" are those children that gave consent for blood to be drawn. "Withdrawal" are household that have withdrawn from the RISE study. “Successful Draw” refers to any attempt resulting in blood that is returned to the laboratory (either EDTA, SST, or filter paper). “SST obtained” refers to the percentage of cases when an EDTA tube is successfuly filled and the SST fill is started (cases when both EDTA and SST blood volume are returned).
kable(child_sampling_summary5) %>% kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed", "responsive"), full_width = F)
Visit Status and Presence of Primary Caregiver
Status of Surveys. Key: 1. Completed survey; no return visit required; 2. Completed survey; return visit required for at least one child; 3. Incomplete survey; 4. Child exceeded age cut-off of 5 years old; 5. No one home; 6. No one available to complete the survey; 7. Previously consented but refused to participate in the survey; 8. No previous consent and did not want to consent today; -77. Other
kable(table (child$settlement_barcode, child$survey_status)) %>% kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed", "responsive"), full_width = F)
Caregiver Present Status Cases were primary caregiver was available. In cases where primary caregiver was not available, another caregiver may have completed the survey.
r caregiver_table <- child %>% select(settlement_barcode, caregiver_present) %>% group_by (settlement_barcode) %>% summarise (Present = sum(caregiver_present), Absent = (n() - sum(caregiver_present)), total = n())
kable(caregiver_table) %>% kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed", "responsive"), full_width = F)
Demographics, Recent Symptoms, & Healthcare Utilization
The field team collected demographic information on r sum(child_samples$survey) children.
“Children aging out in 3 mon” refers to children who are projected to be 5 years or older at the next sampling period.
r child_sampling_summary2 <- child_samples2 %>% group_by (settlement) %>% summarise (Total = sum(test, na.rm = T), 'Mean Age' = mean(age, na.rm = T), '% Male' = round((sum(gender == 1, na.rm = T)/sum(survey == 1))*100, digits = 1), 'Children < 6 Months' = sum(age < 0.5, na.rm = T), 'Children Aging Out in 3 Months' = sum(age > 4.75, na.rm = T))
kable(child_sampling_summary2) %>% kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed", "responsive"), full_width = F)
Parents/Guardians who said their children had either diarrhea (3+ loose or watery stools in a 24-hour period), a cough (lasted throughout the day), shortness of breath (breathing), a fever (fever) in the last week, swum or played in local water ways in the last three months (swimming), or eaten dirt/soil in the last week (dirt):
kable(sick_exposure) %>% kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed", "responsive"), full_width = F)
Parents/Guardians who said they took their child for an outpatient visit to see a healthcare worker, such as a nurse or doctor, for any reason (Outpatient Visit) or because the child was sick or injured (Sick/Injured), and if the child received antibiotics (Antibiotics).
kable(healthcare) %>% kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed", "responsive"), full_width = F)
For the children who had an outpatient visit, how many times did they go in the last 3 months:
r hospital_visits_long <- hospital_visits %>% gather (hospitalization_visits, na.rm = TRUE)
r hospital_visits_long$hospitalization_visits <- factor(hospital_visits_long$hospitalization_visits, levels = hospital_visits_long$hospitalization_visits)
ggplot (hospital_visits_long, aes (x = hospitalization_visits, y = value)) + geom_bar (stat = "identity") + xlab ("# of outpatient visits") + ylab ("Count") + theme_minimal () + #remove grey background theme (panel.grid = element_blank (), # No underlying grid lines axis.text.x = element_text (angle = 90, vjust = 0.5, hjust = 0)) + # rotated x-axis text ggtitle("Fig 3: Number of days of children who had an outpatient visit") # Of children who had an outpatient visit, how many outpatient visits did they have in the last 30 days
Symptoms resulting in healthcare visits:
r symptoms_long <- symptoms %>% gather (symptoms, na.rm = TRUE)
r symptoms_long$symptoms <- factor(symptoms_long$symptoms, levels = symptoms_long$symptoms)
ggplot (symptoms_long, aes (x = symptoms, y = value)) + geom_bar (stat = "identity") + xlab ("Symptoms") + ylab ("Count") + theme_minimal () + #remove grey background theme (panel.grid = element_blank (), # No underlying grid lines axis.text.x = element_text (angle = 90, vjust = 0.5, hjust = 0)) + # rotated x-axis text ggtitle("Fig 4: Number of children who had a healthcare visit by symptom") # Number of children who had a healthcare visit by symptom
There are r sum(child$hospital_yn > 0, na.rm = T) (r round((sum(child$hospital_yn > 0, na.rm = T)/sum(child$hospital_yn >= 0, na.rm = TRUE))*100, digits = 1)%) children who checked into the hospital overnight.
Hemloglobin Levels
There are r hemoglobin$'<7' children who have hemoglobin levels <7 and need a referral.
r hemoglobin_long <- hemoglobin %>% gather (hemoglobin, na.rm = TRUE)
r hemoglobin_long$hemoglobin <- factor(hemoglobin_long$hemoglobin, levels = hemoglobin_long$hemoglobin)
ggplot (hemoglobin_long, aes (x = hemoglobin, y = value)) + geom_bar (stat = "identity") + xlab ("Hemoglobin Level") + ylab ("Count") + theme_minimal () + #remove grey background theme (panel.grid = element_blank (), # No underlying grid lines axis.text.x = element_text (angle = 90, vjust = 0.5, hjust = 0)) + # rotated x-axis text ggtitle("Fig 5: Number of children at each hemoglobin level") # Number of children at each hemoglobin level
Z Scores:
There are r zscores_histogram$'<-3' children who have <-3 for their z scores levels and need a referral.
r zscores_long <- zscores_histogram %>% gather (zscores_histogram, na.rm = TRUE)
r zscores_long$zscores_histogram <- factor(zscores_long$zscores_histogram, levels = zscores_long$zscores_histogram)
ggplot (zscores_long, aes (x = zscores_histogram, y = value)) + geom_bar (stat = "identity") + xlab ("Z Score") + ylab ("Count") + theme_minimal () + #remove grey background theme (panel.grid = element_blank (), # No underlying grid lines axis.text.x = element_text (angle = 90, vjust = 0.5, hjust = 0)) + # rotated x-axis text ggtitle("Fig 6: Number of children at each Z Score") # Number of children at each Z Score
Helminth Data:
Number of children by settlement that tested positive for various worm species.
kable(feces_kk_summary) %>% kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed", "responsive"), full_width = F, font_size = 7)
LIMS Data:
EDTA and SST QC Checks
Blood (EDTA and SST) QC: Checks if blood drawn in the field in either EDTA or SST Tube has been returned to the laboratory
I have found r nrow(edta_check[(edta_check$edta_yn == 2 | edta_check$serum_yn == 2) & is.na(edta_check$Date_receipt),]) cases where blood volume was drawn and not returned to the laboratory.
r edta_final <- edta_check %>% filter ((edta_yn == 2 | serum_yn == 2) & is.na(Date_receipt)) %>% rename (settlement = settlement_barcode, house_no = extract_house_no)
kable(edta_final) %>% kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed", "responsive"), full_width = F, font_size = 8)
Blood (EDTA and SST) QC: Checks how often EDTA or SST are drawn alone based on SurveyCTO data. Because EDTA is normally drawn first, system only flags when SST tubes are drawn and no EDTA tubes are reported. In any tables, 1 means not collected; 2 means collected.
I have found r nrow(edta_check[edta_check$edta_yn != 3 & edta_check$serum_yn == 3,]) cases where an EDTA tube was drawn and no SST tube was drawn.
I have found r nrow(edta_check[edta_check$edta_yn == 3 & edta_check$serum_yn != 3,]) cases where an SST tube was drawn and no EDTA tube was drawn; these are printed below, if any:
r edta_final2 <- edta_check %>% filter (edta_yn == 3 & serum_yn != 3) %>% rename (Settlement = settlement_barcode, House_no = extract_house_no)
kable(edta_final2) %>% kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed", "responsive"), full_width = F, font_size = 8)
LIMS blood samples QC: blood samples registered at sample reception but no corresponding edta aliquot sample.
I have found r sum(is.na(blood_aliquots$EDTA_date) & is.na(blood_aliquots$SST_date) & is.na(blood_aliquots$WholeBlood_date)) cases where a blood sample was registered at sample reception but no blood aliquot sample was found:
r blood_aliquots_final <- blood_aliquots %>% filter (is.na(EDTA_date) & is.na(SST_date) & is.na(WholeBlood_date))
kable(blood_aliquots_final) %>% kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed", "responsive"), full_width = F, font_size = 5)
Blood Spots QC Check
Blood spots have been collected on r nrow(bloodspot_check) children, with an average of r round((sum(bloodspot_check$blood_spot_no, na.rm = TRUE)/nrow(bloodspot_check)), digits=1) spots collected per child. The lab has currently checked in r length(bloodspot_check$Date_receipt[!is.na(bloodspot_check$Date_receipt)]) blood spot samples from the field.
I have found r nrow(bloodspot_check[!is.na(bloodspot_check$barcode_bloodspot) & bloodspot_check$blood_spot_no != 0 & is.na(bloodspot_check$Date_receipt),]) cases where bloodspots were collected in the field and were not registered in the laboratory.
r bloodspot_check_final <- bloodspot_check %>% filter (!is.na(bloodspot_check$barcode_bloodspot) & bloodspot_check$blood_spot_no != 0 & is.na(bloodspot_check$Date_receipt)) %>% rename (settlement = settlement_barcode, house_no = extract_house_no)
kable(bloodspot_check_final) %>% kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed", "responsive"), full_width = F)
Feces QC Check
Checking for kits that were given to one household and returned in another. This may occur when the caregiver gives the wrong household number when child is processed at a centralized location, the feces transporter enters the wrong house number at pick-up when houses are very close together, or caregivers switch feces kits by accident with another caregiver.
I found r nrow(feces.compare[duplicated(feces.compare$feces.kits),]) kits that appear to be mismatched:
kable(feces.compare_final) %>% kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed", "responsive"), full_width = F)
Field and LIMS Feces QC: Feces given out in field, picked up, but never returned to lab. Consider if these feces samples were expired and never processed at laboratory.
I have found r nrow(feces_check[!is.na(feces_check$today.feces) & is.na(feces_check$Date_receipt),]) cases where feces kits were given out in the field, picked up with feces, but never returned to the lab.
r feces_check_final <- feces_check %>% filter (!is.na(feces_check$today.feces) & is.na(feces_check$Date_receipt)) %>% rename (Settlement = settlement_barcode, House_no = extract_house_no, Date_Out = today, Date_Collected = today.feces, Date_Lab = Date_receipt) %>% select (Settlement, House_no, Date_Out, feces_kit_barcode, Date_Collected, Date_Lab)
kable(feces_check_final) %>% kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed", "responsive"), full_width = F)
Field and LIMS Feces QC: Feces kits given out in field, never reported picked up or returned to lab. Kits that have a distrubtion date near the date of this report may still be in circulation and are pending pick-up. Kits that are older than 5 days were likely returned empty and still appear on this list.
I have found r nrow(feces_check[!is.na(feces_check$today) & is.na(feces_check$today.feces) & is.na(feces_check$Date_receipt),]) cases where feces kits were given out in the field and never picked up or returned to the lab:
r feces_check_final2 <- feces_check %>% mutate (Days_Out = Sys.Date() - feces_check$today) %>% filter (!is.na(feces_check$today) & is.na(feces_check$today.feces) & is.na(feces_check$Date_receipt) & Days_Out <= 10) %>% rename (Date_Out = today, Date_Collected = today.feces, Date_Lab = Date_receipt) %>% rename(Settlement = settlement_barcode, House_no = extract_house_no) %>% select (Settlement, House_no, Date_Out, feces_kit_barcode, Date_Collected, Date_Lab, Days_Out)
kable(feces_check_final2) %>% kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed", "responsive"), full_width = F)
Field and LIMS Feces QC: Feces returned to lab, never reported given out in field.
r feces_check3 <- feces_check2 %>% filter(duplicated(feces_check2$feces_kit_barcode, incomparables=NA) == "FALSE")
I have found r nrow(feces_check3[(is.na(feces_check3$today) & !is.na(feces_check3$Date_receipt) & !is.na(feces_check3$Date_receipt)) ,]) cases where feces kits were returned to the lab but reportedly never given out in the field:
r feces_check_final3 <- feces_check3 %>% filter(is.na(feces_check3$today) & !is.na(feces_check3$Date_receipt) & !is.na(feces_check3$Date_receipt)) %>% rename (Settlement = settlement_barcode, House_no = extract_house_no, Date_Out = today, Date_Collected = today.feces, Date_Lab = Date_receipt) %>% select (Settlement, House_no, Date_Out, feces_kit_barcode, Date_Collected, Date_Lab)
kable(feces_check_final3) %>% kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed", "responsive"), full_width = F)
Field and LIMS Feces QC: Feces returned to lab, never reported picked up by transporter.
I have found r nrow(feces_check3[(!is.na(feces_check3$today) & is.na(feces_check3$Date_receipt) & !is.na(feces_check3$Date_receipt)) ,]) cases where feces kits were returned to the lab but reportedly never picked up by the transporter:
r feces_check_final4 <- feces_check3 %>% filter(!is.na(feces_check3$today) & is.na(feces_check3$Date_receipt) & !is.na(feces_check3$Date_receipt)) %>% rename (Settlement = settlement_barcode, House_no = extract_house_no, Date_Out = today, Date_Collected = today.feces, Date_Lab = Date_receipt) %>% select (Settlement, House_no, Date_Out, feces_kit_barcode, Date_Collected, Date_Lab)
kable(feces_check_final4) %>% kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed", "responsive"), full_width = F)
LIMS Feces QC: human feces registered at sample reception but no corresponding feces aliquot sample.
I have found r sum(is.na(feces_aliquot$Date_process)) cases where a feces sample was registered at sample reception but no feces aliquot sample was found:
r feces_aliquot_final <- feces_aliquot %>% filter (is.na(Date_process)) %>% select (Barcode_sample, Date_receipt, Sample_type, Date_process, Barcode_aliquot1, Volume_aliquot1, Cryobox1) %>% rename (Sample_reception_date = Date_receipt)
kable(feces_aliquot_final) %>% kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed", "responsive"), full_width = F, font_size = 8)
LIMS KK1 and KK2 QC: number of KK1 samples equal number of KK2 samples.
I have found r sum(is.na(feces_kk$date.kk1) | is.na(feces_kk$date.kk2)) cases where the number of KK1 samples does not equal the number KK2 samples:
r feces_kk_QC <- feces_kk %>% filter (is.na(feces_kk$date.kk1) | is.na(feces_kk$date.kk2)) %>% select (Barcode_sample, Date_receipt, Sample_type, Barcode_kk_slide, date.kk1, date.kk2) %>% rename (Sample_reception_date = Date_receipt, KK1_date = date.kk1, KK2_date = date.kk2)
kable(feces_kk_QC) %>% kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed", "responsive"), full_width = F, font_size = 9)
LIMS KK1 and Mac1 QC: number of KK1 and Mac1 samples correspond to human feces aliquot entered into sample reception.
I have found r sum(is.na(aliquotQC$Barcode_kk_slide) | is.na(aliquotQC$Barcode_macconkey)) cases where there is no KK1 sample or Mac1 sample that corresponds with a feces aliquot barcode number:
r aliquotQC_final <- aliquotQC %>% filter(is.na(aliquotQC$Barcode_kk_slide) | is.na(aliquotQC$Barcode_macconkey))
kable(aliquotQC_final) %>% kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed", "responsive"), full_width = F, font_size = 8)
LIMS Mac1 and Mac2 QC: number of Mac1 samples equal number of Mac2 samples.
I have found r sum((is.na(feces_mac$Date_process.y) | is.na(feces_mac$Date_process.x)) - (is.na(feces_mac$Date_process.y) & is.na(feces_mac$Date_process.x))) cases where the number of Mac1 samples does not equal the number Mac2 samples:
r mac_temp <- feces_mac %>% filter(is.na(feces_mac$Date_process.y) | is.na(feces_mac$Date_process.x))
r feces_mac_QC <- mac_temp %>% filter (!is.na(mac_temp$Date_process.x) | !is.na(mac_temp$Date_process.y)) %>% select (Barcode_sample, Date_receipt, Sample_type, Barcode_macconkey, Date_process.x, Date_process.y) %>% rename (Sample_reception_date = Date_receipt, Mac1_date = Date_process.x, Mac2_date = Date_process.y)
kable(feces_mac_QC) %>% kable_styling(bootstrap_options = c("striped", "hover", "bordered", "condensed", "responsive"), full_width = F, font_size = 8)
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.