YTQTUSE ;ASF/ALB- PSYCHOLOGICAL TEST USEAGE REPORTING ; 7/30/09 10:44am
;;5.01;MENTAL HEALTH;**87,97**;Dec 30, 1994;Build 42
;called as a server option from YTQTUSE
1 N YSB,YSY,DFN,YSTST,YSCOMP,N,N1,A,YSCPLETE,YSGIVEN,YSCODEN,YSAD,Y
N XMA,XMDUZ,XMY,XMSUB,XMRG,XQSUB,XMTEXT
K ^TMP($J,"YSTAT")
S ^TMP($J,"YSTAT",1)=$$SITE^VASITE
S XMA=1 X XMREC
I XMRG="" S ^TMP($J,"YSTAT",12)="Dates can not be resolved" D SENDER Q ;-->out
S YSB=$P(XMRG,U),YSY=$P(XMRG,U,2)
S ^TMP($J,"YSTAT",2)="From: "_YSB_" To: "_YSY
S ^TMP($J,"YSTAT",3)=" "
TT ;test ck
S N=20
D STATS ;useage rollup
S YSTST=0 F S YSTST=$O(A(YSTST)) Q:YSTST'>0 D
. S N=N+1
. S ^TMP($J,"YSTAT",N)=+A(YSTST)_U_$P($G(^YTT(601.71,YSTST,0)),U)_U_YSTST_U_$$SITE^VASITE_U_A(YSTST)
SENDER ;
S XMSUB="MHA3 Automated Usage Report"
S XMY(XMFROM)=""
S XMTEXT="^TMP($J,""YSTAT"","
S XMDUZ="MH3 automated testing REPLY"
N XMFROM,XMZ,XMREC,XMCHAN D ^XMD
Q
STATS ;test count
N YSHLSTAT,YSHLP K A
S YSCODEN=0 F S YSCODEN=$O(^YTT(601.84,"AC",YSCODEN)) Q:YSCODEN'>0 D
. S YSGIVEN=YSB-.01
. F S YSGIVEN=$O(^YTT(601.84,"AC",YSCODEN,YSGIVEN)) Q:YSGIVEN'>0!(YSGIVEN>YSY) D
.. S YSAD=0
.. F S YSAD=$O(^YTT(601.84,"AC",YSCODEN,YSGIVEN,YSAD)) Q:YSAD'>0 D
... S YSCPLETE=$P(^YTT(601.84,YSAD,0),U,9)
... Q:YSCPLETE'="Y" ;-->out
... S YSHLSTAT=$P($G(^YTT(601.84,YSAD,2)),U)
... S YSHLP=$S(YSHLSTAT="S":2,YSHLSTAT="E":3,YSHLSTAT="T":4,1:5)
... S $P(A(YSCODEN),U)=$P($G(A(YSCODEN)),U)+1
... S $P(A(YSCODEN),U,YSHLP)=$P(A(YSCODEN),U,YSHLP)+1
Q
EN1 ;interactive login
;
N DIR,YSB,YSY,YSCPLETE,A,B,YSINS,YSLFT
S N=0,YSLFT=0
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)
S YSY=Y
D STATS
S YSTST=0 F S YSTST=$O(A(YSTST)) Q:YSTST'>0 D
. S N=N+1
. S B($P($G(^YTT(601.71,YSTST,0)),U))=A(YSTST)
. K A(YSTST)
D ^%ZIS Q:POP U IO
W @IOF,!,"MHA3 Test Count from: "
S Y=YSB D DD^%DT W Y
S Y=YSY D DD^%DT W " to: ",Y
W !,?5,"Count",?12,"Instrument",?60,"S E T ?"
S YSINS=0
F S YSINS=$O(B(YSINS)) Q:YSINS=""!(YSLFT) D
. D:(($Y+5)>IOSL) WAIT
. W !?5,$P(B(YSINS),U),?12,YSINS,?60,$P(B(YSINS),U,2,9)
D ^%ZISC
Q
WAIT ;
F I0=1:1:IOSL-$Y-4 W !
N DIR,DTOUT,DUOUT,DIRUT
I IOST?1"C".E S DIR(0)="E" D ^DIR K DIR S YSLFT=$D(DIRUT)
W @IOF Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYTQTUSE 2439 printed Sep 23, 2025@19:55:11 Page 2
YTQTUSE ;ASF/ALB- PSYCHOLOGICAL TEST USEAGE REPORTING ; 7/30/09 10:44am
+1 ;;5.01;MENTAL HEALTH;**87,97**;Dec 30, 1994;Build 42
+2 ;called as a server option from YTQTUSE
1 NEW YSB,YSY,DFN,YSTST,YSCOMP,N,N1,A,YSCPLETE,YSGIVEN,YSCODEN,YSAD,Y
+1 NEW XMA,XMDUZ,XMY,XMSUB,XMRG,XQSUB,XMTEXT
+2 KILL ^TMP($JOB,"YSTAT")
+3 SET ^TMP($JOB,"YSTAT",1)=$$SITE^VASITE
+4 SET XMA=1
XECUTE XMREC
+5 ;-->out
IF XMRG=""
SET ^TMP($JOB,"YSTAT",12)="Dates can not be resolved"
DO SENDER
QUIT
+6 SET YSB=$PIECE(XMRG,U)
SET YSY=$PIECE(XMRG,U,2)
+7 SET ^TMP($JOB,"YSTAT",2)="From: "_YSB_" To: "_YSY
+8 SET ^TMP($JOB,"YSTAT",3)=" "
TT ;test ck
+1 SET N=20
+2 ;useage rollup
DO STATS
+3 SET YSTST=0
FOR
SET YSTST=$ORDER(A(YSTST))
if YSTST'>0
QUIT
Begin DoDot:1
+4 SET N=N+1
+5 SET ^TMP($JOB,"YSTAT",N)=+A(YSTST)_U_$PIECE($GET(^YTT(601.71,YSTST,0)),U)_U_YSTST_U_$$SITE^VASITE_U_A(YSTST)
End DoDot:1
SENDER ;
+1 SET XMSUB="MHA3 Automated Usage Report"
+2 SET XMY(XMFROM)=""
+3 SET XMTEXT="^TMP($J,""YSTAT"","
+4 SET XMDUZ="MH3 automated testing REPLY"
+5 NEW XMFROM,XMZ,XMREC,XMCHAN
DO ^XMD
+6 QUIT
STATS ;test count
+1 NEW YSHLSTAT,YSHLP
KILL A
+2 SET YSCODEN=0
FOR
SET YSCODEN=$ORDER(^YTT(601.84,"AC",YSCODEN))
if YSCODEN'>0
QUIT
Begin DoDot:1
+3 SET YSGIVEN=YSB-.01
+4 FOR
SET YSGIVEN=$ORDER(^YTT(601.84,"AC",YSCODEN,YSGIVEN))
if YSGIVEN'>0!(YSGIVEN>YSY)
QUIT
Begin DoDot:2
+5 SET YSAD=0
+6 FOR
SET YSAD=$ORDER(^YTT(601.84,"AC",YSCODEN,YSGIVEN,YSAD))
if YSAD'>0
QUIT
Begin DoDot:3
+7 SET YSCPLETE=$PIECE(^YTT(601.84,YSAD,0),U,9)
+8 ;-->out
if YSCPLETE'="Y"
QUIT
+9 SET YSHLSTAT=$PIECE($GET(^YTT(601.84,YSAD,2)),U)
+10 SET YSHLP=$SELECT(YSHLSTAT="S":2,YSHLSTAT="E":3,YSHLSTAT="T":4,1:5)
+11 SET $PIECE(A(YSCODEN),U)=$PIECE($GET(A(YSCODEN)),U)+1
+12 SET $PIECE(A(YSCODEN),U,YSHLP)=$PIECE(A(YSCODEN),U,YSHLP)+1
End DoDot:3
End DoDot:2
End DoDot:1
+13 QUIT
EN1 ;interactive login
+1 ;
+2 NEW DIR,YSB,YSY,YSCPLETE,A,B,YSINS,YSLFT
+3 SET N=0
SET YSLFT=0
+4 KILL DIR
SET DIR(0)="DA^2961001:NOW:TX"
SET DIR("A")="Begin date/time: "
SET DIR("B")="T-1M"
DO ^DIR
+5 if $DATA(DIRUT)
QUIT
+6 SET YSB=Y
+7 KILL DIR
SET DIR(0)="DA^2961001:NOW:TX"
SET DIR("A")="End date/time: "
SET DIR("B")="NOW"
DO ^DIR
+8 if $DATA(DIRUT)
QUIT
+9 SET YSY=Y
+10 DO STATS
+11 SET YSTST=0
FOR
SET YSTST=$ORDER(A(YSTST))
if YSTST'>0
QUIT
Begin DoDot:1
+12 SET N=N+1
+13 SET B($PIECE($GET(^YTT(601.71,YSTST,0)),U))=A(YSTST)
+14 KILL A(YSTST)
End DoDot:1
+15 DO ^%ZIS
if POP
QUIT
USE IO
+16 WRITE @IOF,!,"MHA3 Test Count from: "
+17 SET Y=YSB
DO DD^%DT
WRITE Y
+18 SET Y=YSY
DO DD^%DT
WRITE " to: ",Y
+19 WRITE !,?5,"Count",?12,"Instrument",?60,"S E T ?"
+20 SET YSINS=0
+21 FOR
SET YSINS=$ORDER(B(YSINS))
if YSINS=""!(YSLFT)
QUIT
Begin DoDot:1
+22 if (($Y+5)>IOSL)
DO WAIT
+23 WRITE !?5,$PIECE(B(YSINS),U),?12,YSINS,?60,$PIECE(B(YSINS),U,2,9)
End DoDot:1
+24 DO ^%ZISC
+25 QUIT
WAIT ;
+1 FOR I0=1:1:IOSL-$Y-4
WRITE !
+2 NEW DIR,DTOUT,DUOUT,DIRUT
+3 IF IOST?1"C".E
SET DIR(0)="E"
DO ^DIR
KILL DIR
SET YSLFT=$DATA(DIRUT)
+4 WRITE @IOF
QUIT
