GMTSLRM1 ;SLC/SBW - Microbiology Component Continue ;2/13/98 14:15
;;2.7;Health Summary;**25**;Oct 20, 1995
N RPT,NUM,FIRST
S NUM="",FIRST=1
F S NUM=$O(^TMP("LRM",$J,GMZ,GMK,NUM)) Q:+NUM'>0 D Q:$D(GMTSQIT)
. S RPT=^TMP("LRM",$J,GMZ,GMK,NUM)
. I $L(RPT)>58 S RPT=$$WRAP^GMTSORC(RPT,58)
. D CKP^GMTSUP Q:$D(GMTSQIT)
. I FIRST W ?12,"Remarks:" S FIRST=0
. W ?21,$P(RPT,"|"),!
. I $L($P(RPT,"|",2)) D CKP^GMTSUP Q:$D(GMTSQIT) W ?23,$P(RPT,"|",2),!
Q
Q:+$D(^TMP("LRM",$J,GMZ,GMK,"COM"))'>0
N REC,COM
S REC=0
F S REC=$O(^TMP("LRM",$J,GMZ,GMK,"COM",REC)) Q:REC'>0 D
. S COM=^TMP("LRM",$J,GMZ,GMK,"COM",REC)
. I $L(COM)>55 S COM=$$WRAP^GMTSORC(COM,55)
. D CKP^GMTSUP Q:$D(GMTSQIT)
. W ?25,$P(COM,"|"),!
. I $L($P(COM,"|",2)) D CKP^GMTSUP Q:$D(GMTSQIT) W ?27,$P(COM,"|",2),!
Q
PARACOMM ; Write comment for parasite
Q:+$D(^TMP("LRM",$J,GMZ,GMK,GML,"COM"))'>0
N REC,COM
S REC=0
F S REC=$O(^TMP("LRM",$J,GMZ,GMK,GML,"COM",REC)) Q:REC'>0 D
. S COM=^TMP("LRM",$J,GMZ,GMK,GML,"COM",REC)
. I $L(COM)>53 S COM=$$WRAP^GMTSORC(COM,53)
. D CKP^GMTSUP Q:$D(GMTSQIT)
. W ?27,$P(COM,"|"),!
. I $L($P(COM,"|",2)) D CKP^GMTSUP Q:$D(GMTSQIT) W ?29,$P(COM,"|",2),!
Q
WRTGRM ; Writes Gram Stain Results
N GMGRAM
S GMGRAM=^TMP("LRM",$J,GMZ,GMK)
S:$L(GMGRAM)>58 GMGRAM=$$WRAP^GMTSORC(GMGRAM,58)
D CKP^GMTSUP Q:$D(GMTSQIT) W:GMK=1 ?15,"Gram:" W ?21,$P(GMGRAM,"|"),!
I $L($P(GMGRAM,"|",2)) D CKP^GMTSUP Q:$D(GMTSQIT) W ?23,$P(GMGRAM,"|",2),!
Q
ANTIBX ; Writes Antibiotic susceptability data
N GML,GMCNT,ANAM,ANLEN,ANEXT,GMSUB
S GMABX=1
F GMSUB="S","I","R","O" D Q:$D(GMTSQIT)
. Q:+$D(^TMP("LRM",$J,GMZ,GMK,"SUSC",GMSUB))'>0
. D CKP^GMTSUP Q:$D(GMTSQIT)
. W:GMSUB="S" ?5,"Susceptible to: "
. W:GMSUB="I" ?7,"Intermediate: "
. W:GMSUB="R" ?7,"Resistant to: "
. W:GMSUB="O" ?7," Other: "
. S ANLEN=21,GML=""
. F S GML=$O(^TMP("LRM",$J,GMZ,GMK,"SUSC",GMSUB,GML)) Q:GML="" S ANAM=$P($P(^(GML),U),";",2)_$S(GMSUB="O":"("_$P(^(GML),U,2)_"/"_$P(^(GML),U,3)_")",1:""),ANEXT=$O(^(GML)) D Q:$D(GMTSQIT)
. . I $L(ANAM)+ANLEN>79 D CKP^GMTSUP Q:$D(GMTSQIT) W:'GMTSNPG ! W ?21 S ANLEN=21
. . W ANAM,$S(ANEXT]"":", ",1:"") S ANLEN=ANLEN+$L(ANAM)+2
. W !
Q
WRTTEST ; Writes Lab Test for Accession
N GML,GMCNT,TNAM,TLEN,TNEXT
Q:'$D(^TMP("LRM",$J,GMZ,"TEST"))
D CKP^GMTSUP Q:$D(GMTSQIT) W ?4,"Test(s) ordered: "
S TLEN=21,GML=""
F S GML=$O(^TMP("LRM",$J,GMZ,"TEST",GML)) Q:GML="" S TNAM=$P($G(^(GML)),U),TNEXT=$O(^(GML)) D Q:$D(GMTSQIT)
. I $L(TNAM)+TLEN>79 D CKP^GMTSUP Q:$D(GMTSQIT) W:'GMTSNPG ! W ?21 S TLEN=21
. W TNAM,$S(TNEXT]"":", ",1:"") S TLEN=TLEN+$L(TNAM)+2
W !
Q
WRTSTER ; Writes sterility control data
N STER,GML
S STER=$G(^TMP("LRM",$J,"BSTER",0))
Q:STER']""
D CKP^GMTSUP Q:$D(GMTSQIT)
W ?2,"Sterility Control:",?21,STER,!
S GML=0
F S GML=$O(^TMP("LRM",$J,GMZ,GML)) Q:GML'>0 D Q:$D(GMTSQIT)
. D CKP^GMTSUP I $D(GMTSQIT)
. W ?13,"Number:",?21,GML,?44,"Results: ",$P(^TMP("LRM",$J,GMZ,GML),U),!
Q
TBSUSC ;Display TB Susceptiblities
Q:+$D(^TMP("LRM",$J,GMZ,GMK,"SUSC"))'>0
N GMTB,QTY
S GMTB=0
F S GMTB=$O(^TMP("LRM",$J,GMZ,GMK,"SUSC",GMTB)) Q:GMTB'>0 D Q:$D(GMTSQIT)
. D CKP^GMTSUP Q:$D(GMTSQIT)
. W ?21,$P(^TMP("LRM",$J,GMZ,GMK,"SUSC",GMTB),U)
. S QTY=$P(^TMP("LRM",$J,GMZ,GMK,"SUSC",GMTB),U,2)
. I $L(QTY)>36 S QTY=$$WRAP^GMTSORC(QTY,36)
. W ?44,$P(QTY,"|"),!
. I $L($P(QTY,"|",2)) D CKP^GMTSUP Q:$D(GMTSQIT) W ?44,$P(QTY,"|",2),!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSLRM1 3552 printed Oct 16, 2024@17:58:35 Page 2
GMTSLRM1 ;SLC/SBW - Microbiology Component Continue ;2/13/98 14:15
+1 ;;2.7;Health Summary;**25**;Oct 20, 1995
+1 NEW RPT,NUM,FIRST
+2 SET NUM=""
SET FIRST=1
+3 FOR
SET NUM=$ORDER(^TMP("LRM",$JOB,GMZ,GMK,NUM))
if +NUM'>0
QUIT
Begin DoDot:1
+4 SET RPT=^TMP("LRM",$JOB,GMZ,GMK,NUM)
+5 IF $LENGTH(RPT)>58
SET RPT=$$WRAP^GMTSORC(RPT,58)
+6 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+7 IF FIRST
WRITE ?12,"Remarks:"
SET FIRST=0
+8 WRITE ?21,$PIECE(RPT,"|"),!
+9 IF $LENGTH($PIECE(RPT,"|",2))
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE ?23,$PIECE(RPT,"|",2),!
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+10 QUIT
+1 if +$DATA(^TMP("LRM",$JOB,GMZ,GMK,"COM"))'>0
QUIT
+2 NEW REC,COM
+3 SET REC=0
+4 FOR
SET REC=$ORDER(^TMP("LRM",$JOB,GMZ,GMK,"COM",REC))
if REC'>0
QUIT
Begin DoDot:1
+5 SET COM=^TMP("LRM",$JOB,GMZ,GMK,"COM",REC)
+6 IF $LENGTH(COM)>55
SET COM=$$WRAP^GMTSORC(COM,55)
+7 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+8 WRITE ?25,$PIECE(COM,"|"),!
+9 IF $LENGTH($PIECE(COM,"|",2))
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE ?27,$PIECE(COM,"|",2),!
End DoDot:1
+10 QUIT
PARACOMM ; Write comment for parasite
+1 if +$DATA(^TMP("LRM",$JOB,GMZ,GMK,GML,"COM"))'>0
QUIT
+2 NEW REC,COM
+3 SET REC=0
+4 FOR
SET REC=$ORDER(^TMP("LRM",$JOB,GMZ,GMK,GML,"COM",REC))
if REC'>0
QUIT
Begin DoDot:1
+5 SET COM=^TMP("LRM",$JOB,GMZ,GMK,GML,"COM",REC)
+6 IF $LENGTH(COM)>53
SET COM=$$WRAP^GMTSORC(COM,53)
+7 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+8 WRITE ?27,$PIECE(COM,"|"),!
+9 IF $LENGTH($PIECE(COM,"|",2))
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE ?29,$PIECE(COM,"|",2),!
End DoDot:1
+10 QUIT
WRTGRM ; Writes Gram Stain Results
+1 NEW GMGRAM
+2 SET GMGRAM=^TMP("LRM",$JOB,GMZ,GMK)
+3 if $LENGTH(GMGRAM)>58
SET GMGRAM=$$WRAP^GMTSORC(GMGRAM,58)
+4 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
if GMK=1
WRITE ?15,"Gram:"
WRITE ?21,$PIECE(GMGRAM,"|"),!
+5 IF $LENGTH($PIECE(GMGRAM,"|",2))
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE ?23,$PIECE(GMGRAM,"|",2),!
+6 QUIT
ANTIBX ; Writes Antibiotic susceptability data
+1 NEW GML,GMCNT,ANAM,ANLEN,ANEXT,GMSUB
+2 SET GMABX=1
+3 FOR GMSUB="S","I","R","O"
Begin DoDot:1
+4 if +$DATA(^TMP("LRM",$JOB,GMZ,GMK,"SUSC",GMSUB))'>0
QUIT
+5 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+6 if GMSUB="S"
WRITE ?5,"Susceptible to: "
+7 if GMSUB="I"
WRITE ?7,"Intermediate: "
+8 if GMSUB="R"
WRITE ?7,"Resistant to: "
+9 if GMSUB="O"
WRITE ?7," Other: "
+10 SET ANLEN=21
SET GML=""
+11 FOR
SET GML=$ORDER(^TMP("LRM",$JOB,GMZ,GMK,"SUSC",GMSUB,GML))
if GML=""
QUIT
SET ANAM=$PIECE($PIECE(^(GML),U),";",2)_$SELECT(GMSUB="O":"("_$PIECE(^(GML),U,2)_"/"_$PIECE(^(GML),U,3)_")",1:"")
SET ANEXT=$ORDER(^(GML))
Begin DoDot:2
+12 IF $LENGTH(ANAM)+ANLEN>79
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
if 'GMTSNPG
WRITE !
WRITE ?21
SET ANLEN=21
+13 WRITE ANAM,$SELECT(ANEXT]"":", ",1:"")
SET ANLEN=ANLEN+$LENGTH(ANAM)+2
End DoDot:2
if $DATA(GMTSQIT)
QUIT
+14 WRITE !
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+15 QUIT
WRTTEST ; Writes Lab Test for Accession
+1 NEW GML,GMCNT,TNAM,TLEN,TNEXT
+2 if '$DATA(^TMP("LRM",$JOB,GMZ,"TEST"))
QUIT
+3 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE ?4,"Test(s) ordered: "
+4 SET TLEN=21
SET GML=""
+5 FOR
SET GML=$ORDER(^TMP("LRM",$JOB,GMZ,"TEST",GML))
if GML=""
QUIT
SET TNAM=$PIECE($GET(^(GML)),U)
SET TNEXT=$ORDER(^(GML))
Begin DoDot:1
+6 IF $LENGTH(TNAM)+TLEN>79
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
if 'GMTSNPG
WRITE !
WRITE ?21
SET TLEN=21
+7 WRITE TNAM,$SELECT(TNEXT]"":", ",1:"")
SET TLEN=TLEN+$LENGTH(TNAM)+2
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+8 WRITE !
+9 QUIT
WRTSTER ; Writes sterility control data
+1 NEW STER,GML
+2 SET STER=$GET(^TMP("LRM",$JOB,"BSTER",0))
+3 if STER']""
QUIT
+4 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+5 WRITE ?2,"Sterility Control:",?21,STER,!
+6 SET GML=0
+7 FOR
SET GML=$ORDER(^TMP("LRM",$JOB,GMZ,GML))
if GML'>0
QUIT
Begin DoDot:1
+8 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
+9 WRITE ?13,"Number:",?21,GML,?44,"Results: ",$PIECE(^TMP("LRM",$JOB,GMZ,GML),U),!
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+10 QUIT
TBSUSC ;Display TB Susceptiblities
+1 if +$DATA(^TMP("LRM",$JOB,GMZ,GMK,"SUSC"))'>0
QUIT
+2 NEW GMTB,QTY
+3 SET GMTB=0
+4 FOR
SET GMTB=$ORDER(^TMP("LRM",$JOB,GMZ,GMK,"SUSC",GMTB))
if GMTB'>0
QUIT
Begin DoDot:1
+5 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+6 WRITE ?21,$PIECE(^TMP("LRM",$JOB,GMZ,GMK,"SUSC",GMTB),U)
+7 SET QTY=$PIECE(^TMP("LRM",$JOB,GMZ,GMK,"SUSC",GMTB),U,2)
+8 IF $LENGTH(QTY)>36
SET QTY=$$WRAP^GMTSORC(QTY,36)
+9 WRITE ?44,$PIECE(QTY,"|"),!
+10 IF $LENGTH($PIECE(QTY,"|",2))
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE ?44,$PIECE(QTY,"|",2),!
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+11 QUIT
