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

MAGQBJH.m

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