source: FOIAVistA/trunk/r/IMAGING-MAG-ZMAG/MAGGTU1.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 2.7 KB
Line 
1MAGGTU1 ;WOIFO/GEK - Silent Utilities ; [ 06/20/2001 08:57 ]
2 ;;3.0;IMAGING;**3,8,85,59**;Nov 27, 2007;Build 20
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ;; +---------------------------------------------------------------+
5 ;; | Property of the US Government. |
6 ;; | No permission to copy or redistribute this software is given. |
7 ;; | Use of unreleased versions of this software requires the user |
8 ;; | to execute a written test agreement with the VistA Imaging |
9 ;; | Development Office of the Department of Veterans Affairs, |
10 ;; | telephone (301) 734-0100. |
11 ;; | |
12 ;; | The Food and Drug Administration classifies this software as |
13 ;; | a medical device. As such, it may not be changed in any way. |
14 ;; | Modifications to this software may result in an adulterated |
15 ;; | medical device under 21CFR820, the use of which is considered |
16 ;; | to be a violation of US Federal Statutes. |
17 ;; +---------------------------------------------------------------+
18 ;;
19 Q
20DRIVE(X,SITE) ; Get the current drive for writing an image
21 ; Copied from MAGFILE and edited for silent running, made extrinsic.
22 ; X : The Network Location to Write to. Dicom Gateway sends this.
23 ; IF 'X then use DUZ(2) to find IMAGE NETWORK WRITE LOCATION.
24 ; P 85, Enable writing to any valid site. Not Just Duz(2)
25 ; SITE : The Site to Write to. Import API now sends this.
26 ;
27 ;
28 N Z,MAGREF,MAGREFNM,MAGDRIVE,MAGPLC
29 S SITE=$S($G(SITE):SITE,1:$G(DUZ(2)))
30 S MAGPLC=$$PLACE^MAGBAPI(SITE) ;pre-patch 85 was DUZ(2)
31 S MAGREF=$G(X)
32 I $G(MAGWRITE)="PACS" S MAGREF=$$GET1^DIQ(2006.1,MAGPLC,1.03,"I") ; DBI 9/20/02 - SEB
33 I 'MAGREF S MAGREF=$$GET1^DIQ(2006.1,MAGPLC,.03,"I") ; DBI 9/20/02 - SEB
34 I MAGREF="" D Q Z
35 . S Z="0^NEED WRITE LOCATION in SITE Parameters file!!! Call IRM"
36 ;
37 I '$P(^MAG(2005.2,MAGREF,0),"^",6) D Q Z
38 . S Z="0^The Server that you are writing to is off-line. Call IRM"
39 ;
40 S MAGREFNM=$P(^MAG(2005.2,MAGREF,0),"^",1),MAGDRIVE=$P(^(0),"^",2)
41 Q MAGREF_U_MAGDRIVE
42 ;
43DA2NAME(IEN,SUF) ; Return file name with extension
44 ; SUF should always be defined, but default to .TIF if not.
45 N PRE,FILE,CMPF,MAGPLC
46 S MAGPLC=$$DA2PLC^MAGBAPIP(IEN,"F")
47 S SUF=$S($L($G(SUF)):SUF,1:"TIF")
48 S PRE=$$GET1^DIQ(2006.1,MAGPLC,.02,"E") ; gek DBI
49 ;S PRE=$G(^MAG(2006.1,"ALTR"))
50 I '$L(PRE) Q "0^Need Site Specific LETTERS in Site Parameters File"
51 ;
52 S FILE=PRE_IEN
53 ; Design of Patch 3 was changed to only return 14 digit file names.
54 ; 08/02/2002 Patch 3,8 force 14.3 file name convention
55 I ($L(FILE)<14) S FILE=PRE_$E(10000000000000+IEN,$L(PRE)+1,14)
56 Q "1^"_FILE_"."_SUF
Note: See TracBrowser for help on using the repository browser.