stdid.R at ea93c4a ⋅ ropensci/cleanEHR

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


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


#' Convert standard IDs to numbers (character) which can be used for indexing.
#'
#' @param obj a StdId object. 
#' @export as.number
as.number <- function(obj) {
    if(!all(grepl("NIHR_HIC_ICU_", obj@ids)))# input is code alredy
        return(obj@ids)
    no.prefix <- 
        unlist(strsplit(obj@ids, "NIHR_HIC_ICU_"))[seq(2, length(obj@ids) * 2, 2)]
    return(as.character(no.prefix))
}

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


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

#' Convert NHIC codes to the short names
#'
#' @param code character NIHC code, e.g. NIHR_HIC_ICU_0108
#' @return shortname character e.g. h_rate 
#' @export code2stname
code2stname <- function(code) {
    code <- as.character(code)
    stn <- code2stname.dict[code]
    stn[is.na(stn)] <- code[is.na(stn)]
    return(stn)
}

#' Convert short names to NHIC codes
#' 
#' @param stname character short names of data item h_rate 
#' @return NIHC code character such as NIHR_HIC_ICU_0108
#' @export stname2code
stname2code <- function(stname) {
    stname <- as.character(stname)
    code <- stname2code.dict[stname]
    code[is.na(code)] <- stname[is.na(code)]
    return(code)
}

#' Convert short names to long names. 
#' 
#' @param stname character short names of data item h_rate 
#' @return longname character such as "heart rate"
#' @export 
stname2longname <- function(stname) {
    stname <- as.character(stname)
    code <- stname2longname.dict[stname]
    code[is.na(code)] <- stname[is.na(code)]
    return(code)
}

#' Convert long names to short names. 
#' 
#' @param l long name such as "heart rate" 
#' @return short name character such as "h_rate"
#' @export
long2stname <- function(l) {
    l <- as.character(l)
    s <- long2stname.dict[l]
    s[is.na(s)] <- l[is.na(s)]
    return(s)
}


#' Identify the classification - classification1 
#' 
#' Identify the classification of a given item code or short
#' name. Classification1 has 5 labels: 
#' [1] "Demographic", [2] "Physiology" 
#' [3] "Drugs" [4] "Nursing_other" [5] "Laboratory"
#' @param item_name NHIC code or the short name
#' @return character the item classification
#' @export which.classification
which.classification <- function(item_name) {
    cls <- class.dict_code[item_name]
    if (is.na(cls))
        cls <- class.dict_stname[item_name]
    if (is.na(cls)) stop(paste("item name", item_name, "cannot be found."))
    return(cls)
}


#' Check if the item NHIC code or short name belongs to the demographic
#' category.
#' @param item_name character the NHIC code or the short name
#' @return logical
#' @export is.demographic
is.demographic <- function(item_name) {
    return(which.classification(item_name) == "Demographic")
}


#' Check if the item NHIC code or short name belongs to the physiology
#' category.
#' @param item_name character the NHIC code or the short name
#' @return logical
#' @export is.physiology
is.physiology <- function(item_name) {
    return(which.classification(item_name) == "Physiology")
}


#' Check if the item NHIC code or short name belongs to the drugs 
#' category.
#' @param item_name character the NHIC code or the short name
#' @return logical
#' @export is.drugs
is.drugs <- function(item_name) {
    return(which.classification(item_name) == "Drugs")
}


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

Read our documentation on viewing source code .

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		}

Navigation	Overlay
`t` Navigate files	`h` Toggle hits
`y` Change url to tip of branch	`m` Toggle misses
`b / v` Jump to prev/next hit line	`p` Toggle partial
`z / x` Jump to prev/next missed or partial line	`1..9` Toggle flags
`shift + o` Open current page in GitHub	`a` Toggle all on
`/ or ?` Show keyboard shortcuts dialog	`c` Toggle context lines or commits