BCHRCHP ; IHS/CMI/LAB - HIGHTLISTS Report ;
;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
;IHS/CMI/LAB - tmp to xtmp
;
;
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
S BCHPG=0
I BCHTT=0 D HEAD W "NO DATA TO REPORT" G DONE
S BCHTH=BCHTT/60
PROB ;
S BCHPROC="P"
D @("HEAD"_(2-($E(IOST,1,2)="C-")))
;
S (BCHX,C)=0 F S BCHX=$O(^XTMP("BCHRCH",BCHJOB,BCHBT,"TOP PROBS",BCHX)) Q:BCHX'=+BCHX!(C>BCHLNO)!($D(BCHQUIT)) D
.S BCHY=0 F S BCHY=$O(^XTMP("BCHRCH",BCHJOB,BCHBT,"TOP PROBS",BCHX,BCHY)) Q:BCHY'=+BCHY!($D(BCHQUIT)) S C=C+1 D
..S H=$P(^XTMP("BCHRCH",BCHJOB,BCHBT,"TOP PROBS",BCHX,BCHY),U,2),P=$P(^(BCHY),U,3)*100,H=H/60
..I $Y>(IOSL-4) D HEAD Q:$D(BCHQUIT)
..I BCHCHRT="L" W !,$P(^BCHTPROB(BCHY,0),U),?36,$J($FN(H,",",1),10),?58,$J(P,5,1) Q
..I BCHCHRT="B" W !,$P(^BCHTPROB(BCHY,0),U),?23,$J($FN(H,",",0),6) D
... S Q=P+.5,Q=$P(Q,".") W ?32 F I=1:1:Q W "*"
...W " (",$J(P,5,1),"%)"
...Q
..Q
.Q
G:$D(BCHQUIT) DONE
TOTALP ;
I $Y>(IOSL-4) D HEAD G:$D(BCHQUIT) DONE
W !!,"ALL HEALTH PROBLEMS"
I BCHCHRT="L" W ?36,$J($FN(BCHTH,",",1),10),?58,$J("100%",5)
I BCHCHRT="B" W ?23,$J($FN(BCHTH,",",0),6)
I $Y>(IOSL-5) D HEAD G:$D(BCHQUIT) DONE
W !!
ACT ;
G:$D(BCHQUIT) DONE
S BCHPROC="A"
I $Y>(IOSL-20) D HEAD G:$D(BCHQUIT) DONE G ACT1
D @BCHCHRT
ACT1 S (BCHX,C)=0 F S BCHX=$O(^XTMP("BCHRCH",BCHJOB,BCHBT,"TOP ACTS",BCHX)) Q:BCHX'=+BCHX!(C>BCHLNO)!($D(BCHQUIT)) D
.S BCHY=0 F S BCHY=$O(^XTMP("BCHRCH",BCHJOB,BCHBT,"TOP ACTS",BCHX,BCHY)) Q:BCHY'=+BCHY!($D(BCHQUIT)) S C=C+1 D
..S H=$P(^XTMP("BCHRCH",BCHJOB,BCHBT,"TOP ACTS",BCHX,BCHY),U,2),P=$P(^(BCHY),U,3)*100,H=H/60
..I $Y>(IOSL-4) D HEAD Q:$D(BCHQUIT)
..I BCHCHRT="L" W !,$P(^BCHTSERV(BCHY,0),U),?36,$J($FN(H,",",1),10),?58,$J(P,5,1) Q
..I BCHCHRT="B" W !,$P(^BCHTSERV(BCHY,0),U),?23,$J($FN(H,",",0),6) D
...S Q=P+.5,Q=$P(P,".") W ?32 F I=1:1:Q W "*"
...W " (",$J(P,5,1),"%)"
...Q
..Q
.Q
G:$D(BCHQUIT) DONE
TOTALA ;
I $Y>(IOSL-4) D HEAD G:$D(BCHQUIT) DONE
W !!,"ALL SERVICES"
I BCHCHRT="L" W ?36,$J($FN(BCHTH,",",1),10),?58,$J("100%",5)
I BCHCHRT="B" W ?23,$J($FN(BCHTH,",",0),6)
I $Y>(IOSL-5) D HEAD G:$D(BCHQUIT) DONE
W !!
DONE D DONE^BCHUTIL1
K ^XTMP("BCHRCH",BCHJOB,BCHBT),BCHJOB,BCHBT
Q
HEAD ;
;I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I BCHY=0!(Y="^")!($D(DTOUT)) S BCHQUIT="" Q
I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I BCHY=0!(Y=0)!($D(DUOUT)) S BCHQUIT="" Q
HEAD1 ; if terminal
W:$D(IOF) @IOF
;
HEAD2 ; if printer
S BCHPG=BCHPG+1
W !,"DATE PRINTED: ",BCHDT,?$S(BCHCHRT="L":72,1:121),"Page ",BCHPG,!
W $$CTR^BCHRLU($$LOC^BCHRLU),!
W !,"COMMUNITY HEALTH REPRESENTATIVE REPORT 13 -- HIGHLIGHTS"
W !,"TOP ",BCHLNO," HEALTH PROBLEMS AND SERVICES"
S BCHPROGN=$S(BCHPRG:$P(^BCHTPROG(BCHPRG,0),U)_" ("_$P(^(0),U,5)_")",1:"ALL"),X=$L(BCHPROGN)+10
W !,"PROGRAM: ",BCHPROGN
S BCHPROVN=$S(BCHPROVT="O":$P(^VA(200,BCHCHR1,0),U),1:"ALL"),X=$L(BCHPROGN)+10
W !,"PROVIDER: ",BCHPROVN
W !,"PATIENTS: ",BCHREGN
W !,"REPORTING PERIOD: ",BCHBDD," TO ",BCHEDD,!
I BCHCHRT="L" D L
I BCHCHRT="B" D B
Q
L ;
Q:$G(BCHPROC)=""
W !,$S(BCHPROC="P":"HEALTH PROBLEM",1:"SERVICE"),?35,"SERVICE & TRAVEL",?58,"% OF TOTAL",!?40,"HOURS"
W !,$TR($J(" ",80)," ","-")
Q
B ;
Q:$G(BCHPROC)=""
W !,$S(BCHPROC="P":"HEALTH PROBLEM",1:"SERVICE"),?23," S+T" S J=38 F I=10:10:100 W ?J,I,"%" S J=J+10
W !?23,"HOURS" S J=41 F I=1:1:10 W ?J,"|" S J=J+10
BCHRCHP ; IHS/CMI/LAB - HIGHTLISTS Report ;
+1 ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
+2 ;IHS/CMI/LAB - tmp to xtmp
+3 ;
+4 ;
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 SET BCHPG=0
+4 IF BCHTT=0
DO HEAD
WRITE "NO DATA TO REPORT"
GOTO DONE
+5 SET BCHTH=BCHTT/60
PROB ;
+1 SET BCHPROC="P"
+2 DO @("HEAD"_(2-($EXTRACT(IOST,1,2)="C-")))
+3 ;
+4 SET (BCHX,C)=0
FOR
SET BCHX=$ORDER(^XTMP("BCHRCH",BCHJOB,BCHBT,"TOP PROBS",BCHX))
IF BCHX'=+BCHX!(C>BCHLNO)!($DATA(BCHQUIT))
QUIT
Begin DoDot:1
+5 SET BCHY=0
FOR
SET BCHY=$ORDER(^XTMP("BCHRCH",BCHJOB,BCHBT,"TOP PROBS",BCHX,BCHY))
IF BCHY'=+BCHY!($DATA(BCHQUIT))
QUIT
SET C=C+1
Begin DoDot:2
+6 SET H=$PIECE(^XTMP("BCHRCH",BCHJOB,BCHBT,"TOP PROBS",BCHX,BCHY),U,2)
SET P=$PIECE(^(BCHY),U,3)*100
SET H=H/60
+7 IF $Y>(IOSL-4)
DO HEAD
IF $DATA(BCHQUIT)
QUIT
+8 IF BCHCHRT="L"
WRITE !,$PIECE(^BCHTPROB(BCHY,0),U),?36,$JUSTIFY($FNUMBER(H,",",1),10),?58,$JUSTIFY(P,5,1)
QUIT
+9 IF BCHCHRT="B"
WRITE !,$PIECE(^BCHTPROB(BCHY,0),U),?23,$JUSTIFY($FNUMBER(H,",",0),6)
Begin DoDot:3
+10 SET Q=P+.5
SET Q=$PIECE(Q,".")
WRITE ?32
FOR I=1:1:Q
WRITE "*"
+11 WRITE " (",$JUSTIFY(P,5,1),"%)"
+12 QUIT
End DoDot:3
+13 QUIT
End DoDot:2
+14 QUIT
End DoDot:1
+15 IF $DATA(BCHQUIT)
GOTO DONE
TOTALP ;
+1 IF $Y>(IOSL-4)
DO HEAD
IF $DATA(BCHQUIT)
GOTO DONE
+2 WRITE !!,"ALL HEALTH PROBLEMS"
+3 IF BCHCHRT="L"
WRITE ?36,$JUSTIFY($FNUMBER(BCHTH,",",1),10),?58,$JUSTIFY("100%",5)
+4 IF BCHCHRT="B"
WRITE ?23,$JUSTIFY($FNUMBER(BCHTH,",",0),6)
+5 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(BCHQUIT)
GOTO DONE
+6 WRITE !!
ACT ;
+1 IF $DATA(BCHQUIT)
GOTO DONE
+2 SET BCHPROC="A"
+3 IF $Y>(IOSL-20)
DO HEAD
IF $DATA(BCHQUIT)
GOTO DONE
GOTO ACT1
+4 DO @BCHCHRT
ACT1 SET (BCHX,C)=0
FOR
SET BCHX=$ORDER(^XTMP("BCHRCH",BCHJOB,BCHBT,"TOP ACTS",BCHX))
IF BCHX'=+BCHX!(C>BCHLNO)!($DATA(BCHQUIT))
QUIT
Begin DoDot:1
+1 SET BCHY=0
FOR
SET BCHY=$ORDER(^XTMP("BCHRCH",BCHJOB,BCHBT,"TOP ACTS",BCHX,BCHY))
IF BCHY'=+BCHY!($DATA(BCHQUIT))
QUIT
SET C=C+1
Begin DoDot:2
+2 SET H=$PIECE(^XTMP("BCHRCH",BCHJOB,BCHBT,"TOP ACTS",BCHX,BCHY),U,2)
SET P=$PIECE(^(BCHY),U,3)*100
SET H=H/60
+3 IF $Y>(IOSL-4)
DO HEAD
IF $DATA(BCHQUIT)
QUIT
+4 IF BCHCHRT="L"
WRITE !,$PIECE(^BCHTSERV(BCHY,0),U),?36,$JUSTIFY($FNUMBER(H,",",1),10),?58,$JUSTIFY(P,5,1)
QUIT
+5 IF BCHCHRT="B"
WRITE !,$PIECE(^BCHTSERV(BCHY,0),U),?23,$JUSTIFY($FNUMBER(H,",",0),6)
Begin DoDot:3
+6 SET Q=P+.5
SET Q=$PIECE(P,".")
WRITE ?32
FOR I=1:1:Q
WRITE "*"
+7 WRITE " (",$JUSTIFY(P,5,1),"%)"
+8 QUIT
End DoDot:3
+9 QUIT
End DoDot:2
+10 QUIT
End DoDot:1
+11 IF $DATA(BCHQUIT)
GOTO DONE
TOTALA ;
+1 IF $Y>(IOSL-4)
DO HEAD
IF $DATA(BCHQUIT)
GOTO DONE
+2 WRITE !!,"ALL SERVICES"
+3 IF BCHCHRT="L"
WRITE ?36,$JUSTIFY($FNUMBER(BCHTH,",",1),10),?58,$JUSTIFY("100%",5)
+4 IF BCHCHRT="B"
WRITE ?23,$JUSTIFY($FNUMBER(BCHTH,",",0),6)
+5 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(BCHQUIT)
GOTO DONE
+6 WRITE !!
DONE DO DONE^BCHUTIL1
+1 KILL ^XTMP("BCHRCH",BCHJOB,BCHBT),BCHJOB,BCHBT
+2 QUIT
HEAD ;
+1 ;I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I BCHY=0!(Y="^")!($D(DTOUT)) S BCHQUIT="" Q
+2 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF BCHY=0!(Y=0)!($DATA(DUOUT))
SET BCHQUIT=""
QUIT
HEAD1 ; if terminal
+1 IF $DATA(IOF)
WRITE @IOF
+2 ;
HEAD2 ; if printer
+1 SET BCHPG=BCHPG+1
+2 WRITE !,"DATE PRINTED: ",BCHDT,?$SELECT(BCHCHRT="L":72,1:121),"Page ",BCHPG,!
+3 WRITE $$CTR^BCHRLU($$LOC^BCHRLU),!
+4 WRITE !,"COMMUNITY HEALTH REPRESENTATIVE REPORT 13 -- HIGHLIGHTS"
+5 WRITE !,"TOP ",BCHLNO," HEALTH PROBLEMS AND SERVICES"
+6 SET BCHPROGN=$SELECT(BCHPRG:$PIECE(^BCHTPROG(BCHPRG,0),U)_" ("_$PIECE(^(0),U,5)_")",1:"ALL")
SET X=$LENGTH(BCHPROGN)+10
+7 WRITE !,"PROGRAM: ",BCHPROGN
+8 SET BCHPROVN=$SELECT(BCHPROVT="O":$PIECE(^VA(200,BCHCHR1,0),U),1:"ALL")
SET X=$LENGTH(BCHPROGN)+10
+9 WRITE !,"PROVIDER: ",BCHPROVN
+10 WRITE !,"PATIENTS: ",BCHREGN
+11 WRITE !,"REPORTING PERIOD: ",BCHBDD," TO ",BCHEDD,!
+12 IF BCHCHRT="L"
DO L
+13 IF BCHCHRT="B"
DO B
+14 QUIT
L ;
+1 IF $GET(BCHPROC)=""
QUIT
+2 WRITE !,$SELECT(BCHPROC="P":"HEALTH PROBLEM",1:"SERVICE"),?35,"SERVICE & TRAVEL",?58,"% OF TOTAL",!?40,"HOURS"
+3 WRITE !,$TRANSLATE($JUSTIFY(" ",80)," ","-")
+4 QUIT
B ;
+1 IF $GET(BCHPROC)=""
QUIT
+2 WRITE !,$SELECT(BCHPROC="P":"HEALTH PROBLEM",1:"SERVICE"),?23," S+T"
SET J=38
FOR I=10:10:100
WRITE ?J,I,"%"
SET J=J+10
+3 WRITE !?23,"HOURS"
SET J=41
FOR I=1:1:10
WRITE ?J,"|"
SET J=J+10
