YTQAPI15	;ASF/ALB MHA XML ; 4/3/07 11:29am
	;;5.01;MENTAL HEALTH;**85**;Dec 30, 1994;Build 49
	Q
MAIN	;
	N N,G,YSCN,ICN,Y,YSA,YSAD,YSB,YSC,YSCN,YSCODE,YSD,YSDFN,YSDG,YSE,YSEA,YSER,YSF,YSFIELD,YSFILE,YSIENS,YSJ,YSLOC,YSOD,YSQNUMB,YSQTEXT,YSR,DFN,DIRUT
	D SELAD
DEV	S %ZIS="QM" D ^%ZIS Q:IO=""
	I '$D(IO("Q")) W !,"Please Queue this job",! G DEV
	D  D ^%ZTLOAD D HOME^%ZIS K IO("Q") Q  ;-->out
	.S ZTRTN="ENQ^YTQAPI15",ZTDESC="MHA3 XML Export",ZTSAVE("YS*")=""
	.S ZTIO=ION_";"_IOST
	.I $D(IO("DOC"))#2,IO("DOC")]"" S ZTIO=ZTIO_";"_IO("DOC") Q
	.I IOM S ZTIO=ZTIO_";"_IOM
	.I IOSL S ZTIO=ZTIO_";"_IOSL
	;
ENQ	;taskman entry
	K ^TMP("YSXML",$J),^TMP("YSAD",$J)
	S N=0
	D SI:YSF="I",SP:YSF="P",SO:YSF="O",SL:YSF="L",SD:YSF="D"
	I '$D(^TMP("YSAD",$J)) S ^TMP("YSXML",$J,1)="[ERROR]^no data" Q  ;-->out
	S N=N+1,^TMP("YSXML",$J,N)="<?xml version='1.0' encoding='UTF-8'?>"
	S N=N+1,^TMP("YSXML",$J,N)="<Export>"
	D ADMIN
	S N=N+1,^TMP("YSXML",$J,N)="</Export>"
	U IO S N=0 F  S N=$O(^TMP("YSXML",$J,N)) Q:N'>0  W ^(N),!
	D ^%ZISC
	Q  ;-->out
SELAD	;administation filter
	W @IOF,!!,"MHA XML Export"
	K DIR S DIR(0)="S^D:Date Only;I:Instrument;L:Location;P:Patient;O:Ordered By"
	S DIR("A")="Filter By" D ^DIR
	Q:$D(DIRUT)
	S YSF=Y
	K DIR S DIR(0)="DA^2961001:NOW:TX",DIR("A")="Begin date/time: ",DIR("B")="T-1M" D ^DIR
	Q:$D(DIRUT)
	S YSB=Y
	K DIR S DIR(0)="DA^2961001:NOW:TX",DIR("A")="End date/time: ",DIR("B")="NOW" D ^DIR
	Q:$D(DIRUT)
	S YSE=Y
	K DIR S DIR(0)="Y",DIR("A")="Export Answers",DIR("B")="No" D ^DIR
	Q:$D(DIRUT)
	S YSEA=Y
	K DIR S DIR(0)="Y",DIR("A")="Export Results",DIR("B")="No" D ^DIR
	Q:$D(DIRUT)
	S YSER=Y
	K DIC
	I YSF="I" S DIC(0)="AEQ",DIC="^YTT(601.71," D ^DIC Q:Y'>0  S YSCODE=$P(Y,U,2)
	I YSF="P" D ^YSLRP Q:DFN'>0  ;-->out
	I YSF="O" S DIC("A")="Ordered By: ",DIC(0)="AEQ",DIC="^VA(200," D ^DIC Q:Y'>0  S YSOD=+Y
	I YSF="L" S DIC(0)="AEQ",DIC="^DIC(42," D ^DIC Q:Y'>0  S YSLOC=+Y
	Q
SI	;selct by instrument
	S YSCN=$O(^YTT(601.71,"B",YSCODE,-1))
	S YSD=YSB-.00001 F  S YSD=$O(^YTT(601.84,"AC",YSCN,YSD)) Q:(YSD'>0)!(YSD>YSE)  D
	. S YSAD=0 F  S YSAD=$O(^YTT(601.84,"AC",YSCN,YSD,YSAD)) Q:YSAD'>0  S ^TMP("YSAD",$J,YSAD)=""
	Q
SP	;select by patient
	S YSAD=0 F  S YSAD=$O(^YTT(601.84,"C",YSDFN,YSAD)) Q:YSAD'>0  D
	. S YSDG=$P(^YTT(601.84,YSAD,0),U,4)
	. S:(YSDG'<YSB)&(YSDG'>(YSE+.9)) ^TMP("YSAD",$J,YSAD)=""
	Q
SD	;select by Date Only
	S YSAD=0 F  S YSAD=$O(^YTT(601.84,"B",YSAD)) Q:YSAD'>0  D
	. S YSDG=$P(^YTT(601.84,YSAD,0),U,4)
	. S:(YSDG'<YSB)&(YSDG'>(YSE+.9)) ^TMP("YSAD",$J,YSAD)=""
	Q
SO	;select by Ordered by
	S YSAD=0 F  S YSAD=$O(^YTT(601.84,"AO",YSOD,YSAD)) Q:YSAD'>0  D
	. S YSDG=$P(^YTT(601.84,YSAD,0),U,4)
	. S:(YSDG'<YSB)&(YSDG'>(YSE+.9)) ^TMP("YSAD",$J,YSAD)=""
	Q
SL	;select by location
	S YSAD=0 F  S YSAD=$O(^YTT(601.84,"AL",YSLOC,YSAD)) Q:YSAD'>0  D
	. S YSDG=$P(^YTT(601.84,YSAD,0),U,4)
	. S:(YSDG'<YSB)&(YSDG'>(YSE+.9)) ^TMP("YSAD",$J,YSAD)=""
	Q
ADMIN	;extract the data into an XML global
	S YSAD=0 F  S YSAD=$O(^TMP("YSAD",$J,YSAD)) Q:YSAD'>0  D
	. S N=N+1,^TMP("YSXML",$J,N)="<Admin>"
	. S N=N+1,^TMP("YSXML",$J,N)="<Admin_ID>"_YSAD_"</Admin_ID>"
	. D FORM("Patient",601.84,YSAD,1)
	. S DFN=$P(^YTT(601.84,YSAD,0),U,2),ICN=$$GETICN^MPIF001(DFN),N=N+1,^TMP("YSXML",$J,N)="<ICN>"_ICN_"</ICN>"
	. D FORM("Instrument",601.84,YSAD,2)
	. D FORM("Given",601.84,YSAD,3)
	. D FORM("Saved",601.84,YSAD,4)
	. D FORM("Ordered",601.84,YSAD,5)
	. D FORM("Complete",601.84,YSAD,8)
	. D FORM("Location",601.84,YSAD,13)
	. D QUEST:YSEA
	. D RESULT:YSER
	. S N=N+1,^TMP("YSXML",$J,N)="</Admin>"
	Q
FORM(YSTAG,YSFILE,YSIENS,YSFIELD)	;xml entry
	N G
	S N=N+1
	S G="<"_YSTAG_">"
	S G=G_$$GET1^DIQ(YSFILE,YSIENS_",",YSFIELD)
	S G=G_"</"_YSTAG_">"
	S ^TMP("YSXML",$J,N)=G
	Q
QUEST	;answers out
	S YSA=0,YSJ=0  F  S YSA=$O(^YTT(601.85,"AD",YSAD,YSA)) Q:YSA'>0  D
	. S N=N+1,^TMP("YSXML",$J,N)="<Quest>"
	. S N=N+1,^TMP("YSXML",$J,N)="<Admin_ID>"_YSAD_"</Admin_ID>"
	. S YSQNUMB=$P(^YTT(601.85,YSA,0),U,3)
	. S N=N+1,^TMP("YSXML",$J,N)="<Qnumb>"_YSQNUMB_"</Qnumb>"
	. S YSQTEXT=$G(^YTT(601.72,YSQNUMB,1,1,0))
	. S N=N+1,^TMP("YSXML",$J,N)="<Qtext>"_YSQTEXT_"</Qtext>"
	. S N=N+1,YSJ=YSJ+1,^TMP("YSXML",$J,N)="<Seq>"_YSJ_"</Seq>"
	. D FORM("Choice",601.85,YSA,4)
	. S N=N+1
	. S YSC=$P(^YTT(601.85,YSA,0),U,4)
	. S YSCN=$S(YSC?1N.N:^YTT(601.75,YSC,1),1:"???")
	. S:$D(^YTT(601.85,YSA,1,1,0)) YSCN=^YTT(601.85,YSA,1,1,0)
	. S ^TMP("YSXML",$J,N)="<Ans>"_YSCN_"</Ans>"
	. S N=N+1,^TMP("YSXML",$J,N)="</Quest>"
	Q
RESULT	;results out
	S YSR=0
	F  S YSR=$O(^YTT(601.92,"AC",YSAD,YSR)) Q:YSR'>0  D
	. S N=N+1,^TMP("YSXML",$J,N)="<Score>"
	. S N=N+1,^TMP("YSXML",$J,N)="<Admin_ID>"_YSAD_"</Admin_ID>"
	. D FORM("Scale",601.92,YSR,2)
	. D FORM("Raw",601.92,YSR,3)
	. D FORM("Trans1",601.92,YSR,4)
	. S N=N+1,^TMP("YSXML",$J,N)="</Score>"
	Q
HEAD	;