mirror of
https://github.com/agdamsbo/daDoctoR.git
synced 2024-10-30 02:31:52 +01:00
77 lines
1.9 KiB
R
77 lines
1.9 KiB
R
#' Extracting date of birth from CPR
|
|
#'
|
|
#' For easy calculation.
|
|
#' @param cpr cpr-numbers in format ddmmyy-xxxx.
|
|
#' @keywords cpr
|
|
#' @export
|
|
#' @examples
|
|
#' dob_extract_cpr("231045-0637")
|
|
|
|
|
|
dob_extract_cpr<-function(cpr)
|
|
## Input as cpr-numbers in format ddmmyy-xxxx
|
|
## Build upon data from this document: https://cpr.dk/media/167692/personnummeret%20i%20cpr.pdf
|
|
## example vector: fsd<-c("010190-2000", "010115-4000", "010189-6000","010189-3000","010150-6000","010150-4000")
|
|
## cpr <- "231045-0637"
|
|
## cpr <- "2310450637"
|
|
{
|
|
|
|
if (any(substr(cpr,7,7)=="-")){ # test if input is ddmmyy-xxxx, standard format
|
|
message("Input er i formatet ddmmyy-xxxx")
|
|
cpr_std<-TRUE
|
|
}
|
|
|
|
if (any(substr(cpr,7,7)%in%c(0:9))){
|
|
message("Input er i formatet ddmmyyxxxx") # test if input is ddmmyyxxxx
|
|
cpr_std<-FALSE
|
|
}
|
|
|
|
|
|
dobs<-c()
|
|
|
|
a00<-as.numeric(c(0:99))
|
|
a36<-as.numeric(c(0:36))
|
|
a57<-as.numeric(c(0:57))
|
|
b00<-as.numeric(c(0,1,2,3))
|
|
b36<-as.numeric(c(4,9))
|
|
b57<-as.numeric(c(5,6,7,8))
|
|
|
|
for (x in cpr)
|
|
{
|
|
p56<-as.numeric(substr(x,5,6))
|
|
|
|
if (cpr_std){p8<-as.numeric(substr(x,8,8))} else {p8<-as.numeric(substr(x,9,9))}
|
|
|
|
birth<-as.Date(substr(x,1,6),format="%d%m%y")
|
|
|
|
|
|
if (((p56%in%a00)&&(p8%in%b00)))
|
|
{
|
|
dob<-as.Date(format(birth, format="19%y%m%d"), format="%Y%m%d")
|
|
}
|
|
else if (((p56%in%a36)&&(p8%in%b36)))
|
|
{
|
|
dob<-as.Date(format(birth, format="20%y%m%d"), format="%Y%m%d")
|
|
}
|
|
else if ((!(p56%in%a36)&&(p8%in%b36)))
|
|
{
|
|
dob<-as.Date(format(birth, format="19%y%m%d"), format="%Y%m%d")
|
|
}
|
|
else if (((p56%in%a57)&&(p8%in%b57)))
|
|
{
|
|
dob<-as.Date(format(birth, format="20%y%m%d"), format="%Y%m%d")
|
|
}
|
|
else if ((!(p56%in%a57)&&(p8%in%b57)))
|
|
{
|
|
dob<-as.Date(format(birth, format="18%y%m%d"), format="%Y%m%d")
|
|
}
|
|
else {print("Input contains data in wrong format") # test if position 5,6 or 8 contains letters as is the case for temporary cpr-numbers
|
|
}
|
|
dobs<-append(dobs,dob)
|
|
|
|
}
|
|
|
|
return(dobs)
|
|
|
|
}
|