source: FOIAVistA/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPEM0.m@ 1666

Last change on this file since 1666 was 628, checked in by George Lilly, 16 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.3 KB
Line 
1GMRAPEM0 ;HIRMFO/WAA,FT-ALLERGY/ADVERSE REACTION PATIENT EDIT DRIVER ;9/22/06 09:35
2 ;;4.0;Adverse Reaction Tracking;**2,5,17,21,36**;Mar 29, 1996;Build 9
3EN11 ; Entry point for GMRA USER E/E PAT REC DATA option
4 ; GMRAUSER is a flag that indicates that this is a User
5 ; If user has Verifier Key then user will act normal
6 I '$D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) S GMRAUSER=1
7EN1 ; Entry for ENTER/EDIT PATIENT REACTION DATA option
8 ; EDIT PATIENT A/AR (DFN UNK.)
9 S GMRAOUT=0
10 W @IOF D PAT^GMRAPAT ; Select A Patient
11 D:'GMRAOUT EN21 G:'GMRAOUT EN1
12 K DFN,DIC,GMRAOUT,GMRARET,GMA,GMRAUSER
13 D EXIT,EN1^GMRAKILL
14 Q
15EN21 ; Process patient data and determine if patient is NKA
16 S GMRAOUT=$G(GMRAOUT,0)
17 ; check patient assessment before enter/edit reaction
18 I $$NKA^GMRANKA(DFN),$$NKASCR^GMRANKA(DFN) D ;delete 120.86 entry if assessment=yes, but no active reactions in 120.8
19 .N DA,DIK
20 .S DIK="^GMR(120.86,",DA=DFN D ^DIK
21 .Q
22 I '$$NKA^GMRANKA(DFN) D NKAASK^GMRANKA(DFN,.GMRAOUT) Q:GMRAOUT I '$$NKA^GMRANKA(DFN) Q
23 L +^XTMP("GMRAED",DFN):1 I '$T D MESS^GMRAGUI1 Q ;21
24 S GMRAOUT=0
25 D:'GMRAOUT SELECT
26 I $G(GMRAPA)'>0 S GMRAOUT=0
27 S GMRARP=1 I 'GMRAOUT D
28 .D ASK^GMRAUTL("Enter another Causative Agent? ",.GMRAOUT,.GMRARP)
29 .I 'GMRARP S GMRACNT=$O(^TMP($J,"GMRASF","B"),-1) D
30 ..I GMRACNT D SIGNOFF^GMRASIGN
31 ..I 'GMRAOUT D IDBAND^GMRASIGN
32 ..I GMRAOUT S GMRAOUT=2-GMRAOUT D:GMRAOUT&($D(^TMP($J,"GMRASF"))) ALERT^GMRASIGN K ^TMP($J,"GMRASF"),GMRACNT
33 ..Q
34 .Q
35 I GMRARP,'GMRAOUT K GMRARP L -^XTMP("GMRAED",DFN) G EN21 ;21
36 K GMRARP
37 ; check patient assessment when exiting enter/edit reaction
38 I $$NKA^GMRANKA(DFN),$$NKASCR^GMRANKA(DFN) D ;delete 120.86 entry if assessment=yes, but no active reactions in 120.8
39 .N DA,DIK
40 .S DIK="^GMR(120.86,",DA=DFN D ^DIK
41 .Q
42 L -^XTMP("GMRAED",DFN) ;21
43 Q
44EN2 ; EDIT PATIENT A/AR (DFN KNOWN)
45 ; Called from the GMRAOR ALLERGY ENTER/EDIT protocol
46 I '$D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) S GMRAUSER=1
47 N GMRAOUT
48 D EN21 D
49 .;N GMRAOUT
50 .D EXIT,EN1^GMRAKILL
51 .Q
52 K GMA,GMRARET,GMRAUSER
53 Q
54ALERT ; PROCESS ALERTS FOR ART
55 N DFN,GMRAPA,GMRACNT,GMRAOUT,GMRANEW,GMRAUSER
56 S (GMRACNT,GMRAOUT,GMRANEW)=0 D
57 . I $G(XQADATA)="" S XQAKILL=0 Q
58 . S DFN=$P(XQADATA,U),GMRAPA=$P(XQADATA,U,2),GMRAUSER=$P(XQADATA,U,3) Q:'DFN!'GMRAPA
59 . I $D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) K GMRAUSER
60 . S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""
61 . I $P(GMRAPA(0),U,12) D Q
62 . . W !,"This reaction has been signed off.",$C(7)
63 . . D HANGT^GMRAPEH0
64 . . S XQAKILL=0
65 . . Q
66 . D EDIT^GMRAPEM4
67 . D UPDATE^GMRAPEM3
68 . I '$P(GMRAPA(0),U,12) D SIGNOFF^GMRASIGN
69 . I GMRAOUT S GMRAOUT=2-GMRAOUT K XQAKILL
70 . E D
71 . .I $P(GMRAPA(0),U,12) S XQAKILL=0
72 . .I '$P(GMRAPA(0),U,12) K XQAKILL
73 . D EXIT,EN1^GMRAKILL
74 . Q
75 Q
76SELECT ;Select a patient reaction
77 S GMRACNT=0 D 1^VADPT
78 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
79 K GMRADUP S GMRALAGO=1
80 D REACT^GMRAPAT(DFN) ; Load all reaction for this patient.
81 D EN1^GMRAPES0
82 I GMRAPA>0 D TYPE D
83 .I GMRAOUT D:$G(GMRANEW) DELETE S:'$$MISSREQ&('$P($G(GMRAPA(0)),U,12)) GMRAOUT=0,^TMP($J,"GMRASF","B",GMRAPA,GMRACNT)="",^TMP($J,"GMRASF",GMRACNT,GMRAPA)="" D:GMRAOUT UPOUT^GMRAPEM3 Q ; 21,36
84 .I GMRAERR D ERR^GMRAPEM3 Q ;The reaction was entered in error
85 .I $P(GMRAPA(0),U,12) D SIGNED^GMRAPEM3 Q ;The reaction has been signed
86 .; Reaction is a new reaction or Update data
87 .D UPDATE^GMRAPEM3
88 .Q
89 Q
90TYPE ; Select the type of the process to use this reaction
91 S GMRAERR=0
92 ; If reaction is not new check to see if user want to enter in error
93 I 'GMRANEW W @IOF N GMRADFN D EN1^GMRAPEE0 I GMRAERR!GMRAOUT Q
94 ;If reaction is observed and signed off
95 I $P(GMRAPA(0),U,6)="o",$P(GMRAPA(0),U,12) D Q:GMRAOUT
96 .Q:$G(GMRAUSER,0)
97 .N GMRARP
98 .S GMRARP=0 D ASK^GMRAUTL("DO YOU WISH TO EDIT OBSERVED DATA? ",.GMRAOUT,.GMRARP) Q:GMRAOUT
99 .Q:'GMRARP ;Observed data
100 .N GMRAOD S GMRAOD=$D(^GMR(120.85,"C",GMRAPA)) ;Existing observation data?
101OBSDATE .;
102 .S GMRALAGO=1 F D EN2^GMRAU85 Q:GMRAPA1>0 Q:GMRAOUT W !,"You must enter a valid date or an Up-arrow to exit",!,$C(7)
103 .I 'GMRAOUT,GMRAPA1>0 D EN2^GMRAROBS
104 .I '$D(^GMR(120.85,"C",GMRAPA)),$G(GMRANEW)!('$G(GMRANEW)&($G(GMRAOD))) D OBSPROB S GMRAOUT=0 G OBSDATE
105 .Q
106 ;Verify data
107 I 'GMRAERR,$P($G(^GMR(120.8,GMRAPA,0)),U,16)=0,$P(GMRAPA(0),U,12)=1,$D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) D Q:GMRAOUT
108 .K GMRAVER S GMRAVER=0
109 .N GMRAPRNT D EN1^GMRAVFY K GMRALLER,GMRAMEC,GMRAY
110 .I $P($G(^GMR(120.8,GMRAPA,0)),U,16)=1 S GMRASLL(GMRAPA)=1
111 .Q
112 ;EDIT Verified data
113 I 'GMRAERR,$P($G(^GMR(120.8,GMRAPA,0)),U,16)=1,$D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) D Q:GMRAOUT
114 .Q:$G(GMRAVER)=1
115 .N GMRARP
116 .S GMRARP=0
117 .D ASK^GMRAUTL("DO YOU WISH TO EDIT VERIFIED DATA? ",.GMRAOUT,.GMRARP) Q:GMRAOUT
118 .D:GMRARP SITE^GMRAUTL,EN1^GMRAPED0
119 .Q
120 ;if the reaction is new or not signed off
121 I '$P(GMRAPA(0),U,12) D
122 .D EDIT^GMRAPEM4
123 .I $P($G(^GMR(120.8,GMRAPA,0)),U,16) S GMRASLL(GMRAPA)=1
124 .Q
125 Q
126EXIT S GMRAPA=0 F S GMRAPA=$O(^TMP($J,"GMRASF","B",GMRAPA)) Q:GMRAPA<1 D UNLOCK^GMRAUTL(120.8,GMRAPA)
127 K ^TMP($J,"GMRASF")
128 K ^TMP($J,"GMRALST")
129 Q
130 ;
131DELETE ;Delete entry if required information is not entered - section added in 17
132 N DA,DIK,GMRAPA1
133 W !!,"Entry process not completed, deleting entry...",!
134 S GMRAPA1=$O(^GMR(120.85,"C",GMRAPA,0))
135 I GMRAPA1,$G(^GMR(120.85,GMRAPA1,0))="" K ^GMR(120.85,"C",GMRAPA,GMRAPA1)
136 I GMRAPA1 S DIK="^GMR(120.85,",DA=GMRAPA1 D ^DIK D UNLOCK^GMRAUTL(120.85,GMRAPA1)
137 I GMRAPA S DIK="^GMR(120.8,",DA=GMRAPA D ^DIK D UNLOCK^GMRAUTL(120.8,GMRAPA)
138 Q
139 ;
140OBSPROB ;Display help information for missing observed date/time entry
141 W !!,"Observed reactions must have at least one observation entry.",!,"If this reaction is incorrect then enter a date and then proceed",!,"to mark it as entered in error.",!
142 Q
143 ;
144MISSREQ() ;Function determines if required data is missing
145 N GMRA0,TYPE
146 S GMRA0=$G(^GMR(120.8,+$G(GMRAPA),0)) I GMRA0="" Q 1 ;Entry not found
147 S TYPE=$P(GMRA0,U,6) ;Get observed/historical
148 I TYPE="" Q 1 ;Type not entered
149 I TYPE="h" Q 0 ;Historical has no requirements
150 I TYPE="o" I '$D(^GMR(120.85,"C",GMRAPA))!('$O(^GMR(120.85,+$O(^GMR(120.85,"C",GMRAPA,0)),2,0)))!('$$REQCOM) Q 1 ;Missing obs date/time or sign/symptom or required comment
151 Q 0
152 ;
153REQCOM() ;Function determines if comments required
154 I '$D(GMRASITE) D SITE^GMRAUTL
155 I +$P(^GMRD(120.84,+GMRASITE,0),U,4)=0 Q 1 ;Comments required?
156 I $O(^GMR(120.8,GMRAPA,26,0)) Q 1
157 Q 0
Note: See TracBrowser for help on using the repository browser.