source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGQBGCC.m@ 1036

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

initial load of WorldVistAEHR

File size: 3.2 KB
RevLine 
[613]1MAGQBGCC ;WOIFO/RMP - Export an image file to a remote location [ 06/20/2001 08:57 ]
2 ;;3.0;IMAGING;**8,48,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 ;;
18ENTRY(RESULT,QPTR) ; entry point from ^MAGQBTM
19 ; RESULT=STATUS^IMAGE PTR^FROM FILE^TO FILE^QUEUE PTR^REMOTELOC PTR^QSN
20 ; QSN=QUEUE SEQUENCE NUMBER
21 N CWL,IMGPTR,L,FILE,MAGREF,TOFILE,QNODE,QSN,ZNODE,SOURCE,FTYPE,MSG,EXT,ALTDEST,ALTTYPE
22 S QNODE=$G(^MAGQUEUE(2006.03,QPTR,0)),RESULT="1"
23 S IMGPTR=$P(QNODE,U,7),QSN=+$P(QNODE,U,9),ALTDEST=+$P(QNODE,U,10),ALTTYPE=$P(QNODE,U,11)
24 S ZNODE=$G(^MAG(2005,IMGPTR,0))
25 I ZNODE="" D Q ;RESULT ;!!!!
26 . S RESULT="-101^"_QPTR_"^MAG Global Node #"_IMGPTR_" not present"
27 S FILE=$P(ZNODE,U,2)
28 I FILE="" D Q ;RESULT ;!!!
29 . I +$P($G(^MAG(2005,IMGPTR,1,0)),U,4)>0 D
30 . . S MSG="Image group parent"
31 . E S MSG="Does not have an image file specified"
32 . S RESULT="-5"_U_QPTR_U_MSG
33 S FTYPE=$S(ALTTYPE="":"FULL",1:$$FTYPE^MAGQBPRG(ALTTYPE))
34 D @(FTYPE_"(.RESULT,.MAGREF,IMGPTR)")
35 Q:$P(RESULT,"^")<0
36 S SOURCE=$$WPATH(FILE,MAGREF)_FILE
37 S L=+$P(QNODE,"^",10)
38 S CWL=$S(L>0:L,1:$$CEL())
39 I $P(^MAG(2005.2,CWL,0),"^",6)'="1" D Q
40 . S RESULT="-4"_U_QPTR_U_"Export Network Location is set Off-Line"
41 S TOFILE=$$WPATH(FILE,CWL)_FILE
42 S RESULT="1^"_IMGPTR_U_SOURCE_U_TOFILE_U_QPTR_U_CWL_U_QSN_U_$P(QNODE,U,11)
43 Q
44CEL() ; Current Export Pointer
45 Q $S($P(^MAG(2006.1,$$PLACE^MAGBAPI(+$G(DUZ(2))),0),"^",7)>1:$P(^(0),"^",7),1:1)
46WPATH(FILE,LOC) ; Write path of location (CWP)
47 Q $P(^MAG(2005.2,LOC,0),"^",2)_$$DIRHASH^MAGFILEB(FILE,LOC)
48FULL(RESULT,MAGREF,MAGIFN) ; copy a full-size image
49 S MAGREF=$$LINE(+$P(^MAG(2005,MAGIFN,0),"^",3))
50 I 'MAGREF S MAGREF=$$LINE(+$P(^MAG(2005,MAGIFN,0),"^",5))
51 S:('MAGREF) RESULT="-3"_U_QPTR_U_"File not on-line"
52 Q
53 ;
54ABS(RESULT,MAGREF,MAGIFN) ; copy an image abstract
55 S MAGREF=$$LINE(+$P(^MAG(2005,MAGIFN,0),"^",4))
56 I 'MAGREF S MAGREF=$$LINE(+$P(^MAG(2005,MAGIFN,0),"^",5))
57 S:('MAGREF) RESULT="-3"_U_QPTR_U_"Abstract File not on-line"
58 Q
59 ;
60BIG(RESULT,MAGREF,MAGIFN) ; copy a big image
61 S MAGREF=$$LINE(+$P(^MAG(2005,MAGIFN,"FBIG"),"^",1))
62 I 'MAGREF S MAGREF=$$LINE(+$P(^MAG(2005,MAGIFN,"FBIG"),"^",2))
63 S:('MAGREF) RESULT="-3"_U_QPTR_U_"Big File not on-line"
64 Q
65LINE(PTR) ;Check if the share is online
66 Q:PTR<1 ""
67 Q $S($P($G(^MAG(2005.2,PTR,0)),U,6)=1:PTR,1:"")
68 ;
Note: See TracBrowser for help on using the repository browser.