GMRAPEM4 ;HIRMFO/WAA-EDIT OF DATA TO HISTORICAL STORAGE ; 12/24/91
;;4.0;Adverse Reaction Tracking;**51**;Mar 29, 1996;Build 189
EDIT ; Add/Edit Reaction data
N GMRAOUT1
W @IOF
D SITE^GMRAUTL
S GMRADRUG=$S($P(GMRAPA(0),U,20)["D":1,1:0),GMRACNT=GMRACNT+1
G:GMRANEW NEW
I '$P(GMRAPA(0),"^",12),$P(GMRAPA(0),"^",5)'=DUZ,'$D(^XUSEC("GMRA-SUPERVISOR",DUZ)),'$D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) D Q
.W !,$C(7),"THE PERSON INITIALLY ENTERING THIS ALLERGY/ADVERSE REACTION HAS NOT",!,"FINISHED ENTERING THE MANDATORY FIELDS, YOU CANNOT EDIT"
.D UNLOCK^GMRAUTL(120.8,GMRAPA)
.Q
I $P(GMRAPA(0),"^",12) D UNLOCK^GMRAUTL(120.8,GMRAPA) Q
NEW S DR="6(O)bserved or (H)istorical Allergy/Adverse Reaction",DIE="^GMR(120.8,",DA=GMRAPA D ^DIE I $D(Y) S GMRAOUT=1 Q
S GMRANEW(0)=$S($D(^GMR(120.8,GMRAPA,0)):^(0),1:"") W:$P(GMRANEW(0),"^",6)']"" $C(7)," Required??"
G NEW:$P(GMRANEW(0),"^",6)']"",EDAT:$P(GMRANEW(0),"^",6)=$P(GMRAPA(0),"^",6)
YNNW I $P(GMRAPA(0),"^",6)]"" W !,"Are you sure you want to make that change" S %=1 D YN^DICN I '% W !?4,$C(7),"ANSWER YES IF THE CHANGE IS OK, ELSE ANSWER NO." G YNNW
I $P(GMRAPA(0),"^",6)]"" I %'=1 S GMRAOUT=(%=-1),DIE="^GMR(120.8,",DR="6////"_$P(GMRAPA(0),"^",6),DA=GMRAPA D ^DIE G NEW:%=2 Q
S $P(GMRAPA(0),"^",6)=$P(GMRANEW(0),"^",6)
EDAT I $P(GMRAPA(0),"^",6)="o" D EN1^GMRAPEO0
I $P(GMRAPA(0),"^",6)="h" S GMRAOUT1=0 D EN1^GMRAPEH0 I GMRAOUT1 S GMRAOUT=1
K GMRAVER S GMRAVER=0
I 'GMRAOUT D
.I '$D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) Q
.I $$VFY^GMRASIGN(.GMRAPA) W !,"This Causative Agent will be Auto-verified when it is signed off." Q
.N GMRAPRNT
.D EN1^GMRAVFY K GMRALLER,GMRAMEC,GMRAY
.Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAPEM4 1678 printed Sep 23, 2025@19:15:59 Page 2
GMRAPEM4 ;HIRMFO/WAA-EDIT OF DATA TO HISTORICAL STORAGE ; 12/24/91
+1 ;;4.0;Adverse Reaction Tracking;**51**;Mar 29, 1996;Build 189
EDIT ; Add/Edit Reaction data
+1 NEW GMRAOUT1
+2 WRITE @IOF
+3 DO SITE^GMRAUTL
+4 SET GMRADRUG=$SELECT($PIECE(GMRAPA(0),U,20)["D":1,1:0)
SET GMRACNT=GMRACNT+1
+5 if GMRANEW
GOTO NEW
+6 IF '$PIECE(GMRAPA(0),"^",12)
IF $PIECE(GMRAPA(0),"^",5)'=DUZ
IF '$DATA(^XUSEC("GMRA-SUPERVISOR",DUZ))
IF '$DATA(^XUSEC("GMRA-ALLERGY VERIFY",DUZ))
Begin DoDot:1
+7 WRITE !,$CHAR(7),"THE PERSON INITIALLY ENTERING THIS ALLERGY/ADVERSE REACTION HAS NOT",!,"FINISHED ENTERING THE MANDATORY FIELDS, YOU CANNOT EDIT"
+8 DO UNLOCK^GMRAUTL(120.8,GMRAPA)
+9 QUIT
End DoDot:1
QUIT
+10 IF $PIECE(GMRAPA(0),"^",12)
DO UNLOCK^GMRAUTL(120.8,GMRAPA)
QUIT
NEW SET DR="6(O)bserved or (H)istorical Allergy/Adverse Reaction"
SET DIE="^GMR(120.8,"
SET DA=GMRAPA
DO ^DIE
IF $DATA(Y)
SET GMRAOUT=1
QUIT
+1 SET GMRANEW(0)=$SELECT($DATA(^GMR(120.8,GMRAPA,0)):^(0),1:"")
if $PIECE(GMRANEW(0),"^",6)']""
WRITE $CHAR(7)," Required??"
+2 if $PIECE(GMRANEW(0),"^",6)']""
GOTO NEW
if $PIECE(GMRANEW(0),"^",6)=$PIECE(GMRAPA(0),"^",6)
GOTO EDAT
YNNW IF $PIECE(GMRAPA(0),"^",6)]""
WRITE !,"Are you sure you want to make that change"
SET %=1
DO YN^DICN
IF '%
WRITE !?4,$CHAR(7),"ANSWER YES IF THE CHANGE IS OK, ELSE ANSWER NO."
GOTO YNNW
+1 IF $PIECE(GMRAPA(0),"^",6)]""
IF %'=1
SET GMRAOUT=(%=-1)
SET DIE="^GMR(120.8,"
SET DR="6////"_$PIECE(GMRAPA(0),"^",6)
SET DA=GMRAPA
DO ^DIE
if %=2
GOTO NEW
QUIT
+2 SET $PIECE(GMRAPA(0),"^",6)=$PIECE(GMRANEW(0),"^",6)
EDAT IF $PIECE(GMRAPA(0),"^",6)="o"
DO EN1^GMRAPEO0
+1 IF $PIECE(GMRAPA(0),"^",6)="h"
SET GMRAOUT1=0
DO EN1^GMRAPEH0
IF GMRAOUT1
SET GMRAOUT=1
+2 KILL GMRAVER
SET GMRAVER=0
+3 IF 'GMRAOUT
Begin DoDot:1
+4 IF '$DATA(^XUSEC("GMRA-ALLERGY VERIFY",DUZ))
QUIT
+5 IF $$VFY^GMRASIGN(.GMRAPA)
WRITE !,"This Causative Agent will be Auto-verified when it is signed off."
QUIT
+6 NEW GMRAPRNT
+7 DO EN1^GMRAVFY
KILL GMRALLER,GMRAMEC,GMRAY
+8 QUIT
End DoDot:1
+9 QUIT
