LAMIV11 ; IHS/DIR/FJE - PROCESS VITEK GPS & YBC CARDS 7/20/90 09:38 ;
;;5.2;LA;;NOV 01, 1997
;;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 ;IHS/ANMC/CLS 11/1/95 per Frank
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
LAMIV11 ; IHS/DIR/FJE - PROCESS VITEK GPS & YBC CARDS 7/20/90 09:38 ;
+1 ;;5.2;LA;;NOV 01, 1997
+2 ;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994
+3 ;No MIC results
IF $EXTRACT(IN,1,2)'="01"
QUIT
+4 ;Find the organism and mic results
+5 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
+6 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)
+7 FOR I2=17:6:92
SET V=$EXTRACT(IN,I2)
DO MICF
+8 SET LRT=CARD
SET CARD=$ORDER(^LAB(62.4,TSK,7,"B","10",0))
+9 SET RMK=""
SET FL=$EXTRACT(IN,3)
FOR CODE=46,47
DO MSG
+10 IF $EXTRACT(IN,3)=1
SET FL=$EXTRACT(IN,8)
FOR CODE=48,49
DO MSG
+11 IF $EXTRACT(IN,3)=1
SET FL=$EXTRACT(IN,9)
FOR CODE=50,51
DO MSG
+12 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 ;F X1=0:0 S X1=$O(^LAB(62.4,TSK,7,CARD,4,"B",CODE,X1)) Q:X1'>0 D MS2 ;IHS/ANMC/CLS 11/1/95 per Frank
+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
