R/computeTreatmentDuration.R

In davidcoffey/Diamonds: For clinical data mining of the Caisis and Diamonds databases

#' Computes treatment duration per line of therapy
#'
#' Computes treatment duration per line of therapy where a line of therapy as all drugs
#' given within a defined range of days.
#'
#' @param data A data frame generated by the function extractMedicalTherapy.
#' @param days Number of days between the start of treatment that defines a line of therapy.
#' @return Returns a data frame with treatment duration calculated per line of therapy.  Output
#' contains the same input with the addition of 4 new columns where line sequentional number of
#' therapies, duration is the number of days between treatments, DaysFromTxStart is the number
#' of days from the first line of therapy, and MedTxDayByLine it the recomputed number of days
#' from the first line of therapy.
#' @export
computeTreatmentDuration = function(data, days = 14){
    # Create empty dataframes
    line.duration = data.frame()

    # Create a vector of patients to index on
    patients = as.character(unique(data$PatientMRN))

    i = 1
    for(i in 1:length(patients)) {
        # Determine line of therapy
        therapy.per.pateint = data[data$PatientMRN == patients[i], ]

        therapy.per.pateint$DaysFromTxStart = therapy.per.pateint$MedTxDate - min(therapy.per.pateint$MedTxDate)
        therapy.per.pateint = therapy.per.pateint[order(as.character(therapy.per.pateint$PatientMRN), therapy.per.pateint$DaysFromTxStart, decreasing = FALSE), ]



        # Recalculate line of therapy by line of therapy (defined as drugs given within 14 days of each)
        k = 1
        for(k in 1:nrow(therapy.per.pateint)) {
            if(k == 1){
                therapy.per.pateint$MedTxDateByLine[k] = therapy.per.pateint$DaysFromTxStart[k]
            } else {
                therapy.per.pateint$MedTxDateByLine[k] = ifelse(therapy.per.pateint$DaysFromTxStart[k] - therapy.per.pateint$DaysFromTxStart[k - 1] < days,
                                                                therapy.per.pateint$MedTxDateByLine[k - 1], therapy.per.pateint$DaysFromTxStart[k])
            }
        }
        line = data.frame(MedTxDateByLine = unique(therapy.per.pateint$MedTxDateByLine),
                          Line = seq(from = 1, to = length(unique(therapy.per.pateint$MedTxDateByLine))))


        # Compute duration of therapy
        line$Duration = c(line$MedTxDateByLine[-1], NA) - line$MedTxDateByLine
        therapy.per.line = merge(therapy.per.pateint, line)
        line.duration = rbind(line.duration, therapy.per.line)
    }
    return(line.duration)
}