GMRASEN2 ;HIRMFO/WAA-SEND ID BAND/CHART MARK TO BULLETIN/TEAM ;12/21/04 15:56
;;4.0;Adverse Reaction Tracking;**14,19,21**;Mar 29, 1996
BULLT ; SEND GMRA MARK CHART BULLETIN
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
.D PID^VADPT6 S GMRAVIP=VA("PID") D KVAR^VADPT K VA
.D BUL(.GMRASEND)
.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)
K GMRAPAT,GMRATEAM,GMRASEND
Q
BUL(XMY) ;MAIL A BULLETIN TO A GROUP OR PERSON
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
S XMB(1)=GMRANAM,XMB(3)=$S(GMRALOC'="":GMRALOC,1:"Outpatient"),XMB(4)=GMRAVIP ;19
I '$D(GMRAPA2(2)) S XMB(2)=$P(GMRAPA2(1),U),XMB(5)=$P(GMRAPA2(1),U,2)
E S XMB(2)="See listing of allergies below." D
.S GMRAPA2=0 F S GMRAPA2=$O(GMRAPA2(GMRAPA2)) Q:GMRAPA2<1 D
..N GMRALN,GMRASPC
..S GMRASPC=" "
..S GMRALN=GMRAPA2(GMRAPA2)
..S GMRAPA2(GMRAPA2)=$E($P(GMRALN,U),1,38)
..S GMRAPA2(GMRAPA2)=GMRAPA2(GMRAPA2)_$E(GMRASPC,$L(GMRAPA2(GMRAPA2)),40)
..S GMRAPA2(GMRAPA2)=GMRAPA2(GMRAPA2)_$P(GMRALN,U,2)
..Q
.S GMRAPA2=0 S XMTEXT="GMRAPA2",GMRAPA2(.4)="" ;21
.S GMRAPA2(.5)="This patient has the following allergies:"
.S GMRAPA2(.6)=""
.S GMRAPA2(.7)="Causative Agent Mechanism"
.S GMRAPA2(.8)="--------------- ---------"
.Q
S XMB(6)="chart (due to admission)",XMB(7)="chart" ;21
M GMRAXMB=XMB,GMRAXMY=XMY ;21
D SENDBULL^XMXAPI(DUZ,"GMRA MARK CHART",.GMRAXMB,$G(XMTEXT),.GMRAXMY) ;19,21
K GMRAPAT,GMRATEAM,GMRASEND
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRASEN2 2663 printed Apr 09, 2024@20:46:12 Page 2
GMRASEN2 ;HIRMFO/WAA-SEND ID BAND/CHART MARK TO BULLETIN/TEAM ;12/21/04 15:56
+1 ;;4.0;Adverse Reaction Tracking;**14,19,21**;Mar 29, 1996
BULLT ; SEND GMRA MARK CHART BULLETIN
+1 SET GMRAOUT=0
KILL GMRASEND
+2 IF '$DATA(GMRASITE)
DO SITE^GMRAUTL
SET GMRASITE(0)=$GET(^GMRD(120.84,+GMRASITE,0))
+3 IF $PIECE(GMRASITE(0),U,8)=2
QUIT
+4 IF $PIECE(GMRASITE(0),U,8)<1!($$VERSION^XPDUTL("OR")<2)
Begin DoDot:1
+5 ;19
SET GMRABULL=$$FIND1^DIC(3.8,,"BX","GMRA MARK CHART")
+6 ;19
IF GMRABULL<1
if '$DATA(ZTQUEUED)&('$$BROKER^XWBLIB)
Begin DoDot:2
+7 WRITE !,"PLEASE CONTACT IRM TO CREATE A MAIL GROUP: GMRA MARK CHART",$CHAR(7)
SET GMRASEND(DUZ)=""
+8 KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
+9 QUIT
End DoDot:2
QUIT
+10 ;19
IF '$$GOTLOCAL^XMXAPIG(GMRABULL)
if '$DATA(ZTQUEUED)&('$$BROKER^XWBLIB)
Begin DoDot:2
+11 WRITE !,"CALL IRM AND HAVE USERS ASSIGNED TO THE GMRA MARK CHART MAIL GROUP",$CHAR(7)
+12 KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
SET GMRASEND(DUZ)=""
+13 QUIT
End DoDot:2
QUIT
+14 ;19
IF '$TEST
SET GMRASEND("G.GMRA MARK CHART")=""
+15 DO PID^VADPT6
SET GMRAVIP=VA("PID")
DO KVAR^VADPT
KILL VA
+16 DO BUL(.GMRASEND)
+17 QUIT
End DoDot:1
KILL GMRASEND,GMRASND,GMRABULL
QUIT
+18 SET GMRAPAT=$PIECE(GMRAPA(0),U)_";DPT("
+19 SET GMRATEAM=0
FOR
SET GMRATEAM=$ORDER(^OR(100.21,"AB",GMRAPAT,GMRATEAM))
if GMRATEAM<1
QUIT
Begin DoDot:1
+20 if '$DATA(^OR(100.21,GMRATEAM,0))
QUIT
+21 SET GMRASEND=0
FOR
SET GMRASEND=$ORDER(^OR(100.21,GMRATEAM,1,GMRASEND))
if GMRASEND<1
QUIT
Begin DoDot:2
+22 if '$DATA(^OR(100.21,GMRATEAM,1,GMRASEND,0))
QUIT
+23 SET GMRASEND(GMRASEND)=""
+24 QUIT
End DoDot:2
+25 QUIT
End DoDot:1
+26 ;*********************************************************************
+27 DO BUL(.GMRASEND)
+28 KILL GMRAPAT,GMRATEAM,GMRASEND
+29 QUIT
BUL(XMY) ;MAIL A BULLETIN TO A GROUP OR PERSON
+1 ;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
+2 ;19
SET XMB(1)=GMRANAM
SET XMB(3)=$SELECT(GMRALOC'="":GMRALOC,1:"Outpatient")
SET XMB(4)=GMRAVIP
+3 IF '$DATA(GMRAPA2(2))
SET XMB(2)=$PIECE(GMRAPA2(1),U)
SET XMB(5)=$PIECE(GMRAPA2(1),U,2)
+4 IF '$TEST
SET XMB(2)="See listing of allergies below."
Begin DoDot:1
+5 SET GMRAPA2=0
FOR
SET GMRAPA2=$ORDER(GMRAPA2(GMRAPA2))
if GMRAPA2<1
QUIT
Begin DoDot:2
+6 NEW GMRALN,GMRASPC
+7 SET GMRASPC=" "
+8 SET GMRALN=GMRAPA2(GMRAPA2)
+9 SET GMRAPA2(GMRAPA2)=$EXTRACT($PIECE(GMRALN,U),1,38)
+10 SET GMRAPA2(GMRAPA2)=GMRAPA2(GMRAPA2)_$EXTRACT(GMRASPC,$LENGTH(GMRAPA2(GMRAPA2)),40)
+11 SET GMRAPA2(GMRAPA2)=GMRAPA2(GMRAPA2)_$PIECE(GMRALN,U,2)
+12 QUIT
End DoDot:2
+13 ;21
SET GMRAPA2=0
SET XMTEXT="GMRAPA2"
SET GMRAPA2(.4)=""
+14 SET GMRAPA2(.5)="This patient has the following allergies:"
+15 SET GMRAPA2(.6)=""
+16 SET GMRAPA2(.7)="Causative Agent Mechanism"
+17 SET GMRAPA2(.8)="--------------- ---------"
+18 QUIT
End DoDot:1
+19 ;21
SET XMB(6)="chart (due to admission)"
SET XMB(7)="chart"
+20 ;21
MERGE GMRAXMB=XMB,GMRAXMY=XMY
+21 ;19,21
DO SENDBULL^XMXAPI(DUZ,"GMRA MARK CHART",.GMRAXMB,$GET(XMTEXT),.GMRAXMY)
+22 KILL GMRAPAT,GMRATEAM,GMRASEND
+23 QUIT
