- 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 Jan 18, 2025@02:40:14 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