source: WorldVistAEHR/trunk/r/MENTAL_HEALTH-YS-RUCL-YI-YT/YTQAPI16.m@ 1800

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

initial load of WorldVistAEHR

File size: 2.9 KB
Line 
1YTQAPI16 ;ASF/ALB MHA REPORT BY Q ; 4/3/07 11:34am
2 ;;5.01;MENTAL HEALTH;**85**;Dec 30, 1994;Build 49
3 Q
4MAIN ;
5 N N,YSAD,G,YSCODE,YSB,YSD,YSE,YSCN,DIRUT,Y,YSA,YSC,YSCOMP,YSQNUMB,YSQTEXT
6 D SELAD
7 W !!,"You must queue this report- off hours are strongly suggested"
8 S %ZIS="QM" D ^%ZIS Q:IO=""
9 I '$D(IO("Q")) W !,"Must be queued-- try again",! H 2 Q ;-->out
10 I $D(IO("Q")) D D ^%ZTLOAD D HOME^%ZIS K IO("Q") Q
11 .S ZTRTN="ENQ^YTQAPI16",ZTDESC="MHA3 QRQ Export",ZTSAVE("YS*")=""
12 .S ZTIO=ION_";"_IOST
13 .I $D(IO("DOC"))#2,IO("DOC")]"" S ZTIO=ZTIO_";"_IO("DOC") Q
14 .I IOM S ZTIO=ZTIO_";"_IOM
15 .I IOSL S ZTIO=ZTIO_";"_IOSL
16 Q
17ENQ ;taskman entry
18 K ^TMP("YSQR",$J),^TMP("YSQA",$J)
19 S N=0
20 D BUILDG
21 D XML
22 D ^%ZISC
23 Q
24XML ;setup output
25 S N=N+1,^TMP("YSXML",$J,N)="<?xml version='1.0' encoding='UTF-8'?>"
26 S N=N+1,^TMP("YSXML",$J,N)="<Report>"
27 D GUTS
28 S N=N+1,^TMP("YSXML",$J,N)="</Report>"
29 U IO S N=0 F S N=$O(^TMP("YSXML",$J,N)) Q:N'>0 W ^(N),!
30 Q ;-->out
31SELAD ;administation filter
32 W @IOF,!!,"MHA Question Frequency Report"
33 K DIR S DIR(0)="DA^2961001:NOW:TX",DIR("A")="Begin date/time: ",DIR("B")="T-1M" D ^DIR
34 Q:$D(DIRUT)
35 S YSB=Y
36 K DIR S DIR(0)="DA^2961001:NOW:TX",DIR("A")="End date/time: ",DIR("B")="NOW" D ^DIR
37 Q:$D(DIRUT)
38 S YSE=Y
39 K DIC S DIC(0)="AEQ",DIC="^YTT(601.71," D ^DIC Q:Y'>0 S YSCODE=$P(Y,U,2)
40 Q
41BUILDG ;global create
42 S YSCN=$O(^YTT(601.71,"B",YSCODE,-1))
43 S YSD=YSB-.00001
44 F S YSD=$O(^YTT(601.84,"AC",YSCN,YSD)) Q:(YSD'>0)!(YSD>YSE) D
45 . S YSAD=0 F S YSAD=$O(^YTT(601.84,"AC",YSCN,YSD,YSAD)) Q:YSAD'>0 D
46 .. S YSCOMP=$P(^YTT(601.84,YSAD,0),U,9)
47 .. Q:YSCOMP'="Y"
48 .. S ^TMP("YSQA",$J,YSAD)=""
49 S YSAD=0 F S YSAD=$O(^TMP("YSQA",$J,YSAD)) Q:YSAD'>0 S YSA=0 F S YSA=$O(^YTT(601.85,"AD",YSAD,YSA)) Q:YSA'>0 D B3
50 Q
51B3 ;
52 S YSQNUMB=$P(^YTT(601.85,YSA,0),U,3)
53 S YSC=$P(^YTT(601.85,YSA,0),U,4)
54 S:YSC'?1N.N YSC="?"
55 S YSCN=$S(YSC?1N.N:^YTT(601.75,YSC,1),1:"???")
56 S:$D(^YTT(601.85,YSA,1,1,0)) YSCN=^YTT(601.85,YSA,1,1,0)
57 S ^TMP("YSQR",$J,YSQNUMB)=$G(^TMP("YSQR",$J,YSQNUMB))+1
58 S ^TMP("YSQR",$J,YSQNUMB,YSC)=$G(^TMP("YSQR",$J,YSQNUMB,YSC))+1
59 Q
60GUTS ;extract the data into an XML global
61 S N=N+1,^TMP("YSXML",$J,N)="<Instrument>"_YSCODE_"</Instrument>"
62 S YSQNUMB=0 F S YSQNUMB=$O(^TMP("YSQR",$J,YSQNUMB)) Q:YSQNUMB'>0 D
63 . S N=N+1,^TMP("YSXML",$J,N)="<Question>"
64 . S N=N+1,^TMP("YSXML",$J,N)="<Number>"_YSQNUMB_"</Number>"
65 . S YSQTEXT=$G(^YTT(601.72,YSQNUMB,1,1,0))
66 . S N=N+1,^TMP("YSXML",$J,N)="<QText>"_YSQTEXT_"</QText>"
67 . S YSC=0 F S YSC=$O(^TMP("YSQR",$J,YSQNUMB,YSC)) Q:YSC'>0 D
68 .. S N=N+1,^TMP("YSXML",$J,N)="<Choice>"
69 .. S N=N+1,^TMP("YSXML",$J,N)="<ChoiceNumb>"_YSC_"</ChoiceNumb>"
70 .. S N=N+1,^TMP("YSXML",$J,N)="<ChoiceTxt>"_$G(^YTT(601.75,YSC,1))_"</ChoiceTxt>"
71 .. S N=N+1,^TMP("YSXML",$J,N)="<ChoiceCount>"_^TMP("YSQR",$J,YSQNUMB,YSC)_"</ChoiceCount>"
72 .. S N=N+1,^TMP("YSXML",$J,N)="<Qcount>"_^TMP("YSQR",$J,YSQNUMB)_"</Qcount>"
73 .. S N=N+1,^TMP("YSXML",$J,N)="</Choice>"
74 . S N=N+1,^TMP("YSXML",$J,N)="</Question>"
75 Q
Note: See TracBrowser for help on using the repository browser.