Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BGP8PCH

BGP8PCH.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  S BGPQHDR=0,BGPHPG=0
  1.  D HDR
  1.  I BGPPTYPE="P" Q:BGPQHDR
  1.  D W^BGP8DP("Measures: IPC Performance Measures",0,1,BGPPTYPE)
  1.  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)
  1.  D ENDTIME
  1.  D DENOMHDR
  1. N1 I BGPPTYPE="P" Q:BGPQHDR
  1.  I BGPPTYPE="P",$Y>(BGPIOSL-3) D HDR Q:BGPQHDR
  1.  I BGPROT'="P",'$D(BGPGUI) D  I BGPPTYPE="P" Q:BGPQHDR
  1.  .I BGPPTYPE="P",$Y>(BGPIOSL-2) D HDR Q:BGPQHDR
  1.  .I BGPDELF]"" D W^BGP8DP("A delimited output file called "_BGPDELF,0,2,BGPPTYPE) D
  1.  ..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)
  1.  D  I BGPPTYPE="P" Q:BGPQHDR
  1.  .I BGPPTYPE="P",$Y>(BGPIOSL-2) D HDR Q:BGPQHDR
  1.  .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
  1.  .D W^BGP8DP("Community Taxonomy Name: "_$P(^ATXAX(BGPTAXI,0),U),0,2,BGPPTYPE,1,10)
  1.  .D W^BGP8DP("The following communities are included in this report:",0,1,BGPPTYPE,1,10) D
  1.  ..S BGPZZ="",N=0,Y="" F  S BGPZZ=$O(BGPTAX(BGPZZ)) Q:BGPZZ=""  S N=N+1,Y=Y_$S(N=1:"",1:";")_BGPZZ
  1.  ..S BGPZZ=0,C=0 F BGPZZ=1:3:N D
  1.  ...D W^BGP8DP($E($P(Y,";",BGPZZ),1,20),0,1,BGPPTYPE,1,10)
  1.  ...D W^BGP8DP($E($P(Y,";",(BGPZZ+1)),1,20),0,0,BGPPTYPE,2,30)
  1.  ...D W^BGP8DP($E($P(Y,";",(BGPZZ+2)),1,20),0,0,BGPPTYPE,3,60)
  1.  ...Q
  1. H1 D W^BGP8DP("",0,1,BGPPTYPE)
  1.  I BGPPTYPE="D" D W^BGP8DP("ENDCOVERPAGE",0,1,BGPPTYPE)
  1.  K BGPX,BGPQUIT
  1.  Q
  1.  ;
  1. HDR ;EP
  1.  I BGPPTYPE="P",'BGPHPG G HDR1
  1.  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
  1. HDR1 ;
  1.  I BGPPTYPE="P" S BGPHPG=BGPHPG+1 I BGPHPG'=1 W:$D(IOF) @IOF
  1.  I $G(BGPGUI),BGPPTYPE="P",BGPHPG'=1 D W^BGP8DP("ZZZZZZZ",0,0,BGPPTYPE),W^BGP8DP("",0,1,BGPPTYPE)  ;GUI
  1.  D W^BGP8DP("Cover Page",1,2,BGPPTYPE)
  1.  D W^BGP8DP("*** IHS 2018 IPC Measures Report ***",1,2,BGPPTYPE)
  1. N ;
  1.  D W^BGP8DP($$RPTVER^BGP8BAN,1,1,BGPPTYPE)
  1.  D W^BGP8DP("Date Report Run: "_$$FMTE^XLFDT(DT),1,1,BGPPTYPE)
  1.  D W^BGP8DP("Site where Run: "_$P(^DIC(4,DUZ(2),0),U),1,1,BGPPTYPE)
  1.  D W^BGP8DP("Report Generated by: "_$$USR,1,1,BGPPTYPE)
  1.  S X="Report Period:  "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED) D W^BGP8DP(X,1,1,BGPPTYPE)
  1.  S X="Previous Year Period:  "_$$FMTE^XLFDT(BGPPBD)_" to "_$$FMTE^XLFDT(BGPPED) D W^BGP8DP(X,1,1,BGPPTYPE)
  1.  I '$G(BGPDASH) S X="Baseline Period:  "_$$FMTE^XLFDT(BGPBBD)_" to "_$$FMTE^XLFDT(BGPBED) D W^BGP8DP(X,1,1,BGPPTYPE)
  1.  D W^BGP8DP("",0,2,BGPPTYPE)
  1.  Q
  1. DENOMHDR ;IPC COVER PAGE TEXT
  1.  D W^BGP8DP("",0,1,BGPPTYPE)
  1.  Q:$G(BGPSEAT)
  1.  S BGPX=$O(^BGPCTRL("B",2018,0))
  1.  S BGPY=0 F  S BGPY=$O(^BGPCTRL(BGPX,23,BGPY)) Q:BGPY'=+BGPY!(BGPQHDR)  D
  1.  .I BGPPTYPE="P",$Y>(BGPIOSL-2) D HDR Q:BGPQHDR
  1.  .D W^BGP8DP(^BGPCTRL(BGPX,23,BGPY,0),0,1,BGPPTYPE)
  1.  .Q
  1.  D W^BGP8DP("",0,1,BGPPTYPE)
  1.  Q
  1. ENDTIME ;EP
  1.  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
  1.  .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)
  1.  Q
  1. CTR(X,Y) ;EP - Center X in a field Y wide.
  1.  Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
  1.  ;----------
  1. EOP ;EP - End of page.
  1.  Q:$E(IOST)'="C"
  1.  Q:$D(ZTQUEUED)!$D(IO("S"))
  1.  NEW DIR
  1.  K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
  1.  S DIR(0)="E" D ^DIR
  1.  I $D(DIRUT) S BGPQHDR=1
  1.  Q
  1.  ;----------
  1. USR() ;EP - Return name of current user from ^VA(200.
  1.  Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
  1.  I BGPPTYPE="D",'$G(BGPDASH) Q
  1.  G:'BGPGPG HEADER1
  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 Q
  1. HEADER1 ;
  1.  I BGPPTYPE="P" W:$D(IOF) @IOF S BGPGPG=BGPGPG+1
  1.  I $G(BGPGUI),BGPPTYPE="P" D W^BGP8DP("ZZZZZZZ",0,0,BGPPTYPE),W^BGP8DP("",0,1,BGPPTYPE)  ;GUI
  1.  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)
  1.  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)
  1.  D W^BGP8DP("*** IHS 2018 IPC Measures Report ***",1,1,BGPPTYPE) G N
  1.  D W^BGP8DP($P(^DIC(4,DUZ(2),0),U),1,1,BGPPTYPE)
  1.  S X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED) D W^BGP8DP(X,1,1,BGPPTYPE)
  1.  S X="Previous Year Period:  "_$$FMTE^XLFDT(BGPPBD)_" to "_$$FMTE^XLFDT(BGPPED) D W^BGP8DP(X,1,1,BGPPTYPE)
  1.  I '$G(BGPDASH) S X="Baseline Period:  "_$$FMTE^XLFDT(BGPBBD)_" to "_$$FMTE^XLFDT(BGPBED) D W^BGP8DP(X,1,1,BGPPTYPE)
  1.  D W^BGP8DP($TR($J("",80)," ","-"),0,1,BGPPTYPE)
  1.  Q