MAGQBGCC ;WOIFO/RMP - Export an image file to a remote location ; 18 Jan 2011 4:49 PM
;;3.0;IMAGING;**8,48,20,39**;Mar 19, 2002;Build 2010;Mar 08, 2011
;; 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
ENTRY(RESULT,QPTR) ; entry point from ^MAGQBTM
; RESULT=STATUS^IMAGE PTR^FROM FILE^TO FILE^QUEUE PTR^REMOTELOC PTR^QSN
; QSN=QUEUE SEQUENCE NUMBER
N CWL,IMGPTR,L,FILE,MAGREF,TOFILE,QNODE,QSN,ZNODE,SOURCE,FTYPE,MSG,EXT,ALTDEST,ALTNAME
S QNODE=$G(^MAGQUEUE(2006.03,QPTR,0)),RESULT="1"
S IMGPTR=$P(QNODE,U,7),QSN=+$P(QNODE,U,9),ALTDEST=+$P(QNODE,U,10),ALTNAME=$P($P(QNODE,U,11),"~")
S FTYPE=$P($P(QNODE,U,11),"~",2)
S ZNODE=$G(^MAG(2005,IMGPTR,0))
I ZNODE="" D Q
. S RESULT="-101^"_QPTR_"^MAG Global Node #"_IMGPTR_" not present"
S FILE=$P(ZNODE,U,2)
I FILE="" D Q
. I +$P($G(^MAG(2005,IMGPTR,1,0)),U,4)>0 D
. . S MSG="Image group parent"
. E S MSG="Does not have an image file specified"
. S RESULT="-5"_U_QPTR_U_MSG
;Next we implement alternate file types
S FTYPE=$S(FTYPE="":"FULL",1:$$FTYPE^MAGQBPRG(FTYPE,IMGPTR))
D @(FTYPE_"(.RESULT,.MAGREF,IMGPTR)")
Q:$P(RESULT,"^")<0
S SOURCE=$$WPATH(FILE,MAGREF)_FILE
S L=+$P(QNODE,"^",10)
S CWL=$S(L>0:L,1:$$CEL()) ;DETERMINE DESTINATION SHARE
I $P(^MAG(2005.2,CWL,0),"^",6)'="1" D Q
. S RESULT="-4"_U_QPTR_U_"Export Network Location is set Offline"
S TOFILE=$S(ALTDEST:$$WPATH(FILE,ALTDEST)_ALTNAME,1:$$WPATH(FILE,CWL)_FILE)
S RESULT="1^"_IMGPTR_U_SOURCE_U_TOFILE_U_QPTR_U_CWL_U_QSN_U_ALTNAME
Q
CEL() ; Current Export Pointer
Q $S($P(^MAG(2006.1,$$PLACE^MAGBAPI(+$G(DUZ(2))),0),"^",7)>1:$P(^(0),"^",7),1:1)
WPATH(FILE,LOC) ; Write path of location (CWP)
Q $P(^MAG(2005.2,LOC,0),"^",2)_$$DIRHASH^MAGFILEB(FILE,LOC)
FULL(RESULT,MAGREF,MAGIFN) ; copy a full-size image
S MAGREF=$$LINE(+$P(^MAG(2005,MAGIFN,0),"^",3))
I 'MAGREF S MAGREF=$$LINE(+$P(^MAG(2005,MAGIFN,0),"^",5))
S:('MAGREF) RESULT="-3"_U_QPTR_U_"File not online"
Q
;
ABS(RESULT,MAGREF,MAGIFN) ; copy an image abstract
S MAGREF=$$LINE(+$P(^MAG(2005,MAGIFN,0),"^",4))
I 'MAGREF S MAGREF=$$LINE(+$P(^MAG(2005,MAGIFN,0),"^",5))
S:('MAGREF) RESULT="-3"_U_QPTR_U_"Abstract File not online"
Q
;
BIG(RESULT,MAGREF,MAGIFN) ; copy a big image
S MAGREF=$$LINE(+$P(^MAG(2005,MAGIFN,"FBIG"),"^",1))
I 'MAGREF S MAGREF=$$LINE(+$P(^MAG(2005,MAGIFN,"FBIG"),"^",2))
S:('MAGREF) RESULT="-3"_U_QPTR_U_"Big File not online"
Q
LINE(PTR) ;Check if the share is online
Q:PTR<1 ""
Q $S($P($G(^MAG(2005.2,PTR,0)),U,6)=1:PTR,1:"")
PID(MAGRY,MAGIEN) ; Queuing PHOTO ID
N EXLOC,DFN,FN
S EXLOC=$P($G(^MAG(2005.86,$O(^MAG(2005.86,"B","PHOTO-ID COPY","")),0)),U,5)
I 'EXLOC D Q
. N PLACE
. S PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2)))
. D DFNIQ^MAGQBPG1(""," Production Account: "_$$PROD^XUPROD("1"),0,PLACE,"PHOTO ID ACTION")
. D DFNIQ^MAGQBPG1("","The Photo ID protocol in the IMAGE ACTION file (#2005.86) could not ",0,PLACE,"PHOTO ID ACTION")
. D DFNIQ^MAGQBPG1("","resolve the target export location as currently defined. ",0,PLACE,"PHOTO ID ACTION")
. D DFNIQ^MAGQBPG1("","Update the EXPORT LOCATION field for the PHOTO-ID COPY entry in ",0,PLACE,"PHOTO ID ACTION")
. D DFNIQ^MAGQBPG1("","IMAGE ACTION file. ",0,PLACE,"PHOTO ID ACTION")
. D DFNIQ^MAGQBPG1("","Photo_I_D_Action",1,PLACE,"PHOTO ID ACTION")
. S MAGRY(0)="0^The PHOTO ID COPY Image action queue process could not resolve the export location"
. Q
S DFN=$P($G(^MAG(2005,MAGIEN,0)),U,7),FN=DFN_"."_$P($P($G(^MAG(2005,MAGIEN,0)),U,2),".",2)
D CHK^MAGGSQI(.MAGRY,MAGIEN)
I $P(MAGRY(0),U) S MAGRY(0)=$$GCC^MAGBAPI(MAGIEN_U_EXLOC_U_FN,$$DA2PLC^MAGBAPIP(MAGIEN,"F"))
S MAGRY(1)=MAGIEN_" "_$$NOW^XLFDT
D ACTION^MAGGTAU("PPACT^"_$P(^MAG(2005,MAGIEN,0),"^",7)_"^"_MAGIEN_"|PHOTO ID-COPY using GCC^MAGBAPI",1)
K VADPT
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGQBGCC 4747 printed Nov 22, 2024@17:17:51 Page 2
MAGQBGCC ;WOIFO/RMP - Export an image file to a remote location ; 18 Jan 2011 4:49 PM
+1 ;;3.0;IMAGING;**8,48,20,39**;Mar 19, 2002;Build 2010;Mar 08, 2011
+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 ;; | The Food and Drug Administration classifies this software as |
+11 ;; | a medical device. As such, it may not be changed in any way. |
+12 ;; | Modifications to this software may result in an adulterated |
+13 ;; | medical device under 21CFR820, the use of which is considered |
+14 ;; | to be a violation of US Federal Statutes. |
+15 ;; +---------------------------------------------------------------+
+16 ;;
+17 QUIT
ENTRY(RESULT,QPTR) ; entry point from ^MAGQBTM
+1 ; RESULT=STATUS^IMAGE PTR^FROM FILE^TO FILE^QUEUE PTR^REMOTELOC PTR^QSN
+2 ; QSN=QUEUE SEQUENCE NUMBER
+3 NEW CWL,IMGPTR,L,FILE,MAGREF,TOFILE,QNODE,QSN,ZNODE,SOURCE,FTYPE,MSG,EXT,ALTDEST,ALTNAME
+4 SET QNODE=$GET(^MAGQUEUE(2006.03,QPTR,0))
SET RESULT="1"
+5 SET IMGPTR=$PIECE(QNODE,U,7)
SET QSN=+$PIECE(QNODE,U,9)
SET ALTDEST=+$PIECE(QNODE,U,10)
SET ALTNAME=$PIECE($PIECE(QNODE,U,11),"~")
+6 SET FTYPE=$PIECE($PIECE(QNODE,U,11),"~",2)
+7 SET ZNODE=$GET(^MAG(2005,IMGPTR,0))
+8 IF ZNODE=""
Begin DoDot:1
+9 SET RESULT="-101^"_QPTR_"^MAG Global Node #"_IMGPTR_" not present"
End DoDot:1
QUIT
+10 SET FILE=$PIECE(ZNODE,U,2)
+11 IF FILE=""
Begin DoDot:1
+12 IF +$PIECE($GET(^MAG(2005,IMGPTR,1,0)),U,4)>0
Begin DoDot:2
+13 SET MSG="Image group parent"
End DoDot:2
+14 IF '$TEST
SET MSG="Does not have an image file specified"
+15 SET RESULT="-5"_U_QPTR_U_MSG
End DoDot:1
QUIT
+16 ;Next we implement alternate file types
+17 SET FTYPE=$SELECT(FTYPE="":"FULL",1:$$FTYPE^MAGQBPRG(FTYPE,IMGPTR))
+18 DO @(FTYPE_"(.RESULT,.MAGREF,IMGPTR)")
+19 if $PIECE(RESULT,"^")<0
QUIT
+20 SET SOURCE=$$WPATH(FILE,MAGREF)_FILE
+21 SET L=+$PIECE(QNODE,"^",10)
+22 ;DETERMINE DESTINATION SHARE
SET CWL=$SELECT(L>0:L,1:$$CEL())
+23 IF $PIECE(^MAG(2005.2,CWL,0),"^",6)'="1"
Begin DoDot:1
+24 SET RESULT="-4"_U_QPTR_U_"Export Network Location is set Offline"
End DoDot:1
QUIT
+25 SET TOFILE=$SELECT(ALTDEST:$$WPATH(FILE,ALTDEST)_ALTNAME,1:$$WPATH(FILE,CWL)_FILE)
+26 SET RESULT="1^"_IMGPTR_U_SOURCE_U_TOFILE_U_QPTR_U_CWL_U_QSN_U_ALTNAME
+27 QUIT
CEL() ; Current Export Pointer
+1 QUIT $SELECT($PIECE(^MAG(2006.1,$$PLACE^MAGBAPI(+$GET(DUZ(2))),0),"^",7)>1:$PIECE(^(0),"^",7),1:1)
WPATH(FILE,LOC) ; Write path of location (CWP)
+1 QUIT $PIECE(^MAG(2005.2,LOC,0),"^",2)_$$DIRHASH^MAGFILEB(FILE,LOC)
FULL(RESULT,MAGREF,MAGIFN) ; copy a full-size image
+1 SET MAGREF=$$LINE(+$PIECE(^MAG(2005,MAGIFN,0),"^",3))
+2 IF 'MAGREF
SET MAGREF=$$LINE(+$PIECE(^MAG(2005,MAGIFN,0),"^",5))
+3 if ('MAGREF)
SET RESULT="-3"_U_QPTR_U_"File not online"
+4 QUIT
+5 ;
ABS(RESULT,MAGREF,MAGIFN) ; copy an image abstract
+1 SET MAGREF=$$LINE(+$PIECE(^MAG(2005,MAGIFN,0),"^",4))
+2 IF 'MAGREF
SET MAGREF=$$LINE(+$PIECE(^MAG(2005,MAGIFN,0),"^",5))
+3 if ('MAGREF)
SET RESULT="-3"_U_QPTR_U_"Abstract File not online"
+4 QUIT
+5 ;
BIG(RESULT,MAGREF,MAGIFN) ; copy a big image
+1 SET MAGREF=$$LINE(+$PIECE(^MAG(2005,MAGIFN,"FBIG"),"^",1))
+2 IF 'MAGREF
SET MAGREF=$$LINE(+$PIECE(^MAG(2005,MAGIFN,"FBIG"),"^",2))
+3 if ('MAGREF)
SET RESULT="-3"_U_QPTR_U_"Big File not online"
+4 QUIT
LINE(PTR) ;Check if the share is online
+1 if PTR<1
QUIT ""
+2 QUIT $SELECT($PIECE($GET(^MAG(2005.2,PTR,0)),U,6)=1:PTR,1:"")
PID(MAGRY,MAGIEN) ; Queuing PHOTO ID
+1 NEW EXLOC,DFN,FN
+2 SET EXLOC=$PIECE($GET(^MAG(2005.86,$ORDER(^MAG(2005.86,"B","PHOTO-ID COPY","")),0)),U,5)
+3 IF 'EXLOC
Begin DoDot:1
+4 NEW PLACE
+5 SET PLACE=$$PLACE^MAGBAPI(+$GET(DUZ(2)))
+6 DO DFNIQ^MAGQBPG1(""," Production Account: "_$$PROD^XUPROD("1"),0,PLACE,"PHOTO ID ACTION")
+7 DO DFNIQ^MAGQBPG1("","The Photo ID protocol in the IMAGE ACTION file (#2005.86) could not ",0,PLACE,"PHOTO ID ACTION")
+8 DO DFNIQ^MAGQBPG1("","resolve the target export location as currently defined. ",0,PLACE,"PHOTO ID ACTION")
+9 DO DFNIQ^MAGQBPG1("","Update the EXPORT LOCATION field for the PHOTO-ID COPY entry in ",0,PLACE,"PHOTO ID ACTION")
+10 DO DFNIQ^MAGQBPG1("","IMAGE ACTION file. ",0,PLACE,"PHOTO ID ACTION")
+11 DO DFNIQ^MAGQBPG1("","Photo_I_D_Action",1,PLACE,"PHOTO ID ACTION")
+12 SET MAGRY(0)="0^The PHOTO ID COPY Image action queue process could not resolve the export location"
+13 QUIT
End DoDot:1
QUIT
+14 SET DFN=$PIECE($GET(^MAG(2005,MAGIEN,0)),U,7)
SET FN=DFN_"."_$PIECE($PIECE($GET(^MAG(2005,MAGIEN,0)),U,2),".",2)
+15 DO CHK^MAGGSQI(.MAGRY,MAGIEN)
+16 IF $PIECE(MAGRY(0),U)
SET MAGRY(0)=$$GCC^MAGBAPI(MAGIEN_U_EXLOC_U_FN,$$DA2PLC^MAGBAPIP(MAGIEN,"F"))
+17 SET MAGRY(1)=MAGIEN_" "_$$NOW^XLFDT
+18 DO ACTION^MAGGTAU("PPACT^"_$PIECE(^MAG(2005,MAGIEN,0),"^",7)_"^"_MAGIEN_"|PHOTO ID-COPY using GCC^MAGBAPI",1)
+19 KILL VADPT
+20 QUIT
+21 ;
