- LABTEST ; IHS/DIR/FJE - AUTOMATED INSTRUMENT INTERFACE TESTING 7/20/90 07:37 ;
- ;;5.2;LA;;NOV 01, 1997
- ;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994
- A S DIC="^LAB(62.4,",DIC(0)="AEMQZ",DIC("S")="I Y<99,Y#10=1" D ^DIC G END:Y<1 S LANM=$P(Y(0),"^",3)
- S HOME=$O(^LAB(62.4,"C",LANM,0)),BASE=HOME-1 I HOME<1 W !,$C(7),"Can't find '",LANM,"' as a program name in auto instrument file." Q
- S U="^",IOP=$P(^LAB(62.4,HOME,0),U,2),%ZIS="" I IOP="" W !,$C(7),"No IO device to open in auto instrument file." Q
- D ^%ZIS W !,"I ",$S(POP:"Can't open",1:"Will use")," the data IO device: ",ION,"." Q:POP
- D INIT^LABINIT K IOP,%ZIS S LANM="LABTEST"
- X ^%ZOSF("NBRK") U IO(0) W $C(7),!,"Now please turn-OFF then ON the interface."
- F I=1:1:30 U IO R X:60 U IO(0) W !,X Q:X["START"
- X ^%ZOSF("BRK")
- U IO(0) I X'["START" W !,"Did not find starting point. Please check cables." G TRAP
- U IO W *13,*13 R X:2 ;
- IO S T=T-BASE,HDR="T"_$E(100+T,2,3)_"L"_$E(1000+$L(OUT),2,4)
- U IO(0) W !,"==>",HDR," ",OUT," " F I=1:1:100 U IO W HDR,!,OUT,! R *X:5 U IO(0) W $C(X) Q:$C(X)=ACK Q:(X=-1)&(T=0)
- S TRY=0
- RD U IO R HRD:TOUT G TOUT:'$T R IN:2 U IO(0) W !,"<==",HRD," ",IN," " S T=+$E(HRD,2,3)+BASE,L=+$E(HRD,5,7),M=+$E(HRD,9,11)
- I HRD'?1"T"2N1"L"3N1"M"3N!(L'=$L(IN)),TRY<50 S TRY=TRY+1 U IO(0) W NAK U IO W NAK G RD
- U IO(0) W ACK U IO W ACK G W:TRY>49
- IO1 S TOUT=2 IF $D(^LA("TP",0)) S ^LA("TP",0)=1+^(0),^(^(0))=IN
- IF T=HOME S RT=$H,ASK=-2
- IO2 IF '$D(^LA(T)),$D(^LAB(62.4,T,1)) X ^(1)
- IF '$D(^LA(T)) S T=HOME
- LOCK ^LA(T) G IO2:'$D(^LA(T,"I"))#2 S CNT=^LA(T,"I")+1,^("I")=CNT,^("I",CNT)=IN L
- I $D(^LAB(62.4,T,.5)) S OUT="" X ^(.5) I OUT'="" S T=T+BASE G IO
- W IF $D(^LA("STOP")) K ^LA("LOCK",HOME),^LA("STOP",HOME),^LA(HOME),^TMP($J),^TMP("LA",$J) G H^XUS
- S OTN=-1,OUT=$S(TOUT<10:"",1:"1"),T=$S(OUT:HOME,1:BASE) G IO:^LA("Q")=^LA(HOME,"Q")
- LOCK ^LA("Q") S Q=^LA(HOME,"Q")+1,^("Q")=Q,T=$S($D(^LA("Q",Q)):^(Q),1:0) G W:T<HOME,W:HOME+9<T
- K ^LA("Q",Q) L G IO:T<1,W:'$D(^LA(T))
- S CNT=^LA(T,"O",0)+1 IF $D(^(CNT)) S ^(0)=CNT,OUT=^(CNT)
- S TOUT=2 G IO
- ;
- SET G SET^LAB
- ;
- TOUT S:TOUT<35 TOUT=TOUT+2 S:TOUT>35 ASK=ASK+1
- IF ASK=0,TOUT>35 S OUT="1",T=HOME G IO
- IF ASK>1 D ^LABALARM S ASK=-1 U IO
- G W
- OUT S CNT=^LA(T,"O")+1,^("O")=CNT,^("O",CNT)=OUT
- LOCK ^LA("Q") S Q=^LA("Q")+1,^("Q")=Q,^("Q",Q)=T LOCK
- Q
- INIT ;
- TRAP D ^LABERR K ^LA("LOCK",HOME) D ^%ZISC U IO(0) W !,"LABTEST STOPPED.",!
- Q
- END K DIC,LANM Q
- LABTEST ; IHS/DIR/FJE - AUTOMATED INSTRUMENT INTERFACE TESTING 7/20/90 07:37 ;
- +1 ;;5.2;LA;;NOV 01, 1997
- +2 ;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994
- A SET DIC="^LAB(62.4,"
- SET DIC(0)="AEMQZ"
- SET DIC("S")="I Y<99,Y#10=1"
- DO ^DIC
- IF Y<1
- GOTO END
- SET LANM=$PIECE(Y(0),"^",3)
- +1 SET HOME=$ORDER(^LAB(62.4,"C",LANM,0))
- SET BASE=HOME-1
- IF HOME<1
- WRITE !,$CHAR(7),"Can't find '",LANM,"' as a program name in auto instrument file."
- QUIT
- +2 SET U="^"
- SET IOP=$PIECE(^LAB(62.4,HOME,0),U,2)
- SET %ZIS=""
- IF IOP=""
- WRITE !,$CHAR(7),"No IO device to open in auto instrument file."
- QUIT
- +3 DO ^%ZIS
- WRITE !,"I ",$SELECT(POP:"Can't open",1:"Will use")," the data IO device: ",ION,"."
- IF POP
- QUIT
- +4 DO INIT^LABINIT
- KILL IOP,%ZIS
- SET LANM="LABTEST"
- +5 XECUTE ^%ZOSF("NBRK")
- USE IO(0)
- WRITE $CHAR(7),!,"Now please turn-OFF then ON the interface."
- +6 FOR I=1:1:30
- USE IO
- READ X:60
- USE IO(0)
- WRITE !,X
- IF X["START"
- QUIT
- +7 XECUTE ^%ZOSF("BRK")
- +8 USE IO(0)
- IF X'["START"
- WRITE !,"Did not find starting point. Please check cables."
- GOTO TRAP
- +9 ;
- USE IO
- WRITE *13,*13
- READ X:2
- IO SET T=T-BASE
- SET HDR="T"_$EXTRACT(100+T,2,3)_"L"_$EXTRACT(1000+$LENGTH(OUT),2,4)
- +1 USE IO(0)
- WRITE !,"==>",HDR," ",OUT," "
- FOR I=1:1:100
- USE IO
- WRITE HDR,!,OUT,!
- READ *X:5
- USE IO(0)
- WRITE $CHAR(X)
- IF $CHAR(X)=ACK
- QUIT
- IF (X=-1)&(T=0)
- QUIT
- +2 SET TRY=0
- RD USE IO
- READ HRD:TOUT
- IF '$TEST
- GOTO TOUT
- READ IN:2
- USE IO(0)
- WRITE !,"<==",HRD," ",IN," "
- SET T=+$EXTRACT(HRD,2,3)+BASE
- SET L=+$EXTRACT(HRD,5,7)
- SET M=+$EXTRACT(HRD,9,11)
- +1 IF HRD'?1"T"2N1"L"3N1"M"3N!(L'=$LENGTH(IN))
- IF TRY<50
- SET TRY=TRY+1
- USE IO(0)
- WRITE NAK
- USE IO
- WRITE NAK
- GOTO RD
- +2 USE IO(0)
- WRITE ACK
- USE IO
- WRITE ACK
- IF TRY>49
- GOTO W
- IO1 SET TOUT=2
- IF $DATA(^LA("TP",0))
- SET ^LA("TP",0)=1+^(0)
- SET ^(^(0))=IN
- +1 IF T=HOME
- SET RT=$HOROLOG
- SET ASK=-2
- IO2 IF '$DATA(^LA(T))
- IF $DATA(^LAB(62.4,T,1))
- XECUTE ^(1)
- +1 IF '$DATA(^LA(T))
- SET T=HOME
- +2 LOCK ^LA(T)
- IF '$DATA(^LA(T,"I"))#2
- GOTO IO2
- SET CNT=^LA(T,"I")+1
- SET ^("I")=CNT
- SET ^("I",CNT)=IN
- LOCK
- +3 IF $DATA(^LAB(62.4,T,.5))
- SET OUT=""
- XECUTE ^(.5)
- IF OUT'=""
- SET T=T+BASE
- GOTO IO
- W IF $DATA(^LA("STOP"))
- KILL ^LA("LOCK",HOME),^LA("STOP",HOME),^LA(HOME),^TMP($JOB),^TMP("LA",$JOB)
- GOTO H^XUS
- +1 SET OTN=-1
- SET OUT=$SELECT(TOUT<10:"",1:"1")
- SET T=$SELECT(OUT:HOME,1:BASE)
- IF ^LA("Q")=^LA(HOME,"Q")
- GOTO IO
- +2 LOCK ^LA("Q")
- SET Q=^LA(HOME,"Q")+1
- SET ^("Q")=Q
- SET T=$SELECT($DATA(^LA("Q",Q)):^(Q),1:0)
- IF T<HOME
- GOTO W
- IF HOME+9<T
- GOTO W
- +3 KILL ^LA("Q",Q)
- LOCK
- IF T<1
- GOTO IO
- IF '$DATA(^LA(T))
- GOTO W
- +4 SET CNT=^LA(T,"O",0)+1
- IF $DATA(^(CNT))
- SET ^(0)=CNT
- SET OUT=^(CNT)
- +5 SET TOUT=2
- GOTO IO
- +6 ;
- SET GOTO SET^LAB
- +1 ;
- TOUT IF TOUT<35
- SET TOUT=TOUT+2
- IF TOUT>35
- SET ASK=ASK+1
- +1 IF ASK=0
- IF TOUT>35
- SET OUT="1"
- SET T=HOME
- GOTO IO
- +2 IF ASK>1
- DO ^LABALARM
- SET ASK=-1
- USE IO
- +3 GOTO W
- OUT SET CNT=^LA(T,"O")+1
- SET ^("O")=CNT
- SET ^("O",CNT)=OUT
- +1 LOCK ^LA("Q")
- SET Q=^LA("Q")+1
- SET ^("Q")=Q
- SET ^("Q",Q)=T
- LOCK
- +2 QUIT
- INIT ;
- TRAP DO ^LABERR
- KILL ^LA("LOCK",HOME)
- DO ^%ZISC
- USE IO(0)
- WRITE !,"LABTEST STOPPED.",!
- +1 QUIT
- END KILL DIC,LANM
- QUIT
