LABCX4H ;SLC/DLG - BECKMAN CX4 AND CX5 PROTOCOL CONTROLLER ; 3/28/89 9:37 AM ;
;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994
;;
;Call with T set to Instrument data is to/from
; P1= RESET POINT FOR INCOMING RECORDS, P3=Reset point FOR RECORDS SENT
S:'$D(^LA(T,"P1")) ^LA(T,"P1")=0,^("P2")=0,^("P3")="IN"
RCHK K LATYPE S NAK=21 S:IN'["~" LATYPE="X" S:'$D(LATYPE) LATYPE=$E(IN,$F(IN,"~")) Q:"ABCDEFUX"'[LATYPE D @LATYPE
Q
A S Q=^LA(T,"I",0)-1 I ^(Q)="~D" S ^LA(T,"P3")="IN",ACK=3,OUT=$C(6),^LA(T,"P1")=Q+1 Q ;REC SOH
B I $D(^LA(T,"O",0)),^LA(T,"O")=^("O",0) S OUT=$C(6),ACK=3 Q ;RECIEVED STX LBO
S OUT=$C(21) Q ;DENY LINE BID OVERRIDE
F ;EVEN ACK
C S Q=^LA(T,"O",0)+1 S:Q<^LA(T,"O") OUT=^("O",Q),^(0)=Q Q ;RECIEVED ODD ACK
D Q ;REC EOT
E S OUT=$S(ACK=3:6,1:3) Q ;REC ENQ
U S Q=^LA(T,"O",0),OUT=^(Q) Q ;RECIEVED NAK RESEND
X D CKSUM S:$E(IN,($L(IN)-1),$L(IN))=LASUM1 OK=1 S STR=+$P(IN,",",2),FTN=+$P(IN,",",3) D:STR=401 @FTN S OUT=$C($S(OK:ACK,1:NAK)) S ACK=$S(ACK=6:3,1:6) Q
CKSUM S LASUM=0
F I=1:1:($L(IN)-2) S LASUM=LASUM+$A(IN,I)
S LASUM=LASUM#256,LASUM=256-LASUM,LASUM1=$F("0123456789ABCDEF",$E(IN,($L(IN)-1)))-2*16+($F("0123456789ABCDEF",$E(IN,$L(IN)))-2)
Q
S LASUM=0 F I=1:1:120 S LASUM=LASUM+(255-$A(IN,I)+1)
S LASUM=LASUM#256,OUT=$S(LASUM=LASUM1:$C(6),1:$C(NAK)),T=T-BASE Q
2 S RTN=+$P(IN,",",4) S:RTN>0 OK=0 Q
4 S RTN=+$P(IN,",",5) S:RTN>0 OK=0 Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLABCX4H 1399 printed Dec 13, 2024@01:41:26 Page 2
LABCX4H ;SLC/DLG - BECKMAN CX4 AND CX5 PROTOCOL CONTROLLER ; 3/28/89 9:37 AM ;
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994
+2 ;;
+3 ;Call with T set to Instrument data is to/from
+4 ; P1= RESET POINT FOR INCOMING RECORDS, P3=Reset point FOR RECORDS SENT
+5 if '$DATA(^LA(T,"P1"))
SET ^LA(T,"P1")=0
SET ^("P2")=0
SET ^("P3")="IN"
RCHK KILL LATYPE
SET NAK=21
if IN'["~"
SET LATYPE="X"
if '$DATA(LATYPE)
SET LATYPE=$EXTRACT(IN,$FIND(IN,"~"))
if "ABCDEFUX"'[LATYPE
QUIT
DO @LATYPE
+1 QUIT
A ;REC SOH
SET Q=^LA(T,"I",0)-1
IF ^(Q)="~D"
SET ^LA(T,"P3")="IN"
SET ACK=3
SET OUT=$CHAR(6)
SET ^LA(T,"P1")=Q+1
QUIT
B ;RECIEVED STX LBO
IF $DATA(^LA(T,"O",0))
IF ^LA(T,"O")=^("O",0)
SET OUT=$CHAR(6)
SET ACK=3
QUIT
+1 ;DENY LINE BID OVERRIDE
SET OUT=$CHAR(21)
QUIT
F ;EVEN ACK
C ;RECIEVED ODD ACK
SET Q=^LA(T,"O",0)+1
if Q<^LA(T,"O")
SET OUT=^("O",Q)
SET ^(0)=Q
QUIT
D ;REC EOT
QUIT
E ;REC ENQ
SET OUT=$SELECT(ACK=3:6,1:3)
QUIT
U ;RECIEVED NAK RESEND
SET Q=^LA(T,"O",0)
SET OUT=^(Q)
QUIT
X DO CKSUM
if $EXTRACT(IN,($LENGTH(IN)-1),$LENGTH(IN))=LASUM1
SET OK=1
SET STR=+$PIECE(IN,",",2)
SET FTN=+$PIECE(IN,",",3)
if STR=401
DO @FTN
SET OUT=$CHAR($SELECT(OK:ACK,1:NAK))
SET ACK=$SELECT(ACK=6:3,1:6)
QUIT
CKSUM SET LASUM=0
+1 FOR I=1:1:($LENGTH(IN)-2)
SET LASUM=LASUM+$ASCII(IN,I)
+2 SET LASUM=LASUM#256
SET LASUM=256-LASUM
SET LASUM1=$FIND("0123456789ABCDEF",$EXTRACT(IN,($LENGTH(IN)-1)))-2*16+($FIND("0123456789ABCDEF",$EXTRACT(IN,$LENGTH(IN)))-2)
+3 QUIT
+4 SET LASUM=0
FOR I=1:1:120
SET LASUM=LASUM+(255-$ASCII(IN,I)+1)
+5 SET LASUM=LASUM#256
SET OUT=$SELECT(LASUM=LASUM1:$CHAR(6),1:$CHAR(NAK))
SET T=T-BASE
QUIT
2 SET RTN=+$PIECE(IN,",",4)
if RTN>0
SET OK=0
QUIT
4 SET RTN=+$PIECE(IN,",",5)
if RTN>0
SET OK=0
QUIT
