LAEPXPXX ; IHS/DIR/FJE - AUTOMATED SINGLE INSTRUMENT EPX DIRECT CONNECT LAB INTERFACE 9/5/90 14:34 ;
;;5.2;LA;;NOV 01, 1997
;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994
;THIS ROUTINE IS STARTED TO RUN AN INSTRUMENT DIRECT TO A CPU
;RATHER THAN THRU THE LSI. IT IS A CONSTANT BACKGROUND JOB
;THAT ONLY STOPS WHEN SYSTEM IS TAKEN DOWN OR THE JOB IS STOPPED BY
;SETTING THE ^LA("STOP",INST#)=""
;THE CODE HAS A DATA TRAP CAPABILITY TO TRAP ALL DATA GOING THRU
;THIS ROUTINE. S ^LA("D"_T,0)=0 WHERE T IS THE AUTOINSTRUMENT
;ENTRY NUMBER WILL TURN THE TRAP ON. K ^LA("D"_T) WILL TURN THE
;TRAP OFF AND KILL ALL THE DATA.
S:$D(ZTQUEUED) ZTREQ="@" S LANM=$T(+0),(HOME,T)=+$E(LANM,7,8) Q:+T<1 Q:$D(^LA("LOCK",T))
S DEB="D"_T,PAR=$S($D(^LAB(62.4,T,.5))#2:^(.5),1:""),OUT="",BASE=0,TOUT=5,U="^",IOP=$P(^LAB(62.4,HOME,0),"^",2) G:IOP="" H^XUS S IOP=IOP_";255",%ZIS=""
D ^%ZIS G:POP H^XUS U IO X ^%ZOSF("TYPE-AHEAD"),^%ZOSF("LABOFF")
C:IO(0)'=IO IO(0) S X="TRAP^"_LANM,@^%ZOSF("TRAP"),DUZ=.5
S ^LA("LOCK",T)=$J
R X:1,X:1 ;ALLOW BREAK AND FLUSH BUFFER
LA2 I OUT]"" D:$D(^LA(DEB,0)) DEBUGO W OUT G:OUT'["#" W W *13 S TRY=0,OUT=""
RD S IN="" F I=0:0 R *X:TOUT Q:'$T Q:X=13 S IN=IN_$C(X) Q:$L(IN)=255
G:X<0 TOUT
LA22 D SET
L ^LA(T) G LA22:'$D(^LA(T,"I"))#2 S CNT=^LA(T,"I")+1,^("I")=CNT,^("I",CNT)=IN L
D:$D(^LA(DEB,0)) DEBUGI
I IN'["#" G RD
I PAR]"" S OUT="" X PAR I OUT]"" S T=T+BASE G LA2
G RD
W IF $D(^LA("STOP",HOME)) K ^LA("LOCK",HOME),^LA("STOP",HOME) G H^XUS
S OUT="" S CNT=^LA(T,"O",0)+1 IF $D(^(CNT)) S ^(0)=CNT,OUT=^(CNT)
S TOUT=5 G LA2
;
SET 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 Q
;
TOUT S TOUT=$S(TOUT<8:TOUT+1,1:5) G:TOUT'=5 RD S OUT="" G RD:'$D(^LA(T))
I $D(^LA(T,"O",0)),^LA(T,"O")>^LA(T,"O",0) G W
G RD Q
DQ K ^LA("LOCK",$E($T(+0),7,8)) G LAEPXPXX
DEBUGO S (Q,^LA(DEB,0))=^LA(DEB,0)+1,^(Q)="OUT: "_$E(OUT,1,230)_"%^%"_$H Q
DEBUGI S (Q,^LA(DEB,0))=^LA(DEB,0)+1,^(Q)="IN: "_$E(IN,1,230)_"%^%"_$H Q
TRAP D ^LABERR S T=TSK D SET G @("LA2^"_LANM)
Q
LAEPXPXX ; IHS/DIR/FJE - AUTOMATED SINGLE INSTRUMENT EPX DIRECT CONNECT LAB INTERFACE 9/5/90 14:34 ;
+1 ;;5.2;LA;;NOV 01, 1997
+2 ;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994
+3 ;THIS ROUTINE IS STARTED TO RUN AN INSTRUMENT DIRECT TO A CPU
+4 ;RATHER THAN THRU THE LSI. IT IS A CONSTANT BACKGROUND JOB
+5 ;THAT ONLY STOPS WHEN SYSTEM IS TAKEN DOWN OR THE JOB IS STOPPED BY
+6 ;SETTING THE ^LA("STOP",INST#)=""
+7 ;THE CODE HAS A DATA TRAP CAPABILITY TO TRAP ALL DATA GOING THRU
+8 ;THIS ROUTINE. S ^LA("D"_T,0)=0 WHERE T IS THE AUTOINSTRUMENT
+9 ;ENTRY NUMBER WILL TURN THE TRAP ON. K ^LA("D"_T) WILL TURN THE
+10 ;TRAP OFF AND KILL ALL THE DATA.
+11 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
SET LANM=$TEXT(+0)
SET (HOME,T)=+$EXTRACT(LANM,7,8)
IF +T<1
QUIT
IF $DATA(^LA("LOCK",T))
QUIT
+12 SET DEB="D"_T
SET PAR=$SELECT($DATA(^LAB(62.4,T,.5))#2:^(.5),1:"")
SET OUT=""
SET BASE=0
SET TOUT=5
SET U="^"
SET IOP=$PIECE(^LAB(62.4,HOME,0),"^",2)
IF IOP=""
GOTO H^XUS
SET IOP=IOP_";255"
SET %ZIS=""
+13 DO ^%ZIS
IF POP
GOTO H^XUS
USE IO
XECUTE ^%ZOSF("TYPE-AHEAD")
XECUTE ^%ZOSF("LABOFF")
+14 IF IO(0)'=IO
CLOSE IO(0)
SET X="TRAP^"_LANM
SET @^%ZOSF("TRAP")
SET DUZ=.5
+15 SET ^LA("LOCK",T)=$JOB
+16 ;ALLOW BREAK AND FLUSH BUFFER
READ X:1,X:1
LA2 IF OUT]""
IF $DATA(^LA(DEB,0))
DO DEBUGO
WRITE OUT
IF OUT'["#"
GOTO W
WRITE *13
SET TRY=0
SET OUT=""
RD SET IN=""
FOR I=0:0
READ *X:TOUT
IF '$TEST
QUIT
IF X=13
QUIT
SET IN=IN_$CHAR(X)
IF $LENGTH(IN)=255
QUIT
+1 IF X<0
GOTO TOUT
LA22 DO SET
+1 LOCK ^LA(T)
IF '$DATA(^LA(T,"I"))#2
GOTO LA22
SET CNT=^LA(T,"I")+1
SET ^("I")=CNT
SET ^("I",CNT)=IN
LOCK
+2 IF $DATA(^LA(DEB,0))
DO DEBUGI
+3 IF IN'["#"
GOTO RD
+4 IF PAR]""
SET OUT=""
XECUTE PAR
IF OUT]""
SET T=T+BASE
GOTO LA2
+5 GOTO RD
W IF $DATA(^LA("STOP",HOME))
KILL ^LA("LOCK",HOME),^LA("STOP",HOME)
GOTO H^XUS
+1 SET OUT=""
SET CNT=^LA(T,"O",0)+1
IF $DATA(^(CNT))
SET ^(0)=CNT
SET OUT=^(CNT)
+2 SET TOUT=5
GOTO LA2
+3 ;
SET 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
QUIT
+1 ;
TOUT SET TOUT=$SELECT(TOUT<8:TOUT+1,1:5)
IF TOUT'=5
GOTO RD
SET OUT=""
IF '$DATA(^LA(T))
GOTO RD
+1 IF $DATA(^LA(T,"O",0))
IF ^LA(T,"O")>^LA(T,"O",0)
GOTO W
+2 GOTO RD
QUIT
DQ KILL ^LA("LOCK",$EXTRACT($TEXT(+0),7,8))
GOTO LAEPXPXX
DEBUGO SET (Q,^LA(DEB,0))=^LA(DEB,0)+1
SET ^(Q)="OUT: "_$EXTRACT(OUT,1,230)_"%^%"_$HOROLOG
QUIT
DEBUGI SET (Q,^LA(DEB,0))=^LA(DEB,0)+1
SET ^(Q)="IN: "_$EXTRACT(IN,1,230)_"%^%"_$HOROLOG
QUIT
TRAP DO ^LABERR
SET T=TSK
DO SET
GOTO @("LA2^"_LANM)
+1 QUIT
