| 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 |  ;
 | 
|---|