source: FOIAVistA/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAHDR.m@ 1446

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

initial load of FOIAVistA 6/30/08 version
File size: 4.1 KB
Line 
1GMRAHDR ;SLC/DAN - HDR calls for ART ;5/12/06 08:04
2 ;;4.0;Adverse Reaction Tracking;**18,24,26**;Mar 29, 1996;Build 4
3 ;
4 ;The variable GMRADONT can be set before making a call to this
5 ;routine if you'd like to be able to change data but not have it
6 ;sent to the HDR. If GMRADONT has a positive value then nothing
7 ;will be queued to be sent to the HDR.
8 ;A check will also be made for the existence of VAFCA08 to indicate
9 ;whether a patient merge is taking place. If so, then data isn't
10 ;sent to the HDR.
11 ;
12SETADR ;Call here when updating data
13 N IEN,OIEN
14 I $G(GMRADONT)!($G(XDRDVALF)=1) Q ;Don't send HDR information if variable is set
15 S IEN=$S($D(DA)=1:DA,1:DA($O(DA("?"),-1)))
16 I +$P($G(^GMR(120.8,IEN,0)),U,12)=0 Q ;Stop if it isn't signed off yet
17 I $$TESTPAT^VADPT($P(^GMR(120.8,IEN,0),U)) Q ;24 Don't send data for test patients
18 D TASK("ADR",IEN),UPDRDI ;26 Schedule entry to be sent to HDR, note new data for RDI
19 I $P($G(^GMR(120.8,IEN,0)),U,6)="o" S OIEN=+$O(^GMR(120.85,"C",IEN,0)) I $D(^GMR(120.85,OIEN,0)),'+$G(^GMR(120.8,IEN,"ER")) D TASK("OBS",OIEN) ;If observed reaction, send observed data on sign off
20 Q
21 ;
22KILLADR ;Call here when data is deleted
23 N IEN
24 I $G(GMRADONT)!($G(XDRDVALF)=1) Q ;Don't send data to HDR if variable is set
25 S IEN=$S($D(DA)=1:DA,1:DA($O(DA("?"),-1)))
26 I $P($G(^GMR(120.8,IEN,0)),U,12)=0 Q ;Stop if it isn't signed off yet
27 I $$TESTPAT^VADPT($P(^GMR(120.8,IEN,0),U)) Q ;24 Don't send data for test patients
28 D TASK("ADR",IEN),UPDRDI ;26 Schedule entry to be sent to the HDR, note new data for RDI
29 Q
30 ;
31SETAA ;Action taken when assessment is changed
32 I $G(GMRADONT)!($G(XDRDVALF)=1) Q ;Don't send data if variable is set
33 I $$TESTPAT^VADPT(DA) Q ;24 Don't send data for test patients
34 D TASK("ASMT",DA)
35 Q
36 ;
37KILLAA ;Action taken when value is deleted
38 I $G(GMRADONT)!($G(XDRDVALF)=1) Q ;Don't send data to HDR if variable is set
39 I $$TESTPAT^VADPT(DA) Q ;24 Don't send data for test patients
40 D TASK("ASMT",DA)
41 Q
42 ;
43SETOB ;Make call to HDR when observation data is added or edited
44 N IEN,AIEN
45 I $G(GMRADONT)!($G(XDRDVALF)=1) Q ;Don't send data to HDR if variable is set
46 S IEN=$S($D(DA)=1:DA,1:DA($O(DA("?"),-1)))
47 S AIEN=+$P($G(^GMR(120.85,IEN,0)),U,15) Q:'+AIEN ;Stop if there's no related reaction
48 I $P($G(^GMR(120.8,AIEN,0)),U,12)=0 Q ;Stop if related reaction not signed off
49 I $$TESTPAT^VADPT($P(^GMR(120.8,AIEN,0),U)) Q ;24 Don't send data for test patients
50 D TASK("OBS",IEN)
51 Q
52 ;
53KILLOB ;Action upon deletion of observation data
54 N IEN,AIEN
55 I $G(GMRADONT)!($G(XDRDVALF)=1) Q ;Don't send data to HDR if variable is set
56 S IEN=$S($D(DA)=1:DA,1:DA($O(DA("?"),-1)))
57 S AIEN=+$P($G(^GMR(120.85,IEN,0)),U,15) Q:'AIEN ;Quit if there's no related reaction
58 I +$P($G(^GMR(120.8,AIEN,0)),U,12)=0 Q ;Quit if related reaction not signed off
59 I $$TESTPAT^VADPT($P(^GMR(120.8,AIEN,0),U)) Q ;24 Don't send data for test patients
60 D TASK("OBS",IEN)
61 Q
62 ;
63TASK(TYPE,IEN) ;Create task, if needed, and add entry to list of items to be sent to HDR
64 N ZTRTN,ZTDESC,ZTDTH,ZTSK,ZTIO
65 L +^XTMP("GMRAHDR") ;Control global so no new entries are added
66 I '$D(^XTMP("GMRAHDR")) S ^XTMP("GMRAHDR",0)=$$FMADD^XLFDT(DT,30)_U_$$NOW^XLFDT_U_"Send allergy data to HDR"
67 I '$D(^XTMP("GMRAHDR","TASK")) D
68 .S ZTRTN="DQ^GMRAHDR",ZTDESC="Transmit allergy data to HDR",ZTDTH=$$HADD^XLFDT($H,,,2),ZTIO="" D ^%ZTLOAD S ^XTMP("GMRAHDR","TASK")=ZTSK
69 S ^XTMP("GMRAHDR",TYPE,IEN)="" ;Store off entry to be sent later
70 L -^XTMP("GMRAHDR") ;Release lock
71 Q
72 ;
73DQ ;Send data to HDR
74 N TYPE,IEN,A
75 L +^XTMP("GMRAHDR") ;Get control of global
76 F TYPE="ADR","ASMT","OBS" I $D(^XTMP("GMRAHDR",TYPE)) D
77 .S IEN=0 F S IEN=$O(^XTMP("GMRAHDR",TYPE,IEN)) Q:'+IEN I $L($T(QUEUE^VDEFQM)) S A=$$QUEUE^VDEFQM("ORU^R01","SUBTYPE="_$S(TYPE="ADR":"ALGY",TYPE="ASMT":"ADAS",1:"ADRA")_"^IEN="_IEN,.GMRAERR)
78 K ^XTMP("GMRAHDR")
79 L -^XTMP("GMRAHDR")
80 Q
81 ;
82UPDRDI ;Create flag to let RDI know that patient data has changed
83 N PIEN,ERR
84 S PIEN=$P($G(^GMR(120.8,IEN,0)),U) Q:'+PIEN ;Quit if no patient IEN
85 I '$D(^XTMP("GMRAOC",PIEN)) Q ;If no current patient data then no need to set flag
86 L +^XTMP("GMRAOC",PIEN)
87 S ERR=+$G(^GMR(120.8,IEN,"ER"))
88 S ^XTMP("GMRAOC",PIEN,$S('ERR:"NEW",1:"ERROR"))=""
89 L -^XTMP("GMRAOC",PIEN)
90 Q
Note: See TracBrowser for help on using the repository browser.