- GMRAHDR ;SLC/DAN - HDR calls for ART ;4/1/09 13:55
- ;;4.0;Adverse Reaction Tracking;**18,24,26,42**;Mar 29, 1996;Build 4
- ;
- ;The variable GMRADONT can be set before making a call to this
- ;routine if you'd like to be able to change data but not have it
- ;sent to the HDR. If GMRADONT has a positive value then nothing
- ;will be queued to be sent to the HDR.
- ;A check will also be made for the existence of VAFCA08 to indicate
- ;whether a patient merge is taking place. If so, then data isn't
- ;sent to the HDR.
- ;
- SETADR ;Call here when updating data
- N IEN,OIEN
- I $G(GMRADONT)!($G(XDRDVALF)=1) Q ;Don't send HDR information if variable is set
- S IEN=$S($D(DA)=1:DA,1:DA($O(DA("?"),-1)))
- I +$P($G(^GMR(120.8,IEN,0)),U,12)=0 Q ;Stop if it isn't signed off yet
- I $$TESTPAT^VADPT($P(^GMR(120.8,IEN,0),U)) Q ;24 Don't send data for test patients
- D TASK("ADR",IEN),UPDRDI ;26 Schedule entry to be sent to HDR, note new data for RDI
- 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
- Q
- ;
- KILLADR ;Call here when data is deleted
- N IEN
- I $G(GMRADONT)!($G(XDRDVALF)=1) Q ;Don't send data to HDR if variable is set
- S IEN=$S($D(DA)=1:DA,1:DA($O(DA("?"),-1)))
- I $P($G(^GMR(120.8,IEN,0)),U,12)=0 Q ;Stop if it isn't signed off yet
- I $$TESTPAT^VADPT($P(^GMR(120.8,IEN,0),U)) Q ;24 Don't send data for test patients
- D TASK("ADR",IEN),UPDRDI ;26 Schedule entry to be sent to the HDR, note new data for RDI
- Q
- ;
- SETAA ;Action taken when assessment is changed
- I $G(GMRADONT)!($G(XDRDVALF)=1) Q ;Don't send data if variable is set
- I $$TESTPAT^VADPT(DA) Q ;24 Don't send data for test patients
- D TASK("ASMT",DA)
- Q
- ;
- KILLAA ;Action taken when value is deleted
- I $G(GMRADONT)!($G(XDRDVALF)=1) Q ;Don't send data to HDR if variable is set
- I $$TESTPAT^VADPT(DA) Q ;24 Don't send data for test patients
- D TASK("ASMT",DA)
- Q
- ;
- SETOB ;Make call to HDR when observation data is added or edited
- N IEN,AIEN
- I $G(GMRADONT)!($G(XDRDVALF)=1) Q ;Don't send data to HDR if variable is set
- S IEN=$S($D(DA)=1:DA,1:DA($O(DA("?"),-1)))
- S AIEN=+$P($G(^GMR(120.85,IEN,0)),U,15) Q:'+AIEN ;Stop if there's no related reaction
- I $P($G(^GMR(120.8,AIEN,0)),U,12)=0 Q ;Stop if related reaction not signed off
- I $$TESTPAT^VADPT($P(^GMR(120.8,AIEN,0),U)) Q ;24 Don't send data for test patients
- D TASK("OBS",IEN)
- Q
- ;
- KILLOB ;Action upon deletion of observation data
- N IEN,AIEN
- I $G(GMRADONT)!($G(XDRDVALF)=1) Q ;Don't send data to HDR if variable is set
- S IEN=$S($D(DA)=1:DA,1:DA($O(DA("?"),-1)))
- S AIEN=+$P($G(^GMR(120.85,IEN,0)),U,15) Q:'AIEN ;Quit if there's no related reaction
- I +$P($G(^GMR(120.8,AIEN,0)),U,12)=0 Q ;Quit if related reaction not signed off
- I $$TESTPAT^VADPT($P(^GMR(120.8,AIEN,0),U)) Q ;24 Don't send data for test patients
- D TASK("OBS",IEN)
- Q
- ;
- TASK(TYPE,IEN) ;Create task, if needed, and add entry to list of items to be sent to HDR
- N ZTRTN,ZTDESC,ZTDTH,ZTSK,ZTIO
- F L +^XTMP("GMRAHDR"):1 Q:$T ;Control global so no new entries are added
- ;Check if task exists, if so and it's older than 10 minutes and it's not scheduled to run, get a new task. Added w/patch 42
- I $D(^XTMP("GMRAHDR","TASK")) I $$FMDIFF^XLFDT($$NOW^XLFDT,$P(^XTMP("GMRAHDR",0),U,2),2)>600 I '$$TSKOK(+$G(^XTMP("GMRAHDR","TASK"))) K ^XTMP("GMRAHDR","TASK") ;42
- I '$D(^XTMP("GMRAHDR")) S ^XTMP("GMRAHDR",0)=$$FMADD^XLFDT(DT,30)_U_$$NOW^XLFDT_U_"Send allergy data to HDR"
- I '$D(^XTMP("GMRAHDR","TASK")) D
- .S ZTRTN="DQ^GMRAHDR",ZTDESC="Transmit allergy data to HDR",ZTDTH=$$HADD^XLFDT($H,,,2),ZTIO="" D ^%ZTLOAD S ^XTMP("GMRAHDR","TASK")=ZTSK
- S ^XTMP("GMRAHDR",TYPE,IEN)="" ;Store off entry to be sent later
- L -^XTMP("GMRAHDR") ;Release lock
- Q
- ;
- DQ ;Send data to HDR
- N TYPE,IEN,A
- F L +^XTMP("GMRAHDR"):1 Q:$T ;Get control of global
- F TYPE="ADR","ASMT","OBS" I $D(^XTMP("GMRAHDR",TYPE)) D
- .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)
- K ^XTMP("GMRAHDR")
- L -^XTMP("GMRAHDR")
- Q
- ;
- UPDRDI ;Create flag to let RDI know that patient data has changed
- N PIEN,ERR
- S PIEN=$P($G(^GMR(120.8,IEN,0)),U) Q:'+PIEN ;Quit if no patient IEN
- I '$D(^XTMP("GMRAOC",PIEN)) Q ;If no current patient data then no need to set flag
- F L +^XTMP("GMRAOC",PIEN):1 Q:$T
- S ERR=+$G(^GMR(120.8,IEN,"ER"))
- S ^XTMP("GMRAOC",PIEN,$S('ERR:"NEW",1:"ERROR"))=""
- L -^XTMP("GMRAOC",PIEN)
- Q
- ;
- TSKOK(ZTSK) ;Check to see if task is active. Section added in patch 42
- D ISQED^%ZTLOAD
- Q +ZTSK(0)
- GMRAHDR ;SLC/DAN - HDR calls for ART ;4/1/09 13:55
- +1 ;;4.0;Adverse Reaction Tracking;**18,24,26,42**;Mar 29, 1996;Build 4
- +2 ;
- +3 ;The variable GMRADONT can be set before making a call to this
- +4 ;routine if you'd like to be able to change data but not have it
- +5 ;sent to the HDR. If GMRADONT has a positive value then nothing
- +6 ;will be queued to be sent to the HDR.
- +7 ;A check will also be made for the existence of VAFCA08 to indicate
- +8 ;whether a patient merge is taking place. If so, then data isn't
- +9 ;sent to the HDR.
- +10 ;
- SETADR ;Call here when updating data
- +1 NEW IEN,OIEN
- +2 ;Don't send HDR information if variable is set
- IF $GET(GMRADONT)!($GET(XDRDVALF)=1)
- QUIT
- +3 SET IEN=$SELECT($DATA(DA)=1:DA,1:DA($ORDER(DA("?"),-1)))
- +4 ;Stop if it isn't signed off yet
- IF +$PIECE($GET(^GMR(120.8,IEN,0)),U,12)=0
- QUIT
- +5 ;24 Don't send data for test patients
- IF $$TESTPAT^VADPT($PIECE(^GMR(120.8,IEN,0),U))
- QUIT
- +6 ;26 Schedule entry to be sent to HDR, note new data for RDI
- DO TASK("ADR",IEN)
- DO UPDRDI
- +7 ;If observed reaction, send observed data on sign off
- IF $PIECE($GET(^GMR(120.8,IEN,0)),U,6)="o"
- SET OIEN=+$ORDER(^GMR(120.85,"C",IEN,0))
- IF $DATA(^GMR(120.85,OIEN,0))
- IF '+$GET(^GMR(120.8,IEN,"ER"))
- DO TASK("OBS",OIEN)
- +8 QUIT
- +9 ;
- KILLADR ;Call here when data is deleted
- +1 NEW IEN
- +2 ;Don't send data to HDR if variable is set
- IF $GET(GMRADONT)!($GET(XDRDVALF)=1)
- QUIT
- +3 SET IEN=$SELECT($DATA(DA)=1:DA,1:DA($ORDER(DA("?"),-1)))
- +4 ;Stop if it isn't signed off yet
- IF $PIECE($GET(^GMR(120.8,IEN,0)),U,12)=0
- QUIT
- +5 ;24 Don't send data for test patients
- IF $$TESTPAT^VADPT($PIECE(^GMR(120.8,IEN,0),U))
- QUIT
- +6 ;26 Schedule entry to be sent to the HDR, note new data for RDI
- DO TASK("ADR",IEN)
- DO UPDRDI
- +7 QUIT
- +8 ;
- SETAA ;Action taken when assessment is changed
- +1 ;Don't send data if variable is set
- IF $GET(GMRADONT)!($GET(XDRDVALF)=1)
- QUIT
- +2 ;24 Don't send data for test patients
- IF $$TESTPAT^VADPT(DA)
- QUIT
- +3 DO TASK("ASMT",DA)
- +4 QUIT
- +5 ;
- KILLAA ;Action taken when value is deleted
- +1 ;Don't send data to HDR if variable is set
- IF $GET(GMRADONT)!($GET(XDRDVALF)=1)
- QUIT
- +2 ;24 Don't send data for test patients
- IF $$TESTPAT^VADPT(DA)
- QUIT
- +3 DO TASK("ASMT",DA)
- +4 QUIT
- +5 ;
- SETOB ;Make call to HDR when observation data is added or edited
- +1 NEW IEN,AIEN
- +2 ;Don't send data to HDR if variable is set
- IF $GET(GMRADONT)!($GET(XDRDVALF)=1)
- QUIT
- +3 SET IEN=$SELECT($DATA(DA)=1:DA,1:DA($ORDER(DA("?"),-1)))
- +4 ;Stop if there's no related reaction
- SET AIEN=+$PIECE($GET(^GMR(120.85,IEN,0)),U,15)
- IF '+AIEN
- QUIT
- +5 ;Stop if related reaction not signed off
- IF $PIECE($GET(^GMR(120.8,AIEN,0)),U,12)=0
- QUIT
- +6 ;24 Don't send data for test patients
- IF $$TESTPAT^VADPT($PIECE(^GMR(120.8,AIEN,0),U))
- QUIT
- +7 DO TASK("OBS",IEN)
- +8 QUIT
- +9 ;
- KILLOB ;Action upon deletion of observation data
- +1 NEW IEN,AIEN
- +2 ;Don't send data to HDR if variable is set
- IF $GET(GMRADONT)!($GET(XDRDVALF)=1)
- QUIT
- +3 SET IEN=$SELECT($DATA(DA)=1:DA,1:DA($ORDER(DA("?"),-1)))
- +4 ;Quit if there's no related reaction
- SET AIEN=+$PIECE($GET(^GMR(120.85,IEN,0)),U,15)
- IF 'AIEN
- QUIT
- +5 ;Quit if related reaction not signed off
- IF +$PIECE($GET(^GMR(120.8,AIEN,0)),U,12)=0
- QUIT
- +6 ;24 Don't send data for test patients
- IF $$TESTPAT^VADPT($PIECE(^GMR(120.8,AIEN,0),U))
- QUIT
- +7 DO TASK("OBS",IEN)
- +8 QUIT
- +9 ;
- TASK(TYPE,IEN) ;Create task, if needed, and add entry to list of items to be sent to HDR
- +1 NEW ZTRTN,ZTDESC,ZTDTH,ZTSK,ZTIO
- +2 ;Control global so no new entries are added
- FOR
- LOCK +^XTMP("GMRAHDR"):1
- IF $TEST
- QUIT
- +3 ;Check if task exists, if so and it's older than 10 minutes and it's not scheduled to run, get a new task. Added w/patch 42
- +4 ;42
- IF $DATA(^XTMP("GMRAHDR","TASK"))
- IF $$FMDIFF^XLFDT($$NOW^XLFDT,$PIECE(^XTMP("GMRAHDR",0),U,2),2)>600
- IF '$$TSKOK(+$GET(^XTMP("GMRAHDR","TASK")))
- KILL ^XTMP("GMRAHDR","TASK")
- +5 IF '$DATA(^XTMP("GMRAHDR"))
- SET ^XTMP("GMRAHDR",0)=$$FMADD^XLFDT(DT,30)_U_$$NOW^XLFDT_U_"Send allergy data to HDR"
- +6 IF '$DATA(^XTMP("GMRAHDR","TASK"))
- Begin DoDot:1
- +7 SET ZTRTN="DQ^GMRAHDR"
- SET ZTDESC="Transmit allergy data to HDR"
- SET ZTDTH=$$HADD^XLFDT($HOROLOG,,,2)
- SET ZTIO=""
- DO ^%ZTLOAD
- SET ^XTMP("GMRAHDR","TASK")=ZTSK
- End DoDot:1
- +8 ;Store off entry to be sent later
- SET ^XTMP("GMRAHDR",TYPE,IEN)=""
- +9 ;Release lock
- LOCK -^XTMP("GMRAHDR")
- +10 QUIT
- +11 ;
- DQ ;Send data to HDR
- +1 NEW TYPE,IEN,A
- +2 ;Get control of global
- FOR
- LOCK +^XTMP("GMRAHDR"):1
- IF $TEST
- QUIT
- +3 FOR TYPE="ADR","ASMT","OBS"
- IF $DATA(^XTMP("GMRAHDR",TYPE))
- Begin DoDot:1
- +4 SET IEN=0
- FOR
- SET IEN=$ORDER(^XTMP("GMRAHDR",TYPE,IEN))
- IF '+IEN
- QUIT
- IF $LENGTH($TEXT(QUEUE^VDEFQM))
- SET A=$$QUEUE^VDEFQM("ORU^R01","SUBTYPE="_$SELECT(TYPE="ADR":"ALGY",TYPE="ASMT":"ADAS",1:"ADRA")_"^IEN="_IEN,.GMRAERR)
- End DoDot:1
- +5 KILL ^XTMP("GMRAHDR")
- +6 LOCK -^XTMP("GMRAHDR")
- +7 QUIT
- +8 ;
- UPDRDI ;Create flag to let RDI know that patient data has changed
- +1 NEW PIEN,ERR
- +2 ;Quit if no patient IEN
- SET PIEN=$PIECE($GET(^GMR(120.8,IEN,0)),U)
- IF '+PIEN
- QUIT
- +3 ;If no current patient data then no need to set flag
- IF '$DATA(^XTMP("GMRAOC",PIEN))
- QUIT
- +4 FOR
- LOCK +^XTMP("GMRAOC",PIEN):1
- IF $TEST
- QUIT
- +5 SET ERR=+$GET(^GMR(120.8,IEN,"ER"))
- +6 SET ^XTMP("GMRAOC",PIEN,$SELECT('ERR:"NEW",1:"ERROR"))=""
- +7 LOCK -^XTMP("GMRAOC",PIEN)
- +8 QUIT
- +9 ;
- TSKOK(ZTSK) ;Check to see if task is active. Section added in patch 42
- +1 DO ISQED^%ZTLOAD
- +2 QUIT +ZTSK(0)