Index: WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRACMR4.m
===================================================================
--- WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRACMR4.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRACMR4.m	(revision 623)
@@ -1,75 +1,74 @@
-GMRACMR4	;HIRMFO/WAA-PATIENT NOT ASKED ABOUT ALLERGIES ;10/1/92
-	;;4.0;Adverse Reaction Tracking;**33**;Mar 29, 1996;Build 5
-EN1	;This is the main entry point for this program
-	D EN1^GMRACMR G:GMRAOUT EXIT
-DEV	; *** Select output device, force queuing
-	S GMRAZIS=""
-	S:GMRASEL'="1," GMRAZIS="Q"
-	W !! D DEV^GMRAUTL I POP S GMRAOUT=1 G EXIT
-	I $D(IO("Q")) D  G EXIT
-	. K IO("Q")
-	. S ZTRTN="ENTSK^GMRACMR4"
-	. S ZTSAVE("GMRA*")="",ZTSAVE("^TMP($J,")=""
-	. S ZTDESC="List of patients without ID band or Chart marked"
-	. D ^%ZTLOAD
-	. W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try later...")
-	. Q
-	E  D ENTSK
-	Q
-ENTSK	U IO
-	D EN1^GMRACMR2,EN1^GMRACMR3
-	S GMRAPAGE=0,X="NOW" D ^%DT S GMRAPDT=$$DATE^GMRAUTL1(Y)
-	D SITE^GMRAUTL S GMRASITE=$G(^GMRD(120.84,GMRASITE,0))
-	D PRINT
-	G EXIT
-PRINT	;PRINT THE DATE
-	D PRE^GMRAPNA
-	S GMRAHLOC="" F  S GMRAHLOC=$O(^TMP($J,"GMRAWC","C",GMRAHLOC)) Q:GMRAHLOC=""  S GMRAX=0 Q:GMRAOUT  F  S GMRAX=$O(^(GMRAHLOC,GMRAX)) Q:GMRAX<1  D  Q:GMRAOUT
-	.S GMRA=^TMP($J,"GMRAWC",GMRAX)
-	.D HEAD Q:GMRAOUT
-	.W !!,?10,$S(GMRA="W":"WARD",GMRA="M":"MODULE",GMRA="C":"CLINIC",1:"UNKNOWN"),": ",$P(^SC(GMRAX,0),U)
-	.S GMRACNT=0
-	.S GMRADATE=0 F  S GMRADATE=$O(^TMP($J,"GMRAWC",GMRAX,GMRADATE))  Q:GMRADATE=""  S (GMRAFLG,GMRADFN)=0 F  S GMRADFN=$O(^TMP($J,"GMRAWC",GMRAX,GMRADATE,GMRADFN)) Q:GMRADFN<1  D  Q:GMRAOUT
-	..Q:'$$PRDTST^GMRAUTL1(GMRADFN)  ;GMRA*4*33 Exclude test patient from report if production or legacy environment.
-	..S GMRAI=0 F  S GMRAI=$O(^GMR(120.8,"B",GMRADFN,GMRAI)) Q:GMRAI<1  D  Q:GMRAOUT
-	...Q:'$D(^GMR(120.8,GMRAI,0))  Q:$P($G(^GMR(120.86,GMRADFN,0)),U,2)'=1
-	...Q:$D(^GMR(120.8,GMRAI,"ER"))
-	...Q:$P(^GMR(120.8,GMRAI,0),U,2)=""
-	...S (GMRA("C"),GMRA("I"),GMRA("M"))=1
-	...I '$O(^GMR(120.8,GMRAI,13,0)) S (GMRA("C"),GMRA("M"))=0
-	...I GMRA'="W",GMRA("M") Q
-	...I GMRA="W",$P(GMRASITE,U,5)'=0,'$$IDMARK^GMRACMR5(GMRADFN,GMRADATE,GMRAI) S (GMRA("I"),GMRA("M"))=0
-	...I GMRA("M") Q
-	...S GMRACNT=GMRACNT+1
-	...W ! I GMRAFLG'=GMRADFN W $E($P(^DPT(GMRADFN,0),U),1,30) S (DFN,GMRAFLG)=GMRADFN S GMRAPID="" D VAD^GMRAUTL1(GMRADFN,"","","","","","","",.GMRAPID) W ?30,GMRAPID K GMRAPID
-	...W ?45,$E($P(^GMR(120.8,GMRAI,0),U,2),1,20)
-	...I GMRA="W" W ?66,$S(('GMRA("C")&'GMRA("I")):"ID BAND/CHART",('GMRA("C")):"CHART",('GMRA("I")):"ID BAND",1:"ERROR")
-	...E  W ?66,$S('GMRA("C"):"CHART",1:"ERROR")
-	...I $Y>(IOSL-4) D HEAD Q:GMRAOUT
-	...Q
-	..Q
-	.D NOPAT^GMRAPNA
-	.Q
-	D CLOSE^GMRAUTL
-	Q
-HEAD	;HEADER PAGE FOR PRINTOUT
-	S GMRAPAGE=GMRAPAGE+1,GMRATL="" I $E(IOST,1)="C",GMRAPAGE=1 W @IOF
-	I $E(IOST,1)="C",GMRAPAGE'=1 D  Q:GMRAOUT
-	.S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1
-	.K Y
-	.Q
-	W:GMRAPAGE'=1 @IOF
-	W !,GMRAPDT,?22,"PATIENTS WITH UNMARKED ID BAND/CHART",?70,"PAGE ",GMRAPAGE
-	I GMRASEL["1" S GMRATL="CURRENT INPATIENTS"
-	I GMRASEL["2" S GMRATL=$S(GMRATL="":"OUTPATIENTS",1:GMRATL_" / OUTPATIENTS")
-	I GMRASEL["3" S GMRATL=$S(GMRATL="":"NEW ADMISSIONS",1:GMRATL_" / NEW ADMISSIONS")
-	W !,?(40-($L(GMRATL)/2)),GMRATL
-	I (GMRASEL["2"!(GMRASEL["3")) W !,?22,"FROM ",$$DATE^GMRAUTL1(GMRAST),?43,"TO ",$$DATE^GMRAUTL1(GMRAED)
-	W !!,"PATIENT",?30,"SSN",?45,"ALLERGY",?66,"UNMARKED"
-	W !,$$REPEAT^XLFSTR("-",79)
-	I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user
-	Q
-EXIT	;
-	K ^TMP($J,"GMRAWC")
-	D KILL^XUSCLEAN
-	Q
+GMRACMR4 ;HIRMFO/WAA-PATIENT NOT ASKED ABOUT ALLERGIES ; 10/1/92
+ ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996
+EN1 ;This is the main entry point for this program
+ D EN1^GMRACMR G:GMRAOUT EXIT
+DEV ; *** Select output device, force queueing
+ S GMRAZIS=""
+ S:GMRASEL'="1," GMRAZIS="Q"
+ W !! D DEV^GMRAUTL I POP S GMRAOUT=1 G EXIT
+ I $D(IO("Q")) D  G EXIT
+ . K IO("Q")
+ . S ZTRTN="ENTSK^GMRACMR4"
+ . S ZTSAVE("GMRA*")="",ZTSAVE("^TMP($J,")=""
+ . S ZTDESC="List of patients without ID band or Chart marked"
+ . D ^%ZTLOAD
+ . W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try later...")
+ . Q
+ E  D ENTSK
+ Q
+ENTSK U IO
+ D EN1^GMRACMR2,EN1^GMRACMR3
+ S GMRAPAGE=0,X="NOW" D ^%DT S GMRAPDT=$$DATE^GMRAUTL1(Y)
+ D SITE^GMRAUTL S GMRASITE=$G(^GMRD(120.84,GMRASITE,0))
+ D PRINT
+ G EXIT
+PRINT ;PRINT THE DATE
+ D PRE^GMRAPNA
+ S GMRAHLOC="" F  S GMRAHLOC=$O(^TMP($J,"GMRAWC","C",GMRAHLOC)) Q:GMRAHLOC=""  S GMRAX=0 Q:GMRAOUT  F  S GMRAX=$O(^(GMRAHLOC,GMRAX)) Q:GMRAX<1  D  Q:GMRAOUT
+ .S GMRA=^TMP($J,"GMRAWC",GMRAX)
+ .D HEAD Q:GMRAOUT
+ .W !!,?10,$S(GMRA="W":"WARD",GMRA="M":"MODULE",GMRA="C":"CLINIC",1:"UNKNOWN"),": ",$P(^SC(GMRAX,0),U)
+ .S GMRACNT=0
+ .S GMRADATE=0 F  S GMRADATE=$O(^TMP($J,"GMRAWC",GMRAX,GMRADATE))  Q:GMRADATE=""  S (GMRAFLG,GMRADFN)=0 F  S GMRADFN=$O(^TMP($J,"GMRAWC",GMRAX,GMRADATE,GMRADFN)) Q:GMRADFN<1  D  Q:GMRAOUT
+ ..S GMRAI=0 F  S GMRAI=$O(^GMR(120.8,"B",GMRADFN,GMRAI)) Q:GMRAI<1  D  Q:GMRAOUT
+ ...Q:'$D(^GMR(120.8,GMRAI,0))  Q:$P($G(^GMR(120.86,GMRADFN,0)),U,2)'=1
+ ...Q:$D(^GMR(120.8,GMRAI,"ER"))
+ ...Q:$P(^GMR(120.8,GMRAI,0),U,2)=""
+ ...S (GMRA("C"),GMRA("I"),GMRA("M"))=1
+ ...I '$O(^GMR(120.8,GMRAI,13,0)) S (GMRA("C"),GMRA("M"))=0
+ ...I GMRA'="W",GMRA("M") Q
+ ...I GMRA="W",$P(GMRASITE,U,5)'=0,'$$IDMARK^GMRACMR5(GMRADFN,GMRADATE,GMRAI) S (GMRA("I"),GMRA("M"))=0
+ ...I GMRA("M") Q
+ ...S GMRACNT=GMRACNT+1
+ ...W ! I GMRAFLG'=GMRADFN W $E($P(^DPT(GMRADFN,0),U),1,30) S (DFN,GMRAFLG)=GMRADFN S GMRAPID="" D VAD^GMRAUTL1(GMRADFN,"","","","","","","",.GMRAPID) W ?30,GMRAPID K GMRAPID
+ ...W ?45,$E($P(^GMR(120.8,GMRAI,0),U,2),1,20)
+ ...I GMRA="W" W ?66,$S(('GMRA("C")&'GMRA("I")):"ID BAND/CHART",('GMRA("C")):"CHART",('GMRA("I")):"ID BAND",1:"ERROR")
+ ...E  W ?66,$S('GMRA("C"):"CHART",1:"ERROR")
+ ...I $Y>(IOSL-4) D HEAD Q:GMRAOUT
+ ...Q
+ ..Q
+ .D NOPAT^GMRAPNA
+ .Q
+ D CLOSE^GMRAUTL
+ Q
+HEAD ;HEADER PAGE FOR PRINTOUT
+ S GMRAPAGE=GMRAPAGE+1,GMRATL="" I $E(IOST,1)="C",GMRAPAGE=1 W @IOF
+ I $E(IOST,1)="C",GMRAPAGE'=1 D  Q:GMRAOUT
+ .S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1
+ .K Y
+ .Q
+ W:GMRAPAGE'=1 @IOF
+ W !,GMRAPDT,?22,"PATIENTS WITH UNMARKED ID BAND/CHART",?70,"PAGE ",GMRAPAGE
+ I GMRASEL["1" S GMRATL="CURRENT INPATIENTS"
+ I GMRASEL["2" S GMRATL=$S(GMRATL="":"OUTPATIENTS",1:GMRATL_" / OUTPATIENTS")
+ I GMRASEL["3" S GMRATL=$S(GMRATL="":"NEW ADMISSIONS",1:GMRATL_" / NEW ADMISSIONS")
+ W !,?(40-($L(GMRATL)/2)),GMRATL
+ I (GMRASEL["2"!(GMRASEL["3")) W !,?22,"FROM ",$$DATE^GMRAUTL1(GMRAST),?43,"TO ",$$DATE^GMRAUTL1(GMRAED)
+ W !!,"PATIENT",?30,"SSN",?45,"ALLERGY",?66,"UNMARKED"
+ W !,$$REPEAT^XLFSTR("-",79)
+ I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user
+ Q
+EXIT ;
+ K ^TMP($J,"GMRAWC")
+ D KILL^XUSCLEAN
+ Q
Index: WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRADSP5.m
===================================================================
--- WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRADSP5.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRADSP5.m	(revision 623)
@@ -1,42 +1,41 @@
-GMRADSP5	;HIRMFO/YMP,RM,WAA-LISTING OF ALLERGIES TO SIGNED OFF ALLERGIES ;8/16/92
-	;;4.0;Adverse Reaction Tracking;**33**;Mar 29, 1996;Build 5
-EN1	; Entry to PATIENT ALLERGIES NOT SIGNED OFF option
-	S GMRAOUT=0
-	S GMRAHEAD(1)=$J("ALLERGY/ADVERSE REACTIONS TO BE SIGNED OFF",59),GMRAHEAD(4)=$J("ORIGINATOR",10)_$J("PATIENT",21)_$J("ALLERGY",19)_$J("ORIGINATION DATE/TIME",29),(GMRAHEAD(3),GMRAHEAD(5),GMRAHEAD(6))="",$P(GMRAHEAD(5),"-",81)=""
-	S GMRANOW=$$NOW^XLFDT,GMRANOW=$$FMTE^XLFDT(GMRANOW,"2P")
-	S GMRAHEAD(1.5)=$J("Run Date/Time: "_GMRANOW,55)
-	K GMRAZIS D DEV^GMRAUTL I POP S GMRAOUT=1 G EXIT
-	I $D(IO("Q")) D TASK G EXIT
-EN2	S (GMRAORG,GMRADT)=""
-	F GMRAREC=0:0 S GMRAREC=$O(^GMR(120.8,"ASGN",GMRAREC)) Q:GMRAREC'>0  D EN2A
-	G DISP
-	Q
-EN2A	S GMRATEMP=$G(^GMR(120.8,GMRAREC,0)) Q:GMRATEMP=""
-	I '$D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) Q:$P(GMRATEMP,U,5)'=DUZ
-	Q:'$$PRDTST^GMRAUTL1($P(GMRATEMP,U))  ;GMRA*4*33 Exclude test patient if production or legacy environment.
-	S DFN=$P(GMRATEMP,U) D PID^VADPT6 S GMRASSN=VA("BID") D KVA^VADPT
-	I $P(GMRATEMP,U,5)'="" S ^TMP($J,"GMRADSP",$P(^VA(200,$P(GMRATEMP,U,5),0),U),$P(GMRATEMP,U,5),$P(GMRATEMP,U,4),$P(GMRATEMP,U),GMRAREC)=$P(GMRATEMP,U,2)_U_$E($P(^DPT($P(GMRATEMP,U),0),U),1,14)_"("_GMRASSN_")"
-	Q
-DISP	S GMRAPG=0 D HDR^GMRADSP3 W:'$D(^TMP($J,"GMRADSP")) !!!,?7,"NO DATA FOR THIS REPORT"
-	S GMRAORG="" F  S GMRAORG=$O(^TMP($J,"GMRADSP",GMRAORG)) Q:GMRAORG=""!GMRAOUT  D  Q:GMRAOUT
-	.S GMRAIEN="" F  S GMRAIEN=$O(^TMP($J,"GMRADSP",GMRAORG,GMRAIEN)) Q:GMRAIEN=""!GMRAOUT  D  Q:GMRAOUT
-	..S GMRADT="" F  S GMRADT=$O(^TMP($J,"GMRADSP",GMRAORG,GMRAIEN,GMRADT)) Q:GMRADT=""!GMRAOUT  D  Q:GMRAOUT
-	...S GMRADFN="" F  S GMRADFN=$O(^TMP($J,"GMRADSP",GMRAORG,GMRAIEN,GMRADT,GMRADFN)) Q:GMRADFN=""!GMRAOUT  D EN3
-	...Q
-	..Q
-	.Q
-EXIT	;Quit and kill
-	D CLOSE^GMRAUTL
-	K ^TMP($J,"GMRADSP"),X,Y,Z
-	D KILL^XUSCLEAN
-	Q
-EN3	S GMRAPAT="" F  S GMRAPAT=$O(^TMP($J,"GMRADSP",GMRAORG,GMRAIEN,GMRADT,GMRADFN,GMRAPAT)) Q:GMRAPAT=""!GMRAOUT  S GMRALL=$G(^(GMRAPAT)) I GMRALL'="" D  Q:GMRAOUT
-	.S Y=GMRADT D D^DIQ W !,$E(GMRAORG,1,15),?17,$P(GMRALL,U,2),?42,$E($P(GMRALL,U),1,16),?59,Y
-	.D:IOSL-4<$Y EOP^GMRADSP3 Q:GMRAOUT
-	.Q
-	Q
-TASK	;
-	S ZTDESC="Patient reactions not signed off",ZTRTN="EN2^GMRADSP5",ZTDTH="",ZTIO=ION,ZTSAVE("GMRA*")="",ZTSAVE("DFN")="" D ^%ZTLOAD
-	W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try later...")
-	K ZTRTN,ZTDH,ZTSAVE,ZTDTH,ZTSK
-	Q
+GMRADSP5 ;HIRMFO/YMP,RM,WAA-LISTING OF ALLERGIES TO SIGNED OFF ALLERGIES ; 8/16/92
+ ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996
+EN1 ; Entry to PATIENT ALLERGIES NOT SIGNED OFF option
+ S GMRAOUT=0
+ S GMRAHEAD(1)=$J("ALLERGY/ADVERSE REACTIONS TO BE SIGNED OFF",59),GMRAHEAD(4)=$J("ORIGINATOR",10)_$J("PATIENT",21)_$J("ALLERGY",19)_$J("ORIGINATION DATE/TIME",29),(GMRAHEAD(3),GMRAHEAD(5),GMRAHEAD(6))="",$P(GMRAHEAD(5),"-",81)=""
+ S GMRANOW=$$NOW^XLFDT,GMRANOW=$$FMTE^XLFDT(GMRANOW,"2P")
+ S GMRAHEAD(1.5)=$J("Run Date/Time: "_GMRANOW,55)
+ K GMRAZIS D DEV^GMRAUTL I POP S GMRAOUT=1 G EXIT
+ I $D(IO("Q")) D TASK G EXIT
+EN2 S (GMRAORG,GMRADT)=""
+ F GMRAREC=0:0 S GMRAREC=$O(^GMR(120.8,"ASGN",GMRAREC)) Q:GMRAREC'>0  D EN2A
+ G DISP
+ Q
+EN2A S GMRATEMP=$G(^GMR(120.8,GMRAREC,0)) Q:GMRATEMP=""
+ I '$D(^XUSEC("GMRA-ALLERGY VERIFY",DUZ)) Q:$P(GMRATEMP,U,5)'=DUZ
+ S DFN=$P(GMRATEMP,U) D PID^VADPT6 S GMRASSN=VA("BID") D KVA^VADPT
+ I $P(GMRATEMP,U,5)'="" S ^TMP($J,"GMRADSP",$P(^VA(200,$P(GMRATEMP,U,5),0),U),$P(GMRATEMP,U,5),$P(GMRATEMP,U,4),$P(GMRATEMP,U),GMRAREC)=$P(GMRATEMP,U,2)_U_$E($P(^DPT($P(GMRATEMP,U),0),U),1,14)_"("_GMRASSN_")"
+ Q
+DISP S GMRAPG=0 D HDR^GMRADSP3 W:'$D(^TMP($J,"GMRADSP")) !!!,?7,"NO DATA FOR THIS REPORT"
+ S GMRAORG="" F  S GMRAORG=$O(^TMP($J,"GMRADSP",GMRAORG)) Q:GMRAORG=""!GMRAOUT  D  Q:GMRAOUT
+ .S GMRAIEN="" F  S GMRAIEN=$O(^TMP($J,"GMRADSP",GMRAORG,GMRAIEN)) Q:GMRAIEN=""!GMRAOUT  D  Q:GMRAOUT
+ ..S GMRADT="" F  S GMRADT=$O(^TMP($J,"GMRADSP",GMRAORG,GMRAIEN,GMRADT)) Q:GMRADT=""!GMRAOUT  D  Q:GMRAOUT
+ ...S GMRADFN="" F  S GMRADFN=$O(^TMP($J,"GMRADSP",GMRAORG,GMRAIEN,GMRADT,GMRADFN)) Q:GMRADFN=""!GMRAOUT  D EN3
+ ...Q
+ ..Q
+ .Q
+EXIT ;Quit and kill
+ D CLOSE^GMRAUTL
+ K ^TMP($J,"GMRADSP"),X,Y,Z
+ D KILL^XUSCLEAN
+ Q
+EN3 S GMRAPAT="" F  S GMRAPAT=$O(^TMP($J,"GMRADSP",GMRAORG,GMRAIEN,GMRADT,GMRADFN,GMRAPAT)) Q:GMRAPAT=""!GMRAOUT  S GMRALL=$G(^(GMRAPAT)) I GMRALL'="" D  Q:GMRAOUT
+ .S Y=GMRADT D D^DIQ W !,$E(GMRAORG,1,15),?17,$P(GMRALL,U,2),?42,$E($P(GMRALL,U),1,16),?59,Y
+ .D:IOSL-4<$Y EOP^GMRADSP3 Q:GMRAOUT
+ .Q
+ Q
+TASK ;
+ S ZTDESC="Patient reactions not signed off",ZTRTN="EN2^GMRADSP5",ZTDTH="",ZTIO=ION,ZTSAVE("GMRA*")="",ZTSAVE("DFN")="" D ^%ZTLOAD
+ W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try later...")
+ K ZTRTN,ZTDH,ZTSAVE,ZTDTH,ZTSK
+ Q
Index: WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAEF2.m
===================================================================
--- WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAEF2.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAEF2.m	(revision 623)
@@ -1,30 +1,29 @@
-GMRAEF2	;HIRMFO/WAA-FDA EXCEPTION REPORT ;11/29/95  15:01
-	;;4.0;Adverse Reaction Tracking;**33**;Mar 29, 1996;Build 5
-EN1	; Entry to PRINT ALL FDA EXCEPTIONS WITHIN A D/T RANGE option
-	S GMRAOUT=0 K DIR
-	S DIR(0)="DO^:DT:ETX",DIR("A")="Select Start Date"
-	D ^DIR K DIR
-	I $D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT)) S GMRAOUT=1 G EXIT
-	S (GMRABGDT,GMRASTDT)=Y K Y
-	S DIR(0)="DO^"_GMRABGDT_":NOW:ETX",DIR("A")="Select End Date",DIR("B")="T"
-	D ^DIR K DIR
-	I $D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT)) S GMRAOUT=1 G EXIT
-	S GMRAEDT=Y,GMRAENDT=((Y+1)-.0000001) K Y
-EN2	;
-	S GMRABGDT=GMRABGDT-.0000001
-	F  S GMRABGDT=$O(^GMR(120.8,"AODT",GMRABGDT)) Q:GMRABGDT<1  Q:GMRABGDT>GMRAENDT  S GMRAIEN=0 F  S GMRAIEN=$O(^GMR(120.8,"AODT",GMRABGDT,GMRAIEN)) Q:GMRAIEN<1  D
-	.S GMRA(0)=$G(^GMR(120.8,GMRAIEN,0))
-	.Q:$P(GMRA(0),U,2)=""
-	.Q:$D(^GMR(120.8,GMRAIEN,"ER"))
-	.I $P(GMRA(0),U,6)'="o"!($P(GMRA(0),U,20)'["D") Q
-	.I '$P(GMRA(0),U,12) Q
-	.I $$CMPFDA^GMRAEF1(GMRAIEN) Q
-	.S GMRDFN=$P(GMRA(0),U)
-	.Q:'$$PRDTST^GMRAUTL1(GMRDFN)  ;GMRA*4*33 Exclude test patient from report if production or legacy environment.
-	.S ^TMP($J,"GMRAEF",GMRDFN,GMRABGDT)=GMRAIEN
-	.Q
-	D EN1^GMRAEF
-EXIT	;EXIT OF ROUTINE
-	K GMRAY,GMRAX,GMRAIEN,GMRDFN,GMRBGDT,GMRENDT,GMRDT,GMRAOUT
-	K GMRA,GMRABGDT,GMRAENDT
-	Q
+GMRAEF2 ;HIRMFO/WAA-FDA EXCEPTION REPORT ;11/29/95  15:01
+ ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996
+EN1 ; Entry to PRINT ALL FDA EXCEPTIONS WITHIN A D/T RANGE option
+ S GMRAOUT=0 K DIR
+ S DIR(0)="DO^:DT:ETX",DIR("A")="Select Start Date"
+ D ^DIR K DIR
+ I $D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT)) S GMRAOUT=1 G EXIT
+ S (GMRABGDT,GMRASTDT)=Y K Y
+ S DIR(0)="DO^"_GMRABGDT_":NOW:ETX",DIR("A")="Select End Date",DIR("B")="T"
+ D ^DIR K DIR
+ I $D(DTOUT)!($D(DUOUT))!($D(DIRUT))!($D(DIROUT)) S GMRAOUT=1 G EXIT
+ S GMRAEDT=Y,GMRAENDT=((Y+1)-.0000001) K Y
+EN2 ;
+ S GMRABGDT=GMRABGDT-.0000001
+ F  S GMRABGDT=$O(^GMR(120.8,"AODT",GMRABGDT)) Q:GMRABGDT<1  Q:GMRABGDT>GMRAENDT  S GMRAIEN=0 F  S GMRAIEN=$O(^GMR(120.8,"AODT",GMRABGDT,GMRAIEN)) Q:GMRAIEN<1  D
+ .S GMRA(0)=$G(^GMR(120.8,GMRAIEN,0))
+ .Q:$P(GMRA(0),U,2)=""
+ .Q:$D(^GMR(120.8,GMRAIEN,"ER"))
+ .I $P(GMRA(0),U,6)'="o"!($P(GMRA(0),U,20)'["D") Q
+ .I '$P(GMRA(0),U,12) Q
+ .I $$CMPFDA^GMRAEF1(GMRAIEN) Q
+ .S GMRDFN=$P(GMRA(0),U)
+ .S ^TMP($J,"GMRAEF",GMRDFN,GMRABGDT)=GMRAIEN
+ .Q
+ D EN1^GMRAEF
+EXIT ;EXIT OF ROUTINE
+ K GMRAY,GMRAX,GMRAIEN,GMRDFN,GMRBGDT,GMRENDT,GMRDT,GMRAOUT
+ K GMRA,GMRABGDT,GMRAENDT
+ Q
Index: WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAFDA3.m
===================================================================
--- WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAFDA3.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAFDA3.m	(revision 623)
@@ -1,68 +1,67 @@
-GMRAFDA3	;HIRMFO/WAA-DISPLAY FDA REPORT OVER DT RANGE ;12/1/95  11:34
-	;;4.0;Adverse Reaction Tracking;**33**;Mar 29, 1996;Build 5
-EN1	; Entry for PRINT ALL FDA EVENTS WITHIN D/T RANGE option
-	S GMRAOUT=0 K DIR
-	S DIR(0)="DO^:NOW:EXT",DIR("A")="Select Start Date/Time"
-	D ^DIR K DIR
-	I $D(DIRUT) G EXIT
-	S GMRABGDT=Y K Y
-	S DIR(0)="DO^"_GMRABGDT_":NOW:EXT",DIR("A")="Select End Date/Time",DIR("B")="T"
-	D ^DIR K DIR
-	I $D(DIRUT) G EXIT
-	S GMRAENDT=Y K Y
-EN2	;
-	S GMRABGDT=GMRABGDT-.0000001
-	S GMRAENDT=$S($P(GMRAENDT,".",2)="":GMRAENDT_".24",1:(GMRAENDT+.000001))
-YN	F  S %=1 W !,"Do you want an Abbreviated report" D YN^DICN S:%=-1 %=2,GMRAOUT=1 Q:%  W !,"ENTER ""Y"" FOR YES OR ""N"" FOR NO",$C(7)
-	G:GMRAOUT EXIT
-	S GMRAYN=%
-PRINTER	;Select printer
-	S GMRAOUT=0,GMRAPG=0
-	W ! K GMRAZIS S:GMRAYN=2 GMRAZIS="QM132S60" D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" G EXIT
-	I $D(IO("Q")) D  G EXIT
-	.S ZTRTN="PRINT^GMRAFDA3",ZTSAVE("GMRAPG")="",ZTSAVE("GMRAOUT")="",ZTSAVE("GMRABGDT")="",ZTSAVE("GMRAENDT")="",ZTSAVE("GMRAYN")=""
-	.S ZTDESC="Print FDA Report by Date/Time" D ^%ZTLOAD
-	.W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try later...")
-	.Q
-	U IO D PRINT U IO(0)
-	D CLOSE^GMRAUTL
-	G EXIT
-	Q
-PRINT	;Central Print
-	N GMRACNT S GMRACNT=0
-	S GMRAFLG=0,GMRANOW=$$NOW^XLFDT,GMRANOW=$$FMTE^XLFDT(GMRANOW,"1")
-	I IOST?1"C".E W @IOF
-	I GMRAYN=1 D HDR1
-	F  S GMRABGDT=$O(^GMR(120.85,"B",GMRABGDT)) Q:GMRABGDT<1!(GMRABGDT>GMRAENDT)!(GMRAOUT)  S GMRAPA1=0 F  S GMRAPA1=$O(^GMR(120.85,"B",GMRABGDT,GMRAPA1)) Q:GMRAPA1<1  D  Q:GMRAOUT
-	.I +$P($G(^GMR(120.8,+$P($G(^GMR(120.85,+GMRAPA1,0)),U,15),"ER")),U,1)=1 Q
-	.I GMRAYN=2 D PRT^GMRAFDA1 Q
-	.I $Y>(IOSL-3) D HEAD Q:GMRAOUT
-	.S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0)) Q:GMRAPA1(0)=""
-	.S GMRAPA(0)=$G(^GMR(120.8,$P(GMRAPA1(0),U,15),0)) Q:GMRAPA(0)=""
-	.S DFN=$P(GMRAPA(0),U) D PID^VADPT6
-	.Q:'$$PRDTST^GMRAUTL1(DFN)  ;GMRA*4*33  Exclude test patient from report if production or legacy environment.
-	.S GMRACNT=GMRACNT+1
-	.W !,$E($P(^DPT(DFN,0),U),1,23)," (",VA("PID"),")" K VA,DFN
-	.W ?32,$E($P(GMRAPA(0),U,2),1,28)
-	.W ?62 S Y=$P(GMRAPA1(0),U),Y=$$DATE^GMRAUTL1(Y) W $P(Y,":",1,2) K Y
-	.I $P($G(^GMR(120.85,GMRAPA1,"PTC1")),U,5) D
-	..W !,?5,"(SENT TO FDA: " S Y=$P(^GMR(120.85,GMRAPA1,"PTC1"),U,5),Y=$$DATE^GMRAUTL1(Y) W $P(Y,":",1,2),")" K Y
-	.Q
-	.K GMRAPA1(0),GMRAPA(0)
-	.Q
-	I 'GMRACNT W !,?30,"NO DATA FOR THIS REPORT"
-	Q
-HEAD	;Header Print
-HDR	;
-	I IOST?1"C".E K DIR S DIR(0)="E" D ^DIR K DIR I Y'>0 S GMRAOUT=1 Q
-	W @IOF
-HDR1	S GMRAPG=GMRAPG+1
-	W GMRANOW,?70,"Page: ",GMRAPG
-	W !,?30,"FDA ABBREVIATED REPORT"
-	W !,"PATIENT",?32,"SUSPECTED AGENT",?62,"D/T OF EVENT"
-	W !,$$REPEAT^XLFSTR("-",79),!
-	Q
-EXIT	;EXIT
-	K ^TMP($J,"GMRAEF")
-	D KILL^XUSCLEAN
-	Q
+GMRAFDA3 ;HIRMFO/WAA-DISPLAY FDA REPORT OVER DT RANGE ;12/1/95  11:34
+ ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996
+EN1 ; Entry for PRINT ALL FDA EVENTS WITHIN D/T RANGE option
+ S GMRAOUT=0 K DIR
+ S DIR(0)="DO^:NOW:EXT",DIR("A")="Select Start Date/Time"
+ D ^DIR K DIR
+ I $D(DIRUT) G EXIT
+ S GMRABGDT=Y K Y
+ S DIR(0)="DO^"_GMRABGDT_":NOW:EXT",DIR("A")="Select End Date/Time",DIR("B")="T"
+ D ^DIR K DIR
+ I $D(DIRUT) G EXIT
+ S GMRAENDT=Y K Y
+EN2 ;
+ S GMRABGDT=GMRABGDT-.0000001
+ S GMRAENDT=$S($P(GMRAENDT,".",2)="":GMRAENDT_".24",1:(GMRAENDT+.000001))
+YN F  S %=1 W !,"Do you want an Abbreviated report" D YN^DICN S:%=-1 %=2,GMRAOUT=1 Q:%  W !,"ENTER ""Y"" FOR YES OR ""N"" FOR NO",$C(7)
+ G:GMRAOUT EXIT
+ S GMRAYN=%
+PRINTER ;Select printer
+ S GMRAOUT=0,GMRAPG=0
+ W ! K GMRAZIS S:GMRAYN=2 GMRAZIS="QM132S60" D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" G EXIT
+ I $D(IO("Q")) D  G EXIT
+ .S ZTRTN="PRINT^GMRAFDA3",ZTSAVE("GMRAPG")="",ZTSAVE("GMRAOUT")="",ZTSAVE("GMRABGDT")="",ZTSAVE("GMRAENDT")="",ZTSAVE("GMRAYN")=""
+ .S ZTDESC="Print FDA Report by Date/Time" D ^%ZTLOAD
+ .W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try later...")
+ .Q
+ U IO D PRINT U IO(0)
+ D CLOSE^GMRAUTL
+ G EXIT
+ Q
+PRINT ;Central Print
+ N GMRACNT S GMRACNT=0
+ S GMRAFLG=0,GMRANOW=$$NOW^XLFDT,GMRANOW=$$FMTE^XLFDT(GMRANOW,"1")
+ I IOST?1"C".E W @IOF
+ I GMRAYN=1 D HDR1
+ F  S GMRABGDT=$O(^GMR(120.85,"B",GMRABGDT)) Q:GMRABGDT<1!(GMRABGDT>GMRAENDT)!(GMRAOUT)  S GMRAPA1=0 F  S GMRAPA1=$O(^GMR(120.85,"B",GMRABGDT,GMRAPA1)) Q:GMRAPA1<1  D  Q:GMRAOUT
+ .I +$P($G(^GMR(120.8,+$P($G(^GMR(120.85,+GMRAPA1,0)),U,15),"ER")),U,1)=1 Q
+ .I GMRAYN=2 D PRT^GMRAFDA1 Q
+ .I $Y>(IOSL-3) D HEAD Q:GMRAOUT
+ .S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0)) Q:GMRAPA1(0)=""
+ .S GMRAPA(0)=$G(^GMR(120.8,$P(GMRAPA1(0),U,15),0)) Q:GMRAPA(0)=""
+ .S DFN=$P(GMRAPA(0),U) D PID^VADPT6
+ .S GMRACNT=GMRACNT+1
+ .W !,$E($P(^DPT(DFN,0),U),1,23)," (",VA("PID"),")" K VA,DFN
+ .W ?32,$E($P(GMRAPA(0),U,2),1,28)
+ .W ?62 S Y=$P(GMRAPA1(0),U),Y=$$DATE^GMRAUTL1(Y) W $P(Y,":",1,2) K Y
+ .I $P($G(^GMR(120.85,GMRAPA1,"PTC1")),U,5) D
+ ..W !,?5,"(SENT TO FDA: " S Y=$P(^GMR(120.85,GMRAPA1,"PTC1"),U,5),Y=$$DATE^GMRAUTL1(Y) W $P(Y,":",1,2),")" K Y
+ .Q
+ .K GMRAPA1(0),GMRAPA(0)
+ .Q
+ I 'GMRACNT W !,?30,"NO DATA FOR THIS REPORT"
+ Q
+HEAD ;Header Print
+HDR ;
+ I IOST?1"C".E K DIR S DIR(0)="E" D ^DIR K DIR I Y'>0 S GMRAOUT=1 Q
+ W @IOF
+HDR1 S GMRAPG=GMRAPG+1
+ W GMRANOW,?70,"Page: ",GMRAPG
+ W !,?30,"FDA ABBREVIATED REPORT"
+ W !,"PATIENT",?32,"SUSPECTED AGENT",?62,"D/T OF EVENT"
+ W !,$$REPEAT^XLFSTR("-",79),!
+ Q
+EXIT ;EXIT
+ K ^TMP($J,"GMRAEF")
+ D KILL^XUSCLEAN
+ Q
Index: WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAGUI1.m
===================================================================
--- WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAGUI1.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAGUI1.m	(revision 623)
@@ -1,158 +1,157 @@
-GMRAGUI1	;SLC/DAN - CPRS GUI support ;11/17/06  09:50
-	;;4.0;Adverse Reaction Tracking;**21,25,36,38**;Mar 29, 1996;Build 2
-	;
-	Q
-EN1	; GETREC, cont'd
-OBSV	;  Get OBSERVATIONS from file 120.85
-	S STRING="~OBSERVATIONS" D NEXT
-	S OBSIEN=0
-OBSLOOP	S OBSIEN=$O(^GMR(120.85,"C",GMRAIEN,OBSIEN)) G:OBSIEN<1 EXIT
-	S GMRA(1)=$G(^GMR(120.85,OBSIEN,0)) Q:'$L(GMRA(1))
-	S STRING="tRecord            : "_OBSIEN D NEXT
-	S USRNAM=""
-	S USR=$P(GMRA(1),U,13) I USR'="" D GETUSR
-	S Y=$P(GMRA(1),U,1) X ^DD("DD")
-	S STRING="tDate/Time of Event: "_Y D NEXT
-	S STRING="tObserver          : "_USRNAM D NEXT
-	S SEVCOD=$P(GMRA(1),U,14)
-	S SEVER=$S(SEVCOD=1:"MILD",SEVCOD=2:"MODERATE",SEVCOD=3:"SEVERE",1:"")
-	S STRING="tSeverity          : "_SEVER D NEXT
-	S Y=$P(GMRA(1),U,18) X ^DD("DD")
-	S STRING="tDate Reported     : "_Y D NEXT
-	S USRNAM=""
-	S USR=$P(GMRA(1),U,19) I USR'="" D GETUSR
-	S STRING="tReporting User    : "_USRNAM D NEXT
-	S STRING="t" F I=1:1:60 S STRING=STRING_"-"
-	D NEXT
-	G OBSLOOP
-EXIT	Q
-NEXT	;SET ARRAY NODE AND INCREMENT ARRAY COUNTER
-	S @GMRARRAY@(ND)=STRING,ND=ND+1,STRING=""
-	Q
-GETUSR	S USRNAM=$$GET1^DIQ(200,USR_",",".01")
-	Q
-	;
-EIE(GMRAIEN,GMRADFN,GMRARRAY)	;Mark individual entry as entered in error
-	N DIE,DA,DR,Y,DIK,DFN,OROLD,VAIN,X,GMRAOUT,GMRAPA
-	L +^XTMP("GMRAED",GMRADFN):1 I '$T D MESS Q
-	S GMRAPA=GMRAIEN
-	S DIE="^GMR(120.8,",DA=GMRAPA,DR="15///1;22///1;23///"_@GMRARRAY@("GMRAERRDT")_";24////"_$G(@GMRARRAY@("GMRAERRBY"),.5) ;36
-	D ^DIE ;Entered in error on date/time by user
-	I $D(@GMRARRAY@("GMRAERRCMTS")) D ADCOM(GMRAPA,"E",$NA(@GMRARRAY@("GMRAERRCMTS"))) ;add comments
-	I $$NKASCR^GMRANKA($P(^GMR(120.8,GMRAPA,0),U)) D
-	.S DIK="^GMR(120.86,",DA=$P(^GMR(120.8,GMRAPA,0),U)
-	.D ^DIK ;If patient's last allergy marked as entered in error then delete assessment
-	S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""
-	S GMRAOUT=0
-	D EN1^GMRAEAB ;Sends entered in error bulletin to appropriate mail groups
-	D EN1^GMRAPET0(GMRADFN,GMRAPA,"E",.GMRAOUT) ;21 File Progress Note
-	S DFN=GMRADFN
-	D INP^VADPT S X=$$FIND1^DIC(101,,"BX","GMRA ENTERED IN ERROR")_";ORD(101,"
-	D:X EN^XQOR ;Process protocols hanging off of "entered in error" protocol
-	L -^XTMP("GMRAED",GMRADFN)
-	S ORY=0_$S(+$G(GMRAPN)>0:("^"_+$G(GMRAPN)),1:"") ;38 Return IEN of progress note if created
-	Q
-	;
-ADCOM(ENTRY,TYPE,GMRACOM)	;Add comments to allergies
-	;
-	N FDA,GMRAI,X,DIWL,DIWR
-	K ^UTILITY($J,"W") S DIWL=1,DIWR=60 S GMRAI=0 F  S GMRAI=$O(@GMRACOM@(GMRAI)) Q:'+GMRAI  S X=@GMRACOM@(GMRAI) D ^DIWP
-	S GMRACOM="^UTILITY($J,""W"",1)"
-	S FDA(120.826,"+1,"_ENTRY_",",.01)=$$NOW^XLFDT
-	S FDA(120.826,"+1,"_ENTRY_",",1)=DUZ
-	S FDA(120.826,"+1,"_ENTRY_",",1.5)=TYPE
-	S FDA(120.826,"+1,"_ENTRY_",",2)=GMRACOM
-	D UPDATE^DIE("","FDA")
-	Q
-	;
-NKA	;Change patient assessment to NKA
-	;
-	N DA,DR,DIE,NKA,DFN
-	S DFN=ORDFN
-	L +^XTMP("GMRAED",DFN):1 I '$T D MESS Q
-	S NKA=$$NKA^GMRANKA(DFN)
-	I NKA=0 Q  ;Patient is already NKA
-	I NKA=1 S ORY="-1^Patient has active allergies - can't mark as NKA" Q
-	L +^GMR(120.86,0):5 I '$T S ORY="-1^Unable to update assessment - try again." Q
-	I '$D(^GMR(120.86,DFN,0)) D  ;Add assessment entry
-	.S $P(^GMR(120.86,0),U,3,4)=(DFN_"^"_($P(^GMR(120.86,0),U,4)+1))
-	.S ^GMR(120.86,DFN,0)=DFN_U,^GMR(120.86,"B",DFN,DFN)=""
-	L -^GMR(120.86,0) L +^GMR(120.86,DFN,0):5 I '$T S ORY="-1^Unable to update assessment - try again." Q
-	S DIE="^GMR(120.86,",DA=DFN,DR="1////0;2////"_DUZ_";3///NOW" D ^DIE
-	S ORY=0
-	L -^XTMP("GMRAED",DFN)
-	Q
-	;
-UPDATE(GMRAIEN,DFN,GMRARRAY)	;Add/edit allergies
-	N NEW,NKA,FDA,NODE,IEN,SUB,FILE,DA,DIK,SIEN,GMRAS0,GMRAIEN,GMRAL,GMRAPA,GMRAAR,GMRALL,GMRADFN,GMRAOUT,GMRAROT
-	S NEW='$G(GMRAIEN)
-	I NEW,$$DUPCHK^GMRAOR0(DFN,$P(@GMRARRAY@("GMRAGNT"),U))=1 S ORY="-1^Patient already has a "_$P(@GMRARRAY@("GMRAGNT"),U)_" reaction entered.  No duplicates allowed." Q
-	L +^XTMP("GMRAED",DFN):1 I '$T D MESS Q
-	D SITE^GMRAUTL S GMRASITE(0)=$G(^GMRD(120.84,+GMRASITE,0))
-	S NKA='$$NKA^GMRANKA(DFN) ;is patient NKA?
-	I NKA,NEW D
-	.S FDA(120.86,"?+"_DFN_",",.01)=DFN
-	.S FDA(120.86,"?+"_DFN_",",1)=1
-	.S FDA(120.86,"?+"_DFN_",",2)=DUZ
-	.S FDA(120.86,"?+"_DFN_",",3)=$G(@GMRARRAY@("GMRAORDT"),$$NOW^XLFDT)
-	.S IEN(DFN)=DFN
-	.D UPDATE^DIE("","FDA","IEN")
-	K FDA,IEN
-	S NODE=$S($G(NEW):"+1,",1:(GMRAIEN_","))
-	S:$G(NEW) FDA(120.8,NODE,.01)=DFN
-	I $P($G(@GMRARRAY@("GMRAGNT")),U,2)["50.67" S $P(@GMRARRAY@("GMRAGNT"),U,2)=$$TGTOG^PSNAPIS($P(@GMRARRAY@("GMRAGNT"),U))_";PSNDF(50.6,"
-	F SUB="GMRAGNT;.02","GMRATYPE;3.1","GMRANATR;17","GMRAORIG;5","GMRAORDT;4","GMRAOBHX;6" D
-	.S FDA(120.8,NODE,$P(SUB,";",2))=$P(@GMRARRAY@($P(SUB,";")),U)
-	.I (SUB["GMRAGNT"),NEW S FDA(120.8,NODE,1)=$P(@GMRARRAY@($P(SUB,";")),U,2)
-	D UPDATE^DIE("","FDA","IEN")
-	S:NEW GMRAIEN=IEN(1)
-	K FDA
-	F SUB="GMRACHT","GMRAIDBN" D
-	.Q:'$D(@GMRARRAY@(SUB))  ;Stop if no updates
-	.S FILE=$S(SUB="GMRACHT":120.813,1:120.814)
-	.S FDA(FILE,"+1,"_GMRAIEN_",",.01)=@GMRARRAY@(SUB,1)
-	.S FDA(FILE,"+1,"_GMRAIEN_",",1)=DUZ
-	.D UPDATE^DIE("","FDA")
-	I $D(@GMRARRAY@("GMRACMTS")) D ADCOM(GMRAIEN,"O",$NA(@GMRARRAY@("GMRACMTS"))) ;Add comments if included
-	K FDA
-	S SUB=0 F  S SUB=$O(@GMRARRAY@("GMRASYMP",SUB)) Q:'+SUB  D
-	.S GMRAS0=^(SUB) ;Naked from above
-	.Q:$P(^(SUB),U)=""  ;25 No text or free text entered so don't store
-	.S SIEN=$O(^GMR(120.8,GMRAIEN,10,"B",$P(GMRAS0,U),0))
-	.I SIEN,$P(^GMR(120.8,GMRAIEN,10,SIEN,0),U,4)=$P(GMRAS0,U,3) Q  ;Exists and nothing has changed
-	.I SIEN,$P(GMRAS0,U,5)="@" S DIK="^GMR(120.8,"_GMRAIEN_",",DA(1)=GMRAIEN,DA=SIEN D ^DIK Q  ;Sign/symptom deleted
-	.S:'SIEN FDA(120.81,"+1,"_GMRAIEN_",",.01)=$S($P(GMRAS0,U)="FT":$O(^GMRD(120.83,"B","OTHER REACTION",0)),1:$P(GMRAS0,U))
-	.S NODE=$S(SIEN:SIEN_","_GMRAIEN,1:"+1,"_GMRAIEN_",")
-	.S:$P(GMRAS0,U)="FT" FDA(120.81,NODE,1)=$P(GMRAS0,U,2)
-	.S FDA(120.81,NODE,2)=DUZ
-	.S FDA(120.81,NODE,3)=$P(GMRAS0,U,3)
-	.D UPDATE^DIE("","FDA","","ERR")
-	.S GMRAROT($P(GMRAS0,U,2))="" ;21 record s/s added
-	I NEW D
-	.S GMRALL(GMRAIEN)="" D VAD^GMRAUTL1(DFN,,.GMRALOC,.GMRANAM) D EN7^GMRAMCB ;Send mark chart/ID band bulletin if needed.
-	.I $P(@GMRARRAY@("GMRAOBHX"),U)="o" D  ;if observed reaction add data to 120.85
-	..S GMRAOUT=0 ;21
-	..S GMRAL(GMRAIEN,"O",GMRAIEN)=$G(@GMRARRAY@("GMRARDT"))_"^"_$G(@GMRARRAY@("GMRASEVR"))
-	..S GMRADFN=DFN
-	..S GMRAL(GMRAIEN)="^^"_$P($G(@GMRARRAY@("GMRAGNT")),U)_"^^^^"_$G(@GMRARRAY@("GMRAORIG"))
-	..M GMRAL(GMRAIEN,"S")=@GMRARRAY@("GMRASYMP")
-	..S SUB=0 F  S SUB=$O(GMRAL(GMRAIEN,"S",SUB)) Q:'+SUB  S $P(GMRAL(GMRAIEN,"S",SUB),U,2)=$P(GMRAL(GMRAIEN,"S",SUB),U,2)_"^" S:$P(GMRAL(GMRAIEN,"S",SUB),U)="FT" $P(GMRAL(GMRAIEN,"S",SUB),U)=$O(^GMRD(120.83,"B","OTHER REACTION",0))
-	..S GMRAL=GMRAIEN
-	..D ADVERSE^GMRAOR7(GMRAIEN,.GMRAL) ;adds entry to 120.85
-	..S GMRAIEN(GMRAIEN)="" ;21
-	..D EN1^GMRAPET0(GMRADFN,.GMRAIEN,"S",.GMRAOUT) ;21 File progress note
-	..I $G(@GMRARRAY@("GMRATYPE"))["D" S GMRAPA=GMRAIEN D EN1^GMRAPTB ;21 Send med-watch update
-	.S GMRAAR=$P($G(@GMRARRAY@("GMRAGNT")),U,2),GMRAPA=GMRAIEN
-	.D EN1^GMRAOR9 S ^TMP($J,"GMRASF",1,GMRAPA)="" D RANGE^GMRASIGN(1) ;add ingredients/classes send appropriate bulletins
-	S ORY=0_$S(+$G(GMRAPN)>0:("^"_+$G(GMRAPN)),1:"") ;38 If note was created send back IEN
-	L -^XTMP("GMRAED",DFN)
-	Q
-	;
-MESS	;Give out locked message
-	N GMRAXBOS,GMRAL1,GMRAL2
-	S GMRAXBOS=$$BROKER^XWBLIB ;In GUI?
-	S GMRAL1="Another user is editing this patient's allergy information."
-	S GMRAL2="Please refresh/review the patient's information before proceeding."
-	I 'GMRAXBOS W !,GMRAL1,!,GMRAL2 D WAIT^GMRAFX3 Q
-	S ORY="-1^"_GMRAL1_"  "_GMRAL2
-	Q
+GMRAGUI1 ;SLC/DAN - CPRS GUI support ;7/13/06  14:32
+ ;;4.0;Adverse Reaction Tracking;**21,25,36**;Mar 29, 1996;Build 9
+ ;
+ Q
+EN1 ; GETREC, cont'd
+OBSV ;  Get OBSERVATIONS from file 120.85
+ S STRING="~OBSERVATIONS" D NEXT
+ S OBSIEN=0
+OBSLOOP S OBSIEN=$O(^GMR(120.85,"C",GMRAIEN,OBSIEN)) G:OBSIEN<1 EXIT
+ S GMRA(1)=$G(^GMR(120.85,OBSIEN,0)) Q:'$L(GMRA(1))
+ S STRING="tRecord            : "_OBSIEN D NEXT
+ S USRNAM=""
+ S USR=$P(GMRA(1),U,13) I USR'="" D GETUSR
+ S Y=$P(GMRA(1),U,1) X ^DD("DD")
+ S STRING="tDate/Time of Event: "_Y D NEXT
+ S STRING="tObserver          : "_USRNAM D NEXT
+ S SEVCOD=$P(GMRA(1),U,14)
+ S SEVER=$S(SEVCOD=1:"MILD",SEVCOD=2:"MODERATE",SEVCOD=3:"SEVERE",1:"")
+ S STRING="tSeverity          : "_SEVER D NEXT
+ S Y=$P(GMRA(1),U,18) X ^DD("DD")
+ S STRING="tDate Reported     : "_Y D NEXT
+ S USRNAM=""
+ S USR=$P(GMRA(1),U,19) I USR'="" D GETUSR
+ S STRING="tReporting User    : "_USRNAM D NEXT
+ S STRING="t" F I=1:1:60 S STRING=STRING_"-"
+ D NEXT
+ G OBSLOOP
+EXIT Q
+NEXT ;SET ARRAY NODE AND INCREMENT ARRAY COUNTER
+ S @GMRARRAY@(ND)=STRING,ND=ND+1,STRING=""
+ Q
+GETUSR S USRNAM=$$GET1^DIQ(200,USR_",",".01")
+ Q
+ ;
+EIE(GMRAIEN,GMRADFN,GMRARRAY) ;Mark individual entry as entered in error
+ N DIE,DA,DR,Y,DIK,DFN,OROLD,VAIN,X,GMRAOUT,GMRAPA
+ L +^XTMP("GMRAED",GMRADFN):1 I '$T D MESS Q
+ S GMRAPA=GMRAIEN
+ S DIE="^GMR(120.8,",DA=GMRAPA,DR="15///1;22///1;23///"_@GMRARRAY@("GMRAERRDT")_";24////"_$G(@GMRARRAY@("GMRAERRBY"),.5) ;36
+ D ^DIE ;Entered in error on date/time by user
+ I $D(@GMRARRAY@("GMRAERRCMTS")) D ADCOM(GMRAPA,"E",$NA(@GMRARRAY@("GMRAERRCMTS"))) ;add comments
+ I $$NKASCR^GMRANKA($P(^GMR(120.8,GMRAPA,0),U)) D
+ .S DIK="^GMR(120.86,",DA=$P(^GMR(120.8,GMRAPA,0),U)
+ .D ^DIK ;If patient's last allergy marked as entered in error then delete assessment
+ S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""
+ S GMRAOUT=0
+ D EN1^GMRAEAB ;Sends entered in error bulletin to appropriate mail groups
+ D EN1^GMRAPET0(GMRADFN,GMRAPA,"E",.GMRAOUT) ;21 File Progress Note
+ S DFN=GMRADFN
+ D INP^VADPT S X=$$FIND1^DIC(101,,"BX","GMRA ENTERED IN ERROR")_";ORD(101,"
+ D:X EN^XQOR ;Process protocols hanging off of "entered in error" protocol
+ L -^XTMP("GMRAED",GMRADFN)
+ Q
+ ;
+ADCOM(ENTRY,TYPE,GMRACOM) ;Add comments to allergies
+ ;
+ N FDA,GMRAI,X,DIWL,DIWR
+ K ^UTILITY($J,"W") S DIWL=1,DIWR=60 S GMRAI=0 F  S GMRAI=$O(@GMRACOM@(GMRAI)) Q:'+GMRAI  S X=@GMRACOM@(GMRAI) D ^DIWP
+ S GMRACOM="^UTILITY($J,""W"",1)"
+ S FDA(120.826,"+1,"_ENTRY_",",.01)=$$NOW^XLFDT
+ S FDA(120.826,"+1,"_ENTRY_",",1)=DUZ
+ S FDA(120.826,"+1,"_ENTRY_",",1.5)=TYPE
+ S FDA(120.826,"+1,"_ENTRY_",",2)=GMRACOM
+ D UPDATE^DIE("","FDA")
+ Q
+ ;
+NKA ;Change patient assessment to NKA
+ ;
+ N DA,DR,DIE,NKA,DFN
+ S DFN=ORDFN
+ L +^XTMP("GMRAED",DFN):1 I '$T D MESS Q
+ S NKA=$$NKA^GMRANKA(DFN)
+ I NKA=0 Q  ;Patient is already NKA
+ I NKA=1 S ORY="-1^Patient has active allergies - can't mark as NKA" Q
+ L +^GMR(120.86,0):5 I '$T S ORY="-1^Unable to update assessment - try again." Q
+ I '$D(^GMR(120.86,DFN,0)) D  ;Add assessment entry
+ .S $P(^GMR(120.86,0),U,3,4)=(DFN_"^"_($P(^GMR(120.86,0),U,4)+1))
+ .S ^GMR(120.86,DFN,0)=DFN_U,^GMR(120.86,"B",DFN,DFN)=""
+ L -^GMR(120.86,0) L +^GMR(120.86,DFN,0):5 I '$T S ORY="-1^Unable to update assessment - try again." Q
+ S DIE="^GMR(120.86,",DA=DFN,DR="1////0;2////"_DUZ_";3///NOW" D ^DIE
+ S ORY=0
+ L -^XTMP("GMRAED",DFN)
+ Q
+ ;
+UPDATE(GMRAIEN,DFN,GMRARRAY) ;Add/edit allergies
+ N NEW,NKA,FDA,NODE,IEN,SUB,FILE,DA,DIK,SIEN,GMRAS0,GMRAIEN,GMRAL,GMRAPA,GMRAAR,GMRALL,GMRADFN,GMRAOUT,GMRAROT
+ S NEW='$G(GMRAIEN)
+ I NEW,$$DUPCHK^GMRAOR0(DFN,$P(@GMRARRAY@("GMRAGNT"),U))=1 S ORY="-1^Patient already has a "_$P(@GMRARRAY@("GMRAGNT"),U)_" reaction entered.  No duplicates allowed." Q
+ L +^XTMP("GMRAED",DFN):1 I '$T D MESS Q
+ D SITE^GMRAUTL S GMRASITE(0)=$G(^GMRD(120.84,+GMRASITE,0))
+ S NKA='$$NKA^GMRANKA(DFN) ;is patient NKA?
+ I NKA,NEW D
+ .S FDA(120.86,"?+"_DFN_",",.01)=DFN
+ .S FDA(120.86,"?+"_DFN_",",1)=1
+ .S FDA(120.86,"?+"_DFN_",",2)=DUZ
+ .S FDA(120.86,"?+"_DFN_",",3)=$G(@GMRARRAY@("GMRAORDT"),$$NOW^XLFDT)
+ .S IEN(DFN)=DFN
+ .D UPDATE^DIE("","FDA","IEN")
+ K FDA,IEN
+ S NODE=$S($G(NEW):"+1,",1:(GMRAIEN_","))
+ S:$G(NEW) FDA(120.8,NODE,.01)=DFN
+ I $P($G(@GMRARRAY@("GMRAGNT")),U,2)["50.67" S $P(@GMRARRAY@("GMRAGNT"),U,2)=$$TGTOG^PSNAPIS($P(@GMRARRAY@("GMRAGNT"),U))_";PSNDF(50.6,"
+ F SUB="GMRAGNT;.02","GMRATYPE;3.1","GMRANATR;17","GMRAORIG;5","GMRAORDT;4","GMRAOBHX;6" D
+ .S FDA(120.8,NODE,$P(SUB,";",2))=$P(@GMRARRAY@($P(SUB,";")),U)
+ .I (SUB["GMRAGNT"),NEW S FDA(120.8,NODE,1)=$P(@GMRARRAY@($P(SUB,";")),U,2)
+ D UPDATE^DIE("","FDA","IEN")
+ S:NEW GMRAIEN=IEN(1)
+ K FDA
+ F SUB="GMRACHT","GMRAIDBN" D
+ .Q:'$D(@GMRARRAY@(SUB))  ;Stop if no updates
+ .S FILE=$S(SUB="GMRACHT":120.813,1:120.814)
+ .S FDA(FILE,"+1,"_GMRAIEN_",",.01)=@GMRARRAY@(SUB,1)
+ .S FDA(FILE,"+1,"_GMRAIEN_",",1)=DUZ
+ .D UPDATE^DIE("","FDA")
+ I $D(@GMRARRAY@("GMRACMTS")) D ADCOM(GMRAIEN,"O",$NA(@GMRARRAY@("GMRACMTS"))) ;Add comments if included
+ K FDA
+ S SUB=0 F  S SUB=$O(@GMRARRAY@("GMRASYMP",SUB)) Q:'+SUB  D
+ .S GMRAS0=^(SUB) ;Naked from above
+ .Q:$P(^(SUB),U)=""  ;25 No text or free text entered so don't store
+ .S SIEN=$O(^GMR(120.8,GMRAIEN,10,"B",$P(GMRAS0,U),0))
+ .I SIEN,$P(^GMR(120.8,GMRAIEN,10,SIEN,0),U,4)=$P(GMRAS0,U,3) Q  ;Exists and nothing has changed
+ .I SIEN,$P(GMRAS0,U,5)="@" S DIK="^GMR(120.8,"_GMRAIEN_",",DA(1)=GMRAIEN,DA=SIEN D ^DIK Q  ;Sign/symptom deleted
+ .S:'SIEN FDA(120.81,"+1,"_GMRAIEN_",",.01)=$S($P(GMRAS0,U)="FT":$O(^GMRD(120.83,"B","OTHER REACTION",0)),1:$P(GMRAS0,U))
+ .S NODE=$S(SIEN:SIEN_","_GMRAIEN,1:"+1,"_GMRAIEN_",")
+ .S:$P(GMRAS0,U)="FT" FDA(120.81,NODE,1)=$P(GMRAS0,U,2)
+ .S FDA(120.81,NODE,2)=DUZ
+ .S FDA(120.81,NODE,3)=$P(GMRAS0,U,3)
+ .D UPDATE^DIE("","FDA","","ERR")
+ .S GMRAROT($P(GMRAS0,U,2))="" ;21 record s/s added
+ I NEW D
+ .S GMRALL(GMRAIEN)="" D VAD^GMRAUTL1(DFN,,.GMRALOC,.GMRANAM) D EN7^GMRAMCB ;Send mark chart/ID band bulletin if needed.
+ .I $P(@GMRARRAY@("GMRAOBHX"),U)="o" D  ;if observed reaction add data to 120.85
+ ..S GMRAOUT=0 ;21
+ ..S GMRAL(GMRAIEN,"O",GMRAIEN)=$G(@GMRARRAY@("GMRARDT"))_"^"_$G(@GMRARRAY@("GMRASEVR"))
+ ..S GMRADFN=DFN
+ ..S GMRAL(GMRAIEN)="^^"_$P($G(@GMRARRAY@("GMRAGNT")),U)_"^^^^"_$G(@GMRARRAY@("GMRAORIG"))
+ ..M GMRAL(GMRAIEN,"S")=@GMRARRAY@("GMRASYMP")
+ ..S SUB=0 F  S SUB=$O(GMRAL(GMRAIEN,"S",SUB)) Q:'+SUB  S $P(GMRAL(GMRAIEN,"S",SUB),U,2)=$P(GMRAL(GMRAIEN,"S",SUB),U,2)_"^" S:$P(GMRAL(GMRAIEN,"S",SUB),U)="FT" $P(GMRAL(GMRAIEN,"S",SUB),U)=$O(^GMRD(120.83,"B","OTHER REACTION",0))
+ ..S GMRAL=GMRAIEN
+ ..D ADVERSE^GMRAOR7(GMRAIEN,.GMRAL) ;adds entry to 120.85
+ ..S GMRAIEN(GMRAIEN)="" ;21
+ ..D EN1^GMRAPET0(GMRADFN,.GMRAIEN,"S",.GMRAOUT) ;21 File progress note
+ ..I $G(@GMRARRAY@("GMRATYPE"))["D" S GMRAPA=GMRAIEN D EN1^GMRAPTB ;21 Send med-watch update
+ .S GMRAAR=$P($G(@GMRARRAY@("GMRAGNT")),U,2),GMRAPA=GMRAIEN
+ .D EN1^GMRAOR9 S ^TMP($J,"GMRASF",1,GMRAPA)="" D RANGE^GMRASIGN(1) ;add ingredients/classes send appropriate bulletins
+ S ORY=0
+ L -^XTMP("GMRAED",DFN)
+ Q
+ ;
+MESS ;Give out locked message
+ N GMRAXBOS,GMRAL1,GMRAL2
+ S GMRAXBOS=$$BROKER^XWBLIB ;In GUI?
+ S GMRAL1="Another user is editing this patient's allergy information."
+ S GMRAL2="Please refresh/review the patient's information before proceeding."
+ I 'GMRAXBOS W !,GMRAL1,!,GMRAL2 D WAIT^GMRAFX3 Q
+ S ORY="-1^"_GMRAL1_"  "_GMRAL2
+ Q
Index: WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPET0.m
===================================================================
--- WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPET0.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPET0.m	(revision 623)
@@ -1,121 +1,121 @@
-GMRAPET0	;HIRMFO/RM-VERIFIED ALLERGY TASKS ;11/17/06  10:27
-	;;4.0;Adverse Reaction Tracking;**6,17,21,20,38**;Mar 29, 1996;Build 2
-EN1(GMRADFN,GMRAPA,GMRACT,GMRAOUT)	;
-	; ENTRY TO PERFORM ALL OF THE TASKS NECESSARY FOR
-	;                 A PROGRESS NOTE TO BE ENTERED BY ART
-	;     INPUT:
-	;           GMRADFN = PATIENT IEN IN THE PATIENT FILE
-	;           GMRAPA  = THE IEN IN THE PATIENT ALLERGY FILE
-	;           GMRACT  = THE ACTION TO BE ENTERED FOR THIS REACTION
-	;                   = "V" VERIFICATION OF A REACTION
-	;                   = "S" SIGN OFF OF A REACTION
-	;                   = "M" MEDWATCH FORM ENTERD
-	;                   = "E" REACTION ENERED IN ERROR
-	;      OUTPUT:
-	;           GMRAOUT = REACTION ALL WAS PASSED
-	;                   = 1 USER ABORT OR PN FAIL IN SOME WAY
-	;                   = 0 PASSED
-	;
-	;      VARABLE LIST
-	;        GMRACW = IS THE PROGRESS NOTE TITLE
-	;       GMRALOC = IS THE LOCATION OF THE PATIENT
-	;      GMRAHLOC = IS THE LOCATION IN FILE 44
-	;       GMRADFN = IS THE PATIENT IEN
-	;        GMRADT = IS THE DATE THE EVENT TOOK PLACE
-	;       GMRADUZ = IS THE USER WHO ENTERED THE INFORMATION
-	;        GMRAPN = IS THE IEN OF THE PROGRESS NOTE THAT WAS ENTERED
-	;
-	;CHECKING FOR A VALID TITLE
-	K ^TMP("TIUP",$J),GMRAPN
-	N GMRACW,GMRALOC,GMRAHLOC,GMRAXBOS ;21
-	S GMRAPN=-1,GMRAXBOS=$$BROKER^XWBLIB ;21 Got GUI?
-	I "VSME"'[GMRACT S GMRAOUT=1 D EXIT Q
-	; The following lines of code which reference Progress Notes files and
-	; routines will have to change when TIU replaces Progress Notes.
-	;S GMRACW=0 F  S GMRACW=$O(^GMR(121.2,"B","ADVERSE REACTION/ALLERGY",GMRACW)) Q:GMRACW<1  I $P($G(^GMR(121.1,$P($G(^GMR(121.2,GMRACW,0)),U,2),0)),U)="GENERAL NOTE" Q
-	;-----ADDED BY VAUGHN 1/13/97 FOR TIU REPLACES LINE ABOVE----
-	S GMRACW=+$$WHATITLE^TIUPUTU("ADVERSE REACTION/ALLERGY")
-	;------END---
-	;-----CHANGED BY VAUGHN 1/13/97 FOR TIU---
-	I GMRACW<1!($T(NEW^TIUPNAPI)']"")!('$$CANPICK^TIULP(GMRACW)) S GMRAOUT=1 D EXIT Q  ;21
-	;I GMRACW<1!($T(PN^GMRPART)']"") S GMRAOUT=1 D EXIT Q
-	;-----END----
-	D @GMRACT I GMRAOUT D EXIT Q  ; THIS TELL'S THE PROGRAM WHERE TO GO
-	S GMRALOC=""
-	D VAD^GMRAUTL1(GMRADFN,"",.GMRALOC,"","","")
-	I GMRALOC'="" S GMRAHLOC=+$G(^DIC(42,GMRALOC,44))
-	;E  I '$G(GMRAXBOS) D ASK ;20
-	; Call to Progress Notes
-	; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
-	;S:'GMRAOUT GMRAPN=+$$PN^GMRPART(GMRADFN,GMRADUZ,GMRADT,GMRACW,GMRAHLOC)
-	;---REPLACED LINE ABOVE WITH LINE BELOW;1/13/97 VAUGHN---
-	I 'GMRAOUT D
-	.S GMRAPN=0 D NEW^TIUPNAPI(.GMRAPN,GMRADFN,GMRADUZ,GMRADT,GMRACW,$G(GMRAHLOC),$S($G(GMRAXBOS):0,1:1)) ;17,21 Allow editing if not in GUI
-	;----------END-------
-	I GMRAPN=-1,'$G(GMRAXBOS) S GMRAOUT=1 W !,"No Progress Note was created." ;21
-	I GMRAPN=0,'$G(GMRAXBOS) W !,"Progress note has not been signed." ;21
-	D EXIT
-	Q
-EXIT	; Clean up of variables
-	K ^TMP("TIUP",$J),GMRALOC,GMRAHLOC,GMRADUZ ;38 Removed variable GMRAPN from list of variables to kill
-	Q
-ASK	; Simple file manager query for a location in file 44
-	N DIC
-	S X=""
-	S DIC=44,DIC(0)="AEQ",DIC("A")="Select a Hospital Location: ",DIC("S")="I ""CMW""[$P(^(0),U,3)" ;20
-	W !,"A progress note is being created because you "_$S(GMRACT="V":"verified",GMRACT="E":"inactivated",GMRACT="S":"activated",1:"entered a medwatch form for"),!,$P($G(^GMR(120.8,GMRAPA,0)),U,2),"." ;20
-	W !,"Enter a hospital location to be associated with this note." ;20
-	D ^DIC
-	I $D(DTOUT)!($D(DUOUT)) S GMRAOUT=1 Q
-	S GMRAHLOC=+Y
-	Q
-V	; Verified Reaction
-	N GMRAI ;21
-	S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0))
-	S GMRADT=$P(GMRAPA(0),U,17),GMRADUZ=$P(GMRAPA(0),U,18)
-	S:GMRADUZ="" GMRADUZ=DUZ ; Autoverified reaction being reverified
-	S ^TMP("TIUP",$J,1,0)="This patient has had an "_$S($P(GMRAPA(0),"^",14)="P":"adverse reaction reported for ",1:"allergy to ")_$P(GMRAPA(0),"^",2)
-	S ^TMP("TIUP",$J,2,0)="verified on "_$$FMTE^XLFDT(GMRADT,1)_"."
-	S GMRAI=2 D ADDCOM("V",.GMRAI) ;21
-	S ^TMP("TIUP",$J,0)=U_U_GMRAI_U_GMRAI_U_GMRADT_"^^^" ;21
-	Q
-S	; Signed Reaction
-	N GMRAI,GMRAREAC ;21
-	D NOW^%DTC
-	S GMRADT=%,GMRADUZ=DUZ
-	S GMRAREAC=0,GMRAI=3 F  S GMRAREAC=$O(GMRAPA(GMRAREAC)) Q:GMRAREAC<1  S GMRAI=GMRAI+1,^TMP("TIUP",$J,GMRAI,0)=$P($G(^GMR(120.8,GMRAREAC,0)),U,2) S GMRAPA=GMRAREAC D  ;21
-	.D ADDCOM("O",.GMRAI) ;21
-	.S GMRAI=GMRAI+1,^TMP("TIUP",$J,GMRAI,0)="" ;21
-	S ^TMP("TIUP",$J,1,0)="This patient has had the following reaction"_$S(GMRAI=3:" ",1:"s ")
-	S ^TMP("TIUP",$J,2,0)="signed-off on "_$$FMTE^XLFDT(GMRADT,1)_"."
-	S ^TMP("TIUP",$J,3,0)="" ;21
-	S ^TMP("TIUP",$J,0)=U_U_GMRAI_U_GMRAI_U_GMRADT_"^^^"
-	Q
-M	; MedWATCH data entered
-	N X
-	S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0))
-	D NOW^%DTC
-	S GMRADT=%,GMRADUZ=DUZ
-	S ^TMP("TIUP",$J,1,0)="This patient has had a MEDWatch report completed on "_$$FMTE^XLFDT(GMRADT,1)_" for"
-	S ^TMP("TIUP",$J,2,0)=$S($P(GMRAPA(0),"^",14)="P":"an adverse reaction to ",1:"allergy to ")_$P(GMRAPA(0),"^",2)_"."
-	S ^TMP("TIUP",$J,0)=U_U_"2"_U_"2"_U_GMRADT_"^^^"
-	Q
-E	; Reaction Entered in Error
-	N GMRAER,GMRAI ;21
-	S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0))
-	S GMRAER=$G(^GMR(120.8,GMRAPA,"ER")) I GMRAER="" S GMRAOUT=1 Q
-	S GMRADT=$P(GMRAER,U,2),GMRADUZ=$P(GMRAER,U,3)
-	S ^TMP("TIUP",$J,1,0)="The "_$S($P(GMRAPA(0),"^",14)="P":"adverse reaction ",1:"allergy ")_"to "_$P(GMRAPA(0),"^",2)_" was removed on "_$$FMTE^XLFDT($P(GMRADT,"."),2)_"." ;20
-	S ^TMP("TIUP",$J,2,0)="This reaction was either an erroneous entry or was found" ;20
-	S ^TMP("TIUP",$J,3,0)="to no longer be a true "_$S($P(GMRAPA(0),"^",14)="P":"adverse reaction",1:"allergy")_"." ;20
-	S GMRAI=3 D ADDCOM("E",.GMRAI) ;21,20
-	S ^TMP("TIUP",$J,0)=U_U_GMRAI_U_GMRAI_U_GMRADT_"^^^" ;21
-	Q
-	;
-ADDCOM(TYPE,CNT)	;Add any comments to progress note - section added in patch 21
-	N SUB,ENTRY
-	S ENTRY=$O(^GMR(120.8,GMRAPA,26,"AVER",TYPE,0)) Q:'+ENTRY
-	S CNT=CNT+1,^TMP("TIUP",$J,CNT,0)="",CNT=CNT+1,^TMP("TIUP",$J,CNT,0)="Author's comments:"
-	S CNT=CNT+1,^TMP("TIUP",$J,CNT,0)=""
-	S SUB=0 F  S SUB=$O(^GMR(120.8,GMRAPA,26,ENTRY,2,SUB)) Q:'+SUB  S CNT=CNT+1,^TMP("TIUP",$J,CNT,0)=^GMR(120.8,GMRAPA,26,ENTRY,2,SUB,0)
-	Q
+GMRAPET0 ;HIRMFO/RM-VERIFIED ALLERGY TASKS ;4/7/06  12:38
+ ;;4.0;Adverse Reaction Tracking;**6,17,21,20**;Mar 29, 1996;Build 1
+EN1(GMRADFN,GMRAPA,GMRACT,GMRAOUT) ;
+ ; ENTRY TO PERFORM ALL OF THE TASKS NECESSARY FOR
+ ;                 A PROGRESS NOTE TO BE ENTERED BY ART
+ ;     INPUT:
+ ;           GMRADFN = PATIENT IEN IN THE PATIENT FILE
+ ;           GMRAPA  = THE IEN IN THE PATIENT ALLERGY FILE
+ ;           GMRACT  = THE ACTION TO BE ENTERED FOR THIS REACTION
+ ;                   = "V" VERIFICATION OF A REACTION
+ ;                   = "S" SIGN OFF OF A REACTION
+ ;                   = "M" MEDWATCH FORM ENTERD
+ ;                   = "E" REACTION ENERED IN ERROR
+ ;      OUTPUT:
+ ;           GMRAOUT = REACTION ALL WAS PASSED
+ ;                   = 1 USER ABORT OR PN FAIL IN SOME WAY
+ ;                   = 0 PASSED
+ ;
+ ;      VARABLE LIST
+ ;        GMRACW = IS THE PROGRESS NOTE TITLE
+ ;       GMRALOC = IS THE LOCATION OF THE PATIENT
+ ;      GMRAHLOC = IS THE LOCATION IN FILE 44
+ ;       GMRADFN = IS THE PATIENT IEN
+ ;        GMRADT = IS THE DATE THE EVENT TOOK PLACE
+ ;       GMRADUZ = IS THE USER WHO ENTERED THE INFORMATION
+ ;        GMRAPN = IS THE IEN OF THE PROGRESS NOTE THAT WAS ENTERED
+ ;
+ ;CHECKING FOR A VALID TITLE
+ K ^TMP("TIUP",$J),GMRAPN
+ N GMRACW,GMRALOC,GMRAHLOC,GMRAXBOS ;21
+ S GMRAPN=-1,GMRAXBOS=$$BROKER^XWBLIB ;21 Got GUI?
+ I "VSME"'[GMRACT S GMRAOUT=1 D EXIT Q
+ ; The following lines of code which reference Progress Notes files and
+ ; routines will have to change when TIU replaces Progress Notes.
+ ;S GMRACW=0 F  S GMRACW=$O(^GMR(121.2,"B","ADVERSE REACTION/ALLERGY",GMRACW)) Q:GMRACW<1  I $P($G(^GMR(121.1,$P($G(^GMR(121.2,GMRACW,0)),U,2),0)),U)="GENERAL NOTE" Q
+ ;-----ADDED BY VAUGHN 1/13/97 FOR TIU REPLACES LINE ABOVE----
+ S GMRACW=+$$WHATITLE^TIUPUTU("ADVERSE REACTION/ALLERGY")
+ ;------END---
+ ;-----CHANGED BY VAUGHN 1/13/97 FOR TIU---
+ I GMRACW<1!($T(NEW^TIUPNAPI)']"")!('$$CANPICK^TIULP(GMRACW)) S GMRAOUT=1 D EXIT Q  ;21
+ ;I GMRACW<1!($T(PN^GMRPART)']"") S GMRAOUT=1 D EXIT Q
+ ;-----END----
+ D @GMRACT I GMRAOUT D EXIT Q  ; THIS TELL'S THE PROGRAM WHERE TO GO
+ S GMRALOC=""
+ D VAD^GMRAUTL1(GMRADFN,"",.GMRALOC,"","","")
+ I GMRALOC'="" S GMRAHLOC=+$G(^DIC(42,GMRALOC,44))
+ ;E  I '$G(GMRAXBOS) D ASK ;20
+ ; Call to Progress Notes
+ ; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
+ ;S:'GMRAOUT GMRAPN=+$$PN^GMRPART(GMRADFN,GMRADUZ,GMRADT,GMRACW,GMRAHLOC)
+ ;---REPLACED LINE ABOVE WITH LINE BELOW;1/13/97 VAUGHN---
+ I 'GMRAOUT D
+ .S GMRAPN=0 D NEW^TIUPNAPI(.GMRAPN,GMRADFN,GMRADUZ,GMRADT,GMRACW,$G(GMRAHLOC),$S($G(GMRAXBOS):0,1:1)) ;17,21 Allow editing if not in GUI
+ ;----------END-------
+ I GMRAPN=-1,'$G(GMRAXBOS) S GMRAOUT=1 W !,"No Progress Note was created." ;21
+ I GMRAPN=0,'$G(GMRAXBOS) W !,"Progress note has not been signed." ;21
+ D EXIT
+ Q
+EXIT ; Clean up of variables
+ K ^TMP("TIUP",$J),GMRAPN,GMRALOC,GMRAHLOC,GMRADUZ
+ Q
+ASK ; Simple file manager query for a location in file 44
+ N DIC
+ S X=""
+ S DIC=44,DIC(0)="AEQ",DIC("A")="Select a Hospital Location: ",DIC("S")="I ""CMW""[$P(^(0),U,3)" ;20
+ W !,"A progress note is being created because you "_$S(GMRACT="V":"verified",GMRACT="E":"inactivated",GMRACT="S":"activated",1:"entered a medwatch form for"),!,$P($G(^GMR(120.8,GMRAPA,0)),U,2),"." ;20
+ W !,"Enter a hospital location to be associated with this note." ;20
+ D ^DIC
+ I $D(DTOUT)!($D(DUOUT)) S GMRAOUT=1 Q
+ S GMRAHLOC=+Y
+ Q
+V ; Verified Reaction
+ N GMRAI ;21
+ S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0))
+ S GMRADT=$P(GMRAPA(0),U,17),GMRADUZ=$P(GMRAPA(0),U,18)
+ S:GMRADUZ="" GMRADUZ=DUZ ; Autoverified reaction being reverified
+ S ^TMP("TIUP",$J,1,0)="This patient has had an "_$S($P(GMRAPA(0),"^",14)="P":"adverse reaction reported for ",1:"allergy to ")_$P(GMRAPA(0),"^",2)
+ S ^TMP("TIUP",$J,2,0)="verified on "_$$FMTE^XLFDT(GMRADT,1)_"."
+ S GMRAI=2 D ADDCOM("V",.GMRAI) ;21
+ S ^TMP("TIUP",$J,0)=U_U_GMRAI_U_GMRAI_U_GMRADT_"^^^" ;21
+ Q
+S ; Signed Reaction
+ N GMRAI,GMRAREAC ;21
+ D NOW^%DTC
+ S GMRADT=%,GMRADUZ=DUZ
+ S GMRAREAC=0,GMRAI=3 F  S GMRAREAC=$O(GMRAPA(GMRAREAC)) Q:GMRAREAC<1  S GMRAI=GMRAI+1,^TMP("TIUP",$J,GMRAI,0)=$P($G(^GMR(120.8,GMRAREAC,0)),U,2) S GMRAPA=GMRAREAC D  ;21
+ .D ADDCOM("O",.GMRAI) ;21
+ .S GMRAI=GMRAI+1,^TMP("TIUP",$J,GMRAI,0)="" ;21
+ S ^TMP("TIUP",$J,1,0)="This patient has had the following reaction"_$S(GMRAI=3:" ",1:"s ")
+ S ^TMP("TIUP",$J,2,0)="signed-off on "_$$FMTE^XLFDT(GMRADT,1)_"."
+ S ^TMP("TIUP",$J,3,0)="" ;21
+ S ^TMP("TIUP",$J,0)=U_U_GMRAI_U_GMRAI_U_GMRADT_"^^^"
+ Q
+M ; MedWATCH data entered
+ N X
+ S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0))
+ D NOW^%DTC
+ S GMRADT=%,GMRADUZ=DUZ
+ S ^TMP("TIUP",$J,1,0)="This patient has had a MEDWatch report completed on "_$$FMTE^XLFDT(GMRADT,1)_" for"
+ S ^TMP("TIUP",$J,2,0)=$S($P(GMRAPA(0),"^",14)="P":"an adverse reaction to ",1:"allergy to ")_$P(GMRAPA(0),"^",2)_"."
+ S ^TMP("TIUP",$J,0)=U_U_"2"_U_"2"_U_GMRADT_"^^^"
+ Q
+E ; Reaction Entered in Error
+ N GMRAER,GMRAI ;21
+ S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0))
+ S GMRAER=$G(^GMR(120.8,GMRAPA,"ER")) I GMRAER="" S GMRAOUT=1 Q
+ S GMRADT=$P(GMRAER,U,2),GMRADUZ=$P(GMRAER,U,3)
+ S ^TMP("TIUP",$J,1,0)="The "_$S($P(GMRAPA(0),"^",14)="P":"adverse reaction ",1:"allergy ")_"to "_$P(GMRAPA(0),"^",2)_" was removed on "_$$FMTE^XLFDT($P(GMRADT,"."),2)_"." ;20
+ S ^TMP("TIUP",$J,2,0)="This reaction was either an erroneous entry or was found" ;20
+ S ^TMP("TIUP",$J,3,0)="to no longer be a true "_$S($P(GMRAPA(0),"^",14)="P":"adverse reaction",1:"allergy")_"." ;20
+ S GMRAI=3 D ADDCOM("E",.GMRAI) ;21,20
+ S ^TMP("TIUP",$J,0)=U_U_GMRAI_U_GMRAI_U_GMRADT_"^^^" ;21
+ Q
+ ;
+ADDCOM(TYPE,CNT) ;Add any comments to progress note - section added in patch 21
+ N SUB,ENTRY
+ S ENTRY=$O(^GMR(120.8,GMRAPA,26,"AVER",TYPE,0)) Q:'+ENTRY
+ S CNT=CNT+1,^TMP("TIUP",$J,CNT,0)="",CNT=CNT+1,^TMP("TIUP",$J,CNT,0)="Author's comments:"
+ S CNT=CNT+1,^TMP("TIUP",$J,CNT,0)=""
+ S SUB=0 F  S SUB=$O(^GMR(120.8,GMRAPA,26,ENTRY,2,SUB)) Q:'+SUB  S CNT=CNT+1,^TMP("TIUP",$J,CNT,0)=^GMR(120.8,GMRAPA,26,ENTRY,2,SUB,0)
+ Q
Index: WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPFT.m
===================================================================
--- WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPFT.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPFT.m	(revision 623)
@@ -1,83 +1,82 @@
-GMRAPFT	;HIRMFO/WAA- PRINT FDA REACTION BY DATE ENTERED/TRACKED ;4/10/97  09:30
-	;;4.0;Adverse Reaction Tracking;**7,33**;Mar 29, 1996;Build 5
-EN1	; This routine will loop through the ADT entry point to get all
-	; the entries in that date range.
-	S GMRAOUT=0
-	W !,"Select a Tracking date range for this report."
-	D DT^GMRAPL G:GMRAOUT EXIT
-	D PRINTER
-EXIT	; Exit of program kill cleanup
-	D KILL^XUSCLEAN
-	Q
-PRINTER	;Select printer
-	W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q
-	I $D(IO("Q")) D  Q
-	. S ZTRTN="PRINT^GMRAPFT",(ZTSAVE("GMRAOUT"),ZTSAVE("GMAST"),ZTSAVE("GMAEN"))=""
-	. S ZTDESC="List of FDA Reactions over a Date range by Tracking date" D ^%ZTLOAD
-	. W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try Later.")
-	. Q
-	U IO D PRINT U IO(0)
-	D EXIT
-	Q
-PRINT	;Queue point for report
-	D NOW^%DTC S GMRADPDT=X
-	S GMRADATE=GMAST-.0001,GMRAPG=1
-	F  S GMRADATE=$O(^GMR(120.85,"ARDT",GMRADATE)) Q:GMRADATE<1  Q:GMRADATE>GMAEN  D  Q:GMRAOUT
-	.S GMRAPA1=0
-	.F  S GMRAPA1=$O(^GMR(120.85,"ARDT",GMRADATE,GMRAPA1)) Q:GMRAPA1<1  D  Q:GMRAOUT
-	..S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0)) Q:GMRAPA1(0)=""
-	..Q:+$G(^GMR(120.8,$P(GMRAPA1(0),U,15),"ER"))  ;data entered in error
-	..D HEAD Q:GMRAOUT
-	..S (GMRAPID,GMRANAME,GMRALOC)=""
-	..S GMRADFN=$P(GMRAPA1(0),U,2),GMRADDT=$P(GMRAPA1(0),U)
-	..Q:'$$PRDTST^GMRAUTL1(GMRADFN)  ;GMRA*4*33 Exclude test patient from report if production or legacy system.
-	..D VAD^GMRAUTL1(GMRADFN,GMRADDT,.GMRALOC,.GMRANAME,"",.GMRAPID)
-	..I GMRALOC="" S GMRALOC="OUT PATIENT"
-	..E  S GMRALOC=$P($G(^DIC(42,GMRALOC,0)),U)
-	..W !,$E(GMRANAME,1,30) ; Patient Name
-	..K GMRARAC
-	..S GMRARAC=0,GMRACNT=1 F  S GMRARAC=$O(^GMR(120.85,GMRAPA1,3,GMRARAC)) Q:GMRARAC<1  D
-	...S GMRARAC(GMRACNT)=$P($G(^GMR(120.85,GMRAPA1,3,GMRARAC,0)),U) Q:GMRARAC(GMRACNT)=""
-	...S GMRACNT=GMRACNT+1
-	...Q
-	..W ?32,"Obs DT: ",$$FMTE^XLFDT($P(GMRAPA1(0),U),"2D") ; Observed Date
-	..W ?49,$E($G(GMRARAC(1)),1,30) ; The 1st reaction that is listed first
-	..W !,"(",GMRAPID,")"
-	..W ?32,"Trk DT: ",$$FMTE^XLFDT($P(GMRAPA1(0),U,18),"2D") ; Tracking Date
-	..W ?49,$E($G(GMRARAC(2)),1,30) ; The 2nd reaction that is listed
-	..W !,"Loc: ",GMRALOC
-	..W ?32,"-------------" ; Separator
-	..W ?49,$E($G(GMRARAC(3)),1,30) ; The 3rd reaction that is listed
-	..W !,"Obs: ",$P($G(^VA(200,$P(GMRAPA1(0),U,19),0)),U) ; User entered
-	..D
-	...N X1,X2,X,Y
-	...S X2=$P(GMRAPA1(0),U),X1=$P(GMRAPA1(0),U,18)
-	...D ^%DTC
-	...W ?32,X," Days Difference" ;Difference
-	...Q
-	..W ?50,$E($G(GMRARAC(4)),1,30) ; The 4th reaction that is listed
-	..S GMRACNT=4 F  S GMRACNT=$O(GMRARAC(GMRACNT))  Q:GMRACNT<1  W !,?50,$E($G(GMRARAC(GMRACNT)),1,30) ; The Nth reaction that is listed
-	..W ! ; Put a blank line between the ADRs
-	..Q
-	.Q
-	D CLOSE^GMRAUTL
-	Q
-HEAD	; Print header information
-	I GMRAPG'=1  Q:$Y<(IOSL-4)
-	I $E(IOST,1)="C" D  Q:GMRAOUT
-	.I GMRAPG=1 W @IOF Q
-	.I GMRAPG'=1 D  Q:GMRAOUT
-	..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1
-	..K Y
-	..Q
-	.Q
-	Q:GMRAOUT
-	I GMRAPG'=1 W @IOF
-	W "Report Date: ",$P($$FMTE^XLFDT(GMRADPDT),"@"),?70,"Page: ",GMRAPG
-	W !,?22,"Adverse Reaction Tracking Report"
-	W !,?25,"From: ",$$FMTE^XLFDT(GMAST,"2D")," To: ",$$FMTE^XLFDT(GMAEN,"2D")
-	W !,"Patient",?40,"Dates",?49,"Related Reaction"
-	W !,$$REPEAT^XLFSTR("-",78)
-	S GMRAPG=GMRAPG+1
-	I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user
-	Q
+GMRAPFT ;HIRMFO/WAA- PRINT FDA REACTION BY DATE ENTERED/TRACKED ;4/10/97  09:30
+ ;;4.0;Adverse Reaction Tracking;**7**;Mar 29, 1996
+EN1 ; This routine will loop through the ADT entry point to get all
+ ; the entries in that date range.
+ S GMRAOUT=0
+ W !,"Select a Tracking date range for this report."
+ D DT^GMRAPL G:GMRAOUT EXIT
+ D PRINTER
+EXIT ; Exit of program kill cleanup
+ D KILL^XUSCLEAN
+ Q
+PRINTER ;Select printer
+ W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q
+ I $D(IO("Q")) D  Q
+ . S ZTRTN="PRINT^GMRAPFT",(ZTSAVE("GMRAOUT"),ZTSAVE("GMAST"),ZTSAVE("GMAEN"))=""
+ . S ZTDESC="List of FDA Reactions over a Date range by Tracking date" D ^%ZTLOAD
+ . W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try Later.")
+ . Q
+ U IO D PRINT U IO(0)
+ D EXIT
+ Q
+PRINT ;Queue point for report
+ D NOW^%DTC S GMRADPDT=X
+ S GMRADATE=GMAST-.0001,GMRAPG=1
+ F  S GMRADATE=$O(^GMR(120.85,"ARDT",GMRADATE)) Q:GMRADATE<1  Q:GMRADATE>GMAEN  D  Q:GMRAOUT
+ .S GMRAPA1=0
+ .F  S GMRAPA1=$O(^GMR(120.85,"ARDT",GMRADATE,GMRAPA1)) Q:GMRAPA1<1  D  Q:GMRAOUT
+ ..S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0)) Q:GMRAPA1(0)=""
+ ..Q:+$G(^GMR(120.8,$P(GMRAPA1(0),U,15),"ER"))  ;data entered in error
+ ..D HEAD Q:GMRAOUT
+ ..S (GMRAPID,GMRANAME,GMRALOC)=""
+ ..S GMRADFN=$P(GMRAPA1(0),U,2),GMRADDT=$P(GMRAPA1(0),U)
+ ..D VAD^GMRAUTL1(GMRADFN,GMRADDT,.GMRALOC,.GMRANAME,"",.GMRAPID)
+ ..I GMRALOC="" S GMRALOC="OUT PATIENT"
+ ..E  S GMRALOC=$P($G(^DIC(42,GMRALOC,0)),U)
+ ..W !,$E(GMRANAME,1,30) ; Patient Name
+ ..K GMRARAC
+ ..S GMRARAC=0,GMRACNT=1 F  S GMRARAC=$O(^GMR(120.85,GMRAPA1,3,GMRARAC)) Q:GMRARAC<1  D
+ ...S GMRARAC(GMRACNT)=$P($G(^GMR(120.85,GMRAPA1,3,GMRARAC,0)),U) Q:GMRARAC(GMRACNT)=""
+ ...S GMRACNT=GMRACNT+1
+ ...Q
+ ..W ?32,"Obs DT: ",$$FMTE^XLFDT($P(GMRAPA1(0),U),"2D") ; Observed Date
+ ..W ?49,$E($G(GMRARAC(1)),1,30) ; The 1st reaction that is listed first
+ ..W !,"(",GMRAPID,")"
+ ..W ?32,"Trk DT: ",$$FMTE^XLFDT($P(GMRAPA1(0),U,18),"2D") ; Tracking Date
+ ..W ?49,$E($G(GMRARAC(2)),1,30) ; The 2nd reaction that is listed
+ ..W !,"Loc: ",GMRALOC
+ ..W ?32,"-------------" ; Seperator
+ ..W ?49,$E($G(GMRARAC(3)),1,30) ; The 3rd reaction that is listed
+ ..W !,"Obs: ",$P($G(^VA(200,$P(GMRAPA1(0),U,19),0)),U) ; User entered
+ ..D
+ ...N X1,X2,X,Y
+ ...S X2=$P(GMRAPA1(0),U),X1=$P(GMRAPA1(0),U,18)
+ ...D ^%DTC
+ ...W ?32,X," Days Difference" ;Difference
+ ...Q
+ ..W ?50,$E($G(GMRARAC(4)),1,30) ; The 4th reaction that is listed
+ ..S GMRACNT=4 F  S GMRACNT=$O(GMRARAC(GMRACNT))  Q:GMRACNT<1  W !,?50,$E($G(GMRARAC(GMRACNT)),1,30) ; The Nth reaction that is listed
+ ..W ! ; Put a blank line between the ADRs
+ ..Q
+ .Q
+ D CLOSE^GMRAUTL
+ Q
+HEAD ; Print header information
+ I GMRAPG'=1  Q:$Y<(IOSL-4)
+ I $E(IOST,1)="C" D  Q:GMRAOUT
+ .I GMRAPG=1 W @IOF Q
+ .I GMRAPG'=1 D  Q:GMRAOUT
+ ..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1
+ ..K Y
+ ..Q
+ .Q
+ Q:GMRAOUT
+ I GMRAPG'=1 W @IOF
+ W "Report Date: ",$P($$FMTE^XLFDT(GMRADPDT),"@"),?70,"Page: ",GMRAPG
+ W !,?22,"Adverse Reaction Tracking Report"
+ W !,?25,"From: ",$$FMTE^XLFDT(GMAST,"2D")," To: ",$$FMTE^XLFDT(GMAEN,"2D")
+ W !,"Patient",?40,"Dates",?49,"Related Reaction"
+ W !,$$REPEAT^XLFSTR("-",78)
+ S GMRAPG=GMRAPG+1
+ I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user
+ Q
Index: WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPL.m
===================================================================
--- WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPL.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPL.m	(revision 623)
@@ -1,110 +1,109 @@
-GMRAPL	;HIRMFO/WAA- PRINT ALLERGY LIST BY LOCATION ;5/2/97  14:13
-	;;4.0;Adverse Reaction Tracking;**7,33**;Mar 29, 1996;Build 5
-EN1	; This routine will loop through the GMRA patient allergy file
-	; to find all patient within the date range that meet the criteria
-	; and then display all the data for those patients first by location
-	; then by date/time range of the reaction.
-	; First select a starting date.
-	; then select an end date.
-	; then select a print device.
-	; GMAST = START DATE
-	; GMAEN = END DATE
-	;
-	S GMRAOUT=0
-	D DT G:GMRAOUT EXIT
-	S GMAPG=1
-	D DEVICE
-	D EXIT
-	Q
-GET	; This sub routine is to find all the reaction with in this observed 
-	; date range.
-	K ^TMP($J,"GMRAPL")
-	N GMADT S GMADT=GMAST-.0001
-	F  S GMADT=$O(^GMR(120.8,"AODT",GMADT)) Q:GMADT<1  Q:GMADT>GMAEN  D
-	.N GMRAPA S GMRAPA=0
-	.F  S GMRAPA=$O(^GMR(120.8,"AODT",GMADT,GMRAPA)) Q:GMRAPA<1  D
-	..S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0))
-	..; Stop if it is not Signed or if is E/E
-	..Q:GMRAPA(0)=""  ; Bad Zero node 
-	..Q:'$P(GMRAPA(0),U,12)  ; Not signed off
-	..Q:$P($G(^GMR(120.8,GMRAPA,"ER")),U)  ; Entered in error
-	..; Get patient name and location.
-	..S GMRATYP=$P(GMRAPA(0),U,20) ; Get the reaction types FDO
-	..S (GMRANAM,GMRALOC,GMRAVIP)=""
-	..Q:'$$PRDTST^GMRAUTL1($P($G(GMRAPA(0)),U))  ;GMRA*4*33 Exclude test patient from report if production or legacy environment
-	..D VAD^GMRAUTL1($P(GMRAPA(0),U),$P(GMRAPA(0),U,4),.GMRALOC,.GMRANAM,"","","","",.GMRAVIP)
-	..I GMRALOC'="",+$G(^DIC(42,GMRALOC,44)) S GMRALOC=$P($G(^SC(+$G(^DIC(42,GMRALOC,44)),0)),U)
-	..I GMRALOC="" S GMRALOC="Out Patients"
-	..;Data format is as follows....
-	..;^TMP($J,"GMRAPL",Ward location,Patient,PID,Reaction Type(FDO),Reaction)
-	..S ^TMP($J,"GMRAPL",$E(GMRALOC,1,30),$E(GMRANAM,1,30),GMRAVIP,GMRATYP,GMRAPA)=""
-	..Q
-	.Q
-	Q
-PRINT	; Print data in the reaction global
-	I $E(IOST,1)="C" W !,"One moment please...",!
-	D GET
-	S GMRALOC="" F  S GMRALOC=$O(^TMP($J,"GMRAPL",GMRALOC)) Q:GMRALOC=""  D  Q:GMRAOUT
-	.D HEAD Q:GMRAOUT
-	.S GMRANAM="" F  S GMRANAM=$O(^TMP($J,"GMRAPL",GMRALOC,GMRANAM)) Q:GMRANAM=""  D  Q:GMRAOUT
-	..S GMRAVIP="" F  S GMRAVIP=$O(^TMP($J,"GMRAPL",GMRALOC,GMRANAM,GMRAVIP)) Q:GMRAVIP=""  D  Q:GMRAOUT
-	...I $Y>(IOSL-4) D HEAD Q:GMRAOUT
-	...W !,?10,"Patient: ",GMRANAM," (",GMRAVIP,")"
-	...S GMRATYP="" F  S GMRATYP=$O(^TMP($J,"GMRAPL",GMRALOC,GMRANAM,GMRAVIP,GMRATYP)) W:GMRATYP="" ! Q:GMRATYP=""  D  Q:GMRAOUT
-	....S GMRAPA=0 F  S GMRAPA=$O(^TMP($J,"GMRAPL",GMRALOC,GMRANAM,GMRAVIP,GMRATYP,GMRAPA)) Q:GMRAPA<1  D  Q:GMRAOUT
-	.....S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""
-	.....W !,$$FMTE^XLFDT($P(GMRAPA(0),U,4),"1") ;When It was entered
-	.....W ?20,$S($P(GMRAPA(0),U,5)'="":$E($P(^VA(200,$P(GMRAPA(0),U,5),0),U),1,25),1:"<None>") ;Who Entered it
-	.....W ?46,GMRATYP ;Type of reaction
-	.....W ?50,$E($P(GMRAPA(0),U,2),1,30) ;Reaction
-	.....I $Y>(IOSL-4) D HEAD
-	.....Q
-	....Q
-	...Q
-	..Q
-	.Q
-	Q
-HEAD	; Header
-	I $E(IOST,1)="C" D  Q:GMRAOUT
-	.I GMAPG=1 W @IOF Q
-	.I GMAPG'=1 D  Q:GMRAOUT
-	..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1
-	..K Y
-	..Q
-	.Q
-	I GMAPG'=1 W @IOF
-	W $$FMTE^XLFDT(GMRAPDT,"1"),?70,"Page: ",GMAPG S GMAPG=GMAPG+1
-	W !,?11,"List all Signed Patient Reactions for",$S(GMRALOC'="Out Patients":" Ward Location ",1:" "),GMRALOC
-	W !,?15,"From ",$$FMTE^XLFDT(GMAST,"1")," to ",$$FMTE^XLFDT(GMAEN,"1")
-	W !,"Date",?20,"Originator",?45,"Type",?50,"Causative Agent"
-	W !,$$REPEAT^XLFSTR("-",79)
-	Q
-DEVICE	; Select a device to print on
-	D NOW^%DTC S GMRAPDT=X
-	W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q
-	I $D(IO("Q")) D  Q
-	. S ZTRTN="PRINT^GMRAPL",(ZTSAVE("GMAST"),ZTSAVE("GMAEN"),ZTSAVE("GMRAOUT"),ZTSAVE("GMRAPDT"),ZTSAVE("GMAPG"))=""
-	. S ZTDESC="List of Reactions by Ward Location within a date range." D ^%ZTLOAD
-	. W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try  Later.")
-	. Q
-	U IO D PRINT U IO(0)
-	D CLOSE^GMRAUTL
-	D EXIT
-	Q
-DT	; Get dates
-	S GMAST=$$DATE("Enter Start Date: ") I GMAST<1 S GMRAOUT=1 Q
-	S GMAEN=$$DATE("Enter Ending Date: ",GMAST) I GMAEN<1 S GMRAOUT=1 Q
-	S GMAEN=GMAEN_".24" ;Gives results through entire day when 'T' is selected
-	Q
-DATE(PROMPT,GMADATE)	; Date sub routine
-	S GMADATE=$G(GMADATE)
-	S DATE=""
-	N DIR
-	S DIR(0)="DAO^"_GMADATE_"::AEP",DIR("A")=PROMPT
-	D ^DIR I $D(DIRUT) S DATE="" Q DATE
-	S DATE=Y
-	Q DATE
-EXIT	;EXIT ROUTINE DATA
-	K ^TMP($J,"GMRAPL")
-	D KILL^XUSCLEAN
-	Q
+GMRAPL ;HIRMFO/WAA- PRINT ALLERGY LIST BY LOCATION ;5/2/97  14:13
+ ;;4.0;Adverse Reaction Tracking;**7**;Mar 29, 1996
+EN1 ; This routine will loop thourgh the GMRA patient allergy file
+ ; to find all patient within the date range that meet the critera
+ ; and then display all the data for those patients first by location
+ ; then by date/time range of the reaction.
+ ; First select a starting date.
+ ; then select an end date.
+ ; then select a print device.
+ ; GMAST = START DATE
+ ; GMAEN = END DATE
+ ;
+ S GMRAOUT=0
+ D DT G:GMRAOUT EXIT
+ S GMAPG=1
+ D DEVICE
+ D EXIT
+ Q
+GET ; This sub routine is to find all the reaction with in this observed 
+ ; date range.
+ K ^TMP($J,"GMRAPL")
+ N GMADT S GMADT=GMAST-.0001
+ F  S GMADT=$O(^GMR(120.8,"AODT",GMADT)) Q:GMADT<1  Q:GMADT>GMAEN  D
+ .N GMRAPA S GMRAPA=0
+ .F  S GMRAPA=$O(^GMR(120.8,"AODT",GMADT,GMRAPA)) Q:GMRAPA<1  D
+ ..S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0))
+ ..; Stop if it is not Signed or if is E/E
+ ..Q:GMRAPA(0)=""  ; Bad Zero node 
+ ..Q:'$P(GMRAPA(0),U,12)  ; Not signed off
+ ..Q:$P($G(^GMR(120.8,GMRAPA,"ER")),U)  ; Entered in error
+ ..; Get patient name and location.
+ ..S GMRATYP=$P(GMRAPA(0),U,20) ; Get the reaction types FDO
+ ..S (GMRANAM,GMRALOC,GMRAVIP)=""
+ ..D VAD^GMRAUTL1($P(GMRAPA(0),U),$P(GMRAPA(0),U,4),.GMRALOC,.GMRANAM,"","","","",.GMRAVIP)
+ ..I GMRALOC'="",+$G(^DIC(42,GMRALOC,44)) S GMRALOC=$P($G(^SC(+$G(^DIC(42,GMRALOC,44)),0)),U)
+ ..I GMRALOC="" S GMRALOC="Out Patients"
+ ..;Data format is as follows....
+ ..;^TMP($J,"GMRAPL",Ward location,Patient,PID,Reaction Type(FDO),Reaction)
+ ..S ^TMP($J,"GMRAPL",$E(GMRALOC,1,30),$E(GMRANAM,1,30),GMRAVIP,GMRATYP,GMRAPA)=""
+ ..Q
+ .Q
+ Q
+PRINT ; Print data in the reaction global
+ I $E(IOST,1)="C" W !,"One moment please...",!
+ D GET
+ S GMRALOC="" F  S GMRALOC=$O(^TMP($J,"GMRAPL",GMRALOC)) Q:GMRALOC=""  D  Q:GMRAOUT
+ .D HEAD Q:GMRAOUT
+ .S GMRANAM="" F  S GMRANAM=$O(^TMP($J,"GMRAPL",GMRALOC,GMRANAM)) Q:GMRANAM=""  D  Q:GMRAOUT
+ ..S GMRAVIP="" F  S GMRAVIP=$O(^TMP($J,"GMRAPL",GMRALOC,GMRANAM,GMRAVIP)) Q:GMRAVIP=""  D  Q:GMRAOUT
+ ...I $Y>(IOSL-4) D HEAD Q:GMRAOUT
+ ...W !,?10,"Patient: ",GMRANAM," (",GMRAVIP,")"
+ ...S GMRATYP="" F  S GMRATYP=$O(^TMP($J,"GMRAPL",GMRALOC,GMRANAM,GMRAVIP,GMRATYP)) W:GMRATYP="" ! Q:GMRATYP=""  D  Q:GMRAOUT
+ ....S GMRAPA=0 F  S GMRAPA=$O(^TMP($J,"GMRAPL",GMRALOC,GMRANAM,GMRAVIP,GMRATYP,GMRAPA)) Q:GMRAPA<1  D  Q:GMRAOUT
+ .....S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""
+ .....W !,$$FMTE^XLFDT($P(GMRAPA(0),U,4),"1") ;When It was entered
+ .....W ?20,$S($P(GMRAPA(0),U,5)'="":$E($P(^VA(200,$P(GMRAPA(0),U,5),0),U),1,25),1:"<None>") ;Who Entered it
+ .....W ?46,GMRATYP ;Type of reaction
+ .....W ?50,$E($P(GMRAPA(0),U,2),1,30) ;Reaction
+ .....I $Y>(IOSL-4) D HEAD
+ .....Q
+ ....Q
+ ...Q
+ ..Q
+ .Q
+ Q
+HEAD ; Header
+ I $E(IOST,1)="C" D  Q:GMRAOUT
+ .I GMAPG=1 W @IOF Q
+ .I GMAPG'=1 D  Q:GMRAOUT
+ ..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1
+ ..K Y
+ ..Q
+ .Q
+ I GMAPG'=1 W @IOF
+ W $$FMTE^XLFDT(GMRAPDT,"1"),?70,"Page: ",GMAPG S GMAPG=GMAPG+1
+ W !,?11,"List all Signed Patient Reactions for",$S(GMRALOC'="Out Patients":" Ward Location ",1:" "),GMRALOC
+ W !,?15,"From ",$$FMTE^XLFDT(GMAST,"1")," to ",$$FMTE^XLFDT(GMAEN,"1")
+ W !,"Date",?20,"Originator",?45,"Type",?50,"Causative Agent"
+ W !,$$REPEAT^XLFSTR("-",79)
+ Q
+DEVICE ; Select a device to print on
+ D NOW^%DTC S GMRAPDT=X
+ W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q
+ I $D(IO("Q")) D  Q
+ . S ZTRTN="PRINT^GMRAPL",(ZTSAVE("GMAST"),ZTSAVE("GMAEN"),ZTSAVE("GMRAOUT"),ZTSAVE("GMRAPDT"),ZTSAVE("GMAPG"))=""
+ . S ZTDESC="List of Reactions by Ward Location within a date range." D ^%ZTLOAD
+ . W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try  Later.")
+ . Q
+ U IO D PRINT U IO(0)
+ D CLOSE^GMRAUTL
+ D EXIT
+ Q
+DT ; Get dates
+ S GMAST=$$DATE("Enter Start Date: ") I GMAST<1 S GMRAOUT=1 Q
+ S GMAEN=$$DATE("Enter Ending Date: ",GMAST) I GMAEN<1 S GMRAOUT=1 Q
+ S GMAEN=GMAEN_".24" ;Gives results through entire day when 'T' is selected
+ Q
+DATE(PROMPT,GMADATE) ; Date sub routine
+ S GMADATE=$G(GMADATE)
+ S DATE=""
+ N DIR
+ S DIR(0)="DAO^"_GMADATE_"::AEP",DIR("A")=PROMPT
+ D ^DIR I $D(DIRUT) S DATE="" Q DATE
+ S DATE=Y
+ Q DATE
+EXIT ;EXIT ROUTINE DATA
+ K ^TMP($J,"GMRAPL")
+ D KILL^XUSCLEAN
+ Q
Index: WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPNA.m
===================================================================
--- WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPNA.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPNA.m	(revision 623)
@@ -1,86 +1,85 @@
-GMRAPNA	;HIRMFO/WAA-PATIENT NOT ASKED ABOUT ALLERGIES ;12/1/95  14:15
-	;;4.0;Adverse Reaction Tracking;**30,33**;Mar 29, 1996;Build 5
-EN1	; Entry for LIST BY LOCATION OF UNDOCUMENTED ALLERGIES option
-	D EN1^GMRACMR G:GMRAOUT EXIT
-	D DEV
-	D EXIT
-	Q
-DEV	; *** Select output device, force queuing
-	;***** NOTE: CHECKS TO SEE IF VALID DEVICE IS SELECTED THEN ALL I HAVE TO DO IS RUN TASK MAN.
-	S GMRAZIS="" S:GMRASEL'="1," GMRAZIS="Q"
-	W !! D DEV^GMRAUTL I POP G EXIT
-	I $D(IO("Q")) D  G EXIT
-	. K IO("Q")
-	. S ZTRTN="ENTSK^GMRAPNA"
-	. S ZTSAVE("GMRA*")="",ZTSAVE("^TMP($J,")=""
-	. S ZTDESC="List of patients who have not been asked of allergies"
-	. D ^%ZTLOAD
-	. W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try later...")
-	. Q
-	E  D ENTSK
-	Q
-ENTSK	U IO
-	D EN1^GMRACMR2,EN1^GMRACMR3
-	S GMRAPAGE=0,X="NOW" D ^%DT S GMRAPDT=$$DATE^GMRAUTL1(Y)
-	D PRINT
-	G EXIT
-PRINT	;PRINT THE DATE
-	D PRE
-	S GMRAHLOC="" F  S GMRAHLOC=$O(^TMP($J,"GMRAWC","C",GMRAHLOC)) Q:GMRAHLOC=""!(GMRAOUT)  S GMRAX=0 F  S GMRAX=$O(^(GMRAHLOC,GMRAX)) Q:GMRAX<1  D  Q:GMRAOUT
-	.S GMRA=$G(^TMP($J,"GMRAWC",GMRAX)),GMRACNT=0
-	.I GMRA="" Q
-	.D HEAD Q:GMRAOUT
-	.W !!,?10,$S(GMRA="W":"WARD",GMRA="M":"MODULE",GMRA="C":"CLINIC",1:"UNKNOWN"),": ",$P(^SC(GMRAX,0),U)
-	.S GMRADATE=0 F  S GMRADATE=$O(^TMP($J,"GMRAWC",GMRAX,GMRADATE))  Q:GMRADATE=""  S GMRADFN=0 Q:GMRAOUT  F  S GMRADFN=$O(^TMP($J,"GMRAWC",GMRAX,GMRADATE,GMRADFN)) Q:GMRADFN<1  D  Q:GMRAOUT
-	..I '$D(^GMR(120.86,GMRADFN,0))
-	..E  I +$P(^GMR(120.86,GMRADFN,0),U,4)<$G(GMRAED,9999999) Q
-	..Q:'$D(^DPT(GMRADFN,0))
-	..Q:$$DECEASED^GMRAFX(GMRADFN)  ;GMRA*4*30 Prevent deceased patients from appearing on this report.
-	..Q:'$$PRDTST^GMRAUTL1(GMRADFN)  ;GMRA*4*33 Exclude test patient from report if production or legacy environment.
-	..S GMRACNT=GMRACNT+1
-	..W !,$P(^DPT(GMRADFN,0),U) S DFN=GMRADFN,VAINDT=$S(GMRADATE="CURRENT":DT,1:GMRADATE) D 1^VADPT W ?30,VA("PID") W:GMRA'="C" ?45,$P(VAIN(2),U,2)
-	..I VAIN(5)'="" W !,?5,"Room/Bed: ",VAIN(5)
-	..D KVAR^VADPT K VA,DFN
-	..I $Y>(IOSL-4) D HEAD Q:GMRAOUT
-	..Q
-	.D NOPAT
-	.Q
-	D CLOSE^GMRAUTL
-	Q
-NOPAT	; If there are no patients print informational message
-	Q:GMRACNT
-	W !,?24,"* No Patients for this ",$S(GMRA="W":"Ward",GMRA="M":"Module",GMRA="C":"Clinic",1:"UNKNOWN")," *"
-	W !
-	Q
-HEAD	;HEADER PAGE FOR PRINTOUT
-	S GMRAPAGE=GMRAPAGE+1,GMRATL="" I $E(IOST,1)="C",GMRAPAGE=1 W @IOF
-	I $E(IOST,1)="C",GMRAPAGE'=1 D  Q:GMRAOUT
-	.S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1
-	.K Y
-	.Q
-	I GMRAPAGE'=1 W @IOF
-	W !,GMRAPDT,?23,"PATIENTS NOT ASKED ABOUT ALLERGIES",?70,"PAGE ",GMRAPAGE
-	I GMRASEL["1" S GMRATL="CURRENT INPATIENTS"
-	I GMRASEL["2" S GMRATL=$S(GMRATL="":"OUTPATIENTS",1:GMRATL_" / OUTPATIENTS")
-	I GMRASEL["3" S GMRATL=$S(GMRATL="":"NEW ADMISSIONS",1:GMRATL_" / NEW ADMISSIONS")
-	W !,?(40-($L(GMRATL)/2)),GMRATL
-	I (GMRASEL["2"!(GMRASEL["3")) W !,?23,"FROM ",$$DATE^GMRAUTL1(GMRAST),?42,"TO ",$$DATE^GMRAUTL1(GMRAED)
-	W !!,"PATIENT",?30,"SSN" W:GMRA'="C" ?45,"PROVIDER"
-	W !,$$REPEAT^XLFSTR("-",78)
-	I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user
-	Q
-PRE	; This will validate the TMP global and fire off Xref
-	N GMRAX,GMRAY,GMRAT1,GMRAT2,GMRAT3
-	Q:'$D(^TMP($J,"GMRAWC"))
-	S GMRAX=0  F  S GMRAX=$O(^TMP($J,"GMRAWC",GMRAX)) Q:GMRAX<1  D
-	.S GMRAY=^TMP($J,"GMRAWC",GMRAX)
-	.S GMRAT1=$P($G(^SC(GMRAX,0)),U,2)
-	.S GMRAT2=$P($G(^SC(GMRAX,0)),U)
-	.S GMRAT3=$S(GMRAT1'="":GMRAT1,1:GMRAT2)
-	.S ^TMP($J,"GMRAWC","C",GMRAT3,GMRAX)=""
-	.Q
-	Q
-EXIT	;
-	K ^TMP($J,"GMRAWC")
-	D KILL^XUSCLEAN
-	Q
+GMRAPNA ;HIRMFO/WAA-PATIENT NOT ASKED ABOUT ALLERGIES ;12/1/95  14:15
+ ;;4.0;Adverse Reaction Tracking;**30**;Mar 29, 1996
+EN1 ; Entry for LIST BY LOCATION OF UNDOCUMENTED ALLERGIES option
+ D EN1^GMRACMR G:GMRAOUT EXIT
+ D DEV
+ D EXIT
+ Q
+DEV ; *** Select output device, force queueing
+ ;***** NOTE: CHECKS TO SEE IF VALID DEVICE IS SELECTED THEN ALL I HAVE TO DO IS RUN TASK MAN.
+ S GMRAZIS="" S:GMRASEL'="1," GMRAZIS="Q"
+ W !! D DEV^GMRAUTL I POP G EXIT
+ I $D(IO("Q")) D  G EXIT
+ . K IO("Q")
+ . S ZTRTN="ENTSK^GMRAPNA"
+ . S ZTSAVE("GMRA*")="",ZTSAVE("^TMP($J,")=""
+ . S ZTDESC="List of patients who have not been asked of allergies"
+ . D ^%ZTLOAD
+ . W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try later...")
+ . Q
+ E  D ENTSK
+ Q
+ENTSK U IO
+ D EN1^GMRACMR2,EN1^GMRACMR3
+ S GMRAPAGE=0,X="NOW" D ^%DT S GMRAPDT=$$DATE^GMRAUTL1(Y)
+ D PRINT
+ G EXIT
+PRINT ;PRINT THE DATE
+ D PRE
+ S GMRAHLOC="" F  S GMRAHLOC=$O(^TMP($J,"GMRAWC","C",GMRAHLOC)) Q:GMRAHLOC=""!(GMRAOUT)  S GMRAX=0 F  S GMRAX=$O(^(GMRAHLOC,GMRAX)) Q:GMRAX<1  D  Q:GMRAOUT
+ .S GMRA=$G(^TMP($J,"GMRAWC",GMRAX)),GMRACNT=0
+ .I GMRA="" Q
+ .D HEAD Q:GMRAOUT
+ .W !!,?10,$S(GMRA="W":"WARD",GMRA="M":"MODULE",GMRA="C":"CLINIC",1:"UNKNOWN"),": ",$P(^SC(GMRAX,0),U)
+ .S GMRADATE=0 F  S GMRADATE=$O(^TMP($J,"GMRAWC",GMRAX,GMRADATE))  Q:GMRADATE=""  S GMRADFN=0 Q:GMRAOUT  F  S GMRADFN=$O(^TMP($J,"GMRAWC",GMRAX,GMRADATE,GMRADFN)) Q:GMRADFN<1  D  Q:GMRAOUT
+ ..I '$D(^GMR(120.86,GMRADFN,0))
+ ..E  I +$P(^GMR(120.86,GMRADFN,0),U,4)<$G(GMRAED,9999999) Q
+ ..Q:'$D(^DPT(GMRADFN,0))
+ ..Q:$$DECEASED^GMRAFX(GMRADFN)  ;GMRA*4*30 Prevent deceased patients from appearing on this report.
+ ..S GMRACNT=GMRACNT+1
+ ..W !,$P(^DPT(GMRADFN,0),U) S DFN=GMRADFN,VAINDT=$S(GMRADATE="CURRENT":DT,1:GMRADATE) D 1^VADPT W ?30,VA("PID") W:GMRA'="C" ?45,$P(VAIN(2),U,2)
+ ..I VAIN(5)'="" W !,?5,"Room/Bed: ",VAIN(5)
+ ..D KVAR^VADPT K VA,DFN
+ ..I $Y>(IOSL-4) D HEAD Q:GMRAOUT
+ ..Q
+ .D NOPAT
+ .Q
+ D CLOSE^GMRAUTL
+ Q
+NOPAT ; If there are no patients print informational message
+ Q:GMRACNT
+ W !,?24,"* No Patients for this ",$S(GMRA="W":"Ward",GMRA="M":"Module",GMRA="C":"Clinic",1:"UNKNOWN")," *"
+ W !
+ Q
+HEAD ;HEADER PAGE FOR PRINTOUT
+ S GMRAPAGE=GMRAPAGE+1,GMRATL="" I $E(IOST,1)="C",GMRAPAGE=1 W @IOF
+ I $E(IOST,1)="C",GMRAPAGE'=1 D  Q:GMRAOUT
+ .S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1
+ .K Y
+ .Q
+ I GMRAPAGE'=1 W @IOF
+ W !,GMRAPDT,?23,"PATIENTS NOT ASKED ABOUT ALLERGIES",?70,"PAGE ",GMRAPAGE
+ I GMRASEL["1" S GMRATL="CURRENT INPATIENTS"
+ I GMRASEL["2" S GMRATL=$S(GMRATL="":"OUTPATIENTS",1:GMRATL_" / OUTPATIENTS")
+ I GMRASEL["3" S GMRATL=$S(GMRATL="":"NEW ADMISSIONS",1:GMRATL_" / NEW ADMISSIONS")
+ W !,?(40-($L(GMRATL)/2)),GMRATL
+ I (GMRASEL["2"!(GMRASEL["3")) W !,?23,"FROM ",$$DATE^GMRAUTL1(GMRAST),?42,"TO ",$$DATE^GMRAUTL1(GMRAED)
+ W !!,"PATIENT",?30,"SSN" W:GMRA'="C" ?45,"PROVIDER"
+ W !,$$REPEAT^XLFSTR("-",78)
+ I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user
+ Q
+PRE ; This will validate the TMP global and fire off Xref
+ N GMRAX,GMRAY,GMRAT1,GMRAT2,GMRAT3
+ Q:'$D(^TMP($J,"GMRAWC"))
+ S GMRAX=0  F  S GMRAX=$O(^TMP($J,"GMRAWC",GMRAX)) Q:GMRAX<1  D
+ .S GMRAY=^TMP($J,"GMRAWC",GMRAX)
+ .S GMRAT1=$P($G(^SC(GMRAX,0)),U,2)
+ .S GMRAT2=$P($G(^SC(GMRAX,0)),U)
+ .S GMRAT3=$S(GMRAT1'="":GMRAT1,1:GMRAT2)
+ .S ^TMP($J,"GMRAWC","C",GMRAT3,GMRAX)=""
+ .Q
+ Q
+EXIT ;
+ K ^TMP($J,"GMRAWC")
+ D KILL^XUSCLEAN
+ Q
Index: WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPST1.m
===================================================================
--- WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPST1.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPST1.m	(revision 623)
@@ -1,89 +1,88 @@
-GMRAPST1	;HIRMFO/WAA- PRINT LISTING OF FATAL REACTIONS ;3/5/97  14:45
-	;;4.0;Adverse Reaction Tracking;**7,33**;Mar 29, 1996;Build 5
-EN1	; This routine will loop through the ADT entry point to get all
-	; the entries where the patient has died.
-	S GMRAOUT=0
-	W !,"Select an Observed date range for this report."
-	D DT^GMRAPL G:GMRAOUT EXIT
-	D PRINTER
-EXIT	; Exit of program kill cleanup
-	D KILL^XUSCLEAN
-	K ^TMP($J,"GMRAPST1")
-	Q
-PRINTER	;Select printer
-	W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q
-	I $D(IO("Q")) D  Q
-	. S ZTRTN="PRINT^GMRAPST1",(ZTSAVE("GMRAOUT"),ZTSAVE("GMAST"),ZTSAVE("GMAEN"))=""
-	. S ZTDESC="List of Fatal Reaction over a date range" D ^%ZTLOAD
-	. W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try Later.")
-	. Q
-	U IO D PRINT U IO(0)
-	Q
-PRINT	;Queue point for report
-	;Loop through the 120.85 file.
-	K ^TMP($J,"GMRAPST1")
-	D NOW^%DTC S GMRADPDT=X
-	S GMRADATE=GMAST-.0001,GMRAPG=1
-	F  S GMRADATE=$O(^GMR(120.85,"B",GMRADATE)) Q:GMRADATE<1  Q:GMRADATE>GMAEN  D
-	.S GMRAPA1=0 F  S GMRAPA1=$O(^GMR(120.85,"B",GMRADATE,GMRAPA1)) Q:GMRAPA1<1  D
-	..S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0)) Q:GMRAPA1(0)=""  ;Bad Node
-	..Q:+$G(^GMR(120.8,$P(GMRAPA1(0),U,15),"ER"))  ;data entered in error
-	..Q:$P(GMRAPA1(0),U,3)'="y"  ; If patient did not die of the reaction
-	..S GMRADFN=$P(GMRAPA1(0),U,2),GMRADDT=$P(GMRAPA1(0),U) ; reaction date
-	..Q:'$$PRDTST^GMRAUTL1(GMRADFN)  ;GMRA*4*33 Exclude test patient from report in production or legacy environments.
-	..S (GMRAPID,GMRANAME)=""
-	..D VAD^GMRAUTL1(GMRADFN,GMRADDT,"",.GMRANAME,"",.GMRAPID)
-	..S GMRADIED=$P($G(^DPT(GMRADFN,.35)),U) ; Date patient died
-	..S ^TMP($J,"GMRAPST1",$E(GMRANAME,1,30),GMRAPID,GMRADDT,GMRAPA1)=GMRADIED
-	..Q
-	.Q
-	Q:GMRAOUT
-	I '$D(^TMP($J,"GMRAPST1")) D HEAD W !,"NO DATA FOR THIS REPORT..." Q
-	S GMRANAME=""
-	F  S GMRANAME=$O(^TMP($J,"GMRAPST1",GMRANAME)) Q:GMRANAME=""  D  Q:GMRAOUT
-	.S GMRAPID=""
-	.F  S GMRAPID=$O(^TMP($J,"GMRAPST1",GMRANAME,GMRAPID)) Q:GMRAPID=""  D  Q:GMRAOUT
-	..D HEAD Q:GMRAOUT
-	..W !,$E(GMRANAME,1,22)," (",$E(GMRANAME,1),$P(GMRAPID,"-",3),")"
-	..S GMRADDT=0
-	..F  S GMRADDT=$O(^TMP($J,"GMRAPST1",GMRANAME,GMRAPID,GMRADDT)) Q:GMRADDT<1  D  Q:GMRAOUT
-	...S GMRAPA1=0
-	...F  S GMRAPA1=$O(^TMP($J,"GMRAPST1",GMRANAME,GMRAPID,GMRADDT,GMRAPA1)) Q:GMRAPA1<1  D  Q:GMRAOUT  W !
-	....S GMRADIED=^TMP($J,"GMRAPST1",GMRANAME,GMRAPID,GMRADDT,GMRAPA1)
-	....W ?31,$$FMTE^XLFDT($P(^GMR(120.85,GMRAPA1,0),U),"2D")
-	....S GMRAX="",GMRACNT=1 K GMRARX
-	....F  S GMRAX=$O(^GMR(120.85,GMRAPA1,3,"B",GMRAX)) Q:GMRAX=""  D
-	.....S GMRARX(GMRACNT)=GMRAX,GMRACNT=GMRACNT+1
-	.....Q
-	....W ?40,GMRARX(1),?70,$$FMTE^XLFDT(GMRADIED,"2D")
-	....D HEAD Q:GMRAOUT
-	....S GMRACNT=1 F  S GMRACNT=$O(GMRARX(GMRACNT)) Q:GMRACNT<1  D  Q:GMRAOUT
-	.....W !,?40,GMRARX(GMRACNT) D HEAD Q:GMRAOUT
-	.....Q
-	....Q
-	...Q
-	..W ! D HEAD Q:GMRAOUT
-	..Q
-	.Q
-	D CLOSE^GMRAUTL
-	Q
-	;has the patient died within the date
-HEAD	; Print header information
-	I GMRAPG'=1  Q:$Y<(IOSL-4)
-	I $E(IOST,1)="C" D  Q:GMRAOUT
-	.I GMRAPG=1 W @IOF Q
-	.I GMRAPG'=1 D  Q:GMRAOUT
-	..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1
-	..K Y
-	..Q
-	.Q
-	Q:GMRAOUT
-	I GMRAPG'=1 W @IOF
-	W "Report Date: ",$P($$FMTE^XLFDT(GMRADPDT),"@"),?70,"Page: ",GMRAPG
-	W !,?22,"List of Fatal Reaction over a date range"
-	W !,?25,"From: ",$$FMTE^XLFDT(GMAST,"2D")," To: ",$$FMTE^XLFDT(GMAEN,"2D")
-	W !,"Patient",?31,"Dates",?40,"Related Reaction",?70,"Date Died"
-	W !,$$REPEAT^XLFSTR("-",79)
-	S GMRAPG=GMRAPG+1
-	I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user
-	Q
+GMRAPST1 ;HIRMFO/WAA- PRINT LISTING OF FATAL REACTIONS ;3/5/97  14:45
+ ;;4.0;Adverse Reaction Tracking;**7**;Mar 29, 1996
+EN1 ; This routine will loop through the ADT entry point to get all
+ ; the entries where the patient has died.
+ S GMRAOUT=0
+ W !,"Select an Observed date range for this report."
+ D DT^GMRAPL G:GMRAOUT EXIT
+ D PRINTER
+EXIT ; Exit of program kill cleanup
+ D KILL^XUSCLEAN
+ K ^TMP($J,"GMRAPST1")
+ Q
+PRINTER ;Select printer
+ W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q
+ I $D(IO("Q")) D  Q
+ . S ZTRTN="PRINT^GMRAPST1",(ZTSAVE("GMRAOUT"),ZTSAVE("GMAST"),ZTSAVE("GMAEN"))=""
+ . S ZTDESC="List of Fatal Reaction over a date range" D ^%ZTLOAD
+ . W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try Later.")
+ . Q
+ U IO D PRINT U IO(0)
+ Q
+PRINT ;Queue point for report
+ ;Loop through the 120.85 file.
+ K ^TMP($J,"GMRAPST1")
+ D NOW^%DTC S GMRADPDT=X
+ S GMRADATE=GMAST-.0001,GMRAPG=1
+ F  S GMRADATE=$O(^GMR(120.85,"B",GMRADATE)) Q:GMRADATE<1  Q:GMRADATE>GMAEN  D
+ .S GMRAPA1=0 F  S GMRAPA1=$O(^GMR(120.85,"B",GMRADATE,GMRAPA1)) Q:GMRAPA1<1  D
+ ..S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0)) Q:GMRAPA1(0)=""  ;Bad Node
+ ..Q:+$G(^GMR(120.8,$P(GMRAPA1(0),U,15),"ER"))  ;data entered in error
+ ..Q:$P(GMRAPA1(0),U,3)'="y"  ; If patient did not die of the reaction
+ ..S GMRADFN=$P(GMRAPA1(0),U,2),GMRADDT=$P(GMRAPA1(0),U) ; reaction date
+ ..S (GMRAPID,GMRANAME)=""
+ ..D VAD^GMRAUTL1(GMRADFN,GMRADDT,"",.GMRANAME,"",.GMRAPID)
+ ..S GMRADIED=$P($G(^DPT(GMRADFN,.35)),U) ; Date patient died
+ ..S ^TMP($J,"GMRAPST1",$E(GMRANAME,1,30),GMRAPID,GMRADDT,GMRAPA1)=GMRADIED
+ ..Q
+ .Q
+ Q:GMRAOUT
+ I '$D(^TMP($J,"GMRAPST1")) D HEAD W !,"NO DATA FOR THIS REPORT..." Q
+ S GMRANAME=""
+ F  S GMRANAME=$O(^TMP($J,"GMRAPST1",GMRANAME)) Q:GMRANAME=""  D  Q:GMRAOUT
+ .S GMRAPID=""
+ .F  S GMRAPID=$O(^TMP($J,"GMRAPST1",GMRANAME,GMRAPID)) Q:GMRAPID=""  D  Q:GMRAOUT
+ ..D HEAD Q:GMRAOUT
+ ..W !,$E(GMRANAME,1,22)," (",$E(GMRANAME,1),$P(GMRAPID,"-",3),")"
+ ..S GMRADDT=0
+ ..F  S GMRADDT=$O(^TMP($J,"GMRAPST1",GMRANAME,GMRAPID,GMRADDT)) Q:GMRADDT<1  D  Q:GMRAOUT
+ ...S GMRAPA1=0
+ ...F  S GMRAPA1=$O(^TMP($J,"GMRAPST1",GMRANAME,GMRAPID,GMRADDT,GMRAPA1)) Q:GMRAPA1<1  D  Q:GMRAOUT  W !
+ ....S GMRADIED=^TMP($J,"GMRAPST1",GMRANAME,GMRAPID,GMRADDT,GMRAPA1)
+ ....W ?31,$$FMTE^XLFDT($P(^GMR(120.85,GMRAPA1,0),U),"2D")
+ ....S GMRAX="",GMRACNT=1 K GMRARX
+ ....F  S GMRAX=$O(^GMR(120.85,GMRAPA1,3,"B",GMRAX)) Q:GMRAX=""  D
+ .....S GMRARX(GMRACNT)=GMRAX,GMRACNT=GMRACNT+1
+ .....Q
+ ....W ?40,GMRARX(1),?70,$$FMTE^XLFDT(GMRADIED,"2D")
+ ....D HEAD Q:GMRAOUT
+ ....S GMRACNT=1 F  S GMRACNT=$O(GMRARX(GMRACNT)) Q:GMRACNT<1  D  Q:GMRAOUT
+ .....W !,?40,GMRARX(GMRACNT) D HEAD Q:GMRAOUT
+ .....Q
+ ....Q
+ ...Q
+ ..W ! D HEAD Q:GMRAOUT
+ ..Q
+ .Q
+ D CLOSE^GMRAUTL
+ Q
+ ;has the patient died with inthe dat
+HEAD ; Print header information
+ I GMRAPG'=1  Q:$Y<(IOSL-4)
+ I $E(IOST,1)="C" D  Q:GMRAOUT
+ .I GMRAPG=1 W @IOF Q
+ .I GMRAPG'=1 D  Q:GMRAOUT
+ ..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1
+ ..K Y
+ ..Q
+ .Q
+ Q:GMRAOUT
+ I GMRAPG'=1 W @IOF
+ W "Report Date: ",$P($$FMTE^XLFDT(GMRADPDT),"@"),?70,"Page: ",GMRAPG
+ W !,?22,"List of Fatal Reaction over a date range"
+ W !,?25,"From: ",$$FMTE^XLFDT(GMAST,"2D")," To: ",$$FMTE^XLFDT(GMAEN,"2D")
+ W !,"Patient",?31,"Dates",?40,"Related Reaction",?70,"Date Died"
+ W !,$$REPEAT^XLFSTR("-",79)
+ S GMRAPG=GMRAPG+1
+ I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user
+ Q
Index: WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPST2.m
===================================================================
--- WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPST2.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPST2.m	(revision 623)
@@ -1,91 +1,90 @@
-GMRAPST2	;HIRMFO/WAA- PRINT SUM LISTING OF OUT COMES ;3/5/97  14:50
-	;;4.0;Adverse Reaction Tracking;**7,33**;Mar 29, 1996;Build 5
-EN1	; This routine will loop through the ADT entry point to get all
-	; the entries in that date range.
-	S GMRAOUT=0
-	W !,"Select an Observed date range for this report."
-	D DT^GMRAPL G:GMRAOUT EXIT
-	D PRINTER
-EXIT	; Exit of program kill cleanup
-	D KILL^XUSCLEAN
-	Q
-PRINTER	;Select printer
-	W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q
-	I $D(IO("Q")) D  Q
-	. S ZTRTN="PRINT^GMRAPST2",(ZTSAVE("GMRAOUT"),ZTSAVE("GMAST"),ZTSAVE("GMAEN"))=""
-	. S ZTDESC="Summary of Outcomes" D ^%ZTLOAD
-	. W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try Later.")
-	. Q
-	U IO D PRINT U IO(0)
-	Q
-PRINT	;Queue point for report
-	;loop through the 120.85 file and look for the field that 
-	D NOW^%DTC S GMRADPDT=X
-	S GMRADATE=GMAST-.0001,GMRAPG=1
-	S (GMRARRAY("YES"),GMRARRAY("NO"),GMRARRAY("NULL"))="",GMRATOT=0
-	F  S GMRADATE=$O(^GMR(120.85,"B",GMRADATE)) Q:GMRADATE<1  Q:GMRADATE>GMAEN  D
-	.S GMRAPA1=0 F  S GMRAPA1=$O(^GMR(120.85,"B",GMRADATE,GMRAPA1)) Q:GMRAPA1<1  D
-	..S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0)) Q:GMRAPA1(0)=""  ;Bad Node
-	..Q:+$G(^GMR(120.8,$P(GMRAPA1(0),U,15),"ER"))  ;Entered in Error data
-	..Q:'$$PRDTST^GMRAUTL1($P(GMRAPA1(0),U,2))  ;GMRA*4*33 Exclude test patient from report if production or legacy environment.
-	..S GMRATOT=GMRATOT+1
-	..F GMRALAB=1:1 S GMRALINE=$T(TEXT+GMRALAB) Q:$P(GMRALINE,";",3)=""  D
-	...S GMRAP=$P(GMRALINE,";",4)
-	...I $P(GMRAPA1(0),U,GMRAP)="y" S $P(GMRARRAY("YES"),U,GMRAP)=$P(GMRARRAY("YES"),U,GMRAP)+1
-	...I $P(GMRAPA1(0),U,GMRAP)="n" S $P(GMRARRAY("NO"),U,GMRAP)=$P(GMRARRAY("NO"),U,GMRAP)+1
-	...I $P(GMRAPA1(0),U,GMRAP)="" S $P(GMRARRAY("NULL"),U,GMRAP)=$P(GMRARRAY("NULL"),U,GMRAP)+1
-	...Q
-	..Q
-	.Q
-	Q:GMRAOUT
-	D HEAD
-	S (GMRAY,GMRAN,GMRANU)=0
-	F GMRALAB=1:1 S GMRALINE=$T(TEXT+GMRALAB) Q:$P(GMRALINE,";",3)=""  D
-	.N GMRAP,GMRATAB
-	.S GMRAP=$P(GMRALINE,";",4)
-	.S GMRATAB=40-$L($P(GMRALINE,";",3))
-	.W !,?GMRATAB,$P(GMRALINE,";",3)
-	.W ?42,$P(GMRARRAY("YES"),U,GMRAP)
-	.S GMRAY=GMRAY+$P(GMRARRAY("YES"),U,GMRAP)
-	.W ?53,"| ",$P(GMRARRAY("NO"),U,GMRAP)
-	.S GMRAN=GMRAN+$P(GMRARRAY("NO"),U,GMRAP)
-	.W ?63,"| ",$P(GMRARRAY("NULL"),U,GMRAP)
-	.S GMRANU=GMRANU+$P(GMRARRAY("NULL"),U,GMRAP)
-	.Q
-	W !,?30,"        ---------------------------------------"
-	W !,?32,"Totals: ",?42,GMRAY,?53,"| ",GMRAN,?63,"| ",GMRANU
-	W !!,?22,"Total number of records processed ",GMRATOT
-	D CLOSE^GMRAUTL
-	Q
-	;has the patient died within the date
-HEAD	; Print header information
-	I GMRAPG'=1  Q:$Y<(IOSL-4)
-	I $E(IOST,1)="C" D  Q:GMRAOUT
-	.I GMRAPG=1 W @IOF Q
-	.I GMRAPG'=1 D  Q:GMRAOUT
-	..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1
-	..K Y
-	..Q
-	.Q
-	Q:GMRAOUT
-	I GMRAPG'=1 W @IOF
-	W "Report Date: ",$P($$FMTE^XLFDT(GMRADPDT),"@"),?70,"Page: ",GMRAPG
-	W !,?30,"Summary of Outcomes"
-	W !,?25,"From: ",$$FMTE^XLFDT(GMAST,"2D")," To: ",$$FMTE^XLFDT(GMAEN,"2D")
-	W !,?42,"Yes",?55,"No",?65,"No Response"
-	W !,$$REPEAT^XLFSTR("-",79)
-	S GMRAPG=GMRAPG+1
-	I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user
-	Q
-TEXT	;;these are the labels that will denote the field data
-	;;Patients that Died: ;3
-	;;Reactions treated with RX drugs: ;4
-	;;Life Threatening illness: ;5
-	;;Required ER/MD visit: ;6
-	;;Required hospitalization: ;7
-	;;Prolonged Hospitalization: ;9
-	;;Resulted in permanent disability: ;10
-	;;Patient recovered: ;11
-	;;Congenital Anomaly: ;16
-	;;Required intervention: ;17
-	;;
+GMRAPST2 ;HIRMFO/WAA- PRINT SUM LISTING OF OUT COMES ;3/5/97  14:50
+ ;;4.0;Adverse Reaction Tracking;**7**;Mar 29, 1996
+EN1 ; This routine will loop through the ADT entry point to get all
+ ; the entries in that date range.
+ S GMRAOUT=0
+ W !,"Select an Observed date range for this report."
+ D DT^GMRAPL G:GMRAOUT EXIT
+ D PRINTER
+EXIT ; Exit of program kill cleanup
+ D KILL^XUSCLEAN
+ Q
+PRINTER ;Select printer
+ W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q
+ I $D(IO("Q")) D  Q
+ . S ZTRTN="PRINT^GMRAPST2",(ZTSAVE("GMRAOUT"),ZTSAVE("GMAST"),ZTSAVE("GMAEN"))=""
+ . S ZTDESC="Summary of Outcomes" D ^%ZTLOAD
+ . W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try Later.")
+ . Q
+ U IO D PRINT U IO(0)
+ Q
+PRINT ;Queue point for report
+ ;loop through the 120.85 file and look for the field that 
+ D NOW^%DTC S GMRADPDT=X
+ S GMRADATE=GMAST-.0001,GMRAPG=1
+ S (GMRARRAY("YES"),GMRARRAY("NO"),GMRARRAY("NULL"))="",GMRATOT=0
+ F  S GMRADATE=$O(^GMR(120.85,"B",GMRADATE)) Q:GMRADATE<1  Q:GMRADATE>GMAEN  D
+ .S GMRAPA1=0 F  S GMRAPA1=$O(^GMR(120.85,"B",GMRADATE,GMRAPA1)) Q:GMRAPA1<1  D
+ ..S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0)) Q:GMRAPA1(0)=""  ;Bad Node
+ ..Q:+$G(^GMR(120.8,$P(GMRAPA1(0),U,15),"ER"))  ;Entered in Error data
+ ..S GMRATOT=GMRATOT+1
+ ..F GMRALAB=1:1 S GMRALINE=$T(TEXT+GMRALAB) Q:$P(GMRALINE,";",3)=""  D
+ ...S GMRAP=$P(GMRALINE,";",4)
+ ...I $P(GMRAPA1(0),U,GMRAP)="y" S $P(GMRARRAY("YES"),U,GMRAP)=$P(GMRARRAY("YES"),U,GMRAP)+1
+ ...I $P(GMRAPA1(0),U,GMRAP)="n" S $P(GMRARRAY("NO"),U,GMRAP)=$P(GMRARRAY("NO"),U,GMRAP)+1
+ ...I $P(GMRAPA1(0),U,GMRAP)="" S $P(GMRARRAY("NULL"),U,GMRAP)=$P(GMRARRAY("NULL"),U,GMRAP)+1
+ ...Q
+ ..Q
+ .Q
+ Q:GMRAOUT
+ D HEAD
+ S (GMRAY,GMRAN,GMRANU)=0
+ F GMRALAB=1:1 S GMRALINE=$T(TEXT+GMRALAB) Q:$P(GMRALINE,";",3)=""  D
+ .N GMRAP,GMRATAB
+ .S GMRAP=$P(GMRALINE,";",4)
+ .S GMRATAB=40-$L($P(GMRALINE,";",3))
+ .W !,?GMRATAB,$P(GMRALINE,";",3)
+ .W ?42,$P(GMRARRAY("YES"),U,GMRAP)
+ .S GMRAY=GMRAY+$P(GMRARRAY("YES"),U,GMRAP)
+ .W ?53,"| ",$P(GMRARRAY("NO"),U,GMRAP)
+ .S GMRAN=GMRAN+$P(GMRARRAY("NO"),U,GMRAP)
+ .W ?63,"| ",$P(GMRARRAY("NULL"),U,GMRAP)
+ .S GMRANU=GMRANU+$P(GMRARRAY("NULL"),U,GMRAP)
+ .Q
+ W !,?30,"        ---------------------------------------"
+ W !,?32,"Totals: ",?42,GMRAY,?53,"| ",GMRAN,?63,"| ",GMRANU
+ W !!,?22,"Total number of records processed ",GMRATOT
+ D CLOSE^GMRAUTL
+ Q
+ ;has the patient died with inthe dat
+HEAD ; Print header information
+ I GMRAPG'=1  Q:$Y<(IOSL-4)
+ I $E(IOST,1)="C" D  Q:GMRAOUT
+ .I GMRAPG=1 W @IOF Q
+ .I GMRAPG'=1 D  Q:GMRAOUT
+ ..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1
+ ..K Y
+ ..Q
+ .Q
+ Q:GMRAOUT
+ I GMRAPG'=1 W @IOF
+ W "Report Date: ",$P($$FMTE^XLFDT(GMRADPDT),"@"),?70,"Page: ",GMRAPG
+ W !,?30,"Summary of Outcomes"
+ W !,?25,"From: ",$$FMTE^XLFDT(GMAST,"2D")," To: ",$$FMTE^XLFDT(GMAEN,"2D")
+ W !,?42,"Yes",?55,"No",?65,"No Response"
+ W !,$$REPEAT^XLFSTR("-",79)
+ S GMRAPG=GMRAPG+1
+ I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user
+ Q
+TEXT ;;these are the labeles that will denote the field data
+ ;;Patients that Died: ;3
+ ;;Reactions treated with RX drugs: ;4
+ ;;Life Threatening illness: ;5
+ ;;Required ER/MD visit: ;6
+ ;;Required hospitalization: ;7
+ ;;Prolonged Hospitalization: ;9
+ ;;Resulted in permanent disability: ;10
+ ;;Patient recovered: ;11
+ ;;Congenital Anomaly: ;16
+ ;;Required intervention: ;17
+ ;;
Index: WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPST3.m
===================================================================
--- WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPST3.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPST3.m	(revision 623)
@@ -1,81 +1,80 @@
-GMRAPST3	;HIRMFO/WAA- PRINT FREQUENCY OF DIST OVR DT BY REACT ;3/5/97  15:14
-	;;4.0;Adverse Reaction Tracking;**7,33**;Mar 29, 1996;Build 5
-EN1	; This routine will loop through the ADT entry point to get all
-	; the entries in that date range.
-	S GMRAOUT=0
-	W !,"Select an Observed date range for this report."
-	D DT^GMRAPL G:GMRAOUT EXIT
-	D PRINTER
-EXIT	; Exit of program kill cleanup
-	D KILL^XUSCLEAN
-	K ^TMP($J,"GMRAPST3B")
-	K ^TMP($J,"GMRAPST3A")
-	Q
-PRINTER	;Select printer
-	W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q
-	I $D(IO("Q")) D  Q
-	. S ZTRTN="PRINT^GMRAPST3",(ZTSAVE("GMRAOUT"),ZTSAVE("GMAST"),ZTSAVE("GMAEN"))=""
-	. S ZTDESC="Frequency Distribution of Causative Agents" D ^%ZTLOAD
-	. W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try Later.")
-	. Q
-	U IO D PRINT U IO(0)
-	Q
-PRINT	;Queue point for report
-	;loop through the 120.85 file and look for the field that 
-	D NOW^%DTC S GMRADPDT=X
-	S GMRADATE=GMAST-.0001,GMRAPG=1
-	K ^TMP($J,"GMRAPST3A")
-	S GMRATOT=0
-	F  S GMRADATE=$O(^GMR(120.85,"B",GMRADATE)) Q:GMRADATE<1  Q:GMRADATE>GMAEN  D
-	.S GMRAPA1=0 F  S GMRAPA1=$O(^GMR(120.85,"B",GMRADATE,GMRAPA1)) Q:GMRAPA1<1  D
-	..S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0)) Q:GMRAPA1(0)=""  ;Bad Node
-	..Q:+$G(^GMR(120.8,$P(GMRAPA1(0),U,15),"ER"))  ;Entered in error data
-	..Q:'$$PRDTST^GMRAUTL1($P(GMRAPA1(0),U,2))  ;GMRA*4*33 Exclude test patient from report if production or legacy environment.
-	..S GMRATOT=GMRATOT+1
-	..S GMRAPA=$P(GMRAPA1(0),U,15) Q:'GMRAPA
-	..S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""
-	..S GMRAREC=$P(GMRAPA(0),U,2)
-	..S ^TMP($J,"GMRAPST3A",GMRAREC)=$G(^TMP($J,"GMRAPST3A",GMRAREC))+1
-	..Q
-	.Q
-	Q:GMRAOUT
-	Q:'$D(^TMP($J,"GMRAPST3A"))
-	K ^TMP($J,"GMRAPST3B")
-	S GMRAREC=""
-	F  S GMRAREC=$O(^TMP($J,"GMRAPST3A",GMRAREC)) Q:GMRAREC=""  D
-	.S GMRARECN=$G(^TMP($J,"GMRAPST3A",GMRAREC)) Q:GMRARECN=""
-	.S ^TMP($J,"GMRAPST3B",GMRARECN,GMRAREC)=""
-	.Q
-	D HEAD
-	S GMRARECN=""
-	F  S GMRARECN=$O(^TMP($J,"GMRAPST3B",GMRARECN),-1) Q:GMRARECN<1  D  Q:GMRAOUT
-	.S GMRAREC=""
-	.F  S GMRAREC=$O(^TMP($J,"GMRAPST3B",GMRARECN,GMRAREC)) Q:GMRAREC=""  D  Q:GMRAOUT
-	..S GMRATAB=30-$L($E(GMRAREC,1,30))
-	..W !,?GMRATAB,$E(GMRAREC,1,30)," :",$J(GMRARECN,5)
-	..D HEAD Q:GMRAOUT
-	..Q
-	.Q
-	W !!,?22,"Total number of records processed ",GMRATOT
-	D CLOSE^GMRAUTL
-	Q
-	;has the patient died within the date
-HEAD	; Print header information
-	I GMRAPG'=1  Q:$Y<(IOSL-4)
-	I $E(IOST,1)="C" D  Q:GMRAOUT
-	.I GMRAPG=1 W @IOF Q
-	.I GMRAPG'=1 D  Q:GMRAOUT
-	..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1
-	..K Y
-	..Q
-	.Q
-	Q:GMRAOUT
-	I GMRAPG'=1 W @IOF
-	W "Report Date: ",$P($$FMTE^XLFDT(GMRADPDT),"@"),?70,"Page: ",GMRAPG
-	W !,?20,"Frequency Distribution of Causative Agents"
-	W !,?25,"From: ",$$FMTE^XLFDT(GMAST,"2D")," To: ",$$FMTE^XLFDT(GMAEN,"2D")
-	W !,"Causative Agents",?34,"Number"
-	W !,$$REPEAT^XLFSTR("-",79)
-	S GMRAPG=GMRAPG+1
-	I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user
-	Q
+GMRAPST3 ;HIRMFO/WAA- PRINT FREQUENCY OF DIST OVR DT BY REACT ;3/5/97  15:14
+ ;;4.0;Adverse Reaction Tracking;**7**;Mar 29, 1996
+EN1 ; This routine will loop through the ADT entry point to get all
+ ; the entries in that date range.
+ S GMRAOUT=0
+ W !,"Select an Observed date range for this report."
+ D DT^GMRAPL G:GMRAOUT EXIT
+ D PRINTER
+EXIT ; Exit of program kill cleanup
+ D KILL^XUSCLEAN
+ K ^TMP($J,"GMRAPST3B")
+ K ^TMP($J,"GMRAPST3A")
+ Q
+PRINTER ;Select printer
+ W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q
+ I $D(IO("Q")) D  Q
+ . S ZTRTN="PRINT^GMRAPST3",(ZTSAVE("GMRAOUT"),ZTSAVE("GMAST"),ZTSAVE("GMAEN"))=""
+ . S ZTDESC="Frequency Distribution of Causative Agents" D ^%ZTLOAD
+ . W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try Later.")
+ . Q
+ U IO D PRINT U IO(0)
+ Q
+PRINT ;Queue point for report
+ ;loop through the 120.85 file and look for the field that 
+ D NOW^%DTC S GMRADPDT=X
+ S GMRADATE=GMAST-.0001,GMRAPG=1
+ K ^TMP($J,"GMRAPST3A")
+ S GMRATOT=0
+ F  S GMRADATE=$O(^GMR(120.85,"B",GMRADATE)) Q:GMRADATE<1  Q:GMRADATE>GMAEN  D
+ .S GMRAPA1=0 F  S GMRAPA1=$O(^GMR(120.85,"B",GMRADATE,GMRAPA1)) Q:GMRAPA1<1  D
+ ..S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0)) Q:GMRAPA1(0)=""  ;Bad Node
+ ..Q:+$G(^GMR(120.8,$P(GMRAPA1(0),U,15),"ER"))  ;Entered in error data
+ ..S GMRATOT=GMRATOT+1
+ ..S GMRAPA=$P(GMRAPA1(0),U,15) Q:'GMRAPA
+ ..S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""
+ ..S GMRAREC=$P(GMRAPA(0),U,2)
+ ..S ^TMP($J,"GMRAPST3A",GMRAREC)=$G(^TMP($J,"GMRAPST3A",GMRAREC))+1
+ ..Q
+ .Q
+ Q:GMRAOUT
+ Q:'$D(^TMP($J,"GMRAPST3A"))
+ K ^TMP($J,"GMRAPST3B")
+ S GMRAREC=""
+ F  S GMRAREC=$O(^TMP($J,"GMRAPST3A",GMRAREC)) Q:GMRAREC=""  D
+ .S GMRARECN=$G(^TMP($J,"GMRAPST3A",GMRAREC)) Q:GMRARECN=""
+ .S ^TMP($J,"GMRAPST3B",GMRARECN,GMRAREC)=""
+ .Q
+ D HEAD
+ S GMRARECN=""
+ F  S GMRARECN=$O(^TMP($J,"GMRAPST3B",GMRARECN),-1) Q:GMRARECN<1  D  Q:GMRAOUT
+ .S GMRAREC=""
+ .F  S GMRAREC=$O(^TMP($J,"GMRAPST3B",GMRARECN,GMRAREC)) Q:GMRAREC=""  D  Q:GMRAOUT
+ ..S GMRATAB=30-$L($E(GMRAREC,1,30))
+ ..W !,?GMRATAB,$E(GMRAREC,1,30)," :",$J(GMRARECN,5)
+ ..D HEAD Q:GMRAOUT
+ ..Q
+ .Q
+ W !!,?22,"Total number of records processed ",GMRATOT
+ D CLOSE^GMRAUTL
+ Q
+ ;has the patient died with inthe dat
+HEAD ; Print header information
+ I GMRAPG'=1  Q:$Y<(IOSL-4)
+ I $E(IOST,1)="C" D  Q:GMRAOUT
+ .I GMRAPG=1 W @IOF Q
+ .I GMRAPG'=1 D  Q:GMRAOUT
+ ..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1
+ ..K Y
+ ..Q
+ .Q
+ Q:GMRAOUT
+ I GMRAPG'=1 W @IOF
+ W "Report Date: ",$P($$FMTE^XLFDT(GMRADPDT),"@"),?70,"Page: ",GMRAPG
+ W !,?20,"Frequency Distribution of Causative Agents"
+ W !,?25,"From: ",$$FMTE^XLFDT(GMAST,"2D")," To: ",$$FMTE^XLFDT(GMAEN,"2D")
+ W !,"Causative Agents",?34,"Number"
+ W !,$$REPEAT^XLFSTR("-",79)
+ S GMRAPG=GMRAPG+1
+ I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user
+ Q
Index: WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPST4.m
===================================================================
--- WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPST4.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPST4.m	(revision 623)
@@ -1,83 +1,82 @@
-GMRAPST4	;HIRMFO/WAA- PRINT FREQUENCY OF DIST OVR DT BY DC ;3/5/97  15:15
-	;;4.0;Adverse Reaction Tracking;**7,33**;Mar 29, 1996;Build 5
-EN1	; This routine will loop through the ADT entry point to get all
-	; the entries in that date range.
-	S GMRAOUT=0
-	W !,"Select an Observed date range for this report."
-	D DT^GMRAPL G:GMRAOUT EXIT
-	D PRINTER
-EXIT	; Exit of program kill cleanup
-	K ^TMP($J,"GMRAPST4")
-	D KILL^XUSCLEAN
-	Q
-PRINTER	;Select printer
-	W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q
-	I $D(IO("Q")) D  Q
-	. S ZTRTN="PRINT^GMRAPST4",(ZTSAVE("GMRAOUT"),ZTSAVE("GMAST"),ZTSAVE("GMAEN"))=""
-	. S ZTDESC="Frequency Distribution of Drug Classes" D ^%ZTLOAD
-	. W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try Later.")
-	. Q
-	U IO D PRINT U IO(0)
-	Q
-PRINT	;Queue point for report
-	;loop through the 120.85 file and look for the field that 
-	D NOW^%DTC S GMRADPDT=X
-	S GMRADATE=GMAST-.0001,GMRAPG=1
-	K ^TMP($J,"GMRAPST4")
-	S GMRATOT=0
-	F  S GMRADATE=$O(^GMR(120.85,"B",GMRADATE)) Q:GMRADATE<1  Q:GMRADATE>GMAEN  D
-	.S GMRAPA1=0 F  S GMRAPA1=$O(^GMR(120.85,"B",GMRADATE,GMRAPA1)) Q:GMRAPA1<1  D
-	..S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0)) Q:GMRAPA1(0)=""  ;Bad Node
-	..Q:+$G(^GMR(120.8,$P(GMRAPA1(0),U,15),"ER"))  ;Entered in error data
-	..Q:'$$PRDTST^GMRAUTL1($P(GMRAPA1(0),U,2))  ;GMRA*4*33  Exclude test patient from report if production or legacy environment.
-	..S GMRATOT=GMRATOT+1
-	..S GMRAPA=$P(GMRAPA1(0),U,15) Q:'GMRAPA
-	..S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""
-	..S GMRADC=0
-	..F  S GMRADC=$O(^GMR(120.8,GMRAPA,3,GMRADC)) Q:GMRADC<1  D
-	...S GMRADCN=$P($G(^GMR(120.8,GMRAPA,3,GMRADC,0)),U) Q:GMRADCN=""
-	...S ^TMP($J,"GMRAPST4",GMRADCN)=$G(^TMP($J,"GMRAPST4",GMRADCN))+1
-	...Q
-	..Q
-	.Q
-	Q:GMRAOUT
-	Q:'$D(^TMP($J,"GMRAPST4"))
-	S GMRADCN=0
-	;Sort in value order.
-	F  S GMRADCN=$O(^TMP($J,"GMRAPST4",GMRADCN)) Q:GMRADCN<1  D
-	.S GMRADC=$G(^TMP($J,"GMRAPST4",GMRADCN))  Q:GMRADC<1
-	.S ^TMP($J,"GMRAPST4","B",GMRADC,GMRADCN)=""
-	.Q
-	D HEAD
-	S GMRADC=""
-	F  S GMRADC=$O(^TMP($J,"GMRAPST4","B",GMRADC),-1) Q:GMRADC<1  D  Q:GMRAOUT
-	.S GMRADCN=0
-	.F  S GMRADCN=$O(^TMP($J,"GMRAPST4","B",GMRADC,GMRADCN)) Q:GMRADCN<1  D  Q:GMRAOUT
-	..S GMRADC0=$G(^PS(50.605,GMRADCN,0)) Q:GMRADC0=""
-	..S GMRATAB=30-$L($E($P(GMRADC0,U,2),1,30))
-	..W !,?GMRATAB,$E($P(GMRADC0,U,2),1,30)," (",$P(GMRADC0,U),") :",$J(GMRADC,5)
-	..D HEAD Q:GMRAOUT
-	..Q
-	.Q
-	W !!,?22,"Total number of records processed ",GMRATOT
-	D CLOSE^GMRAUTL
-	Q
-HEAD	; Print header information
-	I GMRAPG'=1  Q:$Y<(IOSL-4)
-	I $E(IOST,1)="C" D  Q:GMRAOUT
-	.I GMRAPG=1 W @IOF Q
-	.I GMRAPG'=1 D  Q:GMRAOUT
-	..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1
-	..K Y
-	..Q
-	.Q
-	Q:GMRAOUT
-	I GMRAPG'=1 W @IOF
-	W "Report Date: ",$P($$FMTE^XLFDT(GMRADPDT),"@"),?70,"Page: ",GMRAPG
-	W !,?20,"Frequency Distribution of Drug Classes"
-	W !,?25,"From: ",$$FMTE^XLFDT(GMAST,"2D")," To: ",$$FMTE^XLFDT(GMAEN,"2D")
-	W !,"Drug Class",?39,"Number"
-	W !,$$REPEAT^XLFSTR("-",79)
-	S GMRAPG=GMRAPG+1
-	I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user
-	Q
+GMRAPST4 ;HIRMFO/WAA- PRINT FREQUENCY OF DIST OVR DT BY DC ;3/5/97  15:15
+ ;;4.0;Adverse Reaction Tracking;**7**;Mar 29, 1996
+EN1 ; This routine will loop through the ADT entry point to get all
+ ; the entries in that date range.
+ S GMRAOUT=0
+ W !,"Select an Observed date range for this report."
+ D DT^GMRAPL G:GMRAOUT EXIT
+ D PRINTER
+EXIT ; Exit of program kill cleanup
+ K ^TMP($J,"GMRAPST4")
+ D KILL^XUSCLEAN
+ Q
+PRINTER ;Select printer
+ W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q
+ I $D(IO("Q")) D  Q
+ . S ZTRTN="PRINT^GMRAPST4",(ZTSAVE("GMRAOUT"),ZTSAVE("GMAST"),ZTSAVE("GMAEN"))=""
+ . S ZTDESC="Frequency Distribution of Drug Classes" D ^%ZTLOAD
+ . W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try Later.")
+ . Q
+ U IO D PRINT U IO(0)
+ Q
+PRINT ;Queue point for report
+ ;loop through the 120.85 file and look for the field that 
+ D NOW^%DTC S GMRADPDT=X
+ S GMRADATE=GMAST-.0001,GMRAPG=1
+ K ^TMP($J,"GMRAPST4")
+ S GMRATOT=0
+ F  S GMRADATE=$O(^GMR(120.85,"B",GMRADATE)) Q:GMRADATE<1  Q:GMRADATE>GMAEN  D
+ .S GMRAPA1=0 F  S GMRAPA1=$O(^GMR(120.85,"B",GMRADATE,GMRAPA1)) Q:GMRAPA1<1  D
+ ..S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0)) Q:GMRAPA1(0)=""  ;Bad Node
+ ..Q:+$G(^GMR(120.8,$P(GMRAPA1(0),U,15),"ER"))  ;Entered in error data
+ ..S GMRATOT=GMRATOT+1
+ ..S GMRAPA=$P(GMRAPA1(0),U,15) Q:'GMRAPA
+ ..S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""
+ ..S GMRADC=0
+ ..F  S GMRADC=$O(^GMR(120.8,GMRAPA,3,GMRADC)) Q:GMRADC<1  D
+ ...S GMRADCN=$P($G(^GMR(120.8,GMRAPA,3,GMRADC,0)),U) Q:GMRADCN=""
+ ...S ^TMP($J,"GMRAPST4",GMRADCN)=$G(^TMP($J,"GMRAPST4",GMRADCN))+1
+ ...Q
+ ..Q
+ .Q
+ Q:GMRAOUT
+ Q:'$D(^TMP($J,"GMRAPST4"))
+ S GMRADCN=0
+ ;Sort in value order.
+ F  S GMRADCN=$O(^TMP($J,"GMRAPST4",GMRADCN)) Q:GMRADCN<1  D
+ .S GMRADC=$G(^TMP($J,"GMRAPST4",GMRADCN))  Q:GMRADC<1
+ .S ^TMP($J,"GMRAPST4","B",GMRADC,GMRADCN)=""
+ .Q
+ D HEAD
+ S GMRADC=""
+ F  S GMRADC=$O(^TMP($J,"GMRAPST4","B",GMRADC),-1) Q:GMRADC<1  D  Q:GMRAOUT
+ .S GMRADCN=0
+ .F  S GMRADCN=$O(^TMP($J,"GMRAPST4","B",GMRADC,GMRADCN)) Q:GMRADCN<1  D  Q:GMRAOUT
+ ..S GMRADC0=$G(^PS(50.605,GMRADCN,0)) Q:GMRADC0=""
+ ..S GMRATAB=30-$L($E($P(GMRADC0,U,2),1,30))
+ ..W !,?GMRATAB,$E($P(GMRADC0,U,2),1,30)," (",$P(GMRADC0,U),") :",$J(GMRADC,5)
+ ..D HEAD Q:GMRAOUT
+ ..Q
+ .Q
+ W !!,?22,"Total number of records processed ",GMRATOT
+ D CLOSE^GMRAUTL
+ Q
+HEAD ; Print header information
+ I GMRAPG'=1  Q:$Y<(IOSL-4)
+ I $E(IOST,1)="C" D  Q:GMRAOUT
+ .I GMRAPG=1 W @IOF Q
+ .I GMRAPG'=1 D  Q:GMRAOUT
+ ..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1
+ ..K Y
+ ..Q
+ .Q
+ Q:GMRAOUT
+ I GMRAPG'=1 W @IOF
+ W "Report Date: ",$P($$FMTE^XLFDT(GMRADPDT),"@"),?70,"Page: ",GMRAPG
+ W !,?20,"Frequency Distribution of Drug Classes"
+ W !,?25,"From: ",$$FMTE^XLFDT(GMAST,"2D")," To: ",$$FMTE^XLFDT(GMAEN,"2D")
+ W !,"Drug Class",?39,"Number"
+ W !,$$REPEAT^XLFSTR("-",79)
+ S GMRAPG=GMRAPG+1
+ I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user
+ Q
Index: WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPST5.m
===================================================================
--- WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPST5.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPST5.m	(revision 623)
@@ -1,57 +1,56 @@
-GMRAPST5	;HIRMFO/WAA- PRINT TOTAL NUMBER OF REPORTED REACTION ;3/5/97  15:16
-	;;4.0;Adverse Reaction Tracking;**7,33**;Mar 29, 1996;Build 5
-EN1	; This routine will loop through the ADT entry point to get all
-	; the entries in that date range.
-	S GMRAOUT=0
-	W !,"Select an Observed date range for this report."
-	D DT^GMRAPL G:GMRAOUT EXIT
-	D PRINTER
-EXIT	; Exit of program kill cleanup
-	D KILL^XUSCLEAN
-	Q
-PRINTER	;Select printer
-	W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q
-	I $D(IO("Q")) D  Q
-	. S ZTRTN="PRINT^GMRAPST5",(ZTSAVE("GMRAOUT"),ZTSAVE("GMAST"),ZTSAVE("GMAEN"))=""
-	. S ZTDESC="Reported Reaction over a date range." D ^%ZTLOAD
-	. W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try Later.")
-	. Q
-	U IO D PRINT U IO(0)
-	Q
-PRINT	;Queue point for report
-	;loop through the 120.85 file and look for the field that 
-	D NOW^%DTC S GMRADPDT=X
-	S GMRADATE=GMAST-.0001,GMRAPG=1
-	S GMRATOT=0
-	F  S GMRADATE=$O(^GMR(120.85,"B",GMRADATE)) Q:GMRADATE<1  Q:GMRADATE>GMAEN  D
-	.S GMRAPA1=0 F  S GMRAPA1=$O(^GMR(120.85,"B",GMRADATE,GMRAPA1)) Q:GMRAPA1<1  D
-	..S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0)) Q:GMRAPA1(0)=""  ;Bad Node
-	..Q:+$G(^GMR(120.8,$P(GMRAPA1(0),U,15),"ER"))  ;Entered in Error Data
-	..Q:'$$PRDTST^GMRAUTL1($P(GMRAPA1(0),U,2))  ;GMRA*4*33  Exclude test patient from report if production or legacy environment.
-	..S GMRATOT=GMRATOT+1
-	..Q
-	.Q
-	Q:GMRAOUT
-	D HEAD
-	W !,?19,"Total Number of Reported Reactions: ",GMRATOT
-	W !,?27,"From: ",$$FMTE^XLFDT(GMAST,"2D"),?42,"To: ",$$FMTE^XLFDT(GMAEN,"2D")
-	D CLOSE^GMRAUTL
-	Q
-	;has the patient died within the date
-HEAD	; Print header information
-	I GMRAPG'=1  Q:$Y<(IOSL-4)
-	I $E(IOST,1)="C" D  Q:GMRAOUT
-	.I GMRAPG=1 W @IOF Q
-	.I GMRAPG'=1 D  Q:GMRAOUT
-	..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1
-	..K Y
-	..Q
-	.Q
-	Q:GMRAOUT
-	I GMRAPG'=1 W @IOF
-	W "Report Date: ",$P($$FMTE^XLFDT(GMRADPDT),"@"),?70,"Page: ",GMRAPG
-	W !,?33,"Reported Reactions"
-	W !,$$REPEAT^XLFSTR("-",79)
-	S GMRAPG=GMRAPG+1
-	I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user
-	Q
+GMRAPST5 ;HIRMFO/WAA- PRINT TOTAL NUMBER OF REPORTED REACTION ;3/5/97  15:16
+ ;;4.0;Adverse Reaction Tracking;**7**;Mar 29, 1996
+EN1 ; This routine will loop through the ADT entry point to get all
+ ; the entries in that date range.
+ S GMRAOUT=0
+ W !,"Select an Observed date range for this report."
+ D DT^GMRAPL G:GMRAOUT EXIT
+ D PRINTER
+EXIT ; Exit of program kill cleanup
+ D KILL^XUSCLEAN
+ Q
+PRINTER ;Select printer
+ W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q
+ I $D(IO("Q")) D  Q
+ . S ZTRTN="PRINT^GMRAPST5",(ZTSAVE("GMRAOUT"),ZTSAVE("GMAST"),ZTSAVE("GMAEN"))=""
+ . S ZTDESC="Reported Reaction over a date range." D ^%ZTLOAD
+ . W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try Later.")
+ . Q
+ U IO D PRINT U IO(0)
+ Q
+PRINT ;Queue point for report
+ ;loop through the 120.85 file and look for the field that 
+ D NOW^%DTC S GMRADPDT=X
+ S GMRADATE=GMAST-.0001,GMRAPG=1
+ S GMRATOT=0
+ F  S GMRADATE=$O(^GMR(120.85,"B",GMRADATE)) Q:GMRADATE<1  Q:GMRADATE>GMAEN  D
+ .S GMRAPA1=0 F  S GMRAPA1=$O(^GMR(120.85,"B",GMRADATE,GMRAPA1)) Q:GMRAPA1<1  D
+ ..S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0)) Q:GMRAPA1(0)=""  ;Bad Node
+ ..Q:+$G(^GMR(120.8,$P(GMRAPA1(0),U,15),"ER"))  ;Entered in Error Data
+ ..S GMRATOT=GMRATOT+1
+ ..Q
+ .Q
+ Q:GMRAOUT
+ D HEAD
+ W !,?19,"Total Number of Reported Reactions: ",GMRATOT
+ W !,?27,"From: ",$$FMTE^XLFDT(GMAST,"2D"),?42,"To: ",$$FMTE^XLFDT(GMAEN,"2D")
+ D CLOSE^GMRAUTL
+ Q
+ ;has the patient died with inthe dat
+HEAD ; Print header information
+ I GMRAPG'=1  Q:$Y<(IOSL-4)
+ I $E(IOST,1)="C" D  Q:GMRAOUT
+ .I GMRAPG=1 W @IOF Q
+ .I GMRAPG'=1 D  Q:GMRAOUT
+ ..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1
+ ..K Y
+ ..Q
+ .Q
+ Q:GMRAOUT
+ I GMRAPG'=1 W @IOF
+ W "Report Date: ",$P($$FMTE^XLFDT(GMRADPDT),"@"),?70,"Page: ",GMRAPG
+ W !,?33,"Reported Reactions"
+ W !,$$REPEAT^XLFSTR("-",79)
+ S GMRAPG=GMRAPG+1
+ I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user
+ Q
Index: WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPST6.m
===================================================================
--- WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPST6.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPST6.m	(revision 623)
@@ -1,96 +1,95 @@
-GMRAPST6	;HIRMFO/WAA- ADR OUTCOME REPORT ;3/5/97  15:16
-	;;4.0;Adverse Reaction Tracking;**7,33**;Mar 29, 1996;Build 5
-EN1	; This routine will loop through the ADT entry point to get all
-	; the entries in that date range.
-	S GMRAOUT=0
-	W !,"Select an Observed date range for this report."
-	D DT^GMRAPL G:GMRAOUT EXIT
-	D PRINTER
-EXIT	; Exit of program kill cleanup
-	D KILL^XUSCLEAN
-	K ^TMP($J,"GMRAPST6")
-	Q
-PRINTER	;Select printer
-	W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q
-	I $D(IO("Q")) D  Q
-	. S ZTRTN="PRINT^GMRAPST6",(ZTSAVE("GMRAOUT"),ZTSAVE("GMAST"),ZTSAVE("GMAEN"))=""
-	. S ZTDESC="P&T Committee ADR Outcome Report" D ^%ZTLOAD
-	. W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try Later.")
-	. Q
-	U IO D PRINT U IO(0)
-	Q
-PRINT	;Queue point for report
-	;loop through the 120.85 file and look for the field that 
-	K ^TMP($J,"GMRAPST6")
-	D NOW^%DTC S GMRADPDT=X
-	S GMRADATE=GMAST-.0001,GMRAPG=1
-	F  S GMRADATE=$O(^GMR(120.85,"B",GMRADATE)) Q:GMRADATE<1  Q:GMRADATE>GMAEN  D
-	.S GMRAPA1=0 F  S GMRAPA1=$O(^GMR(120.85,"B",GMRADATE,GMRAPA1)) Q:GMRAPA1<1  D
-	..S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0)) Q:GMRAPA1(0)=""  ;Bad Node
-	..S GMRADDT=$P(GMRAPA1(0),U) ; reaction date
-	..S GMRAPA=$P(GMRAPA1(0),U,15) ; Get the 120.8 entry for this reaction in 120.85
-	..S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""  ; Bad node
-	..Q:+$G(^GMR(120.8,GMRAPA,"ER"))  ;entered in error data
-	..S GMRACA=$P(GMRAPA(0),U,2) ; Causative Agent
-	..S DFN=$P(GMRAPA(0),U),GMRACA=$E(GMRACA,1,22)_"-"_$E($P(^DPT(DFN,0),U),1)_$E($P(^(0),U,9),6,9)
-	..Q:'$$PRDTST^GMRAUTL1(DFN)  ;GMRA*4*33 Exclude test patients if production or legacy environment.
-	..S ^TMP($J,"GMRAPST6",GMRADDT,GMRACA,GMRAPA1)=""
-	..Q
-	.Q
-	Q:GMRAOUT
-	I '$D(^TMP($J,"GMRAPST6")) D HEAD W !,"NO DATA FOR THIS REPORT..." Q
-	S GMRAOTH=$G(GMRAOTH,$O(^GMRD(120.83,"B","OTHER REACTION",0)))
-	S GMRADDT=0
-	F  S GMRADDT=$O(^TMP($J,"GMRAPST6",GMRADDT)) Q:GMRADDT<1  D  Q:GMRAOUT
-	.S GMRACA=""
-	.F  S GMRACA=$O(^TMP($J,"GMRAPST6",GMRADDT,GMRACA)) Q:GMRACA=""  D  Q:GMRAOUT
-	..S GMRAPA1=0
-	..F  S GMRAPA1=$O(^TMP($J,"GMRAPST6",GMRADDT,GMRACA,GMRAPA1)) Q:GMRAPA1<1  D  Q:GMRAOUT
-	...S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0))
-	...Q:GMRAPA(0)=""
-	...D HEAD Q:GMRAOUT
-	...W !,$J($$FMTE^XLFDT(GMRADDT,"2D"),8) ; Obs Date
-	...W ?8,"|",GMRACA ; Causative Agent
-	...W ?38,"|"
-	...S GMRAREC=0
-	...S GMRAREC=$O(^GMR(120.85,GMRAPA1,2,0)) D:GMRAREC>0 SIGN("0",GMRAREC)
-	...W ?58,"|" W:$P(GMRAPA1(0),U,4)="y" " Y" ; Req Tx with Rx
-	...W ?63,"|" W:$P(GMRAPA1(0),U,7)="y" " Y" ; Req Hosp.
-	...W ?68,"|" W:$P(GMRAPA1(0),U,10)="y" " Y" ; Disability
-	...W ?73,"|" W:$P(GMRAPA1(0),U,3)="y" " Y" ; Death
-	...F  S GMRAREC=$O(^GMR(120.85,GMRAPA1,2,GMRAREC)) Q:GMRAREC<1  D SIGN("1",GMRAREC) Q:GMRAOUT
-	...Q:GMRAOUT
-	...D HEAD Q:GMRAOUT  W !,?8,"|",?38,"|",?58,"|",?63,"|",?68,"|",?73,"|"
-	...Q
-	..Q
-	.Q
-	D CLOSE^GMRAUTL
-	Q
-SIGN(CNT,GMRAREC)	; Print Sign/Symptoms
-	N NAM,Y
-	S Y=$G(^GMR(120.85,GMRAPA1,2,GMRAREC,0))
-	S NAM=$S(+Y=GMRAOTH:$P(Y,U,2),$D(^GMRD(120.83,+Y,0)):$P(^GMRD(120.83,+Y,0),U),1:"")
-	I 'CNT W $E(NAM,1,19)
-	E  D HEAD Q:GMRAOUT  W !,?8,"|",?38,"|",$E(NAM,1,19),?58,"|",?63,"|",?68,"|",?73,"|"
-	Q
-HEAD	; Print header information
-	I GMRAPG'=1  Q:$Y<(IOSL-4)
-	I $E(IOST,1)="C" D  Q:GMRAOUT
-	.I GMRAPG=1 W @IOF Q
-	.I GMRAPG'=1 D  Q:GMRAOUT
-	..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1
-	..K Y
-	..Q
-	.Q
-	Q:GMRAOUT
-	I GMRAPG'=1 W @IOF
-	W "Report Date: ",$P($$FMTE^XLFDT(GMRADPDT),"@"),?70,"Page: ",GMRAPG
-	W !,?22,"P&T Committee ADR Outcome Report"
-	W !,?25,"From: ",$$FMTE^XLFDT(GMAST,"2D")," To: ",$$FMTE^XLFDT(GMAEN,"2D")
-	W !,$$REPEAT^XLFSTR("-",79)
-	W !,"Obsv.",?8,"|",?38,"|",?58,"|Req.",?63,"|Req.",?68,"|",?73,"|"
-	W !,"Date",?8,"|Causative agent-Pat. ID",?38,"|Sign/Symptoms",?58,"|Tx",?63,"|Hosp",?68,"|Dis.",?73,"|Death"
-	W !,$$REPEAT^XLFSTR("-",79)
-	S GMRAPG=GMRAPG+1
-	I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user
-	Q
+GMRAPST6 ;HIRMFO/WAA- ADR OUTCOME REPORT ;3/5/97  15:16
+ ;;4.0;Adverse Reaction Tracking;**7**;Mar 29, 1996
+EN1 ; This routine will loop through the ADT entry point to get all
+ ; the entries in that date range.
+ S GMRAOUT=0
+ W !,"Select an Observed date range for this report."
+ D DT^GMRAPL G:GMRAOUT EXIT
+ D PRINTER
+EXIT ; Exit of program kill cleanup
+ D KILL^XUSCLEAN
+ K ^TMP($J,"GMRAPST6")
+ Q
+PRINTER ;Select printer
+ W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q
+ I $D(IO("Q")) D  Q
+ . S ZTRTN="PRINT^GMRAPST6",(ZTSAVE("GMRAOUT"),ZTSAVE("GMAST"),ZTSAVE("GMAEN"))=""
+ . S ZTDESC="P&T Committee ADR Outcome Report" D ^%ZTLOAD
+ . W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try Later.")
+ . Q
+ U IO D PRINT U IO(0)
+ Q
+PRINT ;Queue point for report
+ ;loop through the 120.85 file and look for the field that 
+ K ^TMP($J,"GMRAPST6")
+ D NOW^%DTC S GMRADPDT=X
+ S GMRADATE=GMAST-.0001,GMRAPG=1
+ F  S GMRADATE=$O(^GMR(120.85,"B",GMRADATE)) Q:GMRADATE<1  Q:GMRADATE>GMAEN  D
+ .S GMRAPA1=0 F  S GMRAPA1=$O(^GMR(120.85,"B",GMRADATE,GMRAPA1)) Q:GMRAPA1<1  D
+ ..S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0)) Q:GMRAPA1(0)=""  ;Bad Node
+ ..S GMRADDT=$P(GMRAPA1(0),U) ; reaction date
+ ..S GMRAPA=$P(GMRAPA1(0),U,15) ; Get the 120.8 entry for this reaction in 120.85
+ ..S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""  ; Bad node
+ ..Q:+$G(^GMR(120.8,GMRAPA,"ER"))  ;entered in error data
+ ..S GMRACA=$P(GMRAPA(0),U,2) ; Causative Agent
+ ..S DFN=$P(GMRAPA(0),U),GMRACA=$E(GMRACA,1,22)_"-"_$E($P(^DPT(DFN,0),U),1)_$E($P(^(0),U,9),6,9)
+ ..S ^TMP($J,"GMRAPST6",GMRADDT,GMRACA,GMRAPA1)=""
+ ..Q
+ .Q
+ Q:GMRAOUT
+ I '$D(^TMP($J,"GMRAPST6")) D HEAD W !,"NO DATA FOR THIS REPORT..." Q
+ S GMRAOTH=$G(GMRAOTH,$O(^GMRD(120.83,"B","OTHER REACTION",0)))
+ S GMRADDT=0
+ F  S GMRADDT=$O(^TMP($J,"GMRAPST6",GMRADDT)) Q:GMRADDT<1  D  Q:GMRAOUT
+ .S GMRACA=""
+ .F  S GMRACA=$O(^TMP($J,"GMRAPST6",GMRADDT,GMRACA)) Q:GMRACA=""  D  Q:GMRAOUT
+ ..S GMRAPA1=0
+ ..F  S GMRAPA1=$O(^TMP($J,"GMRAPST6",GMRADDT,GMRACA,GMRAPA1)) Q:GMRAPA1<1  D  Q:GMRAOUT
+ ...S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0))
+ ...Q:GMRAPA(0)=""
+ ...D HEAD Q:GMRAOUT
+ ...W !,$J($$FMTE^XLFDT(GMRADDT,"2D"),8) ; Obs Date
+ ...W ?8,"|",GMRACA ; Causative Agent
+ ...W ?38,"|"
+ ...S GMRAREC=0
+ ...S GMRAREC=$O(^GMR(120.85,GMRAPA1,2,0)) D:GMRAREC>0 SIGN("0",GMRAREC)
+ ...W ?58,"|" W:$P(GMRAPA1(0),U,4)="y" " Y" ; Req Tx with Rx
+ ...W ?63,"|" W:$P(GMRAPA1(0),U,7)="y" " Y" ; Req Hosp.
+ ...W ?68,"|" W:$P(GMRAPA1(0),U,10)="y" " Y" ; Disability
+ ...W ?73,"|" W:$P(GMRAPA1(0),U,3)="y" " Y" ; Death
+ ...F  S GMRAREC=$O(^GMR(120.85,GMRAPA1,2,GMRAREC)) Q:GMRAREC<1  D SIGN("1",GMRAREC) Q:GMRAOUT
+ ...Q:GMRAOUT
+ ...D HEAD Q:GMRAOUT  W !,?8,"|",?38,"|",?58,"|",?63,"|",?68,"|",?73,"|"
+ ...Q
+ ..Q
+ .Q
+ D CLOSE^GMRAUTL
+ Q
+SIGN(CNT,GMRAREC) ; Print Sign/Symptoms
+ N NAM,Y
+ S Y=$G(^GMR(120.85,GMRAPA1,2,GMRAREC,0))
+ S NAM=$S(+Y=GMRAOTH:$P(Y,U,2),$D(^GMRD(120.83,+Y,0)):$P(^GMRD(120.83,+Y,0),U),1:"")
+ I 'CNT W $E(NAM,1,19)
+ E  D HEAD Q:GMRAOUT  W !,?8,"|",?38,"|",$E(NAM,1,19),?58,"|",?63,"|",?68,"|",?73,"|"
+ Q
+HEAD ; Print header information
+ I GMRAPG'=1  Q:$Y<(IOSL-4)
+ I $E(IOST,1)="C" D  Q:GMRAOUT
+ .I GMRAPG=1 W @IOF Q
+ .I GMRAPG'=1 D  Q:GMRAOUT
+ ..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1
+ ..K Y
+ ..Q
+ .Q
+ Q:GMRAOUT
+ I GMRAPG'=1 W @IOF
+ W "Report Date: ",$P($$FMTE^XLFDT(GMRADPDT),"@"),?70,"Page: ",GMRAPG
+ W !,?22,"P&T Committee ADR Outcome Report"
+ W !,?25,"From: ",$$FMTE^XLFDT(GMAST,"2D")," To: ",$$FMTE^XLFDT(GMAEN,"2D")
+ W !,$$REPEAT^XLFSTR("-",79)
+ W !,"Obsv.",?8,"|",?38,"|",?58,"|Req.",?63,"|Req.",?68,"|",?73,"|"
+ W !,"Date",?8,"|Causative agent-Pat. ID",?38,"|Sign/Symptoms",?58,"|Tx",?63,"|Hosp",?68,"|Dis.",?73,"|Death"
+ W !,$$REPEAT^XLFSTR("-",79)
+ S GMRAPG=GMRAPG+1
+ I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user
+ Q
Index: WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPST7.m
===================================================================
--- WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPST7.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPST7.m	(revision 623)
@@ -1,112 +1,111 @@
-GMRAPST7	;HIRMFO/WAA- ADVERSE DRUG REACTION REPORT ;3/5/97  15:17
-	;;4.0;Adverse Reaction Tracking;**7,33**;Mar 29, 1996;Build 5
-EN1	; This routine will loop through the ADT entry point to get all
-	; the entries in that date range.
-	S GMRAOUT=0
-	W !,"Select an Observed date range for this report."
-	D DT^GMRAPL G:GMRAOUT EXIT
-	D PRINTER
-EXIT	; Exit of program kill cleanup
-	D KILL^XUSCLEAN
-	K ^TMP($J,"GMRAPST7")
-	Q
-PRINTER	;Select printer
-	W !!,"This report required a 132 column printer."
-	K GMRAZIS S GMRAZIS="M132" D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q
-	I $D(IO("Q")) D  Q
-	. S ZTRTN="PRINT^GMRAPST7",(ZTSAVE("GMRAOUT"),ZTSAVE("GMAST"),ZTSAVE("GMAEN"))=""
-	. S ZTDESC="P&T Committee ADR Report" D ^%ZTLOAD
-	. W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try Later.")
-	. Q
-	U IO D PRINT U IO(0)
-	Q
-PRINT	;Queue point for report
-	;loop through the 120.85 file and look for the field that 
-	K ^TMP($J,"GMRAPST7")
-	D NOW^%DTC S GMRADPDT=X
-	S GMRADATE=GMAST-.0001,GMRAPG=1
-	F  S GMRADATE=$O(^GMR(120.85,"B",GMRADATE)) Q:GMRADATE<1  Q:GMRADATE>GMAEN  D
-	.S GMRAPA1=0 F  S GMRAPA1=$O(^GMR(120.85,"B",GMRADATE,GMRAPA1)) Q:GMRAPA1<1  D
-	..S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0)) Q:GMRAPA1(0)=""  ;Bad Node
-	..S GMRADDT=$P(GMRAPA1(0),U) ; reaction date
-	..S GMRAPA=$P(GMRAPA1(0),U,15) ; Get the 120.8 entry for this reaction in 120.85
-	..S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""  ; Bad node
-	..Q:+$G(^GMR(120.8,GMRAPA,"ER"))  ;Entered in error data
-	..S GMRACA=$P(GMRAPA(0),U,2) ; Causative Agent
-	..S DFN=$P(GMRAPA(0),U),GMRACA=$E(GMRACA,1,22)_"-"_$E($P(^DPT(DFN,0),U),1)_$E($P(^(0),U,9),6,9)
-	..Q:'$$PRDTST^GMRAUTL1(DFN)  ;GMRA*4*33 Exclude test patients from report if production or legacy environment.
-	..S ^TMP($J,"GMRAPST7",GMRADDT,GMRACA,GMRAPA1)=GMRAPA
-	..Q
-	.Q
-	Q:GMRAOUT
-	I '$D(^TMP($J,"GMRAPST7")) D HEAD W !,"NO DATA FOR THIS REPORT..." Q
-	S GMRAOTH=$G(GMRAOTH,$O(^GMRD(120.83,"B","OTHER REACTION",0)))
-	S GMRADDT=0
-	F  S GMRADDT=$O(^TMP($J,"GMRAPST7",GMRADDT)) Q:GMRADDT<1  D  Q:GMRAOUT
-	.S GMRACA=""
-	.F  S GMRACA=$O(^TMP($J,"GMRAPST7",GMRADDT,GMRACA)) Q:GMRACA=""  D  Q:GMRAOUT
-	..S GMRAPA1=0
-	..F  S GMRAPA1=$O(^TMP($J,"GMRAPST7",GMRADDT,GMRACA,GMRAPA1)) Q:GMRAPA1<1  D  Q:GMRAOUT
-	...S GMRAPA=$G(^TMP($J,"GMRAPST7",GMRADDT,GMRACA,GMRAPA1))
-	...Q:GMRAPA=""
-	...S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0))
-	...Q:GMRAPA1(0)=""
-	...S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0))
-	...Q:GMRAPA(0)=""
-	...D HEAD Q:GMRAOUT
-	...W !,$J($$FMTE^XLFDT(GMRADDT,"2D"),8) ; Obs Date
-	...W ?8,"|",GMRACA ; Causative Agent
-	...W ?38,"|"
-	...S GMRAREC=0
-	...S GMRAREC=$O(^GMR(120.85,GMRAPA1,2,0)) D:GMRAREC>0 SIGN("0",GMRAREC)
-	...W ?58,"| " W $P(GMRAPA(0),U,14) ; Mechanism
-	...W ?63,"|" W $S($P(GMRAPA1(0),U,14)=1:"MILD",$P(GMRAPA1(0),U,14)=2:"MOD.",$P(GMRAPA1(0),U,14)=3:"SVR.",1:"") ; Severity
-	...W ?68,"|"
-	...K ^TMP($J,"GMRAWORD") D WORD^GMRAWORD(GMRAPA,"OVE",60)
-	...S GMRACNT=1 W $G(^TMP($J,"GMRAWORD",GMRACNT))
-	...F  S GMRAREC=$O(^GMR(120.85,GMRAPA1,2,GMRAREC)) Q:GMRAREC<1  D SIGN("1",GMRAREC) Q:GMRAOUT
-	...F  S GMRACNT=$O(^TMP($J,"GMRAWORD",GMRACNT)) Q:GMRACNT<1  D  Q:GMRAOUT
-	....D HEAD Q:GMRAOUT  W !,?8,"|",?38,"|",?58,"|",?63,"|",?68,"|"
-	....Q:GMRAOUT
-	....W $G(^TMP($J,"GMRAWORD",GMRACNT))
-	....Q
-	...K ^TMP($J,"GMRAWORD")
-	...Q:GMRAOUT
-	...D HEAD Q:GMRAOUT  W !,?8,"|",?38,"|",?58,"|",?63,"|",?68,"|"
-	...Q
-	..Q
-	.Q
-	D CLOSE^GMRAUTL
-	Q
-SIGN(CNT,GMRAREC)	; Print Sign/Symptoms
-	N NAM,Y
-	S Y=$G(^GMR(120.85,GMRAPA1,2,GMRAREC,0))
-	S NAM=$S(+Y=GMRAOTH:$P(Y,U,2),$D(^GMRD(120.83,+Y,0)):$P(^GMRD(120.83,+Y,0),U),1:"")
-	I 'CNT W $E(NAM,1,19)
-	E  D
-	.D HEAD Q:GMRAOUT  W !,?8,"|",?38,"|",$E(NAM,1,19),?58,"|",?63,"|",?68,"|"
-	.I $D(^TMP($J,"GMRAWORD",(GMRACNT+1))) S GMRACNT=GMRACNT+1 W $G(^TMP($J,"GMRAWORD",GMRACNT))
-	.Q
-	Q
-HEAD	; Print header information
-	I GMRAPG'=1  Q:$Y<(IOSL-4)
-	I $E(IOST,1)="C" D  Q:GMRAOUT
-	.I GMRAPG=1 W @IOF Q
-	.I GMRAPG'=1 D  Q:GMRAOUT
-	..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1
-	..K Y
-	..Q
-	.Q
-	Q:GMRAOUT
-	I GMRAPG'=1 W @IOF
-	N Z
-	W "Report Date: ",$P($$FMTE^XLFDT(GMRADPDT),"@"),?125,"Page: ",GMRAPG
-	W !,?48,"P&T Committee ADR Report"
-	W !,?51,"From: ",$$FMTE^XLFDT(GMAST,"2D")," To: ",$$FMTE^XLFDT(GMAEN,"2D")
-	W !,$$REPEAT^XLFSTR("-",130)
-	W !,"Obsv.",?8,"|",?38,"|",?58,"|ADR",?63,"|ADR",?68,"|"
-	W !,"Date",?8,"|Causative agent-Pat. ID",?38,"|Sign/Symptoms",?58,"|Mech",?63,"|Svr.",?68,"|Comments"
-	W !,$$REPEAT^XLFSTR("-",130)
-	S GMRAPG=GMRAPG+1
-	I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user
-	Q
+GMRAPST7 ;HIRMFO/WAA- ADVERSE DRUG REACTION REPORT ;3/5/97  15:17
+ ;;4.0;Adverse Reaction Tracking;**7**;Mar 29, 1996
+EN1 ; This routine will loop through the ADT entry point to get all
+ ; the entries in that date range.
+ S GMRAOUT=0
+ W !,"Select an Observed date range for this report."
+ D DT^GMRAPL G:GMRAOUT EXIT
+ D PRINTER
+EXIT ; Exit of program kill cleanup
+ D KILL^XUSCLEAN
+ K ^TMP($J,"GMRAPST7")
+ Q
+PRINTER ;Select printer
+ W !!,"This report required a 132 column printer."
+ K GMRAZIS S GMRAZIS="M132" D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q
+ I $D(IO("Q")) D  Q
+ . S ZTRTN="PRINT^GMRAPST7",(ZTSAVE("GMRAOUT"),ZTSAVE("GMAST"),ZTSAVE("GMAEN"))=""
+ . S ZTDESC="P&T Committee ADR Report" D ^%ZTLOAD
+ . W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try Later.")
+ . Q
+ U IO D PRINT U IO(0)
+ Q
+PRINT ;Queue point for report
+ ;loop through the 120.85 file and look for the field that 
+ K ^TMP($J,"GMRAPST7")
+ D NOW^%DTC S GMRADPDT=X
+ S GMRADATE=GMAST-.0001,GMRAPG=1
+ F  S GMRADATE=$O(^GMR(120.85,"B",GMRADATE)) Q:GMRADATE<1  Q:GMRADATE>GMAEN  D
+ .S GMRAPA1=0 F  S GMRAPA1=$O(^GMR(120.85,"B",GMRADATE,GMRAPA1)) Q:GMRAPA1<1  D
+ ..S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0)) Q:GMRAPA1(0)=""  ;Bad Node
+ ..S GMRADDT=$P(GMRAPA1(0),U) ; reaction date
+ ..S GMRAPA=$P(GMRAPA1(0),U,15) ; Get the 120.8 entry for this reaction in 120.85
+ ..S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""  ; Bad node
+ ..Q:+$G(^GMR(120.8,GMRAPA,"ER"))  ;Entered in error data
+ ..S GMRACA=$P(GMRAPA(0),U,2) ; Causative Agent
+ ..S DFN=$P(GMRAPA(0),U),GMRACA=$E(GMRACA,1,22)_"-"_$E($P(^DPT(DFN,0),U),1)_$E($P(^(0),U,9),6,9)
+ ..S ^TMP($J,"GMRAPST7",GMRADDT,GMRACA,GMRAPA1)=GMRAPA
+ ..Q
+ .Q
+ Q:GMRAOUT
+ I '$D(^TMP($J,"GMRAPST7")) D HEAD W !,"NO DATA FOR THIS REPORT..." Q
+ S GMRAOTH=$G(GMRAOTH,$O(^GMRD(120.83,"B","OTHER REACTION",0)))
+ S GMRADDT=0
+ F  S GMRADDT=$O(^TMP($J,"GMRAPST7",GMRADDT)) Q:GMRADDT<1  D  Q:GMRAOUT
+ .S GMRACA=""
+ .F  S GMRACA=$O(^TMP($J,"GMRAPST7",GMRADDT,GMRACA)) Q:GMRACA=""  D  Q:GMRAOUT
+ ..S GMRAPA1=0
+ ..F  S GMRAPA1=$O(^TMP($J,"GMRAPST7",GMRADDT,GMRACA,GMRAPA1)) Q:GMRAPA1<1  D  Q:GMRAOUT
+ ...S GMRAPA=$G(^TMP($J,"GMRAPST7",GMRADDT,GMRACA,GMRAPA1))
+ ...Q:GMRAPA=""
+ ...S GMRAPA1(0)=$G(^GMR(120.85,GMRAPA1,0))
+ ...Q:GMRAPA1(0)=""
+ ...S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0))
+ ...Q:GMRAPA(0)=""
+ ...D HEAD Q:GMRAOUT
+ ...W !,$J($$FMTE^XLFDT(GMRADDT,"2D"),8) ; Obs Date
+ ...W ?8,"|",GMRACA ; Causative Agent
+ ...W ?38,"|"
+ ...S GMRAREC=0
+ ...S GMRAREC=$O(^GMR(120.85,GMRAPA1,2,0)) D:GMRAREC>0 SIGN("0",GMRAREC)
+ ...W ?58,"| " W $P(GMRAPA(0),U,14) ; Mechanism
+ ...W ?63,"|" W $S($P(GMRAPA1(0),U,14)=1:"MILD",$P(GMRAPA1(0),U,14)=2:"MOD.",$P(GMRAPA1(0),U,14)=3:"SVR.",1:"") ; Severity
+ ...W ?68,"|"
+ ...K ^TMP($J,"GMRAWORD") D WORD^GMRAWORD(GMRAPA,"OVE",60)
+ ...S GMRACNT=1 W $G(^TMP($J,"GMRAWORD",GMRACNT))
+ ...F  S GMRAREC=$O(^GMR(120.85,GMRAPA1,2,GMRAREC)) Q:GMRAREC<1  D SIGN("1",GMRAREC) Q:GMRAOUT
+ ...F  S GMRACNT=$O(^TMP($J,"GMRAWORD",GMRACNT)) Q:GMRACNT<1  D  Q:GMRAOUT
+ ....D HEAD Q:GMRAOUT  W !,?8,"|",?38,"|",?58,"|",?63,"|",?68,"|"
+ ....Q:GMRAOUT
+ ....W $G(^TMP($J,"GMRAWORD",GMRACNT))
+ ....Q
+ ...K ^TMP($J,"GMRAWORD")
+ ...Q:GMRAOUT
+ ...D HEAD Q:GMRAOUT  W !,?8,"|",?38,"|",?58,"|",?63,"|",?68,"|"
+ ...Q
+ ..Q
+ .Q
+ D CLOSE^GMRAUTL
+ Q
+SIGN(CNT,GMRAREC) ; Print Sign/Symptoms
+ N NAM,Y
+ S Y=$G(^GMR(120.85,GMRAPA1,2,GMRAREC,0))
+ S NAM=$S(+Y=GMRAOTH:$P(Y,U,2),$D(^GMRD(120.83,+Y,0)):$P(^GMRD(120.83,+Y,0),U),1:"")
+ I 'CNT W $E(NAM,1,19)
+ E  D
+ .D HEAD Q:GMRAOUT  W !,?8,"|",?38,"|",$E(NAM,1,19),?58,"|",?63,"|",?68,"|"
+ .I $D(^TMP($J,"GMRAWORD",(GMRACNT+1))) S GMRACNT=GMRACNT+1 W $G(^TMP($J,"GMRAWORD",GMRACNT))
+ .Q
+ Q
+HEAD ; Print header information
+ I GMRAPG'=1  Q:$Y<(IOSL-4)
+ I $E(IOST,1)="C" D  Q:GMRAOUT
+ .I GMRAPG=1 W @IOF Q
+ .I GMRAPG'=1 D  Q:GMRAOUT
+ ..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1
+ ..K Y
+ ..Q
+ .Q
+ Q:GMRAOUT
+ I GMRAPG'=1 W @IOF
+ N Z
+ W "Report Date: ",$P($$FMTE^XLFDT(GMRADPDT),"@"),?125,"Page: ",GMRAPG
+ W !,?48,"P&T Committee ADR Report"
+ W !,?51,"From: ",$$FMTE^XLFDT(GMAST,"2D")," To: ",$$FMTE^XLFDT(GMAEN,"2D")
+ W !,$$REPEAT^XLFSTR("-",130)
+ W !,"Obsv.",?8,"|",?38,"|",?58,"|ADR",?63,"|ADR",?68,"|"
+ W !,"Date",?8,"|Causative agent-Pat. ID",?38,"|Sign/Symptoms",?58,"|Mech",?63,"|Svr.",?68,"|Comments"
+ W !,$$REPEAT^XLFSTR("-",130)
+ S GMRAPG=GMRAPG+1
+ I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user
+ Q
Index: WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPU.m
===================================================================
--- WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPU.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAPU.m	(revision 623)
@@ -1,81 +1,80 @@
-GMRAPU	;HIRMFO/WAA- PRINT ALLERGY LIST BY LOCATION UNVERIFIED ;8/27/93
-	;;4.0;Adverse Reaction Tracking;**33**;Mar 29, 1996;Build 5
-EN1	; This routine will loop through the GMRA patient allergy file (120.8)
-	; to find all patients with unverified reactions
-	;
-	S GMRAOUT=0 D PRINTER
-EXIT	; Exit of program kill cleanup
-	D KILL^XUSCLEAN
-	K ^TMP($J,"GMRAPU")
-	Q
-PRINTER	;Select printer
-	W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q
-	I $D(IO("Q")) D  Q
-	. S ZTRTN="PRINT^GMRAPU",ZTSAVE("GMRAOUT")=""
-	. S ZTDESC="List of Unverified Reactions by Ward Location" D ^%ZTLOAD
-	. W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try Later.")
-	. Q
-	U IO D PRINT U IO(0)
-	Q
-PRINT	;Queue point for report
-	K ^TMP($J,"GMRAPU") D FIND
-REPORT	; Print out the report
-	S GMRAOUT=$G(GMRAOUT)
-	S GMALOC="",GMRAPG=1,GMRADATE=$$NOW^XLFDT
-	I '$D(^TMP($J,"GMRAPU")) D HEAD W !,?20,"NO DATA FOR THIS REPORT"
-	F  S GMALOC=$O(^TMP($J,"GMRAPU",GMALOC)) Q:GMALOC=""  D HEAD Q:GMRAOUT  D  Q:GMRAOUT
-	.S GMRANAM="" F  S GMRANAM=$O(^TMP($J,"GMRAPU",GMALOC,GMRANAM)) Q:GMRANAM=""  D  Q:GMRAOUT
-	..S GMADFN=0 F  S GMADFN=$O(^TMP($J,"GMRAPU",GMALOC,GMRANAM,GMADFN)) Q:GMADFN<1  D  Q:GMRAOUT
-	...S GMRASSN="",GMRARB=""
-	...D VAD^GMRAUTL1(GMADFN,"","","","",.GMRASSN,.GMRARB)
-	...W !,GMRARB,$S(GMRARB'="":"  ",1:""),GMRANAM," (",GMRASSN,")"
-	...S GMADT=0 F  S GMADT=$O(^TMP($J,"GMRAPU",GMALOC,GMRANAM,GMADFN,GMADT)) Q:GMADT<1  S GMRAPA=0 F  S GMRAPA=$O(^TMP($J,"GMRAPU",GMALOC,GMRANAM,GMADFN,GMADT,GMRAPA)) Q:GMRAPA<1  D  Q:GMRAOUT
-	....S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0))
-	....Q:GMRAPA(0)=""
-	....W !,?3,$$FMTE^XLFDT(GMADT,"1")
-	....W ?30,$S($P(GMRAPA(0),U,5)'="":$E($P($G(^VA(200,$P(GMRAPA(0),U,5),0)),U),1,24),1:"<None>")
-	....W ?55,$E($P(GMRAPA(0),U,2),1,24)
-	....I $Y>(IOSL-4) D HEAD
-	....Q
-	...Q
-	..Q
-	.Q
-	D CLOSE^GMRAUTL
-	Q
-HEAD	; Print header information
-	I $E(IOST,1)="C" D  Q:GMRAOUT
-	.I GMRAPG=1 W @IOF Q
-	.I GMRAPG'=1 D  Q:GMRAOUT
-	..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1
-	..K Y
-	..Q
-	.Q
-	Q:GMRAOUT
-	I GMRAPG'=1 W @IOF
-	W "Report Date: ",$P($$FMTE^XLFDT(GMRADATE),"@"),?70,"Page: ",GMRAPG
-	W !,?19,"List of Unverified Reactions by Ward Location"
-	W !,?30,"Ward Location: ",GMALOC
-	W !,?3,"Origination Date/Time",?30,"Originator",?55,"Reaction"
-	W !,$$REPEAT^XLFSTR("-",78)
-	S GMRAPG=GMRAPG+1
-	I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user
-	Q
-FIND	; This subroutines will build the data for the report.
-	N GMADFN
-	S GMADFN=0
-	F  S GMADFN=$O(^GMR(120.8,"AVER",GMADFN)) Q:GMADFN<1  D
-	.N GMRALOC,GMRANAM,GMALOC,GMRAPA
-	.S GMRANAM="",GMRALOC=""
-	.Q:'$$PRDTST^GMRAUTL1(GMADFN)  ;GMRA*4*33 Exclude test patients if production or legacy environment.
-	.D VAD^GMRAUTL1(GMADFN,"",.GMRALOC,.GMRANAM,"","","") I GMRALOC="" S GMALOC="OUTPATIENT"
-	.E  S GMALOC=$P($G(^DIC(42,GMRALOC,0)),U)
-	.Q:GMALOC=""
-	.S GMRAPA=0
-	.F  S GMRAPA=$O(^GMR(120.8,"AVER",GMADFN,GMRAPA)) Q:GMRAPA<1  D
-	..N GMADT
-	..S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""
-	..S GMADT=$P(GMRAPA(0),U,4)
-	..S ^TMP($J,"GMRAPU",GMALOC,GMRANAM,GMADFN,GMADT,GMRAPA)=""
-	..Q
-	.Q
-	Q
+GMRAPU ;HIRMFO/WAA- PRINT ALLERGY LIST BY LOCATION UNVERIFIED ; 8/27/93
+ ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996
+EN1 ; This routine will loop through the GMRA patient allergy file (120.8)
+ ; to find all patients with unverified reactions
+ ;
+ S GMRAOUT=0 D PRINTER
+EXIT ; Exit of program kill cleanup
+ D KILL^XUSCLEAN
+ K ^TMP($J,"GMRAPU")
+ Q
+PRINTER ;Select printer
+ W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q
+ I $D(IO("Q")) D  Q
+ . S ZTRTN="PRINT^GMRAPU",ZTSAVE("GMRAOUT")=""
+ . S ZTDESC="List of Unverified Reactions by Ward Location" D ^%ZTLOAD
+ . W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try Later.")
+ . Q
+ U IO D PRINT U IO(0)
+ Q
+PRINT ;Queue point for report
+ K ^TMP($J,"GMRAPU") D FIND
+REPORT ; Print out the report
+ S GMRAOUT=$G(GMRAOUT)
+ S GMALOC="",GMRAPG=1,GMRADATE=$$NOW^XLFDT
+ I '$D(^TMP($J,"GMRAPU")) D HEAD W !,?20,"NO DATA FOR THIS REPORT"
+ F  S GMALOC=$O(^TMP($J,"GMRAPU",GMALOC)) Q:GMALOC=""  D HEAD Q:GMRAOUT  D  Q:GMRAOUT
+ .S GMRANAM="" F  S GMRANAM=$O(^TMP($J,"GMRAPU",GMALOC,GMRANAM)) Q:GMRANAM=""  D  Q:GMRAOUT
+ ..S GMADFN=0 F  S GMADFN=$O(^TMP($J,"GMRAPU",GMALOC,GMRANAM,GMADFN)) Q:GMADFN<1  D  Q:GMRAOUT
+ ...S GMRASSN="",GMRARB=""
+ ...D VAD^GMRAUTL1(GMADFN,"","","","",.GMRASSN,.GMRARB)
+ ...W !,GMRARB,$S(GMRARB'="":"  ",1:""),GMRANAM," (",GMRASSN,")"
+ ...S GMADT=0 F  S GMADT=$O(^TMP($J,"GMRAPU",GMALOC,GMRANAM,GMADFN,GMADT)) Q:GMADT<1  S GMRAPA=0 F  S GMRAPA=$O(^TMP($J,"GMRAPU",GMALOC,GMRANAM,GMADFN,GMADT,GMRAPA)) Q:GMRAPA<1  D  Q:GMRAOUT
+ ....S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0))
+ ....Q:GMRAPA(0)=""
+ ....W !,?3,$$FMTE^XLFDT(GMADT,"1")
+ ....W ?30,$S($P(GMRAPA(0),U,5)'="":$E($P($G(^VA(200,$P(GMRAPA(0),U,5),0)),U),1,24),1:"<None>")
+ ....W ?55,$E($P(GMRAPA(0),U,2),1,24)
+ ....I $Y>(IOSL-4) D HEAD
+ ....Q
+ ...Q
+ ..Q
+ .Q
+ D CLOSE^GMRAUTL
+ Q
+HEAD ; Print header information
+ I $E(IOST,1)="C" D  Q:GMRAOUT
+ .I GMRAPG=1 W @IOF Q
+ .I GMRAPG'=1 D  Q:GMRAOUT
+ ..N DIR S DIR(0)="E" D ^DIR I 'Y S GMRAOUT=1
+ ..K Y
+ ..Q
+ .Q
+ Q:GMRAOUT
+ I GMRAPG'=1 W @IOF
+ W "Report Date: ",$P($$FMTE^XLFDT(GMRADATE),"@"),?70,"Page: ",GMRAPG
+ W !,?19,"List of Unverified Reactions by Ward Location"
+ W !,?30,"Ward Location: ",GMALOC
+ W !,?3,"Origination Date/Time",?30,"Originator",?55,"Reaction"
+ W !,$$REPEAT^XLFSTR("-",78)
+ S GMRAPG=GMRAPG+1
+ I $D(ZTQUEUED) S:$$STPCK^GMRAUTL1 GMRAOUT=1 ; Check if stopped by user
+ Q
+FIND ; This subroutines will build the data for the report.
+ N GMADFN
+ S GMADFN=0
+ F  S GMADFN=$O(^GMR(120.8,"AVER",GMADFN)) Q:GMADFN<1  D
+ .N GMRALOC,GMRANAM,GMALOC,GMRAPA
+ .S GMRANAM="",GMRALOC=""
+ .D VAD^GMRAUTL1(GMADFN,"",.GMRALOC,.GMRANAM,"","","") I GMRALOC="" S GMALOC="OUTPATIENT"
+ .E  S GMALOC=$P($G(^DIC(42,GMRALOC,0)),U)
+ .Q:GMALOC=""
+ .S GMRAPA=0
+ .F  S GMRAPA=$O(^GMR(120.8,"AVER",GMADFN,GMRAPA)) Q:GMRAPA<1  D
+ ..N GMADT
+ ..S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""
+ ..S GMADT=$P(GMRAPA(0),U,4)
+ ..S ^TMP($J,"GMRAPU",GMALOC,GMRANAM,GMADFN,GMADT,GMRAPA)=""
+ ..Q
+ .Q
+ Q
Index: WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAUTL1.m
===================================================================
--- WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAUTL1.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAUTL1.m	(revision 623)
@@ -1,88 +1,74 @@
-GMRAUTL1	;HIRMFO/WAA-ALLERGY UTILITIES ;12/04/92
-	;;4.0;Adverse Reaction Tracking;**33**;Mar 29, 1996;Build 5
-	;
-	; Reference to $$PROD^XUPROD supported by DBIA 4440
-	; Reference to $$TESTPAT^VADPT supported by DBIA 3744
-	; 
-	Q
-STPCK()	; This is to check to see if the user wanted to stop the print
-	S ZTSTOP=0
-	I $$S^%ZTLOAD D
-	.S ZTSTOP=1 K ZTREG W !?10,"*** OUTPUT STOPPED AT USER'S REQUEST ***"
-	.Q
-	Q ZTSTOP
-BR	; This is a online reference card entry point
-	I '$$TEST^DDBRT D  Q
-	.W $C(7)
-	.W !,?20,"Your Terminal cannot display this Reference Card."
-	.W !,?20,"Please contact IRM Service to correct this problem."
-	.Q
-	N X
-	S X=$O(^GMRD(120.87,"B","REFERENCE CARD",0)) Q:X<1
-	D WP^DDBR(120.87,X,1)
-	Q
-PR	; This is a print utility for the reference card for IRM
-	W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q
-	I $D(IO("Q")) D  Q
-	. S ZTRTN="PR1^GMRAUTL1",(ZTSAVE("GMRAOUT"),ZTSAVE("GMAST"),ZTSAVE("GMAEN"))=""
-	. S ZTDESC="Print reference card" D ^%ZTLOAD
-	. W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try Later.")
-	. Q
-	U IO D PR1 U IO(0)
-	Q
-PR1	; Print out the card
-	N GMRAOUT,GMRACD,GMRALN,X
-	I $E(IOST,1)="C" W @IOF
-	S GMRACD=$O(^GMRD(120.87,"B","REFERENCE CARD",0))
-	S (GMRAOUT,GMRALN)=0
-LP1	; Main loop
-	F  S GMRALN=$O(^GMRD(120.87,GMRACD,1,GMRALN)) Q:GMRALN<1  D  Q:GMRAOUT
-	.S X=$G(^GMRD(120.87,GMRACD,1,GMRALN,0))
-	.W !,X
-	.I $Y>(IOSL-4) D
-	..I $E(IOST,1)="C" N DIR,DIRUT,DIROUT,DTOUT,DUOUT S DIR(0)="E" D ^DIR S:$D(DIRUT) GMRAOUT=1 W:'GMRAOUT @IOF Q
-	..W @IOF
-	..Q
-	.Q
-	D CLOSE^GMRAUTL
-	Q
-PRDTST(GMRADFN)	; GMRA*4*33 - Remove Test Patients from Live Reports
-	; This function will return 0 if the patient should not print on the report, and 1 if the patient
-	; should appear on the report.  This function will allow all patients to print on the report if the
-	; report is run in a test environment.
-	;
-	I GMRADFN="" Q 0  ;DFN not defined. Should never be the case.
-	I '$$PROD^XUPROD() Q 1  ;Not a production or legacy environment.  Print all patients on report.
-	I $$TESTPAT^VADPT(GMRADFN) Q 0  ;Production or legacy environment.  Test patient.  Do not print on report.
-	Q 1  ;Production or legacy environment.  Not a test patient.  Print on report.
-	; 
-VAD(DFN,DAT,LOC,NAM,SEX,SSN,RB,PRO,PID)	; Call to VADPT
-	; This call is a generic call to 1^VADPT
-	; Input:
-	; 1     DFN = Patient Internal entry number in the Patient File
-	; 2     DAT = Date for lookup
-	;
-	; Output:
-	; 3     LOC = Hospital Location
-	; 4     NAM = Full Patient name
-	; 5     SEX = Patient SEX
-	; 6     SSN = Patient SSN
-	; 7     RB  = Patient Room Bed
-	; 8     PRO = Patient Provider
-	; 9     PID = Patient ID
-	;
-	S DFN=$G(DFN) Q:DFN=""
-	S VAINDT=$G(DAT) I VAINDT="" K VAINDT
-	D 1^VADPT
-	S LOC=$P(VAIN(4),U),NAM=VADM(1),SEX=VADM(5)
-	S SSN=$P(VADM(2),U,2),RB=VAIN(5),PID=VA("PID")
-	S PRO=$P(VAIN(2),U,2)
-	D KVAR^VADPT K VA,VAROOT
-	Q
-DATE(DATE)	; This Ex-Function will date the date from the DATE
-	; and convert it to the old DD("DD") style format
-	; it returns the answer in DATE
-	N Y
-	S Y=$$FMTE^XLFDT(DATE,1)
-	S DATE=$P(Y," ")_" "_(+$P($P(Y,",")," ",2))_","_$P(Y," ",3)
-	Q DATE
+GMRAUTL1 ;HIRMFO/WAA-ALLERGY UTILITIES ; 12/04/92
+ ;;4.0;Adverse Reaction Tracking;;Mar 29, 1996
+ Q
+STPCK() ; This is to check to see if the user wanted to stop the print
+ S ZTSTOP=0
+ I $$S^%ZTLOAD D
+ .S ZTSTOP=1 K ZTREG W !?10,"*** OUTPUT STOPPED AT USER'S REQUEST ***"
+ .Q
+ Q ZTSTOP
+BR ; This is a online reference card entry point
+ I '$$TEST^DDBRT D  Q
+ .W $C(7)
+ .W !,?20,"Your Terminal cannot display this Reference Card."
+ .W !,?20,"Please contact IRM Service to correct this problem."
+ .Q
+ N X
+ S X=$O(^GMRD(120.87,"B","REFERENCE CARD",0)) Q:X<1
+ D WP^DDBR(120.87,X,1)
+ Q
+PR ; This is a print utility for the reference card for IRM
+ W ! K GMRAZIS D DEV^GMRAUTL I POP W !,"PLEASE TRY LATER" S GMRAOUT=1 Q
+ I $D(IO("Q")) D  Q
+ . S ZTRTN="PR1^GMRAUTL1",(ZTSAVE("GMRAOUT"),ZTSAVE("GMAST"),ZTSAVE("GMAEN"))=""
+ . S ZTDESC="Print reference card" D ^%ZTLOAD
+ . W !!,$S($D(ZTSK):"Request queued...",1:"Request NOT queued please try Later.")
+ . Q
+ U IO D PR1 U IO(0)
+ Q
+PR1 ; Print out the card
+ N GMRAOUT,GMRACD,GMRALN,X
+ I $E(IOST,1)="C" W @IOF
+ S GMRACD=$O(^GMRD(120.87,"B","REFERENCE CARD",0))
+ S (GMRAOUT,GMRALN)=0
+LP1 ; Main loop
+ F  S GMRALN=$O(^GMRD(120.87,GMRACD,1,GMRALN)) Q:GMRALN<1  D  Q:GMRAOUT
+ .S X=$G(^GMRD(120.87,GMRACD,1,GMRALN,0))
+ .W !,X
+ .I $Y>(IOSL-4) D
+ ..I $E(IOST,1)="C" N DIR,DIRUT,DIROUT,DTOUT,DUOUT S DIR(0)="E" D ^DIR S:$D(DIRUT) GMRAOUT=1 W:'GMRAOUT @IOF Q
+ ..W @IOF
+ ..Q
+ .Q
+ D CLOSE^GMRAUTL
+ Q
+VAD(DFN,DAT,LOC,NAM,SEX,SSN,RB,PRO,PID) ; Call to VADPT
+ ; This call is a generic call to 1^VADPT
+ ; Input:
+ ; 1     DFN = Patient Internal entry number in the Patient File
+ ; 2     DAT = Date for lookup
+ ;
+ ; Output:
+ ; 3     LOC = Hospital Location
+ ; 4     NAM = Full Patient name
+ ; 5     SEX = Patient SEX
+ ; 6     SSN = Patient SSN
+ ; 7     RB  = Patient Room Bed
+ ; 8     PRO = Patient Provider
+ ; 9     PID = Patient ID
+ ;
+ S DFN=$G(DFN) Q:DFN=""
+ S VAINDT=$G(DAT) I VAINDT="" K VAINDT
+ D 1^VADPT
+ S LOC=$P(VAIN(4),U),NAM=VADM(1),SEX=VADM(5)
+ S SSN=$P(VADM(2),U,2),RB=VAIN(5),PID=VA("PID")
+ S PRO=$P(VAIN(2),U,2)
+ D KVAR^VADPT K VA,VAROOT
+ Q
+DATE(DATE) ; This Ex-Function will date the date from the DATE
+ ; and convert it to the old DD("DD") style format
+ ; it returns the answer in DATE
+ N Y
+ S Y=$$FMTE^XLFDT(DATE,1)
+ S DATE=$P(Y," ")_" "_(+$P($P(Y,",")," ",2))_","_$P(Y," ",3)
+ Q DATE
Index: WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAVFY.m
===================================================================
--- WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAVFY.m	(revision 613)
+++ WorldVistAEHR/trunk/r/ADVERSE_REACTION_TRACKING-GMRA-GMA/GMRAVFY.m	(revision 623)
@@ -1,33 +1,32 @@
-GMRAVFY	;HIRMFO/WAA,PWC-VERIFY AND SIGN OFF AN AGENT ; 5/23/07 10:32am
-	;;4.0;Adverse Reaction Tracking;**2,33**;Mar 29, 1996;Build 5
-EN1	;This is the main entry point for the verifier option.
-	S GMRAVER=0,GMRADRUG=0
-	I $P(GMRAPA(0),U,20)'["D" S GMRAFLAG=0 G VERIFY
-	S GMRAFLAG=1,GMRADRUG=1
-	I $P(GMRAPA(0),U,6)'="o" G VERIFY
-	I '$D(GMRASITE) D SITE^GMRAUTL S GMRASITE(0)=$G(^GMRD(120.84,GMRASITE,0))
-	I $P(^GMRD(120.84,+GMRASITE,0),U,7)'="y" G VERIFY
-	I $D(^GMR(120.85,"C",GMRAPA)) G VERIFY
-	W !,"Since this Causative Agent is an observed drug reaction and"
-	W !,"FDA Data is required you must enter the Observer information"
-	W !,"prior to verification."
-	G EXIT
-VERIFY	;Verify an agent
-	W !!,"Currently you have verifier access."
-	F  W !,"Would you like to verify this Causative Agent now" S %=1 D YN^DICN Q:%'=0  W !?4,"ANSWER YES IF YOU WOULD LIKE TO VERIFY THIS DATA, ELSE ANSWER NO."
-	S:%=-1 GMRAOUT=1 G EXIT:%'=1 S GMRAVFY=1 W @IOF,! D SITE^GMRAUTL,EN2^GMRAPEV0 K GMRAVFY G:GMRAOUT EXIT
-	I GMRAVER S GMRANAME=$P($G(^DPT(+GMRAPA(0),0)),U),GMRALLER=$P(GMRAPA(0),U,2) K:GMRANAME]""&(GMRALLER]"") ^TMP($J,"GMRADSP",GMRANAME,GMRALLER,GMRAPA) K ^TMP("GMRA",$J)
-	I 'GMRAVER!GMRAOUT G EXIT
-	S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""
-	I '$P(GMRAPA(0),U,12) S DA=GMRAPA,DIE="^GMR(120.8,",DR="15////1" D ^DIE D  ; Execute the event point for this reaction
-	.Q:'$D(GMRAPA)  S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""
-	.N OROLD,DFN,GMRACNT S DFN=$P(GMRAPA(0),U)
-	.D INP^VADPT S X=$O(^ORD(101,"B","GMRA SIGN-OFF ON DATA",0))_";ORD(101," D EN^XQOR:X K VAIN,X
-	.Q
-	S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)),GMRATYPE=$P(GMRAPA(0),U,20)
-	S DA=GMRAPA,DIE="^GMR(120.8,",DR="19////1;20///N;21////"_DUZ D ^DIE D:'GMRAVER EN1^GMRAVAB S GMRAPA(0)=$S($D(^GMR(120.8,GMRAPA,0)):^(0),1:"")
-	I $G(GMRANEW) D  ;send NOTIFICATION bulletin if this is new -- GMRA*4*33
-	. I $P(GMRAPA(0),U,6)="o",GMRATYPE["D" D PTBUL^GMRAROBS
-	I GMRAVER D EN1^GMRAPET0($P(GMRAPA(0),U),GMRAPA,"V",.GMRAOUT) I GMRAOUT S GMRAOUT=0
-Q1	D UNLOCK^GMRAUTL(120.8,GMRAPA)
-EXIT	K GMRAFLAG,DA,DIE,DR,GMRADRUG Q
+GMRAVFY ;HIRMFO/WAA-VERIFY AND SIGN OFF AN AGENT ;12/1/95  16:06
+ ;;4.0;Adverse Reaction Tracking;**2**;Mar 29, 1996
+EN1 ;This is the main entry point for the verifier option.
+ S GMRAVER=0,GMRADRUG=0
+ I $P(GMRAPA(0),U,20)'["D" S GMRAFLAG=0 G VERIFY
+ S GMRAFLAG=1,GMRADRUG=1
+ I $P(GMRAPA(0),U,6)'="o" G VERIFY
+ I '$D(GMRASITE) D SITE^GMRAUTL S GMRASITE(0)=$G(^GMRD(120.84,GMRASITE,0))
+ I $P(^GMRD(120.84,+GMRASITE,0),U,7)'="y" G VERIFY
+ I $D(^GMR(120.85,"C",GMRAPA)) G VERIFY
+ W !,"Since this Causative Agent is an observed drug reaction and"
+ W !,"FDA Data is required you must enter the Observer information"
+ W !,"prior to verification."
+ G EXIT
+VERIFY ;Verify an agent
+ W !!,"Currently you have verifier access."
+ F  W !,"Would you like to verify this Causative Agent now" S %=1 D YN^DICN Q:%'=0  W !?4,"ANSWER YES IF YOU WOULD LIKE TO VERIFY THIS DATA, ELSE ANSWER NO."
+ S:%=-1 GMRAOUT=1 G EXIT:%'=1 S GMRAVFY=1 W @IOF,! D SITE^GMRAUTL,EN2^GMRAPEV0 K GMRAVFY G:GMRAOUT EXIT
+ I GMRAVER S GMRANAME=$P($G(^DPT(+GMRAPA(0),0)),U),GMRALLER=$P(GMRAPA(0),U,2) K:GMRANAME]""&(GMRALLER]"") ^TMP($J,"GMRADSP",GMRANAME,GMRALLER,GMRAPA) K ^TMP("GMRA",$J)
+ I 'GMRAVER!GMRAOUT G EXIT
+ S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""
+ I '$P(GMRAPA(0),U,12) S DA=GMRAPA,DIE="^GMR(120.8,",DR="15////1" D ^DIE D  ; Execute the event point for this reaction
+ .Q:'$D(GMRAPA)  S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)) Q:GMRAPA(0)=""
+ .N OROLD,DFN,GMRACNT S DFN=$P(GMRAPA(0),U)
+ .D INP^VADPT S X=$O(^ORD(101,"B","GMRA SIGN-OFF ON DATA",0))_";ORD(101," D EN^XQOR:X K VAIN,X
+ .Q
+ S GMRAPA(0)=$G(^GMR(120.8,GMRAPA,0)),GMRATYPE=$P(GMRAPA(0),U,20)
+ S DA=GMRAPA,DIE="^GMR(120.8,",DR="19////1;20///N;21////"_DUZ D ^DIE D:'GMRAVER EN1^GMRAVAB S GMRAPA(0)=$S($D(^GMR(120.8,GMRAPA,0)):^(0),1:"")
+ I $P(GMRAPA(0),U,6)="o",GMRATYPE["D" D PTBUL^GMRAROBS
+ I GMRAVER D EN1^GMRAPET0($P(GMRAPA(0),U),GMRAPA,"V",.GMRAOUT) I GMRAOUT S GMRAOUT=0
+Q1 D UNLOCK^GMRAUTL(120.8,GMRAPA)
+EXIT K GMRAFLAG,DA,DIE,DR,GMRADRUG Q