LAMIV12.m

LAMIV12 ; IHS/DIR/FJE - PROCESS VITEK GNS CARDS 7/20/90 09:38 ;

 ;;5.2;LA;;NOV 01, 1997

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

A Q:$E(IN,1,2)'="01"  ;NO RESULTS OR MULTI COLUMN

 S RMK=$E(IN,3),RMK=$S(RMK=0:"Oxidase Negative",RMK=1:"Oxidase Positive",1:"")

 S O=$E(IN,5,6),V=$E(IN,7),TYPE=$S("12"[V:$O(^LAB(62.4,TSK,7,"B","0E",0)),1:"") 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=1:1:13 S V=$E(IN,(I2*6)+11),I3=$E(IN,16) D MIC0

 Q

MIC0 S O=$E(IN,(I2*6)+15),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

512 S C=0,U="^" ;0E, 5.12, Gram Neg ID card

 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=43,FL=$E(IN,44) D MSG S CODE=44,FL=$E(IN,44) D MSG S CODE=45,FL=$E(IN,46) D MSG S CODE=46,FL=$E(IN,47) D MSG S CODE=47,FL=$E(IN,48) D MSG

 S:'$D(ORG(ISOL)) BAD=1 Q

L2 S ORG(ISOL)=+^LAB(62.4,TSK,7,CARD,1,X1,0),X=$E(IN,I+2,I+3) D PROB S ORG(ISOL,1)=X I X=""!(X<80) K ORG(ISOL) ;cancel 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

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

LAMIV12   ; IHS/DIR/FJE - PROCESS VITEK GNS CARDS 7/20/90 09:38 ;

 +1       ;;5.2;LA;;NOV 01, 1997

 +2       ;;5.2;AUTOMATED LAB INSTRUMENTS;**5**;Sep 27, 1994

A         ;NO RESULTS OR MULTI COLUMN

           IF $EXTRACT(IN,1,2)'="01"

               QUIT 

 +1        SET RMK=$EXTRACT(IN,3)

           SET RMK=$SELECT(RMK=0:"Oxidase Negative",RMK=1:"Oxidase Positive",1:"")

 +2        SET O=$EXTRACT(IN,5,6)

           SET V=$EXTRACT(IN,7)

           SET TYPE=$SELECT("12"[V:$ORDER(^LAB(62.4,TSK,7,"B","0E",0)),1:"")

           IF TYPE<1

               QUIT 

 +3        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)

 +4        FOR I2=1:1:13

               SET V=$EXTRACT(IN,(I2*6)+11)

               SET I3=$EXTRACT(IN,16)

               DO MIC0

 +5        QUIT 

MIC0       SET O=$EXTRACT(IN,(I2*6)+15)

           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 

512       ;0E, 5.12, Gram Neg ID card

           SET C=0

           SET U="^"

 +1        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 

 +2        SET RMK=""

           SET CODE=43

           SET FL=$EXTRACT(IN,44)

           DO MSG

           SET CODE=44

           SET FL=$EXTRACT(IN,44)

           DO MSG

           SET CODE=45

           SET FL=$EXTRACT(IN,46)

           DO MSG

           SET CODE=46

           SET FL=$EXTRACT(IN,47)

           DO MSG

           SET CODE=47

           SET FL=$EXTRACT(IN,48)

           DO MSG

 +3        IF '$DATA(ORG(ISOL))

               SET BAD=1

           QUIT 

L2        ;cancel if PROB<80%

           SET ORG(ISOL)=+^LAB(62.4,TSK,7,CARD,1,X1,0)

           SET X=$EXTRACT(IN,I+2,I+3)

           DO PROB

           SET ORG(ISOL,1)=X

           IF X=""!(X<80)

               KILL ORG(ISOL)

 +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 

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