LADOWN1.m

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

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