GMRAPEE0 ;HIRMFO/YMP,RM-ENTERRED IN ERROR CHECK ;01-Feb-2011 09:49;DU
;;4.0;Adverse Reaction Tracking;**2,1002**;Mar 29, 1996;Build 32
;IHS/MSC/MGH Inactivate an entry
EN1 ; ENTRY TO SET GMRAERR IF THIS ALLERGY HAS BEEN ENTERED IN ERROR
S GMRAERR=0
K GMRAHEAD S GMRAPRNT=0 D EN1^GMRADSP2
S:GMRAOUT GMRAOUT=GMRAOUT-1 Q:GMRAOUT
I $P(^GMR(120.8,GMRAPA,0),U,16),$P(^(0),U,18)'="",'$D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) Q
YNEE K GMRAEIE W !,"Is the reaction information correct" S %=1 D YN^DICN I '% W !?4,$C(7),"ANSWER NO IF THIS ALLERGY IS INCORRECT AND NEEDS TO BE MARKED",!?4,"AS ENTERED IN ERROR, ELSE ANSWER YES." G YNEE
I %=-1 S GMRAOUT=1 K GMRAPRCT Q
I %=2 D I $G(GMRAIN)=1 G YNEE
.K DIR S DIR(0)="Y",DIR("A")="Mark this reaction as 'Entered-in-Error'"
.D ^DIR K DIR I $D(DIRUT)!(Y=0) S GMRAEIE=1
.I Y=1 D Q
..S GMRAERR=1,DIE="^GMR(120.8,",DA=GMRAPA,DR="22///1;23///NOW;24////"_DUZ D ^DIE
..D SITE^GMRAUTL S GMRASITE(0)=$G(^GMRD(120.84,GMRASITE,0))
..I $P(GMRASITE(0),U,11) S GMRAVCM="E" D ENDING^GMRAPEM1
..D EN1^GMRAPET0($P(^GMR(120.8,GMRAPA,0),U),GMRAPA,"E",.GMRAOUT)
..D EN1^GMRAEAB
..D ; Execute the event point for this reaction
...Q:'$D(GMRAPA) S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""
...N OROLD,DFN S DFN=$P(GMRAPA(0),U)
...D INP^VADPT S X=$O(^ORD(101,"B","GMRA ENTERED IN ERROR",0))_";ORD(101," D EN^XQOR:X K VAIN,X
...Q
.;MSC/IHS/MGH INACTIVATE AN ENTRY
.K DIR S DIR(0)="Y",DIR("A")="Inactivate this reaction"
.D ^DIR K DIR I $D(DIRUT)!(Y=0)
.I Y=1 D Q
..N WHY,AIEN,FDA,IEN,ERR,FNUM
..S WHY=$$REA
..S FNUM=120.899999912
..S AIEN="+1,"_GMRAPA_","
..S FDA(120.899999912,AIEN,1)=WHY
..S FDA(120.899999912,AIEN,.01)=$$NOW^XLFDT
..S FDA(120.899999912,AIEN,2)=DUZ
..D UPDATE^DIE(,"FDA","IEN","ERR")
..I $D(ERR("DIERR")) W !,"Unable to inactivate allergy"
..S GMRAOUT=1
..K FDA,IEN,ERR
.; This patch (#2) will loop through the patient reactions
.; and ensure that the patient's NKA information is marked
.; based on the existence of patient reactions.
.I $$NKASCR^GMRANKA($P(^GMR(120.8,GMRAPA,0),U)) D ; true NKA
..S DIK="^GMR(120.86,",DA=$P(^GMR(120.8,GMRAPA,0),U)
..D ^DIK ; purge the NKA node from 120.86
..Q
.Q
K %,DA,DIE,DR,GMRASITE
Q
REA() ;GET THE REASON
N DA,DIC,DR,Y
S DIC=90460.05
S DIC(0)="AEMQ"
S DIC("S")="I $P(^(0),U,2)=""I"""
S DIC("A")="Select reason: "
D ^DIC I $D(DIRUT) K DIRUT Q -1
Q +Y
GMRAPEE0 ;HIRMFO/YMP,RM-ENTERRED IN ERROR CHECK ;01-Feb-2011 09:49;DU
+1 ;;4.0;Adverse Reaction Tracking;**2,1002**;Mar 29, 1996;Build 32
+2 ;IHS/MSC/MGH Inactivate an entry
EN1 ; ENTRY TO SET GMRAERR IF THIS ALLERGY HAS BEEN ENTERED IN ERROR
+1 SET GMRAERR=0
+2 KILL GMRAHEAD
SET GMRAPRNT=0
DO EN1^GMRADSP2
+3 IF GMRAOUT
SET GMRAOUT=GMRAOUT-1
IF GMRAOUT
QUIT
+4 IF $PIECE(^GMR(120.8,GMRAPA,0),U,16)
IF $PIECE(^(0),U,18)'=""
IF '$DATA(^XUSEC("GMRA-ALLERGY VERIFY",DUZ))
QUIT
YNEE KILL GMRAEIE
WRITE !,"Is the reaction information correct"
SET %=1
DO YN^DICN
IF '%
WRITE !?4,$CHAR(7),"ANSWER NO IF THIS ALLERGY IS INCORRECT AND NEEDS TO BE MARKED",!?4,"AS ENTERED IN ERROR, ELSE ANSWER YES."
GOTO YNEE
+1 IF %=-1
SET GMRAOUT=1
KILL GMRAPRCT
QUIT
+2 IF %=2
Begin DoDot:1
+3 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Mark this reaction as 'Entered-in-Error'"
+4 DO ^DIR
KILL DIR
IF $DATA(DIRUT)!(Y=0)
SET GMRAEIE=1
+5 IF Y=1
Begin DoDot:2
+6 SET GMRAERR=1
SET DIE="^GMR(120.8,"
SET DA=GMRAPA
SET DR="22///1;23///NOW;24////"_DUZ
DO ^DIE
+7 DO SITE^GMRAUTL
SET GMRASITE(0)=$GET(^GMRD(120.84,GMRASITE,0))
+8 IF $PIECE(GMRASITE(0),U,11)
SET GMRAVCM="E"
DO ENDING^GMRAPEM1
+9 DO EN1^GMRAPET0($PIECE(^GMR(120.8,GMRAPA,0),U),GMRAPA,"E",.GMRAOUT)
+10 DO EN1^GMRAEAB
+11 ; Execute the event point for this reaction
Begin DoDot:3
+12 IF '$DATA(GMRAPA)
QUIT
SET GMRAPA(0)=$GET(^GMR(120.8,GMRAPA,0))
IF GMRAPA(0)=""
QUIT
+13 NEW OROLD,DFN
SET DFN=$PIECE(GMRAPA(0),U)
+14 DO INP^VADPT
SET X=$ORDER(^ORD(101,"B","GMRA ENTERED IN ERROR",0))_";ORD(101,"
IF X
DO EN^XQOR
KILL VAIN,X
+15 QUIT
End DoDot:3
End DoDot:2
QUIT
+16 ;MSC/IHS/MGH INACTIVATE AN ENTRY
+17 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Inactivate this reaction"
+18 DO ^DIR
KILL DIR
IF $DATA(DIRUT)!(Y=0)
+19 IF Y=1
Begin DoDot:2
+20 NEW WHY,AIEN,FDA,IEN,ERR,FNUM
+21 SET WHY=$$REA
+22 SET FNUM=120.899999912
+23 SET AIEN="+1,"_GMRAPA_","
+24 SET FDA(120.899999912,AIEN,1)=WHY
+25 SET FDA(120.899999912,AIEN,.01)=$$NOW^XLFDT
+26 SET FDA(120.899999912,AIEN,2)=DUZ
+27 DO UPDATE^DIE(,"FDA","IEN","ERR")
+28 IF $DATA(ERR("DIERR"))
WRITE !,"Unable to inactivate allergy"
+29 SET GMRAOUT=1
+30 KILL FDA,IEN,ERR
End DoDot:2
QUIT
+31 ; This patch (#2) will loop through the patient reactions
+32 ; and ensure that the patient's NKA information is marked
+33 ; based on the existence of patient reactions.
+34 ; true NKA
IF $$NKASCR^GMRANKA($PIECE(^GMR(120.8,GMRAPA,0),U))
Begin DoDot:2
+35 SET DIK="^GMR(120.86,"
SET DA=$PIECE(^GMR(120.8,GMRAPA,0),U)
+36 ; purge the NKA node from 120.86
DO ^DIK
+37 QUIT
End DoDot:2
+38 QUIT
End DoDot:1
IF $GET(GMRAIN)=1
GOTO YNEE
+39 KILL %,DA,DIE,DR,GMRASITE
+40 QUIT
REA() ;GET THE REASON
+1 NEW DA,DIC,DR,Y
+2 SET DIC=90460.05
+3 SET DIC(0)="AEMQ"
+4 SET DIC("S")="I $P(^(0),U,2)=""I"""
+5 SET DIC("A")="Select reason: "
+6 DO ^DIC
IF $DATA(DIRUT)
KILL DIRUT
QUIT -1
+7 QUIT +Y
