source: WorldVistAEHR/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LAHT1KD.m@ 701

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

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1LAHT1KD ;SLC/DLG - HITATCHI 736 WITH JT1000 BUILD DOWNLOAD FILE. ;8/16/90 10:31 ;
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994
3 ;Call with LRLL = load list to build
4 ;Call with LRTRAY1 = Starting tray number
5 ;Call with LRLL = Auto Instrument pointer
6 ;Call with LRFORCE=1 if send tray and cup.
7 S:$D(ZTQUEUED) ZTREQ="@" I '$D(^LA(LRINST,"O")) S T=LRINST D SETO^LAB
8A F LRTRAY=LRTRAY1:0 D:$D(^LRO(68.2,LRLL,1,LRTRAY)) TRAY S LRTRAY=$O(^LRO(68.2,LRLL,1,LRTRAY)),LRCUP1=1 Q:LRTRAY'>0
9 S LREND=0 L ^LA(LRINST,"O"),^LA("Q") S:^LA(LRINST,"O")=^("I",0) ^(0)=^(0)+1 S Q=^LA("Q")+1,^("Q")=Q,^("Q",Q)=LRINST L
10 I '$D(^LA("LOCK",LRINST)),$D(^LAB(62.4,LRINST,1)) S T=LRINST X ^(1)
11 Q
12TRAY F LRCUP=(LRCUP1-1):0 S LRCUP=$O(^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP)) Q:LRCUP'>0 D SAMPLE S LRECORD=""
13 Q
14SAMPLE S LRL=^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP,0),LRAA=+LRL,LRAD=$P(LRL,"^",2),LRAN=$P(LRL,"^",3) D TEST
15 S LRECORD=$E(1000000000+LRAN,2,10)_X D CKSUM S LRECORD="["_LRECORD_CKSUM_"]" D SEND Q
16TEST D ZERO F LRTEST=0:0 S LRTEST=$O(^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP,1,LRTEST)) Q:LRTEST'>0 D T2
17 Q
18T2 Q:'$D(^TMP($J,LRTEST)) F I=0:0 S I=$O(^TMP($J,LRTEST,I)) Q:I'>0 S Y=^(I) S X=$E(X,1,(Y-1))_"1"_$E(X,(Y+1),35)
19 Q
20ZERO S X="" F I=1:1:35 S X=X_"0"
21 Q
22SEND I '$D(^LA(LRINST,"O")) S T=LRINST D SETO^LAB
23 S (C,^LA(LRINST,"O"))=^LA(LRINST,"O")+1,^("O",C)=LRECORD Q
24CKSUM S CKSUM=0 F I=1:1:$L(LRECORD) S CKSUM=CKSUM+$A(LRECORD,I)#256
25 S CKSUM=$E("0123456789ABCDEF",(CKSUM\16+1))_$E("0123456789ABCDEF",(CKSUM#16+1)) Q
26CHECK ;ENTRY FOR HANDSHAKE RESPONSE FIELD OF AUTOINSTRUMENT FILE
27 G OUT:IN="$",AGN:IN="?",OUT:IN="%"
28 S:'$D(ERR) ERR=0 S LRECORD=$E(IN,2,($L(IN)-3)),CK=$E(IN,($L(IN)-2),($L(IN)-1))
29 D CKSUM S OUT=$S(CK=CKSUM:"$",1:"?"),ERR=$S(OUT="?":ERR+1,1:0) S:ERR=6 OUT="$",ERR=0,^LA(T,"I")=^LA(T,"I")-1 S T=T-BASE Q
30OUT S CNT=^LA(T,"O",0)+1 I $D(^(CNT))#2 S ^(0)=CNT,OUT=^(CNT),T=T-BASE
31 Q
32AGN S CNT=^LA(T,"O",0),OUT=^(CNT),T=T-BASE Q
Note: See TracBrowser for help on using the repository browser.