Index: WorldVistAEHR/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7ADL.m
===================================================================
--- WorldVistAEHR/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7ADL.m	(revision 613)
+++ WorldVistAEHR/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7ADL.m	(revision 623)
@@ -1,249 +1,232 @@
-LA7ADL	;DALOI/JMC - Automatic Download of Test Orders;May 30, 2008
-	;;5.2;AUTOMATED LAB INSTRUMENTS;**17,25,23,57,66**;Sep 27, 1994;Build 30
-	;
-	; This routine will monitor the ^LA("ADL") node to check for accessions which are to have test orders automatically
-	; downloaded to another computer system. All entries in the auto instrument file which are flagged for automatic downloading
-	; will be checked to see if they contain any tests on the accession. If tests are found then the appropiate download message
-	; is constructed and sent.
-	;
-	;
-EN(LA7UID)	; Set flag to check accession for downloading, start background job if needed.
-	; Called by LR7OMERG, LRCONJAM, LRTSTSET, LRWLST1.
-	;
-	; No UID passed to routine.
-	I $G(LA7UID)="" Q
-	;
-	; No instrument flagged for auto downloading.
-	I '$D(^LAB(62.4,"AE")) Q
-	;
-	; Quit if "Don't Start/Collect" flag set.
-	I +$G(^LA("ADL","STOP"),0)=3 Q
-	;
-	; Lock node in case already downloading this accession, wait until downloading finished.
-	L +^LA("ADL","Q",LA7UID):60
-	;
-	; Set flag to check this accession for auto downloading.
-	S ^LA("ADL","Q",LA7UID)=""
-	;
-	; Release lock.
-	L -^LA("ADL","Q",LA7UID)
-	;
-	; Quit if "Don't Start" flag set.
-	I +$G(^LA("ADL","STOP"),0)=2 Q
-	;
-	; Task background job to run.
-	D CHKTSK
-	;
-	; Unlock node.
-	L -^LA("ADL",0)
-	;
-	Q
-	;
-	;
-DQ	; Entry point from Taskman.
-	;
-	; Wait for a little while in case another job checking for background job has lock.
-	L +^LA("ADL",0):10
-	; Another process has lock, only want one at a time.
-	I '$T S:$D(ZTQUEUED) ZTREQ="@" Q
-	;
-	; No instrument flagged for auto downloading.
-	I '$D(^LAB(62.4,"AE")) D EXIT Q
-	;
-	; Quit if "Don't Start/Collect" flags set.
-	I +$G(^LA("ADL","STOP"),0)>1 Q
-	;
-	; Update XTMP entry to let auto download know we're running for this process
-	;  and build table of tests to check for downloading}
-	D XTMP,BUILD
-	;
-	F  D UID Q:TOUT>60
-	D EXIT
-	Q
-	;
-	;
-UID	; Start loop to monitor for accessions to download.
-	;
-	S LA7UID="",(TOUT,ZTSTOP)=0
-	;
-	; Flag set to "Rebuild".
-	I +$G(^LA("ADL","STOP"))=1,'ZTSTOP D BUILD
-	;
-	F  S LA7UID=$O(^LA("ADL","Q",LA7UID)) Q:LA7UID=""!(ZTSTOP)!(TOUT)  D
-	. I +$G(^LA("ADL","STOP"))>0 S TOUT=61 Q
-	. I $$S^%ZTLOAD("Processing Lab UID "_LA7UID) S ZTSTOP=1,TOUT=61 Q
-	. ; Lock this UID, synch setting/deleting when another job is attempting to set node.
-	. D LOCK^DILF("^LA(""ADL"",""Q"",LA7UID)")
-	. ; Unable to get lock, go on to next UID, check again on next go around.
-	. I '$T Q
-	. ; Get accession info from ^LRO(68,"C").
-	. S X=$Q(^LRO(68,"C",LA7UID))
-	. ; Quit - UID does not match.
-	. I $QS(X,3)'=LA7UID D CLEANUP Q
-	. ; Setup accession variables for auto downloading.
-	. S LRAA=+$QS(X,4),LRAD=+$QS(X,5),LRAN=+$QS(X,6)
-	. D BLDTST
-	. S LA7INST=0
-	. F  S LA7INST=$O(LA7AUTO(LA7INST)) Q:'LA7INST  D
-	. . D CHKTEST
-	. . ; No tests on instrument list for this accession.
-	. . I '$D(LA7ACC) Q
-	. . S LRINST=LA7INST,LRAUTO=LA7AUTO(LA7INST)
-	. . N LA7UID
-	. . ; File build (entry^routine) from fields #93 and #94 in file #62.4.
-	. . D @$P(LA7AUTO(LA7INST,9),"^",3,4)
-	. D CLEANUP,XTMP
-	;
-	F  D  Q:$O(^LA("ADL","Q",""))'=""  Q:TOUT>60 
-	. I $G(^LA("ADL","STOP"))>1 S TOUT=61 Q
-	. ; Task has been requested to stop.
-	. I $$S^%ZTLOAD("Idle - waiting for new accessions to process") S TOUT=61,ZTSTOP=1 Q
-	. S TOUT=TOUT+1 H 5 D XTMP
-	;
-	Q
-	;
-	;
-BLDTST	; Build array of tests on accession to check for downloading
-	;
-	N X,LA760,LA7PCNT
-	;
-	K LA7TREE
-	S LA760=0
-	F  S LA760=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LA760)) Q:'LA760  D
-	. ; Quit if test has been removed from accession.
-	. S X=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LA760,0),0) Q:'X
-	. ; If test completed (#4, COMPLETE DATE entered), don't download.
-	. I $P(X,"^",5) Q
-	. ; Build array of atomic tests on accession with urgency.
-	. S LA7PCNT=0
-	. D UNWIND^LA7ADL1(LA760,$P(X,"^",2),0)
-	;
-	Q
-	;
-	;
-CHKTEST	; Check tests to determine if they should build in message.
-	; Array LA7ACC returned with tests to send in message
-	;
-	N LA760,LA761,LA76205,LA768,LA7I,LRDPF,X
-	;
-	K LA7ACC
-	;
-	; Quit - specimen uncollected & don't download uncollected flag set.
-	;        controls exempted.
-	S LRDPF=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,0)),"^",2)
-	S X=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,3))
-	I LRDPF'=62.3,'$P(X,"^",3),'$P(^TMP("LA7-INST",$J,LA7INST),"^") Q
-	;
-	S X=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,5,0))
-	S LA761=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,5,X,0),"^")
-	S LA760=0
-	F  S LA760=$O(LA7TREE(LA760)) Q:'LA760  D
-	. I '$D(^TMP("LA7-INST",$J,LA7INST,LA760)) Q
-	. S LA7I=0
-	. F  S LA7I=$O(^TMP("LA7-INST",$J,LA7INST,LA760,LA7I)) Q:'LA7I  D
-	. . S LA76205=+$P(LA7TREE(LA760),"^")
-	. . D CHKMASK
-	;
-	Q
-	;
-CHKMASK	; Check pattern mask for tests that match download pattern mask
-	;
-	; Any accession area, specimen, urgency
-	I $D(^TMP("LA7-INST",$J,LA7INST,LA760,LA7I,0,0,0)) D ADD Q
-	;
-	; Specific accession area, any specimen/urgency
-	I $D(^TMP("LA7-INST",$J,LA7INST,LA760,LA7I,LRAA,0,0)) D ADD Q
-	;
-	; Specific specimen, any accession area/urgency
-	I $D(^TMP("LA7-INST",$J,LA7INST,LA760,LA7I,0,LA761,0)) D ADD Q
-	;
-	; Specific urgency, any accession area/specimen
-	I $D(^TMP("LA7-INST",$J,LA7INST,LA760,LA7I,0,0,LA76205)) D ADD Q
-	;
-	; Specific accession/specimen, any urgency
-	I $D(^TMP("LA7-INST",$J,LA7INST,LA760,LA7I,LRAA,LA761,0)) D ADD Q
-	;
-	; Specific specimen/urgency, any accession area
-	I $D(^TMP("LA7-INST",$J,LA7INST,LA760,LA7I,0,LA761,LA76205)) D ADD Q
-	;
-	; Specific accession/specimen/urgency
-	I $D(^TMP("LA7-INST",$J,LA7INST,LA760,LA7I,LRAA,LA761,LA76205)) D ADD Q
-	;
-	Q
-	;
-ADD	; Add to list of tests to download
-	;
-	S LA7ACC(LA7I)=LA760_"^"_LA7TREE(LA760)
-	Q
-	;
-	;
-CLEANUP	; Delete flag after accession has been checked.
-	; NOTE: Lock previously set above.
-	;
-	K ^LA("ADL","Q",LA7UID)
-	;
-	; Release lock on this UID.
-	L -^LA("ADL","Q",LA7UID)
-	;
-	Q
-	;
-	;
-CHKTSK	; Check if we shoud task the auto download processing routine.
-	; Check if we recently tasked the processing routine for this process by compaing values in the XTMP global.
-	; 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
-	; 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
-	; is already running.
-	;
-	N LA7X,LA7Y
-	S LA7X=$H,LA7Y=$G(^XTMP("LA7ADL",1))
-	I $P(LA7X,",")=$P(LA7Y,","),($P(LA7X,",",2)-$P(LA7Y,",",2))<240 Q
-	;
-	; Lock zeroth node.
-	; Quit if another process has lock - either another job setting node or the background job.
-	D LOCK^DILF("^LA(""ADL"",0)")
-	I '$T Q
-	;
-ZTSK	; Task background job to run.
-	;
-	; Call here to queue this processing routine to run in the background.
-	;
-	; Task background job if not running.
-	N ZTDESC,ZTSAVE,ZTDTH,ZTIO,ZTRTN
-	S ZTRTN="DQ^LA7ADL",ZTDESC="Lab Auto Download",ZTIO="",ZTDTH=$H
-	D ^%ZTLOAD
-	;
-	Q
-	;
-	;
-BUILD	; Build TMP global with list of tests for instruments flagged for auto download.
-	;
-	D BUILD^LA7ADL1
-	;
-	; Set flag to "Running".
-	D SETSTOP^LA7ADL1(0,$G(DUZ))
-	;
-	Q
-	;
-	;
-XTMP	; Set/update XTMP with current run time of this processing routine
-	;
-	S DT=$$DT^XLFDT
-	S ^XTMP("LA7ADL",0)=DT_"^"_DT_"^LAB AUTO DOWNLOAD PROCESS TASKING"
-	S ^XTMP("LA7ADL",1)=$H
-	Q
-	;
-	;
-EXIT	; Exit and cleanup.
-	;
-	; Release lock on LA("ADL") global.
-	L -^LA("ADL",0)
-	;
-	K ^TMP("LA7",$J),^TMP($J),^XTMP("LA7ADL",1)
-	K LA7ADL,LA7AUTO,LA7NVAF,LRAA,LRAD,LRAN,TOUT
-	;
-	; Clear flag if normal shutdown, no new accessions.
-	I +$G(^LA("ADL","STOP"))<2 K ^LA("ADL","STOP")
-	;
-	; Set flag for taskman to cleanup task.
-	I $D(ZTQUEUED) S ZTREQ="@"
-	Q
+LA7ADL ;DALOI/JMC - Automatic Download of Test Orders; 1/30/95 09:00
+ ;;5.2;AUTOMATED LAB INSTRUMENTS;**17,25,23,57**;Sep 27, 1994
+ ;
+ ; This routine will monitor the ^LA("ADL") node to check for accessions which are to have test orders automatically
+ ; downloaded to another computer system. All entries in the auto instrument file which are flagged for automatic downloading
+ ; will be checked to see if they contain any tests on the accession. If tests are found then the appropiate download message
+ ; is constructed and sent.
+ ;
+ ;
+EN(LA7UID) ; Set flag to check accession for downloading, start background job if needed.
+ ; Called by LR7OMERG, LRCONJAM, LRTSTSET, LRWLST1.
+ ;
+ ; No UID passed to routine.
+ I $G(LA7UID)="" Q
+ ;
+ ; No instrument flagged for auto downloading.
+ I '$D(^LAB(62.4,"AE")) Q
+ ;
+ ; Quit if "Don't Start/Collect" flag set.
+ I +$G(^LA("ADL","STOP"),0)=3 Q
+ ;
+ ; Lock node in case already downloading this accession, wait until downloading finished.
+ L +^LA("ADL","Q",LA7UID):60
+ ;
+ ; Set flag to check this accession for auto downloading.
+ S ^LA("ADL","Q",LA7UID)=""
+ ;
+ ; Release lock.
+ L -^LA("ADL","Q",LA7UID)
+ ;
+ ; Quit if "Don't Start" flag set.
+ I +$G(^LA("ADL","STOP"),0)=2 Q
+ ;
+ ; Lock zeroth node.
+ ; Quit if another process has lock
+ ; - either another job setting node or the background job.
+ L +^LA("ADL",0):1
+ I '$T Q
+ ;
+ ; Task background job to run.
+ N ZTSK
+ D ZTSK
+ ;
+ ; Unlock node.
+ L -^LA("ADL",0)
+ ;
+ Q
+ ;
+ ;
+DQ ; Entry point from Taskman.
+ ;
+ ; Set flag for taskman to cleanup task.
+ I $D(ZTQUEUED) S ZTREQ="@"
+ ;
+ ; Wait for a little while in case another job checking for background job has lock.
+ L +^LA("ADL",0):10
+ ; Another process has lock, only want one at a time.
+ I '$T Q
+ ;
+ ; No instrument flagged for auto downloading.
+ I '$D(^LAB(62.4,"AE")) D EXIT Q
+ ;
+ ; Quit if "Don't Start/Collect" flags set.
+ I +$G(^LA("ADL","STOP"),0)>1 Q
+ ;
+ D BUILD
+ ;
+ F  D UID Q:TOUT>60
+ D EXIT
+ Q
+ ;
+ ;
+UID ; Start loop to monitor for accessions to download.
+ ;
+ S LA7UID="",(TOUT,ZTSTOP)=0
+ ;
+ ; Flag set to "Rebuild".
+ I +$G(^LA("ADL","STOP"))=1,'ZTSTOP D BUILD
+ ;
+ F  S LA7UID=$O(^LA("ADL","Q",LA7UID)) Q:LA7UID=""!(ZTSTOP)!(TOUT)  D
+ . I +$G(^LA("ADL","STOP"))>0 S TOUT=61 Q
+ . I $$S^%ZTLOAD S ZTSTOP=1,TOUT=61 Q
+ . ; Lock this UID, synch setting/deleting when another job is attempting to set node.
+ . L +^LA("ADL","Q",LA7UID):1
+ . ; Unable to get lock, go on to next UID, check again on next go around.
+ . I '$T Q
+ . ; Get accession info from ^LRO(68,"C").
+ . S X=$Q(^LRO(68,"C",LA7UID))
+ . ; Quit - UID does not match.
+ . I $QS(X,3)'=LA7UID D CLEANUP Q
+ . ; Setup accession variables for auto downloading.
+ . S LRAA=+$QS(X,4),LRAD=+$QS(X,5),LRAN=+$QS(X,6)
+ . D BLDTST
+ . S LA7INST=0
+ . F  S LA7INST=$O(LA7AUTO(LA7INST)) Q:'LA7INST  D
+ . . D CHKTEST
+ . . ; No tests on instrument list for this accession.
+ . . I '$D(LA7ACC) Q
+ . . S LRINST=LA7INST,LRAUTO=LA7AUTO(LA7INST)
+ . . N LA7UID
+ . . ; File build (entry^routine) from fields #93 and #94 in file #62.4.
+ . . D @$P(LA7AUTO(LA7INST,9),"^",3,4)
+ . D CLEANUP
+ ;
+ F  D  Q:$O(^LA("ADL","Q",""))'=""  Q:TOUT>60 
+ . I $G(^LA("ADL","STOP"))>1 S TOUT=61 Q
+ . ; Task has been requested to stop.
+ . I $$S^%ZTLOAD S TOUT=61,ZTSTOP=1 Q
+ . S TOUT=TOUT+1 H 5
+ ;
+ Q
+ ;
+ ;
+BLDTST ; Build array of tests on accession to check for downloading
+ ;
+ N X,LA760,LA7PCNT
+ ;
+ K LA7TREE
+ S LA760=0
+ F  S LA760=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LA760)) Q:'LA760  D
+ . ; Quit if test has been removed from accession.
+ . S X=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LA760,0),0) Q:'X
+ . ; If test completed (#4, COMPLETE DATE entered), don't download.
+ . I $P(X,"^",5) Q
+ . ; Build array of atomic tests on accession with urgency.
+ . S LA7PCNT=0
+ . D UNWIND^LA7ADL1(LA760,$P(X,"^",2),0)
+ ;
+ Q
+ ;
+ ;
+CHKTEST ; Check tests to determine if they should build in message.
+ ; Array LA7ACC returned with tests to send in message
+ ;
+ N LA760,LA761,LA76205,LA768,LA7I,LRDPF,X
+ ;
+ K LA7ACC
+ ;
+ ; Quit - specimen uncollected & don't download uncollected flag set.
+ ;        controls exempted.
+ S LRDPF=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,0)),"^",2)
+ S X=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,3))
+ I LRDPF'=62.3,'$P(X,"^",3),'$P(^TMP("LA7-INST",$J,LA7INST),"^") Q
+ ;
+ S X=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,5,0))
+ S LA761=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,5,X,0),"^")
+ S LA760=0
+ F  S LA760=$O(LA7TREE(LA760)) Q:'LA760  D
+ . I '$D(^TMP("LA7-INST",$J,LA7INST,LA760)) Q
+ . S LA7I=0
+ . F  S LA7I=$O(^TMP("LA7-INST",$J,LA7INST,LA760,LA7I)) Q:'LA7I  D
+ . . S LA76205=+$P(LA7TREE(LA760),"^")
+ . . D CHKMASK
+ ;
+ Q
+ ;
+CHKMASK ; Check pattern mask for tests that match download pattern mask
+ ;
+ ; Any accession area, specimen, urgency
+ I $D(^TMP("LA7-INST",$J,LA7INST,LA760,LA7I,0,0,0)) D ADD Q
+ ;
+ ; Specific accession area, any specimen/urgency
+ I $D(^TMP("LA7-INST",$J,LA7INST,LA760,LA7I,LRAA,0,0)) D ADD Q
+ ;
+ ; Specific specimen, any accession area/urgency
+ I $D(^TMP("LA7-INST",$J,LA7INST,LA760,LA7I,0,LA761,0)) D ADD Q
+ ;
+ ; Specific urgency, any accession area/specimen
+ I $D(^TMP("LA7-INST",$J,LA7INST,LA760,LA7I,0,0,LA76205)) D ADD Q
+ ;
+ ; Specific accession/specimen, any urgency
+ I $D(^TMP("LA7-INST",$J,LA7INST,LA760,LA7I,LRAA,LA761,0)) D ADD Q
+ ;
+ ; Specific specimen/urgency, any accession area
+ I $D(^TMP("LA7-INST",$J,LA7INST,LA760,LA7I,0,LA761,LA76205)) D ADD Q
+ ;
+ ; Specific accession/specimen/urgency
+ I $D(^TMP("LA7-INST",$J,LA7INST,LA760,LA7I,LRAA,LA761,LA76205)) D ADD Q
+ ;
+ Q
+ ;
+ADD ; Add to list of tests to download
+ ;
+ S LA7ACC(LA7I)=LA760_"^"_LA7TREE(LA760)
+ Q
+ ;
+ ;
+CLEANUP ; Delete flag after accession has been checked.
+ ; NOTE: Lock previously set above.
+ ;
+ K ^LA("ADL","Q",LA7UID)
+ ;
+ ; Release lock on this UID.
+ L -^LA("ADL","Q",LA7UID)
+ ;
+ Q
+ ;
+ ;
+ZTSK ; Task background job to run.
+ ;
+ N ZTDESC,ZTSAVE,ZTDTH,ZTIO,ZTRTN
+ ;
+ ; Task background job if not running.
+ S ZTRTN="DQ^LA7ADL",ZTDESC="Lab Auto Download",ZTIO="",ZTDTH=$H
+ D ^%ZTLOAD
+ ;
+ Q
+ ;
+ ;
+BUILD ; Build TMP global with list of tests for instruments flagged for auto download.
+ D BUILD^LA7ADL1
+ ;
+ ; Set flag to "Running".
+ D SETSTOP^LA7ADL1(0,$G(DUZ))
+ ;
+ Q
+ ;
+ ;
+EXIT ; Exit and cleanup.
+ ;
+ ; Release lock on LA("ADL") global.
+ L -^LA("ADL",0)
+ ;
+ K ^TMP("LA7",$J),^TMP($J)
+ K LA7ADL
+ K LRAA,LRAD,LRAN
+ K TOUT
+ ;
+ ; Clear flag if normal shutdown, no new accessions.
+ I +$G(^LA("ADL","STOP"))<2 K ^LA("ADL","STOP")
+ ;
+ Q
