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

BGP6DAP.m

Go to the documentation of this file. 
  1. BGP6DAP ; IHS/CMI/LAB - IHS GPRA 04 SELECTED REPORT DRIVER ALL PATIENTS ;
  1.  ;;16.1;IHS CLINICAL REPORTING;;MAR 22, 2016;Build 170
  1.  ;
  1.  ;
  1.  W:$D(IOF) @IOF
  1.  W !!,$$CTR("IHS 2016 Clinical Performance Measure Report (Selected Measures)",80)
  1.  W !,$$CTR("Report on all Patients regardless of Community of Residence",80),!!
  1. INTRO ;
  1.  D XIT
  1.  W !,"This will produce a Performance Measure Report for one or more measures for a"
  1.  W !,"year period you specify.  You will be asked to provide: 1) the"
  1.  W !,"reporting period and, 2) the baseline period to compare data to."
  1.  W !!,"NOTE:  With this option all patients in your database will be reviewed",!,"regardless of what community they live in.  You will NOT be asked to enter",!,"a community taxonomy name.  Since this may cause the report to be",!
  1.  W "very large, the SEL option will be limited to no more than 15 topics",!,"at one time.",!
  1. SETIND ;
  1.  D XIT
  1.  S BGPINDM=""
  1.  S BGPRTYPE=4,BGPYRPTH="A"
  1.  S DIR(0)="S^DM:Diabetes-Related Measures;CVD:Cardiovascular Disease Prevention for At-Risk Patients;WH:Women's Health-Related Measures"
  1.  S DIR(0)=DIR(0)_";IPC:Improving Patient Care Measures;PQA:Pharmacy Quality Alliance Measures;AST:Asthma-Related Measures;SEL:Selected Performance Measures (User Defined)"
  1.  S DIR("A")="Which set of Measures should be included in this report" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) D XIT Q
  1.  S BGPINDM=$E(Y)
  1.  I BGPINDM="S" D SI I '$D(BGPIND) G SETIND
  1. GI ;gather all measures
  1.  I BGPINDM="D" D DI
  1.  I BGPINDM="C" D CI
  1.  I BGPINDM="W" D WI
  1.  I BGPINDM="I" D II
  1.  I BGPINDM="P" D PI
  1.  I BGPINDM="A" D AI
  1.  ;I BGPINDM="E" D EI
  1.  I '$D(BGPIND) W !!,"no measures selected" G SETIND
  1.  D TAXCHK^BGP6XTCH
  1.  S X=$$DEMOCHK^BGP6UTL2()
  1.  I 'X W !!,"Exiting Report....." D PAUSE^BGP6DU,XIT Q
  1. TP ;get time period
  1.  S BGPRTYPE=4,BGPYRPTH="A"
  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 XIT Q
  1.  S BGPQTR=Y
  1.  I BGPQTR=5 D ENDDATE^BGP6DGPU
  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. COMM ;
  1.  K BGPTAX
  1.  S BGPALLPT=1
  1.  K BGPQUIT
  1.  ;
  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 BEN
  1.  W !,"Your HOME location is defined as: ",$P(^DIC(4,BGPHOME,0),U)," asufac:  ",$P(^AUTTLOC(BGPHOME,0),U,10)
  1.  I BGPINDM'="S" D LISTS
  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"
  1.  KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) G COMM
  1.  S BGPBEN=Y
  1. SUM ;display summary of this report
  1.  W:$D(IOF) @IOF
  1.  W !,$$CTR("SUMMARY OF 2016 CLINICAL MEASURE PERFORMANCE REPORT TO BE GENERATED")
  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 '$G(BGPALLPT) W !!,"The COMMUNITY Taxonomy to be used is: ",$P(^ATXAX(BGPTAXI,0),U)
  1.  I $G(BGPALLPT) W !!,"ALL Communities included."
  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 !!,"These measures will be calculated: " S X=0 F  S X=$O(BGPIND(X)) Q:X'=+X  W $P(^BGPINDM(X,0),U,3)," ; "
  1.  W !!,"Lists will be produced for these measures: "
  1.  S X=0 F  S X=$O(BGPLIST(X)) Q:X'=+X  W $P(^BGPINDM(X,0),U,3)," ; "
  1.  D TEXT^BGP6DSL
  1.  I $D(DIRUT) G LISTS
  1.  D PT^BGP6DSL
  1.  I BGPROT="" G LISTS
  1. ZIS ;call to XBDBQUE
  1.  D REPORT^BGP6UTL
  1.  I $G(BGPQUIT) D XIT Q
  1.  I BGPRPT="" D XIT Q
  1.  K IOP,%ZIS I BGPROT="D",BGPDELT="F" D NODEV,XIT Q
  1.  W !! S %ZIS=$S(BGPDELT'="S":"PQM",1:"PM") D ^%ZIS
  1. ZIS1 ;
  1.  I POP W !,"Report Aborted" S DA=BGPRPT,DIK="^BGPGPDCM(" D ^DIK K DIK D XIT Q
  1.  I POP W !,"Report Aborted" S DA=BGPRPT,DIK="^BGPGPDPM(" D ^DIK K DIK D XIT Q
  1.  I POP W !,"Report Aborted" S DA=BGPRPT,DIK="^BGPGPDBM(" D ^DIK K DIK D XIT Q
  1.  I $D(IO("Q")) G TSKMN
  1. DRIVER ;
  1.  D ^BGP6D1
  1.  U IO
  1.  D ^BGP6DP
  1.  D ^%ZISC
  1.  D XIT
  1.  Q
  1.  ;
  1. NODEV1 ;
  1.  D ^BGP6D1
  1.  D ^BGP6DP
  1.  D ^%ZISC
  1.  D XIT
  1.  Q
  1. DI ;
  1.  S X=0 F  S X=$O(^BGPINDMC("ADM",1,X)) Q:X'=+X  S BGPIND($P(^BGPINDMC(X,0),U,1))=""
  1.  Q
  1. II ;
  1.  S X=0 F  S X=$O(^BGPINDMC("AIPC",1,X)) Q:X'=+X  S BGPIND($P(^BGPINDMC(X,0),U,1))=""
  1.  Q
  1. PI ;
  1.  S X=0 F  S X=$O(^BGPINDMC("APQA",1,X)) Q:X'=+X  S BGPIND($P(^BGPINDMC(X,0),U,1))=""
  1.  Q
  1. CI ;
  1.  S X=0 F  S X=$O(^BGPINDMC("ACARD",1,X)) Q:X'=+X  S BGPIND($P(^BGPINDMC(X,0),U,1))=""
  1.  Q
  1. AI ;
  1.  S X=0 F  S X=$O(^BGPINDMC("AAST",1,X)) Q:X'=+X  S BGPIND($P(^BGPINDMC(X,0),U,1))=""
  1.  Q
  1. WI ;
  1.  S X=0 F  S X=$O(^BGPINDMC("AWH",1,X)) Q:X'=+X  S BGPIND($P(^BGPINDMC(X,0),U,1))=""
  1.  Q
  1. EI ;
  1.  S X=0 F  S X=$O(^BGPINDMC("AEL",1,X)) Q:X'=+X  S BGPIND($P(^BGPINDMC(X,0),U,1))=""
  1.  Q
  1. SI ;
  1.  K BGPIND
  1.  D EN^BGP6DSI
  1.  I '$D(BGPIND) Q
  1.  D LISTS
  1.  Q
  1. LISTS ;any lists with measures?
  1.  K BGPLIST
  1.  W !!,"PATIENT LISTS"
  1.  I '$D(^XUSEC("BGPZ PATIENT LISTS",DUZ)) W !!,"You do not have the security access to print patient lists.",!,"Please see your supervisor or program manager if you feel you should have",!,"the BGPZ PATIENT LISTS security key.",! D  Q
  1.  .K DIR S DIR(0)="E",DIR("A")="Press enter to continue" D ^DIR K DIR
  1.  S DIR(0)="Y",DIR("A")="Do you want patient lists for any of the measures",DIR("B")="N" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT)!(Y="") Q
  1.  I Y=0 Q
  1.  K BGPLIST
  1.  D EN^BGP6DSL
  1.  I '$D(BGPLIST) W !!,"No lists selected.",!
  1.  I $D(BGPLIST) D RT^BGP6DSL I '$D(BGPLIST)!($D(BGPQUIT)) G LISTS ;get report type for each list
  1.  Q
  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^BGP6DL",ZTDTH="",ZTDESC="GPRA 16 REPORT" D ^%ZTLOAD D XIT Q
  1.  Q
  1.  ;
  1. NODEV ;
  1.  S XBRP="",XBRC="NODEV1^BGP6DL",XBRX="XIT^BGP6DL",XBNS="BGP"
  1.  D ^XBDBQUE
  1.  ;D XIT
  1.  Q
  1.  ;
  1. XIT ;
  1.  D ^%ZISC
  1.  D EN^XBVK("BGP") I $D(ZTQUEUED) S ZTREQ="@"
  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,DIRUT,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 ;calendar year
  1.  S (BGPPER,BGPVDT)=""
  1.  W !!,"Enter the Calendar Year for the report END date.  Use a 4 digit",!,"year, e.g. 2016"
  1.  S DIR(0)="D^::EP"
  1.  S DIR("A")="Enter 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 BGPPER=BGPVDT
  1.  Q