source: FOIAVistA/tag/r/IMAGING-MAG-ZMAG/MAGQBTM.m@ 1796

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

WorldVistAEHR overlayed on FOIAVistA

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