source: WorldVistAEHR/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LABCX4XX.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: 3.6 KB
Line 
1LABCX4XX ;SLC/DLG - BECKMAN BIDIRECTIONAL DIRECT CONNECT INTERFACE ;8/16/90 14:53 ;
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994
3 S:$D(ZTQUEUED) ZTREQ="@"
4 S LANM=$T(+0),(TSK,T)=+$E(LANM,7,8) Q:+T<1 Q:$D(^LA("LOCK",T)) S IOP=$P(^LAB(62.4,T,0),"^",2) G:IOP="" H^XUS G ^LABCX4I
5LA2 K RES,TV,Y S A=1 G RD:OUT="" D:$D(^LA(DEB,0)) DBO W OUT G RD:$A(OUT,1)<32
6 I OUT'["]" G W
7 W !
8RD S:OUT["[" TOUT=$S($P(OUT,",",3)="03":180,1:15) S IN="",A=0 R *X:TOUT G:'$T TOUT D:$D(^LA(DEB,0)) DBX S IN=$C(X) D IN G RD1:IN="["
9 I X=LB S ^LA(T,"P")="IN",OUT=$C(ACK),^("P1")=ETX G LA2
10 I X=LBO S OUT=$C(NAK) G LA2
11 I X=EOT S ^LA(T,"P")="",(^("P1"),^("P2"))=ACK,OUT="" G LA2
12 I X=ENQ G LA2
13 I X=NAK S ^LA(T,"O",0)=^LA(T,"P3") G W
14 I X=^LA(T,"P2") S ^("P2")=$S(X=ACK:ETX,1:ACK),^LA(T,"P3")=^LA(T,"O",0),OUT="",FLA=1,^LA(T,"P")="OUT" G RD
15 S OUT="" G LA2
16RD1 S TOUT=2,CK=X,FL=1,^LA(T,"P")="IN"
17RD2 F I=0:0 Q:$L(IN)=255 R *X:TOUT Q:('$T!(X=13)) S:FL CK=CK+X S IN=IN_$C(X) S:X=93 FL=0
18 D:'$D(^LA(T,"I")) SET D IN,QC,DBI:$D(^LA(DEB,0)) S LN=$L(IN)
19 I LN=255,(IN'["]") S IN="" G RD2
20 I LN<255,(IN'["]") S OUT=$C(NAK) G LA2
21 S LRCC=$S(LN=1:$E(Y(A-1),$L(Y(A-1)))_IN,LN=2:IN,1:$E(IN,LN-1,LN))
22 S CK=CK+($F("0123456789ABCDEF",$E(LRCC,1))-2*16)+$F("0123456789ABCDEF",$E(LRCC,2))-2#256 S:CK OUT=$C(NAK) G:CK LA2 S OUT=$C(^LA(T,"P1")),^LA(T,"P1")=$S(^LA(T,"P1")=ACK:ETX,1:ACK)
23 K TV S (TRAY,CUP,ID,IDE,RMK)="",ST=+$P(Y(1),",",2),FC=+$P(Y(1),",",3) G @ST
24400 ;
25403 ;
26404 G LA2
27401 G:FC#2 LA2 S RC=+$P(Y(1),",",$S(FC=2:4,1:5)) G:RC>0 LA2 D OUT G LA2
28402 D HDR:FC=1,RES:FC=3,RES1:FC=11 G LA2:'(FC=1!(FC=3)!(FC=11))
29LA3 G:ID="" LA2 X LAGEN G LA2:'ISQN
30 F I=0:0 S I=$O(TV(I)) Q:I<1 S:TV(I,1)]"" ^LAH(LWL,1,ISQN,I)=TV(I,1)
31 S:$L(RMK) ^LAH(LWL,1,ISQN,1)=RMK G LA2
32W IF $D(^LA("STOP",T)) K ^LA("LOCK",T),^LA("STOP",T) G H^XUS
33 S OUT="",CNT=^LA(T,"O",0)+1 I $D(^(CNT)) S ^(0)=CNT,OUT=^(CNT)
34 S:OUT=$C(4,1) ^LA(T,"P")="PEND" G LA2
35TOUT S %H=$H D YMD^%DTC S:LADT'=X LADT=X K %,%H
36 I $D(^LA(T,"O")),^LA(T,"O")>^LA(T,"O",0) G W
37 I $D(^LA(T,"C")),^LA(T,"C")>^("C",0) D OUT G TOUT
38 G RD Q
39QC S A=A+1,Y(A)=IN Q
40NUM S X="" F JJ=1:1:$L(V) S:$A(V,JJ)>32 X=X_$E(V,JJ)
41 S V=X Q
42IN Q:IN="[" L ^LA(T,"I") S (CNT,^LA(T,"I"),^LA(T,"I",0))=^LA(T,"I")+1,^LA(T,"I",CNT)=$S($L(IN)>1:IN,1:"~"_$C(X+64)) K:CNT>100 ^LA(T,"I",CNT-100) L Q
43OUT Q:'$D(^LA(T,"C",0)) S MV="",CNT=^LA(T,"C",0)+1 I $D(^(CNT)) S ^(0)=CNT,MV=^(CNT),CT=^LA(T,"O")+1,^("O")=CT,^("O",CT)=MV K:CT>100 ^LA(T,"O",CT-100)
44 Q:MV="" I MV'[$C(4),(MV'["]") G OUT
45HDR S IDE=+$P(Y(1),",",19),ID=+$P(Y(1),",",15),TRAY=+$P(Y(1),",",8),CUP=+$P(Y(1),",",9)
46 S RMK=$P(Y(1),",",16)_$P(Y(1),",",17)_$P(Y(1),",",27)_$P(Y(2),",",1) F I=$L(RMK):-1:1 Q:$E(RMK,I)'=" " S RMK=$E(RMK,1,I-1)
47 Q
48RES S TRAY=+$P(Y(1),",",8),CUP=+$P(Y(1),",",9),V=$P(Y(1),",",10) D NUM S TS=V,V=$P(Y(1),",",15) D NUM S:V="" V=$P(Y(1),",",23) D NUM S V=$S("*"[V:"","#"[V:"",1:V) I V]"",($D(TS(TS))#2) S @TC(TS(TS),1)=+V
49F S J=$O(^LAH(LWL,1,"B",TRAY_";"_CUP,0)) I J>0 S ID=$P(^LAH(LWL,1,J,0),"^",5)
50 Q
51RES1 S TRAY=+$P(Y(1),",",5),CUP=+$P(Y(1),",",6),V=$P(Y(1),",",8) D NUM S TS=V
52 S V=$P(Y(1),",",10) D NUM S:"*"[V V="" I V]"",($D(TS(TS))#2),($P(Y(1),",",11)="OK") S @TC(TS(TS),1)=+V
53 G F
54DQ K ^LA("LOCK",$E($T(+0),7,8)) G LABCX4XX
55SET S:'$D(^LA(T,"I"))#2 ^LA(T,"I")=0,^("I",0)=0
56SETO S:'$D(^LA(T,"O"))#2 ^LA(T,"O")=0,^("O",0)=0 Q
57TRAP D ^LABERR S T=TSK D SET^LAB G @("LA2^"_LANM)
58DBO S (Q,^LA(DEB,0))=^LA(DEB,0)+1,^(Q)="OUT: "_$S($L(OUT)>2:$E(OUT,1,230),$L(OUT)=1:"~"_$C($A(OUT)+64),1:"~"_$C($A(OUT,1)+64)_"~"_$C($A(OUT,2)+64))_"%^%"_$H Q
59DBX Q:X=91 S (Q,^LA(DEB,0))=^LA(DEB,0)+1,^(Q)="IN: "_$S(X>31:$C(X),1:"~"_$C(X+64))_"%^%"_$H Q
60DBI S (Q,^LA(DEB,0))=^LA(DEB,0)+1,^(Q)="IN: "_$E(IN,1,230)_"%^%"_$H Q
Note: See TracBrowser for help on using the repository browser.