source: FOIAVistA/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7ADL.m@ 1328

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

initial load of FOIAVistA 6/30/08 version
File size: 6.2 KB
Line 
1LA7ADL ;DALOI/JMC - Automatic Download of Test Orders; 1/30/95 09:00
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**17,25,23,57**;Sep 27, 1994
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 ; Lock zeroth node.
35 ; Quit if another process has lock
36 ; - either another job setting node or the background job.
37 L +^LA("ADL",0):1
38 I '$T Q
39 ;
40 ; Task background job to run.
41 N ZTSK
42 D ZTSK
43 ;
44 ; Unlock node.
45 L -^LA("ADL",0)
46 ;
47 Q
48 ;
49 ;
50DQ ; Entry point from Taskman.
51 ;
52 ; Set flag for taskman to cleanup task.
53 I $D(ZTQUEUED) S ZTREQ="@"
54 ;
55 ; Wait for a little while in case another job checking for background job has lock.
56 L +^LA("ADL",0):10
57 ; Another process has lock, only want one at a time.
58 I '$T Q
59 ;
60 ; No instrument flagged for auto downloading.
61 I '$D(^LAB(62.4,"AE")) D EXIT Q
62 ;
63 ; Quit if "Don't Start/Collect" flags set.
64 I +$G(^LA("ADL","STOP"),0)>1 Q
65 ;
66 D BUILD
67 ;
68 F D UID Q:TOUT>60
69 D EXIT
70 Q
71 ;
72 ;
73UID ; Start loop to monitor for accessions to download.
74 ;
75 S LA7UID="",(TOUT,ZTSTOP)=0
76 ;
77 ; Flag set to "Rebuild".
78 I +$G(^LA("ADL","STOP"))=1,'ZTSTOP D BUILD
79 ;
80 F S LA7UID=$O(^LA("ADL","Q",LA7UID)) Q:LA7UID=""!(ZTSTOP)!(TOUT) D
81 . I +$G(^LA("ADL","STOP"))>0 S TOUT=61 Q
82 . I $$S^%ZTLOAD S ZTSTOP=1,TOUT=61 Q
83 . ; Lock this UID, synch setting/deleting when another job is attempting to set node.
84 . L +^LA("ADL","Q",LA7UID):1
85 . ; Unable to get lock, go on to next UID, check again on next go around.
86 . I '$T Q
87 . ; Get accession info from ^LRO(68,"C").
88 . S X=$Q(^LRO(68,"C",LA7UID))
89 . ; Quit - UID does not match.
90 . I $QS(X,3)'=LA7UID D CLEANUP Q
91 . ; Setup accession variables for auto downloading.
92 . S LRAA=+$QS(X,4),LRAD=+$QS(X,5),LRAN=+$QS(X,6)
93 . D BLDTST
94 . S LA7INST=0
95 . F S LA7INST=$O(LA7AUTO(LA7INST)) Q:'LA7INST D
96 . . D CHKTEST
97 . . ; No tests on instrument list for this accession.
98 . . I '$D(LA7ACC) Q
99 . . S LRINST=LA7INST,LRAUTO=LA7AUTO(LA7INST)
100 . . N LA7UID
101 . . ; File build (entry^routine) from fields #93 and #94 in file #62.4.
102 . . D @$P(LA7AUTO(LA7INST,9),"^",3,4)
103 . D CLEANUP
104 ;
105 F D Q:$O(^LA("ADL","Q",""))'="" Q:TOUT>60
106 . I $G(^LA("ADL","STOP"))>1 S TOUT=61 Q
107 . ; Task has been requested to stop.
108 . I $$S^%ZTLOAD S TOUT=61,ZTSTOP=1 Q
109 . S TOUT=TOUT+1 H 5
110 ;
111 Q
112 ;
113 ;
114BLDTST ; Build array of tests on accession to check for downloading
115 ;
116 N X,LA760,LA7PCNT
117 ;
118 K LA7TREE
119 S LA760=0
120 F S LA760=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LA760)) Q:'LA760 D
121 . ; Quit if test has been removed from accession.
122 . S X=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LA760,0),0) Q:'X
123 . ; If test completed (#4, COMPLETE DATE entered), don't download.
124 . I $P(X,"^",5) Q
125 . ; Build array of atomic tests on accession with urgency.
126 . S LA7PCNT=0
127 . D UNWIND^LA7ADL1(LA760,$P(X,"^",2),0)
128 ;
129 Q
130 ;
131 ;
132CHKTEST ; Check tests to determine if they should build in message.
133 ; Array LA7ACC returned with tests to send in message
134 ;
135 N LA760,LA761,LA76205,LA768,LA7I,LRDPF,X
136 ;
137 K LA7ACC
138 ;
139 ; Quit - specimen uncollected & don't download uncollected flag set.
140 ; controls exempted.
141 S LRDPF=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,0)),"^",2)
142 S X=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,3))
143 I LRDPF'=62.3,'$P(X,"^",3),'$P(^TMP("LA7-INST",$J,LA7INST),"^") Q
144 ;
145 S X=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,5,0))
146 S LA761=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,5,X,0),"^")
147 S LA760=0
148 F S LA760=$O(LA7TREE(LA760)) Q:'LA760 D
149 . I '$D(^TMP("LA7-INST",$J,LA7INST,LA760)) Q
150 . S LA7I=0
151 . F S LA7I=$O(^TMP("LA7-INST",$J,LA7INST,LA760,LA7I)) Q:'LA7I D
152 . . S LA76205=+$P(LA7TREE(LA760),"^")
153 . . D CHKMASK
154 ;
155 Q
156 ;
157CHKMASK ; Check pattern mask for tests that match download pattern mask
158 ;
159 ; Any accession area, specimen, urgency
160 I $D(^TMP("LA7-INST",$J,LA7INST,LA760,LA7I,0,0,0)) D ADD Q
161 ;
162 ; Specific accession area, any specimen/urgency
163 I $D(^TMP("LA7-INST",$J,LA7INST,LA760,LA7I,LRAA,0,0)) D ADD Q
164 ;
165 ; Specific specimen, any accession area/urgency
166 I $D(^TMP("LA7-INST",$J,LA7INST,LA760,LA7I,0,LA761,0)) D ADD Q
167 ;
168 ; Specific urgency, any accession area/specimen
169 I $D(^TMP("LA7-INST",$J,LA7INST,LA760,LA7I,0,0,LA76205)) D ADD Q
170 ;
171 ; Specific accession/specimen, any urgency
172 I $D(^TMP("LA7-INST",$J,LA7INST,LA760,LA7I,LRAA,LA761,0)) D ADD Q
173 ;
174 ; Specific specimen/urgency, any accession area
175 I $D(^TMP("LA7-INST",$J,LA7INST,LA760,LA7I,0,LA761,LA76205)) D ADD Q
176 ;
177 ; Specific accession/specimen/urgency
178 I $D(^TMP("LA7-INST",$J,LA7INST,LA760,LA7I,LRAA,LA761,LA76205)) D ADD Q
179 ;
180 Q
181 ;
182ADD ; Add to list of tests to download
183 ;
184 S LA7ACC(LA7I)=LA760_"^"_LA7TREE(LA760)
185 Q
186 ;
187 ;
188CLEANUP ; Delete flag after accession has been checked.
189 ; NOTE: Lock previously set above.
190 ;
191 K ^LA("ADL","Q",LA7UID)
192 ;
193 ; Release lock on this UID.
194 L -^LA("ADL","Q",LA7UID)
195 ;
196 Q
197 ;
198 ;
199ZTSK ; Task background job to run.
200 ;
201 N ZTDESC,ZTSAVE,ZTDTH,ZTIO,ZTRTN
202 ;
203 ; Task background job if not running.
204 S ZTRTN="DQ^LA7ADL",ZTDESC="Lab Auto Download",ZTIO="",ZTDTH=$H
205 D ^%ZTLOAD
206 ;
207 Q
208 ;
209 ;
210BUILD ; Build TMP global with list of tests for instruments flagged for auto download.
211 D BUILD^LA7ADL1
212 ;
213 ; Set flag to "Running".
214 D SETSTOP^LA7ADL1(0,$G(DUZ))
215 ;
216 Q
217 ;
218 ;
219EXIT ; Exit and cleanup.
220 ;
221 ; Release lock on LA("ADL") global.
222 L -^LA("ADL",0)
223 ;
224 K ^TMP("LA7",$J),^TMP($J)
225 K LA7ADL
226 K LRAA,LRAD,LRAN
227 K TOUT
228 ;
229 ; Clear flag if normal shutdown, no new accessions.
230 I +$G(^LA("ADL","STOP"))<2 K ^LA("ADL","STOP")
231 ;
232 Q
Note: See TracBrowser for help on using the repository browser.