LRMISR1 ;DALOI/STAFF - INPUT TRANSFORM FOR ANTIBIOTIC SENSITIVITIES ;Sep 23, 2008
;;5.2;LAB SERVICE;**350**;Sep 27, 1994;Build 230
;
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))!(LRSCREEN=""&LRISR="") K X Q
S LRBN=+$P(DQ(DQ),U,4) Q:'LRBN
I LRISR'="",'$D(^LAB(62.06,"AJ",$P($P(DQ(DQ),U,4),";"),LRISR)) K X Q
I LRSCREEN'="",LRSCREEN'?1(1"A",1"R",1"N") K X Q
I LRISR="" S LRR=X D INTRP
I LRSCREEN="" D SCREEN
Q
;
;
IS ; from LRMISR
D INTRP,SCREEN
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)
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)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRMISR1 1895 printed Dec 13, 2024@02:17:26 Page 2
LRMISR1 ;DALOI/STAFF - INPUT TRANSFORM FOR ANTIBIOTIC SENSITIVITIES ;Sep 23, 2008
+1 ;;5.2;LAB SERVICE;**350**;Sep 27, 1994;Build 230
+2 ;
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))!(LRSCREEN=""&LRISR="")
KILL X
QUIT
+4 SET LRBN=+$PIECE(DQ(DQ),U,4)
if 'LRBN
QUIT
+5 IF LRISR'=""
IF '$DATA(^LAB(62.06,"AJ",$PIECE($PIECE(DQ(DQ),U,4),";"),LRISR))
KILL X
QUIT
+6 IF LRSCREEN'=""
IF LRSCREEN'?1(1"A",1"R",1"N")
KILL X
QUIT
+7 IF LRISR=""
SET LRR=X
DO INTRP
+8 IF LRSCREEN=""
DO SCREEN
+9 QUIT
+10 ;
+11 ;
IS ; from LRMISR
+1 DO INTRP
DO SCREEN
+2 QUIT
+3 ;
+4 ;
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
+8 ;
+9 ;
SPEC ;
+1 IF $DATA(^LAB(62.06,"AI",LRBN,LRR,C2,LRSPEC))
SET C4=LRSPEC
DO ALT
QUIT
+2 IF $DATA(^LAB(62.06,"AI",LRBN,LRR,C2,"ANY"))
SET C4="ANY"
DO ALT
+3 QUIT
+4 ;
+5 ;
ALT ;
+1 SET LRISR=$PIECE(^LAB(62.06,"AI",LRBN,LRR,C2,C4),U)
+2 QUIT
+3 ;
+4 ;
SCREEN ;
+1 SET LRSCREEN=^LAB(62.06,"AS",LRBN)
if '$DATA(LRBG1)!'$DATA(LRSPEC)
QUIT
+2 IF $ORDER(^LAB(62.06,"AS",LRBN,0))=""
QUIT
+3 IF $DATA(^LAB(62.06,"AS",LRBN,+LRBG1))
SET C2=+LRBG1
DO SSPEC
QUIT
+4 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
+5 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
+6 IF $DATA(^LAB(62.06,"AS",LRBN,"ANY"))
SET C2="ANY"
DO SSPEC
+7 QUIT
+8 ;
+9 ;
SSPEC ;
+1 IF $DATA(^LAB(62.06,"AS",LRBN,C2,LRSPEC))
SET C4=LRSPEC
DO SALT
QUIT
+2 IF $DATA(^LAB(62.06,"AS",LRBN,C2,"ANY"))
SET C4="ANY"
DO SALT
+3 QUIT
+4 ;
+5 ;
SALT ;
+1 SET LRSCREEN=^LAB(62.06,"AS",LRBN,C2,C4)
+2 QUIT
