- 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
