source: FOIAVistA/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7ADL1.m@ 1123

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

initial load of FOIAVistA 6/30/08 version
File size: 5.1 KB
Line 
1LA7ADL1 ;DALOI/JMC - Automatic Download of Test Orders (Cont'd) ; 1/30/95 09:00
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**17,23,57**;Sep 27, 1994
3 ;
4BUILD ; Build test listing for all instruments designated for auto download.
5 ;
6 N LA7I,LA7INST,LA7WL
7 ;
8 K ^TMP("LA7-INST",$J)
9 K LA7AUTO
10 ;
11 ; Flag used to notify download routines of automatic download (no worklist).
12 S LA7ADL=1
13 ;
14 S LA7INST=0
15 F S LA7INST=$O(^LAB(62.4,"AE",LA7INST)) Q:'LA7INST D BLDINST(LA7INST,0)
16 Q
17 ;
18 ;
19BLDINST(LA7INST,LA7WL) ; Build list of instrument tests
20 ; Call with LA7INST = ien of entry in file #62.4
21 ; LA7WL = ien of entry in file #62.8 (optional)
22 ; will default to list associated with #62.4 entry.
23 ;
24 K ^TMP("LA7-INST",$J,LA7INST)
25 ;
26 S LA7AUTO(LA7INST)=$G(^LAB(62.4,LA7INST,0))
27 ; Quit - no zero node in 62.4.
28 I LA7AUTO(LA7INST)="" K LA7AUTO(LA7INST) Q
29 ;
30 S LA7AUTO(LA7INST,9)=$G(^LAB(62.4,LA7INST,9))
31 ; Quit - no/invalid download routine specified.
32 I $$CHKRTN Q
33 ;
34 ; Worklist pointer
35 I 'LA7WL S LA7WL=$P(LA7AUTO(LA7INST),"^",4)
36 ;
37 ; Store "include uncollected accessions" flag, defaults to 0 (NO)
38 S ^TMP("LA7-INST",$J,LA7INST)=+$P($G(^LRO(68.2,LA7WL,0)),"^",10)
39 ;
40 S LA7I=0
41 F S LA7I=$O(^LAB(62.4,LA7INST,3,LA7I)) Q:'LA7I D BLDTST
42 ;
43 ; No download tests found for this instrument.
44 I '$O(^TMP("LA7-INST",$J,LA7INST,0)) D
45 . K LA7AUTO(LA7INST)
46 . K ^TMP("LA7-INST",$J,LA7INST)
47 Q
48 ;
49 ;
50BLDTST ; Build list of test that can be downloaded.
51 ;
52 N X,Y
53 ; Don't download this test.
54 I $P($G(^LAB(62.4,LA7INST,3,LA7I,2)),"^",4)=0 Q
55 ;
56 ; X = Zeroth node of test multiple
57 ; Y = Screening criteria - accession area, specimen type, urgency
58 S X=$G(^LAB(62.4,LA7INST,3,LA7I,0))
59 S Y=$G(^LAB(62.4,LA7INST,3,LA7I,2))
60 ;
61 ; Build pattern mask based on file #60, #62.41, #68, #61, #62.05 iens
62 S ^TMP("LA7-INST",$J,LA7INST,+X,LA7I,+$P(Y,"^",12),+$P(Y,"^",13),+$P(Y,"^",14))=""
63 ;
64 ; Build test info
65 S ^TMP("LA7",$J,LA7INST,LA7I)=X
66 S $P(^TMP("LA7",$J,LA7INST,LA7I),"^",7)=$P($G(^LAB(60,+X,.2)),"^")
67 ;
68 Q
69 ;
70 ;
71CHKRTN() ; Check if download routine defined and valid
72 ;
73 N LA7ERR,X,XQA,XQAMSG
74 ;
75 S LA7ERR=0,XQAMSG=""
76 ;
77 ; Check if download routine specified
78 I $P(LA7AUTO(LA7INST,9),"^",4)="" D
79 . S LA7ERR=1
80 . S XQAMSG="No download routine (field #94)"
81 ;
82 ; Check if download routine valid
83 I $L($P(LA7AUTO(LA7INST,9),"^",4)) D
84 . S X=$P(LA7AUTO(LA7INST,9),"^",4) X ^%ZOSF("TEST") Q:$T
85 . S LA7ERR=1
86 . S XQAMSG="Invalid download routine (field #94)"
87 ;
88 ; Check if routine label valid
89 I 'LA7ERR,$L($P(LA7AUTO(LA7INST,9),"^",3)) D
90 . I $L($T(@$P(LA7AUTO(LA7INST,9),"^",3,4))) Q
91 . S LA7ERR=1
92 . S XQAMSG="Invalid download routine label (field #93)"
93 ;
94 ; If problem send alert and kill array entry
95 I LA7ERR D
96 . S XQAMSG=XQAMSG_" specified for AUTO INSTRUMENT: "_$P(LA7AUTO(LA7INST),"^")
97 . D ERROR^LA7UID
98 . K LA7AUTO(LA7INST)
99 ;
100 Q LA7ERR
101 ;
102 ;
103UNWIND(LA760,LA7URG,LA7TYP) ; Unwind profile - set tests into array LA7TREE with urgency.
104 ;
105 ; Call with LA760 = file #60 ien
106 ; LA7URG = file #62.05 ien
107 ; LA7TYP = 0 ordered test
108 ; 1 expanded from panel
109 ;
110 ; Recursive panel, caught in a loop.
111 I $G(LA7PCNT)>50 Q
112 ;
113 ; If no urgency, set to routine (9), default value.
114 I 'LA7URG S LA7URG=9
115 ;
116 ; Test does not exist in file 60.
117 I '$D(^LAB(60,LA760,0)) Q
118 ;
119 ; Bypass "workload" type tests.
120 I $P(^LAB(60,LA760,0),"^",4)="WK" Q
121 ;
122 ; Test already listed, check if urgency different.
123 I $D(LA7TREE(LA760)) D Q
124 . S LA7PCNT=0
125 . ; Convert expanded panel test urgency to regular urgency
126 . I LA7URG>50 S LA7URG=LA7URG-50
127 . ; Found test with higher urgency, save new urgency.
128 . I LA7URG<LA7TREE(LA760) S $P(LA7TREE(LA760),"^")=LA7URG
129 ;
130 ; Not a panel, list test with urgency.
131 I '$O(^LAB(60,LA760,2,0)) S LA7TREE(LA760)=LA7URG_"^"_LA7TYP,LA7PCNT=0 Q
132 ;
133 N I
134 ;
135 ; Increment panel and test loop counter.
136 S LA7PCNT=$G(LA7PCNT)+1,I=0
137 ;
138 ; Expand test on panel.
139 F S I=$O(^LAB(60,LA760,2,I)) Q:'I D
140 . N II
141 . ; IEN of test on panel.
142 . S II=+$G(^LAB(60,LA760,2,I,0))
143 . ; Recursive panel, panel calls itself.
144 . I II,II=LA760 Q
145 . I II D UNWIND(II,LA7URG,1)
146 ;
147 Q
148 ;
149 ;
150SETSTOP(FLAG,USER) ; Set "STOP" node in ^LA("ADL") global..
151 ; Required parameters
152 ; FLAG - Values passed can be:
153 ; 0 = Auto download background task running.
154 ; 1 = Start/Restart background task.
155 ; 2 = Shutdown auto download background task, don't restart.
156 ; 3 = Shutdown, don't start auto download task and don't collect accessions for downloading.
157 ; USER - DUZ of user.
158 ;
159 ; Value passed out of range.
160 I FLAG<0!(FLAG>3) Q
161 ;
162 I $G(USER)'>0 S USER="UNKNOWN"
163 ;
164 ; Set flag to value passed, user and current time.
165 S ^LA("ADL","STOP")=FLAG_"^"_$$HTFM^XLFDT($H)_"^"_USER
166 ;
167 Q
168 ;
169 ;
170SHOWST() ; Show status
171 ;
172 N X,Y
173 ;
174 S X=$G(^LA("ADL","STOP"),-1)
175 S Y=$P("Not Running^Running^Start/Restart Auto Download Job^Shutdown Auto Download Job^Shutdown Auto Download Job and Stop Collecting Accessions","^",$P(X,"^")+2)
176 ;
177 I +X'<0 D
178 . S $P(Y,"^",2)=$$FMTE^XLFDT($P(X,"^",2))
179 . I $P(X,"^",3) S $P(Y,"^",3)=$$GET1^DIQ(200,$P(X,"^",3)_",",.01)
180 . I $P(X,"^",3)="UNKNOWN"!($P(Y,"^",3)="") S $P(Y,"^",3)="UNKNOWN"
181 ;
182 Q Y
Note: See TracBrowser for help on using the repository browser.