BGPMUPP ; IHS/MSC/MGH - Meaningful Use Print Jul 2009 6:26 AM ;31-Jan-2011 16:06;MGH
;;14.1;IHS CLINICAL REPORTING;**1**;MAY 29, 2014;Build 2
;
;
PRINT ;
K ^TMP($J)
K BGPDELIM
S BGPIOSL=$S($G(BGPGUI):55,1:$G(IOSL))
S BGPQUIT=""
S ^TMP($J,"BGPDEL",0)=0
I $G(BGPAREAA) D SETEXCEL
S BGPIFTR=""
I BGPROT="X" D XML Q
I BGPROT="D" D DEL Q
S BGPPTYPE="P"
S BGPQHDR=0
;I BGPQHDR D EXIT Q
S BGPGPG=0
S BGPQUIT=""
D PRINT1
K ^TMP($J)
D EXIT
Q
;
DEL ;create delimited output file
I '$D(BGPGUI) D ^%ZISC ;close printer device
I BGPDELT="F" D
.S Y="A delimited output file called "_BGPDELF_".txt has been placed in" D W(Y,0,2,"P")
.S Y="the public directory for your use in Excel or some other software package. See" D W(Y,0,1,"P")
.S Y="your site manager to access this file." D W(Y,0,1,"P")
K ^TMP($J)
S ^TMP($J,"BGPDEL",0)=0
S BGPQHDR=0
S BGPPTYPE="D"
S BGPGPG=0
S BGPQUIT=""
D PRINT1^BGPMUDEL
D SAVEDEL^BGPMUDEL
S BGPIFTR=1
K ^TMP($J)
Q
XML ;create XML output files
I '$D(BGPGUI) D ^%ZISC ;close printer device
K ^TMP($J)
S ^TMP($J,"BGPXML",0)=0
S BGPQHDR=0
S BGPPTYPE="X"
S BGPQUIT=""
D PRINT1^BGPMUXML
D SAVEXML^BGPMUXML
S BGPIFTR=1
K ^TMP($J)
Q
;V=text, C=centered, F=#of CR/LF before, M="P"(print),"D"(delim), P=tmp global piece, T=tab pos
W(V,C,F,M,P,T) ;EP
I $G(F)="" S F=1
I $G(C)="" S C=0
I $G(P)="" S P=1
I $G(T)="" S T=0
I M="P" D Q
.;I $Y>(BGPIOSL-4) D HEADER^BGPMUPH
.NEW X
.F X=1:1:F W !
.I C W $$CJ^XLFSTR(V,80)
.I 'C W ?T,V
;set up array
I '$G(F) S F=0
NEW %,Z
S Z=""
S %=$P($G(^TMP($J,"BGPDEL",0)),U)
F Z=1:1:F S %=%+1 S ^TMP($J,"BGPDEL",%)=""
S $P(^TMP($J,"BGPDEL",0),U)=%
I '$D(^TMP($J,"BGPDEL",%)) S ^TMP($J,"BGPDEL",%)=""
S $P(^TMP($J,"BGPDEL",%),U,P)=V
Q
;
WTITLE(I) ;EP - write title line
NEW T,X,Y,S
S T=$P(^BGPMUIND(BGPMUYF,I,0),U,3)
I BGPPTYPE="P",$L(T)<81 D W(T,0,1,BGPPTYPE) Q
I BGPPTYPE="D" D W(T,0,1,BGPPTYPE),W("",0,1,BGPPTYPE) Q
S X=$E(T,1,80)
S S=""
F Y=80:-1:1 Q:S S I=$E(X,Y) I I=" " S S=Y
D W^BGPMUPP($E(T,1,S),0,1,BGPPTYPE) ;W !,$E(T,1,S)
D W^BGPMUPP($E(T,(S+1),$L(T)),0,1,BGPPTYPE)
Q
ANYDEV() ;
NEW X,G,Y
S G=0
S X=0 F S X=$O(BGPINDL(X)) Q:X'=+X S Y=0 F S Y=$O(BGPINDL(X,Y)) Q:Y'=+Y I $P(^BGPNPLT(Y,0),U,7)=9 S G=1
Q G
ALLDEV() ;
NEW X,G,Y
S G=1
S X=0 F S X=$O(BGPINDL(X)) Q:X'=+X S Y=0 F S Y=$O(BGPINDL(X,Y)) Q:Y'=+Y I $P(^BGPNPLT(Y,0),U,7)=1 S G=0
Q G
PRINT1 ;EP
N BGPDEVOR,BGPIC,BGPGDEV
D COVERPG
S BGPGDEV=1
S BGPDEVOR=0 F S BGPDEVOR=$O(^BGPMUIND(BGPMUYF,"ADO",BGPDEVOR)) Q:BGPDEVOR'=+BGPDEVOR!(BGPQUIT) D
.S BGPIC=$O(^BGPMUIND(BGPMUYF,"ADO",BGPDEVOR,0)) Q:BGPIC=""
.I $D(BGPIND(BGPIC)) D PRINT2
.Q:BGPQUIT
K BGPGDEV
Q:BGPQUIT
PRINTSUM ; Print summary page of all measure calculations
N BGPPSUM
S BGPPSUM=1
D ^BGPMUPPS
Q
COVERPG ;
S Y="Cover Page" D W(Y,1,0,BGPPTYPE)
S Y="*** IHS Stage 1 Meaningful Use ***" D W(Y,1,2,BGPPTYPE)
S Y="*** "_$S($G(BGPMUT)'="H":"Eligible Professional (EP)",1:"Hospital")_" Clinical Quality Measures Report ***" D W(Y,1,1,BGPPTYPE)
S Y="CRS 2014, Version 14.1" D W(Y,1,2,BGPPTYPE)
S Y="Date Report Run: "_$$FMTE^XLFDT(DT) D W(Y,1,1,BGPPTYPE)
S Y="Site where Run: "_$P(^DIC(4,DUZ(2),0),U) D W(Y,1,1,BGPPTYPE)
S Y="Report Generated by: "_$P($G(^VA(200,DUZ,0)),U,1) D W(Y,1,1,BGPPTYPE)
S Y="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED) D W(Y,1,1,BGPPTYPE)
S Y="Previous Period: "_$$FMTE^XLFDT(BGPPBD)_" to "_$$FMTE^XLFDT(BGPPED) D W(Y,1,1,BGPPTYPE)
S Y="Baseline Period: "_$$FMTE^XLFDT(BGPBBD)_" to "_$$FMTE^XLFDT(BGPBED) D W(Y,1,1,BGPPTYPE)
I $G(BGPMUT)'="H" S Y="Measures: Stage 1 Meaningful Use Eligible Professional (EP) "_$S(BGPINDT="C":"Core Measures",BGPINDT="A":"Alternate Core",BGPINDT="M":"Menu Set Measures",1:"Selected Measures") D W(Y,0,2,BGPPTYPE)
I $G(BGPMUT)="H" D
.S Y="Measures: Stage 1 Meaningful Use Eligible Hospital (EH) and" D W(Y,0,2,BGPPTYPE)
.S Y="Critical Access Hospital (CAH) Clinical Quality Measures" D W(Y,0,1,BGPPTYPE)
;I $G(BGPMUT)="H" S Y="Measures: Stage 1 Meaningful Use Eligible Hospital "_$S(BGPINDT="S":"Selected Measures",1:"Measures") D W(Y,0,2,BGPPTYPE)
;I BGPINDT="A" S Y="Measures" D W(Y,0,1,BGPPTYPE)
I $G(BGPMUT)="P" S Y="Population: "_$S(BGPBEN=1:"Indian/Alaskan Native (Classification 01)",BGPBEN=2:"Not Indian Alaskan/Native (Not Classification 01)",1:"All patients") D W(Y,0,2,BGPPTYPE)
I $G(BGPMUT)'="H" D
.S Y="Eligible Professional (EP): "_$P(^VA(200,BGPPROV,0),U) D W(Y,0,2,BGPPTYPE)
I $G(BGPMUT)="H" D
.S Y="Population: "_$S(BGPBEN=1:"AI/AN Only",BGPBEN=2:"Non-AI/AN",BGPBEN=3:"All Patients",1:"")
.D W(Y,0,2,BGPPTYPE)
.S Y="Eligible Hospital: "_$$LOC^BGPMUEH()_", "_$$GET1^DIQ(4,DUZ(2)_",",1.03)_", "_$$GET1^DIQ(4,DUZ(2)_",",.02)
.D W(Y,0,2,BGPPTYPE)
D ENDTIME
;
I $G(BGPMUT)'="H" D Q:BGPQUIT
.I BGPPTYPE="P",$Y>(BGPIOSL-4) D HEADER^BGPMUPH Q:BGPQUIT
.S Y="Warning: The Meaningful Use reports do not verify that the EP selected for" D W(Y,0,2,BGPPTYPE)
.S Y="the reports meets the CMS EHR Incentive Program eligibility criteria. The" D W(Y,0,1,BGPPTYPE)
.S Y="EP must make that determination." D W(Y,0,1,BGPPTYPE)
;
I $G(BGPMUT)'="H" D Q:BGPQUIT
.I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER^BGPMUPH Q:BGPQUIT
.S Y="This report includes the EP "_$S(BGPINDT="C":"core",BGPINDT="A":"alternate",BGPINDT="M":"menu set",1:"selected")_" clinical quality measures for" D W(Y,0,2,BGPPTYPE)
.S Y="Stage 1 Meaningful Use." D W(Y,0,1,BGPPTYPE)
I $G(BGPMUT)="H" D Q:BGPQUIT
.I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER^BGPMUPH Q:BGPQUIT
.S Y="This report includes the eligible hospital and critical access hospital" D W(Y,0,2,BGPPTYPE)
.S Y="clinical quality measures for Stage 1 Meaningful Use." D W(Y,0,1,BGPPTYPE)
;
I $G(BGPMUT)'="H" D Q:BGPQUIT
.I BGPPTYPE="P",$Y>(BGPIOSL-4) D HEADER^BGPMUPH Q:BGPQUIT
.S Y="For the first Meaningful Use payment year, the reporting period is any" D W(Y,0,2,BGPPTYPE)
.S Y="consecutive 90-days during a calendar year (Jan 1 - Dec 31). For all" D W(Y,0,1,BGPPTYPE)
.S Y="subsequent years, the reporting period is the entire calendar year." D W(Y,0,1,BGPPTYPE)
I $G(BGPMUT)="H" D Q:BGPQUIT
.I BGPPTYPE="P",$Y>(BGPIOSL-4) D HEADER^BGPMUPH Q:BGPQUIT
.S Y="For the first Meaningful Use payment year, the reporting period is any" D W(Y,0,2,BGPPTYPE)
.S Y="consecutive 90-days during a federal fiscal year (Oct 1 - Sep 30). For all" D W(Y,0,1,BGPPTYPE)
.S Y="subsequent years, the reporting period is the entire federal fiscal year." D W(Y,0,1,BGPPTYPE)
;
I BGPPTYPE="P",$Y>(BGPIOSL-7) D HEADER^BGPMUPH Q:BGPQUIT
S Y="The report will provide a description of the measure, and explanations for" D W(Y,0,2,BGPPTYPE)
S Y="the denominator(s), numerator(s) and exclusions (if applicable)" D W(Y,0,1,BGPPTYPE)
S Y="and the measure logic." D W(Y,0,1,BGPPTYPE)
S Y="The measure results are contained in tabular form with the following column" D W(Y,0,2,BGPPTYPE)
S Y="headings:" D W(Y,0,1,BGPPTYPE)
S Y="REPORT % PREV YR % CHG FROM BASE % CHG" D W(Y,0,2,BGPPTYPE,,30)
S Y="PERIOD PERIOD PREV YR YR BASE %" D W(Y,0,1,BGPPTYPE,,30)
I $G(BGPMUT)'="H" D Q:BGPQUIT
.I BGPPTYPE="P",$Y>(BGPIOSL-7) D HEADER^BGPMUPH Q:BGPQUIT
.S Y="When a report is run for a 90-day period, the PREV YR PERIOD is the same 90-day" D W(Y,0,2,BGPPTYPE)
.S Y="period for the previous calendar year and the BASE YR is the same 90-day period" D W(Y,0,1,BGPPTYPE)
.S Y="for the base calendar year selected. For example, a report run with Apr 1, 2010" D W(Y,0,1,BGPPTYPE)
.S Y="through Jun 30, 2010 as the REPORT PERIOD and a base year of 2008 will include" D W(Y,0,1,BGPPTYPE)
.S Y="data from Apr 1, 2009 through Jun 30, 2009 in the PREV YR PERIOD and Apr 1, 2008" D W(Y,0,1,BGPPTYPE)
.S Y="through Jun 30, 2008 in the BASE YR." D W(Y,0,1,BGPPTYPE)
I $G(BGPMUT)="H" D Q:BGPQUIT
.I BGPPTYPE="P",$Y>(BGPIOSL-7) D HEADER^BGPMUPH Q:BGPQUIT
.S Y="When a report is run for a 90-day period, the PREV YR PERIOD is the same 90-day" D W(Y,0,2,BGPPTYPE)
.S Y="period for the previous fiscal year and the BASE YR is the same 90-day" D W(Y,0,1,BGPPTYPE)
.S Y="period for the base fiscal year selected. For example, a report run" D W(Y,0,1,BGPPTYPE)
.S Y="with Apr 1, 2010 through Jun 30, 2010 as the REPORT PERIOD and a base year of" D W(Y,0,1,BGPPTYPE)
.S Y="2008 will include data from Apr 1, 2009 through Jun 30, 2009 in the PREV YR" D W(Y,0,1,BGPPTYPE)
.S Y="PERIOD and Apr 1, 2008 through Jun 30, 2008 in the BASE YR." D W(Y,0,1,BGPPTYPE)
I BGPDELT="F" D Q:BGPQUIT
.I BGPPTYPE="P",$Y>(BGPIOSL-4) D HEADER^BGPMUPH Q:BGPQUIT
.S Y="A delimited output file called "_BGPDELF_".txt has been placed in" D W(Y,0,2,BGPPTYPE)
.S Y="the public directory for your use in Excel or some other software package. See" D W(Y,0,1,BGPPTYPE)
.S Y="your site manager to access this file." D W(Y,0,1,BGPPTYPE)
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 S X="RUN TIME (H.M.S): "_BGPHR_"."_BGPM_"."_BGPS D W(X,0,2,BGPPTYPE)
Q
WP ;
K ^UTILITY($J,"W")
S BGPZ=0,BGPLCNT=0
S DIWL=1,DIWR=80,DIWF="",BGPZ=0 F S BGPZ=$O(^BGPMUIND(BGPMUYF,BGPIC,BGPNODE,BGPY,1,BGPZ)) Q:BGPZ'=+BGPZ D
.S BGPLCNT=BGPLCNT+1
.S X=^BGPMUIND(BGPMUYF,BGPIC,BGPNODE,BGPY,1,BGPZ,0) S:BGPLCNT=1 X=" - "_X D ^DIWP
.Q
WPS ;
S Z=0 F S Z=$O(^UTILITY($J,"W",DIWL,Z)) Q:Z'=+Z D
.I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER^BGPMUPH Q:BGPQUIT
.D W^BGPMUPP(^UTILITY($J,"W",DIWL,Z,0),0,1,BGPPTYPE)
K DIWL,DIWR,DIWF,Z
K ^UTILITY($J,"W"),X
Q
PRINT2 ;
;K DIR I $E(IOST)="C",IO=IO(0),'$D(ZTQUEUED) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BGPQUIT=1
D HEADER1^BGPMUPH ;header for all measures
;I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER^BGPMUPH Q:BGPQUIT
D WTITLE(BGPIC)
;W !,$P(^BGPMUIND(BGPMUYF,BGPIC,0),U,3),!
;I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER^BGPMUPH Q:BGPQUIT
;Print out the description node if there is data in it
S BGPNODE=12 D PRINTN(BGPNODE,"Measure Summary:")
;Print out the population node if there is data in it
S BGPNODE=13 D PRINTN(BGPNODE,"Population:")
W !!
W "Logic:"
;Print out the denominator node if there is data in it
S BGPNODE=14 D PRINTN(BGPNODE,"Denominator Logic:",,1)
;The order for the next two sections is different between EP and Hosp
I $G(BGPMUT)'="H" D
.;Print out the numerator node if there is data in it
.S BGPNODE=15 D PRINTN(BGPNODE,"Numerator Logic:",,1)
.;Print ou the logic node if there is data in it
.S BGPNODE=16 D PRINTN(BGPNODE,"Exclusion Logic:",,1)
I $G(BGPMUT)="H" D
.;Print ou the logic node if there is data in it
.S BGPNODE=16 D PRINTN(BGPNODE,"Denominator Exclusion Logic:",,1)
.;Print out the numerator node if there is data in it
.S BGPNODE=15 D PRINTN(BGPNODE,"Numerator Logic:",,1)
;Print out the Performance node if there is data in it
S BGPNODE=17 D PRINTN(BGPNODE,"Performance:")
;Print out the source node if there is data in it
S BGPNODE=18 D PRINTN(BGPNODE,"Measure Source: ",1)
CALC I BGPPTYPE="P" X ^BGPMUIND(BGPMUYF,BGPIC,3) D W^BGPMUPP("",0,1,BGPPTYPE)
I BGPPTYPE="D" X ^BGPMUIND(BGPMUYF,BGPIC,4) D W^BGPMUPP("",0,1,BGPPTYPE)
Q
PRINTN(BGPNODE,TXT,SLF,XLF) ;Print out a node - SLF = print on same line as header, XLF = Xtra line feed after header
I $O(^BGPMUIND(BGPMUYF,BGPIC,BGPNODE,0)) D
.D W^BGPMUPP(TXT,0,2,BGPPTYPE)
.I $G(XLF) S X="" D W^BGPMUPP(X,0,1,BGPPTYPE)
.S BGPY=0 F S BGPY=$O(^BGPMUIND(BGPMUYF,BGPIC,BGPNODE,BGPY)) Q:BGPY'=+BGPY!(BGPQUIT) D
..I BGPPTYPE="P",$Y>(BGPIOSL-4),'$G(SLF) D HEADER^BGPMUPH Q:BGPQUIT
..D W^BGPMUPP(^BGPMUIND(BGPMUYF,BGPIC,BGPNODE,BGPY,0),0,$S($G(SLF):0,1:1),BGPPTYPE)
Q
SETEXCEL ;EP
I $G(BGPAREAA) D Q
.S X=0 F S X=$O(BGPSUL(X)) Q:X'=+X D
..S N=^BGPGPDCT(X,0)
..S (D,L)=""
..S L=$P(N,U,9) I L S L=$O(^AUTTLOC("C",L,0)) I L S D=$P($G(^AUTTLOC(L,1)),U,3),L=$S(L:$P(^DIC(4,L,0),U),1:"?????")
..S BGPEI(X)=L_U_$P(N,U,9)_U_D_U_$$DATE^BGP0UTL($P(N,U,13)) S P=5 F Y=1:1:6 S $P(BGPEI(X),U,P)=$$DATE^BGP0UTL($P(N,U,Y)),P=P+1
..S BGPEI2(X)=L_U_$P(N,U,9)_U_D_U_$$DATE^BGP0UTL($P(N,U,13)) S P=5 F Y=1:1:6 S $P(BGPEI2(X),U,P)=$$DATE^BGP0UTL($P(N,U,Y)),P=P+1
..S BGPEIDV1(X)=L_U_$P(N,U,9)_U_D_U_$$DATE^BGP0UTL($P(N,U,13)) S P=5 F Y=1:1:6 S $P(BGPEIDV1(X),U,P)=$$DATE^BGP0UTL($P(N,U,Y)),P=P+1
..S BGPEIDV2(X)=L_U_$P(N,U,9)_U_D_U_$$DATE^BGP0UTL($P(N,U,13)) S P=5 F Y=1:1:6 S $P(BGPEIDV2(X),U,P)=$$DATE^BGP0UTL($P(N,U,Y)),P=P+1
..S BGPONN1(X)=L_U_$P(N,U,9)_U_D_U_$$DATE^BGP0UTL($P(N,U,13)) S P=5 F Y=1:1:6 S $P(BGPONN1(X),U,P)=$$DATE^BGP0UTL($P(N,U,Y)),P=P+1
..S BGPONN2(X)=L_U_$P(N,U,9)_U_D_U_$$DATE^BGP0UTL($P(N,U,13)) S P=5 F Y=1:1:6 S $P(BGPONN2(X),U,P)=$$DATE^BGP0UTL($P(N,U,Y)),P=P+1
..;S BGPONN3(X)=L_U_$P(N,U,9)_U_D_U_$$DATE^BGP0UTL($P(N,U,13)) S P=5 F Y=1:1:6 S $P(BGPONN3(X),U,P)=$$DATE^BGP0UTL($P(N,U,Y)),P=P+1
..Q
.Q
;S X=BGPRPT
;S N=^BGPGPDCT(X,0)
;S L=$P(N,U,9),L=$O(^AUTTLOC("C",L,0)) S D=$P($G(^AUTTLOC(L,1)),U,3),L=$S(L:$P(^DIC(4,L,0),U),1:"?????")
;S BGPEI(X)=L_U_$P(N,U,9)_U_D_U_$$DATE^BGP0UTL($P(N,U,13)) S P=5 F Y=1:1:6 S $P(BGPEI(X),U,P)=$$DATE^BGP0UTL($P(N,U,Y)),P=P+1
Q
EXIT ;
Q:BGPPTYPE'="P"
I $E(IOST)="C",IO=IO(0),'$D(ZTQUEUED) W ! S DIR(0)="EO",DIR("A")="End of report. Press ENTER" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q
ISED(BGPMUYF,BGPIC) ; Determine if measure is an ED measure (for special headings)
N BGPTITLE
S BGPTITLE=$P(^BGPMUIND(BGPMUYF,BGPIC,0),U,3)
Q ($E(BGPTITLE,1,2)="ED")
Q
C(X,X2,X3) ;
D COMMA^%DTC
Q X
BGPMUPP ; IHS/MSC/MGH - Meaningful Use Print Jul 2009 6:26 AM ;31-Jan-2011 16:06;MGH
+1 ;;14.1;IHS CLINICAL REPORTING;**1**;MAY 29, 2014;Build 2
+2 ;
+3 ;
PRINT ;
+1 KILL ^TMP($JOB)
+2 KILL BGPDELIM
+3 SET BGPIOSL=$SELECT($GET(BGPGUI):55,1:$GET(IOSL))
+4 SET BGPQUIT=""
+5 SET ^TMP($JOB,"BGPDEL",0)=0
+6 IF $GET(BGPAREAA)
DO SETEXCEL
+7 SET BGPIFTR=""
+8 IF BGPROT="X"
DO XML
QUIT
+9 IF BGPROT="D"
DO DEL
QUIT
+10 SET BGPPTYPE="P"
+11 SET BGPQHDR=0
+12 ;I BGPQHDR D EXIT Q
+13 SET BGPGPG=0
+14 SET BGPQUIT=""
+15 DO PRINT1
+16 KILL ^TMP($JOB)
+17 DO EXIT
+18 QUIT
+19 ;
DEL ;create delimited output file
+1 ;close printer device
IF '$DATA(BGPGUI)
DO ^%ZISC
+2 IF BGPDELT="F"
Begin DoDot:1
+3 SET Y="A delimited output file called "_BGPDELF_".txt has been placed in"
DO W(Y,0,2,"P")
+4 SET Y="the public directory for your use in Excel or some other software package. See"
DO W(Y,0,1,"P")
+5 SET Y="your site manager to access this file."
DO W(Y,0,1,"P")
End DoDot:1
+6 KILL ^TMP($JOB)
+7 SET ^TMP($JOB,"BGPDEL",0)=0
+8 SET BGPQHDR=0
+9 SET BGPPTYPE="D"
+10 SET BGPGPG=0
+11 SET BGPQUIT=""
+12 DO PRINT1^BGPMUDEL
+13 DO SAVEDEL^BGPMUDEL
+14 SET BGPIFTR=1
+15 KILL ^TMP($JOB)
+16 QUIT
XML ;create XML output files
+1 ;close printer device
IF '$DATA(BGPGUI)
DO ^%ZISC
+2 KILL ^TMP($JOB)
+3 SET ^TMP($JOB,"BGPXML",0)=0
+4 SET BGPQHDR=0
+5 SET BGPPTYPE="X"
+6 SET BGPQUIT=""
+7 DO PRINT1^BGPMUXML
+8 DO SAVEXML^BGPMUXML
+9 SET BGPIFTR=1
+10 KILL ^TMP($JOB)
+11 QUIT
+12 ;V=text, C=centered, F=#of CR/LF before, M="P"(print),"D"(delim), P=tmp global piece, T=tab pos
W(V,C,F,M,P,T) ;EP
+1 IF $GET(F)=""
SET F=1
+2 IF $GET(C)=""
SET C=0
+3 IF $GET(P)=""
SET P=1
+4 IF $GET(T)=""
SET T=0
+5 IF M="P"
Begin DoDot:1
+6 ;I $Y>(BGPIOSL-4) D HEADER^BGPMUPH
+7 NEW X
+8 FOR X=1:1:F
WRITE !
+9 IF C
WRITE $$CJ^XLFSTR(V,80)
+10 IF 'C
WRITE ?T,V
End DoDot:1
QUIT
+11 ;set up array
+12 IF '$GET(F)
SET F=0
+13 NEW %,Z
+14 SET Z=""
+15 SET %=$PIECE($GET(^TMP($JOB,"BGPDEL",0)),U)
+16 FOR Z=1:1:F
SET %=%+1
SET ^TMP($JOB,"BGPDEL",%)=""
+17 SET $PIECE(^TMP($JOB,"BGPDEL",0),U)=%
+18 IF '$DATA(^TMP($JOB,"BGPDEL",%))
SET ^TMP($JOB,"BGPDEL",%)=""
+19 SET $PIECE(^TMP($JOB,"BGPDEL",%),U,P)=V
+20 QUIT
+21 ;
WTITLE(I) ;EP - write title line
+1 NEW T,X,Y,S
+2 SET T=$PIECE(^BGPMUIND(BGPMUYF,I,0),U,3)
+3 IF BGPPTYPE="P"
IF $LENGTH(T)<81
DO W(T,0,1,BGPPTYPE)
QUIT
+4 IF BGPPTYPE="D"
DO W(T,0,1,BGPPTYPE)
DO W("",0,1,BGPPTYPE)
QUIT
+5 SET X=$EXTRACT(T,1,80)
+6 SET S=""
+7 FOR Y=80:-1:1
IF S
QUIT
SET I=$EXTRACT(X,Y)
IF I=" "
SET S=Y
+8 ;W !,$E(T,1,S)
DO W^BGPMUPP($EXTRACT(T,1,S),0,1,BGPPTYPE)
+9 DO W^BGPMUPP($EXTRACT(T,(S+1),$LENGTH(T)),0,1,BGPPTYPE)
+10 QUIT
ANYDEV() ;
+1 NEW X,G,Y
+2 SET G=0
+3 SET X=0
FOR
SET X=$ORDER(BGPINDL(X))
IF X'=+X
QUIT
SET Y=0
FOR
SET Y=$ORDER(BGPINDL(X,Y))
IF Y'=+Y
QUIT
IF $PIECE(^BGPNPLT(Y,0),U,7)=9
SET G=1
+4 QUIT G
ALLDEV() ;
+1 NEW X,G,Y
+2 SET G=1
+3 SET X=0
FOR
SET X=$ORDER(BGPINDL(X))
IF X'=+X
QUIT
SET Y=0
FOR
SET Y=$ORDER(BGPINDL(X,Y))
IF Y'=+Y
QUIT
IF $PIECE(^BGPNPLT(Y,0),U,7)=1
SET G=0
+4 QUIT G
PRINT1 ;EP
+1 NEW BGPDEVOR,BGPIC,BGPGDEV
+2 DO COVERPG
+3 SET BGPGDEV=1
+4 SET BGPDEVOR=0
FOR
SET BGPDEVOR=$ORDER(^BGPMUIND(BGPMUYF,"ADO",BGPDEVOR))
IF BGPDEVOR'=+BGPDEVOR!(BGPQUIT)
QUIT
Begin DoDot:1
+5 SET BGPIC=$ORDER(^BGPMUIND(BGPMUYF,"ADO",BGPDEVOR,0))
IF BGPIC=""
QUIT
+6 IF $DATA(BGPIND(BGPIC))
DO PRINT2
+7 IF BGPQUIT
QUIT
End DoDot:1
+8 KILL BGPGDEV
+9 IF BGPQUIT
QUIT
PRINTSUM ; Print summary page of all measure calculations
+1 NEW BGPPSUM
+2 SET BGPPSUM=1
+3 DO ^BGPMUPPS
+4 QUIT
COVERPG ;
+1 SET Y="Cover Page"
DO W(Y,1,0,BGPPTYPE)
+2 SET Y="*** IHS Stage 1 Meaningful Use ***"
DO W(Y,1,2,BGPPTYPE)
+3 SET Y="*** "_$SELECT($GET(BGPMUT)'="H":"Eligible Professional (EP)",1:"Hospital")_" Clinical Quality Measures Report ***"
DO W(Y,1,1,BGPPTYPE)
+4 SET Y="CRS 2014, Version 14.1"
DO W(Y,1,2,BGPPTYPE)
+5 SET Y="Date Report Run: "_$$FMTE^XLFDT(DT)
DO W(Y,1,1,BGPPTYPE)
+6 SET Y="Site where Run: "_$PIECE(^DIC(4,DUZ(2),0),U)
DO W(Y,1,1,BGPPTYPE)
+7 SET Y="Report Generated by: "_$PIECE($GET(^VA(200,DUZ,0)),U,1)
DO W(Y,1,1,BGPPTYPE)
+8 SET Y="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED)
DO W(Y,1,1,BGPPTYPE)
+9 SET Y="Previous Period: "_$$FMTE^XLFDT(BGPPBD)_" to "_$$FMTE^XLFDT(BGPPED)
DO W(Y,1,1,BGPPTYPE)
+10 SET Y="Baseline Period: "_$$FMTE^XLFDT(BGPBBD)_" to "_$$FMTE^XLFDT(BGPBED)
DO W(Y,1,1,BGPPTYPE)
+11 IF $GET(BGPMUT)'="H"
SET Y="Measures: Stage 1 Meaningful Use Eligible Professional (EP) "_$SELECT(BGPINDT="C":"Core Measures",BGPINDT="A":"Alternate Core",BGPINDT="M":"Menu Set Measures",1:"Selected Measures")
DO W(Y,0,2,BGPPTYPE)
+12 IF $GET(BGPMUT)="H"
Begin DoDot:1
+13 SET Y="Measures: Stage 1 Meaningful Use Eligible Hospital (EH) and"
DO W(Y,0,2,BGPPTYPE)
+14 SET Y="Critical Access Hospital (CAH) Clinical Quality Measures"
DO W(Y,0,1,BGPPTYPE)
End DoDot:1
+15 ;I $G(BGPMUT)="H" S Y="Measures: Stage 1 Meaningful Use Eligible Hospital "_$S(BGPINDT="S":"Selected Measures",1:"Measures") D W(Y,0,2,BGPPTYPE)
+16 ;I BGPINDT="A" S Y="Measures" D W(Y,0,1,BGPPTYPE)
+17 IF $GET(BGPMUT)="P"
SET Y="Population: "_$SELECT(BGPBEN=1:"Indian/Alaskan Native (Classification 01)",BGPBEN=2:"Not Indian Alaskan/Native (Not Classification 01)",1:"All patients")
DO W(Y,0,2,BGPPTYPE)
+18 IF $GET(BGPMUT)'="H"
Begin DoDot:1
+19 SET Y="Eligible Professional (EP): "_$PIECE(^VA(200,BGPPROV,0),U)
DO W(Y,0,2,BGPPTYPE)
End DoDot:1
+20 IF $GET(BGPMUT)="H"
Begin DoDot:1
+21 SET Y="Population: "_$SELECT(BGPBEN=1:"AI/AN Only",BGPBEN=2:"Non-AI/AN",BGPBEN=3:"All Patients",1:"")
+22 DO W(Y,0,2,BGPPTYPE)
+23 SET Y="Eligible Hospital: "_$$LOC^BGPMUEH()_", "_$$GET1^DIQ(4,DUZ(2)_",",1.03)_", "_$$GET1^DIQ(4,DUZ(2)_",",.02)
+24 DO W(Y,0,2,BGPPTYPE)
End DoDot:1
+25 DO ENDTIME
+26 ;
+27 IF $GET(BGPMUT)'="H"
Begin DoDot:1
+28 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-4)
DO HEADER^BGPMUPH
IF BGPQUIT
QUIT
+29 SET Y="Warning: The Meaningful Use reports do not verify that the EP selected for"
DO W(Y,0,2,BGPPTYPE)
+30 SET Y="the reports meets the CMS EHR Incentive Program eligibility criteria. The"
DO W(Y,0,1,BGPPTYPE)
+31 SET Y="EP must make that determination."
DO W(Y,0,1,BGPPTYPE)
End DoDot:1
IF BGPQUIT
QUIT
+32 ;
+33 IF $GET(BGPMUT)'="H"
Begin DoDot:1
+34 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-3)
DO HEADER^BGPMUPH
IF BGPQUIT
QUIT
+35 SET Y="This report includes the EP "_$SELECT(BGPINDT="C":"core",BGPINDT="A":"alternate",BGPINDT="M":"menu set",1:"selected")_" clinical quality measures for"
DO W(Y,0,2,BGPPTYPE)
+36 SET Y="Stage 1 Meaningful Use."
DO W(Y,0,1,BGPPTYPE)
End DoDot:1
IF BGPQUIT
QUIT
+37 IF $GET(BGPMUT)="H"
Begin DoDot:1
+38 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-3)
DO HEADER^BGPMUPH
IF BGPQUIT
QUIT
+39 SET Y="This report includes the eligible hospital and critical access hospital"
DO W(Y,0,2,BGPPTYPE)
+40 SET Y="clinical quality measures for Stage 1 Meaningful Use."
DO W(Y,0,1,BGPPTYPE)
End DoDot:1
IF BGPQUIT
QUIT
+41 ;
+42 IF $GET(BGPMUT)'="H"
Begin DoDot:1
+43 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-4)
DO HEADER^BGPMUPH
IF BGPQUIT
QUIT
+44 SET Y="For the first Meaningful Use payment year, the reporting period is any"
DO W(Y,0,2,BGPPTYPE)
+45 SET Y="consecutive 90-days during a calendar year (Jan 1 - Dec 31). For all"
DO W(Y,0,1,BGPPTYPE)
+46 SET Y="subsequent years, the reporting period is the entire calendar year."
DO W(Y,0,1,BGPPTYPE)
End DoDot:1
IF BGPQUIT
QUIT
+47 IF $GET(BGPMUT)="H"
Begin DoDot:1
+48 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-4)
DO HEADER^BGPMUPH
IF BGPQUIT
QUIT
+49 SET Y="For the first Meaningful Use payment year, the reporting period is any"
DO W(Y,0,2,BGPPTYPE)
+50 SET Y="consecutive 90-days during a federal fiscal year (Oct 1 - Sep 30). For all"
DO W(Y,0,1,BGPPTYPE)
+51 SET Y="subsequent years, the reporting period is the entire federal fiscal year."
DO W(Y,0,1,BGPPTYPE)
End DoDot:1
IF BGPQUIT
QUIT
+52 ;
+53 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-7)
DO HEADER^BGPMUPH
IF BGPQUIT
QUIT
+54 SET Y="The report will provide a description of the measure, and explanations for"
DO W(Y,0,2,BGPPTYPE)
+55 SET Y="the denominator(s), numerator(s) and exclusions (if applicable)"
DO W(Y,0,1,BGPPTYPE)
+56 SET Y="and the measure logic."
DO W(Y,0,1,BGPPTYPE)
+57 SET Y="The measure results are contained in tabular form with the following column"
DO W(Y,0,2,BGPPTYPE)
+58 SET Y="headings:"
DO W(Y,0,1,BGPPTYPE)
+59 SET Y="REPORT % PREV YR % CHG FROM BASE % CHG"
DO W(Y,0,2,BGPPTYPE,,30)
+60 SET Y="PERIOD PERIOD PREV YR YR BASE %"
DO W(Y,0,1,BGPPTYPE,,30)
+61 IF $GET(BGPMUT)'="H"
Begin DoDot:1
+62 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-7)
DO HEADER^BGPMUPH
IF BGPQUIT
QUIT
+63 SET Y="When a report is run for a 90-day period, the PREV YR PERIOD is the same 90-day"
DO W(Y,0,2,BGPPTYPE)
+64 SET Y="period for the previous calendar year and the BASE YR is the same 90-day period"
DO W(Y,0,1,BGPPTYPE)
+65 SET Y="for the base calendar year selected. For example, a report run with Apr 1, 2010"
DO W(Y,0,1,BGPPTYPE)
+66 SET Y="through Jun 30, 2010 as the REPORT PERIOD and a base year of 2008 will include"
DO W(Y,0,1,BGPPTYPE)
+67 SET Y="data from Apr 1, 2009 through Jun 30, 2009 in the PREV YR PERIOD and Apr 1, 2008"
DO W(Y,0,1,BGPPTYPE)
+68 SET Y="through Jun 30, 2008 in the BASE YR."
DO W(Y,0,1,BGPPTYPE)
End DoDot:1
IF BGPQUIT
QUIT
+69 IF $GET(BGPMUT)="H"
Begin DoDot:1
+70 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-7)
DO HEADER^BGPMUPH
IF BGPQUIT
QUIT
+71 SET Y="When a report is run for a 90-day period, the PREV YR PERIOD is the same 90-day"
DO W(Y,0,2,BGPPTYPE)
+72 SET Y="period for the previous fiscal year and the BASE YR is the same 90-day"
DO W(Y,0,1,BGPPTYPE)
+73 SET Y="period for the base fiscal year selected. For example, a report run"
DO W(Y,0,1,BGPPTYPE)
+74 SET Y="with Apr 1, 2010 through Jun 30, 2010 as the REPORT PERIOD and a base year of"
DO W(Y,0,1,BGPPTYPE)
+75 SET Y="2008 will include data from Apr 1, 2009 through Jun 30, 2009 in the PREV YR"
DO W(Y,0,1,BGPPTYPE)
+76 SET Y="PERIOD and Apr 1, 2008 through Jun 30, 2008 in the BASE YR."
DO W(Y,0,1,BGPPTYPE)
End DoDot:1
IF BGPQUIT
QUIT
+77 IF BGPDELT="F"
Begin DoDot:1
+78 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-4)
DO HEADER^BGPMUPH
IF BGPQUIT
QUIT
+79 SET Y="A delimited output file called "_BGPDELF_".txt has been placed in"
DO W(Y,0,2,BGPPTYPE)
+80 SET Y="the public directory for your use in Excel or some other software package. See"
DO W(Y,0,1,BGPPTYPE)
+81 SET Y="your site manager to access this file."
DO W(Y,0,1,BGPPTYPE)
End DoDot:1
IF BGPQUIT
QUIT
+82 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
SET X="RUN TIME (H.M.S): "_BGPHR_"."_BGPM_"."_BGPS
DO W(X,0,2,BGPPTYPE)
End DoDot:1
+3 QUIT
WP ;
+1 KILL ^UTILITY($JOB,"W")
+2 SET BGPZ=0
SET BGPLCNT=0
+3 SET DIWL=1
SET DIWR=80
SET DIWF=""
SET BGPZ=0
FOR
SET BGPZ=$ORDER(^BGPMUIND(BGPMUYF,BGPIC,BGPNODE,BGPY,1,BGPZ))
IF BGPZ'=+BGPZ
QUIT
Begin DoDot:1
+4 SET BGPLCNT=BGPLCNT+1
+5 SET X=^BGPMUIND(BGPMUYF,BGPIC,BGPNODE,BGPY,1,BGPZ,0)
IF BGPLCNT=1
SET X=" - "_X
DO ^DIWP
+6 QUIT
End DoDot:1
WPS ;
+1 SET Z=0
FOR
SET Z=$ORDER(^UTILITY($JOB,"W",DIWL,Z))
IF Z'=+Z
QUIT
Begin DoDot:1
+2 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-3)
DO HEADER^BGPMUPH
IF BGPQUIT
QUIT
+3 DO W^BGPMUPP(^UTILITY($JOB,"W",DIWL,Z,0),0,1,BGPPTYPE)
End DoDot:1
+4 KILL DIWL,DIWR,DIWF,Z
+5 KILL ^UTILITY($JOB,"W"),X
+6 QUIT
PRINT2 ;
+1 ;K DIR I $E(IOST)="C",IO=IO(0),'$D(ZTQUEUED) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BGPQUIT=1
+2 ;header for all measures
DO HEADER1^BGPMUPH
+3 ;I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER^BGPMUPH Q:BGPQUIT
+4 DO WTITLE(BGPIC)
+5 ;W !,$P(^BGPMUIND(BGPMUYF,BGPIC,0),U,3),!
+6 ;I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER^BGPMUPH Q:BGPQUIT
+7 ;Print out the description node if there is data in it
+8 SET BGPNODE=12
DO PRINTN(BGPNODE,"Measure Summary:")
+9 ;Print out the population node if there is data in it
+10 SET BGPNODE=13
DO PRINTN(BGPNODE,"Population:")
+11 WRITE !!
+12 WRITE "Logic:"
+13 ;Print out the denominator node if there is data in it
+14 SET BGPNODE=14
DO PRINTN(BGPNODE,"Denominator Logic:",,1)
+15 ;The order for the next two sections is different between EP and Hosp
+16 IF $GET(BGPMUT)'="H"
Begin DoDot:1
+17 ;Print out the numerator node if there is data in it
+18 SET BGPNODE=15
DO PRINTN(BGPNODE,"Numerator Logic:",,1)
+19 ;Print ou the logic node if there is data in it
+20 SET BGPNODE=16
DO PRINTN(BGPNODE,"Exclusion Logic:",,1)
End DoDot:1
+21 IF $GET(BGPMUT)="H"
Begin DoDot:1
+22 ;Print ou the logic node if there is data in it
+23 SET BGPNODE=16
DO PRINTN(BGPNODE,"Denominator Exclusion Logic:",,1)
+24 ;Print out the numerator node if there is data in it
+25 SET BGPNODE=15
DO PRINTN(BGPNODE,"Numerator Logic:",,1)
End DoDot:1
+26 ;Print out the Performance node if there is data in it
+27 SET BGPNODE=17
DO PRINTN(BGPNODE,"Performance:")
+28 ;Print out the source node if there is data in it
+29 SET BGPNODE=18
DO PRINTN(BGPNODE,"Measure Source: ",1)
CALC IF BGPPTYPE="P"
XECUTE ^BGPMUIND(BGPMUYF,BGPIC,3)
DO W^BGPMUPP("",0,1,BGPPTYPE)
+1 IF BGPPTYPE="D"
XECUTE ^BGPMUIND(BGPMUYF,BGPIC,4)
DO W^BGPMUPP("",0,1,BGPPTYPE)
+2 QUIT
PRINTN(BGPNODE,TXT,SLF,XLF) ;Print out a node - SLF = print on same line as header, XLF = Xtra line feed after header
+1 IF $ORDER(^BGPMUIND(BGPMUYF,BGPIC,BGPNODE,0))
Begin DoDot:1
+2 DO W^BGPMUPP(TXT,0,2,BGPPTYPE)
+3 IF $GET(XLF)
SET X=""
DO W^BGPMUPP(X,0,1,BGPPTYPE)
+4 SET BGPY=0
FOR
SET BGPY=$ORDER(^BGPMUIND(BGPMUYF,BGPIC,BGPNODE,BGPY))
IF BGPY'=+BGPY!(BGPQUIT)
QUIT
Begin DoDot:2
+5 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-4)
IF '$GET(SLF)
DO HEADER^BGPMUPH
IF BGPQUIT
QUIT
+6 DO W^BGPMUPP(^BGPMUIND(BGPMUYF,BGPIC,BGPNODE,BGPY,0),0,$SELECT($GET(SLF):0,1:1),BGPPTYPE)
End DoDot:2
End DoDot:1
+7 QUIT
SETEXCEL ;EP
+1 IF $GET(BGPAREAA)
Begin DoDot:1
+2 SET X=0
FOR
SET X=$ORDER(BGPSUL(X))
IF X'=+X
QUIT
Begin DoDot:2
+3 SET N=^BGPGPDCT(X,0)
+4 SET (D,L)=""
+5 SET L=$PIECE(N,U,9)
IF L
SET L=$ORDER(^AUTTLOC("C",L,0))
IF L
SET D=$PIECE($GET(^AUTTLOC(L,1)),U,3)
SET L=$SELECT(L:$PIECE(^DIC(4,L,0),U),1:"?????")
+6 SET BGPEI(X)=L_U_$PIECE(N,U,9)_U_D_U_$$DATE^BGP0UTL($PIECE(N,U,13))
SET P=5
FOR Y=1:1:6
SET $PIECE(BGPEI(X),U,P)=$$DATE^BGP0UTL($PIECE(N,U,Y))
SET P=P+1
+7 SET BGPEI2(X)=L_U_$PIECE(N,U,9)_U_D_U_$$DATE^BGP0UTL($PIECE(N,U,13))
SET P=5
FOR Y=1:1:6
SET $PIECE(BGPEI2(X),U,P)=$$DATE^BGP0UTL($PIECE(N,U,Y))
SET P=P+1
+8 SET BGPEIDV1(X)=L_U_$PIECE(N,U,9)_U_D_U_$$DATE^BGP0UTL($PIECE(N,U,13))
SET P=5
FOR Y=1:1:6
SET $PIECE(BGPEIDV1(X),U,P)=$$DATE^BGP0UTL($PIECE(N,U,Y))
SET P=P+1
+9 SET BGPEIDV2(X)=L_U_$PIECE(N,U,9)_U_D_U_$$DATE^BGP0UTL($PIECE(N,U,13))
SET P=5
FOR Y=1:1:6
SET $PIECE(BGPEIDV2(X),U,P)=$$DATE^BGP0UTL($PIECE(N,U,Y))
SET P=P+1
+10 SET BGPONN1(X)=L_U_$PIECE(N,U,9)_U_D_U_$$DATE^BGP0UTL($PIECE(N,U,13))
SET P=5
FOR Y=1:1:6
SET $PIECE(BGPONN1(X),U,P)=$$DATE^BGP0UTL($PIECE(N,U,Y))
SET P=P+1
+11 SET BGPONN2(X)=L_U_$PIECE(N,U,9)_U_D_U_$$DATE^BGP0UTL($PIECE(N,U,13))
SET P=5
FOR Y=1:1:6
SET $PIECE(BGPONN2(X),U,P)=$$DATE^BGP0UTL($PIECE(N,U,Y))
SET P=P+1
+12 ;S BGPONN3(X)=L_U_$P(N,U,9)_U_D_U_$$DATE^BGP0UTL($P(N,U,13)) S P=5 F Y=1:1:6 S $P(BGPONN3(X),U,P)=$$DATE^BGP0UTL($P(N,U,Y)),P=P+1
+13 QUIT
End DoDot:2
+14 QUIT
End DoDot:1
QUIT
+15 ;S X=BGPRPT
+16 ;S N=^BGPGPDCT(X,0)
+17 ;S L=$P(N,U,9),L=$O(^AUTTLOC("C",L,0)) S D=$P($G(^AUTTLOC(L,1)),U,3),L=$S(L:$P(^DIC(4,L,0),U),1:"?????")
+18 ;S BGPEI(X)=L_U_$P(N,U,9)_U_D_U_$$DATE^BGP0UTL($P(N,U,13)) S P=5 F Y=1:1:6 S $P(BGPEI(X),U,P)=$$DATE^BGP0UTL($P(N,U,Y)),P=P+1
+19 QUIT
EXIT ;
+1 IF BGPPTYPE'="P"
QUIT
+2 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
IF '$DATA(ZTQUEUED)
WRITE !
SET DIR(0)="EO"
SET DIR("A")="End of report. Press ENTER"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 QUIT
ISED(BGPMUYF,BGPIC) ; Determine if measure is an ED measure (for special headings)
+1 NEW BGPTITLE
+2 SET BGPTITLE=$PIECE(^BGPMUIND(BGPMUYF,BGPIC,0),U,3)
+3 QUIT ($EXTRACT(BGPTITLE,1,2)="ED")
+4 QUIT
C(X,X2,X3) ;
+1 DO COMMA^%DTC
+2 QUIT X
