library(xml2)
library(dplyr)
library(writexl)
library(vctrs)
# Perusrekisteri (XML)
<- tempfile(fileext = ".xml")
tmpfile download.file(url = "https://data.pilvi.fimea.fi/avoin-data/Perusrekisteri.xml",
tmpfile)<- xml2::read_xml(tmpfile)
raw <- xml2::as_list(raw)
raw_lst
<- raw_lst$Perusrekisteri
perusrekisteri
<- list()
versiotiedot <- list()
pakkaus <- list()
laakevalmiste <- list()
laakeaine for (o in seq(perusrekisteri)){
if (o %% 1000 == 0) print(o)
<- perusrekisteri[o][1]
i01 if (names(i01) == "Versiotiedot"){
<- i01$Versiotiedot
i02 <- names(i02)
nms_i02 <- list()
lst_i02 for (i in seq(nms_i02)){
<- i02[nms_i02[i]][[1]][[1]]
lst_i02[[nms_i02[i]]]
}<- lst_i02
versiotiedot[[o]]
}# Pakkaus01
if (names(i01) == "Pakkaus"){
<- i01$Pakkaus
i02 <- names(i02)
nms_i02 # if ("VNR-numero" %in% nms_i02){
# Kyseessä eka pakkaus-lista
<- list()
lst_i02 for (i in seq(nms_i02)){
# Jos attribuutteja
if (length(attributes(i02[nms_i02[i]][[1]])) > 0){
# ota attribuutti value
<- attributes(i02[nms_i02[i]][[1]])$value
lst_i02[[nms_i02[i]]] else {
} # jos elementin pituus on nolla, anna NA
if (length(i02[nms_i02[i]][[1]]) == 0){
<- NA
lst_i02[[nms_i02[i]]] else {
} # muuten ota suora arvo
<- i02[nms_i02[i]][[1]][[1]]
lst_i02[[nms_i02[i]]]
}
}
}<- as.data.frame(lst_i02)
pakkaus[[o]] # }
}# Laakevalmiste
# if (names(i01) == "Laakevalmiste") stop()
if (names(i01) == "Laakevalmiste"){
<- i01$Laakevalmiste
i02 <- names(i02)
nms_i02 <- list()
lst_i02 for (i in seq(nms_i02)){
# Myyntilupa
if ("Myyntilupa" %in% names(i02[nms_i02[i]])){
<- i02[nms_i02[i]]$Myyntilupa
i03 <- names(i03)
nms_i03 <- list()
lst_i03 for (ii in seq(nms_i03)){
# Jos attribuutteja
if (length(attributes(i03[nms_i03[ii]][[1]])) > 0){
# ota attribuutti value
<- attributes(i03[nms_i03[ii]][[1]])$value
lst_i03[[nms_i03[ii]]] else {
} # jos elementin pituus on nolla, anna NA
if (length(i03[nms_i03[ii]][[1]]) == 0){
<- NA
lst_i03[[nms_i03[i]]] else {
} # muuten ota suora arvo
<- i03[nms_i03[ii]][[1]][[1]]
lst_i03[[nms_i03[ii]]]
}
}
}<- data.frame(lst_i03) |> setNames(paste0("myyntilupa_", names(lst_i03)))
df_myyntilupa else if ("Erityislupa" %in% names(i02[nms_i02[i]])){
} <- i02[nms_i02[i]]$Erityislupa
i03 <- names(i03)
nms_i03 <- list()
lst_i03 for (ii in seq(nms_i03)){
# Jos attribuutteja
if (length(attributes(i03[nms_i03[ii]][[1]])) > 0){
# ota attribuutti value
<- attributes(i03[nms_i03[ii]][[1]])$value
lst_i03[[nms_i03[ii]]] else {
} # jos elementin pituus on nolla, anna NA
if (length(i03[nms_i03[ii]][[1]]) == 0){
<- NA
lst_i03[[nms_i03[i]]] else {
} # muuten ota suora arvo
<- i03[nms_i03[ii]][[1]][[1]]
lst_i03[[nms_i03[ii]]]
}
}
}<- data.frame(lst_i03) |> setNames(paste0("erityislupa_", names(lst_i03)))
df_erityislupa else if ("Rekisterointi" %in% names(i02[nms_i02[i]])){
} <- i02[nms_i02[i]]$Rekisterointi
i03 <- names(i03)
nms_i03 <- list()
lst_i03 for (ii in seq(nms_i03)){
# Jos attribuutteja
if (length(attributes(i03[nms_i03[ii]][[1]])) > 0){
# ota attribuutti value
<- attributes(i03[nms_i03[ii]][[1]])$value
lst_i03[[nms_i03[ii]]] else {
} # jos elementin pituus on nolla, anna NA
if (length(i03[nms_i03[ii]][[1]]) == 0){
<- NA
lst_i03[[nms_i03[i]]] else {
} # muuten ota suora arvo
<- i03[nms_i03[ii]][[1]][[1]]
lst_i03[[nms_i03[ii]]]
}
}
}<- data.frame(lst_i03) |> setNames(paste0("rekisterointi_", names(lst_i03)))
df_rekisterointi
}# Jos attribuutteja
if (length(attributes(i02[nms_i02[i]][[1]])) > 0){
# jos ATC-koodi, tsekkaa ensin että on listname ja sitten poimi ATC code
if ("listname" %in% names(attributes(i02[nms_i02[i]][[1]]))) {
if (attributes(i02[nms_i02[i]][[1]])$listname == "ATC Code"){
# ota attribuutti value
"ATC_koodi"]] <- attributes(i02[nms_i02[i]][[1]])$id
lst_i02[["ATC_nimi"]] <- attributes(i02[nms_i02[i]][[1]])$value
lst_i02[[
}else {
} # ota normaalisti attribuutti value
<- attributes(i02[nms_i02[i]][[1]])$value
lst_i02[[nms_i02[i]]]
}else {
} # jos elementin pituus on nolla, anna NA
if (length(i02[nms_i02[i]][[1]]) == 0){
<- NA
lst_i02[[nms_i02[i]]] else {
} # muuten ota suora arvo
<- i02[nms_i02[i]][[1]][[1]]
lst_i02[[nms_i02[i]]]
}
}
}<- as.data.frame(lst_i02)
tmpxx if (exists("df_myyntilupa")){
<- tmpxx %>% bind_cols(df_myyntilupa)
tmpxx rm(df_myyntilupa)
}if (exists("df_erityislupa")){
<- tmpxx %>% bind_cols(df_erityislupa)
tmpxx rm(df_erityislupa)
}if (exists("df_rekisterointi")){
<- tmpxx %>% bind_cols(df_rekisterointi)
tmpxx rm(df_rekisterointi)
}<- tmpxx
laakevalmiste[[o]]
}
# Laakeaine
if (names(i01) == "Laakeaine"){
<- i01$Laakeaine$VaikuttavaAine
i02 <- names(i02)
nms_i02 <- list()
lst_i02 for (i in seq(nms_i02)){
# Jos attribuutteja
if (length(attributes(i02[nms_i02[i]][[1]])) > 0){
# ota attribuutti value
<- attributes(i02[nms_i02[i]][[1]])$value
lst_i02[[nms_i02[i]]] else {
} # jos elementin pituus on nolla, anna NA
if (length(i02[nms_i02[i]][[1]]) == 0){
<- NA
lst_i02[[nms_i02[i]]] else {
} # muuten ota suora arvo
<- i02[nms_i02[i]][[1]][[1]]
lst_i02[[nms_i02[i]]]
}
}
}<- as.data.frame(lst_i02)
laakeaine[[o]]
}rm(lst_i02)
}<- vctrs::list_drop_empty(versiotiedot) %>%
dat_versiotiedot do.call("bind_rows", .) %>% as_tibble()
<- vctrs::list_drop_empty(pakkaus) %>%
dat_pakkaus do.call("bind_rows", .) %>% as_tibble()
<- vctrs::list_drop_empty(laakevalmiste) %>%
dat_laakevalmiste do.call("bind_rows", .) %>% as_tibble()
<- vctrs::list_drop_empty(laakeaine) %>%
dat_laakeaine do.call("bind_rows", .) %>% as_tibble()
# Kirjoitetaan ekseliin välilehtiin
::write_xlsx(x = list(
writexlVersiotiedot = dat_versiotiedot,
Pakkaus = dat_pakkaus,
Laakevalmiste = dat_laakevalmiste,
Laakeaine = dat_laakeaine
),path = "perusrekisteri.xlsx")
Tässä jutussa käydään läpi kahden keskeisen lääkealan avoimen datan: Fimean lääkevalmisteiden perusrekisterin sekä Kelan lääketietokannan käsittelyä R-kielellä.
Lääkevalmisteiden perusrekisteri
Fimea julkaisee XML-muotoista lääkevalmisteiden perusrekisteriä osoiteessa: https://fimea.fi/laakehaut_ja_luettelot/perusrekisteri-xml
Lääkevalmisteiden perusrekisteri on Fimean ylläpitämä rekisteri myyntiluvallisista lääkkeistä, rekisteröinneistä ja määräaikaista erityislupavalmisteista. Rekisteri päivitetään joka yö automaattisena ajona.
XML-tiedosto on suuri ja rakenteeltaan melko polveileva. Rekisterin tietosisällöt on kuvattu oheisessa pdf-tiedostossa: perusrekisterin kenttäselitykset
Alla oleva R-koodi lataa sen hetkisen XML-tiedoston ja parsiin sen sisällön neljäksi eri dataksi ja kirjoittaa ne lopuksi excel-tiedostoon omille välilehdilleen. Tämän päivän (29. lokakuuta 2024) version ekselistä voit ladata tutkittavaksi tästä: perusrekisteri.xlsx
Lääketietokanta
Lääketietokantaan puolestaan julkaiseen Kelan Kanta-palvelut osoitteessa https://www.kanta.fi/ammattilaiset/laaketietokanta.
Lääketietokannassa on myyntiluvallisten resepti- ja itsehoitolääkkeiden lisäksi tiedot määräaikaisista erityislupavalmisteista sekä korvattavista perusvoiteista ja kliinisistä ravintovalmisteista.
Alla oleva R-koodi lataa sen hetkisen XML-tiedoston ja parsiin sen sisällön kolmeksi eri dataksi ja kirjoittaa ne lopuksi excel-tiedostoon omille välilehdilleen. Tämän päivän (29. lokakuuta 2024) version ekselistä voit ladata tutkittavaksi tästä: laaketietokanta.xlsx
<- tempfile(fileext = ".zip")
tmpfile_zip download.file("https://www.kanta.fi/documents/d/guest/laaketietokanta2022-export-2024-023",
tmpfile_zip)unzip(zipfile = tmpfile_zip, exdir = "./")
<- fs::dir_ls("./", glob = "*.xml")
filu
<- xml2::read_xml(filu)
raw <- xml2::as_list(raw)
raw_lst
<- list()
voimassaoloaika <- list()
versionumero <- list()
laakepakkaus
for (o in seq(laaketietokanta)){
if (o %% 1000 == 0) print(o)
<- laaketietokanta[o][1]
i01 if (names(i01) == "Voimassaoloaika"){
<- i01$Voimassaoloaika
i02 <- names(i02)
nms_i02 <- list()
lst_i02 for (i in seq(nms_i02)){
<- i02[nms_i02[i]][[1]][[1]]
lst_i02[[nms_i02[i]]]
}<- data.frame(lst_i02)
voimassaoloaika[[o]] rm(lst_i02)
}if (names(i01) == "Versionumero"){
<- i01$Versionumero
i02 <- data.frame(Versionumero = i02[[1]])
lst_i02 <- lst_i02
versionumero[[o]] rm(lst_i02)
}# Pakkaus01
if (names(i01) == "Laakepakkaus"){
<- i01$Laakepakkaus
i02 <- names(i02)
nms_i02 # if ("VNR-numero" %in% nms_i02){
# Kyseessä eka pakkaus-lista
<- list()
lst_i02 for (i in seq(nms_i02)){
if (nms_i02[i] == "Yksilointitiedot"){
attributes(i02[nms_i02[i]][[1]])$value
<- i02[nms_i02[i]][[1]]
i03 <- names(i03)
nms_i03 <- list()
lst_i03 for (ii in seq(nms_i03)){
<- i03[nms_i03[ii]]
i04 <- purrr::pluck_depth(i04)
syvyys
if (names(i04) %in% "Tukkuliike"){
<- names(i04$Tukkuliike)
nms_i04 # lst_i04 <- list()
for (iii in seq(nms_i04)){
paste0("Tukkuliike_",nms_i04[iii])]] <- i04$Tukkuliike[nms_i04[iii]][[1]][[1]]
lst_i03[[
}else if (names(i04) %in% "ValmisteenLaji"){
} $ValmisteenLaji_code = attributes(i04$ValmisteenLaji)$code
lst_i03$ValmisteenLaji_codeSystem = attributes(i04$ValmisteenLaji)$codeSystem
lst_i03$ValmisteenLaji_displayName = attributes(i04$ValmisteenLaji)$displayName
lst_i03# )
else if (names(i04) %in% "VaikuttavaAine"){
} paste0("VaikuttavaAine_Laakeaine_nro_",ii)]] = attributes(i04$VaikuttavaAine$Laakeaine)$nro
lst_i03[[paste0("VaikuttavaAine_Laakeaine_suomeksi_",ii)]] = attributes(i04$VaikuttavaAine$Laakeaine)$suomeksi
lst_i03[[paste0("VaikuttavaAine_Laakeaine_ruotsiksi_",ii)]] = attributes(i04$VaikuttavaAine$Laakeaine)$ruotsiksi
lst_i03[[paste0("VaikuttavaAine_Vahvuus_",ii)]] <- i04$VaikuttavaAine$Vahvuus[[1]]
lst_i03[[paste0("VaikuttavaAine_Vahvuusyksikko",ii)]] <- i04$VaikuttavaAine$VaikuttavaAine_Vahvuusyksikko[[1]]
lst_i03[[else if (names(i04) %in% "Laakemuoto"){
} $Laakemuoto_koodi = attributes(i04$Laakemuoto)$koodi
lst_i03$Laakemuoto_suomeksi = attributes(i04$Laakemuoto)$suomeksi
lst_i03$Laakemuoto_ruotsiksi = attributes(i04$Laakemuoto)$ruotsiksi
lst_i03else if (names(i04) %in% "Laakeryhmat"){
} $Laakeryhmat_code = attributes(i04$Laakeryhma$Laakeryhma)$code
lst_i03$Laakeryhmat_codeSystem = attributes(i04$Laakeryhma$Laakeryhma)$codeSystem
lst_i03else if (names(i04) %in% "Pakkaus"){
} <- names(i04$Pakkaus)
nms_i04 for (iii in seq(nms_i04)){
paste0("Pakkaus_",nms_i04[iii])]] <- i04$Pakkaus[nms_i04[iii]][[1]][[1]]
lst_i03[[
}else if (syvyys == 3){
} <- i03[nms_i03[ii]][[1]][[1]]
vektori if ("list" %in% is(vektori)) next()
<- i03[nms_i03[ii]][[1]][[1]]
lst_i03[[nms_i03[ii]]]
}
}<- data.frame(lst_i03)
lst_i02[[nms_i02[i]]]
}# Hintatiedot
if (nms_i02[i] == "Hintatiedot"){
<- i02[nms_i02[i]][[1]]
i03 <- names(i03)
nms_i03 <- list()
lst_i03 for (ii in seq(nms_i03)){
<- i03[[nms_i03[ii]]][[1]]
lst_i03[[nms_i03[ii]]]
}<- data.frame(lst_i03)
lst_i02[[nms_i02[i]]]
}# MuutTiedot
if (nms_i02[i] == "MuutTiedot"){
<- i02[nms_i02[i]][[1]]
i03 <- names(i03)
nms_i03 <- list()
lst_i03 for (ii in seq(nms_i03)){
<- pluck_depth(i03[[nms_i03[ii]]])
syvyys if (nms_i03[ii] == "LaakeKohde"){
<- attributes(i03[[nms_i03[ii]]])$hum
lst_i03[[nms_i03[ii]]] else if (nms_i03[ii] == "Maaraamisehto"){
} paste0(nms_i03[ii],"_koodi")]] <- attributes(i03[[nms_i03[ii]]])$koodi
lst_i03[[paste0(nms_i03[ii],"_suomeksi")]] <- attributes(i03[[nms_i03[ii]]])$suomeksi
lst_i03[[paste0(nms_i03[ii],"_ruotsiksi")]] <- attributes(i03[[nms_i03[ii]]])$ruotsiksi
lst_i03[[else if (nms_i03[ii] == "ATC"){
} paste0(nms_i03[ii],"_koodi")]] <- attributes(i03[[nms_i03[ii]]])$koodi
lst_i03[[paste0(nms_i03[ii],"_suomeksi")]] <- attributes(i03[[nms_i03[ii]]])$suomeksi
lst_i03[[paste0(nms_i03[ii],"_ruotsiksi")]] <- attributes(i03[[nms_i03[ii]]])$ruotsiksi
lst_i03[[else if (nms_i03[ii] == "Laakkeenantoreitti"){
} paste0(nms_i03[ii],"_code")]] <- attributes(i03[[nms_i03[ii]]])$code
lst_i03[[paste0(nms_i03[ii],"_codeSystem")]] <- attributes(i03[[nms_i03[ii]]])$codeSystem
lst_i03[[paste0(nms_i03[ii],"_codeSystemName")]] <- attributes(i03[[nms_i03[ii]]])$codeSystemName
lst_i03[[paste0(nms_i03[ii],"_displayName")]] <- attributes(i03[[nms_i03[ii]]])$displayName
lst_i03[[else if (nms_i03[ii] %in% "Laakeryhmat"){
} $Laakeryhmat_code = attributes(i04$Laakeryhma$Laakeryhma)$code
lst_i03$Laakeryhmat_codeSystem = attributes(i04$Laakeryhma$Laakeryhma)$codeSystem
lst_i03else if (syvyys == 2){
} <- i03[[nms_i03[ii]]][[1]]
lst_i03[[nms_i03[ii]]]
}
}<- data.frame(lst_i03)
lst_i02[[nms_i02[i]]]
}# TeknisetTiedot
if (nms_i02[i] == "TeknisetTiedot"){
<- i02[nms_i02[i]][[1]]
i03 <- names(i03)
nms_i03 <- list()
lst_i03 for (ii in seq(nms_i03)){
<- pluck_depth(i03[[nms_i03[ii]]])
syvyys if (syvyys == 2){
<- i03[[nms_i03[ii]]][[1]]
lst_i03[[nms_i03[ii]]]
}<- data.frame(lst_i03)
lst_i02[[nms_i02[i]]]
}
}# Korvausluokka, niitä on kaksi?!?
if (nms_i02[i] == "Korvausluokka"){
<- i02[nms_i02[i]][[1]]
i03 <- names(i03)
nms_i03 <- list()
lst_i03 try(lst_i03[[paste0(nms_i03[ii],"_koodi", i)]] <- attributes(i03[[nms_i03[ii]]])$koodi, silent = TRUE)
paste0("Korvausluokka_koodi",i)]] <- attributes(i03)$koodi
lst_i03[[paste0("Korvausluokka_suomeksi",i)]] <- attributes(i03)$suomeksi
lst_i03[[paste0("Korvausluokka_ruotsiksi",i)]] <- attributes(i03)$ruotsiksi
lst_i03[[paste0(nms_i02[i],"_",i)]] <- data.frame(lst_i03)
lst_i02[[
}if (nms_i02[i] == "EhdollinenKorvattavuus"){
<- i02[nms_i02[i]][[1]]
lst_i02[[nms_i02[i]]]
}if (nms_i02[i] == "RajattuLaakkeenmaaraamisoikeus"){
<- i02[nms_i02[i]][[1]]
i03 <- names(i03)
nms_i03 <- list()
lst_i03 "Ammattiryhma_code"]] <- attributes(i03[["Ammattiryhma"]])$code
lst_i03[["Ammattiryhma_codeSystem"]] <- attributes(i03[["Ammattiryhma"]])$codeSystem
lst_i03[["Ammattiryhma_displayName"]] <- attributes(i03[["Ammattiryhma"]])$displayName
lst_i03[["Laakkeenmaaraystapa"]] <- i03[["Laakkeenmaaraystapa"]][[1]]
lst_i03[["Kayttotarkoitus_code"]] <- attributes(i03[["Kayttotarkoitus"]])$code
lst_i03[["Kayttotarkoitus_codeSystem"]] <- attributes(i03[["Kayttotarkoitus"]])$codeSystem
lst_i03[["Kayttotarkoitus_displayName"]] <- attributes(i03[["Kayttotarkoitus"]])$displayName
lst_i03[["Erityisrajaus_code"]] <- attributes(i03[["Erityisrajaus"]])$code
lst_i03[["Erityisrajaus_codeSystem"]] <- attributes(i03[["Erityisrajaus"]])$codeSystem
lst_i03[["Erityisrajaus_displayName"]] <- attributes(i03[["Erityisrajaus"]])$displayName
lst_i03[[paste0(nms_i02[i],"_",i)]] <- data.frame(lst_i03)
lst_i02[[
}
}<- do.call("cbind", lst_i02)
laakepakkaus[[o]] # laakepakkaus[[o]] <- lst_i02
}
}
<- vctrs::list_drop_empty(voimassaoloaika) %>%
dat_voimassaoloaika do.call("bind_rows", .) %>% as_tibble()
<- vctrs::list_drop_empty(versionumero) %>%
dat_versionumero do.call("bind_rows", .) %>% as_tibble()
<- vctrs::list_drop_empty(laakepakkaus) %>%
dat_laakepakkaus do.call("bind_rows", .) %>% as_tibble()
# Kirjoitetaan ekseliin välilehtiin
::write_xlsx(x = list(
writexlVoimassaoloaika = dat_voimassaoloaika,
Versionumero = dat_versionumero,
Laakepakkaus = dat_laakepakkaus
),path = "laaketietokanta.xlsx")
Uudelleenkäyttö
Viittaus
@online{kainu2024,
author = {Kainu, Markus},
title = {Fimean lääkevalmisteiden perusrekisterin sekä Kanta-palvelun
lääketietokannan käsittely R-kielellä},
date = {2024-10-29},
url = {https://markuskainu.fi/posts/2024-10-29-fimean-perusrekisteri/},
langid = {fi}
}