Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMTSLRM1

GMTSLRM1.m

Go to the documentation of this file.
  1. GMTSLRM1 ;SLC/SBW - Microbiology Component Continue ;2/13/98 14:15
  1. ;;2.7;Health Summary;**25**;Oct 20, 1995
  1. REMARKS ; Write remarks
  1. N RPT,NUM,FIRST
  1. S NUM="",FIRST=1
  1. F S NUM=$O(^TMP("LRM",$J,GMZ,GMK,NUM)) Q:+NUM'>0 D Q:$D(GMTSQIT)
  1. . S RPT=^TMP("LRM",$J,GMZ,GMK,NUM)
  1. . I $L(RPT)>58 S RPT=$$WRAP^GMTSORC(RPT,58)
  1. . D CKP^GMTSUP Q:$D(GMTSQIT)
  1. . I FIRST W ?12,"Remarks:" S FIRST=0
  1. . W ?21,$P(RPT,"|"),!
  1. . I $L($P(RPT,"|",2)) D CKP^GMTSUP Q:$D(GMTSQIT) W ?23,$P(RPT,"|",2),!
  1. Q
  1. COMMENT ; Write comment
  1. Q:+$D(^TMP("LRM",$J,GMZ,GMK,"COM"))'>0
  1. N REC,COM
  1. S REC=0
  1. F S REC=$O(^TMP("LRM",$J,GMZ,GMK,"COM",REC)) Q:REC'>0 D
  1. . S COM=^TMP("LRM",$J,GMZ,GMK,"COM",REC)
  1. . I $L(COM)>55 S COM=$$WRAP^GMTSORC(COM,55)
  1. . D CKP^GMTSUP Q:$D(GMTSQIT)
  1. . W ?25,$P(COM,"|"),!
  1. . I $L($P(COM,"|",2)) D CKP^GMTSUP Q:$D(GMTSQIT) W ?27,$P(COM,"|",2),!
  1. Q
  1. PARACOMM ; Write comment for parasite
  1. Q:+$D(^TMP("LRM",$J,GMZ,GMK,GML,"COM"))'>0
  1. N REC,COM
  1. S REC=0
  1. F S REC=$O(^TMP("LRM",$J,GMZ,GMK,GML,"COM",REC)) Q:REC'>0 D
  1. . S COM=^TMP("LRM",$J,GMZ,GMK,GML,"COM",REC)
  1. . I $L(COM)>53 S COM=$$WRAP^GMTSORC(COM,53)
  1. . D CKP^GMTSUP Q:$D(GMTSQIT)
  1. . W ?27,$P(COM,"|"),!
  1. . I $L($P(COM,"|",2)) D CKP^GMTSUP Q:$D(GMTSQIT) W ?29,$P(COM,"|",2),!
  1. Q
  1. WRTGRM ; Writes Gram Stain Results
  1. N GMGRAM
  1. S GMGRAM=^TMP("LRM",$J,GMZ,GMK)
  1. S:$L(GMGRAM)>58 GMGRAM=$$WRAP^GMTSORC(GMGRAM,58)
  1. D CKP^GMTSUP Q:$D(GMTSQIT) W:GMK=1 ?15,"Gram:" W ?21,$P(GMGRAM,"|"),!
  1. I $L($P(GMGRAM,"|",2)) D CKP^GMTSUP Q:$D(GMTSQIT) W ?23,$P(GMGRAM,"|",2),!
  1. Q
  1. ANTIBX ; Writes Antibiotic susceptability data
  1. N GML,GMCNT,ANAM,ANLEN,ANEXT,GMSUB
  1. S GMABX=1
  1. F GMSUB="S","I","R","O" D Q:$D(GMTSQIT)
  1. . Q:+$D(^TMP("LRM",$J,GMZ,GMK,"SUSC",GMSUB))'>0
  1. . D CKP^GMTSUP Q:$D(GMTSQIT)
  1. . W:GMSUB="S" ?5,"Susceptible to: "
  1. . W:GMSUB="I" ?7,"Intermediate: "
  1. . W:GMSUB="R" ?7,"Resistant to: "
  1. . W:GMSUB="O" ?7," Other: "
  1. . S ANLEN=21,GML=""
  1. . 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)
  1. . . I $L(ANAM)+ANLEN>79 D CKP^GMTSUP Q:$D(GMTSQIT) W:'GMTSNPG ! W ?21 S ANLEN=21
  1. . . W ANAM,$S(ANEXT]"":", ",1:"") S ANLEN=ANLEN+$L(ANAM)+2
  1. . W !
  1. Q
  1. WRTTEST ; Writes Lab Test for Accession
  1. N GML,GMCNT,TNAM,TLEN,TNEXT
  1. Q:'$D(^TMP("LRM",$J,GMZ,"TEST"))
  1. D CKP^GMTSUP Q:$D(GMTSQIT) W ?4,"Test(s) ordered: "
  1. S TLEN=21,GML=""
  1. 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)
  1. . I $L(TNAM)+TLEN>79 D CKP^GMTSUP Q:$D(GMTSQIT) W:'GMTSNPG ! W ?21 S TLEN=21
  1. . W TNAM,$S(TNEXT]"":", ",1:"") S TLEN=TLEN+$L(TNAM)+2
  1. W !
  1. Q
  1. WRTSTER ; Writes sterility control data
  1. N STER,GML
  1. S STER=$G(^TMP("LRM",$J,"BSTER",0))
  1. Q:STER']""
  1. D CKP^GMTSUP Q:$D(GMTSQIT)
  1. W ?2,"Sterility Control:",?21,STER,!
  1. S GML=0
  1. F S GML=$O(^TMP("LRM",$J,GMZ,GML)) Q:GML'>0 D Q:$D(GMTSQIT)
  1. . D CKP^GMTSUP I $D(GMTSQIT)
  1. . W ?13,"Number:",?21,GML,?44,"Results: ",$P(^TMP("LRM",$J,GMZ,GML),U),!
  1. Q
  1. TBSUSC ;Display TB Susceptiblities
  1. Q:+$D(^TMP("LRM",$J,GMZ,GMK,"SUSC"))'>0
  1. N GMTB,QTY
  1. S GMTB=0
  1. F S GMTB=$O(^TMP("LRM",$J,GMZ,GMK,"SUSC",GMTB)) Q:GMTB'>0 D Q:$D(GMTSQIT)
  1. . D CKP^GMTSUP Q:$D(GMTSQIT)
  1. . W ?21,$P(^TMP("LRM",$J,GMZ,GMK,"SUSC",GMTB),U)
  1. . S QTY=$P(^TMP("LRM",$J,GMZ,GMK,"SUSC",GMTB),U,2)
  1. . I $L(QTY)>36 S QTY=$$WRAP^GMTSORC(QTY,36)
  1. . W ?44,$P(QTY,"|"),!
  1. . I $L($P(QTY,"|",2)) D CKP^GMTSUP Q:$D(GMTSQIT) W ?44,$P(QTY,"|",2),!
  1. Q