- LAHT1KD ; IHS/DIR/FJE - HITATCHI 736 WITH JT1000 BUILD DOWNLOAD FILE. 8/16/90 10:31 ;
- ;;5.2;LA;;NOV 01, 1997
- ;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994
- ;Call with LRLL = load list to build
- ;Call with LRTRAY1 = Starting tray number
- ;Call with LRLL = Auto Instrument pointer
- ;Call with LRFORCE=1 if send tray and cup.
- S:$D(ZTQUEUED) ZTREQ="@" I '$D(^LA(LRINST,"O")) S T=LRINST D SETO^LAB
- A 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
- 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
- I '$D(^LA("LOCK",LRINST)),$D(^LAB(62.4,LRINST,1)) S T=LRINST X ^(1)
- Q
- TRAY F LRCUP=(LRCUP1-1):0 S LRCUP=$O(^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP)) Q:LRCUP'>0 D SAMPLE S LRECORD=""
- Q
- SAMPLE S LRL=^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP,0),LRAA=+LRL,LRAD=$P(LRL,"^",2),LRAN=$P(LRL,"^",3) D TEST
- S LRECORD=$E(1000000000+LRAN,2,10)_X D CKSUM S LRECORD="["_LRECORD_CKSUM_"]" D SEND Q
- TEST D ZERO F LRTEST=0:0 S LRTEST=$O(^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP,1,LRTEST)) Q:LRTEST'>0 D T2
- Q
- T2 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)
- Q
- ZERO S X="" F I=1:1:35 S X=X_"0"
- Q
- SEND I '$D(^LA(LRINST,"O")) S T=LRINST D SETO^LAB
- S (C,^LA(LRINST,"O"))=^LA(LRINST,"O")+1,^("O",C)=LRECORD Q
- CKSUM S CKSUM=0 F I=1:1:$L(LRECORD) S CKSUM=CKSUM+$A(LRECORD,I)#256
- S CKSUM=$E("0123456789ABCDEF",(CKSUM\16+1))_$E("0123456789ABCDEF",(CKSUM#16+1)) Q
- CHECK ;ENTRY FOR HANDSHAKE RESPONSE FIELD OF AUTOINSTRUMENT FILE
- G OUT:IN="$",AGN:IN="?",OUT:IN="%"
- S:'$D(ERR) ERR=0 S LRECORD=$E(IN,2,($L(IN)-3)),CK=$E(IN,($L(IN)-2),($L(IN)-1))
- 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
- OUT S CNT=^LA(T,"O",0)+1 I $D(^(CNT))#2 S ^(0)=CNT,OUT=^(CNT),T=T-BASE
- Q
- AGN S CNT=^LA(T,"O",0),OUT=^(CNT),T=T-BASE Q
- LAHT1KD ; IHS/DIR/FJE - HITATCHI 736 WITH JT1000 BUILD DOWNLOAD FILE. 8/16/90 10:31 ;
- +1 ;;5.2;LA;;NOV 01, 1997
- +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 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- IF '$DATA(^LA(LRINST,"O"))
- SET T=LRINST
- DO SETO^LAB
- A FOR LRTRAY=LRTRAY1:0
- IF $DATA(^LRO(68.2,LRLL,1,LRTRAY))
- DO TRAY
- SET LRTRAY=$ORDER(^LRO(68.2,LRLL,1,LRTRAY))
- SET LRCUP1=1
- IF LRTRAY'>0
- QUIT
- +1 SET LREND=0
- LOCK ^LA(LRINST,"O"),^LA("Q")
- IF ^LA(LRINST,"O")=^("I",0)
- SET ^(0)=^(0)+1
- SET Q=^LA("Q")+1
- SET ^("Q")=Q
- SET ^("Q",Q)=LRINST
- LOCK
- +2 IF '$DATA(^LA("LOCK",LRINST))
- IF $DATA(^LAB(62.4,LRINST,1))
- SET T=LRINST
- XECUTE ^(1)
- +3 QUIT
- TRAY FOR LRCUP=(LRCUP1-1):0
- SET LRCUP=$ORDER(^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP))
- IF LRCUP'>0
- QUIT
- DO SAMPLE
- SET LRECORD=""
- +1 QUIT
- SAMPLE SET LRL=^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP,0)
- SET LRAA=+LRL
- SET LRAD=$PIECE(LRL,"^",2)
- SET LRAN=$PIECE(LRL,"^",3)
- DO TEST
- +1 SET LRECORD=$EXTRACT(1000000000+LRAN,2,10)_X
- DO CKSUM
- SET LRECORD="["_LRECORD_CKSUM_"]"
- DO SEND
- QUIT
- TEST DO ZERO
- FOR LRTEST=0:0
- SET LRTEST=$ORDER(^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP,1,LRTEST))
- IF LRTEST'>0
- QUIT
- DO T2
- +1 QUIT
- T2 IF '$DATA(^TMP($JOB,LRTEST))
- QUIT
- FOR I=0:0
- SET I=$ORDER(^TMP($JOB,LRTEST,I))
- IF I'>0
- QUIT
- SET Y=^(I)
- SET X=$EXTRACT(X,1,(Y-1))_"1"_$EXTRACT(X,(Y+1),35)
- +1 QUIT
- ZERO SET X=""
- FOR I=1:1:35
- SET X=X_"0"
- +1 QUIT
- SEND IF '$DATA(^LA(LRINST,"O"))
- SET T=LRINST
- DO SETO^LAB
- +1 SET (C,^LA(LRINST,"O"))=^LA(LRINST,"O")+1
- SET ^("O",C)=LRECORD
- QUIT
- CKSUM SET CKSUM=0
- FOR I=1:1:$LENGTH(LRECORD)
- SET CKSUM=CKSUM+$ASCII(LRECORD,I)#256
- +1 SET CKSUM=$EXTRACT("0123456789ABCDEF",(CKSUM\16+1))_$EXTRACT("0123456789ABCDEF",(CKSUM#16+1))
- QUIT
- CHECK ;ENTRY FOR HANDSHAKE RESPONSE FIELD OF AUTOINSTRUMENT FILE
- +1 IF IN="$"
- GOTO OUT
- IF IN="?"
- GOTO AGN
- IF IN="%"
- GOTO OUT
- +2 IF '$DATA(ERR)
- SET ERR=0
- SET LRECORD=$EXTRACT(IN,2,($LENGTH(IN)-3))
- SET CK=$EXTRACT(IN,($LENGTH(IN)-2),($LENGTH(IN)-1))
- +3 DO CKSUM
- SET OUT=$SELECT(CK=CKSUM:"$",1:"?")
- SET ERR=$SELECT(OUT="?":ERR+1,1:0)
- IF ERR=6
- SET OUT="$"
- SET ERR=0
- SET ^LA(T,"I")=^LA(T,"I")-1
- SET T=T-BASE
- QUIT
- OUT SET CNT=^LA(T,"O",0)+1
- IF $DATA(^(CNT))#2
- SET ^(0)=CNT
- SET OUT=^(CNT)
- SET T=T-BASE
- +1 QUIT
- AGN SET CNT=^LA(T,"O",0)
- SET OUT=^(CNT)
- SET T=T-BASE
- QUIT
