close Warning: Can't use blame annotator: 
svn blame failed on WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAVAM0.m: 'GenericSWIGWrapper' object has no attribute '_wrap'

source: WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAVAM0.m@ 1464

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

initial load of WorldVistAEHR
File size: 4.6 KB
RevLine 
1GMRAVAM0 ;HIRMFO/YMP,WAA,RM-DRIVER FOR VERIFIER ;7/30/04 14:42
2 ;;4.0;Adverse Reaction Tracking;**11,21**;Mar 29, 1996
3EN1 ; Entry for VERIFY PATIENT REACTION DATA option
4 I '$D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) G NOVER
5EN2 ;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
32VERPT ; 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
36ARRAY 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
40DISPLAY ;
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
50SELECT D SEL G:GMRAOUT EXIT
51 I $D(GMRAY) G:GMRAY="" EXIT
52 I GMRAOUT G EXIT
53SELL 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
56SELT ;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
69ALLERPR ;
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
72WRITE 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
84SCREEN 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
91SEL ;
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
102NOVER ;
103 W !!?5,$C(7),"You do not have the 'GMRA-ALLERGY VERIFY' Security Key."
104EXIT ;
105 K ^TMP("GMRAV",$J),^TMP("GMRA",$J)
106 D KILL^XUSCLEAN
107 Q
108FF ;
109 W #
110 Q
Note: See TracBrowser for help on using the repository browser.