GMRAEER0.m

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

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