YTQAPI16 ;ASF/ALB MHA REPORT BY Q ; 4/3/07 11:34am
;;5.01;MENTAL HEALTH;**85,119**;Dec 30, 1994;Build 40
Q
MAIN ;
N N,YSAD,G,YSCODE,YSB,YSD,YSE,YSCN,DIRUT,Y,YSA,YSC,YSCOMP,YSQNUMB,YSQTEXT
D SELAD
W !!,"You must queue this report- off hours are strongly suggested"
S %ZIS="QM" D ^%ZIS Q:IO=""
I '$D(IO("Q")) W !,"Must be queued-- try again",! H 2 Q ;-->out
I $D(IO("Q")) D D ^%ZTLOAD D HOME^%ZIS K IO("Q") Q
.S ZTRTN="ENQ^YTQAPI16",ZTDESC="MHA3 QRQ 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
Q
ENQ ;taskman entry
K ^TMP("YSQR",$J),^TMP("YSQA",$J)
S N=0
D BUILDG
D XML
D ^%ZISC
Q
XML ;setup output
S N=N+1,^TMP("YSXML",$J,N)="<?xml version='1.0' encoding='UTF-8'?>"
S N=N+1,^TMP("YSXML",$J,N)="<Report>"
D GUTS
S N=N+1,^TMP("YSXML",$J,N)="</Report>"
U IO S N=0 F S N=$O(^TMP("YSXML",$J,N)) Q:N'>0 W ^(N),!
Q ;-->out
SELAD ;administation filter
W @IOF,!!,"MHA Question Frequency Report"
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)
N YTTLKUP S YTTLKUP=1 ; suppress filter
S YSE=Y
K DIC S DIC(0)="AEQ",DIC="^YTT(601.71," D ^DIC Q:Y'>0 S YSCODE=$P(Y,U,2)
Q
BUILDG ;global create
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 D
.. S YSCOMP=$P(^YTT(601.84,YSAD,0),U,9)
.. Q:YSCOMP'="Y"
.. S ^TMP("YSQA",$J,YSAD)=""
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
Q
B3 ;
S YSQNUMB=$P(^YTT(601.85,YSA,0),U,3)
S YSC=$P(^YTT(601.85,YSA,0),U,4)
S:YSC'?1N.N YSC="?"
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("YSQR",$J,YSQNUMB)=$G(^TMP("YSQR",$J,YSQNUMB))+1
S ^TMP("YSQR",$J,YSQNUMB,YSC)=$G(^TMP("YSQR",$J,YSQNUMB,YSC))+1
Q
GUTS ;extract the data into an XML global
S N=N+1,^TMP("YSXML",$J,N)="<Instrument>"_YSCODE_"</Instrument>"
S YSQNUMB=0 F S YSQNUMB=$O(^TMP("YSQR",$J,YSQNUMB)) Q:YSQNUMB'>0 D
. S N=N+1,^TMP("YSXML",$J,N)="<Question>"
. S N=N+1,^TMP("YSXML",$J,N)="<Number>"_YSQNUMB_"</Number>"
. S YSQTEXT=$G(^YTT(601.72,YSQNUMB,1,1,0))
. S N=N+1,^TMP("YSXML",$J,N)="<QText>"_YSQTEXT_"</QText>"
. S YSC=0 F S YSC=$O(^TMP("YSQR",$J,YSQNUMB,YSC)) Q:YSC'>0 D
.. S N=N+1,^TMP("YSXML",$J,N)="<Choice>"
.. S N=N+1,^TMP("YSXML",$J,N)="<ChoiceNumb>"_YSC_"</ChoiceNumb>"
.. S N=N+1,^TMP("YSXML",$J,N)="<ChoiceTxt>"_$G(^YTT(601.75,YSC,1))_"</ChoiceTxt>"
.. S N=N+1,^TMP("YSXML",$J,N)="<ChoiceCount>"_^TMP("YSQR",$J,YSQNUMB,YSC)_"</ChoiceCount>"
.. S N=N+1,^TMP("YSXML",$J,N)="<Qcount>"_^TMP("YSQR",$J,YSQNUMB)_"</Qcount>"
.. S N=N+1,^TMP("YSXML",$J,N)="</Choice>"
. S N=N+1,^TMP("YSXML",$J,N)="</Question>"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTQAPI16 3103 printed Nov 22, 2024@17:28:13 Page 2
YTQAPI16 ;ASF/ALB MHA REPORT BY Q ; 4/3/07 11:34am
+1 ;;5.01;MENTAL HEALTH;**85,119**;Dec 30, 1994;Build 40
+2 QUIT
MAIN ;
+1 NEW N,YSAD,G,YSCODE,YSB,YSD,YSE,YSCN,DIRUT,Y,YSA,YSC,YSCOMP,YSQNUMB,YSQTEXT
+2 DO SELAD
+3 WRITE !!,"You must queue this report- off hours are strongly suggested"
+4 SET %ZIS="QM"
DO ^%ZIS
if IO=""
QUIT
+5 ;-->out
IF '$DATA(IO("Q"))
WRITE !,"Must be queued-- try again",!
HANG 2
QUIT
+6 IF $DATA(IO("Q"))
Begin DoDot:1
+7 SET ZTRTN="ENQ^YTQAPI16"
SET ZTDESC="MHA3 QRQ Export"
SET ZTSAVE("YS*")=""
+8 SET ZTIO=ION_";"_IOST
+9 IF $DATA(IO("DOC"))#2
IF IO("DOC")]""
SET ZTIO=ZTIO_";"_IO("DOC")
QUIT
+10 IF IOM
SET ZTIO=ZTIO_";"_IOM
+11 IF IOSL
SET ZTIO=ZTIO_";"_IOSL
End DoDot:1
DO ^%ZTLOAD
DO HOME^%ZIS
KILL IO("Q")
QUIT
+12 QUIT
ENQ ;taskman entry
+1 KILL ^TMP("YSQR",$JOB),^TMP("YSQA",$JOB)
+2 SET N=0
+3 DO BUILDG
+4 DO XML
+5 DO ^%ZISC
+6 QUIT
XML ;setup output
+1 SET N=N+1
SET ^TMP("YSXML",$JOB,N)="<?xml version='1.0' encoding='UTF-8'?>"
+2 SET N=N+1
SET ^TMP("YSXML",$JOB,N)="<Report>"
+3 DO GUTS
+4 SET N=N+1
SET ^TMP("YSXML",$JOB,N)="</Report>"
+5 USE IO
SET N=0
FOR
SET N=$ORDER(^TMP("YSXML",$JOB,N))
if N'>0
QUIT
WRITE ^(N),!
+6 ;-->out
QUIT
SELAD ;administation filter
+1 WRITE @IOF,!!,"MHA Question Frequency Report"
+2 KILL DIR
SET DIR(0)="DA^2961001:NOW:TX"
SET DIR("A")="Begin date/time: "
SET DIR("B")="T-1M"
DO ^DIR
+3 if $DATA(DIRUT)
QUIT
+4 SET YSB=Y
+5 KILL DIR
SET DIR(0)="DA^2961001:NOW:TX"
SET DIR("A")="End date/time: "
SET DIR("B")="NOW"
DO ^DIR
+6 if $DATA(DIRUT)
QUIT
+7 ; suppress filter
NEW YTTLKUP
SET YTTLKUP=1
+8 SET YSE=Y
+9 KILL DIC
SET DIC(0)="AEQ"
SET DIC="^YTT(601.71,"
DO ^DIC
if Y'>0
QUIT
SET YSCODE=$PIECE(Y,U,2)
+10 QUIT
BUILDG ;global create
+1 SET YSCN=$ORDER(^YTT(601.71,"B",YSCODE,-1))
+2 SET YSD=YSB-.00001
+3 FOR
SET YSD=$ORDER(^YTT(601.84,"AC",YSCN,YSD))
if (YSD'>0)!(YSD>YSE)
QUIT
Begin DoDot:1
+4 SET YSAD=0
FOR
SET YSAD=$ORDER(^YTT(601.84,"AC",YSCN,YSD,YSAD))
if YSAD'>0
QUIT
Begin DoDot:2
+5 SET YSCOMP=$PIECE(^YTT(601.84,YSAD,0),U,9)
+6 if YSCOMP'="Y"
QUIT
+7 SET ^TMP("YSQA",$JOB,YSAD)=""
End DoDot:2
End DoDot:1
+8 SET YSAD=0
FOR
SET YSAD=$ORDER(^TMP("YSQA",$JOB,YSAD))
if YSAD'>0
QUIT
SET YSA=0
FOR
SET YSA=$ORDER(^YTT(601.85,"AD",YSAD,YSA))
if YSA'>0
QUIT
DO B3
+9 QUIT
B3 ;
+1 SET YSQNUMB=$PIECE(^YTT(601.85,YSA,0),U,3)
+2 SET YSC=$PIECE(^YTT(601.85,YSA,0),U,4)
+3 if YSC'?1N.N
SET YSC="?"
+4 SET YSCN=$SELECT(YSC?1N.N:^YTT(601.75,YSC,1),1:"???")
+5 if $DATA(^YTT(601.85,YSA,1,1,0))
SET YSCN=^YTT(601.85,YSA,1,1,0)
+6 SET ^TMP("YSQR",$JOB,YSQNUMB)=$GET(^TMP("YSQR",$JOB,YSQNUMB))+1
+7 SET ^TMP("YSQR",$JOB,YSQNUMB,YSC)=$GET(^TMP("YSQR",$JOB,YSQNUMB,YSC))+1
+8 QUIT
GUTS ;extract the data into an XML global
+1 SET N=N+1
SET ^TMP("YSXML",$JOB,N)="<Instrument>"_YSCODE_"</Instrument>"
+2 SET YSQNUMB=0
FOR
SET YSQNUMB=$ORDER(^TMP("YSQR",$JOB,YSQNUMB))
if YSQNUMB'>0
QUIT
Begin DoDot:1
+3 SET N=N+1
SET ^TMP("YSXML",$JOB,N)="<Question>"
+4 SET N=N+1
SET ^TMP("YSXML",$JOB,N)="<Number>"_YSQNUMB_"</Number>"
+5 SET YSQTEXT=$GET(^YTT(601.72,YSQNUMB,1,1,0))
+6 SET N=N+1
SET ^TMP("YSXML",$JOB,N)="<QText>"_YSQTEXT_"</QText>"
+7 SET YSC=0
FOR
SET YSC=$ORDER(^TMP("YSQR",$JOB,YSQNUMB,YSC))
if YSC'>0
QUIT
Begin DoDot:2
+8 SET N=N+1
SET ^TMP("YSXML",$JOB,N)="<Choice>"
+9 SET N=N+1
SET ^TMP("YSXML",$JOB,N)="<ChoiceNumb>"_YSC_"</ChoiceNumb>"
+10 SET N=N+1
SET ^TMP("YSXML",$JOB,N)="<ChoiceTxt>"_$GET(^YTT(601.75,YSC,1))_"</ChoiceTxt>"
+11 SET N=N+1
SET ^TMP("YSXML",$JOB,N)="<ChoiceCount>"_^TMP("YSQR",$JOB,YSQNUMB,YSC)_"</ChoiceCount>"
+12 SET N=N+1
SET ^TMP("YSXML",$JOB,N)="<Qcount>"_^TMP("YSQR",$JOB,YSQNUMB)_"</Qcount>"
+13 SET N=N+1
SET ^TMP("YSXML",$JOB,N)="</Choice>"
End DoDot:2
+14 SET N=N+1
SET ^TMP("YSXML",$JOB,N)="</Question>"
End DoDot:1
+15 QUIT
