- BGP6DON ; IHS/CMI/LAB - NATL COMP EXPORT 13 Nov 2006 12:31 PM ;
- ;;16.1;IHS CLINICAL REPORTING;;MAR 22, 2016;Build 170
- ;
- ;
- W:$D(IOF) @IOF
- D XIT
- W !,$$CTR("IHS 2016 Other National Measures Report",80)
- CHOICE ;
- W !!,"Please select the type of report would you like to run:"
- W !!?8,"H Hard-coded Report: Report with all parameters set to the"
- W !?11,"same as the National GPRA/GPRAMA Report (report period of "
- W !?11,"July 1, 2015 - June 30, 2016, baseline period of July 1, 2009"
- W !?11,"- June 30, 2010, and AI/AN patients only)"
- W !!?8,"U User-defined Report: You select the report and baseline"
- W !?11,"periods and beneficiary population"
- W !
- S DIR(0)="F^1:1",DIR("A")="Select a Report Option"
- S DIR("B")="H",DIR("?")="Enter an H for Hard-coded or a U for User-defined"
- D ^DIR
- I $D(DIRUT) D XIT Q
- KILL DIR
- S Y=$$UP^XLFSTR(Y) I Y'="U",Y'="H" W !!,"Please enter an H for Hard-coded or a U for User-defined." G CHOICE
- S BGPRTC=Y
- INTRO ;
- W !,$$CTR("IHS 2016 Other National Measures Report",80)
- I BGPRTC="U" D
- .W !!,"This will produce the Other National Measures (ONM) Report for all"
- .W !,"ONM performance measures for a year period you specify. You will be "
- .W !,"asked to provide: 1) the reporting period, 2) the baseline period to "
- .W !,"compare data to, 3) the community taxonomy to determine which patients"
- .W !,"will be included, and the 4) beneficiary population."
- .W !!,"You will be given the opportunity to export this data to the Area office."
- .W !,"If you answer yes, this option will produce a report in export format for "
- .W !,"the Area Office to use in Area aggregated data. Depending on site specific"
- .W !,"configuration, the export file will either be automatically transmitted"
- .W !,"directly to the Area or the site will have to send the file manually."
- .W !
- I BGPRTC="H" D
- .W !!,"This will produce an Other National Measures report. You will be asked to"
- .W !,"provide the community taxonomy to determine which patients will be included."
- .W !,"This report will be run for the Report Period July 1, 2015 through "
- .W !,"June 30, 2016 with a Baseline Year of July 1, 2009 through June 30, 2010."
- .W !,"This report will include beneficiary population of American Indian/Alaska"
- .W !,"Native only."
- .W !!,"You can choose to export this data to the Area office. If you answer yes"
- .W !,"at the export prompt, a report will be produced in export format for the "
- .W !,"Area Office to use in Area aggregated data. Depending on site specific"
- .W !,"configuration, the export file will either be automatically transmitted"
- .W !,"directly to the Area or the site will have to send the file manually."
- .W !
- K DIR S DIR(0)="E",DIR("A")="Press Enter to Continue" D ^DIR K DIR,DUOUT,DIRUT
- D TAXCHK^BGP6XTCO
- S X=$$DEMOCHK^BGP6UTL2()
- I 'X W !!,"Exiting Report....." D PAUSE^BGP6DU,XIT Q
- ST ;
- TP ;get time period
- S BGPRTYPE=7,BGPYRPTH=""
- S (BGPBD,BGPED,BGPTP)=""
- H I BGPRTC="H" D G COMM
- .S X=$O(^BGPCTRL("B",2016,0))
- .S Y=^BGPCTRL(X,0)
- .S BGPBD=$P(Y,U,8),BGPED=$P(Y,U,9)
- .S BGPPBD=$P(Y,U,10),BGPPED=$P(Y,U,11)
- .S BGPBBD=$P(Y,U,12),BGPBED=$P(Y,U,13)
- .S BGPPER=$P(Y,U,14),BGPQTR=3
- .;BEGIN TEST STUFF
- .G NT ;COMMENT OUT THIS LINE WHEN TESTING IN TEHR
- .W !!,"for testing purposes only, please enter a report year",!
- .D F
- .I BGPPER="" W !!,"no year entered..bye" D XIT Q
- .S BGPQTR=3
- .S BGPBD=$E(BGPPER,1,3)_"0101",BGPED=$E(BGPPER,1,3)_"1231"
- .S BGPPBD=($E(BGPPER,1,3)-1)_"0101",BGPPED=($E(BGPPER,1,3)-1)_"1231"
- .W !!,"for testing purposes only, please enter a BASELINE year",!
- .D B
- .I BGPBPER="" W !!,"no year entered..bye" D XIT Q
- .S BGPBBD=$E(BGPBPER,1,3)_"0101",BGPBED=$E(BGPBPER,1,3)_"1231"
- NT .;END TEST STUFF
- .W !!,"The date ranges for this report are:"
- .W !?5,"Report Period: ",?31,$$FMTE^XLFDT(BGPBD)," to ",?31,$$FMTE^XLFDT(BGPED)
- .W !?5,"Previous Year Period: ",?31,$$FMTE^XLFDT(BGPPBD)," to ",?31,$$FMTE^XLFDT(BGPPED)
- .W !?5,"Baseline Period: ",?31,$$FMTE^XLFDT(BGPBBD)," to ",?31,$$FMTE^XLFDT(BGPBED)
- .S BGPHOME=$P($G(^BGPSITE(DUZ(2),0)),U,2)
- .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 H1
- .W !!,"Your HOME location is defined as: ",$P(^DIC(4,BGPHOME,0),U)," asufac: ",$P(^AUTTLOC(BGPHOME,0),U,10)
- H1 .S BGPBEN=1,BGPBENF(0)="Indian/Alaskan Native (Classification 01)" W !!,"Beneficiary Population is set to American Indian/Alaskan Native Only."
- 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
- I $D(DIRUT) D XIT Q
- S BGPQTR=Y
- I BGPQTR=5 D ENDDATE
- I BGPQTR'=5 D F
- I BGPPER="" W !,"Year not entered.",! G TP
- I BGPQTR=1 S BGPBD=$E(BGPPER,1,3)_"0101",BGPED=$E(BGPPER,1,3)_"1231"
- I BGPQTR=2 S BGPBD=($E(BGPPER,1,3)-1)_"0401",BGPED=$E(BGPPER,1,3)_"0331"
- I BGPQTR=3 S BGPBD=($E(BGPPER,1,3)-1)_"0701",BGPED=$E(BGPPER,1,3)_"0630"
- I BGPQTR=4 S BGPBD=($E(BGPPER,1,3)-1)_"1001",BGPED=$E(BGPPER,1,3)_"0930"
- I BGPQTR=5 S BGPBD=$$FMADD^XLFDT(BGPPER,-364),BGPED=BGPPER,BGPPER=$E(BGPED,1,3)_"0000"
- I BGPED>DT D G:BGPDO=1 TP
- .W !!,"You have selected Current Report period ",$$FMTE^XLFDT(BGPBD)," through ",$$FMTE^XLFDT(BGPED),"."
- .W !,"The end date of this report is in the future; your data will not be",!,"complete.",!
- .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
- .I $D(DIRUT) S BGPDO=1 Q
- .I Y S BGPDO=1 Q
- .Q
- BY ;get baseline year
- S BGPVDT=""
- W !!,"Enter the Baseline Year to compare data to.",!,"Use a 4 digit year, e.g. 2010"
- S DIR(0)="D^::EP"
- S DIR("A")="Enter Year (e.g. 2010)"
- D ^DIR KILL DIR
- I $D(DIRUT) G TP
- I $D(DUOUT) S DIRUT=1 G TP
- S BGPVDT=Y
- I $E(Y,4,7)'="0000" W !!,"Please enter a year only!",! G BY
- S X=$E(BGPPER,1,3)-$E(BGPVDT,1,3)
- S X=X_"0000"
- S BGPBBD=BGPBD-X,BGPBBD=$E(BGPBBD,1,3)_$E(BGPBD,4,7)
- S BGPBED=BGPED-X,BGPBED=$E(BGPBED,1,3)_$E(BGPED,4,7)
- S BGPPBD=($E(BGPBD,1,3)-1)_$E(BGPBD,4,7)
- S BGPPED=($E(BGPED,1,3)-1)_$E(BGPED,4,7)
- W !!,"The date ranges for this report are:"
- W !?5,"Report Period: ",?31,$$FMTE^XLFDT(BGPBD)," to ",?31,$$FMTE^XLFDT(BGPED)
- W !?5,"Previous Year Period: ",?31,$$FMTE^XLFDT(BGPPBD)," to ",?31,$$FMTE^XLFDT(BGPPED)
- W !?5,"Baseline Period: ",?31,$$FMTE^XLFDT(BGPBBD)," to ",?31,$$FMTE^XLFDT(BGPBED)
- I BGPPBD=BGPBBD,BGPPED=BGPBED K Y D CHKY I Y K BGPBBD,BGPBED,BGPPBD,BGPPED G BY
- COMM ;
- W !!,"Specify the community taxonomy to determine which patients will be",!,"included in the report. You should have created this taxonomy using QMAN.",!
- K BGPTAX
- S BGPTAXI=""
- D ^XBFMK
- S DIC("S")="I $P(^(0),U,15)=9999999.05",DIC="^ATXAX(",DIC(0)="AEMQ",DIC("A")="Enter the Name of the Community Taxonomy: "
- S B=$P($G(^BGPSITE(DUZ(2),0)),U,5) I B S DIC("B")=$P(^ATXAX(B,0),U)
- D ^DIC
- I Y=-1 G CHOICE
- S BGPTAXI=+Y
- COM1 S X=0
- F S X=$O(^ATXAX(BGPTAXI,21,X)) Q:'X D
- .S BGPTAX($P(^ATXAX(BGPTAXI,21,X,0),U))=""
- .Q
- I '$D(BGPTAX) W !!,"There are no communities in that taxonomy." G COMM
- S X=0,G=0
- F S X=$O(^ATXAX(BGPTAXI,21,X)) Q:'X D
- .S C=$P(^ATXAX(BGPTAXI,21,X,0),U)
- .I '$D(^AUTTCOM("B",C)) W !!,"*** Warning: Community ",C," is in the taxonomy but does not",!,"exist in the community table. Please recreate your community taxonomy." S G=1
- .Q
- I G W !!,"The community taxonomy may not be accurate." D I BGPQUIT D XIT Q
- .S BGPQUIT=0
- .S DIR(0)="Y",DIR("A")="Do you wish to continue running the report" KILL DA D ^DIR KILL DIR
- .I $D(DIRUT) S BGPQUIT=1
- .I 'Y S BGPQUIT=1
- .Q
- K BGPQUIT
- BEN ;
- ;I $G(BGPSEAT) G HOME
- I BGPRTC="H" G HOME
- S BGPBEN=""
- 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"
- S DIR("B")="1" KILL DA D ^DIR KILL DIR
- I $D(DIRUT) G COMM
- S BGPBEN=Y,BGPBENF(0)=Y(0)
- HOME ;
- S BGPHOME=$P($G(^BGPSITE(DUZ(2),0)),U,2)
- 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 AI
- W !,"Your HOME location is defined as: ",$P(^DIC(4,BGPHOME,0),U)," asufac: ",$P(^AUTTLOC(BGPHOME,0),U,10)
- AI ;gather all gpra measures
- S X=0 F S X=$O(^BGPINDM("ON",1,X)) Q:X'=+X S BGPIND(X)=""
- S BGPINDM="O"
- EXPORT ;export to area or not?
- S BGPEXPT="" ;,BGPYWCHW=0
- ;I $D(BGPSEAT) G EISSEX
- S DIR(0)="Y",DIR("A")="Do you wish to export this data to Area" KILL DA D ^DIR KILL DIR
- I $D(DIRUT) G COMM
- S BGPEXPT=Y
- EISSEX ;
- S BGPEXCEL=""
- S BGPUF=$$GETDIR^BGP6UTL2()
- ;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")
- ;I $P(^AUTTSITE(1,0),U,21)=1 S BGPUF="/usr/spool/uucppublic/"
- I BGPEXPT,BGPUF="" W:'$D(ZTQUEUED) !!,"Cannot continue.....can't find export directory name. EXCEL file",!,"not written." D PAUSE^BGP6DU,XIT Q
- SUM ;display summary of this report
- W:$D(IOF) @IOF
- W !,$$CTR("SUMMARY OF OTHER NATIONAL MEASURES REPORT TO BE GENERATED")
- W !!,"The date ranges for this report are:"
- W !?5,"Report Period: ",?31,$$FMTE^XLFDT(BGPBD)," to ",?31,$$FMTE^XLFDT(BGPED)
- W !?5,"Previous Year Period: ",?31,$$FMTE^XLFDT(BGPPBD)," to ",?31,$$FMTE^XLFDT(BGPPED)
- W !?5,"Baseline Period: ",?31,$$FMTE^XLFDT(BGPBBD)," to ",?31,$$FMTE^XLFDT(BGPBED)
- W !!,"The COMMUNITY Taxonomy to be used is: ",$P(^ATXAX(BGPTAXI,0),U)
- W !,"The Beneficiary Population is: ",BGPBENF(0)
- I BGPHOME W !,"The HOME location is: ",$P(^DIC(4,BGPHOME,0),U)," ",$P(^AUTTLOC(BGPHOME,0),U,10)
- I 'BGPHOME W !,"No HOME Location selected."
- D TEXT^BGP6DSL
- I $D(DIRUT) G BEN
- D PT^BGP6DSL
- I BGPROT="" G BEN
- ZIS ;call to XBDBQUE
- D REPORT^BGP6UTL
- I $G(BGPQUIT) D XIT Q
- I BGPRPT="" D XIT Q
- I BGPEXPT D
- .W !!,"A file will be created called BG161",$P(^AUTTLOC(DUZ(2),0),U,10)_".ONM"_BGPRPT," and will reside",!,"in the ",BGPUF," directory.",!
- .W !,"Depending on your site configuration, these files may need to be manually",!,"sent to your Area Office.",!
- K IOP,%ZIS I BGPROT="D",BGPDELT="F" D NODEV,XIT Q
- K IOP,%ZIS W !! S %ZIS=$S(BGPDELT'="S":"PQM",1:"PM") D ^%ZIS
- I POP W !,"Report Aborted" S DA=BGPRPT,DIK="^BGPGPDCM(" D ^DIK K DIK D XIT Q
- I POP W !,"Report Aborted" S DA=BGPRPT,DIK="^BGPGPDPM(" D ^DIK K DIK D XIT Q
- I POP W !,"Report Aborted" S DA=BGPRPT,DIK="^BGPGPDBM(" D ^DIK K DIK D XIT Q
- I $D(IO("Q")) G TSKMN
- DRIVER ;
- D ^BGP6D1
- U IO
- D ^BGP6DP
- D ^%ZISC
- I BGPEXPT D GS^BGP6UTL
- Q
- ;
- NODEV ;
- S XBRP="",XBRC="NODEV1^BGP6DON",XBRX="XIT^BGP6DON",XBNS="BGP"
- D ^XBDBQUE
- Q
- ;
- NODEV1 ;
- D ^BGP6D1
- ;I $D(BGPSEAT) D ^BGP6D10
- D ^BGP6DP
- D ^%ZISC
- I BGPEXPT D GS^BGP6UTL
- ;I $G(BGPEXCEL) D EXCELGS^BGP6UTL
- D XIT
- Q
- TSKMN ;EP ENTRY POINT FROM TASKMAN
- S ZTIO=$S($D(ION):ION,1:IO) I $D(IOST)#2,IOST]"" S ZTIO=ZTIO_";"_IOST
- I $G(IO("DOC"))]"" S ZTIO=ZTIO_";"_$G(IO("DOC"))
- I $D(IOM)#2,IOM S ZTIO=ZTIO_";"_IOM I $D(IOSL)#2,IOSL S ZTIO=ZTIO_";"_IOSL
- K ZTSAVE S ZTSAVE("BGP*")=""
- S ZTCPU=$G(IOCPU),ZTRTN="DRIVER^BGP6DON",ZTDTH="",ZTDESC="Other National Measures REPORT 15" D ^%ZTLOAD D XIT Q
- Q
- ;
- XIT ;
- D ^%ZISC
- D EN^XBVK("BGP") I $D(ZTQUEUED) S ZTREQ="@"
- K DIRUT,DUOUT,DIR,DOD
- K DIADD,DLAYGO
- D KILL^AUPNPAT
- K X,X1,X2,X3,X4,X5,X6
- 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
- K N,N1,N2,N3,N4,N5,N6
- K BD,ED
- D KILL^AUPNPAT
- D ^XBFMK
- Q
- ;
- CTR(X,Y) ;EP - Center X in a field Y wide.
- Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
- ;----------
- EOP ;EP - End of page.
- Q:$E(IOST)'="C"
- Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))
- NEW DIR
- K DIR,DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
- S DIR(0)="E" D ^DIR KILL DIR
- Q
- ;----------
- USR() ;EP - Return name of current user from ^VA(200.
- Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
- ;----------
- LOC() ;EP - Return location name from file 4 based on DUZ(2).
- Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
- ;----------
- ;
- CHKY ;
- W !!,"The baseline year and the previous year time periods are the same.",!!
- S DIR(0)="Y",DIR("A")="Do you want to change the baseline year",DIR("B")="N" KILL DA D ^DIR KILL DIR
- I $D(DIRUT) S Y="" Q
- Q
- F ;fiscal year
- S (BGPPER,BGPVDT)=""
- W !!,"Enter the year for the report. Use a 4 digit ",!,"year, e.g. 2016"
- S DIR(0)="D^::EP"
- S DIR("A")="Enter year"
- S DIR("?")="This report is compiled for a period. Enter a valid date."
- D ^DIR KILL DIR
- I $D(DIRUT) Q
- I $D(DUOUT) S DIRUT=1 Q
- S BGPVDT=Y
- I $E(Y,4,7)'="0000" W !!,"Please enter a year only!",! G F
- S BGPPER=BGPVDT
- Q
- B ;fiscal year
- S (BGPBPER,BGPVDT)=""
- W !!,"Enter the BASELINE year for the report. Use a 4 digit ",!,"year, e.g. 2010"
- S DIR(0)="D^::EP"
- S DIR("A")="Enter BASELINE year"
- S DIR("?")="This report is compiled for a period. Enter a valid date."
- D ^DIR KILL DIR
- I $D(DIRUT) Q
- I $D(DUOUT) S DIRUT=1 Q
- S BGPVDT=Y
- I $E(Y,4,7)'="0000" W !!,"Please enter a year only!",! G F
- S BGPBPER=BGPVDT
- Q
- ENDDATE ;EP
- W !!,"When entering dates, if you do not enter a full 4 digit year (e.g. 2016)"
- W !,"will assume a year in the past, if you want to put in a future date,"
- W !,"remember to enter the full 4 digit year. For example, if today is"
- W !,"January 4, 2010 and you type in 6/30/10 the system will assume the year"
- W !,"as 1910 since that is a date in the past. You must type 6/30/2010 if you"
- W !,"want a date in the future."
- S (BGPPER,BGPVDT)=""
- W ! K DIR,X,Y S DIR(0)="D^::EP",DIR("A")="Enter End Date for the Report: (e.g. 11/30/2016)" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
- I $D(DIRUT) Q
- S (BGPPER,BGPVDT)=Y
- Q
- BGP6DON ; IHS/CMI/LAB - NATL COMP EXPORT 13 Nov 2006 12:31 PM ;
- +1 ;;16.1;IHS CLINICAL REPORTING;;MAR 22, 2016;Build 170
- +2 ;
- +3 ;
- +4 IF $DATA(IOF)
- WRITE @IOF
- +5 DO XIT
- +6 WRITE !,$$CTR("IHS 2016 Other National Measures Report",80)
- CHOICE ;
- +1 WRITE !!,"Please select the type of report would you like to run:"
- +2 WRITE !!?8,"H Hard-coded Report: Report with all parameters set to the"
- +3 WRITE !?11,"same as the National GPRA/GPRAMA Report (report period of "
- +4 WRITE !?11,"July 1, 2015 - June 30, 2016, baseline period of July 1, 2009"
- +5 WRITE !?11,"- June 30, 2010, and AI/AN patients only)"
- +6 WRITE !!?8,"U User-defined Report: You select the report and baseline"
- +7 WRITE !?11,"periods and beneficiary population"
- +8 WRITE !
- +9 SET DIR(0)="F^1:1"
- SET DIR("A")="Select a Report Option"
- +10 SET DIR("B")="H"
- SET DIR("?")="Enter an H for Hard-coded or a U for User-defined"
- +11 DO ^DIR
- +12 IF $DATA(DIRUT)
- DO XIT
- QUIT
- +13 KILL DIR
- +14 SET Y=$$UP^XLFSTR(Y)
- IF Y'="U"
- IF Y'="H"
- WRITE !!,"Please enter an H for Hard-coded or a U for User-defined."
- GOTO CHOICE
- +15 SET BGPRTC=Y
- INTRO ;
- +1 WRITE !,$$CTR("IHS 2016 Other National Measures Report",80)
- +2 IF BGPRTC="U"
- Begin DoDot:1
- +3 WRITE !!,"This will produce the Other National Measures (ONM) Report for all"
- +4 WRITE !,"ONM performance measures for a year period you specify. You will be "
- +5 WRITE !,"asked to provide: 1) the reporting period, 2) the baseline period to "
- +6 WRITE !,"compare data to, 3) the community taxonomy to determine which patients"
- +7 WRITE !,"will be included, and the 4) beneficiary population."
- +8 WRITE !!,"You will be given the opportunity to export this data to the Area office."
- +9 WRITE !,"If you answer yes, this option will produce a report in export format for "
- +10 WRITE !,"the Area Office to use in Area aggregated data. Depending on site specific"
- +11 WRITE !,"configuration, the export file will either be automatically transmitted"
- +12 WRITE !,"directly to the Area or the site will have to send the file manually."
- +13 WRITE !
- End DoDot:1
- +14 IF BGPRTC="H"
- Begin DoDot:1
- +15 WRITE !!,"This will produce an Other National Measures report. You will be asked to"
- +16 WRITE !,"provide the community taxonomy to determine which patients will be included."
- +17 WRITE !,"This report will be run for the Report Period July 1, 2015 through "
- +18 WRITE !,"June 30, 2016 with a Baseline Year of July 1, 2009 through June 30, 2010."
- +19 WRITE !,"This report will include beneficiary population of American Indian/Alaska"
- +20 WRITE !,"Native only."
- +21 WRITE !!,"You can choose to export this data to the Area office. If you answer yes"
- +22 WRITE !,"at the export prompt, a report will be produced in export format for the "
- +23 WRITE !,"Area Office to use in Area aggregated data. Depending on site specific"
- +24 WRITE !,"configuration, the export file will either be automatically transmitted"
- +25 WRITE !,"directly to the Area or the site will have to send the file manually."
- +26 WRITE !
- End DoDot:1
- +27 KILL DIR
- SET DIR(0)="E"
- SET DIR("A")="Press Enter to Continue"
- DO ^DIR
- KILL DIR,DUOUT,DIRUT
- +28 DO TAXCHK^BGP6XTCO
- +29 SET X=$$DEMOCHK^BGP6UTL2()
- +30 IF 'X
- WRITE !!,"Exiting Report....."
- DO PAUSE^BGP6DU
- DO XIT
- QUIT
- ST ;
- TP ;get time period
- +1 SET BGPRTYPE=7
- SET BGPYRPTH=""
- +2 SET (BGPBD,BGPED,BGPTP)=""
- H IF BGPRTC="H"
- Begin DoDot:1
- +1 SET X=$ORDER(^BGPCTRL("B",2016,0))
- +2 SET Y=^BGPCTRL(X,0)
- +3 SET BGPBD=$PIECE(Y,U,8)
- SET BGPED=$PIECE(Y,U,9)
- +4 SET BGPPBD=$PIECE(Y,U,10)
- SET BGPPED=$PIECE(Y,U,11)
- +5 SET BGPBBD=$PIECE(Y,U,12)
- SET BGPBED=$PIECE(Y,U,13)
- +6 SET BGPPER=$PIECE(Y,U,14)
- SET BGPQTR=3
- +7 ;BEGIN TEST STUFF
- +8 ;COMMENT OUT THIS LINE WHEN TESTING IN TEHR
- GOTO NT
- +9 WRITE !!,"for testing purposes only, please enter a report year",!
- +10 DO F
- +11 IF BGPPER=""
- WRITE !!,"no year entered..bye"
- DO XIT
- QUIT
- +12 SET BGPQTR=3
- +13 SET BGPBD=$EXTRACT(BGPPER,1,3)_"0101"
- SET BGPED=$EXTRACT(BGPPER,1,3)_"1231"
- +14 SET BGPPBD=($EXTRACT(BGPPER,1,3)-1)_"0101"
- SET BGPPED=($EXTRACT(BGPPER,1,3)-1)_"1231"
- +15 WRITE !!,"for testing purposes only, please enter a BASELINE year",!
- +16 DO B
- +17 IF BGPBPER=""
- WRITE !!,"no year entered..bye"
- DO XIT
- QUIT
- +18 SET BGPBBD=$EXTRACT(BGPBPER,1,3)_"0101"
- SET BGPBED=$EXTRACT(BGPBPER,1,3)_"1231"
- NT ;END TEST STUFF
- +1 WRITE !!,"The date ranges for this report are:"
- +2 WRITE !?5,"Report Period: ",?31,$$FMTE^XLFDT(BGPBD)," to ",?31,$$FMTE^XLFDT(BGPED)
- +3 WRITE !?5,"Previous Year Period: ",?31,$$FMTE^XLFDT(BGPPBD)," to ",?31,$$FMTE^XLFDT(BGPPED)
- +4 WRITE !?5,"Baseline Period: ",?31,$$FMTE^XLFDT(BGPBBD)," to ",?31,$$FMTE^XLFDT(BGPBED)
- +5 SET BGPHOME=$PIECE($GET(^BGPSITE(DUZ(2),0)),U,2)
- +6 IF BGPHOME=""
- WRITE !!,"Home Location not found in Site File!!",!,"PHN Visits counts to Home will be calculated using clinic 11 only!!"
- HANG 2
- GOTO H1
- +7 WRITE !!,"Your HOME location is defined as: ",$PIECE(^DIC(4,BGPHOME,0),U)," asufac: ",$PIECE(^AUTTLOC(BGPHOME,0),U,10)
- H1 SET BGPBEN=1
- SET BGPBENF(0)="Indian/Alaskan Native (Classification 01)"
- WRITE !!,"Beneficiary Population is set to American Indian/Alaskan Native Only."
- End DoDot:1
- GOTO COMM
- +1 SET 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"
- SET DIR("A")="Enter the date range for your report"
- KILL DA
- DO ^DIR
- KILL DIR
- +2 IF $DATA(DIRUT)
- DO XIT
- QUIT
- +3 SET BGPQTR=Y
- +4 IF BGPQTR=5
- DO ENDDATE
- +5 IF BGPQTR'=5
- DO F
- +6 IF BGPPER=""
- WRITE !,"Year not entered.",!
- GOTO TP
- +7 IF BGPQTR=1
- SET BGPBD=$EXTRACT(BGPPER,1,3)_"0101"
- SET BGPED=$EXTRACT(BGPPER,1,3)_"1231"
- +8 IF BGPQTR=2
- SET BGPBD=($EXTRACT(BGPPER,1,3)-1)_"0401"
- SET BGPED=$EXTRACT(BGPPER,1,3)_"0331"
- +9 IF BGPQTR=3
- SET BGPBD=($EXTRACT(BGPPER,1,3)-1)_"0701"
- SET BGPED=$EXTRACT(BGPPER,1,3)_"0630"
- +10 IF BGPQTR=4
- SET BGPBD=($EXTRACT(BGPPER,1,3)-1)_"1001"
- SET BGPED=$EXTRACT(BGPPER,1,3)_"0930"
- +11 IF BGPQTR=5
- SET BGPBD=$$FMADD^XLFDT(BGPPER,-364)
- SET BGPED=BGPPER
- SET BGPPER=$EXTRACT(BGPED,1,3)_"0000"
- +12 IF BGPED>DT
- Begin DoDot:1
- +13 WRITE !!,"You have selected Current Report period ",$$FMTE^XLFDT(BGPBD)," through ",$$FMTE^XLFDT(BGPED),"."
- +14 WRITE !,"The end date of this report is in the future; your data will not be",!,"complete.",!
- +15 KILL DIR
- SET BGPDO=0
- SET DIR(0)="Y"
- SET DIR("A")="Do you want to change your Current Report Dates"
- SET DIR("B")="N"
- KILL DA
- DO ^DIR
- KILL DIR
- +16 IF $DATA(DIRUT)
- SET BGPDO=1
- QUIT
- +17 IF Y
- SET BGPDO=1
- QUIT
- +18 QUIT
- End DoDot:1
- IF BGPDO=1
- GOTO TP
- BY ;get baseline year
- +1 SET BGPVDT=""
- +2 WRITE !!,"Enter the Baseline Year to compare data to.",!,"Use a 4 digit year, e.g. 2010"
- +3 SET DIR(0)="D^::EP"
- +4 SET DIR("A")="Enter Year (e.g. 2010)"
- +5 DO ^DIR
- KILL DIR
- +6 IF $DATA(DIRUT)
- GOTO TP
- +7 IF $DATA(DUOUT)
- SET DIRUT=1
- GOTO TP
- +8 SET BGPVDT=Y
- +9 IF $EXTRACT(Y,4,7)'="0000"
- WRITE !!,"Please enter a year only!",!
- GOTO BY
- +10 SET X=$EXTRACT(BGPPER,1,3)-$EXTRACT(BGPVDT,1,3)
- +11 SET X=X_"0000"
- +12 SET BGPBBD=BGPBD-X
- SET BGPBBD=$EXTRACT(BGPBBD,1,3)_$EXTRACT(BGPBD,4,7)
- +13 SET BGPBED=BGPED-X
- SET BGPBED=$EXTRACT(BGPBED,1,3)_$EXTRACT(BGPED,4,7)
- +14 SET BGPPBD=($EXTRACT(BGPBD,1,3)-1)_$EXTRACT(BGPBD,4,7)
- +15 SET BGPPED=($EXTRACT(BGPED,1,3)-1)_$EXTRACT(BGPED,4,7)
- +16 WRITE !!,"The date ranges for this report are:"
- +17 WRITE !?5,"Report Period: ",?31,$$FMTE^XLFDT(BGPBD)," to ",?31,$$FMTE^XLFDT(BGPED)
- +18 WRITE !?5,"Previous Year Period: ",?31,$$FMTE^XLFDT(BGPPBD)," to ",?31,$$FMTE^XLFDT(BGPPED)
- +19 WRITE !?5,"Baseline Period: ",?31,$$FMTE^XLFDT(BGPBBD)," to ",?31,$$FMTE^XLFDT(BGPBED)
- +20 IF BGPPBD=BGPBBD
- IF BGPPED=BGPBED
- KILL Y
- DO CHKY
- IF Y
- KILL BGPBBD,BGPBED,BGPPBD,BGPPED
- GOTO BY
- COMM ;
- +1 WRITE !!,"Specify the community taxonomy to determine which patients will be",!,"included in the report. You should have created this taxonomy using QMAN.",!
- +2 KILL BGPTAX
- +3 SET BGPTAXI=""
- +4 DO ^XBFMK
- +5 SET DIC("S")="I $P(^(0),U,15)=9999999.05"
- SET DIC="^ATXAX("
- SET DIC(0)="AEMQ"
- SET DIC("A")="Enter the Name of the Community Taxonomy: "
- +6 SET B=$PIECE($GET(^BGPSITE(DUZ(2),0)),U,5)
- IF B
- SET DIC("B")=$PIECE(^ATXAX(B,0),U)
- +7 DO ^DIC
- +8 IF Y=-1
- GOTO CHOICE
- +9 SET BGPTAXI=+Y
- COM1 SET X=0
- +1 FOR
- SET X=$ORDER(^ATXAX(BGPTAXI,21,X))
- IF 'X
- QUIT
- Begin DoDot:1
- +2 SET BGPTAX($PIECE(^ATXAX(BGPTAXI,21,X,0),U))=""
- +3 QUIT
- End DoDot:1
- +4 IF '$DATA(BGPTAX)
- WRITE !!,"There are no communities in that taxonomy."
- GOTO COMM
- +5 SET X=0
- SET G=0
- +6 FOR
- SET X=$ORDER(^ATXAX(BGPTAXI,21,X))
- IF 'X
- QUIT
- Begin DoDot:1
- +7 SET C=$PIECE(^ATXAX(BGPTAXI,21,X,0),U)
- +8 IF '$DATA(^AUTTCOM("B",C))
- WRITE !!,"*** Warning: Community ",C," is in the taxonomy but does not",!,"exist in the community table. Please recreate your community taxonomy."
- SET G=1
- +9 QUIT
- End DoDot:1
- +10 IF G
- WRITE !!,"The community taxonomy may not be accurate."
- Begin DoDot:1
- +11 SET BGPQUIT=0
- +12 SET DIR(0)="Y"
- SET DIR("A")="Do you wish to continue running the report"
- KILL DA
- DO ^DIR
- KILL DIR
- +13 IF $DATA(DIRUT)
- SET BGPQUIT=1
- +14 IF 'Y
- SET BGPQUIT=1
- +15 QUIT
- End DoDot:1
- IF BGPQUIT
- DO XIT
- QUIT
- +16 KILL BGPQUIT
- BEN ;
- +1 ;I $G(BGPSEAT) G HOME
- +2 IF BGPRTC="H"
- GOTO HOME
- +3 SET BGPBEN=""
- +4 SET 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)"
- SET DIR("A")="Select Beneficiary Population to include in this report"
- +5 SET DIR("B")="1"
- KILL DA
- DO ^DIR
- KILL DIR
- +6 IF $DATA(DIRUT)
- GOTO COMM
- +7 SET BGPBEN=Y
- SET BGPBENF(0)=Y(0)
- HOME ;
- +1 SET BGPHOME=$PIECE($GET(^BGPSITE(DUZ(2),0)),U,2)
- +2 IF BGPHOME=""
- WRITE !!,"Home Location not found in Site File!!",!,"PHN Visits counts to Home will be calculated using clinic 11 only!!"
- HANG 2
- GOTO AI
- +3 WRITE !,"Your HOME location is defined as: ",$PIECE(^DIC(4,BGPHOME,0),U)," asufac: ",$PIECE(^AUTTLOC(BGPHOME,0),U,10)
- AI ;gather all gpra measures
- +1 SET X=0
- FOR
- SET X=$ORDER(^BGPINDM("ON",1,X))
- IF X'=+X
- QUIT
- SET BGPIND(X)=""
- +2 SET BGPINDM="O"
- EXPORT ;export to area or not?
- +1 ;,BGPYWCHW=0
- SET BGPEXPT=""
- +2 ;I $D(BGPSEAT) G EISSEX
- +3 SET DIR(0)="Y"
- SET DIR("A")="Do you wish to export this data to Area"
- KILL DA
- DO ^DIR
- KILL DIR
- +4 IF $DATA(DIRUT)
- GOTO COMM
- +5 SET BGPEXPT=Y
- EISSEX ;
- +1 SET BGPEXCEL=""
- +2 SET BGPUF=$$GETDIR^BGP6UTL2()
- +3 ;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")
- +4 ;I $P(^AUTTSITE(1,0),U,21)=1 S BGPUF="/usr/spool/uucppublic/"
- +5 IF BGPEXPT
- IF BGPUF=""
- IF '$DATA(ZTQUEUED)
- WRITE !!,"Cannot continue.....can't find export directory name. EXCEL file",!,"not written."
- DO PAUSE^BGP6DU
- DO XIT
- QUIT
- SUM ;display summary of this report
- +1 IF $DATA(IOF)
- WRITE @IOF
- +2 WRITE !,$$CTR("SUMMARY OF OTHER NATIONAL MEASURES REPORT TO BE GENERATED")
- +3 WRITE !!,"The date ranges for this report are:"
- +4 WRITE !?5,"Report Period: ",?31,$$FMTE^XLFDT(BGPBD)," to ",?31,$$FMTE^XLFDT(BGPED)
- +5 WRITE !?5,"Previous Year Period: ",?31,$$FMTE^XLFDT(BGPPBD)," to ",?31,$$FMTE^XLFDT(BGPPED)
- +6 WRITE !?5,"Baseline Period: ",?31,$$FMTE^XLFDT(BGPBBD)," to ",?31,$$FMTE^XLFDT(BGPBED)
- +7 WRITE !!,"The COMMUNITY Taxonomy to be used is: ",$PIECE(^ATXAX(BGPTAXI,0),U)
- +8 WRITE !,"The Beneficiary Population is: ",BGPBENF(0)
- +9 IF BGPHOME
- WRITE !,"The HOME location is: ",$PIECE(^DIC(4,BGPHOME,0),U)," ",$PIECE(^AUTTLOC(BGPHOME,0),U,10)
- +10 IF 'BGPHOME
- WRITE !,"No HOME Location selected."
- +11 DO TEXT^BGP6DSL
- +12 IF $DATA(DIRUT)
- GOTO BEN
- +13 DO PT^BGP6DSL
- +14 IF BGPROT=""
- GOTO BEN
- ZIS ;call to XBDBQUE
- +1 DO REPORT^BGP6UTL
- +2 IF $GET(BGPQUIT)
- DO XIT
- QUIT
- +3 IF BGPRPT=""
- DO XIT
- QUIT
- +4 IF BGPEXPT
- Begin DoDot:1
- +5 WRITE !!,"A file will be created called BG161",$PIECE(^AUTTLOC(DUZ(2),0),U,10)_".ONM"_BGPRPT," and will reside",!,"in the ",BGPUF," directory.",!
- +6 WRITE !,"Depending on your site configuration, these files may need to be manually",!,"sent to your Area Office.",!
- End DoDot:1
- +7 KILL IOP,%ZIS
- IF BGPROT="D"
- IF BGPDELT="F"
- DO NODEV
- DO XIT
- QUIT
- +8 KILL IOP,%ZIS
- WRITE !!
- SET %ZIS=$SELECT(BGPDELT'="S":"PQM",1:"PM")
- DO ^%ZIS
- +9 IF POP
- WRITE !,"Report Aborted"
- SET DA=BGPRPT
- SET DIK="^BGPGPDCM("
- DO ^DIK
- KILL DIK
- DO XIT
- QUIT
- +10 IF POP
- WRITE !,"Report Aborted"
- SET DA=BGPRPT
- SET DIK="^BGPGPDPM("
- DO ^DIK
- KILL DIK
- DO XIT
- QUIT
- +11 IF POP
- WRITE !,"Report Aborted"
- SET DA=BGPRPT
- SET DIK="^BGPGPDBM("
- DO ^DIK
- KILL DIK
- DO XIT
- QUIT
- +12 IF $DATA(IO("Q"))
- GOTO TSKMN
- DRIVER ;
- +1 DO ^BGP6D1
- +2 USE IO
- +3 DO ^BGP6DP
- +4 DO ^%ZISC
- +5 IF BGPEXPT
- DO GS^BGP6UTL
- +6 QUIT
- +7 ;
- NODEV ;
- +1 SET XBRP=""
- SET XBRC="NODEV1^BGP6DON"
- SET XBRX="XIT^BGP6DON"
- SET XBNS="BGP"
- +2 DO ^XBDBQUE
- +3 QUIT
- +4 ;
- NODEV1 ;
- +1 DO ^BGP6D1
- +2 ;I $D(BGPSEAT) D ^BGP6D10
- +3 DO ^BGP6DP
- +4 DO ^%ZISC
- +5 IF BGPEXPT
- DO GS^BGP6UTL
- +6 ;I $G(BGPEXCEL) D EXCELGS^BGP6UTL
- +7 DO XIT
- +8 QUIT
- TSKMN ;EP ENTRY POINT FROM TASKMAN
- +1 SET ZTIO=$SELECT($DATA(ION):ION,1:IO)
- IF $DATA(IOST)#2
- IF IOST]""
- SET ZTIO=ZTIO_";"_IOST
- +2 IF $GET(IO("DOC"))]""
- SET ZTIO=ZTIO_";"_$GET(IO("DOC"))
- +3 IF $DATA(IOM)#2
- IF IOM
- SET ZTIO=ZTIO_";"_IOM
- IF $DATA(IOSL)#2
- IF IOSL
- SET ZTIO=ZTIO_";"_IOSL
- +4 KILL ZTSAVE
- SET ZTSAVE("BGP*")=""
- +5 SET ZTCPU=$GET(IOCPU)
- SET ZTRTN="DRIVER^BGP6DON"
- SET ZTDTH=""
- SET ZTDESC="Other National Measures REPORT 15"
- DO ^%ZTLOAD
- DO XIT
- QUIT
- +6 QUIT
- +7 ;
- XIT ;
- +1 DO ^%ZISC
- +2 DO EN^XBVK("BGP")
- IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +3 KILL DIRUT,DUOUT,DIR,DOD
- +4 KILL DIADD,DLAYGO
- +5 DO KILL^AUPNPAT
- +6 KILL X,X1,X2,X3,X4,X5,X6
- +7 KILL 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
- +8 KILL N,N1,N2,N3,N4,N5,N6
- +9 KILL BD,ED
- +10 DO KILL^AUPNPAT
- +11 DO ^XBFMK
- +12 QUIT
- +13 ;
- CTR(X,Y) ;EP - Center X in a field Y wide.
- +1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
- +2 ;----------
- EOP ;EP - End of page.
- +1 IF $EXTRACT(IOST)'="C"
- QUIT
- +2 IF $DATA(ZTQUEUED)!'(IOT="TRM")!$DATA(IO("S"))
- QUIT
- +3 NEW DIR
- +4 KILL DIR,DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
- +5 SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- +6 QUIT
- +7 ;----------
- USR() ;EP - Return name of current user from ^VA(200.
- +1 QUIT $SELECT($GET(DUZ):$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
- +2 ;----------
- LOC() ;EP - Return location name from file 4 based on DUZ(2).
- +1 QUIT $SELECT($GET(DUZ(2)):$SELECT($DATA(^DIC(4,DUZ(2),0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
- +2 ;----------
- +3 ;
- CHKY ;
- +1 WRITE !!,"The baseline year and the previous year time periods are the same.",!!
- +2 SET DIR(0)="Y"
- SET DIR("A")="Do you want to change the baseline year"
- SET DIR("B")="N"
- KILL DA
- DO ^DIR
- KILL DIR
- +3 IF $DATA(DIRUT)
- SET Y=""
- QUIT
- +4 QUIT
- F ;fiscal year
- +1 SET (BGPPER,BGPVDT)=""
- +2 WRITE !!,"Enter the year for the report. Use a 4 digit ",!,"year, e.g. 2016"
- +3 SET DIR(0)="D^::EP"
- +4 SET DIR("A")="Enter year"
- +5 SET DIR("?")="This report is compiled for a period. Enter a valid date."
- +6 DO ^DIR
- KILL DIR
- +7 IF $DATA(DIRUT)
- QUIT
- +8 IF $DATA(DUOUT)
- SET DIRUT=1
- QUIT
- +9 SET BGPVDT=Y
- +10 IF $EXTRACT(Y,4,7)'="0000"
- WRITE !!,"Please enter a year only!",!
- GOTO F
- +11 SET BGPPER=BGPVDT
- +12 QUIT
- B ;fiscal year
- +1 SET (BGPBPER,BGPVDT)=""
- +2 WRITE !!,"Enter the BASELINE year for the report. Use a 4 digit ",!,"year, e.g. 2010"
- +3 SET DIR(0)="D^::EP"
- +4 SET DIR("A")="Enter BASELINE year"
- +5 SET DIR("?")="This report is compiled for a period. Enter a valid date."
- +6 DO ^DIR
- KILL DIR
- +7 IF $DATA(DIRUT)
- QUIT
- +8 IF $DATA(DUOUT)
- SET DIRUT=1
- QUIT
- +9 SET BGPVDT=Y
- +10 IF $EXTRACT(Y,4,7)'="0000"
- WRITE !!,"Please enter a year only!",!
- GOTO F
- +11 SET BGPBPER=BGPVDT
- +12 QUIT
- ENDDATE ;EP
- +1 WRITE !!,"When entering dates, if you do not enter a full 4 digit year (e.g. 2016)"
- +2 WRITE !,"will assume a year in the past, if you want to put in a future date,"
- +3 WRITE !,"remember to enter the full 4 digit year. For example, if today is"
- +4 WRITE !,"January 4, 2010 and you type in 6/30/10 the system will assume the year"
- +5 WRITE !,"as 1910 since that is a date in the past. You must type 6/30/2010 if you"
- +6 WRITE !,"want a date in the future."
- +7 SET (BGPPER,BGPVDT)=""
- +8 WRITE !
- KILL DIR,X,Y
- SET DIR(0)="D^::EP"
- SET DIR("A")="Enter End Date for the Report: (e.g. 11/30/2016)"
- DO ^DIR
- KILL DIR
- IF $DATA(DUOUT)
- SET DIRUT=1
- +9 IF $DATA(DIRUT)
- QUIT
- +10 SET (BGPPER,BGPVDT)=Y
- +11 QUIT