- 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 ;
