Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed

  • WorldVistAEHR/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7ADL.m

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