VistA-FOIAVistA/r/IMAGING-MAG-ZMAG/MAGQBJH.m

108 lines
5.0 KiB
Mathematica

MAGQBJH ;WOIFO/PMK/RMP - Copy an image from the Jukebox to the Hard Disk [ 06/20/2001 08:57 ]
;;3.0;IMAGING;**8,20**;Apr 12, 2006
;; +---------------------------------------------------------------+
;; | 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. |
;; +---------------------------------------------------------------+
;;
; RESULT=STATUS^MAGIFN^FROMPATH^TOPATH^FILETYPE^QPTR^VWP^QSN
; VWP = VISTA WRITE-LOCATION POINTER, QSN=QUEUE SEQUENCE NUMBER
ENTRY(RESULT,QPTR) ; entry point from ^MAGBMAIN
N NODE,X,MAGIFN,FILETYPE,MAGXX,STATUS,TODAY,MAGPIECE,MAGREF
N FROMPATH,TOPATH,MAGFILE,MAGFILE2,QSN,MSG,PLACE
S U="^",NODE=^MAGQUEUE(2006.03,QPTR,0),QSN=+$P(NODE,U,9)
S PLACE=$P(NODE,U,12)
I "^JBTOHD^PREFET^"'[(U_$P(NODE,U)_U) D Q
. S RESULT="-4"_U_QPTR_U_"Not a Jukebox to HardDisk Process"
S MAGIFN=$P(NODE,U,7),FILETYPE=$P(NODE,U,8)
D NOW^%DTC S TODAY=X
I "^FULL^ABSTRACT^BIG^"'[("^"_FILETYPE_"^") D Q
. S RESULT="-4"_U_QPTR_U_FILETYPE_" Is not a Jukebox to HardDisk Process"
I $P(^MAG(2005,MAGIFN,0),U,2)="" D Q
. I +$P($G(^MAG(2005,MAGIFN,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
. K ^MAGQUEUE(2006.03,"F",PLACE,MAGIFN,FILETYPE,QPTR)
D @(FILETYPE_"(PLACE)") ; do either FULL or ABSTRACT
K ^MAGQUEUE(2006.03,"F",PLACE,MAGIFN,FILETYPE,QPTR)
K MAGFILE1
S RESULT=STATUS
S $P(RESULT,U,8)=QSN
Q ;RESULT ;!!! REMOVE RESULT ON DISTRIBUTION
;
FULL(PLACE) ; copy a full-size image
S MAGXX=MAGIFN D VSTNOCP^MAGFILEB
I (($P(MAGFILE1,U)="-1")!('$P(^MAG(2005,MAGIFN,0),"^",5))) D Q
. S STATUS="-3"_U_QPTR_U_"Image IEN:"_MAGIFN_"has no file on-line"
S MAGREF=$P(^MAG(2005,MAGIFN,0),"^",3)
I MAGREF?1N.N D WLSET(.STATUS,MAGIFN,MAGREF,"FULL",PLACE) Q
S STATUS=$$COPY(PLACE) I +STATUS>0 D ;
. S $P(^MAG(2005,MAGIFN,0),"^",9)=TODAY ; update the last access date
Q
;
ABSTRACT(PLACE) ; copy an image abstract
S MAGXX=MAGIFN D ABSNOCP^MAGFILEB
I (($P(MAGFILE1,U)="-1")!('$P(^MAG(2005,MAGIFN,0),"^",5))) D Q
. S STATUS="-3"_U_QPTR_U_"Image IEN:"_MAGIFN_"has no file on-line"
S MAGREF=$P(^MAG(2005,MAGIFN,0),"^",4)
I MAGREF?1N.N D WLSET(.STATUS,MAGIFN,MAGREF,"ABSTRACT",PLACE) Q
S STATUS=$$COPY(PLACE) I +STATUS>0 D ;
. S $P(^MAG(2005,MAGIFN,0),"^",9)=TODAY ; update the last access date
Q
;
BIG(PLACE) ; copy a big image
S MAGXX=MAGIFN D BIGNOCP^MAGFILEB
I (($P(MAGFILE1,U)="-1")!('$P($G(^MAG(2005,MAGIFN,"FBIG")),U,2))) D Q
. S STATUS="-3"_U_QPTR_U_"Image IEN:"_MAGIFN_"has no file on-line"
S MAGREF=$P(^MAG(2005,MAGIFN,"FBIG"),U)
I MAGREF?1N.N D WLSET(.STATUS,MAGIFN,MAGREF,"BIG",PLACE) Q
S STATUS=$$COPY(PLACE) I +STATUS>0 D ;
. S $P(^MAG(2005,MAGIFN,0),"^",9)=TODAY ; update the last access date
Q
;
WLSET(STATUS,MAGIFN,MAGREF,TYPE,PLACE) ;Write Location set already
N JBREF,JBPATH,CWL,SOURCE,DEST,ALTDEST,ONLINE,PATH
S $P(^MAG(2005,MAGIFN,0),U,9)=TODAY ; update the last access date
; output the warning message
S JBREF=$S(TYPE="BIG":$P($G(^MAG(2005,MAGIFN,"FBIG")),U,2),1:$P(^MAG(2005,MAGIFN,0),U,5))
S JBPATH=$P(^MAG(2005.2,JBREF,0),U,2)
S JBPATH=JBPATH_$$DIRHASH^MAGFILEB(MAGFILE1,JBREF)
S CWL=$$CWL^MAGBAPI(PLACE)
S SOURCE=JBPATH_MAGFILE1
S ONLINE=$P(^MAG(2005.2,MAGREF,0),U,6)
;If the current magnetic write location is on line the first
;destination path will be to that path and the 2nd path is the
;current write location
S PATH=$P(^MAG(2005.2,$S(ONLINE:MAGREF,1:CWL),0),U,2)
S DEST=PATH_$$DIRHASH^MAGFILEB(MAGFILE1,$S(ONLINE:MAGREF,1:CWL))_MAGFILE1
S:ONLINE ALTDEST=$P(^MAG(2005.2,CWL,0),U,2)_$$DIRHASH^MAGFILEB(MAGFILE1,CWL)_MAGFILE1
S STATUS="2^"_MAGIFN_U_SOURCE_U_DEST
S STATUS=STATUS_U_FILETYPE_U_QPTR_U_$S(ONLINE:MAGREF,1:CWL)_U_QSN
S:ONLINE STATUS=STATUS_U_ALTDEST_U_CWL
Q
;
COPY(PLACE) ; copy an image file from the jukebox to the hard drive
N MAGREF,MAGDRIVE
D GETDRIVE(.MAGDRIVE,.MAGREF,PLACE) ;^MAGFILE ; find space to put file
I MAGREF'?1N.N Q "-4^"_QPTR_"^Current Write Location is not SET"
I +$P($G(^MAG(2005.2,MAGREF,0)),"^",6)'>0 Q "-4^"_QPTR_"^Current Write Location is OFFLINE"
S TOPATH=MAGDRIVE_$$DIRHASH^MAGFILEB(MAGFILE1,MAGREF)_MAGFILE1
S FROMPATH=MAGFILE2
Q "1"_U_MAGIFN_U_FROMPATH_U_TOPATH_U_FILETYPE_U_QPTR_U_MAGREF
GETDRIVE(DRIVE,MAGREF,PLACE) ; Get the current drive for writing an image
S MAGREF=$$CWL^MAGBAPI(PLACE)
S DRIVE=$S('MAGREF:"",1:$P(^MAG(2005.2,MAGREF,0),U,2))
Q
;