GMRAEF1 ;HIRMFO/WAA-FDA EXCEPTION REPORT ; 11/25/92
;;4.0;Adverse Reaction Tracking;;Mar 29, 1996
EN1 ; Entry to PRINT PATIENT FDA EXCEPTION DATA option
K DIC S GMRAOUT=0
W ! S DIC="^DPT(",DIC(0)="AEQM"
D ^DIC K DIC,DLAYGO G:+Y'>0 EN1Q
S GMRDFN=+Y D EN2 G:'GMRAOUT EN1
EN1Q K GMRDFN,DIC,GMRAOUT
D KILL^XUSCLEAN G EXIT
EN2 ;
S GMRAX=$P($G(^GMR(120.86,GMRDFN,0)),U,2) I GMRAX=0 W !,"This patient has No Known Allergies" K GMRAX Q
S X=0 F X=0:0 S X=$O(^GMR(120.8,"B",GMRDFN,X)) Q:X'>0 I '+$G(^GMR(120.8,X,"ER")) S X=X+1 Q
I 'X W !,"This patient has no allergies on file" Q
DDATE ;Select discharge date
K DIR S DIR("A")="Enter the Date to start search (Time optional)"
S DIR("B")="T-30",DIR(0)="DO^::AET"
S DIR("?")="ENTER THE DATE YOU WANT THE SYSTEM TO START IT'S SEARCH"
D ^DIR K DIR
I "^^"[Y S GMRAOUT=1 G EXIT
I $D(DIRUT) G EXIT
S GMRASTDT=Y
S GMRAIEN=0 F S GMRAIEN=$O(^GMR(120.8,"B",GMRDFN,GMRAIEN)) Q:GMRAIEN<1 D
.Q:+$G(^GMR(120.8,GMRAIEN,"ER"))
.S GMRA(0)=$G(^GMR(120.8,GMRAIEN,0))
.Q:GMRA(0)=""
.I $P(GMRA(0),U,6)'="o"!($P(GMRA(0),U,20)'["D") Q
.I '$P(GMRA(0),U,12) Q
.I $P(GMRA(0),U,4)<GMRASTDT Q
.I $$CMPFDA(GMRAIEN) Q
.S GMRABGDT=$P(GMRA(0),U,4)
.S ^TMP($J,"GMRAEF",GMRDFN,GMRABGDT)=GMRAIEN
.Q
D EN1^GMRAEF
Q
CMPFDA(DA) ; GIVEN DA ENTRY IN 120.8 RETURN 0 IF THERE IS INCOMPLETE
; FDA DATA, ELSE RETURN 1
N X
S X=0,Y=0 ; Pre set quit flag to valid
;loop through for each entry
F S X=$O(^GMR(120.85,"C",DA,X)) Q:X'>0 D Q:'Y
.S X(0)=$G(^GMR(120.85,X,0)) ; get the zero node
.; Required data
.I $P(X(0),U)="" Q ; Date/Time of Event
.I $P(X(0),U,2)="" Q ; Patient
.I $P(X(0),U,18)="" Q ; Date Reported
.I $P(X(0),U,19)="" Q ; Reporting User
.I '$O(^GMR(120.85,X,2,0)) Q ; Reaction
.I '$O(^GMR(120.85,X,3,0)) Q ; Suspected Agent
.S Y=1
.I $P(X(0),U,3)'="" Q ; Question 1
.I $P(X(0),U,4)'="" Q ; Question 2
.I $P(X(0),U,5)'="" Q ; Question 3
.I $P(X(0),U,6)'="" Q ; Question 4
.I $P(X(0),U,7)'="" Q ; Question 5
.I $P(X(0),U,9)'="" Q ; Question 6
.I $P(X(0),U,10)'="" Q ; Question 7
.I $P(X(0),U,11)'="" Q ; Question 8
.I $P(X(0),U,16)'="" Q ; Question 9
.I $P(X(0),U,17)'="" Q ; Question 10
.S Y=0
.Q
Q Y
EXIT ;EXIT OF ROUTINE
K DIC
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAEF1 2282 printed Sep 23, 2025@19:15:01 Page 2
GMRAEF1 ;HIRMFO/WAA-FDA EXCEPTION REPORT ; 11/25/92
+1 ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996
EN1 ; Entry to PRINT PATIENT FDA EXCEPTION DATA option
+1 KILL DIC
SET GMRAOUT=0
+2 WRITE !
SET DIC="^DPT("
SET DIC(0)="AEQM"
+3 DO ^DIC
KILL DIC,DLAYGO
if +Y'>0
GOTO EN1Q
+4 SET GMRDFN=+Y
DO EN2
if 'GMRAOUT
GOTO EN1
EN1Q KILL GMRDFN,DIC,GMRAOUT
+1 DO KILL^XUSCLEAN
GOTO EXIT
EN2 ;
+1 SET GMRAX=$PIECE($GET(^GMR(120.86,GMRDFN,0)),U,2)
IF GMRAX=0
WRITE !,"This patient has No Known Allergies"
KILL GMRAX
QUIT
+2 SET X=0
FOR X=0:0
SET X=$ORDER(^GMR(120.8,"B",GMRDFN,X))
if X'>0
QUIT
IF '+$GET(^GMR(120.8,X,"ER"))
SET X=X+1
QUIT
+3 IF 'X
WRITE !,"This patient has no allergies on file"
QUIT
DDATE ;Select discharge date
+1 KILL DIR
SET DIR("A")="Enter the Date to start search (Time optional)"
+2 SET DIR("B")="T-30"
SET DIR(0)="DO^::AET"
+3 SET DIR("?")="ENTER THE DATE YOU WANT THE SYSTEM TO START IT'S SEARCH"
+4 DO ^DIR
KILL DIR
+5 IF "^^"[Y
SET GMRAOUT=1
GOTO EXIT
+6 IF $DATA(DIRUT)
GOTO EXIT
+7 SET GMRASTDT=Y
+8 SET GMRAIEN=0
FOR
SET GMRAIEN=$ORDER(^GMR(120.8,"B",GMRDFN,GMRAIEN))
if GMRAIEN<1
QUIT
Begin DoDot:1
+9 if +$GET(^GMR(120.8,GMRAIEN,"ER"))
QUIT
+10 SET GMRA(0)=$GET(^GMR(120.8,GMRAIEN,0))
+11 if GMRA(0)=""
QUIT
+12 IF $PIECE(GMRA(0),U,6)'="o"!($PIECE(GMRA(0),U,20)'["D")
QUIT
+13 IF '$PIECE(GMRA(0),U,12)
QUIT
+14 IF $PIECE(GMRA(0),U,4)<GMRASTDT
QUIT
+15 IF $$CMPFDA(GMRAIEN)
QUIT
+16 SET GMRABGDT=$PIECE(GMRA(0),U,4)
+17 SET ^TMP($JOB,"GMRAEF",GMRDFN,GMRABGDT)=GMRAIEN
+18 QUIT
End DoDot:1
+19 DO EN1^GMRAEF
+20 QUIT
CMPFDA(DA) ; GIVEN DA ENTRY IN 120.8 RETURN 0 IF THERE IS INCOMPLETE
+1 ; FDA DATA, ELSE RETURN 1
+2 NEW X
+3 ; Pre set quit flag to valid
SET X=0
SET Y=0
+4 ;loop through for each entry
+5 FOR
SET X=$ORDER(^GMR(120.85,"C",DA,X))
if X'>0
QUIT
Begin DoDot:1
+6 ; get the zero node
SET X(0)=$GET(^GMR(120.85,X,0))
+7 ; Required data
+8 ; Date/Time of Event
IF $PIECE(X(0),U)=""
QUIT
+9 ; Patient
IF $PIECE(X(0),U,2)=""
QUIT
+10 ; Date Reported
IF $PIECE(X(0),U,18)=""
QUIT
+11 ; Reporting User
IF $PIECE(X(0),U,19)=""
QUIT
+12 ; Reaction
IF '$ORDER(^GMR(120.85,X,2,0))
QUIT
+13 ; Suspected Agent
IF '$ORDER(^GMR(120.85,X,3,0))
QUIT
+14 SET Y=1
+15 ; Question 1
IF $PIECE(X(0),U,3)'=""
QUIT
+16 ; Question 2
IF $PIECE(X(0),U,4)'=""
QUIT
+17 ; Question 3
IF $PIECE(X(0),U,5)'=""
QUIT
+18 ; Question 4
IF $PIECE(X(0),U,6)'=""
QUIT
+19 ; Question 5
IF $PIECE(X(0),U,7)'=""
QUIT
+20 ; Question 6
IF $PIECE(X(0),U,9)'=""
QUIT
+21 ; Question 7
IF $PIECE(X(0),U,10)'=""
QUIT
+22 ; Question 8
IF $PIECE(X(0),U,11)'=""
QUIT
+23 ; Question 9
IF $PIECE(X(0),U,16)'=""
QUIT
+24 ; Question 10
IF $PIECE(X(0),U,17)'=""
QUIT
+25 SET Y=0
+26 QUIT
End DoDot:1
if 'Y
QUIT
+27 QUIT Y
EXIT ;EXIT OF ROUTINE
+1 KILL DIC
+2 QUIT
