BGP4DG ; IHS/CMI/LAB - IHS GPRA 04 REPORT DRIVER ;
;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007
;
;
W:$D(IOF) @IOF
W !!,$$CTR("IHS FY04 GPRA Clinical Performance Indicator Report",80)
INTRO ;
D XIT
W !!,"This will produce a GPRA Indicator Report for all GPRA indicators for a"
W !,"year period you specify. You will be asked to provide: 1) the"
W !,"reporting period, 2) the baseline period to compare data to, and 3) the ",!,"Community taxonomy to determine which patients will be included."
W !!,"You can choose to export this data to the Area office. If you"
W !,"answer yes at the export prompt, a report will be produced in export format"
W !,"for 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.",!
D TAXCHK^BGP4TXCH
TP ;get time period
D XIT
S BGPRTYPE=1,BGPBEN=1
S (BGPBD,BGPED,BGPTP)=""
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
I $D(DIRUT) D XIT Q
S BGPQTR=Y
D F
I BGPPER="" W !,"Year not entered.",! G TP
I BGPQTR=1 S BGPBD=($E(BGPPER,1,3)-1)_"0101",BGPED=($E(BGPPER,1,3)-1)_"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 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 (at least 2 years prior to Current).",!,"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,"Reporting 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 previously created this taxonomy using",!,"QMAN or the Taxonomy Setup option. (see User Manual for more detail).",!
K BGPTAX
S BGPTAXI=""
D ^XBFMK
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: "
S B=$P($G(^BGPSITE(DUZ(2),0)),U,5) I B S DIC("B")=$P(^ATXAX(B,0),U)
D ^DIC K DIC
I Y=-1 Q
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
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 GI
W !,"Your HOME location is defined as: ",$P(^DIC(4,BGPHOME,0),U)," asufac: ",$P(^AUTTLOC(BGPHOME,0),U,10)
GI ;gather all gpra indicators
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)=""
S BGPINDT="G"
LISTS ;any lists with indicators?
;W !!
;K BGPLIST
;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
;I $D(DIRUT)!(Y="") G COMM
;I Y=0 G EXPORT
;K BGPLIST
;D EN^BGP4DSL
;I '$D(BGPLIST) W !!,"No lists selected.",!
;I $D(BGPLIST) D RT^BGP4DSL I '$D(BGPLIST)!($D(BGPQUIT)) G LISTS ;get report type for each list
EXPORT ;export to area or not?
S BGPEXPT=""
K DIR 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 TP
S BGPEXPT=Y
EISSEX ;
S BGPEXCEL=1
S BGPUF=""
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"
S BGPNOW=$$NOW^XLFDT() S BGPNOW=$$NOW^XLFDT() S BGPNOW=$P(BGPNOW,".")_"."_$$RZERO^BGP4UTL($P(BGPNOW,".",2),6)
I BGPUF="" W:'$D(ZTQUEUED) !!,"Cannot continue.....can't find export directory name. EXCEL file",!,"not written." Q
S BGPFN="GPRAEX"_$P(^AUTTLOC(DUZ(2),0),U,10)_$$D^BGP4UTL(BGPBD)_$$D^BGP4UTL(BGPED)_$$D^BGP4UTL(BGPNOW)_"_000001"_".TXT"
SUM ;display summary of this report
W:$D(IOF) @IOF
W !,$$CTR("SUMMARY OF FY 04 GPRA REPORT TO BE GENERATED")
W !!,"The date ranges for this report are:"
W !?5,"Reporting 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)
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."
W !!,"All GPRA indicators will be calculated."
D PT^BGP4DSL
I BGPROT="" G LISTS
ZIS ;call to XBDBQUE
D REPORT^BGP4UTL
I $G(BGPQUIT) D XIT Q
I BGPRPT="" D XIT Q
I BGPEXPT D
.W !!,"A file will be created called BG04",$P(^AUTTLOC(DUZ(2),0),U,10)_"."_BGPRPT," and will reside",!,"in the ",BGPUF," directory.",!
.W !,"Depending on your site configuration, this file may need to be manually",!,"sent to your Area Office.",!
I BGPEXCEL,BGPEXPT D
.W !,"A file will be created called ",BGPFN,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
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="^BGPGPDCF(" D ^DIK K DIK D XIT Q
I POP W !,"Report Aborted" S DA=BGPRPT,DIK="^BGPGPDPF(" D ^DIK K DIK D XIT Q
I POP W !,"Report Aborted" S DA=BGPRPT,DIK="^BGPGPDBF(" D ^DIK K DIK D XIT Q
I $D(IO("Q")) G TSKMN
DRIVER ;
D ^BGP4D1
U IO
D ^BGP4DP
D ^%ZISC
I BGPEXPT D GS^BGP4UTL
I BGPEXCEL,BGPEXPT D EXCELGS^BGP4UTL
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^BGP4DG",ZTDTH="",ZTDESC="GPRA 04 REPORT" D ^%ZTLOAD D XIT Q
Q
;
NODEV ;
S XBRP="",XBRC="NODEV1^BGP4DG",XBRX="XIT^BGP4DG",XBNS="BGP"
D ^XBDBQUE
;D XIT
Q
;
NODEV1 ;
D ^BGP4D1
D ^BGP4DP
D ^%ZISC
I BGPEXPT D GS^BGP4UTL
I BGPEXCEL,BGPEXPT D EXCELGS^BGP4UTL
D XIT
Q
OLD ;
S XBRP="PRINT^BGPDP",XBRC="PROC^BGPD1",XBRX="XIT^BGPD",XBNS="BGP"
D ^XBDBQUE
D XIT
Q
;
XIT ;
D ^%ZISC
D EN^XBVK("BGP")
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,DIRUTUT,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 Fiscal Year (FY) for the the report END date.",!,"Use a 4 digit year, e.g. 2004"
S DIR(0)="D^::EP"
S DIR("A")="Enter FY"
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
BGP4DG ; IHS/CMI/LAB - IHS GPRA 04 REPORT DRIVER ;
+1 ;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007
+2 ;
+3 ;
+4 IF $DATA(IOF)
WRITE @IOF
+5 WRITE !!,$$CTR("IHS FY04 GPRA Clinical Performance Indicator Report",80)
INTRO ;
+1 DO XIT
+2 WRITE !!,"This will produce a GPRA Indicator Report for all GPRA indicators for a"
+3 WRITE !,"year period you specify. You will be asked to provide: 1) the"
+4 WRITE !,"reporting period, 2) the baseline period to compare data to, and 3) the ",!,"Community taxonomy to determine which patients will be included."
+5 WRITE !!,"You can choose to export this data to the Area office. If you"
+6 WRITE !,"answer yes at the export prompt, a report will be produced in export format"
+7 WRITE !,"for the Area Office to use in Area aggregated data. Depending on site specific"
+8 WRITE !,"configuration, the export file will either be automatically transmitted "
+9 WRITE !,"directly to the Area or the site will have to send the file manually.",!
+10 DO TAXCHK^BGP4TXCH
TP ;get time period
+1 DO XIT
+2 SET BGPRTYPE=1
SET BGPBEN=1
+3 SET (BGPBD,BGPED,BGPTP)=""
+4 SET DIR(0)="S^1:January 1 - December 31;2:April 1 - March 31;3:July 1 - June 30;4:October 1 - September 30"
SET DIR("A")="Enter the date range for your report"
KILL DA
DO ^DIR
KILL DIR
+5 IF $DATA(DIRUT)
DO XIT
QUIT
+6 SET BGPQTR=Y
+7 DO F
+8 IF BGPPER=""
WRITE !,"Year not entered.",!
GOTO TP
+9 IF BGPQTR=1
SET BGPBD=($EXTRACT(BGPPER,1,3)-1)_"0101"
SET BGPED=($EXTRACT(BGPPER,1,3)-1)_"1231"
+10 IF BGPQTR=2
SET BGPBD=($EXTRACT(BGPPER,1,3)-1)_"0401"
SET BGPED=$EXTRACT(BGPPER,1,3)_"0331"
+11 IF BGPQTR=3
SET BGPBD=($EXTRACT(BGPPER,1,3)-1)_"0701"
SET BGPED=$EXTRACT(BGPPER,1,3)_"0630"
+12 IF BGPQTR=4
SET BGPBD=($EXTRACT(BGPPER,1,3)-1)_"1001"
SET BGPED=$EXTRACT(BGPPER,1,3)_"0930"
+13 IF BGPED>DT
Begin DoDot:1
+14 WRITE !!,"You have selected Current Report period ",$$FMTE^XLFDT(BGPBD)," through ",$$FMTE^XLFDT(BGPED),"."
+15 WRITE !,"The end date of this report is in the future; your data will not be",!,"complete.",!
+16 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
+17 IF $DATA(DIRUT)
SET BGPDO=1
QUIT
+18 IF Y
SET BGPDO=1
QUIT
+19 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 (at least 2 years prior to Current).",!,"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,"Reporting 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 previously created this taxonomy using",!,"QMAN or the Taxonomy Setup option. (see User Manual for more detail).",!
+2 KILL BGPTAX
+3 SET BGPTAXI=""
+4 DO ^XBFMK
+5 KILL DIC
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
KILL DIC
+8 IF Y=-1
QUIT
+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
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 GI
+3 WRITE !,"Your HOME location is defined as: ",$PIECE(^DIC(4,BGPHOME,0),U)," asufac: ",$PIECE(^AUTTLOC(BGPHOME,0),U,10)
GI ;gather all gpra indicators
+1 SET X=0
FOR
SET X=$ORDER(^BGPINDF("GPRA",X))
IF X'=+X
QUIT
SET Y=0
FOR
SET Y=$ORDER(^BGPINDF("GPRA",X,Y))
IF Y'=+Y
QUIT
SET BGPIND(Y)=""
+2 SET BGPINDT="G"
LISTS ;any lists with indicators?
+1 ;W !!
+2 ;K BGPLIST
+3 ;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
+4 ;I $D(DIRUT)!(Y="") G COMM
+5 ;I Y=0 G EXPORT
+6 ;K BGPLIST
+7 ;D EN^BGP4DSL
+8 ;I '$D(BGPLIST) W !!,"No lists selected.",!
+9 ;I $D(BGPLIST) D RT^BGP4DSL I '$D(BGPLIST)!($D(BGPQUIT)) G LISTS ;get report type for each list
EXPORT ;export to area or not?
+1 SET BGPEXPT=""
+2 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Do you wish to export this data to Area"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
GOTO TP
+4 SET BGPEXPT=Y
EISSEX ;
+1 SET BGPEXCEL=1
+2 SET BGPUF=""
+3 IF ^%ZOSF("OS")["PC"!(^%ZOSF("OS")["NT")!($PIECE($GET(^AUTTSITE(1,0)),U,21)=2)
SET BGPUF=$SELECT($PIECE($GET(^AUTTSITE(1,1)),U,2)]"":$PIECE(^AUTTSITE(1,1),U,2),1:"C:\EXPORT")
+4 IF $PIECE(^AUTTSITE(1,0),U,21)=1
SET BGPUF="/usr/spool/uucppublic"
+5 SET BGPNOW=$$NOW^XLFDT()
SET BGPNOW=$$NOW^XLFDT()
SET BGPNOW=$PIECE(BGPNOW,".")_"."_$$RZERO^BGP4UTL($PIECE(BGPNOW,".",2),6)
+6 IF BGPUF=""
IF '$DATA(ZTQUEUED)
WRITE !!,"Cannot continue.....can't find export directory name. EXCEL file",!,"not written."
QUIT
+7 SET BGPFN="GPRAEX"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_$$D^BGP4UTL(BGPBD)_$$D^BGP4UTL(BGPED)_$$D^BGP4UTL(BGPNOW)_"_000001"_".TXT"
SUM ;display summary of this report
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,$$CTR("SUMMARY OF FY 04 GPRA REPORT TO BE GENERATED")
+3 WRITE !!,"The date ranges for this report are:"
+4 WRITE !?5,"Reporting 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 IF BGPHOME
WRITE !,"The HOME location is: ",$PIECE(^DIC(4,BGPHOME,0),U)," ",$PIECE(^AUTTLOC(BGPHOME,0),U,10)
+9 IF 'BGPHOME
WRITE !,"No HOME Location selected."
+10 WRITE !!,"All GPRA indicators will be calculated."
+11 DO PT^BGP4DSL
+12 IF BGPROT=""
GOTO LISTS
ZIS ;call to XBDBQUE
+1 DO REPORT^BGP4UTL
+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 BG04",$PIECE(^AUTTLOC(DUZ(2),0),U,10)_"."_BGPRPT," and will reside",!,"in the ",BGPUF," directory.",!
+6 WRITE !,"Depending on your site configuration, this file may need to be manually",!,"sent to your Area Office.",!
End DoDot:1
+7 IF BGPEXCEL
IF BGPEXPT
Begin DoDot:1
+8 WRITE !,"A file will be created called ",BGPFN,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
End DoDot:1
+9 KILL IOP,%ZIS
IF BGPROT="D"
IF BGPDELT="F"
DO NODEV
DO XIT
QUIT
+10 KILL IOP,%ZIS
WRITE !!
SET %ZIS=$SELECT(BGPDELT'="S":"PQM",1:"PM")
DO ^%ZIS
+11 IF POP
WRITE !,"Report Aborted"
SET DA=BGPRPT
SET DIK="^BGPGPDCF("
DO ^DIK
KILL DIK
DO XIT
QUIT
+12 IF POP
WRITE !,"Report Aborted"
SET DA=BGPRPT
SET DIK="^BGPGPDPF("
DO ^DIK
KILL DIK
DO XIT
QUIT
+13 IF POP
WRITE !,"Report Aborted"
SET DA=BGPRPT
SET DIK="^BGPGPDBF("
DO ^DIK
KILL DIK
DO XIT
QUIT
+14 IF $DATA(IO("Q"))
GOTO TSKMN
DRIVER ;
+1 DO ^BGP4D1
+2 USE IO
+3 DO ^BGP4DP
+4 DO ^%ZISC
+5 IF BGPEXPT
DO GS^BGP4UTL
+6 IF BGPEXCEL
IF BGPEXPT
DO EXCELGS^BGP4UTL
+7 DO XIT
+8 QUIT
+9 ;
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^BGP4DG"
SET ZTDTH=""
SET ZTDESC="GPRA 04 REPORT"
DO ^%ZTLOAD
DO XIT
QUIT
+6 QUIT
+7 ;
NODEV ;
+1 SET XBRP=""
SET XBRC="NODEV1^BGP4DG"
SET XBRX="XIT^BGP4DG"
SET XBNS="BGP"
+2 DO ^XBDBQUE
+3 ;D XIT
+4 QUIT
+5 ;
NODEV1 ;
+1 DO ^BGP4D1
+2 DO ^BGP4DP
+3 DO ^%ZISC
+4 IF BGPEXPT
DO GS^BGP4UTL
+5 IF BGPEXCEL
IF BGPEXPT
DO EXCELGS^BGP4UTL
+6 DO XIT
+7 QUIT
OLD ;
+1 SET XBRP="PRINT^BGPDP"
SET XBRC="PROC^BGPD1"
SET XBRX="XIT^BGPD"
SET XBNS="BGP"
+2 DO ^XBDBQUE
+3 DO XIT
+4 QUIT
+5 ;
XIT ;
+1 DO ^%ZISC
+2 DO EN^XBVK("BGP")
+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,DIRUTUT,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 Fiscal Year (FY) for the the report END date.",!,"Use a 4 digit year, e.g. 2004"
+3 SET DIR(0)="D^::EP"
+4 SET DIR("A")="Enter FY"
+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
