source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTQAPI15.m@ 623

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

initial load of WorldVistAEHR

File size: 4.7 KB
Line 
1YTQAPI15 ;ASF/ALB MHA XML ; 4/3/07 11:29am
2 ;;5.01;MENTAL HEALTH;**85**;Dec 30, 1994;Build 49
3 Q
4MAIN ;
5 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
6 D SELAD
7DEV S %ZIS="QM" D ^%ZIS Q:IO=""
8 I '$D(IO("Q")) W !,"Please Queue this job",! G DEV
9 D D ^%ZTLOAD D HOME^%ZIS K IO("Q") Q ;-->out
10 .S ZTRTN="ENQ^YTQAPI15",ZTDESC="MHA3 XML Export",ZTSAVE("YS*")=""
11 .S ZTIO=ION_";"_IOST
12 .I $D(IO("DOC"))#2,IO("DOC")]"" S ZTIO=ZTIO_";"_IO("DOC") Q
13 .I IOM S ZTIO=ZTIO_";"_IOM
14 .I IOSL S ZTIO=ZTIO_";"_IOSL
15 ;
16ENQ ;taskman entry
17 K ^TMP("YSXML",$J),^TMP("YSAD",$J)
18 S N=0
19 D SI:YSF="I",SP:YSF="P",SO:YSF="O",SL:YSF="L",SD:YSF="D"
20 I '$D(^TMP("YSAD",$J)) S ^TMP("YSXML",$J,1)="[ERROR]^no data" Q ;-->out
21 S N=N+1,^TMP("YSXML",$J,N)="<?xml version='1.0' encoding='UTF-8'?>"
22 S N=N+1,^TMP("YSXML",$J,N)="<Export>"
23 D ADMIN
24 S N=N+1,^TMP("YSXML",$J,N)="</Export>"
25 U IO S N=0 F S N=$O(^TMP("YSXML",$J,N)) Q:N'>0 W ^(N),!
26 D ^%ZISC
27 Q ;-->out
28SELAD ;administation filter
29 W @IOF,!!,"MHA XML Export"
30 K DIR S DIR(0)="S^D:Date Only;I:Instrument;L:Location;P:Patient;O:Ordered By"
31 S DIR("A")="Filter By" D ^DIR
32 Q:$D(DIRUT)
33 S YSF=Y
34 K DIR S DIR(0)="DA^2961001:NOW:TX",DIR("A")="Begin date/time: ",DIR("B")="T-1M" D ^DIR
35 Q:$D(DIRUT)
36 S YSB=Y
37 K DIR S DIR(0)="DA^2961001:NOW:TX",DIR("A")="End date/time: ",DIR("B")="NOW" D ^DIR
38 Q:$D(DIRUT)
39 S YSE=Y
40 K DIR S DIR(0)="Y",DIR("A")="Export Answers",DIR("B")="No" D ^DIR
41 Q:$D(DIRUT)
42 S YSEA=Y
43 K DIR S DIR(0)="Y",DIR("A")="Export Results",DIR("B")="No" D ^DIR
44 Q:$D(DIRUT)
45 S YSER=Y
46 K DIC
47 I YSF="I" S DIC(0)="AEQ",DIC="^YTT(601.71," D ^DIC Q:Y'>0 S YSCODE=$P(Y,U,2)
48 I YSF="P" D ^YSLRP Q:DFN'>0 ;-->out
49 I YSF="O" S DIC("A")="Ordered By: ",DIC(0)="AEQ",DIC="^VA(200," D ^DIC Q:Y'>0 S YSOD=+Y
50 I YSF="L" S DIC(0)="AEQ",DIC="^DIC(42," D ^DIC Q:Y'>0 S YSLOC=+Y
51 Q
52SI ;selct by instrument
53 S YSCN=$O(^YTT(601.71,"B",YSCODE,-1))
54 S YSD=YSB-.00001 F S YSD=$O(^YTT(601.84,"AC",YSCN,YSD)) Q:(YSD'>0)!(YSD>YSE) D
55 . S YSAD=0 F S YSAD=$O(^YTT(601.84,"AC",YSCN,YSD,YSAD)) Q:YSAD'>0 S ^TMP("YSAD",$J,YSAD)=""
56 Q
57SP ;select by patient
58 S YSAD=0 F S YSAD=$O(^YTT(601.84,"C",YSDFN,YSAD)) Q:YSAD'>0 D
59 . S YSDG=$P(^YTT(601.84,YSAD,0),U,4)
60 . S:(YSDG'<YSB)&(YSDG'>(YSE+.9)) ^TMP("YSAD",$J,YSAD)=""
61 Q
62SD ;select by Date Only
63 S YSAD=0 F S YSAD=$O(^YTT(601.84,"B",YSAD)) Q:YSAD'>0 D
64 . S YSDG=$P(^YTT(601.84,YSAD,0),U,4)
65 . S:(YSDG'<YSB)&(YSDG'>(YSE+.9)) ^TMP("YSAD",$J,YSAD)=""
66 Q
67SO ;select by Ordered by
68 S YSAD=0 F S YSAD=$O(^YTT(601.84,"AO",YSOD,YSAD)) Q:YSAD'>0 D
69 . S YSDG=$P(^YTT(601.84,YSAD,0),U,4)
70 . S:(YSDG'<YSB)&(YSDG'>(YSE+.9)) ^TMP("YSAD",$J,YSAD)=""
71 Q
72SL ;select by location
73 S YSAD=0 F S YSAD=$O(^YTT(601.84,"AL",YSLOC,YSAD)) Q:YSAD'>0 D
74 . S YSDG=$P(^YTT(601.84,YSAD,0),U,4)
75 . S:(YSDG'<YSB)&(YSDG'>(YSE+.9)) ^TMP("YSAD",$J,YSAD)=""
76 Q
77ADMIN ;extract the data into an XML global
78 S YSAD=0 F S YSAD=$O(^TMP("YSAD",$J,YSAD)) Q:YSAD'>0 D
79 . S N=N+1,^TMP("YSXML",$J,N)="<Admin>"
80 . S N=N+1,^TMP("YSXML",$J,N)="<Admin_ID>"_YSAD_"</Admin_ID>"
81 . D FORM("Patient",601.84,YSAD,1)
82 . S DFN=$P(^YTT(601.84,YSAD,0),U,2),ICN=$$GETICN^MPIF001(DFN),N=N+1,^TMP("YSXML",$J,N)="<ICN>"_ICN_"</ICN>"
83 . D FORM("Instrument",601.84,YSAD,2)
84 . D FORM("Given",601.84,YSAD,3)
85 . D FORM("Saved",601.84,YSAD,4)
86 . D FORM("Ordered",601.84,YSAD,5)
87 . D FORM("Complete",601.84,YSAD,8)
88 . D FORM("Location",601.84,YSAD,13)
89 . D QUEST:YSEA
90 . D RESULT:YSER
91 . S N=N+1,^TMP("YSXML",$J,N)="</Admin>"
92 Q
93FORM(YSTAG,YSFILE,YSIENS,YSFIELD) ;xml entry
94 N G
95 S N=N+1
96 S G="<"_YSTAG_">"
97 S G=G_$$GET1^DIQ(YSFILE,YSIENS_",",YSFIELD)
98 S G=G_"</"_YSTAG_">"
99 S ^TMP("YSXML",$J,N)=G
100 Q
101QUEST ;answers out
102 S YSA=0,YSJ=0 F S YSA=$O(^YTT(601.85,"AD",YSAD,YSA)) Q:YSA'>0 D
103 . S N=N+1,^TMP("YSXML",$J,N)="<Quest>"
104 . S N=N+1,^TMP("YSXML",$J,N)="<Admin_ID>"_YSAD_"</Admin_ID>"
105 . S YSQNUMB=$P(^YTT(601.85,YSA,0),U,3)
106 . S N=N+1,^TMP("YSXML",$J,N)="<Qnumb>"_YSQNUMB_"</Qnumb>"
107 . S YSQTEXT=$G(^YTT(601.72,YSQNUMB,1,1,0))
108 . S N=N+1,^TMP("YSXML",$J,N)="<Qtext>"_YSQTEXT_"</Qtext>"
109 . S N=N+1,YSJ=YSJ+1,^TMP("YSXML",$J,N)="<Seq>"_YSJ_"</Seq>"
110 . D FORM("Choice",601.85,YSA,4)
111 . S N=N+1
112 . S YSC=$P(^YTT(601.85,YSA,0),U,4)
113 . S YSCN=$S(YSC?1N.N:^YTT(601.75,YSC,1),1:"???")
114 . S:$D(^YTT(601.85,YSA,1,1,0)) YSCN=^YTT(601.85,YSA,1,1,0)
115 . S ^TMP("YSXML",$J,N)="<Ans>"_YSCN_"</Ans>"
116 . S N=N+1,^TMP("YSXML",$J,N)="</Quest>"
117 Q
118RESULT ;results out
119 S YSR=0
120 F S YSR=$O(^YTT(601.92,"AC",YSAD,YSR)) Q:YSR'>0 D
121 . S N=N+1,^TMP("YSXML",$J,N)="<Score>"
122 . S N=N+1,^TMP("YSXML",$J,N)="<Admin_ID>"_YSAD_"</Admin_ID>"
123 . D FORM("Scale",601.92,YSR,2)
124 . D FORM("Raw",601.92,YSR,3)
125 . D FORM("Trans1",601.92,YSR,4)
126 . S N=N+1,^TMP("YSXML",$J,N)="</Score>"
127 Q
128HEAD ;
Note: See TracBrowser for help on using the repository browser.