GMRAPEO0 ;HIRMFO/WAA,RM-EDIT OBSERVED A/AR ;10/15/04  10:06
 ;;4.0;Adverse Reaction Tracking;**8,17,21**;Mar 29, 1996
EN1 ; Entry to edit Observed A/AR Data
 ;This code allows the user to select a concomitant reaction by date.
 ;If that reactant doesn't have a date, then a new date is added
 ;for the reactant.
 N GMRAN85
 S (GMRAX,GMRAN85)=0 I $D(^GMR(120.85,"C",GMRAPA)) S X=0 F  S X=$O(^GMR(120.85,"C",GMRAPA,X)) Q:X<1  S GMRAX=X
 I GMRAX K X S:$D(^GMR(120.85,GMRAX,0)) DIC("B")=$P(^GMR(120.85,GMRAX,0),U)
OBS ; 
 S GMRALAGO=1 D EN2^GMRAU85 I GMRAOUT D:GMRAPA1 UNLOCK^GMRAUTL(120.85,GMRAPA1) G EXIT
 I $P($G(^GMR(120.85,+$O(^GMR(120.85,"C",GMRAPA,0)),0)),U)="" W !?4,$C(7),"OBSERVATION DATE IS A REQUIRED ENTRY!!" G OBS
 I $G(GMRAPA1)<1 W !?4,$C(7),"OBSERVATION DATE IS A REQUIRED ENTRY!!" G OBS
 D EN1^GMRAPER2(GMRAPA,"120.8",.GMRAOUT,$P(^GMR(120.85,GMRAPA1,0),U))
 I 'GMRAOUT,$O(^GMR(120.8,GMRAPA,10,0)) D
 .N GMRAX
 .K ^GMR(120.85,GMRAPA1,2) ;Clear out s/s before updating
 .S ^GMR(120.85,GMRAPA1,2,0)="^120.8502P^"_$P(^GMR(120.8,GMRAPA,10,0),U,3,4),GMRAX=0 F  S GMRAX=$O(^GMR(120.8,GMRAPA,10,GMRAX)) Q:GMRAX<1  D
 ..Q:'$D(^GMR(120.8,GMRAPA,10,GMRAX,0))
 ..S ^GMR(120.85,GMRAPA1,2,GMRAX,0)=$P(^GMR(120.8,GMRAPA,10,GMRAX,0),U,1,2)_"^"_DUZ
 ..S DIK="^GMR(120.85,GMRAPA1,2,",DA(1)=GMRAPA1,DA=GMRAX D IX1^DIK ;21
 ..Q
 .Q
 G:GMRAOUT EXIT
 I $D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) D MECH^GMRAPED0
 G EXIT:GMRAOUT
 D COMM G EXIT:GMRAOUT
 D ORR G EXIT:GMRAOUT
EXIT ; Exit line
 I $G(GMRAPA1)'<0 D UNLOCK^GMRAUTL(120.85,GMRAPA1)
 K DA,DIK,DR,GMRADT,GMRAR10,GMRAPA1,GMRARAD,GMRARDL,GMRAREC,GMRADATE,GMRARODT,GMRAROT,GMRARPR,GMRAX,GMRAY,GMRAZN
 Q
ORR ; Observed the reserved reaction reports
 Q:$G(GMRAPA1)<1
 Q:$G(GMRAUSER,0)
 F  S %=1 W !,"Complete the observed reaction report" D YN^DICN Q:%=1  S:%<0 %=2 Q:%=2  W:%=0 !,"ENTER YES TO EDIT REACTION DATA OR NO TO SKIP REACTION DATA",$C(7)
 I %=1 D
 .N %
 .D EN2^GMRAROBS
 .Q
 E  S:%=-1 GMRAOUT=1
 Q
COMM ; Fill in the comments
 S GMRAVCM="O" D ENDING^GMRAPEM1 Q:GMRAOUT
 I $D(DTOUT) S GMRAOUT=1
 I 'GMRAOUT D COMCHECK^GMRAPEH0
 I 'GMRAOUT G:GMRAREQ COMM
 S GMRAOUT=0
 K DUOUT,DTOUT,DA,DR,DIE Q
 K DA,DR,DIE
 Q