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 ---[H[J[2J[HLASMACA 2133 printed Apr 09, 2024@20:47:11 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
