BGP9DH ; IHS/CMI/LAB - cover page for gpra 28 Apr 2008 11:30 AM 02 Jul 2008 9:25 AM ;
;;9.0;IHS CLINICAL REPORTING;**1**;JUL 01, 2009
;
S BGPQHDR=0,BGPHPG=0
D HDR
Q:BGPQHDR
D MD
D PD
I BGPRTYPE=1,$G(BGPDESGP) W !!,"Designated Provider: ",$P(^VA(200,BGPDESGP,0),U,1)
D ENDTIME
I BGPRTYPE=4,BGP9RPTH="C" D COMHDR
I BGPRTYPE=4,BGP9RPTH="P" D PPHDR
I BGPRTYPE=4,BGP9RPTH="A" D ALLHDR
I BGPRTYPE=1,'$G(BGP9GPU),'$G(BGPSUMON) D GPRAHDR
I BGPRTYPE=1,'$G(BGP9GPU),$G(BGPSUMON) D GPRAHDRS
I BGPRTYPE=1,$G(BGP9GPU) D COMHDR
I BGPRTYPE=6 D PEHDR
I BGPRTYPE=7 D ONMHDR
Q:BGPQHDR
I $Y>(BGPIOSL-3) D HDR Q:BGPQHDR
I $G(BGPEXPT),BGPRTYPE=1,'$G(BGPNGR09) W !!,"A file will be created called BG09",$P(^AUTTLOC(DUZ(2),0),U,10)_"."_BGPRPT,".",!,"It will reside in the public/export directory.",!,"This file should be sent to your Area Office.",!
I $Y>(BGPIOSL-3) D HDR Q:BGPQHDR
I $G(BGPEXPT),BGPRTYPE=7 W !!,"A file will be created called BG09",$P(^AUTTLOC(DUZ(2),0),U,10)_".ONM"_BGPRPT,".",!,"It will reside in the public/export directory.",!,"This file should be sent to your Area Office.",!
I $Y>(BGPIOSL-3) D HDR Q:BGPQHDR
I $G(BGPYWCHW)=2 W !!,"HT/WT filename: ",BGPFN,!
I BGPRTYPE=6,$G(BGPPEEXP) D Q:BGPQHDR
.I $Y>(BGPIOSL-3) D HDR Q:BGPQHDR
.W !,"A file will be created called BG09",$P(^AUTTLOC(DUZ(2),0),U,10)_".PED"_BGPRPT," and will reside",!,"in the public/exort directory.",!,"This file should be sent to your Area Office.",!
I BGPROT'="P",'$D(BGPGUI) D Q:BGPQHDR
.I $Y>(BGPIOSL-2) D HDR Q:BGPQHDR
.W !,"A delimited output file called ",BGPDELF,!,"has been placed in the public directory for your use in Excel or some",!,"other software package.",!,"See your site manager to access this file.",!
I $G(BGPALLPT) D Q:BGPQHDR
.I $Y>(BGPIOSL-2) D HDR Q:BGPQHDR
.W !!,"All Communities Included.",!
I BGP9RPTH="P" K BGPX,BGPQUIT
I '$G(BGPALLPT),'$G(BGPSEAT) D Q:BGPQHDR
.I $Y>(BGPIOSL-2) D HDR Q:BGPQHDR
.W !?10,"Community Taxonomy Name: ",$P(^ATXAX(BGPTAXI,0),U)
I '$G(BGPALLPT),'$G(BGPSEAT) D Q:BGPQHDR
.W !?10,"The following communities are included in this report:",! D
..S BGPZZ="",BGPN=0,BGPY="" F S BGPZZ=$O(BGPTAX(BGPZZ)) Q:BGPZZ=""!(BGPQHDR) S BGPN=BGPN+1,BGPY=BGPY_$S(BGPN=1:"",1:";")_BGPZZ
..S BGPZZ=0,C=0 F BGPZZ=1:3:BGPN D Q:BGPQHDR
...I $Y>(BGPIOSL-2) D HDR Q:BGPQHDR
...W !?10,$E($P(BGPY,";",BGPZZ),1,20),?30,$E($P(BGPY,";",(BGPZZ+1)),1,20),?60,$E($P(BGPY,";",(BGPZZ+2)),1,20)
Q:BGPQHDR
I $G(BGPMFITI) W !!?10,"MFI Visit Location Taxonomy Name: ",$P(^ATXAX(BGPMFITI,0),U)
I $G(BGPMFITI) W !?10,"The following Locations are used for patient visits in this report:",! D
.S BGPZZ="",BGPN=0,BGPY="" F S BGPZZ=$O(^ATXAX(BGPMFITI,21,"B",BGPZZ)) Q:BGPZZ="" S BGPN=BGPN+1,BGPY=BGPY_$S(BGPN=1:"",1:";")_$P($G(^DIC(4,BGPZZ,0)),U)
.S BGPZZ=0,C=0 F BGPZZ=1:3:BGPN D Q:BGPQHDR
..I $Y>(BGPIOSL-2) D HDR Q:BGPQHDR
..W !?10,$E($P(BGPY,";",BGPZZ),1,20),?30,$E($P(BGPY,";",(BGPZZ+1)),1,20),?60,$E($P(BGPY,";",(BGPZZ+2)),1,20)
..Q
K BGPX,BGPQUIT
Q
;
MD ;
I BGPRTYPE=6 W !!,"Measures: Patient Education Performance Measures"
I BGPRTYPE=4 W !!,"Measures: ",$P($T(@BGPINDT),";;",2)
I BGPRTYPE=1 W !!,"Measures: GPRA, GPRA Developmental, and PART Denominators and Numerators and ",!,"Selected Other Clinical Denominators and Numerators"
I BGPRTYPE=7 W !!,"Measures: Key Clinical Denominators and Numerators for Non-GPRA National",!,"Reporting"
Q
;
PD ;
I BGPRTYPE=1,$G(BGP9GPU) W !,"Population: ",$S(BGPBEN=1:"AI/AN Only (Classification 01)",BGPBEN=2:"non AI/AN Only (Classification NOT 01)",BGPBEN=3:"All (Both AI/AN and non AI/AN)",1:"")
I BGPRTYPE=4,BGP9RPTH'="P" W !,"Population: ",$S(BGPBEN=1:"AI/AN Only (Classification 01)",BGPBEN=2:"non AI/AN Only (Classification NOT 01)",BGPBEN=3:"All (Both AI/AN and non AI/AN)",1:"")
I BGPRTYPE=4,BGP9RPTH="P" W !,"Population: ",$P(^DIBT(BGPSEAT,0),U)
I BGPRTYPE=1,'$G(BGP9GPU)!(BGPRTYPE=7) W !!,"Population: AI/AN Only (Classification 01)"
I BGPRTYPE=6,'$G(BGPSEAT) W !,"Population: ",$S(BGPBEN=1:"AI/AN Only (Classification 01)",BGPBEN=2:"non AI/AN Only (Classification NOT 01)",BGPBEN=3:"All (Both AI/AN and non AI/AN)",1:"")
I BGPRTYPE=6,$G(BGPSEAT) W !!,"Patient Population: ",$P(^DIBT(BGPSEAT,0),U)
I BGPRTYPE=7 W !,"Population: ",$S(BGPBEN=1:"AI/AN Only (Classification 01)",BGPBEN=2:"non AI/AN Only (Classification NOT 01)",BGPBEN=3:"All (Both AI/AN and non AI/AN)",1:"")
Q
;
HDR ;EP
I 'BGPHPG G HDR1
I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BGPQHDR=1 Q
HDR1 ;
S BGPHPG=BGPHPG+1 I BGPHPG'=1 W:$D(IOF) @IOF
W !,$$CTR("Cover Page "_BGPHPG,80)
I BGPRTYPE=4,$G(BGP9RPTH)="C" W !!,$$CTR("*** IHS 2009 Selected Measures with Community Specified Report ***",80) G N
I BGPRTYPE=4,$G(BGP9RPTH)="A" W !!,$$CTR("*** IHS 2009 Selected Measures with All Communities Report ***",80) G N
I BGPRTYPE=4,$G(BGP9RPTH)="P" W !!,$$CTR("*** IHS 2009 Selected Measures with Patient Panel Population Report ***",80)
I BGPRTYPE=6,'$G(BGPEDPP) W !!,$$CTR("*** IHS 2009 Patient Education with Community Specified Report ***",80)
I BGPRTYPE=6,$G(BGPEDPP) W !!,$$CTR("*** IHS 2009 Patient Education with Patient Panel Population Report ***",80)
I BGPRTYPE=1,$G(BGPNGR09) W !!,$$CTR("*** IHS 2010 National GPRA & PART Report, Run Using 2009 Logic ***",80) G N
I BGPRTYPE=1,$G(BGPDESGP) W !!,$$CTR("*** IHS 2009 National GPRA & PART Report by Designated Provider ***",80) G N
I BGPRTYPE=1,'$G(BGP9GPU),'$G(BGPSUMON) W !!,$$CTR("*** IHS 2009 National GPRA & PART Report ***",80)
I BGPRTYPE=1,'$G(BGP9GPU),$G(BGPSUMON) W !!,$$CTR("*** IHS 2009 National GPRA & PART Report Clinical Performance Summaries ***",80)
I BGPRTYPE=1,$G(BGP9GPU) W !!,$$CTR("*** IHS 2009 GPRA Performance & PART Report ***",80)
I BGPRTYPE=7 W !!,$$CTR("*** IHS 2009 Other National Measures Report ***",80)
N ;
I $G(BGPCPPL) W !,$$CTR("** Including Comprehensive Patient List **",80)
W !,$$CTR($$RPTVER^BGP9BAN,80)
W !,$$CTR("Date Report Run: "_$$FMTE^XLFDT(DT),80)
W !,$$CTR("Site where Run: "_$P(^DIC(4,DUZ(2),0),U),80)
W !,$$CTR("Report Generated by: "_$$USR,80)
S X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED) W !,$$CTR(X,80)
S X="Previous Year Period: "_$$FMTE^XLFDT(BGPPBD)_" to "_$$FMTE^XLFDT(BGPPED) W !,$$CTR(X,80)
S X="Baseline Period: "_$$FMTE^XLFDT(BGPBBD)_" to "_$$FMTE^XLFDT(BGPBED) W !,$$CTR(X,80)
W !!
Q
PEHDR ;
D PEHDR^BGP9DH1
Q
COMHDR ;
D COMHDR^BGP9DH1
Q
ONMHDR ;
D ONMHDR^BGP9DH1
Q
;
PPHDR ;
D PPHDR^BGP9DH1
Q
DENOMHDR ;
W !
Q:$G(BGPSEAT)
S BGPX=$O(^BGPCTRL("B",2009,0))
S BGPY=0 F S BGPY=$O(^BGPCTRL(BGPX,13,BGPY)) Q:BGPY'=+BGPY!(BGPQHDR) D
.I $Y>(BGPIOSL-2) D HDR Q:BGPQHDR
.W !,^BGPCTRL(BGPX,13,BGPY,0)
.Q
W !
Q
ALLHDR ;
D ALLHDR^BGP9DH1
Q
AREAHDR ;
W !
S BGPX=$O(^BGPCTRL("B",2009,0))
S BGPY=0 F S BGPY=$O(^BGPCTRL(BGPX,15,BGPY)) Q:BGPY'=+BGPY!(BGPQHDR) D
.I $Y>(BGPIOSL-2) D HDR Q:BGPQHDR
.W !,^BGPCTRL(BGPX,15,BGPY,0)
.Q
Q
GPRAHDRA ;
W !
S BGPX=$O(^BGPCTRL("B",2009,0))
S BGPNODEP=$S(BGPCHSO&('BGPCHSN):23,(BGPCHSO+BGPCHSN)=2:29,1:14)
S BGPY=0 F S BGPY=$O(^BGPCTRL(BGPX,BGPNODEP,BGPY)) Q:BGPY'=+BGPY!(BGPQHDR) D
.I $Y>(BGPIOSL-2) D AHDR^BGP9DH1 Q:BGPQHDR
.W !,^BGPCTRL(BGPX,BGPNODEP,BGPY,0)
.Q
Q
GPRAHDRS ;
D GPRAHDRS^BGP9DH1
Q
COMHDRA ;
W !
S BGPX=$O(^BGPCTRL("B",2009,0))
S BGPNODEP=$S(BGPCHSO&('BGPCHSN):24,(BGPCHSO+BGPCHSN)=2:31,1:17)
S BGPY=0 F S BGPY=$O(^BGPCTRL(BGPX,BGPNODEP,BGPY)) Q:BGPY'=+BGPY!(BGPQHDR) D
.I $Y>(BGPIOSL-2) D AHDR^BGP9DH1 Q:BGPQHDR
.W !,^BGPCTRL(BGPX,BGPNODEP,BGPY,0)
.Q
I $G(BGP9GPU) W !,"See last pages of this report for Performance Summaries."
Q
GPRAHDR ;
W !
S BGPNODEP=$S(BGPCHSO:23,1:14)
S BGPX=$O(^BGPCTRL("B",2009,0))
S BGPY=0 F S BGPY=$O(^BGPCTRL(BGPX,BGPNODEP,BGPY)) Q:BGPY'=+BGPY!(BGPQHDR) D
.I $Y>(BGPIOSL-2) D HDR Q:BGPQHDR
.W !,^BGPCTRL(BGPX,BGPNODEP,BGPY,0)
.Q
Q
ENDTIME ;
I $D(BGPET) S BGPTS=(86400*($P(BGPET,",")-$P(BGPBT,",")))+($P(BGPET,",",2)-$P(BGPBT,",",2)),BGPHR=$P(BGPTS/3600,".") S:BGPHR="" BGPHR=0 D
.S BGPTS=BGPTS-(BGPHR*3600),BGPM=$P(BGPTS/60,".") S:BGPM="" BGPM=0 S BGPTS=BGPTS-(BGPM*60),BGPS=BGPTS W !!,"RUN TIME (H.M.S): ",BGPHR,".",BGPM,".",BGPS
Q
;
AREACP ;EP -
S BGPQHDR=0,BGPHPG=0
D AHDR^BGP9DH1
Q:BGPQHDR
D MD
D PD
D ENDTIME
I BGPRTYPE=6 D PEDCP Q
S BGPCHSO="",X=0 F S X=$O(BGPSUL(X)) Q:X'=+X I $P(^BGPGPDCN(X,0),U,17) S BGPCHSO=1
S BGPCHSN="",X=0 F S X=$O(BGPSUL(X)) Q:X'=+X I '$P(^BGPGPDCN(X,0),U,17) S BGPCHSN=1
I BGPRTYPE=1,'$G(BGP9GPU) D GPRAHDRA
I BGPRTYPE=1,$G(BGP9GPU) D COMHDRA
I BGPRTYPE=7 D ONMHDR
I $G(BGPEXCEL),'$G(BGP9GPU),BGPRTYPE=1 W !!,"National GPRA filenames: ",!?15,BGPFGNT1,!?15,BGPFGNT2,!?15,BGPFGNT3,!?15,BGPFGNT4
I $G(BGPEXCEL),BGPRTYPE=7 W !,"Other National Measures filenames: ",!,?15,BGPFONN1,!?15,BGPFONN2,!?15,BGPFONN3
I BGPROT'="P",'$D(BGPGUI) W !!,"A delimited output file called ",BGPDELF,!,"has been placed in the public directory for your use in Excel or some",!,"other software package. See your site manager to access this file.",!
W !!?1,"Report includes data from the following facilities:"
NEW BGPX
S BGPX="",BGPC=0 F S BGPX=$O(BGPSUL(BGPX)) Q:BGPX=""!(BGPQHDR) D
.I $Y>(BGPIOSL-3) D AHDR^BGP9DH1 Q:BGPQHDR
.S BGPC=BGPC+1
.S X=$P(^BGPGPDCN(BGPX,0),U,9),X=$O(^AUTTLOC("C",X,0)) S X=$S(X:$P(^DIC(4,X,0),U),1:"?????")
.W !?3,BGPC,". ",$S($P(^BGPGPDCN(BGPX,0),U,17):"*",1:""),X
W !!?1,"The following communities are included in this report:"
NEW BGPX
S BGPX="",BGPC=0 F S BGPX=$O(BGPSUL(BGPX)) Q:BGPX=""!(BGPQHDR) D
.I $Y>(BGPIOSL-3) D AHDR^BGP9DH1 Q:BGPQHDR
.S BGPC=BGPC+1
.S X=$P(^BGPGPDCN(BGPX,0),U,9),X=$O(^AUTTLOC("C",X,0)) S X=$S(X:$P(^DIC(4,X,0),U),1:"?????")
.W !!?3,BGPC,". ",$S($P(^BGPGPDCN(BGPX,0),U,17):"*",1:""),X
.W !?3,"Community Taxonomy Name: ",$P(^BGPGPDCN(BGPX,0),U,18)
.;W !?5,"Communities: "
.S BGPXX=0,BGPXN=0,BGPXY="" F S BGPXX=$O(^BGPGPDCN(BGPX,9999,BGPXX)) Q:BGPXX'=+BGPXX S BGPXN=BGPXN+1,BGPXY=BGPXY_$S(BGPXN=1:"",1:";")_$P(^BGPGPDCN(BGPX,9999,BGPXX,0),U)
.S BGPX1=0,C=0 F BGPX1=1:3:BGPXN D
..I $Y>(BGPIOSL-2) D AHDR^BGP9DH1 Q:BGPQHDR
..W !?10,$E($P(BGPXY,";",BGPX1),1,20),?30,$E($P(BGPXY,";",(BGPX1+1)),1,20),?60,$E($P(BGPXY,";",(BGPX1+2)),1,20)
.Q:BGPQHDR
.I $O(^BGPGPDCN(BGPX,1111,0)) D
..I $Y>(BGPIOSL-2) D AHDR^BGP9DH1 Q:BGPQHDR
..W !!?5,"MFI Visit Locations: " S BGPXX=0,BGPXN=0,BGPXY="" F S BGPXX=$O(^BGPGPDCN(BGPX,1111,BGPXX)) Q:BGPXX'=+BGPXX S BGPXN=BGPXN+1,BGPXY=BGPXY_$S(BGPXN=1:"",1:";")_$P(^BGPGPDCN(BGPX,1111,BGPXX,0),U)
..S BGPX1=0,C=0 F BGPX1=1:3:BGPXN Q:BGPQHDR W !?10,$E($P(BGPXY,";",BGPX1),1,18),?30,$E($P(BGPXY,";",(BGPX1+1)),1,20),?60,$E($P(BGPXY,";",(BGPX1+2)),1,18)
.Q
Q:BGPQHDR
I BGPCHSO D
.I $Y>(BGPIOSL-2) D AHDR^BGP9DH1 Q:BGPQHDR
.W !!,"* CHS-only site. Uses Active Clinical CHS Population definition vs. Active",!,"Clinical."
K BGPX,BGPQUIT
Q
PEDCP ;
D PEHDR
I BGPROT'="P",'$D(BGPGUI) W !!,"A delimited output file called ",BGPDELF,!,"has been placed in the public directory for your use in Excel or some",!,"other software package. See your site manager to access this file.",!
W !!?1,"Report includes data from the following facilities:"
NEW BGPX
S BGPX="",BGPC=0 F S BGPX=$O(BGPSUL(BGPX)) Q:BGPX=""!(BGPQHDR) D
.I $Y>(BGPIOSL-3) D AHDR^BGP9DH1 Q:BGPQHDR
.S BGPC=BGPC+1
.S X=$P(^BGPPEDCN(BGPX,0),U,9),X=$O(^AUTTLOC("C",X,0)) S X=$S(X:$P(^DIC(4,X,0),U),1:"?????")
.W !?3,BGPC,". ",$S($P(^BGPPEDCN(BGPX,0),U,17):"*",1:""),X
W !!?1,"The following communities are included in this report:"
NEW BGPX
S BGPX="",BGPC=0 F S BGPX=$O(BGPSUL(BGPX)) Q:BGPX=""!(BGPQHDR) D
.I $Y>(BGPIOSL-3) D AHDR^BGP9DH1 Q:BGPQHDR
.S BGPC=BGPC+1
.S X=$P(^BGPPEDCN(BGPX,0),U,9),X=$O(^AUTTLOC("C",X,0)) S X=$S(X:$P(^DIC(4,X,0),U),1:"?????")
.W !!?3,BGPC,". ",$S($P(^BGPPEDCN(BGPX,0),U,17):"*",1:""),X
.W !?5,"Communities: " S BGPXX=0,BGPXN=0,BGPXY="" F S BGPXX=$O(^BGPPEDCN(BGPX,9999,BGPXX)) Q:BGPXX'=+BGPXX S BGPXN=BGPXN+1,BGPXY=BGPXY_$S(BGPXN=1:"",1:";")_$P(^BGPPEDCN(BGPX,9999,BGPXX,0),U)
.S BGPX1=0,C=0 F BGPX1=1:3:BGPXN D
..I $Y>(BGPIOSL-2) D AHDR^BGP9DH1 Q:BGPQHDR
..W !?10,$E($P(BGPXY,";",BGPX1),1,20),?30,$E($P(BGPXY,";",(BGPX1+1)),1,20),?60,$E($P(BGPXY,";",(BGPX1+2)),1,20)
.Q:BGPQHDR
.I $O(^BGPPEDCN(BGPX,1111,0)) D
..I $Y>(BGPIOSL-2) D AHDR^BGP9DH1 Q:BGPQHDR
..W !!?5,"MFI Visit Locations: " S BGPXX=0,BGPXN=0,BGPXY="" F S BGPXX=$O(^BGPPEDCN(BGPX,1111,BGPXX)) Q:BGPXX'=+BGPXX S BGPXN=BGPXN+1,BGPXY=BGPXY_$S(BGPXN=1:"",1:";")_$P(^BGPPEDCN(BGPX,1111,BGPXX,0),U)
..S BGPX1=0,C=0 F BGPX1=1:3:BGPXN Q:BGPQHDR W !?10,$E($P(BGPXY,";",BGPX1),1,18),?30,$E($P(BGPXY,";",(BGPX1+1)),1,20),?60,$E($P(BGPXY,";",(BGPX1+2)),1,18)
.Q
Q:BGPQHDR
K BGPX,BGPQUIT
Q
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
EOP ;EP - End of page.
Q:$E(IOST)'="C"
Q:$D(ZTQUEUED)!$D(IO("S"))
NEW DIR
K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
S DIR(0)="E" D ^DIR
I $D(DIRUT) S BGPQHDR=1
Q
;----------
USR() ;EP - Return name of current user from ^VA(200.
Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
;----------
;;
E ;;Elder Care-Related Measures
G ;;GPRA Measures (All)
A ;;AREA Director Performance Measures (All)
H ;;HEDIS Measures (All)
D ;;Diabetes-Related Measures
C ;;Cardiovascular Disease Prevention for At-Risk Patients
S ;;Selected Measures (User Defined)
W ;;Women's Health-Related Measures
P ;;Prevention Related Indictors
;
BGP9DH ; IHS/CMI/LAB - cover page for gpra 28 Apr 2008 11:30 AM 02 Jul 2008 9:25 AM ;
+1 ;;9.0;IHS CLINICAL REPORTING;**1**;JUL 01, 2009
+2 ;
+3 SET BGPQHDR=0
SET BGPHPG=0
+4 DO HDR
+5 IF BGPQHDR
QUIT
+6 DO MD
+7 DO PD
+8 IF BGPRTYPE=1
IF $GET(BGPDESGP)
WRITE !!,"Designated Provider: ",$PIECE(^VA(200,BGPDESGP,0),U,1)
+9 DO ENDTIME
+10 IF BGPRTYPE=4
IF BGP9RPTH="C"
DO COMHDR
+11 IF BGPRTYPE=4
IF BGP9RPTH="P"
DO PPHDR
+12 IF BGPRTYPE=4
IF BGP9RPTH="A"
DO ALLHDR
+13 IF BGPRTYPE=1
IF '$GET(BGP9GPU)
IF '$GET(BGPSUMON)
DO GPRAHDR
+14 IF BGPRTYPE=1
IF '$GET(BGP9GPU)
IF $GET(BGPSUMON)
DO GPRAHDRS
+15 IF BGPRTYPE=1
IF $GET(BGP9GPU)
DO COMHDR
+16 IF BGPRTYPE=6
DO PEHDR
+17 IF BGPRTYPE=7
DO ONMHDR
+18 IF BGPQHDR
QUIT
+19 IF $Y>(BGPIOSL-3)
DO HDR
IF BGPQHDR
QUIT
+20 IF $GET(BGPEXPT)
IF BGPRTYPE=1
IF '$GET(BGPNGR09)
WRITE !!,"A file will be created called BG09",$PIECE(^AUTTLOC(DUZ(2),0),U,10)_"."_BGPRPT,".",!,"It will reside in the public/export directory.",!,"This file should be sent to your Area Office.",!
+21 IF $Y>(BGPIOSL-3)
DO HDR
IF BGPQHDR
QUIT
+22 IF $GET(BGPEXPT)
IF BGPRTYPE=7
WRITE !!,"A file will be created called BG09",$PIECE(^AUTTLOC(DUZ(2),0),U,10)_".ONM"_BGPRPT,".",!,"It will reside in the public/export directory.",!,"This file should be sent to your Area Office.",!
+23 IF $Y>(BGPIOSL-3)
DO HDR
IF BGPQHDR
QUIT
+24 IF $GET(BGPYWCHW)=2
WRITE !!,"HT/WT filename: ",BGPFN,!
+25 IF BGPRTYPE=6
IF $GET(BGPPEEXP)
Begin DoDot:1
+26 IF $Y>(BGPIOSL-3)
DO HDR
IF BGPQHDR
QUIT
+27 WRITE !,"A file will be created called BG09",$PIECE(^AUTTLOC(DUZ(2),0),U,10)_".PED"_BGPRPT," and will reside",!,"in the public/exort directory.",!,"This file should be sent to your Area Office.",!
End DoDot:1
IF BGPQHDR
QUIT
+28 IF BGPROT'="P"
IF '$DATA(BGPGUI)
Begin DoDot:1
+29 IF $Y>(BGPIOSL-2)
DO HDR
IF BGPQHDR
QUIT
+30 WRITE !,"A delimited output file called ",BGPDELF,!,"has been placed in the public directory for your use in Excel or some",!,"other software package.",!,"See your site manager to access this file.",!
End DoDot:1
IF BGPQHDR
QUIT
+31 IF $GET(BGPALLPT)
Begin DoDot:1
+32 IF $Y>(BGPIOSL-2)
DO HDR
IF BGPQHDR
QUIT
+33 WRITE !!,"All Communities Included.",!
End DoDot:1
IF BGPQHDR
QUIT
+34 IF BGP9RPTH="P"
KILL BGPX,BGPQUIT
+35 IF '$GET(BGPALLPT)
IF '$GET(BGPSEAT)
Begin DoDot:1
+36 IF $Y>(BGPIOSL-2)
DO HDR
IF BGPQHDR
QUIT
+37 WRITE !?10,"Community Taxonomy Name: ",$PIECE(^ATXAX(BGPTAXI,0),U)
End DoDot:1
IF BGPQHDR
QUIT
+38 IF '$GET(BGPALLPT)
IF '$GET(BGPSEAT)
Begin DoDot:1
+39 WRITE !?10,"The following communities are included in this report:",!
Begin DoDot:2
+40 SET BGPZZ=""
SET BGPN=0
SET BGPY=""
FOR
SET BGPZZ=$ORDER(BGPTAX(BGPZZ))
IF BGPZZ=""!(BGPQHDR)
QUIT
SET BGPN=BGPN+1
SET BGPY=BGPY_$SELECT(BGPN=1:"",1:";")_BGPZZ
+41 SET BGPZZ=0
SET C=0
FOR BGPZZ=1:3:BGPN
Begin DoDot:3
+42 IF $Y>(BGPIOSL-2)
DO HDR
IF BGPQHDR
QUIT
+43 WRITE !?10,$EXTRACT($PIECE(BGPY,";",BGPZZ),1,20),?30,$EXTRACT($PIECE(BGPY,";",(BGPZZ+1)),1,20),?60,$EXTRACT($PIECE(BGPY,";",(BGPZZ+2)),1,20)
End DoDot:3
IF BGPQHDR
QUIT
End DoDot:2
End DoDot:1
IF BGPQHDR
QUIT
+44 IF BGPQHDR
QUIT
+45 IF $GET(BGPMFITI)
WRITE !!?10,"MFI Visit Location Taxonomy Name: ",$PIECE(^ATXAX(BGPMFITI,0),U)
+46 IF $GET(BGPMFITI)
WRITE !?10,"The following Locations are used for patient visits in this report:",!
Begin DoDot:1
+47 SET BGPZZ=""
SET BGPN=0
SET BGPY=""
FOR
SET BGPZZ=$ORDER(^ATXAX(BGPMFITI,21,"B",BGPZZ))
IF BGPZZ=""
QUIT
SET BGPN=BGPN+1
SET BGPY=BGPY_$SELECT(BGPN=1:"",1:";")_$PIECE($GET(^DIC(4,BGPZZ,0)),U)
+48 SET BGPZZ=0
SET C=0
FOR BGPZZ=1:3:BGPN
Begin DoDot:2
+49 IF $Y>(BGPIOSL-2)
DO HDR
IF BGPQHDR
QUIT
+50 WRITE !?10,$EXTRACT($PIECE(BGPY,";",BGPZZ),1,20),?30,$EXTRACT($PIECE(BGPY,";",(BGPZZ+1)),1,20),?60,$EXTRACT($PIECE(BGPY,";",(BGPZZ+2)),1,20)
+51 QUIT
End DoDot:2
IF BGPQHDR
QUIT
End DoDot:1
+52 KILL BGPX,BGPQUIT
+53 QUIT
+54 ;
MD ;
+1 IF BGPRTYPE=6
WRITE !!,"Measures: Patient Education Performance Measures"
+2 IF BGPRTYPE=4
WRITE !!,"Measures: ",$PIECE($TEXT(@BGPINDT),";;",2)
+3 IF BGPRTYPE=1
WRITE !!,"Measures: GPRA, GPRA Developmental, and PART Denominators and Numerators and ",!,"Selected Other Clinical Denominators and Numerators"
+4 IF BGPRTYPE=7
WRITE !!,"Measures: Key Clinical Denominators and Numerators for Non-GPRA National",!,"Reporting"
+5 QUIT
+6 ;
PD ;
+1 IF BGPRTYPE=1
IF $GET(BGP9GPU)
WRITE !,"Population: ",$SELECT(BGPBEN=1:"AI/AN Only (Classification 01)",BGPBEN=2:"non AI/AN Only (Classification NOT 01)",BGPBEN=3:"All (Both AI/AN and non AI/AN)",1:"")
+2 IF BGPRTYPE=4
IF BGP9RPTH'="P"
WRITE !,"Population: ",$SELECT(BGPBEN=1:"AI/AN Only (Classification 01)",BGPBEN=2:"non AI/AN Only (Classification NOT 01)",BGPBEN=3:"All (Both AI/AN and non AI/AN)",1:"")
+3 IF BGPRTYPE=4
IF BGP9RPTH="P"
WRITE !,"Population: ",$PIECE(^DIBT(BGPSEAT,0),U)
+4 IF BGPRTYPE=1
IF '$GET(BGP9GPU)!(BGPRTYPE=7)
WRITE !!,"Population: AI/AN Only (Classification 01)"
+5 IF BGPRTYPE=6
IF '$GET(BGPSEAT)
WRITE !,"Population: ",$SELECT(BGPBEN=1:"AI/AN Only (Classification 01)",BGPBEN=2:"non AI/AN Only (Classification NOT 01)",BGPBEN=3:"All (Both AI/AN and non AI/AN)",1:"")
+6 IF BGPRTYPE=6
IF $GET(BGPSEAT)
WRITE !!,"Patient Population: ",$PIECE(^DIBT(BGPSEAT,0),U)
+7 IF BGPRTYPE=7
WRITE !,"Population: ",$SELECT(BGPBEN=1:"AI/AN Only (Classification 01)",BGPBEN=2:"non AI/AN Only (Classification NOT 01)",BGPBEN=3:"All (Both AI/AN and non AI/AN)",1:"")
+8 QUIT
+9 ;
HDR ;EP
+1 IF 'BGPHPG
GOTO HDR1
+2 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET BGPQHDR=1
QUIT
HDR1 ;
+1 SET BGPHPG=BGPHPG+1
IF BGPHPG'=1
IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,$$CTR("Cover Page "_BGPHPG,80)
+3 IF BGPRTYPE=4
IF $GET(BGP9RPTH)="C"
WRITE !!,$$CTR("*** IHS 2009 Selected Measures with Community Specified Report ***",80)
GOTO N
+4 IF BGPRTYPE=4
IF $GET(BGP9RPTH)="A"
WRITE !!,$$CTR("*** IHS 2009 Selected Measures with All Communities Report ***",80)
GOTO N
+5 IF BGPRTYPE=4
IF $GET(BGP9RPTH)="P"
WRITE !!,$$CTR("*** IHS 2009 Selected Measures with Patient Panel Population Report ***",80)
+6 IF BGPRTYPE=6
IF '$GET(BGPEDPP)
WRITE !!,$$CTR("*** IHS 2009 Patient Education with Community Specified Report ***",80)
+7 IF BGPRTYPE=6
IF $GET(BGPEDPP)
WRITE !!,$$CTR("*** IHS 2009 Patient Education with Patient Panel Population Report ***",80)
+8 IF BGPRTYPE=1
IF $GET(BGPNGR09)
WRITE !!,$$CTR("*** IHS 2010 National GPRA & PART Report, Run Using 2009 Logic ***",80)
GOTO N
+9 IF BGPRTYPE=1
IF $GET(BGPDESGP)
WRITE !!,$$CTR("*** IHS 2009 National GPRA & PART Report by Designated Provider ***",80)
GOTO N
+10 IF BGPRTYPE=1
IF '$GET(BGP9GPU)
IF '$GET(BGPSUMON)
WRITE !!,$$CTR("*** IHS 2009 National GPRA & PART Report ***",80)
+11 IF BGPRTYPE=1
IF '$GET(BGP9GPU)
IF $GET(BGPSUMON)
WRITE !!,$$CTR("*** IHS 2009 National GPRA & PART Report Clinical Performance Summaries ***",80)
+12 IF BGPRTYPE=1
IF $GET(BGP9GPU)
WRITE !!,$$CTR("*** IHS 2009 GPRA Performance & PART Report ***",80)
+13 IF BGPRTYPE=7
WRITE !!,$$CTR("*** IHS 2009 Other National Measures Report ***",80)
N ;
+1 IF $GET(BGPCPPL)
WRITE !,$$CTR("** Including Comprehensive Patient List **",80)
+2 WRITE !,$$CTR($$RPTVER^BGP9BAN,80)
+3 WRITE !,$$CTR("Date Report Run: "_$$FMTE^XLFDT(DT),80)
+4 WRITE !,$$CTR("Site where Run: "_$PIECE(^DIC(4,DUZ(2),0),U),80)
+5 WRITE !,$$CTR("Report Generated by: "_$$USR,80)
+6 SET X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED)
WRITE !,$$CTR(X,80)
+7 SET X="Previous Year Period: "_$$FMTE^XLFDT(BGPPBD)_" to "_$$FMTE^XLFDT(BGPPED)
WRITE !,$$CTR(X,80)
+8 SET X="Baseline Period: "_$$FMTE^XLFDT(BGPBBD)_" to "_$$FMTE^XLFDT(BGPBED)
WRITE !,$$CTR(X,80)
+9 WRITE !!
+10 QUIT
PEHDR ;
+1 DO PEHDR^BGP9DH1
+2 QUIT
COMHDR ;
+1 DO COMHDR^BGP9DH1
+2 QUIT
ONMHDR ;
+1 DO ONMHDR^BGP9DH1
+2 QUIT
+3 ;
PPHDR ;
+1 DO PPHDR^BGP9DH1
+2 QUIT
DENOMHDR ;
+1 WRITE !
+2 IF $GET(BGPSEAT)
QUIT
+3 SET BGPX=$ORDER(^BGPCTRL("B",2009,0))
+4 SET BGPY=0
FOR
SET BGPY=$ORDER(^BGPCTRL(BGPX,13,BGPY))
IF BGPY'=+BGPY!(BGPQHDR)
QUIT
Begin DoDot:1
+5 IF $Y>(BGPIOSL-2)
DO HDR
IF BGPQHDR
QUIT
+6 WRITE !,^BGPCTRL(BGPX,13,BGPY,0)
+7 QUIT
End DoDot:1
+8 WRITE !
+9 QUIT
ALLHDR ;
+1 DO ALLHDR^BGP9DH1
+2 QUIT
AREAHDR ;
+1 WRITE !
+2 SET BGPX=$ORDER(^BGPCTRL("B",2009,0))
+3 SET BGPY=0
FOR
SET BGPY=$ORDER(^BGPCTRL(BGPX,15,BGPY))
IF BGPY'=+BGPY!(BGPQHDR)
QUIT
Begin DoDot:1
+4 IF $Y>(BGPIOSL-2)
DO HDR
IF BGPQHDR
QUIT
+5 WRITE !,^BGPCTRL(BGPX,15,BGPY,0)
+6 QUIT
End DoDot:1
+7 QUIT
GPRAHDRA ;
+1 WRITE !
+2 SET BGPX=$ORDER(^BGPCTRL("B",2009,0))
+3 SET BGPNODEP=$SELECT(BGPCHSO&('BGPCHSN):23,(BGPCHSO+BGPCHSN)=2:29,1:14)
+4 SET BGPY=0
FOR
SET BGPY=$ORDER(^BGPCTRL(BGPX,BGPNODEP,BGPY))
IF BGPY'=+BGPY!(BGPQHDR)
QUIT
Begin DoDot:1
+5 IF $Y>(BGPIOSL-2)
DO AHDR^BGP9DH1
IF BGPQHDR
QUIT
+6 WRITE !,^BGPCTRL(BGPX,BGPNODEP,BGPY,0)
+7 QUIT
End DoDot:1
+8 QUIT
GPRAHDRS ;
+1 DO GPRAHDRS^BGP9DH1
+2 QUIT
COMHDRA ;
+1 WRITE !
+2 SET BGPX=$ORDER(^BGPCTRL("B",2009,0))
+3 SET BGPNODEP=$SELECT(BGPCHSO&('BGPCHSN):24,(BGPCHSO+BGPCHSN)=2:31,1:17)
+4 SET BGPY=0
FOR
SET BGPY=$ORDER(^BGPCTRL(BGPX,BGPNODEP,BGPY))
IF BGPY'=+BGPY!(BGPQHDR)
QUIT
Begin DoDot:1
+5 IF $Y>(BGPIOSL-2)
DO AHDR^BGP9DH1
IF BGPQHDR
QUIT
+6 WRITE !,^BGPCTRL(BGPX,BGPNODEP,BGPY,0)
+7 QUIT
End DoDot:1
+8 IF $GET(BGP9GPU)
WRITE !,"See last pages of this report for Performance Summaries."
+9 QUIT
GPRAHDR ;
+1 WRITE !
+2 SET BGPNODEP=$SELECT(BGPCHSO:23,1:14)
+3 SET BGPX=$ORDER(^BGPCTRL("B",2009,0))
+4 SET BGPY=0
FOR
SET BGPY=$ORDER(^BGPCTRL(BGPX,BGPNODEP,BGPY))
IF BGPY'=+BGPY!(BGPQHDR)
QUIT
Begin DoDot:1
+5 IF $Y>(BGPIOSL-2)
DO HDR
IF BGPQHDR
QUIT
+6 WRITE !,^BGPCTRL(BGPX,BGPNODEP,BGPY,0)
+7 QUIT
End DoDot:1
+8 QUIT
ENDTIME ;
+1 IF $DATA(BGPET)
SET BGPTS=(86400*($PIECE(BGPET,",")-$PIECE(BGPBT,",")))+($PIECE(BGPET,",",2)-$PIECE(BGPBT,",",2))
SET BGPHR=$PIECE(BGPTS/3600,".")
IF BGPHR=""
SET BGPHR=0
Begin DoDot:1
+2 SET BGPTS=BGPTS-(BGPHR*3600)
SET BGPM=$PIECE(BGPTS/60,".")
IF BGPM=""
SET BGPM=0
SET BGPTS=BGPTS-(BGPM*60)
SET BGPS=BGPTS
WRITE !!,"RUN TIME (H.M.S): ",BGPHR,".",BGPM,".",BGPS
End DoDot:1
+3 QUIT
+4 ;
AREACP ;EP -
+1 SET BGPQHDR=0
SET BGPHPG=0
+2 DO AHDR^BGP9DH1
+3 IF BGPQHDR
QUIT
+4 DO MD
+5 DO PD
+6 DO ENDTIME
+7 IF BGPRTYPE=6
DO PEDCP
QUIT
+8 SET BGPCHSO=""
SET X=0
FOR
SET X=$ORDER(BGPSUL(X))
IF X'=+X
QUIT
IF $PIECE(^BGPGPDCN(X,0),U,17)
SET BGPCHSO=1
+9 SET BGPCHSN=""
SET X=0
FOR
SET X=$ORDER(BGPSUL(X))
IF X'=+X
QUIT
IF '$PIECE(^BGPGPDCN(X,0),U,17)
SET BGPCHSN=1
+10 IF BGPRTYPE=1
IF '$GET(BGP9GPU)
DO GPRAHDRA
+11 IF BGPRTYPE=1
IF $GET(BGP9GPU)
DO COMHDRA
+12 IF BGPRTYPE=7
DO ONMHDR
+13 IF $GET(BGPEXCEL)
IF '$GET(BGP9GPU)
IF BGPRTYPE=1
WRITE !!,"National GPRA filenames: ",!?15,BGPFGNT1,!?15,BGPFGNT2,!?15,BGPFGNT3,!?15,BGPFGNT4
+14 IF $GET(BGPEXCEL)
IF BGPRTYPE=7
WRITE !,"Other National Measures filenames: ",!,?15,BGPFONN1,!?15,BGPFONN2,!?15,BGPFONN3
+15 IF BGPROT'="P"
IF '$DATA(BGPGUI)
WRITE !!,"A delimited output file called ",BGPDELF,!,"has been placed in the public directory for your use in Excel or some",!,"other software package. See your site manager to access this file.",!
+16 WRITE !!?1,"Report includes data from the following facilities:"
+17 NEW BGPX
+18 SET BGPX=""
SET BGPC=0
FOR
SET BGPX=$ORDER(BGPSUL(BGPX))
IF BGPX=""!(BGPQHDR)
QUIT
Begin DoDot:1
+19 IF $Y>(BGPIOSL-3)
DO AHDR^BGP9DH1
IF BGPQHDR
QUIT
+20 SET BGPC=BGPC+1
+21 SET X=$PIECE(^BGPGPDCN(BGPX,0),U,9)
SET X=$ORDER(^AUTTLOC("C",X,0))
SET X=$SELECT(X:$PIECE(^DIC(4,X,0),U),1:"?????")
+22 WRITE !?3,BGPC,". ",$SELECT($PIECE(^BGPGPDCN(BGPX,0),U,17):"*",1:""),X
End DoDot:1
+23 WRITE !!?1,"The following communities are included in this report:"
+24 NEW BGPX
+25 SET BGPX=""
SET BGPC=0
FOR
SET BGPX=$ORDER(BGPSUL(BGPX))
IF BGPX=""!(BGPQHDR)
QUIT
Begin DoDot:1
+26 IF $Y>(BGPIOSL-3)
DO AHDR^BGP9DH1
IF BGPQHDR
QUIT
+27 SET BGPC=BGPC+1
+28 SET X=$PIECE(^BGPGPDCN(BGPX,0),U,9)
SET X=$ORDER(^AUTTLOC("C",X,0))
SET X=$SELECT(X:$PIECE(^DIC(4,X,0),U),1:"?????")
+29 WRITE !!?3,BGPC,". ",$SELECT($PIECE(^BGPGPDCN(BGPX,0),U,17):"*",1:""),X
+30 WRITE !?3,"Community Taxonomy Name: ",$PIECE(^BGPGPDCN(BGPX,0),U,18)
+31 ;W !?5,"Communities: "
+32 SET BGPXX=0
SET BGPXN=0
SET BGPXY=""
FOR
SET BGPXX=$ORDER(^BGPGPDCN(BGPX,9999,BGPXX))
IF BGPXX'=+BGPXX
QUIT
SET BGPXN=BGPXN+1
SET BGPXY=BGPXY_$SELECT(BGPXN=1:"",1:";")_$PIECE(^BGPGPDCN(BGPX,9999,BGPXX,0),U)
+33 SET BGPX1=0
SET C=0
FOR BGPX1=1:3:BGPXN
Begin DoDot:2
+34 IF $Y>(BGPIOSL-2)
DO AHDR^BGP9DH1
IF BGPQHDR
QUIT
+35 WRITE !?10,$EXTRACT($PIECE(BGPXY,";",BGPX1),1,20),?30,$EXTRACT($PIECE(BGPXY,";",(BGPX1+1)),1,20),?60,$EXTRACT($PIECE(BGPXY,";",(BGPX1+2)),1,20)
End DoDot:2
+36 IF BGPQHDR
QUIT
+37 IF $ORDER(^BGPGPDCN(BGPX,1111,0))
Begin DoDot:2
+38 IF $Y>(BGPIOSL-2)
DO AHDR^BGP9DH1
IF BGPQHDR
QUIT
+39 WRITE !!?5,"MFI Visit Locations: "
SET BGPXX=0
SET BGPXN=0
SET BGPXY=""
FOR
SET BGPXX=$ORDER(^BGPGPDCN(BGPX,1111,BGPXX))
IF BGPXX'=+BGPXX
QUIT
SET BGPXN=BGPXN+1
SET BGPXY=BGPXY_$SELECT(BGPXN=1:"",1:";")_$PIECE(^BGPGPDCN(BGPX,1111,BGPXX,0),U)
+40 SET BGPX1=0
SET C=0
FOR BGPX1=1:3:BGPXN
IF BGPQHDR
QUIT
WRITE !?10,$EXTRACT($PIECE(BGPXY,";",BGPX1),1,18),?30,$EXTRACT($PIECE(BGPXY,";",(BGPX1+1)),1,20),?60,$EXTRACT($PIECE(BGPXY,";",(BGPX1+2)),1,18)
End DoDot:2
+41 QUIT
End DoDot:1
+42 IF BGPQHDR
QUIT
+43 IF BGPCHSO
Begin DoDot:1
+44 IF $Y>(BGPIOSL-2)
DO AHDR^BGP9DH1
IF BGPQHDR
QUIT
+45 WRITE !!,"* CHS-only site. Uses Active Clinical CHS Population definition vs. Active",!,"Clinical."
End DoDot:1
+46 KILL BGPX,BGPQUIT
+47 QUIT
PEDCP ;
+1 DO PEHDR
+2 IF BGPROT'="P"
IF '$DATA(BGPGUI)
WRITE !!,"A delimited output file called ",BGPDELF,!,"has been placed in the public directory for your use in Excel or some",!,"other software package. See your site manager to access this file.",!
+3 WRITE !!?1,"Report includes data from the following facilities:"
+4 NEW BGPX
+5 SET BGPX=""
SET BGPC=0
FOR
SET BGPX=$ORDER(BGPSUL(BGPX))
IF BGPX=""!(BGPQHDR)
QUIT
Begin DoDot:1
+6 IF $Y>(BGPIOSL-3)
DO AHDR^BGP9DH1
IF BGPQHDR
QUIT
+7 SET BGPC=BGPC+1
+8 SET X=$PIECE(^BGPPEDCN(BGPX,0),U,9)
SET X=$ORDER(^AUTTLOC("C",X,0))
SET X=$SELECT(X:$PIECE(^DIC(4,X,0),U),1:"?????")
+9 WRITE !?3,BGPC,". ",$SELECT($PIECE(^BGPPEDCN(BGPX,0),U,17):"*",1:""),X
End DoDot:1
+10 WRITE !!?1,"The following communities are included in this report:"
+11 NEW BGPX
+12 SET BGPX=""
SET BGPC=0
FOR
SET BGPX=$ORDER(BGPSUL(BGPX))
IF BGPX=""!(BGPQHDR)
QUIT
Begin DoDot:1
+13 IF $Y>(BGPIOSL-3)
DO AHDR^BGP9DH1
IF BGPQHDR
QUIT
+14 SET BGPC=BGPC+1
+15 SET X=$PIECE(^BGPPEDCN(BGPX,0),U,9)
SET X=$ORDER(^AUTTLOC("C",X,0))
SET X=$SELECT(X:$PIECE(^DIC(4,X,0),U),1:"?????")
+16 WRITE !!?3,BGPC,". ",$SELECT($PIECE(^BGPPEDCN(BGPX,0),U,17):"*",1:""),X
+17 WRITE !?5,"Communities: "
SET BGPXX=0
SET BGPXN=0
SET BGPXY=""
FOR
SET BGPXX=$ORDER(^BGPPEDCN(BGPX,9999,BGPXX))
IF BGPXX'=+BGPXX
QUIT
SET BGPXN=BGPXN+1
SET BGPXY=BGPXY_$SELECT(BGPXN=1:"",1:";")_$PIECE(^BGPPEDCN(BGPX,9999,BGPXX,0),U)
+18 SET BGPX1=0
SET C=0
FOR BGPX1=1:3:BGPXN
Begin DoDot:2
+19 IF $Y>(BGPIOSL-2)
DO AHDR^BGP9DH1
IF BGPQHDR
QUIT
+20 WRITE !?10,$EXTRACT($PIECE(BGPXY,";",BGPX1),1,20),?30,$EXTRACT($PIECE(BGPXY,";",(BGPX1+1)),1,20),?60,$EXTRACT($PIECE(BGPXY,";",(BGPX1+2)),1,20)
End DoDot:2
+21 IF BGPQHDR
QUIT
+22 IF $ORDER(^BGPPEDCN(BGPX,1111,0))
Begin DoDot:2
+23 IF $Y>(BGPIOSL-2)
DO AHDR^BGP9DH1
IF BGPQHDR
QUIT
+24 WRITE !!?5,"MFI Visit Locations: "
SET BGPXX=0
SET BGPXN=0
SET BGPXY=""
FOR
SET BGPXX=$ORDER(^BGPPEDCN(BGPX,1111,BGPXX))
IF BGPXX'=+BGPXX
QUIT
SET BGPXN=BGPXN+1
SET BGPXY=BGPXY_$SELECT(BGPXN=1:"",1:";")_$PIECE(^BGPPEDCN(BGPX,1111,BGPXX,0),U)
+25 SET BGPX1=0
SET C=0
FOR BGPX1=1:3:BGPXN
IF BGPQHDR
QUIT
WRITE !?10,$EXTRACT($PIECE(BGPXY,";",BGPX1),1,18),?30,$EXTRACT($PIECE(BGPXY,";",(BGPX1+1)),1,20),?60,$EXTRACT($PIECE(BGPXY,";",(BGPX1+2)),1,18)
End DoDot:2
+26 QUIT
End DoDot:1
+27 IF BGPQHDR
QUIT
+28 KILL BGPX,BGPQUIT
+29 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 ;----------
EOP ;EP - End of page.
+1 IF $EXTRACT(IOST)'="C"
QUIT
+2 IF $DATA(ZTQUEUED)!$DATA(IO("S"))
QUIT
+3 NEW DIR
+4 KILL DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
+5 SET DIR(0)="E"
DO ^DIR
+6 IF $DATA(DIRUT)
SET BGPQHDR=1
+7 QUIT
+8 ;----------
USR() ;EP - Return name of current user from ^VA(200.
+1 QUIT $SELECT($GET(DUZ):$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
+2 ;----------
+3 ;;
E ;;Elder Care-Related Measures
G ;;GPRA Measures (All)
A ;;AREA Director Performance Measures (All)
H ;;HEDIS Measures (All)
D ;;Diabetes-Related Measures
C ;;Cardiovascular Disease Prevention for At-Risk Patients
S ;;Selected Measures (User Defined)
W ;;Women's Health-Related Measures
P ;;Prevention Related Indictors
+1 ;
