- LA7ADL1 ;DALOI/JMC - Automatic Download of Test Orders (Cont'd) ;Aug 14, 2008
- ;;5.2;AUTOMATED LAB INSTRUMENTS;**17,23,57,74**;Sep 27, 1994;Build 229
- ;
- ;
- 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 $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
- . 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,LA7PARNT) ; Unwind profile - set tests into array LA7TREE with urgency.
- ;
- ; Call with LA760 = file #60 ien
- ; LA7URG = file #62.05 ien
- ; LA7PARNT = file #60 ien - ordered parent (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_"^"_LA7PARNT,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,LA7PARNT)
- ;
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLA7ADL1 5373 printed Jan 18, 2025@02:40:10 Page 2
- LA7ADL1 ;DALOI/JMC - Automatic Download of Test Orders (Cont'd) ;Aug 14, 2008
- +1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**17,23,57,74**;Sep 27, 1994;Build 229
- +2 ;
- +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 $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 IF $LENGTH($TEXT(@$PIECE(LA7AUTO(LA7INST,9),"^",3,4)))
- QUIT
- +20 SET LA7ERR=1
- +21 SET XQAMSG="Invalid download routine label (field #93)"
- End DoDot:1
- +22 ;
- +23 ; If problem send alert and kill array entry
- +24 IF LA7ERR
- Begin DoDot:1
- +25 SET XQAMSG=XQAMSG_" specified for AUTO INSTRUMENT: "_$PIECE(LA7AUTO(LA7INST),"^")
- +26 DO ERROR^LA7UID
- +27 KILL LA7AUTO(LA7INST)
- End DoDot:1
- +28 ;
- +29 QUIT LA7ERR
- +30 ;
- +31 ;
- UNWIND(LA760,LA7URG,LA7PARNT) ; Unwind profile - set tests into array LA7TREE with urgency.
- +1 ;
- +2 ; Call with LA760 = file #60 ien
- +3 ; LA7URG = file #62.05 ien
- +4 ; LA7PARNT = file #60 ien - ordered parent (panel)
- +5 ;
- +6 ; Recursive panel, caught in a loop.
- +7 IF $GET(LA7PCNT)>50
- QUIT
- +8 ;
- +9 ; If no urgency, set to routine (9), default value.
- +10 IF 'LA7URG
- SET LA7URG=9
- +11 ;
- +12 ; Test does not exist in file 60.
- +13 IF '$DATA(^LAB(60,LA760,0))
- QUIT
- +14 ;
- +15 ; Bypass "workload" type tests.
- +16 IF $PIECE(^LAB(60,LA760,0),"^",4)="WK"
- QUIT
- +17 ;
- +18 ; Test already listed, check if urgency different.
- +19 IF $DATA(LA7TREE(LA760))
- Begin DoDot:1
- +20 SET LA7PCNT=0
- +21 ; Convert expanded panel test urgency to regular urgency
- +22 IF LA7URG>50
- SET LA7URG=LA7URG-50
- +23 ; Found test with higher urgency, save new urgency.
- +24 IF LA7URG<LA7TREE(LA760)
- SET $PIECE(LA7TREE(LA760),"^")=LA7URG
- End DoDot:1
- QUIT
- +25 ;
- +26 ; Not a panel, list test with urgency.
- +27 IF '$ORDER(^LAB(60,LA760,2,0))
- SET LA7TREE(LA760)=LA7URG_"^"_LA7PARNT
- SET LA7PCNT=0
- QUIT
- +28 ;
- +29 NEW I
- +30 ;
- +31 ; Increment panel and test loop counter.
- +32 SET LA7PCNT=$GET(LA7PCNT)+1
- SET I=0
- +33 ;
- +34 ; Expand test on panel.
- +35 FOR
- SET I=$ORDER(^LAB(60,LA760,2,I))
- if 'I
- QUIT
- Begin DoDot:1
- +36 NEW II
- +37 ; IEN of test on panel.
- +38 SET II=+$GET(^LAB(60,LA760,2,I,0))
- +39 ; Recursive panel, panel calls itself.
- +40 IF II
- IF II=LA760
- QUIT
- +41 IF II
- DO UNWIND(II,LA7URG,LA7PARNT)
- End DoDot:1
- +42 ;
- +43 QUIT
- +44 ;
- +45 ;
- 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