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
