Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LABCX7R

LABCX7R.m

Go to the documentation of this file.
  1. LABCX7R ; IHS/DIR/FJE - ; [ 05/27/2003 6:53 AM ]
  1. ;;5.2;LA;**1016**;MAY 27, 2003
  1. DOC ;Response to Host Query
  1. S DEV=$P(Y(1),","),RC=1
  1. LOOP F I=4:1:10 I $E($P(Y(1),",",I),1,11)'=" " D GETDATA
  1. I '$D(GOOD) S OUT="" G EXIT
  1. S OUT=$C(4) D SET
  1. EXIT S OUT=$C(3),^LA(T,"P1")=ETX
  1. K CKSUM,D1,D2,DEV,GOOD,H1,H2,ID,J,K,ZCNT Q ;final exit
  1. GETDATA ;
  1. S ID=$E($P(Y(1),",",I),1,11) I '$D(^LAZ(ID)) D UNDEF Q
  1. I '$D(GOOD) S GOOD=1,OUT=$C(1) D SET
  1. F J=0:1:2 Q:'$D(^LAZ(ID,J)) D SEND
  1. S CKSUM=CKSUM#256,CKSUM=256-CKSUM D HEX S ^LA(T,"O",ZCNT)=OUT_CKSUM
  1. I $D(^LAZ("ZZZ",ID)) K ^LAZ("ZZZ",ID)
  1. Q
  1. SEND ;
  1. S OUT=^LAZ(ID,J)
  1. I J=0 S $P(OUT,",",1)=DEV,CKSUM=0
  1. D SET
  1. F K=1:1:$L(OUT) S CKSUM=CKSUM+$A($E(OUT,K))
  1. S RC=0 Q
  1. UNDEF ;Sample Id has not been downloaded to ^LAZ
  1. S ^LAZ("ZZZ",ID)="NOT DOWNLOADED, QUERY FROM DEVICE "_$E(DEV,2,3)
  1. Q
  1. HEX ;convert decimal to hex
  1. S D1=CKSUM\16,D2=CKSUM#16
  1. I D1=0 S H1=0 G H2
  1. S H1=$E("123456789ABCDEF",D1)
  1. H2 I D2=0 S H2=0 G CK
  1. S H2=$E("123456789ABCDEF",D2)
  1. CK S CKSUM=H1_H2
  1. Q
  1. SET I '$D(^LA(T,"O")) S ^LA(T,"O")=0
  1. S (ZCNT,^LA(T,"O"))=^LA(T,"O")+1
  1. S ^LA(T,"O",ZCNT)=OUT
  1. I '$D(^LA(T,"O",0)) S ^LA(T,"O",0)=0
  1. Q