111 lines
4.6 KiB
Mathematica
111 lines
4.6 KiB
Mathematica
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
|