source: WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRASEND.m@ 862

Last change on this file since 862 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.8 KB
RevLine 
[613]1GMRASEND ;HIRMFO/WAA-SEND ID BAND/CHART MARK TO BULLETIN/TEAM ;12/8/04 11:24
2 ;;4.0;Adverse Reaction Tracking;**14,19,21**;Mar 29, 1996
3BULLT ; SEND GMRA MARK CHART BULLETIN
4 I '$D(GMRATYPE) S GMRATYPE="B"
5 S GMRAOUT=0 K GMRASEND
6 I '$D(GMRASITE) D SITE^GMRAUTL S GMRASITE(0)=$G(^GMRD(120.84,+GMRASITE,0))
7 I $P(GMRASITE(0),U,8)=2 Q
8 I $P(GMRASITE(0),U,8)<1!($$VERSION^XPDUTL("OR")<2) D K GMRASEND,GMRASND,GMRABULL Q
9 .S GMRABULL=$$FIND1^DIC(3.8,,"BX","GMRA MARK CHART") ;19
10 .I GMRABULL<1 D:'$D(ZTQUEUED)&('$$BROKER^XWBLIB) Q ;19
11 ..W !,"PLEASE CONTACT IRM TO CREATE A MAIL GROUP: GMRA MARK CHART",$C(7) S GMRASEND(DUZ)=""
12 ..K DIR S DIR(0)="E" D ^DIR K DIR
13 ..Q
14 .I '$$GOTLOCAL^XMXAPIG(GMRABULL) D:'$D(ZTQUEUED)&('$$BROKER^XWBLIB) Q ;19
15 ..W !,"CALL IRM AND HAVE USERS ASSIGNED TO THE GMRA MARK CHART MAIL GROUP",$C(7)
16 ..K DIR S DIR(0)="E" D ^DIR K DIR S GMRASEND(DUZ)=""
17 ..Q
18 .E S GMRASEND("G.GMRA MARK CHART")="" ;19
19 .S DFN=$P(GMRAPA(0),U) D INP^VADPT S:'+VAIN(4) GMRALOC=""
20 .I +VAIN(4) S GMRAHLOC=+$G(^DIC(42,+VAIN(4),44)),GMRALOC=$P(VAIN(4),U,2)
21 .D PID^VADPT6 S GMRAVIP=VA("PID") D KVAR^VADPT K VA
22 .D BUL(.GMRASEND,GMRATYPE)
23 .Q
24 ;=====================================================================
25 S GMRAPAT=$P(GMRAPA(0),U)_";DPT("
26 S GMRATEAM=0 F S GMRATEAM=$O(^OR(100.21,"AB",GMRAPAT,GMRATEAM)) Q:GMRATEAM<1 D
27 .Q:'$D(^OR(100.21,GMRATEAM,0))
28 .S GMRASEND=0 F S GMRASEND=$O(^OR(100.21,GMRATEAM,1,GMRASEND)) Q:GMRASEND<1 D
29 ..Q:'$D(^OR(100.21,GMRATEAM,1,GMRASEND,0))
30 ..S GMRASEND(GMRASEND)=""
31 ..Q
32 .Q
33 ;*********************************************************************
34 D BUL(.GMRASEND,GMRATYPE)
35 K GMRAPAT,GMRATEAM,GMRASEND
36 Q
37BUL(XMY,GMRATYPE) ;MAIL A BULLETIN TO A GROUP OR PERSON
38 I '$D(GMRAVIP) S DFN=$P(GMRAPA(0),U) D PID^VADPT6 S GMRAVIP=VA("PID") D KVAR^VADPT K VA
39 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
40 I GMRATYPE="A",$P(GMRASITE(0),U,9)'=0 D Q
41 .N GMRA
42 .S GMRA=0 F S GMRA=$O(XMY(GMRA)) Q:GMRA<1 S XQA(GMRA)=""
43 .K XMY
44 .S XQAMSG="Mark Chart"_$S(GMRALOC'="":"/ID Band",1:"")_" for "_$E(GMRANAM,1,30)_","_GMRAVIP_" with "_$E($P(GMRAPA(0),U,2),1,20)
45 .D SETUP^XQALERT
46 .Q
47 S XMB(1)=GMRANAM,XMB(3)=$S(GMRALOC'="":GMRALOC,1:"Outpatient"),XMB(4)=GMRAVIP,XMB(2)=$P(GMRAPA(0),U,2) ;19
48 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:"")
49 N GMRACHT,GMRAID ;21
50 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
51 S (XMB(6),XMB(7))=$S('GMRACHT&('GMRAID):"chart and ID band",'GMRACHT:"chart",'GMRAID:"ID band",1:"") ;21
52 I XMB(6)="" Q ;21 Don't send bulletin if it's not needed
53 N GMRAXMB,GMRAXMY ;19
54 M GMRAXMB=XMB,GMRAXMY=XMY ;19
55 D SENDBULL^XMXAPI(DUZ,"GMRA MARK CHART",.GMRAXMB,,.GMRAXMY) ;19
56 Q
Note: See TracBrowser for help on using the repository browser.