source: FOIAVistA/trunk/r/IMAGING-MAG-ZMAG/MAGQBTM.m@ 1008

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

initial load of FOIAVistA 6/30/08 version

File size: 8.9 KB
Line 
1MAGQBTM ;WOIFO/RMP - REMOTE Task SERVER Program [ 03/25/2001 11:20 ]
2 ;;3.0;IMAGING;**1,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 ;;
18 ;
19ENTRY(RESULT,WSTAT,PROCESS) ; RPC[MAGQ ABP]
20 N X,SYSIEN,SYSNAME,NODE,INDX,CNT,PROC,%,QPTR,QCNT,VERS,EXEDATE,WSOS,PLACE,VOK
21 D NOW^%DTC
22 S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
23 S (SYSIEN,CNT)=0,SYSNAME="",PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2))),VOK=""
24 S $P(RESULT(0),U,6)=$D(^XUSEC("MAG SYSTEM",DUZ))
25 Q:'$P(RESULT(0),U,6)
26 S VERS=$P(WSTAT,U,2),EXEDATE=$P(WSTAT,U,3),WSOS=$P(WSTAT,U,4)
27 S WSTAT=$P(WSTAT,U)
28 S SYSIEN=$O(^MAG(2006.8,"C",PLACE,WSTAT,""))
29 I 'SYSIEN S SYSIEN=$O(^MAG(2006.8,"C",PLACE,$$UPPER^MAGQE4(WSTAT),""))
30 I 'SYSIEN D
31 . N TRY
32 . F TRY=1:1:$L(WSTAT,".") D Q:SYSIEN?1.N
33 . . S SYSIEN=$O(^MAG(2006.8,"C",PLACE,$P(WSTAT,".",TRY),""))
34 . . I 'SYSIEN S SYSIEN=$O(^MAG(2006.8,"C",PLACE,$$UPPER^MAGQE4($P(WSTAT,".",TRY)),""))
35 Q:SYSIEN=""
36 S $P(^MAG(2006.8,SYSIEN,1),U,2)=VERS
37 S $P(^MAG(2006.8,SYSIEN,1),U,3)=EXEDATE
38 S $P(^MAG(2006.8,SYSIEN,1),U,4)=WSOS
39 S VERS=$P(VERS,".",1,2)_"P"_$P(VERS,".",3)
40 D VOKR^MAGQBUT4(.VOK,VERS)
41 Q:'$P(VOK,U)
42 S ^TMP("MAGQN",$J,0)=SYSIEN_"^"_WSTAT
43 S NODE=^MAG(2006.8,SYSIEN,0)
44 S SYSNAME=$P(NODE,U)
45 I SYSNAME="" D Q
46 . S $P(RESULT(0),U,1,2)="-1^No Background Processor parameters on system"
47 I $P(NODE,U,12)'=1 D Q
48 . S $P(RESULT(0),U,1,2)="-1^Not assigned as a Background Processor"
49 F PROC="ABSTRACT","JUKEBOX","JBTOHD","DELETE","PREFET","GCC","IMPORT" D
50 . N FNUM,PIECE
51 . S FNUM=$$FNUM(PROC)
52 . S PIECE=$$GET1^DID(2006.8,FNUM,"","GLOBAL SUBSCRIPT LOCATION")
53 . S PIECE=$P(PIECE,";",2)
54 . I $P(NODE,U,PIECE)="1" D
55 . . N QCNT,QPTR
56 . . D ADD^MAGBAPI(0,PROC,PLACE)
57 . . S QPTR=$O(^MAGQUEUE(2006.031,"C",PLACE,PROC,""))
58 . . S QCNT=$P($G(^MAGQUEUE(2006.031,+QPTR,0)),U,3)
59 . . S CNT=CNT+1
60 . . S RESULT(CNT)=PROC_U_QCNT
61 . . Q
62 . Q
63 S $P(RESULT(0),U,1,5)="0^BP List^PID: "_$$BASE^XLFUTL($J,10,16)_"^"_SYSNAME_U_WSTAT
64 Q
65FNUM(PROCESS) ;
66 Q:PROC="ABSTRACT" 12
67 Q:PROC="JUKEBOX" 13
68 Q:PROC="JBTOHD" 14
69 Q:PROC="PREFET" 15
70 Q:PROC="IMPORT" 16
71 Q:PROC="GCC" 17
72 Q:PROC="DELETE" 20
73 Q 0
74GETQUE(RESULT,ACTION) ; RPC[MAGQ GET]
75 S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
76 D @(ACTION_"(.RESULT)")
77 I +RESULT<0 D
78 . D NOW^%DTC
79 . D QSTAT($P(RESULT,U,2),$P(RESULT,U,3),ACTION,$$PLACE^MAGBAPI(+$G(DUZ(2))))
80 . D QPTER(ACTION,$P(RESULT,U,2))
81 Q
82ABSTRACT(RESULT) ;
83 D DEQUEUE("ABSTRACT",.RESULT) Q
84JUKEBOX(RESULT) ;
85 D DEQUEUE("JUKEBOX",.RESULT) Q
86JBTOHD(RESULT) ;
87 D DEQUEUE("JBTOHD",.RESULT) Q
88GCC(RESULT) ;
89 D DEQUEUE("GCC",.RESULT) Q
90DELETE(RESULT) ;
91 D DEQUEUE("DELETE",.RESULT) Q
92PREFET(RESULT) ;
93 D DEQUEUE("PREFET",.RESULT) Q
94IMPORT(RESULT) ;
95 D DEQUEUE("IMPORT",.RESULT) Q
96DEQUEUE(QUE,RESULT) ;
97 S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
98 N QPTR,QPTR2,ROU,MAGIEN,ZNODE,MSG,IMQUE,PLACE
99 S PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2)))
100 S QPTR2=$O(^MAGQUEUE(2006.031,"C",PLACE,QUE,""))
101 S QPTR=$S(QPTR2:$P(^MAGQUEUE(2006.031,QPTR2,0),U,2),1:"")
102 S QPTR=$O(^MAGQUEUE(2006.03,"C",PLACE,QUE,QPTR))
103 I QPTR="" D Q
104 . S RESULT="0"_U_QPTR2_U_"No "_QUE_" "_QPTR2_" to process."
105 D QSTAT(QPTR,QUE_" in progress.",QUE,PLACE)
106 S ZNODE=$G(^MAGQUEUE(2006.03,QPTR,0))
107 I ZNODE="" S RESULT=-101_U_QPTR_U_"Queue Record does not exist" Q
108 I QUE="IMPORT" D ENTRY^MAGQBIM(QPTR,QUE,QPTR2,ZNODE,.RESULT) Q
109 S MAGIEN=$P(ZNODE,"^",7)
110 I ("^DELETE^JUKEBOX^")'[(U_QUE_U),(('(+MAGIEN))!('$D(^MAG(2005,+MAGIEN,0)))!($P(ZNODE,U)'=QUE)) D Q
111 . I $D(^MAG(2005.1,+MAGIEN,0)) D
112 . . S MSG="Image Record Deleted and in archive file."
113 . E S MSG="No valid image file number to process."
114 . S RESULT=-101_U_QPTR_U_MSG
115 S ROU=$$RESET(QUE)
116 I ROU="" S RESULT="-1"_U_QPTR_U_QUE_" Is an inactive process" Q
117 D @("ENTRY^"_ROU_"(.RESULT,QPTR)")
118 Q
119QSTAT(QPTR,MESSAGE,ACTION,PLACE) ;
120 N ZNODE
121 Q:QPTR=""
122 S MESSAGE=$TR(MESSAGE,":;<>.?/\'()*^%$#@!0123456789","")
123 Q:'$D(^MAGQUEUE(2006.03,QPTR,0))
124 S ZNODE=$G(^MAGQUEUE(2006.03,QPTR,0))
125 D NOW^%DTC
126 I $P(ZNODE,U,5)]"" D
127 . K ^MAGQUEUE(2006.03,"D",PLACE,$P(ZNODE,U),$E($P(ZNODE,U,5),1,30),QPTR) Q
128 S ^MAGQUEUE(2006.03,"D",PLACE,$P(ZNODE,U),$E(MESSAGE,1,30),QPTR)=""
129 S $P(^MAGQUEUE(2006.03,QPTR,0),U,5,6)=$P(MESSAGE,U)_U_%
130 I ACTION["IMPORT" D STAT^MAGQBIM(QPTR,%,MESSAGE)
131 Q
132QPTER(QUEUE,QPTR) ;
133 N QREC,PREV,PNODE,PLACE
134 S PLACE=$P($G(^MAGQUEUE(2006.03,QPTR,0)),U,12)
135 S PLACE=$S(PLACE:PLACE,1:$$PLACE^MAGBAPI(+$G(DUZ(2))))
136 S QREC=$O(^MAGQUEUE(2006.031,"C",PLACE,QUEUE,""))
137 S PREV=$S(QREC:$P(^MAGQUEUE(2006.031,QREC,0),U,2),1:"")
138 I PREV'=QPTR D Q
139 . D ADD^MAGBAPI(-1,QUEUE,PLACE)
140 . L +^MAGQUEUE(2006.031,QREC,0)
141 . S $P(^MAGQUEUE(2006.031,QREC,0),U,2)=QPTR
142 . L -^MAGQUEUE(2006.031,QREC,0)
143 . Q
144 D ADD^MAGBAPI(0,QUEUE,PLACE)
145 Q
146RESET(QUEUE) ; Set Routine parameter
147 Q:QUEUE="ABSTRACT" "MAGQBAB"
148 Q:QUEUE="JUKEBOX" "MAGQBJB"
149 Q:QUEUE="JBTOHD" "MAGQBJH"
150 Q:QUEUE="DELETE" "MAGQBD"
151 Q:QUEUE="PREFET" "MAGQBJH"
152 Q:QUEUE="IMPORT" "MAGQBIM"
153 Q:QUEUE="GCC" "MAGQBGCC"
154 Q ""
155RQCNT(PLACE) ;
156 N QIEN,QPTR,QNAM
157 S QNAM=""
158 F S QNAM=$O(^MAGQUEUE(2006.031,"C",PLACE,QNAM)) Q:QNAM="" D
159 . S QIEN=$O(^MAGQUEUE(2006.031,"C",PLACE,QNAM,"")) Q:QIEN'?1.N
160 . S QPTR=+$P(^MAGQUEUE(2006.031,QIEN,0),U,2)
161 . S $P(^MAGQUEUE(2006.031,QIEN,0),U,3)=""
162 . D ADD^MAGBAPI(0,QNAM,PLACE)
163 . Q
164 Q
165QUPDTE(RESULT,QPTR,UPDATE) ;RPC[MAGQ QUD]
166 S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
167 N NODE,STAT,TYPE,VPTR,MPTR,IEN,IDFN,MSG,PLACE
168 S NODE=$G(^MAGQUEUE(2006.03,QPTR,0))
169 S PLACE=$P(NODE,U,12)
170 S RESULT="1^QUEUE UPDATE COMPLETE"
171 S STAT=$P(UPDATE,U)
172 S TYPE=$P(NODE,U)
173 S MSG=$S($P(UPDATE,U,2)="":TYPE_" Process Error",1:$P(UPDATE,U,2))
174 D QSTAT(QPTR,MSG,TYPE,PLACE)
175 D QPTER(TYPE,QPTR)
176 I STAT<0 Q
177 I "^DELETE^"[("^"_TYPE_"^") D DQUE^MAGQBUT(QPTR) Q
178 I "^IMPORT^"[("^"_TYPE_"^") D Q
179 . D DQUE^MAGQBUT(QPTR)
180 . S DIK="^MAG(2006.034,",DA=QPTR D ^DIK
181 . S DIK="^MAG(2006.041,",DA=QPTR D ^DIK
182 . K DIK,DA
183 . Q
184 S VPTR=$P(UPDATE,U,3)
185 I VPTR?1.N D
186 . S MPTR=$P(NODE,U,7)
187 . I "^ABSTRACT^"[("^"_TYPE_"^") D Q
188 . . S $P(^MAG(2005,MPTR,0),U,4)=VPTR
189 . . S X=$$JUKEBOX^MAGBAPI(MPTR,PLACE)
190 . . D DQUE^MAGQBUT(QPTR) Q
191 . I ("^JBTOHD^"[("^"_TYPE_"^"))!("^PREFET^"[("^"_TYPE_"^")) D Q
192 . . I "^FULL^"[$P(NODE,U,8) S $P(^MAG(2005,MPTR,0),U,3)=VPTR
193 . . I "^ABSTRACT^"[$P(NODE,U,8) S $P(^MAG(2005,MPTR,0),U,4)=VPTR
194 . . I "^BIG^"[$P(NODE,U,8) S $P(^MAG(2005,MPTR,"FBIG"),U)=VPTR
195 . . D DQUE^MAGQBUT(QPTR) Q
196 . I "^JUKEBOX^"[("^"_TYPE_"^") D Q
197 . . I $P(UPDATE,U,2)["BIG" D Q
198 . . . S:$D(^MAG(2005,MPTR)) $P(^MAG(2005,MPTR,"FBIG"),U,2)=VPTR
199 . . . S:$D(^MAG(2005.1,MPTR)) $P(^MAG(2005.1,MPTR,"FBIG"),U,2)=VPTR
200 . . . D DQUE^MAGQBUT(QPTR) Q
201 . . E D
202 . . . S:$D(^MAG(2005,MPTR)) $P(^MAG(2005,MPTR,0),U,5)=VPTR
203 . . . S:$D(^MAG(2005.1,MPTR)) $P(^MAG(2005.1,MPTR,0),U,5)=VPTR
204 . . . D DQUE^MAGQBUT(QPTR) Q
205 . . Q
206 . I "^GCC^"[("^"_TYPE_"^") D Q
207 . . D NOW^%DTC
208 . . S FDA(2005.01,"+1,"_MPTR_",",.01)=VPTR
209 . . S FDA(2005.01,"+1,"_MPTR_",",1)=%
210 . . S FDA(2005.01,"+1,"_MPTR_",",2)=$P($$TRIM^MAGQBUT4($P(UPDATE,U,2))," ")
211 . . D UPDATE^DIE("U","FDA","","MAGIMP")
212 . . S IDFN=$P(^MAG(2005,MPTR,0),U,7)
213 . . D ENTRY^MAGLOG("EXPORT->"_$P($G(^MAG(2005.2,VPTR,0)),U,2),$P(NODE,U,2),MPTR,"Document Imaging",IDFN,0)
214 . . D DQUE^MAGQBUT(QPTR) Q
215 . Q
216 Q
217REQUE(RESULT,QPTR) ;
218 ; RPC[MAGQ REQ]
219 S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
220 N PROC,NODE,INDX,PARAM,OPDUZ,STATUS,TRACKID,PLACE
221 S INDX=$$TRIM^MAGQBUT4(QPTR),TRACKID=0
222 S NODE=$G(^MAGQUEUE(2006.03,INDX,0))
223 Q:NODE']""
224 S PLACE=$P(NODE,U,12)
225 Q:'PLACE
226 S PROC=$P(NODE,U),STATUS=$P(NODE,U,5)
227 I PROC'="IMPORT" D
228 . D RQP(PROC,NODE,.PARAM)
229 . S @("RESULT=$$"_PROC_"^MAGBAPI(PARAM,PLACE)")
230 . Q
231 E D
232 . S $P(PARAM,U,3)=+$P(NODE,U,9)+1
233 . S $P(PARAM,U,4)=$S($P(NODE,U,11)?1N.N:$P(NODE,U,11),1:QPTR)
234 . D TIDL^MAGQBIM($S($P(NODE,U,11)?1N.N:$P(NODE,U,11),1:QPTR),PROC,.TRACKID)
235 . Q:TRACKID=0
236 . S @("RESULT=$$"_PROC_"^MAGBAPI(PARAM,$P(NODE,U,10),TRACKID,PLACE)")
237 Q:((PROC="IMPORT")&(TRACKID=0))
238 D DQUE^MAGQBUT(INDX)
239 Q
240RQP(P,N,PAR) ;
241 N P1,P2,P3,P4
242 I ("^JBTOHD^PREFET^")[P S P1=$P(N,U,7),P2=$P(N,U,8),P3=+$P(N,U,9)+1,PAR=P1_U_P2_U_P3 Q
243 I P["DELETE" S P1=$P(N,U,10),P2=+$P(N,U,9)+1,PAR=P2_U_P1 Q
244 I P["GCC" D Q
245 . S P1=$P(N,U,7),P2=$P(N,U,10),P3=$P(N,U,11),P4=$P(N,U,9)+1,PAR=P1_U_P2_U_P3_U_P4 Q
246 S P1=$P(N,U,7)_"^^",P2=+$P(N,U,9)+1,PAR=P1_P2 ;JUKEBOX + ABSTRACT
247 Q
248ERR ;
249 N ERRXX
250 S ERRXX=$$EC^%ZOSV
251 D ^%ZTER
252 D ^XUSCLEAN
253 Q
Note: See TracBrowser for help on using the repository browser.