Fimean lääkevalmisteiden perusrekisterin sekä Kanta-palvelun lääketietokannan käsittely R-kielellä

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

library(xml2)
library(dplyr)
library(writexl)
library(vctrs)

# Perusrekisteri (XML)
tmpfile <- tempfile(fileext = ".xml")
download.file(url = "https://data.pilvi.fimea.fi/avoin-data/Perusrekisteri.xml", 
              tmpfile)
raw <- xml2::read_xml(tmpfile)
raw_lst <- xml2::as_list(raw)

perusrekisteri <- raw_lst$Perusrekisteri

versiotiedot <- list()
pakkaus <- list()
laakevalmiste <- list()
laakeaine <- list()
for (o in seq(perusrekisteri)){
  if (o %% 1000 == 0) print(o)
  i01 <- perusrekisteri[o][1]
  if (names(i01) == "Versiotiedot"){
    i02 <- i01$Versiotiedot
    nms_i02 <- names(i02)
    lst_i02 <- list()
    for (i in seq(nms_i02)){
          lst_i02[[nms_i02[i]]]  <- i02[nms_i02[i]][[1]][[1]]
    }
    versiotiedot[[o]] <- lst_i02
  }
  # Pakkaus01
  if (names(i01) == "Pakkaus"){
    i02 <- i01$Pakkaus
    nms_i02 <- names(i02)
    # if ("VNR-numero" %in% nms_i02){
      # Kyseessä eka pakkaus-lista
      lst_i02 <- list()
      for (i in seq(nms_i02)){
        # Jos attribuutteja
        if (length(attributes(i02[nms_i02[i]][[1]])) > 0){
          # ota attribuutti value
          lst_i02[[nms_i02[i]]]  <- attributes(i02[nms_i02[i]][[1]])$value
        } else {
          # jos elementin pituus on nolla, anna NA
          if (length(i02[nms_i02[i]][[1]]) == 0){
            lst_i02[[nms_i02[i]]]  <- NA
          } else {
            # muuten ota suora arvo
              lst_i02[[nms_i02[i]]]  <- i02[nms_i02[i]][[1]][[1]]
            }
          }
      }
      pakkaus[[o]] <- as.data.frame(lst_i02)
    # }
  }
  # Laakevalmiste
   # if (names(i01) == "Laakevalmiste") stop()
  if (names(i01) == "Laakevalmiste"){
    i02 <- i01$Laakevalmiste
    nms_i02 <- names(i02)
    lst_i02 <- list()
    for (i in seq(nms_i02)){

      # Myyntilupa
      if ("Myyntilupa" %in% names(i02[nms_i02[i]])){
        i03 <- i02[nms_i02[i]]$Myyntilupa
        nms_i03 <- names(i03)
        lst_i03 <- list()
        for (ii in seq(nms_i03)){
          # Jos attribuutteja
          if (length(attributes(i03[nms_i03[ii]][[1]])) > 0){
            # ota attribuutti value
            lst_i03[[nms_i03[ii]]]  <- attributes(i03[nms_i03[ii]][[1]])$value
          } else {
            # jos elementin pituus on nolla, anna NA
            if (length(i03[nms_i03[ii]][[1]]) == 0){
              lst_i03[[nms_i03[i]]]  <- NA
            } else {
              # muuten ota suora arvo
              lst_i03[[nms_i03[ii]]]  <- i03[nms_i03[ii]][[1]][[1]]
            }
          }
        }
        df_myyntilupa <- data.frame(lst_i03) |> setNames(paste0("myyntilupa_", names(lst_i03)))
      } else if ("Erityislupa" %in% names(i02[nms_i02[i]])){
        i03 <- i02[nms_i02[i]]$Erityislupa
        nms_i03 <- names(i03)
        lst_i03 <- list()
        for (ii in seq(nms_i03)){
          # Jos attribuutteja
          if (length(attributes(i03[nms_i03[ii]][[1]])) > 0){
            # ota attribuutti value
            lst_i03[[nms_i03[ii]]]  <- attributes(i03[nms_i03[ii]][[1]])$value
          } else {
            # jos elementin pituus on nolla, anna NA
            if (length(i03[nms_i03[ii]][[1]]) == 0){
              lst_i03[[nms_i03[i]]]  <- NA
            } else {
              # muuten ota suora arvo
              lst_i03[[nms_i03[ii]]]  <- i03[nms_i03[ii]][[1]][[1]]
            }
          }
        }
        df_erityislupa <- data.frame(lst_i03) |> setNames(paste0("erityislupa_", names(lst_i03)))
      } else if ("Rekisterointi" %in% names(i02[nms_i02[i]])){
        i03 <- i02[nms_i02[i]]$Rekisterointi
        nms_i03 <- names(i03)
        lst_i03 <- list()
        for (ii in seq(nms_i03)){
          # Jos attribuutteja
          if (length(attributes(i03[nms_i03[ii]][[1]])) > 0){
            # ota attribuutti value
            lst_i03[[nms_i03[ii]]]  <- attributes(i03[nms_i03[ii]][[1]])$value
          } else {
            # jos elementin pituus on nolla, anna NA
            if (length(i03[nms_i03[ii]][[1]]) == 0){
              lst_i03[[nms_i03[i]]]  <- NA
            } else {
              # muuten ota suora arvo
              lst_i03[[nms_i03[ii]]]  <- i03[nms_i03[ii]][[1]][[1]]
            }
          }
        }
        df_rekisterointi <- data.frame(lst_i03) |> setNames(paste0("rekisterointi_", names(lst_i03)))
      }
      # 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
        lst_i02[["ATC_koodi"]]  <- attributes(i02[nms_i02[i]][[1]])$id
        lst_i02[["ATC_nimi"]]  <- attributes(i02[nms_i02[i]][[1]])$value
        }
      } else {
        # ota normaalisti attribuutti value
        lst_i02[[nms_i02[i]]]  <- attributes(i02[nms_i02[i]][[1]])$value          
        }
      } else {
        # jos elementin pituus on nolla, anna NA
        if (length(i02[nms_i02[i]][[1]]) == 0){
          lst_i02[[nms_i02[i]]]  <- NA
        } else {
          # muuten ota suora arvo
          lst_i02[[nms_i02[i]]]  <- i02[nms_i02[i]][[1]][[1]]
        }
      }
    }
    tmpxx <- as.data.frame(lst_i02)
    if (exists("df_myyntilupa")){
      tmpxx <-  tmpxx %>% bind_cols(df_myyntilupa)
      rm(df_myyntilupa)
    }
    if (exists("df_erityislupa")){
      tmpxx <-  tmpxx %>% bind_cols(df_erityislupa)
      rm(df_erityislupa)
    }
    if (exists("df_rekisterointi")){
      tmpxx <-  tmpxx %>% bind_cols(df_rekisterointi)
      rm(df_rekisterointi)
    }
    laakevalmiste[[o]] <- tmpxx
  }


# Laakeaine
    if (names(i01) == "Laakeaine"){
      i02 <- i01$Laakeaine$VaikuttavaAine
      nms_i02 <- names(i02)
      lst_i02 <- list()
        for (i in seq(nms_i02)){
          # Jos attribuutteja
          if (length(attributes(i02[nms_i02[i]][[1]])) > 0){
            # ota attribuutti value
            lst_i02[[nms_i02[i]]]  <- attributes(i02[nms_i02[i]][[1]])$value
          } else {
            # jos elementin pituus on nolla, anna NA
            if (length(i02[nms_i02[i]][[1]]) == 0){
              lst_i02[[nms_i02[i]]]  <- NA
            } else {
              # muuten ota suora arvo
              lst_i02[[nms_i02[i]]]  <- i02[nms_i02[i]][[1]][[1]]
            }
          }
        }
        laakeaine[[o]] <- as.data.frame(lst_i02)
  }
  rm(lst_i02)
}
dat_versiotiedot <- vctrs::list_drop_empty(versiotiedot) %>%
  do.call("bind_rows", .) %>% as_tibble()
dat_pakkaus <- vctrs::list_drop_empty(pakkaus) %>%
  do.call("bind_rows", .) %>% as_tibble()
dat_laakevalmiste <- vctrs::list_drop_empty(laakevalmiste) %>%
  do.call("bind_rows", .) %>% as_tibble()
dat_laakeaine <- vctrs::list_drop_empty(laakeaine) %>%
  do.call("bind_rows", .) %>% as_tibble()

# Kirjoitetaan ekseliin välilehtiin
writexl::write_xlsx(x = list(
  Versiotiedot = dat_versiotiedot,
  Pakkaus = dat_pakkaus,
  Laakevalmiste = dat_laakevalmiste,
  Laakeaine = dat_laakeaine
),
path = "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

tmpfile_zip <- tempfile(fileext = ".zip")
download.file("https://www.kanta.fi/documents/d/guest/laaketietokanta2022-export-2024-023", 
              tmpfile_zip)
unzip(zipfile = tmpfile_zip, exdir = "./")
filu <- fs::dir_ls("./", glob = "*.xml")

raw <- xml2::read_xml(filu)
raw_lst <- xml2::as_list(raw)

voimassaoloaika <- list()
versionumero <- list()
laakepakkaus <- list()

for (o in seq(laaketietokanta)){
if (o %% 1000 == 0) print(o)
  i01 <- laaketietokanta[o][1]
  if (names(i01) == "Voimassaoloaika"){
    i02 <- i01$Voimassaoloaika
    nms_i02 <- names(i02)
    lst_i02 <- list()
    for (i in seq(nms_i02)){
          lst_i02[[nms_i02[i]]]  <- i02[nms_i02[i]][[1]][[1]]
    }
    voimassaoloaika[[o]] <- data.frame(lst_i02)
    rm(lst_i02)
  }
  if (names(i01) == "Versionumero"){
    i02 <- i01$Versionumero
    lst_i02  <- data.frame(Versionumero = i02[[1]])
    versionumero[[o]] <- lst_i02
    rm(lst_i02)
  }
  # Pakkaus01
  if (names(i01) == "Laakepakkaus"){
    i02 <- i01$Laakepakkaus
    nms_i02 <- names(i02)
    # if ("VNR-numero" %in% nms_i02){
      # Kyseessä eka pakkaus-lista
      lst_i02 <- list()
      for (i in seq(nms_i02)){
        if (nms_i02[i] == "Yksilointitiedot"){
          
          attributes(i02[nms_i02[i]][[1]])$value
          i03 <- i02[nms_i02[i]][[1]]
          nms_i03 <- names(i03)
          lst_i03 <- list()
          for (ii in seq(nms_i03)){
            i04 <- i03[nms_i03[ii]]
            syvyys <- purrr::pluck_depth(i04)
            
            if (names(i04) %in% "Tukkuliike"){
              nms_i04 <- names(i04$Tukkuliike)
              # lst_i04 <- list()
              for (iii in seq(nms_i04)){
                lst_i03[[paste0("Tukkuliike_",nms_i04[iii])]] <- i04$Tukkuliike[nms_i04[iii]][[1]][[1]]
              }
            } else if (names(i04) %in% "ValmisteenLaji"){
          lst_i03$ValmisteenLaji_code = attributes(i04$ValmisteenLaji)$code
          lst_i03$ValmisteenLaji_codeSystem = attributes(i04$ValmisteenLaji)$codeSystem
          lst_i03$ValmisteenLaji_displayName = attributes(i04$ValmisteenLaji)$displayName
              # )
            } else if (names(i04) %in% "VaikuttavaAine"){
          lst_i03[[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]]
            } else if (names(i04) %in% "Laakemuoto"){
              lst_i03$Laakemuoto_koodi = attributes(i04$Laakemuoto)$koodi
              lst_i03$Laakemuoto_suomeksi = attributes(i04$Laakemuoto)$suomeksi
              lst_i03$Laakemuoto_ruotsiksi = attributes(i04$Laakemuoto)$ruotsiksi
          } else if (names(i04) %in% "Laakeryhmat"){
              lst_i03$Laakeryhmat_code = attributes(i04$Laakeryhma$Laakeryhma)$code
              lst_i03$Laakeryhmat_codeSystem = attributes(i04$Laakeryhma$Laakeryhma)$codeSystem
          } else if (names(i04) %in% "Pakkaus"){
              nms_i04 <- names(i04$Pakkaus)
              for (iii in seq(nms_i04)){
                lst_i03[[paste0("Pakkaus_",nms_i04[iii])]] <- i04$Pakkaus[nms_i04[iii]][[1]][[1]]
              }
            } else if (syvyys == 3){
              vektori <- i03[nms_i03[ii]][[1]][[1]]
              if ("list" %in% is(vektori)) next()
              lst_i03[[nms_i03[ii]]] <- i03[nms_i03[ii]][[1]][[1]]  
            }
          }
          lst_i02[[nms_i02[i]]] <- data.frame(lst_i03)
        }
        # Hintatiedot
        if (nms_i02[i] == "Hintatiedot"){
          
          i03 <- i02[nms_i02[i]][[1]]
          nms_i03 <- names(i03)
          lst_i03 <- list()
          for (ii in seq(nms_i03)){
            lst_i03[[nms_i03[ii]]] <- i03[[nms_i03[ii]]][[1]]
          }
          lst_i02[[nms_i02[i]]] <- data.frame(lst_i03)
        }
        # MuutTiedot
        if (nms_i02[i] == "MuutTiedot"){
          i03 <- i02[nms_i02[i]][[1]]
          nms_i03 <- names(i03)
          lst_i03 <- list()
          for (ii in seq(nms_i03)){
            syvyys <- pluck_depth(i03[[nms_i03[ii]]])
            if (nms_i03[ii] == "LaakeKohde"){
            lst_i03[[nms_i03[ii]]] <- attributes(i03[[nms_i03[ii]]])$hum  
            } else if (nms_i03[ii] == "Maaraamisehto"){
            lst_i03[[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
            } else if (nms_i03[ii] == "ATC"){
            lst_i03[[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
            } else if (nms_i03[ii] == "Laakkeenantoreitti"){
            lst_i03[[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
            } else if (nms_i03[ii] %in% "Laakeryhmat"){
              lst_i03$Laakeryhmat_code = attributes(i04$Laakeryhma$Laakeryhma)$code
              lst_i03$Laakeryhmat_codeSystem = attributes(i04$Laakeryhma$Laakeryhma)$codeSystem
            } else if (syvyys == 2){
              lst_i03[[nms_i03[ii]]] <- i03[[nms_i03[ii]]][[1]]  
            } 
          }
          lst_i02[[nms_i02[i]]] <- data.frame(lst_i03)
        }
        # TeknisetTiedot
        if (nms_i02[i] == "TeknisetTiedot"){
          i03 <- i02[nms_i02[i]][[1]]
          nms_i03 <- names(i03)
          lst_i03 <- list()
          for (ii in seq(nms_i03)){
            syvyys <- pluck_depth(i03[[nms_i03[ii]]])
            if (syvyys == 2){
              lst_i03[[nms_i03[ii]]] <- i03[[nms_i03[ii]]][[1]]  
          }
          lst_i02[[nms_i02[i]]] <- data.frame(lst_i03)
          }
        }
          # Korvausluokka, niitä on kaksi?!?
        if (nms_i02[i] == "Korvausluokka"){
          i03 <- i02[nms_i02[i]][[1]]
          nms_i03 <- names(i03)
          lst_i03 <- list()
            try(lst_i03[[paste0(nms_i03[ii],"_koodi", i)]] <- attributes(i03[[nms_i03[ii]]])$koodi, silent = TRUE)
            lst_i03[[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_i02[[paste0(nms_i02[i],"_",i)]] <- data.frame(lst_i03)
        }
        if (nms_i02[i] == "EhdollinenKorvattavuus"){
          lst_i02[[nms_i02[i]]] <- i02[nms_i02[i]][[1]]
        }
        if (nms_i02[i] == "RajattuLaakkeenmaaraamisoikeus"){
          i03 <- i02[nms_i02[i]][[1]]
          nms_i03 <- names(i03)
          lst_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_i02[[paste0(nms_i02[i],"_",i)]] <- data.frame(lst_i03)
        }
      }
      laakepakkaus[[o]] <- do.call("cbind", lst_i02)
      # laakepakkaus[[o]] <- lst_i02
      }
  }

dat_voimassaoloaika <- vctrs::list_drop_empty(voimassaoloaika) %>%
  do.call("bind_rows", .) %>% as_tibble()
dat_versionumero <- vctrs::list_drop_empty(versionumero) %>%
  do.call("bind_rows", .) %>% as_tibble()
dat_laakepakkaus <- vctrs::list_drop_empty(laakepakkaus) %>%
  do.call("bind_rows", .) %>% as_tibble()

# Kirjoitetaan ekseliin välilehtiin
writexl::write_xlsx(x = list(
  Voimassaoloaika = dat_voimassaoloaika,
  Versionumero = dat_versionumero,
  Laakepakkaus = dat_laakepakkaus
),
path = "laaketietokanta.xlsx")