source: FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGQBPG1.m@ 636

Last change on this file since 636 was 636, checked in by George Lilly, 14 years ago

WorldVistAEHR overlayed on FOIAVistA
File size: 9.2 KB
Line 
1MAGQBPG1 ;WOIFO/RMP - REMOTE Task SERVER Program [ 11/08/2001 17:18 ]
2 ;;3.0;IMAGING;**7,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,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
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"))
94 . Q:'IEN
95 . S ZNODE=$G(@(GL_IEN_",0)"))
96 . S PLACEOK=$S($P($G(@(GL_IEN_",100)")),U,3)=$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 GL[("^MAG(2005.1,") S $P(RESULT,U,21)="ARCH"
136 E S $P(RESULT,U,12,17)=$$CHKIMG^MAGQBUT2(IEN)
137 Q
138JPUD(RESULT,JPTR,EXT,IEN) ; RPC[MAGQ JPUD]
139 N TYPE,PIECE,NODE,GL
140 S X="ERR^MAGQBTM",@^%ZOSF("TRAP"),RESULT="0"
141 S TYPE=$$FTYPE^MAGQBPRG(EXT)
142 S PIECE=$S(TYPE="BIG":2,1:5)
143 S NODE=$S(TYPE="BIG":"FBIG",1:0)
144 I JPTR="0" D Q:(RESULT<0)
145 . S JPTR=""
146 . S GL=$S($D(^MAG(2005,IEN)):"^MAG(2005,",$D(^MAG(2005.1,IEN)):"^MAG(2005.1,",1:0)
147 . I GL=0 S RESULT="-1" Q
148 . I $D(^MAGQUEUE(2006.033,"B",$P($G(@(GL_IEN_",0)")),U,2))) D Q
149 . . S RESULT=-2 Q ;Don't clear the JB pointer if image is on an Off-line Platter
150 . . Q
151 . Q
152 S:$D(^MAG(2005,IEN,NODE)) $P(^MAG(2005,IEN,NODE),U,PIECE)=JPTR
153 S:$D(^MAG(2005.1,IEN,NODE)) $P(^MAG(2005.1,IEN,NODE),U,PIECE)=JPTR
154 S RESULT="1"
155 Q
156VCUD(RESULT,VCPTR,EXT,IEN) ; RPC[MAGQ VCUD]
157 N TYPE,PIECE,NODE
158 S X="ERR^MAGQBTM",@^%ZOSF("TRAP"),RESULT="0"
159 S TYPE=$$FTYPE^MAGQBPRG(EXT)
160 S PIECE=$S(TYPE="BIG":1,TYPE="ABS":4,1:3)
161 S NODE=$S(TYPE="BIG":"FBIG",1:0)
162 S:VCPTR="0" VCPTR=""
163 S:$D(^MAG(2005,IEN,NODE)) $P(^MAG(2005,IEN,NODE),U,PIECE)=VCPTR
164 S:$D(^MAG(2005.1,IEN,NODE)) $P(^MAG(2005.1,IEN,NODE),U,PIECE)=VCPTR
165 S RESULT="1"
166 Q
167DFNIQ(RESULT,INPUT,SEND) ;
168 S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
169 N LOC,CNT,Y
170 S U="^"
171 S CNT=+$O(^TMP($J,"MAGQDFN",""),-1)
172 I CNT<2 D
173 . D NOW^%DTC S Y=% D DD^%DT
174 . S LOC=$$KSP^XUPARAM("WHERE")
175 . S ^TMP($J,"MAGQDFN",1)=" SITE: "_LOC
176 . S ^TMP($J,"MAGQDFN",2)=" DATE: "_Y_" "_$G(^XMB("TIMEZONE"))
177 . S CNT=2
178 . Q
179 I SEND="1" D
180 . S XMSUB=INPUT
181 . N XMY,XMTEXT
182 . S XMTEXT="^TMP($J,""MAGQDFN"","
183 . S XMY("G.MAG SERVER")=""
184 . S:$G(DUZ) XMY(DUZ)=""
185 . D ^XMD
186 . K ^TMP($J,"MAGQDFN")
187 . Q
188 E S CNT=CNT+1,^TMP($J,"MAGQDFN",CNT)=INPUT
189 S RESULT="1"
190 Q
191MOVE(RESULT,FNAM) ;[MAGQ MOVE]
192 S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
193 N IEN,FTYPE,NMSPC,SITEID,EXT,ALT,J
194 S NMSPC=$TR($P(FNAM,"."),"0123456789","")
195 S SITEID=$$INIS^MAGQBPG2($$PLACE^MAGBAPI(+DUZ(2)))
196 I SITEID'[(","_NMSPC_",") D Q
197 . S RESULT="0^Invalid Imaging Namespace"
198 S IEN=$O(^MAG(2005,"F",$P(FNAM,"."),""))
199 I IEN'?1N.N!('$D(^MAG(2005,IEN,0))) D Q
200 . S RESULT="0^No matching 2005 entry"
201 S EXT=$P(FNAM,".",2)
202 I $P($G(^MAG(2005,IEN,0)),U,2)[FNAM S RESULT=IEN_U_"FULL"
203 E D
204 . S FTYPE=$$FTYPE^MAGQBPRG(EXT)
205 . I FTYPE="FULL" D Q
206 . . D FTYPE^MAGQBUT(.ALT)
207 . . S J=""
208 . . F S J=$O(ALT(J)) Q:J'?1N.N S:ALT(J)[EXT FTYPE="ALT"
209 . . I FTYPE["ALT" S RESULT=IEN_U_FTYPE
210 . . E S RESULT="0^Invalid File Extension"
211 . E S RESULT=IEN_U_FTYPE
212 Q
213SCAN(IEN,ORDER,GB) ; Find the next image spanning the Image and the Image Archive file
214 I IEN,GB="^MAG(2005,",$D(^MAG(2005.1,IEN)) D Q
215 . S IEN=IEN,GB="^MAG(2005.1," Q
216 N I1,I2
217 I $G(ORDER)="F" D
218 . S I1=$O(^MAG(2005,IEN)),I1=$S(I1:I1,1:"")
219 . S I2=$O(^MAG(2005.1,IEN)),I2=$S(I2:I2,1:"")
220 . I I1,'I2 S IEN=I1,GB="^MAG(2005," Q
221 . I I2,'I1 S IEN=I2,GB="^MAG(2005.1," Q
222 . S GB=$S(I1>I2:"^MAG(2005.1,",1:"^MAG(2005,")
223 . S IEN=$S(I1>I2:I2,1:I1)
224 . Q
225 E D ;Reverse
226 . S I1=$O(^MAG(2005,IEN),-1),I1=$S(I1:I1,1:"")
227 . S I2=$O(^MAG(2005.1,IEN),-1),I2=$S(I2:I2,1:"")
228 . I I1,'I2 S IEN=I1,GB="^MAG(2005," Q
229 . I I2,'I1 S IEN=I2,GB="^MAG(2005.1," Q
230 . S GB=$S(I1<I2:"^MAG(2005.1,",1:"^MAG(2005,")
231 . S IEN=$S(I1<I2:I2,1:I1)
232 . Q
233 S IEN=$S('IEN:"",1:IEN)
234 Q
Note: See TracBrowser for help on using the repository browser.