- LADEKT7B ; IHS/DIR/FJE - EKTACHEM 700 BI-DIRECTIONAL 7/23/90 11:04 ;
- ;;5.2;LA;;NOV 01, 1997
- ;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994
- ;CROSS LINK BY ID OR IDE
- LA1 S:$D(ZTQUEUED) ZTREQ="@" S LANM=$T(+0),TSK=$O(^LAB(62.4,"C",LANM,0)) Q:TSK<1
- Q:'$D(^LA(TSK,"I",0))
- K LATOP D ^LASET Q:'TSK S X="TRAP^"_LANM,@^%ZOSF("TRAP"),U="^"
- LA2 K TV,TY,Y S TOUT=0,A=1,RMK="" D IN G QUIT:TOUT,LA2:$E(IN,1,6)'?6N D QC
- S LATM=$E(IN,1,6),V=$E(IN,11,25) D NUM S TRAY=+$P(V,"TRAY",2),V=$E(IN,26,40) D NUM S IDE=+V,LAFL=$E(IN,41),LAV6=$E(IN,42),CUP=$A(IN,43)-32,LAMD=$E(IN,44),V=$E(IN,45,49) D NUM S DILU=+X,Y(1)=$E(IN,50,999)
- I Y(1)'["]" F A=2:1 D IN,QC Q:IN["]"
- S IN="" F A1=1:1:A S IN=IN_Y(A1) F I=1:1:$L(IN,"}")-1 S Y=$P(IN,"}",1),IN=$P(IN,"}",2,99),V=$E(Y,2,10),E=$E(Y,12),OV="" D NUM S:"0127"'[E OV=V,V="" S TY($E(Y))=V_"^"_$E(Y,11,22)_$S(OV]"":"^"_OV,1:"")
- F I=0:0 S I=$O(^TMP("LA",$J,I)),V="" Q:I<1 X ^TMP("LA",$J,I,2) I V]"" S @^TMP("LA",$J,I,1)=V
- S ID=IDE
- LA3 X LAGEN G LA2:'ISQN ;Can be changed by the cross-link code
- F I=0:0 S I=$O(TV(I)) Q:I<1 S:TV(I,1)]"" ^LAH(LWL,1,ISQN,I)=TV(I,1)
- I $D(RMK),$L(RMK) D RMK^LASET
- G LA2
- QC ;QC TESTING HERE; S BAD=1 IF DONT STORE
- S Y(A)=IN Q
- NUM S X="" F JJ=1:1:$L(V) S:$A(V,JJ)>32 X=X_$E(V,JJ)
- S V=X Q
- IN S:'$D(^LA(TSK,"C",0)) ^LA(TSK,"C")=0,^("C",0)=0 I ^LA(TSK,"C")=^LA(TSK,"C",0) D ^LADKERM3 Q:TOUT
- S CNT=^LA(TSK,"C",0)+1 IF '$D(^(CNT)) S TOUT=TOUT+1 Q:TOUT>9 H 5 G IN
- S ^LA(TSK,"C",0)=CNT,IN=^(CNT),TOUT=0
- S:IN["~" CTRL=$P(IN,"~",2),IN=$P(IN,"~",1)
- Q
- OUT S CNT=^LA(TSK,"O")+1,^("O")=CNT,^("O",CNT)=OUT
- LOCK ^LA("Q") S Q=^LA("Q")+1,^("Q")=Q,^("Q",Q)=TSK LOCK
- Q
- QUIT G:'$D(^LA(TSK,"I")) Q1 G:^LA(TSK,"I")>^LA(TSK,"I",0) LA2 I $D(^LA(TSK,"P")),^("P")'["QUIT" H 60 G QUIT
- I ^LA(TSK,"O")'=^LA(TSK,"O",0) H 60 G QUIT
- Q1 K ^LA("LOCK",TSK) LOCK ^LA(TSK) H 1 K ^LA(TSK,"I"),^("C") L
- Q
- TRAP D ^LABERR S T=TSK D SET^LAB G @("LA2^"_LANM) ;ERROR TRAP
- Q
- LADEKT7B ; IHS/DIR/FJE - EKTACHEM 700 BI-DIRECTIONAL 7/23/90 11:04 ;
- +1 ;;5.2;LA;;NOV 01, 1997
- +2 ;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994
- +3 ;CROSS LINK BY ID OR IDE
- LA1 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- SET LANM=$TEXT(+0)
- SET TSK=$ORDER(^LAB(62.4,"C",LANM,0))
- IF TSK<1
- QUIT
- +1 IF '$DATA(^LA(TSK,"I",0))
- QUIT
- +2 KILL LATOP
- DO ^LASET
- IF 'TSK
- QUIT
- SET X="TRAP^"_LANM
- SET @^%ZOSF("TRAP")
- SET U="^"
- LA2 KILL TV,TY,Y
- SET TOUT=0
- SET A=1
- SET RMK=""
- DO IN
- IF TOUT
- GOTO QUIT
- IF $EXTRACT(IN,1,6)'?6N
- GOTO LA2
- DO QC
- +1 SET LATM=$EXTRACT(IN,1,6)
- SET V=$EXTRACT(IN,11,25)
- DO NUM
- SET TRAY=+$PIECE(V,"TRAY",2)
- SET V=$EXTRACT(IN,26,40)
- DO NUM
- SET IDE=+V
- SET LAFL=$EXTRACT(IN,41)
- SET LAV6=$EXTRACT(IN,42)
- SET CUP=$ASCII(IN,43)-32
- SET LAMD=$EXTRACT(IN,44)
- SET V=$EXTRACT(IN,45,49)
- DO NUM
- SET DILU=+X
- SET Y(1)=$EXTRACT(IN,50,999)
- +2 IF Y(1)'["]"
- FOR A=2:1
- DO IN
- DO QC
- IF IN["]"
- QUIT
- +3 SET IN=""
- FOR A1=1:1:A
- SET IN=IN_Y(A1)
- FOR I=1:1:$LENGTH(IN,"}")-1
- SET Y=$PIECE(IN,"}",1)
- SET IN=$PIECE(IN,"}",2,99)
- SET V=$EXTRACT(Y,2,10)
- SET E=$EXTRACT(Y,12)
- SET OV=""
- DO NUM
- IF "0127"'[E
- SET OV=V
- SET V=""
- SET TY($EXTRACT(Y))=V_"^"_$EXTRACT(Y,11,22)_$SELECT(OV]"":"^"_OV,1:"")
- +4 FOR I=0:0
- SET I=$ORDER(^TMP("LA",$JOB,I))
- SET V=""
- IF I<1
- QUIT
- XECUTE ^TMP("LA",$JOB,I,2)
- IF V]""
- SET @^TMP("LA",$JOB,I,1)=V
- +5 SET ID=IDE
- LA3 ;Can be changed by the cross-link code
- XECUTE LAGEN
- IF 'ISQN
- GOTO LA2
- +1 FOR I=0:0
- SET I=$ORDER(TV(I))
- IF I<1
- QUIT
- IF TV(I,1)]""
- SET ^LAH(LWL,1,ISQN,I)=TV(I,1)
- +2 IF $DATA(RMK)
- IF $LENGTH(RMK)
- DO RMK^LASET
- +3 GOTO LA2
- QC ;QC TESTING HERE; S BAD=1 IF DONT STORE
- +1 SET Y(A)=IN
- QUIT
- NUM SET X=""
- FOR JJ=1:1:$LENGTH(V)
- IF $ASCII(V,JJ)>32
- SET X=X_$EXTRACT(V,JJ)
- +1 SET V=X
- QUIT
- IN IF '$DATA(^LA(TSK,"C",0))
- SET ^LA(TSK,"C")=0
- SET ^("C",0)=0
- IF ^LA(TSK,"C")=^LA(TSK,"C",0)
- DO ^LADKERM3
- IF TOUT
- QUIT
- +1 SET CNT=^LA(TSK,"C",0)+1
- IF '$DATA(^(CNT))
- SET TOUT=TOUT+1
- IF TOUT>9
- QUIT
- HANG 5
- GOTO IN
- +2 SET ^LA(TSK,"C",0)=CNT
- SET IN=^(CNT)
- SET TOUT=0
- +3 IF IN["~"
- SET CTRL=$PIECE(IN,"~",2)
- SET IN=$PIECE(IN,"~",1)
- +4 QUIT
- OUT SET CNT=^LA(TSK,"O")+1
- SET ^("O")=CNT
- SET ^("O",CNT)=OUT
- +1 LOCK ^LA("Q")
- SET Q=^LA("Q")+1
- SET ^("Q")=Q
- SET ^("Q",Q)=TSK
- LOCK
- +2 QUIT
- QUIT IF '$DATA(^LA(TSK,"I"))
- GOTO Q1
- IF ^LA(TSK,"I")>^LA(TSK,"I",0)
- GOTO LA2
- IF $DATA(^LA(TSK,"P"))
- IF ^("P")'["QUIT"
- HANG 60
- GOTO QUIT
- +1 IF ^LA(TSK,"O")'=^LA(TSK,"O",0)
- HANG 60
- GOTO QUIT
- Q1 KILL ^LA("LOCK",TSK)
- LOCK ^LA(TSK)
- HANG 1
- KILL ^LA(TSK,"I"),^("C")
- LOCK
- +1 QUIT
- TRAP ;ERROR TRAP
- DO ^LABERR
- SET T=TSK
- DO SET^LAB
- GOTO @("LA2^"_LANM)
- +1 QUIT
