GMRAPVDE ;HIRMFO/RM,WAA-EDIT DATA FOR AN ALLERGY (POST VERIFICATION) ; 10/18/92
;;4.0;Adverse Reaction Tracking;;Mar 29, 1996
EN1 ; ENTRY FROM 'GMRA ENTER A/AR IN ERROR' OPTION
W ! S DIC="^DPT(",DIC(0)="AEQM" D ^DIC K DIC G:+Y'>0 Q1 S DFN=+Y D EN2 G:'GMRAOUT EN1
Q1 D KILL^XUSCLEAN
Q
EN2 ; EDIT A PATIENT A/AR WHERE DFN KNOWN
; INPUT VAR: DFN = PTR TO 2
; OUTPUT VAR: DFN AND GMRAOUT = 0 IF NORMAL EXIT ELSE 1
Q:'$D(DFN) D 1^VADPT S GMRALOC=$P(VAIN(4),U,2),GMRANAM=VADM(1),GMRASEX=VADM(5),GMRAOUT=0,GMRAOTH=$O(^GMRD(120.83,"B","OTHER REACTION",0)) D KVAR^VADPT K VA,VAROOT
S GMRAER=1 D:'$D(GMRAL) EN1^GMRADPT D EN1^GMRADSP0(.GMRAL) G Q2:GMRAOUT K GMRAER
SELECT S GMRALAGO=0 D EN1^GMRAPES0 I GMRAPA>0,'$P(GMRAPA(0),U,16) S GMRAPA=-1 W !,"YOU CANNOT PICK AN UNVERIFIED ENTRY"
W:GMRAPA'>0&'GMRAOUT $C(7)," ??" G Q2:GMRAOUT,EN2:GMRAPA'>0 ; IF HIT RETURN THEN EXIT
G:'$$LOCK^GMRAUTL(120.8,GMRAPA,1) SELECT
D SITE^GMRAUTL,EN1^GMRAPED0
D UNLOCK^GMRAUTL(120.8,GMRAPA)
Q2 ;
K GMRADRUG,GMRAERR,GMRAHEAD,GMRALAGO,GMRALOC,GMRANAM,GMRANEW,GMRAOTH,GMRAPA,GMRAPG,GMRAPRNT,GMRASEX,GMRASWH
I GMRAOUT S GMRAOUT=2-GMRAOUT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAPVDE 1144 printed Sep 23, 2025@19:16:24 Page 2
GMRAPVDE ;HIRMFO/RM,WAA-EDIT DATA FOR AN ALLERGY (POST VERIFICATION) ; 10/18/92
+1 ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996
EN1 ; ENTRY FROM 'GMRA ENTER A/AR IN ERROR' OPTION
+1 WRITE !
SET DIC="^DPT("
SET DIC(0)="AEQM"
DO ^DIC
KILL DIC
if +Y'>0
GOTO Q1
SET DFN=+Y
DO EN2
if 'GMRAOUT
GOTO EN1
Q1 DO KILL^XUSCLEAN
+1 QUIT
EN2 ; EDIT A PATIENT A/AR WHERE DFN KNOWN
+1 ; INPUT VAR: DFN = PTR TO 2
+2 ; OUTPUT VAR: DFN AND GMRAOUT = 0 IF NORMAL EXIT ELSE 1
+3 if '$DATA(DFN)
QUIT
DO 1^VADPT
SET GMRALOC=$PIECE(VAIN(4),U,2)
SET GMRANAM=VADM(1)
SET GMRASEX=VADM(5)
SET GMRAOUT=0
SET GMRAOTH=$ORDER(^GMRD(120.83,"B","OTHER REACTION",0))
DO KVAR^VADPT
KILL VA,VAROOT
+4 SET GMRAER=1
if '$DATA(GMRAL)
DO EN1^GMRADPT
DO EN1^GMRADSP0(.GMRAL)
if GMRAOUT
GOTO Q2
KILL GMRAER
SELECT SET GMRALAGO=0
DO EN1^GMRAPES0
IF GMRAPA>0
IF '$PIECE(GMRAPA(0),U,16)
SET GMRAPA=-1
WRITE !,"YOU CANNOT PICK AN UNVERIFIED ENTRY"
+1 ; IF HIT RETURN THEN EXIT
if GMRAPA'>0&'GMRAOUT
WRITE $CHAR(7)," ??"
if GMRAOUT
GOTO Q2
if GMRAPA'>0
GOTO EN2
+2 if '$$LOCK^GMRAUTL(120.8,GMRAPA,1)
GOTO SELECT
+3 DO SITE^GMRAUTL
DO EN1^GMRAPED0
+4 DO UNLOCK^GMRAUTL(120.8,GMRAPA)
Q2 ;
+1 KILL GMRADRUG,GMRAERR,GMRAHEAD,GMRALAGO,GMRALOC,GMRANAM,GMRANEW,GMRAOTH,GMRAPA,GMRAPG,GMRAPRNT,GMRASEX,GMRASWH
+2 IF GMRAOUT
SET GMRAOUT=2-GMRAOUT
+3 QUIT
