- 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 Apr 23, 2025@18:33:31 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
