LA7ADL1 ;DALOI/JMC - Automatic Download of Test Orders (Cont'd) ; 1/30/95 09:00 [ 04/21/2003 8:15 AM ]
;;5.2T9;LR;**1018**;Nov 17, 2004
;;5.2;AUTOMATED LAB INSTRUMENTS;**17,23,57**;Sep 27, 1994
;
BUILD ; Build test listing for all instruments designated for auto download.
;
N LA7I,LA7INST,LA7WL
;
K ^TMP("LA7-INST",$J)
K LA7AUTO
;
; Flag used to notify download routines of automatic download (no worklist).
S LA7ADL=1
;
S LA7INST=0
F S LA7INST=$O(^LAB(62.4,"AE",LA7INST)) Q:'LA7INST D BLDINST(LA7INST,0)
Q
;
;
BLDINST(LA7INST,LA7WL) ; Build list of instrument tests
; Call with LA7INST = ien of entry in file #62.4
; LA7WL = ien of entry in file #62.8 (optional)
; will default to list associated with #62.4 entry.
;
K ^TMP("LA7-INST",$J,LA7INST)
;
S LA7AUTO(LA7INST)=$G(^LAB(62.4,LA7INST,0))
; Quit - no zero node in 62.4.
I LA7AUTO(LA7INST)="" K LA7AUTO(LA7INST) Q
;
S LA7AUTO(LA7INST,9)=$G(^LAB(62.4,LA7INST,9))
; Quit - no/invalid download routine specified.
I $$CHKRTN Q
;
; Worklist pointer
I 'LA7WL S LA7WL=$P(LA7AUTO(LA7INST),"^",4)
;
; Store "include uncollected accessions" flag, defaults to 0 (NO)
S ^TMP("LA7-INST",$J,LA7INST)=+$P($G(^LRO(68.2,LA7WL,0)),"^",10)
;
S LA7I=0
F S LA7I=$O(^LAB(62.4,LA7INST,3,LA7I)) Q:'LA7I D BLDTST
;
; No download tests found for this instrument.
I '$O(^TMP("LA7-INST",$J,LA7INST,0)) D
. K LA7AUTO(LA7INST)
. K ^TMP("LA7-INST",$J,LA7INST)
Q
;
;
BLDTST ; Build list of test that can be downloaded.
;
N X,Y
; Don't download this test.
I $P($G(^LAB(62.4,LA7INST,3,LA7I,2)),"^",4)=0 Q
;
; X = Zeroth node of test multiple
; Y = Screening criteria - accession area, specimen type, urgency
S X=$G(^LAB(62.4,LA7INST,3,LA7I,0))
S Y=$G(^LAB(62.4,LA7INST,3,LA7I,2))
;
; Build pattern mask based on file #60, #62.41, #68, #61, #62.05 iens
S ^TMP("LA7-INST",$J,LA7INST,+X,LA7I,+$P(Y,"^",12),+$P(Y,"^",13),+$P(Y,"^",14))=""
;
; Build test info
S ^TMP("LA7",$J,LA7INST,LA7I)=X
S $P(^TMP("LA7",$J,LA7INST,LA7I),"^",7)=$P($G(^LAB(60,+X,.2)),"^")
;
Q
;
;
CHKRTN() ; Check if download routine defined and valid
;
N LA7ERR,X,XQA,XQAMSG
;
S LA7ERR=0,XQAMSG=""
;
; Check if download routine specified
I $P(LA7AUTO(LA7INST,9),"^",4)="" D
. S LA7ERR=1
. S XQAMSG="No download routine (field #94)"
;
; Check if download routine valid
I $L($P(LA7AUTO(LA7INST,9),"^",4)) D
. S X=$P(LA7AUTO(LA7INST,9),"^",4) X ^%ZOSF("TEST") Q:$T
. S LA7ERR=1
. S XQAMSG="Invalid download routine (field #94)"
;
; Check if routine label valid
I 'LA7ERR,$L($P(LA7AUTO(LA7INST,9),"^",3)) D
.;----- BEGIN IHS MODIFICATIONS LR*5.2*1018
. S HLZOS=$$VERSION^%ZOSV(1)
. Q:HLZOS'[("Cache")
.;----- END IHS MODIFICATIONS
. I $L($T(@$P(LA7AUTO(LA7INST,9),"^",3,4))) Q
. S LA7ERR=1
. S XQAMSG="Invalid download routine label (field #93)"
;
; If problem send alert and kill array entry
I LA7ERR D
. S XQAMSG=XQAMSG_" specified for AUTO INSTRUMENT: "_$P(LA7AUTO(LA7INST),"^")
. D ERROR^LA7UID
. K LA7AUTO(LA7INST)
;
Q LA7ERR
;
;
UNWIND(LA760,LA7URG,LA7TYP) ; Unwind profile - set tests into array LA7TREE with urgency.
;
; Call with LA760 = file #60 ien
; LA7URG = file #62.05 ien
; LA7TYP = 0 ordered test
; 1 expanded from panel
;
; Recursive panel, caught in a loop.
I $G(LA7PCNT)>50 Q
;
; If no urgency, set to routine (9), default value.
I 'LA7URG S LA7URG=9
;
; Test does not exist in file 60.
I '$D(^LAB(60,LA760,0)) Q
;
; Bypass "workload" type tests.
I $P(^LAB(60,LA760,0),"^",4)="WK" Q
;
; Test already listed, check if urgency different.
I $D(LA7TREE(LA760)) D Q
. S LA7PCNT=0
. ; Convert expanded panel test urgency to regular urgency
. I LA7URG>50 S LA7URG=LA7URG-50
. ; Found test with higher urgency, save new urgency.
. I LA7URG<LA7TREE(LA760) S $P(LA7TREE(LA760),"^")=LA7URG
;
; Not a panel, list test with urgency.
I '$O(^LAB(60,LA760,2,0)) S LA7TREE(LA760)=LA7URG_"^"_LA7TYP,LA7PCNT=0 Q
;
N I
;
; Increment panel and test loop counter.
S LA7PCNT=$G(LA7PCNT)+1,I=0
;
; Expand test on panel.
F S I=$O(^LAB(60,LA760,2,I)) Q:'I D
. N II
. ; IEN of test on panel.
. S II=+$G(^LAB(60,LA760,2,I,0))
. ; Recursive panel, panel calls itself.
. I II,II=LA760 Q
. I II D UNWIND(II,LA7URG,1)
;
Q
;
;
SETSTOP(FLAG,USER) ; Set "STOP" node in ^LA("ADL") global..
; Required parameters
; FLAG - Values passed can be:
; 0 = Auto download background task running.
; 1 = Start/Restart background task.
; 2 = Shutdown auto download background task, don't restart.
; 3 = Shutdown, don't start auto download task and don't collect accessions for downloading.
; USER - DUZ of user.
;
; Value passed out of range.
I FLAG<0!(FLAG>3) Q
;
I $G(USER)'>0 S USER="UNKNOWN"
;
; Set flag to value passed, user and current time.
S ^LA("ADL","STOP")=FLAG_"^"_$$HTFM^XLFDT($H)_"^"_USER
;
Q
;
;
SHOWST() ; Show status
;
N X,Y
;
S X=$G(^LA("ADL","STOP"),-1)
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)
;
I +X'<0 D
. S $P(Y,"^",2)=$$FMTE^XLFDT($P(X,"^",2))
. I $P(X,"^",3) S $P(Y,"^",3)=$$GET1^DIQ(200,$P(X,"^",3)_",",.01)
. I $P(X,"^",3)="UNKNOWN"!($P(Y,"^",3)="") S $P(Y,"^",3)="UNKNOWN"
;
Q Y
LA7ADL1 ;DALOI/JMC - Automatic Download of Test Orders (Cont'd) ; 1/30/95 09:00 [ 04/21/2003 8:15 AM ]
+1 ;;5.2T9;LR;**1018**;Nov 17, 2004
+2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**17,23,57**;Sep 27, 1994
+3 ;
BUILD ; Build test listing for all instruments designated for auto download.
+1 ;
+2 NEW LA7I,LA7INST,LA7WL
+3 ;
+4 KILL ^TMP("LA7-INST",$JOB)
+5 KILL LA7AUTO
+6 ;
+7 ; Flag used to notify download routines of automatic download (no worklist).
+8 SET LA7ADL=1
+9 ;
+10 SET LA7INST=0
+11 FOR
SET LA7INST=$ORDER(^LAB(62.4,"AE",LA7INST))
IF 'LA7INST
QUIT
DO BLDINST(LA7INST,0)
+12 QUIT
+13 ;
+14 ;
BLDINST(LA7INST,LA7WL) ; Build list of instrument tests
+1 ; Call with LA7INST = ien of entry in file #62.4
+2 ; LA7WL = ien of entry in file #62.8 (optional)
+3 ; will default to list associated with #62.4 entry.
+4 ;
+5 KILL ^TMP("LA7-INST",$JOB,LA7INST)
+6 ;
+7 SET LA7AUTO(LA7INST)=$GET(^LAB(62.4,LA7INST,0))
+8 ; Quit - no zero node in 62.4.
+9 IF LA7AUTO(LA7INST)=""
KILL LA7AUTO(LA7INST)
QUIT
+10 ;
+11 SET LA7AUTO(LA7INST,9)=$GET(^LAB(62.4,LA7INST,9))
+12 ; Quit - no/invalid download routine specified.
+13 IF $$CHKRTN
QUIT
+14 ;
+15 ; Worklist pointer
+16 IF 'LA7WL
SET LA7WL=$PIECE(LA7AUTO(LA7INST),"^",4)
+17 ;
+18 ; Store "include uncollected accessions" flag, defaults to 0 (NO)
+19 SET ^TMP("LA7-INST",$JOB,LA7INST)=+$PIECE($GET(^LRO(68.2,LA7WL,0)),"^",10)
+20 ;
+21 SET LA7I=0
+22 FOR
SET LA7I=$ORDER(^LAB(62.4,LA7INST,3,LA7I))
IF 'LA7I
QUIT
DO BLDTST
+23 ;
+24 ; No download tests found for this instrument.
+25 IF '$ORDER(^TMP("LA7-INST",$JOB,LA7INST,0))
Begin DoDot:1
+26 KILL LA7AUTO(LA7INST)
+27 KILL ^TMP("LA7-INST",$JOB,LA7INST)
End DoDot:1
+28 QUIT
+29 ;
+30 ;
BLDTST ; Build list of test that can be downloaded.
+1 ;
+2 NEW X,Y
+3 ; Don't download this test.
+4 IF $PIECE($GET(^LAB(62.4,LA7INST,3,LA7I,2)),"^",4)=0
QUIT
+5 ;
+6 ; X = Zeroth node of test multiple
+7 ; Y = Screening criteria - accession area, specimen type, urgency
+8 SET X=$GET(^LAB(62.4,LA7INST,3,LA7I,0))
+9 SET Y=$GET(^LAB(62.4,LA7INST,3,LA7I,2))
+10 ;
+11 ; Build pattern mask based on file #60, #62.41, #68, #61, #62.05 iens
+12 SET ^TMP("LA7-INST",$JOB,LA7INST,+X,LA7I,+$PIECE(Y,"^",12),+$PIECE(Y,"^",13),+$PIECE(Y,"^",14))=""
+13 ;
+14 ; Build test info
+15 SET ^TMP("LA7",$JOB,LA7INST,LA7I)=X
+16 SET $PIECE(^TMP("LA7",$JOB,LA7INST,LA7I),"^",7)=$PIECE($GET(^LAB(60,+X,.2)),"^")
+17 ;
+18 QUIT
+19 ;
+20 ;
CHKRTN() ; Check if download routine defined and valid
+1 ;
+2 NEW LA7ERR,X,XQA,XQAMSG
+3 ;
+4 SET LA7ERR=0
SET XQAMSG=""
+5 ;
+6 ; Check if download routine specified
+7 IF $PIECE(LA7AUTO(LA7INST,9),"^",4)=""
Begin DoDot:1
+8 SET LA7ERR=1
+9 SET XQAMSG="No download routine (field #94)"
End DoDot:1
+10 ;
+11 ; Check if download routine valid
+12 IF $LENGTH($PIECE(LA7AUTO(LA7INST,9),"^",4))
Begin DoDot:1
+13 SET X=$PIECE(LA7AUTO(LA7INST,9),"^",4)
XECUTE ^%ZOSF("TEST")
IF $TEST
QUIT
+14 SET LA7ERR=1
+15 SET XQAMSG="Invalid download routine (field #94)"
End DoDot:1
+16 ;
+17 ; Check if routine label valid
+18 IF 'LA7ERR
IF $LENGTH($PIECE(LA7AUTO(LA7INST,9),"^",3))
Begin DoDot:1
+19 ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018
+20 SET HLZOS=$$VERSION^%ZOSV(1)
+21 IF HLZOS'[("Cache")
QUIT
+22 ;----- END IHS MODIFICATIONS
+23 IF $LENGTH($TEXT(@$PIECE(LA7AUTO(LA7INST,9),"^",3,4)))
QUIT
+24 SET LA7ERR=1
+25 SET XQAMSG="Invalid download routine label (field #93)"
End DoDot:1
+26 ;
+27 ; If problem send alert and kill array entry
+28 IF LA7ERR
Begin DoDot:1
+29 SET XQAMSG=XQAMSG_" specified for AUTO INSTRUMENT: "_$PIECE(LA7AUTO(LA7INST),"^")
+30 DO ERROR^LA7UID
+31 KILL LA7AUTO(LA7INST)
End DoDot:1
+32 ;
+33 QUIT LA7ERR
+34 ;
+35 ;
UNWIND(LA760,LA7URG,LA7TYP) ; Unwind profile - set tests into array LA7TREE with urgency.
+1 ;
+2 ; Call with LA760 = file #60 ien
+3 ; LA7URG = file #62.05 ien
+4 ; LA7TYP = 0 ordered test
+5 ; 1 expanded from panel
+6 ;
+7 ; Recursive panel, caught in a loop.
+8 IF $GET(LA7PCNT)>50
QUIT
+9 ;
+10 ; If no urgency, set to routine (9), default value.
+11 IF 'LA7URG
SET LA7URG=9
+12 ;
+13 ; Test does not exist in file 60.
+14 IF '$DATA(^LAB(60,LA760,0))
QUIT
+15 ;
+16 ; Bypass "workload" type tests.
+17 IF $PIECE(^LAB(60,LA760,0),"^",4)="WK"
QUIT
+18 ;
+19 ; Test already listed, check if urgency different.
+20 IF $DATA(LA7TREE(LA760))
Begin DoDot:1
+21 SET LA7PCNT=0
+22 ; Convert expanded panel test urgency to regular urgency
+23 IF LA7URG>50
SET LA7URG=LA7URG-50
+24 ; Found test with higher urgency, save new urgency.
+25 IF LA7URG<LA7TREE(LA760)
SET $PIECE(LA7TREE(LA760),"^")=LA7URG
End DoDot:1
QUIT
+26 ;
+27 ; Not a panel, list test with urgency.
+28 IF '$ORDER(^LAB(60,LA760,2,0))
SET LA7TREE(LA760)=LA7URG_"^"_LA7TYP
SET LA7PCNT=0
QUIT
+29 ;
+30 NEW I
+31 ;
+32 ; Increment panel and test loop counter.
+33 SET LA7PCNT=$GET(LA7PCNT)+1
SET I=0
+34 ;
+35 ; Expand test on panel.
+36 FOR
SET I=$ORDER(^LAB(60,LA760,2,I))
IF 'I
QUIT
Begin DoDot:1
+37 NEW II
+38 ; IEN of test on panel.
+39 SET II=+$GET(^LAB(60,LA760,2,I,0))
+40 ; Recursive panel, panel calls itself.
+41 IF II
IF II=LA760
QUIT
+42 IF II
DO UNWIND(II,LA7URG,1)
End DoDot:1
+43 ;
+44 QUIT
+45 ;
+46 ;
SETSTOP(FLAG,USER) ; Set "STOP" node in ^LA("ADL") global..
+1 ; Required parameters
+2 ; FLAG - Values passed can be:
+3 ; 0 = Auto download background task running.
+4 ; 1 = Start/Restart background task.
+5 ; 2 = Shutdown auto download background task, don't restart.
+6 ; 3 = Shutdown, don't start auto download task and don't collect accessions for downloading.
+7 ; USER - DUZ of user.
+8 ;
+9 ; Value passed out of range.
+10 IF FLAG<0!(FLAG>3)
QUIT
+11 ;
+12 IF $GET(USER)'>0
SET USER="UNKNOWN"
+13 ;
+14 ; Set flag to value passed, user and current time.
+15 SET ^LA("ADL","STOP")=FLAG_"^"_$$HTFM^XLFDT($HOROLOG)_"^"_USER
+16 ;
+17 QUIT
+18 ;
+19 ;
SHOWST() ; Show status
+1 ;
+2 NEW X,Y
+3 ;
+4 SET X=$GET(^LA("ADL","STOP"),-1)
+5 SET Y=$PIECE("Not Running^Running^Start/Restart Auto Download Job^Shutdown Auto Download Job^Shutdown Auto Download Job and Stop Collecting Accessions","^",$PIECE(X,"^")+2)
+6 ;
+7 IF +X'<0
Begin DoDot:1
+8 SET $PIECE(Y,"^",2)=$$FMTE^XLFDT($PIECE(X,"^",2))
+9 IF $PIECE(X,"^",3)
SET $PIECE(Y,"^",3)=$$GET1^DIQ(200,$PIECE(X,"^",3)_",",.01)
+10 IF $PIECE(X,"^",3)="UNKNOWN"!($PIECE(Y,"^",3)="")
SET $PIECE(Y,"^",3)="UNKNOWN"
End DoDot:1
+11 ;
+12 QUIT Y
