使用R语言生成CDISC SDTM.AE domain

写在前面

- 使用的是Rstudio

- 其实R已经有生成sdtm相关的package，以下代码仅作为练习R语言的语法，不是高效生成sdtm的方法

- 代码中没有解决的问题包括：EPOCH相关的逻辑没有考虑partial date的情况；在使用arrange() function做-SEQ排序时，关于大小写英文字母的排序机制似乎与SAS语言的sort function有所不同，导致使用相同的排序变量，通过R和SAS排序后，record的顺序会有不同；输出xpt结果是乱码，暂时输出到csv文件中。

- 还没有写生成SUPPAE的代码

- 代码参考了以下材料

Generating .xpt files with SAS, R and Python

https://www.pharmasug.org/proceedings/2021/EP/PharmaSUG-2021-EP-057.pdf

Yotube @mycsg

mycsg TASKS-SDTMGEN

以下是R代码

setwd('C://R_software')
library(haven)
library(dplyr)
library(tidyverse)
library(sas7bdat)
library(SASxport)
library(Hmisc)

# import source data
raw_ae_001 <- read_sas('C://rawdata/ae_001.sas7bdat')
raw_meddrathsaurus <- read_sas('C://rawdata/meddrathesaurus.sas7bdat')
sdtm_dm <- read_sas('C://sdtmdata/SDTM/DM.sas7bdat')
sdtm_se <- read_sas('C://rawdata/SE.sas7bdat')

# Update the variable name to uppercase, because var name is case sensitive in R
names(raw_ae_001) <- toupper(names(raw_ae_001))
names(raw_meddrathsaurus) <- toupper(names(raw_meddrathsaurus))

# Filter ae raw data with AETERM not missing, and keep necessary variables
ae <- raw_ae_001 %>%
  select(SUBJECT,RECORDPOSITION,AETERM,AESTDAT_RAW,AESTTIM,AEENDAT_RAW,AEENTIM,
         AESEV_STD,AESER_STD,AEACN_STD,AEREL_STD,AEREL_WD_STD,AEPATT_STD,AEOUT_STD,AESCONG_STD,
         AESDISAB_STD,AESDTH_STD,AESHOSP_STD,AESLIFE_STD,AESMIE_STD,AEONGO) %>% 
  filter(AETERM != "") 

# Update AETERM value to uppercase in order to merge with source MedDRA coding data
ae$AETERM <- toupper(ae$AETERM)

# Filter MedDRA source data with AE pannel only
meddra <- raw_meddrathsaurus  %>%
  filter(PANEL=="AE")

# Merge AE and MedDRA data (left join) by AETERM, create AESTDTC/AEENDTC 
ae1 <- merge (ae, meddra, by.x = c("AETERM"), by.y = c("VERBATIM"), all.x = T) %>%
  # create AESTDTC
  mutate(
    stdayn = suppressWarnings(as.numeric(word(AESTDAT_RAW,1))), ### as.numeric>>input, word>>scan
    stday = if_else(!is.na(stdayn), str_pad(stdayn, width = 2, pad = "0"), "-"), ### is.na>>not missing, !>>not, str_pad>>put xx.
    stmonthc = str_to_upper(word(AESTDAT_RAW, 2)), ### str_to_upper>>uppercase
    stmonth = case_when(
      stmonthc == "JAN" ~ "01",
      stmonthc == "FEB" ~ "02",
      stmonthc == "MAR" ~ "03",
      stmonthc == "APR" ~ "04",
      stmonthc == "MAY" ~ "05",
      stmonthc == "JUN" ~ "06",
      stmonthc == "JUL" ~ "07",
      stmonthc == "AUG" ~ "08",
      stmonthc == "SEP" ~ "09",
      stmonthc == "OCT" ~ "10",
      stmonthc == "NOV" ~ "11",
      stmonthc == "DEC" ~ "12",
      TRUE ~ "-"
    ),
    styear = word(AESTDAT_RAW,3),
    styear1 = if_else((styear == "UNK") | (is.na(styear)), "-", styear), ### | >> or
    aestdate = str_c(styear1, stmonth, stday, sep = "-"), ### str_c >> catx
    AESTDTC = if_else(AESTTIM != "", str_c(aestdate, str_pad(AESTTIM, width = 5, pad = "0"), sep = "T"), aestdate),
    
    AESTDTC = if_else(str_sub(AESTDTC, -5) == "-----", "", AESTDTC),
    AESTDTC = if_else(str_sub(AESTDTC, -4) == "----", str_sub(AESTDTC,end=-5), AESTDTC),
    AESTDTC = if_else(str_sub(AESTDTC, -2) == "--", str_sub(AESTDTC,end=-3), AESTDTC)
  ) %>%
  # create AEENDTC
  mutate(
    endayn = suppressWarnings(as.numeric(word(AEENDAT_RAW,1))), ### as.numeric>>input, word>>scan
    enday = if_else(!is.na(endayn), str_pad(endayn, width = 2, pad = "0"), "-"), ### is.na>>not missing, !>>not, str_pad>>put xx.
    enmonthc = str_to_upper(word(AEENDAT_RAW, 2)), ### str_to_upper>>uppercase
    enmonth = case_when(
      enmonthc == "JAN" ~ "01",
      enmonthc == "FEB" ~ "02",
      enmonthc == "MAR" ~ "03",
      enmonthc == "APR" ~ "04",
      enmonthc == "MAY" ~ "05",
      enmonthc == "JUN" ~ "06",
      enmonthc == "JUL" ~ "07",
      enmonthc == "AUG" ~ "08",
      enmonthc == "SEP" ~ "09",
      enmonthc == "OCT" ~ "10",
      enmonthc == "NOV" ~ "11",
      enmonthc == "DEC" ~ "12",
      TRUE ~ "-"
    ),
    enyear = word(AEENDAT_RAW,3),
    enyear1 = if_else((enyear == "UNK") | (is.na(enyear)), "-", enyear), ### | >> or
    aeendate = str_c(enyear1, enmonth, enday, sep = "-"), ### str_c >> catx
    AEENDTC = if_else(AEENTIM != "", str_c(aeendate, str_pad(AEENTIM, width = 5, pad = "0"), sep = "T"), aeendate),
    
    AEENDTC = if_else(str_sub(AEENDTC, -5) == "-----", "", AEENDTC),
    AEENDTC = if_else(str_sub(AEENDTC, -4) == "----", str_sub(AEENDTC,end=-5), AEENDTC),
    AEENDTC = if_else(str_sub(AEENDTC, -2) == "--", str_sub(AEENDTC,end=-3), AEENDTC)
  )

# Create AE domain vars
ae2 <- ae1 %>%
  cbind(
    STUDYID=c("PROTOCOLID"), 
    DOMAIN=c("AE"), 
    USUBJID=str_c(c("PROTOCOLID-0"),substr(ae1$SUBJECT,4,6),c("-00"),substr(ae1$SUBJECT,7,9)), # str_c() is catx() in SAS
    SUBJID=ae1$SUBJECT,
    AESPID=str_c(c("AE_001-"),ae1$RECORDPOSITION),
    AELLT=ae1$LLT_NAME,
    AELLTCD=ae1$LLT_CODE,
    AEDECOD=ae1$PT_NAME,
    AEPTCD=ae1$PT_CODE,
    AEHLT=ae1$HLT_NAME,
    AEHLTCD=ae1$HLT_CODE,
    AEHLGT=ae1$HGT_NAME,
    AEHLGTCD=ae1$HGT_CODE,
    AEBODSYS=ae1$SOC_NAME,
    AEBDSYCD=ae1$SOC_CODE,
    AESOC=ae1$SOC_NAME,
    AESOCCD=ae1$SOC_CODE,
    AESEV=ae1$AESEV_STD,
    AESER=ae1$AESER_STD,
    AEACN=ae1$AEACN_STD,
    AEREL=ae1$AEREL_STD,
    AERELNST=ae1$AEREL_WD_STD,
    AEPATT=ae1$AEPATT_STD,
    AEOUT=ae1$AEOUT_STD,
    AESCONG=ae1$AESCONG_STD,
    AESDISAB=ae1$AESDISAB_STD,
    AESDTH=ae1$AESDTH_STD,
    AESHOSP=ae1$AESHOSP_STD,
    AESLIFE=ae1$AESLIFE_STD,
    AESMIE=ae1$AESMIE_STD
  )  

# Merge AE and SDTM.DM by USUBJID, create AESTDY/AEENDY
sdtm_dm <- select(sdtm_dm,USUBJID,RFSTDTC,RFENDTC)

ae3 <- merge (ae2, sdtm_dm, by = c("USUBJID"), all.x = T) %>%
  mutate(
    aestdt=as.Date(AESTDTC),
    rfstdt=as.Date(RFSTDTC),
    rfstdate=str_sub(RFSTDTC,1,10),
    rfst_year=str_sub(RFSTDTC,1,4),
    rfst_month=str_sub(RFSTDTC,6,7),
    rfst_day=str_sub(RFSTDTC,9,10),
    AESTDY=ifelse(!is.na(aestdt) & !is.na(rfstdt),
              ifelse((aestdt>=rfstdt),aestdt-rfstdt+1,aestdt-rfstdt), ""
                  )
  ) %>%
  mutate(
    aeendt=as.Date(AEENDTC),
    rfstdt=as.Date(RFSTDTC),
    AEENDY=ifelse(!is.na(aeendt) & !is.na(rfstdt),
                  ifelse((aeendt>=rfstdt),aeendt-rfstdt+1,aeendt-rfstdt), ""
            )
  ) %>%
  # create AEENRTPT, AEENTPT
  mutate(
    AEENRTPT=ifelse(AEONGO==1,"ONGOING",""),
    AEENTPT=ifelse(AEONGO==1,
                   ifelse(is.na(rfstdt)==T,"SCREENING","END OF STUDY"),""
                  )
  )

# prepare SE dataset for creating EPOCH
sdtm_se <- select(sdtm_se,USUBJID,ETCD,SESTDTC,SEENDTC)

sest <- sdtm_se %>%
  select(USUBJID,ETCD,SESTDTC) %>%
  pivot_wider(names_from=ETCD, values_from=SESTDTC)

colnames(sest) <- c("USUBJID","st1","st2","st3")

seen <- sdtm_se %>%
  select(USUBJID,ETCD,SEENDTC) %>%
  pivot_wider(names_from=ETCD, values_from=SEENDTC)

colnames(seen) <- c("USUBJID","en1","en2","en3")

sesten <- merge (sest, seen, by = c("USUBJID"))

ae4 <- merge (ae3, sesten, by = c("USUBJID"), all.x = T)

ae5 <- ae4 %>%
  mutate(EPOCH=NA) %>%
  mutate(
    EPOCH=ifelse((st1<=aestdt & aestdt<en1) | (aestdt<=en1 & is.na(st2)==T), "SCREENING",ifelse(st2<=aestdt & aestdt<=en2, "TREATMENT", "FOLLOW-UP"))
  ) %>%
  #mutate(
  #  EPOCH=ifelse(!is.na(EPOCH)==T & !is.na(stday)==T, EPOCH, ifelse())
  #) %>%
  arrange(STUDYID,USUBJID,AEDECOD,AESTDTC,AEENDTC,AESPID) %>%
  group_by(USUBJID) %>%
  mutate(AESEQ=row_number())

# select target vars in AE
sdtm_ae <- select(ae5,STUDYID,DOMAIN,USUBJID,SUBJID,AESEQ,AESPID,
            AETERM,AELLT,AELLTCD,AEDECOD,AEPTCD,AEHLT,AEHLTCD,AEHLGT,AEHLGTCD,AEBODSYS,AEBDSYCD,AESOC,AESOCCD,
            AESEV,AESER,AEACN,AEREL,AERELNST,AEPATT,AEOUT,AESCONG,AESDISAB,AESDTH,AESHOSP,AESLIFE,AESMIE,
            EPOCH,AESTDTC,AEENDTC,AESTDY,AEENDY,AEENRTPT,AEENTPT)

# convert following vars to numeric per CDSIC definition
sdtm_ae$AELLTCD <- as.numeric(sdtm_ae$AELLTCD)
sdtm_ae$AEPTCD <- as.numeric(sdtm_ae$AEPTCD)
sdtm_ae$AEHLTCD <- as.numeric(sdtm_ae$AEHLTCD)
sdtm_ae$AEHLGTCD <- as.numeric(sdtm_ae$AEHLGTCD)
sdtm_ae$AEBDSYCD <- as.numeric(sdtm_ae$AEBDSYCD)
sdtm_ae$AESOCCD <- as.numeric(sdtm_ae$AESOCCD)
sdtm_ae$AESTDY <- as.numeric(sdtm_ae$AESTDY)
sdtm_ae$AEENDY <- as.numeric(sdtm_ae$AEENDY)

# convert NA to null
sdtm_ae$AESTDY[is.na(sdtm_ae$AESTDY)] <- ""
sdtm_ae$AEENDY[is.na(sdtm_ae$AEENDY)] <- ""

# add label
label(sdtm_ae) <- "Adverse Events"
label(sdtm_ae$STUDYID)   <- "Study Identifier"                       
label(sdtm_ae$DOMAIN)    <- "Domain Abbreviation"                    
label(sdtm_ae$USUBJID)   <- "Unique Subject Identifier"              
label(sdtm_ae$SUBJID)    <- "Subject Identifier for the Study"       
label(sdtm_ae$AESEQ)     <- "Sequence Number"                      
label(sdtm_ae$AESPID)    <- "Sponsor-Defined Identifier"             
label(sdtm_ae$AETERM)    <- "Reported Term for the Adverse Event"    
label(sdtm_ae$AELLT)     <- "Lowest Level Term"                      
label(sdtm_ae$AELLTCD)   <- "Lowest Level Term Code"                 
label(sdtm_ae$AEDECOD)   <- "Dictionary-Derived Term"                
label(sdtm_ae$AEPTCD)    <- "Preferred Term Code"                    
label(sdtm_ae$AEHLT)     <- "High Level Term"                        
label(sdtm_ae$AEHLTCD)   <- "High Level Term Code"                   
label(sdtm_ae$AEHLGT)    <- "High Level Group Term"                  
label(sdtm_ae$AEHLGTCD)  <- "High Level Group Term Code"             
label(sdtm_ae$AEBODSYS)  <- "Body System or Organ Class"             
label(sdtm_ae$AEBDSYCD)  <- "Body System or Organ Class Code"        
label(sdtm_ae$AESOC)     <- "Primary System Organ Class"             
label(sdtm_ae$AESOCCD)   <- "Primary System Organ Class Code"        
label(sdtm_ae$AESEV)     <- "Severity/Intensity"                     
label(sdtm_ae$AESER)     <- "Serious Event"                          
label(sdtm_ae$AEACN)     <- "Action Taken with Study Treatment"      
label(sdtm_ae$AEREL)     <- "Causality"                              
label(sdtm_ae$AERELNST)  <- "Relationship to Non-Study Treatment"    
label(sdtm_ae$AEPATT)    <- "Pattern of Adverse Event"               
label(sdtm_ae$AEOUT)     <- "Outcome of Adverse Event"               
label(sdtm_ae$AESCONG)   <- "Congenital Anomaly or Birth Defect"     
label(sdtm_ae$AESDISAB)  <- "Persist or Signif Disability/Incapacity"
label(sdtm_ae$AESDTH)    <- "Results in Death"                       
label(sdtm_ae$AESHOSP)   <- "Requires or Prolongs Hospitalization"   
label(sdtm_ae$AESLIFE)   <- "Is Life Threatening"                    
label(sdtm_ae$AESMIE)    <- "Other Medically Important Serious Event"
label(sdtm_ae$EPOCH)     <- "Epoch"                                 
label(sdtm_ae$AESTDTC)   <- "Start Date/Time of Adverse Event"       
label(sdtm_ae$AEENDTC)   <- "End Date/Time of Adverse Event"         
label(sdtm_ae$AESTDY)    <- "Study Day of Start of Adverse Event"    
label(sdtm_ae$AEENDY)    <- "Study Day of End of Adverse Event"      
label(sdtm_ae$AEENRTPT)  <- "End Relative to Reference Time Point"   
label(sdtm_ae$AEENTPT)   <- "End Reference Time Point"               

  
#export to xpt  
write.xport(sdtm_ae, file="C://R_software/ae_R.xpt")
# export to CSV
write.csv(sdtm_ae, file="C://R_software/ae.csv")