BGP8PCH ; IHS/CMI/LAB - cover page for ELDER 25 Jun 2010 10:20 AM ;
;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
;
S BGPQHDR=0,BGPHPG=0
D HDR
I BGPPTYPE="P" Q:BGPQHDR
D W^BGP8DP("Measures: IPC Performance Measures",0,1,BGPPTYPE)
D W^BGP8DP("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)
D ENDTIME
D DENOMHDR
N1 I BGPPTYPE="P" Q:BGPQHDR
I BGPPTYPE="P",$Y>(BGPIOSL-3) D HDR Q:BGPQHDR
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^BGP8DP("A delimited output file called "_BGPDELF,0,2,BGPPTYPE) D
..D W^BGP8DP("has been placed in the "_$$GETDEDIR^BGP8UTL2()_" directory for your use in Excel or some",0,1,BGPPTYPE),W^BGP8DP("other software package. See your site manager to access this file.",0,1,BGPPTYPE)
D I BGPPTYPE="P" Q:BGPQHDR
.I BGPPTYPE="P",$Y>(BGPIOSL-2) D HDR Q:BGPQHDR
.I $G(BGPCOMMI) D W^BGP8DP("The following Community is included in this report: "_$P(^AUTTCOM(BGPCOMMI,0),U),0,2,BGPPTYPE,1,2) G H1
.D W^BGP8DP("Community Taxonomy Name: "_$P(^ATXAX(BGPTAXI,0),U),0,2,BGPPTYPE,1,10)
.D W^BGP8DP("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^BGP8DP($E($P(Y,";",BGPZZ),1,20),0,1,BGPPTYPE,1,10)
...D W^BGP8DP($E($P(Y,";",(BGPZZ+1)),1,20),0,0,BGPPTYPE,2,30)
...D W^BGP8DP($E($P(Y,";",(BGPZZ+2)),1,20),0,0,BGPPTYPE,3,60)
...Q
H1 D W^BGP8DP("",0,1,BGPPTYPE)
I BGPPTYPE="D" D W^BGP8DP("ENDCOVERPAGE",0,1,BGPPTYPE)
K BGPX,BGPQUIT
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^BGP8DP("ZZZZZZZ",0,0,BGPPTYPE),W^BGP8DP("",0,1,BGPPTYPE) ;GUI
D W^BGP8DP("Cover Page",1,2,BGPPTYPE)
D W^BGP8DP("*** IHS 2018 IPC Measures Report ***",1,2,BGPPTYPE)
N ;
D W^BGP8DP($$RPTVER^BGP8BAN,1,1,BGPPTYPE)
D W^BGP8DP("Date Report Run: "_$$FMTE^XLFDT(DT),1,1,BGPPTYPE)
D W^BGP8DP("Site where Run: "_$P(^DIC(4,DUZ(2),0),U),1,1,BGPPTYPE)
D W^BGP8DP("Report Generated by: "_$$USR,1,1,BGPPTYPE)
S X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED) D W^BGP8DP(X,1,1,BGPPTYPE)
S X="Previous Year Period: "_$$FMTE^XLFDT(BGPPBD)_" to "_$$FMTE^XLFDT(BGPPED) D W^BGP8DP(X,1,1,BGPPTYPE)
I '$G(BGPDASH) S X="Baseline Period: "_$$FMTE^XLFDT(BGPBBD)_" to "_$$FMTE^XLFDT(BGPBED) D W^BGP8DP(X,1,1,BGPPTYPE)
D W^BGP8DP("",0,2,BGPPTYPE)
Q
DENOMHDR ;IPC COVER PAGE TEXT
D W^BGP8DP("",0,1,BGPPTYPE)
Q:$G(BGPSEAT)
S BGPX=$O(^BGPCTRL("B",2018,0))
S BGPY=0 F S BGPY=$O(^BGPCTRL(BGPX,23,BGPY)) Q:BGPY'=+BGPY!(BGPQHDR) D
.I BGPPTYPE="P",$Y>(BGPIOSL-2) D HDR Q:BGPQHDR
.D W^BGP8DP(^BGPCTRL(BGPX,23,BGPY,0),0,1,BGPPTYPE)
.Q
D W^BGP8DP("",0,1,BGPPTYPE)
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^BGP8DP("RUN TIME (H.M.S): "_BGPHR_"."_BGPM_"."_BGPS,0,2,BGPPTYPE)
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")
I BGPPTYPE="D",'$G(BGPDASH) Q
G:'BGPGPG HEADER1
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 Q
I BGPPTYPE="P" W:$D(IOF) @IOF S BGPGPG=BGPGPG+1
I $G(BGPGUI),BGPPTYPE="P" D W^BGP8DP("ZZZZZZZ",0,0,BGPPTYPE),W^BGP8DP("",0,1,BGPPTYPE) ;GUI
I BGPPTYPE="P" S X=$P(^VA(200,DUZ,0),U,2),$E(X,35)=$$FMTE^XLFDT(DT),$E(X,70)="Page "_BGPGPG D W^BGP8DP(X,1,1,BGPPTYPE)
I BGPPTYPE'="P" S X=$P(^VA(200,DUZ,0),U,2),$P(X,U,2)=$$FMTE^XLFDT(DT) D W^BGP8DP(X,0,1,BGPPTYPE)
D W^BGP8DP("*** IHS 2018 IPC Measures Report ***",1,1,BGPPTYPE) G N
D W^BGP8DP($P(^DIC(4,DUZ(2),0),U),1,1,BGPPTYPE)
S X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED) D W^BGP8DP(X,1,1,BGPPTYPE)
S X="Previous Year Period: "_$$FMTE^XLFDT(BGPPBD)_" to "_$$FMTE^XLFDT(BGPPED) D W^BGP8DP(X,1,1,BGPPTYPE)
I '$G(BGPDASH) S X="Baseline Period: "_$$FMTE^XLFDT(BGPBBD)_" to "_$$FMTE^XLFDT(BGPBED) D W^BGP8DP(X,1,1,BGPPTYPE)
D W^BGP8DP($TR($J("",80)," ","-"),0,1,BGPPTYPE)
Q
BGP8PCH ; IHS/CMI/LAB - cover page for ELDER 25 Jun 2010 10:20 AM ;
+1 ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
+2 ;
+3 SET BGPQHDR=0
SET BGPHPG=0
+4 DO HDR
+5 IF BGPPTYPE="P"
IF BGPQHDR
QUIT
+6 DO W^BGP8DP("Measures: IPC Performance Measures",0,1,BGPPTYPE)
+7 DO W^BGP8DP("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)
+8 DO ENDTIME
+9 DO DENOMHDR
N1 IF BGPPTYPE="P"
IF BGPQHDR
QUIT
+1 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-3)
DO HDR
IF BGPQHDR
QUIT
+2 IF BGPROT'="P"
IF '$DATA(BGPGUI)
Begin DoDot:1
+3 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-2)
DO HDR
IF BGPQHDR
QUIT
+4 IF BGPDELF]""
DO W^BGP8DP("A delimited output file called "_BGPDELF,0,2,BGPPTYPE)
Begin DoDot:2
+5 DO W^BGP8DP("has been placed in the "_$$GETDEDIR^BGP8UTL2()_" directory for your use in Excel or some",0,1,BGPPTYPE)
DO W^BGP8DP("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
+6 Begin DoDot:1
+7 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-2)
DO HDR
IF BGPQHDR
QUIT
+8 IF $GET(BGPCOMMI)
DO W^BGP8DP("The following Community is included in this report: "_$PIECE(^AUTTCOM(BGPCOMMI,0),U),0,2,BGPPTYPE,1,2)
GOTO H1
+9 DO W^BGP8DP("Community Taxonomy Name: "_$PIECE(^ATXAX(BGPTAXI,0),U),0,2,BGPPTYPE,1,10)
+10 DO W^BGP8DP("The following communities are included in this report:",0,1,BGPPTYPE,1,10)
Begin DoDot:2
+11 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
+12 SET BGPZZ=0
SET C=0
FOR BGPZZ=1:3:N
Begin DoDot:3
+13 DO W^BGP8DP($EXTRACT($PIECE(Y,";",BGPZZ),1,20),0,1,BGPPTYPE,1,10)
+14 DO W^BGP8DP($EXTRACT($PIECE(Y,";",(BGPZZ+1)),1,20),0,0,BGPPTYPE,2,30)
+15 DO W^BGP8DP($EXTRACT($PIECE(Y,";",(BGPZZ+2)),1,20),0,0,BGPPTYPE,3,60)
+16 QUIT
End DoDot:3
End DoDot:2
End DoDot:1
IF BGPPTYPE="P"
IF BGPQHDR
QUIT
H1 DO W^BGP8DP("",0,1,BGPPTYPE)
+1 IF BGPPTYPE="D"
DO W^BGP8DP("ENDCOVERPAGE",0,1,BGPPTYPE)
+2 KILL BGPX,BGPQUIT
+3 QUIT
+4 ;
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^BGP8DP("ZZZZZZZ",0,0,BGPPTYPE)
DO W^BGP8DP("",0,1,BGPPTYPE)
+3 DO W^BGP8DP("Cover Page",1,2,BGPPTYPE)
+4 DO W^BGP8DP("*** IHS 2018 IPC Measures Report ***",1,2,BGPPTYPE)
N ;
+1 DO W^BGP8DP($$RPTVER^BGP8BAN,1,1,BGPPTYPE)
+2 DO W^BGP8DP("Date Report Run: "_$$FMTE^XLFDT(DT),1,1,BGPPTYPE)
+3 DO W^BGP8DP("Site where Run: "_$PIECE(^DIC(4,DUZ(2),0),U),1,1,BGPPTYPE)
+4 DO W^BGP8DP("Report Generated by: "_$$USR,1,1,BGPPTYPE)
+5 SET X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED)
DO W^BGP8DP(X,1,1,BGPPTYPE)
+6 SET X="Previous Year Period: "_$$FMTE^XLFDT(BGPPBD)_" to "_$$FMTE^XLFDT(BGPPED)
DO W^BGP8DP(X,1,1,BGPPTYPE)
+7 IF '$GET(BGPDASH)
SET X="Baseline Period: "_$$FMTE^XLFDT(BGPBBD)_" to "_$$FMTE^XLFDT(BGPBED)
DO W^BGP8DP(X,1,1,BGPPTYPE)
+8 DO W^BGP8DP("",0,2,BGPPTYPE)
+9 QUIT
DENOMHDR ;IPC COVER PAGE TEXT
+1 DO W^BGP8DP("",0,1,BGPPTYPE)
+2 IF $GET(BGPSEAT)
QUIT
+3 SET BGPX=$ORDER(^BGPCTRL("B",2018,0))
+4 SET BGPY=0
FOR
SET BGPY=$ORDER(^BGPCTRL(BGPX,23,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^BGP8DP(^BGPCTRL(BGPX,23,BGPY,0),0,1,BGPPTYPE)
+7 QUIT
End DoDot:1
+8 DO W^BGP8DP("",0,1,BGPPTYPE)
+9 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^BGP8DP("RUN TIME (H.M.S): "_BGPHR_"."_BGPM_"."_BGPS,0,2,BGPPTYPE)
End DoDot:1
+3 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")
+1 IF BGPPTYPE="D"
IF '$GET(BGPDASH)
QUIT
+2 IF 'BGPGPG
GOTO HEADER1
+3 KILL DIR
IF $EXTRACT(IOST)="C"
IF IO=IO(0)
IF '$DATA(ZTQUEUED)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET BGPQUIT=1
QUIT
+1 IF BGPPTYPE="P"
IF $DATA(IOF)
WRITE @IOF
SET BGPGPG=BGPGPG+1
+2 ;GUI
IF $GET(BGPGUI)
IF BGPPTYPE="P"
DO W^BGP8DP("ZZZZZZZ",0,0,BGPPTYPE)
DO W^BGP8DP("",0,1,BGPPTYPE)
+3 IF BGPPTYPE="P"
SET X=$PIECE(^VA(200,DUZ,0),U,2)
SET $EXTRACT(X,35)=$$FMTE^XLFDT(DT)
SET $EXTRACT(X,70)="Page "_BGPGPG
DO W^BGP8DP(X,1,1,BGPPTYPE)
+4 IF BGPPTYPE'="P"
SET X=$PIECE(^VA(200,DUZ,0),U,2)
SET $PIECE(X,U,2)=$$FMTE^XLFDT(DT)
DO W^BGP8DP(X,0,1,BGPPTYPE)
+5 DO W^BGP8DP("*** IHS 2018 IPC Measures Report ***",1,1,BGPPTYPE)
GOTO N
+6 DO W^BGP8DP($PIECE(^DIC(4,DUZ(2),0),U),1,1,BGPPTYPE)
+7 SET X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED)
DO W^BGP8DP(X,1,1,BGPPTYPE)
+8 SET X="Previous Year Period: "_$$FMTE^XLFDT(BGPPBD)_" to "_$$FMTE^XLFDT(BGPPED)
DO W^BGP8DP(X,1,1,BGPPTYPE)
+9 IF '$GET(BGPDASH)
SET X="Baseline Period: "_$$FMTE^XLFDT(BGPBBD)_" to "_$$FMTE^XLFDT(BGPBED)
DO W^BGP8DP(X,1,1,BGPPTYPE)
+10 DO W^BGP8DP($TRANSLATE($JUSTIFY("",80)," ","-"),0,1,BGPPTYPE)
+11 QUIT
