Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly

Appearance settings
Jeanbosco edited this page Jun 30, 2026 · 1 revision

=========================================================

PACKAGES

=========================================================

library(shiny) library(httr) library(jsonlite) library(dplyr) library(tidyr) library(ggplot2) library(plotly) library(DT) library(forecast) library(leaflet) library(rmarkdown)

=========================================================

UI

=========================================================

ui <- fluidPage(

titlePanel("🏥 Surgical HMIS Intelligence Dashboard (DHIS2)"),

sidebarLayout(
	
	sidebarPanel(
		
		h4("🔐 DHIS2 Login"),
		
		# FIX 1: Added proper IDs "username" and "password"
		textInput("..", "Username"),
		passwordInput("..", "Password"),
		actionButton("load", "Connect & Load 2025 Data",
								 class = "btn-primary"),
		
		uiOutput("status_msg"),
		
		hr(),
		strong("📅 Period: January–December 2025"),
		
		hr(),
		
		h4("📄 Scientific Paper"),
		textInput("paper_title", "Title", "Surgical HMIS Analysis Report"),
		textInput("author",      "Author", "MoH Analyst"),
		actionButton("generate_paper", "Generate Paper"),
		downloadButton("download_paper", "⬇ Download Paper")
	),
	
	mainPanel(
		
		tabsetPanel(
			
			tabPanel("Overview",     DTOutput("table")),
			tabPanel("Descriptive",  verbatimTextOutput("desc")),
			tabPanel("Trend",        plotlyOutput("trend")),
			tabPanel("Surgery Mix",  plotlyOutput("mix")),
			tabPanel("Anesthesia",   plotlyOutput("anesthesia")),
			tabPanel("Waiting",      plotlyOutput("waiting")),
			tabPanel("Infection",    plotlyOutput("infection")),
			tabPanel("Forecast",     plotlyOutput("forecast")),
			tabPanel("Ranking",      DTOutput("ranking")),
			tabPanel("Anomalies",    plotlyOutput("anomalies")),
			tabPanel("Correlation",  plotlyOutput("correlation")),
			tabPanel("Map",          leafletOutput("map"))
		)
	)
)

)

=========================================================

SERVER

=========================================================

server <- function(input, output, session) {

# -------------------------------------------------------
# FIX 2: Store data in a reactiveVal so API is called
#         only ONCE when button is clicked, not on every
#         render call
# -------------------------------------------------------
hmis_data  <- reactiveVal(NULL)
name_lookup <- reactiveVal(NULL)   # id -> human name map

output$status_msg <- renderUI(NULL)

# =======================================================
# LOAD DATA ON BUTTON CLICK
# =======================================================
observeEvent(input$load, {
	
	req(input$username, input$password)
	
	auth <- authenticate("....", ".......")
	
	base_url   <- "https://aggregate.moh.gov.rw/api"
	dataset_id <- "iynGsJrWbuY"
	
	# ---- Show spinner ----
	output$status_msg <- renderUI(
		tags$p("⏳ Connecting to DHIS2…", style = "color:orange")
	)
	
	# --------------------------------------------------
	# STEP 1 – METADATA  (get element IDs + names)
	# --------------------------------------------------
	meta_res <- tryCatch(
		GET(
			paste0(base_url, "/dataSets/", iynGsJrWbuY,
						 "?fields=dataSetElements[dataElement[id,name]]"),
			auth
		),
		error = function(e) NULL
	)
	
	if (is.null(meta_res) || status_code(meta_res) != 200) {
		output$status_msg <- renderUI(
			tags$p("❌ Metadata fetch failed. Check credentials / VPN.",
						 style = "color:red")
		)
		return()
	}
	
	meta <- content(meta_res, "parsed", simplifyVector = TRUE)
	
	# Build id→name lookup
	elems <- meta$dataSetElements
	ids   <- sapply(elems, function(x) x$dataElement$id)
	names_vec <- sapply(elems, function(x) x$dataElement$name)
	lookup <- setNames(names_vec, ids)
	name_lookup(lookup)
	
	dx <- paste(ids, collapse = ";")
	
	# --------------------------------------------------
	# FIX 3: Correct period strings (Jan–Dec 2025)
	#         DHIS2 monthly format = "YYYYMM"
	# --------------------------------------------------
	months <- sprintf("2025%02d", 1:5)   # "202501" … "202512"
	pe     <- paste(months, collapse = ";")
	
	# --------------------------------------------------
	# FIX 4: Add orgUnit dimension (required by analytics)
	#         Using the Rwanda national level OU
	# --------------------------------------------------
	ou <- "ImspTQPwCqd"   # ← replace with your actual top-level OU uid
	# Tip: find yours at:
	# GET https://aggregate.moh.gov.rw/api/organisationUnits?level=1&fields=id,name
	
	analytics_url <- paste0(
		base_url, "/analytics.json",
		"?dimension=dx:", dx,
		"&dimension=pe:", pe,
		"&dimension=ou:", ou,
		"&displayProperty=NAME"    # returns human-readable names in headers
	)
	
	data_res <- tryCatch(
		GET(analytics_url, auth),
		error = function(e) NULL
	)
	
	if (is.null(data_res) || status_code(data_res) != 200) {
		output$status_msg <- renderUI(
			tags$p(
				paste0("❌ Analytics API failed (HTTP ",
							 if (!is.null(data_res)) status_code(data_res) else "?",
							 "). Check OU uid or date range."),
				style = "color:red"
			)
		)
		return()
	}
	
	parsed <- content(data_res, "parsed", simplifyVector = TRUE)
	
	if (is.null(parsed$rows) || length(parsed$rows) == 0) {
		output$status_msg <- renderUI(
			tags$p("⚠️ Connected but no data returned for 2025. 
           The dataset may have no values yet for this period.",
						 style = "color:darkorange")
		)
		return()
	}
	
	# --------------------------------------------------
	# FIX 5: Build df safely using header names
	# --------------------------------------------------
	headers <- parsed$headers$name   # e.g. c("dx","pe","ou","value")
	
	df <- as.data.frame(parsed$rows, stringsAsFactors = FALSE)
	colnames(df) <- headers
	
	# Rename to friendly names regardless of header order
	colnames(df)[colnames(df) == "dx"]    <- "DataElement"
	colnames(df)[colnames(df) == "pe"]    <- "Period"
	colnames(df)[colnames(df) == "ou"]    <- "OrgUnit"
	colnames(df)[colnames(df) == "value"] <- "Value"
	
	df$Value <- as.numeric(df$Value)
	
	# Replace IDs with human names using displayProperty=NAME
	# (DHIS2 returns names directly when displayProperty=NAME is set)
	# If names come back as IDs, use lookup:
	if (all(nchar(df$DataElement) == 11)) {   # still UIDs
		df$DataElement <- lookup[df$DataElement]
	}
	
	hmis_data(df)
	
	write.csv(df, "hmis_surgical_2025.csv", row.names = FALSE)
	
	output$status_msg <- renderUI(
		tags$p(
			paste0("✅ Loaded ", nrow(df), " records."),
			style = "color:green"
		)
	)
})

# -------------------------------------------------------
# Helper: gate all outputs on data being available
# -------------------------------------------------------
df_ready <- reactive({
	req(hmis_data())
	hmis_data()
})

# =======================================================
# TABLE
# =======================================================
output$table <- renderDT({
	datatable(df_ready(), options = list(pageLength = 15))
})

# =======================================================
# DESCRIPTIVE
# =======================================================
output$desc <- renderPrint({
	df <- df_ready()
	cat("===== SURGICAL HMIS SUMMARY 2025 =====\n")
	cat("Total records  :", nrow(df), "\n")
	cat("Data elements  :", n_distinct(df$DataElement), "\n")
	cat("Org units      :", n_distinct(df$OrgUnit), "\n")
	cat("Periods        :", paste(sort(unique(df$Period)), collapse=", "), "\n\n")
	cat("--- Value stats ---\n")
	print(summary(df$Value))
})

# =======================================================
# TREND
# =======================================================
output$trend <- renderPlotly({
	df <- df_ready()
	
	ts_data <- df %>%
		group_by(Period) %>%
		summarise(Value = sum(Value, na.rm = TRUE), .groups = "drop") %>%
		arrange(Period)
	
	ggplotly(
		ggplot(ts_data, aes(Period, Value, group = 1)) +
			geom_line(color = "steelblue", linewidth = 1) +
			geom_point(color = "steelblue", size = 2) +
			labs(title = "Monthly Surgical Activity 2025",
					 x = "Period (YYYYMM)", y = "Total Volume") +
			theme_minimal() +
			theme(axis.text.x = element_text(angle = 45, hjust = 1))
	)
})

# =======================================================
# SURGERY MIX
# =======================================================
output$mix <- renderPlotly({
	df <- df_ready()
	
	mix <- df %>%
		group_by(DataElement) %>%
		summarise(Value = sum(Value, na.rm = TRUE), .groups = "drop") %>%
		arrange(desc(Value))
	
	plot_ly(mix,
					x = ~reorder(DataElement, -Value),
					y = ~Value,
					type = "bar",
					marker = list(color = "steelblue")) %>%
		layout(title = "Surgery Mix by Data Element",
					 xaxis = list(title = "", tickangle = -40),
					 yaxis = list(title = "Volume"))
})

# =======================================================
# FIX 6: Anesthesia – match on real element names
#         Change the grep pattern to match YOUR data element
#         names (run Overview tab first to see exact names)
# =======================================================
output$anesthesia <- renderPlotly({
	df <- df_ready()
	
	ana <- df %>%
		filter(grepl("anaesthe|anesthes|anaesth", tolower(DataElement))) %>%
		group_by(DataElement) %>%
		summarise(Value = sum(Value, na.rm = TRUE), .groups = "drop")
	
	if (nrow(ana) == 0) {
		return(plotly_empty() %>%
					 	layout(title = "No anesthesia-related elements found.\nCheck element names in Overview tab."))
	}
	
	plot_ly(ana, labels = ~DataElement, values = ~Value, type = "pie") %>%
		layout(title = "Anesthesia Type Distribution")
})

# =======================================================
# FIX 7: Waiting – flexible pattern
# =======================================================
output$waiting <- renderPlotly({
	df <- df_ready()
	
	wait <- df %>%
		filter(grepl("wait|liste|queue", tolower(DataElement))) %>%
		group_by(DataElement) %>%
		summarise(Value = sum(Value, na.rm = TRUE), .groups = "drop")
	
	if (nrow(wait) == 0) {
		return(plotly_empty() %>%
					 	layout(title = "No waiting-list elements found.\nCheck element names in Overview tab."))
	}
	
	plot_ly(wait, x = ~DataElement, y = ~Value, type = "bar") %>%
		layout(title = "Surgical Waiting List")
})

# =======================================================
# FIX 8: Infection – flexible pattern
# =======================================================
output$infection <- renderPlotly({
	df <- df_ready()
	
	inf <- df %>%
		filter(grepl("infect|ssi|sepsis|wound", tolower(DataElement))) %>%
		group_by(Period) %>%
		summarise(Value = sum(Value, na.rm = TRUE), .groups = "drop") %>%
		arrange(Period)
	
	if (nrow(inf) == 0) {
		return(plotly_empty() %>%
					 	layout(title = "No infection-related elements found.\nCheck element names in Overview tab."))
	}
	
	plot_ly(inf, x = ~Period, y = ~Value,
					type = "scatter", mode = "lines+markers") %>%
		layout(title = "Surgical Site Infection Trend")
})

# =======================================================
# FIX 9: Forecast – needs ≥6 periods; warns if too few
# =======================================================
output$forecast <- renderPlotly({
	df <- df_ready()
	
	ts_data <- df %>%
		group_by(Period) %>%
		summarise(Value = sum(Value, na.rm = TRUE), .groups = "drop") %>%
		arrange(Period)
	
	n <- nrow(ts_data)
	
	if (n < 6) {
		return(plotly_empty() %>%
					 	layout(title = paste0(
					 		"Forecast needs ≥6 months of data. Currently only ",
					 		n, " period(s) available."
					 	)))
	}
	
	ts_obj <- ts(ts_data$Value, frequency = 12)
	model  <- tryCatch(auto.arima(ts_obj), error = function(e) NULL)
	
	if (is.null(model)) {
		return(plotly_empty() %>% layout(title = "ARIMA model failed."))
	}
	
	fc <- forecast(model, h = 6)
	
	x_hist <- seq_len(n)
	x_fore <- seq(n + 1, n + 6)
	
	plot_ly() %>%
		add_lines(x = x_hist, y = as.numeric(ts_obj),
							name = "Actual", line = list(color = "steelblue")) %>%
		add_lines(x = x_fore, y = as.numeric(fc$mean),
							name = "Forecast", line = list(color = "red", dash = "dash")) %>%
		add_ribbons(x = x_fore,
								ymin = as.numeric(fc$lower[, 2]),
								ymax = as.numeric(fc$upper[, 2]),
								name = "95% CI",
								fillcolor = "rgba(255,0,0,0.1)",
								line = list(color = "transparent")) %>%
		layout(title = "6-Month Surgical Volume Forecast",
					 xaxis = list(title = "Month index"),
					 yaxis = list(title = "Volume"))
})

# =======================================================
# RANKING
# =======================================================
output$ranking <- renderDT({
	df <- df_ready()
	
	rank <- df %>%
		group_by(OrgUnit) %>%
		summarise(Total = sum(Value, na.rm = TRUE), .groups = "drop") %>%
		arrange(desc(Total)) %>%
		mutate(Rank = row_number())
	
	datatable(rank, options = list(pageLength = 15))
})

# =======================================================
# ANOMALIES
# =======================================================
output$anomalies <- renderPlotly({
	df <- df_ready()
	
	anom <- df %>%
		group_by(OrgUnit) %>%
		summarise(Value = sum(Value, na.rm = TRUE), .groups = "drop") %>%
		mutate(
			z       = (Value - mean(Value, na.rm = TRUE)) / sd(Value, na.rm = TRUE),
			anomaly = abs(z) > 2,
			color   = ifelse(anomaly, "Anomaly", "Normal")
		)
	
	plot_ly(anom,
					x     = ~OrgUnit,
					y     = ~Value,
					color = ~color,
					colors = c("Normal" = "steelblue", "Anomaly" = "red"),
					type  = "bar") %>%
		layout(title = "Facility-level Anomaly Detection (|z| > 2)",
					 xaxis = list(tickangle = -40))
})

# =======================================================
# CORRELATION
# =======================================================
output$correlation <- renderPlotly({
	df <- df_ready()
	
	wide <- df %>%
		group_by(DataElement, OrgUnit) %>%
		summarise(Value = sum(Value, na.rm = TRUE), .groups = "drop") %>%
		pivot_wider(names_from = DataElement, values_from = Value,
								values_fill = 0)
	
	num_cols <- wide %>% select(-OrgUnit)
	
	if (ncol(num_cols) < 2) {
		return(plotly_empty() %>%
					 	layout(title = "Need ≥2 data elements for correlation."))
	}
	
	corr <- cor(num_cols, use = "pairwise.complete.obs")
	
	plot_ly(
		x = colnames(corr),
		y = rownames(corr),
		z = corr,
		type      = "heatmap",
		colorscale = "RdBu",
		zmin = -1, zmax = 1
	) %>%
		layout(title = "Correlation Matrix of Surgical Indicators")
})

# =======================================================
# MAP  (basic tiles; extend with facility coords if available)
# =======================================================
output$map <- renderLeaflet({
	leaflet() %>%
		addTiles() %>%
		setView(lng = 29.87, lat = -1.94, zoom = 8)   # Rwanda centre
})

# =======================================================
# PAPER GENERATION
# =======================================================
paper_file <- reactiveVal(NULL)

observeEvent(input$generate_paper, {
	df <- df_ready()
	
	rmd <- tempfile(fileext = ".Rmd")
	out <- tempfile(fileext = ".html")
	
	top5 <- df %>%
		group_by(DataElement) %>%
		summarise(Total = sum(Value, na.rm = TRUE), .groups = "drop") %>%
		arrange(desc(Total)) %>%
		head(5)
	
	writeLines(c(
		"---",
		paste0("title: '", input$paper_title, "'"),
		paste0("author: '", input$author, "'"),
		"date: '`r Sys.Date()`'",
		"output: html_document",
		"---",
		"",
		"## 1. Introduction",
		"This report summarises surgical HMIS data extracted from DHIS2 for 2025.",
		"",
		"## 2. Summary Statistics",
		paste("- Total records:", nrow(df)),
		paste("- Data elements:", n_distinct(df$DataElement)),
		paste("- Org units:", n_distinct(df$OrgUnit)),
		paste("- Periods covered:", paste(sort(unique(df$Period)), collapse = ", ")),
		paste("- Mean value:", round(mean(df$Value, na.rm = TRUE), 2)),
		paste("- Median value:", round(median(df$Value, na.rm = TRUE), 2)),
		"",
		"## 3. Top 5 Surgical Indicators",
		knitr::kable(top5, format = "markdown"),
		"",
		"## 4. Conclusion",
		"Further disaggregation by facility and procedure type is recommended."
	), rmd)
	
	tryCatch({
		rmarkdown::render(rmd, output_file = out, quiet = TRUE)
		paper_file(out)
		showNotification("✅ Paper generated successfully!", type = "message")
	}, error = function(e) {
		showNotification(paste("❌ Paper generation failed:", e$message), type = "error")
	})
})

output$download_paper <- downloadHandler(
	filename = function() paste0("HMIS_Surgical_", Sys.Date(), ".html"),
	content  = function(file) {
		req(paper_file())
		file.copy(paper_file(), file)
	}
)

}

=========================================================

RUN APP

=========================================================

shinyApp(ui, server)

Clone this wiki locally

Morty Proxy This is a proxified and sanitized view of the page, visit original site.