LRMISR1 ; IHS/DIR/FJE - INPUT TRANSFORM FOR ANTIBIOTIC SENSITIVITIES 7/14/87 09:34 ;DEC 09, 2008 8:30 AM
;;5.2;LAB SERVICE;**1013,1025**;NOV 01, 1997
;
;;5.2;LAB SERVICE;;Sep 27, 1994
STAR ;from LRMISR
I $P(X,"*",3,4)["*" K X Q
S LRSCREEN=$P(X,"*",3),LRISR=$P(X,"*",2),X=$P(X,"*") I '$L(X) K X Q
I '$D(^LAB(62.06,C6,1,"B",X))!('$L(LRSCREEN)&'$L(LRISR)) K X Q
S LRBN=+$P(DQ(DQ),U,4) Q:'LRBN I $L(LRISR),'$D(^LAB(62.06,"AJ",$P($P(DQ(DQ),U,4),";"),LRISR)) K X Q
I $L(LRSCREEN),$L(LRSCREEN)'=1!("ARN"'[LRSCREEN) K X Q
I '$L(LRISR) S LRR=X D INTRP
I '$L(LRSCREEN) D SCREEN
I LRSCREEN="A" S LRSCREEN=""
Q
IS ;from LRMISR
D INTRP,SCREEN S:LRISR=X LRISR="" S:LRSCREEN="A" LRSCREEN=""
Q
INTRP ;from LRMISR
S LRISR=$G(^LAB(62.06,"AI",LRBN,LRR)) Q:'$D(LRBG1)!'$D(LRSPEC)!('$L(LRISR))
I $O(^LAB(62.06,"AI",LRBN,LRR,0))="" Q
I $D(^LAB(62.06,"AI",LRBN,LRR,+LRBG1)) S C2=+LRBG1 D SPEC Q
I $P(^LAB(61.2,+LRBG1,0),U,3)="P",$D(^LAB(62.06,"AI",LRBN,LRR,"GRAM POS")) S C2="GRAM POS" D SPEC Q
I $P(^LAB(61.2,+LRBG1,0),U,3)="N",$D(^LAB(62.06,"AI",LRBN,LRR,"GRAM NEG")) S C2="GRAM NEG" D SPEC Q
I $D(^LAB(62.06,"AI",LRBN,LRR,"ANY")) S C2="ANY" D SPEC
Q
SPEC I $D(^LAB(62.06,"AI",LRBN,LRR,C2,LRSPEC)) S C4=LRSPEC D ALT Q
I $D(^LAB(62.06,"AI",LRBN,LRR,C2,"ANY")) S C4="ANY" D ALT
Q
ALT S LRISR=$P(^LAB(62.06,"AI",LRBN,LRR,C2,C4),U)
Q
SCREEN ; S LRSCREEN=^LAB(62.06,"AS",LRBN) Q:'$D(LRBG1)!'$D(LRSPEC)
; ----- BEGIN IHS/OIT/MKK -- LR*5.2*1025 MODIFICATION -- Naked Reference can cause problem
S LRSCREEN=$G(^LAB(62.06,"AS",LRBN))
Q:'$D(LRBG1)!'$D(LRSPEC)
; ----- END IHS/OIT/MKK -- LR*5.2*1025 MODIFICATION
I $O(^LAB(62.06,"AS",LRBN,0))="" Q
I $D(^LAB(62.06,"AS",LRBN,+LRBG1)) S C2=+LRBG1 D SSPEC Q
I $P(^LAB(61.2,+LRBG1,0),U,3)="P",$D(^LAB(62.06,"AS",LRBN,"GRAM POS")) S C2="GRAM POS" D SSPEC Q
I $P(^LAB(61.2,+LRBG1,0),U,3)="N",$D(^LAB(62.06,"AS",LRBN,"GRAM NEG")) S C2="GRAM NEG" D SSPEC Q
I $D(^LAB(62.06,"AS",LRBN,"ANY")) S C2="ANY" D SSPEC
Q
SSPEC I $D(^LAB(62.06,"AS",LRBN,C2,LRSPEC)) S C4=LRSPEC D SALT Q
I $D(^LAB(62.06,"AS",LRBN,C2,"ANY")) S C4="ANY" D SALT
Q
SALT ; S LRSCREEN=^LAB(62.06,"AS",LRBN,C2,C4)
; ----- BEGIN IHS/OIT/MKK -- LR*5.2*1025 MODIFICATION -- Naked Reference can cause problem
S LRSCREEN=$G(^LAB(62.06,"AS",LRBN,C2,C4))
; ----- END IHS/OIT/MKK -- LR*5.2*1025 MODIFICATION
Q
LRMISR1 ; IHS/DIR/FJE - INPUT TRANSFORM FOR ANTIBIOTIC SENSITIVITIES 7/14/87 09:34 ;DEC 09, 2008 8:30 AM
+1 ;;5.2;LAB SERVICE;**1013,1025**;NOV 01, 1997
+2 ;
+3 ;;5.2;LAB SERVICE;;Sep 27, 1994
STAR ;from LRMISR
+1 IF $PIECE(X,"*",3,4)["*"
KILL X
QUIT
+2 SET LRSCREEN=$PIECE(X,"*",3)
SET LRISR=$PIECE(X,"*",2)
SET X=$PIECE(X,"*")
IF '$LENGTH(X)
KILL X
QUIT
+3 IF '$DATA(^LAB(62.06,C6,1,"B",X))!('$LENGTH(LRSCREEN)&'$LENGTH(LRISR))
KILL X
QUIT
+4 SET LRBN=+$PIECE(DQ(DQ),U,4)
IF 'LRBN
QUIT
IF $LENGTH(LRISR)
IF '$DATA(^LAB(62.06,"AJ",$PIECE($PIECE(DQ(DQ),U,4),";"),LRISR))
KILL X
QUIT
+5 IF $LENGTH(LRSCREEN)
IF $LENGTH(LRSCREEN)'=1!("ARN"'[LRSCREEN)
KILL X
QUIT
+6 IF '$LENGTH(LRISR)
SET LRR=X
DO INTRP
+7 IF '$LENGTH(LRSCREEN)
DO SCREEN
+8 IF LRSCREEN="A"
SET LRSCREEN=""
+9 QUIT
IS ;from LRMISR
+1 DO INTRP
DO SCREEN
IF LRISR=X
SET LRISR=""
IF LRSCREEN="A"
SET LRSCREEN=""
+2 QUIT
INTRP ;from LRMISR
+1 SET LRISR=$GET(^LAB(62.06,"AI",LRBN,LRR))
IF '$DATA(LRBG1)!'$DATA(LRSPEC)!('$LENGTH(LRISR))
QUIT
+2 IF $ORDER(^LAB(62.06,"AI",LRBN,LRR,0))=""
QUIT
+3 IF $DATA(^LAB(62.06,"AI",LRBN,LRR,+LRBG1))
SET C2=+LRBG1
DO SPEC
QUIT
+4 IF $PIECE(^LAB(61.2,+LRBG1,0),U,3)="P"
IF $DATA(^LAB(62.06,"AI",LRBN,LRR,"GRAM POS"))
SET C2="GRAM POS"
DO SPEC
QUIT
+5 IF $PIECE(^LAB(61.2,+LRBG1,0),U,3)="N"
IF $DATA(^LAB(62.06,"AI",LRBN,LRR,"GRAM NEG"))
SET C2="GRAM NEG"
DO SPEC
QUIT
+6 IF $DATA(^LAB(62.06,"AI",LRBN,LRR,"ANY"))
SET C2="ANY"
DO SPEC
+7 QUIT
SPEC IF $DATA(^LAB(62.06,"AI",LRBN,LRR,C2,LRSPEC))
SET C4=LRSPEC
DO ALT
QUIT
+1 IF $DATA(^LAB(62.06,"AI",LRBN,LRR,C2,"ANY"))
SET C4="ANY"
DO ALT
+2 QUIT
ALT SET LRISR=$PIECE(^LAB(62.06,"AI",LRBN,LRR,C2,C4),U)
+1 QUIT
SCREEN ; S LRSCREEN=^LAB(62.06,"AS",LRBN) Q:'$D(LRBG1)!'$D(LRSPEC)
+1 ; ----- BEGIN IHS/OIT/MKK -- LR*5.2*1025 MODIFICATION -- Naked Reference can cause problem
+2 SET LRSCREEN=$GET(^LAB(62.06,"AS",LRBN))
+3 IF '$DATA(LRBG1)!'$DATA(LRSPEC)
QUIT
+4 ; ----- END IHS/OIT/MKK -- LR*5.2*1025 MODIFICATION
+5 IF $ORDER(^LAB(62.06,"AS",LRBN,0))=""
QUIT
+6 IF $DATA(^LAB(62.06,"AS",LRBN,+LRBG1))
SET C2=+LRBG1
DO SSPEC
QUIT
+7 IF $PIECE(^LAB(61.2,+LRBG1,0),U,3)="P"
IF $DATA(^LAB(62.06,"AS",LRBN,"GRAM POS"))
SET C2="GRAM POS"
DO SSPEC
QUIT
+8 IF $PIECE(^LAB(61.2,+LRBG1,0),U,3)="N"
IF $DATA(^LAB(62.06,"AS",LRBN,"GRAM NEG"))
SET C2="GRAM NEG"
DO SSPEC
QUIT
+9 IF $DATA(^LAB(62.06,"AS",LRBN,"ANY"))
SET C2="ANY"
DO SSPEC
+10 QUIT
SSPEC IF $DATA(^LAB(62.06,"AS",LRBN,C2,LRSPEC))
SET C4=LRSPEC
DO SALT
QUIT
+1 IF $DATA(^LAB(62.06,"AS",LRBN,C2,"ANY"))
SET C4="ANY"
DO SALT
+2 QUIT
SALT ; S LRSCREEN=^LAB(62.06,"AS",LRBN,C2,C4)
+1 ; ----- BEGIN IHS/OIT/MKK -- LR*5.2*1025 MODIFICATION -- Naked Reference can cause problem
+2 SET LRSCREEN=$GET(^LAB(62.06,"AS",LRBN,C2,C4))
+3 ; ----- END IHS/OIT/MKK -- LR*5.2*1025 MODIFICATION
+4 QUIT
