source: WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPEO0.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.1 KB
RevLine 
[613]1GMRAPEO0 ;HIRMFO/WAA,RM-EDIT OBSERVED A/AR ;10/15/04 10:06
2 ;;4.0;Adverse Reaction Tracking;**8,17,21**;Mar 29, 1996
3EN1 ; Entry to edit Observed A/AR Data
4 ;This code allows the user to select a concomitant reaction by date.
5 ;If that reactant doesn't have a date, then a new date is added
6 ;for the reactant.
7 N GMRAN85
8 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
9 I GMRAX K X S:$D(^GMR(120.85,GMRAX,0)) DIC("B")=$P(^GMR(120.85,GMRAX,0),U)
10OBS ;
11 S GMRALAGO=1 D EN2^GMRAU85 I GMRAOUT D:GMRAPA1 UNLOCK^GMRAUTL(120.85,GMRAPA1) G EXIT
12 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
13 I $G(GMRAPA1)<1 W !?4,$C(7),"OBSERVATION DATE IS A REQUIRED ENTRY!!" G OBS
14 D EN1^GMRAPER2(GMRAPA,"120.8",.GMRAOUT,$P(^GMR(120.85,GMRAPA1,0),U))
15 I 'GMRAOUT,$O(^GMR(120.8,GMRAPA,10,0)) D
16 .N GMRAX
17 .K ^GMR(120.85,GMRAPA1,2) ;Clear out s/s before updating
18 .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
19 ..Q:'$D(^GMR(120.8,GMRAPA,10,GMRAX,0))
20 ..S ^GMR(120.85,GMRAPA1,2,GMRAX,0)=$P(^GMR(120.8,GMRAPA,10,GMRAX,0),U,1,2)_"^"_DUZ
21 ..S DIK="^GMR(120.85,GMRAPA1,2,",DA(1)=GMRAPA1,DA=GMRAX D IX1^DIK ;21
22 ..Q
23 .Q
24 G:GMRAOUT EXIT
25 I $D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) D MECH^GMRAPED0
26 G EXIT:GMRAOUT
27 D COMM G EXIT:GMRAOUT
28 D ORR G EXIT:GMRAOUT
29EXIT ; Exit line
30 I $G(GMRAPA1)'<0 D UNLOCK^GMRAUTL(120.85,GMRAPA1)
31 K DA,DIK,DR,GMRADT,GMRAR10,GMRAPA1,GMRARAD,GMRARDL,GMRAREC,GMRADATE,GMRARODT,GMRAROT,GMRARPR,GMRAX,GMRAY,GMRAZN
32 Q
33ORR ; Observed the reserved reaction reports
34 Q:$G(GMRAPA1)<1
35 Q:$G(GMRAUSER,0)
36 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)
37 I %=1 D
38 .N %
39 .D EN2^GMRAROBS
40 .Q
41 E S:%=-1 GMRAOUT=1
42 Q
43COMM ; Fill in the comments
44 S GMRAVCM="O" D ENDING^GMRAPEM1 Q:GMRAOUT
45 I $D(DTOUT) S GMRAOUT=1
46 I 'GMRAOUT D COMCHECK^GMRAPEH0
47 I 'GMRAOUT G:GMRAREQ COMM
48 S GMRAOUT=0
49 K DUOUT,DTOUT,DA,DR,DIE Q
50 K DA,DR,DIE
51 Q
Note: See TracBrowser for help on using the repository browser.