source: WorldVistAEHR/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LABCX4H.m@ 1000

Last change on this file since 1000 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.3 KB
RevLine 
[613]1LABCX4H ;SLC/DLG - BECKMAN CX4 AND CX5 PROTOCOL CONTROLLER ; 3/28/89 9:37 AM ;
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 S:'$D(^LA(T,"P1")) ^LA(T,"P1")=0,^("P2")=0,^("P3")="IN"
7RCHK K LATYPE S NAK=21 S:IN'["~" LATYPE="X" S:'$D(LATYPE) LATYPE=$E(IN,$F(IN,"~")) Q:"ABCDEFUX"'[LATYPE D @LATYPE
8 Q
9A 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
10B I $D(^LA(T,"O",0)),^LA(T,"O")=^("O",0) S OUT=$C(6),ACK=3 Q ;RECIEVED STX LBO
11 S OUT=$C(21) Q ;DENY LINE BID OVERRIDE
12F ;EVEN ACK
13C S Q=^LA(T,"O",0)+1 S:Q<^LA(T,"O") OUT=^("O",Q),^(0)=Q Q ;RECIEVED ODD ACK
14D Q ;REC EOT
15E S OUT=$S(ACK=3:6,1:3) Q ;REC ENQ
16U S Q=^LA(T,"O",0),OUT=^(Q) Q ;RECIEVED NAK RESEND
17X 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
18CKSUM S LASUM=0
19 F I=1:1:($L(IN)-2) S LASUM=LASUM+$A(IN,I)
20 S LASUM=LASUM#256,LASUM=256-LASUM,LASUM1=$F("0123456789ABCDEF",$E(IN,($L(IN)-1)))-2*16+($F("0123456789ABCDEF",$E(IN,$L(IN)))-2)
21 Q
22 S LASUM=0 F I=1:1:120 S LASUM=LASUM+(255-$A(IN,I)+1)
23 S LASUM=LASUM#256,OUT=$S(LASUM=LASUM1:$C(6),1:$C(NAK)),T=T-BASE Q
242 S RTN=+$P(IN,",",4) S:RTN>0 OK=0 Q
254 S RTN=+$P(IN,",",5) S:RTN>0 OK=0 Q
Note: See TracBrowser for help on using the repository browser.