1 | GMTSLRME ; SLC/JER,KER - Microbiology Extract Routine ; 08/27/2002
|
---|
2 | ;;2.7;Health Summary;**25,28,37,56**;Oct 20, 1995
|
---|
3 | ;
|
---|
4 | ; External References
|
---|
5 | ; DBIA 67 ^LAB(60
|
---|
6 | ; DBIA 525 ^LR(
|
---|
7 | ; DBIA 531 ^LRO(68
|
---|
8 | ; DBIA 10006 ^DIC
|
---|
9 | ; DBIA 10007 MIX^DIC1
|
---|
10 | ; DBIA 2056 $$GET1^DIQ
|
---|
11 | ; DBIA 10015 EN^DIQ1
|
---|
12 | ;
|
---|
13 | XTRCT ; Extract
|
---|
14 | N ACC,CDT,SS,CS,X,DIC,DIQ,DA,DR,MICRO,LOC,RDT,MICCOM K ^TMP("LRM",$J)
|
---|
15 | S X=$P(^LR(LRDFN,"MI",IX,0),U),RDT=$P(^(0),U,3),ACC=$P(^(0),U,6),LOC=$P(^(0),U,8) D REGDTM4^GMTSU S CDT=X K X
|
---|
16 | D LABTEST($P(^LR(LRDFN,"MI",IX,0),U),ACC)
|
---|
17 | ; Get External format of site/specimen
|
---|
18 | ; collection sample, and comment
|
---|
19 | S DIC=63,DIQ="MICRO",DIQ(0)="E",DA=LRDFN,DA(63.05)=IX,DR=5,DR(63.05)=".05;.055;.99"
|
---|
20 | D EN^DIQ1
|
---|
21 | S SS=MICRO(63.05,IX,.05,"E")
|
---|
22 | S CS=MICRO(63.05,IX,.055,"E"),MICCOM=MICRO(63.05,IX,.99,"E")
|
---|
23 | S ^TMP("LRM",$J,0)=CDT_U_ACC_U_SS I $D(EXPAND) S ^TMP("LRM",$J,0)=^TMP("LRM",$J,0)_U_RDT_U_LOC
|
---|
24 | S $P(^TMP("LRM",$J,0),U,6)=CS_U_MICCOM
|
---|
25 | D ABXLEV,BACT,GRAM,STER,PARA^GMTSLRMX,MYCO^GMTSLRMX,TB^GMTSLRMX,VIRO^GMTSLRMX
|
---|
26 | Q
|
---|
27 | BACT ; Get Bacteriology Work-up
|
---|
28 | N DA,DIC,DIQ,DR,STATUS,ISO,ORG,RMK,COM,SMEAR
|
---|
29 | ; Work up
|
---|
30 | I $D(^LR(LRDFN,"MI",IX,1)) D
|
---|
31 | . S DIC=63,DA=LRDFN,DA(63.05)=IX,DR=5,DR(63.05)="11.5;11.51;11.57;11.58",DIQ="STATUS"
|
---|
32 | . S DIQ(0)="E" D EN^DIQ1
|
---|
33 | . ; Include Status, sputum screen, and urine screen
|
---|
34 | . S ^TMP("LRM",$J,"BACT",0)=$E($P(STATUS(63.05,IX,11.5,"E")," ",1),1,6)_U_STATUS(63.05,IX,11.58,"E")_U_STATUS(63.05,IX,11.57,"E")
|
---|
35 | . ; Include sterility control
|
---|
36 | . S ^TMP("LRM",$J,"BSTER",0)=STATUS(63.05,IX,11.51,"E")
|
---|
37 | S ISO=0 F S ISO=$O(^LR(LRDFN,"MI",IX,3,ISO)) Q:+ISO'>0 D
|
---|
38 | . D ORGNSM S ^TMP("LRM",$J,"BACT",ISO)=$S($D(EXPAND):ISO_";"_ORG,1:ORG)
|
---|
39 | . I $O(^LR(LRDFN,"MI",IX,3,ISO,1)) D ANTIBX
|
---|
40 | . ; Get Comment
|
---|
41 | . S COM=0
|
---|
42 | . F S COM=$O(^LR(LRDFN,"MI",IX,3,ISO,1,COM)) Q:COM'>0 S ^TMP("LRM",$J,"BACT",ISO,"COM",COM)=^(COM,0)
|
---|
43 | ; Bacteriology smear/prep
|
---|
44 | S SMEAR=0
|
---|
45 | F S SMEAR=$O(^LR(LRDFN,"MI",IX,25,SMEAR)) Q:SMEAR'>0 S ^TMP("LRM",$J,"BACT","SMEAR",SMEAR)=^(SMEAR,0)
|
---|
46 | ; Get Remark
|
---|
47 | S RMK=0
|
---|
48 | F S RMK=$O(^LR(LRDFN,"MI",IX,4,RMK)) Q:RMK="" S ^TMP("LRM",$J,"BACT","R",RMK)=^(RMK,0)
|
---|
49 | Q
|
---|
50 | ORGNSM ; Get Organism
|
---|
51 | N QTY
|
---|
52 | S ORG=+^LR(LRDFN,"MI",IX,3,ISO,0),QTY=$P(^(0),U,2)
|
---|
53 | S ORG=$$GET1^DIQ(61.2,ORG,.01,"I")
|
---|
54 | S ORG=ORG_U_QTY
|
---|
55 | Q
|
---|
56 | ANTIBX ; Get Antibitiotic susceptibility results on demand
|
---|
57 | N ABX S ABX=1
|
---|
58 | F S ABX=$O(^LR(LRDFN,"MI",IX,3,ISO,ABX)) Q:ABX=""!(ABX'<3) D ABXSET
|
---|
59 | Q
|
---|
60 | ABXSET ; Antibiotic Susceptability Data
|
---|
61 | ; Separate out by Susceptable, Intermediate, and Resistant
|
---|
62 | N FOUND,GMTSR,GMABX,ABXI,ABXNM,ABXN
|
---|
63 | S ABXI=$$ABXI(ABX),ABXNM=$$ABXNM(ABXI),ABXN=ABX_";"_ABXNM
|
---|
64 | I $P(ABXN,";",2)']"" S $P(ABXN,";",2)="UNKNOWN"
|
---|
65 | I ("A"[$P(^LR(LRDFN,"MI",IX,3,ISO,ABX),U,3)) D
|
---|
66 | . S GMABX=$G(^LR(LRDFN,"MI",IX,3,ISO,ABX))
|
---|
67 | . ; Check for interpreted result (S, I, or R) first
|
---|
68 | . S FOUND=0
|
---|
69 | . S GMTSR=$P(GMABX,U,2) D SAVE Q:FOUND
|
---|
70 | . ; If not found then check reported result (S,I, or R)
|
---|
71 | . S GMTSR=$P(GMABX,U) D SAVE Q:FOUND
|
---|
72 | . ; Neither interpreted nor reported result equaled
|
---|
73 | . ; S, I, or R so we'll store it in the "other" list
|
---|
74 | . ; provided that reported and interpreted are both
|
---|
75 | . ; not null
|
---|
76 | . S:$P(GMABX,U)'=""&($P(GMABX,U,2)'="") ^TMP("LRM",$J,"BACT",ISO,"SUSC","O",$P($P(ABXN,U),";",2))=ABXN_U_GMABX
|
---|
77 | Q
|
---|
78 | ABXI(X) ; Antibiotic Susceptability IEN
|
---|
79 | S X=$G(X) Q:'$L(X) 0 N DIC,DTOUT,DUOUT,Y S DIC="^LAB(62.06,",D="AD",DIC(0)="" D MIX^DIC1 S X=+($G(Y)) S:X'>0 X=0 Q X
|
---|
80 | ABXNM(X) ; Antibiotic Susceptability Name
|
---|
81 | S X=$G(X) Q:+X'>0 "" S X=$$GET1^DIQ(62.06,+X,.01) Q X
|
---|
82 | ABXLEV ; Get Serum antibiotic level
|
---|
83 | Q:'$D(^LR(LRDFN,"MI",IX,14)) N GMI S GMI=0
|
---|
84 | F S GMI=$O(^LR(LRDFN,"MI",IX,14,GMI)) Q:GMI'>0 S ^TMP("LRM",$J,"CABXL",GMI)=$G(^(GMI,0))
|
---|
85 | Q
|
---|
86 | STER ; Get sterility results if they exist
|
---|
87 | N RESULT,STER S STER=0
|
---|
88 | F S STER=$O(^LR(LRDFN,"MI",IX,31,STER)) Q:STER'>0 D
|
---|
89 | . S DIQ(0)="E",DIC=63,DA=LRDFN,DA(63.05)=IX,DR=5,DR(63.05)=11.52
|
---|
90 | . S DR(63.292)=.01,DIQ="RESULT"
|
---|
91 | . S DA(63.292)=STER
|
---|
92 | . D EN^DIQ1
|
---|
93 | . S ^TMP("LRM",$J,"BSTER",STER)=RESULT(63.292,STER,.01,"E")
|
---|
94 | Q
|
---|
95 | GRAM ; Get Gram Stain Results
|
---|
96 | N ISO Q:'$D(^LR(LRDFN,"MI",IX,2)) S ISO=0
|
---|
97 | F S ISO=$O(^LR(LRDFN,"MI",IX,2,ISO)) Q:ISO="" S ^TMP("LRM",$J,"GRAM",ISO)=^(ISO,0)
|
---|
98 | Q
|
---|
99 | LABTEST(SDT,LRACC) ; Get lab test names and results
|
---|
100 | N X,Y,LRAA,LRAN,LRAD,LRBRR,LRTSTS,LRTS
|
---|
101 | S LRAD=+$E(SDT)_$P(LRACC," ",2)_"0000",X=$P(LRACC," "),DIC=68,DIC(0)="M"
|
---|
102 | Q:'$L(X) D ^DIC S LRAA=+Y,LRAN=+$P(LRACC," ",3)
|
---|
103 | S LRBRR=0
|
---|
104 | F S LRBRR=+$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRBRR)) Q:LRBRR'>0 D
|
---|
105 | . S LRTS=+^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRBRR,0),LRTS(1)=$P(^(0),U,5)
|
---|
106 | . Q:"BO"'[$P($G(^LAB(60,LRTS,0)),U,3)
|
---|
107 | . S LRTSTS=$S($D(^LAB(60,LRTS,0)):$P(^(0),U),1:"deleted test")
|
---|
108 | . ; Lab test name and results in print order
|
---|
109 | . S ^TMP("LRM",$J,0,"TEST",$S($D(^LAB(60,LRTS,.1)):$P(^(.1),U,6),1:"")_","_U_LRBRR)=LRTSTS_U_LRTS(1)
|
---|
110 | Q
|
---|
111 | SAVE ; If result = S, I, or R then save
|
---|
112 | I $S(GMTSR="I":1,GMTSR="R":1,GMTSR="S":1,1:0) S ^TMP("LRM",$J,"BACT",ISO,"SUSC",GMTSR,$P($P(ABXN,U),";",2))=ABXN_U_GMABX S FOUND=1
|
---|
113 | Q
|
---|