- 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 Mar 13, 2025@20:47:56 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
