source: WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSLRM1.m@ 1801

Last change on this file since 1801 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.4 KB
Line 
1GMTSLRM1 ;SLC/SBW - Microbiology Component Continue ;2/13/98 14:15
2 ;;2.7;Health Summary;**25**;Oct 20, 1995
3REMARKS ; Write remarks
4 N RPT,NUM,FIRST
5 S NUM="",FIRST=1
6 F S NUM=$O(^TMP("LRM",$J,GMZ,GMK,NUM)) Q:+NUM'>0 D Q:$D(GMTSQIT)
7 . S RPT=^TMP("LRM",$J,GMZ,GMK,NUM)
8 . I $L(RPT)>58 S RPT=$$WRAP^GMTSORC(RPT,58)
9 . D CKP^GMTSUP Q:$D(GMTSQIT)
10 . I FIRST W ?12,"Remarks:" S FIRST=0
11 . W ?21,$P(RPT,"|"),!
12 . I $L($P(RPT,"|",2)) D CKP^GMTSUP Q:$D(GMTSQIT) W ?23,$P(RPT,"|",2),!
13 Q
14COMMENT ; Write comment
15 Q:+$D(^TMP("LRM",$J,GMZ,GMK,"COM"))'>0
16 N REC,COM
17 S REC=0
18 F S REC=$O(^TMP("LRM",$J,GMZ,GMK,"COM",REC)) Q:REC'>0 D
19 . S COM=^TMP("LRM",$J,GMZ,GMK,"COM",REC)
20 . I $L(COM)>55 S COM=$$WRAP^GMTSORC(COM,55)
21 . D CKP^GMTSUP Q:$D(GMTSQIT)
22 . W ?25,$P(COM,"|"),!
23 . I $L($P(COM,"|",2)) D CKP^GMTSUP Q:$D(GMTSQIT) W ?27,$P(COM,"|",2),!
24 Q
25PARACOMM ; Write comment for parasite
26 Q:+$D(^TMP("LRM",$J,GMZ,GMK,GML,"COM"))'>0
27 N REC,COM
28 S REC=0
29 F S REC=$O(^TMP("LRM",$J,GMZ,GMK,GML,"COM",REC)) Q:REC'>0 D
30 . S COM=^TMP("LRM",$J,GMZ,GMK,GML,"COM",REC)
31 . I $L(COM)>53 S COM=$$WRAP^GMTSORC(COM,53)
32 . D CKP^GMTSUP Q:$D(GMTSQIT)
33 . W ?27,$P(COM,"|"),!
34 . I $L($P(COM,"|",2)) D CKP^GMTSUP Q:$D(GMTSQIT) W ?29,$P(COM,"|",2),!
35 Q
36WRTGRM ; Writes Gram Stain Results
37 N GMGRAM
38 S GMGRAM=^TMP("LRM",$J,GMZ,GMK)
39 S:$L(GMGRAM)>58 GMGRAM=$$WRAP^GMTSORC(GMGRAM,58)
40 D CKP^GMTSUP Q:$D(GMTSQIT) W:GMK=1 ?15,"Gram:" W ?21,$P(GMGRAM,"|"),!
41 I $L($P(GMGRAM,"|",2)) D CKP^GMTSUP Q:$D(GMTSQIT) W ?23,$P(GMGRAM,"|",2),!
42 Q
43ANTIBX ; Writes Antibiotic susceptability data
44 N GML,GMCNT,ANAM,ANLEN,ANEXT,GMSUB
45 S GMABX=1
46 F GMSUB="S","I","R","O" D Q:$D(GMTSQIT)
47 . Q:+$D(^TMP("LRM",$J,GMZ,GMK,"SUSC",GMSUB))'>0
48 . D CKP^GMTSUP Q:$D(GMTSQIT)
49 . W:GMSUB="S" ?5,"Susceptible to: "
50 . W:GMSUB="I" ?7,"Intermediate: "
51 . W:GMSUB="R" ?7,"Resistant to: "
52 . W:GMSUB="O" ?7," Other: "
53 . S ANLEN=21,GML=""
54 . 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)
55 . . I $L(ANAM)+ANLEN>79 D CKP^GMTSUP Q:$D(GMTSQIT) W:'GMTSNPG ! W ?21 S ANLEN=21
56 . . W ANAM,$S(ANEXT]"":", ",1:"") S ANLEN=ANLEN+$L(ANAM)+2
57 . W !
58 Q
59WRTTEST ; Writes Lab Test for Accession
60 N GML,GMCNT,TNAM,TLEN,TNEXT
61 Q:'$D(^TMP("LRM",$J,GMZ,"TEST"))
62 D CKP^GMTSUP Q:$D(GMTSQIT) W ?4,"Test(s) ordered: "
63 S TLEN=21,GML=""
64 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)
65 . I $L(TNAM)+TLEN>79 D CKP^GMTSUP Q:$D(GMTSQIT) W:'GMTSNPG ! W ?21 S TLEN=21
66 . W TNAM,$S(TNEXT]"":", ",1:"") S TLEN=TLEN+$L(TNAM)+2
67 W !
68 Q
69WRTSTER ; Writes sterility control data
70 N STER,GML
71 S STER=$G(^TMP("LRM",$J,"BSTER",0))
72 Q:STER']""
73 D CKP^GMTSUP Q:$D(GMTSQIT)
74 W ?2,"Sterility Control:",?21,STER,!
75 S GML=0
76 F S GML=$O(^TMP("LRM",$J,GMZ,GML)) Q:GML'>0 D Q:$D(GMTSQIT)
77 . D CKP^GMTSUP I $D(GMTSQIT)
78 . W ?13,"Number:",?21,GML,?44,"Results: ",$P(^TMP("LRM",$J,GMZ,GML),U),!
79 Q
80TBSUSC ;Display TB Susceptiblities
81 Q:+$D(^TMP("LRM",$J,GMZ,GMK,"SUSC"))'>0
82 N GMTB,QTY
83 S GMTB=0
84 F S GMTB=$O(^TMP("LRM",$J,GMZ,GMK,"SUSC",GMTB)) Q:GMTB'>0 D Q:$D(GMTSQIT)
85 . D CKP^GMTSUP Q:$D(GMTSQIT)
86 . W ?21,$P(^TMP("LRM",$J,GMZ,GMK,"SUSC",GMTB),U)
87 . S QTY=$P(^TMP("LRM",$J,GMZ,GMK,"SUSC",GMTB),U,2)
88 . I $L(QTY)>36 S QTY=$$WRAP^GMTSORC(QTY,36)
89 . W ?44,$P(QTY,"|"),!
90 . I $L($P(QTY,"|",2)) D CKP^GMTSUP Q:$D(GMTSQIT) W ?44,$P(QTY,"|",2),!
91 Q
Note: See TracBrowser for help on using the repository browser.