- 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 Jan 18, 2025@02:59:01 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