- LRMISR ;SLC/CJS/BA - INPUT TRANSFORM FOR ANTIBIOTIC SENSITIVITIES ;6/14/89 08:36 ;
- ;;5.2;LAB SERVICE;;Sep 27, 1994
- ;input transform for antibiotics
- FILE I $L(X)>20!($L(X)<1) K X Q
- S C6=+$O(^LAB(62.06,"C",$P(DQ(DQ),U),0)) I X["*" D STAR^LRMISR1 D @$S($D(X):"SET",1:"OUT") Q
- I '$D(^LAB(62.06,C6,1,"B",X)) K X,C6 Q
- S LRBN=+$P(DQ(DQ),U,4) I 'LRBN K C6,LRBN Q
- S LRR=X D IS^LRMISR1
- SET S $P(^LR(LRDFN,"MI",DA(1),3,DA,LRBN),U,2)=LRISR,$P(^(LRBN),U,3)=LRSCREEN W:$L(LRISR) " (",LRISR,")" I $L(LRSCREEN) W $S(LRSCREEN="N":" (not displayed)",LRSCREEN="R":" (restricted display)",1:"")
- OUT K C6,C4,C2,LRBN,LRR,LRISR,LRSCREEN
- Q
- EN ;help prompts for antibiotic interpretations
- S LRBN=+$P(DQ(DQ),U,4) Q:'LRBN S C8=$S($D(^LR(LRDFN,"MI",LRIDT,3,DA,LRBN))#2:^(LRBN),1:"")
- I $L($P(C8,U)) W !,"Result: ",$P(C8,U),?25,"Interpretation: ",$S($L($P(C8,U,2)):$P(C8,U,2),1:$P(C8,U)),?53,"Screen: ",$S($P(C8,U,3)="N":"Never",$P(C8,U,3)="R":"Restricted",1:"Always")," Display",!
- S C6=+$O(^LAB(62.06,"C",$P(DQ(DQ),U),0)) W !,"CHOOSE FROM:"
- S LRR="" F A6=0:1 S LRR=$O(^LAB(62.06,C6,1,"B",LRR)) Q:LRR="" S C4=+$O(^(LRR,0)) D INTRP^LRMISR1 W ?15,LRR,?24,$S('A6:" FOR: ",1:" "),?32,LRISR,! K C2,C4,LRISR
- K A6,C6,C8,LRBN,LRR
- Q
- HELP S XQH="LRHM LRMIEDZ Example1" H 1 D EN^XQH K X
- Q
- INT I '$D(^LAB(62.06,"AJ",$P($P(DQ(DQ),U,4),";"),X)) K X
- Q
- HINT W !,"Interpretations for this antibiotic:" S J=0 F I=0:0 S J=$O(^LAB(62.06,"AJ",$P($P(DQ(DQ),U,4),";"),J)) Q:J="" W !,?25,J
- Q
- COM ;input transform for AFB antibiotics - will expand lab descriptions
- I $L(X)>20!($L(X)<1)!(X'?.ANP) K X Q
- S B3="" F A6=1:1 Q:$P(X," ",A6,99)="" S B6=$P(X," ",A6) D:B6]"" Z2 S A4=$L(B3)+$L(B6) S:A4'>68 B3=B3_B6_" " I A4>68 W " too long",! K X Q
- W " (",$E(B3,1,$L(B3)-1),")" S X=B3 K A4,A6,B3,B6
- Q
- Z2 S A2=0 F I=0:0 S A2=$O(^LAB(62.5,"B",B6,A2)) Q:A2<1 I "KMTVP"[$P(^LAB(62.5,A2,0),U,4) S B6=$P(^LAB(62.5,A2,0),U,2) Q:'$D(^(9)) S B4=$P(X," ",A6-1),B4=$E(B4,$L(B4)) S:B4>1 B6=^(9) Q
- K A2,B4
- Q
- ZQ ;AFB prompts from lab descriptions
- S X=$S(X="??":"??",1:"?"),DIC="^LAB(62.5,",DIC(0)="Q",DIC("S")="I ""KMTVP""[$P(^(0),U,4)",D="B",DZ=X K DO D DQ^DICQ K DIC S DIC=DIE D DO^DIC1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRMISR 2187 printed Feb 18, 2025@23:43:17 Page 2
- LRMISR ;SLC/CJS/BA - INPUT TRANSFORM FOR ANTIBIOTIC SENSITIVITIES ;6/14/89 08:36 ;
- +1 ;;5.2;LAB SERVICE;;Sep 27, 1994
- +2 ;input transform for antibiotics
- FILE IF $LENGTH(X)>20!($LENGTH(X)<1)
- KILL X
- QUIT
- +1 SET C6=+$ORDER(^LAB(62.06,"C",$PIECE(DQ(DQ),U),0))
- IF X["*"
- DO STAR^LRMISR1
- DO @$SELECT($DATA(X):"SET",1:"OUT")
- QUIT
- +2 IF '$DATA(^LAB(62.06,C6,1,"B",X))
- KILL X,C6
- QUIT
- +3 SET LRBN=+$PIECE(DQ(DQ),U,4)
- IF 'LRBN
- KILL C6,LRBN
- QUIT
- +4 SET LRR=X
- DO IS^LRMISR1
- SET SET $PIECE(^LR(LRDFN,"MI",DA(1),3,DA,LRBN),U,2)=LRISR
- SET $PIECE(^(LRBN),U,3)=LRSCREEN
- if $LENGTH(LRISR)
- WRITE " (",LRISR,")"
- IF $LENGTH(LRSCREEN)
- WRITE $SELECT(LRSCREEN="N":" (not displayed)",LRSCREEN="R":" (restricted display)",1:"")
- OUT KILL C6,C4,C2,LRBN,LRR,LRISR,LRSCREEN
- +1 QUIT
- EN ;help prompts for antibiotic interpretations
- +1 SET LRBN=+$PIECE(DQ(DQ),U,4)
- if 'LRBN
- QUIT
- SET C8=$SELECT($DATA(^LR(LRDFN,"MI",LRIDT,3,DA,LRBN))#2:^(LRBN),1:"")
- +2 IF $LENGTH($PIECE(C8,U))
- WRITE !,"Result: ",$PIECE(C8,U),?25,"Interpretation: ",$SELECT($LENGTH($PIECE(C8,U,2)):$PIECE(C8,U,2),1:$PIECE(C8,U)),?53,"Screen: ",$SELECT($PIECE(C8,U,3)="N":"Never",$PIECE(C8,U,3)="R":"Restricted",1:"Always")," Display",!
- +3 SET C6=+$ORDER(^LAB(62.06,"C",$PIECE(DQ(DQ),U),0))
- WRITE !,"CHOOSE FROM:"
- +4 SET LRR=""
- FOR A6=0:1
- SET LRR=$ORDER(^LAB(62.06,C6,1,"B",LRR))
- if LRR=""
- QUIT
- SET C4=+$ORDER(^(LRR,0))
- DO INTRP^LRMISR1
- WRITE ?15,LRR,?24,$SELECT('A6:" FOR: ",1:" "),?32,LRISR,!
- KILL C2,C4,LRISR
- +5 KILL A6,C6,C8,LRBN,LRR
- +6 QUIT
- HELP SET XQH="LRHM LRMIEDZ Example1"
- HANG 1
- DO EN^XQH
- KILL X
- +1 QUIT
- INT IF '$DATA(^LAB(62.06,"AJ",$PIECE($PIECE(DQ(DQ),U,4),";"),X))
- KILL X
- +1 QUIT
- HINT WRITE !,"Interpretations for this antibiotic:"
- SET J=0
- FOR I=0:0
- SET J=$ORDER(^LAB(62.06,"AJ",$PIECE($PIECE(DQ(DQ),U,4),";"),J))
- if J=""
- QUIT
- WRITE !,?25,J
- +1 QUIT
- COM ;input transform for AFB antibiotics - will expand lab descriptions
- +1 IF $LENGTH(X)>20!($LENGTH(X)<1)!(X'?.ANP)
- KILL X
- QUIT
- +2 SET B3=""
- FOR A6=1:1
- if $PIECE(X," ",A6,99)=""
- QUIT
- SET B6=$PIECE(X," ",A6)
- if B6]""
- DO Z2
- SET A4=$LENGTH(B3)+$LENGTH(B6)
- if A4'>68
- SET B3=B3_B6_" "
- IF A4>68
- WRITE " too long",!
- KILL X
- QUIT
- +3 WRITE " (",$EXTRACT(B3,1,$LENGTH(B3)-1),")"
- SET X=B3
- KILL A4,A6,B3,B6
- +4 QUIT
- Z2 SET A2=0
- FOR I=0:0
- SET A2=$ORDER(^LAB(62.5,"B",B6,A2))
- if A2<1
- QUIT
- IF "KMTVP"[$PIECE(^LAB(62.5,A2,0),U,4)
- SET B6=$PIECE(^LAB(62.5,A2,0),U,2)
- if '$DATA(^(9))
- QUIT
- SET B4=$PIECE(X," ",A6-1)
- SET B4=$EXTRACT(B4,$LENGTH(B4))
- if B4>1
- SET B6=^(9)
- QUIT
- +1 KILL A2,B4
- +2 QUIT
- ZQ ;AFB prompts from lab descriptions
- +1 SET X=$SELECT(X="??":"??",1:"?")
- SET DIC="^LAB(62.5,"
- SET DIC(0)="Q"
- SET DIC("S")="I ""KMTVP""[$P(^(0),U,4)"
- SET D="B"
- SET DZ=X
- KILL DO
- DO DQ^DICQ
- KILL DIC
- SET DIC=DIE
- DO DO^DIC1
- +2 QUIT