YTQAPI16.m

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 ---YTQAPI16   3103     printed  Apr 23, 2025@18:32:36                                                                                                                                                                                                    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