MAGDRAHL ;WOIFO/PMK,SAF - Program to read a DICOM file ; 13 Feb 2013 11:17 AM
;;3.0;IMAGING;**49,123,138**;Mar 19, 2002;Build 5380;Sep 03, 2013
;; Per VHA Directive 2004-038, this routine should not be modified.
;; +---------------------------------------------------------------+
;; | Property of the US Government. |
;; | No permission to copy or redistribute this software is given. |
;; | Use of unreleased versions of this software requires the user |
;; | to execute a written test agreement with the VistA Imaging |
;; | Development Office of the Department of Veterans Affairs, |
;; | telephone (301) 734-0100. |
;; | The Food and Drug Administration classifies this software as |
;; | a medical device. As such, it may not be changed in any way. |
;; | Modifications to this software may result in an adulterated |
;; | medical device under 21CFR820, the use of which is considered |
;; | to be a violation of US Federal Statutes. |
;; +---------------------------------------------------------------+
;;
; This routine is invoked by RAHLR to create the HL7 ZDS segment with
; the Study Instance UID
;
; The following code creates a DICOM Study Instance UID from three
; Radiology Package variables: RADTI, RACNI, and ACNUMB
; Input:
; RADTI -- internal subscript for the study in RADPT - reverse date/time
; RACNI -- internal subscript for the study in RADPT - counter
; ACNUMB - external identifier for the study - [site number -] date-case number
;
STUDYUID(RADTI,RACNI,ACNUMB) ; return the Study Instance UID
N FLAG ;----- Flag to prevent multiple dots in a row or leading zeroes
N I ;-------- Loop counter
N RAW ;----- "Raw" STUDYUID
N STUDYUID ;- Resulting unique identifier
;
S RAW=^MAGD(2006.15,1,"UID ROOT")_".1.4."_$$STATNUMB^MAGDFCNV()_"."_RADTI_"."_RACNI_"."_ACNUMB
S STUDYUID="",FLAG=0 F I=1:1:$L(RAW) D
. N E
. S E=$E(RAW,I) S:E'?1AN E="."
. I "123456789"[E S STUDYUID=STUDYUID_E,FLAG=1 Q
. I E="0" S:$E(RAW,I+1)'?1AN FLAG=1 S:FLAG STUDYUID=STUDYUID_E Q
. I E?1U S STUDYUID=STUDYUID_($A(E)),FLAG=1 Q
. I E?1L S STUDYUID=STUDYUID_($A(E)-32),FLAG=1 Q
. I E="." S:FLAG STUDYUID=STUDYUID_E S FLAG=0 Q
. Q
; No trailing dots either
F Q:$E(STUDYUID,$L(STUDYUID))'="." S STUDYUID=$E(STUDYUID,1,$L(STUDYUID)-1)
I $L(STUDYUID)>64 S $EC=",U13-STUDY UID too long,"
Q STUDYUID
;
ZDS(STUDYUID) ; returns the ZDS segment
N HLECH1 ;--- HL7 component separator
S HLECH1=$E(HLECH) ; HL7 component separator
I $L(STUDYUID)>64 S $EC=",U13-STUDY UID too long,"
Q "ZDS"_HLFS_STUDYUID_HLECH1_"VISTA"_HLECH1_"Application"_HLECH1_"DICOM"
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDRAHL 2751 printed Oct 16, 2024@18:02 Page 2
MAGDRAHL ;WOIFO/PMK,SAF - Program to read a DICOM file ; 13 Feb 2013 11:17 AM
+1 ;;3.0;IMAGING;**49,123,138**;Mar 19, 2002;Build 5380;Sep 03, 2013
+2 ;; Per VHA Directive 2004-038, this routine should not be modified.
+3 ;; +---------------------------------------------------------------+
+4 ;; | Property of the US Government. |
+5 ;; | No permission to copy or redistribute this software is given. |
+6 ;; | Use of unreleased versions of this software requires the user |
+7 ;; | to execute a written test agreement with the VistA Imaging |
+8 ;; | Development Office of the Department of Veterans Affairs, |
+9 ;; | telephone (301) 734-0100. |
+10 ;; | The Food and Drug Administration classifies this software as |
+11 ;; | a medical device. As such, it may not be changed in any way. |
+12 ;; | Modifications to this software may result in an adulterated |
+13 ;; | medical device under 21CFR820, the use of which is considered |
+14 ;; | to be a violation of US Federal Statutes. |
+15 ;; +---------------------------------------------------------------+
+16 ;;
+17 ; This routine is invoked by RAHLR to create the HL7 ZDS segment with
+18 ; the Study Instance UID
+19 ;
+20 ; The following code creates a DICOM Study Instance UID from three
+21 ; Radiology Package variables: RADTI, RACNI, and ACNUMB
+22 ; Input:
+23 ; RADTI -- internal subscript for the study in RADPT - reverse date/time
+24 ; RACNI -- internal subscript for the study in RADPT - counter
+25 ; ACNUMB - external identifier for the study - [site number -] date-case number
+26 ;
STUDYUID(RADTI,RACNI,ACNUMB) ; return the Study Instance UID
+1 ;----- Flag to prevent multiple dots in a row or leading zeroes
NEW FLAG
+2 ;-------- Loop counter
NEW I
+3 ;----- "Raw" STUDYUID
NEW RAW
+4 ;- Resulting unique identifier
NEW STUDYUID
+5 ;
+6 SET RAW=^MAGD(2006.15,1,"UID ROOT")_".1.4."_$$STATNUMB^MAGDFCNV()_"."_RADTI_"."_RACNI_"."_ACNUMB
+7 SET STUDYUID=""
SET FLAG=0
FOR I=1:1:$LENGTH(RAW)
Begin DoDot:1
+8 NEW E
+9 SET E=$EXTRACT(RAW,I)
if E'?1AN
SET E="."
+10 IF "123456789"[E
SET STUDYUID=STUDYUID_E
SET FLAG=1
QUIT
+11 IF E="0"
if $EXTRACT(RAW,I+1)'?1AN
SET FLAG=1
if FLAG
SET STUDYUID=STUDYUID_E
QUIT
+12 IF E?1U
SET STUDYUID=STUDYUID_($ASCII(E))
SET FLAG=1
QUIT
+13 IF E?1L
SET STUDYUID=STUDYUID_($ASCII(E)-32)
SET FLAG=1
QUIT
+14 IF E="."
if FLAG
SET STUDYUID=STUDYUID_E
SET FLAG=0
QUIT
+15 QUIT
End DoDot:1
+16 ; No trailing dots either
+17 FOR
if $EXTRACT(STUDYUID,$LENGTH(STUDYUID))'="."
QUIT
SET STUDYUID=$EXTRACT(STUDYUID,1,$LENGTH(STUDYUID)-1)
+18 IF $LENGTH(STUDYUID)>64
SET $ECODE=",U13-STUDY UID too long,"
+19 QUIT STUDYUID
+20 ;
ZDS(STUDYUID) ; returns the ZDS segment
+1 ;--- HL7 component separator
NEW HLECH1
+2 ; HL7 component separator
SET HLECH1=$EXTRACT(HLECH)
+3 IF $LENGTH(STUDYUID)>64
SET $ECODE=",U13-STUDY UID too long,"
+4 QUIT "ZDS"_HLFS_STUDYUID_HLECH1_"VISTA"_HLECH1_"Application"_HLECH1_"DICOM"
