source: FOIAVistA/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAVAM0.m@ 1154

GMRAVAM0 ;HIRMFO/YMP,WAA,RM-DRIVER FOR VERIFIER ;7/30/04  14:42
 ;;4.0;Adverse Reaction Tracking;**11,21**;Mar 29, 1996
EN1 ; Entry for VERIFY PATIENT REACTION DATA option
 I '$D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) G NOVER
EN2 ;Select the type of Agent to verify
 S (GMRAOUT,GMRADFN)=0
 S DIR("A")="Would you like to verify a single patient's data"
 S DIR(0)="Y",DIR("B")="NO" D ^DIR K DIR I $D(DIRUT) K DIRUT G EXIT
 ;If yes above, D ^DIC on Patient file S GMRADFN=+Y
 I Y D  G:GMRAOUT EXIT
 .W ! S DIC="^DPT(",DIC(0)="AEQM" D ^DIC
 .I +Y<1!($D(DUOUT))!($D(DTOUT)) K DIC,DUOUT,DTOUT S GMRAOUT=1 Q
 .S GMRADFN=+Y
 .K DIC
 .Q
 D FF
 F I="Drug","Non-drug","Both" W !,?20,$E(I,1),?23,I
 K DIR S DIR(0)="SOMBA^D:DRUG;N:NON-DRUG;B:BOTH"
 S DIR("A")="Select type of AGENT to verify:(D/N/B): "
 S DIR("?",1)="ENTER D FOR DRUG AGENTS, N FOR NON-DRUG AGENTS"
 S DIR("?")="OR B FOR BOTH DRUG AND NON DRUG AGENTS."
 D ^DIR K DIR  I "^^"[Y G EXIT
 S GMRAFLAG=$S(Y="D":1,Y="N":0,1:2)
 K Y
 D FF
 S GMRAOUT=0 K ^TMP("GMRAV",$J),^TMP("GMRA",$J)
 I GMRADFN D VERPT
 I 'GMRADFN F GMRADFN=0:0 S GMRADFN=$O(^GMR(120.8,"AVER",GMRADFN)) Q:GMRADFN'>0  D VERPT
 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
 G DISPLAY
 Q
VERPT ; Loop through all Patient GMRADFN's data to be verified and save
 ; in ^TMP("GMRAV",$J array.
 F GMRALL=0:0 S GMRALL=$O(^GMR(120.8,"AVER",GMRADFN,GMRALL)) Q:GMRALL'>0  D ARRAY
 Q
ARRAY S GMRAG=$G(^GMR(120.8,GMRALL,0))
 S %=$P(GMRAG,U,20),GMRADRUG=$S(%["D"&'(%["F"!(%["O")):1,%'["D":0,1:2)
 I GMRAFLAG=2!(GMRADRUG=2)!(GMRAFLAG=GMRADRUG) S ^TMP("GMRAV",$J,$P(^DPT(GMRADFN,0),"^"),$P(GMRAG,"^",2),GMRALL)=GMRAG Q
 Q
DISPLAY ;
 I GMRAOUT G EXIT
 I $O(^TMP("GMRAV",$J,0))="" G EXIT
 K GMRADIG D FF
 W !,?66,"OBS/"
 W !,?4,"PATIENT",?41,"ALLERGY",?66,"HIST",?71,"ADR",?75,"TYPE"
 W !,?4,"-------",?41,"-------",?66,"----",?71,"---",?75,"----",!
 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
 G:GMRAOUT EXIT
 G:$D(GMRADIG) SELL I GMRAOUT G EXIT
SELECT D SEL G:GMRAOUT EXIT
 I $D(GMRAY) G:GMRAY="" EXIT
 I GMRAOUT G EXIT
SELL F GMRAZ=1:1 S GMRANS=$P(GMRAY,",",GMRAZ) Q:GMRANS<1  Q:GMRAOUT!GMRAER  D SELT
 K ^TMP("GMRA",$J)
 G DISPLAY
SELT ;SELECT THE REACTIONS
 D FF
 N GMRAY,GMRAZ
 S GMRACHK=^TMP("GMRA",$J,GMRANS)
 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
 S GMRADRUG=GMRAFLAG,GMRAOUT=0,GMRAOTH=$O(^GMRD(120.83,"B","OTHER REACTION",0)),GMRAPA=+GMRACHK,GMRAPA(0)=$P(GMRACHK,"^",2,999),GMRAVEDT=0
 Q:'$$LOCK^GMRAUTL(120.8,GMRAPA,1)
 D SITE^GMRAUTL,EN1^GMRAPEV0 S GMRALL=GMRAPA,GMRADFN=$P(^GMR(120.8,GMRAPA,0),U) D ARRAY
 I GMRAVER D EN1^GMRAPET0(GMRADFN,GMRAPA,"V",.GMRAOUT) I GMRAOUT S GMRAOUT=0
 I $G(GMRAERR),$G(GMRAOUT) S GMRAOUT=0 ;21
 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)
 D UNLOCK^GMRAUTL(120.8,GMRAPA)
 Q
ALLERPR ;
 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
 Q
WRITE S GMRAG=^TMP("GMRAV",$J,GMRANAME,GMRALLER,GMRAREC)
 S DFN=$P(GMRAG,U) D 1^VADPT S GMRALOC=$P(VAIN(4),"^",2) D PID^VADPT6 S GMRASSN=VA("BID")
 D KVAR^VADPT K VA,VAROOT
 W !,$J(CX,2),".",?4,$E(GMRANAME,1,20)," (",GMRASSN,") ",$E(GMRALOC,1,8),?41,$E(GMRALLER,1,23),?66
 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")
 W ?75 D  ;This code is to allow for more than one type.
 .N X,GMRAY
 .S GMRAY=$P(GMRAG,"^",20)
 .F X=1:1:$L(GMRAY) W:X>1 !,?75 W $P("^FOOD^DRUG^OTHER","^",$F("FDO",$E(GMRAY,X)))
 .Q
 S ^TMP("GMRA",$J,CX)=GMRAREC_"^"_GMRAG
 Q
SCREEN W !,"TYPE '^' TO STOP OR"
 Q:GMRAOUT  D SEL Q:GMRAOUT
 I GMRAY="" D FF Q
 I GMRAOUT Q
 I GMRAER W !?4,$C(7),"ANSWER WITH A NUMBER BETWEEN 1 AND ",CX G SCREEN
 S GMRADIG=1
 Q
SEL ;
 Q:CX<1
 K DIR S DIR(0)="LOA^1:"_CX,DIR("A")="Select a number between 1-"_CX_": "
 S DIR(0)=DIR(0)_"^I X[""."" W !,""DO NOT USE DECIMAL VALUES."",$C(7) K X Q"
 D ^DIR K DIR
 S GMRAY=Y K Y
 I "^^"[GMRAY S GMRAOUT=$L(GMRAY) Q
 S GMRAER=0 F GMRAZ=1:1 S GMRAX=$P(GMRAY,",",GMRAZ) Q:GMRAX<1  D  Q:GMRAER
 .I '$D(^TMP("GMRA",$J,GMRAX)) W !,"ERROR INVALID SELECTION" S GMRAER=1
 .Q
 K GMRAX,GMRAZ Q
NOVER ;
 W !!?5,$C(7),"You do not have the 'GMRA-ALLERGY VERIFY' Security Key."
EXIT ;
 K ^TMP("GMRAV",$J),^TMP("GMRA",$J)
 D KILL^XUSCLEAN
 Q
FF ;
 W #
 Q