- 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
