36 lines
2.1 KiB
Mathematica
36 lines
2.1 KiB
Mathematica
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
|