GMTSLRM ; SLC/JER,KER - Microbiology Component Driver ; 09/21/2001
;;2.7;Health Summary;**28,47**;Oct 20, 1995
;
; External References
; DBIA 525 ^LR( all fields
; DBIA 10035 ^DPT( field 63 Read w/Fileman
; DBIA 2056 $$GET1^DIQ (file 2)
;
MAIN ; Microbiology
N IX0,IX,LRDFN,MAX,D1,D2,D3
S LRDFN=+($$GET1^DIQ(2,(+($G(DFN))_","),63,"I")) Q:+LRDFN=0 Q:'$D(^LR(LRDFN))
Q:+($S('$D(^LR(LRDFN,"MI",0)):1,'$O(^LR(LRDFN,"MI",GMTS1)):1,$O(^(GMTS1))>GMTS2:1,1:0))
S MAX=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:999),IX=GMTS1
F IX0=1:1:MAX S IX=$O(^LR(LRDFN,"MI",IX)) Q:+IX'>0!(IX>GMTS2)!$D(GMTSQIT) D CKP^GMTSUP Q:$D(GMTSQIT) D Q:$D(GMTSQIT)
. D ^GMTSLRME I $D(^TMP("LRM",$J)) D:IX0>1 CKP^GMTSUP Q:$D(GMTSQIT) W:IX0>1 ! D INTRP
. K ^TMP("LRM",$J)
Q
INTRP ; Interprets ^TMP("LRM",$J
N GMZ,GMK S (GMZ,GMK)=""
F S GMZ=$O(^TMP("LRM",$J,GMZ)) Q:GMZ="" D RDNODE Q:$D(GMTSQIT)
Q
RDNODE ; Reads current node of ^TMP("LRM",$J
N GMABX,COM S GMABX=0 I GMZ=0 D Q
. D CKP^GMTSUP Q:$D(GMTSQIT) W ?10,"Collected:",?21,$P(^TMP("LRM",$J,GMZ),U),?43,"Acc:",?48,$P(^TMP("LRM",$J,GMZ),U,2),!
. I $P(^TMP("LRM",$J,GMZ),U,6)'=$P(^(GMZ),U,3) D
. . D CKP^GMTSUP Q:$D(GMTSQIT) W ?2,"Collection Sample:",?21,$P(^TMP("LRM",$J,GMZ),U,6),!
. D CKP^GMTSUP Q:$D(GMTSQIT) W ?6,"Site/Specimen:",?21,$TR($P(^TMP("LRM",$J,GMZ),U,3),"|"," "),!
. S COM=$P(^TMP("LRM",$J,GMZ),U,7)
. I COM]"" D
. . D CKP^GMTSUP Q:$D(GMTSQIT)
. . W "Comment on Specimen:"
. . I $L(COM)>58 S COM=$$WRAP^GMTSORC(COM,58)
. . W ?21,$P(COM,"|"),!
. . I $L($P(COM,"|",2)) D CKP^GMTSUP Q:$D(GMTSQIT) W ?22,$P(COM,"|",2),!
. D WRTTEST^GMTSLRM1
S GMK="" F S GMK=$O(^TMP("LRM",$J,GMZ,GMK)) Q:GMK="" D WRTNODE Q:$D(GMTSQIT)
Q
WRTNODE ; Writes current node of ^TMP("LRM",$J
N GML,SMEAR,QTY,ORG,GMN,RSMEAR
I GMZ="BSTER" D Q
. I GMK=0 D Q
. . Q:$P(^TMP("LRM",$J,"BSTER",GMK),U)']""
. . D CKP^GMTSUP Q:$D(GMTSQIT)
. . W ?2,"Sterility Control:",?21,$P(^TMP("LRM",$J,"BSTER",GMK),U),! Q
. D CKP^GMTSUP I $D(GMTSQIT)
. W ?13,"Number:",?21,GMK,?34,"Sterility Results: ",$P(^TMP("LRM",$J,GMZ,GMK),U),!
I GMK=0 S GMN=$G(^TMP("LRM",$J,GMZ,GMK)) D CKP^GMTSUP Q:$D(GMTSQIT) W ?4,$S(GMZ="BACT":" Bact ",GMZ="TB":"Mycobact ",GMZ="MYCO":"Mycology ",GMZ="PARA":"Parasite ",GMZ="VIRO":"Virology ",1:" ")_"Report:",?21,$P(GMN,U),! D Q
. I GMZ="BACT" D Q:$D(GMTSQIT)
. . I $P(GMN,U,3)]"" D CKP^GMTSUP Q:$D(GMTSQIT) W ?7,"Urine Screen: ",$P(GMN,U,3),!
. . I $P(GMN,U,2)]"" D CKP^GMTSUP Q:$D(GMTSQIT) W ?6,"Sputum Screen: ",$P(GMN,U,2),!
. I GMZ="TB" D Q:$D(GMTSQIT)
. . I $P(GMN,U,2)]"" D CKP^GMTSUP Q:$D(GMTSQIT) W ?4,"Acid Fast Stain: ",$E($P(GMN,U,2),1,20) D
. . . S QTY=$P(GMN,U,3)
. . . I $L(QTY)>35 S QTY=$$WRAP^GMTSORC(QTY,35)
. . . W ?44,$P(QTY,"|"),!
. . . I $L($P(QTY,"|",2)) D CKP^GMTSUP Q:$D(GMTSQIT) W ?44,$P(QTY,"|",2),!
I GMZ="GRAM" D WRTGRM^GMTSLRM1 Q
I GMK="SMEAR" D Q
. D CKP^GMTSUP Q:$D(GMTSQIT)
. W ?9,"Smear/Prep:"
. S SMEAR=0
. F S SMEAR=$O(^TMP("LRM",$J,GMZ,GMK,SMEAR)) Q:SMEAR'>0 D I +$O(^TMP("LRM",$J,GMK,SMEAR)) D CKP^GMTSUP Q:$D(GMTSQIT)
. . S RSMEAR=^TMP("LRM",$J,GMZ,GMK,SMEAR)
. . I $L(RSMEAR)>58 S RSMEAR=$$WRAP^GMTSORC(RSMEAR,58)
. . W ?21,$P(RSMEAR,"|"),!
. . I $L($P(RSMEAR,"|",2)) D CKP^GMTSUP Q:$D(GMTSQIT) W ?22,$P(RSMEAR,"|",2),!
I GMK="R" D REMARKS^GMTSLRM1 Q
I GMZ'="CABXL" D Q:$D(GMTSQIT)
. S ORG=$P(^TMP("LRM",$J,GMZ,GMK),U),QTY=$P(^(GMK),U,2)
. I $L(ORG)>58 S ORG=$$WRAP^GMTSORC(ORG,58)
. D CKP^GMTSUP Q:$D(GMTSQIT)
. W ?11,"Organism:"
. W ?21,$P(ORG,"|",1),!
. I $L($P(ORG,"|",2)) D CKP^GMTSUP Q:$D(GMTSQIT) W ?23,$P(ORG,"|",2),!
. I QTY]"" W ?11,"Quantity:" D
. . I $L(QTY)>58 S QTY=$$WRAP^GMTSORC(QTY,58)
. . D CKP^GMTSUP Q:$D(GMTSQIT) W ?21,$P(QTY,"|"),!
. . I $L($P(QTY,"|",2)) D CKP^GMTSUP Q:$D(GMTSQIT) W ?23,$P(QTY,"|",2),!
. D COMMENT^GMTSLRM1 Q:$D(GMTSQIT)
. I GMZ="TB" D TBSUSC^GMTSLRM1
I GMZ="CABXL" D
. I GMK=1!(GMABX=1) D CKP^GMTSUP Q:$D(GMTSQIT) W ?8,"Ser Abx Lev:"
. W ?21,$E($P(^TMP("LRM",$J,GMZ,GMK),U),1,20),?45,$$DRAW($P(^TMP("LRM",$J,GMZ,GMK),U,2)),?55,$P(^TMP("LRM",$J,GMZ,GMK),U,3)," ug/ml",! D CKP^GMTSUP Q:$D(GMTSQIT)
I GMZ="BACT",$D(^TMP("LRM",$J,GMZ,GMK,"SUSC")) D ANTIBX^GMTSLRM1 Q
I GMZ="PARA",$D(^TMP("LRM",$J,GMZ,GMK))=11 D
. S GML=0
. F S GML=$O(^TMP("LRM",$J,GMZ,GMK,GML)) Q:GML'>0 D Q:$D(GMTSQIT)
. . D CKP^GMTSUP Q:$D(GMTSQIT)
. . W ?23,$P(^TMP("LRM",$J,GMZ,GMK,GML),U)
. . S QTY=$P(^TMP("LRM",$J,GMZ,GMK,GML),U,2)
. . I $L(QTY)>34 S QTY=$$WRAP^GMTSORC(QTY,34)
. . W ?45,$P(QTY,"|"),!
. . I $L($P(QTY,"|",2)) D CKP^GMTSUP Q:$D(GMTSQIT) W ?45,$P(QTY,"|",2),!
. . D PARACOMM^GMTSLRM1
Q
DRAW(CODE) ; Peak/Trough/Random Abx level
Q $S(CODE="P":"PEAK",CODE="T":"TROUGH",1:"RANDOM")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSLRM 4831 printed Sep 23, 2025@19:33:51 Page 2
GMTSLRM ; SLC/JER,KER - Microbiology Component Driver ; 09/21/2001
+1 ;;2.7;Health Summary;**28,47**;Oct 20, 1995
+2 ;
+3 ; External References
+4 ; DBIA 525 ^LR( all fields
+5 ; DBIA 10035 ^DPT( field 63 Read w/Fileman
+6 ; DBIA 2056 $$GET1^DIQ (file 2)
+7 ;
MAIN ; Microbiology
+1 NEW IX0,IX,LRDFN,MAX,D1,D2,D3
+2 SET LRDFN=+($$GET1^DIQ(2,(+($GET(DFN))_","),63,"I"))
if +LRDFN=0
QUIT
if '$DATA(^LR(LRDFN))
QUIT
+3 if +($SELECT('$DATA(^LR(LRDFN,"MI",0))
QUIT
+4 SET MAX=$SELECT(+($GET(GMTSNDM))>0:+($GET(GMTSNDM)),1:999)
SET IX=GMTS1
+5 FOR IX0=1:1:MAX
SET IX=$ORDER(^LR(LRDFN,"MI",IX))
if +IX'>0!(IX>GMTS2)!$DATA(GMTSQIT)
QUIT
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
Begin DoDot:1
+6 DO ^GMTSLRME
IF $DATA(^TMP("LRM",$JOB))
if IX0>1
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
if IX0>1
WRITE !
DO INTRP
+7 KILL ^TMP("LRM",$JOB)
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+8 QUIT
INTRP ; Interprets ^TMP("LRM",$J
+1 NEW GMZ,GMK
SET (GMZ,GMK)=""
+2 FOR
SET GMZ=$ORDER(^TMP("LRM",$JOB,GMZ))
if GMZ=""
QUIT
DO RDNODE
if $DATA(GMTSQIT)
QUIT
+3 QUIT
RDNODE ; Reads current node of ^TMP("LRM",$J
+1 NEW GMABX,COM
SET GMABX=0
IF GMZ=0
Begin DoDot:1
+2 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE ?10,"Collected:",?21,$PIECE(^TMP("LRM",$JOB,GMZ),U),?43,"Acc:",?48,$PIECE(^TMP("LRM",$JOB,GMZ),U,2),!
+3 IF $PIECE(^TMP("LRM",$JOB,GMZ),U,6)'=$PIECE(^(GMZ),U,3)
Begin DoDot:2
+4 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE ?2,"Collection Sample:",?21,$PIECE(^TMP("LRM",$JOB,GMZ),U,6),!
End DoDot:2
+5 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE ?6,"Site/Specimen:",?21,$TRANSLATE($PIECE(^TMP("LRM",$JOB,GMZ),U,3),"|"," "),!
+6 SET COM=$PIECE(^TMP("LRM",$JOB,GMZ),U,7)
+7 IF COM]""
Begin DoDot:2
+8 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+9 WRITE "Comment on Specimen:"
+10 IF $LENGTH(COM)>58
SET COM=$$WRAP^GMTSORC(COM,58)
+11 WRITE ?21,$PIECE(COM,"|"),!
+12 IF $LENGTH($PIECE(COM,"|",2))
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE ?22,$PIECE(COM,"|",2),!
End DoDot:2
+13 DO WRTTEST^GMTSLRM1
End DoDot:1
QUIT
+14 SET GMK=""
FOR
SET GMK=$ORDER(^TMP("LRM",$JOB,GMZ,GMK))
if GMK=""
QUIT
DO WRTNODE
if $DATA(GMTSQIT)
QUIT
+15 QUIT
WRTNODE ; Writes current node of ^TMP("LRM",$J
+1 NEW GML,SMEAR,QTY,ORG,GMN,RSMEAR
+2 IF GMZ="BSTER"
Begin DoDot:1
+3 IF GMK=0
Begin DoDot:2
+4 if $PIECE(^TMP("LRM",$JOB,"BSTER",GMK),U)']""
QUIT
+5 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+6 WRITE ?2,"Sterility Control:",?21,$PIECE(^TMP("LRM",$JOB,"BSTER",GMK),U),!
QUIT
End DoDot:2
QUIT
+7 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
+8 WRITE ?13,"Number:",?21,GMK,?34,"Sterility Results: ",$PIECE(^TMP("LRM",$JOB,GMZ,GMK),U),!
End DoDot:1
QUIT
+9 IF GMK=0
SET GMN=$GET(^TMP("LRM",$JOB,GMZ,GMK))
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE ?4,$SELECT(GMZ="BACT":" Bact ",GMZ="TB":"Mycobact ",GMZ="MYCO":"Mycology ",GMZ="PARA":"Parasite ",GMZ="VIRO":"Virology ",1:" ")_"Report:",?21,$PIECE(GMN,U),!
Begin DoDot:1
+10 IF GMZ="BACT"
Begin DoDot:2
+11 IF $PIECE(GMN,U,3)]""
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE ?7,"Urine Screen: ",$PIECE(GMN,U,3),!
+12 IF $PIECE(GMN,U,2)]""
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE ?6,"Sputum Screen: ",$PIECE(GMN,U,2),!
End DoDot:2
if $DATA(GMTSQIT)
QUIT
+13 IF GMZ="TB"
Begin DoDot:2
+14 IF $PIECE(GMN,U,2)]""
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE ?4,"Acid Fast Stain: ",$EXTRACT($PIECE(GMN,U,2),1,20)
Begin DoDot:3
+15 SET QTY=$PIECE(GMN,U,3)
+16 IF $LENGTH(QTY)>35
SET QTY=$$WRAP^GMTSORC(QTY,35)
+17 WRITE ?44,$PIECE(QTY,"|"),!
+18 IF $LENGTH($PIECE(QTY,"|",2))
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE ?44,$PIECE(QTY,"|",2),!
End DoDot:3
End DoDot:2
if $DATA(GMTSQIT)
QUIT
End DoDot:1
QUIT
+19 IF GMZ="GRAM"
DO WRTGRM^GMTSLRM1
QUIT
+20 IF GMK="SMEAR"
Begin DoDot:1
+21 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+22 WRITE ?9,"Smear/Prep:"
+23 SET SMEAR=0
+24 FOR
SET SMEAR=$ORDER(^TMP("LRM",$JOB,GMZ,GMK,SMEAR))
if SMEAR'>0
QUIT
Begin DoDot:2
+25 SET RSMEAR=^TMP("LRM",$JOB,GMZ,GMK,SMEAR)
+26 IF $LENGTH(RSMEAR)>58
SET RSMEAR=$$WRAP^GMTSORC(RSMEAR,58)
+27 WRITE ?21,$PIECE(RSMEAR,"|"),!
+28 IF $LENGTH($PIECE(RSMEAR,"|",2))
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE ?22,$PIECE(RSMEAR,"|",2),!
End DoDot:2
IF +$ORDER(^TMP("LRM",$JOB,GMK,SMEAR))
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
End DoDot:1
QUIT
+29 IF GMK="R"
DO REMARKS^GMTSLRM1
QUIT
+30 IF GMZ'="CABXL"
Begin DoDot:1
+31 SET ORG=$PIECE(^TMP("LRM",$JOB,GMZ,GMK),U)
SET QTY=$PIECE(^(GMK),U,2)
+32 IF $LENGTH(ORG)>58
SET ORG=$$WRAP^GMTSORC(ORG,58)
+33 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+34 WRITE ?11,"Organism:"
+35 WRITE ?21,$PIECE(ORG,"|",1),!
+36 IF $LENGTH($PIECE(ORG,"|",2))
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE ?23,$PIECE(ORG,"|",2),!
+37 IF QTY]""
WRITE ?11,"Quantity:"
Begin DoDot:2
+38 IF $LENGTH(QTY)>58
SET QTY=$$WRAP^GMTSORC(QTY,58)
+39 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE ?21,$PIECE(QTY,"|"),!
+40 IF $LENGTH($PIECE(QTY,"|",2))
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE ?23,$PIECE(QTY,"|",2),!
End DoDot:2
+41 DO COMMENT^GMTSLRM1
if $DATA(GMTSQIT)
QUIT
+42 IF GMZ="TB"
DO TBSUSC^GMTSLRM1
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+43 IF GMZ="CABXL"
Begin DoDot:1
+44 IF GMK=1!(GMABX=1)
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE ?8,"Ser Abx Lev:"
+45 WRITE ?21,$EXTRACT($PIECE(^TMP("LRM",$JOB,GMZ,GMK),U),1,20),?45,$$DRAW($PIECE(^TMP("LRM",$JOB,GMZ,GMK),U,2)),?55,$PIECE(^TMP("LRM",$JOB,GMZ,GMK),U,3)," ug/ml",!
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
End DoDot:1
+46 IF GMZ="BACT"
IF $DATA(^TMP("LRM",$JOB,GMZ,GMK,"SUSC"))
DO ANTIBX^GMTSLRM1
QUIT
+47 IF GMZ="PARA"
IF $DATA(^TMP("LRM",$JOB,GMZ,GMK))=11
Begin DoDot:1
+48 SET GML=0
+49 FOR
SET GML=$ORDER(^TMP("LRM",$JOB,GMZ,GMK,GML))
if GML'>0
QUIT
Begin DoDot:2
+50 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+51 WRITE ?23,$PIECE(^TMP("LRM",$JOB,GMZ,GMK,GML),U)
+52 SET QTY=$PIECE(^TMP("LRM",$JOB,GMZ,GMK,GML),U,2)
+53 IF $LENGTH(QTY)>34
SET QTY=$$WRAP^GMTSORC(QTY,34)
+54 WRITE ?45,$PIECE(QTY,"|"),!
+55 IF $LENGTH($PIECE(QTY,"|",2))
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE ?45,$PIECE(QTY,"|",2),!
+56 DO PARACOMM^GMTSLRM1
End DoDot:2
if $DATA(GMTSQIT)
QUIT
End DoDot:1
+57 QUIT
DRAW(CODE) ; Peak/Trough/Random Abx level
+1 QUIT $SELECT(CODE="P":"PEAK",CODE="T":"TROUGH",1:"RANDOM")
