LABCX4H.m

LABCX4H ; IHS/DIR/FJE - BECKMAN CX4 AND CX5 PROTOCOL CONTROLLER 3/28/89 9:37 AM ;

 ;;5.2;LA;;NOV 01, 1997

 ;;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

LABCX4H   ; IHS/DIR/FJE - BECKMAN CX4 AND CX5 PROTOCOL CONTROLLER 3/28/89 9:37 AM ;

 +1       ;;5.2;LA;;NOV 01, 1997

 +2       ;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994

 +3       ;;

 +4       ;Call with T set to Instrument data is to/from

 +5       ; P1= RESET POINT FOR INCOMING RECORDS, P3=Reset point FOR RECORDS SENT

 +6        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