source: FOIAVistA/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTQAPI15.m@ 1245

YTQAPI15 ;ASF/ALB MHA XML ; 4/3/07 11:29am
 ;;5.01;MENTAL HEALTH;**85**;Dec 30, 1994;Build 48
 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 ;