source: FOIAVistA/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOORDA.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 9.2 KB
Line 
1PSOORDA ;ISC-BHAM/LC - build detailed allergy list ;12/10/04 8:29am
2 ;;7.0;OUTPATIENT PHARMACY;**44,139,152,186**;DEC 1997
3 ;External reference to EN1^GMRADPT supported by DBIA 10099
4 ;External reference to EN1^GMRAOR2 supported by DBIA 2422
5 ;
6 ;Inpatient Pharmacy's DBIA 2211 allows reference to ^TMP("PSJAL" and ^TMP("PSJDA"
7 ;
8 ;PSO*7*186 Newing of variables to protect their global values
9 ;
10BEG(DFN) N VALMCNT,DR,IEN S GMRA="0^0^111",IEN=0 D EN1^GMRADPT
11 NEW PSONSP S PSONSP=$S($G(PSJINPT):"PSJDA",1:"PSODA")
12 K ^TMP(PSONSP,$J) I 'GMRAL S IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=$S($G(GMRAL)=0:"No Known Allergies",'GMRAL:"Patient has not been asked about allergies",1:"")
13 S (OT,FD,DG,LTO,VY,NVY,VDG,VDGF,VDGFO,VDGO,VFD,VFDO,VOT,NDG,NDGF,NDGFO,NDGO,NFD,NFDO,NOT)=0,(NU,TY)="" D:$G(GMRAL)
14 .F DR=0:0 S DR=$O(GMRAL(DR)) Q:'DR S AG($S($P(GMRAL(DR),"^",4):1,1:2),$P(GMRAL(DR),"^",7),$P(GMRAL(DR),"^",2))=DR_"^"_$P(GMRAL(DR),"^",2)_"^"_+$P(GMRAL(DR),"^",4)_"^"_+$P(GMRAL(DR),"^",8)
15 .F S NU=$O(AG(NU)) Q:'NU S:NU=1 VY=1 S:NU=2 NVY=1 F S TY=$O(AG(NU,TY)) Q:TY="" D
16 ..S:VY&(TY="D") VDG=1 S:VY&(TY="DF") VDGF=1 S:VY&(TY="DFO") VDGFO=1 S:VY&(TY="DO") VDGO=1 S:VY&(TY="F") VFD=1 S:VY&(TY="FO") VFDO=1 S:VY&(TY="O") VOT=1
17 ..S:NVY&(TY="D") NDG=1 S:NVY&(TY="DF") NDGF=1 S:NVY&(TY="DFO") NDGFO=1 S:NVY&(TY="DO") NDGO=1 S:NVY&(TY="F") NFD=1 S:NVY&(TY="FO") NFDO=1 S:NVY&(TY="O") NOT=1
18 .S:VY IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" Verified"
19 .S:VDG IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" Drug: "
20 .S AL="" F S AL=$O(AG(1,"D",AL)) Q:AL="" D
21 ..S DG=DG+1,IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" "_DG_" "_AL,AGN(DG)=$P(AG(1,"D",AL),"^")
22 .S:VDGF IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" Drug/Food: "
23 .S AL="" F S AL=$O(AG(1,"DF",AL)) Q:AL="" D
24 ..S DG=DG+1,IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" "_DG_" "_AL,AGN(DG)=$P(AG(1,"DF",AL),"^")
25 .S:VDGFO IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" Drug/Food/Other: "
26 .S AL="" F S AL=$O(AG(1,"DFO",AL)) Q:AL="" D
27 ..S DG=DG+1,IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" "_DG_" "_AL,AGN(DG)=$P(AG(1,"DFO",AL),"^")
28 .S:VDGO IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" Drug/Other: "
29 .S AL="" F S AL=$O(AG(1,"DO",AL)) Q:AL="" D
30 ..S DG=DG+1,IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" "_DG_" "_AL,AGN(DG)=$P(AG(1,"DO",AL),"^")
31 .S:VFD IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" Food: "
32 .S AL="" F S AL=$O(AG(1,"F",AL)) Q:AL="" D
33 ..S FD=FD+1,IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" "_(FD+DG)_" "_AL,AGN(FD+DG)=$P(AG(1,"F",AL),"^")
34 .S:VFDO IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" Food/Other: "
35 .S AL="" F S AL=$O(AG(1,"FO",AL)) Q:AL="" D
36 ..S FD=FD+1,IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" "_(FD+DG)_" "_AL,AGN(FD+DG)=$P(AG(1,"FO",AL),"^")
37 .S:VOT IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" Other: "
38 .S AL="" F S AL=$O(AG(1,"O",AL)) Q:AL="" D
39 ..S OT=OT+1,IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" "_(OT+FD+DG)_" "_AL,AGN(OT+FD+DG)=$P(AG(1,"O",AL),"^")
40 .S IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" ",LTO=(OT+FD+DG),(OT,FD,DG)=0
41 .S:NVY IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)="Non-Verified"
42 .S:NDG IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" Drug: "
43 .S AL="" F S AL=$O(AG(2,"D",AL)) Q:AL="" D
44 ..S DG=DG+1,IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" "_(DG+LTO)_" "_AL,AGN(DG+LTO)=$P(AG(2,"D",AL),"^")
45 .S:NDGF IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" Drug/Food: "
46 .S AL="" F S AL=$O(AG(2,"DF",AL)) Q:AL="" D
47 ..S DG=DG+1,IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" "_(DG+LTO)_" "_AL,AGN(DG+LTO)=$P(AG(2,"DF",AL),"^")
48 .S:NDGFO IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" Drug/Food/Other: "
49 .S AL="" F S AL=$O(AG(2,"DFO",AL)) Q:AL="" D
50 ..S DG=DG+1,IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" "_(DG+LTO)_" "_AL,AGN(DG+LTO)=$P(AG(2,"DFO",AL),"^")
51 .S:NDGO IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" Drug/Other: "
52 .S AL="" F S AL=$O(AG(2,"DO",AL)) Q:AL="" D
53 ..S DG=DG+1,IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" "_(DG+LTO)_" "_AL,AGN(DG+LTO)=$P(AG(2,"DO",AL),"^")
54 .S:NFD IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" Food: "
55 .S AL="" F S AL=$O(AG(2,"F",AL)) Q:AL="" D
56 ..S FD=FD+1,IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" "_(FD+DG+LTO)_" "_AL,AGN(FD+DG+LTO)=$P(AG(2,"F",AL),"^")
57 .S:NFDO IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" Food/Other: "
58 .S AL="" F S AL=$O(AG(2,"FO",AL)) Q:AL="" D
59 ..S FD=FD+1,IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" "_(FD+DG+LTO)_" "_AL,AGN(FD+DG+LTO)=$P(AG(2,"FO",AL),"^")
60 .S:NOT IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" Other: "
61 .S AL="" F S AL=$O(AG(2,"O",AL)) Q:AL="" D
62 ..S OT=OT+1,IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" "_(OT+FD+DG+LTO)_" "_AL,AGN(OT+FD+DG+LTO)=$P(AG(2,"O",AL),"^")
63 S PSODA=IEN,PSOALL=(OT+FD+DG+LTO)
64 S:$D(PSJINPT) PSJDA=IEN,PSJALL=(OT+FD+DG+LTO)
65 K AL,AG,DG,FD,GMRA,GMRAL,LTO,NU,OT,TY,VY,VDG,VDGF,VDGFO,VDGO,VFD,VFDO,VOT,NDG,NDGF,NDGFO,NDGO,NFD,NFDO,NOT,NVY
66 Q
67SEL ;select allergy for detail display
68 N ORD,ORN,IEN,VALMCNT I '$G(PSOALL) S VALMSG="This patient has no Allergies!" S VALMBCK="" Q
69 K DIR,DUOUT,DIRUT S DIR("A")="Select Allergies by number",DIR(0)="LO^1:"_PSOALL D ^DIR I $D(DTOUT)!($D(DUOUT)) K DIR,DIRUT,DTOUT,DUOUT S VALMBCK="" Q
70SELAL N ORD,ORN,IEN,VALMCNT ;PSO*7*186
71 K DIR,DIRUT,DTOUT,DTOUT S PSOELSE=+Y I +Y S ALST=Y D FULL^VALM1 D
72 .F ORD=1:1:$L(ALST,",") Q:$P(ALST,",",ORD)']"" S ORN=+$P(ALST,",",ORD) D DSPLY(DFN)
73 ;S PSONSP=$S($G(PSJINPT):"PSJAL",1:"PSODA")
74 I 'PSOELSE S VALMBCK=""
75 K ALST,PSOELSE
76 Q
77DSPLY(DFN) ;build detailed allergy display
78 NEW PSONSP S PSONSP=$S($G(PSJINPT):"PSJAL",1:"PSOAL")
79 K ^TMP(PSONSP,$J),AGNL S IEN=0,NB=$G(AGN(ORN)) D EN1^GMRAOR2(NB,"AGNL")
80 S IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" Causative Agent: "_$P(AGNL,"^")
81 S IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" "
82 S ^TMP(PSONSP,$J,IEN,0)=^TMP(PSONSP,$J,IEN,0)_" Severity: "
83 S I="" F S I=$O(AGNL("O",I)) Q:I="" D
84 . I $P(AGNL("O",I),"^",2)="" Q
85 . S X=$$DT(+AGNL("O",I))_" "_$P(AGNL("O",I),"^",2)
86 . I I=$O(AGNL("O","")) S ^TMP(PSONSP,$J,IEN,0)=^TMP(PSONSP,$J,IEN,0)_X Q
87 . S IEN=IEN+1,$E(^TMP(PSONSP,$J,IEN,0),63)=X
88 ;get ingredients
89 S (ING,ING1)="" I $D(AGNL("I")) F IT=0:1 S IN=$O(AGNL("I",IT)) Q:'IN D
90 .S:$L(ING_";"_$P($G(AGNL("I",IN)),"^"))>230 ING1=ING1_";"_$P($G(AGNL("I",IN)),"^")
91 .S:$L(ING_";"_$P($G(AGNL("I",IN)),"^"))<230 ING=ING_";"_$P($G(AGNL("I",IN)),"^")
92 S IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" Ingredients: ",ING=$E(ING,2,99999),ING1=$E(ING1,2,99999)
93ING F IG=1:1:$L(ING) Q:$P(ING,";",IG)="" S LCC=IG,LC=0
94 F IG=1:1:$L(ING) Q:$P(ING,";",IG)="" D
95 .S:$L(^TMP(PSONSP,$J,IEN,0)_$P(ING,";",IG))>50 LC=LC+1,IEN=IEN+1,$P(^TMP(PSONSP,$J,IEN,0)," ",19)=" "
96 .S ^TMP(PSONSP,$J,IEN,0)=$G(^TMP(PSONSP,$J,IEN,0))_$P(ING,";",IG)_$S($G(LC)=0&($G(IG)=LCC):"",$G(IG)<LCC:", ",$G(LC)>0&($G(IG)=LCC):"",$G(LC)>0&($G(IG)<LCC):", ",1:"")
97 I '$D(ING2)&($G(ING1)]"") S ING2=1,ING=ING1 G ING
98 S IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)="" S ODT=$S($D(AGNL("C",1)):$P(AGNL("C",1),"^"),1:"*******.******"),OD=$P(ODT,".")
99 ;
100 ;get drug class
101 S CLS="" I $D(AGNL("V")) F CT=0:1 S CPT=$O(AGNL("V",CT)) Q:'CPT S CLS=CLS_","_$P($G(AGNL("V",CPT)),"^",2)
102 S IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" VA Drug Class: ",CLS=$E(CLS,2,99999)
103 F CG=1:1:$L(CLS) Q:$P(CLS,",",CG)="" S LCC=CG,LC=0
104 F CG=1:1:$L(CLS) Q:$P(CLS,",",CG)="" D
105 .S:$L(^TMP(PSONSP,$J,IEN,0)_$P(CLS,",",CG))>50 IEN=IEN+1,$P(^TMP(PSONSP,$J,IEN,0)," ",19)=" "
106 .S ^TMP(PSONSP,$J,IEN,0)=$G(^TMP(PSONSP,$J,IEN,0))_$P(CLS,",",CG)_$S($G(LC)=0&($G(CG)=LCC):"",$G(CG)<LCC:", ",$G(LC)>0&($G(CG)=LCC):"",$G(LC)>0&($G(CG)<LCC):", ",1:"")
107 ;
108 S IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" Originated: "_$E(OD,4,5)_"/"_$E(OD,6,7)_"/"_$E(OD,2,3)
109 S ^TMP(PSONSP,$J,IEN,0)=^TMP(PSONSP,$J,IEN,0)_" Originator: "_$P(AGNL,"^",2)
110 S IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" Verified: "_$S($P(AGNL,"^",4)="VERIFIED":"Yes",$P(AGNL,"^",4)="NOT VERIFIED":"No ",1:" ")
111 S ^TMP(PSONSP,$J,IEN,0)=^TMP(PSONSP,$J,IEN,0)_" OBS/Hist: "_$P(AGNL,"^",5)
112 S IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=""
113 ;get originator comments
114 S IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" Comments: " ;,ORC=$E(ORC,2,99999)
115 ;S ORC="" I $D(AGNL("C",1)) F ORT=0:0 S ORT=$O(AGNL("C",1,ORT)) Q:'ORT!(ORT>8)!($L(ORC)+$L($G(AGNL("C",1,ORT,0)))>432) S ORC=ORC_";"_$G(AGNL("C",1,ORT,0))
116 ;S ORC=$E(ORC,2,99999) F OG=1:1:$L(ORC) Q:$P(ORC,";",OG)="" S:$L(^TMP(PSONSP,$J,IEN,0)_$P(ORC,";",OG))>75 IEN=IEN+1,$P(^TMP(PSONSP,$J,IEN,0)," ",1)=" " S ^TMP(PSONSP,$J,IEN,0)=$G(^TMP(PSONSP,$J,IEN,0))_" "_$P(ORC,";",OG)
117 I $D(AGNL("C",1)) F ORT=0:0 S ORT=$O(AGNL("C",1,ORT)) Q:'ORT S IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=$G(AGNL("C",1,ORT,0))
118 ;get signs/symptoms
119 S IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=""
120 S SYM="" I $D(AGNL("S")) F SNM=0:0 S SNM=$O(AGNL("S",SNM)) Q:'SNM S SYM=SYM_","_$G(AGNL("S",SNM))
121 S IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" Signs/Symptoms: ",SYM=$E(SYM,2,99999)
122 F SG=1:1:$L(SYM) Q:$P(SYM,",",SG)="" S LCC=SG,LC=0
123 F SG=1:1:$L(SYM) Q:$P(SYM,",",SG)="" D
124 .S:$L(^TMP(PSONSP,$J,IEN,0)_$P(SYM,",",SG))>50 IEN=IEN+1,$P(^TMP(PSONSP,$J,IEN,0)," ",19)=" "
125 .S ^TMP(PSONSP,$J,IEN,0)=$G(^TMP(PSONSP,$J,IEN,0))_$P(SYM,",",SG)_$S($G(LC)=0&($G(SG)=LCC):"",$G(SG)<LCC:", ",$G(LC)>0&($G(SG)=LCC):"",$G(LC)>0&($G(SG)<LCC):", ",1:"")
126 S IEN=IEN+1,^TMP(PSONSP,$J,IEN,0)=" Mechanism: "_$P(AGNL,"^",6)
127 ;
128 I $D(PSJINPT) S PSJAL=IEN D EXT Q
129 S PSOAL=IEN D EN^PSOLMAL
130EXT K AGNL,CG,CLS,CPT,CT,IG,IN,ING,ING1,ING2,IPT,IT,LC,LCC,NB,NUM,OD,ODT,OG,ORC,ORT,SG,SNM,SYM,Y
131 Q
132DT(DT) ; - Convert FM Date to MM/DD/YYYY
133 Q $E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
Note: See TracBrowser for help on using the repository browser.