BGP1DON ; IHS/CMI/LAB - NATL COMP EXPORT 13 Nov 2006 12:31 PM ;
;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
;
;
W:$D(IOF) @IOF
D XIT
W !,$$CTR("IHS 2011 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 and Part Report (report period of "
W !?11,"July 1, 2010 - June 30, 2011, baseline period of July 1, 1999"
W !?11,"- June 30, 2000, 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 2011 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, 2010 through "
.W !,"June 30, 2011 with a Baseline Year of July 1, 1999 through June 30, 2000."
.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^BGP1XTCO
S X=$$DEMOCHK^BGP1UTL2()
I 'X W !!,"Exiting Report....." D PAUSE^BGP1CL,XIT Q
ST ;
TP ;get time period
S BGPRTYPE=7,BGP1RPTH=""
S (BGPBD,BGPED,BGPTP)=""
H I BGPRTC="H" D G COMM
.S X=$O(^BGPCTRL("B",2011,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. 1999, 2000"
S DIR(0)="D^::EP"
S DIR("A")="Enter Year (e.g. 2000)"
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
MFIC K BGPQUIT
I $P($G(^BGPSITE(DUZ(2),0)),U,8)=1 D I BGPMFITI="" G COMM
.S BGPMFITI=""
.W !!,"Specify the LOCATION taxonomy to determine which patient visits will be"
.W !,"used to determine whether a patient is in the denominators for the report."
.W !,"You should have created this taxonomy using QMAN.",!
.K BGPMFIT
.S BGPMFITI=""
.D ^XBFMK
.S DIC("S")="I $P(^(0),U,15)=9999999.06",DIC="^ATXAX(",DIC(0)="AEMQ",DIC("A")="Enter the Name of the Location/Facility Taxonomy: "
.S B=$P($G(^BGPSITE(DUZ(2),0)),U,9) I B S DIC("B")=$P(^ATXAX(B,0),U)
.D ^DIC
.I Y=-1 Q
.S BGPMFITI=+Y
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(^BGPINDB("ON",1,X)) Q:X'=+X S BGPIND(X)=""
S BGPINDB="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^BGP1UTL2()
;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^BGP1CL,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 $G(BGPSEAT) W !!,"The Patient Population is: ",$P(^DIBT(BGPSEAT,0),U,1)
;W !!,"The COMMUNITY Taxonomy to be used is: ",$P(^ATXAX(BGPTAXI,0),U)
I $G(BGPMFITI) W !!,"The MFI Location Taxonomy to be used is: ",$P(^ATXAX(BGPMFITI,0),U)
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 PT^BGP1DSL
I BGPROT="" G BEN
ZIS ;call to XBDBQUE
D REPORT^BGP1UTL
I $G(BGPQUIT) D XIT Q
I BGPRPT="" D XIT Q
I BGPEXPT D
.W !!,"A file will be created called BG11",$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="^BGPGPDCB(" D ^DIK K DIK D XIT Q
I POP W !,"Report Aborted" S DA=BGPRPT,DIK="^BGPGPDPB(" D ^DIK K DIK D XIT Q
I POP W !,"Report Aborted" S DA=BGPRPT,DIK="^BGPGPDBB(" D ^DIK K DIK D XIT Q
I $D(IO("Q")) G TSKMN
DRIVER ;
D ^BGP1D1
;I $D(BGPSEAT) D ^BGP1D10
U IO
D ^BGP1DP
D ^%ZISC
I BGPEXPT D GS^BGP1UTL
;I $G(BGPEXCEL) D EXCELGS^BGP1UTL
Q
;
NODEV ;
S XBRP="",XBRC="NODEV1^BGP1DON",XBRX="XIT^BGP1DON",XBNS="BGP"
D ^XBDBQUE
Q
;
NODEV1 ;
D ^BGP1D1
;I $D(BGPSEAT) D ^BGP1D10
D ^BGP1DP
D ^%ZISC
I BGPEXPT D GS^BGP1UTL
;I $G(BGPEXCEL) D EXCELGS^BGP1UTL
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^BGP1DON",ZTDTH="",ZTDESC="Other National Measures REPORT 11" 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. 2011"
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. 2000"
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. 2011)"
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/05 the system will assume the year"
W !,"as 1905 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/2005)" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) Q
S (BGPPER,BGPVDT)=Y
Q
BGP1DON ; IHS/CMI/LAB - NATL COMP EXPORT 13 Nov 2006 12:31 PM ;
+1 ;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
+2 ;
+3 ;
+4 IF $DATA(IOF)
WRITE @IOF
+5 DO XIT
+6 WRITE !,$$CTR("IHS 2011 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 and Part Report (report period of "
+4 WRITE !?11,"July 1, 2010 - June 30, 2011, baseline period of July 1, 1999"
+5 WRITE !?11,"- June 30, 2000, 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 2011 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, 2010 through "
+18 WRITE !,"June 30, 2011 with a Baseline Year of July 1, 1999 through June 30, 2000."
+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^BGP1XTCO
+29 SET X=$$DEMOCHK^BGP1UTL2()
+30 IF 'X
WRITE !!,"Exiting Report....."
DO PAUSE^BGP1CL
DO XIT
QUIT
ST ;
TP ;get time period
+1 SET BGPRTYPE=7
SET BGP1RPTH=""
+2 SET (BGPBD,BGPED,BGPTP)=""
H IF BGPRTC="H"
Begin DoDot:1
+1 SET X=$ORDER(^BGPCTRL("B",2011,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. 1999, 2000"
+3 SET DIR(0)="D^::EP"
+4 SET DIR("A")="Enter Year (e.g. 2000)"
+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
MFIC KILL BGPQUIT
+1 IF $PIECE($GET(^BGPSITE(DUZ(2),0)),U,8)=1
Begin DoDot:1
+2 SET BGPMFITI=""
+3 WRITE !!,"Specify the LOCATION taxonomy to determine which patient visits will be"
+4 WRITE !,"used to determine whether a patient is in the denominators for the report."
+5 WRITE !,"You should have created this taxonomy using QMAN.",!
+6 KILL BGPMFIT
+7 SET BGPMFITI=""
+8 DO ^XBFMK
+9 SET DIC("S")="I $P(^(0),U,15)=9999999.06"
SET DIC="^ATXAX("
SET DIC(0)="AEMQ"
SET DIC("A")="Enter the Name of the Location/Facility Taxonomy: "
+10 SET B=$PIECE($GET(^BGPSITE(DUZ(2),0)),U,9)
IF B
SET DIC("B")=$PIECE(^ATXAX(B,0),U)
+11 DO ^DIC
+12 IF Y=-1
QUIT
+13 SET BGPMFITI=+Y
End DoDot:1
IF BGPMFITI=""
GOTO COMM
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(^BGPINDB("ON",1,X))
IF X'=+X
QUIT
SET BGPIND(X)=""
+2 SET BGPINDB="O"
EXPORT ;export to area or not?
+1 SET BGPEXPT=""
SET BGPYWCHW=0
+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^BGP1UTL2()
+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^BGP1CL
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 ;I $G(BGPSEAT) W !!,"The Patient Population is: ",$P(^DIBT(BGPSEAT,0),U,1)
+10 ;W !!,"The COMMUNITY Taxonomy to be used is: ",$P(^ATXAX(BGPTAXI,0),U)
+11 IF $GET(BGPMFITI)
WRITE !!,"The MFI Location Taxonomy to be used is: ",$PIECE(^ATXAX(BGPMFITI,0),U)
+12 IF BGPHOME
WRITE !,"The HOME location is: ",$PIECE(^DIC(4,BGPHOME,0),U)," ",$PIECE(^AUTTLOC(BGPHOME,0),U,10)
+13 IF 'BGPHOME
WRITE !,"No HOME Location selected."
+14 DO PT^BGP1DSL
+15 IF BGPROT=""
GOTO BEN
ZIS ;call to XBDBQUE
+1 DO REPORT^BGP1UTL
+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 BG11",$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="^BGPGPDCB("
DO ^DIK
KILL DIK
DO XIT
QUIT
+10 IF POP
WRITE !,"Report Aborted"
SET DA=BGPRPT
SET DIK="^BGPGPDPB("
DO ^DIK
KILL DIK
DO XIT
QUIT
+11 IF POP
WRITE !,"Report Aborted"
SET DA=BGPRPT
SET DIK="^BGPGPDBB("
DO ^DIK
KILL DIK
DO XIT
QUIT
+12 IF $DATA(IO("Q"))
GOTO TSKMN
DRIVER ;
+1 DO ^BGP1D1
+2 ;I $D(BGPSEAT) D ^BGP1D10
+3 USE IO
+4 DO ^BGP1DP
+5 DO ^%ZISC
+6 IF BGPEXPT
DO GS^BGP1UTL
+7 ;I $G(BGPEXCEL) D EXCELGS^BGP1UTL
+8 QUIT
+9 ;
NODEV ;
+1 SET XBRP=""
SET XBRC="NODEV1^BGP1DON"
SET XBRX="XIT^BGP1DON"
SET XBNS="BGP"
+2 DO ^XBDBQUE
+3 QUIT
+4 ;
NODEV1 ;
+1 DO ^BGP1D1
+2 ;I $D(BGPSEAT) D ^BGP1D10
+3 DO ^BGP1DP
+4 DO ^%ZISC
+5 IF BGPEXPT
DO GS^BGP1UTL
+6 ;I $G(BGPEXCEL) D EXCELGS^BGP1UTL
+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^BGP1DON"
SET ZTDTH=""
SET ZTDESC="Other National Measures REPORT 11"
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. 2011"
+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. 2000"
+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. 2011)"
+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/05 the system will assume the year"
+5 WRITE !,"as 1905 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/2005)"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+9 IF $DATA(DIRUT)
QUIT
+10 SET (BGPPER,BGPVDT)=Y
+11 QUIT