In Rapporteket/nnrr: Resultatrapporter for Norsk nakke- og ryggregister

knitr::opts_chunk$set(echo = FALSE)

Bakgrunn/innledning

Denne rapporten tar for seg datakvaliteten i NNRR. Den fokuserer på utfyllingsgrad og ser på følgende problemstillinger:

• Andel besvart av spørsmålene
• Forholdet mellom utfylte pasientskjema og behandlerskjema

NNRR består av tre skjemaer:

• Pasientskjema før behandling - 1a
• Behandlerskjema - 1b
• Pasientskjema etter behandling - 2

Skjemaene har felter som i MRS-løsningen er delt inn i følgende datatyper:

• Dato/Tid
• Enkeltvalg
• Numerisk (heltall)
• Numerisk (flyttall)
• Text
• Avkrysning
• Id (Guid)

De tre NNRR-skjemaene har (ifølge kodebok hentet fra MRS-løsningen) følgende fordeling av datatyper.

rm(list = ls())
library(nnrr)
# library(xtable)
library(knitr)
library(printr)
library(tidyverse)
kodebok1a <- read.table('I:/nnrr/Kodebok1a_feb2019.csv', sep=';', header=T, stringsAsFactors=F)
kodebok1b <- read.table('I:/nnrr/Kodebok1b_feb2019.csv', sep=';', header=T, stringsAsFactors=F)
kodebok2 <- read.table('I:/nnrr/Kodebok2_feb2019.csv', sep=';', header=T, stringsAsFactors=F)

felttyper <- sort(unique(c(kodebok1a$Felttype, kodebok1b$Felttype, kodebok2$Felttype)))

kodebok1a$Felttype <- factor(kodebok1a$Felttype, levels = felttyper)
kodebok1b$Felttype <- factor(kodebok1b$Felttype, levels = felttyper)
kodebok2$Felttype <- factor(kodebok2$Felttype, levels = felttyper)

tab_1a <- table(kodebok1a$Felttype)[-1]
tab_1b <- table(kodebok1b$Felttype)[-1]
tab_2 <- table(kodebok2$Felttype)[-1]

Oppsum <- rbind(rbind(tab_1a, tab_2), tab_1b)
row.names(Oppsum) <- c('Skjema 1a', 'Skjema 2', 'Skjema 1b')

knitr::kable(Oppsum, caption = 'Antallet felter på NNRR sine skjema etter felttype')

Denne rapporten fokuserer på tre datatyper, Avkrysning, Enkeltvalg og Numerisk siden disse utgjør mesteparten av feltene. Her følger en kort forklaring til datatypene.

Avkrysning

Dette er boolske variabler (True/False) med default-verdi "False". Avkrysningsboksene er typisk organisert under overskrifter hvor én eller flere kryss forventes satt. Det finnes derfor ingen fasit på hvor mange bokser som skal være avkrysset ved en komplett utfylling.

Enkeltvalg

Dette er kategoriske variabler hvor ett alternativ velges fra en liste. I de fleste tilfeller er manglende verdier kodet som -1 men i noen tilfeller kodes de med 0. I presentasjon av utfyllingsgrad brukes kun de Enkeltvalg-variablene som er kodet numerisk i datadumpen, hvilket gjør at en del variabler faller bort fra vurderingen. I tillegg må det presiseres at ikke alle registrerte nødvendigvis skal svare på alle spørsmål. F.eks. finnes det nakkespesifikke verktøy som ikke skal benyttes av de med utelukkende ryggsmerter.

Numerisk

Disse variablene er som regel én av tre typer:

• Velg et antall (f.eks. barn) eller tall på en skala (f.eks. smerter fra 0-10).
• Koding for et svaralternativ som skal inngå i beregningen av en score.
• En score eller prosent

datoFra <- '2019-01-01'
datoTil <- '2019-12-31'

skjema1b <- read.table('I:/nnrr/DataDump_MRS-PROD_1b_Registreringsskjema+poliklinikk_2020-08-04.csv', sep=';',
                         header=T, fileEncoding = 'UTF-8-BOM', stringsAsFactors = F)
skjema1a <- read.table('I:/nnrr/DataDump_MRS-PROD_1a_Spørreskjema+før+behandling_2020-08-04_red.csv', sep=';',
                              header=T, stringsAsFactors = F)
skjema2 <- read.table('I:/nnrr/DataDump_MRS-PROD_2_Spørreskjema+etter+behandling_2020-08-04.csv', sep=';',
                               header=T, fileEncoding = 'UTF-8-BOM', stringsAsFactors = F)

dato_var1a <- as.character(kodebok1a$Variabelnavn)[which(as.character(kodebok1a$Felttype) == 'Dato/tid')]
dato_var1a <- intersect(dato_var1a, names(skjema1a))
dato_var1b <- as.character(kodebok1b$Variabelnavn)[which(as.character(kodebok1b$Felttype) == 'Dato/tid')]
dato_var1b <- intersect(dato_var1b, names(skjema1b))
dato_var2 <- as.character(kodebok2$Variabelnavn)[which(as.character(kodebok2$Felttype) == 'Dato/tid')]
dato_var2 <- intersect(dato_var2, names(skjema2))
skjema1a[, dato_var1a] <- mutate_all(skjema1a[, dato_var1a], funs(as.Date(., format="%d.%m.%Y")))
skjema1b[, dato_var1b] <- mutate_all(skjema1b[, dato_var1b], funs(as.Date(., format="%d.%m.%Y")))
skjema2[, dato_var2] <- mutate_all(skjema2[, dato_var2], funs(as.Date(., format="%d.%m.%Y")))

skjema1b$Hoveddato <- skjema1b$S1b_DateOfCompletion
skjema1b <- skjema1b[which(skjema1b$Hoveddato >= datoFra & skjema1b$Hoveddato <= datoTil), ]
skjema1b <- skjema1b[order(skjema1b$Hoveddato), ]
skjema1a$Hoveddato <- skjema1a$S1b_DateOfCompletion
skjema1a <- skjema1a[which(skjema1a$Hoveddato >= datoFra & skjema1a$Hoveddato <= datoTil), ]
skjema2$Hoveddato <- skjema2$DateOfCompletion
skjema2 <- skjema2[which(skjema2$Hoveddato >= datoFra & skjema2$Hoveddato <= datoTil), ]


boolske_var1a <- as.character(kodebok1a$Variabelnavn)[which(as.character(kodebok1a$Felttype) == 'Avkrysning')]
enum_var1a <- as.character(kodebok1a$Variabelnavn)[which(as.character(kodebok1a$Felttype) == 'Enkeltvalg')]
numerisk_var1a <- as.character(kodebok1a$Variabelnavn)[which(as.character(kodebok1a$Felttype) %in% c('Numerisk (heltall)', 'Numerisk (flyttall)'))]
boolske_var1b <- as.character(kodebok1b$Variabelnavn)[which(as.character(kodebok1b$Felttype) == 'Avkrysning')]
enum_var1b <- as.character(kodebok1b$Variabelnavn)[which(as.character(kodebok1b$Felttype) == 'Enkeltvalg')]
# enum_var1b <- c('NeckSurgery', 'PelvisSurgery', 'PrevSickLeave', 'RadiologicalF_Spondylolisthesis', 'RadiologicalF_Scoliosis_Subcategory', 'Treatment_InvidualInterdisciplinary', 'Treatment_GroupInterdisciplinary')
numerisk_var1b <- as.character(kodebok1b$Variabelnavn)[which(as.character(kodebok1b$Felttype) %in% c('Numerisk (heltall)', 'Numerisk (flyttall)'))]
boolske_var2 <- as.character(kodebok2$Variabelnavn)[which(as.character(kodebok2$Felttype) == 'Avkrysning')]
boolske_var2 <- intersect(boolske_var2, names(skjema2))
enum_var2 <- as.character(kodebok2$Variabelnavn)[which(as.character(kodebok2$Felttype) == 'Enkeltvalg')]
enum_var2 <- intersect(enum_var2, names(skjema2))
numerisk_var2 <- as.character(kodebok2$Variabelnavn)[which(as.character(kodebok2$Felttype) %in% c('Numerisk (heltall)', 'Numerisk (flyttall)'))]
numerisk_var2 <- intersect(numerisk_var2, names(skjema2))

skjema1a[, boolske_var1a] <- apply(skjema1a[, boolske_var1a], 2, as.logical)
skjema1b[, boolske_var1b] <- apply(skjema1b[, boolske_var1b], 2, as.logical)
skjema2[, boolske_var2] <- apply(skjema2[, boolske_var2], 2, as.logical)

skjema1a_bak <- skjema1a

enum_var1b <- enum_var1b[sapply((skjema1b[, enum_var1b]), class) != "character"]
enum_var1a <- enum_var1a[sapply((skjema1a[, enum_var1a]), class) != "character"]
enum_var2 <- enum_var2[sapply((skjema2[, enum_var2]), class) != "character"]

skjema1a[, enum_var1a] <- apply(skjema1a[, enum_var1a], 2, function(x){as.numeric(!(x == min(x, na.rm = T) | is.na(x)))})
skjema1b[, enum_var1b] <- apply(skjema1b[, enum_var1b], 2, function(x){as.numeric(!(x == min(x, na.rm = T) | is.na(x)))})
skjema2[, enum_var2] <- apply(skjema2[, enum_var2], 2, function(x){as.numeric(!(x == min(x, na.rm = T) | is.na(x)))})

ingen_avkrysninger1a <- which(rowSums(skjema1a[, boolske_var1a])==0)
ingen_enum1a <- which(rowSums(skjema1a[, enum_var1a])<=1)
ingen_avkrysninger1b <- which(rowSums(skjema1b[, boolske_var1b])==0)
ingen_enum1b <- which(rowSums(skjema1b[, enum_var1b])<=1)
ingen_avkrysninger2 <- which(rowSums(skjema2[, boolske_var2])==0)
ingen_enum2 <- which(rowSums(skjema2[, enum_var2])<=1)

skjema1b$SykehusNavn <- NA
skjema1b$SykehusNavn[skjema1b$UnitId == 102959] <- 'Haukeland'
skjema1b$SykehusNavn[skjema1b$UnitId == 104293] <- 'St. Olavs'
skjema1b$SykehusNavn[skjema1b$UnitId == 109834] <- 'OUS'
skjema1b$SykehusNavn[skjema1b$UnitId == 601032] <- 'UNN'

skjema1a$SykehusNavn <- NA
skjema1a$SykehusNavn[skjema1a$UnitId == 102959] <- 'Haukeland'
skjema1a$SykehusNavn[skjema1a$UnitId == 104293] <- 'St. Olavs'
skjema1a$SykehusNavn[skjema1a$UnitId == 109834] <- 'OUS'
skjema1a$SykehusNavn[skjema1a$UnitId == 601032] <- 'UNN'

# Kommenter inn hvis OUS skal ekskluderes:
skjema1a <- skjema1a[which(skjema1a$UnitId != 109834), ]
skjema1b <- skjema1b[which(skjema1b$UnitId != 109834), ]

manglende1bPrShus <- tapply(skjema1b$SkjemaGUID[ingen_avkrysninger1b], as.factor(skjema1b$SykehusNavn)[ingen_avkrysninger1b], length)
Totalt1bPrShus <- tapply(skjema1b$SkjemaGUID, as.factor(skjema1b$SykehusNavn), length) #[-3]
manglende1bPrShus <- as.data.frame(cbind(manglende1bPrShus, Totalt1bPrShus))
names(manglende1bPrShus) <- c('Tomme', 'Totalt')

skjema1a[, numerisk_var1a] <- apply(skjema1a[, numerisk_var1a], 2, function(x){as.numeric(sapply(as.character(x), gsub, pattern = ",", replacement= "."))})
skjema1b[, numerisk_var1b] <- apply(skjema1b[, numerisk_var1b], 2, function(x){as.numeric(sapply(as.character(x), gsub, pattern = ",", replacement= "."))})
skjema2[, numerisk_var2] <- apply(skjema2[, numerisk_var2], 2, function(x){as.numeric(sapply(as.character(x), gsub, pattern = ",", replacement= "."))})

Forhold mellom skjema

dobbel_1a <- names(sort(table(skjema1a$HovedskjemaGUID), decreasing = T)[sort(table(skjema1a$HovedskjemaGUID), 
                                                                           decreasing = T)>1])
dobbel_2 <- names(sort(table(skjema2$HovedskjemaGUID), decreasing = T)[sort(table(skjema2$HovedskjemaGUID), 
                                                                           decreasing = T)>1])
dobbel_1b <- names(sort(table(skjema1b$SkjemaGUID), decreasing = T)[sort(table(skjema1b$SkjemaGUID), 
                                                                           decreasing = T)>1])

mangler1b <- length(setdiff(skjema1a$HovedskjemaGUID, skjema1b$SkjemaGUID))
mangler1a <- length(setdiff(skjema1b$SkjemaGUID, skjema1a$HovedskjemaGUID))
potensiellOppf <- length(skjema1b$SkjemaGUID[skjema1b$Hoveddato <= '2018-06-01'])
manglerOppf <- length(setdiff(skjema1b$SkjemaGUID[skjema1b$Hoveddato <= '2018-06-01'], skjema2$HovedskjemaGUID))

Denne rapporten benytter data fra pasienter med besøksdato mellom r min(skjema1a$Hoveddato) og r max(skjema1a$Hoveddato) samt oppfølginger registrert mellom r min(skjema2$Hoveddato) og r max(skjema2$Hoveddato). OUS er utelukket fra rapporten siden en kjent bug fra seneste oppdatering av registeret gjør at all data fra OUS fra mai 2018 og fremover i praksis er ubrukelige.

Det er totalt r dim(skjema1a)[1] skjema 1a i utvalget og r dim(skjema1b)[1] skjema 1b. A disse er det r mangler1b pasientskjema som mangler klinikerskjema og r mangler1a klinikerskjema som mangler pasientskjema. Av de r potensiellOppf som hadde konsultasjon 7 eller flere måneder siden er det r manglerOppf som ikke har oppfølgingsdata.

Manglende utfyllinger

Numeriske variabler

Skjema 1a

Andel_tom_num <- data.frame(Antall_tom=apply(skjema1a[, numerisk_var1a], 2, function(x){sum(is.na(x))}), N=dim(skjema1a)[1])
Andel_tom_num$Andel <- round(Andel_tom_num$Antall_tom/Andel_tom_num$N*100, 1)
Andel_tom_num[,-2]
# tmp <- skjema1a[, c(numerisk_var1a, "SykehusNavn")] %>%
#   group_by(SykehusNavn) %>%
#   summarise_all(funs(sum(is.na(.)))) %>% tr_summarize_output()

Skjema 1b

Andel_tom_num <- data.frame(Antall_tom=apply(skjema1b[, numerisk_var1b], 2, function(x){sum(is.na(x))}), N=dim(skjema1b)[1])
Andel_tom_num$Andel <- round(Andel_tom_num$Antall_tom/Andel_tom_num$N*100, 1)
Andel_tom_num[,-2]
# tmp <- skjema1a[, c(numerisk_var1a, "SykehusNavn")] %>%
#   group_by(SykehusNavn) %>%
#   summarise_all(funs(sum(is.na(.)))) %>% tr_summarize_output()

Skjema 2

Andel_tom_num <- data.frame(Antall_tom=apply(skjema2[, numerisk_var2], 2, function(x){sum(is.na(x))}), N=dim(skjema2)[1])
Andel_tom_num$Andel <- round(Andel_tom_num$Antall_tom/Andel_tom_num$N*100, 1)
Andel_tom_num[,-2]
# tmp <- skjema1a[, c(numerisk_var1a, "SykehusNavn")] %>%
#   group_by(SykehusNavn) %>%
#   summarise_all(funs(sum(is.na(.)))) %>% tr_summarize_output()

Kategoriske variabler

Skjema 1a

Andel_tom_kat <- data.frame(Antall_tom=apply(skjema1a[, enum_var1a], 2, function(x){sum(x==0)}), N=dim(skjema1a)[1])
Andel_tom_kat$Andel <- round(Andel_tom_kat$Antall_tom/Andel_tom_kat$N*100, 1)
Andel_tom_kat[,-2]

Skjema 1b

Andel_tom_kat <- data.frame(Antall_tom=apply(skjema1b[, enum_var1b], 2, function(x){sum(x==0)}), N=dim(skjema1b)[1])
Andel_tom_kat$Andel <- round(Andel_tom_kat$Antall_tom/Andel_tom_kat$N*100, 1)
Andel_tom_kat[,-2]

Skjema 2

Andel_tom_kat <- data.frame(Antall_tom=apply(skjema2[, enum_var2], 2, function(x){sum(x==0)}), N=dim(skjema2)[1])
Andel_tom_kat$Andel <- round(Andel_tom_kat$Antall_tom/Andel_tom_kat$N*100, 1)
Andel_tom_kat[,-2]

Avkrysningsvariabler

Denne variabeltypen kan per design ikke være tom så det er umulig å si hva det korrekte antallet avkrysninger er. Tabellen over andelen som ikke har krysset av for variablene under er derfor vanskelig å tolke. Tabellen over hvor mange avkrysninger det er per skjema er kanskje bedre egnet til å avsløre manglende registreringer. Skjema 1a har r length(boolske_var1a) avkrysningsbokser, mens skjema 1b og skjema 2 har henholdsvis r length(boolske_var1b) og r length(boolske_var2). Hvis bare en svært liten andel er avkrysset på et skjema er det muligens grunn til å være skeptisk til datakvaliteten.

Skjema 1a

Andel_tom_boolsk <- data.frame(Antall_FALSE=apply(skjema1a[, boolske_var1a], 2, function(x){sum(!x)}), N=dim(skjema1a)[1])
Andel_tom_boolsk$Andel <- round(Andel_tom_boolsk$Antall_FALSE/Andel_tom_boolsk$N*100, 1)
Andel_tom_boolsk[,-2]

Antall avkrysninger per skjema

table(rowSums(skjema1a[, boolske_var1a]))

Skjema 1b

Andel_tom_boolsk <- data.frame(Antall_FALSE=apply(skjema1b[, boolske_var1b], 2, function(x){sum(!x)}), N=dim(skjema1b)[1])
Andel_tom_boolsk$Andel <- round(Andel_tom_boolsk$Antall_FALSE/Andel_tom_boolsk$N*100, 1)
Andel_tom_boolsk[,-2]

Antall avkrysninger per skjema

table(rowSums(skjema1b[, boolske_var1b]))

Skjema 2

Andel_tom_boolsk <- data.frame(Antall_FALSE=apply(skjema2[, boolske_var2], 2, function(x){sum(!x)}), N=dim(skjema2)[1])
Andel_tom_boolsk$Andel <- round(Andel_tom_boolsk$Antall_FALSE/Andel_tom_boolsk$N*100, 1)
Andel_tom_boolsk[,-2]

Antall avkrysninger per skjema

table(rowSums(skjema2[, boolske_var2]))

Rapporteket/nnrr documentation built on Jan. 27, 2023, 5:53 p.m.