LAB ;SLC/RWF - AUTOMATED INSTRUMENT LAB INTERFACE ;9/10/90 13:59 ;
;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994
S:$D(ZTQUEUED) ZTREQ="@"
S LANM=$T(+0),HOME=$O(^LAB(62.4,"C",LANM,0)),BASE=HOME-1 Q:HOME<1
Q:$D(^LA("LOCK",HOME))
D INIT^LABINIT C:IO(0)'=IO IO(0) S X="TRAP^"_LANM,@^%ZOSF("TRAP")
R X:1,X:1 ;FLUSH BUFFER
IO S T=T-BASE,HDR="T"_$E(100+T,2,3)_"L"_$E(1000+$L(OUT),2,4)
F I=1:1:100 W HDR,!,OUT,! R *X:5 Q:$C(X)=ACK Q:(X=-1)&(T=0)
S TRY=0
RD S ^LA(HOME,"R")=$H R HRD:TOUT G TOUT:'$T R IN:5 G TOUT:'$T 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 W NAK G RD
W ACK G W:TRY>49
IO1 S TOUT=5 IF $D(^LA("TP",0)) S ^LA("TP",0)=1+^(0),^(^(0))=T_"^"_$E(IN,1,250)
IF T=HOME S RT=$H,ASK=-2
IO2 IF '$D(^LA(T,"I")),$D(^LAB(62.4,T,1)) X ^(1)
IF '$D(^LA(T,"I")) S T=HOME
L ^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 L IF $D(^LA("STOP",HOME)) K ^LA("LOCK",HOME),^LA(HOME),^LA("STOP",HOME) G H^XUS
S T=BASE,OUT="" G IO:^LA("Q")'>^LA(HOME,"Q")
L ^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,"O",0))
S CNT=^LA(T,"O",0)+1 IF $D(^(CNT)) S ^(0)=CNT,OUT=^(CNT)
IF $D(^LA("TP",0)) S ^LA("TP",0)=1+^(0),^(^(0))=T_"^Sent: "_$E(OUT,1,245)
S TOUT=5 G IO
;
SET S ER=$D(^LA(T,"I")) Q:ER S:'$D(^LA(T,"I"))#2 ^LA(T,"I")=0,^("I",0)=0
SETO S:'$D(^LA(T,"O"))#2 ^LA(T,"O")=0,^("O",0)=0,^LA(T,"Q")=0 D GETENV^%ZOSV S ^LA(T,"ENV")=Y Q
;^LA(T,"ENV")=UCI^VOLUME SET^VAX NODE
;
TOUT S:TOUT<15 TOUT=TOUT+1 S:TOUT>15 ASK=ASK+1
IF ASK=0,TOUT>15 S T=HOME,OUT="1" 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
DQ S LANM=$T(+0),HOME=$O(^LAB(62.4,"C",LANM,0)) Q:HOME=""!(HOME>99)!(HOME#10'=1)
I $D(^LAB(62.4,HOME,0)),$L($P(^(0),"^",2)) S ZTIO=$P(^(0),"^",2),ZTRTN=LANM,ZTDTH=$H,ZTDESC="START LAB JOB PORT # "_HOME K ^LA("LOCK",HOME) D ^%ZTLOAD
Q
TRAP D ^LABERR
S T=HOME,OUT=1,TOUT=5,ASK=-2,ACK="A",NAK="N",ER=0 U IO R X:1,X:1 G @("IO^"_LANM)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLAB 2230 printed Nov 22, 2024@16:51:35 Page 2
LAB ;SLC/RWF - AUTOMATED INSTRUMENT LAB INTERFACE ;9/10/90 13:59 ;
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994
+2 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 SET LANM=$TEXT(+0)
SET HOME=$ORDER(^LAB(62.4,"C",LANM,0))
SET BASE=HOME-1
if HOME<1
QUIT
+4 if $DATA(^LA("LOCK",HOME))
QUIT
+5 DO INIT^LABINIT
if IO(0)'=IO
CLOSE IO(0)
SET X="TRAP^"_LANM
SET @^%ZOSF("TRAP")
+6 ;FLUSH BUFFER
READ X:1,X:1
IO SET T=T-BASE
SET HDR="T"_$EXTRACT(100+T,2,3)_"L"_$EXTRACT(1000+$LENGTH(OUT),2,4)
+1 FOR I=1:1:100
WRITE HDR,!,OUT,!
READ *X:5
if $CHAR(X)=ACK
QUIT
if (X=-1)&(T=0)
QUIT
+2 SET TRY=0
RD SET ^LA(HOME,"R")=$HOROLOG
READ HRD:TOUT
if '$TEST
GOTO TOUT
READ IN:5
if '$TEST
GOTO TOUT
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
WRITE NAK
GOTO RD
+2 WRITE ACK
if TRY>49
GOTO W
IO1 SET TOUT=5
IF $DATA(^LA("TP",0))
SET ^LA("TP",0)=1+^(0)
SET ^(^(0))=T_"^"_$EXTRACT(IN,1,250)
+1 IF T=HOME
SET RT=$HOROLOG
SET ASK=-2
IO2 IF '$DATA(^LA(T,"I"))
IF $DATA(^LAB(62.4,T,1))
XECUTE ^(1)
+1 IF '$DATA(^LA(T,"I"))
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 LOCK
IF $DATA(^LA("STOP",HOME))
KILL ^LA("LOCK",HOME),^LA(HOME),^LA("STOP",HOME)
GOTO H^XUS
+1 SET T=BASE
SET OUT=""
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,"O",0))
GOTO W
+4 SET CNT=^LA(T,"O",0)+1
IF $DATA(^(CNT))
SET ^(0)=CNT
SET OUT=^(CNT)
+5 IF $DATA(^LA("TP",0))
SET ^LA("TP",0)=1+^(0)
SET ^(^(0))=T_"^Sent: "_$EXTRACT(OUT,1,245)
+6 SET TOUT=5
GOTO IO
+7 ;
SET SET ER=$DATA(^LA(T,"I"))
if ER
QUIT
if '$DATA(^LA(T,"I"))#2
SET ^LA(T,"I")=0
SET ^("I",0)=0
SETO if '$DATA(^LA(T,"O"))#2
SET ^LA(T,"O")=0
SET ^("O",0)=0
SET ^LA(T,"Q")=0
DO GETENV^%ZOSV
SET ^LA(T,"ENV")=Y
QUIT
+1 ;^LA(T,"ENV")=UCI^VOLUME SET^VAX NODE
+2 ;
TOUT if TOUT<15
SET TOUT=TOUT+1
if TOUT>15
SET ASK=ASK+1
+1 IF ASK=0
IF TOUT>15
SET T=HOME
SET OUT="1"
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
DQ SET LANM=$TEXT(+0)
SET HOME=$ORDER(^LAB(62.4,"C",LANM,0))
if HOME=""!(HOME>99)!(HOME#10'=1)
QUIT
+1 IF $DATA(^LAB(62.4,HOME,0))
IF $LENGTH($PIECE(^(0),"^",2))
SET ZTIO=$PIECE(^(0),"^",2)
SET ZTRTN=LANM
SET ZTDTH=$HOROLOG
SET ZTDESC="START LAB JOB PORT # "_HOME
KILL ^LA("LOCK",HOME)
DO ^%ZTLOAD
+2 QUIT
TRAP DO ^LABERR
+1 SET T=HOME
SET OUT=1
SET TOUT=5
SET ASK=-2
SET ACK="A"
SET NAK="N"
SET ER=0
USE IO
READ X:1,X:1
GOTO @("IO^"_LANM)
