- 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
