1
find.episode.time <- function(episode) {
2 1
    time <- unlist(lapply(episode@data, 
3 1
                          function(d) {
4 1
                              if (length(d) > 1) 
5 1
                                  return(as.character(d$time))
6
                              else
7 1
                                  return(NULL)
8 1
                          }), use.names=FALSE)
9 1
    if (is.null(time))
10 1
        return(list(admt=as.POSIXct(NA), 
11 1
                    dsct=as.POSIXct(NA)))
12
    else {
13 1
        time <- tryCatch(xmlTime2POSIX(time), 
14 1
                         error=function(e) {
15 0
                             cat("time is not xmlTime format.\n")
16 0
                             print(unlist(time))
17 0
                             stop()
18
                         })
19 1
        return(list(admt=min(time), dsct=max(time)))
20
    }
21
}
22

23

24

25

26
#' Convert calendar date-time to the time difference comparing to the ICU
27
#' admission time.
28
#'
29
#' @param record ccRecord
30
#' @param pseudotime logical If pseudotime is set to be TRUE, then the
31
#' admission and discharge time will be set as the earliest and latest data stamp
32
#' in the record.
33
#' @param units units of delta time, which can be "hours", "mins", "days".
34
#' @param tdiff if false the delta time will be written in numeric format. 
35
#' @export deltaTime
36
deltaTime <- function(record, pseudotime=FALSE, units="hours", tdiff=FALSE) {
37 1
    nep <- record@nepisodes
38 1
    if (nep == 0)
39 1
        stop("record is an empty ccRecord object!")
40

41
    # for pseudotime data only: 
42
    # convert hash admin time to the earliest time of the record
43 1
    if (pseudotime == TRUE) {
44 1
        admdsct <- for_each_episode(record, find.episode.time)
45 1
        for(e in seq(record@episodes)) {
46 1
                record@episodes[[e]]@t_admission <- admdsct[[e]]$admt
47 1
                record@episodes[[e]]@t_discharge <- admdsct[[e]]$dsct
48
        }
49
    }
50

51 1
    update_time <- function(ep) {
52 1
        env <- environment()
53 1
        t_admission <- xmlTime2POSIX(ep@t_admission, allow=TRUE)
54 1
        if (is.na(t_admission)) {
55 1
            return(NULL)
56
        }
57
        else {
58 1
            eps <- 
59 1
                lapply(ep@data,
60 1
                       function(data) {
61 1
                           if (length(data) > 1) {
62 1
                               data$time <- 
63 1
                                   difftime(xmlTime2POSIX(data$time), 
64 1
                                            env$t_admission,
65 1
                                            units=units)
66 1
                               if (!tdiff)
67 1
                                   data$time <- as.numeric(data$time)
68

69
                           }
70 1
                           return(data)
71
                       })
72 1
            newep <- new.episode(eps)
73 1
            newep@parse_file <- ep@parse_file
74 1
            newep@parse_time <- ep@parse_time
75 1
            newep
76
        }
77
    }
78

79

80 1
    record <- ccRecord() + for_each_episode(record, update_time)
81

82 1
    if (pseudotime == TRUE) {
83 1
        for(e in seq(record@episodes)) {
84 1
                record@episodes[[e]]@t_admission <- admdsct[[e]]$admt
85 1
                record@episodes[[e]]@t_discharge <- admdsct[[e]]$dsct
86
            }
87 1
        record <- index.record(record)
88
    }
89

90

91 1
    if (nep != record@nepisodes) {
92 1
        if (pseudotime)
93 1
            warning(nep - record@nepisodes, 
94 1
                    " episodes have been removed due to no admission data.")
95
        else 
96 1
            warning(nep - record@nepisodes, 
97 1
                    " episodes have been removed due to no time-wise data.")
98
    }
99 1
    return(record)
100
}

Read our documentation on viewing source code .

Loading