52 lines
2.1 KiB
Mathematica
52 lines
2.1 KiB
Mathematica
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
|