| [623] | 1 | LA7ADL ;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 | ;
|
|---|
| 10 | EN(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 | ;
|
|---|
| 50 | DQ ; 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 | ;
|
|---|
| 73 | UID ; 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 | ;
|
|---|
| 114 | BLDTST ; 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 | ;
|
|---|
| 132 | CHKTEST ; 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 | ;
|
|---|
| 157 | CHKMASK ; 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 | ;
|
|---|
| 182 | ADD ; Add to list of tests to download
|
|---|
| 183 | ;
|
|---|
| 184 | S LA7ACC(LA7I)=LA760_"^"_LA7TREE(LA760)
|
|---|
| 185 | Q
|
|---|
| 186 | ;
|
|---|
| 187 | ;
|
|---|
| 188 | CLEANUP ; 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 | ;
|
|---|
| 199 | ZTSK ; 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 | ;
|
|---|
| 210 | BUILD ; 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 | ;
|
|---|
| 219 | EXIT ; 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
|
|---|
