LAHTCCAH ;SLC/DLG - HITACHI 717 THRU CCA SYSTEM PROTOCALL CONTROLLER ;7/20/90 09:18 ;
;;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,"P2")) ^("P2")=0,^("P")="IN"
RCHK K LATYPE S LATYPE=$P(IN,"~",2),LATYPE=$S("BCDEFU"[LATYPE:LATYPE,1:"Z") D @LATYPE S T=T-BASE Q
B S ^LA(T,"P2")=0 Q ;RECIEVED STX
C F I=1:1:$L(IN)-2 S LASUM=LASUM+$A(IN,I)
S ^LA(T,"P2")=LASUM#256 I $E(IN,1)="D" S ^LA(T,"P")="D"
Q
D S ^LA(T,"P")="QUIT" Q ;REC EOT
E S ^LA(T,"P")="IN",OUT=$C(6),^LA(T,"P2")=0 Q ;REC ENQ
F S Q=^LA(T,"O",0)+1 I $D(^(Q)) S ^(0)=Q,OUT=^(Q) ;GOT ACK SEND NEXT
Q
U S OUT=^LA(T,"O",0) Q ;RECIEVED NAK RESEND
Z S OUT=$S(($L(IN)=3&+IN=^LA(T,"P2")):$C(6),1:$C(21))
S ^LA(T,"P2")=0 I ^LA(T,"P")="D" S ^("P")="OUT",Q=^LA(T,"O",0)+1 I $D(^(Q)) S ^(0)=Q L ^LA("Q") S Q=^LA("Q")+1,^("Q")=Q,^("Q",Q)=T L
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLAHTCCAH 951 printed Dec 13, 2024@01:42:43 Page 2
LAHTCCAH ;SLC/DLG - HITACHI 717 THRU CCA SYSTEM PROTOCALL CONTROLLER ;7/20/90 09:18 ;
+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
+5 if '$DATA(^LA(T,"P2"))
SET ^("P2")=0
SET ^("P")="IN"
RCHK KILL LATYPE
SET LATYPE=$PIECE(IN,"~",2)
SET LATYPE=$SELECT("BCDEFU"[LATYPE:LATYPE,1:"Z")
DO @LATYPE
SET T=T-BASE
QUIT
B ;RECIEVED STX
SET ^LA(T,"P2")=0
QUIT
C FOR I=1:1:$LENGTH(IN)-2
SET LASUM=LASUM+$ASCII(IN,I)
+1 SET ^LA(T,"P2")=LASUM#256
IF $EXTRACT(IN,1)="D"
SET ^LA(T,"P")="D"
+2 QUIT
D ;REC EOT
SET ^LA(T,"P")="QUIT"
QUIT
E ;REC ENQ
SET ^LA(T,"P")="IN"
SET OUT=$CHAR(6)
SET ^LA(T,"P2")=0
QUIT
F ;GOT ACK SEND NEXT
SET Q=^LA(T,"O",0)+1
IF $DATA(^(Q))
SET ^(0)=Q
SET OUT=^(Q)
+1 QUIT
U ;RECIEVED NAK RESEND
SET OUT=^LA(T,"O",0)
QUIT
Z SET OUT=$SELECT(($LENGTH(IN)=3&+IN=^LA(T,"P2")):$CHAR(6),1:$CHAR(21))
+1 SET ^LA(T,"P2")=0
IF ^LA(T,"P")="D"
SET ^("P")="OUT"
SET Q=^LA(T,"O",0)+1
IF $DATA(^(Q))
SET ^(0)=Q
LOCK ^LA("Q")
SET Q=^LA("Q")+1
SET ^("Q")=Q
SET ^("Q",Q)=T
LOCK
