1 | GMTSALG ; SLC/DLT,KER - Allergies ; 01/06/2003
|
---|
2 | ;;2.7;Health Summary;**9,28,49,58**;Oct 20, 1995
|
---|
3 | ;
|
---|
4 | ; External References
|
---|
5 | ; DBIA 10096 ^%ZOSF("TEST"
|
---|
6 | ; DBIA 10035 ^DPT(
|
---|
7 | ; DBIA 905 ^GMR(120.8
|
---|
8 | ; DBIA 2056 $$GET1^DIQ (file #120.86 and #200)
|
---|
9 | ; DBIA 10011 ^DIWP
|
---|
10 | ; DBIA 10099 EN1^GMRADPT
|
---|
11 | ; DBIA 10060 ^VA(200,
|
---|
12 | ; DBIA 3449 ^GMR(120.86,
|
---|
13 | ;
|
---|
14 | ALLRG ; Allergies
|
---|
15 | N X,GMTSALAS,GMTSALAD,GMTSALAW,GMTSALAT,GMTSAV,GMTSAFN,GMRAL,GMTSAL
|
---|
16 | N GMTSALNM,GMTSCNT,GMTSEACT,GMTSLN,GMTSMECH,GMTSPRT,GMTSTY,CC,C,KK
|
---|
17 | N ALLRG,TITLE,JJ K GMTSA S (SEQ,ALLRG)=0,TITLE="ALLERGY/ADVERSE REACTION (AR)"
|
---|
18 | S X="GMRADPT" X ^%ZOSF("TEST")
|
---|
19 | I $T D Q:$D(GMTSQIT)
|
---|
20 | . D GETALLRG D:ALLRG TITLE,ALLRGP D:'ALLRG&($L($G(GMTSALAS))) TITLE,NKA
|
---|
21 | I 'ALLRG,'$L($G(GMTSALAS)) D
|
---|
22 | . I $D(GMTSPNF)&('ALLRG) D CKP^GMTSUP Q:$D(GMTSQIT) W "Unknown, please evaluate",!
|
---|
23 | K ALL,CC,CCC,CD,DIWF,DIWL,DIWR,GMTSALF,GMTSALNM,GMTSNODE,GMTSPRT,I,II,JJ,KK,L,M,MX,N,Z,X,SEQ,GMTSA,ALLRG,TITLE,GMRA,GMRAL,GMTSEACT,GMTSMECH,GMTSTY,GMTSPFN,GMTSAL,GMTSCNT,GMTSLN,ODT
|
---|
24 | Q
|
---|
25 | ALLRGP ; Allergy Print
|
---|
26 | S II="" F S II=$O(GMTSAL(II)) Q:II']"" I $O(GMTSAL(II,""))]"" D
|
---|
27 | . D CKP^GMTSUP Q:$D(GMTSQIT) W !?2,$S(II="D":"Drug:",II="DF":"Drug/Food:",II="DFO":"Drug/Food/Other:",II="DO":"Drug/Other:",II="F":"Food:",II="FO":"Food/Other:",II="O":"Other:",1:II_":")
|
---|
28 | . S JJ="" F S JJ=$O(GMTSAL(II,JJ)) Q:JJ="" D
|
---|
29 | .. N WKK S KK="" F S KK=$O(GMTSAL(II,JJ,KK)) Q:KK="" D
|
---|
30 | ... S L=0 F S L=$O(GMTSAL(II,JJ,KK,L)) Q:'L D CKP^GMTSUP Q:$D(GMTSQIT) D AUTOV W !?5,JJ_": " S:$L(KK)>30 WKK=KK,WKK=$$WRAP^GMTSORC(WKK,30) W ?24,$S($L(KK)>30:$P(WKK,"|"),1:KK) D
|
---|
31 | .... I GMTSAV=1 W " (AV"
|
---|
32 | .... E W $S($P(GMTSAL(II,JJ,KK,L),U,5)=1:" (V",$P(GMTSAL(II,JJ,KK,L),U,5)=0:" (NV",1:"")
|
---|
33 | .... W $S($P($G(^GMR(120.8,GMTSALNM,0)),U,6)="h":"/Historical)",$P($G(^(0)),U,6)="o":"/Observed)",1:")")
|
---|
34 | .... I $L($P($G(WKK),"|",2)) D CKP^GMTSUP Q:$D(GMTSQIT) W !,?24,$P(WKK,"|",2)
|
---|
35 | .... S (M,MX,ALL)=0 F S M=$O(GMTSAL(II,JJ,KK,L,"S",M)) Q:M="" D Q:$D(GMTSQIT)
|
---|
36 | ..... I ALL=0 D CKP^GMTSUP Q:$D(GMTSQIT) W !?27
|
---|
37 | ..... S MX=MX+1
|
---|
38 | ..... W:MX>1 ", "
|
---|
39 | ..... S N=$P(GMTSAL(II,JJ,KK,L,"S",M),";")
|
---|
40 | ..... S ALL=1 I (74)'>($X+$L(N)) D CKP^GMTSUP Q:$D(GMTSQIT) W !,?27,N Q
|
---|
41 | ..... S ALL=1 W N
|
---|
42 | .... D SIGBLK($P(GMTSAFN,U,5))
|
---|
43 | .... D CKP^GMTSUP Q:$D(GMTSQIT) W !,?24,"Date/Time: " S ODT=$P(GMTSAFN,U,4) S X=ODT D REGDTM4^GMTSU W X,!
|
---|
44 | ....S CC="" F S CC=$O(^GMR(120.8,GMTSALNM,26,"B",CC)) Q:CC="" D CKP^GMTSUP Q:$D(GMTSQIT) W !,?24,"Comments at: " S X=CC D REGDTM4^GMTSU S CD=X S CCC=0 F S CCC=$O(^GMR(120.8,GMTSALNM,26,"B",CC,CCC)) Q:'CCC D TEXT
|
---|
45 | Q
|
---|
46 | NKA ; No known allergies
|
---|
47 | D CKP^GMTSUP Q:$D(GMTSQIT) W:$L($G(GMTSALAS))!($L($G(GMTSALAD))) !
|
---|
48 | D CKP^GMTSUP Q:$D(GMTSQIT) W:$L($G(GMTSALAS)) ?22,$G(GMTSALAS),!
|
---|
49 | D CKP^GMTSUP Q:$D(GMTSQIT) W:$L($G(GMTSALAS))!($L($G(GMTSALAD)))!($L($G(GMTSALAW))) ?24,"Assessment date: ",$G(GMTSALAD),!
|
---|
50 | D CKP^GMTSUP Q:$D(GMTSQIT) W:$L($G(GMTSALAW)) ?28,"Assessed by: ",GMTSALAW,!
|
---|
51 | D CKP^GMTSUP Q:$D(GMTSQIT) W:$L($G(GMTSALAW))&($L($G(GMTSALAT))) ?34,"Title: ",GMTSALAT,!
|
---|
52 | Q
|
---|
53 | GETALLRG ; Get Allergies
|
---|
54 | S GMRA="0^0^111" D EN1^GMRADPT I GMRAL="" S ALLRG=0 Q
|
---|
55 | I +($G(DFN))>0,+($G(GMRAL))=0 D ALLAS S ALLRG=0 Q
|
---|
56 | I $D(GMRAL)>9 D
|
---|
57 | . S I=0 F GMTSCNT=1:1 S I=$O(GMRAL(I)) Q:'I D
|
---|
58 | .. S GMTSTY=$P(GMRAL(I),U,7) Q:GMTSTY']""
|
---|
59 | .. S GMTSEACT=$P(GMRAL(I),U,2) Q:GMTSEACT']""
|
---|
60 | .. S GMTSMECH=$P($P(GMRAL(I),U,8),";")
|
---|
61 | .. S:GMTSMECH']"" GMTSMECH="UNKNOWN"
|
---|
62 | .. S GMTSAL(GMTSTY,GMTSMECH,GMTSEACT,GMTSCNT)=I_"^"_GMRAL(I)
|
---|
63 | .. S JJ=0 F S JJ=$O(GMRAL(I,"S",JJ)) Q:'JJ S GMTSAL(GMTSTY,GMTSMECH,GMTSEACT,GMTSCNT,"S",JJ)=GMRAL(I,"S",JJ)
|
---|
64 | .. S ALLRG=1
|
---|
65 | Q
|
---|
66 | ALLAS ; Allergy Assessment
|
---|
67 | N X,GMTSALG1,GMTSALG2,GMTSALG3,GMTSAU S (GMTSALAS,GMTSALAD,GMTSALAW)="" S GMTSALAS="No known allergies"
|
---|
68 | S GMTSALAD=$$GET1^DIQ(120.86,+($G(DFN)),3,"I",,"GMTSALG2") S:$D(GMTSALG2) GMTSALAD="" S:+GMTSALAD=0 GMTSALAD=""
|
---|
69 | I +GMTSALAD>0 S X=GMTSALAD D REGDT4^GMTSU S GMTSALAD=X
|
---|
70 | S GMTSAU=$$GET1^DIQ(120.86,+($G(DFN)),2,"I")
|
---|
71 | S GMTSALAW=$$GET1^DIQ(200,(+GMTSAU_","),.01,"E",,"GMTSALG3")
|
---|
72 | S GMTSALAT=$$GET1^DIQ(200,(+GMTSAU_","),20.3)
|
---|
73 | S:$D(GMTSALG3) (GMTSALAW,GMTSALAT)=""
|
---|
74 | Q
|
---|
75 | AUTOV ; Autoverify
|
---|
76 | S GMTSAV=0,GMTSALNM=$P(GMTSAL(II,JJ,KK,L),U),GMTSAFN=$G(^GMR(120.8,GMTSALNM,0))
|
---|
77 | I $P(GMTSAFN,U,18)="",$P(GMTSAFN,U,16)=1 S GMTSAV=1
|
---|
78 | Q
|
---|
79 | TITLE ; Print title
|
---|
80 | D CKP^GMTSUP Q:$D(GMTSQIT)
|
---|
81 | I $D(GMTSPNF) W ?21,TITLE,!
|
---|
82 | E W ?21,"Title: ",TITLE,!
|
---|
83 | Q
|
---|
84 | TEXT ; Setup for print of allergy comments
|
---|
85 | W ?31,CD D CKP^GMTSUP Q:$D(GMTSQIT)
|
---|
86 | K ^UTILITY($J,"W") S GMTSLN=0 F S GMTSLN=$O(^GMR(120.8,GMTSALNM,26,CCC,2,GMTSLN)) Q:'GMTSLN S GMTSPRT=^GMR(120.8,GMTSALNM,26,CCC,2,GMTSLN,0) D FORMAT
|
---|
87 | I $D(^UTILITY($J,"W")) F GMTSLN=1:1:^UTILITY($J,"W",DIWL) D LINE Q:$D(GMTSQIT)
|
---|
88 | K ^UTILITY($J,"W")
|
---|
89 | Q:'GMTSLN
|
---|
90 | W ! Q
|
---|
91 | FORMAT ; Formats each line
|
---|
92 | S DIWL=3,DIWR=80,DIWF="C58",X=GMTSPRT D ^DIWP
|
---|
93 | Q
|
---|
94 | LINE ; Writes formatted lines of text
|
---|
95 | D CKP^GMTSUP Q:$D(GMTSQIT) W !,?24,^UTILITY($J,"W",DIWL,GMTSLN,0)
|
---|
96 | Q
|
---|
97 | SIGBLK(GMTSALF) ; Signature block
|
---|
98 | Q:+GMTSALF'>0 N GMTSSB,GMTSST,GMTSSN S GMTSSB=$$GET1^DIQ(200,(+GMTSALF_","),20.2),GMTSST=$$GET1^DIQ(200,(+GMTSALF_","),20.3),GMTSSN=$$GET1^DIQ(200,(+GMTSALF_","),.01)
|
---|
99 | D CKP^GMTSUP Q:$D(GMTSQIT) W !!,?24,"Originator: ",$S(GMTSSB'="":GMTSSB,1:GMTSSN)
|
---|
100 | D CKP^GMTSUP Q:$D(GMTSQIT) W:$L(GMTSST) !,?24,"Title: ",GMTSST
|
---|
101 | Q
|
---|