| [613] | 1 | MAGDLB6 ;WOIFO/LB,MLH - DICOM file utilities ; 12/16/2004  11:30
 | 
|---|
 | 2 |  ;;3.0;IMAGING;**21,10,11,51**;26-August-2005
 | 
|---|
 | 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 |  ;; |                                                               |
 | 
|---|
 | 11 |  ;; | The Food and Drug Administration classifies this software as  |
 | 
|---|
 | 12 |  ;; | a medical device.  As such, it may not be changed in any way. |
 | 
|---|
 | 13 |  ;; | Modifications to this software may result in an adulterated   |
 | 
|---|
 | 14 |  ;; | medical device under 21CFR820, the use of which is considered |
 | 
|---|
 | 15 |  ;; | to be a violation of US Federal Statutes.                     |
 | 
|---|
 | 16 |  ;; +---------------------------------------------------------------+
 | 
|---|
 | 17 |  ;;
 | 
|---|
 | 18 |  Q
 | 
|---|
 | 19 |  ;
 | 
|---|
 | 20 | XREF ; Set "F" xref for fields 36 and 9 - Gateway Location and Study UID
 | 
|---|
 | 21 |  N GWLOC ; -- location number of DICOM Gateway
 | 
|---|
 | 22 |  N ORIG ; --- Entry number for original image for this study
 | 
|---|
 | 23 |  N PREDA ; -- original DA value
 | 
|---|
 | 24 |  S GWLOC=$P(^MAGD(2006.575,DA,1),"^",5) Q:'GWLOC
 | 
|---|
 | 25 |  ;
 | 
|---|
 | 26 |  ; If this is the first one, create the "F" cross-reference
 | 
|---|
 | 27 |  ;
 | 
|---|
 | 28 |  I '$D(^MAGD(2006.575,"F",GWLOC,X)) D  Q
 | 
|---|
 | 29 |  . S ^MAGD(2006.575,"F",GWLOC,X,DA)=""
 | 
|---|
 | 30 |  . Q
 | 
|---|
 | 31 |  ;
 | 
|---|
 | 32 |  ; Otherwise, the image is "related" to the original one
 | 
|---|
 | 33 |  ; for this study.
 | 
|---|
 | 34 |  ;
 | 
|---|
 | 35 |  S ORIG=$O(^MAGD(2006.575,"F",GWLOC,X,0))
 | 
|---|
 | 36 |  Q:'$D(^MAGD(2006.575,ORIG,0))  ; No longer in database
 | 
|---|
 | 37 |  S PREDA=DA D
 | 
|---|
 | 38 |  . N D0,DA,DD,DIC,DIE,ERR,X,Y
 | 
|---|
 | 39 |  . S DIC="^MAGD(2006.575,"_ORIG_",""RLATE"","
 | 
|---|
 | 40 |  . S DIC(0)="L"
 | 
|---|
 | 41 |  . S DA(1)=ORIG,X=PREDA
 | 
|---|
 | 42 |  . S ERR="Related Image ("_X_") for image #"_ORIG_" not filed."
 | 
|---|
 | 43 |  . D FILE^DICN
 | 
|---|
 | 44 |  . I Y=-1 D EN^DDIOL(ERR,"","!")
 | 
|---|
 | 45 |  . Q
 | 
|---|
 | 46 |  Q
 | 
|---|
 | 47 |  ;
 | 
|---|
 | 48 | XREFK ; Kill "F" cross-reference
 | 
|---|
 | 49 |  N GWLOC
 | 
|---|
 | 50 |  Q:'DA
 | 
|---|
 | 51 |  S GWLOC=$P(^MAGD(2006.575,DA,1),"^",5) Q:'GWLOC
 | 
|---|
 | 52 |  K ^MAGD(2006.575,"F",GWLOC,X,DA)
 | 
|---|
 | 53 |  Q
 | 
|---|
 | 54 |  ;
 | 
|---|