LAPORTXX ;SLC/DLG - AUTOMATED SINGLE INSTRUMENT LAB INTERFACE ;8/16/90 14:22 ;
;;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=^LAB(62.4,HOME,.75) 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 S:'$D(^LA(T,"Q")) ^LA(T,"Q")=0 S:(OUT]""&$D(^LA(DEB,0))) (Q,^LA(DEB,0))=^LA(DEB,0)+1,^(Q)="OUT: "_OUT_"%^%"_$H W:OUT]"" OUT,! S TRY=0,(OUT,IN)=""
RD R IN:TOUT G TOUT:'$T S:$D(^LA(DEB,0)) (Q,^LA(DEB,0))=^LA(DEB,0)+1,^(Q)="IN: "_IN_"%^%"_$H S:$E(IN,1)=$C(1) IN=$E(IN,2,999)
IO1 S TOUT=5 IF T=HOME S RT=$H,ASK=-2
IO2 D SET
L ^LA(T) G IO2:'$D(^LA(T,"I"))#2 S CNT=^LA(T,"I")+1,^("I")=CNT,^("I",CNT)=IN L
I PAR]"" S OUT="" X PAR I OUT]"" S T=T+BASE G LA2
W S:'$D(^LA(T,"Q")) ^("Q")=0 IF $D(^LA("STOP",HOME)) K ^LA("LOCK",HOME),^LA("STOP",HOME) G H^XUS
S OUT="" G LA2:^LA("Q")'>^LA(HOME,"Q") L ^LA("Q") S Q=0
F I=0:0 S Q=$O(^LA("Q",Q)) Q:Q<1 Q:^(Q)=T
L K:Q>0 ^LA("Q",Q) G LA2:Q<1
I $D(^LA(T,"O",0)) 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 S:'$D(^LA(T,"O"))#2 ^LA(T,"O")=0,^("O",0)=0,^LA(T,"Q")=0 Q:$D(^LA(T,"ENV")) D GETENV^%ZOSV S ^LA(T,"ENV")=Y Q
;
TOUT S TOUT=$S(TOUT<15:TOUT+1,1:5) S OUT="" I $D(^LA(T,"O",0)),(^LA(T,"O")>^LA(T,"O",0)) G W
G RD Q
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 K ^LA("LOCK",T) I $D(^LA("Q")),$O(^LA("Q"))="" K ^LA("Q")
G LAPORTXX
TRAP D ^LABERR S T=TSK D SET^LAB G @("LA2^"_LANM)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLAPORTXX 2321 printed Dec 13, 2024@01:44:02 Page 2
LAPORTXX ;SLC/DLG - AUTOMATED SINGLE INSTRUMENT LAB INTERFACE ;8/16/90 14:22 ;
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994
+2 ;THIS ROUTINE IS STARTED TO RUN AN INSTRUMENT DIRECT TO A CPU
+3 ;RATHER THAN THRU THE LSI. IT IS A CONSTANT BACKGROUND JOB
+4 ;THAT ONLY STOPS WHEN SYSTEM IS TAKEN DOWN OR THE JOB IS STOPPED BY
+5 ;SETTING THE ^LA("STOP",INST#)=""
+6 ;THE CODE HAS A DATA TRAP CAPABILITY TO TRAP ALL DATA GOING THRU
+7 ;THIS ROUTINE. S ^LA("D"_T,0)=0 WHERE T IS THE AUTOINSTRUMENT
+8 ;ENTRY NUMBER WILL TURN THE TRAP ON. K ^LA("D"_T) WILL TURN THE
+9 ;TRAP OFF AND KILL ALL THE DATA.
+10 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+11 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=^LAB(62.4,HOME,.75)
if IOP=""
GOTO H^XUS
+13 SET IOP=IOP_";255"
SET %ZIS=""
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 '$DATA(^LA(T,"Q"))
SET ^LA(T,"Q")=0
if (OUT]""&$DATA(^LA(DEB,0)))
SET (Q,^LA(DEB,0))=^LA(DEB,0)+1
SET ^(Q)="OUT: "_OUT_"%^%"_$HOROLOG
if OUT]""
WRITE OUT,!
SET TRY=0
SET (OUT,IN)=""
RD READ IN:TOUT
if '$TEST
GOTO TOUT
if $DATA(^LA(DEB,0))
SET (Q,^LA(DEB,0))=^LA(DEB,0)+1
SET ^(Q)="IN: "_IN_"%^%"_$HOROLOG
if $EXTRACT(IN,1)=$CHAR(1)
SET IN=$EXTRACT(IN,2,999)
IO1 SET TOUT=5
IF T=HOME
SET RT=$HOROLOG
SET ASK=-2
IO2 DO SET
+1 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
+2 IF PAR]""
SET OUT=""
XECUTE PAR
IF OUT]""
SET T=T+BASE
GOTO LA2
W if '$DATA(^LA(T,"Q"))
SET ^("Q")=0
IF $DATA(^LA("STOP",HOME))
KILL ^LA("LOCK",HOME),^LA("STOP",HOME)
GOTO H^XUS
+1 SET OUT=""
if ^LA("Q")'>^LA(HOME,"Q")
GOTO LA2
LOCK ^LA("Q")
SET Q=0
+2 FOR I=0:0
SET Q=$ORDER(^LA("Q",Q))
if Q<1
QUIT
if ^(Q)=T
QUIT
+3 LOCK
if Q>0
KILL ^LA("Q",Q)
if Q<1
GOTO LA2
+4 IF $DATA(^LA(T,"O",0))
SET CNT=^LA(T,"O",0)+1
IF $DATA(^(CNT))
SET ^(0)=CNT
SET OUT=^(CNT)
+5 SET TOUT=5
GOTO LA2
+6 ;
SET if '$DATA(^LA(T,"I"))#2
SET ^LA(T,"I")=0
SET ^("I",0)=0
if '$DATA(^LA(T,"O"))#2
SET ^LA(T,"O")=0
SET ^("O",0)=0
SET ^LA(T,"Q")=0
if $DATA(^LA(T,"ENV"))
QUIT
DO GETENV^%ZOSV
SET ^LA(T,"ENV")=Y
QUIT
+1 ;
TOUT SET TOUT=$SELECT(TOUT<15:TOUT+1,1:5)
SET OUT=""
IF $DATA(^LA(T,"O",0))
IF (^LA(T,"O")>^LA(T,"O",0))
GOTO W
+1 GOTO RD
QUIT
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 KILL ^LA("LOCK",T)
IF $DATA(^LA("Q"))
IF $ORDER(^LA("Q"))=""
KILL ^LA("Q")
+1 GOTO LAPORTXX
TRAP DO ^LABERR
SET T=TSK
DO SET^LAB
GOTO @("LA2^"_LANM)
