LATOA ;SLC/RWF - TOA AUTO INSTRUMENT ;7/20/90  10:17 ;
 ;;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")
LA2 K TV,Y S TOUT=0 D IN G QUIT:TOUT,LA2:$L(IN)'=44,LA2:+$E(IN,41,44)'=0
 S Y(1)=IN,(RBC,HCT,HGB)=0 F I=0:0 S I=$O(TC(I)) Q:I<1  X TC(I,2) D:$D(TC(I,3)) MATH S @TC(I,1)=V
 S (ID,IDE,CUP)=+$E(Y(1),11,14),TRAY=1
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)
 K RBC,HCT,HGB G LA2
MATH ;DIVIDE BY PARAM 2
 Q:+TC(I,3)'>0  S V=V/TC(I,3),V=$J(V,1,1) 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 CNT=^LA(TSK,"I",0)+1 IF '$D(^(CNT)) S TOUT=TOUT+1 Q:TOUT>9  H 5 G IN
 S ^LA(TSK,"I",0)=CNT,IN=^(CNT),TOUT=0
 S:IN["~" CTRL=$P(IN,"~",2),IN=$P(IN,"~",1)
 Q
QUIT LOCK ^LA(TSK) H 1 K ^LA(TSK),^LA("LOCK",TSK),^TMP($J),^TMP("LA",$J)
 Q
TRAP D ^LABERR S T=TSK D SET^LAB G @("LA2^"_LANM) ;ERROR TRAP
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLATOA   1106     printed  Sep 23, 2025@19:20:24                                                                                                                                                                                                       Page 2
LATOA     ;SLC/RWF - TOA AUTO INSTRUMENT ;7/20/90  10:17 ;
 +1       ;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994
 +2       ;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")
LA2        KILL TV,Y
           SET TOUT=0
           DO IN
           if TOUT
               GOTO QUIT
           if $LENGTH(IN)'=44
               GOTO LA2
           if +$EXTRACT(IN,41,44)'=0
               GOTO LA2
 +1        SET Y(1)=IN
           SET (RBC,HCT,HGB)=0
           FOR I=0:0
               SET I=$ORDER(TC(I))
               if I<1
                   QUIT 
               XECUTE TC(I,2)
               if $DATA(TC(I,3))
                   DO MATH
               SET @TC(I,1)=V
 +2        SET (ID,IDE,CUP)=+$EXTRACT(Y(1),11,14)
           SET TRAY=1
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        KILL RBC,HCT,HGB
           GOTO LA2
MATH      ;DIVIDE BY PARAM 2
 +1        if +TC(I,3)'>0
               QUIT 
           SET V=V/TC(I,3)
           SET V=$JUSTIFY(V,1,1)
           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         SET CNT=^LA(TSK,"I",0)+1
           IF '$DATA(^(CNT))
               SET TOUT=TOUT+1
               if TOUT>9
                   QUIT 
               HANG 5
               GOTO IN
 +1        SET ^LA(TSK,"I",0)=CNT
           SET IN=^(CNT)
           SET TOUT=0
 +2        if IN["~"
               SET CTRL=$PIECE(IN,"~",2)
               SET IN=$PIECE(IN,"~",1)
 +3        QUIT 
QUIT       LOCK ^LA(TSK)
           HANG 1
           KILL ^LA(TSK),^LA("LOCK",TSK),^TMP($JOB),^TMP("LA",$JOB)
 +1        QUIT 
TRAP      ;ERROR TRAP
           DO ^LABERR
           SET T=TSK
           DO SET^LAB
           GOTO @("LA2^"_LANM)