source: WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSLRMB.m@ 1806

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

initial load of WorldVistAEHR
File size: 4.2 KB
Line 
1GMTSLRMB ; SLC/JER,KER - Microbiology Component Dvr ; 09/21/2001
2 ;;2.7;Health Summary;**25,28,47**;Oct 20, 1995
3 ;
4 ; External References
5 ; DBIA 525 ^LR( all fields
6 ; DBIA 10035 ^DPT( field 63 Read w/Fileman
7 ; DBIA 2056 $$GET1^DIQ (file 2)
8 ;
9MAIN ; Microbioloby Brief
10 N IX0,IX,LRDFN,MAX,D1,D2,D3
11 S LRDFN=+($$GET1^DIQ(2,(+($G(DFN))_","),63,"I")) Q:+LRDFN=0 Q:'$D(^LR(LRDFN))
12 S MAX=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:999)
13 S IX=GMTS1 F IX0=1:1:MAX S IX=$O(^LR(LRDFN,"MI",IX)) Q:+IX'>0!(IX>GMTS2) D CKP^GMTSUP Q:$D(GMTSQIT) D Q:$D(GMTSQIT)
14 . D ^GMTSLRME I $D(^TMP("LRM",$J)) D
15 . . D:IX0>1 CKP^GMTSUP Q:$D(GMTSQIT) W:IX0>1&'GMTSNPG ! D INTRP
16 . K ^TMP("LRM",$J)
17 Q
18INTRP ; Interprets ^TMP("LRM",$J
19 N GMTSJ,GMK,GMW,SMEAR,GMABX
20 S (GMTSJ,GMK)=""
21 F S GMTSJ=$O(^TMP("LRM",$J,GMTSJ)) Q:GMTSJ=""!$D(GMTSQIT) D RDNODE
22 Q
23RDNODE ; Reads current node of ^TMP("LRM",$J
24 Q:GMTSJ="BSTER"
25 I GMTSJ=0 D Q
26 . D CKP^GMTSUP Q:$D(GMTSQIT) W $P($P(^TMP("LRM",$J,GMTSJ),U)," "),?12,$P(^TMP("LRM",$J,GMTSJ),U,3),!
27 . D WRTTEST
28 S GMK=""
29 F S GMK=$O(^TMP("LRM",$J,GMTSJ,GMK)) Q:GMK=""!$D(GMTSQIT) D WRTNODE
30 I GMTSJ="TB" D Q:$D(GMTSQIT)
31 . I $P(^TMP("LRM",$J,GMTSJ,0),U,2)]"" D
32 . . D CKP^GMTSUP Q:$D(GMTSQIT)
33 . . W "AFB Sme:",?12,$E($P(^TMP("LRM",$J,GMTSJ,0),U,2),1,20),!
34 . . I $P(^TMP("LRM",$J,GMTSJ,0),U,3)]"" D
35 . . . D CKP^GMTSUP Q:$D(GMTSQIT)
36 . . . W ?12,$P(^TMP("LRM",$J,GMTSJ,0),U,3),!
37 I $D(^TMP("LRM",$J,GMTSJ,"SMEAR")) D
38 . D CKP^GMTSUP Q:$D(GMTSQIT)
39 . W ?2,"Smear:"
40 . S SMEAR=0
41 . F S SMEAR=$O(^TMP("LRM",$J,GMTSJ,"SMEAR",SMEAR)) Q:SMEAR'>0 W ?12,^(SMEAR),! I +$O(^TMP("LRM",$J,"SMEAR",SMEAR)) D CKP^GMTSUP Q:$D(GMTSQIT)
42 Q
43WRTNODE ; Writes current node of ^TMP("LRM",$J
44 N GML,QTY
45 I GMK=0 D CKP^GMTSUP Q:$D(GMTSQIT) W ?1,"Report:",?12,$P(^TMP("LRM",$J,GMTSJ,GMK),U),! Q
46 I GMTSJ="GRAM" D WRTGRM Q
47 Q:GMK="SMEAR"
48 I GMK="R" D REMARKS Q
49 I GMTSJ'="CABXL" D Q:$D(GMTSQIT)
50 . D CKP^GMTSUP Q:$D(GMTSQIT) W "Organsm:",?12,$P(^TMP("LRM",$J,GMTSJ,GMK),U),!
51 . I $P(^TMP("LRM",$J,GMTSJ,GMK),U,2)]"" D CKP^GMTSUP Q:$D(GMTSQIT) W ?4,"QTY:",?12,$P(^TMP("LRM",$J,GMTSJ,GMK),U,2),!
52 I GMTSJ="CABXL" D
53 . D CKP^GMTSUP Q:$D(GMTSQIT)
54 . W:GMK=1 "Ser Abx:"
55 . W ?12,$E($P(^TMP("LRM",$J,GMTSJ,GMK),U),1,18),?30,$$DRAW^GMTSLRM($P(^TMP("LRM",$J,GMTSJ,GMK),U,2)),?38,$P(^(GMK),U,3)," ug/ml",!
56 I GMTSJ="BACT",$D(^TMP("LRM",$J,GMTSJ,GMK,"SUSC")) D ANTIBX Q
57 I GMTSJ="PARA",$D(^TMP("LRM",$J,GMTSJ,GMK))=11 D
58 . S GML=""
59 . F S GML=$O(^TMP("LRM",$J,GMTSJ,GMK,GML)) Q:GML'>0 D Q:$D(GMTSQIT)
60 . . D CKP^GMTSUP Q:$D(GMTSQIT)
61 . . W ?12,$P(^TMP("LRM",$J,GMTSJ,GMK,GML),U)
62 . . S QTY=$P(^TMP("LRM",$J,GMTSJ,GMK,GML),U,2)
63 . . I $L(QTY)>46 S QTY=$$WRAP^GMTSORC(QTY,46)
64 . . W ?35,$P(QTY,"|"),!
65 . . I $L($P(QTY,"|",2)) D CKP^GMTSUP Q:$D(GMTSQIT) W ?35,$P(QTY,"|",2),!
66 Q
67REMARKS ; Write remarks
68 N NUM,FIRST
69 S NUM="",FIRST=1
70 F S NUM=$O(^TMP("LRM",$J,GMTSJ,GMK,NUM)) Q:+NUM'>0 D Q:$D(GMTSQIT)
71 . D CKP^GMTSUP Q:$D(GMTSQIT)
72 . W:$X>0 !
73 . I FIRST W "Remarks:" S FIRST=0
74 . W ?12,^TMP("LRM",$J,GMTSJ,GMK,NUM),!
75 Q
76WRTGRM ; Writes Gram Stain Results
77 D CKP^GMTSUP Q:$D(GMTSQIT) W:$X>0 ! W:GMK=1 ?3,"Gram:" W ?12,$E(^TMP("LRM",$J,GMTSJ,GMK),1,69),!
78 Q
79ANTIBX ; Writes Antibiotic susceptability data
80 N GML,GMCNT,ANAM,ANLEN,ANEXT,GMSUB
81 S GMABX=1
82 F GMSUB="S","I","R","O" D Q:$D(GMTSQIT)
83 . Q:+$D(^TMP("LRM",$J,GMTSJ,GMK,"SUSC",GMSUB))'>0
84 . D CKP^GMTSUP Q:$D(GMTSQIT)
85 . W:GMSUB="S" "Susc to: "
86 . W:GMSUB="I" "Interme: "
87 . W:GMSUB="R" "Resista: "
88 . W:GMSUB="O" " Other: "
89 . S ANLEN=10,GML=""
90 . F S GML=$O(^TMP("LRM",$J,GMTSJ,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)
91 . . I $L(ANAM)+ANLEN>79 D CKP^GMTSUP Q:$D(GMTSQIT) W:'GMTSNPG ! W ?12 S ANLEN=10
92 . . W ANAM,$S(ANEXT]"":", ",1:"") S ANLEN=ANLEN+$L(ANAM)+2
93 . W !
94 Q
95WRTTEST ; Writes Lab Test for Accession
96 N GML,GMCNT,TNAM,TLEN,TNEXT
97 Q:'$D(^TMP("LRM",$J,GMTSJ,"TEST"))
98 D CKP^GMTSUP Q:$D(GMTSQIT) W "Test(s): "
99 S TLEN=10,GML=""
100 F S GML=$O(^TMP("LRM",$J,GMTSJ,"TEST",GML)) Q:GML="" S TNAM=$P($G(^(GML)),U),TNEXT=$O(^(GML)) D Q:$D(GMTSQIT)
101 . I $L(TNAM)+TLEN>79 D CKP^GMTSUP Q:$D(GMTSQIT) W:'GMTSNPG ! W ?12 S TLEN=10
102 . W TNAM,$S(TNEXT]"":", ",1:"") S TLEN=TLEN+$L(TNAM)+2
103 W !
104 Q
Note: See TracBrowser for help on using the repository browser.