LASMACA.m

LASMACA ;SLC/RWF - GETS DATA FROM SMAC ;8/16/90  11:03 ;

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

 ;CROSS LINK BY,  ID =smac IDEE #(bar code),  IDE =smac MED REC #, IDE2 =labnum

LA1 S:$D(ZTQUEUED) ZTREQ="@" S LANM=$T(+0),TSK=$O(^LAB(62.4,"C",LANM,0)),U="^",LRTEC="" Q:TSK<1

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

 S LRTOP=$P(^LAB(69.9,1,1),U,3) D ^LASET ;SET LRTOP

 S TP=0,SS="CH",X="TRAP^"_LANM,@^%ZOSF("TRAP")

 I TC(1,2)?.N1P.N F I=1:1:TC S Y=+TC(I,2),E=+$P(TC(I,2),",",2),TC(I,2)="S V=$E(Y("_Y_"),"_E_","_(E+3)_"),T=$E(Y("_Y_"),"_(E+4)_")"

 S IDT=0

LA2 G ENT

D2S S RMK=$P(RMK,"   ",1)_" "_$P(RMK,"   ",2,99) G D2S:RMK["   " Q

ENT K TV S END=0,BAD=0,IDE="",ID=""

C1 S TOUT=0 D IN G LAST:TOUT,C1:$E(IN,13)'="/"

 S I=1 D REC F I=2:1:4 D IN,REC:'TOUT

 G ENT:TOUT!BAD D SAVE G ENT

LAST K ^LA("LOCK",TSK),^LA("STOP",TSK) Q:$D(LRMODE)  L ^LA(TSK) H 2 K ^LA(TSK)

 Q

REC ;

 IF $E(IN,$P("13^36^7^5",U,I))'=$E("/// ",I) S BAD=1

 Q:END!BAD  S Y(I)=IN

 Q

SAVE S K=",",FG=0

 S RMK=$E(Y(2),6,35),NSS=$E(RMK,1,5) D D2S S IDE=$E(Y(1),1,12),ID=$E(Y(3),1,6),IDE2=$E(Y(3),8,11)

 S DILU=$S(NSS["SX":+$P(NSS,"SX",2),NSS["UX":+$P(NSS,"UX",2),1:0),SPEC=$S($E(NSS)="U":$P(^LAB(69.9,1,1),U,2),1:$P(^LAB(69.9,1,1),U,3))

 F II=1:1:TC X TC(II,2) S:V="    "!(V="----") T="B" S:T'="B"&DILU V=V*DILU S:T'="B"&TC(II,3) V=V/TC(II,3) S @TC(II,1)=$S("/*="[T:+V,1:"")_$S("CGTLD*"[T:T,1:""),FG=("CGTLD*"[T)+FG

 S TRAY=+$E(ID,1,3),CUP=+$E(ID,4,6)

 Q:ID?.P

LA3 X LAGEN ;D ^LACRIT:SPEC=$P(^LAB(69.9,1,1),U,3)

 IF $D(^LRO(68.2,LWL,8,0)) S:FG ^LRO(68.2,LWL,8,ISQN)=FG

 F I=0:0 S I=$O(TV(I)) Q:I<1  D LA4

 I RMK'?." " S ^LAH(LWL,1,ISQN,1)=RMK

 I DPF=62.3 D CONTROL^LAGEN

 Q

LA4 I $D(TV(I,1)),TV(I,1)]"" S ^LAH(LWL,1,ISQN,I)=TV(I,1)

 Q

 Q

IN S CNT=^LA(TSK,"I",0)+1 IF '$D(^(CNT)) S TOUT=TOUT+1 S:$D(^LA("STOP",TSK)) TOUT=99 Q:TOUT>30  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

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

TRAP D ^LABERR K OLD,^LA("LOCK",TSK) Q

 ;Y(I),START $E, DIVIDE BY

 ;IDE=MEDICAL REC. NUM, ID=IDEE

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---LASMACA   2133     printed  Mar 13, 2025@20:48:55                                                                                                                                                                                                     Page 2

LASMACA   ;SLC/RWF - GETS DATA FROM SMAC ;8/16/90  11:03 ;

 +1       ;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994

 +2       ;CROSS LINK BY,  ID =smac IDEE #(bar code),  IDE =smac MED REC #, IDE2 =labnum

LA1        if $DATA(ZTQUEUED)

               SET ZTREQ="@"

           SET LANM=$TEXT(+0)

           SET TSK=$ORDER(^LAB(62.4,"C",LANM,0))

           SET U="^"

           SET LRTEC=""

           if TSK<1

               QUIT 

 +1        if '$DATA(^LA(TSK,"I",0))

               QUIT 

 +2       ;SET LRTOP

           SET LRTOP=$PIECE(^LAB(69.9,1,1),U,3)

           DO ^LASET

 +3        SET TP=0

           SET SS="CH"

           SET X="TRAP^"_LANM

           SET @^%ZOSF("TRAP")

 +4        IF TC(1,2)?.N1P.N

               FOR I=1:1:TC

                   SET Y=+TC(I,2)

                   SET E=+$PIECE(TC(I,2),",",2)

                   SET TC(I,2)="S V=$E(Y("_Y_"),"_E_","_(E+3)_"),T=$E(Y("_Y_"),"_(E+4)_")"

 +5        SET IDT=0

LA2        GOTO ENT

D2S        SET RMK=$PIECE(RMK,"   ",1)_" "_$PIECE(RMK,"   ",2,99)

           if RMK["   "

               GOTO D2S

           QUIT 

ENT        KILL TV

           SET END=0

           SET BAD=0

           SET IDE=""

           SET ID=""

C1         SET TOUT=0

           DO IN

           if TOUT

               GOTO LAST

           if $EXTRACT(IN,13)'="/"

               GOTO C1

 +1        SET I=1

           DO REC

           FOR I=2:1:4

               DO IN

               if 'TOUT

                   DO REC

 +2        if TOUT!BAD

               GOTO ENT

           DO SAVE

           GOTO ENT

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

           if $DATA(LRMODE)

               QUIT 

           LOCK ^LA(TSK)

           HANG 2

           KILL ^LA(TSK)

 +1        QUIT 

REC       ;

 +1        IF $EXTRACT(IN,$PIECE("13^36^7^5",U,I))'=$EXTRACT("/// ",I)

               SET BAD=1

 +2        if END!BAD

               QUIT 

           SET Y(I)=IN

 +3        QUIT 

SAVE       SET K=","

           SET FG=0

 +1        SET RMK=$EXTRACT(Y(2),6,35)

           SET NSS=$EXTRACT(RMK,1,5)

           DO D2S

           SET IDE=$EXTRACT(Y(1),1,12)

           SET ID=$EXTRACT(Y(3),1,6)

           SET IDE2=$EXTRACT(Y(3),8,11)

 +2        SET DILU=$SELECT(NSS["SX":+$PIECE(NSS,"SX",2),NSS["UX":+$PIECE(NSS,"UX",2),1:0)

           SET SPEC=$SELECT($EXTRACT(NSS)="U":$PIECE(^LAB(69.9,1,1),U,2),1:$PIECE(^LAB(69.9,1,1),U,3))

 +3        FOR II=1:1:TC

               XECUTE TC(II,2)

               if V="    "!(V="----")

                   SET T="B"

               if T'="B"&DILU

                   SET V=V*DILU

               if T'="B"&TC(II,3)

                   SET V=V/TC(II,3)

               SET @TC(II,1)=$SELECT("/*="[T:+V,1:"")_$SELECT("CGTLD*"[T:T,1:"")

               SET FG=("CGTLD*"[T)+FG

 +4        SET TRAY=+$EXTRACT(ID,1,3)

           SET CUP=+$EXTRACT(ID,4,6)

 +5        if ID?.P

               QUIT 

LA3       ;D ^LACRIT:SPEC=$P(^LAB(69.9,1,1),U,3)

           XECUTE LAGEN

 +1        IF $DATA(^LRO(68.2,LWL,8,0))

               if FG

                   SET ^LRO(68.2,LWL,8,ISQN)=FG

 +2        FOR I=0:0

               SET I=$ORDER(TV(I))

               if I<1

                   QUIT 

               DO LA4

 +3        IF RMK'?." "

               SET ^LAH(LWL,1,ISQN,1)=RMK

 +4        IF DPF=62.3

               DO CONTROL^LAGEN

 +5        QUIT 

LA4        IF $DATA(TV(I,1))

               IF TV(I,1)]""

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

 +1        QUIT 

 +2        QUIT 

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

           IF '$DATA(^(CNT))

               SET TOUT=TOUT+1

               if $DATA(^LA("STOP",TSK))

                   SET TOUT=99

               if TOUT>30

                   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 

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 

TRAP       DO ^LABERR

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

           QUIT 

 +1       ;Y(I),START $E, DIVIDE BY

 +2       ;IDE=MEDICAL REC. NUM, ID=IDEE