source: FOIAVistA/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRASEN2.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 2.5 KB
Line 
1GMRASEN2 ;HIRMFO/WAA-SEND ID BAND/CHART MARK TO BULLETIN/TEAM ;12/21/04 15:56
2 ;;4.0;Adverse Reaction Tracking;**14,19,21**;Mar 29, 1996
3BULLT ; SEND GMRA MARK CHART BULLETIN
4 S GMRAOUT=0 K GMRASEND
5 I '$D(GMRASITE) D SITE^GMRAUTL S GMRASITE(0)=$G(^GMRD(120.84,+GMRASITE,0))
6 I $P(GMRASITE(0),U,8)=2 Q
7 I $P(GMRASITE(0),U,8)<1!($$VERSION^XPDUTL("OR")<2) D K GMRASEND,GMRASND,GMRABULL Q
8 .S GMRABULL=$$FIND1^DIC(3.8,,"BX","GMRA MARK CHART") ;19
9 .I GMRABULL<1 D:'$D(ZTQUEUED)&('$$BROKER^XWBLIB) Q ;19
10 ..W !,"PLEASE CONTACT IRM TO CREATE A MAIL GROUP: GMRA MARK CHART",$C(7) S GMRASEND(DUZ)=""
11 ..K DIR S DIR(0)="E" D ^DIR K DIR
12 ..Q
13 .I '$$GOTLOCAL^XMXAPIG(GMRABULL) D:'$D(ZTQUEUED)&('$$BROKER^XWBLIB) Q ;19
14 ..W !,"CALL IRM AND HAVE USERS ASSIGNED TO THE GMRA MARK CHART MAIL GROUP",$C(7)
15 ..K DIR S DIR(0)="E" D ^DIR K DIR S GMRASEND(DUZ)=""
16 ..Q
17 .E S GMRASEND("G.GMRA MARK CHART")="" ;19
18 .D PID^VADPT6 S GMRAVIP=VA("PID") D KVAR^VADPT K VA
19 .D BUL(.GMRASEND)
20 .Q
21 S GMRAPAT=$P(GMRAPA(0),U)_";DPT("
22 S GMRATEAM=0 F S GMRATEAM=$O(^OR(100.21,"AB",GMRAPAT,GMRATEAM)) Q:GMRATEAM<1 D
23 .Q:'$D(^OR(100.21,GMRATEAM,0))
24 .S GMRASEND=0 F S GMRASEND=$O(^OR(100.21,GMRATEAM,1,GMRASEND)) Q:GMRASEND<1 D
25 ..Q:'$D(^OR(100.21,GMRATEAM,1,GMRASEND,0))
26 ..S GMRASEND(GMRASEND)=""
27 ..Q
28 .Q
29 ;*********************************************************************
30 D BUL(.GMRASEND)
31 K GMRAPAT,GMRATEAM,GMRASEND
32 Q
33BUL(XMY) ;MAIL A BULLETIN TO A GROUP OR PERSON
34 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
35 S XMB(1)=GMRANAM,XMB(3)=$S(GMRALOC'="":GMRALOC,1:"Outpatient"),XMB(4)=GMRAVIP ;19
36 I '$D(GMRAPA2(2)) S XMB(2)=$P(GMRAPA2(1),U),XMB(5)=$P(GMRAPA2(1),U,2)
37 E S XMB(2)="See listing of allergies below." D
38 .S GMRAPA2=0 F S GMRAPA2=$O(GMRAPA2(GMRAPA2)) Q:GMRAPA2<1 D
39 ..N GMRALN,GMRASPC
40 ..S GMRASPC=" "
41 ..S GMRALN=GMRAPA2(GMRAPA2)
42 ..S GMRAPA2(GMRAPA2)=$E($P(GMRALN,U),1,38)
43 ..S GMRAPA2(GMRAPA2)=GMRAPA2(GMRAPA2)_$E(GMRASPC,$L(GMRAPA2(GMRAPA2)),40)
44 ..S GMRAPA2(GMRAPA2)=GMRAPA2(GMRAPA2)_$P(GMRALN,U,2)
45 ..Q
46 .S GMRAPA2=0 S XMTEXT="GMRAPA2",GMRAPA2(.4)="" ;21
47 .S GMRAPA2(.5)="This patient has the following allergies:"
48 .S GMRAPA2(.6)=""
49 .S GMRAPA2(.7)="Causative Agent Mechanism"
50 .S GMRAPA2(.8)="--------------- ---------"
51 .Q
52 S XMB(6)="chart (due to admission)",XMB(7)="chart" ;21
53 M GMRAXMB=XMB,GMRAXMY=XMY ;21
54 D SENDBULL^XMXAPI(DUZ,"GMRA MARK CHART",.GMRAXMB,$G(XMTEXT),.GMRAXMY) ;19,21
55 K GMRAPAT,GMRATEAM,GMRASEND
56 Q
Note: See TracBrowser for help on using the repository browser.