LACD1600.m

LACD1600 ; IHS/DIR/FJE - CELL-DYN 1500,1600,2000 AUTOMATED DATA 6/2/89 8:57 AM ;

 ;;5.2;LA;;NOV 01, 1997

 ;;5.2;AUTOMATED LAB INSTRUMENTS;**6**;Sep 27, 1994;

 ;CROSS LINK BY ID OR IDE

LA1 S LANM=$T(+0),TSK=$O(^LAB(62.4,"C",LANM,0)) Q:TSK<1

 Q:'$D(^LA(TSK,"I",0))  S LAC=","

 K LATOP D ^LASET Q:'TSK  S X="TRAP^"_LANM,@^%ZOSF("TRAP")

LA2 K TV,Y S TOUT=0 D IN G QUIT:TOUT

 D LA2:$P(IN,LAC)'="""   """ S TOUT=0,A=1 S Y(A)=IN

LAC I IN="" D IN G QUIT:TOUT S TOUT=0,A=A+1,Y(A)=IN G LAC

 ;S V=$P(Y(1),",",2) D NUM S IDE=+V,V=$E($P(Y(1),",",3),2,99) D NUM

 ;S (ID,CUP)=+V,TRAY=1,V=$P(Y(1),",",38) D NUM S TYPE=V

 S IDE=+$$NUM($P(Y(1),LAC,2)),(ID,CUP)=+$$NUM($E($P(Y(1),LAC,3),2,99))

 S TRAY=1,TYPE=$$NUM($P(Y(1),LAC,38))

 F I=0:0 S I=$O(TC(I)) Q:I=""  X TC(I,2) S @TC(I,1)=V ;V COULD BE MODIFIED ON THIS LINE

LA3 G:'ID LA2 X LAGEN G LA2:'ISQN ;Can be changed by the cross-link code

 F I=0:0 S I=$O(TV(I)) Q:I=""  S:TV(I,1)>0 ^LAH(LWL,1,ISQN,I)=TV(I,1)

 G QUIT:TOUT>9 G LA2 ;<543/EPH> ADDED G QUIT:TOUT>9

QC ;QC TESTING HERE; S BAD=1 IF DONT STORE

 S Y(A)=IN Q

NUM(X) N LAX,JJ S LAX="" F JJ=1:1:$L(X) S:$A(X,JJ)>32 LAX=LAX_$E(X,JJ)

 Q LAX

IN G QUIT:'$D(^LA(TSK,"I",0)) S CNT=^LA(TSK,"I",0)+1 IF '$D(^(CNT)) S TOUT=TOUT+1 Q:TOUT>9  H 2 G IN

 S ^LA(TSK,"I",0)=CNT,IN=^(CNT),TOUT=0 I ECHOALL S Z=IN D WRITE

 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 -^LA("Q")

 Q

WRITE I IO]"" O IO::1 IF $T U IO W:'ECHOALL *7 W !,Z C IO

 Q

QUIT S TOUT=9 K ^LA(TSK),^LA("LOCK",TSK) I $D(ZTSK) D KILL^%ZTLOAD K ZTSK

 Q

TRAP D ^LABERR S T=TSK D SET^LAB G @("LA2^"_LANM) ;ERROR TRAP

LACD1600  ; IHS/DIR/FJE - CELL-DYN 1500,1600,2000 AUTOMATED DATA 6/2/89 8:57 AM ;

 +1       ;;5.2;LA;;NOV 01, 1997

 +2       ;;5.2;AUTOMATED LAB INSTRUMENTS;**6**;Sep 27, 1994;

 +3       ;CROSS LINK BY ID OR IDE

LA1        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 

           SET LAC=","

 +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

 +1        IF $PIECE(IN,LAC)'="""   """

               DO LA2

           SET TOUT=0

           SET A=1

           SET Y(A)=IN

LAC        IF IN=""

               DO IN

               IF TOUT

                   GOTO QUIT

               SET TOUT=0

               SET A=A+1

               SET Y(A)=IN

               GOTO LAC

 +1       ;S V=$P(Y(1),",",2) D NUM S IDE=+V,V=$E($P(Y(1),",",3),2,99) D NUM

 +2       ;S (ID,CUP)=+V,TRAY=1,V=$P(Y(1),",",38) D NUM S TYPE=V

 +3        SET IDE=+$$NUM($PIECE(Y(1),LAC,2))

           SET (ID,CUP)=+$$NUM($EXTRACT($PIECE(Y(1),LAC,3),2,99))

 +4        SET TRAY=1

           SET TYPE=$$NUM($PIECE(Y(1),LAC,38))

 +5       ;V COULD BE MODIFIED ON THIS LINE

           FOR I=0:0

               SET I=$ORDER(TC(I))

               IF I=""

                   QUIT 

               XECUTE TC(I,2)

               SET @TC(I,1)=V

LA3       ;Can be changed by the cross-link code

           IF 'ID

               GOTO LA2

           XECUTE LAGEN

           IF 'ISQN

               GOTO LA2

 +1        FOR I=0:0

               SET I=$ORDER(TV(I))

               IF I=""

                   QUIT 

               IF TV(I,1)>0

                   SET ^LAH(LWL,1,ISQN,I)=TV(I,1)

 +2       ;<543/EPH> ADDED G QUIT:TOUT>9

           IF TOUT>9

               GOTO QUIT

           GOTO LA2

QC        ;QC TESTING HERE; S BAD=1 IF DONT STORE

 +1        SET Y(A)=IN

           QUIT 

NUM(X)     NEW LAX,JJ

           SET LAX=""

           FOR JJ=1:1:$LENGTH(X)

               IF $ASCII(X,JJ)>32

                   SET LAX=LAX_$EXTRACT(X,JJ)

 +1        QUIT LAX

IN         IF '$DATA(^LA(TSK,"I",0))

               GOTO QUIT

           SET CNT=^LA(TSK,"I",0)+1

           IF '$DATA(^(CNT))

               SET TOUT=TOUT+1

               IF TOUT>9

                   QUIT 

               HANG 2

               GOTO IN

 +1        SET ^LA(TSK,"I",0)=CNT

           SET IN=^(CNT)

           SET TOUT=0

           IF ECHOALL

               SET Z=IN

               DO WRITE

 +2        IF IN["~"

               SET CTRL=$PIECE(IN,"~",2)

               SET IN=$PIECE(IN,"~",1)

 +3        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 -^LA("Q")

 +2        QUIT 

WRITE      IF IO]""

               OPEN IO::1

               IF $TEST

                   USE IO

                   IF 'ECHOALL

                       WRITE *7

                   WRITE !,Z

                   CLOSE IO

 +1        QUIT 

QUIT       SET TOUT=9

           KILL ^LA(TSK),^LA("LOCK",TSK)

           IF $DATA(ZTSK)

               DO KILL^%ZTLOAD

               KILL ZTSK

 +1        QUIT 

TRAP      ;ERROR TRAP

           DO ^LABERR

           SET T=TSK

           DO SET^LAB

           GOTO @("LA2^"_LANM)