- LAEPXPXX ;SLC/DLG - AUTOMATED SINGLE INSTRUMENT EPX DIRECT CONNECT LAB INTERFACE ;9/5/90 14:34 ;
- ;;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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLAEPXPXX 2050 printed Feb 18, 2025@23:08:48 Page 2
- LAEPXPXX ;SLC/DLG - AUTOMATED SINGLE INSTRUMENT EPX DIRECT CONNECT LAB INTERFACE ;9/5/90 14:34 ;
- +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="@"
- SET LANM=$TEXT(+0)
- SET (HOME,T)=+$EXTRACT(LANM,7,8)
- if +T<1
- QUIT
- if $DATA(^LA("LOCK",T))
- QUIT
- +11 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=""
- +12 DO ^%ZIS
- if POP
- GOTO H^XUS
- USE IO
- XECUTE ^%ZOSF("TYPE-AHEAD")
- XECUTE ^%ZOSF("LABOFF")
- +13 if IO(0)'=IO
- CLOSE IO(0)
- SET X="TRAP^"_LANM
- SET @^%ZOSF("TRAP")
- SET DUZ=.5
- +14 SET ^LA("LOCK",T)=$JOB
- +15 ;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
