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

BGP4DG.m

Go to the documentation of this file. 
  1. BGP4DG ; IHS/CMI/LAB - IHS GPRA 04 REPORT DRIVER ;
  1.  ;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007
  1.  ;
  1.  ;
  1.  W:$D(IOF) @IOF
  1.  W !!,$$CTR("IHS FY04 GPRA Clinical Performance Indicator Report",80)
  1. INTRO ;
  1.  D XIT
  1.  W !!,"This will produce a GPRA Indicator Report for all GPRA indicators for a"
  1.  W !,"year period you specify.  You will be asked to provide: 1) the"
  1.  W !,"reporting period, 2) the baseline period to compare data to, and 3) the ",!,"Community taxonomy to determine which patients will be included."
  1.  W !!,"You can choose to export this data to the Area office.  If you"
  1.  W !,"answer yes at the export prompt, a report will be produced in export format"
  1.  W !,"for the Area Office to use in Area aggregated data.  Depending on site specific"
  1.  W !,"configuration, the export file will either be automatically transmitted "
  1.  W !,"directly to the Area or the site will have to send the file manually.",!
  1.  D TAXCHK^BGP4TXCH
  1. TP ;get time period
  1.  D XIT
  1.  S BGPRTYPE=1,BGPBEN=1
  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",DIR("A")="Enter the date range for your report" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) D XIT Q
  1.  S BGPQTR=Y
  1.  D F
  1.  I BGPPER="" W !,"Year not entered.",! G TP
  1.  I BGPQTR=1 S BGPBD=($E(BGPPER,1,3)-1)_"0101",BGPED=($E(BGPPER,1,3)-1)_"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 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 (at least 2 years prior to Current).",!,"Use a 4 digit year, e.g. 1999, 2000"
  1.  S DIR(0)="D^::EP"
  1.  S DIR("A")="Enter Year (e.g. 2000)"
  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,"Reporting 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. COMM ;
  1.  W !!,"Specify the community taxonomy to determine which patients will be",!,"included in the report.  You should have previously created this taxonomy using",!,"QMAN or the Taxonomy Setup option. (see User Manual for more detail).",!
  1.  K BGPTAX
  1.  S BGPTAXI=""
  1.  D ^XBFMK
  1.  K DIC S DIC("S")="I $P(^(0),U,15)=9999999.05",DIC="^ATXAX(",DIC(0)="AEMQ",DIC("A")="Enter the Name of the Community Taxonomy: "
  1.  S B=$P($G(^BGPSITE(DUZ(2),0)),U,5) I B S DIC("B")=$P(^ATXAX(B,0),U)
  1.  D ^DIC K DIC
  1.  I Y=-1 Q
  1.  S BGPTAXI=+Y
  1. COM1 S X=0
  1.  F  S X=$O(^ATXAX(BGPTAXI,21,X)) Q:'X  D
  1.  .S BGPTAX($P(^ATXAX(BGPTAXI,21,X,0),U))=""
  1.  .Q
  1.  I '$D(BGPTAX) W !!,"There are no communities in that taxonomy." G COMM
  1. HOME ;
  1.  S BGPHOME=$P($G(^BGPSITE(DUZ(2),0)),U,2)
  1.  I BGPHOME="" W !!,"Home Location not found in Site File!!",!,"PHN Visits counts to Home will be calculated using clinic 11 only!!" H 2 G GI
  1.  W !,"Your HOME location is defined as: ",$P(^DIC(4,BGPHOME,0),U)," asufac:  ",$P(^AUTTLOC(BGPHOME,0),U,10)
  1. GI ;gather all gpra indicators
  1.  S X=0 F  S X=$O(^BGPINDF("GPRA",X)) Q:X'=+X  S Y=0 F  S Y=$O(^BGPINDF("GPRA",X,Y)) Q:Y'=+Y  S BGPIND(Y)=""
  1.  S BGPINDT="G"
  1. LISTS ;any lists with indicators?
  1.  ;W !!
  1.  ;K BGPLIST
  1.  ;S DIR(0)="Y",DIR("A")="Do you want patient lists for any of the GPRA indicators",DIR("B")="N" KILL DA D ^DIR KILL DIR
  1.  ;I $D(DIRUT)!(Y="") G COMM
  1.  ;I Y=0 G EXPORT
  1.  ;K BGPLIST
  1.  ;D EN^BGP4DSL
  1.  ;I '$D(BGPLIST) W !!,"No lists selected.",!
  1.  ;I $D(BGPLIST) D RT^BGP4DSL I '$D(BGPLIST)!($D(BGPQUIT)) G LISTS ;get report type for each list
  1. EXPORT ;export to area or not?
  1.  S BGPEXPT=""
  1.  K DIR S DIR(0)="Y",DIR("A")="Do you wish to export this data to Area" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) G TP
  1.  S BGPEXPT=Y
  1. EISSEX ;
  1.  S BGPEXCEL=1
  1.  S BGPUF=""
  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.  S BGPNOW=$$NOW^XLFDT() S BGPNOW=$$NOW^XLFDT() S BGPNOW=$P(BGPNOW,".")_"."_$$RZERO^BGP4UTL($P(BGPNOW,".",2),6)
  1.  I BGPUF="" W:'$D(ZTQUEUED) !!,"Cannot continue.....can't find export directory name. EXCEL file",!,"not written." Q
  1.  S BGPFN="GPRAEX"_$P(^AUTTLOC(DUZ(2),0),U,10)_$$D^BGP4UTL(BGPBD)_$$D^BGP4UTL(BGPED)_$$D^BGP4UTL(BGPNOW)_"_000001"_".TXT"
  1. SUM ;display summary of this report
  1.  W:$D(IOF) @IOF
  1.  W !,$$CTR("SUMMARY OF FY 04 GPRA REPORT TO BE GENERATED")
  1.  W !!,"The date ranges for this report are:"
  1.  W !?5,"Reporting 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.  W !!,"The COMMUNITY Taxonomy to be used is: ",$P(^ATXAX(BGPTAXI,0),U)
  1.  I BGPHOME W !,"The HOME location is: ",$P(^DIC(4,BGPHOME,0),U)," ",$P(^AUTTLOC(BGPHOME,0),U,10)
  1.  I 'BGPHOME W !,"No HOME Location selected."
  1.  W !!,"All GPRA indicators will be calculated."
  1.  D PT^BGP4DSL
  1.  I BGPROT="" G LISTS
  1. ZIS ;call to XBDBQUE
  1.  D REPORT^BGP4UTL
  1.  I $G(BGPQUIT) D XIT Q
  1.  I BGPRPT="" D XIT Q
  1.  I BGPEXPT D
  1.  .W !!,"A file will be created called BG04",$P(^AUTTLOC(DUZ(2),0),U,10)_"."_BGPRPT," and will reside",!,"in the ",BGPUF," directory.",!
  1.  .W !,"Depending on your site configuration, this file may need to be manually",!,"sent to your Area Office.",!
  1.  I BGPEXCEL,BGPEXPT D
  1.  .W !,"A file will be created called ",BGPFN,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
  1.  K IOP,%ZIS I BGPROT="D",BGPDELT="F" D NODEV,XIT Q
  1.  K IOP,%ZIS W !! S %ZIS=$S(BGPDELT'="S":"PQM",1:"PM") D ^%ZIS
  1.  I POP W !,"Report Aborted" S DA=BGPRPT,DIK="^BGPGPDCF(" D ^DIK K DIK D XIT Q
  1.  I POP W !,"Report Aborted" S DA=BGPRPT,DIK="^BGPGPDPF(" D ^DIK K DIK D XIT Q
  1.  I POP W !,"Report Aborted" S DA=BGPRPT,DIK="^BGPGPDBF(" D ^DIK K DIK D XIT Q
  1.  I $D(IO("Q")) G TSKMN
  1. DRIVER ;
  1.  D ^BGP4D1
  1.  U IO
  1.  D ^BGP4DP
  1.  D ^%ZISC
  1.  I BGPEXPT D GS^BGP4UTL
  1.  I BGPEXCEL,BGPEXPT D EXCELGS^BGP4UTL
  1.  D XIT
  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^BGP4DG",ZTDTH="",ZTDESC="GPRA 04 REPORT" D ^%ZTLOAD D XIT Q
  1.  Q
  1.  ;
  1. NODEV ;
  1.  S XBRP="",XBRC="NODEV1^BGP4DG",XBRX="XIT^BGP4DG",XBNS="BGP"
  1.  D ^XBDBQUE
  1.  ;D XIT
  1.  Q
  1.  ;
  1. NODEV1 ;
  1.  D ^BGP4D1
  1.  D ^BGP4DP
  1.  D ^%ZISC
  1.  I BGPEXPT D GS^BGP4UTL
  1.  I BGPEXCEL,BGPEXPT D EXCELGS^BGP4UTL
  1.  D XIT
  1.  Q
  1. OLD ;
  1.  S XBRP="PRINT^BGPDP",XBRC="PROC^BGPD1",XBRX="XIT^BGPD",XBNS="BGP"
  1.  D ^XBDBQUE
  1.  D XIT
  1.  Q
  1.  ;
  1. XIT ;
  1.  D ^%ZISC
  1.  D EN^XBVK("BGP")
  1.  K DIRUT,DUOUT,DIR,DOD
  1.  K DIADD,DLAYGO
  1.  D KILL^AUPNPAT
  1.  K X,X1,X2,X3,X4,X5,X6
  1.  K A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,V,W,X,Y,Z
  1.  K N,N1,N2,N3,N4,N5,N6
  1.  K BD,ED
  1.  D KILL^AUPNPAT
  1.  D ^XBFMK
  1.  Q
  1.  ;
  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 DIR,DIRUTUT,DFOUT,DLOUT,DTOUT,DUOUT
  1.  S DIR(0)="E" D ^DIR KILL 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. 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
  1. F ;fiscal year
  1.  S (BGPPER,BGPVDT)=""
  1.  W !!,"Enter the Fiscal Year (FY) for the the report END date.",!,"Use a 4 digit year, e.g. 2004"
  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 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 BGPPER=BGPVDT
  1.  Q