LAMIV11 ;SLC/DLG/FHS/DAL - PROCESS VITEK GPS & YBC CARDS ;7/20/90 09:38 ;
;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994
Q:$E(IN,1,2)'="01" ;No MIC results
;Find the organism and mic results
S O=$E(IN,5,6),V=$E(IN,10),V=$S("0"[V:"0F","1"[V:"0FB",1:"") Q:V="" S TYPE=$O(^LAB(62.4,TSK,7,"B",V,0)) Q:TYPE<1
S V=$O(^LAB(62.4,TSK,7,TYPE,1,"C",O,0)) Q:V<1 S ORG(ISOL)=+^LAB(62.4,TSK,7,TYPE,1,V,0)
F I2=17:6:92 S V=$E(IN,I2) D MICF
S LRT=CARD,CARD=$O(^LAB(62.4,TSK,7,"B","10",0))
S RMK="",FL=$E(IN,3) F CODE=46,47 D MSG
I $E(IN,3)=1 S FL=$E(IN,8) F CODE=48,49 D MSG
I $E(IN,3)=1 S FL=$E(IN,9) F CODE=50,51 D MSG
S CARD=LRT K LRT Q
MICF S O=$E(IN,(I2+4)),I4=$O(^LAB(62.4,TSK,7,CARD,2,"C",O,0)) Q:I4'>0 S I3=$P(^LAB(62.4,TSK,7,CARD,2,I4,0),U,2) X $P(^(0),U,3) S:V]"" MIC(ISOL,I3)=V
Q
511 S C=0,U="^",I1=3,I2=7 Q:$E(IN,1,2)'="FF" ;0F, 5.11, Gram Pos ID card
;CARD "OFB" is for the Catalase -/Non-Beta-Hemolytic or Catalase +/Coagulase + part
I $E(IN,3,4)="FF" S CARD=$O(^LAB(62.4,TSK,7,"B","0FB",0)) Q:CARD'>0 F I=11,15 S X1=$O(^LAB(62.4,TSK,7,CARD,1,"C",$E(IN,I,I+1),0)) D L2:X1>0 Q:$D(ORG)
I $E(IN,3,4)'="FF" S CARD=$O(^LAB(62.4,TSK,7,"B","0F",0)) Q:CARD'>0 F I=3,7 S X1=$O(^LAB(62.4,TSK,7,CARD,1,"C",$E(IN,I,I+1),0)) D L2:X1>0 Q:$D(ORG)
S RMK="",CODE=46,FL=$E(IN,90) D MSG S CODE=47,FL=$E(IN,91) D MSG
Q
L2 N X2 S (X,X2)=$E(IN,I+2,I+3) D PROB I X>80 S ORG(ISOL,1)=X2,ORG(ISOL)=+^LAB(62.4,TSK,7,CARD,1,X1,0) ;accept if prob>80%
Q
HEX S XX=X,X="" F II=1:1:$L(XX) S X=X*16+($F("0123456789ABCDEF",$E(XX,II))-2)
Q
54 S C=0,U="^" ;05, 5.4, Yeast card
F I=1,5 S X1=$O(^LAB(62.4,TSK,7,CARD,1,"C",$E(IN,I,I+1),0)) D L2:X1>0
D RMK
Q
RMK S RMK="" S CODE=41,FL=$E(IN,42) D MSG S CODE=42,FL=$E(IN,42) D MSG F CODE=44:1:46 S FL=$E(IN,CODE) D MSG
S CODE=41,FL=$E(IN,43) D MSG S CODE=42 D MSG
Q
MSG F X1=0:0 S X1=$O(^LAB(62.4,TSK,7,CARD,4,"B",CODE,X1)) Q:X1'>0 D MS2
Q
MS2 S X3=^LAB(62.4,TSK,7,CARD,4,X1,0)
S X4=$P(X3,U,2) I $L(X4),X4'=FL Q ;
S:$L(RMK) RMK=RMK_", " S RMK=RMK_$P(X3,U,3)
Q
PROB D HEX I X>100 S X="" Q
S:X=0 X="<1" S X=X_"% Probability" Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLAMIV11 2108 printed Oct 16, 2024@17:44:07 Page 2
LAMIV11 ;SLC/DLG/FHS/DAL - PROCESS VITEK GPS & YBC CARDS ;7/20/90 09:38 ;
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994
+2 ;No MIC results
if $EXTRACT(IN,1,2)'="01"
QUIT
+3 ;Find the organism and mic results
+4 SET O=$EXTRACT(IN,5,6)
SET V=$EXTRACT(IN,10)
SET V=$SELECT("0"[V:"0F","1"[V:"0FB",1:"")
if V=""
QUIT
SET TYPE=$ORDER(^LAB(62.4,TSK,7,"B",V,0))
if TYPE<1
QUIT
+5 SET V=$ORDER(^LAB(62.4,TSK,7,TYPE,1,"C",O,0))
if V<1
QUIT
SET ORG(ISOL)=+^LAB(62.4,TSK,7,TYPE,1,V,0)
+6 FOR I2=17:6:92
SET V=$EXTRACT(IN,I2)
DO MICF
+7 SET LRT=CARD
SET CARD=$ORDER(^LAB(62.4,TSK,7,"B","10",0))
+8 SET RMK=""
SET FL=$EXTRACT(IN,3)
FOR CODE=46,47
DO MSG
+9 IF $EXTRACT(IN,3)=1
SET FL=$EXTRACT(IN,8)
FOR CODE=48,49
DO MSG
+10 IF $EXTRACT(IN,3)=1
SET FL=$EXTRACT(IN,9)
FOR CODE=50,51
DO MSG
+11 SET CARD=LRT
KILL LRT
QUIT
MICF SET O=$EXTRACT(IN,(I2+4))
SET I4=$ORDER(^LAB(62.4,TSK,7,CARD,2,"C",O,0))
if I4'>0
QUIT
SET I3=$PIECE(^LAB(62.4,TSK,7,CARD,2,I4,0),U,2)
XECUTE $PIECE(^(0),U,3)
if V]""
SET MIC(ISOL,I3)=V
+1 QUIT
511 ;0F, 5.11, Gram Pos ID card
SET C=0
SET U="^"
SET I1=3
SET I2=7
if $EXTRACT(IN,1,2)'="FF"
QUIT
+1 ;CARD "OFB" is for the Catalase -/Non-Beta-Hemolytic or Catalase +/Coagulase + part
+2 IF $EXTRACT(IN,3,4)="FF"
SET CARD=$ORDER(^LAB(62.4,TSK,7,"B","0FB",0))
if CARD'>0
QUIT
FOR I=11,15
SET X1=$ORDER(^LAB(62.4,TSK,7,CARD,1,"C",$EXTRACT(IN,I,I+1),0))
if X1>0
DO L2
if $DATA(ORG)
QUIT
+3 IF $EXTRACT(IN,3,4)'="FF"
SET CARD=$ORDER(^LAB(62.4,TSK,7,"B","0F",0))
if CARD'>0
QUIT
FOR I=3,7
SET X1=$ORDER(^LAB(62.4,TSK,7,CARD,1,"C",$EXTRACT(IN,I,I+1),0))
if X1>0
DO L2
if $DATA(ORG)
QUIT
+4 SET RMK=""
SET CODE=46
SET FL=$EXTRACT(IN,90)
DO MSG
SET CODE=47
SET FL=$EXTRACT(IN,91)
DO MSG
+5 QUIT
L2 ;accept if prob>80%
NEW X2
SET (X,X2)=$EXTRACT(IN,I+2,I+3)
DO PROB
IF X>80
SET ORG(ISOL,1)=X2
SET ORG(ISOL)=+^LAB(62.4,TSK,7,CARD,1,X1,0)
+1 QUIT
HEX SET XX=X
SET X=""
FOR II=1:1:$LENGTH(XX)
SET X=X*16+($FIND("0123456789ABCDEF",$EXTRACT(XX,II))-2)
+1 QUIT
54 ;05, 5.4, Yeast card
SET C=0
SET U="^"
+1 FOR I=1,5
SET X1=$ORDER(^LAB(62.4,TSK,7,CARD,1,"C",$EXTRACT(IN,I,I+1),0))
if X1>0
DO L2
+2 DO RMK
+3 QUIT
RMK SET RMK=""
SET CODE=41
SET FL=$EXTRACT(IN,42)
DO MSG
SET CODE=42
SET FL=$EXTRACT(IN,42)
DO MSG
FOR CODE=44:1:46
SET FL=$EXTRACT(IN,CODE)
DO MSG
+1 SET CODE=41
SET FL=$EXTRACT(IN,43)
DO MSG
SET CODE=42
DO MSG
+2 QUIT
MSG FOR X1=0:0
SET X1=$ORDER(^LAB(62.4,TSK,7,CARD,4,"B",CODE,X1))
if X1'>0
QUIT
DO MS2
+1 QUIT
MS2 SET X3=^LAB(62.4,TSK,7,CARD,4,X1,0)
+1 ;
SET X4=$PIECE(X3,U,2)
IF $LENGTH(X4)
IF X4'=FL
QUIT
+2 if $LENGTH(RMK)
SET RMK=RMK_", "
SET RMK=RMK_$PIECE(X3,U,3)
+3 QUIT
PROB DO HEX
IF X>100
SET X=""
QUIT
+1 if X=0
SET X="<1"
SET X=X_"% Probability"
QUIT
