source: FOIAVistA/trunk/r/IMAGING-MAG-ZMAG/MAGGTU6.m@ 938

Last change on this file since 938 was 628, checked in by George Lilly, 16 years ago

initial load of FOIAVistA 6/30/08 version
File size: 7.6 KB
Line 
1MAGGTU6 ;WOIFO/GEK - Silent Utilities ; [ 06/20/2001 08:57 ]
2 ;;3.0;IMAGING;**24,8,48,45,20,46,59**;Nov 27, 2007;Build 20
3 ;; Per VHA Directive 2004-038, this routine should not be modified.
4 ;; +---------------------------------------------------------------+
5 ;; | Property of the US Government. |
6 ;; | No permission to copy or redistribute this software is given. |
7 ;; | Use of unreleased versions of this software requires the user |
8 ;; | to execute a written test agreement with the VistA Imaging |
9 ;; | Development Office of the Department of Veterans Affairs, |
10 ;; | telephone (301) 734-0100. |
11 ;; | |
12 ;; | The Food and Drug Administration classifies this software as |
13 ;; | a medical device. As such, it may not be changed in any way. |
14 ;; | Modifications to this software may result in an adulterated |
15 ;; | medical device under 21CFR820, the use of which is considered |
16 ;; | to be a violation of US Federal Statutes. |
17 ;; +---------------------------------------------------------------+
18 ;;
19 Q
20 ;
21LOGACT(MAGRY,ZY) ;RPC [MAGGACTION LOG]
22 ; Call to LogAction from Delphi Window
23 ;
24 ; ZY is input variable it is '^' delimited string
25 ; 'A|B|C|D|E' ^^ MAGIEN ^ 'Copy/Download' ^ DFN ^ '1';
26 ; DUZ is inserted as 2nd piece below.
27 ; I.E. zy = "C^^103660^Copy To Clipboard^1033^1"
28 N Y
29 S MAGRY="0^Logging access..."
30 ;
31 N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGGTERR"
32 ; C DUZ MAGIEN ACTION DFN 1
33 D ENTRY^MAGLOG($P(ZY,U),+$G(DUZ),$P(ZY,U,3),$P(ZY,U,4),$P(ZY,U,5),$P(ZY,U,6))
34 S MAGRY="1^Action was Logged."
35 Q
36LINKDT(MAGRY,MAGDA,DTTM) ; This is called when an Image is successfully
37 ; linked (Associated) with a Report/Procedure/Note etc.
38 ; MAGDA = Image IEN
39 ; DTTM = "" No date sent, so use NOW
40 ; DTTM = 1 No Date Sent, but use Image capture Date.
41 ; DTTM = Valid FM Date/Time , Use it.
42 N MSG
43 S DTTM=$G(DTTM)
44 I 'DTTM S DTTM=$$NOW^XLFDT ; Using NOW
45 I '$D(^MAG(2005,MAGDA)) Q
46 I DTTM=1 S DTTM=$P(^MAG(2005,MAGDA,2),"^",1) ; Using Date Image Captured.
47 I '$$VALID^MAGGSIV1(2005,64,.DTTM,.MSG) S MAGRY="0^"_MSG Q
48 S $P(^MAG(2005,MAGDA,2),"^",11)=DTTM
49 S MAGRY="1^Okay"
50 Q
51TIMEOUT(MAGRY,APP) ;RPC [MAGG GET TIMEOUT]
52 ; Call Returns the timeout for the APP from IMAGING SITE PARAMETERS File
53 ; APP is either 'DISPLAY' 'CAPTURE' or 'VISTARAD'
54 N I,MAGTIMES,MAGPLC
55 S MAGRY=""
56 S MAGPLC=$$PLACE^MAGBAPI(DUZ(2)) I 'MAGPLC Q ; DBI - SEB 9/20/2002
57 S MAGTIMES=$G(^MAG(2006.1,MAGPLC,"KEYS"))
58 I APP="DISPLAY" S MAGRY=$P(MAGTIMES,U,2)
59 I APP="CAPTURE" S MAGRY=$P(MAGTIMES,U,3)
60 I APP="VISTARAD" S MAGRY=$P(MAGTIMES,U,4)
61 I APP="TELEREADER" S MAGRY=$P(MAGTIMES,U,6) ; MJK - 2006.01.25 - TeleReader
62 Q
63EXIST(EKGPLACE) ;Does an ekg server exist in 2005.2
64 I $$CONSOLID^MAGBAPI()=0 Q $O(^MAG(2005.2,"E","EKG","")) ; DBI - SEB 9/20/2002
65 Q $O(^MAG(2005.2,"F",EKGPLACE,"EKG",""))
66 ;
67ONLINE(MAGR) ;RPC [MAG EKG ONLINE] EKG network location status
68 ;returns the status of the first EKG network location type
69 ;O if offline or a network location doesn't exist
70 ;1 if online
71 ;
72 N EKG1,EKGPLACE
73 S EKGPLACE=$$PLACE^MAGBAPI(DUZ(2)) ; DBI - SEB 9/20/2002
74 I EKGPLACE=0 S EKGPLACE=$$PLACE^MAGBAPI(DUZ(2)) ;Convert to extrinsic /gek 8/2003
75 I $$EXIST(EKGPLACE) D
76 . I $$CONSOLID^MAGBAPI() S EKG1=$O(^MAG(2005.2,"F",EKGPLACE,"EKG","")) ; DBI - SEB 9/20/2002
77 . E S EKG1=$O(^MAG(2005.2,"E","EKG",""))
78 . S MAGR=$P(^MAG(2005.2,EKG1,0),U,6)
79 E S MAGR=0
80 Q
81SHARE(MAGRY,TYPE) ;RPC [MAG GET NETLOC]
82 ; Get list of image shares
83 ;TYPE = One of the STORAGE TYPE codes : MAG, EKG, WORM, URL or ALL
84 N TMP,I,DATA0,DATA2,DATA3,DATA6,INFO,VALUE,STYP,PHYREF
85 N $ETRAP,$ESTACK S $ETRAP="D ERRA^MAGGTERR"
86 S I=0
87 I TYPE="" S TYPE="ALL"
88 S MAGRY(0)="1^SUCCESS"
89 F S I=$O(^MAG(2005.2,I)) Q:'I D
90 . Q:$$LOCDRIVE(I)
91 . S DATA0=$G(^MAG(2005.2,I,0))
92 . S DATA2=$G(^MAG(2005.2,I,2))
93 . S DATA3=$G(^MAG(2005.2,I,3))
94 . S DATA6=$G(^MAG(2005.2,I,6))
95 . ;
96 . S PHYREF=$P(DATA0,"^",2) ; PHYSICAL REFERENCE
97 . S STYP=$P(DATA0,"^",7) ; STORAGE TYPE
98 . ;
99 . I TYPE'="ALL" Q:STYP'[TYPE
100 . Q:$P(DATA0,"^",6)=0 ;SHARE IS OFFLINE (don't return offline shares)
101 . I STYP'="URL" Q:(PHYREF[".") ; pre 45, quit if '.' in phyref
102 . I STYP'="URL" Q:($E(PHYREF,1,2)'="\\") ; pre 45 quit if doesn't start with '\\'
103 . ;
104 . S INFO=$S($E(PHYREF,$L(PHYREF))="\":$E(PHYREF,1,$L(PHYREF)-1),1:PHYREF)
105 . S $P(INFO,"^",2)=$P($G(DATA0),"^",7) ;Physical reference (path)
106 . S $P(INFO,"^",3)=$P($G(DATA0),"^",6) ;Operational Status 0=OFFLINE 1=ONLINE
107 . S $P(INFO,"^",4)=$P($G(DATA2),"^",1) ;Username
108 . S $P(INFO,"^",5)=$P($G(DATA2),"^",2) ;Password
109 . S $P(INFO,"^",6)=$P($G(DATA6),"^",1) ;MUSE Site #
110 . I $P($G(DATA6),"^",2)'="" S $P(INFO,"^",7)=^MAG(2006.17,$P(DATA6,"^",2),0) ;MUSE version #
111 . S $P(INFO,"^",8)=$P($G(DATA3),"^",5) ;Network location SITE
112 . Q:$D(TMP(INFO))
113 . S TMP(INFO)=I
114 S INFO=""
115 F S INFO=$O(TMP(INFO)) Q:INFO="" D
116 . S MAGRY($O(MAGRY(""),-1)+1)=TMP(INFO)_"^"_INFO
117 K TMP
118 Q
119LOCDRIVE(I) ; Returns 1 if this is a local drive, else 0
120 ; Local Drive is determined by the DIR not being Type : URL and having a ":"
121 I $P(^MAG(2005.2,I,0),"^",7)'="URL" I $P(^MAG(2005.2,I,0),"^",2)[":" Q 1
122 Q 0
123GETENV(MAGRY) ;RPC [MAG GET ENV]
124 ; Get some environment variables (used by annotation control)
125 S MAGRY=DUZ(2)_"^"_$$NOW^XLFDT
126 Q
127ANNCB(STATARR) ;Status Callback (called by the import API)
128 ;
129 N I,CDUZ,QINDEX,A,COUNT
130 N XMDUZ,XMSUB,XMTEXT,XMY
131 ; 0 = error, all others are success.
132 I $P(STATARR(0),"^",1)'=0 D
133 . ; Import was successful
134 E D
135 . ; Import failed - send mail to MAG SERVER group and person who queued the import
136 . S XMDUZ=DUZ
137 . S XMSUB="Import Error Report"
138 . ; get text of message from status array
139 . S XMTEXT="A("
140 . ; XMD needs array to start with 1, not 0
141 . S COUNT=1,I=""
142 . F S I=$O(STATARR(I)) Q:I="" D
143 . . S A(COUNT)=I_") "_STATARR(I)
144 . . S COUNT=COUNT+1
145 . . Q
146 . S A(COUNT+1)=" "
147 . S A(COUNT+2)=" "
148 . S A(COUNT+3)=" The errors listed above were generated by"
149 . S A(COUNT+4)=" the VistA Imaging Annotation Editor while"
150 . S A(COUNT+5)=" trying to import your diagram. Please"
151 . S A(COUNT+6)=" report these errors to your VistA Imaging"
152 . S A(COUNT+7)=" support personnel."
153 . ;Get person who did the import
154 . S QINDEX=STATARR(2)
155 . S I=-1 F S I=$O(^MAG(2006.034,QINDEX,1,I)) Q:I="" D
156 . . I $P($G(^MAG(2006.034,QINDEX,1,I,0)),"^",1)=8 S CDUZ=$P(^MAG(2006.034,QINDEX,1,I,0),"^",2)
157 . ;Set recipients of message
158 . S XMY("G.MAG SERVER")=""
159 . I $G(CDUZ) S XMY(CDUZ)=""
160 . D ^XMD
161 . Q
162 Q
163GETCTP(MAGRY) ;RPC [MAG4 CT PRESETS GET]
164 N MAGPLC
165 S MAGPLC=$$PLACE^MAGBAPI(DUZ(2))
166 I 'MAGPLC S MAGRY="0^Error resolving Users Division" Q
167 S MAGRY=$G(^MAG(2006.1,MAGPLC,"CT"))
168 I MAGRY="" S MAGRY="0^Site doesn't have CT Presets defined." Q
169 S MAGRY="1^"_MAGRY
170 Q
171SAVECTP(MAGRY,VALUE) ;RPC [MAG4 CT PRESETS SAVE]
172 N MAGPLC
173 S MAGPLC=$$PLACE^MAGBAPI(DUZ(2))
174 I 'MAGPLC S MAGRY="0^Error resolving Users Division" Q
175 S ^MAG(2006.1,MAGPLC,"CT")=VALUE
176 S MAGRY="1^CT Presets saved."
177 Q
178NETPLCS ; Create an array of Place, SiteCodes for all entries of
179 ; Network Location entries.
180 N I,PLC,PLCODE,CONS
181 S CONS=$$CONSOLID^MAGBAPI
182 I 'CONS S PLC=$O(^MAG(2006.1,0)),PLCODE=$P(^MAG(2006.1,PLC,0),"^",9)
183 ;
184 K MAGJOB("NETPLC")
185 S I=0 F S I=$O(^MAG(2005.2,I)) Q:'I D
186 . I 'CONS S MAGJOB("NETPLC",I)=PLC_"^"_PLCODE Q
187 . ; Here, for consolidated sites we get the real Site IEN, and Site Code.
188 . I CONS S PLC=$P($G(^MAG(2005.2,I,0)),"^",10),PLCODE=$S(PLC:$P($G(^MAG(2006.1,PLC,0)),"^",9),1:"n/a")
189 . S MAGJOB("NETPLC",I)=PLC_"^"_PLCODE
190 . Q
191 Q
Note: See TracBrowser for help on using the repository browser.