source: WorldVistAEHR/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LADOWN1.m@ 701

Last change on this file since 701 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 901 bytes
RevLine 
[613]1LADOWN1 ;DALOI/DG - UTILITY PARTS OF DOWNLOAD ;7/20/90 08:07
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**17,42,57**;Sep 27, 1994
3 ;
4BUILD ; Build a test expansion and codes into ^TMP
5 ;
6 N LAI,T,P1,P2,P3,S1,J1
7 S:$D(ZTQUEUED) ZTREQ="@"
8 ;
9 K ^TMP($J)
10 ;
11 S LAI=0
12 F S LAI=$O(^LAB(62.4,LRINST,3,LAI)) Q:LAI'>0 D
13 . S T=$G(^LAB(62.4,LRINST,3,LAI,0)),^TMP($J,+T,+T)=$P(T,"^",6)
14 ;
15 ; Expand the LL test.
16 S P1=0
17 F S P1=$O(^LRO(68.2,LRLL,10,P1)) Q:P1'>0 D
18 . S P2=0
19 . F S P2=$O(^LRO(68.2,LRLL,10,P1,1,P2)) Q:P2'>0 S P3=^(P2,0) D BU2
20 ;
21 Q
22 ;
23 ;
24BU2 S (J,S1)=0,(T,X)=+P3
25 D TREE
26 Q
27 ;
28 ;
29TREE ;
30 ; Bad LRTEST number; from LREXPD
31 I '$D(^LAB(60,X,0)) Q
32 I $P(^LAB(60,X,0),U,5)]"",$D(^TMP($J,X,X)) S ^TMP($J,T,X)=^TMP($J,X,X)
33 ; Not a panel
34 Q:'$D(^LAB(60,X,2,0)) Q:$O(^(0))<1
35 ;
36 S S1=S1+1,S1(S1)=X,J1(S1)=J
37 F J=0:0 S J=$O(^LAB(60,S1(S1),2,J)) Q:J<1 S X=+^(J,0) D TREE
38 S J=J1(S1),X=S1(S1),S1=S1-1
39 ;
40 Q
Note: See TracBrowser for help on using the repository browser.