| [613] | 1 | LRMISR ;SLC/CJS/BA - INPUT TRANSFORM FOR ANTIBIOTIC SENSITIVITIES ;6/14/89 08:36 ;
|
|---|
| 2 | ;;5.2;LAB SERVICE;;Sep 27, 1994
|
|---|
| 3 | ;input transform for antibiotics
|
|---|
| 4 | FILE I $L(X)>20!($L(X)<1) K X Q
|
|---|
| 5 | 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
|
|---|
| 6 | I '$D(^LAB(62.06,C6,1,"B",X)) K X,C6 Q
|
|---|
| 7 | S LRBN=+$P(DQ(DQ),U,4) I 'LRBN K C6,LRBN Q
|
|---|
| 8 | S LRR=X D IS^LRMISR1
|
|---|
| 9 | 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:"")
|
|---|
| 10 | OUT K C6,C4,C2,LRBN,LRR,LRISR,LRSCREEN
|
|---|
| 11 | Q
|
|---|
| 12 | EN ;help prompts for antibiotic interpretations
|
|---|
| 13 | S LRBN=+$P(DQ(DQ),U,4) Q:'LRBN S C8=$S($D(^LR(LRDFN,"MI",LRIDT,3,DA,LRBN))#2:^(LRBN),1:"")
|
|---|
| 14 | 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",!
|
|---|
| 15 | S C6=+$O(^LAB(62.06,"C",$P(DQ(DQ),U),0)) W !,"CHOOSE FROM:"
|
|---|
| 16 | 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
|
|---|
| 17 | K A6,C6,C8,LRBN,LRR
|
|---|
| 18 | Q
|
|---|
| 19 | HELP S XQH="LRHM LRMIEDZ Example1" H 1 D EN^XQH K X
|
|---|
| 20 | Q
|
|---|
| 21 | INT I '$D(^LAB(62.06,"AJ",$P($P(DQ(DQ),U,4),";"),X)) K X
|
|---|
| 22 | Q
|
|---|
| 23 | 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
|
|---|
| 24 | Q
|
|---|
| 25 | COM ;input transform for AFB antibiotics - will expand lab descriptions
|
|---|
| 26 | I $L(X)>20!($L(X)<1)!(X'?.ANP) K X Q
|
|---|
| 27 | 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
|
|---|
| 28 | W " (",$E(B3,1,$L(B3)-1),")" S X=B3 K A4,A6,B3,B6
|
|---|
| 29 | Q
|
|---|
| 30 | 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
|
|---|
| 31 | K A2,B4
|
|---|
| 32 | Q
|
|---|
| 33 | ZQ ;AFB prompts from lab descriptions
|
|---|
| 34 | 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
|
|---|
| 35 | Q
|
|---|
