LAMIVTKC.m

LAMIVTKC ; IHS/DIR/FJE - VITEK PROTOCOL CONTROLLER 7/20/90 09:40 ;

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

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

LAMIVTKC  ; IHS/DIR/FJE - VITEK PROTOCOL CONTROLLER 7/20/90 09:40 ;

 +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

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