source: WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAEF1.m@ 861

Last change on this file since 861 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.2 KB
Line 
1GMRAEF1 ;HIRMFO/WAA-FDA EXCEPTION REPORT ; 11/25/92
2 ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996
3EN1 ; Entry to PRINT PATIENT FDA EXCEPTION DATA option
4 K DIC S GMRAOUT=0
5 W ! S DIC="^DPT(",DIC(0)="AEQM"
6 D ^DIC K DIC,DLAYGO G:+Y'>0 EN1Q
7 S GMRDFN=+Y D EN2 G:'GMRAOUT EN1
8EN1Q K GMRDFN,DIC,GMRAOUT
9 D KILL^XUSCLEAN G EXIT
10EN2 ;
11 S GMRAX=$P($G(^GMR(120.86,GMRDFN,0)),U,2) I GMRAX=0 W !,"This patient has No Known Allergies" K GMRAX Q
12 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
13 I 'X W !,"This patient has no allergies on file" Q
14DDATE ;Select discharge date
15 K DIR S DIR("A")="Enter the Date to start search (Time optional)"
16 S DIR("B")="T-30",DIR(0)="DO^::AET"
17 S DIR("?")="ENTER THE DATE YOU WANT THE SYSTEM TO START IT'S SEARCH"
18 D ^DIR K DIR
19 I "^^"[Y S GMRAOUT=1 G EXIT
20 I $D(DIRUT) G EXIT
21 S GMRASTDT=Y
22 S GMRAIEN=0 F S GMRAIEN=$O(^GMR(120.8,"B",GMRDFN,GMRAIEN)) Q:GMRAIEN<1 D
23 .Q:+$G(^GMR(120.8,GMRAIEN,"ER"))
24 .S GMRA(0)=$G(^GMR(120.8,GMRAIEN,0))
25 .Q:GMRA(0)=""
26 .I $P(GMRA(0),U,6)'="o"!($P(GMRA(0),U,20)'["D") Q
27 .I '$P(GMRA(0),U,12) Q
28 .I $P(GMRA(0),U,4)<GMRASTDT Q
29 .I $$CMPFDA(GMRAIEN) Q
30 .S GMRABGDT=$P(GMRA(0),U,4)
31 .S ^TMP($J,"GMRAEF",GMRDFN,GMRABGDT)=GMRAIEN
32 .Q
33 D EN1^GMRAEF
34 Q
35CMPFDA(DA) ; GIVEN DA ENTRY IN 120.8 RETURN 0 IF THERE IS INCOMPLETE
36 ; FDA DATA, ELSE RETURN 1
37 N X
38 S X=0,Y=0 ; Pre set quit flag to valid
39 ;loop through for each entry
40 F S X=$O(^GMR(120.85,"C",DA,X)) Q:X'>0 D Q:'Y
41 .S X(0)=$G(^GMR(120.85,X,0)) ; get the zero node
42 .; Required data
43 .I $P(X(0),U)="" Q ; Date/Time of Event
44 .I $P(X(0),U,2)="" Q ; Patient
45 .I $P(X(0),U,18)="" Q ; Date Reported
46 .I $P(X(0),U,19)="" Q ; Reporting User
47 .I '$O(^GMR(120.85,X,2,0)) Q ; Reaction
48 .I '$O(^GMR(120.85,X,3,0)) Q ; Suspected Agent
49 .S Y=1
50 .I $P(X(0),U,3)'="" Q ; Question 1
51 .I $P(X(0),U,4)'="" Q ; Question 2
52 .I $P(X(0),U,5)'="" Q ; Question 3
53 .I $P(X(0),U,6)'="" Q ; Question 4
54 .I $P(X(0),U,7)'="" Q ; Question 5
55 .I $P(X(0),U,9)'="" Q ; Question 6
56 .I $P(X(0),U,10)'="" Q ; Question 7
57 .I $P(X(0),U,11)'="" Q ; Question 8
58 .I $P(X(0),U,16)'="" Q ; Question 9
59 .I $P(X(0),U,17)'="" Q ; Question 10
60 .S Y=0
61 .Q
62 Q Y
63EXIT ;EXIT OF ROUTINE
64 K DIC
65 Q
Note: See TracBrowser for help on using the repository browser.