LAMIVTKC ;SLC/DLG - VITEK PROTOCOL CONTROLLER ;7/20/90 09:40 ;
;;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
RCHK K LATYPE S:IN'["~" LATYPE="X" S:'$D(LATYPE) LATYPE=$E(IN,$F(IN,"~")) Q:"BCDEFUX^]"'[LATYPE S LATYPE=$S(LATYPE="]":"GS",LATYPE="^":"RS",1:LATYPE) D @LATYPE
Q
B Q ;RECIEVED STX
C Q ;RECIEVED ETX
D I $D(^LA(T,"O",0)),^LA(T,"O")'=^LA(T,"O",0) S K=1 D OUT Q ;RECIEVED EOT
Q
E S ^LA(T,"P1")=CNT+2,OUT=$C(6),%=OUT
;I ^LA(T,"O",^LA(T,"P3"))[$C(29) S ^LA(T,"O",0)=^LA(T,"P2") L ^LA(T) S Q=^LA("Q")+1,^("Q")=Q,^LA("Q",Q)=T L ;OUTPUT WAS HUNG RESET FOR RETRANSMISSION
S T=T-BASE Q ;RECIEVED ENQ
F S O=^LA(T,"O",0),^LA(T,"P3")=$S(^LA(T,"O",O)[$C(2):O+1,1:O) S K=1 D OUT Q ;RECIEVED ACK
GS D CKSUM Q ;GS RECORD NEXT RECORD SHOULD BE X TYPE LENGTH 2
RS D CKSUM Q ;RECIEVED RS DATA PACKET
U S ^LA(T,"O",0)=^LA(T,"P3"),K=1 D OUT Q ;RECIEVED NAK
X D CKSUM I $L(IN)=2 S OUT=$S(LASUM=LASUM1:$C(6),1:$C(21)),%=OUT S:LASUM=LASUM1 ^LA(T,"P1")=CNT+1 S T=T-BASE K LASUM,LASUM1 Q ;RECIEVED GS CKSUM PACKET
Q
CKSUM S:'$D(LASUM) LASUM=0
S LASUM=$S(LATYPE="RS":30,LATYPE="GS":29,LATYPE="X":23,1:0)+LASUM
I LATYPE="X",($L(IN)>2) F I=1:1:$L(IN) S LASUM=LASUM+$A(IN,I)
I LATYPE="X",($L(IN)=2) S LASUM=LASUM-23,LASUM=LASUM#256,LASUM1=$F("0123456789abcdef",$E(IN,1))-2*16+($F("0123456789abcdef",$E(IN,2))-2)
Q
OUT D NEXT Q:'$D(^LA(T,"O",O)) Q:%[$C(29) ;Q:%[$C(4) Q:%[$C(5)
S K=K+1 G OUT Q
NEXT S O=^LA(T,"O",0)+K Q:'$D(^(O)) S %=^(O)
L ^LA("Q") S Q=^LA("Q")+1,^("Q")=Q,^("Q",Q)=T L Q
ACK S LASUM1=$F("0123456789abcdef",$E(IN,121))-2*16+($F("0123456789abcdef",$E(IN,122))-2)
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(21)),%=OUT S T=T-BASE Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLAMIVTKC 1869 printed Apr 09, 2024@20:48:36 Page 2
LAMIVTKC ;SLC/DLG - VITEK PROTOCOL CONTROLLER ;7/20/90 09:40 ;
+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
RCHK KILL LATYPE
if IN'["~"
SET LATYPE="X"
if '$DATA(LATYPE)
SET LATYPE=$EXTRACT(IN,$FIND(IN,"~"))
if "BCDEFUX^]"'[LATYPE
QUIT
SET LATYPE=$SELECT(LATYPE="]":"GS",LATYPE="^":"RS",1:LATYPE)
DO @LATYPE
+1 QUIT
B ;RECIEVED STX
QUIT
C ;RECIEVED ETX
QUIT
D ;RECIEVED EOT
IF $DATA(^LA(T,"O",0))
IF ^LA(T,"O")'=^LA(T,"O",0)
SET K=1
DO OUT
QUIT
+1 QUIT
E SET ^LA(T,"P1")=CNT+2
SET OUT=$CHAR(6)
SET %=OUT
+1 ;I ^LA(T,"O",^LA(T,"P3"))[$C(29) S ^LA(T,"O",0)=^LA(T,"P2") L ^LA(T) S Q=^LA("Q")+1,^("Q")=Q,^LA("Q",Q)=T L ;OUTPUT WAS HUNG RESET FOR RETRANSMISSION
+2 ;RECIEVED ENQ
SET T=T-BASE
QUIT
F ;RECIEVED ACK
SET O=^LA(T,"O",0)
SET ^LA(T,"P3")=$SELECT(^LA(T,"O",O)[$CHAR(2):O+1,1:O)
SET K=1
DO OUT
QUIT
GS ;GS RECORD NEXT RECORD SHOULD BE X TYPE LENGTH 2
DO CKSUM
QUIT
RS ;RECIEVED RS DATA PACKET
DO CKSUM
QUIT
U ;RECIEVED NAK
SET ^LA(T,"O",0)=^LA(T,"P3")
SET K=1
DO OUT
QUIT
X ;RECIEVED GS CKSUM PACKET
DO CKSUM
IF $LENGTH(IN)=2
SET OUT=$SELECT(LASUM=LASUM1:$CHAR(6),1:$CHAR(21))
SET %=OUT
if LASUM=LASUM1
SET ^LA(T,"P1")=CNT+1
SET T=T-BASE
KILL LASUM,LASUM1
QUIT
+1 QUIT
CKSUM if '$DATA(LASUM)
SET LASUM=0
+1 SET LASUM=$SELECT(LATYPE="RS":30,LATYPE="GS":29,LATYPE="X":23,1:0)+LASUM
+2 IF LATYPE="X"
IF ($LENGTH(IN)>2)
FOR I=1:1:$LENGTH(IN)
SET LASUM=LASUM+$ASCII(IN,I)
+3 IF LATYPE="X"
IF ($LENGTH(IN)=2)
SET LASUM=LASUM-23
SET LASUM=LASUM#256
SET LASUM1=$FIND("0123456789abcdef",$EXTRACT(IN,1))-2*16+($FIND("0123456789abcdef",$EXTRACT(IN,2))-2)
+4 QUIT
OUT ;Q:%[$C(4) Q:%[$C(5)
DO NEXT
if '$DATA(^LA(T,"O",O))
QUIT
if %[$CHAR(29)
QUIT
+1 SET K=K+1
GOTO OUT
QUIT
NEXT SET O=^LA(T,"O",0)+K
if '$DATA(^(O))
QUIT
SET %=^(O)
+1 LOCK ^LA("Q")
SET Q=^LA("Q")+1
SET ^("Q")=Q
SET ^("Q",Q)=T
LOCK
QUIT
ACK SET LASUM1=$FIND("0123456789abcdef",$EXTRACT(IN,121))-2*16+($FIND("0123456789abcdef",$EXTRACT(IN,122))-2)
+1 SET LASUM=0
FOR I=1:1:120
SET LASUM=LASUM+(255-$ASCII(IN,I)+1)
+2 SET LASUM=LASUM#256
SET OUT=$SELECT(LASUM=LASUM1:$CHAR(6),1:$CHAR(21))
SET %=OUT
SET T=T-BASE
QUIT
