source: WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRASIGN.m@ 701

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

initial load of WorldVistAEHR

File size: 5.8 KB
Line 
1GMRASIGN ;HIRMFO/WAA-ALLERGY/ADVERSE REACTION PATIENT SIGN OFF ;9/22/06 11:01
2 ;;4.0;Adverse Reaction Tracking;**17,19,36**;Mar 29, 1996;Build 9
3SIGNOFF ; The signoff code
4 N GMRAOUT,GMRACNTT S GMRAOUT=0 ;19
5 S GMRASIGN=0
6 D ENCNT^GMRASIG1 ; Count entries
7 D SOQ ; Display entries and ask if user wants all the entries signed.
8 I 'Y D ; User said no the sign off question
9 .I GMRACNTT>1 S GMRASIGN=1 D YNSO^GMRASIG1 I Y'=0 D RANGE(Y) ; User had more than one entry
10 .D ALERT ; Ask Delete and trigger alerts for those non delete entries
11 .Q
12 K GMRASITE ; force the update of the site parameters
13 D PNOTE^GMRASIG1 ; File progress note
14 K ^TMP($J,"GMRASF") ; clean up the temp globals
15 Q
16SOQ ;Sign off on all allergies for a patient
17 W @IOF,!,"Causative Agent Data edited this Session:"
18 K X D PRINT^GMRASIG1 ; Display entries edit this session
19 N DIR
20 S DIR(0)="YA",DIR("B")="NO"
21 S DIR("?")="PLEASE ENTER 'Y' IF THE DATA IS CORRECT OR 'N' IF IT IS NOT CORRECT"
22 S DIR("??")="^D PRINT^GMRASIG1"
23 S DIR("A")=$S(GMRACNTT>1:"Are ALL these",1:"Is this")_" correct? "
24 D ^DIR
25 I $D(DIRUT) S Y=0,GMRAOUT=1 ; user ^ or timed out
26 I Y=0 Q ; user answered no the sign off
27 D ALLSNG,RANGE(Y) ; sign all the entries
28 S Y=1
29 Q
30ALLSNG ;Sign off on all
31 N X
32 S Y="",X=0
33 F S X=$O(^TMP($J,"GMRASF",X)) Q:X<1 S Y=Y_X_","
34 Q
35RANGE(GMRARNG) ;Sign off select allergies
36 ;Input:
37 ; GMRARNG = The entries that need to be signed
38 ;
39 N GMRATYPE ;19
40 F I=1:1 S GMRACNT=$P(GMRARNG,",",I) Q:GMRACNT<1 S GMRAPA=$O(^TMP($J,"GMRASF",GMRACNT,0)) Q:GMRAPA'>0 D
41 .N I,GMRARNG
42 .S DA=GMRAPA,DIE="^GMR(120.8,",DR="15////1" D ^DIE
43 .S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0))
44 .S GMRATYPE=$P(GMRAPA(0),U,20)
45 .S GMRASLL(GMRAPA)=0
46 .I '$P(GMRAPA(0),U,16) D
47 ..N GMRACNT K DR S DA=GMRAPA,DIE="^GMR(120.8,"
48 ..I $$VFY(.GMRAPA) D
49 ...S DR="19////1;20///N" D ^DIE
50 ...Q
51 ..E S DR="19////0" D ^DIE,EN1^GMRAVAB
52 ..S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0))
53 .I $P(GMRAPA(0),U,6)="o",GMRATYPE["D" D PTBUL^GMRAROBS
54 .D ; Execute the event point for this reaction
55 ..Q:'$D(GMRAPA) S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""
56 ..N OROLD,DFN,GMRACNT S DFN=$P(GMRAPA(0),U)
57 ..D INP^VADPT S X=$$FIND1^DIC(101,,"BX","GMRA SIGN-OFF ON DATA")_";ORD(101," D EN^XQOR:X K VAIN,X ;19
58 ..Q
59 .K ^TMP($J,"GMRASF",GMRACNT,GMRAPA),^TMP($J,"GMRASF","B",GMRAPA,GMRACNT)
60 .Q
61 Q
62ALERT ; SENDS ALERT FOR ALL DATA THAT IS UNSIGNED
63 I '$O(^TMP($J,"GMRASF",0)) Q
64 D REMAIN ;D DEL^GMRADEL ; Ask user if they want to delete given entries
65 Q:$D(XQADATA) ; user is processing alert
66 S (GMRACNT,GMRACNTF)=0 F S GMRACNT=$O(^TMP($J,"GMRASF",GMRACNT)) Q:GMRACNT<1 S GMRAPA=$O(^TMP($J,"GMRASF",GMRACNT,0)) Q:GMRAPA<1 D
67 .S GMRAPA(0)=(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""
68 .S XQA(DUZ)=""
69 .S XQAMSG=GMRANAM_" with reaction of "_$P(GMRAPA(0),U,2)_" has not been Signed off."
70 .S XQAID="GMASignoff Alert"
71 .S XQADATA=DFN_U_GMRAPA_U_$G(GMRAUSER,0)
72 .S XQAROU="ALERT^GMRAPEM0"
73 .D SETUP^XQALERT
74 .D UNLOCK^GMRAUTL(120.8,GMRAPA)
75 .I 'GMRACNTF W !,?5,"Please Note that these UNSIGNED Causative Agents ",!,?5,"will not show in the patient's records.",$C(7) D HANGT^GMRAPEH0 S GMRACNTF=1
76 .S X=$O(^TMP($J,"GMRASF","B",GMRAPA,0))
77 .K ^TMP($J,"GMRASF",X,GMRAPA),^TMP($J,"GMRASF","B",GMRAPA,X)
78 .Q
79 K XQA,XQAMSG,GMRACNTF
80 Q
81IDBAND ; Mark ID Bands and Charts for a given patient
82 I $D(GMRASLL) D
83 .D EN4^GMRAMCB(.GMRASLL,DFN) S GMRAPA=0 F S GMRAPA=$O(GMRASLL(GMRAPA)) Q:GMRAPA<1 D UNLOCK^GMRAUTL(120.8,GMRAPA)
84 .K GMRASLL
85 .Q
86 Q
87VFY(Y) ;THIS FUNCTION WILL RETURN TRUE IF THIS ALLERGY IS AUTO VERIFIED
88 N GMRAPASS,X
89 S GMRAPASS=0
90 I '$D(GMRASITE) D SITE^GMRAUTL
91 S X=$G(^GMRD(120.84,+GMRASITE,0))
92 S GMRATYPE=$P(Y(0),U,20)
93 I @(($P(Y(0),U,6)="o"&($P(X,U,3)\2)!($P(Y(0),U,6)="h"&($P(X,U,3)#2)))_$S($P(X,U,6)="&":"&",1:"!")_(GMRATYPE["F"&($P(X,U,2)\2#2)!(GMRATYPE["D"&($P(X,U,2)#2))!(GMRATYPE["O"&($P(X,U,2)\4)))) S GMRAPASS=1
94 Q GMRAPASS
95 Q
96 ;
97REMAIN ;Review remaining entries that were not signed off. Entire section added with patch 17
98 N GMRAPA,LCVJ,Y,DIR,DIRUT,DUOUT,SIGNED,GMRAOUT,GMRANEW,DIC,DONE
99 S SIGNED=""
100 S LCVJ=0 F S LCVJ=$O(^TMP($J,"GMRASF",LCVJ)) Q:'+LCVJ D
101 .S GMRAPA=$O(^TMP($J,"GMRASF",LCVJ,0)) Q:'+GMRAPA S GMRAPA(0)=^GMR(120.8,GMRAPA,0)
102 .S DIR(0)="SB^Edit:Edit;Delete:Delete",DIR("B")="Edit" ;36
103 .S DIR("?")="Select edit or delete" ;36
104 .S DIR("?",1)="You must complete entry of this record. Select edit to change" ;36
105 .S DIR("?",2)="the record or delete to remove the record. Previously existing" ;36
106 .S DIR("?",3)="records will be marked as entered in error while records added" ;36
107 .S DIR("?",4)="during this session will be deleted." ;36
108 .S DIR("A")="For reactant "_$P(GMRAPA(0),U,2) D ^DIR K DIR S:$G(DIRUT) Y="E" ;36
109 .I $E(Y)="D" Q ;Do nothing if allergy is to be deleted
110 .S GMRANEW=0
111 .F D Q:DONE
112 ..S DONE=0,GMRAOUT=0
113 ..D EDIT^GMRAPEM4 W !
114 ..I $P(^GMR(120.8,GMRAPA,0),U,6)="o" I '$D(^GMR(120.85,"C",GMRAPA))!('$O(^GMR(120.85,+$O(^GMR(120.85,"C",GMRAPA,0)),2,0)))!('$$REQCOM^GMRAPEM0) D Q
115 ...W !,"Observed reactions require the date of the reaction and",!,"sign/symptoms",$S('$$REQCOM^GMRAPEM0:" and comments.",1:"."),!
116 ...S DIR(0)="SA^R:Re-edit;D:Delete",DIR("A")="Do you want to (R)e-edit or (D)elete this entry? ",DIR("B")="R" D ^DIR S:Y'="R" DONE=1 Q
117 ..I $P(^GMR(120.8,GMRAPA,0),U,6)="h",$D(^GMR(120.85,"C",GMRAPA)) D DELOBS ;Delete observed data if changing to historical
118 ..S DIR(0)="Y",DIR("A")="Is this entry now correct",DIR("B")="Y",DIR("?")="Answer yes to accept the allergy. Enter NO to re-edit. Enter ^ to delete this entry." D ^DIR
119 ..I Y=0 Q
120 ..I $G(DIRUT) S DONE=1 Q
121 ..S SIGNED=SIGNED_LCVJ_",",DONE=1
122 I $L(SIGNED)>1 D RANGE(SIGNED) ;Sign off on accepted allergies
123 I $O(^TMP($J,"GMRASF",0)) D DELETE^GMRADEL ;Delete unaccepted entries
124 Q
125 ;
126DELOBS ;Delete observed data from 120.85
127 N OIEN,DIK,DA
128 S OIEN=0 F S OIEN=$O(^GMR(120.85,"C",GMRAPA,OIEN)) Q:'+OIEN S DIK="^GMR(120.85,",DA=OIEN D ^DIK
129 Q
Note: See TracBrowser for help on using the repository browser.