[613] | 1 | GMRAPEE0 ;HIRMFO/YMP,RM-ENTERRED IN ERROR CHECK ; 10/16/91
|
---|
| 2 | ;;4.0;Adverse Reaction Tracking;**2**;Mar 29, 1996
|
---|
| 3 | EN1 ; ENTRY TO SET GMRAERR IF THIS ALLERGY HAS BEEN ENTERED IN ERROR
|
---|
| 4 | S GMRAERR=0
|
---|
| 5 | K GMRAHEAD S GMRAPRNT=0 D EN1^GMRADSP2
|
---|
| 6 | S:GMRAOUT GMRAOUT=GMRAOUT-1 Q:GMRAOUT
|
---|
| 7 | I $P(^GMR(120.8,GMRAPA,0),U,16),$P(^(0),U,18)'="",'$D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) Q
|
---|
| 8 | YNEE K GMRAEIE W !,"Is the reaction information correct" S %=1 D YN^DICN I '% W !?4,$C(7),"ANSWER NO IF THIS ALLERGY IS INCORRECT AND NEEDS TO BE MARKED",!?4,"AS ENTERED IN ERROR, ELSE ANSWER YES." G YNEE
|
---|
| 9 | I %=-1 S GMRAOUT=1 K GMRAPRCT Q
|
---|
| 10 | I %=2 D I $G(GMRAEIE)=1 G YNEE
|
---|
| 11 | .K DIR S DIR(0)="Y",DIR("A")="Mark this reaction as 'Entered-in-Error'"
|
---|
| 12 | .D ^DIR K DIR I $D(DIRUT)!(Y=0) S GMRAEIE=1 Q
|
---|
| 13 | .S GMRAERR=1,DIE="^GMR(120.8,",DA=GMRAPA,DR="22///1;23///NOW;24////"_DUZ D ^DIE
|
---|
| 14 | .D SITE^GMRAUTL S GMRASITE(0)=$G(^GMRD(120.84,GMRASITE,0))
|
---|
| 15 | .I $P(GMRASITE(0),U,11) S GMRAVCM="E" D ENDING^GMRAPEM1
|
---|
| 16 | .; This patch (#2) will loop through the patient reactions
|
---|
| 17 | .; and ensure that the patient's NKA information is marked
|
---|
| 18 | .; based on the existence of patient reactions.
|
---|
| 19 | .I $$NKASCR^GMRANKA($P(^GMR(120.8,GMRAPA,0),U)) D ; true NKA
|
---|
| 20 | ..S DIK="^GMR(120.86,",DA=$P(^GMR(120.8,GMRAPA,0),U)
|
---|
| 21 | ..D ^DIK ; purge the NKA node from 120.86
|
---|
| 22 | ..Q
|
---|
| 23 | .D EN1^GMRAPET0($P(^GMR(120.8,GMRAPA,0),U),GMRAPA,"E",.GMRAOUT)
|
---|
| 24 | .D EN1^GMRAEAB
|
---|
| 25 | .D ; Execute the event point for this reaction
|
---|
| 26 | ..Q:'$D(GMRAPA) S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""
|
---|
| 27 | ..N OROLD,DFN S DFN=$P(GMRAPA(0),U)
|
---|
| 28 | ..D INP^VADPT S X=$O(^ORD(101,"B","GMRA ENTERED IN ERROR",0))_";ORD(101," D EN^XQOR:X K VAIN,X
|
---|
| 29 | ..Q
|
---|
| 30 | .Q
|
---|
| 31 | K %,DA,DIE,DR,GMRASITE
|
---|
| 32 | Q
|
---|