| 1 | YTQAPI16 ;ASF/ALB MHA REPORT BY Q ; 4/3/07 11:34am
|
|---|
| 2 | ;;5.01;MENTAL HEALTH;**85**;Dec 30, 1994;Build 49
|
|---|
| 3 | Q
|
|---|
| 4 | MAIN ;
|
|---|
| 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
|
|---|
| 17 | ENQ ;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
|
|---|
| 24 | XML ;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
|
|---|
| 31 | SELAD ;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
|
|---|
| 41 | BUILDG ;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
|
|---|
| 51 | B3 ;
|
|---|
| 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
|
|---|
| 60 | GUTS ;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
|
|---|
