- MAGGTU1 ;WOIFO/GEK - Silent Utilities ; [ 06/20/2001 08:57 ]
- ;;3.0;IMAGING;**3,8,85,59**;Nov 27, 2007;Build 20
- ;;Per VHA Directive 2004-038, this routine should not be modified.
- ;; +---------------------------------------------------------------+
- ;; | Property of the US Government. |
- ;; | No permission to copy or redistribute this software is given. |
- ;; | Use of unreleased versions of this software requires the user |
- ;; | to execute a written test agreement with the VistA Imaging |
- ;; | Development Office of the Department of Veterans Affairs, |
- ;; | telephone (301) 734-0100. |
- ;; | |
- ;; | The Food and Drug Administration classifies this software as |
- ;; | a medical device. As such, it may not be changed in any way. |
- ;; | Modifications to this software may result in an adulterated |
- ;; | medical device under 21CFR820, the use of which is considered |
- ;; | to be a violation of US Federal Statutes. |
- ;; +---------------------------------------------------------------+
- ;;
- Q
- DRIVE(X,SITE) ; Get the current drive for writing an image
- ; Copied from MAGFILE and edited for silent running, made extrinsic.
- ; X : The Network Location to Write to. Dicom Gateway sends this.
- ; IF 'X then use DUZ(2) to find IMAGE NETWORK WRITE LOCATION.
- ; P 85, Enable writing to any valid site. Not Just Duz(2)
- ; SITE : The Site to Write to. Import API now sends this.
- ;
- ;
- N Z,MAGREF,MAGREFNM,MAGDRIVE,MAGPLC
- S SITE=$S($G(SITE):SITE,1:$G(DUZ(2)))
- S MAGPLC=$$PLACE^MAGBAPI(SITE) ;pre-patch 85 was DUZ(2)
- S MAGREF=$G(X)
- I $G(MAGWRITE)="PACS" S MAGREF=$$GET1^DIQ(2006.1,MAGPLC,1.03,"I") ; DBI 9/20/02 - SEB
- I 'MAGREF S MAGREF=$$GET1^DIQ(2006.1,MAGPLC,.03,"I") ; DBI 9/20/02 - SEB
- I MAGREF="" D Q Z
- . S Z="0^NEED WRITE LOCATION in SITE Parameters file!!! Call IRM"
- ;
- I '$P(^MAG(2005.2,MAGREF,0),"^",6) D Q Z
- . S Z="0^The Server that you are writing to is off-line. Call IRM"
- ;
- S MAGREFNM=$P(^MAG(2005.2,MAGREF,0),"^",1),MAGDRIVE=$P(^(0),"^",2)
- Q MAGREF_U_MAGDRIVE
- ;
- DA2NAME(IEN,SUF) ; Return file name with extension
- ; SUF should always be defined, but default to .TIF if not.
- N PRE,FILE,CMPF,MAGPLC
- S MAGPLC=$$DA2PLC^MAGBAPIP(IEN,"F")
- S SUF=$S($L($G(SUF)):SUF,1:"TIF")
- S PRE=$$GET1^DIQ(2006.1,MAGPLC,.02,"E") ; gek DBI
- ;S PRE=$G(^MAG(2006.1,"ALTR"))
- I '$L(PRE) Q "0^Need Site Specific LETTERS in Site Parameters File"
- ;
- S FILE=PRE_IEN
- ; Design of Patch 3 was changed to only return 14 digit file names.
- ; 08/02/2002 Patch 3,8 force 14.3 file name convention
- I ($L(FILE)<14) S FILE=PRE_$E(10000000000000+IEN,$L(PRE)+1,14)
- Q "1^"_FILE_"."_SUF
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGGTU1 2807 printed Jan 18, 2025@03:04:32 Page 2
- MAGGTU1 ;WOIFO/GEK - Silent Utilities ; [ 06/20/2001 08:57 ]
- +1 ;;3.0;IMAGING;**3,8,85,59**;Nov 27, 2007;Build 20
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified.
- +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 QUIT
- DRIVE(X,SITE) ; Get the current drive for writing an image
- +1 ; Copied from MAGFILE and edited for silent running, made extrinsic.
- +2 ; X : The Network Location to Write to. Dicom Gateway sends this.
- +3 ; IF 'X then use DUZ(2) to find IMAGE NETWORK WRITE LOCATION.
- +4 ; P 85, Enable writing to any valid site. Not Just Duz(2)
- +5 ; SITE : The Site to Write to. Import API now sends this.
- +6 ;
- +7 ;
- +8 NEW Z,MAGREF,MAGREFNM,MAGDRIVE,MAGPLC
- +9 SET SITE=$SELECT($GET(SITE):SITE,1:$GET(DUZ(2)))
- +10 ;pre-patch 85 was DUZ(2)
- SET MAGPLC=$$PLACE^MAGBAPI(SITE)
- +11 SET MAGREF=$GET(X)
- +12 ; DBI 9/20/02 - SEB
- IF $GET(MAGWRITE)="PACS"
- SET MAGREF=$$GET1^DIQ(2006.1,MAGPLC,1.03,"I")
- +13 ; DBI 9/20/02 - SEB
- IF 'MAGREF
- SET MAGREF=$$GET1^DIQ(2006.1,MAGPLC,.03,"I")
- +14 IF MAGREF=""
- Begin DoDot:1
- +15 SET Z="0^NEED WRITE LOCATION in SITE Parameters file!!! Call IRM"
- End DoDot:1
- QUIT Z
- +16 ;
- +17 IF '$PIECE(^MAG(2005.2,MAGREF,0),"^",6)
- Begin DoDot:1
- +18 SET Z="0^The Server that you are writing to is off-line. Call IRM"
- End DoDot:1
- QUIT Z
- +19 ;
- +20 SET MAGREFNM=$PIECE(^MAG(2005.2,MAGREF,0),"^",1)
- SET MAGDRIVE=$PIECE(^(0),"^",2)
- +21 QUIT MAGREF_U_MAGDRIVE
- +22 ;
- DA2NAME(IEN,SUF) ; Return file name with extension
- +1 ; SUF should always be defined, but default to .TIF if not.
- +2 NEW PRE,FILE,CMPF,MAGPLC
- +3 SET MAGPLC=$$DA2PLC^MAGBAPIP(IEN,"F")
- +4 SET SUF=$SELECT($LENGTH($GET(SUF)):SUF,1:"TIF")
- +5 ; gek DBI
- SET PRE=$$GET1^DIQ(2006.1,MAGPLC,.02,"E")
- +6 ;S PRE=$G(^MAG(2006.1,"ALTR"))
- +7 IF '$LENGTH(PRE)
- QUIT "0^Need Site Specific LETTERS in Site Parameters File"
- +8 ;
- +9 SET FILE=PRE_IEN
- +10 ; Design of Patch 3 was changed to only return 14 digit file names.
- +11 ; 08/02/2002 Patch 3,8 force 14.3 file name convention
- +12 IF ($LENGTH(FILE)<14)
- SET FILE=PRE_$EXTRACT(10000000000000+IEN,$LENGTH(PRE)+1,14)
- +13 QUIT "1^"_FILE_"."_SUF