LA1103 ;SLC/RWF - TO CHECK THE STATUS OF THE LSI-11 INTERFACE ; 8/5/87 21:0 ;
;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994
ASK ;from LRJOB
I '$D(^LA("Q")) W !,"There are no LAB routines running to check" Q
S X=$O(^LAB(62.4,0)) I (X<1)!(X>91) W !,"There are no Interface's in the Auto-instrument file." Q
F LR=1:10:91 IF $D(^LAB(62.4,LR,0)) W !,"Checking Interface # ",LR D AS1
K I,LR,Q,X,LROLD,LRCNT,LRPCNT,T,LROUT,LRANS Q
AS1 I '$D(^LA(LR,"I")) W " Routine for this Interface not started." Q
S T=LR,X=0,LROUT=1,LROLD=^LA(LR,"I") D OUT K LRPCNT
AS2 W !,"Interface check ... This may take a minute. "
F I=1:1:15 Q:^LA(LR,"I")>LROLD H 2
S LRCNT=^LA(LR,"I"),LRANS=^LA(LR,"I",LRCNT)
W !,"Interface data line is ",$S(LROLD=LRCNT:"NOT WORKING",1:"OK "_LRANS),!
IF LROLD=LRCNT,'$D(LRPCNT) W !,"LET ME TRY ONCE MORE" S LRPCNT=1 G AS2
Q
OUT S LRCNT=^LA(T,"O")+1,^("O")=LRCNT,^("O",LRCNT)=LROUT
LOCK ^LA("Q") S Q=^LA("Q")+1,^("Q")=Q,^("Q",Q)=T LOCK
Q
ACK ;Build and send the ACK triger/responce string
F LR=1:10:91 I $D(^LAB(62.4,LR,0)) W:'$D(ACK) !,"Sending string for Interface # ",LR D AC2
K I,LR,LROUT,Q,LRCNT,X Q
AC2 S LROUT="" F I=LR:1:LR+9 S X=$S($D(^LAB(62.4,I,0)):^(0),1:""),LROUT=LROUT_$E(100+$P(X,"^",13),2,3)_$E(100+$P(X,"^",14),2,3)
S T=LR D OUT W:'$D(ACK) !?10,"$L(",LROUT,")=",$L(LROUT) Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLA1103 1338 printed Nov 22, 2024@16:48:54 Page 2
LA1103 ;SLC/RWF - TO CHECK THE STATUS OF THE LSI-11 INTERFACE ; 8/5/87 21:0 ;
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994
ASK ;from LRJOB
+1 IF '$DATA(^LA("Q"))
WRITE !,"There are no LAB routines running to check"
QUIT
+2 SET X=$ORDER(^LAB(62.4,0))
IF (X<1)!(X>91)
WRITE !,"There are no Interface's in the Auto-instrument file."
QUIT
+3 FOR LR=1:10:91
IF $DATA(^LAB(62.4,LR,0))
WRITE !,"Checking Interface # ",LR
DO AS1
+4 KILL I,LR,Q,X,LROLD,LRCNT,LRPCNT,T,LROUT,LRANS
QUIT
AS1 IF '$DATA(^LA(LR,"I"))
WRITE " Routine for this Interface not started."
QUIT
+1 SET T=LR
SET X=0
SET LROUT=1
SET LROLD=^LA(LR,"I")
DO OUT
KILL LRPCNT
AS2 WRITE !,"Interface check ... This may take a minute. "
+1 FOR I=1:1:15
if ^LA(LR,"I")>LROLD
QUIT
HANG 2
+2 SET LRCNT=^LA(LR,"I")
SET LRANS=^LA(LR,"I",LRCNT)
+3 WRITE !,"Interface data line is ",$SELECT(LROLD=LRCNT:"NOT WORKING",1:"OK "_LRANS),!
+4 IF LROLD=LRCNT
IF '$DATA(LRPCNT)
WRITE !,"LET ME TRY ONCE MORE"
SET LRPCNT=1
GOTO AS2
+5 QUIT
OUT SET LRCNT=^LA(T,"O")+1
SET ^("O")=LRCNT
SET ^("O",LRCNT)=LROUT
+1 LOCK ^LA("Q")
SET Q=^LA("Q")+1
SET ^("Q")=Q
SET ^("Q",Q)=T
LOCK
+2 QUIT
ACK ;Build and send the ACK triger/responce string
+1 FOR LR=1:10:91
IF $DATA(^LAB(62.4,LR,0))
if '$DATA(ACK)
WRITE !,"Sending string for Interface # ",LR
DO AC2
+2 KILL I,LR,LROUT,Q,LRCNT,X
QUIT
AC2 SET LROUT=""
FOR I=LR:1:LR+9
SET X=$SELECT($DATA(^LAB(62.4,I,0)):^(0),1:"")
SET LROUT=LROUT_$EXTRACT(100+$PIECE(X,"^",13),2,3)_$EXTRACT(100+$PIECE(X,"^",14),2,3)
+1 SET T=LR
DO OUT
if '$DATA(ACK)
WRITE !?10,"$L(",LROUT,")=",$LENGTH(LROUT)
QUIT
