| 1 | LAMIVTLX ;SLC/DLG/DALISC/PAC - VITEK LITERAL PROTOCOL CONTROLLER ; | 
|---|
| 2 | ;;5.2;AUTOMATED LAB INSTRUMENTS;**12**;Sep 27, 1994 | 
|---|
| 3 | ;; | 
|---|
| 4 | ;Call with T set to Instrument data is to/from | 
|---|
| 5 | ; P1= RESET POINT FOR INCOMING RECORDS, | 
|---|
| 6 | ; P3=Reset point FOR RECORDS SENT | 
|---|
| 7 | S OSTX=$C(2),OETX=$C(3),OEDT=$C(4),OENQ=$C(5),OACK=$C(6),ONAK=$C(21) | 
|---|
| 8 | RCHK K LATYPE S:IN'["~" LATYPE="X" S:'$D(LATYPE) LATYPE=$E(IN,$F(IN,"~")) | 
|---|
| 9 | Q:"BCDEFUX^]"'[LATYPE | 
|---|
| 10 | S LATYPE=$S(LATYPE="]":"GS",LATYPE="^":"RS",LATYPE="B":"RS",1:LATYPE) | 
|---|
| 11 | S OLDTYPE=LATYPE D @LATYPE | 
|---|
| 12 | ;,^LA(T,"I")=^LA(T,"I")+1 D @LATYPE | 
|---|
| 13 | ;I LATYPE="B" G RCHK | 
|---|
| 14 | Q | 
|---|
| 15 | B ; ~B RECEIVED STX 2 | 
|---|
| 16 | D RS Q  ; S OUT="",%=OUT Q | 
|---|
| 17 | C ; ~C RECEIVED ETX 3 | 
|---|
| 18 | Q | 
|---|
| 19 | D ; ~D RECEIVED EOT 4 | 
|---|
| 20 | I OLDTYPE="X" D CKSUM  S OUT=$S(LASUM=LASUM1:$C(6),1:$C(21)) Q | 
|---|
| 21 | I $D(^LA(T,"O",0)),^LA(T,"O")'=^LA(T,"O",0) S K=1 D OUT Q | 
|---|
| 22 | Q | 
|---|
| 23 | E ; ~E RECEIVED ENQ 5 | 
|---|
| 24 | ;S OUT=$C(6),%=OUT | 
|---|
| 25 | S ^LA(T,"P1")=CNT+2,OUT=$C(6),%=OUT | 
|---|
| 26 | ;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 | 
|---|
| 27 | S T=T-BASE Q | 
|---|
| 28 | ; | 
|---|
| 29 | F ;~F RECEIVED ACK 6 | 
|---|
| 30 | 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 | 
|---|
| 31 | Q | 
|---|
| 32 | GS ; ~] GS RECORD NEXT RECORD SHOULD BE X TYPE LENGTH 2 ? 35 | 
|---|
| 33 | D CKSUM Q  ;S OUT=OACK,%=OACK Q | 
|---|
| 34 | RS ; ~^ RECEIVED RS DATA PACKET 30 | 
|---|
| 35 | D CKSUM Q | 
|---|
| 36 | U ; ~U RECEIVED NAK 21 | 
|---|
| 37 | S ^LA(T,"O",0)=^LA(T,"P3"),K=1 D OUT Q  ;RECEIVED NAK | 
|---|
| 38 | X ;RECEIVED GS CKSUM PACKET/? | 
|---|
| 39 | ;D CKSUM I $L(IN)=2,$E(IN,2)="D" S OUT=$C(6),%=OUT,^LA(T,"P1")=CNT+1 S T=T-BASE K LASUM,LASUM1 Q | 
|---|
| 40 | D CKSUM I $L(IN)=2 S OUT=$S(LASUM=LASUM1:$C(6),1:$C(6)),%=OUT S:LASUM=LASUM1 ^LA(T,"P1")=CNT+1 S T=T-BASE K LASUM,LASUM1 Q  ;RECEIVED GS CKSUM PACKET | 
|---|
| 41 | S ^LA(T,"P1")=CNT+1 | 
|---|
| 42 | Q | 
|---|
| 43 | CKSUM S:'$D(LASUM) LASUM=0 | 
|---|
| 44 | S LASUM=$S(LATYPE="RS":30,LATYPE="GS":29,LATYPE="X":23,1:0)+LASUM | 
|---|
| 45 | ;I LATYPE="X",($L(IN)>2) F I=1:1:$L(IN) S LASUM=LASUM+$A(IN,I) | 
|---|
| 46 | ;I LATYPE="X",($L(IN)=2) | 
|---|
| 47 | I LATYPE="X" S LASUM=LASUM-23,LASUM=LASUM#256,LASUM1=$F("0123456789abcdef",$E(IN,1))-2*16+($F("0123456789abcdef",$E(IN,2))-2) | 
|---|
| 48 | Q | 
|---|
| 49 | OUT D NEXT Q:'$D(^LA(T,"O",O))  Q:%[$C(29)  ;Q:%[$C(4)  Q:%[$C(5) | 
|---|
| 50 | S K=K+1 G OUT Q | 
|---|
| 51 | NEXT S O=^LA(T,"O",0)+K Q:'$D(^(O))  S %=^(O) | 
|---|
| 52 | L ^LA("Q") S Q=^LA("Q")+1,^("Q")=Q,^("Q",Q)=T L  Q | 
|---|
| 53 | ACK S LASUM1=$F("0123456789abcdef",$E(IN,121))-2*16+($F("0123456789abcdef",$E(IN,122))-2) | 
|---|
| 54 | S LASUM=0 F I=1:1:120 S LASUM=LASUM+(255-$A(IN,I)+1) | 
|---|
| 55 | S LASUM=LASUM#256,OUT=$S(LASUM=LASUM1:$C(6),1:$C(21)),%=OUT S T=T-BASE Q | 
|---|
| 56 | ;S LASUM=LASUM#256,OUT=$C(6),%=OUT S T=T-BASE | 
|---|
| 57 | Q | 
|---|