66 lines
2.2 KiB
Mathematica
66 lines
2.2 KiB
Mathematica
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
|