GMRAPEO0 ;HIRMFO/WAA,RM-EDIT OBSERVED A/AR ;01-May-2012 14:24;DU
;;4.0;Adverse Reaction Tracking;**8,17,21,1002,1006**;Mar 29, 1996;Build 29
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
;IHS/MSC/MGH Mechanism has been removed and is now calculated Patch 1006
;I $D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) D MECH^GMRAPED0
G EXIT:GMRAOUT
G EXIT:GMRAOUT
;add the SNOMED EVENT
D EVENT^GMRAPED0
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
GMRAPEO0 ;HIRMFO/WAA,RM-EDIT OBSERVED A/AR ;01-May-2012 14:24;DU
+1 ;;4.0;Adverse Reaction Tracking;**8,17,21,1002,1006**;Mar 29, 1996;Build 29
EN1 ; Entry to edit Observed A/AR Data
+1 ;This code allows the user to select a concomitant reaction by date.
+2 ;If that reactant doesn't have a date, then a new date is added
+3 ;for the reactant.
+4 NEW GMRAN85
+5 SET (GMRAX,GMRAN85)=0
IF $DATA(^GMR(120.85,"C",GMRAPA))
SET X=0
FOR
SET X=$ORDER(^GMR(120.85,"C",GMRAPA,X))
IF X<1
QUIT
SET GMRAX=X
+6 IF GMRAX
KILL X
IF $DATA(^GMR(120.85,GMRAX,0))
SET DIC("B")=$PIECE(^GMR(120.85,GMRAX,0),U)
OBS ;
+1 SET GMRALAGO=1
DO EN2^GMRAU85
IF GMRAOUT
IF GMRAPA1
DO UNLOCK^GMRAUTL(120.85,GMRAPA1)
GOTO EXIT
+2 IF $PIECE($GET(^GMR(120.85,+$ORDER(^GMR(120.85,"C",GMRAPA,0)),0)),U)=""
WRITE !?4,$CHAR(7),"OBSERVATION DATE IS A REQUIRED ENTRY!!"
GOTO OBS
+3 IF $GET(GMRAPA1)<1
WRITE !?4,$CHAR(7),"OBSERVATION DATE IS A REQUIRED ENTRY!!"
GOTO OBS
+4 DO EN1^GMRAPER2(GMRAPA,"120.8",.GMRAOUT,$PIECE(^GMR(120.85,GMRAPA1,0),U))
+5 IF 'GMRAOUT
IF $ORDER(^GMR(120.8,GMRAPA,10,0))
Begin DoDot:1
+6 NEW GMRAX
+7 ;Clear out s/s before updating
KILL ^GMR(120.85,GMRAPA1,2)
+8 SET ^GMR(120.85,GMRAPA1,2,0)="^120.8502P^"_$PIECE(^GMR(120.8,GMRAPA,10,0),U,3,4)
SET GMRAX=0
FOR
SET GMRAX=$ORDER(^GMR(120.8,GMRAPA,10,GMRAX))
IF GMRAX<1
QUIT
Begin DoDot:2
+9 IF '$DATA(^GMR(120.8,GMRAPA,10,GMRAX,0))
QUIT
+10 SET ^GMR(120.85,GMRAPA1,2,GMRAX,0)=$PIECE(^GMR(120.8,GMRAPA,10,GMRAX,0),U,1,2)_"^"_DUZ
+11 ;21
SET DIK="^GMR(120.85,GMRAPA1,2,"
SET DA(1)=GMRAPA1
SET DA=GMRAX
DO IX1^DIK
+12 QUIT
End DoDot:2
+13 QUIT
End DoDot:1
+14 IF GMRAOUT
GOTO EXIT
+15 ;IHS/MSC/MGH Mechanism has been removed and is now calculated Patch 1006
+16 ;I $D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) D MECH^GMRAPED0
+17 IF GMRAOUT
GOTO EXIT
+18 IF GMRAOUT
GOTO EXIT
+19 ;add the SNOMED EVENT
+20 DO EVENT^GMRAPED0
+21 DO COMM
IF GMRAOUT
GOTO EXIT
+22 DO ORR
IF GMRAOUT
GOTO EXIT
EXIT ; Exit line
+1 IF $GET(GMRAPA1)'<0
DO UNLOCK^GMRAUTL(120.85,GMRAPA1)
+2 KILL DA,DIK,DR,GMRADT,GMRAR10,GMRAPA1,GMRARAD,GMRARDL,GMRAREC,GMRADATE,GMRARODT,GMRAROT,GMRARPR,GMRAX,GMRAY,GMRAZN
+3 QUIT
ORR ; Observed the reserved reaction reports
+1 IF $GET(GMRAPA1)<1
QUIT
+2 IF $GET(GMRAUSER,0)
QUIT
+3 FOR
SET %=1
WRITE !,"Complete the observed reaction report"
DO YN^DICN
IF %=1
QUIT
IF %<0
SET %=2
IF %=2
QUIT
IF %=0
WRITE !,"ENTER YES TO EDIT REACTION DATA OR NO TO SKIP REACTION DATA",$CHAR(7)
+4 IF %=1
Begin DoDot:1
+5 NEW %
+6 DO EN2^GMRAROBS
+7 QUIT
End DoDot:1
+8 IF '$TEST
IF %=-1
SET GMRAOUT=1
+9 QUIT
COMM ; Fill in the comments
+1 SET GMRAVCM="O"
DO ENDING^GMRAPEM1
IF GMRAOUT
QUIT
+2 IF $DATA(DTOUT)
SET GMRAOUT=1
+3 IF 'GMRAOUT
DO COMCHECK^GMRAPEH0
+4 IF 'GMRAOUT
IF GMRAREQ
GOTO COMM
+5 SET GMRAOUT=0
+6 KILL DUOUT,DTOUT,DA,DR,DIE
QUIT
+7 KILL DA,DR,DIE
+8 QUIT
