| 1 | GMRAPEM4 ;HIRMFO/WAA-EDIT OF DATA TO HISTORICAL STORAGE ; 12/24/91
 | 
|---|
| 2 |  ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996
 | 
|---|
| 3 | EDIT ; Add/Edit Reaction data
 | 
|---|
| 4 |  W @IOF
 | 
|---|
| 5 |  D SITE^GMRAUTL
 | 
|---|
| 6 |  S GMRADRUG=$S($P(GMRAPA(0),U,20)["D":1,1:0),GMRACNT=GMRACNT+1
 | 
|---|
| 7 |  G:GMRANEW NEW
 | 
|---|
| 8 |  I '$P(GMRAPA(0),"^",12),$P(GMRAPA(0),"^",5)'=DUZ,'$D(^XUSEC("GMRA-SUPERVISOR",DUZ)),'$D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) D  Q
 | 
|---|
| 9 |  .W !,$C(7),"THE PERSON INITIALLY ENTERING THIS ALLERGY/ADVERSE REACTION HAS NOT",!,"FINISHED ENTERING THE MANDATORY FIELDS, YOU CANNOT EDIT"
 | 
|---|
| 10 |  .D UNLOCK^GMRAUTL(120.8,GMRAPA)
 | 
|---|
| 11 |  .Q
 | 
|---|
| 12 |  I $P(GMRAPA(0),"^",12) D UNLOCK^GMRAUTL(120.8,GMRAPA) Q
 | 
|---|
| 13 | NEW S DR="6(O)bserved or (H)istorical Allergy/Adverse Reaction",DIE="^GMR(120.8,",DA=GMRAPA D ^DIE I $D(Y) S GMRAOUT=1 Q
 | 
|---|
| 14 |  S GMRANEW(0)=$S($D(^GMR(120.8,GMRAPA,0)):^(0),1:"") W:$P(GMRANEW(0),"^",6)']"" $C(7),"  Required??"
 | 
|---|
| 15 |  G NEW:$P(GMRANEW(0),"^",6)']"",EDAT:$P(GMRANEW(0),"^",6)=$P(GMRAPA(0),"^",6)
 | 
|---|
| 16 | YNNW I $P(GMRAPA(0),"^",6)]"" W !,"Are you sure you want to make that change" S %=1 D YN^DICN I '% W !?4,$C(7),"ANSWER YES IF THE CHANGE IS OK, ELSE ANSWER NO." G YNNW
 | 
|---|
| 17 |  I $P(GMRAPA(0),"^",6)]"" I %'=1 S GMRAOUT=(%=-1),DIE="^GMR(120.8,",DR="6////"_$P(GMRAPA(0),"^",6),DA=GMRAPA D ^DIE G NEW:%=2 Q
 | 
|---|
| 18 |  S $P(GMRAPA(0),"^",6)=$P(GMRANEW(0),"^",6)
 | 
|---|
| 19 | EDAT I $P(GMRAPA(0),"^",6)="o" D EN1^GMRAPEO0
 | 
|---|
| 20 |  I $P(GMRAPA(0),"^",6)="h" D EN1^GMRAPEH0
 | 
|---|
| 21 |  K GMRAVER S GMRAVER=0
 | 
|---|
| 22 |  I 'GMRAOUT D
 | 
|---|
| 23 |  .I '$D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) Q 
 | 
|---|
| 24 |  .I $$VFY^GMRASIGN(.GMRAPA) W !,"This Causative Agent will be Auto-verified when it is signed off." Q
 | 
|---|
| 25 |  .N GMRAPRNT
 | 
|---|
| 26 |  .D EN1^GMRAVFY K GMRALLER,GMRAMEC,GMRAY
 | 
|---|
| 27 |  .Q
 | 
|---|
| 28 |  Q
 | 
|---|