LAHTCCAH.m

LAHTCCAH ; IHS/DIR/FJE - HITACHI 717 THRU CCA SYSTEM PROTOCALL CONTROLLER 7/20/90 09:18 ;

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

 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

LAHTCCAH  ; IHS/DIR/FJE - HITACHI 717 THRU CCA SYSTEM PROTOCALL CONTROLLER 7/20/90 09:18 ;

 +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

 +6        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