Nothing
R/export.R
In espadon: Easy Study of Patient DICOM Data in Oncology
Defines functions
create.UID
create.SOPUID
.ascii.to.hex
.tag.to.hex
export.rtdose.to.dicom
export.rtstruct.to.dicom
export.img3Dplan.to.dicom
export
Documented in
export
#' Export espadon objects in DICOM format
#' @description The \code{export} function exports struct class objects and
#' volume class objects with CT or RTDOSE modality in DICOM format.
#' @param obj espadon object of rtstruct, ct or rtdose modality to be exported.
#' @param format Format of the export. For next use.
#' @param ref.obj.list List of espadon objects which are referenced objects of \code{obj}. See Details.
#' @param use.original.UIs,use.original.ref.UIs Booleans. If \code{TRUE}, study instance UID, serie instance
#' UID and image type attribute are those indicated in \code{$object.info} item.
#' Otherwise,They are regenerated. See Details.
#' @param file.prefix String. Prefix added to the generated filename, in case of \code{file.name} is \code{NULL}.
#' @param file.dirname String. Name of the directory in which files are generated.
#' @param file.name String. Base name of the generated files. in CT modality, a slice number is added as a suffix.
#' @param tag.dictionary Dataframe, by default equal to
#' \link[espadon]{dicom.tag.dictionary}, whose structure it must keep. This
#' dataframe is used to parse DICOM files.
#' @param ... Additional settings such as NAvalue (for "volume" data), '(0020,000D)',
#' '(0020,000E)', '(0008,0008)'
#' @return Returns nothing, but generate DICOM files if conditions are required,
#' and indicates the name or number of files created
#' @details The object you want to export may be known in a TPS thanks to these
#' Unique Identifiers (UIs). If you want to create a DICOM object that is different
#' and recognised by your TPS, it is important that the DICOM files you want to
#' create have new UIs: in this case, set the \code{use.original.UIs} argument
#' to \code{FALSE}. Otherwise, UIs in \code{$object.info} item of your object
#' will be used.
#' @details Your object may have been created from another DICOM object (i.e. a
#' reference object). You can, for example, see these links with the function
#' \link[espadon]{display.obj.links}.
#' @details If you want to keep this links, you must indicate which objects are
#' references in the \code{ref.obj.list} argument, in the form of a list of espadon
#' objects. If these reference objects have their own identifier and you wish to
#' keep them, you must set the \code{use.original.ref.UIs} argument to \code{TRUE}.
#' @details Otherwise (\code{use.original.ref.UIs=FALSE}), the UIs of the reference
#' objects will be regenerated. It is therefore important that the reference objects
#' contain all their data such as \code{vol3D.data} or \code{roi.data}.
#' @details It may be useful to impose a study number (tag '(0020,000D)'), serial
#' number (tag '(0020,000E)'), or your Image Type Attribute (tag '(0008,0008)').
#' In this case, you need to add the arguments \code{'(0020,000D)' = your_study_UID},
#' \code{'(0020,000E)' = your_serial_UID}, \code{'(0008,0008)' = your_image_type_attribute}.
#' @examples
#' # First, save toy patient objects to a temporary file pat.dir for testing.
#' pat.dir <- file.path (tempdir(), "PM_Rdcm")
#' dir.create (pat.dir, recursive = TRUE)
#' patient <- toy.load.patient (modality = c("ct", "rtstruct"), roi.name = "",
#' dxyz = c (6, 6, 6))
#' dicom.dir <- file.path (tempdir(), "PM_dcm")
#' export(patient$rtstruct[[1]], ref.obj.list = list (patient$ct[[1]]),
#' file.dirname = dicom.dir,file.name="RS")
#' export(patient$ct[[1]], file.dirname = dicom.dir,file.name="CT")
#' list.files(dicom.dir)
#'
#' # check that the links have been preserved.
#' pat <- load.patient.from.dicom (dicom.dir, verbose = FALSE)
#' display.obj.links (pat)
#'
#' # Cleaning temporary directories
#' unlink (dicom.dir, recursive = TRUE)
#'
#' @export
export <- function(obj,format="dcm", ref.obj.list = NULL, use.original.UIs = FALSE,
use.original.ref.UIs = TRUE,
file.prefix ="", file.dirname= '.', file.name = NULL,
tag.dictionary = dicom.tag.dictionary(), ...){
if (format[1] == "dcm"){
if (!(is(obj,"volume") | is(obj,"struct")))
stop("At present, only espadon objects with the ct, rtdose or rtstruct modality can be exported.")
if (!(obj$modality %in% c("ct","mr","rtdose","rtstruct")))
stop("At present, only espadon objects with the ct, mr, rtdose or rtstruct modality can be exported.")
if (tolower(obj$modality)=="ct" | tolower(obj$modality)=="mr") {
export.img3Dplan.to.dicom (obj, ref.obj.list = ref.obj.list, use.original.UIs = use.original.UIs,
use.original.ref.UIs=use.original.ref.UIs,
file.prefix =file.prefix, file.dirname= file.dirname, file.name = file.name,
tag.dictionary = tag.dictionary,...)
} else if (tolower(obj$modality)=="rtdose") {
export.rtdose.to.dicom (obj, ref.obj.list = ref.obj.list, use.original.UIs = use.original.UIs,
use.original.ref.UIs=use.original.ref.UIs,
file.prefix =file.prefix, file.dirname= file.dirname, file.name = file.name,
tag.dictionary = tag.dictionary,...)
} else if (tolower(obj$modality)=="rtstruct"){
export.rtstruct.to.dicom (obj, ref.obj.list = ref.obj.list, use.original.UIs = use.original.UIs,
use.original.ref.UIs=use.original.ref.UIs,
file.prefix =file.prefix, file.dirname= file.dirname, file.name = file.name,
tag.dictionary = tag.dictionary,...)
}
}
}
################################################################################
export.img3Dplan.to.dicom <- function(obj, ref.obj.list = NULL, use.original.UIs = FALSE,
use.original.ref.UIs = TRUE,
file.prefix ="", file.dirname= '.', file.name = NULL,
tag.dictionary = dicom.tag.dictionary(),...){
rownames(tag.dictionary) <- tag.dictionary$tag
args <- tryCatch(list(...), error = function(e)list())
study.UID <- .ascii.to.hex (args[["(0020,000D)"]], tag.dictionary["(0020,000D)","VR"])
serie.UID <- .ascii.to.hex (args[["(0020,000E)"]], tag.dictionary["(0020,000E)","VR"])
sop.type <- .ascii.to.hex (args[["(0008,0008)"]], tag.dictionary["(0008,0008)","VR"])
patient.position <- .ascii.to.hex (args[["(0018,5100)"]], tag.dictionary["(0018,5100)","VR"])
NAvalue <- args[["NAvalue"]]
study.vect <- c("patient","frame.of.reference")
serie.vect <- c("patient","frame.of.reference","modality", "description", "study.date", "study.time")
if (!is.null(obj$object.info) & use.original.UIs){
if (length(study.UID)==0) study.UID <- .ascii.to.hex (obj$object.info$study.UID, tag.dictionary["(0020,000D)","VR"])
if (length(serie.UID)==0) serie.UID <- .ascii.to.hex (obj$object.info$serie.UID, tag.dictionary["(0020,000E)","VR"])
if (length(sop.type)==0) sop.type <- .ascii.to.hex (obj$object.info$SOP.type, tag.dictionary["(0008,0008)","VR"])
} else {
if (length(study.UID)==0) study.UID <- create.UID(obj,study.vect,size = 50)
if (length(serie.UID)==0) serie.UID <- create.UID(obj,serie.vect,size =50)
if (length(sop.type)==0) sop.type <- .ascii.to.hex ('ORIGINAL\\PRIMARY', tag.dictionary["(0008,0008)","VR"])
}
if (length(patient.position)==0) patient.position <- .ascii.to.hex ("HFS", tag.dictionary["(0018,5100)","VR"])
if (length(.ascii.to.hex(obj$frame.of.reference, "UI"))==0)
obj$frame.of.reference <- rawToChar(create.UID (obj,c("patient", "ref.pseudo"), size =44))
frame.of.reference <- .ascii.to.hex(obj$frame.of.reference, "UI")
frame.of.reference <- c (unlist (.value.to.raw (length (frame.of.reference), 2, TRUE)),
frame.of.reference)
intercept <- NA
slope <- NA
vol3D <- round(obj$vol3D.data,6)
if (length(vol3D)!=0){
f <- is.na(vol3D)
if (all(f)){
warning(c("obj$vol3D.data contains only NA values. This data will not be exported."))
vol3D <- NULL
} else {
obj.max.pixel <- max(vol3D, na.rm =TRUE)
obj.min.pixel <- min(vol3D, na.rm =TRUE)
intercept <- obj.min.pixel
slope <- sort(diff(sort(unique(as.vector(vol3D-intercept)))))[1]
max.pixel <- round((obj.max.pixel-intercept)/slope)
min.pixel <- round((obj.min.pixel-intercept)/slope)
while((abs(max.pixel) > 2^15) | (abs(min.pixel) > 2^15)){
slope <- slope*2
max.pixel <- round((obj.max.pixel-intercept)/slope)
min.pixel <- round((obj.min.pixel-intercept)/slope)
}
if (any(f)) {
if (is.null(NAvalue)){
# NAvalue <- - 2^ceiling(log(slope* max.pixel)/log(2))
if (obj$modality == "ct") {NAvalue <- - 2^15} else {NAvalue <- 0}
warning(c("obj$vol3D.data contains NA values. This data will be replaced by the value ",NAvalue,
". If you wish to change this value, add the argument NAvalue=your_NA_value."))
}
vol3D[f] <- NAvalue
min.pixel <- NAvalue
}
vol3D <- round((vol3D-intercept)/slope)
}
} else {
warning(c("There is no obj$vol3D.data in ", obj$object.alias,"."))
}
L00081140 <- c()
SOP <- create.SOPUID(obj)
######################################
fn <- sapply(SOP$l1155, function(uid) rev(unlist(strsplit(rawToChar(uid[uid!=as.raw(0)]),"[.]")))[1])
if (length(file.name)==0){
filen <- file.path(file.dirname, paste0(file.prefix, fn, ".dcm"))
} else {
le <- nchar(fn[1])
suffix <- substr(fn,le + 1 -nchar(as.character(max(obj$k.idx))),le)
if (length(suffix)==1) suffix <- ""
file.name <- gsub("[.]dcm$","",file.name)
filen <- file.path(file.dirname, paste0(file.name,"_", suffix,".dcm"))
}
dn <- unique(dirname(filen))
for (fdn in dn) if (!dir.exists(fdn)) dir.create(fdn,recursive = T)
#######################################
SOP_UID.1150 <- lapply(SOP$l1150,function(uid) c(unlist(.value.to.raw (length(uid),2,TRUE)),uid))
SOP_UID.1155 <- lapply(SOP$l1155,function(uid) c(unlist(.value.to.raw (length(uid),2,TRUE)),uid))
version_name <- paste(c("R ",version$major,".",version$minor,
" espadon ", .espadon.version()),collapse ="")
version_name <- c(charToRaw(version_name),as.raw(0x00))
version_name <- version_name[1:(2*floor(length(version_name)/2))]
transfert_syntax <- c(charToRaw("1.2.840.10008.1.2.1"),as.raw(0x00))
implementation_UID <- c( charToRaw(paste0(.espadon.version(),".",
paste(charToRaw(obj$modality),collapse=""))),as.raw(0x00))
####################################
preamble <- as.raw(c(rep(0,128),68,73,67,77))
####################################
tag0002 <- c("(0002,0000)","(0002,0001)" ,"(0002,0002)", "(0002,0003)",
"(0002,0010)", "(0002,0012)", "(0002,0013)")
L0002 <- lapply(tag0002,function(t) c())
names(L0002) <- tag0002
L0002[["(0002,0001)"]] <- c(.tag.to.hex ("(0002,0001)"), charToRaw (tag.dictionary["(0002,0001)","VR"]),
as.raw(c(0x00,0x00,0x02,0x00,0x00,0x00,0x00,0x01)))
L0002[["(0002,0010)"]] <- c(.tag.to.hex ("(0002,0010)"), charToRaw (tag.dictionary["(0002,0010)","VR"]),
unlist(.value.to.raw (length(transfert_syntax),2,TRUE)),transfert_syntax)
L0002[["(0002,0012)"]] <- c(.tag.to.hex ("(0002,0012)"), charToRaw (tag.dictionary["(0002,0012)","VR"]),
unlist(.value.to.raw (length(implementation_UID),2,TRUE)),implementation_UID)
L0002[["(0002,0013)"]] <- c(.tag.to.hex ("(0002,0013)"), charToRaw (tag.dictionary["(0002,0013)","VR"]),
unlist(.value.to.raw (length(version_name),2,TRUE)), version_name)
####################################
tag0008 <- c("(0008,0005)", "(0008,0008)", #(optional)
"(0008,0012)", "(0008,0016)", "(0008,0018)", "(0008,0020)", "(0008,0022)",
"(0008,0023)", "(0008,0030)", "(0008,0033)", "(0008,0050)",
"(0008,0060)", "(0008,0070)", "(0008,0090)",
"(0008,1030)", "(0008,103E)", "(0008,1070)")
VR0008 <- tag.dictionary[tag0008,"VR"]
L0008 <- lapply(tag0008,function(t) c())
names(L0008) <- tag0008
names(VR0008) <- tag0008
L0008[["(0008,0005)"]] <- c (.tag.to.hex ("(0008,0005)"), charToRaw (tag.dictionary["(0008,0005)","VR"]),
as.raw (c(0x0A,0x00)), charToRaw ("ISO_IR 100"))
L0008[["(0008,0008)"]] <- c (.tag.to.hex ("(0008,0008)"), charToRaw (tag.dictionary["(0008,0008)","VR"]),
unlist (.value.to.raw (length (sop.type), 2, TRUE)), sop.type)
if (obj$creation.date!=""){
new.raw <- .ascii.to.hex (obj$creation.date, tag.dictionary["(0008,0012)","VR"])
m <- match(new.raw[1:8], as.raw(48:57))
L0008[["(0008,0012)"]]<- c (.tag.to.hex ("(0008,0012)"), charToRaw (tag.dictionary["(0008,0012)","VR"]),
as.raw (c (0x08,0x00)), new.raw[1:8])
} else {
L0008[["(0008,0012)"]]<- c (.tag.to.hex("(0008,0012)"), charToRaw (tag.dictionary["(0008,0012)","VR"]),
as.raw (c(0x08,0x00)),charToRaw (format (Sys.Date (), "%Y%m%d"))) # devient la date d'assignation de SOP_UID
}
new.raw <- .ascii.to.hex (obj$study.date, tag.dictionary["(0008,0020)","VR"])
L0008[["(0008,0020)"]]<- c (.tag.to.hex ("(0008,0020)"), charToRaw (tag.dictionary["(0008,0020)","VR"]),
as.raw (c (0x08,0x00)), new.raw[1:8])
new.raw <- .ascii.to.hex (trimws (obj$acq.date), VR0008["(0008,0022)"])
L0008[["(0008,0022)"]] <- c (.tag.to.hex ("(0008,0022)"), charToRaw (tag.dictionary["(0008,0022)","VR"]),
unlist (.value.to.raw (length (new.raw), 2, TRUE)), new.raw)
L0008[["(0008,0023)"]] <- c (.tag.to.hex ("(0008,0023)"), charToRaw (tag.dictionary["(0008,0023)","VR"]),
unlist (.value.to.raw (length (new.raw), 2, TRUE)), new.raw)
new.raw <- .ascii.to.hex (trimws (obj$study.time), tag.dictionary["(0008,0030)","VR"])
L0008[["(0008,0030)"]] <- c (.tag.to.hex ("(0008,0030)"), charToRaw (tag.dictionary["(0008,0030)","VR"]),
unlist (.value.to.raw (length (new.raw), 2, TRUE)), new.raw)
L0008[["(0008,0033)"]] <- c (.tag.to.hex ("(0008,0033)"), charToRaw (tag.dictionary["(0008,0033)","VR"]), as.raw (c (0x00,0x00)))
L0008[["(0008,0050)"]] <- c (.tag.to.hex ("(0008,0050)"), charToRaw (tag.dictionary["(0008,0050)","VR"]), as.raw (c (0x00,0x00)))
if (obj$modality == "ct") {
L0008[["(0008,0060)"]] <- c (.tag.to.hex ("(0008,0060)"), charToRaw (tag.dictionary["(0008,0060)","VR"]),
as.raw (c (0x02,0x00)), charToRaw ("CT"))
} else {
L0008[["(0008,0060)"]] <- c (.tag.to.hex ("(0008,0060)"), charToRaw (tag.dictionary["(0008,0060)","VR"]),
as.raw (c (0x02,0x00)), charToRaw ("MR"))
}
new.raw <- .ascii.to.hex ("R ESPADON MANUFACTURER", tag.dictionary["(0008,0070)","VR"])
L0008[["(0008,0070)"]] <- c (.tag.to.hex ("(0008,0070)"), charToRaw (tag.dictionary["(0008,0070)","VR"]),
unlist (.value.to.raw (length (new.raw), 2, TRUE)), new.raw)
L0008[["(0008,0090)"]] <- c (.tag.to.hex ("(0008,0090)"), charToRaw (tag.dictionary["(0008,0090)","VR"]), as.raw (c (0x00,0x00)))
description <- unlist(strsplit(obj$description,"[|]")[[1]])
new.raw <-.ascii.to.hex( iconv(description[1], "ISO-IR-100"), tag.dictionary["(0008,1030)","VR"])
L0008[["(0008,1030)"]]<- c (.tag.to.hex ("(0008,1030)"), charToRaw (tag.dictionary["(0008,1030)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
if(!is.na(description[2])!=0){
new.raw <-.ascii.to.hex( iconv(description[2], "ISO-IR-100"), tag.dictionary["(0008,103E)","VR"])
L0008[["(0008,103E)"]]<- c (.tag.to.hex ("(0008,103E)"), charToRaw (tag.dictionary["(0008,103E)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
}
#
L0008[["(0008,1070)"]]<- c (.tag.to.hex ("(0008,1070)"), charToRaw (tag.dictionary["(0008,1070)","VR"]), as.raw (c (0x00,0x00)))
####################################
tag0010 <- c("(0010,0010)","(0010,0020)","(0010,0030)","(0010,0040)")
L0010 <- lapply(tag0010,function(t) c())
names(L0010) <- tag0010
# if(nchar(obj$patient.name)!=0) obj$patient.name <- ""
new.raw <- .ascii.to.hex( iconv(obj$patient.name, "ISO-IR-100"), tag.dictionary["(0010,0010)","VR"])
L0010[["(0010,0010)"]]<- c (.tag.to.hex("(0010,0010)"), charToRaw(tag.dictionary["(0010,0010)","VR"]),
unlist(.value.to.raw (length(new.raw),2,T)),new.raw)
# if(nchar(obj$patient)!=0) obj$patient <- ""
new.raw <-.ascii.to.hex( iconv(obj$patient, "ISO-IR-100"), tag.dictionary["(0010,0020)","VR"])
L0010[["(0010,0020)"]]<- c (.tag.to.hex("(0010,0020)"), charToRaw(tag.dictionary["(0010,0020)","VR"]),
unlist (.value.to.raw (length (new.raw), 2, T)),new.raw)
new.raw <- .ascii.to.hex (trimws(obj$patient.bd), tag.dictionary["(0010,0030)","VR"])
L0010[["(0010,0030)"]]<- c (.tag.to.hex ("(0010,0030)"), charToRaw (tag.dictionary["(0010,0030)","VR"]),
unlist (.value.to.raw (length (new.raw), 2, T)),new.raw)
new.raw <- .ascii.to.hex (trimws(obj$patient.sex), tag.dictionary["(0010,0040)","VR"])
L0010[["(0010,0040)"]]<- c (.tag.to.hex ("(0010,0040)"), charToRaw (tag.dictionary["(0010,0040)","VR"]),
unlist (.value.to.raw (length (new.raw), 2, T)),new.raw)
####################################
tag0018 <- c("(0018,0050)", "(0018,0060)", "(0018,1020)","(0018,5100)")
L0018 <- lapply(tag0018,function(t) c())
names(L0018) <- tag0018
slice.thickness <- obj$slice.thickness
if (slice.thickness==0) slice.thickness<- c()
new.raw <- .ascii.to.hex (as.character(slice.thickness), tag.dictionary["(0018,0050)","VR"])
L0018[["(0018,0050)"]] <- c (.tag.to.hex("(0018,0050)"), charToRaw(tag.dictionary["(0018,0050)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)),new.raw)
L0018[["(0018,0060)"]] <- c (.tag.to.hex ("(0018,0060)"), charToRaw (tag.dictionary["(0018,0060)","VR"]), as.raw (c (0x00,0x00)))
new.raw <- .ascii.to.hex (paste("espadon", .espadon.version()), tag.dictionary["(0018,1020)","VR"])
L0018[["(0018,1020)"]] <- c(.tag.to.hex("(0018,1020)"), charToRaw(tag.dictionary["(0018,1020)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)),new.raw)
L0018[["(0018,5100)"]] <- c(.tag.to.hex("(0018,5100)"), charToRaw(tag.dictionary["(0018,5100)","VR"]),
unlist(.value.to.raw (length(patient.position),2,TRUE)),patient.position)
####################################
tag0020 <- c("(0020,000D)", "(0020,000E)", "(0020,0010)", "(0020,0011)", "(0020,0013)",
"(0020,0032)", "(0020,0037)", "(0020,0052)", "(0020,1040)","(0020,1041)")
L0020 <- lapply(tag0020,function(t) c())
names(L0020) <- tag0020
L0020[["(0020,000D)"]] <- c (.tag.to.hex("(0020,000D)"), charToRaw(tag.dictionary["(0020,000D)","VR"]),
unlist(.value.to.raw (length(study.UID), 2, T)), study.UID)
L0020[["(0020,000E)"]] <- c (.tag.to.hex("(0020,000E)"), charToRaw (tag.dictionary["(0020,000E)","VR"]),
unlist(.value.to.raw (length(serie.UID), 2, TRUE)), serie.UID)
L0020[["(0020,0010)"]] <- c(.tag.to.hex("(0020,0010)"), charToRaw(tag.dictionary["(0020,0010)","VR"]),
as.raw(c(0x00, 0x00)))
L0020[["(0020,0011)"]] <- c(.tag.to.hex("(0020,0011)"), charToRaw(tag.dictionary["(0020,0011)","VR"]),
as.raw(c(0x00, 0x00)))
L0020[["(0020,0013)"]] <- c(.tag.to.hex("(0020,0013)"), charToRaw(tag.dictionary["(0020,0013)","VR"]),
as.raw(c(0x00, 0x00)))
new.raw <- .ascii.to.hex (paste(obj$orientation, collapse="\\"), tag.dictionary["(0020,0037)","VR"])
L0020[["(0020,0037)"]] <- c(.tag.to.hex("(0020,0037)"), charToRaw(tag.dictionary["(0020,0037)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
L0020[["(0020,0052)"]] <- c(.tag.to.hex("(0020,0052)"),charToRaw(tag.dictionary["(0020,0052)","VR"]), frame.of.reference)
L0020[["(0020,1040)"]] <- c(.tag.to.hex("(0020,1040)"), charToRaw(tag.dictionary["(0020,1040)","VR"]),
as.raw(c(0x00, 0x00)))
####################################
tag0028 <- c("(0028,0002)", "(0028,0004)", "(0028,0010)", "(0028,0011)","(0028,0030)",
"(0028,0100)", "(0028,0101)", "(0028,0102)","(0028,0103)", "(0028,0106)",
"(0028,0107)", "(0028,1052)","(0028,1053)","(0028,1054)")#, "(0028,0120)")
L0028 <- lapply(tag0028,function(t) c())
names(L0028) <- tag0028
new.raw <-as.raw(c(1,0))
L0028[["(0028,0002)"]] <- c(.tag.to.hex("(0028,0002)"), charToRaw(tag.dictionary["(0028,0002)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
new.raw <- .ascii.to.hex ("MONOCHROME2", tag.dictionary["(0028,0004)","VR"])
L0028[["(0028,0004)"]] <- c(.tag.to.hex("(0028,0004)"), charToRaw(tag.dictionary["(0028,0004)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
new.raw <- c(as.raw(obj$n.ijk[2]%%256) ,as.raw((obj$n.ijk[2]/256)%%256))
L0028[["(0028,0010)"]] <- c(.tag.to.hex("(0028,0010)"), charToRaw(tag.dictionary["(0028,0010)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
new.raw <- c(as.raw(obj$n.ijk[1]%%256) ,as.raw((obj$n.ijk[1]/256)%%256))
L0028[["(0028,0011)"]] <- c(.tag.to.hex("(0028,0011)"), charToRaw(tag.dictionary["(0028,0011)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
new.raw <- .ascii.to.hex (paste(obj$dxyz[1:2], collapse="\\"), tag.dictionary["(0028,0030)","VR"])
L0028[["(0028,0030)"]] <- c(.tag.to.hex("(0028,0030)"), charToRaw(tag.dictionary["(0028,0030)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
new.raw <-as.raw(c(16,0))
L0028[["(0028,0100)"]] <- c(.tag.to.hex("(0028,0100)"), charToRaw(tag.dictionary["(0028,0100)","VR"]),
unlist( .value.to.raw (length(new.raw),2,TRUE)), new.raw)
L0028[["(0028,0101)"]] <- c(.tag.to.hex("(0028,0101)"), charToRaw(tag.dictionary["(0028,0101)","VR"]),
unlist( .value.to.raw (length(new.raw),2,TRUE)), new.raw)
new.raw <- as.raw(c(15,0))
L0028[["(0028,0102)"]] <- c(.tag.to.hex("(0028,0102)"), charToRaw(tag.dictionary["(0028,0102)","VR"]),
unlist( .value.to.raw (length(new.raw),2,TRUE)), new.raw)
# new.raw <- as.raw(c(0,0))
# if (obj$min.pixel<0)
new.raw <- as.raw(c(1,0))
L0028[["(0028,0103)"]] <- c(.tag.to.hex("(0028,0103)"), charToRaw(tag.dictionary["(0028,0103)","VR"]),
unlist( .value.to.raw (length(new.raw),2,TRUE)), new.raw)
new.raw <- .ascii.to.hex (as.character(intercept), tag.dictionary["(0028,1052)","VR"])
L0028[["(0028,1052)"]] <- c(.tag.to.hex("(0028,1052)"), charToRaw(tag.dictionary["(0028,1052)","VR"]),
unlist( .value.to.raw (length(new.raw),2,TRUE)), new.raw)
new.raw <- .ascii.to.hex (as.character(slope), tag.dictionary["(0028,1053)","VR"])
L0028[["(0028,1053)"]] <- c(.tag.to.hex("(0028,1053)"), charToRaw(tag.dictionary["(0028,1053)","VR"]),
unlist( .value.to.raw (length(new.raw),2,TRUE)), new.raw)
if (nchar(trimws(obj$unit))!=0){
new.raw <- .ascii.to.hex (as.character(obj$unit), tag.dictionary["(0028,1054)","VR"])
L0028[["(0028,1054)"]] <- c(.tag.to.hex("(0028,1054)"), charToRaw(tag.dictionary["(0028,1054)","VR"]),
unlist( .value.to.raw (length(new.raw),2,TRUE)), new.raw)
}
####################################
for (sop.idx in 1:length(filen)){
L0002[["(0002,0002)"]] <- c(.tag.to.hex ("(0002,0002)"), charToRaw (tag.dictionary["(0002,0002)","VR"]),
SOP_UID.1150[[sop.idx]])
L0002[["(0002,0003)"]] <- c(.tag.to.hex ("(0002,0003)"), charToRaw (tag.dictionary["(0002,0003)","VR"]),
SOP_UID.1155[[sop.idx]])
L0002[["(0002,0000)"]] <- c(.tag.to.hex ("(0002,0000)"), charToRaw (tag.dictionary["(0002,0000)","VR"]),
as.raw (c (0x04,0x00)),
unlist ( .value.to.raw (length (unlist (L0002[2:7])), 4, T)))
L0008[["(0008,0016)"]] <- c (.tag.to.hex ("(0008,0016)"), charToRaw (tag.dictionary["(0008,0016)","VR"]),
SOP_UID.1150[[sop.idx]])
L0008[["(0008,0018)"]] <- c (.tag.to.hex ("(0008,0018)"), charToRaw (tag.dictionary["(0008,0018)","VR"]),
SOP_UID.1155[[sop.idx]])
new.raw <- .ascii.to.hex (paste(obj$xyz0[sop.idx,], collapse="\\"), tag.dictionary["(0020,0032)","VR"])
L0020[["(0020,0032)"]] <- c(.tag.to.hex("(0020,0032)"), charToRaw(tag.dictionary["(0020,0032)","VR"]),
unlist( .value.to.raw (length(new.raw),2,TRUE)), new.raw)
new.raw <- .ascii.to.hex (paste(obj$xyz0[sop.idx,3], collapse="\\"), tag.dictionary["(0020,1041)","VR"])
L0020[["(0020,1041)"]] <- c(.tag.to.hex("(0020,1041)"), charToRaw(tag.dictionary["(0020,1041)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
if (length(vol3D)!=0){
map <- as.vector(vol3D[,,sop.idx])
min.pixel <- min(map)
max.pixel <- max(map)
new.raw <- c(as.raw(min.pixel%%256) ,as.raw((min.pixel/256)%%256))
L0028[["(0028,0106)"]] <- c(.tag.to.hex("(0028,0106)"), charToRaw("US"),
as.raw(c(0x02,00)), new.raw)
new.raw <- c(as.raw(max.pixel%%256) ,as.raw((max.pixel/256)%%256))
L0028[["(0028,0107)"]] <- c(.tag.to.hex("(0028,0107)"), charToRaw("US"),
as.raw(c(0x02,00)), new.raw)
map <- as.vector(rbind(as.raw(map%%256) ,as.raw((map/256)%%256)))
L7FE00010 <- c(.tag.to.hex("(7FE0,0010)"),charToRaw("OW"), as.raw(c(0,0)),
unlist(.value.to.raw (length(map),4,TRUE)),map)
}
####################################
rawdata <- as.vector(c(preamble,unlist(L0002),unlist(L0008),unlist(L0010),unlist(L0018),
unlist(L0020),unlist(L0028),L7FE00010))
zz <- file (filen[sop.idx], "wb")
writeBin (rawdata, zz, size = 1)
close (zz)
}
message ("number of files created : ", length(filen))
}
################################################################################
export.rtstruct.to.dicom <- function(obj, ref.obj.list = NULL, use.original.UIs = FALSE,
use.original.ref.UIs = TRUE,
file.prefix ="", file.dirname= '.', file.name = NULL,
tag.dictionary = dicom.tag.dictionary(),...){
rownames(tag.dictionary) <- tag.dictionary$tag
args <- tryCatch(list(...), error = function(e)list())
study.UID <- .ascii.to.hex (args[["(0020,000D)"]], tag.dictionary["(0020,000D)","VR"])
serie.UID <- .ascii.to.hex (args[["(0020,000E)"]], tag.dictionary["(0020,000E)","VR"])
sop.type <- .ascii.to.hex (args[["(0008,0008)"]], tag.dictionary["(0008,0008)","VR"])
# NAvalue <- args[["NAvalue"]]
# if (is.null(NAvalue)) NAvalue <- 0
study.vect <- c("patient","frame.of.reference")
serie.vect <- c("patient","frame.of.reference","modality", "description", "study.date", "study.time")
if (!is.null(obj$object.info) & use.original.UIs){
if (length(study.UID)==0) study.UID <- .ascii.to.hex (obj$object.info$study.UID, tag.dictionary["(0020,000D)","VR"])
if (length(serie.UID)==0) serie.UID <- .ascii.to.hex (obj$object.info$serie.UID, tag.dictionary["(0020,000E)","VR"])
if (length(sop.type)==0) sop.type <- .ascii.to.hex (obj$object.info$SOP.type, tag.dictionary["(0008,0008)","VR"])
} else {
if (length(study.UID)==0) study.UID <- create.UID(obj,study.vect,size = 50)
if (length(serie.UID)==0) serie.UID <- create.UID(obj,serie.vect,size =50)
if (length(sop.type)==0) sop.type <- .ascii.to.hex ('ORIGINAL\\PRIMARY', tag.dictionary["(0008,0008)","VR"])
}
if (length(.ascii.to.hex(obj$frame.of.reference, "UI"))==0)
obj$frame.of.reference <- rawToChar(create.UID (obj,c("patient", "ref.pseudo"), size =44))
frame.of.reference <- .ascii.to.hex(obj$frame.of.reference, "UI")
frame.of.reference <- c (unlist (.value.to.raw (length (frame.of.reference), 2, TRUE)),
frame.of.reference)
ref.SOP_UID.1150 <- NULL
ref.SOP_UID.1155 <- NULL
z.ref <- NULL
if (!is.null(ref.obj.list)){
ref.serie<- do.call(rbind, lapply(ref.obj.list,function(obj_){
if (!is.null(obj_$object.info) & use.original.ref.UIs) return(.ascii.to.hex (obj_$object.info$serie.UID, "UI"))
create.UID(obj_,serie.vect,size =50)}))
f <- !duplicated.array(ref.serie)
ref.obj.list <- ref.obj.list[f]
ref.serie <- ref.serie[f,, drop = FALSE]
SOP.L <- lapply(ref.obj.list, function(obj_) {
if (length(.ascii.to.hex(obj_$frame.of.reference, "UI"))==0)
obj_$frame.of.reference <- rawToChar(create.UID (obj_,c("patient", "ref.pseudo"), size =44))
if (!is.null(obj_$object.info) & use.original.ref.UIs) {
# l1155 <- obj_$object.info$SOP.label
# ncl.f<- cumsum(nchar(l1155))
# ncl.d <- c(1,ncl.f[-length(ncl.f)] -1)
# l1155 <- charToRaw(paste(l1155,collapse=""))
# l1155 <- lapply(1:length(ncl.f), function(i) {
# new.raw <- c(l1155[ncl.d[i]:ncl.f[i]] ,as.raw(0x00)); new.raw[1:(2 * floor(length(new.raw)/2))]})
l1155 <- lapply(obj_$object.info$SOP.label, function(uid) .ascii.to.hex(uid,"UI"))
l1150 <- .ascii.to.hex(obj_$object.info$SOP.ID,"UI")
l1150 <- lapply(l1155,function(i) l1150)
return(list(l1150=l1150,l1155=l1155))
}
return(create.SOPUID(obj_))
})
z.ref <- lapply(ref.obj.list, function(obj_) {
if(obj_$modality!="ct" & obj_$modality!="mr") return(NULL)
t.mat <- ref.cutplane.add(obj_)
(as.matrix(cbind(obj_$xyz0,1)) %*% t(get.rigid.M(t.mat, obj_$ref.pseudo,paste0(obj_$ref.pseudo, "m"))))[,3]
})
ref.SOP_UID.1150 <- lapply(SOP.L, function(l )l$l1150)
ref.SOP_UID.1155 <- lapply(SOP.L, function(l )l$l1155)
ref.SOP_UID.1150 <- lapply(ref.SOP_UID.1150,function(l) lapply(l, function (uid)
c(unlist(.value.to.raw (length(uid),2,TRUE)),uid)))
ref.SOP_UID.1155 <- lapply(ref.SOP_UID.1155,function(l) lapply(l, function (uid)
c(unlist(.value.to.raw (length(uid),2,TRUE)),uid)))
rm(SOP.L)
}
# use.info <- Sys.info()[1:7]
# use.info[6] <- paste(use.info[6],Sys.getenv("LOGNAME"),sep="")
# use.info[7] <- format(Sys.time(), "%Y%m%d%H%M%s")
# use.info <-c(hash(charToRaw(paste(use.info, collapse = " ")), key = NULL, size = 16),
# unlist(.value.to.raw(as.numeric(Sys.time()),2,F)))
# fn <- paste(use.info,collapse="")
SOP <- create.SOPUID(obj)
######################################
fn <- sapply(SOP$l1155, function(uid) rev(unlist(strsplit(rawToChar(uid[uid!=as.raw(0)]),"[.]")))[1])
if (length(file.name)==0){
filen <- file.path(file.dirname, paste0(file.prefix, fn, ".dcm"))
} else {
file.name <- gsub("[.]dcm$","",file.name)
filen <- file.path(file.dirname, paste0(file.name,".dcm"))
}
dn <- unique(dirname(filen))
for (fdn in dn) if (!dir.exists(fdn)) dir.create(fdn,recursive = T)
#######################################
SOP_UID.1150 <- lapply(SOP$l1150,function(uid) c(unlist(.value.to.raw (length(uid),2,TRUE)),uid))
SOP_UID.1155 <- lapply(SOP$l1155,function(uid) c(unlist(.value.to.raw (length(uid),2,TRUE)),uid))
version_name <- paste(c("R ",version$major,".",version$minor,
" espadon ", .espadon.version()),collapse ="")
version_name <- c(charToRaw(version_name),as.raw(0x00))
version_name <- version_name[1:(2*floor(length(version_name)/2))]
transfert_syntax <- c(charToRaw("1.2.840.10008.1.2.1"),as.raw(0x00))
implementation_UID <- c( charToRaw(paste0(.espadon.version(),".",
paste(charToRaw(obj$modality),collapse=""))),as.raw(0x00))
sop.idx <- 1
# for (sop.idx in 1:length(SOP_UID.1155)) {
####################################
preamble <- as.raw(c(rep(0,128),68,73,67,77))
tag0002 <- c("(0002,0000)","(0002,0001)" ,"(0002,0002)", "(0002,0003)",
"(0002,0010)", "(0002,0012)", "(0002,0013)")
L0002 <- lapply(tag0002,function(t) c())
names(L0002) <- tag0002
L0002[["(0002,0001)"]] <- c(.tag.to.hex ("(0002,0001)"), charToRaw (tag.dictionary["(0002,0001)","VR"]),
as.raw(c(0x00,0x00,0x02,0x00,0x00,0x00,0x00,0x01)))
L0002[["(0002,0002)"]] <- c(.tag.to.hex ("(0002,0002)"), charToRaw (tag.dictionary["(0002,0002)","VR"]),
SOP_UID.1150[[sop.idx]])
L0002[["(0002,0003)"]] <- c(.tag.to.hex ("(0002,0003)"), charToRaw (tag.dictionary["(0002,0003)","VR"]),
SOP_UID.1155[[sop.idx]])
L0002[["(0002,0010)"]] <- c(.tag.to.hex ("(0002,0010)"), charToRaw (tag.dictionary["(0002,0010)","VR"]),
unlist(.value.to.raw (length(transfert_syntax),2,TRUE)),transfert_syntax)
L0002[["(0002,0012)"]] <- c(.tag.to.hex ("(0002,0012)"), charToRaw (tag.dictionary["(0002,0012)","VR"]),
unlist(.value.to.raw (length(implementation_UID),2,TRUE)),implementation_UID)
L0002[["(0002,0013)"]] <- c(.tag.to.hex ("(0002,0013)"), charToRaw (tag.dictionary["(0002,0013)","VR"]),
unlist(.value.to.raw (length(version_name),2,TRUE)), version_name)
L0002[["(0002,0000)"]] <- c(.tag.to.hex ("(0002,0000)"), charToRaw (tag.dictionary["(0002,0000)","VR"]),
as.raw (c (0x04,0x00)),
unlist (.value.to.raw (length (unlist (L0002[2:7])), 4, T)))
####################################
tag0008 <- c("(0008,0005)", "(0008,0012)", "(0008,0016)", "(0008,0018)",
"(0008,0020)", "(0008,0021)", "(0008,0023)", "(0008,0030)",
"(0008,0050)", "(0008,0060)", "(0008,0070)", "(0008,0090)",
"(0008,1030)", "(0008,103E)", "(0008,1070)")
VR0008 <- tag.dictionary[tag0008,"VR"]
L0008 <- lapply(tag0008,function(t) c())
names(L0008) <- tag0008
names(VR0008) <- tag0008
L0008[["(0008,0005)"]] <- c (.tag.to.hex ("(0008,0005)"), charToRaw (VR0008["(0008,0005)"]),
as.raw (c(0x0A,0x00)), charToRaw ("ISO_IR 100"))
if (obj$creation.date!=""){
new.raw <- .ascii.to.hex (obj$creation.date, VR0008["(0008,0012)"])
L0008[["(0008,0012)"]]<- c (.tag.to.hex ("(0008,0012)"), charToRaw (VR0008["(0008,0012)"]),
as.raw (c (0x08,0x00)), new.raw[1:8])
} else {
L0008[["(0008,0012)"]]<- c (.tag.to.hex("(0008,0012)"), charToRaw (VR0008["(0008,0012)"]),
as.raw (c(0x08,0x00)),charToRaw (format (Sys.Date (), "%Y%m%d"))) # devient la date d'assignation de SOP_UID
}
L0008[["(0008,0016)"]] <- c (.tag.to.hex ("(0008,0016)"), charToRaw (VR0008["(0008,0016)"]), SOP_UID.1150[sop.idx])
L0008[["(0008,0018)"]] <- c (.tag.to.hex ("(0008,0018)"), charToRaw (VR0008["(0008,0018)"]), SOP_UID.1155[sop.idx])
new.raw <- .ascii.to.hex (obj$study.date, VR0008["(0008,0020)"])
m <- match(new.raw[1:8], as.raw(48:57))
L0008[["(0008,0020)"]]<- c (.tag.to.hex ("(0008,0020)"), charToRaw (VR0008["(0008,0020)"]),
as.raw (c (0x08,0x00)), new.raw[1:8])
new.raw <- .ascii.to.hex (trimws (obj$creation.date), VR0008["(0008,0021)"])
L0008[["(0008,0021)"]] <- c (.tag.to.hex ("(0008,0021)"), charToRaw (VR0008["(0008,0021)"]),
unlist (.value.to.raw (length (new.raw), 2, TRUE)), new.raw)
L0008[["(0008,0023)"]] <- c (.tag.to.hex ("(0008,0023)"), charToRaw (VR0008["(0008,0023)"]),
unlist (.value.to.raw (length (new.raw), 2, TRUE)), new.raw)
new.raw <- .ascii.to.hex (trimws (obj$study.time), VR0008["(0008,0030)"])
L0008[["(0008,0030)"]] <- c (.tag.to.hex ("(0008,0030)"), charToRaw (VR0008["(0008,0030)"]),
unlist (.value.to.raw (length (new.raw), 2, TRUE)), new.raw)
L0008[["(0008,0050)"]]<- c (.tag.to.hex("(0008,0050)"), charToRaw (VR0008["(0008,0050)"]), as.raw (c (0x00,0x00)))
L0008[["(0008,0060)"]] <- c (.tag.to.hex ("(0008,0060)"), charToRaw (VR0008["(0008,0060)"]),
as.raw (c (0x08,0x00)), charToRaw ("RTSTRUCT"))
new.raw <- .ascii.to.hex ("R ESPADON MANUFACTURER", tag.dictionary["(0008,0070)","VR"])
L0008[["(0008,0070)"]] <- c (.tag.to.hex ("(0008,0070)"), charToRaw (tag.dictionary["(0008,0070)","VR"]),
unlist (.value.to.raw (length (new.raw), 2, TRUE)), new.raw)
L0008[["(0008,0090)"]] <- c (.tag.to.hex ("(0008,0090)"), charToRaw (VR0008["(0008,0090)"]),
as.raw(c(0x00, 0x00)))
description <- unlist(strsplit(obj$description,"[|]")[[1]])
if (length(description) == 0) description <-""
new.raw <-.ascii.to.hex( iconv(description[1], "ISO-IR-100"), VR0008["(0008,1030)"])
L0008[["(0008,1030)"]]<- c (.tag.to.hex ("(0008,1030)"), charToRaw (VR0008["(0008,1030)"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
if(!is.na(description[2])!=0){
new.raw <-.ascii.to.hex( iconv(description[2], "ISO-IR-100"), VR0008["(0008,103E)"])
L0008[["(0008,103E)"]]<- c (.tag.to.hex ("(0008,103E)"), charToRaw (VR0008["(0008,103E)"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
}
#
L0008[["(0008,1070)"]]<- c (.tag.to.hex ("(0008,1070)"), charToRaw (VR0008["(0008,1070)"]),
as.raw(c(0x00, 0x00)))
####################################
tag0010 <- c("(0010,0010)","(0010,0020)","(0010,0030)","(0010,0040)")
L0010 <- lapply(tag0010,function(t) c())
names(L0010) <- tag0010
# if(nchar(obj$patient.name)!=0) obj$patient.name <- ""
new.raw <- .ascii.to.hex( iconv(obj$patient.name, "ISO-IR-100"), tag.dictionary["(0010,0010)","VR"])
L0010[["(0010,0010)"]]<- c (.tag.to.hex("(0010,0010)"), charToRaw(tag.dictionary["(0010,0010)","VR"]),
unlist(.value.to.raw (length(new.raw),2,T)),new.raw)
# if(nchar(obj$patient)!=0) obj$patient <- ""
new.raw <-.ascii.to.hex( iconv(obj$patient, "ISO-IR-100"), tag.dictionary["(0010,0020)","VR"])
L0010[["(0010,0020)"]]<- c (.tag.to.hex("(0010,0020)"), charToRaw(tag.dictionary["(0010,0020)","VR"]),
unlist (.value.to.raw (length (new.raw), 2, T)),new.raw)
new.raw <- .ascii.to.hex (trimws(obj$patient.bd), tag.dictionary["(0010,0030)","VR"])
L0010[["(0010,0030)"]]<- c (.tag.to.hex ("(0010,0030)"), charToRaw (tag.dictionary["(0010,0030)","VR"]),
unlist (.value.to.raw (length (new.raw), 2, T)),new.raw)
new.raw <- .ascii.to.hex (trimws(obj$patient.sex), tag.dictionary["(0010,0040)","VR"])
L0010[["(0010,0040)"]]<- c (.tag.to.hex ("(0010,0040)"), charToRaw (tag.dictionary["(0010,0040)","VR"]),
unlist (.value.to.raw (length (new.raw), 2, T)),new.raw)
####################################
# "(0012,0060) "Clinical Trial Coordinating Center Name Attribute
# L0012[["(0012,0060)"]] <- c(.tag.to.hex("(0012,0060)"), charToRaw(tag.dictionary["(0012,0060)","VR"]),
# as.raw(c(0x00, 0x00)))
#
####################################
tag0018 <- "(0018,1020)"
L0018 <- lapply(tag0018,function(t) c())
names(L0018) <- tag0018
new.raw <- .ascii.to.hex (paste("espadon", .espadon.version()), tag.dictionary["(0018,1020)","VR"])
L0018[["(0018,1020)"]] <- c(.tag.to.hex("(0018,1020)"), charToRaw(tag.dictionary["(0018,1020)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)),new.raw)
####################################
tag0020 <- c( "(0020,000D)", "(0020,000E)","(0020,0010)","(0020,0011)",
"(0020,0052)","(0020,1040)")
L0020 <- lapply(tag0020,function(t) c())
names(L0020) <- tag0020
L0020[["(0020,000D)"]] <- c (.tag.to.hex("(0020,000D)"), charToRaw(tag.dictionary["(0020,000D)","VR"]),
unlist(.value.to.raw (length(study.UID), 2, T)), study.UID)
L0020[["(0020,000E)"]] <- c (.tag.to.hex("(0020,000E)"), charToRaw (tag.dictionary["(0020,000E)","VR"]),
unlist(.value.to.raw (length(serie.UID), 2, TRUE)), serie.UID)
L0020[["(0020,0010)"]] <- c(.tag.to.hex("(0020,0010)"), charToRaw(tag.dictionary["(0020,0010)","VR"]),
as.raw(c(0x00, 0x00)))
L0020[["(0020,0011)"]] <- c(.tag.to.hex("(0020,0011)"), charToRaw(tag.dictionary["(0020,0011)","VR"]),
as.raw(c(0x00, 0x00)))
L0020[["(0020,0052)"]] <- c(.tag.to.hex("(0020,0052)"), charToRaw(tag.dictionary["(0020,0052)","VR"]), frame.of.reference)
L0020[["(0020,1040)"]] <- c(.tag.to.hex("(0020,1040)"), charToRaw(tag.dictionary["(0020,1040)","VR"]),
as.raw(c(0x00, 0x00)))
####################################
tag3006 <- c("(3006,0002)","(3006,0008)")
VR3006 <- tag.dictionary[tag3006,"VR"]
L3006 <- lapply(tag3006,function(t) c())
names(L3006) <- tag3006
names(VR3006) <- tag3006
label <- obj$object.alias
le <- nchar(label)
if (grepl('[_]ref[[:digit:]]+',label) & grepl('[_]do[[:digit:]]+',label)){
label <- strsplit(obj$object.alias,"[_]")[[1]]
label <- paste0(label[grep("^ref",label)],"_", label[grep("^do",label)])
le <- nchar(label)
}
new.raw <- .ascii.to.hex (substr(label,max(1,le-15),le) , VR3006["(3006,0002)"])
L3006[["(3006,0002)"]] <- c(.tag.to.hex("(3006,0002)"), charToRaw(VR3006["(3006,0002)"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
L3006[["(3006,0008)"]] <- c(.tag.to.hex("(3006,0008)"), charToRaw(VR3006["(3006,0008)"]),
as.raw(c(0x00, 0x00)))
L30060010 <- c()
if (!is.null( ref.SOP_UID.1150)){#(3006,0010)
L30060016loop <- lapply(1:length(ref.SOP_UID.1150), function(ref.idx)
return(unlist(lapply(1:length(ref.SOP_UID.1150[[ref.idx]]), function(idx){
tot <- c(.tag.to.hex("(0008,1150)"),charToRaw(tag.dictionary["(0008,1150)","VR"]),
ref.SOP_UID.1150[[ref.idx]][[idx]],
.tag.to.hex("(0008,1155)"),charToRaw(tag.dictionary["(0008,1155)","VR"]),
ref.SOP_UID.1155[[ref.idx]][[idx]])
c (as.raw(c(0xfe, 0xff, 0x00, 0xe0)), unlist(.value.to.raw (length(tot),4,TRUE)), tot)}))
))
L300060014loop <- unlist(lapply(1:length(L30060016loop),function(idx){
tot <- c(.tag.to.hex("(0020,000E)"), charToRaw(tag.dictionary["(0020,000E)","VR"]),
unlist(.value.to.raw (length(ref.serie[idx,]),2,TRUE)),ref.serie[idx,],
.tag.to.hex("(3006,0016)"), charToRaw(tag.dictionary["(3006,0016)","VR"]), as.raw(c(0x00,0x00)),
unlist(.value.to.raw (length(L30060016loop[[idx]]),4,TRUE)), L30060016loop[[idx]])
c(as.raw(c(0xfe, 0xff, 0x00, 0xe0)),
unlist(.value.to.raw (length(tot),4,TRUE)),tot)
}))
tag30060012 <- c("(0008,1150)","(0008,1155)","(3006,0014)")
VR30060012 <- tag.dictionary[tag30060012,"VR"]
L30060012 <- list()
L30060012[[1]] <- c(.tag.to.hex("(0008,1150)"), charToRaw(tag.dictionary["(0008,1150)","VR"]),
SOP_UID.1150[[sop.idx]])
L30060012[[2]] <- c(.tag.to.hex("(0008,1155)"), charToRaw(tag.dictionary["(0008,1155)","VR"]),
SOP_UID.1155[[sop.idx]])
L30060012[[3]] <- c(.tag.to.hex("(3006,0014)"), charToRaw(tag.dictionary["(3006,0014)","VR"]) ,
as.raw(c(0x00,0x00)),
unlist(.value.to.raw (length(L300060014loop),4,TRUE)), L300060014loop)
L30060012 <- unlist(L30060012)
L30060012 <- c(as.raw(c(0xfe, 0xff, 0x00, 0xe0)), unlist(.value.to.raw (length(L30060012),4,TRUE)),L30060012)
tag30060010 <- c("(0020,0052)","(3006,0012)")
L30060010 <- lapply(tag30060010,function(t) c())
names(L30060010) <- tag30060010
L30060010[["(0020,0052)"]] <- c(.tag.to.hex("(0020,0052)"),charToRaw(tag.dictionary["(0020,0052)","VR"]), frame.of.reference)
L30060010[["(3006,0012)"]] <- c(.tag.to.hex("(3006,0012)"),charToRaw(tag.dictionary["(3006,0012)","VR"]), as.raw(c(0x00,0x00)),
unlist(.value.to.raw (length(L30060012),4,TRUE)), L30060012)
L30060010 <- as.raw(unlist(L30060010))
L30060010 <- c(as.raw(c(0xfe, 0xff, 0x00, 0xe0)), unlist(.value.to.raw (length(L30060010),4,TRUE)),L30060010)
L30060010 <- c(.tag.to.hex("(3006,0010)"),charToRaw(tag.dictionary["(3006,0010)","VR"]), as.raw(c(0x00,0x00)),
unlist(.value.to.raw (length(L30060010),4,TRUE)), L30060010)
}
#####
tag30060020loop <- c("(3006,0022)","(3006,0024)","(3006,0026)", "(3006,0028)","(3006,0036)")
VR30060020loop <- tag.dictionary[tag30060020loop,"VR"]
add.desc <- any(obj$roi.info$description!="")
L30060020loop <-unlist(lapply(1:nrow(obj$roi.info), function(i) {
v <- .ascii.to.hex(as.character(as.integer(obj$roi.info$number[i])),VR30060020loop[1])
tot <- c(.tag.to.hex("(3006,0022)"),charToRaw(tag.dictionary["(3006,0022)","VR"]),
unlist(.value.to.raw (length(v),2,TRUE)),v)
tot <- c(tot, .tag.to.hex("(3006,0024)"),charToRaw(tag.dictionary["(3006,0024)","VR"]),
frame.of.reference)
v <- .ascii.to.hex(iconv(obj$roi.info$name[i], "ISO-IR-100"),tag.dictionary["(3006,0026)","VR"])
tot <- c(tot, c (.tag.to.hex("(3006,0026)"),charToRaw(tag.dictionary["(3006,0026)","VR"]),
unlist(.value.to.raw (length(v),2,TRUE)), v))
if (add.desc){
v <- .ascii.to.hex(iconv(obj$roi.info$description[i], "ISO-IR-100"),tag.dictionary["(3006,0028)","VR"])
tot <- c(tot, c (.tag.to.hex("(3006,0028)"),charToRaw(tag.dictionary["(3006,0028)","VR"]),
unlist(.value.to.raw (length(v),2,TRUE)), v))
}
v <- .ascii.to.hex(toupper(obj$roi.info$generation.algorithm[i]),VR30060020loop[5])
tot <- c(tot, c (.tag.to.hex(tag30060020loop[5]),charToRaw(VR30060020loop[5]),
unlist(.value.to.raw (length(v),2,TRUE)), v))
c (as.raw(c(0xfe, 0xff, 0x00, 0xe0)), unlist(.value.to.raw (length(tot),4,TRUE)), tot)
}))
tag30060020 <- c( "(3006,0020)")
VR30060020 <- tag.dictionary[tag30060020,"VR"]
L30060020 <- list()
L30060020[[1]] <- c(.tag.to.hex(tag30060020[1]),charToRaw(VR30060020[1]) , as.raw(c(0x00,0x00)),
unlist(.value.to.raw (length(L30060020loop),4,TRUE)), L30060020loop)
####################################
tag30060040 <- c( "(3006,002A)", "(3006,0040)", "(3006,0084)")
VR30060040 <- tag.dictionary[tag30060040,"VR"]
tag30060040loop <- c("(3006,0016)", "(3006,0042)","(3006,0046)","(3006,0048)", "(3006,0050)")
VR30060040loop <- tag.dictionary[tag30060040loop,"VR"]
L30060039loop <- unlist(lapply(1:nrow(obj$roi.info), function(i) {
tot <- raw(0)
if (!is.null(obj$roi.data[[i]])){
L30060040loop <- unlist(lapply( 1:length(obj$roi.data[[i]]), function(j){
pt <- as.matrix(obj$roi.data[[i]][[j]]$pt)
le.pt <- nrow(pt)
if (all(pt[1,]==pt[le.pt,])) {pt <- pt[-le.pt, ]; le.pt <- le.pt-1}
tot_ <- NULL
if (!is.null(ref.obj.list) & length(z.ref)>0){
refz.L <- lapply (1:length(z.ref),function(ref.idx) {
if (is.null(z.ref[[ref.idx]])) return(NULL)
flag <- round(z.ref[[ref.idx]],6) == round(pt[1,3],6)
if (all(!flag)){
warning(paste(obj$roi.info$name[i],": Check Reference object at z=",
round(pt[1,3],6),"mm."),call. = FALSE)
return(NULL)
}
tot <- c(.tag.to.hex("(0008,1150)"),charToRaw(tag.dictionary["(0008,1150)","VR"]),
ref.SOP_UID.1150[[ref.idx]][flag][[1]],
.tag.to.hex("(0008,1155)"),charToRaw(tag.dictionary["(0008,1155)","VR"]),
ref.SOP_UID.1155[[ref.idx]][flag][[1]])
return(c (as.raw(c(0xfe, 0xff, 0x00, 0xe0)), unlist(.value.to.raw (length(tot),4,TRUE)), tot))
})
refz.L <- refz.L[ !sapply(refz.L,is.null)]
if (length(refz.L))
tot_ <- c(.tag.to.hex(tag30060040loop[1]),charToRaw(VR30060040loop[1]) , as.raw(c(0x00,0x00)),
unlist(.value.to.raw (length(refz.L[[1]]),4,TRUE)), refz.L[[1]])
}
v <- .ascii.to.hex(toupper(obj$roi.data[[i]][[j]]$type), VR30060040loop[2])
tot_ <- c(tot_, .tag.to.hex(tag30060040loop[2]), charToRaw(VR30060040loop[2]),
unlist(.value.to.raw (length(v),2,TRUE)),v)
v <- .ascii.to.hex(as.character(le.pt),VR30060040loop[3])
tot_ <- c(tot_, .tag.to.hex(tag30060040loop[3]), charToRaw(VR30060040loop[3]),
unlist(.value.to.raw (length(v),2,TRUE)),v)
v <- .ascii.to.hex(as.character(j-1),VR30060040loop[4])
tot_ <- c(tot_, .tag.to.hex(tag30060040loop[4]), charToRaw(VR30060040loop[4]),
unlist(.value.to.raw (length(v),2,TRUE)),v)
v <- .ascii.to.hex(paste(as.numeric(t(pt)),collapse="\\"),VR30060040loop[5])
tot_ <- c(tot_, .tag.to.hex(tag30060040loop[5]), charToRaw(VR30060040loop[5]),
unlist(.value.to.raw (length(v),2,TRUE)),v)
c (as.raw(c(0xfe, 0xff, 0x00, 0xe0)),
unlist(.value.to.raw (length(tot_),4,TRUE)), tot_)
}))
tot <- c(.tag.to.hex(tag30060040[2]),charToRaw(VR30060040[2]) , as.raw(c(0x00,0x00)),
unlist(.value.to.raw (length(L30060040loop),4,TRUE)), L30060040loop)
}
v <-.ascii.to.hex(paste(as.numeric(col2rgb(obj$roi.info$color[i])),collapse="\\"),VR30060040[1])
tot <- c(.tag.to.hex(tag30060040[1]), charToRaw(VR30060040[1]),
unlist(.value.to.raw (length(v),2,TRUE)),v, tot)
v <- .ascii.to.hex(as.character(as.integer(obj$roi.info$number[i])),VR30060040[3])
tot <- c(tot, .tag.to.hex(tag30060040[3]), charToRaw(VR30060040[3]),
unlist(.value.to.raw (length(v),2,TRUE)),v)
c (as.raw(c(0xfe, 0xff, 0x00, 0xe0)),
unlist(.value.to.raw (length(tot),4,TRUE)), tot)
}))
tag30060039 <- c("(3006,0039)")
VR30060039 <- tag.dictionary[tag30060039,"VR"]
L30060039 <- list()
L30060039[[1]] <- c(.tag.to.hex(tag30060039[1]),charToRaw(VR30060039[1]) , as.raw(c(0x00,0x00)),
unlist(.value.to.raw (length(L30060039loop),4,T)), L30060039loop)
####################################
tag30060080loop <- c("(3006,0082)", "(3006,0084)", "(3006,0085)",
"(3006,00A4)", "(3006,00A6)")
VR30060080loop <- tag.dictionary[tag30060080loop,"VR"]
obj$roi.obs[is.na(obj$roi.obs)] <- ""
L30060080loop <-unlist(lapply(1:nrow(obj$roi.obs), function(i) {
v <- .ascii.to.hex (as.character(as.integer(obj$roi.obs$nb[i])), VR30060080loop[1])
tot <- c (.tag.to.hex (tag30060080loop[1]), charToRaw (VR30060080loop[1]),
unlist (.value.to.raw (length (v), 2, TRUE)), v)
v <- .ascii.to.hex (as.character(as.integer(obj$roi.obs$roi.nb[i])), VR30060080loop[2])
tot <- c(tot, .tag.to.hex (tag30060080loop[2]), charToRaw (VR30060080loop[2]),
unlist (.value.to.raw (length (v), 2, TRUE)), v)
v <- .ascii.to.hex (iconv(obj$roi.obs$label[i], "ISO-IR-100"), VR30060080loop[3])
tot <- c(tot, .tag.to.hex (tag30060080loop[3]), charToRaw (VR30060080loop[3]),
unlist (.value.to.raw (length (v), 2, TRUE)), v)
v <- .ascii.to.hex(iconv(toupper(obj$roi.obs$type[i]), "ISO-IR-100"),VR30060080loop[4])
tot <- c(tot, c (.tag.to.hex(tag30060080loop[4]),charToRaw(VR30060080loop[4]),
unlist(.value.to.raw (length(v),2,TRUE)), v))
v <- .ascii.to.hex(iconv(obj$roi.obs$interpreter[i], "ISO-IR-100"),VR30060080loop[5])
tot <- c(tot, c (.tag.to.hex(tag30060080loop[5]),charToRaw(VR30060080loop[5]),
unlist(.value.to.raw (length(v),2,TRUE)), v))
c (as.raw(c(0xfe, 0xff, 0x00, 0xe0)), unlist(.value.to.raw (length(tot),4,T)), tot)
}))
tag30060080 <- c("(3006,0080)")
VR30060080 <- tag.dictionary[tag30060080,"VR"]
L30060080 <- list()
L30060080[[1]] <- c(.tag.to.hex(tag30060080[1]),charToRaw(VR30060080[1]) , as.raw(c(0x00,0x00)),
unlist(.value.to.raw (length(L30060080loop),4,TRUE)), L30060080loop)
#############################################################################
tag300E <- c("(300E,0002)","(300E,0004)","(300E,0005)","(300E,0008)")
L300E <- lapply(tag300E,function(t) c())
names(L300E) <- tag300E
# Approval Status Attribute
Approval.Status.Attribute <- "UNAPPROVED"
Approval.Status.Attribute.vect <- c("APPROVED", "UNAPPROVED","REJECTED")
if (!is.null(obj$approval.status)) {
m <- match(toupper(trimws(obj$approval.status)), Approval.Status.Attribute.vect)
if (!is.na(m)) Approval.Status.Attribute <- Approval.Status.Attribute.vect[m]
}
new.raw <- .ascii.to.hex(Approval.Status.Attribute, tag.dictionary["(300E,0002)","VR"])
L300E[["(300E,0002)"]]<- c (.tag.to.hex("(300E,0002)"), charToRaw( tag.dictionary["(300E,0002)","VR"]),
unlist(.value.to.raw (length(new.raw),2,T)),new.raw)
if (Approval.Status.Attribute %in% c("APPROVED","REJECTED")){
L300E[["(300E,0004)"]]<- c (.tag.to.hex("(300E,0004)"), charToRaw( tag.dictionary["(300E,0004)","VR"]), as.raw(c(0,0)))
L300E[["(300E,0005)"]]<- c (.tag.to.hex("(300E,0005)"), charToRaw( tag.dictionary["(300E,0005)","VR"]), as.raw(c(0,0)))
L300E[["(300E,0008)"]]<- c (.tag.to.hex("(300E,0008)"), charToRaw( tag.dictionary["(300E,0008)","VR"]), as.raw(c(0,0)))
}
####################################
rawdata <- c(preamble,unlist(L0002),unlist(L0008),unlist(L0010),unlist(L0018),
unlist(L0020),unlist(L3006), L30060010, unlist(L30060020),
unlist(L30060039), unlist(L30060080))
zz <- file (filen, "wb")
writeBin (rawdata, zz, size = 1)
close (zz)
# }
message ("file created : ", basename(filen))
}
################################################################################
export.rtdose.to.dicom <- function(obj, ref.obj.list = NULL, use.original.UIs = FALSE,
use.original.ref.UIs = TRUE,
file.prefix ="", file.dirname= '.', file.name = NULL,
tag.dictionary = dicom.tag.dictionary(),...){
rownames(tag.dictionary) <- tag.dictionary$tag
args <- tryCatch(list(...), error = function(e)list())
study.UID <- .ascii.to.hex (args[["(0020,000D)"]], tag.dictionary["(0020,000D)","VR"])
serie.UID <- .ascii.to.hex (args[["(0020,000E)"]], tag.dictionary["(0020,000E)","VR"])
sop.type <- .ascii.to.hex (args[["(0008,0008)"]], tag.dictionary["(0008,0008)","VR"])
NAvalue <- args[["NAvalue"]]
study.vect <- c("patient","frame.of.reference")
serie.vect <- c("patient","frame.of.reference","modality", "description", "study.date", "study.time")
if (!is.null(obj$object.info) & use.original.UIs){
if (length(study.UID)==0) study.UID <- .ascii.to.hex (obj$object.info$study.UID, tag.dictionary["(0020,000D)","VR"])
if (length(serie.UID)==0) serie.UID <- .ascii.to.hex (obj$object.info$serie.UID, tag.dictionary["(0020,000E)","VR"])
if (length(sop.type)==0) sop.type <- .ascii.to.hex (obj$object.info$SOP.type, tag.dictionary["(0008,0008)","VR"])
} else {
if (length(study.UID)==0) study.UID <- create.UID(obj,study.vect,size = 50)
if (length(serie.UID)==0) serie.UID <- create.UID(obj,serie.vect,size =50)
if (length(sop.type)==0) sop.type <- .ascii.to.hex ('ORIGINAL\\PRIMARY', tag.dictionary["(0008,0008)","VR"])
}
if (length(.ascii.to.hex(obj$frame.of.reference, "UI"))==0)
obj$frame.of.reference <- rawToChar(create.UID (obj,c("patient", "ref.pseudo"), size =44))
frame.of.reference <- .ascii.to.hex(obj$frame.of.reference, "UI")
frame.of.reference <- c (unlist (.value.to.raw (length (frame.of.reference), 2, TRUE)),
frame.of.reference)
ref.modality<- sapply(ref.obj.list, function(l) l$modality)
ref.obj.list <- ref.obj.list[ref.modality=="rtstruct"]
L300C0060 <- c()# voir la référence pour chaque plan
if (!is.null(ref.obj.list)){
ref.serie<- do.call(rbind, lapply(ref.obj.list,function(obj_){
if (!is.null(obj_$object.info) & use.original.ref.UIs) return(.ascii.to.hex (obj_$object.info$serie.UID, "UI"))
create.UID(obj_,serie.vect,size =50)}))
f <- !duplicated.array(ref.serie)
ref.obj.list <- ref.obj.list[f]
ref.serie <- ref.serie[f,, drop = FALSE]
SOP.L <- lapply(ref.obj.list, function(obj_) {
if (length(.ascii.to.hex(obj_$frame.of.reference, "UI"))==0)
obj_$frame.of.reference <- rawToChar(create.UID (obj_,c("patient", "ref.pseudo"), size =44))
if (!is.null(obj_$object.info) & use.original.ref.UIs) {
# l1155 <- obj_$object.info$SOP.label
# ncl.f<- cumsum(nchar(l1155))
# ncl.d <- c(1,ncl.f[-length(ncl.f)] -1)
# l1155 <- charToRaw(paste(l1155,collapse=""))
# l1155 <- lapply(1:length(ncl.f), function(i) {
# new.raw <- c(l1155[ncl.d[i]:ncl.f[i]] ,as.raw(0x00)); new.raw[1:(2 * floor(length(new.raw)/2))]})
l1155 <- lapply(obj_$object.info$SOP.label, function(uid) .ascii.to.hex(uid,"UI"))
l1150 <- .ascii.to.hex(obj_$object.info$SOP.ID,"UI")
l1150 <- lapply(l1155,function(i) l1150)
return(list(l1150=l1150,l1155=l1155))
}
return(create.SOPUID(obj_))
})
z.ref <- lapply(ref.obj.list, function(obj_) {
if(obj_$modality!="ct" & obj_$modality!="mr") return(NULL)
t.mat <- ref.cutplane.add(obj_)
(as.matrix(cbind(obj_$xyz0,1)) %*% t(get.rigid.M(t.mat, obj_$ref.pseudo,paste0(obj_$ref.pseudo, "m"))))[,3]
})
ref.SOP_UID.1150 <- lapply(SOP.L, function(l )l$l1150)
ref.SOP_UID.1155 <- lapply(SOP.L, function(l )l$l1155)
ref.SOP_UID.1150 <- lapply(ref.SOP_UID.1150,function(l) lapply(l, function (uid)
c(unlist(.value.to.raw (length(uid),2,TRUE)),uid)))
ref.SOP_UID.1155 <- lapply(ref.SOP_UID.1155,function(l) lapply(l, function (uid)
c(unlist(.value.to.raw (length(uid),2,TRUE)),uid)))
rm(SOP.L)
L3006060loop <- unlist(lapply(1:length(ref.SOP_UID.1150), function(ref.idx)
return(unlist(lapply(1:length(ref.SOP_UID.1150[[ref.idx]]), function(idx){
tot <- c(.tag.to.hex("(0008,1150)"),charToRaw(tag.dictionary["(0008,1150)","VR"]),
ref.SOP_UID.1150[[ref.idx]][[idx]],
.tag.to.hex("(0008,1155)"),charToRaw(tag.dictionary["(0008,1155)","VR"]),
ref.SOP_UID.1155[[ref.idx]][[idx]])
c (as.raw(c(0xfe, 0xff, 0x00, 0xe0)), unlist(.value.to.raw (length(tot),4,TRUE)), tot)}))
)))
L300C0060 <- c(.tag.to.hex("(300C,0060)"), charToRaw(tag.dictionary["(300C,0060)","VR"]), as.raw(c(0x00,0x00)),
unlist(.value.to.raw (length(L3006060loop),4,TRUE)), L3006060loop)
}
SOP <- create.SOPUID(obj)
######################################
fn <- sapply(SOP$l1155, function(uid) rev(unlist(strsplit(rawToChar(uid[uid!=as.raw(0)]),"[.]")))[1])
if (length(file.name)==0){
filen <- file.path(file.dirname, paste0(file.prefix, fn, ".dcm"))
} else {
file.name <- gsub("[.]dcm$","",file.name)
filen <- file.path(file.dirname, paste0(file.name,".dcm"))
}
dn <- unique(dirname(filen))
for (fdn in dn) if (!dir.exists(fdn)) dir.create(fdn,recursive = T)
#######################################
SOP_UID.1150 <- lapply(SOP$l1150,function(uid) c(unlist(.value.to.raw (length(uid),2,TRUE)),uid))
SOP_UID.1155 <- lapply(SOP$l1155,function(uid) c(unlist(.value.to.raw (length(uid),2,TRUE)),uid))
version_name <- paste(c("R ",version$major,".",version$minor,
" espadon ", .espadon.version()),collapse ="")
version_name <- c(charToRaw(version_name),as.raw(0x00))
version_name <- version_name[1:(2*floor(length(version_name)/2))]
transfert_syntax <- c(charToRaw("1.2.840.10008.1.2.1"),as.raw(0x00))
implementation_UID <- c( charToRaw(paste0(.espadon.version(),".",
paste(charToRaw(obj$modality),collapse=""))),as.raw(0x00))
####################################
sop.idx <- 1
####################################
preamble <- as.raw(c(rep(0,128),68,73,67,77))
####################################
tag0002 <- c("(0002,0000)","(0002,0001)" ,"(0002,0002)", "(0002,0003)",
"(0002,0010)", "(0002,0012)", "(0002,0013)")
L0002 <- lapply(tag0002,function(t) c())
names(L0002) <- tag0002
L0002[["(0002,0001)"]] <- c(.tag.to.hex ("(0002,0001)"), charToRaw (tag.dictionary["(0002,0001)","VR"]),
as.raw(c(0x00,0x00,0x02,0x00,0x00,0x00,0x00,0x01)))
L0002[["(0002,0002)"]] <- c(.tag.to.hex ("(0002,0002)"), charToRaw (tag.dictionary["(0002,0002)","VR"]),
SOP_UID.1150[[sop.idx]])
L0002[["(0002,0003)"]] <- c(.tag.to.hex ("(0002,0003)"), charToRaw (tag.dictionary["(0002,0003)","VR"]),
SOP_UID.1155[[sop.idx]])
L0002[["(0002,0010)"]] <- c(.tag.to.hex ("(0002,0010)"), charToRaw (tag.dictionary["(0002,0010)","VR"]),
unlist(.value.to.raw (length(transfert_syntax),2,TRUE)),transfert_syntax)
L0002[["(0002,0012)"]] <- c(.tag.to.hex ("(0002,0012)"), charToRaw (tag.dictionary["(0002,0012)","VR"]),
unlist(.value.to.raw (length(implementation_UID),2,TRUE)),implementation_UID)
L0002[["(0002,0013)"]] <- c(.tag.to.hex ("(0002,0013)"), charToRaw (tag.dictionary["(0002,0013)","VR"]),
unlist(.value.to.raw (length(version_name),2,TRUE)), version_name)
L0002[["(0002,0000)"]] <- c(.tag.to.hex ("(0002,0000)"), charToRaw (tag.dictionary["(0002,0000)","VR"]),
as.raw (c (0x04,0x00)),
unlist (.value.to.raw (length (unlist (L0002[2:7])), 4, T)))
# rawdata <- as.vector(c(preamble, unlist(L0002)))
# dicom.browser(rawdata)
####################################
tag0008 <- c("(0008,0005)", "(0008,0012)", "(0008,0016)", "(0008,0018)", "(0008,0020)",
"(0008,0023)", "(0008,0030)", "(0008,0050)", "(0008,0060)", "(0008,0070)", "(0008,0090)",
"(0008,1030)", "(0008,103E)", "(0008,1070)")
VR0008 <- tag.dictionary[tag0008,"VR"]
L0008 <- lapply(tag0008,function(t) c())
names(L0008) <- tag0008
names(VR0008) <- tag0008
L0008[["(0008,0005)"]] <- c (.tag.to.hex ("(0008,0005)"), charToRaw (tag.dictionary["(0008,0005)","VR"]),
as.raw (c(0x0A,0x00)), charToRaw ("ISO_IR 100"))
if (obj$creation.date!=""){
new.raw <- .ascii.to.hex (obj$creation.date, tag.dictionary["(0008,0012)","VR"])
L0008[["(0008,0012)"]]<- c (.tag.to.hex ("(0008,0012)"), charToRaw (tag.dictionary["(0008,0012)","VR"]),
as.raw (c (0x08,0x00)), new.raw[1:8])
} else {
L0008[["(0008,0012)"]]<- c (.tag.to.hex("(0008,0012)"), charToRaw (tag.dictionary["(0008,0012)","VR"]),
as.raw (c(0x08,0x00)),charToRaw (format (Sys.Date (), "%Y%m%d"))) # devient la date d'assignation de SOP_UID
}
L0008[["(0008,0016)"]] <- c (.tag.to.hex ("(0008,0016)"), charToRaw (tag.dictionary["(0008,0016)","VR"]), SOP_UID.1150[[sop.idx]])
L0008[["(0008,0018)"]] <- c (.tag.to.hex ("(0008,0018)"), charToRaw (tag.dictionary["(0008,0018)","VR"]), SOP_UID.1155[[sop.idx]])
new.raw <- .ascii.to.hex (obj$study.date, tag.dictionary["(0008,0020)","VR"])
m <- match(new.raw[1:8], as.raw(48:57))
L0008[["(0008,0020)"]]<- c (.tag.to.hex ("(0008,0020)"), charToRaw (tag.dictionary["(0008,0020)","VR"]),
as.raw (c (0x08,0x00)), new.raw[1:8])
new.raw <- .ascii.to.hex (trimws (obj$acq.date), VR0008["(0008,0023)"])
L0008[["(0008,0023)"]] <- c (.tag.to.hex ("(0008,0023)"), charToRaw (tag.dictionary["(0008,0023)","VR"]),
unlist (.value.to.raw (length (new.raw), 2, TRUE)), new.raw)
new.raw <- .ascii.to.hex (trimws (obj$study.time), tag.dictionary["(0008,0030)","VR"])
L0008[["(0008,0030)"]] <- c (.tag.to.hex ("(0008,0030)"), charToRaw (tag.dictionary["(0008,0030)","VR"]),
unlist (.value.to.raw (length (new.raw), 2, TRUE)), new.raw)
L0008[["(0008,0050)"]]<- c (.tag.to.hex("(0008,0050)"), charToRaw (tag.dictionary["(0008,0050)","VR"]), as.raw (c (0x00,0x00)))
L0008[["(0008,0060)"]] <- c (.tag.to.hex ("(0008,0060)"), charToRaw (tag.dictionary["(0008,0060)","VR"]),
as.raw (c (0x06,0x00)), charToRaw ("RTDOSE"))
new.raw <- .ascii.to.hex ("R ESPADON MANUFACTURER", tag.dictionary["(0008,0070)","VR"])
L0008[["(0008,0070)"]] <- c (.tag.to.hex ("(0008,0070)"), charToRaw (tag.dictionary["(0008,0070)","VR"]),
unlist (.value.to.raw (length (new.raw), 2, TRUE)), new.raw)
L0008[["(0008,0090)"]] <- c (.tag.to.hex ("(0008,0090)"),charToRaw (tag.dictionary["(0008,0090)","VR"]),
as.raw(c(0x00, 0x00)))
description <- unlist(strsplit(obj$description,"[|]")[[1]])
new.raw <-.ascii.to.hex( iconv(description[1], "ISO-IR-100"), tag.dictionary["(0008,1030)","VR"])
L0008[["(0008,1030)"]]<- c (.tag.to.hex ("(0008,1030)"), charToRaw (tag.dictionary["(0008,1030)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
if(!is.na(description[2])!=0){
new.raw <-.ascii.to.hex( iconv(description[2], "ISO-IR-100"), tag.dictionary["(0008,103E)","VR"])
L0008[["(0008,103E)"]]<- c (.tag.to.hex ("(0008,103E)"), charToRaw (tag.dictionary["(0008,103E)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
}
#
L0008[["(0008,1070)"]]<- c (.tag.to.hex ("(0008,1070)"), charToRaw (tag.dictionary["(0008,1070)","VR"]),
as.raw(c(0x00, 0x00)))
####################################
tag0010 <- c("(0010,0010)","(0010,0020)","(0010,0030)","(0010,0040)")
L0010 <- lapply(tag0010,function(t) c())
names(L0010) <- tag0010
# if(nchar(obj$patient.name)!=0) obj$patient.name <- ""
new.raw <- .ascii.to.hex( iconv(obj$patient.name, "ISO-IR-100"), tag.dictionary["(0010,0010)","VR"])
L0010[["(0010,0010)"]]<- c (.tag.to.hex("(0010,0010)"), charToRaw(tag.dictionary["(0010,0010)","VR"]),
unlist(.value.to.raw (length(new.raw),2,T)),new.raw)
# if(nchar(obj$patient)!=0) obj$patient <- ""
new.raw <-.ascii.to.hex( iconv(obj$patient, "ISO-IR-100"), tag.dictionary["(0010,0020)","VR"])
L0010[["(0010,0020)"]]<- c (.tag.to.hex("(0010,0020)"), charToRaw(tag.dictionary["(0010,0020)","VR"]),
unlist (.value.to.raw (length (new.raw), 2, T)),new.raw)
new.raw <- .ascii.to.hex (trimws(obj$patient.bd), tag.dictionary["(0010,0030)","VR"])
L0010[["(0010,0030)"]]<- c (.tag.to.hex ("(0010,0030)"), charToRaw (tag.dictionary["(0010,0030)","VR"]),
unlist (.value.to.raw (length (new.raw), 2, T)),new.raw)
new.raw <- .ascii.to.hex (trimws(obj$patient.sex), tag.dictionary["(0010,0040)","VR"])
L0010[["(0010,0040)"]]<- c (.tag.to.hex ("(0010,0040)"), charToRaw (tag.dictionary["(0010,0040)","VR"]),
unlist (.value.to.raw (length (new.raw), 2, T)),new.raw)
####################################
tag0018 <- c("(0018,0050)", "(0018,1020)")
L0018 <- lapply(tag0018,function(t) c())
names(L0018) <- tag0018
slice.thickness <- obj$slice.thickness
if (slice.thickness==0) slice.thickness<- c()
new.raw <- .ascii.to.hex (as.character(slice.thickness), tag.dictionary["(0018,0050)","VR"])
new.raw <- .ascii.to.hex (as.character(obj$slice.thickness), tag.dictionary["(0018,0050)","VR"])
L0018[["(0018,0050)"]] <- c(.tag.to.hex("(0018,0050)"), charToRaw(tag.dictionary["(0018,0050)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)),new.raw)
new.raw <- .ascii.to.hex (paste("espadon", .espadon.version()), tag.dictionary["(0018,1020)","VR"])
L0018[["(0018,1020)"]] <- c(.tag.to.hex("(0018,1020)"), charToRaw(tag.dictionary["(0018,1020)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)),new.raw)
####################################
tag0020 <- c("(0020,000D)", "(0020,000E)", "(0020,0010)", "(0020,0011)", "(0020,0013)",
"(0020,0032)", "(0020,0037)", "(0020,0052)", "(0020,1040)")
L0020 <- lapply(tag0020,function(t) c())
names(L0020) <- tag0020
L0020[["(0020,000D)"]] <- c (.tag.to.hex("(0020,000D)"), charToRaw(tag.dictionary["(0020,000D)","VR"]),
unlist(.value.to.raw (length(study.UID), 2, T)), study.UID)
L0020[["(0020,000E)"]] <- c (.tag.to.hex("(0020,000E)"), charToRaw (tag.dictionary["(0020,000E)","VR"]),
unlist(.value.to.raw (length(serie.UID), 2, TRUE)), serie.UID)
L0020[["(0020,0010)"]] <- c(.tag.to.hex("(0020,0010)"), charToRaw(tag.dictionary["(0020,0010)","VR"]),
as.raw(c(0x00, 0x00)))
L0020[["(0020,0011)"]] <- c(.tag.to.hex("(0020,0011)"), charToRaw(tag.dictionary["(0020,0011)","VR"]),
as.raw(c(0x00, 0x00)))
L0020[["(0020,0013)"]] <- c(.tag.to.hex("(0020,0013)"), charToRaw(tag.dictionary["(0020,0013)","VR"]),
as.raw(c(0x00, 0x00)))
new.raw <- .ascii.to.hex (paste(obj$xyz0[sop.idx,], collapse="\\"), tag.dictionary["(0020,0032)","VR"])
L0020[["(0020,0032)"]] <- c(.tag.to.hex("(0020,0032)"), charToRaw(tag.dictionary["(0020,0032)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
new.raw <- .ascii.to.hex (paste(obj$orientation, collapse="\\"), tag.dictionary["(0020,0037)","VR"])
L0020[["(0020,0037)"]] <- c(.tag.to.hex("(0020,0037)"), charToRaw(tag.dictionary["(0020,0037)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
L0020[["(0020,0052)"]] <- c(.tag.to.hex("(0020,0052)"),charToRaw(tag.dictionary["(0020,0052)","VR"]), frame.of.reference)
L0020[["(0020,1040)"]] <- c(.tag.to.hex("(0020,1040)"), charToRaw(tag.dictionary["(0020,1040)","VR"]),
as.raw(c(0x00, 0x00)))
####################################
tag0028 <- c("(0028,0002)", "(0028,0004)", "(0028,0008)","(0028,0009)", "(0028,0010)", "(0028,0011)","(0028,0030)",
"(0028,0100)", "(0028,0101)", "(0028,0102)","(0028,0103)", "(0028,0106)",
"(0028,0107)")#, "(0028,0120)")
L0028 <- lapply(tag0028,function(t) c())
names(L0028) <- tag0028
new.raw <-as.raw(c(1,0))
L0028[["(0028,0002)"]] <- c(.tag.to.hex("(0028,0002)"), charToRaw(tag.dictionary["(0028,0002)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
new.raw <- .ascii.to.hex ("MONOCHROME2", tag.dictionary["(0028,0004)","VR"])
L0028[["(0028,0004)"]] <- c(.tag.to.hex("(0028,0004)"), charToRaw(tag.dictionary["(0028,0004)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
new.raw <- .ascii.to.hex (as.character(obj$n.ijk[3]), tag.dictionary["(0028,0008)","VR"])
L0028[["(0028,0008)"]] <- c(.tag.to.hex("(0028,0008)"), charToRaw(tag.dictionary["(0028,0008)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
new.raw <- .tag.to.hex("(3004,000C)")
L0028[["(0028,0009)"]] <- c(.tag.to.hex("(0028,0009)"), charToRaw(tag.dictionary["(0028,0009)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
new.raw <- c(as.raw(obj$n.ijk[2]%%256) ,as.raw((obj$n.ijk[2]/256)%%256))
L0028[["(0028,0010)"]] <- c(.tag.to.hex("(0028,0010)"), charToRaw(tag.dictionary["(0028,0010)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
new.raw <- c(as.raw(obj$n.ijk[1]%%256) ,as.raw((obj$n.ijk[1]/256)%%256))
L0028[["(0028,0011)"]] <- c(.tag.to.hex("(0028,0011)"), charToRaw(tag.dictionary["(0028,0011)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
new.raw <- .ascii.to.hex (paste(obj$dxyz[1:2], collapse="\\"), tag.dictionary["(0028,0030)","VR"])
L0028[["(0028,0030)"]] <- c(.tag.to.hex("(0028,0030)"), charToRaw(tag.dictionary["(0028,0030)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
new.raw <-as.raw(c(16,0))
L0028[["(0028,0100)"]] <- c(.tag.to.hex("(0028,0100)"), charToRaw(tag.dictionary["(0028,0100)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
L0028[["(0028,0101)"]] <- c(.tag.to.hex("(0028,0101)"), charToRaw(tag.dictionary["(0028,0101)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
new.raw <- as.raw(c(15,0))
L0028[["(0028,0102)"]] <- c(.tag.to.hex("(0028,0102)"), charToRaw(tag.dictionary["(0028,0102)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
new.raw <- as.raw(c(0,0))
if (obj$min.pixel<0) new.raw <- as.raw(c(1,0))
L0028[["(0028,0103)"]] <- c(.tag.to.hex("(0028,0103)"), charToRaw(tag.dictionary["(0028,0103)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
#codage de 0.1mGy
vol3D <- as.vector(round(obj$vol3D.data,6))
slope <- NA
if (length(vol3D)!=0){
f <- is.na(vol3D)
if (all(f)){
warning(c("obj$vol3D.data contains only NA values. This data will not be exported."))
vol3D <- NULL
} else {
if (any(f)) {
if (is.null(NAvalue)){
NAvalue <- 0
warning(c("obj$vol3D.data contains NA values. This data will be replaced by the value 0. ",
"If you wish to change this value, add the argument NAvalue=your_NA_value."))
}
vol3D[f] <- NAvalue
}
slope <- sort(diff(sort(unique(vol3D))))[1]
obj.max.pixel <- max(vol3D, na.rm =TRUE)
obj.min.pixel <- min(vol3D, na.rm =TRUE)
max.pixel <- round(obj.max.pixel/slope)
min.pixel <- round(obj.min.pixel/slope)
while((abs(max.pixel) > 2^15) | (abs(min.pixel) > 2^15)){
slope <- slope*2
max.pixel <- round(obj.max.pixel/slope)
min.pixel <- round(obj.min.pixel/slope)
}
new.raw <- c(as.raw(min.pixel%%256) ,as.raw((min.pixel/256)%%256))
L0028[["(0028,0106)"]] <- c(.tag.to.hex("(0028,0106)"), charToRaw("US"),
as.raw(c(0x02,00)), new.raw)
new.raw <- c(as.raw(max.pixel%%256) ,as.raw((max.pixel/256)%%256))
L0028[["(0028,0107)"]] <- c(.tag.to.hex("(0028,0107)"), charToRaw("US"),
as.raw(c(0x02,00)), new.raw)
vol3D <- vol3D/slope
vol3D <- as.vector(rbind(as.raw(vol3D%%256) ,as.raw((vol3D/256)%%256)))
}
} else {
warning(c("There is no obj$vol3D.data in ", obj$object.alias,"."))
}
####################################
tag3004 <- c("(3004,0002)", "(3004,0004)", "(3004,000A)", "(3004,000C)","(3004,000E)")
L3004 <- lapply(tag3004,function(t) c())
names(L3004) <- tag3004
new.raw <- .ascii.to.hex (toupper(obj$unit), tag.dictionary["(3004,0002)","VR"])
L3004[["(3004,0002)"]] <- c(.tag.to.hex("(3004,0002)"), charToRaw(tag.dictionary["(3004,0002)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
if (is.null(obj$rtdose.info)){
if (obj$min.pixel<0) {
type.raw <- .ascii.to.hex ("ERROR", tag.dictionary["(3004,0004)","VR"])
} else {
type.raw <- .ascii.to.hex ("PHYSICAL", tag.dictionary["(3004,0004)","VR"])}
summation.raw <- .ascii.to.hex ("PLAN", tag.dictionary["(3004,000A)","VR"])
} else {
type.raw <- .ascii.to.hex (obj$rtdose.info$type, tag.dictionary["(3004,0004)","VR"])
summation.raw <- .ascii.to.hex (obj$rtdose.info$Dose.Summation.Type, tag.dictionary["(3004,000A)","VR"])
}
L3004[["(3004,0004)"]] <- c(.tag.to.hex("(3004,0004)"), charToRaw(tag.dictionary["(3004,0004)","VR"]),
unlist(.value.to.raw (length(type.raw),2,TRUE)), type.raw)
L3004[["(3004,000A)"]] <- c(.tag.to.hex("(3004,000A)"), charToRaw(tag.dictionary["(3004,000A)","VR"]),
unlist(.value.to.raw (length(summation.raw),2,TRUE)), summation.raw)
new.raw <- .ascii.to.hex (paste(obj$k.idx * obj$dxyz[3], collapse="\\"), tag.dictionary["(3004,000C)","VR"])
L3004[["(3004,000C)"]] <- c(.tag.to.hex("(3004,000C)"), charToRaw(tag.dictionary["(3004,000C)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
if (length(vol3D)!=0){
new.raw <- .ascii.to.hex (paste(slope, collapse="\\"), tag.dictionary["(3004,000E)","VR"])
L3004[["(3004,000E)"]] <- c(.tag.to.hex("(3004,000E)"), charToRaw(tag.dictionary["(3004,000E)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
L7FE00010 <- c(.tag.to.hex("(7FE0,0010)"),charToRaw("OW"), as.raw(c(0,0)),
unlist(.value.to.raw (length(vol3D),4,TRUE)),vol3D)
}
####################################
rawdata <- c(preamble,unlist(L0002),unlist(L0008),unlist(L0010),unlist(L0018),
unlist(L0020),unlist(L0028), unlist(L3004),L300C0060,L7FE00010)
zz <- file (filen, "wb")
writeBin (rawdata, zz, size = 1)
close (zz)
message ("file created : ", basename(filen))
}
################################################################################
.tag.to.hex <- function(tag, Low_Order_First=TRUE){
hexcode =c("0","1","2","3","4","5","6","7","8","9","A","B","C","D","E","F")
rtag <- match(unlist(strsplit(tag,""))[c(2:5,7:10)],hexcode)-1
if (Low_Order_First) return(as.raw(c(16*rtag[3] + rtag[4], 16*rtag[1] + rtag[2],
16*rtag[7] + rtag[8], 16*rtag[5] + rtag[6])))
return(as.raw(c(16*rtag[1] + rtag[2], 16*rtag[3] + rtag[4],
16*rtag[5] + rtag[6], 16*rtag[7] + rtag[8])))
}
#' @importFrom sodium hash
.ascii.to.hex <- function(str,VR){
if (length(str)==0) return(raw(0))
if (is.na(str)) return(raw(0))
if (nchar(str)==0) return(raw(0))
switch(VR,
"AE" = {
new.raw <- c(charToRaw (trimws(str)),as.raw(0x20))
new.raw <- new.raw[1:(2 * floor(length(new.raw)/2))]
m <- !is.na(match(new.raw, as.raw(c(0x0a, 0x0c, 0x0d, 0x1b, 0x5c))))
if (length(new.raw)>16 | any(m)) new.raw <- raw(0)
},
"AS" = {
new.raw <- c(charToRaw (trimws(str)),as.raw(0x20))
new.raw <- new.raw[1:(2 * floor(length(new.raw)/2))]
if (length(new.raw)!=4 | any(is.na(m)) | !(new.raw[4] %in% charToRaw ("DWMY"))) new.raw <- raw(0)
},
"CS" = {
new.raw <- c(charToRaw (trimws(str)),as.raw(0x20))
new.raw <- new.raw[1:(2 * floor(length(new.raw)/2))]
m <- match(new.raw, as.raw(c(65:90,48:57,92,95,32)))
# if (length(new.raw)>16 | any(is.na(m))) new.raw <- raw(0)
if (any(is.na(m))) new.raw <- raw(0)
},
"DA" = {
new.raw <- charToRaw (str)
m <- match(new.raw[1:8], as.raw(48:57))
if (length(new.raw)!=8 | any(is.na(m))) new.raw <- raw(0)
},
"DS" = {
new.raw <- charToRaw (str)
m <- match(new.raw,as.raw(0x20))
new.raw <- c(new.raw[is.na(m)],as.raw(0x20))
new.raw <- new.raw[1:(2 * floor(length(new.raw)/2))]
m <- match(new.raw, charToRaw("0123456789+-Ee. \\"))
if (any(is.na(m))) new.raw <- raw(0)
},
"DT" = {
new.raw <- c(charToRaw (trimws(str)),as.raw(0x20))
new.raw <- new.raw[1:(2 * floor(length(new.raw)/2))]
m <- match(new.raw, charToRaw("0123456789+-. "))
if (length(new.raw)>26 | any(is.na(m))) new.raw <- raw(0)
},
"IS" = {
mem <-unlist(strsplit(str,"[\\]"))
mem <- suppressWarnings(as.numeric(mem))
if (any(is.na(mem))){
new.raw <- raw(0)
} else if (any(mem < -2^31) | any(mem > +2^31 - 1 )){
new.raw <- raw(0)
} else {
new.raw <- charToRaw (str)
m <- match(new.raw,as.raw(0x20))
new.raw <- c(new.raw[is.na(m)],as.raw(0x20))
new.raw <- new.raw[1:(2 * floor(length(new.raw)/2))]
m <- match(new.raw, charToRaw("\\0123456789+- "))
if (length(new.raw)>12 | any(is.na(m))) new.raw <- raw(0)
}
},
"LO" = {
new.raw <- c(charToRaw (trimws(str, which="right")),as.raw(0x20))
new.raw <- new.raw[1:(2 * floor(length(new.raw)/2))]
m <- !is.na(match(new.raw,as.raw(c(0:26,28:31,92))))
if (length(new.raw)>64 | any(m)) new.raw <- raw(0)
},
"LT" = {
new.raw <- c(charToRaw (trimws(str, which="right")),as.raw(0x20))
new.raw <- new.raw[1:(2 * floor(length(new.raw)/2))]
m <- !is.na(match(new.raw,as.raw(c(0:9,11,14:26,28:31))))
if (length(new.raw)>64 | any(m)) new.raw <- raw(0)
},
"PN" = {
new.raw <- c(charToRaw (trimws(str)),as.raw(0x20))
new.raw <- new.raw[1:(2 * floor(length(new.raw)/2))]
str_ <- rawToChar(new.raw)
le <- 0
if (nchar(str_)>0) le <- max(nchar(unlist(strsplit(str_,"^", fixed=TRUE))))
m <- !is.na(match(new.raw, as.raw(c(10, 12, 13, 92))))
if (le>64 | any(m)) new.raw <- raw(0)
},
"SH" = {
new.raw <- c(charToRaw (trimws(str)),as.raw(0x20))
new.raw <- new.raw[1:(2 * floor(length(new.raw)/2))]
m <- !is.na(match(new.raw, as.raw(c(0:26,28:31,92))))
if (length(new.raw)>16 | any(m)) new.raw <- raw(0)
},
"ST" = {
new.raw <- c(charToRaw (trimws(str, which="right")),as.raw(0x20))
new.raw <- new.raw[1:(2 * floor(length(new.raw)/2))]
m <- !is.na(match(new.raw,as.raw(c(0:9,11,14:26,28:31))))
if (length(new.raw)>1024 | any(m)) new.raw <- raw(0)
},
"TM" = {
new.raw <- c(charToRaw (trimws(str)),as.raw(0x20))
new.raw <- new.raw[1:(2 * floor(length(new.raw)/2))]
m <- match(new.raw, charToRaw("0123456789. "))
if (length(new.raw)>16 | any(is.na(m))) new.raw <- raw(0)
},
"UI" = {
new.raw <- c(charToRaw (trimws(str)),as.raw(0x00))
new.raw <- new.raw[1:(2 * floor(length(new.raw)/2))]
m <- match(new.raw, as.raw(c(0,46,48:57)))
if (length(new.raw)>64 | any(is.na(m))) new.raw <- raw(0)
},
"UN" = {
new.raw <- c(charToRaw (trimws(str, which="right")),as.raw(0x20))
new.raw <- new.raw[1:(2 * floor(length(new.raw)/2))]
},
"UT"= {
new.raw <- c(charToRaw (trimws(str, which="right")),as.raw(0x20))
new.raw <- new.raw[1:(2 * floor(length(new.raw)/2))]
m <- !is.na(match(new.raw,as.raw(c(0:9,11,14:26,28:31))))
if (length(new.raw)>2^32-2 | any(m))new.raw <- raw(0)
})
if (length(new.raw)==0) warning(str," is not compliant with ", VR," DICOM representation" )
return(new.raw)
}
get.obj.from.alias <- function (obj.alias, patient){
if (is.null(obj.alias)) return(list())
obj.alias <- obj.alias[obj.alias!=""]
if (length(obj.alias)==0) return(list())
start.idx <- which(names(patient)=="T.MAT") + 1
end.idx <- length(patient)
n <-names(patient)
tab <- do.call(rbind,lapply(start.idx:end.idx, function(idx)
data.frame(alias = names(patient[[idx]]), modality = n[idx])))
L <-lapply(obj.alias, function(n){
f <- tab$alias==n
if (any(f)) return(patient[[tab$modality[f]]][[n]])
return(NULL)
})
names(L) <- obj.alias
L
}
create.SOPUID <- function(obj,size=64){
obj$ref.object.alias <- NULL
obj$object.info <- NULL
obj$ref.object.info <- NULL
if (!(is(obj,"volume") | is(obj,"struct"))) return(NULL)
if (!(obj$modality %in% c("ct","mr","rtdose","rtstruct"))) return(NULL)
obj$ref.object.info <- NULL
obj$object.info <- NULL
le.esp <- nchar(.espadon.UID()) + 1
espadon.UID <- charToRaw(paste0(.espadon.UID(),"."))
nb_cut <- 1
nc_nbcut <- 0
raw.mat <- NULL
if (obj$modality %in% c("ct","mr")) {
nb_cut <- max(obj$k.idx)
nc_nbcut <- nchar(as.character(nb_cut))
prefix <- rawToChar(rep(as.raw(0x30),nc_nbcut-1))
nb.str <- paste0(prefix,obj$k.idx)
le.vect <- cumsum(nchar(nb.str))
raw.mat <- charToRaw(paste(nb.str,collapse=""))
raw.mat <- do.call(cbind,lapply(nc_nbcut:1, function(i) raw.mat[le.vect-i+1]))
nb_cut <- nrow(raw.mat)
}
UID.base <- matrix(create.UID(obj, size = size-nc_nbcut),nrow=1, byrow = TRUE)
l1155 <- cbind( UID.base [rep(1,nb_cut),,drop=FALSE], raw.mat, as.raw(0))
l1155 <- l1155[,1:(floor(ncol(l1155)/2)*2), drop=FALSE]
l1155 <- lapply(1:nrow(l1155),function(i) l1155[i,])
l1150 <- switch (obj$modality,
"ct"= "1.2.840.10008.5.1.4.1.1.2",
"mr"= "1.2.840.10008.5.1.4.1.1.4",
"rtdose" = "1.2.840.10008.5.1.4.1.1.481.2",
"rtstruct" = "1.2.840.10008.5.1.4.1.1.481.3")
# l1150 <- matrix(rep(.ascii.to.hex(l1150,"UI") ,nb_cut), nrow= nb_cut, byrow = TRUE)
l1150 <- .ascii.to.hex(l1150,"UI")
l1150 <- lapply(l1155, function(l)l1150)
return(list(l1150=l1150,l1155=l1155))
}
create.UID <- function(obj, el.name=NULL,supp.info.l=NULL, size=64){ #>44
obj$ref.object.alias <- NULL
obj$object.info <- NULL
obj$ref.object.info <- NULL
if (is.null(el.name)){
UID <- qserialize(list(obj,supp.info.l))
}else {
UID <- qserialize(list(obj[el.name],supp.info.l))
}
le.esp <- nchar(.espadon.UID()) + 1
espadon.UID <- charToRaw(paste0(.espadon.UID(),"."))
UID <- paste(.espadon.UID(),
paste(as.numeric(hash(UID, key = NULL, size = max(size,16+le.esp)-le.esp)) %% 10,
collapse=""), sep=".")
new.raw <- c(charToRaw (UID),as.raw(0x00))
new.raw <- new.raw[1:(2 * floor(length(new.raw)/2))]
return(new.raw)
}
get.obj.from.alias <- function (obj.alias, patient){
if (is.null(obj.alias)) return(list())
obj.alias <- obj.alias[obj.alias!=""]
if (length(obj.alias)==0) return(list())
start.idx <- which(names(patient)=="T.MAT") + 1
end.idx <- length(patient)
n <-names(patient)
tab <- do.call(rbind,lapply(start.idx:end.idx, function(idx)
data.frame(alias = names(patient[[idx]]), modality = n[idx])))
L <-lapply(obj.alias, function(n){
f <- tab$alias==n
if (any(f)) return(patient[[tab$modality[f]]][[n]])
return(NULL)
})
names(L) <- obj.alias
L
}
Try the espadon package in your browser
Any scripts or data that you put into this service are public.
espadon documentation built on April 11, 2025, 5:57 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions create.UID create.SOPUID .ascii.to.hex .tag.to.hex export.rtdose.to.dicom export.rtstruct.to.dicom export.img3Dplan.to.dicom export
Documented in export
#' Export espadon objects in DICOM format
#' @description The \code{export} function exports struct class objects and
#' volume class objects with CT or RTDOSE modality in DICOM format.
#' @param obj espadon object of rtstruct, ct or rtdose modality to be exported.
#' @param format Format of the export. For next use.
#' @param ref.obj.list List of espadon objects which are referenced objects of \code{obj}. See Details.
#' @param use.original.UIs,use.original.ref.UIs Booleans. If \code{TRUE}, study instance UID, serie instance
#' UID and image type attribute are those indicated in \code{$object.info} item.
#' Otherwise,They are regenerated. See Details.
#' @param file.prefix String. Prefix added to the generated filename, in case of \code{file.name} is \code{NULL}.
#' @param file.dirname String. Name of the directory in which files are generated.
#' @param file.name String. Base name of the generated files. in CT modality, a slice number is added as a suffix.
#' @param tag.dictionary Dataframe, by default equal to
#' \link[espadon]{dicom.tag.dictionary}, whose structure it must keep. This
#' dataframe is used to parse DICOM files.
#' @param ... Additional settings such as NAvalue (for "volume" data), '(0020,000D)',
#' '(0020,000E)', '(0008,0008)'
#' @return Returns nothing, but generate DICOM files if conditions are required,
#' and indicates the name or number of files created
#' @details The object you want to export may be known in a TPS thanks to these
#' Unique Identifiers (UIs). If you want to create a DICOM object that is different
#' and recognised by your TPS, it is important that the DICOM files you want to
#' create have new UIs: in this case, set the \code{use.original.UIs} argument
#' to \code{FALSE}. Otherwise, UIs in \code{$object.info} item of your object
#' will be used.
#' @details Your object may have been created from another DICOM object (i.e. a
#' reference object). You can, for example, see these links with the function
#' \link[espadon]{display.obj.links}.
#' @details If you want to keep this links, you must indicate which objects are
#' references in the \code{ref.obj.list} argument, in the form of a list of espadon
#' objects. If these reference objects have their own identifier and you wish to
#' keep them, you must set the \code{use.original.ref.UIs} argument to \code{TRUE}.
#' @details Otherwise (\code{use.original.ref.UIs=FALSE}), the UIs of the reference
#' objects will be regenerated. It is therefore important that the reference objects
#' contain all their data such as \code{vol3D.data} or \code{roi.data}.
#' @details It may be useful to impose a study number (tag '(0020,000D)'), serial
#' number (tag '(0020,000E)'), or your Image Type Attribute (tag '(0008,0008)').
#' In this case, you need to add the arguments \code{'(0020,000D)' = your_study_UID},
#' \code{'(0020,000E)' = your_serial_UID}, \code{'(0008,0008)' = your_image_type_attribute}.
#' @examples
#' # First, save toy patient objects to a temporary file pat.dir for testing.
#' pat.dir <- file.path (tempdir(), "PM_Rdcm")
#' dir.create (pat.dir, recursive = TRUE)
#' patient <- toy.load.patient (modality = c("ct", "rtstruct"), roi.name = "",
#' dxyz = c (6, 6, 6))
#' dicom.dir <- file.path (tempdir(), "PM_dcm")
#' export(patient$rtstruct[[1]], ref.obj.list = list (patient$ct[[1]]),
#' file.dirname = dicom.dir,file.name="RS")
#' export(patient$ct[[1]], file.dirname = dicom.dir,file.name="CT")
#' list.files(dicom.dir)
#'
#' # check that the links have been preserved.
#' pat <- load.patient.from.dicom (dicom.dir, verbose = FALSE)
#' display.obj.links (pat)
#'
#' # Cleaning temporary directories
#' unlink (dicom.dir, recursive = TRUE)
#'
#' @export
export <- function(obj,format="dcm", ref.obj.list = NULL, use.original.UIs = FALSE,
use.original.ref.UIs = TRUE,
file.prefix ="", file.dirname= '.', file.name = NULL,
tag.dictionary = dicom.tag.dictionary(), ...){
if (format[1] == "dcm"){
if (!(is(obj,"volume") | is(obj,"struct")))
stop("At present, only espadon objects with the ct, rtdose or rtstruct modality can be exported.")
if (!(obj$modality %in% c("ct","mr","rtdose","rtstruct")))
stop("At present, only espadon objects with the ct, mr, rtdose or rtstruct modality can be exported.")
if (tolower(obj$modality)=="ct" | tolower(obj$modality)=="mr") {
export.img3Dplan.to.dicom (obj, ref.obj.list = ref.obj.list, use.original.UIs = use.original.UIs,
use.original.ref.UIs=use.original.ref.UIs,
file.prefix =file.prefix, file.dirname= file.dirname, file.name = file.name,
tag.dictionary = tag.dictionary,...)
} else if (tolower(obj$modality)=="rtdose") {
export.rtdose.to.dicom (obj, ref.obj.list = ref.obj.list, use.original.UIs = use.original.UIs,
use.original.ref.UIs=use.original.ref.UIs,
file.prefix =file.prefix, file.dirname= file.dirname, file.name = file.name,
tag.dictionary = tag.dictionary,...)
} else if (tolower(obj$modality)=="rtstruct"){
export.rtstruct.to.dicom (obj, ref.obj.list = ref.obj.list, use.original.UIs = use.original.UIs,
use.original.ref.UIs=use.original.ref.UIs,
file.prefix =file.prefix, file.dirname= file.dirname, file.name = file.name,
tag.dictionary = tag.dictionary,...)
}
}
}
################################################################################
export.img3Dplan.to.dicom <- function(obj, ref.obj.list = NULL, use.original.UIs = FALSE,
use.original.ref.UIs = TRUE,
file.prefix ="", file.dirname= '.', file.name = NULL,
tag.dictionary = dicom.tag.dictionary(),...){
rownames(tag.dictionary) <- tag.dictionary$tag
args <- tryCatch(list(...), error = function(e)list())
study.UID <- .ascii.to.hex (args[["(0020,000D)"]], tag.dictionary["(0020,000D)","VR"])
serie.UID <- .ascii.to.hex (args[["(0020,000E)"]], tag.dictionary["(0020,000E)","VR"])
sop.type <- .ascii.to.hex (args[["(0008,0008)"]], tag.dictionary["(0008,0008)","VR"])
patient.position <- .ascii.to.hex (args[["(0018,5100)"]], tag.dictionary["(0018,5100)","VR"])
NAvalue <- args[["NAvalue"]]
study.vect <- c("patient","frame.of.reference")
serie.vect <- c("patient","frame.of.reference","modality", "description", "study.date", "study.time")
if (!is.null(obj$object.info) & use.original.UIs){
if (length(study.UID)==0) study.UID <- .ascii.to.hex (obj$object.info$study.UID, tag.dictionary["(0020,000D)","VR"])
if (length(serie.UID)==0) serie.UID <- .ascii.to.hex (obj$object.info$serie.UID, tag.dictionary["(0020,000E)","VR"])
if (length(sop.type)==0) sop.type <- .ascii.to.hex (obj$object.info$SOP.type, tag.dictionary["(0008,0008)","VR"])
} else {
if (length(study.UID)==0) study.UID <- create.UID(obj,study.vect,size = 50)
if (length(serie.UID)==0) serie.UID <- create.UID(obj,serie.vect,size =50)
if (length(sop.type)==0) sop.type <- .ascii.to.hex ('ORIGINAL\\PRIMARY', tag.dictionary["(0008,0008)","VR"])
}
if (length(patient.position)==0) patient.position <- .ascii.to.hex ("HFS", tag.dictionary["(0018,5100)","VR"])
if (length(.ascii.to.hex(obj$frame.of.reference, "UI"))==0)
obj$frame.of.reference <- rawToChar(create.UID (obj,c("patient", "ref.pseudo"), size =44))
frame.of.reference <- .ascii.to.hex(obj$frame.of.reference, "UI")
frame.of.reference <- c (unlist (.value.to.raw (length (frame.of.reference), 2, TRUE)),
frame.of.reference)
intercept <- NA
slope <- NA
vol3D <- round(obj$vol3D.data,6)
if (length(vol3D)!=0){
f <- is.na(vol3D)
if (all(f)){
warning(c("obj$vol3D.data contains only NA values. This data will not be exported."))
vol3D <- NULL
} else {
obj.max.pixel <- max(vol3D, na.rm =TRUE)
obj.min.pixel <- min(vol3D, na.rm =TRUE)
intercept <- obj.min.pixel
slope <- sort(diff(sort(unique(as.vector(vol3D-intercept)))))[1]
max.pixel <- round((obj.max.pixel-intercept)/slope)
min.pixel <- round((obj.min.pixel-intercept)/slope)
while((abs(max.pixel) > 2^15) | (abs(min.pixel) > 2^15)){
slope <- slope*2
max.pixel <- round((obj.max.pixel-intercept)/slope)
min.pixel <- round((obj.min.pixel-intercept)/slope)
}
if (any(f)) {
if (is.null(NAvalue)){
# NAvalue <- - 2^ceiling(log(slope* max.pixel)/log(2))
if (obj$modality == "ct") {NAvalue <- - 2^15} else {NAvalue <- 0}
warning(c("obj$vol3D.data contains NA values. This data will be replaced by the value ",NAvalue,
". If you wish to change this value, add the argument NAvalue=your_NA_value."))
}
vol3D[f] <- NAvalue
min.pixel <- NAvalue
}
vol3D <- round((vol3D-intercept)/slope)
}
} else {
warning(c("There is no obj$vol3D.data in ", obj$object.alias,"."))
}
L00081140 <- c()
SOP <- create.SOPUID(obj)
######################################
fn <- sapply(SOP$l1155, function(uid) rev(unlist(strsplit(rawToChar(uid[uid!=as.raw(0)]),"[.]")))[1])
if (length(file.name)==0){
filen <- file.path(file.dirname, paste0(file.prefix, fn, ".dcm"))
} else {
le <- nchar(fn[1])
suffix <- substr(fn,le + 1 -nchar(as.character(max(obj$k.idx))),le)
if (length(suffix)==1) suffix <- ""
file.name <- gsub("[.]dcm$","",file.name)
filen <- file.path(file.dirname, paste0(file.name,"_", suffix,".dcm"))
}
dn <- unique(dirname(filen))
for (fdn in dn) if (!dir.exists(fdn)) dir.create(fdn,recursive = T)
#######################################
SOP_UID.1150 <- lapply(SOP$l1150,function(uid) c(unlist(.value.to.raw (length(uid),2,TRUE)),uid))
SOP_UID.1155 <- lapply(SOP$l1155,function(uid) c(unlist(.value.to.raw (length(uid),2,TRUE)),uid))
version_name <- paste(c("R ",version$major,".",version$minor,
" espadon ", .espadon.version()),collapse ="")
version_name <- c(charToRaw(version_name),as.raw(0x00))
version_name <- version_name[1:(2*floor(length(version_name)/2))]
transfert_syntax <- c(charToRaw("1.2.840.10008.1.2.1"),as.raw(0x00))
implementation_UID <- c( charToRaw(paste0(.espadon.version(),".",
paste(charToRaw(obj$modality),collapse=""))),as.raw(0x00))
####################################
preamble <- as.raw(c(rep(0,128),68,73,67,77))
####################################
tag0002 <- c("(0002,0000)","(0002,0001)" ,"(0002,0002)", "(0002,0003)",
"(0002,0010)", "(0002,0012)", "(0002,0013)")
L0002 <- lapply(tag0002,function(t) c())
names(L0002) <- tag0002
L0002[["(0002,0001)"]] <- c(.tag.to.hex ("(0002,0001)"), charToRaw (tag.dictionary["(0002,0001)","VR"]),
as.raw(c(0x00,0x00,0x02,0x00,0x00,0x00,0x00,0x01)))
L0002[["(0002,0010)"]] <- c(.tag.to.hex ("(0002,0010)"), charToRaw (tag.dictionary["(0002,0010)","VR"]),
unlist(.value.to.raw (length(transfert_syntax),2,TRUE)),transfert_syntax)
L0002[["(0002,0012)"]] <- c(.tag.to.hex ("(0002,0012)"), charToRaw (tag.dictionary["(0002,0012)","VR"]),
unlist(.value.to.raw (length(implementation_UID),2,TRUE)),implementation_UID)
L0002[["(0002,0013)"]] <- c(.tag.to.hex ("(0002,0013)"), charToRaw (tag.dictionary["(0002,0013)","VR"]),
unlist(.value.to.raw (length(version_name),2,TRUE)), version_name)
####################################
tag0008 <- c("(0008,0005)", "(0008,0008)", #(optional)
"(0008,0012)", "(0008,0016)", "(0008,0018)", "(0008,0020)", "(0008,0022)",
"(0008,0023)", "(0008,0030)", "(0008,0033)", "(0008,0050)",
"(0008,0060)", "(0008,0070)", "(0008,0090)",
"(0008,1030)", "(0008,103E)", "(0008,1070)")
VR0008 <- tag.dictionary[tag0008,"VR"]
L0008 <- lapply(tag0008,function(t) c())
names(L0008) <- tag0008
names(VR0008) <- tag0008
L0008[["(0008,0005)"]] <- c (.tag.to.hex ("(0008,0005)"), charToRaw (tag.dictionary["(0008,0005)","VR"]),
as.raw (c(0x0A,0x00)), charToRaw ("ISO_IR 100"))
L0008[["(0008,0008)"]] <- c (.tag.to.hex ("(0008,0008)"), charToRaw (tag.dictionary["(0008,0008)","VR"]),
unlist (.value.to.raw (length (sop.type), 2, TRUE)), sop.type)
if (obj$creation.date!=""){
new.raw <- .ascii.to.hex (obj$creation.date, tag.dictionary["(0008,0012)","VR"])
m <- match(new.raw[1:8], as.raw(48:57))
L0008[["(0008,0012)"]]<- c (.tag.to.hex ("(0008,0012)"), charToRaw (tag.dictionary["(0008,0012)","VR"]),
as.raw (c (0x08,0x00)), new.raw[1:8])
} else {
L0008[["(0008,0012)"]]<- c (.tag.to.hex("(0008,0012)"), charToRaw (tag.dictionary["(0008,0012)","VR"]),
as.raw (c(0x08,0x00)),charToRaw (format (Sys.Date (), "%Y%m%d"))) # devient la date d'assignation de SOP_UID
}
new.raw <- .ascii.to.hex (obj$study.date, tag.dictionary["(0008,0020)","VR"])
L0008[["(0008,0020)"]]<- c (.tag.to.hex ("(0008,0020)"), charToRaw (tag.dictionary["(0008,0020)","VR"]),
as.raw (c (0x08,0x00)), new.raw[1:8])
new.raw <- .ascii.to.hex (trimws (obj$acq.date), VR0008["(0008,0022)"])
L0008[["(0008,0022)"]] <- c (.tag.to.hex ("(0008,0022)"), charToRaw (tag.dictionary["(0008,0022)","VR"]),
unlist (.value.to.raw (length (new.raw), 2, TRUE)), new.raw)
L0008[["(0008,0023)"]] <- c (.tag.to.hex ("(0008,0023)"), charToRaw (tag.dictionary["(0008,0023)","VR"]),
unlist (.value.to.raw (length (new.raw), 2, TRUE)), new.raw)
new.raw <- .ascii.to.hex (trimws (obj$study.time), tag.dictionary["(0008,0030)","VR"])
L0008[["(0008,0030)"]] <- c (.tag.to.hex ("(0008,0030)"), charToRaw (tag.dictionary["(0008,0030)","VR"]),
unlist (.value.to.raw (length (new.raw), 2, TRUE)), new.raw)
L0008[["(0008,0033)"]] <- c (.tag.to.hex ("(0008,0033)"), charToRaw (tag.dictionary["(0008,0033)","VR"]), as.raw (c (0x00,0x00)))
L0008[["(0008,0050)"]] <- c (.tag.to.hex ("(0008,0050)"), charToRaw (tag.dictionary["(0008,0050)","VR"]), as.raw (c (0x00,0x00)))
if (obj$modality == "ct") {
L0008[["(0008,0060)"]] <- c (.tag.to.hex ("(0008,0060)"), charToRaw (tag.dictionary["(0008,0060)","VR"]),
as.raw (c (0x02,0x00)), charToRaw ("CT"))
} else {
L0008[["(0008,0060)"]] <- c (.tag.to.hex ("(0008,0060)"), charToRaw (tag.dictionary["(0008,0060)","VR"]),
as.raw (c (0x02,0x00)), charToRaw ("MR"))
}
new.raw <- .ascii.to.hex ("R ESPADON MANUFACTURER", tag.dictionary["(0008,0070)","VR"])
L0008[["(0008,0070)"]] <- c (.tag.to.hex ("(0008,0070)"), charToRaw (tag.dictionary["(0008,0070)","VR"]),
unlist (.value.to.raw (length (new.raw), 2, TRUE)), new.raw)
L0008[["(0008,0090)"]] <- c (.tag.to.hex ("(0008,0090)"), charToRaw (tag.dictionary["(0008,0090)","VR"]), as.raw (c (0x00,0x00)))
description <- unlist(strsplit(obj$description,"[|]")[[1]])
new.raw <-.ascii.to.hex( iconv(description[1], "ISO-IR-100"), tag.dictionary["(0008,1030)","VR"])
L0008[["(0008,1030)"]]<- c (.tag.to.hex ("(0008,1030)"), charToRaw (tag.dictionary["(0008,1030)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
if(!is.na(description[2])!=0){
new.raw <-.ascii.to.hex( iconv(description[2], "ISO-IR-100"), tag.dictionary["(0008,103E)","VR"])
L0008[["(0008,103E)"]]<- c (.tag.to.hex ("(0008,103E)"), charToRaw (tag.dictionary["(0008,103E)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
}
#
L0008[["(0008,1070)"]]<- c (.tag.to.hex ("(0008,1070)"), charToRaw (tag.dictionary["(0008,1070)","VR"]), as.raw (c (0x00,0x00)))
####################################
tag0010 <- c("(0010,0010)","(0010,0020)","(0010,0030)","(0010,0040)")
L0010 <- lapply(tag0010,function(t) c())
names(L0010) <- tag0010
# if(nchar(obj$patient.name)!=0) obj$patient.name <- ""
new.raw <- .ascii.to.hex( iconv(obj$patient.name, "ISO-IR-100"), tag.dictionary["(0010,0010)","VR"])
L0010[["(0010,0010)"]]<- c (.tag.to.hex("(0010,0010)"), charToRaw(tag.dictionary["(0010,0010)","VR"]),
unlist(.value.to.raw (length(new.raw),2,T)),new.raw)
# if(nchar(obj$patient)!=0) obj$patient <- ""
new.raw <-.ascii.to.hex( iconv(obj$patient, "ISO-IR-100"), tag.dictionary["(0010,0020)","VR"])
L0010[["(0010,0020)"]]<- c (.tag.to.hex("(0010,0020)"), charToRaw(tag.dictionary["(0010,0020)","VR"]),
unlist (.value.to.raw (length (new.raw), 2, T)),new.raw)
new.raw <- .ascii.to.hex (trimws(obj$patient.bd), tag.dictionary["(0010,0030)","VR"])
L0010[["(0010,0030)"]]<- c (.tag.to.hex ("(0010,0030)"), charToRaw (tag.dictionary["(0010,0030)","VR"]),
unlist (.value.to.raw (length (new.raw), 2, T)),new.raw)
new.raw <- .ascii.to.hex (trimws(obj$patient.sex), tag.dictionary["(0010,0040)","VR"])
L0010[["(0010,0040)"]]<- c (.tag.to.hex ("(0010,0040)"), charToRaw (tag.dictionary["(0010,0040)","VR"]),
unlist (.value.to.raw (length (new.raw), 2, T)),new.raw)
####################################
tag0018 <- c("(0018,0050)", "(0018,0060)", "(0018,1020)","(0018,5100)")
L0018 <- lapply(tag0018,function(t) c())
names(L0018) <- tag0018
slice.thickness <- obj$slice.thickness
if (slice.thickness==0) slice.thickness<- c()
new.raw <- .ascii.to.hex (as.character(slice.thickness), tag.dictionary["(0018,0050)","VR"])
L0018[["(0018,0050)"]] <- c (.tag.to.hex("(0018,0050)"), charToRaw(tag.dictionary["(0018,0050)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)),new.raw)
L0018[["(0018,0060)"]] <- c (.tag.to.hex ("(0018,0060)"), charToRaw (tag.dictionary["(0018,0060)","VR"]), as.raw (c (0x00,0x00)))
new.raw <- .ascii.to.hex (paste("espadon", .espadon.version()), tag.dictionary["(0018,1020)","VR"])
L0018[["(0018,1020)"]] <- c(.tag.to.hex("(0018,1020)"), charToRaw(tag.dictionary["(0018,1020)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)),new.raw)
L0018[["(0018,5100)"]] <- c(.tag.to.hex("(0018,5100)"), charToRaw(tag.dictionary["(0018,5100)","VR"]),
unlist(.value.to.raw (length(patient.position),2,TRUE)),patient.position)
####################################
tag0020 <- c("(0020,000D)", "(0020,000E)", "(0020,0010)", "(0020,0011)", "(0020,0013)",
"(0020,0032)", "(0020,0037)", "(0020,0052)", "(0020,1040)","(0020,1041)")
L0020 <- lapply(tag0020,function(t) c())
names(L0020) <- tag0020
L0020[["(0020,000D)"]] <- c (.tag.to.hex("(0020,000D)"), charToRaw(tag.dictionary["(0020,000D)","VR"]),
unlist(.value.to.raw (length(study.UID), 2, T)), study.UID)
L0020[["(0020,000E)"]] <- c (.tag.to.hex("(0020,000E)"), charToRaw (tag.dictionary["(0020,000E)","VR"]),
unlist(.value.to.raw (length(serie.UID), 2, TRUE)), serie.UID)
L0020[["(0020,0010)"]] <- c(.tag.to.hex("(0020,0010)"), charToRaw(tag.dictionary["(0020,0010)","VR"]),
as.raw(c(0x00, 0x00)))
L0020[["(0020,0011)"]] <- c(.tag.to.hex("(0020,0011)"), charToRaw(tag.dictionary["(0020,0011)","VR"]),
as.raw(c(0x00, 0x00)))
L0020[["(0020,0013)"]] <- c(.tag.to.hex("(0020,0013)"), charToRaw(tag.dictionary["(0020,0013)","VR"]),
as.raw(c(0x00, 0x00)))
new.raw <- .ascii.to.hex (paste(obj$orientation, collapse="\\"), tag.dictionary["(0020,0037)","VR"])
L0020[["(0020,0037)"]] <- c(.tag.to.hex("(0020,0037)"), charToRaw(tag.dictionary["(0020,0037)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
L0020[["(0020,0052)"]] <- c(.tag.to.hex("(0020,0052)"),charToRaw(tag.dictionary["(0020,0052)","VR"]), frame.of.reference)
L0020[["(0020,1040)"]] <- c(.tag.to.hex("(0020,1040)"), charToRaw(tag.dictionary["(0020,1040)","VR"]),
as.raw(c(0x00, 0x00)))
####################################
tag0028 <- c("(0028,0002)", "(0028,0004)", "(0028,0010)", "(0028,0011)","(0028,0030)",
"(0028,0100)", "(0028,0101)", "(0028,0102)","(0028,0103)", "(0028,0106)",
"(0028,0107)", "(0028,1052)","(0028,1053)","(0028,1054)")#, "(0028,0120)")
L0028 <- lapply(tag0028,function(t) c())
names(L0028) <- tag0028
new.raw <-as.raw(c(1,0))
L0028[["(0028,0002)"]] <- c(.tag.to.hex("(0028,0002)"), charToRaw(tag.dictionary["(0028,0002)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
new.raw <- .ascii.to.hex ("MONOCHROME2", tag.dictionary["(0028,0004)","VR"])
L0028[["(0028,0004)"]] <- c(.tag.to.hex("(0028,0004)"), charToRaw(tag.dictionary["(0028,0004)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
new.raw <- c(as.raw(obj$n.ijk[2]%%256) ,as.raw((obj$n.ijk[2]/256)%%256))
L0028[["(0028,0010)"]] <- c(.tag.to.hex("(0028,0010)"), charToRaw(tag.dictionary["(0028,0010)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
new.raw <- c(as.raw(obj$n.ijk[1]%%256) ,as.raw((obj$n.ijk[1]/256)%%256))
L0028[["(0028,0011)"]] <- c(.tag.to.hex("(0028,0011)"), charToRaw(tag.dictionary["(0028,0011)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
new.raw <- .ascii.to.hex (paste(obj$dxyz[1:2], collapse="\\"), tag.dictionary["(0028,0030)","VR"])
L0028[["(0028,0030)"]] <- c(.tag.to.hex("(0028,0030)"), charToRaw(tag.dictionary["(0028,0030)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
new.raw <-as.raw(c(16,0))
L0028[["(0028,0100)"]] <- c(.tag.to.hex("(0028,0100)"), charToRaw(tag.dictionary["(0028,0100)","VR"]),
unlist( .value.to.raw (length(new.raw),2,TRUE)), new.raw)
L0028[["(0028,0101)"]] <- c(.tag.to.hex("(0028,0101)"), charToRaw(tag.dictionary["(0028,0101)","VR"]),
unlist( .value.to.raw (length(new.raw),2,TRUE)), new.raw)
new.raw <- as.raw(c(15,0))
L0028[["(0028,0102)"]] <- c(.tag.to.hex("(0028,0102)"), charToRaw(tag.dictionary["(0028,0102)","VR"]),
unlist( .value.to.raw (length(new.raw),2,TRUE)), new.raw)
# new.raw <- as.raw(c(0,0))
# if (obj$min.pixel<0)
new.raw <- as.raw(c(1,0))
L0028[["(0028,0103)"]] <- c(.tag.to.hex("(0028,0103)"), charToRaw(tag.dictionary["(0028,0103)","VR"]),
unlist( .value.to.raw (length(new.raw),2,TRUE)), new.raw)
new.raw <- .ascii.to.hex (as.character(intercept), tag.dictionary["(0028,1052)","VR"])
L0028[["(0028,1052)"]] <- c(.tag.to.hex("(0028,1052)"), charToRaw(tag.dictionary["(0028,1052)","VR"]),
unlist( .value.to.raw (length(new.raw),2,TRUE)), new.raw)
new.raw <- .ascii.to.hex (as.character(slope), tag.dictionary["(0028,1053)","VR"])
L0028[["(0028,1053)"]] <- c(.tag.to.hex("(0028,1053)"), charToRaw(tag.dictionary["(0028,1053)","VR"]),
unlist( .value.to.raw (length(new.raw),2,TRUE)), new.raw)
if (nchar(trimws(obj$unit))!=0){
new.raw <- .ascii.to.hex (as.character(obj$unit), tag.dictionary["(0028,1054)","VR"])
L0028[["(0028,1054)"]] <- c(.tag.to.hex("(0028,1054)"), charToRaw(tag.dictionary["(0028,1054)","VR"]),
unlist( .value.to.raw (length(new.raw),2,TRUE)), new.raw)
}
####################################
for (sop.idx in 1:length(filen)){
L0002[["(0002,0002)"]] <- c(.tag.to.hex ("(0002,0002)"), charToRaw (tag.dictionary["(0002,0002)","VR"]),
SOP_UID.1150[[sop.idx]])
L0002[["(0002,0003)"]] <- c(.tag.to.hex ("(0002,0003)"), charToRaw (tag.dictionary["(0002,0003)","VR"]),
SOP_UID.1155[[sop.idx]])
L0002[["(0002,0000)"]] <- c(.tag.to.hex ("(0002,0000)"), charToRaw (tag.dictionary["(0002,0000)","VR"]),
as.raw (c (0x04,0x00)),
unlist ( .value.to.raw (length (unlist (L0002[2:7])), 4, T)))
L0008[["(0008,0016)"]] <- c (.tag.to.hex ("(0008,0016)"), charToRaw (tag.dictionary["(0008,0016)","VR"]),
SOP_UID.1150[[sop.idx]])
L0008[["(0008,0018)"]] <- c (.tag.to.hex ("(0008,0018)"), charToRaw (tag.dictionary["(0008,0018)","VR"]),
SOP_UID.1155[[sop.idx]])
new.raw <- .ascii.to.hex (paste(obj$xyz0[sop.idx,], collapse="\\"), tag.dictionary["(0020,0032)","VR"])
L0020[["(0020,0032)"]] <- c(.tag.to.hex("(0020,0032)"), charToRaw(tag.dictionary["(0020,0032)","VR"]),
unlist( .value.to.raw (length(new.raw),2,TRUE)), new.raw)
new.raw <- .ascii.to.hex (paste(obj$xyz0[sop.idx,3], collapse="\\"), tag.dictionary["(0020,1041)","VR"])
L0020[["(0020,1041)"]] <- c(.tag.to.hex("(0020,1041)"), charToRaw(tag.dictionary["(0020,1041)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
if (length(vol3D)!=0){
map <- as.vector(vol3D[,,sop.idx])
min.pixel <- min(map)
max.pixel <- max(map)
new.raw <- c(as.raw(min.pixel%%256) ,as.raw((min.pixel/256)%%256))
L0028[["(0028,0106)"]] <- c(.tag.to.hex("(0028,0106)"), charToRaw("US"),
as.raw(c(0x02,00)), new.raw)
new.raw <- c(as.raw(max.pixel%%256) ,as.raw((max.pixel/256)%%256))
L0028[["(0028,0107)"]] <- c(.tag.to.hex("(0028,0107)"), charToRaw("US"),
as.raw(c(0x02,00)), new.raw)
map <- as.vector(rbind(as.raw(map%%256) ,as.raw((map/256)%%256)))
L7FE00010 <- c(.tag.to.hex("(7FE0,0010)"),charToRaw("OW"), as.raw(c(0,0)),
unlist(.value.to.raw (length(map),4,TRUE)),map)
}
####################################
rawdata <- as.vector(c(preamble,unlist(L0002),unlist(L0008),unlist(L0010),unlist(L0018),
unlist(L0020),unlist(L0028),L7FE00010))
zz <- file (filen[sop.idx], "wb")
writeBin (rawdata, zz, size = 1)
close (zz)
}
message ("number of files created : ", length(filen))
}
################################################################################
export.rtstruct.to.dicom <- function(obj, ref.obj.list = NULL, use.original.UIs = FALSE,
use.original.ref.UIs = TRUE,
file.prefix ="", file.dirname= '.', file.name = NULL,
tag.dictionary = dicom.tag.dictionary(),...){
rownames(tag.dictionary) <- tag.dictionary$tag
args <- tryCatch(list(...), error = function(e)list())
study.UID <- .ascii.to.hex (args[["(0020,000D)"]], tag.dictionary["(0020,000D)","VR"])
serie.UID <- .ascii.to.hex (args[["(0020,000E)"]], tag.dictionary["(0020,000E)","VR"])
sop.type <- .ascii.to.hex (args[["(0008,0008)"]], tag.dictionary["(0008,0008)","VR"])
# NAvalue <- args[["NAvalue"]]
# if (is.null(NAvalue)) NAvalue <- 0
study.vect <- c("patient","frame.of.reference")
serie.vect <- c("patient","frame.of.reference","modality", "description", "study.date", "study.time")
if (!is.null(obj$object.info) & use.original.UIs){
if (length(study.UID)==0) study.UID <- .ascii.to.hex (obj$object.info$study.UID, tag.dictionary["(0020,000D)","VR"])
if (length(serie.UID)==0) serie.UID <- .ascii.to.hex (obj$object.info$serie.UID, tag.dictionary["(0020,000E)","VR"])
if (length(sop.type)==0) sop.type <- .ascii.to.hex (obj$object.info$SOP.type, tag.dictionary["(0008,0008)","VR"])
} else {
if (length(study.UID)==0) study.UID <- create.UID(obj,study.vect,size = 50)
if (length(serie.UID)==0) serie.UID <- create.UID(obj,serie.vect,size =50)
if (length(sop.type)==0) sop.type <- .ascii.to.hex ('ORIGINAL\\PRIMARY', tag.dictionary["(0008,0008)","VR"])
}
if (length(.ascii.to.hex(obj$frame.of.reference, "UI"))==0)
obj$frame.of.reference <- rawToChar(create.UID (obj,c("patient", "ref.pseudo"), size =44))
frame.of.reference <- .ascii.to.hex(obj$frame.of.reference, "UI")
frame.of.reference <- c (unlist (.value.to.raw (length (frame.of.reference), 2, TRUE)),
frame.of.reference)
ref.SOP_UID.1150 <- NULL
ref.SOP_UID.1155 <- NULL
z.ref <- NULL
if (!is.null(ref.obj.list)){
ref.serie<- do.call(rbind, lapply(ref.obj.list,function(obj_){
if (!is.null(obj_$object.info) & use.original.ref.UIs) return(.ascii.to.hex (obj_$object.info$serie.UID, "UI"))
create.UID(obj_,serie.vect,size =50)}))
f <- !duplicated.array(ref.serie)
ref.obj.list <- ref.obj.list[f]
ref.serie <- ref.serie[f,, drop = FALSE]
SOP.L <- lapply(ref.obj.list, function(obj_) {
if (length(.ascii.to.hex(obj_$frame.of.reference, "UI"))==0)
obj_$frame.of.reference <- rawToChar(create.UID (obj_,c("patient", "ref.pseudo"), size =44))
if (!is.null(obj_$object.info) & use.original.ref.UIs) {
# l1155 <- obj_$object.info$SOP.label
# ncl.f<- cumsum(nchar(l1155))
# ncl.d <- c(1,ncl.f[-length(ncl.f)] -1)
# l1155 <- charToRaw(paste(l1155,collapse=""))
# l1155 <- lapply(1:length(ncl.f), function(i) {
# new.raw <- c(l1155[ncl.d[i]:ncl.f[i]] ,as.raw(0x00)); new.raw[1:(2 * floor(length(new.raw)/2))]})
l1155 <- lapply(obj_$object.info$SOP.label, function(uid) .ascii.to.hex(uid,"UI"))
l1150 <- .ascii.to.hex(obj_$object.info$SOP.ID,"UI")
l1150 <- lapply(l1155,function(i) l1150)
return(list(l1150=l1150,l1155=l1155))
}
return(create.SOPUID(obj_))
})
z.ref <- lapply(ref.obj.list, function(obj_) {
if(obj_$modality!="ct" & obj_$modality!="mr") return(NULL)
t.mat <- ref.cutplane.add(obj_)
(as.matrix(cbind(obj_$xyz0,1)) %*% t(get.rigid.M(t.mat, obj_$ref.pseudo,paste0(obj_$ref.pseudo, "m"))))[,3]
})
ref.SOP_UID.1150 <- lapply(SOP.L, function(l )l$l1150)
ref.SOP_UID.1155 <- lapply(SOP.L, function(l )l$l1155)
ref.SOP_UID.1150 <- lapply(ref.SOP_UID.1150,function(l) lapply(l, function (uid)
c(unlist(.value.to.raw (length(uid),2,TRUE)),uid)))
ref.SOP_UID.1155 <- lapply(ref.SOP_UID.1155,function(l) lapply(l, function (uid)
c(unlist(.value.to.raw (length(uid),2,TRUE)),uid)))
rm(SOP.L)
}
# use.info <- Sys.info()[1:7]
# use.info[6] <- paste(use.info[6],Sys.getenv("LOGNAME"),sep="")
# use.info[7] <- format(Sys.time(), "%Y%m%d%H%M%s")
# use.info <-c(hash(charToRaw(paste(use.info, collapse = " ")), key = NULL, size = 16),
# unlist(.value.to.raw(as.numeric(Sys.time()),2,F)))
# fn <- paste(use.info,collapse="")
SOP <- create.SOPUID(obj)
######################################
fn <- sapply(SOP$l1155, function(uid) rev(unlist(strsplit(rawToChar(uid[uid!=as.raw(0)]),"[.]")))[1])
if (length(file.name)==0){
filen <- file.path(file.dirname, paste0(file.prefix, fn, ".dcm"))
} else {
file.name <- gsub("[.]dcm$","",file.name)
filen <- file.path(file.dirname, paste0(file.name,".dcm"))
}
dn <- unique(dirname(filen))
for (fdn in dn) if (!dir.exists(fdn)) dir.create(fdn,recursive = T)
#######################################
SOP_UID.1150 <- lapply(SOP$l1150,function(uid) c(unlist(.value.to.raw (length(uid),2,TRUE)),uid))
SOP_UID.1155 <- lapply(SOP$l1155,function(uid) c(unlist(.value.to.raw (length(uid),2,TRUE)),uid))
version_name <- paste(c("R ",version$major,".",version$minor,
" espadon ", .espadon.version()),collapse ="")
version_name <- c(charToRaw(version_name),as.raw(0x00))
version_name <- version_name[1:(2*floor(length(version_name)/2))]
transfert_syntax <- c(charToRaw("1.2.840.10008.1.2.1"),as.raw(0x00))
implementation_UID <- c( charToRaw(paste0(.espadon.version(),".",
paste(charToRaw(obj$modality),collapse=""))),as.raw(0x00))
sop.idx <- 1
# for (sop.idx in 1:length(SOP_UID.1155)) {
####################################
preamble <- as.raw(c(rep(0,128),68,73,67,77))
tag0002 <- c("(0002,0000)","(0002,0001)" ,"(0002,0002)", "(0002,0003)",
"(0002,0010)", "(0002,0012)", "(0002,0013)")
L0002 <- lapply(tag0002,function(t) c())
names(L0002) <- tag0002
L0002[["(0002,0001)"]] <- c(.tag.to.hex ("(0002,0001)"), charToRaw (tag.dictionary["(0002,0001)","VR"]),
as.raw(c(0x00,0x00,0x02,0x00,0x00,0x00,0x00,0x01)))
L0002[["(0002,0002)"]] <- c(.tag.to.hex ("(0002,0002)"), charToRaw (tag.dictionary["(0002,0002)","VR"]),
SOP_UID.1150[[sop.idx]])
L0002[["(0002,0003)"]] <- c(.tag.to.hex ("(0002,0003)"), charToRaw (tag.dictionary["(0002,0003)","VR"]),
SOP_UID.1155[[sop.idx]])
L0002[["(0002,0010)"]] <- c(.tag.to.hex ("(0002,0010)"), charToRaw (tag.dictionary["(0002,0010)","VR"]),
unlist(.value.to.raw (length(transfert_syntax),2,TRUE)),transfert_syntax)
L0002[["(0002,0012)"]] <- c(.tag.to.hex ("(0002,0012)"), charToRaw (tag.dictionary["(0002,0012)","VR"]),
unlist(.value.to.raw (length(implementation_UID),2,TRUE)),implementation_UID)
L0002[["(0002,0013)"]] <- c(.tag.to.hex ("(0002,0013)"), charToRaw (tag.dictionary["(0002,0013)","VR"]),
unlist(.value.to.raw (length(version_name),2,TRUE)), version_name)
L0002[["(0002,0000)"]] <- c(.tag.to.hex ("(0002,0000)"), charToRaw (tag.dictionary["(0002,0000)","VR"]),
as.raw (c (0x04,0x00)),
unlist (.value.to.raw (length (unlist (L0002[2:7])), 4, T)))
####################################
tag0008 <- c("(0008,0005)", "(0008,0012)", "(0008,0016)", "(0008,0018)",
"(0008,0020)", "(0008,0021)", "(0008,0023)", "(0008,0030)",
"(0008,0050)", "(0008,0060)", "(0008,0070)", "(0008,0090)",
"(0008,1030)", "(0008,103E)", "(0008,1070)")
VR0008 <- tag.dictionary[tag0008,"VR"]
L0008 <- lapply(tag0008,function(t) c())
names(L0008) <- tag0008
names(VR0008) <- tag0008
L0008[["(0008,0005)"]] <- c (.tag.to.hex ("(0008,0005)"), charToRaw (VR0008["(0008,0005)"]),
as.raw (c(0x0A,0x00)), charToRaw ("ISO_IR 100"))
if (obj$creation.date!=""){
new.raw <- .ascii.to.hex (obj$creation.date, VR0008["(0008,0012)"])
L0008[["(0008,0012)"]]<- c (.tag.to.hex ("(0008,0012)"), charToRaw (VR0008["(0008,0012)"]),
as.raw (c (0x08,0x00)), new.raw[1:8])
} else {
L0008[["(0008,0012)"]]<- c (.tag.to.hex("(0008,0012)"), charToRaw (VR0008["(0008,0012)"]),
as.raw (c(0x08,0x00)),charToRaw (format (Sys.Date (), "%Y%m%d"))) # devient la date d'assignation de SOP_UID
}
L0008[["(0008,0016)"]] <- c (.tag.to.hex ("(0008,0016)"), charToRaw (VR0008["(0008,0016)"]), SOP_UID.1150[sop.idx])
L0008[["(0008,0018)"]] <- c (.tag.to.hex ("(0008,0018)"), charToRaw (VR0008["(0008,0018)"]), SOP_UID.1155[sop.idx])
new.raw <- .ascii.to.hex (obj$study.date, VR0008["(0008,0020)"])
m <- match(new.raw[1:8], as.raw(48:57))
L0008[["(0008,0020)"]]<- c (.tag.to.hex ("(0008,0020)"), charToRaw (VR0008["(0008,0020)"]),
as.raw (c (0x08,0x00)), new.raw[1:8])
new.raw <- .ascii.to.hex (trimws (obj$creation.date), VR0008["(0008,0021)"])
L0008[["(0008,0021)"]] <- c (.tag.to.hex ("(0008,0021)"), charToRaw (VR0008["(0008,0021)"]),
unlist (.value.to.raw (length (new.raw), 2, TRUE)), new.raw)
L0008[["(0008,0023)"]] <- c (.tag.to.hex ("(0008,0023)"), charToRaw (VR0008["(0008,0023)"]),
unlist (.value.to.raw (length (new.raw), 2, TRUE)), new.raw)
new.raw <- .ascii.to.hex (trimws (obj$study.time), VR0008["(0008,0030)"])
L0008[["(0008,0030)"]] <- c (.tag.to.hex ("(0008,0030)"), charToRaw (VR0008["(0008,0030)"]),
unlist (.value.to.raw (length (new.raw), 2, TRUE)), new.raw)
L0008[["(0008,0050)"]]<- c (.tag.to.hex("(0008,0050)"), charToRaw (VR0008["(0008,0050)"]), as.raw (c (0x00,0x00)))
L0008[["(0008,0060)"]] <- c (.tag.to.hex ("(0008,0060)"), charToRaw (VR0008["(0008,0060)"]),
as.raw (c (0x08,0x00)), charToRaw ("RTSTRUCT"))
new.raw <- .ascii.to.hex ("R ESPADON MANUFACTURER", tag.dictionary["(0008,0070)","VR"])
L0008[["(0008,0070)"]] <- c (.tag.to.hex ("(0008,0070)"), charToRaw (tag.dictionary["(0008,0070)","VR"]),
unlist (.value.to.raw (length (new.raw), 2, TRUE)), new.raw)
L0008[["(0008,0090)"]] <- c (.tag.to.hex ("(0008,0090)"), charToRaw (VR0008["(0008,0090)"]),
as.raw(c(0x00, 0x00)))
description <- unlist(strsplit(obj$description,"[|]")[[1]])
if (length(description) == 0) description <-""
new.raw <-.ascii.to.hex( iconv(description[1], "ISO-IR-100"), VR0008["(0008,1030)"])
L0008[["(0008,1030)"]]<- c (.tag.to.hex ("(0008,1030)"), charToRaw (VR0008["(0008,1030)"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
if(!is.na(description[2])!=0){
new.raw <-.ascii.to.hex( iconv(description[2], "ISO-IR-100"), VR0008["(0008,103E)"])
L0008[["(0008,103E)"]]<- c (.tag.to.hex ("(0008,103E)"), charToRaw (VR0008["(0008,103E)"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
}
#
L0008[["(0008,1070)"]]<- c (.tag.to.hex ("(0008,1070)"), charToRaw (VR0008["(0008,1070)"]),
as.raw(c(0x00, 0x00)))
####################################
tag0010 <- c("(0010,0010)","(0010,0020)","(0010,0030)","(0010,0040)")
L0010 <- lapply(tag0010,function(t) c())
names(L0010) <- tag0010
# if(nchar(obj$patient.name)!=0) obj$patient.name <- ""
new.raw <- .ascii.to.hex( iconv(obj$patient.name, "ISO-IR-100"), tag.dictionary["(0010,0010)","VR"])
L0010[["(0010,0010)"]]<- c (.tag.to.hex("(0010,0010)"), charToRaw(tag.dictionary["(0010,0010)","VR"]),
unlist(.value.to.raw (length(new.raw),2,T)),new.raw)
# if(nchar(obj$patient)!=0) obj$patient <- ""
new.raw <-.ascii.to.hex( iconv(obj$patient, "ISO-IR-100"), tag.dictionary["(0010,0020)","VR"])
L0010[["(0010,0020)"]]<- c (.tag.to.hex("(0010,0020)"), charToRaw(tag.dictionary["(0010,0020)","VR"]),
unlist (.value.to.raw (length (new.raw), 2, T)),new.raw)
new.raw <- .ascii.to.hex (trimws(obj$patient.bd), tag.dictionary["(0010,0030)","VR"])
L0010[["(0010,0030)"]]<- c (.tag.to.hex ("(0010,0030)"), charToRaw (tag.dictionary["(0010,0030)","VR"]),
unlist (.value.to.raw (length (new.raw), 2, T)),new.raw)
new.raw <- .ascii.to.hex (trimws(obj$patient.sex), tag.dictionary["(0010,0040)","VR"])
L0010[["(0010,0040)"]]<- c (.tag.to.hex ("(0010,0040)"), charToRaw (tag.dictionary["(0010,0040)","VR"]),
unlist (.value.to.raw (length (new.raw), 2, T)),new.raw)
####################################
# "(0012,0060) "Clinical Trial Coordinating Center Name Attribute
# L0012[["(0012,0060)"]] <- c(.tag.to.hex("(0012,0060)"), charToRaw(tag.dictionary["(0012,0060)","VR"]),
# as.raw(c(0x00, 0x00)))
#
####################################
tag0018 <- "(0018,1020)"
L0018 <- lapply(tag0018,function(t) c())
names(L0018) <- tag0018
new.raw <- .ascii.to.hex (paste("espadon", .espadon.version()), tag.dictionary["(0018,1020)","VR"])
L0018[["(0018,1020)"]] <- c(.tag.to.hex("(0018,1020)"), charToRaw(tag.dictionary["(0018,1020)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)),new.raw)
####################################
tag0020 <- c( "(0020,000D)", "(0020,000E)","(0020,0010)","(0020,0011)",
"(0020,0052)","(0020,1040)")
L0020 <- lapply(tag0020,function(t) c())
names(L0020) <- tag0020
L0020[["(0020,000D)"]] <- c (.tag.to.hex("(0020,000D)"), charToRaw(tag.dictionary["(0020,000D)","VR"]),
unlist(.value.to.raw (length(study.UID), 2, T)), study.UID)
L0020[["(0020,000E)"]] <- c (.tag.to.hex("(0020,000E)"), charToRaw (tag.dictionary["(0020,000E)","VR"]),
unlist(.value.to.raw (length(serie.UID), 2, TRUE)), serie.UID)
L0020[["(0020,0010)"]] <- c(.tag.to.hex("(0020,0010)"), charToRaw(tag.dictionary["(0020,0010)","VR"]),
as.raw(c(0x00, 0x00)))
L0020[["(0020,0011)"]] <- c(.tag.to.hex("(0020,0011)"), charToRaw(tag.dictionary["(0020,0011)","VR"]),
as.raw(c(0x00, 0x00)))
L0020[["(0020,0052)"]] <- c(.tag.to.hex("(0020,0052)"), charToRaw(tag.dictionary["(0020,0052)","VR"]), frame.of.reference)
L0020[["(0020,1040)"]] <- c(.tag.to.hex("(0020,1040)"), charToRaw(tag.dictionary["(0020,1040)","VR"]),
as.raw(c(0x00, 0x00)))
####################################
tag3006 <- c("(3006,0002)","(3006,0008)")
VR3006 <- tag.dictionary[tag3006,"VR"]
L3006 <- lapply(tag3006,function(t) c())
names(L3006) <- tag3006
names(VR3006) <- tag3006
label <- obj$object.alias
le <- nchar(label)
if (grepl('[_]ref[[:digit:]]+',label) & grepl('[_]do[[:digit:]]+',label)){
label <- strsplit(obj$object.alias,"[_]")[[1]]
label <- paste0(label[grep("^ref",label)],"_", label[grep("^do",label)])
le <- nchar(label)
}
new.raw <- .ascii.to.hex (substr(label,max(1,le-15),le) , VR3006["(3006,0002)"])
L3006[["(3006,0002)"]] <- c(.tag.to.hex("(3006,0002)"), charToRaw(VR3006["(3006,0002)"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
L3006[["(3006,0008)"]] <- c(.tag.to.hex("(3006,0008)"), charToRaw(VR3006["(3006,0008)"]),
as.raw(c(0x00, 0x00)))
L30060010 <- c()
if (!is.null( ref.SOP_UID.1150)){#(3006,0010)
L30060016loop <- lapply(1:length(ref.SOP_UID.1150), function(ref.idx)
return(unlist(lapply(1:length(ref.SOP_UID.1150[[ref.idx]]), function(idx){
tot <- c(.tag.to.hex("(0008,1150)"),charToRaw(tag.dictionary["(0008,1150)","VR"]),
ref.SOP_UID.1150[[ref.idx]][[idx]],
.tag.to.hex("(0008,1155)"),charToRaw(tag.dictionary["(0008,1155)","VR"]),
ref.SOP_UID.1155[[ref.idx]][[idx]])
c (as.raw(c(0xfe, 0xff, 0x00, 0xe0)), unlist(.value.to.raw (length(tot),4,TRUE)), tot)}))
))
L300060014loop <- unlist(lapply(1:length(L30060016loop),function(idx){
tot <- c(.tag.to.hex("(0020,000E)"), charToRaw(tag.dictionary["(0020,000E)","VR"]),
unlist(.value.to.raw (length(ref.serie[idx,]),2,TRUE)),ref.serie[idx,],
.tag.to.hex("(3006,0016)"), charToRaw(tag.dictionary["(3006,0016)","VR"]), as.raw(c(0x00,0x00)),
unlist(.value.to.raw (length(L30060016loop[[idx]]),4,TRUE)), L30060016loop[[idx]])
c(as.raw(c(0xfe, 0xff, 0x00, 0xe0)),
unlist(.value.to.raw (length(tot),4,TRUE)),tot)
}))
tag30060012 <- c("(0008,1150)","(0008,1155)","(3006,0014)")
VR30060012 <- tag.dictionary[tag30060012,"VR"]
L30060012 <- list()
L30060012[[1]] <- c(.tag.to.hex("(0008,1150)"), charToRaw(tag.dictionary["(0008,1150)","VR"]),
SOP_UID.1150[[sop.idx]])
L30060012[[2]] <- c(.tag.to.hex("(0008,1155)"), charToRaw(tag.dictionary["(0008,1155)","VR"]),
SOP_UID.1155[[sop.idx]])
L30060012[[3]] <- c(.tag.to.hex("(3006,0014)"), charToRaw(tag.dictionary["(3006,0014)","VR"]) ,
as.raw(c(0x00,0x00)),
unlist(.value.to.raw (length(L300060014loop),4,TRUE)), L300060014loop)
L30060012 <- unlist(L30060012)
L30060012 <- c(as.raw(c(0xfe, 0xff, 0x00, 0xe0)), unlist(.value.to.raw (length(L30060012),4,TRUE)),L30060012)
tag30060010 <- c("(0020,0052)","(3006,0012)")
L30060010 <- lapply(tag30060010,function(t) c())
names(L30060010) <- tag30060010
L30060010[["(0020,0052)"]] <- c(.tag.to.hex("(0020,0052)"),charToRaw(tag.dictionary["(0020,0052)","VR"]), frame.of.reference)
L30060010[["(3006,0012)"]] <- c(.tag.to.hex("(3006,0012)"),charToRaw(tag.dictionary["(3006,0012)","VR"]), as.raw(c(0x00,0x00)),
unlist(.value.to.raw (length(L30060012),4,TRUE)), L30060012)
L30060010 <- as.raw(unlist(L30060010))
L30060010 <- c(as.raw(c(0xfe, 0xff, 0x00, 0xe0)), unlist(.value.to.raw (length(L30060010),4,TRUE)),L30060010)
L30060010 <- c(.tag.to.hex("(3006,0010)"),charToRaw(tag.dictionary["(3006,0010)","VR"]), as.raw(c(0x00,0x00)),
unlist(.value.to.raw (length(L30060010),4,TRUE)), L30060010)
}
#####
tag30060020loop <- c("(3006,0022)","(3006,0024)","(3006,0026)", "(3006,0028)","(3006,0036)")
VR30060020loop <- tag.dictionary[tag30060020loop,"VR"]
add.desc <- any(obj$roi.info$description!="")
L30060020loop <-unlist(lapply(1:nrow(obj$roi.info), function(i) {
v <- .ascii.to.hex(as.character(as.integer(obj$roi.info$number[i])),VR30060020loop[1])
tot <- c(.tag.to.hex("(3006,0022)"),charToRaw(tag.dictionary["(3006,0022)","VR"]),
unlist(.value.to.raw (length(v),2,TRUE)),v)
tot <- c(tot, .tag.to.hex("(3006,0024)"),charToRaw(tag.dictionary["(3006,0024)","VR"]),
frame.of.reference)
v <- .ascii.to.hex(iconv(obj$roi.info$name[i], "ISO-IR-100"),tag.dictionary["(3006,0026)","VR"])
tot <- c(tot, c (.tag.to.hex("(3006,0026)"),charToRaw(tag.dictionary["(3006,0026)","VR"]),
unlist(.value.to.raw (length(v),2,TRUE)), v))
if (add.desc){
v <- .ascii.to.hex(iconv(obj$roi.info$description[i], "ISO-IR-100"),tag.dictionary["(3006,0028)","VR"])
tot <- c(tot, c (.tag.to.hex("(3006,0028)"),charToRaw(tag.dictionary["(3006,0028)","VR"]),
unlist(.value.to.raw (length(v),2,TRUE)), v))
}
v <- .ascii.to.hex(toupper(obj$roi.info$generation.algorithm[i]),VR30060020loop[5])
tot <- c(tot, c (.tag.to.hex(tag30060020loop[5]),charToRaw(VR30060020loop[5]),
unlist(.value.to.raw (length(v),2,TRUE)), v))
c (as.raw(c(0xfe, 0xff, 0x00, 0xe0)), unlist(.value.to.raw (length(tot),4,TRUE)), tot)
}))
tag30060020 <- c( "(3006,0020)")
VR30060020 <- tag.dictionary[tag30060020,"VR"]
L30060020 <- list()
L30060020[[1]] <- c(.tag.to.hex(tag30060020[1]),charToRaw(VR30060020[1]) , as.raw(c(0x00,0x00)),
unlist(.value.to.raw (length(L30060020loop),4,TRUE)), L30060020loop)
####################################
tag30060040 <- c( "(3006,002A)", "(3006,0040)", "(3006,0084)")
VR30060040 <- tag.dictionary[tag30060040,"VR"]
tag30060040loop <- c("(3006,0016)", "(3006,0042)","(3006,0046)","(3006,0048)", "(3006,0050)")
VR30060040loop <- tag.dictionary[tag30060040loop,"VR"]
L30060039loop <- unlist(lapply(1:nrow(obj$roi.info), function(i) {
tot <- raw(0)
if (!is.null(obj$roi.data[[i]])){
L30060040loop <- unlist(lapply( 1:length(obj$roi.data[[i]]), function(j){
pt <- as.matrix(obj$roi.data[[i]][[j]]$pt)
le.pt <- nrow(pt)
if (all(pt[1,]==pt[le.pt,])) {pt <- pt[-le.pt, ]; le.pt <- le.pt-1}
tot_ <- NULL
if (!is.null(ref.obj.list) & length(z.ref)>0){
refz.L <- lapply (1:length(z.ref),function(ref.idx) {
if (is.null(z.ref[[ref.idx]])) return(NULL)
flag <- round(z.ref[[ref.idx]],6) == round(pt[1,3],6)
if (all(!flag)){
warning(paste(obj$roi.info$name[i],": Check Reference object at z=",
round(pt[1,3],6),"mm."),call. = FALSE)
return(NULL)
}
tot <- c(.tag.to.hex("(0008,1150)"),charToRaw(tag.dictionary["(0008,1150)","VR"]),
ref.SOP_UID.1150[[ref.idx]][flag][[1]],
.tag.to.hex("(0008,1155)"),charToRaw(tag.dictionary["(0008,1155)","VR"]),
ref.SOP_UID.1155[[ref.idx]][flag][[1]])
return(c (as.raw(c(0xfe, 0xff, 0x00, 0xe0)), unlist(.value.to.raw (length(tot),4,TRUE)), tot))
})
refz.L <- refz.L[ !sapply(refz.L,is.null)]
if (length(refz.L))
tot_ <- c(.tag.to.hex(tag30060040loop[1]),charToRaw(VR30060040loop[1]) , as.raw(c(0x00,0x00)),
unlist(.value.to.raw (length(refz.L[[1]]),4,TRUE)), refz.L[[1]])
}
v <- .ascii.to.hex(toupper(obj$roi.data[[i]][[j]]$type), VR30060040loop[2])
tot_ <- c(tot_, .tag.to.hex(tag30060040loop[2]), charToRaw(VR30060040loop[2]),
unlist(.value.to.raw (length(v),2,TRUE)),v)
v <- .ascii.to.hex(as.character(le.pt),VR30060040loop[3])
tot_ <- c(tot_, .tag.to.hex(tag30060040loop[3]), charToRaw(VR30060040loop[3]),
unlist(.value.to.raw (length(v),2,TRUE)),v)
v <- .ascii.to.hex(as.character(j-1),VR30060040loop[4])
tot_ <- c(tot_, .tag.to.hex(tag30060040loop[4]), charToRaw(VR30060040loop[4]),
unlist(.value.to.raw (length(v),2,TRUE)),v)
v <- .ascii.to.hex(paste(as.numeric(t(pt)),collapse="\\"),VR30060040loop[5])
tot_ <- c(tot_, .tag.to.hex(tag30060040loop[5]), charToRaw(VR30060040loop[5]),
unlist(.value.to.raw (length(v),2,TRUE)),v)
c (as.raw(c(0xfe, 0xff, 0x00, 0xe0)),
unlist(.value.to.raw (length(tot_),4,TRUE)), tot_)
}))
tot <- c(.tag.to.hex(tag30060040[2]),charToRaw(VR30060040[2]) , as.raw(c(0x00,0x00)),
unlist(.value.to.raw (length(L30060040loop),4,TRUE)), L30060040loop)
}
v <-.ascii.to.hex(paste(as.numeric(col2rgb(obj$roi.info$color[i])),collapse="\\"),VR30060040[1])
tot <- c(.tag.to.hex(tag30060040[1]), charToRaw(VR30060040[1]),
unlist(.value.to.raw (length(v),2,TRUE)),v, tot)
v <- .ascii.to.hex(as.character(as.integer(obj$roi.info$number[i])),VR30060040[3])
tot <- c(tot, .tag.to.hex(tag30060040[3]), charToRaw(VR30060040[3]),
unlist(.value.to.raw (length(v),2,TRUE)),v)
c (as.raw(c(0xfe, 0xff, 0x00, 0xe0)),
unlist(.value.to.raw (length(tot),4,TRUE)), tot)
}))
tag30060039 <- c("(3006,0039)")
VR30060039 <- tag.dictionary[tag30060039,"VR"]
L30060039 <- list()
L30060039[[1]] <- c(.tag.to.hex(tag30060039[1]),charToRaw(VR30060039[1]) , as.raw(c(0x00,0x00)),
unlist(.value.to.raw (length(L30060039loop),4,T)), L30060039loop)
####################################
tag30060080loop <- c("(3006,0082)", "(3006,0084)", "(3006,0085)",
"(3006,00A4)", "(3006,00A6)")
VR30060080loop <- tag.dictionary[tag30060080loop,"VR"]
obj$roi.obs[is.na(obj$roi.obs)] <- ""
L30060080loop <-unlist(lapply(1:nrow(obj$roi.obs), function(i) {
v <- .ascii.to.hex (as.character(as.integer(obj$roi.obs$nb[i])), VR30060080loop[1])
tot <- c (.tag.to.hex (tag30060080loop[1]), charToRaw (VR30060080loop[1]),
unlist (.value.to.raw (length (v), 2, TRUE)), v)
v <- .ascii.to.hex (as.character(as.integer(obj$roi.obs$roi.nb[i])), VR30060080loop[2])
tot <- c(tot, .tag.to.hex (tag30060080loop[2]), charToRaw (VR30060080loop[2]),
unlist (.value.to.raw (length (v), 2, TRUE)), v)
v <- .ascii.to.hex (iconv(obj$roi.obs$label[i], "ISO-IR-100"), VR30060080loop[3])
tot <- c(tot, .tag.to.hex (tag30060080loop[3]), charToRaw (VR30060080loop[3]),
unlist (.value.to.raw (length (v), 2, TRUE)), v)
v <- .ascii.to.hex(iconv(toupper(obj$roi.obs$type[i]), "ISO-IR-100"),VR30060080loop[4])
tot <- c(tot, c (.tag.to.hex(tag30060080loop[4]),charToRaw(VR30060080loop[4]),
unlist(.value.to.raw (length(v),2,TRUE)), v))
v <- .ascii.to.hex(iconv(obj$roi.obs$interpreter[i], "ISO-IR-100"),VR30060080loop[5])
tot <- c(tot, c (.tag.to.hex(tag30060080loop[5]),charToRaw(VR30060080loop[5]),
unlist(.value.to.raw (length(v),2,TRUE)), v))
c (as.raw(c(0xfe, 0xff, 0x00, 0xe0)), unlist(.value.to.raw (length(tot),4,T)), tot)
}))
tag30060080 <- c("(3006,0080)")
VR30060080 <- tag.dictionary[tag30060080,"VR"]
L30060080 <- list()
L30060080[[1]] <- c(.tag.to.hex(tag30060080[1]),charToRaw(VR30060080[1]) , as.raw(c(0x00,0x00)),
unlist(.value.to.raw (length(L30060080loop),4,TRUE)), L30060080loop)
#############################################################################
tag300E <- c("(300E,0002)","(300E,0004)","(300E,0005)","(300E,0008)")
L300E <- lapply(tag300E,function(t) c())
names(L300E) <- tag300E
# Approval Status Attribute
Approval.Status.Attribute <- "UNAPPROVED"
Approval.Status.Attribute.vect <- c("APPROVED", "UNAPPROVED","REJECTED")
if (!is.null(obj$approval.status)) {
m <- match(toupper(trimws(obj$approval.status)), Approval.Status.Attribute.vect)
if (!is.na(m)) Approval.Status.Attribute <- Approval.Status.Attribute.vect[m]
}
new.raw <- .ascii.to.hex(Approval.Status.Attribute, tag.dictionary["(300E,0002)","VR"])
L300E[["(300E,0002)"]]<- c (.tag.to.hex("(300E,0002)"), charToRaw( tag.dictionary["(300E,0002)","VR"]),
unlist(.value.to.raw (length(new.raw),2,T)),new.raw)
if (Approval.Status.Attribute %in% c("APPROVED","REJECTED")){
L300E[["(300E,0004)"]]<- c (.tag.to.hex("(300E,0004)"), charToRaw( tag.dictionary["(300E,0004)","VR"]), as.raw(c(0,0)))
L300E[["(300E,0005)"]]<- c (.tag.to.hex("(300E,0005)"), charToRaw( tag.dictionary["(300E,0005)","VR"]), as.raw(c(0,0)))
L300E[["(300E,0008)"]]<- c (.tag.to.hex("(300E,0008)"), charToRaw( tag.dictionary["(300E,0008)","VR"]), as.raw(c(0,0)))
}
####################################
rawdata <- c(preamble,unlist(L0002),unlist(L0008),unlist(L0010),unlist(L0018),
unlist(L0020),unlist(L3006), L30060010, unlist(L30060020),
unlist(L30060039), unlist(L30060080))
zz <- file (filen, "wb")
writeBin (rawdata, zz, size = 1)
close (zz)
# }
message ("file created : ", basename(filen))
}
################################################################################
export.rtdose.to.dicom <- function(obj, ref.obj.list = NULL, use.original.UIs = FALSE,
use.original.ref.UIs = TRUE,
file.prefix ="", file.dirname= '.', file.name = NULL,
tag.dictionary = dicom.tag.dictionary(),...){
rownames(tag.dictionary) <- tag.dictionary$tag
args <- tryCatch(list(...), error = function(e)list())
study.UID <- .ascii.to.hex (args[["(0020,000D)"]], tag.dictionary["(0020,000D)","VR"])
serie.UID <- .ascii.to.hex (args[["(0020,000E)"]], tag.dictionary["(0020,000E)","VR"])
sop.type <- .ascii.to.hex (args[["(0008,0008)"]], tag.dictionary["(0008,0008)","VR"])
NAvalue <- args[["NAvalue"]]
study.vect <- c("patient","frame.of.reference")
serie.vect <- c("patient","frame.of.reference","modality", "description", "study.date", "study.time")
if (!is.null(obj$object.info) & use.original.UIs){
if (length(study.UID)==0) study.UID <- .ascii.to.hex (obj$object.info$study.UID, tag.dictionary["(0020,000D)","VR"])
if (length(serie.UID)==0) serie.UID <- .ascii.to.hex (obj$object.info$serie.UID, tag.dictionary["(0020,000E)","VR"])
if (length(sop.type)==0) sop.type <- .ascii.to.hex (obj$object.info$SOP.type, tag.dictionary["(0008,0008)","VR"])
} else {
if (length(study.UID)==0) study.UID <- create.UID(obj,study.vect,size = 50)
if (length(serie.UID)==0) serie.UID <- create.UID(obj,serie.vect,size =50)
if (length(sop.type)==0) sop.type <- .ascii.to.hex ('ORIGINAL\\PRIMARY', tag.dictionary["(0008,0008)","VR"])
}
if (length(.ascii.to.hex(obj$frame.of.reference, "UI"))==0)
obj$frame.of.reference <- rawToChar(create.UID (obj,c("patient", "ref.pseudo"), size =44))
frame.of.reference <- .ascii.to.hex(obj$frame.of.reference, "UI")
frame.of.reference <- c (unlist (.value.to.raw (length (frame.of.reference), 2, TRUE)),
frame.of.reference)
ref.modality<- sapply(ref.obj.list, function(l) l$modality)
ref.obj.list <- ref.obj.list[ref.modality=="rtstruct"]
L300C0060 <- c()# voir la référence pour chaque plan
if (!is.null(ref.obj.list)){
ref.serie<- do.call(rbind, lapply(ref.obj.list,function(obj_){
if (!is.null(obj_$object.info) & use.original.ref.UIs) return(.ascii.to.hex (obj_$object.info$serie.UID, "UI"))
create.UID(obj_,serie.vect,size =50)}))
f <- !duplicated.array(ref.serie)
ref.obj.list <- ref.obj.list[f]
ref.serie <- ref.serie[f,, drop = FALSE]
SOP.L <- lapply(ref.obj.list, function(obj_) {
if (length(.ascii.to.hex(obj_$frame.of.reference, "UI"))==0)
obj_$frame.of.reference <- rawToChar(create.UID (obj_,c("patient", "ref.pseudo"), size =44))
if (!is.null(obj_$object.info) & use.original.ref.UIs) {
# l1155 <- obj_$object.info$SOP.label
# ncl.f<- cumsum(nchar(l1155))
# ncl.d <- c(1,ncl.f[-length(ncl.f)] -1)
# l1155 <- charToRaw(paste(l1155,collapse=""))
# l1155 <- lapply(1:length(ncl.f), function(i) {
# new.raw <- c(l1155[ncl.d[i]:ncl.f[i]] ,as.raw(0x00)); new.raw[1:(2 * floor(length(new.raw)/2))]})
l1155 <- lapply(obj_$object.info$SOP.label, function(uid) .ascii.to.hex(uid,"UI"))
l1150 <- .ascii.to.hex(obj_$object.info$SOP.ID,"UI")
l1150 <- lapply(l1155,function(i) l1150)
return(list(l1150=l1150,l1155=l1155))
}
return(create.SOPUID(obj_))
})
z.ref <- lapply(ref.obj.list, function(obj_) {
if(obj_$modality!="ct" & obj_$modality!="mr") return(NULL)
t.mat <- ref.cutplane.add(obj_)
(as.matrix(cbind(obj_$xyz0,1)) %*% t(get.rigid.M(t.mat, obj_$ref.pseudo,paste0(obj_$ref.pseudo, "m"))))[,3]
})
ref.SOP_UID.1150 <- lapply(SOP.L, function(l )l$l1150)
ref.SOP_UID.1155 <- lapply(SOP.L, function(l )l$l1155)
ref.SOP_UID.1150 <- lapply(ref.SOP_UID.1150,function(l) lapply(l, function (uid)
c(unlist(.value.to.raw (length(uid),2,TRUE)),uid)))
ref.SOP_UID.1155 <- lapply(ref.SOP_UID.1155,function(l) lapply(l, function (uid)
c(unlist(.value.to.raw (length(uid),2,TRUE)),uid)))
rm(SOP.L)
L3006060loop <- unlist(lapply(1:length(ref.SOP_UID.1150), function(ref.idx)
return(unlist(lapply(1:length(ref.SOP_UID.1150[[ref.idx]]), function(idx){
tot <- c(.tag.to.hex("(0008,1150)"),charToRaw(tag.dictionary["(0008,1150)","VR"]),
ref.SOP_UID.1150[[ref.idx]][[idx]],
.tag.to.hex("(0008,1155)"),charToRaw(tag.dictionary["(0008,1155)","VR"]),
ref.SOP_UID.1155[[ref.idx]][[idx]])
c (as.raw(c(0xfe, 0xff, 0x00, 0xe0)), unlist(.value.to.raw (length(tot),4,TRUE)), tot)}))
)))
L300C0060 <- c(.tag.to.hex("(300C,0060)"), charToRaw(tag.dictionary["(300C,0060)","VR"]), as.raw(c(0x00,0x00)),
unlist(.value.to.raw (length(L3006060loop),4,TRUE)), L3006060loop)
}
SOP <- create.SOPUID(obj)
######################################
fn <- sapply(SOP$l1155, function(uid) rev(unlist(strsplit(rawToChar(uid[uid!=as.raw(0)]),"[.]")))[1])
if (length(file.name)==0){
filen <- file.path(file.dirname, paste0(file.prefix, fn, ".dcm"))
} else {
file.name <- gsub("[.]dcm$","",file.name)
filen <- file.path(file.dirname, paste0(file.name,".dcm"))
}
dn <- unique(dirname(filen))
for (fdn in dn) if (!dir.exists(fdn)) dir.create(fdn,recursive = T)
#######################################
SOP_UID.1150 <- lapply(SOP$l1150,function(uid) c(unlist(.value.to.raw (length(uid),2,TRUE)),uid))
SOP_UID.1155 <- lapply(SOP$l1155,function(uid) c(unlist(.value.to.raw (length(uid),2,TRUE)),uid))
version_name <- paste(c("R ",version$major,".",version$minor,
" espadon ", .espadon.version()),collapse ="")
version_name <- c(charToRaw(version_name),as.raw(0x00))
version_name <- version_name[1:(2*floor(length(version_name)/2))]
transfert_syntax <- c(charToRaw("1.2.840.10008.1.2.1"),as.raw(0x00))
implementation_UID <- c( charToRaw(paste0(.espadon.version(),".",
paste(charToRaw(obj$modality),collapse=""))),as.raw(0x00))
####################################
sop.idx <- 1
####################################
preamble <- as.raw(c(rep(0,128),68,73,67,77))
####################################
tag0002 <- c("(0002,0000)","(0002,0001)" ,"(0002,0002)", "(0002,0003)",
"(0002,0010)", "(0002,0012)", "(0002,0013)")
L0002 <- lapply(tag0002,function(t) c())
names(L0002) <- tag0002
L0002[["(0002,0001)"]] <- c(.tag.to.hex ("(0002,0001)"), charToRaw (tag.dictionary["(0002,0001)","VR"]),
as.raw(c(0x00,0x00,0x02,0x00,0x00,0x00,0x00,0x01)))
L0002[["(0002,0002)"]] <- c(.tag.to.hex ("(0002,0002)"), charToRaw (tag.dictionary["(0002,0002)","VR"]),
SOP_UID.1150[[sop.idx]])
L0002[["(0002,0003)"]] <- c(.tag.to.hex ("(0002,0003)"), charToRaw (tag.dictionary["(0002,0003)","VR"]),
SOP_UID.1155[[sop.idx]])
L0002[["(0002,0010)"]] <- c(.tag.to.hex ("(0002,0010)"), charToRaw (tag.dictionary["(0002,0010)","VR"]),
unlist(.value.to.raw (length(transfert_syntax),2,TRUE)),transfert_syntax)
L0002[["(0002,0012)"]] <- c(.tag.to.hex ("(0002,0012)"), charToRaw (tag.dictionary["(0002,0012)","VR"]),
unlist(.value.to.raw (length(implementation_UID),2,TRUE)),implementation_UID)
L0002[["(0002,0013)"]] <- c(.tag.to.hex ("(0002,0013)"), charToRaw (tag.dictionary["(0002,0013)","VR"]),
unlist(.value.to.raw (length(version_name),2,TRUE)), version_name)
L0002[["(0002,0000)"]] <- c(.tag.to.hex ("(0002,0000)"), charToRaw (tag.dictionary["(0002,0000)","VR"]),
as.raw (c (0x04,0x00)),
unlist (.value.to.raw (length (unlist (L0002[2:7])), 4, T)))
# rawdata <- as.vector(c(preamble, unlist(L0002)))
# dicom.browser(rawdata)
####################################
tag0008 <- c("(0008,0005)", "(0008,0012)", "(0008,0016)", "(0008,0018)", "(0008,0020)",
"(0008,0023)", "(0008,0030)", "(0008,0050)", "(0008,0060)", "(0008,0070)", "(0008,0090)",
"(0008,1030)", "(0008,103E)", "(0008,1070)")
VR0008 <- tag.dictionary[tag0008,"VR"]
L0008 <- lapply(tag0008,function(t) c())
names(L0008) <- tag0008
names(VR0008) <- tag0008
L0008[["(0008,0005)"]] <- c (.tag.to.hex ("(0008,0005)"), charToRaw (tag.dictionary["(0008,0005)","VR"]),
as.raw (c(0x0A,0x00)), charToRaw ("ISO_IR 100"))
if (obj$creation.date!=""){
new.raw <- .ascii.to.hex (obj$creation.date, tag.dictionary["(0008,0012)","VR"])
L0008[["(0008,0012)"]]<- c (.tag.to.hex ("(0008,0012)"), charToRaw (tag.dictionary["(0008,0012)","VR"]),
as.raw (c (0x08,0x00)), new.raw[1:8])
} else {
L0008[["(0008,0012)"]]<- c (.tag.to.hex("(0008,0012)"), charToRaw (tag.dictionary["(0008,0012)","VR"]),
as.raw (c(0x08,0x00)),charToRaw (format (Sys.Date (), "%Y%m%d"))) # devient la date d'assignation de SOP_UID
}
L0008[["(0008,0016)"]] <- c (.tag.to.hex ("(0008,0016)"), charToRaw (tag.dictionary["(0008,0016)","VR"]), SOP_UID.1150[[sop.idx]])
L0008[["(0008,0018)"]] <- c (.tag.to.hex ("(0008,0018)"), charToRaw (tag.dictionary["(0008,0018)","VR"]), SOP_UID.1155[[sop.idx]])
new.raw <- .ascii.to.hex (obj$study.date, tag.dictionary["(0008,0020)","VR"])
m <- match(new.raw[1:8], as.raw(48:57))
L0008[["(0008,0020)"]]<- c (.tag.to.hex ("(0008,0020)"), charToRaw (tag.dictionary["(0008,0020)","VR"]),
as.raw (c (0x08,0x00)), new.raw[1:8])
new.raw <- .ascii.to.hex (trimws (obj$acq.date), VR0008["(0008,0023)"])
L0008[["(0008,0023)"]] <- c (.tag.to.hex ("(0008,0023)"), charToRaw (tag.dictionary["(0008,0023)","VR"]),
unlist (.value.to.raw (length (new.raw), 2, TRUE)), new.raw)
new.raw <- .ascii.to.hex (trimws (obj$study.time), tag.dictionary["(0008,0030)","VR"])
L0008[["(0008,0030)"]] <- c (.tag.to.hex ("(0008,0030)"), charToRaw (tag.dictionary["(0008,0030)","VR"]),
unlist (.value.to.raw (length (new.raw), 2, TRUE)), new.raw)
L0008[["(0008,0050)"]]<- c (.tag.to.hex("(0008,0050)"), charToRaw (tag.dictionary["(0008,0050)","VR"]), as.raw (c (0x00,0x00)))
L0008[["(0008,0060)"]] <- c (.tag.to.hex ("(0008,0060)"), charToRaw (tag.dictionary["(0008,0060)","VR"]),
as.raw (c (0x06,0x00)), charToRaw ("RTDOSE"))
new.raw <- .ascii.to.hex ("R ESPADON MANUFACTURER", tag.dictionary["(0008,0070)","VR"])
L0008[["(0008,0070)"]] <- c (.tag.to.hex ("(0008,0070)"), charToRaw (tag.dictionary["(0008,0070)","VR"]),
unlist (.value.to.raw (length (new.raw), 2, TRUE)), new.raw)
L0008[["(0008,0090)"]] <- c (.tag.to.hex ("(0008,0090)"),charToRaw (tag.dictionary["(0008,0090)","VR"]),
as.raw(c(0x00, 0x00)))
description <- unlist(strsplit(obj$description,"[|]")[[1]])
new.raw <-.ascii.to.hex( iconv(description[1], "ISO-IR-100"), tag.dictionary["(0008,1030)","VR"])
L0008[["(0008,1030)"]]<- c (.tag.to.hex ("(0008,1030)"), charToRaw (tag.dictionary["(0008,1030)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
if(!is.na(description[2])!=0){
new.raw <-.ascii.to.hex( iconv(description[2], "ISO-IR-100"), tag.dictionary["(0008,103E)","VR"])
L0008[["(0008,103E)"]]<- c (.tag.to.hex ("(0008,103E)"), charToRaw (tag.dictionary["(0008,103E)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
}
#
L0008[["(0008,1070)"]]<- c (.tag.to.hex ("(0008,1070)"), charToRaw (tag.dictionary["(0008,1070)","VR"]),
as.raw(c(0x00, 0x00)))
####################################
tag0010 <- c("(0010,0010)","(0010,0020)","(0010,0030)","(0010,0040)")
L0010 <- lapply(tag0010,function(t) c())
names(L0010) <- tag0010
# if(nchar(obj$patient.name)!=0) obj$patient.name <- ""
new.raw <- .ascii.to.hex( iconv(obj$patient.name, "ISO-IR-100"), tag.dictionary["(0010,0010)","VR"])
L0010[["(0010,0010)"]]<- c (.tag.to.hex("(0010,0010)"), charToRaw(tag.dictionary["(0010,0010)","VR"]),
unlist(.value.to.raw (length(new.raw),2,T)),new.raw)
# if(nchar(obj$patient)!=0) obj$patient <- ""
new.raw <-.ascii.to.hex( iconv(obj$patient, "ISO-IR-100"), tag.dictionary["(0010,0020)","VR"])
L0010[["(0010,0020)"]]<- c (.tag.to.hex("(0010,0020)"), charToRaw(tag.dictionary["(0010,0020)","VR"]),
unlist (.value.to.raw (length (new.raw), 2, T)),new.raw)
new.raw <- .ascii.to.hex (trimws(obj$patient.bd), tag.dictionary["(0010,0030)","VR"])
L0010[["(0010,0030)"]]<- c (.tag.to.hex ("(0010,0030)"), charToRaw (tag.dictionary["(0010,0030)","VR"]),
unlist (.value.to.raw (length (new.raw), 2, T)),new.raw)
new.raw <- .ascii.to.hex (trimws(obj$patient.sex), tag.dictionary["(0010,0040)","VR"])
L0010[["(0010,0040)"]]<- c (.tag.to.hex ("(0010,0040)"), charToRaw (tag.dictionary["(0010,0040)","VR"]),
unlist (.value.to.raw (length (new.raw), 2, T)),new.raw)
####################################
tag0018 <- c("(0018,0050)", "(0018,1020)")
L0018 <- lapply(tag0018,function(t) c())
names(L0018) <- tag0018
slice.thickness <- obj$slice.thickness
if (slice.thickness==0) slice.thickness<- c()
new.raw <- .ascii.to.hex (as.character(slice.thickness), tag.dictionary["(0018,0050)","VR"])
new.raw <- .ascii.to.hex (as.character(obj$slice.thickness), tag.dictionary["(0018,0050)","VR"])
L0018[["(0018,0050)"]] <- c(.tag.to.hex("(0018,0050)"), charToRaw(tag.dictionary["(0018,0050)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)),new.raw)
new.raw <- .ascii.to.hex (paste("espadon", .espadon.version()), tag.dictionary["(0018,1020)","VR"])
L0018[["(0018,1020)"]] <- c(.tag.to.hex("(0018,1020)"), charToRaw(tag.dictionary["(0018,1020)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)),new.raw)
####################################
tag0020 <- c("(0020,000D)", "(0020,000E)", "(0020,0010)", "(0020,0011)", "(0020,0013)",
"(0020,0032)", "(0020,0037)", "(0020,0052)", "(0020,1040)")
L0020 <- lapply(tag0020,function(t) c())
names(L0020) <- tag0020
L0020[["(0020,000D)"]] <- c (.tag.to.hex("(0020,000D)"), charToRaw(tag.dictionary["(0020,000D)","VR"]),
unlist(.value.to.raw (length(study.UID), 2, T)), study.UID)
L0020[["(0020,000E)"]] <- c (.tag.to.hex("(0020,000E)"), charToRaw (tag.dictionary["(0020,000E)","VR"]),
unlist(.value.to.raw (length(serie.UID), 2, TRUE)), serie.UID)
L0020[["(0020,0010)"]] <- c(.tag.to.hex("(0020,0010)"), charToRaw(tag.dictionary["(0020,0010)","VR"]),
as.raw(c(0x00, 0x00)))
L0020[["(0020,0011)"]] <- c(.tag.to.hex("(0020,0011)"), charToRaw(tag.dictionary["(0020,0011)","VR"]),
as.raw(c(0x00, 0x00)))
L0020[["(0020,0013)"]] <- c(.tag.to.hex("(0020,0013)"), charToRaw(tag.dictionary["(0020,0013)","VR"]),
as.raw(c(0x00, 0x00)))
new.raw <- .ascii.to.hex (paste(obj$xyz0[sop.idx,], collapse="\\"), tag.dictionary["(0020,0032)","VR"])
L0020[["(0020,0032)"]] <- c(.tag.to.hex("(0020,0032)"), charToRaw(tag.dictionary["(0020,0032)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
new.raw <- .ascii.to.hex (paste(obj$orientation, collapse="\\"), tag.dictionary["(0020,0037)","VR"])
L0020[["(0020,0037)"]] <- c(.tag.to.hex("(0020,0037)"), charToRaw(tag.dictionary["(0020,0037)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
L0020[["(0020,0052)"]] <- c(.tag.to.hex("(0020,0052)"),charToRaw(tag.dictionary["(0020,0052)","VR"]), frame.of.reference)
L0020[["(0020,1040)"]] <- c(.tag.to.hex("(0020,1040)"), charToRaw(tag.dictionary["(0020,1040)","VR"]),
as.raw(c(0x00, 0x00)))
####################################
tag0028 <- c("(0028,0002)", "(0028,0004)", "(0028,0008)","(0028,0009)", "(0028,0010)", "(0028,0011)","(0028,0030)",
"(0028,0100)", "(0028,0101)", "(0028,0102)","(0028,0103)", "(0028,0106)",
"(0028,0107)")#, "(0028,0120)")
L0028 <- lapply(tag0028,function(t) c())
names(L0028) <- tag0028
new.raw <-as.raw(c(1,0))
L0028[["(0028,0002)"]] <- c(.tag.to.hex("(0028,0002)"), charToRaw(tag.dictionary["(0028,0002)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
new.raw <- .ascii.to.hex ("MONOCHROME2", tag.dictionary["(0028,0004)","VR"])
L0028[["(0028,0004)"]] <- c(.tag.to.hex("(0028,0004)"), charToRaw(tag.dictionary["(0028,0004)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
new.raw <- .ascii.to.hex (as.character(obj$n.ijk[3]), tag.dictionary["(0028,0008)","VR"])
L0028[["(0028,0008)"]] <- c(.tag.to.hex("(0028,0008)"), charToRaw(tag.dictionary["(0028,0008)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
new.raw <- .tag.to.hex("(3004,000C)")
L0028[["(0028,0009)"]] <- c(.tag.to.hex("(0028,0009)"), charToRaw(tag.dictionary["(0028,0009)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
new.raw <- c(as.raw(obj$n.ijk[2]%%256) ,as.raw((obj$n.ijk[2]/256)%%256))
L0028[["(0028,0010)"]] <- c(.tag.to.hex("(0028,0010)"), charToRaw(tag.dictionary["(0028,0010)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
new.raw <- c(as.raw(obj$n.ijk[1]%%256) ,as.raw((obj$n.ijk[1]/256)%%256))
L0028[["(0028,0011)"]] <- c(.tag.to.hex("(0028,0011)"), charToRaw(tag.dictionary["(0028,0011)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
new.raw <- .ascii.to.hex (paste(obj$dxyz[1:2], collapse="\\"), tag.dictionary["(0028,0030)","VR"])
L0028[["(0028,0030)"]] <- c(.tag.to.hex("(0028,0030)"), charToRaw(tag.dictionary["(0028,0030)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
new.raw <-as.raw(c(16,0))
L0028[["(0028,0100)"]] <- c(.tag.to.hex("(0028,0100)"), charToRaw(tag.dictionary["(0028,0100)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
L0028[["(0028,0101)"]] <- c(.tag.to.hex("(0028,0101)"), charToRaw(tag.dictionary["(0028,0101)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
new.raw <- as.raw(c(15,0))
L0028[["(0028,0102)"]] <- c(.tag.to.hex("(0028,0102)"), charToRaw(tag.dictionary["(0028,0102)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
new.raw <- as.raw(c(0,0))
if (obj$min.pixel<0) new.raw <- as.raw(c(1,0))
L0028[["(0028,0103)"]] <- c(.tag.to.hex("(0028,0103)"), charToRaw(tag.dictionary["(0028,0103)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
#codage de 0.1mGy
vol3D <- as.vector(round(obj$vol3D.data,6))
slope <- NA
if (length(vol3D)!=0){
f <- is.na(vol3D)
if (all(f)){
warning(c("obj$vol3D.data contains only NA values. This data will not be exported."))
vol3D <- NULL
} else {
if (any(f)) {
if (is.null(NAvalue)){
NAvalue <- 0
warning(c("obj$vol3D.data contains NA values. This data will be replaced by the value 0. ",
"If you wish to change this value, add the argument NAvalue=your_NA_value."))
}
vol3D[f] <- NAvalue
}
slope <- sort(diff(sort(unique(vol3D))))[1]
obj.max.pixel <- max(vol3D, na.rm =TRUE)
obj.min.pixel <- min(vol3D, na.rm =TRUE)
max.pixel <- round(obj.max.pixel/slope)
min.pixel <- round(obj.min.pixel/slope)
while((abs(max.pixel) > 2^15) | (abs(min.pixel) > 2^15)){
slope <- slope*2
max.pixel <- round(obj.max.pixel/slope)
min.pixel <- round(obj.min.pixel/slope)
}
new.raw <- c(as.raw(min.pixel%%256) ,as.raw((min.pixel/256)%%256))
L0028[["(0028,0106)"]] <- c(.tag.to.hex("(0028,0106)"), charToRaw("US"),
as.raw(c(0x02,00)), new.raw)
new.raw <- c(as.raw(max.pixel%%256) ,as.raw((max.pixel/256)%%256))
L0028[["(0028,0107)"]] <- c(.tag.to.hex("(0028,0107)"), charToRaw("US"),
as.raw(c(0x02,00)), new.raw)
vol3D <- vol3D/slope
vol3D <- as.vector(rbind(as.raw(vol3D%%256) ,as.raw((vol3D/256)%%256)))
}
} else {
warning(c("There is no obj$vol3D.data in ", obj$object.alias,"."))
}
####################################
tag3004 <- c("(3004,0002)", "(3004,0004)", "(3004,000A)", "(3004,000C)","(3004,000E)")
L3004 <- lapply(tag3004,function(t) c())
names(L3004) <- tag3004
new.raw <- .ascii.to.hex (toupper(obj$unit), tag.dictionary["(3004,0002)","VR"])
L3004[["(3004,0002)"]] <- c(.tag.to.hex("(3004,0002)"), charToRaw(tag.dictionary["(3004,0002)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
if (is.null(obj$rtdose.info)){
if (obj$min.pixel<0) {
type.raw <- .ascii.to.hex ("ERROR", tag.dictionary["(3004,0004)","VR"])
} else {
type.raw <- .ascii.to.hex ("PHYSICAL", tag.dictionary["(3004,0004)","VR"])}
summation.raw <- .ascii.to.hex ("PLAN", tag.dictionary["(3004,000A)","VR"])
} else {
type.raw <- .ascii.to.hex (obj$rtdose.info$type, tag.dictionary["(3004,0004)","VR"])
summation.raw <- .ascii.to.hex (obj$rtdose.info$Dose.Summation.Type, tag.dictionary["(3004,000A)","VR"])
}
L3004[["(3004,0004)"]] <- c(.tag.to.hex("(3004,0004)"), charToRaw(tag.dictionary["(3004,0004)","VR"]),
unlist(.value.to.raw (length(type.raw),2,TRUE)), type.raw)
L3004[["(3004,000A)"]] <- c(.tag.to.hex("(3004,000A)"), charToRaw(tag.dictionary["(3004,000A)","VR"]),
unlist(.value.to.raw (length(summation.raw),2,TRUE)), summation.raw)
new.raw <- .ascii.to.hex (paste(obj$k.idx * obj$dxyz[3], collapse="\\"), tag.dictionary["(3004,000C)","VR"])
L3004[["(3004,000C)"]] <- c(.tag.to.hex("(3004,000C)"), charToRaw(tag.dictionary["(3004,000C)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
if (length(vol3D)!=0){
new.raw <- .ascii.to.hex (paste(slope, collapse="\\"), tag.dictionary["(3004,000E)","VR"])
L3004[["(3004,000E)"]] <- c(.tag.to.hex("(3004,000E)"), charToRaw(tag.dictionary["(3004,000E)","VR"]),
unlist(.value.to.raw (length(new.raw),2,TRUE)), new.raw)
L7FE00010 <- c(.tag.to.hex("(7FE0,0010)"),charToRaw("OW"), as.raw(c(0,0)),
unlist(.value.to.raw (length(vol3D),4,TRUE)),vol3D)
}
####################################
rawdata <- c(preamble,unlist(L0002),unlist(L0008),unlist(L0010),unlist(L0018),
unlist(L0020),unlist(L0028), unlist(L3004),L300C0060,L7FE00010)
zz <- file (filen, "wb")
writeBin (rawdata, zz, size = 1)
close (zz)
message ("file created : ", basename(filen))
}
################################################################################
.tag.to.hex <- function(tag, Low_Order_First=TRUE){
hexcode =c("0","1","2","3","4","5","6","7","8","9","A","B","C","D","E","F")
rtag <- match(unlist(strsplit(tag,""))[c(2:5,7:10)],hexcode)-1
if (Low_Order_First) return(as.raw(c(16*rtag[3] + rtag[4], 16*rtag[1] + rtag[2],
16*rtag[7] + rtag[8], 16*rtag[5] + rtag[6])))
return(as.raw(c(16*rtag[1] + rtag[2], 16*rtag[3] + rtag[4],
16*rtag[5] + rtag[6], 16*rtag[7] + rtag[8])))
}
#' @importFrom sodium hash
.ascii.to.hex <- function(str,VR){
if (length(str)==0) return(raw(0))
if (is.na(str)) return(raw(0))
if (nchar(str)==0) return(raw(0))
switch(VR,
"AE" = {
new.raw <- c(charToRaw (trimws(str)),as.raw(0x20))
new.raw <- new.raw[1:(2 * floor(length(new.raw)/2))]
m <- !is.na(match(new.raw, as.raw(c(0x0a, 0x0c, 0x0d, 0x1b, 0x5c))))
if (length(new.raw)>16 | any(m)) new.raw <- raw(0)
},
"AS" = {
new.raw <- c(charToRaw (trimws(str)),as.raw(0x20))
new.raw <- new.raw[1:(2 * floor(length(new.raw)/2))]
if (length(new.raw)!=4 | any(is.na(m)) | !(new.raw[4] %in% charToRaw ("DWMY"))) new.raw <- raw(0)
},
"CS" = {
new.raw <- c(charToRaw (trimws(str)),as.raw(0x20))
new.raw <- new.raw[1:(2 * floor(length(new.raw)/2))]
m <- match(new.raw, as.raw(c(65:90,48:57,92,95,32)))
# if (length(new.raw)>16 | any(is.na(m))) new.raw <- raw(0)
if (any(is.na(m))) new.raw <- raw(0)
},
"DA" = {
new.raw <- charToRaw (str)
m <- match(new.raw[1:8], as.raw(48:57))
if (length(new.raw)!=8 | any(is.na(m))) new.raw <- raw(0)
},
"DS" = {
new.raw <- charToRaw (str)
m <- match(new.raw,as.raw(0x20))
new.raw <- c(new.raw[is.na(m)],as.raw(0x20))
new.raw <- new.raw[1:(2 * floor(length(new.raw)/2))]
m <- match(new.raw, charToRaw("0123456789+-Ee. \\"))
if (any(is.na(m))) new.raw <- raw(0)
},
"DT" = {
new.raw <- c(charToRaw (trimws(str)),as.raw(0x20))
new.raw <- new.raw[1:(2 * floor(length(new.raw)/2))]
m <- match(new.raw, charToRaw("0123456789+-. "))
if (length(new.raw)>26 | any(is.na(m))) new.raw <- raw(0)
},
"IS" = {
mem <-unlist(strsplit(str,"[\\]"))
mem <- suppressWarnings(as.numeric(mem))
if (any(is.na(mem))){
new.raw <- raw(0)
} else if (any(mem < -2^31) | any(mem > +2^31 - 1 )){
new.raw <- raw(0)
} else {
new.raw <- charToRaw (str)
m <- match(new.raw,as.raw(0x20))
new.raw <- c(new.raw[is.na(m)],as.raw(0x20))
new.raw <- new.raw[1:(2 * floor(length(new.raw)/2))]
m <- match(new.raw, charToRaw("\\0123456789+- "))
if (length(new.raw)>12 | any(is.na(m))) new.raw <- raw(0)
}
},
"LO" = {
new.raw <- c(charToRaw (trimws(str, which="right")),as.raw(0x20))
new.raw <- new.raw[1:(2 * floor(length(new.raw)/2))]
m <- !is.na(match(new.raw,as.raw(c(0:26,28:31,92))))
if (length(new.raw)>64 | any(m)) new.raw <- raw(0)
},
"LT" = {
new.raw <- c(charToRaw (trimws(str, which="right")),as.raw(0x20))
new.raw <- new.raw[1:(2 * floor(length(new.raw)/2))]
m <- !is.na(match(new.raw,as.raw(c(0:9,11,14:26,28:31))))
if (length(new.raw)>64 | any(m)) new.raw <- raw(0)
},
"PN" = {
new.raw <- c(charToRaw (trimws(str)),as.raw(0x20))
new.raw <- new.raw[1:(2 * floor(length(new.raw)/2))]
str_ <- rawToChar(new.raw)
le <- 0
if (nchar(str_)>0) le <- max(nchar(unlist(strsplit(str_,"^", fixed=TRUE))))
m <- !is.na(match(new.raw, as.raw(c(10, 12, 13, 92))))
if (le>64 | any(m)) new.raw <- raw(0)
},
"SH" = {
new.raw <- c(charToRaw (trimws(str)),as.raw(0x20))
new.raw <- new.raw[1:(2 * floor(length(new.raw)/2))]
m <- !is.na(match(new.raw, as.raw(c(0:26,28:31,92))))
if (length(new.raw)>16 | any(m)) new.raw <- raw(0)
},
"ST" = {
new.raw <- c(charToRaw (trimws(str, which="right")),as.raw(0x20))
new.raw <- new.raw[1:(2 * floor(length(new.raw)/2))]
m <- !is.na(match(new.raw,as.raw(c(0:9,11,14:26,28:31))))
if (length(new.raw)>1024 | any(m)) new.raw <- raw(0)
},
"TM" = {
new.raw <- c(charToRaw (trimws(str)),as.raw(0x20))
new.raw <- new.raw[1:(2 * floor(length(new.raw)/2))]
m <- match(new.raw, charToRaw("0123456789. "))
if (length(new.raw)>16 | any(is.na(m))) new.raw <- raw(0)
},
"UI" = {
new.raw <- c(charToRaw (trimws(str)),as.raw(0x00))
new.raw <- new.raw[1:(2 * floor(length(new.raw)/2))]
m <- match(new.raw, as.raw(c(0,46,48:57)))
if (length(new.raw)>64 | any(is.na(m))) new.raw <- raw(0)
},
"UN" = {
new.raw <- c(charToRaw (trimws(str, which="right")),as.raw(0x20))
new.raw <- new.raw[1:(2 * floor(length(new.raw)/2))]
},
"UT"= {
new.raw <- c(charToRaw (trimws(str, which="right")),as.raw(0x20))
new.raw <- new.raw[1:(2 * floor(length(new.raw)/2))]
m <- !is.na(match(new.raw,as.raw(c(0:9,11,14:26,28:31))))
if (length(new.raw)>2^32-2 | any(m))new.raw <- raw(0)
})
if (length(new.raw)==0) warning(str," is not compliant with ", VR," DICOM representation" )
return(new.raw)
}
get.obj.from.alias <- function (obj.alias, patient){
if (is.null(obj.alias)) return(list())
obj.alias <- obj.alias[obj.alias!=""]
if (length(obj.alias)==0) return(list())
start.idx <- which(names(patient)=="T.MAT") + 1
end.idx <- length(patient)
n <-names(patient)
tab <- do.call(rbind,lapply(start.idx:end.idx, function(idx)
data.frame(alias = names(patient[[idx]]), modality = n[idx])))
L <-lapply(obj.alias, function(n){
f <- tab$alias==n
if (any(f)) return(patient[[tab$modality[f]]][[n]])
return(NULL)
})
names(L) <- obj.alias
L
}
create.SOPUID <- function(obj,size=64){
obj$ref.object.alias <- NULL
obj$object.info <- NULL
obj$ref.object.info <- NULL
if (!(is(obj,"volume") | is(obj,"struct"))) return(NULL)
if (!(obj$modality %in% c("ct","mr","rtdose","rtstruct"))) return(NULL)
obj$ref.object.info <- NULL
obj$object.info <- NULL
le.esp <- nchar(.espadon.UID()) + 1
espadon.UID <- charToRaw(paste0(.espadon.UID(),"."))
nb_cut <- 1
nc_nbcut <- 0
raw.mat <- NULL
if (obj$modality %in% c("ct","mr")) {
nb_cut <- max(obj$k.idx)
nc_nbcut <- nchar(as.character(nb_cut))
prefix <- rawToChar(rep(as.raw(0x30),nc_nbcut-1))
nb.str <- paste0(prefix,obj$k.idx)
le.vect <- cumsum(nchar(nb.str))
raw.mat <- charToRaw(paste(nb.str,collapse=""))
raw.mat <- do.call(cbind,lapply(nc_nbcut:1, function(i) raw.mat[le.vect-i+1]))
nb_cut <- nrow(raw.mat)
}
UID.base <- matrix(create.UID(obj, size = size-nc_nbcut),nrow=1, byrow = TRUE)
l1155 <- cbind( UID.base [rep(1,nb_cut),,drop=FALSE], raw.mat, as.raw(0))
l1155 <- l1155[,1:(floor(ncol(l1155)/2)*2), drop=FALSE]
l1155 <- lapply(1:nrow(l1155),function(i) l1155[i,])
l1150 <- switch (obj$modality,
"ct"= "1.2.840.10008.5.1.4.1.1.2",
"mr"= "1.2.840.10008.5.1.4.1.1.4",
"rtdose" = "1.2.840.10008.5.1.4.1.1.481.2",
"rtstruct" = "1.2.840.10008.5.1.4.1.1.481.3")
# l1150 <- matrix(rep(.ascii.to.hex(l1150,"UI") ,nb_cut), nrow= nb_cut, byrow = TRUE)
l1150 <- .ascii.to.hex(l1150,"UI")
l1150 <- lapply(l1155, function(l)l1150)
return(list(l1150=l1150,l1155=l1155))
}
create.UID <- function(obj, el.name=NULL,supp.info.l=NULL, size=64){ #>44
obj$ref.object.alias <- NULL
obj$object.info <- NULL
obj$ref.object.info <- NULL
if (is.null(el.name)){
UID <- qserialize(list(obj,supp.info.l))
}else {
UID <- qserialize(list(obj[el.name],supp.info.l))
}
le.esp <- nchar(.espadon.UID()) + 1
espadon.UID <- charToRaw(paste0(.espadon.UID(),"."))
UID <- paste(.espadon.UID(),
paste(as.numeric(hash(UID, key = NULL, size = max(size,16+le.esp)-le.esp)) %% 10,
collapse=""), sep=".")
new.raw <- c(charToRaw (UID),as.raw(0x00))
new.raw <- new.raw[1:(2 * floor(length(new.raw)/2))]
return(new.raw)
}
get.obj.from.alias <- function (obj.alias, patient){
if (is.null(obj.alias)) return(list())
obj.alias <- obj.alias[obj.alias!=""]
if (length(obj.alias)==0) return(list())
start.idx <- which(names(patient)=="T.MAT") + 1
end.idx <- length(patient)
n <-names(patient)
tab <- do.call(rbind,lapply(start.idx:end.idx, function(idx)
data.frame(alias = names(patient[[idx]]), modality = n[idx])))
L <-lapply(obj.alias, function(n){
f <- tab$alias==n
if (any(f)) return(patient[[tab$modality[f]]][[n]])
return(NULL)
})
names(L) <- obj.alias
L
}
Try the espadon package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.