Changeset 623 for WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGGTU1.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGGTU1.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGGTU1.m
r613 r623 1 MAGGTU1 ;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 20 DRIVE(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 ; 43 DA2NAME(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 1 MAGGTU1 ;WOIFO/GEK - Silent Utilities ; [ 06/20/2001 08:57 ] 2 ;;3.0;IMAGING;**3,8,85**;16-March-2007;;Build 1039 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 ;; | 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 DRIVE(X,SITE) ; Get the current drive for writing an image 20 ; Copied from MAGFILE and edited for silent running, made extrinsic. 21 ; X : The Network Location to Write to. Dicom Gateway sends this. 22 ; IF 'X then use DUZ(2) to find IMAGE NETWORK WRITE LOCATION. 23 ; P 85, Enable writing to any valid site. Not Just Duz(2) 24 ; SITE : The Site to Write to. Import API now sends this. 25 ; 26 ; 27 N Z,MAGREF,MAGREFNM,MAGDRIVE,MAGPLC 28 S SITE=$S($G(SITE):SITE,1:$G(DUZ(2))) 29 S MAGPLC=$$PLACE^MAGBAPI(SITE) ;pre-patch 85 was DUZ(2) 30 S MAGREF=$G(X) 31 I $G(MAGWRITE)="PACS" S MAGREF=$$GET1^DIQ(2006.1,MAGPLC,1.03,"I") ; DBI 9/20/02 - SEB 32 I 'MAGREF S MAGREF=$$GET1^DIQ(2006.1,MAGPLC,.03,"I") ; DBI 9/20/02 - SEB 33 I MAGREF="" D Q Z 34 . S Z="0^NEED WRITE LOCATION in SITE Parameters file!!! Call IRM" 35 ; 36 I '$P(^MAG(2005.2,MAGREF,0),"^",6) D Q Z 37 . S Z="0^The Server that you are writing to is off-line. Call IRM" 38 ; 39 S MAGREFNM=$P(^MAG(2005.2,MAGREF,0),"^",1),MAGDRIVE=$P(^(0),"^",2) 40 Q MAGREF_U_MAGDRIVE 41 ; 42 DA2NAME(IEN,SUF) ; Return file name with extension 43 ; SUF should always be defined, but default to .TIF if not. 44 N PRE,FILE,CMPF,MAGPLC 45 S MAGPLC=$$DA2PLC^MAGBAPIP(IEN,"F") 46 S SUF=$S($L($G(SUF)):SUF,1:"TIF") 47 S PRE=$$GET1^DIQ(2006.1,MAGPLC,.02,"E") ; gek DBI 48 ;S PRE=$G(^MAG(2006.1,"ALTR")) 49 I '$L(PRE) Q "0^Need Site Specific LETTERS in Site Parameters File" 50 ; 51 S FILE=PRE_IEN 52 ; Design of Patch 3 was changed to only return 14 digit file names. 53 ; 08/02/2002 Patch 3,8 force 14.3 file name convention 54 I ($L(FILE)<14) S FILE=PRE_$E(10000000000000+IEN,$L(PRE)+1,14) 55 Q "1^"_FILE_"."_SUF
Note:
See TracChangeset
for help on using the changeset viewer.
