GMRAEER0 ;HIRMFO/RM,WAA-ENTER AN ALLERGY RECORD IN ERROR ; 8/20/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,DLAYGO 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:GMRAOUT Q2 K GMRAER
SELECT S GMRALAGO=0 D EN1^GMRAPES0 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 EN1^GMRAPEE0
D UNLOCK^GMRAUTL(120.8,GMRAPA)
Q2 ;
K GMRADRUG,GMRAER,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[HGMRAEER0 1045 printed Dec 13, 2024@01:39 Page 2
GMRAEER0 ;HIRMFO/RM,WAA-ENTER AN ALLERGY RECORD IN ERROR ; 8/20/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,DLAYGO
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 ; IF HIT RETURN THEN EXIT
SET GMRALAGO=0
DO EN1^GMRAPES0
if GMRAPA'>0&'GMRAOUT
WRITE $CHAR(7)," ??"
if GMRAOUT
GOTO Q2
if GMRAPA'>0
GOTO EN2
+1 if '$$LOCK^GMRAUTL(120.8,GMRAPA,1)
GOTO SELECT
+2 DO EN1^GMRAPEE0
+3 DO UNLOCK^GMRAUTL(120.8,GMRAPA)
Q2 ;
+1 KILL GMRADRUG,GMRAER,GMRAERR,GMRAHEAD,GMRALAGO,GMRALOC,GMRANAM,GMRANEW,GMRAOTH,GMRAPA,GMRAPG,GMRAPRNT,GMRASEX,GMRASWH
+2 IF GMRAOUT
SET GMRAOUT=2-GMRAOUT
+3 QUIT
