source: WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSLRMX.m@ 1742

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

initial load of WorldVistAEHR
File size: 4.2 KB
Line 
1GMTSLRMX ; SLC/JER,KER - Extended Microbiology Extract ; 02/27/2002
2 ;;2.7;Health Summary;**49**;Oct 20, 1995
3 ;
4 ; External References
5 ; DBIA 10022 %XY^%RCR
6 ; DBIA 526 ^LAB(61.2
7 ; DBIA 63 ^LR(
8 ; DBIA 2056 $$GET1^DID
9 ; DBIA 10015 EN^DIQ1
10 ;
11PARA ; Get Parasitology Work-up
12 N DA,DIC,DIQ,DR,STATUS,PN,SN,RMK,SMEAR,COM
13 I $D(^LR(LRDFN,"MI",IX,5)) D
14 . S DIC=63,DA=LRDFN,DA(63.05)=IX,DR=5,DR(63.05)=15,DIQ="STATUS"
15 . S DIQ(0)="E" D EN^DIQ1
16 . S ^TMP("LRM",$J,"PARA",0)=$E($P(STATUS(63.05,IX,15,"E")," ",1),1,6)
17 S PN=0
18 F S PN=$O(^LR(LRDFN,"MI",IX,6,PN)) Q:+PN'>0 D
19 . S SN=0
20 . D IDPARA
21 . F S SN=$O(^LR(LRDFN,"MI",IX,6,PN,1,SN)) Q:+SN'>0 D IDPARA
22 ; Parasitology smear/prep
23 S SMEAR=0
24 F S SMEAR=$O(^LR(LRDFN,"MI",IX,24,SMEAR)) Q:SMEAR'>0 S ^TMP("LRM",$J,"PARA","SMEAR",SMEAR)=^(SMEAR,0)
25 ; Remark
26 S RMK=0
27 F S RMK=$O(^LR(LRDFN,"MI",IX,7,RMK)) Q:+RMK'>0 S ^TMP("LRM",$J,"PARA","R",RMK)=^(RMK,0)
28 Q
29IDPARA ; Get parasite stage, quantity, and comment
30 N DA,DIC,DIQ,DR,PARA,STAGE
31 I 'SN S PARA=+^LR(LRDFN,"MI",IX,6,PN,0),PARA=$S($D(EXPAND):PN_";"_$P(^LAB(61.2,PARA,0),U),1:$P(^LAB(61.2,PARA,0),U)),^TMP("LRM",$J,"PARA",PN)=PARA Q
32 S DA=LRDFN,DA(63.05)=IX,DA(63.34)=PN,DA(63.35)=SN,DIC=63,DIQ="STAGE",DIQ(0)="E",DR=5,DR(63.05)=16,DR(63.34)=1,DR(63.35)=".01;1" D EN^DIQ1
33 S ^TMP("LRM",$J,"PARA",PN,SN)=STAGE(63.35,SN,.01,"E")_U_STAGE(63.35,SN,1,"E")
34 ; Comment
35 S COM=0
36 F S COM=$O(^LR(LRDFN,"MI",IX,6,PN,1,SN,1,COM)) Q:COM'>0 S ^TMP("LRM",$J,"PARA",PN,SN,"COM",COM)=^(COM,0)
37 Q
38MYCO ; Get Mycology Work-up
39 N DA,DIC,DIQ,DR,DA,STATUS,GMW,ISO,FUN,RMK,COM,SMEAR
40 ; Work-up
41 I $D(^LR(LRDFN,"MI",IX,8)) D
42 . S DIC=63,DA=LRDFN,DA(63.05)=IX,DR=5,DR(63.05)=19,DIQ="STATUS"
43 . S DIQ(0)="E" D EN^DIQ1
44 . S ^TMP("LRM",$J,"MYCO",0)=$E($P(STATUS(63.05,IX,19,"E")," ",1),1,6)
45 S ISO=0
46 F S ISO=$O(^LR(LRDFN,"MI",IX,9,ISO)) Q:+ISO'>0 D
47 . D FNGS S ^TMP("LRM",$J,"MYCO",ISO)=$S($D(EXPAND):ISO_";"_FUN,1:FUN)
48 . ; Comment
49 . S COM=0
50 . F S COM=$O(^LR(LRDFN,"MI",IX,9,ISO,1,COM)) Q:COM'>0 S ^TMP("LRM",$J,"MYCO",ISO,"COM",COM)=^(COM,0)
51 ; Mycology smear/prep
52 S SMEAR=0
53 F S SMEAR=$O(^LR(LRDFN,"MI",IX,15,SMEAR)) Q:SMEAR'>0 S ^TMP("LRM",$J,"MYCO","SMEAR",SMEAR)=^(SMEAR,0)
54 ; Remark
55 S RMK=0
56 F S RMK=$O(^LR(LRDFN,"MI",IX,10,RMK)) Q:+RMK'>0 S ^TMP("LRM",$J,"MYCO","R",RMK)=^(RMK,0)
57 Q
58FNGS ; Fungus/Yeast
59 N QTY S FUN=+^LR(LRDFN,"MI",IX,9,ISO,0),QTY=$P(^(0),U,2)
60 S FUN=$P(^LAB(61.2,FUN,0),U),FUN=FUN_U_QTY
61 Q
62TB ; Gets Mycobacteriology Work-up
63 N DA,DIC,DIQ,DR,STATUS,GMW,ISO,MB,RMK,X,%X,Y,%Y,COM,MY,GMTB,GMTBA,GMTBF,GMTBL
64 I $D(^LR(LRDFN,"MI",IX,11)) D
65 . S DIC=63,DA=LRDFN,DA(63.05)=IX,DR=5,DR(63.05)="23;24;25",DIQ="STATUS"
66 . S DIQ(0)="E" D EN^DIQ1
67 . ; Status, Acid Fast Stain, Quantity
68 . S ^TMP("LRM",$J,"TB",0)=$E($P(STATUS(63.05,IX,23,"E")," ",1),1,6)_U_STATUS(63.05,IX,24,"E")_U_STATUS(63.05,IX,25,"E")
69 S ISO=0
70 F S ISO=$O(^LR(LRDFN,"MI",IX,12,ISO)) Q:+ISO'>0 D
71 . D MYCB S ^TMP("LRM",$J,"TB",ISO)=$S($D(EXPAND):ISO_";"_MB,1:MB)
72 . ; Comment
73 . S COM=0
74 . F S COM=$O(^LR(LRDFN,"MI",IX,12,ISO,1,COM)) Q:COM'>0 S ^TMP("LRM",$J,"TB",ISO,"COM",COM)=^(COM,0)
75 . ; Susceptiblities
76 . S GMTB=2
77 . F S GMTB=$O(^LR(LRDFN,"MI",IX,12,ISO,GMTB)) Q:GMTB'["2."!(GMTB="") D
78 . . K GMTBL S %X="^DD(63.39,""GL"","_+($G(GMTB))_",1",%Y="GMTBL(" D %XY^%RCR
79 . . S GMTBF=+($O(GMTBL(1,0))),GMTBA=$$GET1^DID(63.39,GMTBF,"","LABEL")
80 . . S ^TMP("LRM",$J,"TB",ISO,"SUSC",GMTB)=GMTBA_U_$P(^LR(LRDFN,"MI",IX,12,ISO,GMTB),U)
81 ; Remark
82 S RMK=0
83 F S RMK=$O(^LR(LRDFN,"MI",IX,13,RMK)) Q:RMK="" S ^TMP("LRM",$J,"TB","R",RMK)=^(RMK,0)
84 Q
85MYCB ; Mycobacterium
86 N QTY S MB=+^LR(LRDFN,"MI",IX,12,ISO,0),QTY=$P(^(0),U,2)
87 S MB=$P(^LAB(61.2,MB,0),U),MB=MB_U_QTY
88 Q
89VIRO ; Gets Virology Work-up
90 N BUG,DA,DIC,DIQ,DR,GMW,ISO,RMK,STATUS
91 I $D(^LR(LRDFN,"MI",IX,16)) D
92 . S DIC=63,DA=LRDFN,DA(63.05)=IX,DR=5,DR(63.05)=34,DIQ="STATUS"
93 . S DIQ(0)="E" D EN^DIQ1
94 . S ^TMP("LRM",$J,"VIRO",0)=$E($P(STATUS(63.05,IX,34,"E")," ",1),1,6)
95 S ISO=0
96 F S ISO=$O(^LR(LRDFN,"MI",IX,17,ISO)) Q:+ISO'>0 D
97 . D PHAGE S ^TMP("LRM",$J,"VIRO",ISO)=$S($D(EXPAND):ISO_";"_BUG,1:BUG)
98 S RMK=0
99 F S RMK=$O(^LR(LRDFN,"MI",IX,18,RMK)) Q:RMK="" S ^TMP("LRM",$J,"VIRO","R",RMK)=^(RMK,0)
100 Q
101PHAGE ; Virus
102 S BUG=+^LR(LRDFN,"MI",IX,17,ISO,0),BUG=$P(^LAB(61.2,BUG,0),U)
103 Q
Note: See TracBrowser for help on using the repository browser.