1 | GMRAVAM0 ;HIRMFO/YMP,WAA,RM-DRIVER FOR VERIFIER ;7/30/04 14:42
|
---|
2 | ;;4.0;Adverse Reaction Tracking;**11,21**;Mar 29, 1996
|
---|
3 | EN1 ; Entry for VERIFY PATIENT REACTION DATA option
|
---|
4 | I '$D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) G NOVER
|
---|
5 | EN2 ;Select the type of Agent to verify
|
---|
6 | S (GMRAOUT,GMRADFN)=0
|
---|
7 | S DIR("A")="Would you like to verify a single patient's data"
|
---|
8 | S DIR(0)="Y",DIR("B")="NO" D ^DIR K DIR I $D(DIRUT) K DIRUT G EXIT
|
---|
9 | ;If yes above, D ^DIC on Patient file S GMRADFN=+Y
|
---|
10 | I Y D G:GMRAOUT EXIT
|
---|
11 | .W ! S DIC="^DPT(",DIC(0)="AEQM" D ^DIC
|
---|
12 | .I +Y<1!($D(DUOUT))!($D(DTOUT)) K DIC,DUOUT,DTOUT S GMRAOUT=1 Q
|
---|
13 | .S GMRADFN=+Y
|
---|
14 | .K DIC
|
---|
15 | .Q
|
---|
16 | D FF
|
---|
17 | F I="Drug","Non-drug","Both" W !,?20,$E(I,1),?23,I
|
---|
18 | K DIR S DIR(0)="SOMBA^D:DRUG;N:NON-DRUG;B:BOTH"
|
---|
19 | S DIR("A")="Select type of AGENT to verify:(D/N/B): "
|
---|
20 | S DIR("?",1)="ENTER D FOR DRUG AGENTS, N FOR NON-DRUG AGENTS"
|
---|
21 | S DIR("?")="OR B FOR BOTH DRUG AND NON DRUG AGENTS."
|
---|
22 | D ^DIR K DIR I "^^"[Y G EXIT
|
---|
23 | S GMRAFLAG=$S(Y="D":1,Y="N":0,1:2)
|
---|
24 | K Y
|
---|
25 | D FF
|
---|
26 | S GMRAOUT=0 K ^TMP("GMRAV",$J),^TMP("GMRA",$J)
|
---|
27 | I GMRADFN D VERPT
|
---|
28 | I 'GMRADFN F GMRADFN=0:0 S GMRADFN=$O(^GMR(120.8,"AVER",GMRADFN)) Q:GMRADFN'>0 D VERPT
|
---|
29 | I $O(^TMP("GMRAV",$J,""))="" W !,$C(7),"There isn't any ",$S(GMRAFLAG=1:"drug ",GMRAFLAG=0:"non-drug ",1:""),"allergy data to verify.",! G EN1
|
---|
30 | G DISPLAY
|
---|
31 | Q
|
---|
32 | VERPT ; Loop through all Patient GMRADFN's data to be verified and save
|
---|
33 | ; in ^TMP("GMRAV",$J array.
|
---|
34 | F GMRALL=0:0 S GMRALL=$O(^GMR(120.8,"AVER",GMRADFN,GMRALL)) Q:GMRALL'>0 D ARRAY
|
---|
35 | Q
|
---|
36 | ARRAY S GMRAG=$G(^GMR(120.8,GMRALL,0))
|
---|
37 | S %=$P(GMRAG,U,20),GMRADRUG=$S(%["D"&'(%["F"!(%["O")):1,%'["D":0,1:2)
|
---|
38 | I GMRAFLAG=2!(GMRADRUG=2)!(GMRAFLAG=GMRADRUG) S ^TMP("GMRAV",$J,$P(^DPT(GMRADFN,0),"^"),$P(GMRAG,"^",2),GMRALL)=GMRAG Q
|
---|
39 | Q
|
---|
40 | DISPLAY ;
|
---|
41 | I GMRAOUT G EXIT
|
---|
42 | I $O(^TMP("GMRAV",$J,0))="" G EXIT
|
---|
43 | K GMRADIG D FF
|
---|
44 | W !,?66,"OBS/"
|
---|
45 | W !,?4,"PATIENT",?41,"ALLERGY",?66,"HIST",?71,"ADR",?75,"TYPE"
|
---|
46 | W !,?4,"-------",?41,"-------",?66,"----",?71,"---",?75,"----",!
|
---|
47 | S GMRANAME="",CX=0 F S GMRANAME=$O(^TMP("GMRAV",$J,GMRANAME)) Q:GMRANAME=""!GMRAOUT S GMRALLER="" D ALLERPR Q:CX<1 I GMRAOUT Q
|
---|
48 | G:GMRAOUT EXIT
|
---|
49 | G:$D(GMRADIG) SELL I GMRAOUT G EXIT
|
---|
50 | SELECT D SEL G:GMRAOUT EXIT
|
---|
51 | I $D(GMRAY) G:GMRAY="" EXIT
|
---|
52 | I GMRAOUT G EXIT
|
---|
53 | SELL F GMRAZ=1:1 S GMRANS=$P(GMRAY,",",GMRAZ) Q:GMRANS<1 Q:GMRAOUT!GMRAER D SELT
|
---|
54 | K ^TMP("GMRA",$J)
|
---|
55 | G DISPLAY
|
---|
56 | SELT ;SELECT THE REACTIONS
|
---|
57 | D FF
|
---|
58 | N GMRAY,GMRAZ
|
---|
59 | S GMRACHK=^TMP("GMRA",$J,GMRANS)
|
---|
60 | S DFN=$P(GMRACHK,"^",2) D 1^VADPT S GMRALOC=$P(VAIN(4),"^",2),GMRANAM=VADM(1),GMRASEX=VADM(5) D KVAR^VADPT K VA,VAROOT
|
---|
61 | S GMRADRUG=GMRAFLAG,GMRAOUT=0,GMRAOTH=$O(^GMRD(120.83,"B","OTHER REACTION",0)),GMRAPA=+GMRACHK,GMRAPA(0)=$P(GMRACHK,"^",2,999),GMRAVEDT=0
|
---|
62 | Q:'$$LOCK^GMRAUTL(120.8,GMRAPA,1)
|
---|
63 | D SITE^GMRAUTL,EN1^GMRAPEV0 S GMRALL=GMRAPA,GMRADFN=$P(^GMR(120.8,GMRAPA,0),U) D ARRAY
|
---|
64 | I GMRAVER D EN1^GMRAPET0(GMRADFN,GMRAPA,"V",.GMRAOUT) I GMRAOUT S GMRAOUT=0
|
---|
65 | I $G(GMRAERR),$G(GMRAOUT) S GMRAOUT=0 ;21
|
---|
66 | I GMRAERR!GMRAVER S GMRANAME=$P($G(^DPT(+GMRAPA(0),0)),U),GMRALLER=$P(GMRAPA(0),U,2) K:GMRANAME]""&(GMRALLER]"") ^TMP("GMRAV",$J,GMRANAME,GMRALLER,GMRAPA)
|
---|
67 | D UNLOCK^GMRAUTL(120.8,GMRAPA)
|
---|
68 | Q
|
---|
69 | ALLERPR ;
|
---|
70 | F S GMRALLER=$O(^TMP("GMRAV",$J,GMRANAME,GMRALLER)) Q:GMRALLER=""!GMRAOUT!$D(GMRADIG) F GMRAREC=0:0 S GMRAREC=$O(^TMP("GMRAV",$J,GMRANAME,GMRALLER,GMRAREC)) Q:GMRAREC'>0 D:$Y>(IOSL-5) SCREEN Q:GMRAOUT!$D(GMRADIG) S CX=CX+1 D WRITE
|
---|
71 | Q
|
---|
72 | WRITE S GMRAG=^TMP("GMRAV",$J,GMRANAME,GMRALLER,GMRAREC)
|
---|
73 | S DFN=$P(GMRAG,U) D 1^VADPT S GMRALOC=$P(VAIN(4),"^",2) D PID^VADPT6 S GMRASSN=VA("BID")
|
---|
74 | D KVAR^VADPT K VA,VAROOT
|
---|
75 | W !,$J(CX,2),".",?4,$E(GMRANAME,1,20)," (",GMRASSN,") ",$E(GMRALOC,1,8),?41,$E(GMRALLER,1,23),?66
|
---|
76 | W $S($P(GMRAG,"^",6)="o":"OBS",$P(GMRAG,"^",6)="h":"HIST",1:""),?71,$S($P(GMRAG,"^",14)="A":"NO",$P(GMRAG,"^",14)="P":"YES",1:"UNK")
|
---|
77 | W ?75 D ;This code is to allow for more than one type.
|
---|
78 | .N X,GMRAY
|
---|
79 | .S GMRAY=$P(GMRAG,"^",20)
|
---|
80 | .F X=1:1:$L(GMRAY) W:X>1 !,?75 W $P("^FOOD^DRUG^OTHER","^",$F("FDO",$E(GMRAY,X)))
|
---|
81 | .Q
|
---|
82 | S ^TMP("GMRA",$J,CX)=GMRAREC_"^"_GMRAG
|
---|
83 | Q
|
---|
84 | SCREEN W !,"TYPE '^' TO STOP OR"
|
---|
85 | Q:GMRAOUT D SEL Q:GMRAOUT
|
---|
86 | I GMRAY="" D FF Q
|
---|
87 | I GMRAOUT Q
|
---|
88 | I GMRAER W !?4,$C(7),"ANSWER WITH A NUMBER BETWEEN 1 AND ",CX G SCREEN
|
---|
89 | S GMRADIG=1
|
---|
90 | Q
|
---|
91 | SEL ;
|
---|
92 | Q:CX<1
|
---|
93 | K DIR S DIR(0)="LOA^1:"_CX,DIR("A")="Select a number between 1-"_CX_": "
|
---|
94 | S DIR(0)=DIR(0)_"^I X[""."" W !,""DO NOT USE DECIMAL VALUES."",$C(7) K X Q"
|
---|
95 | D ^DIR K DIR
|
---|
96 | S GMRAY=Y K Y
|
---|
97 | I "^^"[GMRAY S GMRAOUT=$L(GMRAY) Q
|
---|
98 | S GMRAER=0 F GMRAZ=1:1 S GMRAX=$P(GMRAY,",",GMRAZ) Q:GMRAX<1 D Q:GMRAER
|
---|
99 | .I '$D(^TMP("GMRA",$J,GMRAX)) W !,"ERROR INVALID SELECTION" S GMRAER=1
|
---|
100 | .Q
|
---|
101 | K GMRAX,GMRAZ Q
|
---|
102 | NOVER ;
|
---|
103 | W !!?5,$C(7),"You do not have the 'GMRA-ALLERGY VERIFY' Security Key."
|
---|
104 | EXIT ;
|
---|
105 | K ^TMP("GMRAV",$J),^TMP("GMRA",$J)
|
---|
106 | D KILL^XUSCLEAN
|
---|
107 | Q
|
---|
108 | FF ;
|
---|
109 | W #
|
---|
110 | Q
|
---|