source: WorldVistAEHR/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7ADL.m@ 619

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

initial load of WorldVistAEHR
File size: 7.4 KB
Line 
1LA7ADL ;DALOI/JMC - Automatic Download of Test Orders;May 30, 2008
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**17,25,23,57,66**;Sep 27, 1994;Build 30
3 ;
4 ; This routine will monitor the ^LA("ADL") node to check for accessions which are to have test orders automatically
5 ; downloaded to another computer system. All entries in the auto instrument file which are flagged for automatic downloading
6 ; will be checked to see if they contain any tests on the accession. If tests are found then the appropiate download message
7 ; is constructed and sent.
8 ;
9 ;
10EN(LA7UID) ; Set flag to check accession for downloading, start background job if needed.
11 ; Called by LR7OMERG, LRCONJAM, LRTSTSET, LRWLST1.
12 ;
13 ; No UID passed to routine.
14 I $G(LA7UID)="" Q
15 ;
16 ; No instrument flagged for auto downloading.
17 I '$D(^LAB(62.4,"AE")) Q
18 ;
19 ; Quit if "Don't Start/Collect" flag set.
20 I +$G(^LA("ADL","STOP"),0)=3 Q
21 ;
22 ; Lock node in case already downloading this accession, wait until downloading finished.
23 L +^LA("ADL","Q",LA7UID):60
24 ;
25 ; Set flag to check this accession for auto downloading.
26 S ^LA("ADL","Q",LA7UID)=""
27 ;
28 ; Release lock.
29 L -^LA("ADL","Q",LA7UID)
30 ;
31 ; Quit if "Don't Start" flag set.
32 I +$G(^LA("ADL","STOP"),0)=2 Q
33 ;
34 ; Task background job to run.
35 D CHKTSK
36 ;
37 ; Unlock node.
38 L -^LA("ADL",0)
39 ;
40 Q
41 ;
42 ;
43DQ ; Entry point from Taskman.
44 ;
45 ; Wait for a little while in case another job checking for background job has lock.
46 L +^LA("ADL",0):10
47 ; Another process has lock, only want one at a time.
48 I '$T S:$D(ZTQUEUED) ZTREQ="@" Q
49 ;
50 ; No instrument flagged for auto downloading.
51 I '$D(^LAB(62.4,"AE")) D EXIT Q
52 ;
53 ; Quit if "Don't Start/Collect" flags set.
54 I +$G(^LA("ADL","STOP"),0)>1 Q
55 ;
56 ; Update XTMP entry to let auto download know we're running for this process
57 ; and build table of tests to check for downloading}
58 D XTMP,BUILD
59 ;
60 F D UID Q:TOUT>60
61 D EXIT
62 Q
63 ;
64 ;
65UID ; Start loop to monitor for accessions to download.
66 ;
67 S LA7UID="",(TOUT,ZTSTOP)=0
68 ;
69 ; Flag set to "Rebuild".
70 I +$G(^LA("ADL","STOP"))=1,'ZTSTOP D BUILD
71 ;
72 F S LA7UID=$O(^LA("ADL","Q",LA7UID)) Q:LA7UID=""!(ZTSTOP)!(TOUT) D
73 . I +$G(^LA("ADL","STOP"))>0 S TOUT=61 Q
74 . I $$S^%ZTLOAD("Processing Lab UID "_LA7UID) S ZTSTOP=1,TOUT=61 Q
75 . ; Lock this UID, synch setting/deleting when another job is attempting to set node.
76 . D LOCK^DILF("^LA(""ADL"",""Q"",LA7UID)")
77 . ; Unable to get lock, go on to next UID, check again on next go around.
78 . I '$T Q
79 . ; Get accession info from ^LRO(68,"C").
80 . S X=$Q(^LRO(68,"C",LA7UID))
81 . ; Quit - UID does not match.
82 . I $QS(X,3)'=LA7UID D CLEANUP Q
83 . ; Setup accession variables for auto downloading.
84 . S LRAA=+$QS(X,4),LRAD=+$QS(X,5),LRAN=+$QS(X,6)
85 . D BLDTST
86 . S LA7INST=0
87 . F S LA7INST=$O(LA7AUTO(LA7INST)) Q:'LA7INST D
88 . . D CHKTEST
89 . . ; No tests on instrument list for this accession.
90 . . I '$D(LA7ACC) Q
91 . . S LRINST=LA7INST,LRAUTO=LA7AUTO(LA7INST)
92 . . N LA7UID
93 . . ; File build (entry^routine) from fields #93 and #94 in file #62.4.
94 . . D @$P(LA7AUTO(LA7INST,9),"^",3,4)
95 . D CLEANUP,XTMP
96 ;
97 F D Q:$O(^LA("ADL","Q",""))'="" Q:TOUT>60
98 . I $G(^LA("ADL","STOP"))>1 S TOUT=61 Q
99 . ; Task has been requested to stop.
100 . I $$S^%ZTLOAD("Idle - waiting for new accessions to process") S TOUT=61,ZTSTOP=1 Q
101 . S TOUT=TOUT+1 H 5 D XTMP
102 ;
103 Q
104 ;
105 ;
106BLDTST ; Build array of tests on accession to check for downloading
107 ;
108 N X,LA760,LA7PCNT
109 ;
110 K LA7TREE
111 S LA760=0
112 F S LA760=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LA760)) Q:'LA760 D
113 . ; Quit if test has been removed from accession.
114 . S X=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LA760,0),0) Q:'X
115 . ; If test completed (#4, COMPLETE DATE entered), don't download.
116 . I $P(X,"^",5) Q
117 . ; Build array of atomic tests on accession with urgency.
118 . S LA7PCNT=0
119 . D UNWIND^LA7ADL1(LA760,$P(X,"^",2),0)
120 ;
121 Q
122 ;
123 ;
124CHKTEST ; Check tests to determine if they should build in message.
125 ; Array LA7ACC returned with tests to send in message
126 ;
127 N LA760,LA761,LA76205,LA768,LA7I,LRDPF,X
128 ;
129 K LA7ACC
130 ;
131 ; Quit - specimen uncollected & don't download uncollected flag set.
132 ; controls exempted.
133 S LRDPF=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,0)),"^",2)
134 S X=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,3))
135 I LRDPF'=62.3,'$P(X,"^",3),'$P(^TMP("LA7-INST",$J,LA7INST),"^") Q
136 ;
137 S X=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,5,0))
138 S LA761=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,5,X,0),"^")
139 S LA760=0
140 F S LA760=$O(LA7TREE(LA760)) Q:'LA760 D
141 . I '$D(^TMP("LA7-INST",$J,LA7INST,LA760)) Q
142 . S LA7I=0
143 . F S LA7I=$O(^TMP("LA7-INST",$J,LA7INST,LA760,LA7I)) Q:'LA7I D
144 . . S LA76205=+$P(LA7TREE(LA760),"^")
145 . . D CHKMASK
146 ;
147 Q
148 ;
149CHKMASK ; Check pattern mask for tests that match download pattern mask
150 ;
151 ; Any accession area, specimen, urgency
152 I $D(^TMP("LA7-INST",$J,LA7INST,LA760,LA7I,0,0,0)) D ADD Q
153 ;
154 ; Specific accession area, any specimen/urgency
155 I $D(^TMP("LA7-INST",$J,LA7INST,LA760,LA7I,LRAA,0,0)) D ADD Q
156 ;
157 ; Specific specimen, any accession area/urgency
158 I $D(^TMP("LA7-INST",$J,LA7INST,LA760,LA7I,0,LA761,0)) D ADD Q
159 ;
160 ; Specific urgency, any accession area/specimen
161 I $D(^TMP("LA7-INST",$J,LA7INST,LA760,LA7I,0,0,LA76205)) D ADD Q
162 ;
163 ; Specific accession/specimen, any urgency
164 I $D(^TMP("LA7-INST",$J,LA7INST,LA760,LA7I,LRAA,LA761,0)) D ADD Q
165 ;
166 ; Specific specimen/urgency, any accession area
167 I $D(^TMP("LA7-INST",$J,LA7INST,LA760,LA7I,0,LA761,LA76205)) D ADD Q
168 ;
169 ; Specific accession/specimen/urgency
170 I $D(^TMP("LA7-INST",$J,LA7INST,LA760,LA7I,LRAA,LA761,LA76205)) D ADD Q
171 ;
172 Q
173 ;
174ADD ; Add to list of tests to download
175 ;
176 S LA7ACC(LA7I)=LA760_"^"_LA7TREE(LA760)
177 Q
178 ;
179 ;
180CLEANUP ; Delete flag after accession has been checked.
181 ; NOTE: Lock previously set above.
182 ;
183 K ^LA("ADL","Q",LA7UID)
184 ;
185 ; Release lock on this UID.
186 L -^LA("ADL","Q",LA7UID)
187 ;
188 Q
189 ;
190 ;
191CHKTSK ; Check if we shoud task the auto download processing routine.
192 ; Check if we recently tasked the processing routine for this process by compaing values in the XTMP global.
193 ; Done to avoid repetitive locking attempts on each new accessione since the FileMan locking API uses a site-defined timeout which is usually 3 seconds
194 ; but can be more. Slows down the interface if on each accession we are waiting 3 or more seconds for the lock to find out if the processing routine
195 ; is already running.
196 ;
197 N LA7X,LA7Y
198 S LA7X=$H,LA7Y=$G(^XTMP("LA7ADL",1))
199 I $P(LA7X,",")=$P(LA7Y,","),($P(LA7X,",",2)-$P(LA7Y,",",2))<240 Q
200 ;
201 ; Lock zeroth node.
202 ; Quit if another process has lock - either another job setting node or the background job.
203 D LOCK^DILF("^LA(""ADL"",0)")
204 I '$T Q
205 ;
206ZTSK ; Task background job to run.
207 ;
208 ; Call here to queue this processing routine to run in the background.
209 ;
210 ; Task background job if not running.
211 N ZTDESC,ZTSAVE,ZTDTH,ZTIO,ZTRTN
212 S ZTRTN="DQ^LA7ADL",ZTDESC="Lab Auto Download",ZTIO="",ZTDTH=$H
213 D ^%ZTLOAD
214 ;
215 Q
216 ;
217 ;
218BUILD ; Build TMP global with list of tests for instruments flagged for auto download.
219 ;
220 D BUILD^LA7ADL1
221 ;
222 ; Set flag to "Running".
223 D SETSTOP^LA7ADL1(0,$G(DUZ))
224 ;
225 Q
226 ;
227 ;
228XTMP ; Set/update XTMP with current run time of this processing routine
229 ;
230 S DT=$$DT^XLFDT
231 S ^XTMP("LA7ADL",0)=DT_"^"_DT_"^LAB AUTO DOWNLOAD PROCESS TASKING"
232 S ^XTMP("LA7ADL",1)=$H
233 Q
234 ;
235 ;
236EXIT ; Exit and cleanup.
237 ;
238 ; Release lock on LA("ADL") global.
239 L -^LA("ADL",0)
240 ;
241 K ^TMP("LA7",$J),^TMP($J),^XTMP("LA7ADL",1)
242 K LA7ADL,LA7AUTO,LA7NVAF,LRAA,LRAD,LRAN,TOUT
243 ;
244 ; Clear flag if normal shutdown, no new accessions.
245 I +$G(^LA("ADL","STOP"))<2 K ^LA("ADL","STOP")
246 ;
247 ; Set flag for taskman to cleanup task.
248 I $D(ZTQUEUED) S ZTREQ="@"
249 Q
Note: See TracBrowser for help on using the repository browser.