GMRAPTB ;HIRMFO/RM-BULLETIN SEND FOR E/E REACTIONS ;5/10/96 08:04
;;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)
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
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAPTB 2939 printed Oct 16, 2024@17:41:15 Page 2
GMRAPTB ;HIRMFO/RM-BULLETIN SEND FOR E/E REACTIONS ;5/10/96 08:04
+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 IF GMRALOC'=""
IF +$GET(^DIC(42,GMRALOC,44))
SET GMRALOC=$PIECE($GET(^SC(+$GET(^DIC(42,GMRALOC,44)),0)),U)
+6 IF GMRALOC=""
SET GMRALOC="OUT PATIENT"
+7 SET XMB="GMRA SIGNS/SYMPTOMS UPDATE"
+8 ; Build XMB array
+9 ; Patient Name
SET XMB(1)=GMRANAM
+10 ; Patient SSN
SET XMB(2)=GMRASSN
+11 ; Reaction
SET XMB(3)=$PIECE(GMRAPA(0),"^",2)
+12 ; Location
SET XMB(4)=GMRALOC
+13 ; Originator
SET XMB(5)=$SELECT($PIECE(GMRAPA(0),U,5)'="":$PIECE($GET(^VA(200,$PIECE(GMRAPA(0),U,5),0)),U),1:"<None>")
+14 ; Get reactains that were changed
+15 KILL ^TMP($JOB,"GMRAPT")
+16 SET GMRACNT=1
SET GMRASP=" "
+17 ; v--Add s/s
+18 IF $DATA(GMRAPT("ADD"))
KILL GMRAX
Begin DoDot:1
+19 SET ^TMP($JOB,"GMRAPT",GMRACNT)=" The following Signs/Symptoms have been ADDED to this reaction:"
SET GMRACNT=GMRACNT+1
+20 SET GMRAX=""
FOR
SET GMRAX=$ORDER(GMRAPT("ADD",GMRAX))
if GMRAX=""
QUIT
SET ^TMP($JOB,"GMRAPT",GMRACNT)=" "_GMRAX
SET GMRACNT=GMRACNT+1
+21 QUIT
End DoDot:1
+22 ; v--Deleted s/s
+23 IF $DATA(GMRAPT("DELETE"))
KILL GMRAX
Begin DoDot:1
+24 SET ^TMP($JOB,"GMRAPT",GMRACNT)=" The following Signs/Symptoms have been DELETED from this reaction:"
SET GMRACNT=GMRACNT+1
+25 SET GMRAX=""
FOR
SET GMRAX=$ORDER(GMRAPT("DELETE",GMRAX))
if GMRAX=""
QUIT
SET ^TMP($JOB,"GMRAPT",GMRACNT)=" "_GMRAX
SET GMRACNT=GMRACNT+1
+26 QUIT
End DoDot:1
+27 SET XMTEXT="^TMP($J,""GMRAPT"","
+28 ; Build XMY array
+29 SET XMY("G.GMRA P&T COMMITTEE FDA")=""
+30 DO ^XMB
+31 KILL XMB,XMY,XMTEXT,GMRATEXT,^TMP($JOB,"GMRAPT")
+32 QUIT
