GMRAPAT ;HIRMFO/WAA-Select a patient for ART System ;10/8/96 15:19
;;4.0;Adverse Reaction Tracking;**5**;Mar 29, 1996
PAT ;Select a patient from the patient file
; Return list:
; DFN = If DFN is null patient DFN from the patient file
;
S GMRAOUT=0
W ! S DIC="^DPT(",DIC(0)="AEQM" D ^DIC
I +Y'>0 S GMRAOUT=1 Q
S DFN=+Y,GMRADOD=$P($G(^DPT(DFN,.35)),U)
;check if patient is deceased
I GMRADOD]"" D
.W !!?5,$C(7),"NOTE: This patient is deceased (",$$FMTE^XLFDT(GMRADOD),").",!!
.D HANGT^GMRAPEH0
.Q
K GMRADOD
Q
REACT(DFN) ;Select a patient reaction
;
Q:'$D(DFN)
N GMRAL
S GMRAOUT=0,GMRAL=""
D LIST(DFN,.GMRAL)
I GMRAL D EN1^GMRADSP0(.GMRAL) Q:GMRAOUT
E W !?10,"This patient has no allergy/adverse reaction data."
Q
LIST(DFN,GMRA) ;Get all the reaction for a patient
N GMRAPA
S (GMRAPA,GMRA)=0
F S GMRAPA=$O(^GMR(120.8,"B",DFN,GMRAPA)) Q:GMRAPA<1 D
.Q:$G(^GMR(120.8,GMRAPA,0))=""
.Q:+$G(^GMR(120.8,GMRAPA,"ER"))
.D PASS^GMRADPT(GMRAPA,.GMRA)
.I 'GMRA S GMRA=1
.Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAPAT 1045 printed Sep 23, 2025@19:15:48 Page 2
GMRAPAT ;HIRMFO/WAA-Select a patient for ART System ;10/8/96 15:19
+1 ;;4.0;Adverse Reaction Tracking;**5**;Mar 29, 1996
PAT ;Select a patient from the patient file
+1 ; Return list:
+2 ; DFN = If DFN is null patient DFN from the patient file
+3 ;
+4 SET GMRAOUT=0
+5 WRITE !
SET DIC="^DPT("
SET DIC(0)="AEQM"
DO ^DIC
+6 IF +Y'>0
SET GMRAOUT=1
QUIT
+7 SET DFN=+Y
SET GMRADOD=$PIECE($GET(^DPT(DFN,.35)),U)
+8 ;check if patient is deceased
+9 IF GMRADOD]""
Begin DoDot:1
+10 WRITE !!?5,$CHAR(7),"NOTE: This patient is deceased (",$$FMTE^XLFDT(GMRADOD),").",!!
+11 DO HANGT^GMRAPEH0
+12 QUIT
End DoDot:1
+13 KILL GMRADOD
+14 QUIT
REACT(DFN) ;Select a patient reaction
+1 ;
+2 if '$DATA(DFN)
QUIT
+3 NEW GMRAL
+4 SET GMRAOUT=0
SET GMRAL=""
+5 DO LIST(DFN,.GMRAL)
+6 IF GMRAL
DO EN1^GMRADSP0(.GMRAL)
if GMRAOUT
QUIT
+7 IF '$TEST
WRITE !?10,"This patient has no allergy/adverse reaction data."
+8 QUIT
LIST(DFN,GMRA) ;Get all the reaction for a patient
+1 NEW GMRAPA
+2 SET (GMRAPA,GMRA)=0
+3 FOR
SET GMRAPA=$ORDER(^GMR(120.8,"B",DFN,GMRAPA))
if GMRAPA<1
QUIT
Begin DoDot:1
+4 if $GET(^GMR(120.8,GMRAPA,0))=""
QUIT
+5 if +$GET(^GMR(120.8,GMRAPA,"ER"))
QUIT
+6 DO PASS^GMRADPT(GMRAPA,.GMRA)
+7 IF 'GMRA
SET GMRA=1
+8 QUIT
End DoDot:1
+9 QUIT
