BCHRTEN ; IHS/CMI/LAB - TOP TEN POVS ;
;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
;IHS/CMI/LAB - tmp to xtmp
PREPROC ;
S %="^XTMP(""BCHTEN"",BCHJOB,BCHBT,",BCHA=%_"""POV"",BCHPOV)",BCHC=%_"1)",E=%_"2)",F=%_"3)",G=%_"4)",BCHTOT=0,BCHVTOT=0
Q
POSTPROC ;
D SET
Q
;
;
SET ;
S BCHPOV="" F S BCHPOV=$O(@BCHA) Q:BCHPOV="" S %=^(BCHPOV),@BCHC@(9999999-%,BCHPOV)="" ;BCHA,BCHC global references are set in PREPROC+1
S1 S (X,I)=0 F S X=$O(@BCHC@(X)) Q:'X F Y=0:0 S Y=$O(@BCHC@(X,Y)) Q:'Y S I=I+1,@F@(I)=Y I I=BCHLNO 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=BCHLNO G S3
S3 Q
;
;
;
PRNTPRE ;EP
PRIM ;
S BCHPRIM=""
I $E(BCHRRPT)="A" 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 BCHQUIT=1 Q
S BCHPRIM=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) G PRIM
S BCHCHRT=Y
NUM ;get # entries
S DIR(0)="NO^5:"_$S(BCHCHRT="B":35,1:100)_":0",DIR("A")="How many entries do you want in the "_$S(BCHCHRT="B":"bar chart",1:"list"),DIR("B")="10",DIR("?")="" D ^DIR S:$D(DUOUT) DIRUT=1 K DIR
I $D(DIRUT) G CHRT
S BCHLNO=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 BCHDT=Y
S Y=BCHBD D DD^%DT S BCHBDD=Y S Y=BCHED D DD^%DT S BCHEDD=Y
D COVPAGE^BCHRPTCP
S BCHPG=0 D HEAD
S %="^XTMP(""BCHTEN"",BCHJOB,BCHBT,",A=%_"""POV"",BCHPOV)",B=%_"""APC"",BCHAPC)",BCHC=%_"1)",E=%_"2)",F=%_"3)",G=%_"4)"
S (J,I)=0 F S I=$O(^XTMP("BCHTEN",BCHJOB,BCHBT,1,I)) Q:I'=+I!($D(BCHQUIT))!(J>(BCHLNO-1)) D
.S BCHPOV="" F S BCHPOV=$O(^XTMP("BCHTEN",BCHJOB,BCHBT,1,I,BCHPOV)) Q:BCHPOV=""!($D(BCHQUIT)) S J=J+1 D
..I J=1,BCHCHRT="B" D SETDASH
..I $Y>(IOSL-4) D HEAD Q:$D(BCHQUIT)
..I BCHCHRT="L" W !,J,".",?6,$E(BCHPOV,1,30),?36,$E($P(@BCHA,U,2),1,15),?56,+(@BCHA),?66,$J(($P(@BCHA,U,3)/60),7,1) Q
..W !,$E(BCHPOV,1,17),?18," (",$E($P(@BCHA,U,2),1,6),")",?27,"|" S L=+(@BCHA),D=L\BCHDASH F %=1:1:D W "*"
..W " ",+(@BCHA)
I BCHCHRT="B",$G(BCHDASH) 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,BCHDASH*10*X S J=J+10
PEXIT D DONE^BCHUTIL1 Q
SETDASH ;set dash limits for bar chart
NEW L,D
S L=+(@BCHA)
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 BCHDASH=L\100
Q
HEAD I 'BCHPG 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 BCHQUIT="" Q
HEAD1 ;
W:$D(IOF) @IOF S BCHPG=BCHPG+1
W !?2,BCHDT,?72,"Page ",BCHPG
S BCHLENG=$L($P(^DIC(4,DUZ(2),0),U))
W !?((80-BCHLENG)/2),$P(^DIC(4,DUZ(2),0),U)
W !
W !,"TOP ",BCHLNO," ",BCHINF,"'s."
I $E(BCHRRPT)="P" W !,$S(BCHPRIM="P":"PRIMARY POV Only",1:"Both PRIMARY and SECONDARY POV's are included.")
W !,"DATES: ",BCHBDD," TO ",BCHEDD,!
I BCHCHRT="L" W !,"No.",?6,BCHHD1,?36,BCHHD2,?52,"# Activities",?65,"ACT TIME (hrs)"
I BCHCHRT="B" W !,BCHHD1
I BCHCHRT="L" W !,$TR($J(" ",80)," ","-")
I BCHCHRT="B" W !,$TR($J(" ",132)," ","-")
Q
BCHRTEN ; IHS/CMI/LAB - TOP TEN POVS ;
+1 ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
+2 ;IHS/CMI/LAB - tmp to xtmp
PREPROC ;
+1 SET %="^XTMP(""BCHTEN"",BCHJOB,BCHBT,"
SET BCHA=%_"""POV"",BCHPOV)"
SET BCHC=%_"1)"
SET E=%_"2)"
SET F=%_"3)"
SET G=%_"4)"
SET BCHTOT=0
SET BCHVTOT=0
+2 QUIT
POSTPROC ;
+1 DO SET
+2 QUIT
+3 ;
+4 ;
SET ;
+1 ;BCHA,BCHC global references are set in PREPROC+1
SET BCHPOV=""
FOR
SET BCHPOV=$ORDER(@BCHA)
IF BCHPOV=""
QUIT
SET %=^(BCHPOV)
SET @BCHC@(9999999-%,BCHPOV)=""
S1 SET (X,I)=0
FOR
SET X=$ORDER(@BCHC@(X))
IF 'X
QUIT
FOR Y=0:0
SET Y=$ORDER(@BCHC@(X,Y))
IF 'Y
QUIT
SET I=I+1
SET @F@(I)=Y
IF I=BCHLNO
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=BCHLNO
GOTO S3
S3 QUIT
+1 ;
+2 ;
+3 ;
PRNTPRE ;EP
PRIM ;
+1 SET BCHPRIM=""
+2 IF $EXTRACT(BCHRRPT)="A"
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 BCHQUIT=1
QUIT
+5 SET BCHPRIM=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)
GOTO PRIM
+3 SET BCHCHRT=Y
NUM ;get # entries
+1 SET DIR(0)="NO^5:"_$SELECT(BCHCHRT="B":35,1:100)_":0"
SET DIR("A")="How many entries do you want in the "_$SELECT(BCHCHRT="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 BCHLNO=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 BCHDT=Y
+2 SET Y=BCHBD
DO DD^%DT
SET BCHBDD=Y
SET Y=BCHED
DO DD^%DT
SET BCHEDD=Y
+3 DO COVPAGE^BCHRPTCP
+4 SET BCHPG=0
DO HEAD
+5 SET %="^XTMP(""BCHTEN"",BCHJOB,BCHBT,"
SET A=%_"""POV"",BCHPOV)"
SET B=%_"""APC"",BCHAPC)"
SET BCHC=%_"1)"
SET E=%_"2)"
SET F=%_"3)"
SET G=%_"4)"
+6 SET (J,I)=0
FOR
SET I=$ORDER(^XTMP("BCHTEN",BCHJOB,BCHBT,1,I))
IF I'=+I!($DATA(BCHQUIT))!(J>(BCHLNO-1))
QUIT
Begin DoDot:1
+7 SET BCHPOV=""
FOR
SET BCHPOV=$ORDER(^XTMP("BCHTEN",BCHJOB,BCHBT,1,I,BCHPOV))
IF BCHPOV=""!($DATA(BCHQUIT))
QUIT
SET J=J+1
Begin DoDot:2
+8 IF J=1
IF BCHCHRT="B"
DO SETDASH
+9 IF $Y>(IOSL-4)
DO HEAD
IF $DATA(BCHQUIT)
QUIT
+10 IF BCHCHRT="L"
WRITE !,J,".",?6,$EXTRACT(BCHPOV,1,30),?36,$EXTRACT($PIECE(@BCHA,U,2),1,15),?56,+(@BCHA),?66,$JUSTIFY(($PIECE(@BCHA,U,3)/60),7,1)
QUIT
+11 WRITE !,$EXTRACT(BCHPOV,1,17),?18," (",$EXTRACT($PIECE(@BCHA,U,2),1,6),")",?27,"|"
SET L=+(@BCHA)
SET D=L\BCHDASH
FOR %=1:1:D
WRITE "*"
+12 WRITE " ",+(@BCHA)
End DoDot:2
End DoDot:1
+13 IF BCHCHRT="B"
IF $GET(BCHDASH)
Begin DoDot:1
+14 WRITE !
SET J=27
FOR X=1:1:10
WRITE ?J,"|_________"
SET J=J+10
+15 WRITE "|",!
+16 SET J=27
FOR X=0:1:10
WRITE ?J,BCHDASH*10*X
SET J=J+10
End DoDot:1
PEXIT DO DONE^BCHUTIL1
QUIT
SETDASH ;set dash limits for bar chart
+1 NEW L,D
+2 SET L=+(@BCHA)
+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 BCHDASH=L\100
+6 QUIT
HEAD IF 'BCHPG
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 BCHQUIT=""
QUIT
HEAD1 ;
+1 IF $DATA(IOF)
WRITE @IOF
SET BCHPG=BCHPG+1
+2 WRITE !?2,BCHDT,?72,"Page ",BCHPG
+3 SET BCHLENG=$LENGTH($PIECE(^DIC(4,DUZ(2),0),U))
+4 WRITE !?((80-BCHLENG)/2),$PIECE(^DIC(4,DUZ(2),0),U)
+5 WRITE !
+6 WRITE !,"TOP ",BCHLNO," ",BCHINF,"'s."
+7 IF $EXTRACT(BCHRRPT)="P"
WRITE !,$SELECT(BCHPRIM="P":"PRIMARY POV Only",1:"Both PRIMARY and SECONDARY POV's are included.")
+8 WRITE !,"DATES: ",BCHBDD," TO ",BCHEDD,!
+9 IF BCHCHRT="L"
WRITE !,"No.",?6,BCHHD1,?36,BCHHD2,?52,"# Activities",?65,"ACT TIME (hrs)"
+10 IF BCHCHRT="B"
WRITE !,BCHHD1
+11 IF BCHCHRT="L"
WRITE !,$TRANSLATE($JUSTIFY(" ",80)," ","-")
+12 IF BCHCHRT="B"
WRITE !,$TRANSLATE($JUSTIFY(" ",132)," ","-")
+13 QUIT
