BGP5DH ; IHS/CMI/LAB - cover page for gpra 28 Apr 2010 11:30 AM 02 Jul 2010 9:25 AM ; 19 Feb 2015 11:07 AM
;;15.1;IHS CLINICAL REPORTING;;MAY 06, 2015;Build 143
;
S BGPQHDR=0,BGPHPG=0
D HDR
I BGPPTYPE="P" Q:BGPQHDR
D MD
D PD
I BGPRTYPE=1,$G(BGPDESGP) D W^BGP5DP("Designated Provider: "_$P(^VA(200,BGPDESGP,0),U,1),0,2,BGPPTYPE)
D ENDTIME
I $G(BGPDASH) D DASH^BGP5DH2 G N1
I BGPRTYPE=4,BGPYRPTH="C" D COMHDR
I BGPRTYPE=4,BGPYRPTH="P" D PPHDR
I BGPRTYPE=4,BGPYRPTH="A" D ALLHDR
I BGPRTYPE=1,'$G(BGPYGPU),'$G(BGPSUMON) D GPRAHDR
I BGPRTYPE=1,'$G(BGPYGPU),$G(BGPSUMON) D GPRAHDRS
I BGPRTYPE=1,$G(BGPYGPU),'$G(BGPSEAT) D GPRAHDR
I BGPRTYPE=1,$G(BGPYGPU),$G(BGPSEAT) D GPUPPHDR^BGP5DH1
I BGPRTYPE=6 D PEHDR
I BGPRTYPE=7 D ONMHDR
N1 I BGPPTYPE="P" Q:BGPQHDR
I BGPPTYPE="P",$Y>(BGPIOSL-3) D HDR Q:BGPQHDR
I $G(BGPEXPT),BGPRTYPE=1 D ;,'$G(BGPNGR09) D
.D W^BGP5DP("A file will be created called BG151"_$P(^AUTTLOC(DUZ(2),0),U,10)_"."_BGPRPT,0,2,BGPPTYPE)
.D W^BGP5DP("It will reside in the "_BGPUF_" directory.",0,1,BGPPTYPE)
.D W^BGP5DP("This file should be sent to your Area Office.",0,1,BGPPTYPE)
.D W^BGP5DP("",0,1,BGPPTYPE)
I BGPPTYPE="P",$Y>(BGPIOSL-3) D HDR Q:BGPQHDR
I $G(BGPEXPT),BGPRTYPE=7 D
.D W^BGP5DP("A file will be created called BG151"_$P(^AUTTLOC(DUZ(2),0),U,10)_".ONM"_BGPRPT,0,2,BGPPTYPE)
.D W^BGP5DP("It will reside in the "_BGPUF_" directory.",0,1,BGPPTYPE)
.D W^BGP5DP("This file should be sent to your Area Office.",0,1,BGPPTYPE)
.D W^BGP5DP("",0,1,BGPPTYPE)
I BGPPTYPE="P",$Y>(BGPIOSL-3) D HDR Q:BGPQHDR
I BGPRTYPE=6,$G(BGPPEEXP) D Q:BGPQHDR
.I BGPPTYPE="P",$Y>(BGPIOSL-3) D HDR Q:BGPQHDR
.D W^BGP5DP("A file will be created called BG151"_$P(^AUTTLOC(DUZ(2),0),U,10)_".PED"_BGPRPT_" and will reside",0,1,BGPPTYPE)
.D W^BGP5DP("in the "_BGPUF_" directory. This file should be sent to your Area Office.",0,1,BGPPTYPE)
.D W^BGP5DP("",0,1,BGPPTYPE)
I BGPROT'="P",'$D(BGPGUI) D I BGPPTYPE="P" Q:BGPQHDR
.I BGPPTYPE="P",$Y>(BGPIOSL-2) D HDR Q:BGPQHDR
.I BGPDELF]"" D W^BGP5DP("A delimited output file called "_BGPDELF,0,2,BGPPTYPE) D
..D W^BGP5DP("has been placed in the "_$$GETDEDIR^BGP5UTL2()_" directory for your use in Excel or some",0,1,BGPPTYPE),W^BGP5DP("other software package. See your site manager to access this file.",0,1,BGPPTYPE)
I $G(BGPALLPT) D I BGPPTYPE="P" Q:BGPQHDR
.I BGPPTYPE="P",$Y>(BGPIOSL-2) D HDR Q:BGPQHDR
.D W^BGP5DP("All Communities Included.",0,2,BGPPTYPE)
I BGPYRPTH="P" K BGPX,BGPQUIT
I '$G(BGPALLPT),'$G(BGPSEAT) D I BGPPTYPE="P" Q:BGPQHDR
.I BGPPTYPE="P",$Y>(BGPIOSL-2) D HDR Q:BGPQHDR
.D W^BGP5DP("Community Taxonomy Name: "_$P(^ATXAX(BGPTAXI,0),U),0,2,BGPPTYPE,1,10)
.D W^BGP5DP("The following communities are included in this report:",0,1,BGPPTYPE,1,10) D
..S BGPZZ="",N=0,Y="" F S BGPZZ=$O(BGPTAX(BGPZZ)) Q:BGPZZ="" S N=N+1,Y=Y_$S(N=1:"",1:";")_BGPZZ
..S BGPZZ=0,C=0 F BGPZZ=1:3:N D
...D W^BGP5DP($E($P(Y,";",BGPZZ),1,20),0,1,BGPPTYPE,1,10)
...D W^BGP5DP($E($P(Y,";",(BGPZZ+1)),1,20),0,0,BGPPTYPE,2,30)
...D W^BGP5DP($E($P(Y,";",(BGPZZ+2)),1,20),0,0,BGPPTYPE,3,60)
...Q
D W^BGP5DP("",0,1,BGPPTYPE)
I BGPRTYPE'=6,BGPPTYPE="D" D W^BGP5DP("ENDCOVERPAGE",0,1,BGPPTYPE)
K BGPX,BGPQUIT
Q
;
MD ;EP
I $G(BGPDASH) D W^BGP5DP("Measures: GPRA Denominators and Numerators",0,1,BGPPTYPE) Q
I BGPRTYPE=6 D W^BGP5DP("Measures: Patient Education Performance Measures",0,1,BGPPTYPE) Q
I BGPRTYPE=4 D W^BGP5DP("Measures: "_$P($T(@BGPINDK),";;",2),0,1,BGPPTYPE) Q
I BGPRTYPE=1 D W^BGP5DP("Measures: GPRA Developmental, GPRA/GPRAMA Denominators and Numerators and",0,1,BGPPTYPE),W^BGP5DP("Selected Other Clinical Denominators and Numerators",0,1,BGPPTYPE) Q
I BGPRTYPE=7 D W^BGP5DP("Measures: Key Clinical Denominators and Numerators for Non-GPRA National",0,1,BGPPTYPE),W^BGP5DP("Reporting",0,1,BGPPTYPE) Q
Q
;
PD ;EP
I BGPRTYPE=1,$G(BGPYGPU),'$G(BGPSEAT) D W^BGP5DP("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:""),0,1,BGPPTYPE)
I BGPRTYPE=1,$G(BGPYGPU),$G(BGPSEAT) D W^BGP5DP("Patient Population: "_$P(^DIBT(BGPSEAT,0),U),0,2,BGPPTYPE)
I BGPRTYPE=4,BGPYRPTH'="P" D W^BGP5DP("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:""),0,1,BGPPTYPE)
I BGPRTYPE=4,BGPYRPTH="P" D W^BGP5DP("Population: "_$P(^DIBT(BGPSEAT,0),U),0,1,BGPPTYPE)
I BGPRTYPE=1,'$G(BGPYGPU)!(BGPRTYPE=7) D W^BGP5DP("Population: AI/AN Only (Classification 01)",0,2,BGPPTYPE)
I BGPRTYPE=6,'$G(BGPSEAT) D W^BGP5DP("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:""),0,1,BGPPTYPE)
I BGPRTYPE=6,$G(BGPSEAT) D W^BGP5DP("Patient Population: "_$P(^DIBT(BGPSEAT,0),U),0,2,BGPPTYPE)
I BGPRTYPE=7 D W^BGP5DP("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:""),0,1,BGPPTYPE)
Q
;
HDR ;EP
I BGPPTYPE="P",'BGPHPG G HDR1
I BGPPTYPE="P" 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 ;
I BGPPTYPE="P" S BGPHPG=BGPHPG+1 I BGPHPG'=1 W:$D(IOF) @IOF
I $G(BGPGUI),BGPPTYPE="P",BGPHPG'=1 D W^BGP5DP("ZZZZZZZ",0,0,BGPPTYPE),W^BGP5DP("",0,1,BGPPTYPE) ;GUI
D W^BGP5DP("Cover Page",1,2,BGPPTYPE)
I $G(BGPNPL) D W^BGP5DP("*** IHS 2015 GPRA/GPRAMA Patient List ***",1,2,BGPPTYPE) G N
I $G(BGPDASH) D W^BGP5DP("*** IHS 2015 National GPRA Dashboard ***",1,2,BGPPTYPE) G N
I BGPRTYPE=4,$G(BGPYRPTH)="C" D W^BGP5DP("*** IHS 2015 Selected Measures with Community Specified Report ***",1,2,BGPPTYPE) G N
I BGPRTYPE=4,$G(BGPYRPTH)="A" D W^BGP5DP("*** IHS 2015 Selected Measures with All Communities Report ***",1,2,BGPPTYPE) G N
I BGPRTYPE=4,$G(BGPYRPTH)="P" D W^BGP5DP("*** IHS 2015 Selected Measures with Patient Panel Population Report ***",1,2,BGPPTYPE) G N
I BGPRTYPE=6,'$G(BGPEDPP) D W^BGP5DP("*** IHS 2015 Patient Education with Community Specified Report ***",1,2,BGPPTYPE) G N
I BGPRTYPE=6,$G(BGPEDPP) D W^BGP5DP("*** IHS 2015 Patient Education with Patient Panel Population Report ***",1,2,BGPPTYPE) G N
I BGPRTYPE=1,$G(BGPNGR09) D W^BGP5DP("*** IHS 2015 National GPRA/GPRAMA Report, Run Using 2015 Logic ***",1,2,BGPPTYPE) G N
I BGPRTYPE=1,$G(BGPDESGP) D W^BGP5DP("*** IHS 2015 National GPRA/GPRAMA Report by Designated Provider ***",1,2,BGPPTYPE) G N
I BGPRTYPE=1,'$G(BGPYGPU),'$G(BGPSUMON) D W^BGP5DP("*** IHS 2015 National GPRA/GPRAMA Report ***",1,2,BGPPTYPE)
I BGPRTYPE=1,'$G(BGPYGPU),$G(BGPSUMON) D W^BGP5DP("*** IHS 2015 National GPRA/GPRAMA Report Clinical Performance Summaries ***",1,2,BGPPTYPE)
I BGPRTYPE=1,$G(BGPYGPU) D W^BGP5DP("*** IHS 2015 GPRA/GPRAMA Performance Report ***",1,2,BGPPTYPE)
I BGPRTYPE=7 D W^BGP5DP("*** IHS 2015 Other National Measures Report ***",1,2,BGPPTYPE)
N ;
I $G(BGPCPPL) D W^BGP5DP("** Including Comprehensive Patient List **",1,1,BGPPTYPE)
D W^BGP5DP($$RPTVER^BGP5BAN,1,1,BGPPTYPE)
D W^BGP5DP("Date Report Run: "_$$FMTE^XLFDT(DT),1,1,BGPPTYPE)
D W^BGP5DP("Site where Run: "_$P(^DIC(4,DUZ(2),0),U),1,1,BGPPTYPE)
D W^BGP5DP("Report Generated by: "_$$USR,1,1,BGPPTYPE)
S X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED) D W^BGP5DP(X,1,1,BGPPTYPE)
S X="Previous Year Period: "_$$FMTE^XLFDT(BGPPBD)_" to "_$$FMTE^XLFDT(BGPPED) D W^BGP5DP(X,1,1,BGPPTYPE)
I '$G(BGPDASH) S X="Baseline Period: "_$$FMTE^XLFDT(BGPBBD)_" to "_$$FMTE^XLFDT(BGPBED) D W^BGP5DP(X,1,1,BGPPTYPE)
D W^BGP5DP("",0,2,BGPPTYPE)
Q
PEHDR ;
D PEHDR^BGP5DH1
Q
COMHDR ;
D COMHDR^BGP5DH1
Q
ONMHDR ;EP
D ONMHDR^BGP5DH1
Q
;
PPHDR ;
D PPHDR^BGP5DH1
Q
DENOMHDR ;
D W^BGP5DP("",0,1,BGPPTYPE)
Q:$G(BGPSEAT)
S BGPX=$O(^BGPCTRL("B",2015,0))
S BGPY=0 F S BGPY=$O(^BGPCTRL(BGPX,13,BGPY)) Q:BGPY'=+BGPY!(BGPQHDR) D
.I BGPPTYPE="P",$Y>(BGPIOSL-2) D HDR Q:BGPQHDR
.D W^BGP5DP(^BGPCTRL(BGPX,13,BGPY,0),0,1,BGPPTYPE)
.Q
D W^BGP5DP("",0,1,BGPPTYPE)
Q
ALLHDR ;
D ALLHDR^BGP5DH1
Q
AREAHDR ;
D W^BGP5DP("",0,1,BGPPTYPE)
S BGPX=$O(^BGPCTRL("B",2015,0))
S BGPY=0 F S BGPY=$O(^BGPCTRL(BGPX,15,BGPY)) Q:BGPY'=+BGPY!(BGPQHDR) D
.I BGPPTYPE="P",$Y>(BGPIOSL-2) D HDR Q:BGPQHDR
.D W^BGP5DP(^BGPCTRL(BGPX,15,BGPY,0),0,1,BGPPTYPE)
.Q
Q
GPRAHDRS ;EP
D GPRAHDRS^BGP5DH1
Q
COMHDRA ;EP
D W^BGP5DP("",0,1,BGPPTYPE)
S BGPX=$O(^BGPCTRL("B",2015,0))
S BGPNODEP=17
S BGPY=0 F S BGPY=$O(^BGPCTRL(BGPX,BGPNODEP,BGPY)) Q:BGPY'=+BGPY!(BGPQHDR) D
.I BGPPTYPE="P",$Y>(BGPIOSL-2) D AHDR^BGP5DH1 Q:BGPQHDR
.D W^BGP5DP(^BGPCTRL(BGPX,BGPNODEP,BGPY,0),0,1,BGPPTYPE)
.Q
I $G(BGPYGPU) D W^BGP5DP("See last pages of this report for Performance Summaries.",0,2,BGPPTYPE)
Q
GPRAHDR ;
D W^BGP5DP("",0,1,BGPPTYPE)
S BGPNODEP=14
S BGPX=$O(^BGPCTRL("B",2015,0))
S BGPY=0 F S BGPY=$O(^BGPCTRL(BGPX,BGPNODEP,BGPY)) Q:BGPY'=+BGPY!(BGPQHDR) D
.I BGPPTYPE="P",$Y>(BGPIOSL-2) D HDR Q:BGPQHDR
.D W^BGP5DP(^BGPCTRL(BGPX,BGPNODEP,BGPY,0),0,1,BGPPTYPE)
.Q
Q
ENDTIME ;EP
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 D W^BGP5DP("RUN TIME (H.M.S): "_BGPHR_"."_BGPM_"."_BGPS,0,2,BGPPTYPE)
Q
;
AREACP ;EP -
D AREACP^BGP5DH1
Q
PEDCP ;EP
D PEHDR
I BGPROT'="P",'$D(BGPGUI) W !!,"A delimited output file called ",BGPDELF,!,"has been placed in the "_$$GETDEDIR^BGP5UTL2()_" directory for your use in Excel or some",!,"other software package. See your site manager to access this file.",!
D W^BGP5DP("Report includes data from the following facilities: ",0,2,BGPPTYPE)
NEW BGPX
S BGPX="",BGPC=0 F S BGPX=$O(BGPSUL(BGPX)) Q:BGPX="" D
.S X=$P(^BGPPEDCK(BGPX,0),U,9),X=$O(^AUTTLOC("C",X,0)) S X=$S(X:$P(^DIC(4,X,0),U),1:"?????")
.S BGPC=BGPC+1,X=BGPC_". "_$S($P(^BGPPEDCK(BGPX,0),U,17):"*",1:"")_X D W^BGP5DP(X,0,1,BGPPTYPE,1,3)
.Q
S X=" " D W^BGP5DP(X,0,1,BGPPTYPE)
S X="The following communities are included in this report:" D W^BGP5DP(X,0,1,BGPPTYPE,1,1)
S BGPX="",BGPC=0 F S BGPX=$O(BGPSUL(BGPX)) Q:BGPX="" D
.S X=$P(^BGPPEDCK(BGPX,0),U,9),X=$O(^AUTTLOC("C",X,0)) S X=$S(X:$P(^DIC(4,X,0),U),1:"?????")
.S BGPC=BGPC+1,X=BGPC_". "_$S($P(^BGPPEDCK(BGPX,0),U,17):"*",1:"")_X D W^BGP5DP(X,0,1,BGPPTYPE,1,3)
.;S X="Communities: " D W^BGP5DP(X,0,1,BGPPTYPE,1,5)
.S X="Community Taxonomy Name: "_$P(^BGPPEDCK(BGPX,0),U,18) D W^BGP5DP(X,0,1,BGPPTYPE,1,5)
.S BGPXX=0,BGPXN=0,BGPXY="" F S BGPXX=$O(^BGPPEDCK(BGPX,9999,BGPXX)) Q:BGPXX'=+BGPXX S BGPXN=BGPXN+1,BGPXY=BGPXY_$S(BGPXN=1:"",1:";")_$P(^BGPPEDCK(BGPX,9999,BGPXX,0),U)
.S BGPX1=0,C=0 F BGPX1=1:3:BGPXN D
..D W^BGP5DP($E($P(BGPXY,";",BGPX1),1,20),0,1,BGPPTYPE,1,10)
..D W^BGP5DP($E($P(BGPXY,";",(BGPX1+1)),1,20),0,0,BGPPTYPE,2,30)
..D W^BGP5DP($E($P(BGPXY,";",(BGPX1+2)),1,20),0,0,BGPPTYPE,3,60)
..Q
.Q
D W^BGP5DP(" ",0,1,BGPPTYPE)
I BGPPTYPE="P" 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 ;;Asthma Related Measures
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 ;;Pharmacy Quality Alliance
I ;;Improving Patient Care
;
BGP5DH ; IHS/CMI/LAB - cover page for gpra 28 Apr 2010 11:30 AM 02 Jul 2010 9:25 AM ; 19 Feb 2015 11:07 AM
+1 ;;15.1;IHS CLINICAL REPORTING;;MAY 06, 2015;Build 143
+2 ;
+3 SET BGPQHDR=0
SET BGPHPG=0
+4 DO HDR
+5 IF BGPPTYPE="P"
IF BGPQHDR
QUIT
+6 DO MD
+7 DO PD
+8 IF BGPRTYPE=1
IF $GET(BGPDESGP)
DO W^BGP5DP("Designated Provider: "_$PIECE(^VA(200,BGPDESGP,0),U,1),0,2,BGPPTYPE)
+9 DO ENDTIME
+10 IF $GET(BGPDASH)
DO DASH^BGP5DH2
GOTO N1
+11 IF BGPRTYPE=4
IF BGPYRPTH="C"
DO COMHDR
+12 IF BGPRTYPE=4
IF BGPYRPTH="P"
DO PPHDR
+13 IF BGPRTYPE=4
IF BGPYRPTH="A"
DO ALLHDR
+14 IF BGPRTYPE=1
IF '$GET(BGPYGPU)
IF '$GET(BGPSUMON)
DO GPRAHDR
+15 IF BGPRTYPE=1
IF '$GET(BGPYGPU)
IF $GET(BGPSUMON)
DO GPRAHDRS
+16 IF BGPRTYPE=1
IF $GET(BGPYGPU)
IF '$GET(BGPSEAT)
DO GPRAHDR
+17 IF BGPRTYPE=1
IF $GET(BGPYGPU)
IF $GET(BGPSEAT)
DO GPUPPHDR^BGP5DH1
+18 IF BGPRTYPE=6
DO PEHDR
+19 IF BGPRTYPE=7
DO ONMHDR
N1 IF BGPPTYPE="P"
IF BGPQHDR
QUIT
+1 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-3)
DO HDR
IF BGPQHDR
QUIT
+2 ;,'$G(BGPNGR09) D
IF $GET(BGPEXPT)
IF BGPRTYPE=1
Begin DoDot:1
+3 DO W^BGP5DP("A file will be created called BG151"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_"."_BGPRPT,0,2,BGPPTYPE)
+4 DO W^BGP5DP("It will reside in the "_BGPUF_" directory.",0,1,BGPPTYPE)
+5 DO W^BGP5DP("This file should be sent to your Area Office.",0,1,BGPPTYPE)
+6 DO W^BGP5DP("",0,1,BGPPTYPE)
End DoDot:1
+7 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-3)
DO HDR
IF BGPQHDR
QUIT
+8 IF $GET(BGPEXPT)
IF BGPRTYPE=7
Begin DoDot:1
+9 DO W^BGP5DP("A file will be created called BG151"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_".ONM"_BGPRPT,0,2,BGPPTYPE)
+10 DO W^BGP5DP("It will reside in the "_BGPUF_" directory.",0,1,BGPPTYPE)
+11 DO W^BGP5DP("This file should be sent to your Area Office.",0,1,BGPPTYPE)
+12 DO W^BGP5DP("",0,1,BGPPTYPE)
End DoDot:1
+13 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-3)
DO HDR
IF BGPQHDR
QUIT
+14 IF BGPRTYPE=6
IF $GET(BGPPEEXP)
Begin DoDot:1
+15 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-3)
DO HDR
IF BGPQHDR
QUIT
+16 DO W^BGP5DP("A file will be created called BG151"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_".PED"_BGPRPT_" and will reside",0,1,BGPPTYPE)
+17 DO W^BGP5DP("in the "_BGPUF_" directory. This file should be sent to your Area Office.",0,1,BGPPTYPE)
+18 DO W^BGP5DP("",0,1,BGPPTYPE)
End DoDot:1
IF BGPQHDR
QUIT
+19 IF BGPROT'="P"
IF '$DATA(BGPGUI)
Begin DoDot:1
+20 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-2)
DO HDR
IF BGPQHDR
QUIT
+21 IF BGPDELF]""
DO W^BGP5DP("A delimited output file called "_BGPDELF,0,2,BGPPTYPE)
Begin DoDot:2
+22 DO W^BGP5DP("has been placed in the "_$$GETDEDIR^BGP5UTL2()_" directory for your use in Excel or some",0,1,BGPPTYPE)
DO W^BGP5DP("other software package. See your site manager to access this file.",0,1,BGPPTYPE)
End DoDot:2
End DoDot:1
IF BGPPTYPE="P"
IF BGPQHDR
QUIT
+23 IF $GET(BGPALLPT)
Begin DoDot:1
+24 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-2)
DO HDR
IF BGPQHDR
QUIT
+25 DO W^BGP5DP("All Communities Included.",0,2,BGPPTYPE)
End DoDot:1
IF BGPPTYPE="P"
IF BGPQHDR
QUIT
+26 IF BGPYRPTH="P"
KILL BGPX,BGPQUIT
+27 IF '$GET(BGPALLPT)
IF '$GET(BGPSEAT)
Begin DoDot:1
+28 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-2)
DO HDR
IF BGPQHDR
QUIT
+29 DO W^BGP5DP("Community Taxonomy Name: "_$PIECE(^ATXAX(BGPTAXI,0),U),0,2,BGPPTYPE,1,10)
+30 DO W^BGP5DP("The following communities are included in this report:",0,1,BGPPTYPE,1,10)
Begin DoDot:2
+31 SET BGPZZ=""
SET N=0
SET Y=""
FOR
SET BGPZZ=$ORDER(BGPTAX(BGPZZ))
IF BGPZZ=""
QUIT
SET N=N+1
SET Y=Y_$SELECT(N=1:"",1:";")_BGPZZ
+32 SET BGPZZ=0
SET C=0
FOR BGPZZ=1:3:N
Begin DoDot:3
+33 DO W^BGP5DP($EXTRACT($PIECE(Y,";",BGPZZ),1,20),0,1,BGPPTYPE,1,10)
+34 DO W^BGP5DP($EXTRACT($PIECE(Y,";",(BGPZZ+1)),1,20),0,0,BGPPTYPE,2,30)
+35 DO W^BGP5DP($EXTRACT($PIECE(Y,";",(BGPZZ+2)),1,20),0,0,BGPPTYPE,3,60)
+36 QUIT
End DoDot:3
End DoDot:2
End DoDot:1
IF BGPPTYPE="P"
IF BGPQHDR
QUIT
+37 DO W^BGP5DP("",0,1,BGPPTYPE)
+38 IF BGPRTYPE'=6
IF BGPPTYPE="D"
DO W^BGP5DP("ENDCOVERPAGE",0,1,BGPPTYPE)
+39 KILL BGPX,BGPQUIT
+40 QUIT
+41 ;
MD ;EP
+1 IF $GET(BGPDASH)
DO W^BGP5DP("Measures: GPRA Denominators and Numerators",0,1,BGPPTYPE)
QUIT
+2 IF BGPRTYPE=6
DO W^BGP5DP("Measures: Patient Education Performance Measures",0,1,BGPPTYPE)
QUIT
+3 IF BGPRTYPE=4
DO W^BGP5DP("Measures: "_$PIECE($TEXT(@BGPINDK),";;",2),0,1,BGPPTYPE)
QUIT
+4 IF BGPRTYPE=1
DO W^BGP5DP("Measures: GPRA Developmental, GPRA/GPRAMA Denominators and Numerators and",0,1,BGPPTYPE)
DO W^BGP5DP("Selected Other Clinical Denominators and Numerators",0,1,BGPPTYPE)
QUIT
+5 IF BGPRTYPE=7
DO W^BGP5DP("Measures: Key Clinical Denominators and Numerators for Non-GPRA National",0,1,BGPPTYPE)
DO W^BGP5DP("Reporting",0,1,BGPPTYPE)
QUIT
+6 QUIT
+7 ;
PD ;EP
+1 IF BGPRTYPE=1
IF $GET(BGPYGPU)
IF '$GET(BGPSEAT)
DO W^BGP5DP("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:""),0,1,BGPPTYPE)
+2 IF BGPRTYPE=1
IF $GET(BGPYGPU)
IF $GET(BGPSEAT)
DO W^BGP5DP("Patient Population: "_$PIECE(^DIBT(BGPSEAT,0),U),0,2,BGPPTYPE)
+3 IF BGPRTYPE=4
IF BGPYRPTH'="P"
DO W^BGP5DP("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:""),0,1,BGPPTYPE)
+4 IF BGPRTYPE=4
IF BGPYRPTH="P"
DO W^BGP5DP("Population: "_$PIECE(^DIBT(BGPSEAT,0),U),0,1,BGPPTYPE)
+5 IF BGPRTYPE=1
IF '$GET(BGPYGPU)!(BGPRTYPE=7)
DO W^BGP5DP("Population: AI/AN Only (Classification 01)",0,2,BGPPTYPE)
+6 IF BGPRTYPE=6
IF '$GET(BGPSEAT)
DO W^BGP5DP("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:""),0,1,BGPPTYPE)
+7 IF BGPRTYPE=6
IF $GET(BGPSEAT)
DO W^BGP5DP("Patient Population: "_$PIECE(^DIBT(BGPSEAT,0),U),0,2,BGPPTYPE)
+8 IF BGPRTYPE=7
DO W^BGP5DP("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:""),0,1,BGPPTYPE)
+9 QUIT
+10 ;
HDR ;EP
+1 IF BGPPTYPE="P"
IF 'BGPHPG
GOTO HDR1
+2 IF BGPPTYPE="P"
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 IF BGPPTYPE="P"
SET BGPHPG=BGPHPG+1
IF BGPHPG'=1
IF $DATA(IOF)
WRITE @IOF
+2 ;GUI
IF $GET(BGPGUI)
IF BGPPTYPE="P"
IF BGPHPG'=1
DO W^BGP5DP("ZZZZZZZ",0,0,BGPPTYPE)
DO W^BGP5DP("",0,1,BGPPTYPE)
+3 DO W^BGP5DP("Cover Page",1,2,BGPPTYPE)
+4 IF $GET(BGPNPL)
DO W^BGP5DP("*** IHS 2015 GPRA/GPRAMA Patient List ***",1,2,BGPPTYPE)
GOTO N
+5 IF $GET(BGPDASH)
DO W^BGP5DP("*** IHS 2015 National GPRA Dashboard ***",1,2,BGPPTYPE)
GOTO N
+6 IF BGPRTYPE=4
IF $GET(BGPYRPTH)="C"
DO W^BGP5DP("*** IHS 2015 Selected Measures with Community Specified Report ***",1,2,BGPPTYPE)
GOTO N
+7 IF BGPRTYPE=4
IF $GET(BGPYRPTH)="A"
DO W^BGP5DP("*** IHS 2015 Selected Measures with All Communities Report ***",1,2,BGPPTYPE)
GOTO N
+8 IF BGPRTYPE=4
IF $GET(BGPYRPTH)="P"
DO W^BGP5DP("*** IHS 2015 Selected Measures with Patient Panel Population Report ***",1,2,BGPPTYPE)
GOTO N
+9 IF BGPRTYPE=6
IF '$GET(BGPEDPP)
DO W^BGP5DP("*** IHS 2015 Patient Education with Community Specified Report ***",1,2,BGPPTYPE)
GOTO N
+10 IF BGPRTYPE=6
IF $GET(BGPEDPP)
DO W^BGP5DP("*** IHS 2015 Patient Education with Patient Panel Population Report ***",1,2,BGPPTYPE)
GOTO N
+11 IF BGPRTYPE=1
IF $GET(BGPNGR09)
DO W^BGP5DP("*** IHS 2015 National GPRA/GPRAMA Report, Run Using 2015 Logic ***",1,2,BGPPTYPE)
GOTO N
+12 IF BGPRTYPE=1
IF $GET(BGPDESGP)
DO W^BGP5DP("*** IHS 2015 National GPRA/GPRAMA Report by Designated Provider ***",1,2,BGPPTYPE)
GOTO N
+13 IF BGPRTYPE=1
IF '$GET(BGPYGPU)
IF '$GET(BGPSUMON)
DO W^BGP5DP("*** IHS 2015 National GPRA/GPRAMA Report ***",1,2,BGPPTYPE)
+14 IF BGPRTYPE=1
IF '$GET(BGPYGPU)
IF $GET(BGPSUMON)
DO W^BGP5DP("*** IHS 2015 National GPRA/GPRAMA Report Clinical Performance Summaries ***",1,2,BGPPTYPE)
+15 IF BGPRTYPE=1
IF $GET(BGPYGPU)
DO W^BGP5DP("*** IHS 2015 GPRA/GPRAMA Performance Report ***",1,2,BGPPTYPE)
+16 IF BGPRTYPE=7
DO W^BGP5DP("*** IHS 2015 Other National Measures Report ***",1,2,BGPPTYPE)
N ;
+1 IF $GET(BGPCPPL)
DO W^BGP5DP("** Including Comprehensive Patient List **",1,1,BGPPTYPE)
+2 DO W^BGP5DP($$RPTVER^BGP5BAN,1,1,BGPPTYPE)
+3 DO W^BGP5DP("Date Report Run: "_$$FMTE^XLFDT(DT),1,1,BGPPTYPE)
+4 DO W^BGP5DP("Site where Run: "_$PIECE(^DIC(4,DUZ(2),0),U),1,1,BGPPTYPE)
+5 DO W^BGP5DP("Report Generated by: "_$$USR,1,1,BGPPTYPE)
+6 SET X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED)
DO W^BGP5DP(X,1,1,BGPPTYPE)
+7 SET X="Previous Year Period: "_$$FMTE^XLFDT(BGPPBD)_" to "_$$FMTE^XLFDT(BGPPED)
DO W^BGP5DP(X,1,1,BGPPTYPE)
+8 IF '$GET(BGPDASH)
SET X="Baseline Period: "_$$FMTE^XLFDT(BGPBBD)_" to "_$$FMTE^XLFDT(BGPBED)
DO W^BGP5DP(X,1,1,BGPPTYPE)
+9 DO W^BGP5DP("",0,2,BGPPTYPE)
+10 QUIT
PEHDR ;
+1 DO PEHDR^BGP5DH1
+2 QUIT
COMHDR ;
+1 DO COMHDR^BGP5DH1
+2 QUIT
ONMHDR ;EP
+1 DO ONMHDR^BGP5DH1
+2 QUIT
+3 ;
PPHDR ;
+1 DO PPHDR^BGP5DH1
+2 QUIT
DENOMHDR ;
+1 DO W^BGP5DP("",0,1,BGPPTYPE)
+2 IF $GET(BGPSEAT)
QUIT
+3 SET BGPX=$ORDER(^BGPCTRL("B",2015,0))
+4 SET BGPY=0
FOR
SET BGPY=$ORDER(^BGPCTRL(BGPX,13,BGPY))
IF BGPY'=+BGPY!(BGPQHDR)
QUIT
Begin DoDot:1
+5 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-2)
DO HDR
IF BGPQHDR
QUIT
+6 DO W^BGP5DP(^BGPCTRL(BGPX,13,BGPY,0),0,1,BGPPTYPE)
+7 QUIT
End DoDot:1
+8 DO W^BGP5DP("",0,1,BGPPTYPE)
+9 QUIT
ALLHDR ;
+1 DO ALLHDR^BGP5DH1
+2 QUIT
AREAHDR ;
+1 DO W^BGP5DP("",0,1,BGPPTYPE)
+2 SET BGPX=$ORDER(^BGPCTRL("B",2015,0))
+3 SET BGPY=0
FOR
SET BGPY=$ORDER(^BGPCTRL(BGPX,15,BGPY))
IF BGPY'=+BGPY!(BGPQHDR)
QUIT
Begin DoDot:1
+4 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-2)
DO HDR
IF BGPQHDR
QUIT
+5 DO W^BGP5DP(^BGPCTRL(BGPX,15,BGPY,0),0,1,BGPPTYPE)
+6 QUIT
End DoDot:1
+7 QUIT
GPRAHDRS ;EP
+1 DO GPRAHDRS^BGP5DH1
+2 QUIT
COMHDRA ;EP
+1 DO W^BGP5DP("",0,1,BGPPTYPE)
+2 SET BGPX=$ORDER(^BGPCTRL("B",2015,0))
+3 SET BGPNODEP=17
+4 SET BGPY=0
FOR
SET BGPY=$ORDER(^BGPCTRL(BGPX,BGPNODEP,BGPY))
IF BGPY'=+BGPY!(BGPQHDR)
QUIT
Begin DoDot:1
+5 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-2)
DO AHDR^BGP5DH1
IF BGPQHDR
QUIT
+6 DO W^BGP5DP(^BGPCTRL(BGPX,BGPNODEP,BGPY,0),0,1,BGPPTYPE)
+7 QUIT
End DoDot:1
+8 IF $GET(BGPYGPU)
DO W^BGP5DP("See last pages of this report for Performance Summaries.",0,2,BGPPTYPE)
+9 QUIT
GPRAHDR ;
+1 DO W^BGP5DP("",0,1,BGPPTYPE)
+2 SET BGPNODEP=14
+3 SET BGPX=$ORDER(^BGPCTRL("B",2015,0))
+4 SET BGPY=0
FOR
SET BGPY=$ORDER(^BGPCTRL(BGPX,BGPNODEP,BGPY))
IF BGPY'=+BGPY!(BGPQHDR)
QUIT
Begin DoDot:1
+5 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-2)
DO HDR
IF BGPQHDR
QUIT
+6 DO W^BGP5DP(^BGPCTRL(BGPX,BGPNODEP,BGPY,0),0,1,BGPPTYPE)
+7 QUIT
End DoDot:1
+8 QUIT
ENDTIME ;EP
+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
DO W^BGP5DP("RUN TIME (H.M.S): "_BGPHR_"."_BGPM_"."_BGPS,0,2,BGPPTYPE)
End DoDot:1
+3 QUIT
+4 ;
AREACP ;EP -
+1 DO AREACP^BGP5DH1
+2 QUIT
PEDCP ;EP
+1 DO PEHDR
+2 IF BGPROT'="P"
IF '$DATA(BGPGUI)
WRITE !!,"A delimited output file called ",BGPDELF,!,"has been placed in the "_$$GETDEDIR^BGP5UTL2()_" directory for your use in Excel or some",!,"other software package. See your site manager to access this file.",!
+3 DO W^BGP5DP("Report includes data from the following facilities: ",0,2,BGPPTYPE)
+4 NEW BGPX
+5 SET BGPX=""
SET BGPC=0
FOR
SET BGPX=$ORDER(BGPSUL(BGPX))
IF BGPX=""
QUIT
Begin DoDot:1
+6 SET X=$PIECE(^BGPPEDCK(BGPX,0),U,9)
SET X=$ORDER(^AUTTLOC("C",X,0))
SET X=$SELECT(X:$PIECE(^DIC(4,X,0),U),1:"?????")
+7 SET BGPC=BGPC+1
SET X=BGPC_". "_$SELECT($PIECE(^BGPPEDCK(BGPX,0),U,17):"*",1:"")_X
DO W^BGP5DP(X,0,1,BGPPTYPE,1,3)
+8 QUIT
End DoDot:1
+9 SET X=" "
DO W^BGP5DP(X,0,1,BGPPTYPE)
+10 SET X="The following communities are included in this report:"
DO W^BGP5DP(X,0,1,BGPPTYPE,1,1)
+11 SET BGPX=""
SET BGPC=0
FOR
SET BGPX=$ORDER(BGPSUL(BGPX))
IF BGPX=""
QUIT
Begin DoDot:1
+12 SET X=$PIECE(^BGPPEDCK(BGPX,0),U,9)
SET X=$ORDER(^AUTTLOC("C",X,0))
SET X=$SELECT(X:$PIECE(^DIC(4,X,0),U),1:"?????")
+13 SET BGPC=BGPC+1
SET X=BGPC_". "_$SELECT($PIECE(^BGPPEDCK(BGPX,0),U,17):"*",1:"")_X
DO W^BGP5DP(X,0,1,BGPPTYPE,1,3)
+14 ;S X="Communities: " D W^BGP5DP(X,0,1,BGPPTYPE,1,5)
+15 SET X="Community Taxonomy Name: "_$PIECE(^BGPPEDCK(BGPX,0),U,18)
DO W^BGP5DP(X,0,1,BGPPTYPE,1,5)
+16 SET BGPXX=0
SET BGPXN=0
SET BGPXY=""
FOR
SET BGPXX=$ORDER(^BGPPEDCK(BGPX,9999,BGPXX))
IF BGPXX'=+BGPXX
QUIT
SET BGPXN=BGPXN+1
SET BGPXY=BGPXY_$SELECT(BGPXN=1:"",1:";")_$PIECE(^BGPPEDCK(BGPX,9999,BGPXX,0),U)
+17 SET BGPX1=0
SET C=0
FOR BGPX1=1:3:BGPXN
Begin DoDot:2
+18 DO W^BGP5DP($EXTRACT($PIECE(BGPXY,";",BGPX1),1,20),0,1,BGPPTYPE,1,10)
+19 DO W^BGP5DP($EXTRACT($PIECE(BGPXY,";",(BGPX1+1)),1,20),0,0,BGPPTYPE,2,30)
+20 DO W^BGP5DP($EXTRACT($PIECE(BGPXY,";",(BGPX1+2)),1,20),0,0,BGPPTYPE,3,60)
+21 QUIT
End DoDot:2
+22 QUIT
End DoDot:1
+23 DO W^BGP5DP(" ",0,1,BGPPTYPE)
+24 IF BGPPTYPE="P"
IF BGPQHDR
QUIT
+25 KILL BGPX,BGPQUIT
+26 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 ;;Asthma Related Measures
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 ;;Pharmacy Quality Alliance
I ;;Improving Patient Care
+1 ;
