source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGQBJH.m@ 1604

Last change on this file since 1604 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 5.0 KB
Line 
1MAGQBJH ;WOIFO/PMK/RMP - Copy an image from the Jukebox to the Hard Disk [ 06/20/2001 08:57 ]
2 ;;3.0;IMAGING;**8,20**;Apr 12, 2006
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 ;; | |
11 ;; | The Food and Drug Administration classifies this software as |
12 ;; | a medical device. As such, it may not be changed in any way. |
13 ;; | Modifications to this software may result in an adulterated |
14 ;; | medical device under 21CFR820, the use of which is considered |
15 ;; | to be a violation of US Federal Statutes. |
16 ;; +---------------------------------------------------------------+
17 ;;
18 ; RESULT=STATUS^MAGIFN^FROMPATH^TOPATH^FILETYPE^QPTR^VWP^QSN
19 ; VWP = VISTA WRITE-LOCATION POINTER, QSN=QUEUE SEQUENCE NUMBER
20ENTRY(RESULT,QPTR) ; entry point from ^MAGBMAIN
21 N NODE,X,MAGIFN,FILETYPE,MAGXX,STATUS,TODAY,MAGPIECE,MAGREF
22 N FROMPATH,TOPATH,MAGFILE,MAGFILE2,QSN,MSG,PLACE
23 S U="^",NODE=^MAGQUEUE(2006.03,QPTR,0),QSN=+$P(NODE,U,9)
24 S PLACE=$P(NODE,U,12)
25 I "^JBTOHD^PREFET^"'[(U_$P(NODE,U)_U) D Q
26 . S RESULT="-4"_U_QPTR_U_"Not a Jukebox to HardDisk Process"
27 S MAGIFN=$P(NODE,U,7),FILETYPE=$P(NODE,U,8)
28 D NOW^%DTC S TODAY=X
29 I "^FULL^ABSTRACT^BIG^"'[("^"_FILETYPE_"^") D Q
30 . S RESULT="-4"_U_QPTR_U_FILETYPE_" Is not a Jukebox to HardDisk Process"
31 I $P(^MAG(2005,MAGIFN,0),U,2)="" D Q
32 . I +$P($G(^MAG(2005,MAGIFN,1,0)),U,4)>0 D
33 . . S MSG="Image group parent"
34 . E S MSG="Does not have an image file specified"
35 . S RESULT="-5"_U_QPTR_U_MSG
36 . K ^MAGQUEUE(2006.03,"F",PLACE,MAGIFN,FILETYPE,QPTR)
37 D @(FILETYPE_"(PLACE)") ; do either FULL or ABSTRACT
38 K ^MAGQUEUE(2006.03,"F",PLACE,MAGIFN,FILETYPE,QPTR)
39 K MAGFILE1
40 S RESULT=STATUS
41 S $P(RESULT,U,8)=QSN
42 Q ;RESULT ;!!! REMOVE RESULT ON DISTRIBUTION
43 ;
44FULL(PLACE) ; copy a full-size image
45 S MAGXX=MAGIFN D VSTNOCP^MAGFILEB
46 I (($P(MAGFILE1,U)="-1")!('$P(^MAG(2005,MAGIFN,0),"^",5))) D Q
47 . S STATUS="-3"_U_QPTR_U_"Image IEN:"_MAGIFN_"has no file on-line"
48 S MAGREF=$P(^MAG(2005,MAGIFN,0),"^",3)
49 I MAGREF?1N.N D WLSET(.STATUS,MAGIFN,MAGREF,"FULL",PLACE) Q
50 S STATUS=$$COPY(PLACE) I +STATUS>0 D ;
51 . S $P(^MAG(2005,MAGIFN,0),"^",9)=TODAY ; update the last access date
52 Q
53 ;
54ABSTRACT(PLACE) ; copy an image abstract
55 S MAGXX=MAGIFN D ABSNOCP^MAGFILEB
56 I (($P(MAGFILE1,U)="-1")!('$P(^MAG(2005,MAGIFN,0),"^",5))) D Q
57 . S STATUS="-3"_U_QPTR_U_"Image IEN:"_MAGIFN_"has no file on-line"
58 S MAGREF=$P(^MAG(2005,MAGIFN,0),"^",4)
59 I MAGREF?1N.N D WLSET(.STATUS,MAGIFN,MAGREF,"ABSTRACT",PLACE) Q
60 S STATUS=$$COPY(PLACE) I +STATUS>0 D ;
61 . S $P(^MAG(2005,MAGIFN,0),"^",9)=TODAY ; update the last access date
62 Q
63 ;
64BIG(PLACE) ; copy a big image
65 S MAGXX=MAGIFN D BIGNOCP^MAGFILEB
66 I (($P(MAGFILE1,U)="-1")!('$P($G(^MAG(2005,MAGIFN,"FBIG")),U,2))) D Q
67 . S STATUS="-3"_U_QPTR_U_"Image IEN:"_MAGIFN_"has no file on-line"
68 S MAGREF=$P(^MAG(2005,MAGIFN,"FBIG"),U)
69 I MAGREF?1N.N D WLSET(.STATUS,MAGIFN,MAGREF,"BIG",PLACE) Q
70 S STATUS=$$COPY(PLACE) I +STATUS>0 D ;
71 . S $P(^MAG(2005,MAGIFN,0),"^",9)=TODAY ; update the last access date
72 Q
73 ;
74WLSET(STATUS,MAGIFN,MAGREF,TYPE,PLACE) ;Write Location set already
75 N JBREF,JBPATH,CWL,SOURCE,DEST,ALTDEST,ONLINE,PATH
76 S $P(^MAG(2005,MAGIFN,0),U,9)=TODAY ; update the last access date
77 ; output the warning message
78 S JBREF=$S(TYPE="BIG":$P($G(^MAG(2005,MAGIFN,"FBIG")),U,2),1:$P(^MAG(2005,MAGIFN,0),U,5))
79 S JBPATH=$P(^MAG(2005.2,JBREF,0),U,2)
80 S JBPATH=JBPATH_$$DIRHASH^MAGFILEB(MAGFILE1,JBREF)
81 S CWL=$$CWL^MAGBAPI(PLACE)
82 S SOURCE=JBPATH_MAGFILE1
83 S ONLINE=$P(^MAG(2005.2,MAGREF,0),U,6)
84 ;If the current magnetic write location is on line the first
85 ;destination path will be to that path and the 2nd path is the
86 ;current write location
87 S PATH=$P(^MAG(2005.2,$S(ONLINE:MAGREF,1:CWL),0),U,2)
88 S DEST=PATH_$$DIRHASH^MAGFILEB(MAGFILE1,$S(ONLINE:MAGREF,1:CWL))_MAGFILE1
89 S:ONLINE ALTDEST=$P(^MAG(2005.2,CWL,0),U,2)_$$DIRHASH^MAGFILEB(MAGFILE1,CWL)_MAGFILE1
90 S STATUS="2^"_MAGIFN_U_SOURCE_U_DEST
91 S STATUS=STATUS_U_FILETYPE_U_QPTR_U_$S(ONLINE:MAGREF,1:CWL)_U_QSN
92 S:ONLINE STATUS=STATUS_U_ALTDEST_U_CWL
93 Q
94 ;
95COPY(PLACE) ; copy an image file from the jukebox to the hard drive
96 N MAGREF,MAGDRIVE
97 D GETDRIVE(.MAGDRIVE,.MAGREF,PLACE) ;^MAGFILE ; find space to put file
98 I MAGREF'?1N.N Q "-4^"_QPTR_"^Current Write Location is not SET"
99 I +$P($G(^MAG(2005.2,MAGREF,0)),"^",6)'>0 Q "-4^"_QPTR_"^Current Write Location is OFFLINE"
100 S TOPATH=MAGDRIVE_$$DIRHASH^MAGFILEB(MAGFILE1,MAGREF)_MAGFILE1
101 S FROMPATH=MAGFILE2
102 Q "1"_U_MAGIFN_U_FROMPATH_U_TOPATH_U_FILETYPE_U_QPTR_U_MAGREF
103GETDRIVE(DRIVE,MAGREF,PLACE) ; Get the current drive for writing an image
104 S MAGREF=$$CWL^MAGBAPI(PLACE)
105 S DRIVE=$S('MAGREF:"",1:$P(^MAG(2005.2,MAGREF,0),U,2))
106 Q
107 ;
Note: See TracBrowser for help on using the repository browser.