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

BGP6DARO.m

Go to the documentation of this file. 
  1. BGP6DARO ; IHS/CMI/LAB - ihs area GPRA 02 Sep 2004 1:11 PM 01 Jul 2010 11:43 AM ;
  1.  ;;16.1;IHS CLINICAL REPORTING;;MAR 22, 2016;Build 170
  1.  ;
  1.  ;
  1.  W:$D(IOF) @IOF
  1.  D EXIT
  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 Other National Measures Report",80)
  1. CHOICE ;
  1.  W !!!,"Please select the type of report would you like to run:"
  1.  W !!?8,"H  Hard-coded Report:  Report with all parameters set to the"
  1.  W !?11,"same as the National GPRA Report (report period of "
  1.  W !?11,"July 1, 2015 - June 30, 2016, baseline period of July 1, 2009"
  1.  W !?11,"- June 30, 2010, and AI/AN patients only)"
  1.  W !!?8,"U  User-defined Report:  You select the report and baseline"
  1.  W !?11,"periods and beneficiary population"
  1.  W !
  1.  S DIR(0)="F^1:1",DIR("A")="Select a Report Option"
  1.  S DIR("B")="H",DIR("?")="Enter an H for Hard-coded or a U for User-defined"
  1.  D ^DIR
  1.  I $D(DIRUT) D EXIT Q
  1.  KILL DIR
  1.  S Y=$$UP^XLFSTR(Y)
  1.  I Y'="H",Y'="U" W !!,"Please enter an H for Hard-coded or a U for User-defined." G CHOICE
  1.  S BGPRTC=Y
  1. INTRO ;
  1.  I BGPRTC="U" D
  1.  .W !!,"This will produce an Other National Measures Report for a year period"
  1.  .W !,"you specify.  You will be asked to provide: 1) the reporting period,"
  1.  .W !,"2) the baseline period to compare data to, and 3) the beneficiary/"
  1.  .W !,"classification of the patients."
  1.  .W !
  1.  ;
  1.  S BGPAREAA=1
  1.  S (BGPBD,BGPED,BGPTP)=""
  1.  S BGPRTYPE=7,BGPYRPTH=""
  1. H I BGPRTC="H" D  G ASU
  1.  .S X=$O(^BGPCTRL("B",2016,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.  .;BEGIN TEST STUFF
  1.  .G NT  ;comment out when testing in TEHR
  1.  .W !!,"for testing purposes only, please enter a report year",!
  1.  .D F
  1.  .I BGPPER="" W !!,"no year entered..bye" D EXIT Q
  1.  .S BGPQTR=3
  1.  .S BGPBD=$E(BGPPER,1,3)_"0101",BGPED=$E(BGPPER,1,3)_"1231"
  1.  .S BGPPBD=($E(BGPPER,1,3)-1)_"0101",BGPPED=($E(BGPPER,1,3)-1)_"1231"
  1.  .W !!,"for testing purposes only, please enter a BASELINE year",!
  1.  .D B
  1.  .I BGPBPER="" W !!,"no year entered..bye" D EXIT Q
  1.  .S BGPBBD=$E(BGPBPER,1,3)_"0101",BGPBED=$E(BGPBPER,1,3)_"1231"
  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.  .S BGPBEN=1,BGPBENF(0)="Indian/Alaskan Native (Classification 01)" W !!,"Beneficiary Population is set to American Indian/Alaskan Native Only."
  1. TP ;
  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
  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 S BGPBD=$$FMADD^XLFDT(BGPPER,-364),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.  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.  I BGPPBD=BGPBBD,BGPPED=BGPBED K Y D CHKY I Y K BGPBBD,BGPBED,BGPPBD,BGPPED G BY
  1. BEN ;
  1.  S BGPBEN=""
  1.  S DIR(0)="S^1:Indian/Alaskan Native (Classification 01);2:Not Indian Alaskan/Native (Not Classification 01);3:All (both Indian/Alaskan Natives and Non 01)",DIR("A")="Select Beneficiary Population to include in this report"
  1.  S DIR("B")="1" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) G BY
  1.  S BGPBEN=Y,BGPBENF=Y(0)
  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^BGP6ASL
  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. ZIS ;call to XBDBQUE
  1. EISSEX ;
  1.  S BGPEXCEL=$S($G(BGPSUMON):0,BGPRPTT="F":0,1:1)
  1.  S BGPUF=$$GETDIR^BGP6UTL2()
  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=$P(BGPNOW,".")_"."_$$RZERO^BGP6UTL($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 BGPFONN1="CRSONMNT1"_$P(^AUTTLOC(DUZ(2),0),U,10)_2016063000000000_$$D^BGP6UTL(BGPNOW)_"_"_$$LZERO^BGP6UTL(BGPC,6)_".TXT"
  1.  .S BGPFONN2="CRSONMNT2"_$P(^AUTTLOC(DUZ(2),0),U,10)_2016063000000000_$$D^BGP6UTL(BGPNOW)_"_"_$$LZERO^BGP6UTL(BGPC,6)_".TXT"
  1.  .S BGPFONN3="CRSONMNT3"_$P(^AUTTLOC(DUZ(2),0),U,10)_2016063000000000_$$D^BGP6UTL(BGPNOW)_"_"_$$LZERO^BGP6UTL(BGPC,6)_".TXT"
  1.  .S BGPFONN4="CRSONMNT4"_$P(^AUTTLOC(DUZ(2),0),U,10)_2016063000000000_$$D^BGP6UTL(BGPNOW)_"_"_$$LZERO^BGP6UTL(BGPC,6)_".TXT"
  1.  .;S BGPFONN5="CRSONMNT5"_$P(^AUTTLOC(DUZ(2),0),U,10)_2016063000000000_$$D^BGP6UTL(BGPNOW)_"_"_$$LZERO^BGP6UTL(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 ",BGPFONN1,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
  1.  .W !!,"A file will be created called ",BGPFONN2,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
  1.  .W !!,"A file will be created called ",BGPFONN3,!,"and will reside in the ",BGPUF," directory.  This file can be used in Excel.",!
  1.  .W !!,"A file will be created called ",BGPFONN4,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
  1.  .;W !!,"A file will be created called ",BGPFONN5,!,"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(^BGPINDM("ON",1,X)) Q:X'=+X  S BGPIND(X)=""
  1.  S BGPINDM="G"
  1.  D TEXT^BGP6DSL
  1.  I $D(DIRUT) G ASU
  1.  D PT^BGP6DSL
  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^BGP6PARQ
  1.  I BGPEXCEL D ONN1^BGP6UTL
  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^BGP6DARO",ZTDTH="",ZTDESC="GPRA REPORT" D ^%ZTLOAD D HOME^%ZIS D EXIT Q
  1.  Q
  1.  ;
  1. NODEV ;
  1.  S XBRP="",XBRC="NODEV1^BGP6DARO",XBRX="EXIT^BGP6DARO",XBNS="BGP"
  1.  D ^XBDBQUE
  1.  Q
  1.  ;
  1. NODEV1 ;
  1.  D PRINT^BGP6PARQ
  1.  I BGPRPTT="A" D ONN1^BGP6UTL
  1.  D ^%ZISC
  1.  D EXIT
  1.  Q
  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.  ;
  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. 2016"
  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. ENDDATE ;
  1.  W !!,"When entering dates, if you do not enter a full 4 digit year (e.g. 2016)"
  1.  W !,"will assume a year in the past, if you want to put in a future date,"
  1.  W !,"remember to enter the full 4 digit year.  For example, if today is"
  1.  W !,"January 4, 2010 and you type in 6/30/10 the system will assume the year"
  1.  W !,"as 1910 since that is a date in the past.  You must type 6/30/2010 if you"
  1.  W !,"want a date in the future."
  1.  S (BGPPER,BGPVDT)=""
  1.  W ! K DIR,X,Y S DIR(0)="D^::EP",DIR("A")="Enter End Date for the Report: (e.g. 11/30/2015)" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I $D(DIRUT) Q
  1.  S (BGPPER,BGPVDT)=Y
  1.  Q
  1.  ;
  1. CHKY ;
  1.  W !!,"The baseline year and the previous year time periods are the same.",!!
  1.  S DIR(0)="Y",DIR("A")="Do you want to change the baseline year",DIR("B")="N" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) S Y="" Q
  1.  Q