source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGDLB6.m@ 1240

Last change on this file since 1240 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1MAGDLB6 ;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 ;
20XREF ; 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 ;
48XREFK ; 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 ;
Note: See TracBrowser for help on using the repository browser.