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

BGP7DAR.m

Go to the documentation of this file. 
  1. BGP7DAR ; IHS/CMI/LAB - ihs area GPRA 02 Sep 2004 1:11 PM 09 Apr 2017 10:03 AM 17 Nov 2014 10:36 AM 11 Aug 2016 2:48 PM ; 
  1.  ;;17.1;IHS CLINICAL REPORTING;;MAY 10, 2017;Build 29
  1.  ;
  1.  ;
  1.  W:$D(IOF) @IOF
  1.  S BGPA=$E($P(^AUTTLOC(DUZ(2),0),U,10),1,2),BGPA=$O(^AUTTAREA("C",BGPA,0)) S BGPA=$S(BGPA:$P(^AUTTAREA(BGPA,0),U),1:"UNKNOWN AREA")
  1.  W !!,$$CTR(BGPA_" Area Aggregate National GPRA/GPRAMA Report",80)
  1. INTRO ;
  1.  D EXIT
  1. TP ;
  1.  S BGPAREAA=1
  1.  S BGPRTYPE=1,BGPBEN=1,BGPYRPTH=""
  1.  S X=$O(^BGPCTRL("B",2017,0))
  1.  S Y=^BGPCTRL(X,0)
  1.  S BGPBD=$P(Y,U,8),BGPED=$P(Y,U,9)
  1.  S BGPPBD=$P(Y,U,10),BGPPED=$P(Y,U,11)
  1.  S BGPBBD=$P(Y,U,12),BGPBED=$P(Y,U,13)
  1.  S BGPPER=$P(Y,U,14),BGPQTR=3
  1.  G NT  ;comment out when testing in TEHR
  1.  S (BGPBD,BGPED,BGPTP)=""
  1.  S DIR(0)="S^1:January 1 - December 31;2:April 1 - March 31;3:July 1 - June 30;4:October 1 - September 30;5:User-Defined Report Period",DIR("A")="Enter the date range for your report" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) D EXIT Q
  1.  S BGPQTR=Y
  1.  I BGPQTR=5 D ENDDATE^BGP7DGPU
  1.  I BGPQTR'=5 D F
  1.  I BGPPER="" W !,"Year not entered.",! G TP
  1.  I BGPQTR=1 S BGPBD=$E(BGPPER,1,3)_"0101",BGPED=$E(BGPPER,1,3)_"1231"
  1.  I BGPQTR=2 S BGPBD=($E(BGPPER,1,3)-1)_"0401",BGPED=$E(BGPPER,1,3)_"0331"
  1.  I BGPQTR=3 S BGPBD=($E(BGPPER,1,3)-1)_"0701",BGPED=$E(BGPPER,1,3)_"0630"
  1.  I BGPQTR=4 S BGPBD=($E(BGPPER,1,3)-1)_"1001",BGPED=$E(BGPPER,1,3)_"0930"
  1.  I BGPQTR=5 D
  1.  .S D=$$FMADD^XLFDT(BGPPER,1)
  1.  .I $E(BGPPER,4,7)'=1231 S BGPBD=($E(BGPPER,1,3)-1)_$E(D,4,7),BGPED=BGPPER,BGPPER=$E(BGPED,1,3)_"0000"
  1.  .I $E(BGPPER,4,7)=1231 S BGPBD=$E(BGPPER,1,3)_$E(D,4,7),BGPED=BGPPER,BGPPER=$E(BGPED,1,3)_"0000"
  1.  I BGPED>DT D  G:BGPDO=1 TP
  1.  .W !!,"You have selected Current Report period ",$$FMTE^XLFDT(BGPBD)," through ",$$FMTE^XLFDT(BGPED),"."
  1.  .W !,"The end date of this report is in the future; your data will not be",!,"complete.",!
  1.  .K DIR S BGPDO=0 S DIR(0)="Y",DIR("A")="Do you want to change your Current Report Dates",DIR("B")="N" KILL DA D ^DIR KILL DIR
  1.  .I $D(DIRUT) S BGPDO=1 Q
  1.  .I Y S BGPDO=1 Q
  1.  .Q
  1. BY ;get baseline year
  1.  S BGPVDT=""
  1.  W !!,"Enter the Baseline Year to compare data to.",!,"Use a 4 digit year, e.g. 2010"
  1.  S DIR(0)="D^::EP"
  1.  S DIR("A")="Enter Year (e.g. 2010)"
  1.  D ^DIR KILL DIR
  1.  I $D(DIRUT) G TP
  1.  I $D(DUOUT) S DIRUT=1 G TP
  1.  S BGPVDT=Y
  1.  I $E(Y,4,7)'="0000" W !!,"Please enter a year only!",! G BY
  1.  S X=$E(BGPPER,1,3)-$E(BGPVDT,1,3)
  1.  S X=X_"0000"
  1.  S BGPBBD=BGPBD-X,BGPBBD=$E(BGPBBD,1,3)_$E(BGPBD,4,7)
  1.  S BGPBED=BGPED-X,BGPBED=$E(BGPBED,1,3)_$E(BGPED,4,7)
  1.  S BGPPBD=($E(BGPBD,1,3)-1)_$E(BGPBD,4,7)
  1.  S BGPPED=($E(BGPED,1,3)-1)_$E(BGPED,4,7)
  1. NT ;END TEST STUFF
  1.  W !!,"The date ranges for this report are:"
  1.  W !?5,"Report Period: ",?31,$$FMTE^XLFDT(BGPBD)," to ",?31,$$FMTE^XLFDT(BGPED)
  1.  W !?5,"Previous Year Period: ",?31,$$FMTE^XLFDT(BGPPBD)," to ",?31,$$FMTE^XLFDT(BGPPED)
  1.  W !?5,"Baseline Period: ",?31,$$FMTE^XLFDT(BGPBBD)," to ",?31,$$FMTE^XLFDT(BGPBED)
  1. ASU ;
  1.  S BGPSUCNT=0
  1.  S BGPRPTT=""
  1.  S DIR(0)="S^A:AREA Aggregate;F:One Facility",DIR("A")="Run Report for",DIR("B")="A" KILL DA D ^DIR KILL DIR
  1.  G:$D(DIRUT) EXIT
  1.  S BGPRPTT=Y
  1.  W !!!,"You will now be able to select which sites to use in the",!,"area aggregate/facility report.",!
  1.  S DIR(0)="E",DIR("A")="Press Enter to Continue" KILL DA D ^DIR KILL DIR
  1.  K BGPSUL
  1.  D EN^BGP7ASL
  1.  I '$D(BGPSUL) W !!,"No sites selected" D EXIT Q
  1.  S X=0,C=0 F  S X=$O(BGPSUL(X)) Q:X'=+X  S C=C+1
  1.  W !!,"A total of ",C," facilities have been selected.",!!
  1.  ;I C=1 S BGPRPTT="F",BGPSUCNT=1,Y=$O(BGPSUL(0)),X=$P(^BGPGPDCG(Y,0),U,9),X=$O(^AUTTLOC("C",X,0)) I X S BGPSUNM=$P(^DIC(4,X,0),U)
  1. ZIS ;call to XBDBQUE
  1. EISSEX ;
  1.  S BGPEXCEL=$S($G(BGPSUMON):0,BGPRPTT="F":0,C<1:0,1:1)
  1.  S BGPUF=$$GETDIR^BGP7UTL2()
  1.  ;I ^%ZOSF("OS")["PC"!(^%ZOSF("OS")["NT")!($P($G(^AUTTSITE(1,0)),U,21)=2) S BGPUF=$S($P($G(^AUTTSITE(1,1)),U,2)]"":$P(^AUTTSITE(1,1),U,2),1:"C:\EXPORT")
  1.  ;I $P(^AUTTSITE(1,0),U,21)=1 S BGPUF="/usr/spool/uucppublic/"
  1.  I BGPEXCEL=1 D
  1.  .S BGPNOW=$$NOW^XLFDT() S BGPNOW=$$NOW^XLFDT() S BGPNOW=$P(BGPNOW,".")_"."_$$RZERO^BGP7UTL($P(BGPNOW,".",2),6)
  1.  .S BGPC=0,X=0 F  S X=$O(BGPSUL(X)) Q:X'=+X  S BGPC=BGPC+1
  1.  .I BGPUF="" W:'$D(ZTQUEUED) !!,"Cannot continue.....can't find export directory name. EXCEL file",!,"not written." Q
  1.  .S BGPFGNT1="CRSGPRANT1"_$P(^AUTTLOC(DUZ(2),0),U,10)_2017063000000000_$$D^BGP7UTL(BGPNOW)_"_"_$$LZERO^BGP7UTL(BGPC,6)_".TXT"
  1.  .S BGPFGNT2="CRSGPRANT2"_$P(^AUTTLOC(DUZ(2),0),U,10)_2017063000000000_$$D^BGP7UTL(BGPNOW)_"_"_$$LZERO^BGP7UTL(BGPC,6)_".TXT"
  1.  .S BGPFDEV1="CRSGPRADEVNT1"_$P(^AUTTLOC(DUZ(2),0),U,10)_2017063000000000_$$D^BGP7UTL(BGPNOW)_"_"_$$LZERO^BGP7UTL(BGPC,6)_".TXT"
  1.  .S BGPFDEV2="CRSGPRADEVNT2"_$P(^AUTTLOC(DUZ(2),0),U,10)_2017063000000000_$$D^BGP7UTL(BGPNOW)_"_"_$$LZERO^BGP7UTL(BGPC,6)_".TXT"
  1.  .S BGPFDEV3="CRSGPRADEVNT3"_$P(^AUTTLOC(DUZ(2),0),U,10)_2017063000000000_$$D^BGP7UTL(BGPNOW)_"_"_$$LZERO^BGP7UTL(BGPC,6)_".TXT"
  1.  .S BGPFDEV4="CRSGPRADEVNT4"_$P(^AUTTLOC(DUZ(2),0),U,10)_2017063000000000_$$D^BGP7UTL(BGPNOW)_"_"_$$LZERO^BGP7UTL(BGPC,6)_".TXT"
  1.  .S BGPFGNT3="CRSGPRANT3"_$P(^AUTTLOC(DUZ(2),0),U,10)_2017063000000000_$$D^BGP7UTL(BGPNOW)_"_"_$$LZERO^BGP7UTL(BGPC,6)_".TXT"
  1.  .S BGPFGNT4="CRSGPRANT4"_$P(^AUTTLOC(DUZ(2),0),U,10)_2017063000000000_$$D^BGP7UTL(BGPNOW)_"_"_$$LZERO^BGP7UTL(BGPC,6)_".TXT"
  1.  .S BGPFGNT5="CRSGPRANT5"_$P(^AUTTLOC(DUZ(2),0),U,10)_2017063000000000_$$D^BGP7UTL(BGPNOW)_"_"_$$LZERO^BGP7UTL(BGPC,6)_".TXT"
  1.  .Q
  1.  S BGPASUF=$P(^AUTTLOC(DUZ(2),0),U,10)
  1.  I BGPEXCEL D
  1.  .W !!,"A file will be created called ",BGPFGNT1,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
  1.  .W !!,"A file will be created called ",BGPFGNT2,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
  1.  .W !!,"A file will be created called ",BGPFGNT3,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
  1.  .W !!,"A file will be created called ",BGPFGNT4,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
  1.  .W !!,"A file will be created called ",BGPFGNT5,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
  1.  .W !!,"A file will be created called ",BGPFDEV1,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
  1.  .W !!,"A file will be created called ",BGPFDEV2,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
  1.  .W !!,"A file will be created called ",BGPFDEV3,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
  1.  .W !!,"A file will be created called ",BGPFDEV4,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
  1.  .S BGPASUF=$P(^AUTTLOC(DUZ(2),0),U,10)
  1.  D ^XBFMK
  1.  K DIC,DIADD,DLAYGO,DR,DA,DD,X,Y,DINUM
  1. GI ;gather all gpra measures
  1.  S X=0 F  S X=$O(^BGPINDG("GPRA",1,X)) Q:X'=+X  S BGPIND(X)=""
  1.  S BGPINDG="G"
  1.  D TEXT^BGP7DSL
  1.  D PT^BGP7DSL
  1.  I $D(DIRUT) G ASU
  1.  I BGPROT="" G ASU
  1.  ;
  1.  K IOP,%ZIS I BGPROT="D",BGPDELT="F" D NODEV,EXIT Q
  1.  K IOP,%ZIS W !! S %ZIS=$S(BGPDELT'="S":"PQM",1:"PM") D ^%ZIS
  1.  I POP D EXIT Q
  1.  I $D(IO("Q")) G TSKMN
  1. DRIVER ;
  1.  U IO
  1.  D PRINT^BGP7PARP
  1.  I BGPRPTT="A",BGPIFTR=1,BGPEXCEL D GNT1^BGP7UTL
  1.  D ^%ZISC
  1.  D EXIT
  1.  Q
  1.  ;
  1. TSKMN ;EP ENTRY POINT FROM TASKMAN
  1.  S ZTIO=$S($D(ION):ION,1:IO) I $D(IOST)#2,IOST]"" S ZTIO=ZTIO_";"_IOST
  1.  I $G(IO("DOC"))]"" S ZTIO=ZTIO_";"_$G(IO("DOC"))
  1.  I $D(IOM)#2,IOM S ZTIO=ZTIO_";"_IOM I $D(IOSL)#2,IOSL S ZTIO=ZTIO_";"_IOSL
  1.  K ZTSAVE S ZTSAVE("BGP*")=""
  1.  S ZTCPU=$G(IOCPU),ZTRTN="DRIVER^BGP7DAR",ZTDTH="",ZTDESC="GPRA REPORT" D ^%ZTLOAD D HOME^%ZIS D EXIT Q
  1.  Q
  1.  ;
  1. EXIT ;
  1.  D ^%ZISC
  1.  D EN^XBVK("BGP") I $D(ZTQUEUED) S ZTREQ="@"
  1.  D KILL^AUPNPAT
  1.  D ^XBFMK
  1.  Q
  1. NODEV ;
  1.  S XBRP="",XBRC="NODEV1^BGP7DAR",XBRX="EXIT^BGP7DAR",XBNS="BGP"
  1.  D ^XBDBQUE
  1.  Q
  1.  ;
  1. NODEV1 ;
  1.  D PRINT^BGP7PARP
  1.  I BGPRPTT="A",BGPIFTR,BGPEXCEL D GNT1^BGP7UTL
  1.  D ^%ZISC
  1.  D EXIT
  1.  Q
  1.  ;
  1. B ;fiscal year
  1.  S (BGPBPER,BGPVDT)=""
  1.  W !!,"Enter the BASELINE year for the report.  Use a 4 digit ",!,"year, e.g. 2010"
  1.  S DIR(0)="D^::EP"
  1.  S DIR("A")="Enter BASELINE year"
  1.  S DIR("?")="This report is compiled for a period.  Enter a valid date."
  1.  D ^DIR KILL DIR
  1.  I $D(DIRUT) Q
  1.  I $D(DUOUT) S DIRUT=1 Q
  1.  S BGPVDT=Y
  1.  I $E(Y,4,7)'="0000" W !!,"Please enter a year only!",! G F
  1.  S BGPBPER=BGPVDT
  1.  Q
  1. F ;fiscal year
  1.  S BGPPER=""
  1.  W !
  1.  S BGPVDT=""
  1.  W !,"Enter the Fiscal Year (FY) for the report END date.  Use a 4 digit",!,"year, e.g. 2010, 2017"
  1.  S DIR(0)="D^::EP"
  1.  S DIR("A")="Enter FY"
  1.  S DIR("?")="This report is compiled for a period.  Enter a valid date."
  1.  D ^DIR
  1.  K DIC
  1.  I $D(DUOUT) S DIRUT=1 S BGPQUIT="" Q
  1.  S BGPVDT=Y
  1.  I $E(Y,4,7)'="0000" W !!,"Please enter a year only!",! G F
  1.  S BGPPER=BGPVDT,BGPBD=($E(BGPVDT,1,3)-1)_"1001",BGPED=$E(BGPVDT,1,3)_"0930"
  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)!'(IOT="TRM")!$D(IO("S"))
  1.  NEW DIR
  1.  K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
  1.  S DIR(0)="E" D ^DIR
  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.  ;----------
  1. LOC() ;EP - Return location name from file 4 based on DUZ(2).
  1.  Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
  1.  ;----------
  1.  ; 
  1. SUMONLY ;EP
  1.  W:$D(IOF) @IOF
  1.  S BGPA=$E($P(^AUTTLOC(DUZ(2),0),U,10),1,2),BGPA=$O(^AUTTAREA("C",BGPA,0)) S BGPA=$S(BGPA:$P(^AUTTAREA(BGPA,0),U),1:"UNKNOWN AREA")
  1.  W !,$$CTR("IHS 2017 Area National GPRA/GPRAMA Report Clinical Performance Summaries")
  1.  W !!,"This will produce ONLY the clinical performance summaries for the Area "
  1.  W !,"National GPRA/GPRAMA Report for the 2017 GPRA year.  If you want the detailed "
  1.  W !,"information included in the report, including performance measure "
  1.  W !,"definitions and number of patients in each denominator and numerator"
  1.  W !,"you need to run the AGP menu option."
  1.  W !!,"The CRSGPRANT export files will not be created; use the AGP menu option "
  1.  W !,"to run the report that will create these files."
  1.  W !
  1.  K DIR S DIR(0)="E",DIR("A")="PRESS ENTER" D ^DIR K DIR
  1.  S BGPSUMON=1
  1.  G TP