- 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 Apr 23, 2025@17:54:58 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
