source: FOIAVistA/trunk/r/IMAGING-MAG-ZMAG/MAGQBPG1.m@ 1203

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

initial load of FOIAVistA 6/30/08 version
File size: 9.4 KB
Line 
1MAGQBPG1 ;WOIFO/RMP - REMOTE Task SERVER Program [ 11/08/2001 17:18 ]
2 ;;3.0;IMAGING;**7,8,20,81**;May 17, 2007
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 ;; | 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,WSTAT,PROCESS) ;RPC[MAGQ JBS]
19 N X,SYSIEN,SYSNAME,ZNODE,NODE,INDX,CNT,PROC,%,QPTR,QCNT,SHARE,PLACE
20 D NOW^%DTC
21 S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
22 S (SYSIEN,CNT)=0,SYSNAME="",U="^",PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2)))
23 S SYSIEN=$O(^MAG(2006.8,"C",WSTAT,"")) ;TRUE WORKSTATION NAME
24 I 'SYSIEN S SYSIEN=$O(^MAG(2006.8,"C",$$UPPER^MAGQE4(WSTAT),""))
25 I 'SYSIEN D ;ATTEMPT TO FIND A MATCH FROM LOCAL NAME
26 . N TRY
27 . F TRY=1:1:$L(WSTAT,".") D Q:SYSIEN?1N.N
28 . . S SYSIEN=$O(^MAG(2006.8,"C",$P(WSTAT,".",TRY),""))
29 . . I 'SYSIEN S SYSIEN=$O(^MAG(2006.8,"C",$$UPPER^MAGQE4($P(WSTAT,".",TRY)),""))
30 I SYSIEN="" D Q
31 . S RESULT(0)="-1^This workstation is not currently setup as a Background Processor."
32 . Q
33 S NODE=^MAG(2006.8,SYSIEN,0)
34 S SYSNAME=$P(NODE,U)
35 I SYSNAME="" D Q
36 . S RESULT(0)="-1^This workstation is not currently setup as a Background Processor."
37 . Q
38 S RESULT(0)="0^BP List^PID: "_$$BASE^XLFUTL($J,10,16)_U_SYSNAME_U_WSTAT_U_$P(^MAG(2006.1,PLACE,0),U,2)
39 S (X,CNT)=0
40 F S X=$O(^MAG(2005.2,X)) Q:X'?1N.N S ZNODE=^(X,0) D
41 . Q:'$P(ZNODE,U,6) ;1=on-line
42 . Q:$E($P(ZNODE,U,2),1,2)'="\\"
43 . Q:$P(ZNODE,U,10)'=PLACE
44 . Q:(($P(ZNODE,U,7)'["WORM")&($P(ZNODE,U,7)'="RW"))
45 . S CNT=CNT+1,SHARE=$P(ZNODE,U,2)
46 . I $E(SHARE,$L(SHARE))="\" S SHARE=$E(SHARE,1,$L(SHARE)-1)
47 . S RESULT(CNT)=X_U_SHARE_U_$P(ZNODE,U,8)
48 Q
49JBPTR(RESULT,FILE) ;[MAGQ JBPTR]
50 S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
51 N IEN,SITEID
52 S SITEID=$$UPPER^MAGQE4($P(^MAG(2006.1,$$PLACE^MAGBAPI(+$G(DUZ(2))),0),U,2))
53 S IEN=$P(+$P(FILE,SITEID,2),".")
54 S RESULT=$$JBPTR^MAGQBPRG(IEN,$$FTYPE^MAGQBPRG($P(FILE,".",2)))
55 Q
56SHR(RESULT) ; RPC[MAGQ SHARES]
57 N TMP,INDX,DATA,CNT,SHARE,CWL,VALUE,PLACE ;CWL=CURRENT WRITE LOCATION
58 S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
59 S (CNT,INDX)=0,U="^",PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2)))
60 S CWL=$$CWL^MAGBAPI(PLACE)
61 F S INDX=$O(^MAG(2005.2,INDX)) Q:INDX'?1N.N D
62 . S DATA=$G(^MAG(2005.2,INDX,0))
63 . Q:$P(DATA,U,6,7)'["1^MAG"
64 . Q:$P(DATA,U,9)="1" ;ROUTING SHARE
65 . Q:$P(DATA,U,2)[":"
66 . Q:$P(DATA,U,10)'=PLACE
67 . S SHARE=$P(DATA,U,2)
68 . Q:$E(SHARE,1,2)'="\\"
69 . I $E(SHARE,$L(SHARE))="\" S SHARE=$E(SHARE,1,$L(SHARE)-1)
70 . S SHARE=SHARE_U_$P(DATA,U,8)
71 . Q:$D(TMP(SHARE))
72 . S TMP(SHARE)=INDX
73 S INDX=""
74 F S INDX=$O(TMP(INDX)) Q:INDX="" D
75 . S RESULT(CNT)=TMP(INDX)_U_INDX,CNT=CNT+1
76 . S ^TMP("MAGQBP",$J,"SHRLST",CNT-1)=TMP(INDX)_U_INDX
77 K TMP
78 Q
79CNP2(RESULT,IEN,START,STOP) ;[MAGQ JBSCN]
80 S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
81 N FNAME,PIECE,ZNODE,NODE2,BNODE,BNAME,PTR,HASH,TEMP,ORDER,RDATE,PLACE,OFFLINE,PLACEOK,GL,END,ACQSITE
82 S (RESULT,GL)="",PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2))),(OFFLINE,PLACEOK)=0
83 S:START="" START=$O(^MAG(2005,0)) S:STOP="" STOP=$O(^MAG(2005,"A"),-1)
84 S ORDER=$S(START>STOP:"R",1:"F")
85 I (IEN'?1N.N)!IEN=0 D I IEN="" S RESULT=0 Q
86 . I START=0 S IEN=START Q
87 . I ORDER="R" D
88 . . S I1=+$O(^MAG(2005," "),-1),I2=+$O(^MAG(2005.1," "),-1),END=$S(I1>I2:I1,1:I2)
89 . . S IEN=$S(START>END:START,1:START+1) Q
90 . E S IEN=START-1
91 . Q
92 S IEN=+IEN
93 F D SCAN^MAGQBPG1(.IEN,ORDER,.GL) D Q:((('OFFLINE)&PLACEOK)!('IEN)!($P(RESULT,U,21)="DUPE")!'$G(ACQSITE))
94 . Q:'IEN
95 . S ZNODE=$G(@(GL_IEN_",0)")),ACQSITE=$P($G(@(GL_IEN_",100)")),U,3)
96 . S PLACEOK=$S($$PLACE^MAGBAPI(+ACQSITE)=$$PLACE^MAGBAPI($G(DUZ(2))):1,1:"")
97 . I $P(ZNODE,U,2)'="" S OFFLINE=$$IMOFFLN^MAGFILEB($P(ZNODE,U,2)) ; Only check the offline status of image files
98 . I ($D(^MAG(2005.1,IEN,0))&$D(^MAG(2005,IEN,0))) D Q ; Image is duplicated in the Archive file
99 . . I $P(^MAG(2005,IEN,0),U,1,8)="^^^^^^^",+$P(^MAG(2005,IEN,0),U,9) K ^MAG(2005,IEN,0) Q
100 . . S FDA(2005,IEN_",",13.5)="1" ; Set Dupe field in the Image File
101 . . S FDA(2005,IEN_",",13)="1" ; Set IQ field in the Image File
102 . . D FILE^DIE("I","FDA","MSG") K FDA,MSG
103 . . S FDA(2005.1,IEN_",",13.5)="1" ; Set the Dupe field in the archive file
104 . . S FDA(2005.1,IEN_",",13)="1" ; and set the IQ field in the archive file
105 . . D FILE^DIE("I","FDA","MSG") K FDA,MSG
106 . . S $P(RESULT,U,21)="DUPE"
107 . . S $P(RESULT,U)=IEN
108 . . I $P(ZNODE,U,2)=$P($G(^MAG(2005.1,IEN,0)),U,2) S $P(RESULT,U,2)=$P(ZNODE,U,2) D
109 . . . I $P(RESULT,U,2)="" S $P(RESULT,U,2)="No File Name" Q
110 . . E S $P(RESULT,U,2)=$P(ZNODE,U,2)_"/"_$P($G(^MAG(2005.1,IEN,0)),U,2) D
111 . . . I $P($P(RESULT,U,2),"/")="" S $P(RESULT,U,2)="No File Name"_$P(RESULT,U,2)
112 . . . I $P($P(RESULT,U,2),"/",2)="" S $P(RESULT,U,2)=$P(RESULT,U,2)_"No File Name"
113 . . . Q
114 . . Q
115 . E I $P(ZNODE,U,2)'="" S $P(@(GL_IEN_",0)"),U,12)="0"
116 . Q
117 I $S('IEN:1,((ORDER="F")&(IEN>STOP)):1,((ORDER="R")&(IEN<STOP)):1,1:0) D Q
118 . S RESULT=0
119 . Q
120 S FNAME=$P(ZNODE,U,2)
121 S $P(RESULT,U)=IEN
122 Q:($P(RESULT,U,21)="DUPE")
123 S $P(RESULT,U,19)=$P($P($G(@(GL_IEN_",2)")),U),".")
124 I $P(ZNODE,U,2)'="" D ;NON-GROUP PARENT
125 . S BNODE=$G(@(GL_IEN_",""FBIG"")"))
126 . I $P(ZNODE,U,5)?1N.N S $P(RESULT,U,3)=$P(ZNODE,U,5)
127 . S:$P(BNODE,U,2)?1N.N $P(RESULT,U,4)=$P(BNODE,U,2)
128 . S:$P(ZNODE,U,3)?1N.N $P(RESULT,U,5)=$P(ZNODE,U,3)
129 . S:$P(ZNODE,U,4)?1N.N $P(RESULT,U,6)=$P(ZNODE,U,4)
130 . S:$P(BNODE,U)?1N.N $P(RESULT,U,7)=$P(BNODE,U)
131 . S $P(RESULT,U,8)=$$CWL^MAGBAPI(PLACE)
132 . S $P(RESULT,U,2)=FNAME
133 . I $D(@(GL_IEN_",""FBIG"")")),'$P(BNODE,U),'$P(BNODE,U,2) S $P(RESULT,U,22)="EMPTY_FBIG"
134 . Q
135 I '$P($G(@(GL_IEN_",100)")),U,3) S $P(RESULT,U,23)=-1 ;"NO ACQ SITE VALUE"
136 ;
137 I GL[("^MAG(2005.1,") S $P(RESULT,U,21)="ARCH"
138 E S $P(RESULT,U,12,17)=$$CHKIMG^MAGQBUT2(IEN)
139 Q
140JPUD(RESULT,JPTR,EXT,IEN) ; RPC[MAGQ JPUD]
141 N TYPE,PIECE,NODE,GL
142 S X="ERR^MAGQBTM",@^%ZOSF("TRAP"),RESULT="0"
143 S TYPE=$$FTYPE^MAGQBPRG(EXT)
144 S PIECE=$S(TYPE="BIG":2,1:5)
145 S NODE=$S(TYPE="BIG":"FBIG",1:0)
146 I JPTR="0" D Q:(RESULT<0)
147 . S JPTR=""
148 . S GL=$S($D(^MAG(2005,IEN)):"^MAG(2005,",$D(^MAG(2005.1,IEN)):"^MAG(2005.1,",1:0)
149 . I GL=0 S RESULT="-1" Q
150 . I $D(^MAGQUEUE(2006.033,"B",$P($G(@(GL_IEN_",0)")),U,2))) D Q
151 . . S RESULT=-2 Q ;Don't clear the JB pointer if image is on an Off-line Platter
152 . . Q
153 . Q
154 S:$D(^MAG(2005,IEN,NODE)) $P(^MAG(2005,IEN,NODE),U,PIECE)=JPTR
155 S:$D(^MAG(2005.1,IEN,NODE)) $P(^MAG(2005.1,IEN,NODE),U,PIECE)=JPTR
156 S RESULT="1"
157 Q
158VCUD(RESULT,VCPTR,EXT,IEN) ; RPC[MAGQ VCUD]
159 N TYPE,PIECE,NODE
160 S X="ERR^MAGQBTM",@^%ZOSF("TRAP"),RESULT="0"
161 S TYPE=$$FTYPE^MAGQBPRG(EXT)
162 S PIECE=$S(TYPE="BIG":1,TYPE="ABS":4,1:3)
163 S NODE=$S(TYPE="BIG":"FBIG",1:0)
164 S:VCPTR="0" VCPTR=""
165 S:$D(^MAG(2005,IEN,NODE)) $P(^MAG(2005,IEN,NODE),U,PIECE)=VCPTR
166 S:$D(^MAG(2005.1,IEN,NODE)) $P(^MAG(2005.1,IEN,NODE),U,PIECE)=VCPTR
167 S RESULT="1"
168 Q
169DFNIQ(RESULT,INPUT,SEND) ;
170 S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
171 N LOC,CNT,Y
172 S U="^"
173 S CNT=+$O(^TMP($J,"MAGQDFN",""),-1)
174 I CNT<2 D
175 . D NOW^%DTC S Y=% D DD^%DT
176 . S LOC=$$KSP^XUPARAM("WHERE")
177 . S ^TMP($J,"MAGQDFN",1)=" SITE: "_LOC
178 . S ^TMP($J,"MAGQDFN",2)=" DATE: "_Y_" "_$G(^XMB("TIMEZONE"))
179 . S CNT=2
180 . Q
181 I SEND="1" D
182 . S XMSUB=INPUT
183 . N XMY,XMTEXT
184 . S XMTEXT="^TMP($J,""MAGQDFN"","
185 . S XMY("G.MAG SERVER")=""
186 . S:$G(DUZ) XMY(DUZ)=""
187 . D ^XMD
188 . K ^TMP($J,"MAGQDFN")
189 . K XMSUB
190 . Q
191 E S CNT=CNT+1,^TMP($J,"MAGQDFN",CNT)=INPUT
192 S RESULT="1"
193 Q
194MOVE(RESULT,FNAM) ;[MAGQ MOVE]
195 S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
196 N IEN,FTYPE,NMSPC,SITEID,EXT,ALT,J
197 S NMSPC=$TR($P(FNAM,"."),"0123456789","")
198 S SITEID=$$INIS^MAGQBPG2($$PLACE^MAGBAPI(+DUZ(2)))
199 I SITEID'[(","_NMSPC_",") D Q
200 . S RESULT="0^Invalid Imaging Namespace"
201 S IEN=$O(^MAG(2005,"F",$P(FNAM,"."),""))
202 I IEN'?1N.N!('$D(^MAG(2005,IEN,0))) D Q
203 . S RESULT="0^No matching 2005 entry"
204 S EXT=$P(FNAM,".",2)
205 I $P($G(^MAG(2005,IEN,0)),U,2)[FNAM S RESULT=IEN_U_"FULL"
206 E D
207 . S FTYPE=$$FTYPE^MAGQBPRG(EXT)
208 . I FTYPE="FULL" D Q
209 . . D FTYPE^MAGQBUT(.ALT)
210 . . S J=""
211 . . F S J=$O(ALT(J)) Q:J'?1N.N S:ALT(J)[EXT FTYPE="ALT"
212 . . I FTYPE["ALT" S RESULT=IEN_U_FTYPE
213 . . E S RESULT="0^Invalid File Extension"
214 . E S RESULT=IEN_U_FTYPE
215 Q
216SCAN(IEN,ORDER,GB) ; Find the next image spanning the Image and the Image Archive file
217 I IEN,GB="^MAG(2005,",$D(^MAG(2005.1,IEN)) D Q
218 . S IEN=IEN,GB="^MAG(2005.1," Q
219 N I1,I2
220 I $G(ORDER)="F" D
221 . S I1=$O(^MAG(2005,IEN)),I1=$S(I1:I1,1:"")
222 . S I2=$O(^MAG(2005.1,IEN)),I2=$S(I2:I2,1:"")
223 . I I1,'I2 S IEN=I1,GB="^MAG(2005," Q
224 . I I2,'I1 S IEN=I2,GB="^MAG(2005.1," Q
225 . S GB=$S(I1>I2:"^MAG(2005.1,",1:"^MAG(2005,")
226 . S IEN=$S(I1>I2:I2,1:I1)
227 . Q
228 E D ;Reverse
229 . S I1=$O(^MAG(2005,IEN),-1),I1=$S(I1:I1,1:"")
230 . S I2=$O(^MAG(2005.1,IEN),-1),I2=$S(I2:I2,1:"")
231 . I I1,'I2 S IEN=I1,GB="^MAG(2005," Q
232 . I I2,'I1 S IEN=I2,GB="^MAG(2005.1," Q
233 . S GB=$S(I1<I2:"^MAG(2005.1,",1:"^MAG(2005,")
234 . S IEN=$S(I1<I2:I2,1:I1)
235 . Q
236 S IEN=$S('IEN:"",1:IEN)
237 Q
Note: See TracBrowser for help on using the repository browser.