LABCX7R.m

LABCX7R ; IHS/DIR/FJE - ; [ 05/27/2003  6:53 AM ]

 ;;5.2;LA;**1016**;MAY 27, 2003

DOC ;Response to Host Query

 S DEV=$P(Y(1),","),RC=1

LOOP F I=4:1:10 I $E($P(Y(1),",",I),1,11)'="           " D GETDATA

 I '$D(GOOD) S OUT="" G EXIT

 S OUT=$C(4) D SET

EXIT S OUT=$C(3),^LA(T,"P1")=ETX

 K CKSUM,D1,D2,DEV,GOOD,H1,H2,ID,J,K,ZCNT Q  ;final exit

GETDATA ;

 S ID=$E($P(Y(1),",",I),1,11) I '$D(^LAZ(ID)) D UNDEF Q

 I '$D(GOOD) S GOOD=1,OUT=$C(1) D SET

 F J=0:1:2 Q:'$D(^LAZ(ID,J))  D SEND

 S CKSUM=CKSUM#256,CKSUM=256-CKSUM D HEX S ^LA(T,"O",ZCNT)=OUT_CKSUM

 I $D(^LAZ("ZZZ",ID)) K ^LAZ("ZZZ",ID)

 Q

SEND ;

 S OUT=^LAZ(ID,J)

 I J=0 S $P(OUT,",",1)=DEV,CKSUM=0

 D SET

 F K=1:1:$L(OUT) S CKSUM=CKSUM+$A($E(OUT,K))

 S RC=0 Q

UNDEF ;Sample Id has not been downloaded to ^LAZ

 S ^LAZ("ZZZ",ID)="NOT DOWNLOADED, QUERY FROM DEVICE "_$E(DEV,2,3)

 Q

HEX ;convert decimal to hex

 S D1=CKSUM\16,D2=CKSUM#16

 I D1=0 S H1=0 G H2

 S H1=$E("123456789ABCDEF",D1)

H2 I D2=0 S H2=0 G CK

 S H2=$E("123456789ABCDEF",D2)

CK S CKSUM=H1_H2

 Q

SET I '$D(^LA(T,"O")) S ^LA(T,"O")=0

 S (ZCNT,^LA(T,"O"))=^LA(T,"O")+1

 S ^LA(T,"O",ZCNT)=OUT

 I '$D(^LA(T,"O",0)) S ^LA(T,"O",0)=0

 Q

LABCX7R   ; IHS/DIR/FJE - ; [ 05/27/2003  6:53 AM ]

 +1       ;;5.2;LA;**1016**;MAY 27, 2003

DOC       ;Response to Host Query

 +1        SET DEV=$PIECE(Y(1),",")

           SET RC=1

LOOP       FOR I=4:1:10

               IF $EXTRACT($PIECE(Y(1),",",I),1,11)'="           "

                   DO GETDATA

 +1        IF '$DATA(GOOD)

               SET OUT=""

               GOTO EXIT

 +2        SET OUT=$CHAR(4)

           DO SET

EXIT       SET OUT=$CHAR(3)

           SET ^LA(T,"P1")=ETX

 +1       ;final exit

           KILL CKSUM,D1,D2,DEV,GOOD,H1,H2,ID,J,K,ZCNT

           QUIT 

GETDATA   ;

 +1        SET ID=$EXTRACT($PIECE(Y(1),",",I),1,11)

           IF '$DATA(^LAZ(ID))

               DO UNDEF

               QUIT 

 +2        IF '$DATA(GOOD)

               SET GOOD=1

               SET OUT=$CHAR(1)

               DO SET

 +3        FOR J=0:1:2

               IF '$DATA(^LAZ(ID,J))

                   QUIT 

               DO SEND

 +4        SET CKSUM=CKSUM#256

           SET CKSUM=256-CKSUM

           DO HEX

           SET ^LA(T,"O",ZCNT)=OUT_CKSUM

 +5        IF $DATA(^LAZ("ZZZ",ID))

               KILL ^LAZ("ZZZ",ID)

 +6        QUIT 

SEND      ;

 +1        SET OUT=^LAZ(ID,J)

 +2        IF J=0

               SET $PIECE(OUT,",",1)=DEV

               SET CKSUM=0

 +3        DO SET

 +4        FOR K=1:1:$LENGTH(OUT)

               SET CKSUM=CKSUM+$ASCII($EXTRACT(OUT,K))

 +5        SET RC=0

           QUIT 

UNDEF     ;Sample Id has not been downloaded to ^LAZ

 +1        SET ^LAZ("ZZZ",ID)="NOT DOWNLOADED, QUERY FROM DEVICE "_$EXTRACT(DEV,2,3)

 +2        QUIT 

HEX       ;convert decimal to hex

 +1        SET D1=CKSUM\16

           SET D2=CKSUM#16

 +2        IF D1=0

               SET H1=0

               GOTO H2

 +3        SET H1=$EXTRACT("123456789ABCDEF",D1)

H2         IF D2=0

               SET H2=0

               GOTO CK

 +1        SET H2=$EXTRACT("123456789ABCDEF",D2)

CK         SET CKSUM=H1_H2

 +1        QUIT 

SET        IF '$DATA(^LA(T,"O"))

               SET ^LA(T,"O")=0

 +1        SET (ZCNT,^LA(T,"O"))=^LA(T,"O")+1

 +2        SET ^LA(T,"O",ZCNT)=OUT

 +3        IF '$DATA(^LA(T,"O",0))

               SET ^LA(T,"O",0)=0

 +4        QUIT