GMRAEAB ;HIRMFO/RM-BULLETIN SEND FOR E/E REACTIONS ;12/22/04 08:57
;;4.0;Adverse Reaction Tracking;**21**;Mar 29, 1996
EN1 ; SEND BULLETIN TO ALL VERIFIERS/CHART MARK GROUPS
; INDICATING A/AR NEEDS UPDATES
N GMRAGRUP,%
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 ENTERED IN ERROR"
; 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)'="":$$GET1^DIQ(200,$P(GMRAPA(0),U,5)_",",".01"),1:"<None>") ;21 Originator
S XMB(6)=$$GET1^DIQ(200,$P($G(^GMR(120.8,GMRAPA,"ER")),U,3)_",",".01") ;21 Enter in error by
S XMB(7)=$$FMTE^XLFDT($P($G(^GMR(120.8,GMRAPA,"ER")),U,2),1) ; Enter in error on
S XMB(9)=$$FMTE^XLFDT($P(GMRAPA(0),U,4)) ;21
; Signs/symptoms and comments
K ^TMP($J,"GMRACOM")
N GMRAKIND,GMRACNT,GMRAX,GMRASP,GMRADATA,GMRAI,GMRAP ;21
S GMRACNT=1,GMRASP=" "
D EN1^GMRAOR2(GMRAPA,"GMRADATA") ;21
I $D(GMRADATA("S")) S ^TMP($J,"GMRACOM",GMRACNT)=" Signs/Symptoms: " D ;21
.S GMRAI=0,GMRAP=0 F S GMRAI=$O(GMRADATA("S",GMRAI)) Q:'+GMRAI D ;21
..I 'GMRAP S ^TMP($J,"GMRACOM",GMRACNT)=^TMP($J,"GMRACOM",GMRACNT)_GMRADATA("S",GMRAI),GMRACNT=GMRACNT+1,GMRAP=1 Q ;21
..S ^TMP($J,"GMRACOM",GMRACNT)=$$REPEAT^XLFSTR(" ",24)_GMRADATA("S",GMRAI),GMRACNT=GMRACNT+1 ;21
I $D(^GMR(120.8,GMRAPA,26,"AVER")) S ^TMP($J,"GMRACOM",GMRACNT)="",GMRACNT=GMRACNT+1,^TMP($J,"GMRACOM",GMRACNT)="Comments:",GMRACNT=GMRACNT+1 ;21
F GMRAKIND="O","V","E" S GMRAX=0 S GMRAX=$O(^GMR(120.8,GMRAPA,26,"AVER",GMRAKIND,GMRAX)) I GMRAX>0 D
.S ^TMP($J,"GMRACOM",GMRACNT)=$E(GMRASP,1,5)_$S(GMRAKIND="O":"ORIGINATOR",GMRAKIND="V":"VERIFIER",GMRAKIND="E":"ENTERED IN ERROR",1:""),GMRACNT=GMRACNT+1
.S GMRAX=0 F S GMRAX=$O(^GMR(120.8,GMRAPA,26,"AVER",GMRAKIND,GMRAX)) Q:GMRAX<1 D
..N GMRAY,GMRAZ
..S GMRAY=$P(^GMR(120.8,GMRAPA,26,GMRAX,0),U),GMRAZ=$P(^(0),U,2)
..D PRINT Q:GMRAOUT
..Q
.Q
S XMTEXT="^TMP($J,""GMRACOM"","
; Build XMY array
;Only send bulletin to verifier groups if reactant still needs to be verified or if it wasn't autoverified
I '+$P(GMRAPA(0),U,16)!($P(GMRAPA(0),U,18)) F %=1:1:$L($P(GMRAPA(0),"^",20)) D ;21
.S GMRAGRUP=$E($P(GMRAPA(0),"^",20),%)
.S XMY("G.GMRA VERIFY "_$S(GMRAGRUP="D":"DRUG",GMRAGRUP="F":"FOOD",1:"OTHER")_" ALLERGY")=""
.Q
S XMY("G.GMRA MARK CHART")=""
I $P(GMRAPA(0),U,20)["D"&($P(GMRAPA(0),U,6)="o") S XMY("G.GMRA P&T COMMITTEE FDA")="",XMB(8)="and FDA information " ;21
D ^XMB
K XMB,XMY,XMTEXT,GMRATEXT,^TMP($J,"GMRACOM")
Q
PRINT ;PRINT OUT THE DATA
N GMRAT,GMRAZN S (GMRAZN,GMRAT)=""
S:GMRAZ'="" GMRAZN=$$GET1^DIQ(200,GMRAZ_",",".01") ;21
S:GMRAZ'="" GMRAT=$$GET1^DIQ(200,GMRAZ_",","8","I") ;21
S:GMRAT'="" GMRAT=$P($G(^DIC(3.1,GMRAT,0)),U)
S ^TMP($J,"GMRACOM",GMRACNT)=$E(GMRASP,1,10)_"Date: "_$$FMTE^XLFDT(GMRAY,1)_$E(GMRASP,1,10)_"User: "_GMRAZN,GMRACNT=GMRACNT+1
S ^TMP($J,"GMRACOM",GMRACNT)=$E(GMRASP,1,47)_"Title: "_GMRAT,GMRACNT=GMRACNT+1
I '$D(^GMR(120.8,GMRAPA,26,GMRAX,2,0)) Q
S DIWL=16,DIWR=75,DIWF=""
K ^UTILITY($J,"W",DIWL)
S GMRAXX=0 F S GMRAXX=$O(^GMR(120.8,GMRAPA,26,GMRAX,2,GMRAXX)) Q:GMRAXX<1 S X=^(GMRAXX,0) D ^DIWP
S GMRAXX=0 F S GMRAXX=$O(^UTILITY($J,"W",DIWL,GMRAXX)) Q:GMRAXX<1 S ^TMP($J,"GMRACOM",GMRACNT)=$E(GMRASP,1,16)_^UTILITY($J,"W",DIWL,GMRAXX,0),GMRACNT=GMRACNT+1
S ^TMP($J,"GMRACOM",GMRACNT)=" ",GMRACNT=GMRACNT+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRAEAB 3692 printed Oct 16, 2024@17:39:51 Page 2
GMRAEAB ;HIRMFO/RM-BULLETIN SEND FOR E/E REACTIONS ;12/22/04 08:57
+1 ;;4.0;Adverse Reaction Tracking;**21**;Mar 29, 1996
EN1 ; SEND BULLETIN TO ALL VERIFIERS/CHART MARK GROUPS
+1 ; INDICATING A/AR NEEDS UPDATES
+2 NEW GMRAGRUP,%
+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 ENTERED IN ERROR"
+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 ;21 Originator
SET XMB(5)=$SELECT($PIECE(GMRAPA(0),U,5)'="":$$GET1^DIQ(200,$PIECE(GMRAPA(0),U,5)_",",".01"),1:"<None>")
+14 ;21 Enter in error by
SET XMB(6)=$$GET1^DIQ(200,$PIECE($GET(^GMR(120.8,GMRAPA,"ER")),U,3)_",",".01")
+15 ; Enter in error on
SET XMB(7)=$$FMTE^XLFDT($PIECE($GET(^GMR(120.8,GMRAPA,"ER")),U,2),1)
+16 ;21
SET XMB(9)=$$FMTE^XLFDT($PIECE(GMRAPA(0),U,4))
+17 ; Signs/symptoms and comments
+18 KILL ^TMP($JOB,"GMRACOM")
+19 ;21
NEW GMRAKIND,GMRACNT,GMRAX,GMRASP,GMRADATA,GMRAI,GMRAP
+20 SET GMRACNT=1
SET GMRASP=" "
+21 ;21
DO EN1^GMRAOR2(GMRAPA,"GMRADATA")
+22 ;21
IF $DATA(GMRADATA("S"))
SET ^TMP($JOB,"GMRACOM",GMRACNT)=" Signs/Symptoms: "
Begin DoDot:1
+23 ;21
SET GMRAI=0
SET GMRAP=0
FOR
SET GMRAI=$ORDER(GMRADATA("S",GMRAI))
if '+GMRAI
QUIT
Begin DoDot:2
+24 ;21
IF 'GMRAP
SET ^TMP($JOB,"GMRACOM",GMRACNT)=^TMP($JOB,"GMRACOM",GMRACNT)_GMRADATA("S",GMRAI)
SET GMRACNT=GMRACNT+1
SET GMRAP=1
QUIT
+25 ;21
SET ^TMP($JOB,"GMRACOM",GMRACNT)=$$REPEAT^XLFSTR(" ",24)_GMRADATA("S",GMRAI)
SET GMRACNT=GMRACNT+1
End DoDot:2
End DoDot:1
+26 ;21
IF $DATA(^GMR(120.8,GMRAPA,26,"AVER"))
SET ^TMP($JOB,"GMRACOM",GMRACNT)=""
SET GMRACNT=GMRACNT+1
SET ^TMP($JOB,"GMRACOM",GMRACNT)="Comments:"
SET GMRACNT=GMRACNT+1
+27 FOR GMRAKIND="O","V","E"
SET GMRAX=0
SET GMRAX=$ORDER(^GMR(120.8,GMRAPA,26,"AVER",GMRAKIND,GMRAX))
IF GMRAX>0
Begin DoDot:1
+28 SET ^TMP($JOB,"GMRACOM",GMRACNT)=$EXTRACT(GMRASP,1,5)_$SELECT(GMRAKIND="O":"ORIGINATOR",GMRAKIND="V":"VERIFIER",GMRAKIND="E":"ENTERED IN ERROR",1:"")
SET GMRACNT=GMRACNT+1
+29 SET GMRAX=0
FOR
SET GMRAX=$ORDER(^GMR(120.8,GMRAPA,26,"AVER",GMRAKIND,GMRAX))
if GMRAX<1
QUIT
Begin DoDot:2
+30 NEW GMRAY,GMRAZ
+31 SET GMRAY=$PIECE(^GMR(120.8,GMRAPA,26,GMRAX,0),U)
SET GMRAZ=$PIECE(^(0),U,2)
+32 DO PRINT
if GMRAOUT
QUIT
+33 QUIT
End DoDot:2
+34 QUIT
End DoDot:1
+35 SET XMTEXT="^TMP($J,""GMRACOM"","
+36 ; Build XMY array
+37 ;Only send bulletin to verifier groups if reactant still needs to be verified or if it wasn't autoverified
+38 ;21
IF '+$PIECE(GMRAPA(0),U,16)!($PIECE(GMRAPA(0),U,18))
FOR %=1:1:$LENGTH($PIECE(GMRAPA(0),"^",20))
Begin DoDot:1
+39 SET GMRAGRUP=$EXTRACT($PIECE(GMRAPA(0),"^",20),%)
+40 SET XMY("G.GMRA VERIFY "_$SELECT(GMRAGRUP="D":"DRUG",GMRAGRUP="F":"FOOD",1:"OTHER")_" ALLERGY")=""
+41 QUIT
End DoDot:1
+42 SET XMY("G.GMRA MARK CHART")=""
+43 ;21
IF $PIECE(GMRAPA(0),U,20)["D"&($PIECE(GMRAPA(0),U,6)="o")
SET XMY("G.GMRA P&T COMMITTEE FDA")=""
SET XMB(8)="and FDA information "
+44 DO ^XMB
+45 KILL XMB,XMY,XMTEXT,GMRATEXT,^TMP($JOB,"GMRACOM")
+46 QUIT
PRINT ;PRINT OUT THE DATA
+1 NEW GMRAT,GMRAZN
SET (GMRAZN,GMRAT)=""
+2 ;21
if GMRAZ'=""
SET GMRAZN=$$GET1^DIQ(200,GMRAZ_",",".01")
+3 ;21
if GMRAZ'=""
SET GMRAT=$$GET1^DIQ(200,GMRAZ_",","8","I")
+4 if GMRAT'=""
SET GMRAT=$PIECE($GET(^DIC(3.1,GMRAT,0)),U)
+5 SET ^TMP($JOB,"GMRACOM",GMRACNT)=$EXTRACT(GMRASP,1,10)_"Date: "_$$FMTE^XLFDT(GMRAY,1)_$EXTRACT(GMRASP,1,10)_"User: "_GMRAZN
SET GMRACNT=GMRACNT+1
+6 SET ^TMP($JOB,"GMRACOM",GMRACNT)=$EXTRACT(GMRASP,1,47)_"Title: "_GMRAT
SET GMRACNT=GMRACNT+1
+7 IF '$DATA(^GMR(120.8,GMRAPA,26,GMRAX,2,0))
QUIT
+8 SET DIWL=16
SET DIWR=75
SET DIWF=""
+9 KILL ^UTILITY($JOB,"W",DIWL)
+10 SET GMRAXX=0
FOR
SET GMRAXX=$ORDER(^GMR(120.8,GMRAPA,26,GMRAX,2,GMRAXX))
if GMRAXX<1
QUIT
SET X=^(GMRAXX,0)
DO ^DIWP
+11 SET GMRAXX=0
FOR
SET GMRAXX=$ORDER(^UTILITY($JOB,"W",DIWL,GMRAXX))
if GMRAXX<1
QUIT
SET ^TMP($JOB,"GMRACOM",GMRACNT)=$EXTRACT(GMRASP,1,16)_^UTILITY($JOB,"W",DIWL,GMRAXX,0)
SET GMRACNT=GMRACNT+1
+12 SET ^TMP($JOB,"GMRACOM",GMRACNT)=" "
SET GMRACNT=GMRACNT+1
+13 QUIT
