MAGNUID1 ;WOIFO/NST - DICOM UID generator ; 15 Oct 2010 12:45 AM
;;3.0;IMAGING;**106**;Mar 19, 2002;Build 2002;Feb 28, 2011
;; 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. |
;; +---------------------------------------------------------------+
;;
Q
;
;***** Generates a new DICOM UID
;
; RPC: N/A
;
; Input Parameters
; ================
; SITE - VistA Station Number field #99 in INSTITUTION file (#4)
; SUBROOT - (Optional) A number, Default value is 0.
; (e.g. 106, 4, 7, 8, or 106.4
; 4 - STUDY UID,
; 7 - SERIES UID,
; 8 - SOP INSTANCE UID,
; 106.4 - patch 106 STUDY UID.
; ROOTOWNER - (Optional) Name of the DICOM root owner.
; Default value is "Veterans' Administration".
;
; Return Values
; =============
; if error MAGRY = 0^Error message
; if success MAGRY = 1^New DICOM UID
;
NEWUID(MAGRY,SITE,SUBROOT,ROOTOWNER) ; Generates a new DICOM UID
N ROOT,DTSTAMP,UNISITE,LASTCNT,CNT
N ROOTIEN,UID,LASTUPDATE,X
N MAGRESA,MAGNFDA,MAGNXE
;
I SITE="" S MAGRY="0^Station number is blank" Q ; fatal error
S:$G(SUBROOT)="" SUBROOT=0
S:$G(ROOTOWNER)="" ROOTOWNER="Veterans' Administration" ; VA is a default root owner
S ROOTIEN=$$FIND1^DIC(2006.15,"","BX",ROOTOWNER)
I ROOTIEN'>0 S MAGRY="0^Root UID is not found" Q ; fatal error
;
S ROOT=$P($G(^MAGD(2006.15,ROOTIEN,"UID ROOT")),"^",1)
I ROOT="" S MAGRY="0^DICOM root is missing." Q
S DTSTAMP=$$DATETIME()
S UNISITE=$$CONVS2N(SITE)
I UNISITE'>0 S MAGRY="0^Cannot convert SITE NUMBER to numeric value" Q
L +^MAGD(2006.15,ROOTIEN,1):1E9 ; Lock
S X=$G(^MAGD(2006.15,ROOTIEN,1))
S LASTUPDATE=$P(X,"^",1)
S LASTCNT=$P(X,"^",2)
;
S CNT=LASTCNT+1 ; Increment the TICK
I (LASTUPDATE\1)'=(DTSTAMP\1) S CNT=1 ; Reset the TICK. New day - new beginning
;
I (LASTUPDATE=DTSTAMP),(LASTCNT'<CNT) D Q
. S MAGRY="0^Last UID tick is greater than the new one"
. L -^MAGD(2006.15,ROOTIEN,1) ; Unlock
. Q
I LASTUPDATE>DTSTAMP D Q
. S MAGRY="0^Last UID datetime stamp is greater than the new one"
. L -^MAGD(2006.15,ROOTIEN,1) ; Unlock
. Q
;
K MAGNFDA
S MAGNFDA(2006.15,ROOTIEN_",",2)=DTSTAMP
S MAGNFDA(2006.15,ROOTIEN_",",3)=CNT
D UPDATE^DIE("","MAGNFDA","","MAGNXE")
L -^MAGD(2006.15,ROOTIEN,1) ; Unlock
;
I $D(MAGNXE("DIERR","E")) D Q
. D MSG^DIALOG("A",.MAGRESA,245,5,"MAGNXE")
. S MAGRY="0^"_MAGRESA(1)
. Q
;
S UID=ROOT_"."_SUBROOT_"."_UNISITE_"."_DTSTAMP_"."_CNT
I $L(UID)>64 S MAGRY="0^Generated UID is greater than 64 characters" Q
S MAGRY="1^"_UID
Q
;
DATETIME() ; Get Date time
Q $$NOW^XLFDT
;
CONVS2N(STRTOCNV) ; Convert a string to a unique number
; The string should include characters from "0" to "Z"
; If other character is found -1 will be return
; Before the conversion all characters are converted to upper case
N I,X,RESULT,FACTOR,ERR
S ERR=0
S RESULT=""
S FACTOR=1
S STRTOCNV=$$UP^XLFSTR(STRTOCNV) ; All upper case
; Start with the last character
F I=$L(STRTOCNV):-1:1 D Q:ERR
. S X=$A($E(STRTOCNV,I))-48 ; offset the ASCII number with 48. "0" is 0, "Z" is 42
. I (X<0)!(X>42) S ERR=1 Q
. S RESULT=RESULT+(FACTOR*X)
. S FACTOR=FACTOR*43 ; 43 is the number of characters between "0" and "Z"
. Q
Q:ERR -1 ; a character is not in the "0"-"Z" range
Q RESULT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGNUID1 4416 printed Sep 23, 2025@19:43:47 Page 2
MAGNUID1 ;WOIFO/NST - DICOM UID generator ; 15 Oct 2010 12:45 AM
+1 ;;3.0;IMAGING;**106**;Mar 19, 2002;Build 2002;Feb 28, 2011
+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 QUIT
+18 ;
+19 ;***** Generates a new DICOM UID
+20 ;
+21 ; RPC: N/A
+22 ;
+23 ; Input Parameters
+24 ; ================
+25 ; SITE - VistA Station Number field #99 in INSTITUTION file (#4)
+26 ; SUBROOT - (Optional) A number, Default value is 0.
+27 ; (e.g. 106, 4, 7, 8, or 106.4
+28 ; 4 - STUDY UID,
+29 ; 7 - SERIES UID,
+30 ; 8 - SOP INSTANCE UID,
+31 ; 106.4 - patch 106 STUDY UID.
+32 ; ROOTOWNER - (Optional) Name of the DICOM root owner.
+33 ; Default value is "Veterans' Administration".
+34 ;
+35 ; Return Values
+36 ; =============
+37 ; if error MAGRY = 0^Error message
+38 ; if success MAGRY = 1^New DICOM UID
+39 ;
NEWUID(MAGRY,SITE,SUBROOT,ROOTOWNER) ; Generates a new DICOM UID
+1 NEW ROOT,DTSTAMP,UNISITE,LASTCNT,CNT
+2 NEW ROOTIEN,UID,LASTUPDATE,X
+3 NEW MAGRESA,MAGNFDA,MAGNXE
+4 ;
+5 ; fatal error
IF SITE=""
SET MAGRY="0^Station number is blank"
QUIT
+6 if $GET(SUBROOT)=""
SET SUBROOT=0
+7 ; VA is a default root owner
if $GET(ROOTOWNER)=""
SET ROOTOWNER="Veterans' Administration"
+8 SET ROOTIEN=$$FIND1^DIC(2006.15,"","BX",ROOTOWNER)
+9 ; fatal error
IF ROOTIEN'>0
SET MAGRY="0^Root UID is not found"
QUIT
+10 ;
+11 SET ROOT=$PIECE($GET(^MAGD(2006.15,ROOTIEN,"UID ROOT")),"^",1)
+12 IF ROOT=""
SET MAGRY="0^DICOM root is missing."
QUIT
+13 SET DTSTAMP=$$DATETIME()
+14 SET UNISITE=$$CONVS2N(SITE)
+15 IF UNISITE'>0
SET MAGRY="0^Cannot convert SITE NUMBER to numeric value"
QUIT
+16 ; Lock
LOCK +^MAGD(2006.15,ROOTIEN,1):1E9
+17 SET X=$GET(^MAGD(2006.15,ROOTIEN,1))
+18 SET LASTUPDATE=$PIECE(X,"^",1)
+19 SET LASTCNT=$PIECE(X,"^",2)
+20 ;
+21 ; Increment the TICK
SET CNT=LASTCNT+1
+22 ; Reset the TICK. New day - new beginning
IF (LASTUPDATE\1)'=(DTSTAMP\1)
SET CNT=1
+23 ;
+24 IF (LASTUPDATE=DTSTAMP)
IF (LASTCNT'<CNT)
Begin DoDot:1
+25 SET MAGRY="0^Last UID tick is greater than the new one"
+26 ; Unlock
LOCK -^MAGD(2006.15,ROOTIEN,1)
+27 QUIT
End DoDot:1
QUIT
+28 IF LASTUPDATE>DTSTAMP
Begin DoDot:1
+29 SET MAGRY="0^Last UID datetime stamp is greater than the new one"
+30 ; Unlock
LOCK -^MAGD(2006.15,ROOTIEN,1)
+31 QUIT
End DoDot:1
QUIT
+32 ;
+33 KILL MAGNFDA
+34 SET MAGNFDA(2006.15,ROOTIEN_",",2)=DTSTAMP
+35 SET MAGNFDA(2006.15,ROOTIEN_",",3)=CNT
+36 DO UPDATE^DIE("","MAGNFDA","","MAGNXE")
+37 ; Unlock
LOCK -^MAGD(2006.15,ROOTIEN,1)
+38 ;
+39 IF $DATA(MAGNXE("DIERR","E"))
Begin DoDot:1
+40 DO MSG^DIALOG("A",.MAGRESA,245,5,"MAGNXE")
+41 SET MAGRY="0^"_MAGRESA(1)
+42 QUIT
End DoDot:1
QUIT
+43 ;
+44 SET UID=ROOT_"."_SUBROOT_"."_UNISITE_"."_DTSTAMP_"."_CNT
+45 IF $LENGTH(UID)>64
SET MAGRY="0^Generated UID is greater than 64 characters"
QUIT
+46 SET MAGRY="1^"_UID
+47 QUIT
+48 ;
DATETIME() ; Get Date time
+1 QUIT $$NOW^XLFDT
+2 ;
CONVS2N(STRTOCNV) ; Convert a string to a unique number
+1 ; The string should include characters from "0" to "Z"
+2 ; If other character is found -1 will be return
+3 ; Before the conversion all characters are converted to upper case
+4 NEW I,X,RESULT,FACTOR,ERR
+5 SET ERR=0
+6 SET RESULT=""
+7 SET FACTOR=1
+8 ; All upper case
SET STRTOCNV=$$UP^XLFSTR(STRTOCNV)
+9 ; Start with the last character
+10 FOR I=$LENGTH(STRTOCNV):-1:1
Begin DoDot:1
+11 ; offset the ASCII number with 48. "0" is 0, "Z" is 42
SET X=$ASCII($EXTRACT(STRTOCNV,I))-48
+12 IF (X<0)!(X>42)
SET ERR=1
QUIT
+13 SET RESULT=RESULT+(FACTOR*X)
+14 ; 43 is the number of characters between "0" and "Z"
SET FACTOR=FACTOR*43
+15 QUIT
End DoDot:1
if ERR
QUIT
+16 ; a character is not in the "0"-"Z" range
if ERR
QUIT -1
+17 QUIT RESULT
