LRMIPSZ2 ;AVAMC/REG/SLC/CJS/BA - MICRO PATIENT REPORT - BACTERIA, SIC/SBC, MIC ;3/28/90 15:23 ;
;;5.2;LAB SERVICE;**1013,1033,388,1039**;Sep 27, 1994;Build 32
ANTI ;from LRMIPSZ1
; I $P(^LR(LRDFN,"MI",LRIDT,14,0),U,4)>0 W !!,?28,"Antibiotic Level(s):",!,"ANTIBIOTIC",?20,"CONC RANGE (ug/ml)",?42,"DRAW TIME"
; I S B=0 F I=0:0 S B=$O(^LR(LRDFN,"MI",LRIDT,14,B)) Q:B<1 W !,$P(^LR(LRDFN,"MI",LRIDT,14,B,0),U),?20,$P(^(0),U,3),?42,$$EXTERNAL^DILFD(63.42,1,"",$P(^(0),U,2))
; ----- BEGIN IHS/MSC/MKK - LR*5.2*1033
I $P($G(^LR(LRDFN,"MI",LRIDT,14,0)),U,4)>0 D
. NEW STR,RESULTDT,REFLAB
. W !,?28,"Antibiotic Level(s):"
. W !?20,"CONC"
. W !?20,"RANGE",?29,"DRAW"
. W !,"ANTIBIOTIC",?19,"(ug/ml)",?29,"TIME",?39,"RESULT DATE",?57,"REF LAB"
. S B=0
. F S B=$O(^LR(LRDFN,"MI",LRIDT,14,B)) Q:B<1 D
.. S STR=$G(^LR(LRDFN,"MI",LRIDT,14,B,0))
.. S RESULTDT=$P(STR,"^",9)
.. S REFLAB=$P(STR,"^",10)
.. S:$L(REFLAB) LRPLS(REFLAB)=""
.. W !,$E($P(STR,U),1,18)
.. W ?19,$P(STR,U,3)
.. W ?29,$S($P(STR,U,2)="P":"PEAK",$P(STR,U,2)="T":"TROUGH",1:"")
.. W ?39,$$FMTE^XLFDT(RESULTDT,"5MZ")
.. W ?57,$E($S(+REFLAB:$$GET1^DIQ(4,REFLAB,"NAME"),1:""),1,23)
Q
BACT ;from LRMIPSZ1
I '$L($P(^LR(LRDFN,"MI",LRIDT,1),U)) Q:'$D(LRWRDVEW) Q:LRSB'=1
D BUG
I $D(^LR(LRDFN,"MI",LRIDT,2,0)) D FH^LRMIPSU Q:LREND D GRAM
I $D(^LR(LRDFN,"MI",LRIDT,25,0)) D FH^LRMIPSU Q:LREND D BSMEAR
I $D(^LR(LRDFN,"MI",LRIDT,3,0)) D FH^LRMIPSU Q:LREND D BRMK Q:LREND D BACT^LRMIPSZ5 Q:LREND
I $D(^LR(LRDFN,"MI",LRIDT,4,0)),$P(^(0),U,4)>0 D FH^LRMIPSU Q:LREND W:LRHC ! W !,"Bacteriology Remark(s):" S B=0 F I=0:0 S B=+$O(^LR(LRDFN,"MI",LRIDT,4,B)) Q:B<1 W !,?3,^LR(LRDFN,"MI",LRIDT,4,B,0)
Q
BUG S LRTUS=$P(^LR(LRDFN,"MI",LRIDT,1),U,2),DZ=$P(^(1),U,3),LRUS=$P(^(1),U,6),LRNS=$P(^(1),U,5),Y=$P(^(1),U) D D^LRU
D:$Y>(IOSL-LRFLIP) WAIT^LRMIPSU Q:LREND
; W:LRHC ! W !,"* BACTERIOLOGY ",$S(LRTUS="F":"FINAL",LRTUS="P":"PRELIMINARY",1:"")," REPORT => "_Y_" TECH CODE: "_DZ
W:LRHC ! W "* BACTERIOLOGY ",$S(LRTUS="F":"FINAL",LRTUS="P":"PRELIMINARY",1:"")," REPORT => "_Y_" TECH CODE: "_DZ ; IHS/ANMC/CLS 08/18/96
S LRPRE=19 D PRE^LRMIPSU
I $L(LRUS) W !,"URINE SCREEN: "_$S(LRUS="N":"Negative",LRUS="P":"Positive",1:LRUS) W:LRHC !
I $L(LRNS) W !,"SPUTUM SCREEN: ",LRNS W:LRHC !
Q
GRAM W !,"GRAM STAIN:" S LRGRM=0 F I=0:0 S LRGRM=+$O(^LR(LRDFN,"MI",LRIDT,2,LRGRM)) Q:LRGRM<1 W ?14,^(LRGRM,0),!
W:LRHC !
Q
BSMEAR W !,"BACTERIOLOGY SMEAR/PREP:",! S LRMYC=0 F I=0:0 S LRMYC=+$O(^LR(LRDFN,"MI",LRIDT,25,LRMYC)) Q:LRMYC<1 W ?5,^(LRMYC,0),!
Q
BRMK S (LRBUG,LR2ORMOR)=0 F LRAX=1,2 S LRBUG=+$O(^LR(LRDFN,"MI",LRIDT,3,LRBUG)) Q:LRBUG<1 S:LRAX=2 LR2ORMOR=1
I LRAX'=1 S (LRBUG,LRTSTS)=0 F LRAX=1:1 S LRBUG=+$O(^LR(LRDFN,"MI",LRIDT,3,LRBUG)) Q:LRBUG<1 D LST
Q
LST S (LRBUG(LRAX),LRORG)=$P(^LR(LRDFN,"MI",LRIDT,3,LRBUG,0),U),LRQU=$P(^(0),U,2),LRSSD=$P(^(0),U,3,8),LRORG=$P(^LAB(61.2,LRORG,0),U)
I LRSSD'?."^" S LRSIC1=$P(LRSSD,U),LRSBC1=$P(LRSSD,U,2),LRDRTM1=$P(LRSSD,U,3),LRSIC2=$P(LRSSD,U,4),LRSBC2=$P(LRSSD,U,5),LRDRTM2=$P(LRSSD,U,6),LRSSD=1
W:LRHC ! W:LRAX=1 !,"CULTURE RESULTS:" W:LRAX>1 ! W ?17,$S(LR2ORMOR:LRBUG_". ",1:""),LRQU,LRORG
I LRSSD D FH^LRMIPSU Q:LREND D SSD W:LRHC !
S:$D(^LR(LRDFN,"MI",LRIDT,3,LRBUG,2)) LRTSTS=LRTSTS+1 I $D(^LR(LRDFN,"MI",LRIDT,3,LRBUG,3,0)),$P(^(0),U,4)>0 D MIC
I $D(^LR(LRDFN,"MI",LRIDT,3,LRBUG,1,0)),$P(^(0),U,4)>0 D CMNT
Q
SSD W ! S LRDRTM1=$S(LRDRTM1="P":"PEAK",LRDRTM1="T":"TROUGH",1:LRDRTM1),LRDRTM2=$S(LRDRTM2="P":"PEAK",LRDRTM2="T":"TROUGH",1:LRDRTM2)
I $L(LRSIC1) W !,?20,"SIT " W:$L(LRDRTM1) "(",LRDRTM1,")" W ": ",LRSIC1
I $L(LRSBC1) W !,?20,"SBT " W:$L(LRDRTM1) "(",LRDRTM1,")" W ": ",LRSBC1
I $L(LRSIC2) W !,?20,"SIT " W:$L(LRDRTM2) "(",LRDRTM2,")" W ": ",LRSIC2
I $L(LRSBC2) W !,?20,"SBT " W:$L(LRDRTM2) "(",LRDRTM2,")" W ": ",LRSBC2
Q
MIC W !,?18,"Antibiotic" S B=0 F I=0:0 S B=+$O(^LR(LRDFN,"MI",LRIDT,3,LRBUG,3,B)) Q:B<1 I $L($P(^(B,0),U,2,3))>0 W ?35,"MIC (ug/ml)",?50,"MBC (ug/ml)" Q
S B=0 F I=0:0 S B=+$O(^LR(LRDFN,"MI",LRIDT,3,LRBUG,3,B)) Q:B<1 W !,?18,$P(^(B,0),U),?35,$J($P(^(0),U,2),7),?50,$J($P(^(0),U,3),7)
Q
CMNT S LRPC=0 F A=0:1 S LRPC=+$O(^LR(LRDFN,"MI",LRIDT,3,LRBUG,1,LRPC)) Q:LRPC<1 W !?20 W:A=0 "Comment: " W ?29,^(LRPC,0)
Q
LRMIPSZ2 ;AVAMC/REG/SLC/CJS/BA - MICRO PATIENT REPORT - BACTERIA, SIC/SBC, MIC ;3/28/90 15:23 ;
+1 ;;5.2;LAB SERVICE;**1013,1033,388,1039**;Sep 27, 1994;Build 32
ANTI ;from LRMIPSZ1
+1 ; I $P(^LR(LRDFN,"MI",LRIDT,14,0),U,4)>0 W !!,?28,"Antibiotic Level(s):",!,"ANTIBIOTIC",?20,"CONC RANGE (ug/ml)",?42,"DRAW TIME"
+2 ; I S B=0 F I=0:0 S B=$O(^LR(LRDFN,"MI",LRIDT,14,B)) Q:B<1 W !,$P(^LR(LRDFN,"MI",LRIDT,14,B,0),U),?20,$P(^(0),U,3),?42,$$EXTERNAL^DILFD(63.42,1,"",$P(^(0),U,2))
+3 ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1033
+4 IF $PIECE($GET(^LR(LRDFN,"MI",LRIDT,14,0)),U,4)>0
Begin DoDot:1
+5 NEW STR,RESULTDT,REFLAB
+6 WRITE !,?28,"Antibiotic Level(s):"
+7 WRITE !?20,"CONC"
+8 WRITE !?20,"RANGE",?29,"DRAW"
+9 WRITE !,"ANTIBIOTIC",?19,"(ug/ml)",?29,"TIME",?39,"RESULT DATE",?57,"REF LAB"
+10 SET B=0
+11 FOR
SET B=$ORDER(^LR(LRDFN,"MI",LRIDT,14,B))
IF B<1
QUIT
Begin DoDot:2
+12 SET STR=$GET(^LR(LRDFN,"MI",LRIDT,14,B,0))
+13 SET RESULTDT=$PIECE(STR,"^",9)
+14 SET REFLAB=$PIECE(STR,"^",10)
+15 IF $LENGTH(REFLAB)
SET LRPLS(REFLAB)=""
+16 WRITE !,$EXTRACT($PIECE(STR,U),1,18)
+17 WRITE ?19,$PIECE(STR,U,3)
+18 WRITE ?29,$SELECT($PIECE(STR,U,2)="P":"PEAK",$PIECE(STR,U,2)="T":"TROUGH",1:"")
+19 WRITE ?39,$$FMTE^XLFDT(RESULTDT,"5MZ")
+20 WRITE ?57,$EXTRACT($SELECT(+REFLAB:$$GET1^DIQ(4,REFLAB,"NAME"),1:""),1,23)
End DoDot:2
End DoDot:1
+21 QUIT
BACT ;from LRMIPSZ1
+1 IF '$LENGTH($PIECE(^LR(LRDFN,"MI",LRIDT,1),U))
IF '$DATA(LRWRDVEW)
QUIT
IF LRSB'=1
QUIT
+2 DO BUG
+3 IF $DATA(^LR(LRDFN,"MI",LRIDT,2,0))
DO FH^LRMIPSU
IF LREND
QUIT
DO GRAM
+4 IF $DATA(^LR(LRDFN,"MI",LRIDT,25,0))
DO FH^LRMIPSU
IF LREND
QUIT
DO BSMEAR
+5 IF $DATA(^LR(LRDFN,"MI",LRIDT,3,0))
DO FH^LRMIPSU
IF LREND
QUIT
DO BRMK
IF LREND
QUIT
DO BACT^LRMIPSZ5
IF LREND
QUIT
+6 IF $DATA(^LR(LRDFN,"MI",LRIDT,4,0))
IF $PIECE(^(0),U,4)>0
DO FH^LRMIPSU
IF LREND
QUIT
IF LRHC
WRITE !
WRITE !,"Bacteriology Remark(s):"
SET B=0
FOR I=0:0
SET B=+$ORDER(^LR(LRDFN,"MI",LRIDT,4,B))
IF B<1
QUIT
WRITE !,?3,^LR(LRDFN,"MI",LRIDT,4,B,0)
+7 QUIT
BUG SET LRTUS=$PIECE(^LR(LRDFN,"MI",LRIDT,1),U,2)
SET DZ=$PIECE(^(1),U,3)
SET LRUS=$PIECE(^(1),U,6)
SET LRNS=$PIECE(^(1),U,5)
SET Y=$PIECE(^(1),U)
DO D^LRU
+1 IF $Y>(IOSL-LRFLIP)
DO WAIT^LRMIPSU
IF LREND
QUIT
+2 ; W:LRHC ! W !,"* BACTERIOLOGY ",$S(LRTUS="F":"FINAL",LRTUS="P":"PRELIMINARY",1:"")," REPORT => "_Y_" TECH CODE: "_DZ
+3 ; IHS/ANMC/CLS 08/18/96
IF LRHC
WRITE !
WRITE "* BACTERIOLOGY ",$SELECT(LRTUS="F":"FINAL",LRTUS="P":"PRELIMINARY",1:"")," REPORT => "_Y_" TECH CODE: "_DZ
+4 SET LRPRE=19
DO PRE^LRMIPSU
+5 IF $LENGTH(LRUS)
WRITE !,"URINE SCREEN: "_$SELECT(LRUS="N":"Negative",LRUS="P":"Positive",1:LRUS)
IF LRHC
WRITE !
+6 IF $LENGTH(LRNS)
WRITE !,"SPUTUM SCREEN: ",LRNS
IF LRHC
WRITE !
+7 QUIT
GRAM WRITE !,"GRAM STAIN:"
SET LRGRM=0
FOR I=0:0
SET LRGRM=+$ORDER(^LR(LRDFN,"MI",LRIDT,2,LRGRM))
IF LRGRM<1
QUIT
WRITE ?14,^(LRGRM,0),!
+1 IF LRHC
WRITE !
+2 QUIT
BSMEAR WRITE !,"BACTERIOLOGY SMEAR/PREP:",!
SET LRMYC=0
FOR I=0:0
SET LRMYC=+$ORDER(^LR(LRDFN,"MI",LRIDT,25,LRMYC))
IF LRMYC<1
QUIT
WRITE ?5,^(LRMYC,0),!
+1 QUIT
BRMK SET (LRBUG,LR2ORMOR)=0
FOR LRAX=1,2
SET LRBUG=+$ORDER(^LR(LRDFN,"MI",LRIDT,3,LRBUG))
IF LRBUG<1
QUIT
IF LRAX=2
SET LR2ORMOR=1
+1 IF LRAX'=1
SET (LRBUG,LRTSTS)=0
FOR LRAX=1:1
SET LRBUG=+$ORDER(^LR(LRDFN,"MI",LRIDT,3,LRBUG))
IF LRBUG<1
QUIT
DO LST
+2 QUIT
LST SET (LRBUG(LRAX),LRORG)=$PIECE(^LR(LRDFN,"MI",LRIDT,3,LRBUG,0),U)
SET LRQU=$PIECE(^(0),U,2)
SET LRSSD=$PIECE(^(0),U,3,8)
SET LRORG=$PIECE(^LAB(61.2,LRORG,0),U)
+1 IF LRSSD'?."^"
SET LRSIC1=$PIECE(LRSSD,U)
SET LRSBC1=$PIECE(LRSSD,U,2)
SET LRDRTM1=$PIECE(LRSSD,U,3)
SET LRSIC2=$PIECE(LRSSD,U,4)
SET LRSBC2=$PIECE(LRSSD,U,5)
SET LRDRTM2=$PIECE(LRSSD,U,6)
SET LRSSD=1
+2 IF LRHC
WRITE !
IF LRAX=1
WRITE !,"CULTURE RESULTS:"
IF LRAX>1
WRITE !
WRITE ?17,$SELECT(LR2ORMOR:LRBUG_". ",1:""),LRQU,LRORG
+3 IF LRSSD
DO FH^LRMIPSU
IF LREND
QUIT
DO SSD
IF LRHC
WRITE !
+4 IF $DATA(^LR(LRDFN,"MI",LRIDT,3,LRBUG,2))
SET LRTSTS=LRTSTS+1
IF $DATA(^LR(LRDFN,"MI",LRIDT,3,LRBUG,3,0))
IF $PIECE(^(0),U,4)>0
DO MIC
+5 IF $DATA(^LR(LRDFN,"MI",LRIDT,3,LRBUG,1,0))
IF $PIECE(^(0),U,4)>0
DO CMNT
+6 QUIT
SSD WRITE !
SET LRDRTM1=$SELECT(LRDRTM1="P":"PEAK",LRDRTM1="T":"TROUGH",1:LRDRTM1)
SET LRDRTM2=$SELECT(LRDRTM2="P":"PEAK",LRDRTM2="T":"TROUGH",1:LRDRTM2)
+1 IF $LENGTH(LRSIC1)
WRITE !,?20,"SIT "
IF $LENGTH(LRDRTM1)
WRITE "(",LRDRTM1,")"
WRITE ": ",LRSIC1
+2 IF $LENGTH(LRSBC1)
WRITE !,?20,"SBT "
IF $LENGTH(LRDRTM1)
WRITE "(",LRDRTM1,")"
WRITE ": ",LRSBC1
+3 IF $LENGTH(LRSIC2)
WRITE !,?20,"SIT "
IF $LENGTH(LRDRTM2)
WRITE "(",LRDRTM2,")"
WRITE ": ",LRSIC2
+4 IF $LENGTH(LRSBC2)
WRITE !,?20,"SBT "
IF $LENGTH(LRDRTM2)
WRITE "(",LRDRTM2,")"
WRITE ": ",LRSBC2
+5 QUIT
MIC WRITE !,?18,"Antibiotic"
SET B=0
FOR I=0:0
SET B=+$ORDER(^LR(LRDFN,"MI",LRIDT,3,LRBUG,3,B))
IF B<1
QUIT
IF $LENGTH($PIECE(^(B,0),U,2,3))>0
WRITE ?35,"MIC (ug/ml)",?50,"MBC (ug/ml)"
QUIT
+1 SET B=0
FOR I=0:0
SET B=+$ORDER(^LR(LRDFN,"MI",LRIDT,3,LRBUG,3,B))
IF B<1
QUIT
WRITE !,?18,$PIECE(^(B,0),U),?35,$JUSTIFY($PIECE(^(0),U,2),7),?50,$JUSTIFY($PIECE(^(0),U,3),7)
+2 QUIT
CMNT SET LRPC=0
FOR A=0:1
SET LRPC=+$ORDER(^LR(LRDFN,"MI",LRIDT,3,LRBUG,1,LRPC))
IF LRPC<1
QUIT
WRITE !?20
IF A=0
WRITE "Comment: "
WRITE ?29,^(LRPC,0)
+1 QUIT
