Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MAGQBGCC

MAGQBGCC.m

Go to the documentation of this file. 
  1. 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
  1.  ;; Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;; +---------------------------------------------------------------+
  1.  ;; | Property of the US Government.                                |
  1.  ;; | No permission to copy or redistribute this software is given. |
  1.  ;; | Use of unreleased versions of this software requires the user |
  1.  ;; | to execute a written test agreement with the VistA Imaging    |
  1.  ;; | Development Office of the Department of Veterans Affairs,     |
  1.  ;; | telephone (301) 734-0100.                                     |
  1.  ;; | The Food and Drug Administration classifies this software as  |
  1.  ;; | a medical device.  As such, it may not be changed in any way. |
  1.  ;; | Modifications to this software may result in an adulterated   |
  1.  ;; | medical device under 21CFR820, the use of which is considered |
  1.  ;; | to be a violation of US Federal Statutes.                     |
  1.  ;; +---------------------------------------------------------------+
  1.  ;;
  1.  Q
  1. ENTRY(RESULT,QPTR) ; entry point from ^MAGQBTM
  1.  ; RESULT=STATUS^IMAGE PTR^FROM FILE^TO FILE^QUEUE PTR^REMOTELOC PTR^QSN
  1.  ; QSN=QUEUE SEQUENCE NUMBER
  1.  N CWL,IMGPTR,L,FILE,MAGREF,TOFILE,QNODE,QSN,ZNODE,SOURCE,FTYPE,MSG,EXT,ALTDEST,ALTNAME
  1.  S QNODE=$G(^MAGQUEUE(2006.03,QPTR,0)),RESULT="1"
  1.  S IMGPTR=$P(QNODE,U,7),QSN=+$P(QNODE,U,9),ALTDEST=+$P(QNODE,U,10),ALTNAME=$P($P(QNODE,U,11),"~")
  1.  S FTYPE=$P($P(QNODE,U,11),"~",2)
  1.  S ZNODE=$G(^MAG(2005,IMGPTR,0))
  1.  I ZNODE="" D  Q
  1.  . S RESULT="-101^"_QPTR_"^MAG Global Node #"_IMGPTR_" not present"
  1.  S FILE=$P(ZNODE,U,2)
  1.  I FILE="" D  Q
  1.  . I +$P($G(^MAG(2005,IMGPTR,1,0)),U,4)>0 D
  1.  . . S MSG="Image group parent"
  1.  . E  S MSG="Does not have an image file specified"
  1.  . S RESULT="-5"_U_QPTR_U_MSG
  1.  ;Next we implement alternate file types
  1.  S FTYPE=$S(FTYPE="":"FULL",1:$$FTYPE^MAGQBPRG(FTYPE,IMGPTR))
  1.  D @(FTYPE_"(.RESULT,.MAGREF,IMGPTR)")
  1.  Q:$P(RESULT,"^")<0
  1.  S SOURCE=$$WPATH(FILE,MAGREF)_FILE
  1.  S L=+$P(QNODE,"^",10)
  1.  S CWL=$S(L>0:L,1:$$CEL()) ;DETERMINE DESTINATION SHARE
  1.  I $P(^MAG(2005.2,CWL,0),"^",6)'="1" D  Q
  1.  . S RESULT="-4"_U_QPTR_U_"Export Network Location is set Offline"
  1.  S TOFILE=$S(ALTDEST:$$WPATH(FILE,ALTDEST)_ALTNAME,1:$$WPATH(FILE,CWL)_FILE)
  1.  S RESULT="1^"_IMGPTR_U_SOURCE_U_TOFILE_U_QPTR_U_CWL_U_QSN_U_ALTNAME
  1.  Q
  1. CEL() ; Current Export Pointer
  1.  Q $S($P(^MAG(2006.1,$$PLACE^MAGBAPI(+$G(DUZ(2))),0),"^",7)>1:$P(^(0),"^",7),1:1)
  1. WPATH(FILE,LOC) ; Write path of location (CWP)
  1.  Q $P(^MAG(2005.2,LOC,0),"^",2)_$$DIRHASH^MAGFILEB(FILE,LOC)
  1. FULL(RESULT,MAGREF,MAGIFN) ; copy a full-size image
  1.  S MAGREF=$$LINE(+$P(^MAG(2005,MAGIFN,0),"^",3))
  1.  I 'MAGREF S MAGREF=$$LINE(+$P(^MAG(2005,MAGIFN,0),"^",5))
  1.  S:('MAGREF) RESULT="-3"_U_QPTR_U_"File not online"
  1.  Q 
  1.  ;
  1. ABS(RESULT,MAGREF,MAGIFN) ; copy an image abstract
  1.  S MAGREF=$$LINE(+$P(^MAG(2005,MAGIFN,0),"^",4))
  1.  I 'MAGREF S MAGREF=$$LINE(+$P(^MAG(2005,MAGIFN,0),"^",5))
  1.  S:('MAGREF) RESULT="-3"_U_QPTR_U_"Abstract File not online"
  1.  Q 
  1.  ;
  1. BIG(RESULT,MAGREF,MAGIFN) ; copy a big image
  1.  S MAGREF=$$LINE(+$P(^MAG(2005,MAGIFN,"FBIG"),"^",1))
  1.  I 'MAGREF S MAGREF=$$LINE(+$P(^MAG(2005,MAGIFN,"FBIG"),"^",2))
  1.  S:('MAGREF) RESULT="-3"_U_QPTR_U_"Big File not online"
  1.  Q
  1. LINE(PTR) ;Check if the share is online
  1.  Q:PTR<1 ""
  1.  Q $S($P($G(^MAG(2005.2,PTR,0)),U,6)=1:PTR,1:"")
  1. PID(MAGRY,MAGIEN) ;  Queuing PHOTO ID
  1.  N EXLOC,DFN,FN
  1.  S EXLOC=$P($G(^MAG(2005.86,$O(^MAG(2005.86,"B","PHOTO-ID COPY","")),0)),U,5)
  1.  I 'EXLOC D  Q
  1.  . N PLACE
  1.  . S PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2)))
  1.  . D DFNIQ^MAGQBPG1(""," Production Account: "_$$PROD^XUPROD("1"),0,PLACE,"PHOTO ID ACTION")
  1.  . D DFNIQ^MAGQBPG1("","The Photo ID protocol in the IMAGE ACTION file (#2005.86) could not ",0,PLACE,"PHOTO ID ACTION")
  1.  . D DFNIQ^MAGQBPG1("","resolve the target export location as currently defined. ",0,PLACE,"PHOTO ID ACTION")
  1.  . D DFNIQ^MAGQBPG1("","Update the EXPORT LOCATION field for the PHOTO-ID COPY entry in ",0,PLACE,"PHOTO ID ACTION")
  1.  . D DFNIQ^MAGQBPG1("","IMAGE ACTION file. ",0,PLACE,"PHOTO ID ACTION")
  1.  . D DFNIQ^MAGQBPG1("","Photo_I_D_Action",1,PLACE,"PHOTO ID ACTION")
  1.  . S MAGRY(0)="0^The PHOTO ID COPY Image action queue process could not resolve the export location"
  1.  . Q
  1.  S DFN=$P($G(^MAG(2005,MAGIEN,0)),U,7),FN=DFN_"."_$P($P($G(^MAG(2005,MAGIEN,0)),U,2),".",2)
  1.  D CHK^MAGGSQI(.MAGRY,MAGIEN)
  1.  I $P(MAGRY(0),U) S MAGRY(0)=$$GCC^MAGBAPI(MAGIEN_U_EXLOC_U_FN,$$DA2PLC^MAGBAPIP(MAGIEN,"F"))
  1.  S MAGRY(1)=MAGIEN_" "_$$NOW^XLFDT
  1.  D ACTION^MAGGTAU("PPACT^"_$P(^MAG(2005,MAGIEN,0),"^",7)_"^"_MAGIEN_"|PHOTO ID-COPY using GCC^MAGBAPI",1)
  1.  K VADPT
  1.  Q
  1.  ;