AMHRTEN ; IHS/CMI/LAB - TOP TEN POVS ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
PREPROC ;
D XTMP^AMHUTIL("AMHTEN","BH - TOP TEN REPORT")
S %="^XTMP(""AMHTEN"",AMHJOB,AMHBT,",AMHA=%_"""POV"",AMHPOV)",AMHC=%_"1)",E=%_"2)",F=%_"3)",G=%_"4)",AMHTOT=0,AMHVTOT=0,AMHLINO=0
Q
POSTPROC ;
D SET
Q
;
;
SET ;
S AMHPOV="" F S AMHPOV=$O(@AMHA) Q:AMHPOV="" S %=^(AMHPOV),@AMHC@(9999999-%,AMHPOV)="" ;AMHA,AMHC global references are set in PREPROC+1
S1 S (X,I)=0 F S X=$O(@AMHC@(X)) Q:'X F Y=0:0 S Y=$O(@AMHC@(X,Y)) Q:'Y S I=I+1,@F@(I)=Y I I=AMHLNO G S2
S2 S (X,I)=0 F S X=$O(@E@(X)) Q:'X F Y=0:0 S Y=$O(@E@(X,Y)) Q:'Y S I=I+1,@G@(I)=Y I I=AMHLNO G S3
S3 Q
;
;
;
PRNTPRE ;EP
K DIRUT,DTOUT,DUOUT,DIR
PRIM ;
S AMHPRIM=""
I $E(AMHRRPT)="A",'$D(DIRUT) G CHRT
S DIR(0)="S^P:PRIMARY POV Only;S:PRIMARY and SECONDARY POV's",DIR("A")="Include which POV's",DIR("B")="P" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) S AMHQUIT=1 Q
S AMHPRIM=Y
CHRT ;EP
S DIR(0)="S^L:List of items with Counts;B:Bar Chart (REQUIRES 132 COLUMN PRINTER)",DIR("A")="Select Type of Report",DIR("B")="L" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) S AMHQUIT=1 Q
S AMHCHRT=Y
NUM ;get # entries
S DIR(0)="NO^5:"_$S(AMHCHRT="B":35,1:100)_":0",DIR("A")="How many entries do you want in the "_$S(AMHCHRT="B":"bar chart",1:"list"),DIR("B")="10",DIR("?")="" D ^DIR S:$D(DUOUT) DIRUT=1 K DIR
I $D(DIRUT) G CHRT
S AMHLNO=Y
I $D(DTOUT)!(Y=-1) G NUM
Q
;
PRINT ;EP;PRINT TOP TEN RECORDS
D NOW^%DTC S Y=X D DD^%DT S AMHDT=Y
S Y=AMHBD D DD^%DT S AMHBDD=Y S Y=AMHED D DD^%DT S AMHEDD=Y
D COVPAGE^AMHRPTCP
S AMHPG=0 D HEAD
S %="^XTMP(""AMHTEN"",AMHJOB,AMHBT,",A=%_"""POV"",AMHPOV)",B=%_"""APC"",AMHAPC)",AMHC=%_"1)",E=%_"2)",F=%_"3)",G=%_"4)"
S (J,I)=0 F S I=$O(^XTMP("AMHTEN",AMHJOB,AMHBT,1,I)) Q:I'=+I!($D(AMHQUIT))!(J>(AMHLNO-1)) D
.S AMHPOV="" F S AMHPOV=$O(^XTMP("AMHTEN",AMHJOB,AMHBT,1,I,AMHPOV)) Q:AMHPOV=""!($D(AMHQUIT)) S J=J+1 D
..I J=1,AMHCHRT="B" D SETDASH
..I $Y>(IOSL-4) D HEAD Q:$D(AMHQUIT)
..;I AMHCHRT="L" W !,J,".",?6,$E(AMHPOV,1,30),?39,$E($P(@AMHA,U,2),1,15),?56,+(@AMHA),?66,$P(@AMHA,U,3) Q
..I AMHCHRT="L" W !,J,".",?6,$E(AMHPOV,1,30),?39,$E($P(@AMHA,U,2),1,15),?56,+(@AMHA),?66,$J(($P(@AMHA,U,3)/60),7,1) Q
..W !,$E(AMHPOV,1,17),?18," (",$E($P(@AMHA,U,2),1,6),")",?27,"|" S L=+(@AMHA),D=L\AMHDASH F %=1:1:D W "*"
..W " ",+(@AMHA)
I AMHCHRT="B",$G(AMHDASH) D
.W ! S J=27 F X=1:1:10 W ?J,"|_________" S J=J+10
.W "|",!
.S J=27 F X=0:1:10 W ?J,AMHDASH*10*X S J=J+10
PEXIT D DONE^AMHLEIN,^AMHEKL Q
SETDASH ;set dash limits for bar chart
NEW L,D
S L=+(@AMHA)
S M=$L(L),F=$E(L)+1,L=F F %=1:1:(M-1) S L=L_"0"
I L<100 S L=100
S AMHDASH=L\100
Q
HEAD I 'AMHPG G HEAD1
I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S AMHQUIT="" Q
HEAD1 ;
W:$D(IOF) @IOF S AMHPG=AMHPG+1
W !?2,AMHDT,?72,"Page ",AMHPG
S AMHLENG=$L($P(^DIC(4,DUZ(2),0),U))
W !?((80-AMHLENG)/2),$P(^DIC(4,DUZ(2),0),U)
W !
W !,"TOP ",AMHLNO," ",AMHINF,"'s."
I $E(AMHRRPT)="P" W !,$S(AMHPRIM="P":"PRIMARY POV Only",1:"Both PRIMARY and SECONDARY POV's are included.")
W !,"DATES: ",AMHBDD," TO ",AMHEDD,!
I AMHCHRT="L" W !,"No.",?6,AMHHD1,?39,AMHHD2,?56,"# RECS",?65,"ACT TIME (HRS)"
I AMHCHRT="B" W !,AMHHD1
I AMHCHRT="L" W !,$TR($J(" ",80)," ","-")
I AMHCHRT="B" W !,$TR($J(" ",132)," ","-")
Q
AMHRTEN ; IHS/CMI/LAB - TOP TEN POVS ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
PREPROC ;
+1 DO XTMP^AMHUTIL("AMHTEN","BH - TOP TEN REPORT")
+2 SET %="^XTMP(""AMHTEN"",AMHJOB,AMHBT,"
SET AMHA=%_"""POV"",AMHPOV)"
SET AMHC=%_"1)"
SET E=%_"2)"
SET F=%_"3)"
SET G=%_"4)"
SET AMHTOT=0
SET AMHVTOT=0
SET AMHLINO=0
+3 QUIT
POSTPROC ;
+1 DO SET
+2 QUIT
+3 ;
+4 ;
SET ;
+1 ;AMHA,AMHC global references are set in PREPROC+1
SET AMHPOV=""
FOR
SET AMHPOV=$ORDER(@AMHA)
IF AMHPOV=""
QUIT
SET %=^(AMHPOV)
SET @AMHC@(9999999-%,AMHPOV)=""
S1 SET (X,I)=0
FOR
SET X=$ORDER(@AMHC@(X))
IF 'X
QUIT
FOR Y=0:0
SET Y=$ORDER(@AMHC@(X,Y))
IF 'Y
QUIT
SET I=I+1
SET @F@(I)=Y
IF I=AMHLNO
GOTO S2
S2 SET (X,I)=0
FOR
SET X=$ORDER(@E@(X))
IF 'X
QUIT
FOR Y=0:0
SET Y=$ORDER(@E@(X,Y))
IF 'Y
QUIT
SET I=I+1
SET @G@(I)=Y
IF I=AMHLNO
GOTO S3
S3 QUIT
+1 ;
+2 ;
+3 ;
PRNTPRE ;EP
+1 KILL DIRUT,DTOUT,DUOUT,DIR
PRIM ;
+1 SET AMHPRIM=""
+2 IF $EXTRACT(AMHRRPT)="A"
IF '$DATA(DIRUT)
GOTO CHRT
+3 SET DIR(0)="S^P:PRIMARY POV Only;S:PRIMARY and SECONDARY POV's"
SET DIR("A")="Include which POV's"
SET DIR("B")="P"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+4 IF $DATA(DIRUT)
SET AMHQUIT=1
QUIT
+5 SET AMHPRIM=Y
CHRT ;EP
+1 SET DIR(0)="S^L:List of items with Counts;B:Bar Chart (REQUIRES 132 COLUMN PRINTER)"
SET DIR("A")="Select Type of Report"
SET DIR("B")="L"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
SET AMHQUIT=1
QUIT
+3 SET AMHCHRT=Y
NUM ;get # entries
+1 SET DIR(0)="NO^5:"_$SELECT(AMHCHRT="B":35,1:100)_":0"
SET DIR("A")="How many entries do you want in the "_$SELECT(AMHCHRT="B":"bar chart",1:"list")
SET DIR("B")="10"
SET DIR("?")=""
DO ^DIR
IF $DATA(DUOUT)
SET DIRUT=1
KILL DIR
+2 IF $DATA(DIRUT)
GOTO CHRT
+3 SET AMHLNO=Y
+4 IF $DATA(DTOUT)!(Y=-1)
GOTO NUM
+5 QUIT
+6 ;
PRINT ;EP;PRINT TOP TEN RECORDS
+1 DO NOW^%DTC
SET Y=X
DO DD^%DT
SET AMHDT=Y
+2 SET Y=AMHBD
DO DD^%DT
SET AMHBDD=Y
SET Y=AMHED
DO DD^%DT
SET AMHEDD=Y
+3 DO COVPAGE^AMHRPTCP
+4 SET AMHPG=0
DO HEAD
+5 SET %="^XTMP(""AMHTEN"",AMHJOB,AMHBT,"
SET A=%_"""POV"",AMHPOV)"
SET B=%_"""APC"",AMHAPC)"
SET AMHC=%_"1)"
SET E=%_"2)"
SET F=%_"3)"
SET G=%_"4)"
+6 SET (J,I)=0
FOR
SET I=$ORDER(^XTMP("AMHTEN",AMHJOB,AMHBT,1,I))
IF I'=+I!($DATA(AMHQUIT))!(J>(AMHLNO-1))
QUIT
Begin DoDot:1
+7 SET AMHPOV=""
FOR
SET AMHPOV=$ORDER(^XTMP("AMHTEN",AMHJOB,AMHBT,1,I,AMHPOV))
IF AMHPOV=""!($DATA(AMHQUIT))
QUIT
SET J=J+1
Begin DoDot:2
+8 IF J=1
IF AMHCHRT="B"
DO SETDASH
+9 IF $Y>(IOSL-4)
DO HEAD
IF $DATA(AMHQUIT)
QUIT
+10 ;I AMHCHRT="L" W !,J,".",?6,$E(AMHPOV,1,30),?39,$E($P(@AMHA,U,2),1,15),?56,+(@AMHA),?66,$P(@AMHA,U,3) Q
+11 IF AMHCHRT="L"
WRITE !,J,".",?6,$EXTRACT(AMHPOV,1,30),?39,$EXTRACT($PIECE(@AMHA,U,2),1,15),?56,+(@AMHA),?66,$JUSTIFY(($PIECE(@AMHA,U,3)/60),7,1)
QUIT
+12 WRITE !,$EXTRACT(AMHPOV,1,17),?18," (",$EXTRACT($PIECE(@AMHA,U,2),1,6),")",?27,"|"
SET L=+(@AMHA)
SET D=L\AMHDASH
FOR %=1:1:D
WRITE "*"
+13 WRITE " ",+(@AMHA)
End DoDot:2
End DoDot:1
+14 IF AMHCHRT="B"
IF $GET(AMHDASH)
Begin DoDot:1
+15 WRITE !
SET J=27
FOR X=1:1:10
WRITE ?J,"|_________"
SET J=J+10
+16 WRITE "|",!
+17 SET J=27
FOR X=0:1:10
WRITE ?J,AMHDASH*10*X
SET J=J+10
End DoDot:1
PEXIT DO DONE^AMHLEIN
DO ^AMHEKL
QUIT
SETDASH ;set dash limits for bar chart
+1 NEW L,D
+2 SET L=+(@AMHA)
+3 SET M=$LENGTH(L)
SET F=$EXTRACT(L)+1
SET L=F
FOR %=1:1:(M-1)
SET L=L_"0"
+4 IF L<100
SET L=100
+5 SET AMHDASH=L\100
+6 QUIT
HEAD IF 'AMHPG
GOTO HEAD1
+1 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET AMHQUIT=""
QUIT
HEAD1 ;
+1 IF $DATA(IOF)
WRITE @IOF
SET AMHPG=AMHPG+1
+2 WRITE !?2,AMHDT,?72,"Page ",AMHPG
+3 SET AMHLENG=$LENGTH($PIECE(^DIC(4,DUZ(2),0),U))
+4 WRITE !?((80-AMHLENG)/2),$PIECE(^DIC(4,DUZ(2),0),U)
+5 WRITE !
+6 WRITE !,"TOP ",AMHLNO," ",AMHINF,"'s."
+7 IF $EXTRACT(AMHRRPT)="P"
WRITE !,$SELECT(AMHPRIM="P":"PRIMARY POV Only",1:"Both PRIMARY and SECONDARY POV's are included.")
+8 WRITE !,"DATES: ",AMHBDD," TO ",AMHEDD,!
+9 IF AMHCHRT="L"
WRITE !,"No.",?6,AMHHD1,?39,AMHHD2,?56,"# RECS",?65,"ACT TIME (HRS)"
+10 IF AMHCHRT="B"
WRITE !,AMHHD1
+11 IF AMHCHRT="L"
WRITE !,$TRANSLATE($JUSTIFY(" ",80)," ","-")
+12 IF AMHCHRT="B"
WRITE !,$TRANSLATE($JUSTIFY(" ",132)," ","-")
+13 QUIT
