MAGQBJH ;WOIFO/PMK/RMP - Copy an image from the Jukebox to the Hard Disk ; 18 Jan 2011 4:57 PM
;;3.0;IMAGING;**8,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. |
;; +---------------------------------------------------------------+
;;
; 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,MSG
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)
S TODAY=$P($$NOW^XLFDT,".",1)
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 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)
. Q
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
FULL(PLACE) ; copy a full-size image
S MAGXX=MAGIFN D VSTNOCP^MAGFILEB
I (($E(MAGFILE1,1,2)="-1")!('$P(^MAG(2005,MAGIFN,0),"^",5))) D Q
. S STATUS="-3"_U_QPTR_U_"Image IEN:"_MAGIFN_"has no file online"
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 (($E(MAGFILE1,1,2)="-1")!('$P(^MAG(2005,MAGIFN,0),"^",5))) D Q
. S STATUS="-3"_U_QPTR_U_"Image IEN:"_MAGIFN_"has no file online"
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 (($E(MAGFILE1,1,2)="-1")!('$P($G(^MAG(2005,MAGIFN,"FBIG")),U,2))) D Q
. S STATUS="-3"_U_QPTR_U_"Image IEN:"_MAGIFN_"has no file online"
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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGQBJH 5269 printed Sep 23, 2025@19:44:04 Page 2
MAGQBJH ;WOIFO/PMK/RMP - Copy an image from the Jukebox to the Hard Disk ; 18 Jan 2011 4:57 PM
+1 ;;3.0;IMAGING;**8,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 ; RESULT=STATUS^MAGIFN^FROMPATH^TOPATH^FILETYPE^QPTR^VWP^QSN
+18 ; VWP = VISTA WRITE-LOCATION POINTER, QSN=QUEUE SEQUENCE NUMBER
ENTRY(RESULT,QPTR) ; entry point from ^MAGBMAIN
+1 NEW NODE,X,MAGIFN,FILETYPE,MAGXX,STATUS,TODAY,MAGPIECE,MAGREF,MSG
+2 NEW FROMPATH,TOPATH,MAGFILE,MAGFILE2,QSN,MSG,PLACE
+3 SET U="^"
SET NODE=^MAGQUEUE(2006.03,QPTR,0)
SET QSN=+$PIECE(NODE,U,9)
+4 SET PLACE=$PIECE(NODE,U,12)
+5 IF "^JBTOHD^PREFET^"'[(U_$PIECE(NODE,U)_U)
Begin DoDot:1
+6 SET RESULT="-4"_U_QPTR_U_"Not a Jukebox to HardDisk Process"
End DoDot:1
QUIT
+7 SET MAGIFN=$PIECE(NODE,U,7)
SET FILETYPE=$PIECE(NODE,U,8)
+8 SET TODAY=$PIECE($$NOW^XLFDT,".",1)
+9 IF "^FULL^ABSTRACT^BIG^"'[("^"_FILETYPE_"^")
Begin DoDot:1
+10 SET RESULT="-4"_U_QPTR_U_FILETYPE_" Is not a Jukebox to HardDisk Process"
End DoDot:1
QUIT
+11 IF $PIECE(^MAG(2005,MAGIFN,0),U,2)=""
Begin DoDot:1
+12 IF +$PIECE($GET(^MAG(2005,MAGIFN,1,0)),U,4)>0
SET MSG="Image group parent"
+13 IF '$TEST
SET MSG="Does not have an image file specified"
+14 SET RESULT="-5"_U_QPTR_U_MSG
+15 KILL ^MAGQUEUE(2006.03,"F",PLACE,MAGIFN,FILETYPE,QPTR)
+16 QUIT
End DoDot:1
QUIT
+17 ; do either FULL or ABSTRACT
DO @(FILETYPE_"(PLACE)")
+18 KILL ^MAGQUEUE(2006.03,"F",PLACE,MAGIFN,FILETYPE,QPTR)
+19 KILL MAGFILE1
+20 SET RESULT=STATUS
+21 SET $PIECE(RESULT,U,8)=QSN
+22 QUIT
FULL(PLACE) ; copy a full-size image
+1 SET MAGXX=MAGIFN
DO VSTNOCP^MAGFILEB
+2 IF (($EXTRACT(MAGFILE1,1,2)="-1")!('$PIECE(^MAG(2005,MAGIFN,0),"^",5)))
Begin DoDot:1
+3 SET STATUS="-3"_U_QPTR_U_"Image IEN:"_MAGIFN_"has no file online"
End DoDot:1
QUIT
+4 SET MAGREF=$PIECE(^MAG(2005,MAGIFN,0),"^",3)
+5 IF MAGREF?1N.N
DO WLSET(.STATUS,MAGIFN,MAGREF,"FULL",PLACE)
QUIT
+6 ;
SET STATUS=$$COPY(PLACE)
IF +STATUS>0
Begin DoDot:1
+7 ; update the last access date
SET $PIECE(^MAG(2005,MAGIFN,0),"^",9)=TODAY
End DoDot:1
+8 QUIT
+9 ;
ABSTRACT(PLACE) ; copy an image abstract
+1 SET MAGXX=MAGIFN
DO ABSNOCP^MAGFILEB
+2 IF (($EXTRACT(MAGFILE1,1,2)="-1")!('$PIECE(^MAG(2005,MAGIFN,0),"^",5)))
Begin DoDot:1
+3 SET STATUS="-3"_U_QPTR_U_"Image IEN:"_MAGIFN_"has no file online"
End DoDot:1
QUIT
+4 SET MAGREF=$PIECE(^MAG(2005,MAGIFN,0),"^",4)
+5 IF MAGREF?1N.N
DO WLSET(.STATUS,MAGIFN,MAGREF,"ABSTRACT",PLACE)
QUIT
+6 ;
SET STATUS=$$COPY(PLACE)
IF +STATUS>0
Begin DoDot:1
+7 ; update the last access date
SET $PIECE(^MAG(2005,MAGIFN,0),"^",9)=TODAY
End DoDot:1
+8 QUIT
+9 ;
BIG(PLACE) ; copy a big image
+1 SET MAGXX=MAGIFN
DO BIGNOCP^MAGFILEB
+2 IF (($EXTRACT(MAGFILE1,1,2)="-1")!('$PIECE($GET(^MAG(2005,MAGIFN,"FBIG")),U,2)))
Begin DoDot:1
+3 SET STATUS="-3"_U_QPTR_U_"Image IEN:"_MAGIFN_"has no file online"
End DoDot:1
QUIT
+4 SET MAGREF=$PIECE(^MAG(2005,MAGIFN,"FBIG"),U)
+5 IF MAGREF?1N.N
DO WLSET(.STATUS,MAGIFN,MAGREF,"BIG",PLACE)
QUIT
+6 ;
SET STATUS=$$COPY(PLACE)
IF +STATUS>0
Begin DoDot:1
+7 ; update the last access date
SET $PIECE(^MAG(2005,MAGIFN,0),"^",9)=TODAY
End DoDot:1
+8 QUIT
+9 ;
WLSET(STATUS,MAGIFN,MAGREF,TYPE,PLACE) ;Write Location set already
+1 NEW JBREF,JBPATH,CWL,SOURCE,DEST,ALTDEST,ONLINE,PATH
+2 ; update the last access date
SET $PIECE(^MAG(2005,MAGIFN,0),U,9)=TODAY
+3 ; output the warning message
+4 SET JBREF=$SELECT(TYPE="BIG":$PIECE($GET(^MAG(2005,MAGIFN,"FBIG")),U,2),1:$PIECE(^MAG(2005,MAGIFN,0),U,5))
+5 SET JBPATH=$PIECE(^MAG(2005.2,JBREF,0),U,2)
+6 SET JBPATH=JBPATH_$$DIRHASH^MAGFILEB(MAGFILE1,JBREF)
+7 SET CWL=$$CWL^MAGBAPI(PLACE)
+8 SET SOURCE=JBPATH_MAGFILE1
+9 SET ONLINE=$PIECE(^MAG(2005.2,MAGREF,0),U,6)
+10 ;If the current magnetic write location is on line the first
+11 ;destination path will be to that path and the 2nd path is the
+12 ;current write location
+13 SET PATH=$PIECE(^MAG(2005.2,$SELECT(ONLINE:MAGREF,1:CWL),0),U,2)
+14 SET DEST=PATH_$$DIRHASH^MAGFILEB(MAGFILE1,$SELECT(ONLINE:MAGREF,1:CWL))_MAGFILE1
+15 if ONLINE
SET ALTDEST=$PIECE(^MAG(2005.2,CWL,0),U,2)_$$DIRHASH^MAGFILEB(MAGFILE1,CWL)_MAGFILE1
+16 SET STATUS="2^"_MAGIFN_U_SOURCE_U_DEST
+17 SET STATUS=STATUS_U_FILETYPE_U_QPTR_U_$SELECT(ONLINE:MAGREF,1:CWL)_U_QSN
+18 if ONLINE
SET STATUS=STATUS_U_ALTDEST_U_CWL
+19 QUIT
+20 ;
COPY(PLACE) ; copy an image file from the jukebox to the hard drive
+1 NEW MAGREF,MAGDRIVE
+2 ;^MAGFILE ; find space to put file
DO GETDRIVE(.MAGDRIVE,.MAGREF,PLACE)
+3 IF MAGREF'?1N.N
QUIT "-4^"_QPTR_"^Current Write Location is not SET"
+4 IF +$PIECE($GET(^MAG(2005.2,MAGREF,0)),"^",6)'>0
QUIT "-4^"_QPTR_"^Current Write Location is OFFLINE"
+5 SET TOPATH=MAGDRIVE_$$DIRHASH^MAGFILEB(MAGFILE1,MAGREF)_MAGFILE1
+6 SET FROMPATH=MAGFILE2
+7 QUIT "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
+1 SET MAGREF=$$CWL^MAGBAPI(PLACE)
+2 SET DRIVE=$SELECT('MAGREF:"",1:$PIECE(^MAG(2005.2,MAGREF,0),U,2))
+3 QUIT
+4 ;
