APCLTENP ; IHS/CMI/LAB - cont. of top ten ;
;;2.0;IHS PCC SUITE;**7,11**;MAY 14, 2009;Build 58
;
;
PRINT W:$D(IOF) @IOF,?20,"***** FREQUENCY OF DIAGNOSIS REPORT *****",!!
COVPAGE ;EP
W:$D(IOF) @IOF
W !?20,"********** FREQUENCY OF DIAGNOSES REPORT **********"
S X=$P(^DIC(4,DUZ(2),0),U) W !,$$CTR("Report run at: "_X,80)
W !!,"REPORT REQUESTED BY: ",$P(^VA(200,DUZ,0),U)
W !!,"The following report contains a ",$S(APCLPTVS="V":"PCC Visit",1:"Patient")," report based on the",!,"following criteria:",!
SHOW ;
W !,$S(APCLPTVS="P":"PATIENT",1:"VISIT")," Selection Criteria"
W:APCLTYPE="D" !!?6,"Encounter Date range: ",APCLBDD," to ",APCLEDD,!
W:$G(APCLSEAT) !!?6,"Search Template: ",$P(^DIBT(APCLSEAT,0),U),!
I '$D(^APCLVRPT(APCLRPT,11)) W !!?5,"ALL VISITS IN DATE RANGE SELECTED." G EXCLP
S APCLI=0 F S APCLI=$O(^APCLVRPT(APCLRPT,11,APCLI)) Q:APCLI'=+APCLI D
.I $Y>(IOSL-5) D PAUSE^APCLVL01 W @IOF
.W !?6,$P(^APCLVSTS(APCLI,0),U),": "
.K APCLQ S APCLY=0,C=0 K APCLQ F S APCLY=$O(^APCLVRPT(APCLRPT,11,APCLI,11,"B",APCLY)) S C=C+1 W:C'=1&(APCLY'="") " ; " Q:APCLY=""!($D(APCLQ)) S X=APCLY X:$D(^APCLVSTS(APCLI,2)) ^(2) W X
EXCLP ;
K APCLQ
I $O(APCLDXT(0)),APCLEXCL=1 D
.W !!,"The following diagnoses are excluded"
.S APCLX=0 F S APCLX=$O(APCLDXT(APCLX)) Q:APCLX'=+APCLX!($D(APCLQ)) D
..I $Y>(IOSL-5) D PAUSE^APCLVL01 W:$D(IOF) @IOF
..W ":",$P($$ICDDX^ICDEX(APCLX),U,2) ;cmi/anch/maw 9/12/2007 csv
..Q
.Q
COUNT ;if COUNTING entries only
I $Y>(IOSL-5) D PAUSE^APCLVL01 W:$D(IOF) @IOF
I $D(APCLALL) W !!?5,"ALL (Primary and Secondary) POV's included.",!
I $D(APCLPRIM) W !!?5,"PRIMARY POV's Only",!
W:$D(APCLVTOT) !!!,"Total COUNT of ",$S(APCLPTVS="P":"Patients",1:"Visits"),": ",APCLVTOT
D PAUSE^APCLVL01
W:$D(IOF) @IOF
K APCLQUIT
W !?20,"********** FREQUENCY OF DIAGNOSES REPORT **********"
PPOV I $E(IOST)="C",IO=IO(0),$Y>(IOSL-4) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCLQUIT="" Q
S %="^XTMP(""APCLTEN"",APCLJOB,APCLBT,",A=%_"""POV"",APCLPOV)",B=%_"""APC"",APCLAPC)",C=%_"1)",E=%_"2)",F=%_"3)",G=%_"4)"
W !!,"No. VISITs: ",APCLVTOT,?20,"No. POVs: ",APCLTOT,?40,"POV/VISIT ratio: ",$S(APCLVTOT>0:$J((APCLTOT/APCLVTOT),1,2),1:0)," (min. std. > 1.6)"
W !!!,"TOP ",APCLLNO," POV's =>" I APCLCHRT="L" W !,?58,"# Visits",?68,"# Patients"
S J=0 F I=1:1 Q:'$D(@F@(I))!($D(APCLQUIT)) D
.S APCLPOV=@F@(I)
.I $Y>(IOSL-4) D FF Q:$D(APCLQUIT)
.I I=1,APCLCHRT="B" D SETDASH(A)
.I APCLCHRT="L" W !?3,I,".",?7,$P($$ICDDX^ICDEX(APCLPOV),U,2),?17,$E($P($$ICDDX^ICDEX(APCLPOV),U,4),1,40) D Q ;cmi/anch/maw 9/12/2007 csv
..W ?58,@A,?70,$J($G(^XTMP("APCLTEN",APCLJOB,APCLBT,"PCOUNT",APCLPOV)),7,0)
.W !,$E($P($$ICDDX^ICDEX(APCLPOV),U,4),1,17),?18," (",$P($$ICDDX^ICDEX(APCLPOV),U,2),")",?27,"|" S L=+(@A),D=L\APCLDASH F %=1:1:D W "*" ;cmi/anch/maw 9/12/2007 csv
.W " ",+(@A)
.Q
G:$D(APCLQUIT) PEXIT
I $Y>(IOSL-5) D FF G:$D(APCLQUIT) PEXIT
I APCLCHRT="B" 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,APCLDASH*10*X S J=J+10
.W !!,"each * represents ",APCLDASH," POV"_$S(APCLDASH>1:"'s",1:""),!
I $Y>(IOSL-4) D FF G:$D(APCLQUIT) PEXIT
PAPC W !!,"TOP ",APCLLNO," DIAGNOSTIC CATEGORIES =>",!
F I=1:1 Q:'$D(@G@(I))!($D(APCLQUIT)) D
.S APCLAPC=@G@(I)
.I I=1,APCLCHRT="B" D SETDASH(B)
.I $Y>(IOSL-4) D FF Q:$D(APCLQUIT)
.I APCLCHRT="L" W !?3,I,".",?7,$P(^ICM(APCLAPC,0),U)," (",@B,")" Q
.W !,$E($P(^ICM(APCLAPC,0),U),1,25),?27,"|" S L=+(@B),D=L\APCLDASH F %=1:1:D W "*"
.W " ",+(@B)
.Q
I $Y>(IOSL-5) D FF G:$D(APCLQUIT) PEXIT
I APCLCHRT="B" 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,APCLDASH*10*X S J=J+10
.W !!,"each * represents ",APCLDASH," POV"_$S(APCLDASH>1:"'s",1:""),!
PEXIT D DONE^APCLOSUT Q
;
SETDASH(APCLG) ;
NEW L,D,F,M
S L=+(@APCLG)
S M=$L(L),F=$E(L)+1,L=F F %=1:1:(M-1) S L=L_"0"
S:L<100 L=100
S APCLDASH=L\100
Q
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
FF I IOST["P-" W:$D(IOF) @IOF Q
I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S X="^",APCLQUIT=""
W:$D(IOF) @IOF
Q
;
APCLTENP ; IHS/CMI/LAB - cont. of top ten ;
+1 ;;2.0;IHS PCC SUITE;**7,11**;MAY 14, 2009;Build 58
+2 ;
+3 ;
PRINT IF $DATA(IOF)
WRITE @IOF,?20,"***** FREQUENCY OF DIAGNOSIS REPORT *****",!!
COVPAGE ;EP
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !?20,"********** FREQUENCY OF DIAGNOSES REPORT **********"
+3 SET X=$PIECE(^DIC(4,DUZ(2),0),U)
WRITE !,$$CTR("Report run at: "_X,80)
+4 WRITE !!,"REPORT REQUESTED BY: ",$PIECE(^VA(200,DUZ,0),U)
+5 WRITE !!,"The following report contains a ",$SELECT(APCLPTVS="V":"PCC Visit",1:"Patient")," report based on the",!,"following criteria:",!
SHOW ;
+1 WRITE !,$SELECT(APCLPTVS="P":"PATIENT",1:"VISIT")," Selection Criteria"
+2 IF APCLTYPE="D"
WRITE !!?6,"Encounter Date range: ",APCLBDD," to ",APCLEDD,!
+3 IF $GET(APCLSEAT)
WRITE !!?6,"Search Template: ",$PIECE(^DIBT(APCLSEAT,0),U),!
+4 IF '$DATA(^APCLVRPT(APCLRPT,11))
WRITE !!?5,"ALL VISITS IN DATE RANGE SELECTED."
GOTO EXCLP
+5 SET APCLI=0
FOR
SET APCLI=$ORDER(^APCLVRPT(APCLRPT,11,APCLI))
IF APCLI'=+APCLI
QUIT
Begin DoDot:1
+6 IF $Y>(IOSL-5)
DO PAUSE^APCLVL01
WRITE @IOF
+7 WRITE !?6,$PIECE(^APCLVSTS(APCLI,0),U),": "
+8 KILL APCLQ
SET APCLY=0
SET C=0
KILL APCLQ
FOR
SET APCLY=$ORDER(^APCLVRPT(APCLRPT,11,APCLI,11,"B",APCLY))
SET C=C+1
IF C'=1&(APCLY'="")
WRITE " ; "
IF APCLY=""!($DATA(APCLQ))
QUIT
SET X=APCLY
IF $DATA(^APCLVSTS(APCLI,2))
XECUTE ^(2)
WRITE X
End DoDot:1
EXCLP ;
+1 KILL APCLQ
+2 IF $ORDER(APCLDXT(0))
IF APCLEXCL=1
Begin DoDot:1
+3 WRITE !!,"The following diagnoses are excluded"
+4 SET APCLX=0
FOR
SET APCLX=$ORDER(APCLDXT(APCLX))
IF APCLX'=+APCLX!($DATA(APCLQ))
QUIT
Begin DoDot:2
+5 IF $Y>(IOSL-5)
DO PAUSE^APCLVL01
IF $DATA(IOF)
WRITE @IOF
+6 ;cmi/anch/maw 9/12/2007 csv
WRITE ":",$PIECE($$ICDDX^ICDEX(APCLX),U,2)
+7 QUIT
End DoDot:2
+8 QUIT
End DoDot:1
COUNT ;if COUNTING entries only
+1 IF $Y>(IOSL-5)
DO PAUSE^APCLVL01
IF $DATA(IOF)
WRITE @IOF
+2 IF $DATA(APCLALL)
WRITE !!?5,"ALL (Primary and Secondary) POV's included.",!
+3 IF $DATA(APCLPRIM)
WRITE !!?5,"PRIMARY POV's Only",!
+4 IF $DATA(APCLVTOT)
WRITE !!!,"Total COUNT of ",$SELECT(APCLPTVS="P":"Patients",1:"Visits"),": ",APCLVTOT
+5 DO PAUSE^APCLVL01
+6 IF $DATA(IOF)
WRITE @IOF
+7 KILL APCLQUIT
+8 WRITE !?20,"********** FREQUENCY OF DIAGNOSES REPORT **********"
PPOV IF $EXTRACT(IOST)="C"
IF IO=IO(0)
IF $Y>(IOSL-4)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET APCLQUIT=""
QUIT
+1 SET %="^XTMP(""APCLTEN"",APCLJOB,APCLBT,"
SET A=%_"""POV"",APCLPOV)"
SET B=%_"""APC"",APCLAPC)"
SET C=%_"1)"
SET E=%_"2)"
SET F=%_"3)"
SET G=%_"4)"
+2 WRITE !!,"No. VISITs: ",APCLVTOT,?20,"No. POVs: ",APCLTOT,?40,"POV/VISIT ratio: ",$SELECT(APCLVTOT>0:$JUSTIFY((APCLTOT/APCLVTOT),1,2),1:0)," (min. std. > 1.6)"
+3 WRITE !!!,"TOP ",APCLLNO," POV's =>"
IF APCLCHRT="L"
WRITE !,?58,"# Visits",?68,"# Patients"
+4 SET J=0
FOR I=1:1
IF '$DATA(@F@(I))!($DATA(APCLQUIT))
QUIT
Begin DoDot:1
+5 SET APCLPOV=@F@(I)
+6 IF $Y>(IOSL-4)
DO FF
IF $DATA(APCLQUIT)
QUIT
+7 IF I=1
IF APCLCHRT="B"
DO SETDASH(A)
+8 ;cmi/anch/maw 9/12/2007 csv
IF APCLCHRT="L"
WRITE !?3,I,".",?7,$PIECE($$ICDDX^ICDEX(APCLPOV),U,2),?17,$EXTRACT($PIECE($$ICDDX^ICDEX(APCLPOV),U,4),1,40)
Begin DoDot:2
+9 WRITE ?58,@A,?70,$JUSTIFY($GET(^XTMP("APCLTEN",APCLJOB,APCLBT,"PCOUNT",APCLPOV)),7,0)
End DoDot:2
QUIT
+10 ;cmi/anch/maw 9/12/2007 csv
WRITE !,$EXTRACT($PIECE($$ICDDX^ICDEX(APCLPOV),U,4),1,17),?18," (",$PIECE($$ICDDX^ICDEX(APCLPOV),U,2),")",?27,"|"
SET L=+(@A)
SET D=L\APCLDASH
FOR %=1:1:D
WRITE "*"
+11 WRITE " ",+(@A)
+12 QUIT
End DoDot:1
+13 IF $DATA(APCLQUIT)
GOTO PEXIT
+14 IF $Y>(IOSL-5)
DO FF
IF $DATA(APCLQUIT)
GOTO PEXIT
+15 IF APCLCHRT="B"
Begin DoDot:1
+16 WRITE !
SET J=27
FOR X=1:1:10
WRITE ?J,"|_________"
SET J=J+10
+17 WRITE "|",!
+18 SET J=27
FOR X=0:1:10
WRITE ?J,APCLDASH*10*X
SET J=J+10
+19 WRITE !!,"each * represents ",APCLDASH," POV"_$SELECT(APCLDASH>1:"'s",1:""),!
End DoDot:1
+20 IF $Y>(IOSL-4)
DO FF
IF $DATA(APCLQUIT)
GOTO PEXIT
PAPC WRITE !!,"TOP ",APCLLNO," DIAGNOSTIC CATEGORIES =>",!
+1 FOR I=1:1
IF '$DATA(@G@(I))!($DATA(APCLQUIT))
QUIT
Begin DoDot:1
+2 SET APCLAPC=@G@(I)
+3 IF I=1
IF APCLCHRT="B"
DO SETDASH(B)
+4 IF $Y>(IOSL-4)
DO FF
IF $DATA(APCLQUIT)
QUIT
+5 IF APCLCHRT="L"
WRITE !?3,I,".",?7,$PIECE(^ICM(APCLAPC,0),U)," (",@B,")"
QUIT
+6 WRITE !,$EXTRACT($PIECE(^ICM(APCLAPC,0),U),1,25),?27,"|"
SET L=+(@B)
SET D=L\APCLDASH
FOR %=1:1:D
WRITE "*"
+7 WRITE " ",+(@B)
+8 QUIT
End DoDot:1
+9 IF $Y>(IOSL-5)
DO FF
IF $DATA(APCLQUIT)
GOTO PEXIT
+10 IF APCLCHRT="B"
Begin DoDot:1
+11 WRITE !
SET J=27
FOR X=1:1:10
WRITE ?J,"|_________"
SET J=J+10
+12 WRITE "|",!
+13 SET J=27
FOR X=0:1:10
WRITE ?J,APCLDASH*10*X
SET J=J+10
+14 WRITE !!,"each * represents ",APCLDASH," POV"_$SELECT(APCLDASH>1:"'s",1:""),!
End DoDot:1
PEXIT DO DONE^APCLOSUT
QUIT
+1 ;
SETDASH(APCLG) ;
+1 NEW L,D,F,M
+2 SET L=+(@APCLG)
+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 APCLDASH=L\100
+6 QUIT
CTR(X,Y) ;EP - Center X in a field Y wide.
+1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
+2 ;----------
FF IF IOST["P-"
IF $DATA(IOF)
WRITE @IOF
QUIT
+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 X="^"
SET APCLQUIT=""
+2 IF $DATA(IOF)
WRITE @IOF
+3 QUIT
+4 ;
