- 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
