- 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 Feb 18, 2025@23:34:15 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 ;