Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LA7ADL

LA7ADL.m

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