1
#' S4 class to hold standard IDs such as "NIHR_HIC_ICU_0001"
2
#' @slot ids single or multiple characters
3
#' @import methods
4
StdId <- setClass ("StdId",
5
                   slots = c(ids="vector"), 
6
                   validity=function(object)
7
                   {
8
                       reg <- regexpr("NIHR_HIC_ICU_[0-9]+", object@ids)
9
                       ids <- regmatches(object@ids, reg)
10
                       if (length(object@ids) != length(ids)) 
11
                           return("initialisation failure, as the standard ID pattern cannot be found.")
12
                       else
13
                           object@ids <- ids
14
                       return(TRUE)
15
                   })
16

17

18
#' constructor of StdId class
19
#'
20
#' @param text NIHC code which should be in a format like NIHR_HIC_ICU_xxxx
21
#' @export StdId
22
StdId <- function(text) {
23 1
    reg <- regexpr("NIHR_HIC_ICU_[0-9]+", text)
24 1
    ids <- regmatches(text, reg)
25 1
    if (length(text) != length(ids) | length(text) == 0) 
26 1
        stop("StdId: initialisation failure, as the standard ID pattern cannot be found.")
27
    else
28 1
        return(methods::new("StdId", ids=ids))
29
}
30

31

32
#' Convert standard IDs to numbers (character) which can be used for indexing.
33
#'
34
#' @param obj a StdId object. 
35
#' @export as.number
36
as.number <- function(obj) {
37 1
    if(!all(grepl("NIHR_HIC_ICU_", obj@ids)))# input is code alredy
38 0
        return(obj@ids)
39 1
    no.prefix <- 
40 1
        unlist(strsplit(obj@ids, "NIHR_HIC_ICU_"))[seq(2, length(obj@ids) * 2, 2)]
41 1
    return(as.character(no.prefix))
42
}
43

44
.as.number <- function(code) {
45 1
    return(as.numeric(strsplit(code, "NIHR_HIC_ICU_")[[1]][2]))
46
}
47

48

49
all.nhic.code <- function(cls) {
50 1
        data.checklist[data.checklist$Classification1 == cls,"NHICcode"]
51
}
52

53
#' Convert NHIC codes to the short names
54
#'
55
#' @param code character NIHC code, e.g. NIHR_HIC_ICU_0108
56
#' @return shortname character e.g. h_rate 
57
#' @export code2stname
58
code2stname <- function(code) {
59 1
    code <- as.character(code)
60 1
    stn <- code2stname.dict[code]
61 1
    stn[is.na(stn)] <- code[is.na(stn)]
62 1
    return(stn)
63
}
64

65
#' Convert short names to NHIC codes
66
#' 
67
#' @param stname character short names of data item h_rate 
68
#' @return NIHC code character such as NIHR_HIC_ICU_0108
69
#' @export stname2code
70
stname2code <- function(stname) {
71 1
    stname <- as.character(stname)
72 1
    code <- stname2code.dict[stname]
73 1
    code[is.na(code)] <- stname[is.na(code)]
74 1
    return(code)
75
}
76

77
#' Convert short names to long names. 
78
#' 
79
#' @param stname character short names of data item h_rate 
80
#' @return longname character such as "heart rate"
81
#' @export 
82
stname2longname <- function(stname) {
83 1
    stname <- as.character(stname)
84 1
    code <- stname2longname.dict[stname]
85 1
    code[is.na(code)] <- stname[is.na(code)]
86 1
    return(code)
87
}
88

89
#' Convert long names to short names. 
90
#' 
91
#' @param l long name such as "heart rate" 
92
#' @return short name character such as "h_rate"
93
#' @export
94
long2stname <- function(l) {
95 0
    l <- as.character(l)
96 0
    s <- long2stname.dict[l]
97 0
    s[is.na(s)] <- l[is.na(s)]
98 0
    return(s)
99
}
100

101

102
#' Identify the classification - classification1 
103
#' 
104
#' Identify the classification of a given item code or short
105
#' name. Classification1 has 5 labels: 
106
#' [1] "Demographic", [2] "Physiology" 
107
#' [3] "Drugs" [4] "Nursing_other" [5] "Laboratory"
108
#' @param item_name NHIC code or the short name
109
#' @return character the item classification
110
#' @export which.classification
111
which.classification <- function(item_name) {
112 0
    cls <- class.dict_code[item_name]
113 0
    if (is.na(cls))
114 0
        cls <- class.dict_stname[item_name]
115 0
    if (is.na(cls)) stop(paste("item name", item_name, "cannot be found."))
116 0
    return(cls)
117
}
118

119

120
#' Check if the item NHIC code or short name belongs to the demographic
121
#' category.
122
#' @param item_name character the NHIC code or the short name
123
#' @return logical
124
#' @export is.demographic
125
is.demographic <- function(item_name) {
126 0
    return(which.classification(item_name) == "Demographic")
127
}
128

129

130
#' Check if the item NHIC code or short name belongs to the physiology
131
#' category.
132
#' @param item_name character the NHIC code or the short name
133
#' @return logical
134
#' @export is.physiology
135
is.physiology <- function(item_name) {
136 0
    return(which.classification(item_name) == "Physiology")
137
}
138

139

140
#' Check if the item NHIC code or short name belongs to the drugs 
141
#' category.
142
#' @param item_name character the NHIC code or the short name
143
#' @return logical
144
#' @export is.drugs
145
is.drugs <- function(item_name) {
146 0
    return(which.classification(item_name) == "Drugs")
147
}
148

149

150
#' Check if the item NHIC code or short name belongs to the Laboratory 
151
#' category.
152
#' @param item_name character the NHIC code or the short name
153
#' @return logical
154
#' @export is.laboratory
155
is.laboratory <- function(item_name) {
156 0
    return(which.classification(item_name) == "Laboratory")
157
}

Read our documentation on viewing source code .

Loading