National Electronic Injury Surveillance System

data neiss2122; 

set desk.neiss2019 desk.neiss2020 desk.neiss2021 desk.neiss2022;

if age = 0 then age = .;

if age > 120 then do;

agelt2 = age;

age = .;

end;

if sex = 0 then sex =.;

if race = 0 then race = .;

if hispanic = 0 then hispanic= .;

if disp = 9 then disp = .;

if loc = 0 then loc = .;

format agelt2 agelttwo. sex gender. race race. hispanic hisp. bdpt bdypt. 

diag diag. disp disp. loc loc. prod1 prod2 prod3 prod.;

run;

proc format;

value dayofweek  

1 = "Sunday"

2 = "Monday"

3 = "Tuesday"

4 = "Wednesday"

5 = "Thursday"

6 = "Friday"

7 = "Saturday"

;

value monthtime

1 = "Jan"

2 = "Feb"

3 = "Mar"

4 = "Apr"

5 = "May"

6 = "Jun"

7 = "Jul"

8 = "Aug"

9 = "Sep"

10 = "Oct"

11 = "Nov"

12 = "Dec"

;

run;

data anno;

infile datalines dlm='#';

length function $20.; 

length xc1 $ 10.;

length fillcolor $ 30.;

length linecolor $ 30.;

length layer $ 20.;

length fillstyleelement $ 30.;

length label $ 200.;

input function height width X1 Y1 linecolor label;

datalines;

*text # # 40 # 90 # 2 # # Source: 2019 - 2022 National Electronic Injury Surveillance System Data;

datalines; 

;

run;

data annofootball;

infile datalines dlm='#';

length function $20.; 

length xc1 $ 10.;

length fillcolor $ 30.;

length linecolor $ 30.;

length layer $ 20.;

length fillstyleelement $ 30.;

length label $ 200.;

input function height width X1 Y1 linecolor label ;

datalines;

text # # 40 # 63 # 19 # # T R A I N I N G

text # # 40 # 82 # 19 # # N F L S E A S O N

datalines; 

;

run;

%macro word(KEYWORD, quote, anno);

proc sql;

create table neiss_1_&keyword as select *, 

Year(Trmt_date) as year,

month(Trmt_date) as month

from work.neiss2122

where narr1 like &quote;

quit;

data neiss_2_&keyword;

set neiss_1_&keyword;

if month <10 then YearMonth = catx('-', year, cats('0', month));

else YearMonth = catx('-', year, month);

weekday = weekday(trmt_date);

if year = 2019 then

dayofyear = trmt_date - '01JAN2019'd + 1;

else if year = 2020 then

dayofyear = trmt_date - '01JAN2020'd + 1;

else if year = 2021 then

dayofyear = trmt_date - '01JAN2021'd + 1;

else if year = 2022 then

dayofyear = trmt_date - '01JAN2022'd + 1;

run;

ods trace on;

ods output 'One-Way Distribution'=num&keyword;

proc surveyfreq data=neiss_2_&keyword;

stratum stratum;

cluster PSU;

weight wt;

tables Trmt_date ;

run;

ods output 'CrossTabulation Table'=month&keyword;

proc surveyfreq data=neiss_2_&keyword;

stratum stratum;

cluster PSU;

weight wt;

tables month*year ;

run;

ods output 'One-Way Distribution'=weekday_num&keyword;

proc surveyfreq data=neiss_2_&keyword;

stratum stratum;

cluster PSU;

weight wt;

tables weekday ;

run;

ods trace off;

data num_2_&keyword;

set num&keyword;

if _SkipLine = 1 then delete;

drop F_Trmt_date table _SkipLine;

Upper = wgtfreq + 1.96*stddev;

Lower = wgtfreq - 1.96*stddev;

if wgtfreq =. then wgtfreq = 0;

run;

proc expand data=num_2_&keyword out=num_2_&keyword;

convert wgtfreq=wgtfreq_smoothed / method=none transformout=(cmovave 7 trimleft 3);

convert upper = upper_smoothed / method=none transformout=(cmovave 30 trimleft 14);

convert lower = lower_smoothed / method=none transformout=(cmovave 30 trimleft 14);

run;

data month2&keyword;

set month&keyword;

if _SkipLine = 1 then delete;

if month = "Total" then delete;

drop F_year table _SkipLine;

Upper = wgtfreq + 1.96*stddev;

Lower = wgtfreq - 1.96*stddev;

if wgtfreq =. then wgtfreq = 0;

run;

%mend;

%macro graphs(KEYWORD, quote, anno);

footnote "Source: 2019 - 2022 National Electronic Injury Surveillance System Data";

ods graphics on /width = 1000px height=500px;

proc sgplot data=num_2_&keyword nowall;  

 title "Unintentional consumer product-related injuries and deaths involving &keyword";

*needle y=wgtfreq x=Trmt_date / lineattrs=(color=orange thickness=2px);

series x =trmt_date y=wgtfreq_smoothed /;

band x=trmt_date upper=Upper_smoothed lower=Lower_smoothed / transparency = 0.75 

       legendlabel="Smoothed 95% Confidence Intervals";

yaxis label='Number of Emergency Department Visits' min=0 labelpos = top;

xaxis label='Time' FITPOLICY=THIN ;

label wgtfreq_smoothed = "7-day Rolling Average Number of Emergency Department Visits (USA National Weighting)";

keylegend /down=2 noborder ;

run;title;

ods graphics on /width = 800px height=500px;

proc sgplot data=month2&keyword sganno=&anno nowall;  

 title "Unintentional consumer product-related injuries and deaths involving &keyword";

styleattrs datacontrastcolors=(DAPK LIOY LIYG VLIGB)

datalinepatterns=(solid);

vline month / response = wgtfreq group = year lineattrs=(thickness=3px) transparency = 0.15;

yaxis label='Number of Emergency Department Visits' min=0 labelpos = top;

xaxis label='Time' FITPOLICY=StaggerTHIN min = 1 max = 12;

label wgtfreq = "Daily Number of Emergency Department Visits (USA national weighting)";

label year = "Year";

format month monthtime.;

keylegend /noborder;

run;title;

ods graphics on /width = 500px height=500px;

proc sgplot data=weekday_num&keyword nowall;  

 title "Unintentional consumer product-related injuries and deaths involving &keyword";

needle y=percent x=weekday /lineattrs=( thickness=10px) ;

yaxis label='Percent of all Incidents' max = 50 min = 0 labelpos=top;

xaxis label='Day of the Week' FITPOLICY=staggerthin ;

format weekday dayofweek.;

run;

title;footnote;

ods graphics off;

%mend;

%word(Turkeys, '%TURKEY%', anno );

%grapsh(Turkeys, '%TURKEY%', anno );

%word(footballs, '%FOOTBALL%', annofootball);

%graphs(footballs, '%FOOTBALL%', annofootball);

find_grepl <- function(var, string){

        returnvalue <- NA

        for(i in 1:length(string)){

             case <- case_when(

              is.na(string[i])==F ~ case_when(

               grepl(toupper(string[i]), var)==T ~ str_to_title(string[i])

            ))

             returnvalue <-case_when(is.na(case)==F ~ case,

                                     .default = returnvalue)

        }

   return(returnvalue)

}

plot_dates <-function(string){

  plotdata <- neissdatafull %>%

      filter(grepl(paste(toupper(string),collapse="|"), narrative) == TRUE) %>%

      select(cpsc_case_number, treatment_date, weight, narrative)

  plotdata <- cbind(plotdata, data.frame(category = find_grepl(plotdata$narrative, string)))

  plot <- ggplot(plotdata, aes(treatment_date, weight = weight, group=category, fill=category)) + 

    geom_histogram(color="thistle4", breaks=seq(min(plotdata$treatment_date), max(plotdata$treatment_date), "months")) +

    scale_fill_manual(values=brewer.pal(n = length(string), name = "Pastel1"))+

    labs(title=str_wrap(paste("Weighted Number of Emergency Room Cases Involving:", str_to_title(paste(string, collapse = "|"))), width = 60), subtitle= "Source: National Electronic Injury Surveillance Sysytem (NEISS) Data", color="Injury Match") +

    xlab("Date") +

    scale_x_date(date_breaks = "years" , date_labels = "%Y") +

    ylab(str_wrap("Weighted Number of Cases", width = 8)) +

    theme_classic() +

    theme(axis.title.y = element_text(angle=0, vjust=0.5)) 

  return(plot)

  }

plot_dayofweek <- function(string){

    plotdata <- neissdatafull %>%

      filter(grepl(paste(toupper(string),collapse="|"), narrative) == TRUE) %>%

      mutate(dayofweek = factor(weekdays(treatment_date), c("Monday", "Tuesday", "Wednesday", "Thursday","Friday","Saturday", "Sunday"))) %>%

      select(cpsc_case_number, dayofweek, weight, narrative)

    plotdata <- cbind(plotdata, data.frame(category = find_grepl(plotdata$narrative, string)))

    plot <- ggplot(plotdata, aes(dayofweek, weight = weight, fill=category)) + 

    geom_bar(color="thistle4", position = "dodge") +

    scale_fill_manual(values=brewer.pal(n = length(string), name = "Pastel1"))+

    labs(title=str_wrap(paste("Weighted Number of Emergency Room Cases Involving:", str_to_title(paste(string, collapse = "|"))), width = 60), subtitle= "Source: National Electronic Injury Surveillance Sysytem (NEISS) Data") +

    xlab("Day of the Week") +

    ylab(str_wrap("Weighted Number of Cases", width = 8)) +

    theme_classic() +

    theme(axis.title.y = element_text(angle=0, vjust=0.5)) 

  return(plot)

}

plot_season <- function(string){

    plotdata <- neissdatafull %>%

      filter(grepl(paste(toupper(string),collapse="|"), narrative) == TRUE)

    plotdata <- cbind(plotdata, data.frame(category = find_grepl(plotdata$narrative, string)))

    plotdata <- plotdata %>%

      mutate(year = year(treatment_date), month = factor((months(treatment_date)), c("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December"))) %>%

      group_by(year, month) %>%

      summarize(count = sum(weight), .groups ="drop")%>%

      ungroup()%>%

      select(year, month, count)

  plot <- ggplot(plotdata, aes(x=month, y = count, group=year, color=year)) + 

    geom_line(size = 0.75) +

    labs(title=str_wrap(paste("Weighted Number of Emergency Room Cases Involving:", str_to_title(paste(string, collapse = "|"))), width = 60), subtitle= "Source: National Electronic Injury Surveillance Sysytem (NEISS) Data", color = "Year") +

    xlab("Month") +

    ylab(str_wrap("Weighted Number of Cases", width = 8)) +

    theme_classic() +

    theme(axis.title.y = element_text(angle=0, vjust=0.5), axis.text.x = element_text(angle = 45, vjust = 1, hjust=1))+

    scale_color_gradientn(colors=brewer.pal(n = 3, name = "Pastel1"), values=c(0, 0.5, 1))

  return(plot)

}

example_narrative <- function(string){

  exampledata <- neissdatafull %>%

      filter(grepl(paste(toupper(string),collapse="|"), narrative) == TRUE) %>%

      select(cpsc_case_number, narrative, weight, treatment_date)

  exampledata <- cbind(exampledata, data.frame(category = find_grepl(exampledata$narrative, string)))

  print(exampledata %>%

    group_by(category) %>%

    arrange(category)%>%

    filter(row_number(category)<6) %>%

    select(category, narrative))

}

demo_plot <- function(demo_fctr, string, demo_label = "demographic"){

    demodata <- neissdatafull %>%

    filter(grepl(paste(toupper(string),collapse="|"), narrative) == TRUE)

    demodata <- cbind(demodata, data.frame(category = find_grepl(demodata$narrative, string))) %>%

      select(demo_fctr, weight, category)

  demoplot <- ggplot(demodata, aes(str_wrap(demodata[,1], width=10), weight = weight, fill=category)) + 

    geom_bar(color="thistle4", position = "dodge") +

    scale_fill_manual(values=brewer.pal(n = length(string), name = "Pastel1"))+

    xlab(demo_label) +

    ylab(str_wrap("Weighted Number of Cases", width = 8)) +

    theme_classic() +

    theme(axis.title.y = element_text(angle=0, vjust=0.5)) 

  return(demoplot)

}

demo_plots <- function(string){

  genderplot <- demo_plot("gender_fctr", string, "Gender of Patient")

  raceplot <- demo_plot("race_fctr", string, "Race of Patient")

  locationplot <- demo_plot("location_fctr", string, "Location of Injury")

  dispositionplot <- demo_plot("disposition_fctr", string, "Result of ER Visit")

  alcoholplot <- demo_plot("alcohol_fctr", string, "Involvement of Alcohol")

  drugplot <- demo_plot("drug_fctr", string, "Involvement of Drugs")

  #set the layout

layout <- '

AA

BB

CC

DD

EF

'

#combine all three plots into one plot according to the layout

demoplot <- genderplot + raceplot + locationplot + dispositionplot + alcoholplot + drugplot +

  plot_layout(design = layout) +

  plot_annotation(title=str_wrap(paste("Weighted Number of Emergency Room Cases Involving:", str_to_title(paste(string, collapse = "|"))), width = 100), subtitle= "Source: National Electronic Injury Surveillance Sysytem (NEISS) Data")

return(demoplot)

}