GMRAPTB ;HIRMFO/RM-BULLETIN SEND FOR E/E REACTIONS ;5/10/96 08:04 [ 05/06/2002 11:09 AM ]
;;4.0;Adverse Reaction Tracking;**2**;Mar 29, 1996
EN1 ; SEND BULLETIN TO P&T COMMITTEE
; This option is to fire of an alert to the P&T that a sign has changed
Q:$G(GMRAPA)<1 ;Bad or invalid IEN
S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)="" ;No zero Node
Q:$P(GMRAPA(0),U,6)'="o" ;Check to see that reaction is observed
Q:$P(GMRAPA(0),U,20)'["D" ;Check to see that reaction is a drug type
N GMRAPA1,GMRAPT,GMRAX
;Check to see if in 120.85
S GMRAPA1=$O(^GMR(120.85,"C",GMRAPA,0)) Q:GMRAPA1<1
Q:$G(^GMR(120.85,GMRAPA1,0))="" ;No zero Node
;Check to see if the reaction has changed
; v--Check for add reactions
I $D(GMRARAD) S GMRAX=0 F S GMRAX=$O(GMRARAD(GMRAX)) Q:GMRAX<1 S GMRAPT("ADD",$P(GMRARAD(GMRAX),U))=""
; v--Check for other add reactions
I $D(GMRAROT) S GMRATXT="" F S GMRATXT=$O(GMRAROT(GMRATXT)) Q:GMRATXT="" S GMRAPT("ADD",GMRATXT)=""
; v--Check for deleted reactions
I $D(GMRARDL) S GMRAX=0 F S GMRAX=$O(GMRARDL(GMRAX)) Q:GMRAX<1 S GMRATXT=$P($G(^GMRD(120.83,GMRAX,0)),U) S:GMRATXT'="" GMRAPT("DELETE",GMRATXT)=""
; v--Check for other deleted reactions
I $D(GMRAROTD) S GMRATXT="" F S GMRATXT=$O(GMRARAD(GMRATXT)) Q:GMRATXT="" S GMRAPT("DELETE",GMRATXT)=""
Q:'$D(GMRAPT) ; Nothing was added or deleted
D MAIL
Q
MAIL ; INDICATING MEDWATCH FOR NEEDS TO BE UPDATED NEEDS UPDATES
Q:'$D(GMRAPT)
N GMRAGRUP,%,GMRANAM,GMRALOC,GMRASSN
S GMRANAM="",GMRALOC="",GMRASSN=""
D VAD^GMRAUTL1($P(GMRAPA(0),U),"",.GMRALOC,.GMRANAM,"",.GMRASSN)
;IHS/ITSC/ENM 05/05/02 HRN CALL
S DFN=$P(GMRAPA(0),U),APSPHRN=$$HRCN^APSGFUNC
I GMRALOC'="",+$G(^DIC(42,GMRALOC,44)) S GMRALOC=$P($G(^SC(+$G(^DIC(42,GMRALOC,44)),0)),U)
I GMRALOC="" S GMRALOC="OUT PATIENT"
S XMB="GMRA SIGNS/SYMPTOMS UPDATE"
; Build XMB array
S XMB(1)=GMRANAM ; Patient Name
;IHS/ITSC/ENM 05/06/02 HRN SET
S XMB(2)=APSPHRN K APSPHRN ; Patient Health Rec Nbr.
;S XMB(2)=GMRASSN ; Patient SSN
S XMB(3)=$P(GMRAPA(0),"^",2) ; Reaction
S XMB(4)=GMRALOC ; Location
S XMB(5)=$S($P(GMRAPA(0),U,5)'="":$P($G(^VA(200,$P(GMRAPA(0),U,5),0)),U),1:"<None>") ; Originator
; Get reactains that were changed
K ^TMP($J,"GMRAPT")
S GMRACNT=1,GMRASP=" "
; v--Add s/s
I $D(GMRAPT("ADD")) K GMRAX D
.S ^TMP($J,"GMRAPT",GMRACNT)=" The following Signs/Symptoms have been ADDED to this reaction:" S GMRACNT=GMRACNT+1
.S GMRAX="" F S GMRAX=$O(GMRAPT("ADD",GMRAX)) Q:GMRAX="" S ^TMP($J,"GMRAPT",GMRACNT)=" "_GMRAX,GMRACNT=GMRACNT+1
.Q
; v--Deleted s/s
I $D(GMRAPT("DELETE")) K GMRAX D
.S ^TMP($J,"GMRAPT",GMRACNT)=" The following Signs/Symptoms have been DELETED from this reaction:" S GMRACNT=GMRACNT+1
.S GMRAX="" F S GMRAX=$O(GMRAPT("DELETE",GMRAX)) Q:GMRAX="" S ^TMP($J,"GMRAPT",GMRACNT)=" "_GMRAX,GMRACNT=GMRACNT+1
.Q
S XMTEXT="^TMP($J,""GMRAPT"","
; Build XMY array
S XMY("G.GMRA P&T COMMITTEE FDA")=""
D ^XMB
K XMB,XMY,XMTEXT,GMRATEXT,^TMP($J,"GMRAPT")
Q
GMRAPTB ;HIRMFO/RM-BULLETIN SEND FOR E/E REACTIONS ;5/10/96 08:04 [ 05/06/2002 11:09 AM ]
+1 ;;4.0;Adverse Reaction Tracking;**2**;Mar 29, 1996
EN1 ; SEND BULLETIN TO P&T COMMITTEE
+1 ; This option is to fire of an alert to the P&T that a sign has changed
+2 ;Bad or invalid IEN
IF $GET(GMRAPA)<1
QUIT
+3 ;No zero Node
SET GMRAPA(0)=$GET(^GMR(120.8,GMRAPA,0))
IF GMRAPA(0)=""
QUIT
+4 ;Check to see that reaction is observed
IF $PIECE(GMRAPA(0),U,6)'="o"
QUIT
+5 ;Check to see that reaction is a drug type
IF $PIECE(GMRAPA(0),U,20)'["D"
QUIT
+6 NEW GMRAPA1,GMRAPT,GMRAX
+7 ;Check to see if in 120.85
+8 SET GMRAPA1=$ORDER(^GMR(120.85,"C",GMRAPA,0))
IF GMRAPA1<1
QUIT
+9 ;No zero Node
IF $GET(^GMR(120.85,GMRAPA1,0))=""
QUIT
+10 ;Check to see if the reaction has changed
+11 ; v--Check for add reactions
+12 IF $DATA(GMRARAD)
SET GMRAX=0
FOR
SET GMRAX=$ORDER(GMRARAD(GMRAX))
IF GMRAX<1
QUIT
SET GMRAPT("ADD",$PIECE(GMRARAD(GMRAX),U))=""
+13 ; v--Check for other add reactions
+14 IF $DATA(GMRAROT)
SET GMRATXT=""
FOR
SET GMRATXT=$ORDER(GMRAROT(GMRATXT))
IF GMRATXT=""
QUIT
SET GMRAPT("ADD",GMRATXT)=""
+15 ; v--Check for deleted reactions
+16 IF $DATA(GMRARDL)
SET GMRAX=0
FOR
SET GMRAX=$ORDER(GMRARDL(GMRAX))
IF GMRAX<1
QUIT
SET GMRATXT=$PIECE($GET(^GMRD(120.83,GMRAX,0)),U)
IF GMRATXT'=""
SET GMRAPT("DELETE",GMRATXT)=""
+17 ; v--Check for other deleted reactions
+18 IF $DATA(GMRAROTD)
SET GMRATXT=""
FOR
SET GMRATXT=$ORDER(GMRARAD(GMRATXT))
IF GMRATXT=""
QUIT
SET GMRAPT("DELETE",GMRATXT)=""
+19 ; Nothing was added or deleted
IF '$DATA(GMRAPT)
QUIT
+20 DO MAIL
+21 QUIT
MAIL ; INDICATING MEDWATCH FOR NEEDS TO BE UPDATED NEEDS UPDATES
+1 IF '$DATA(GMRAPT)
QUIT
+2 NEW GMRAGRUP,%,GMRANAM,GMRALOC,GMRASSN
+3 SET GMRANAM=""
SET GMRALOC=""
SET GMRASSN=""
+4 DO VAD^GMRAUTL1($PIECE(GMRAPA(0),U),"",.GMRALOC,.GMRANAM,"",.GMRASSN)
+5 ;IHS/ITSC/ENM 05/05/02 HRN CALL
+6 SET DFN=$PIECE(GMRAPA(0),U)
SET APSPHRN=$$HRCN^APSGFUNC
+7 IF GMRALOC'=""
IF +$GET(^DIC(42,GMRALOC,44))
SET GMRALOC=$PIECE($GET(^SC(+$GET(^DIC(42,GMRALOC,44)),0)),U)
+8 IF GMRALOC=""
SET GMRALOC="OUT PATIENT"
+9 SET XMB="GMRA SIGNS/SYMPTOMS UPDATE"
+10 ; Build XMB array
+11 ; Patient Name
SET XMB(1)=GMRANAM
+12 ;IHS/ITSC/ENM 05/06/02 HRN SET
+13 ; Patient Health Rec Nbr.
SET XMB(2)=APSPHRN
KILL APSPHRN
+14 ;S XMB(2)=GMRASSN ; Patient SSN
+15 ; Reaction
SET XMB(3)=$PIECE(GMRAPA(0),"^",2)
+16 ; Location
SET XMB(4)=GMRALOC
+17 ; Originator
SET XMB(5)=$SELECT($PIECE(GMRAPA(0),U,5)'="":$PIECE($GET(^VA(200,$PIECE(GMRAPA(0),U,5),0)),U),1:"<None>")
+18 ; Get reactains that were changed
+19 KILL ^TMP($JOB,"GMRAPT")
+20 SET GMRACNT=1
SET GMRASP=" "
+21 ; v--Add s/s
+22 IF $DATA(GMRAPT("ADD"))
KILL GMRAX
Begin DoDot:1
+23 SET ^TMP($JOB,"GMRAPT",GMRACNT)=" The following Signs/Symptoms have been ADDED to this reaction:"
SET GMRACNT=GMRACNT+1
+24 SET GMRAX=""
FOR
SET GMRAX=$ORDER(GMRAPT("ADD",GMRAX))
IF GMRAX=""
QUIT
SET ^TMP($JOB,"GMRAPT",GMRACNT)=" "_GMRAX
SET GMRACNT=GMRACNT+1
+25 QUIT
End DoDot:1
+26 ; v--Deleted s/s
+27 IF $DATA(GMRAPT("DELETE"))
KILL GMRAX
Begin DoDot:1
+28 SET ^TMP($JOB,"GMRAPT",GMRACNT)=" The following Signs/Symptoms have been DELETED from this reaction:"
SET GMRACNT=GMRACNT+1
+29 SET GMRAX=""
FOR
SET GMRAX=$ORDER(GMRAPT("DELETE",GMRAX))
IF GMRAX=""
QUIT
SET ^TMP($JOB,"GMRAPT",GMRACNT)=" "_GMRAX
SET GMRACNT=GMRACNT+1
+30 QUIT
End DoDot:1
+31 SET XMTEXT="^TMP($J,""GMRAPT"","
+32 ; Build XMY array
+33 SET XMY("G.GMRA P&T COMMITTEE FDA")=""
+34 DO ^XMB
+35 KILL XMB,XMY,XMTEXT,GMRATEXT,^TMP($JOB,"GMRAPT")
+36 QUIT
