source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGQBJB.m@ 1396

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

initial load of WorldVistAEHR

File size: 4.5 KB
Line 
1MAGQBJB ;WOIFO/PMK/RMP - Get an image file to copy to the JukeBoX [ 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 ;;
18ENTRY(RESULT,QPTR) ; entry point from ^MAGQBTM
19 ; RESULT=STATUS^IMAGE PTR^FROM FILE^TO FILE^VOLUME NAME^
20 ; JUKEBOX DEVICE^QUEUE PTR^JUKEBOX-NETWORK LOC PTR^QSN
21 ; QSN=QUEUE SEQUENCE NUMBER
22 N CWP,IMGPTR,L,JBDEVICE,FILENAME,FILE,X,JBPTR,SUBDIR
23 N MAGFILE,MAGXX,MAGSTORE,MAGFILE2,PERCENT,SIZERTN,MAGDEV,SRCE
24 N TOFILE,TOTAL,QNODE,QSN,ZNODE,BNODE,FULL,ABS,BIG,MSG,PLACE,AGG
25 S U="^",QNODE=$G(^MAGQUEUE(2006.03,QPTR,0)),(ZNODE,FULL,ABS,BIG,JBPTR,AGG)=""
26 S IMGPTR=$P(QNODE,U,7),QSN=+$P(QNODE,U,9),PLACE=$P(QNODE,U,12)
27 I $D(^MAG(2005,IMGPTR,0)) D
28 . S ZNODE=$G(^MAG(2005,IMGPTR,0))
29 . S BNODE=$G(^MAG(2005,IMGPTR,"FBIG"))
30 . Q
31 E I $D(^MAG(2005.1,IMGPTR,0)) D
32 . S ZNODE=$G(^MAG(2005.1,IMGPTR,0))
33 . S BNODE=$G(^MAG(2005.1,IMGPTR,"FBIG"))
34 . Q
35 I ZNODE="" D Q ;RESULT ;!!!!
36 . S RESULT="-101^"_QPTR_"^MAG Global Node #"_IMGPTR_" not present"
37 S FILE=$P(ZNODE,U,2)
38 I FILE="" D Q ;RESULT ;!!!
39 . I +$P($G(^MAG(2005,IMGPTR,1,0)),U,4)>0 D
40 . . S MSG="Image group parent"
41 . E S MSG="Does not have an image file specified"
42 . S RESULT="-5"_U_QPTR_U_MSG
43 ;I $P(ZNODE,U,5),$P(BNODE,U,2) D Q
44 ;. S RESULT="-11^"_QPTR_"^Source file is already archived" Q
45 ; Establish the current Jukebox location
46 S CWP=$$CWP^MAGBAPI($$PLACE^MAGBAPI(+$G(DUZ(2))))
47 I $P(^MAG(2005.2,CWP,0),"^",6)'="1" D Q
48 . S RESULT="-4"_U_QPTR_U_"Jukebox Network Location is set Off-Line"
49 S JBPTR=$$JBPTR^MAGBAPI($$PLACE^MAGBAPI(+$G(DUZ(2))))
50 S JBDEVICE=$$JBDEV(JBPTR)
51 ; If the current Jukebox write location differs from the FULL/ABstract Worm or the BIG Worm then aggregate
52 S AGG=$S($P(ZNODE,U,5)&($P(ZNODE,U,5)'=CWP):1,$P(BNODE,U,2)&($P(BNODE,U,2)'=CWP):1,1:"")
53 ; Check for FULL
54 S SRCE=$S($$SLINE(+$P(ZNODE,U,3)):$P(ZNODE,U,3),1:"")
55 I 'SRCE,AGG S SRCE=$S($$SLINE(+$P(ZNODE,U,5)):$P(ZNODE,U,5),1:"")
56 I SRCE D
57 . S MAGDEV=$P(^MAG(2005.2,SRCE,0),U,2),FULL=MAGDEV_$$DIRHASH^MAGFILEB(FILE,SRCE)_FILE Q
58 ; Check for Abstract
59 S SRCE=$S($$SLINE(+$P(ZNODE,U,4)):$P(ZNODE,U,4),1:"")
60 I 'SRCE,AGG S SRCE=$S($$SLINE(+$P(ZNODE,U,5)):$P(ZNODE,U,5),1:"")
61 I SRCE D
62 . S MAGDEV=$P(^MAG(2005.2,SRCE,0),U,2),ABS=MAGDEV_$$DIRHASH^MAGFILEB(FILE,SRCE)_$P(FILE,".")_".ABS" Q
63 ; Check for Big
64 S SRCE=$S($$SLINE(+$P(BNODE,U,1)):$P(BNODE,U,1),1:"")
65 I 'SRCE,AGG S SRCE=$S($$SLINE(+$P(BNODE,U,2)):$P(BNODE,U,2),1:"")
66 I SRCE D
67 . S MAGDEV=$P(^MAG(2005.2,SRCE,0),U,2),BIG=MAGDEV_$$DIRHASH^MAGFILEB(FILE,SRCE)_$P(FILE,".")_".BIG" Q
68 I FULL="",BIG="",ABS="" D Q
69 . S MSG=$S(('$P(BNODE,U))&('$P(ZNODE,U,4))&('$P(ZNODE,U,4)):"No Vista Cache Source",1:"")
70 . S MSG=$S('MSG:"There are no network location references for this image: "_FILE,1:MSG)
71 . S RESULT="-11^"_QPTR_"^"_MSG
72 . Q
73 K MAGFILE1
74 S TOFILE=$$WPATH(FILE,CWP)_FILE
75 S RESULT="1^"_IMGPTR_U_FULL_U_TOFILE_U
76 S RESULT=RESULT_$$VOLNM(JBPTR)_U_JBDEVICE_U_QPTR_U_CWP_U_QSN_U_ABS_U_BIG
77 Q ;RESULT ;!!!
78JBLPT(JBPTR) ; Jukebox Ptr to Network Location File
79 Q $P(^MAGQUEUE(2006.032,JBPTR,0),U,3)
80WPATH(FILE,CWP) ; Write path of Current Write Platter (CWP)
81 Q $P(^MAG(2005.2,CWP,0),"^",2)_$$DIRHASH^MAGFILEB(FILE,CWP)
82VOLNM(JBPTR) ; Volume name of JBDEVICE
83 Q $P($G(^MAGQUEUE(2006.032,JBPTR,0)),"^",9)
84JBDEV(JBPTR) ; Jukebox Device (drive spec)
85 Q $P($G(^MAGQUEUE(2006.032,JBPTR,0)),"^",2)
86JBPLT(PTR) ; FIND 2005.2 REFERENCE
87 N I,RESULT
88 S (I,RESULT)=0
89 F S I=$O(^MAGQUEUE(2006.032,I)) Q:'I D Q:RESULT
90 . I $P(^MAGQUEUE(2006.032,I,0),U,3)=PTR S RESULT=I
91 . Q
92 Q RESULT
93SLINE(PTR) ;Check if the share is online
94 Q:PTR<1 ""
95 Q $S($P($G(^MAG(2005.2,PTR,0)),U,6)=1:1,1:"")
Note: See TracBrowser for help on using the repository browser.