LADOWN1 ;DALOI/DG - UTILITY PARTS OF DOWNLOAD ;7/20/90 08:07
;;5.2;AUTOMATED LAB INSTRUMENTS;**17,42,57**;Sep 27, 1994
;
BUILD ; Build a test expansion and codes into ^TMP
;
N LAI,T,P1,P2,P3,S1,J1
S:$D(ZTQUEUED) ZTREQ="@"
;
K ^TMP($J)
;
S LAI=0
F S LAI=$O(^LAB(62.4,LRINST,3,LAI)) Q:LAI'>0 D
. S T=$G(^LAB(62.4,LRINST,3,LAI,0)),^TMP($J,+T,+T)=$P(T,"^",6)
;
; Expand the LL test.
S P1=0
F S P1=$O(^LRO(68.2,LRLL,10,P1)) Q:P1'>0 D
. S P2=0
. F S P2=$O(^LRO(68.2,LRLL,10,P1,1,P2)) Q:P2'>0 S P3=^(P2,0) D BU2
;
Q
;
;
BU2 S (J,S1)=0,(T,X)=+P3
D TREE
Q
;
;
TREE ;
; Bad LRTEST number; from LREXPD
I '$D(^LAB(60,X,0)) Q
I $P(^LAB(60,X,0),U,5)]"",$D(^TMP($J,X,X)) S ^TMP($J,T,X)=^TMP($J,X,X)
; Not a panel
Q:'$D(^LAB(60,X,2,0)) Q:$O(^(0))<1
;
S S1=S1+1,S1(S1)=X,J1(S1)=J
F J=0:0 S J=$O(^LAB(60,S1(S1),2,J)) Q:J<1 S X=+^(J,0) D TREE
S J=J1(S1),X=S1(S1),S1=S1-1
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLADOWN1 941 printed Dec 13, 2024@01:42:15 Page 2
LADOWN1 ;DALOI/DG - UTILITY PARTS OF DOWNLOAD ;7/20/90 08:07
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**17,42,57**;Sep 27, 1994
+2 ;
BUILD ; Build a test expansion and codes into ^TMP
+1 ;
+2 NEW LAI,T,P1,P2,P3,S1,J1
+3 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+4 ;
+5 KILL ^TMP($JOB)
+6 ;
+7 SET LAI=0
+8 FOR
SET LAI=$ORDER(^LAB(62.4,LRINST,3,LAI))
if LAI'>0
QUIT
Begin DoDot:1
+9 SET T=$GET(^LAB(62.4,LRINST,3,LAI,0))
SET ^TMP($JOB,+T,+T)=$PIECE(T,"^",6)
End DoDot:1
+10 ;
+11 ; Expand the LL test.
+12 SET P1=0
+13 FOR
SET P1=$ORDER(^LRO(68.2,LRLL,10,P1))
if P1'>0
QUIT
Begin DoDot:1
+14 SET P2=0
+15 FOR
SET P2=$ORDER(^LRO(68.2,LRLL,10,P1,1,P2))
if P2'>0
QUIT
SET P3=^(P2,0)
DO BU2
End DoDot:1
+16 ;
+17 QUIT
+18 ;
+19 ;
BU2 SET (J,S1)=0
SET (T,X)=+P3
+1 DO TREE
+2 QUIT
+3 ;
+4 ;
TREE ;
+1 ; Bad LRTEST number; from LREXPD
+2 IF '$DATA(^LAB(60,X,0))
QUIT
+3 IF $PIECE(^LAB(60,X,0),U,5)]""
IF $DATA(^TMP($JOB,X,X))
SET ^TMP($JOB,T,X)=^TMP($JOB,X,X)
+4 ; Not a panel
+5 if '$DATA(^LAB(60,X,2,0))
QUIT
if $ORDER(^(0))<1
QUIT
+6 ;
+7 SET S1=S1+1
SET S1(S1)=X
SET J1(S1)=J
+8 FOR J=0:0
SET J=$ORDER(^LAB(60,S1(S1),2,J))
if J<1
QUIT
SET X=+^(J,0)
DO TREE
+9 SET J=J1(S1)
SET X=S1(S1)
SET S1=S1-1
+10 ;
+11 QUIT
