GMRASEND ;HIRMFO/WAA-SEND ID BAND/CHART MARK TO BULLETIN/TEAM ;12/8/04 11:24
;;4.0;Adverse Reaction Tracking;**14,19,21**;Mar 29, 1996
BULLT ; SEND GMRA MARK CHART BULLETIN
I '$D(GMRATYPE) S GMRATYPE="B"
S GMRAOUT=0 K GMRASEND
I '$D(GMRASITE) D SITE^GMRAUTL S GMRASITE(0)=$G(^GMRD(120.84,+GMRASITE,0))
I $P(GMRASITE(0),U,8)=2 Q
I $P(GMRASITE(0),U,8)<1!($$VERSION^XPDUTL("OR")<2) D K GMRASEND,GMRASND,GMRABULL Q
.S GMRABULL=$$FIND1^DIC(3.8,,"BX","GMRA MARK CHART") ;19
.I GMRABULL<1 D:'$D(ZTQUEUED)&('$$BROKER^XWBLIB) Q ;19
..W !,"PLEASE CONTACT IRM TO CREATE A MAIL GROUP: GMRA MARK CHART",$C(7) S GMRASEND(DUZ)=""
..K DIR S DIR(0)="E" D ^DIR K DIR
..Q
.I '$$GOTLOCAL^XMXAPIG(GMRABULL) D:'$D(ZTQUEUED)&('$$BROKER^XWBLIB) Q ;19
..W !,"CALL IRM AND HAVE USERS ASSIGNED TO THE GMRA MARK CHART MAIL GROUP",$C(7)
..K DIR S DIR(0)="E" D ^DIR K DIR S GMRASEND(DUZ)=""
..Q
.E S GMRASEND("G.GMRA MARK CHART")="" ;19
.S DFN=$P(GMRAPA(0),U) D INP^VADPT S:'+VAIN(4) GMRALOC=""
.I +VAIN(4) S GMRAHLOC=+$G(^DIC(42,+VAIN(4),44)),GMRALOC=$P(VAIN(4),U,2)
.D PID^VADPT6 S GMRAVIP=VA("PID") D KVAR^VADPT K VA
.D BUL(.GMRASEND,GMRATYPE)
.Q
;=====================================================================
S GMRAPAT=$P(GMRAPA(0),U)_";DPT("
S GMRATEAM=0 F S GMRATEAM=$O(^OR(100.21,"AB",GMRAPAT,GMRATEAM)) Q:GMRATEAM<1 D
.Q:'$D(^OR(100.21,GMRATEAM,0))
.S GMRASEND=0 F S GMRASEND=$O(^OR(100.21,GMRATEAM,1,GMRASEND)) Q:GMRASEND<1 D
..Q:'$D(^OR(100.21,GMRATEAM,1,GMRASEND,0))
..S GMRASEND(GMRASEND)=""
..Q
.Q
;*********************************************************************
D BUL(.GMRASEND,GMRATYPE)
K GMRAPAT,GMRATEAM,GMRASEND
Q
BUL(XMY,GMRATYPE) ;MAIL A BULLETIN TO A GROUP OR PERSON
I '$D(GMRAVIP) S DFN=$P(GMRAPA(0),U) D PID^VADPT6 S GMRAVIP=VA("PID") D KVAR^VADPT K VA
I '($D(XMY)\10) W:'$D(ZTQUEUED)&('$$BROKER^XWBLIB) !,"CALL IRM THERE IS NO ONE TO RECEIVE THIS BULLETIN",$C(7) S GMRAOUT=1 Q ;19
I GMRATYPE="A",$P(GMRASITE(0),U,9)'=0 D Q
.N GMRA
.S GMRA=0 F S GMRA=$O(XMY(GMRA)) Q:GMRA<1 S XQA(GMRA)=""
.K XMY
.S XQAMSG="Mark Chart"_$S(GMRALOC'="":"/ID Band",1:"")_" for "_$E(GMRANAM,1,30)_","_GMRAVIP_" with "_$E($P(GMRAPA(0),U,2),1,20)
.D SETUP^XQALERT
.Q
S XMB(1)=GMRANAM,XMB(3)=$S(GMRALOC'="":GMRALOC,1:"Outpatient"),XMB(4)=GMRAVIP,XMB(2)=$P(GMRAPA(0),U,2) ;19
S XMB(5)=$S($P(GMRAPA(0),U,14)="A":"Allergy",$P(GMRAPA(0),U,14)="P":"Adverse Reaction",$P(GMRAPA(0),U,14)="U":"Unknown",1:"")
N GMRACHT,GMRAID ;21
S GMRACHT=$O(^GMR(120.8,GMRAPA,13,0)),GMRAID=$S('$P(GMRASITE(0),U,5):1,$G(GMRAHLOC):$O(^GMR(120.8,GMRAPA,14,0)),1:1) ;21
S (XMB(6),XMB(7))=$S('GMRACHT&('GMRAID):"chart and ID band",'GMRACHT:"chart",'GMRAID:"ID band",1:"") ;21
I XMB(6)="" Q ;21 Don't send bulletin if it's not needed
N GMRAXMB,GMRAXMY ;19
M GMRAXMB=XMB,GMRAXMY=XMY ;19
D SENDBULL^XMXAPI(DUZ,"GMRA MARK CHART",.GMRAXMB,,.GMRAXMY) ;19
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRASEND 2931 printed Jun 11, 2024@21:24:11 Page 2
GMRASEND ;HIRMFO/WAA-SEND ID BAND/CHART MARK TO BULLETIN/TEAM ;12/8/04 11:24
+1 ;;4.0;Adverse Reaction Tracking;**14,19,21**;Mar 29, 1996
BULLT ; SEND GMRA MARK CHART BULLETIN
+1 IF '$DATA(GMRATYPE)
SET GMRATYPE="B"
+2 SET GMRAOUT=0
KILL GMRASEND
+3 IF '$DATA(GMRASITE)
DO SITE^GMRAUTL
SET GMRASITE(0)=$GET(^GMRD(120.84,+GMRASITE,0))
+4 IF $PIECE(GMRASITE(0),U,8)=2
QUIT
+5 IF $PIECE(GMRASITE(0),U,8)<1!($$VERSION^XPDUTL("OR")<2)
Begin DoDot:1
+6 ;19
SET GMRABULL=$$FIND1^DIC(3.8,,"BX","GMRA MARK CHART")
+7 ;19
IF GMRABULL<1
if '$DATA(ZTQUEUED)&('$$BROKER^XWBLIB)
Begin DoDot:2
+8 WRITE !,"PLEASE CONTACT IRM TO CREATE A MAIL GROUP: GMRA MARK CHART",$CHAR(7)
SET GMRASEND(DUZ)=""
+9 KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
+10 QUIT
End DoDot:2
QUIT
+11 ;19
IF '$$GOTLOCAL^XMXAPIG(GMRABULL)
if '$DATA(ZTQUEUED)&('$$BROKER^XWBLIB)
Begin DoDot:2
+12 WRITE !,"CALL IRM AND HAVE USERS ASSIGNED TO THE GMRA MARK CHART MAIL GROUP",$CHAR(7)
+13 KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
SET GMRASEND(DUZ)=""
+14 QUIT
End DoDot:2
QUIT
+15 ;19
IF '$TEST
SET GMRASEND("G.GMRA MARK CHART")=""
+16 SET DFN=$PIECE(GMRAPA(0),U)
DO INP^VADPT
if '+VAIN(4)
SET GMRALOC=""
+17 IF +VAIN(4)
SET GMRAHLOC=+$GET(^DIC(42,+VAIN(4),44))
SET GMRALOC=$PIECE(VAIN(4),U,2)
+18 DO PID^VADPT6
SET GMRAVIP=VA("PID")
DO KVAR^VADPT
KILL VA
+19 DO BUL(.GMRASEND,GMRATYPE)
+20 QUIT
End DoDot:1
KILL GMRASEND,GMRASND,GMRABULL
QUIT
+21 ;=====================================================================
+22 SET GMRAPAT=$PIECE(GMRAPA(0),U)_";DPT("
+23 SET GMRATEAM=0
FOR
SET GMRATEAM=$ORDER(^OR(100.21,"AB",GMRAPAT,GMRATEAM))
if GMRATEAM<1
QUIT
Begin DoDot:1
+24 if '$DATA(^OR(100.21,GMRATEAM,0))
QUIT
+25 SET GMRASEND=0
FOR
SET GMRASEND=$ORDER(^OR(100.21,GMRATEAM,1,GMRASEND))
if GMRASEND<1
QUIT
Begin DoDot:2
+26 if '$DATA(^OR(100.21,GMRATEAM,1,GMRASEND,0))
QUIT
+27 SET GMRASEND(GMRASEND)=""
+28 QUIT
End DoDot:2
+29 QUIT
End DoDot:1
+30 ;*********************************************************************
+31 DO BUL(.GMRASEND,GMRATYPE)
+32 KILL GMRAPAT,GMRATEAM,GMRASEND
+33 QUIT
BUL(XMY,GMRATYPE) ;MAIL A BULLETIN TO A GROUP OR PERSON
+1 IF '$DATA(GMRAVIP)
SET DFN=$PIECE(GMRAPA(0),U)
DO PID^VADPT6
SET GMRAVIP=VA("PID")
DO KVAR^VADPT
KILL VA
+2 ;19
IF '($DATA(XMY)\10)
if '$DATA(ZTQUEUED)&('$$BROKER^XWBLIB)
WRITE !,"CALL IRM THERE IS NO ONE TO RECEIVE THIS BULLETIN",$CHAR(7)
SET GMRAOUT=1
QUIT
+3 IF GMRATYPE="A"
IF $PIECE(GMRASITE(0),U,9)'=0
Begin DoDot:1
+4 NEW GMRA
+5 SET GMRA=0
FOR
SET GMRA=$ORDER(XMY(GMRA))
if GMRA<1
QUIT
SET XQA(GMRA)=""
+6 KILL XMY
+7 SET XQAMSG="Mark Chart"_$SELECT(GMRALOC'="":"/ID Band",1:"")_" for "_$EXTRACT(GMRANAM,1,30)_","_GMRAVIP_" with "_$EXTRACT($PIECE(GMRAPA(0),U,2),1,20)
+8 DO SETUP^XQALERT
+9 QUIT
End DoDot:1
QUIT
+10 ;19
SET XMB(1)=GMRANAM
SET XMB(3)=$SELECT(GMRALOC'="":GMRALOC,1:"Outpatient")
SET XMB(4)=GMRAVIP
SET XMB(2)=$PIECE(GMRAPA(0),U,2)
+11 SET XMB(5)=$SELECT($PIECE(GMRAPA(0),U,14)="A":"Allergy",$PIECE(GMRAPA(0),U,14)="P":"Adverse Reaction",$PIECE(GMRAPA(0),U,14)="U":"Unknown",1:"")
+12 ;21
NEW GMRACHT,GMRAID
+13 ;21
SET GMRACHT=$ORDER(^GMR(120.8,GMRAPA,13,0))
SET GMRAID=$SELECT('$PIECE(GMRASITE(0),U,5):1,$GET(GMRAHLOC):$ORDER(^GMR(120.8,GMRAPA,14,0)),1:1)
+14 ;21
SET (XMB(6),XMB(7))=$SELECT('GMRACHT&('GMRAID):"chart and ID band",'GMRACHT:"chart",'GMRAID:"ID band",1:"")
+15 ;21 Don't send bulletin if it's not needed
IF XMB(6)=""
QUIT
+16 ;19
NEW GMRAXMB,GMRAXMY
+17 ;19
MERGE GMRAXMB=XMB,GMRAXMY=XMY
+18 ;19
DO SENDBULL^XMXAPI(DUZ,"GMRA MARK CHART",.GMRAXMB,,.GMRAXMY)
+19 QUIT
