BGP8DAR ;IHS/CMI/LAB - GPRA AREA REPORT;
;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
;
;
W:$D(IOF) @IOF
S BGPA=$E($P(^AUTTLOC(DUZ(2),0),U,10),1,2),BGPA=$O(^AUTTAREA("C",BGPA,0)) S BGPA=$S(BGPA:$P(^AUTTAREA(BGPA,0),U),1:"UNKNOWN AREA")
W !!,$$CTR(BGPA_" Area Aggregate National GPRA/GPRAMA Report",80)
INTRO ;
D EXIT
TP ;
S BGPAREAA=1
S BGPRTYPE=1,BGPBEN=1,BGPYRPTH=""
S X=$O(^BGPCTRL("B",2018,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=4
G NT ;comment out when testing in TEHR
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;5:User-Defined Report Period",DIR("A")="Enter the date range for your report" KILL DA D ^DIR KILL DIR
I $D(DIRUT) D EXIT Q
S BGPQTR=Y
I BGPQTR=5 D ENDDATE^BGP8DGPU
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 D
.S D=$$FMADD^XLFDT(BGPPER,1)
.I $E(BGPPER,4,7)'=1231 S BGPBD=($E(BGPPER,1,3)-1)_$E(D,4,7),BGPED=BGPPER,BGPPER=$E(BGPED,1,3)_"0000"
.I $E(BGPPER,4,7)=1231 S BGPBD=$E(BGPPER,1,3)_$E(D,4,7),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)
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)
ASU ;
S BGPSUCNT=0
S BGPRPTT=""
S DIR(0)="S^A:AREA Aggregate;F:One Facility",DIR("A")="Run Report for",DIR("B")="A" KILL DA D ^DIR KILL DIR
G:$D(DIRUT) EXIT
S BGPRPTT=Y
W !!!,"You will now be able to select which sites to use in the",!,"area aggregate/facility report.",!
S DIR(0)="E",DIR("A")="Press Enter to Continue" KILL DA D ^DIR KILL DIR
K BGPSUL
D EN^BGP8ASL
I '$D(BGPSUL) W !!,"No sites selected" D EXIT Q
S X=0,C=0 F S X=$O(BGPSUL(X)) Q:X'=+X S C=C+1
W !!,"A total of ",C," facilities have been selected.",!!
;I C=1 S BGPRPTT="F",BGPSUCNT=1,Y=$O(BGPSUL(0)),X=$P(^BGPGPDCR(Y,0),U,9),X=$O(^AUTTLOC("C",X,0)) I X S BGPSUNM=$P(^DIC(4,X,0),U)
ZIS ;call to XBDBQUE
EISSEX ;
S BGPEXCEL=$S($G(BGPSUMON):0,BGPRPTT="F":0,C<1:0,1:1)
S BGPUF=$$GETDIR^BGP8UTL2()
;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 BGPEXCEL=1 D
.S BGPNOW=$$NOW^XLFDT() S BGPNOW=$$NOW^XLFDT() S BGPNOW=$P(BGPNOW,".")_"."_$$RZERO^BGP8UTL($P(BGPNOW,".",2),6)
.S BGPC=0,X=0 F S X=$O(BGPSUL(X)) Q:X'=+X S BGPC=BGPC+1
.I BGPUF="" W:'$D(ZTQUEUED) !!,"Cannot continue.....can't find export directory name. EXCEL file",!,"not written." Q
.S BGPFGNT1="CRSGPRANT1"_$P(^AUTTLOC(DUZ(2),0),U,10)_2018063000000000_$$D^BGP8UTL(BGPNOW)_"_"_$$LZERO^BGP8UTL(BGPC,6)_".TXT"
.S BGPFGNT2="CRSGPRANT2"_$P(^AUTTLOC(DUZ(2),0),U,10)_2018063000000000_$$D^BGP8UTL(BGPNOW)_"_"_$$LZERO^BGP8UTL(BGPC,6)_".TXT"
.S BGPFDEV1="CRSGPRADEVNT1"_$P(^AUTTLOC(DUZ(2),0),U,10)_2018063000000000_$$D^BGP8UTL(BGPNOW)_"_"_$$LZERO^BGP8UTL(BGPC,6)_".TXT"
.S BGPFDEV2="CRSGPRADEVNT2"_$P(^AUTTLOC(DUZ(2),0),U,10)_2018063000000000_$$D^BGP8UTL(BGPNOW)_"_"_$$LZERO^BGP8UTL(BGPC,6)_".TXT"
.S BGPFDEV3="CRSGPRADEVNT3"_$P(^AUTTLOC(DUZ(2),0),U,10)_2018063000000000_$$D^BGP8UTL(BGPNOW)_"_"_$$LZERO^BGP8UTL(BGPC,6)_".TXT"
.S BGPFDEV4="CRSGPRADEVNT4"_$P(^AUTTLOC(DUZ(2),0),U,10)_2018063000000000_$$D^BGP8UTL(BGPNOW)_"_"_$$LZERO^BGP8UTL(BGPC,6)_".TXT"
.S BGPFGNT3="CRSGPRANT3"_$P(^AUTTLOC(DUZ(2),0),U,10)_2018063000000000_$$D^BGP8UTL(BGPNOW)_"_"_$$LZERO^BGP8UTL(BGPC,6)_".TXT"
.;S BGPFGNT4="CRSGPRANT4"_$P(^AUTTLOC(DUZ(2),0),U,10)_2018063000000000_$$D^BGP8UTL(BGPNOW)_"_"_$$LZERO^BGP8UTL(BGPC,6)_".TXT"
.;S BGPFGNT5="CRSGPRANT5"_$P(^AUTTLOC(DUZ(2),0),U,10)_2018063000000000_$$D^BGP8UTL(BGPNOW)_"_"_$$LZERO^BGP8UTL(BGPC,6)_".TXT"
.;S BGPFGNT6="CRSGPRANT6"_$P(^AUTTLOC(DUZ(2),0),U,10)_2018063000000000_$$D^BGP8UTL(BGPNOW)_"_"_$$LZERO^BGP8UTL(BGPC,6)_".TXT"
.Q
S BGPASUF=$P(^AUTTLOC(DUZ(2),0),U,10)
I BGPEXCEL D
.W !!,"A file will be created called ",BGPFGNT1,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
.W !!,"A file will be created called ",BGPFGNT2,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
.W !!,"A file will be created called ",BGPFGNT3,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
.;W !!,"A file will be created called ",BGPFGNT4,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
.;W !!,"A file will be created called ",BGPFGNT5,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
.;W !!,"A file will be created called ",BGPFGNT6,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
.W !!,"A file will be created called ",BGPFDEV1,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
.W !!,"A file will be created called ",BGPFDEV2,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
.W !!,"A file will be created called ",BGPFDEV3,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
.W !!,"A file will be created called ",BGPFDEV4,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
.S BGPASUF=$P(^AUTTLOC(DUZ(2),0),U,10)
D ^XBFMK
K DIC,DIADD,DLAYGO,DR,DA,DD,X,Y,DINUM
GI ;gather all gpra measures
S X=0 F S X=$O(^BGPINDR("GPRA",1,X)) Q:X'=+X S BGPIND(X)=""
S BGPINDG="G"
D TEXT^BGP8DSL
D PT^BGP8DSL
I $D(DIRUT) G ASU
I BGPROT="" G ASU
;
K IOP,%ZIS I BGPROT="D",BGPDELT="F" D NODEV,EXIT Q
K IOP,%ZIS W !! S %ZIS=$S(BGPDELT'="S":"PQM",1:"PM") D ^%ZIS
I POP D EXIT Q
I $D(IO("Q")) G TSKMN
DRIVER ;
U IO
D PRINT^BGP8PARP
I BGPRPTT="A",BGPIFTR=1,BGPEXCEL D GNT1^BGP8UTL
D ^%ZISC
D EXIT
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^BGP8DAR",ZTDTH="",ZTDESC="GPRA REPORT" D ^%ZTLOAD D HOME^%ZIS D EXIT Q
Q
;
EXIT ;
D ^%ZISC
D EN^XBVK("BGP") I $D(ZTQUEUED) S ZTREQ="@"
D KILL^AUPNPAT
D ^XBFMK
Q
NODEV ;
S XBRP="",XBRC="NODEV1^BGP8DAR",XBRX="EXIT^BGP8DAR",XBNS="BGP"
D ^XBDBQUE
Q
;
NODEV1 ;
D PRINT^BGP8PARP
I BGPRPTT="A",BGPIFTR,BGPEXCEL D GNT1^BGP8UTL
D ^%ZISC
D EXIT
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
F ;fiscal year
S BGPPER=""
W !
S BGPVDT=""
W !,"Enter the Fiscal Year (FY) for the report END date. Use a 4 digit",!,"year, e.g. 2010, 2018"
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
K DIC
I $D(DUOUT) S DIRUT=1 S BGPQUIT="" Q
S BGPVDT=Y
I $E(Y,4,7)'="0000" W !!,"Please enter a year only!",! G F
S BGPPER=BGPVDT,BGPBD=($E(BGPVDT,1,3)-1)_"1001",BGPED=$E(BGPVDT,1,3)_"0930"
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 DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
S DIR(0)="E" D ^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")
;----------
;
SUMONLY ;EP
W:$D(IOF) @IOF
S BGPA=$E($P(^AUTTLOC(DUZ(2),0),U,10),1,2),BGPA=$O(^AUTTAREA("C",BGPA,0)) S BGPA=$S(BGPA:$P(^AUTTAREA(BGPA,0),U),1:"UNKNOWN AREA")
W !,$$CTR("IHS 2018 Area National GPRA/GPRAMA Report Clinical Performance Summaries")
W !!,"This will produce ONLY the clinical performance summaries for the Area "
W !,"National GPRA/GPRAMA Report for the 2018 GPRA year. If you want the detailed "
W !,"information included in the report, including performance measure "
W !,"definitions and number of patients in each denominator and numerator"
W !,"you need to run the AGP menu option."
W !!,"The CRSGPRANT export files will not be created; use the AGP menu option "
W !,"to run the report that will create these files."
W !
K DIR S DIR(0)="E",DIR("A")="PRESS ENTER" D ^DIR K DIR
S BGPSUMON=1
G TP
BGP8DAR ;IHS/CMI/LAB - GPRA AREA REPORT;
+1 ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
+2 ;
+3 ;
+4 IF $DATA(IOF)
WRITE @IOF
+5 SET BGPA=$EXTRACT($PIECE(^AUTTLOC(DUZ(2),0),U,10),1,2)
SET BGPA=$ORDER(^AUTTAREA("C",BGPA,0))
SET BGPA=$SELECT(BGPA:$PIECE(^AUTTAREA(BGPA,0),U),1:"UNKNOWN AREA")
+6 WRITE !!,$$CTR(BGPA_" Area Aggregate National GPRA/GPRAMA Report",80)
INTRO ;
+1 DO EXIT
TP ;
+1 SET BGPAREAA=1
+2 SET BGPRTYPE=1
SET BGPBEN=1
SET BGPYRPTH=""
+3 SET X=$ORDER(^BGPCTRL("B",2018,0))
+4 SET Y=^BGPCTRL(X,0)
+5 SET BGPBD=$PIECE(Y,U,8)
SET BGPED=$PIECE(Y,U,9)
+6 SET BGPPBD=$PIECE(Y,U,10)
SET BGPPED=$PIECE(Y,U,11)
+7 SET BGPBBD=$PIECE(Y,U,12)
SET BGPBED=$PIECE(Y,U,13)
+8 SET BGPPER=$PIECE(Y,U,14)
SET BGPQTR=4
+9 ;comment out when testing in TEHR
GOTO NT
+10 SET (BGPBD,BGPED,BGPTP)=""
+11 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
+12 IF $DATA(DIRUT)
DO EXIT
QUIT
+13 SET BGPQTR=Y
+14 IF BGPQTR=5
DO ENDDATE^BGP8DGPU
+15 IF BGPQTR'=5
DO F
+16 IF BGPPER=""
WRITE !,"Year not entered.",!
GOTO TP
+17 IF BGPQTR=1
SET BGPBD=$EXTRACT(BGPPER,1,3)_"0101"
SET BGPED=$EXTRACT(BGPPER,1,3)_"1231"
+18 IF BGPQTR=2
SET BGPBD=($EXTRACT(BGPPER,1,3)-1)_"0401"
SET BGPED=$EXTRACT(BGPPER,1,3)_"0331"
+19 IF BGPQTR=3
SET BGPBD=($EXTRACT(BGPPER,1,3)-1)_"0701"
SET BGPED=$EXTRACT(BGPPER,1,3)_"0630"
+20 IF BGPQTR=4
SET BGPBD=($EXTRACT(BGPPER,1,3)-1)_"1001"
SET BGPED=$EXTRACT(BGPPER,1,3)_"0930"
+21 IF BGPQTR=5
Begin DoDot:1
+22 SET D=$$FMADD^XLFDT(BGPPER,1)
+23 IF $EXTRACT(BGPPER,4,7)'=1231
SET BGPBD=($EXTRACT(BGPPER,1,3)-1)_$EXTRACT(D,4,7)
SET BGPED=BGPPER
SET BGPPER=$EXTRACT(BGPED,1,3)_"0000"
+24 IF $EXTRACT(BGPPER,4,7)=1231
SET BGPBD=$EXTRACT(BGPPER,1,3)_$EXTRACT(D,4,7)
SET BGPED=BGPPER
SET BGPPER=$EXTRACT(BGPED,1,3)_"0000"
End DoDot:1
+25 IF BGPED>DT
Begin DoDot:1
+26 WRITE !!,"You have selected Current Report period ",$$FMTE^XLFDT(BGPBD)," through ",$$FMTE^XLFDT(BGPED),"."
+27 WRITE !,"The end date of this report is in the future; your data will not be",!,"complete.",!
+28 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
+29 IF $DATA(DIRUT)
SET BGPDO=1
QUIT
+30 IF Y
SET BGPDO=1
QUIT
+31 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)
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)
ASU ;
+1 SET BGPSUCNT=0
+2 SET BGPRPTT=""
+3 SET DIR(0)="S^A:AREA Aggregate;F:One Facility"
SET DIR("A")="Run Report for"
SET DIR("B")="A"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
GOTO EXIT
+5 SET BGPRPTT=Y
+6 WRITE !!!,"You will now be able to select which sites to use in the",!,"area aggregate/facility report.",!
+7 SET DIR(0)="E"
SET DIR("A")="Press Enter to Continue"
KILL DA
DO ^DIR
KILL DIR
+8 KILL BGPSUL
+9 DO EN^BGP8ASL
+10 IF '$DATA(BGPSUL)
WRITE !!,"No sites selected"
DO EXIT
QUIT
+11 SET X=0
SET C=0
FOR
SET X=$ORDER(BGPSUL(X))
IF X'=+X
QUIT
SET C=C+1
+12 WRITE !!,"A total of ",C," facilities have been selected.",!!
+13 ;I C=1 S BGPRPTT="F",BGPSUCNT=1,Y=$O(BGPSUL(0)),X=$P(^BGPGPDCR(Y,0),U,9),X=$O(^AUTTLOC("C",X,0)) I X S BGPSUNM=$P(^DIC(4,X,0),U)
ZIS ;call to XBDBQUE
EISSEX ;
+1 SET BGPEXCEL=$SELECT($GET(BGPSUMON):0,BGPRPTT="F":0,C<1:0,1:1)
+2 SET BGPUF=$$GETDIR^BGP8UTL2()
+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 BGPEXCEL=1
Begin DoDot:1
+6 SET BGPNOW=$$NOW^XLFDT()
SET BGPNOW=$$NOW^XLFDT()
SET BGPNOW=$PIECE(BGPNOW,".")_"."_$$RZERO^BGP8UTL($PIECE(BGPNOW,".",2),6)
+7 SET BGPC=0
SET X=0
FOR
SET X=$ORDER(BGPSUL(X))
IF X'=+X
QUIT
SET BGPC=BGPC+1
+8 IF BGPUF=""
IF '$DATA(ZTQUEUED)
WRITE !!,"Cannot continue.....can't find export directory name. EXCEL file",!,"not written."
QUIT
+9 SET BGPFGNT1="CRSGPRANT1"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_2018063000000000_$$D^BGP8UTL(BGPNOW)_"_"_$$LZERO^BGP8UTL(BGPC,6)_".TXT"
+10 SET BGPFGNT2="CRSGPRANT2"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_2018063000000000_$$D^BGP8UTL(BGPNOW)_"_"_$$LZERO^BGP8UTL(BGPC,6)_".TXT"
+11 SET BGPFDEV1="CRSGPRADEVNT1"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_2018063000000000_$$D^BGP8UTL(BGPNOW)_"_"_$$LZERO^BGP8UTL(BGPC,6)_".TXT"
+12 SET BGPFDEV2="CRSGPRADEVNT2"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_2018063000000000_$$D^BGP8UTL(BGPNOW)_"_"_$$LZERO^BGP8UTL(BGPC,6)_".TXT"
+13 SET BGPFDEV3="CRSGPRADEVNT3"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_2018063000000000_$$D^BGP8UTL(BGPNOW)_"_"_$$LZERO^BGP8UTL(BGPC,6)_".TXT"
+14 SET BGPFDEV4="CRSGPRADEVNT4"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_2018063000000000_$$D^BGP8UTL(BGPNOW)_"_"_$$LZERO^BGP8UTL(BGPC,6)_".TXT"
+15 SET BGPFGNT3="CRSGPRANT3"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_2018063000000000_$$D^BGP8UTL(BGPNOW)_"_"_$$LZERO^BGP8UTL(BGPC,6)_".TXT"
+16 ;S BGPFGNT4="CRSGPRANT4"_$P(^AUTTLOC(DUZ(2),0),U,10)_2018063000000000_$$D^BGP8UTL(BGPNOW)_"_"_$$LZERO^BGP8UTL(BGPC,6)_".TXT"
+17 ;S BGPFGNT5="CRSGPRANT5"_$P(^AUTTLOC(DUZ(2),0),U,10)_2018063000000000_$$D^BGP8UTL(BGPNOW)_"_"_$$LZERO^BGP8UTL(BGPC,6)_".TXT"
+18 ;S BGPFGNT6="CRSGPRANT6"_$P(^AUTTLOC(DUZ(2),0),U,10)_2018063000000000_$$D^BGP8UTL(BGPNOW)_"_"_$$LZERO^BGP8UTL(BGPC,6)_".TXT"
+19 QUIT
End DoDot:1
+20 SET BGPASUF=$PIECE(^AUTTLOC(DUZ(2),0),U,10)
+21 IF BGPEXCEL
Begin DoDot:1
+22 WRITE !!,"A file will be created called ",BGPFGNT1,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
+23 WRITE !!,"A file will be created called ",BGPFGNT2,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
+24 WRITE !!,"A file will be created called ",BGPFGNT3,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
+25 ;W !!,"A file will be created called ",BGPFGNT4,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
+26 ;W !!,"A file will be created called ",BGPFGNT5,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
+27 ;W !!,"A file will be created called ",BGPFGNT6,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
+28 WRITE !!,"A file will be created called ",BGPFDEV1,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
+29 WRITE !!,"A file will be created called ",BGPFDEV2,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
+30 WRITE !!,"A file will be created called ",BGPFDEV3,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
+31 WRITE !!,"A file will be created called ",BGPFDEV4,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
+32 SET BGPASUF=$PIECE(^AUTTLOC(DUZ(2),0),U,10)
End DoDot:1
+33 DO ^XBFMK
+34 KILL DIC,DIADD,DLAYGO,DR,DA,DD,X,Y,DINUM
GI ;gather all gpra measures
+1 SET X=0
FOR
SET X=$ORDER(^BGPINDR("GPRA",1,X))
IF X'=+X
QUIT
SET BGPIND(X)=""
+2 SET BGPINDG="G"
+3 DO TEXT^BGP8DSL
+4 DO PT^BGP8DSL
+5 IF $DATA(DIRUT)
GOTO ASU
+6 IF BGPROT=""
GOTO ASU
+7 ;
+8 KILL IOP,%ZIS
IF BGPROT="D"
IF BGPDELT="F"
DO NODEV
DO EXIT
QUIT
+9 KILL IOP,%ZIS
WRITE !!
SET %ZIS=$SELECT(BGPDELT'="S":"PQM",1:"PM")
DO ^%ZIS
+10 IF POP
DO EXIT
QUIT
+11 IF $DATA(IO("Q"))
GOTO TSKMN
DRIVER ;
+1 USE IO
+2 DO PRINT^BGP8PARP
+3 IF BGPRPTT="A"
IF BGPIFTR=1
IF BGPEXCEL
DO GNT1^BGP8UTL
+4 DO ^%ZISC
+5 DO EXIT
+6 QUIT
+7 ;
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^BGP8DAR"
SET ZTDTH=""
SET ZTDESC="GPRA REPORT"
DO ^%ZTLOAD
DO HOME^%ZIS
DO EXIT
QUIT
+6 QUIT
+7 ;
EXIT ;
+1 DO ^%ZISC
+2 DO EN^XBVK("BGP")
IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 DO KILL^AUPNPAT
+4 DO ^XBFMK
+5 QUIT
NODEV ;
+1 SET XBRP=""
SET XBRC="NODEV1^BGP8DAR"
SET XBRX="EXIT^BGP8DAR"
SET XBNS="BGP"
+2 DO ^XBDBQUE
+3 QUIT
+4 ;
NODEV1 ;
+1 DO PRINT^BGP8PARP
+2 IF BGPRPTT="A"
IF BGPIFTR
IF BGPEXCEL
DO GNT1^BGP8UTL
+3 DO ^%ZISC
+4 DO EXIT
+5 QUIT
+6 ;
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
F ;fiscal year
+1 SET BGPPER=""
+2 WRITE !
+3 SET BGPVDT=""
+4 WRITE !,"Enter the Fiscal Year (FY) for the report END date. Use a 4 digit",!,"year, e.g. 2010, 2018"
+5 SET DIR(0)="D^::EP"
+6 SET DIR("A")="Enter FY"
+7 SET DIR("?")="This report is compiled for a period. Enter a valid date."
+8 DO ^DIR
+9 KILL DIC
+10 IF $DATA(DUOUT)
SET DIRUT=1
SET BGPQUIT=""
QUIT
+11 SET BGPVDT=Y
+12 IF $EXTRACT(Y,4,7)'="0000"
WRITE !!,"Please enter a year only!",!
GOTO F
+13 SET BGPPER=BGPVDT
SET BGPBD=($EXTRACT(BGPVDT,1,3)-1)_"1001"
SET BGPED=$EXTRACT(BGPVDT,1,3)_"0930"
+14 QUIT
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 DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
+5 SET DIR(0)="E"
DO ^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 ;
SUMONLY ;EP
+1 IF $DATA(IOF)
WRITE @IOF
+2 SET BGPA=$EXTRACT($PIECE(^AUTTLOC(DUZ(2),0),U,10),1,2)
SET BGPA=$ORDER(^AUTTAREA("C",BGPA,0))
SET BGPA=$SELECT(BGPA:$PIECE(^AUTTAREA(BGPA,0),U),1:"UNKNOWN AREA")
+3 WRITE !,$$CTR("IHS 2018 Area National GPRA/GPRAMA Report Clinical Performance Summaries")
+4 WRITE !!,"This will produce ONLY the clinical performance summaries for the Area "
+5 WRITE !,"National GPRA/GPRAMA Report for the 2018 GPRA year. If you want the detailed "
+6 WRITE !,"information included in the report, including performance measure "
+7 WRITE !,"definitions and number of patients in each denominator and numerator"
+8 WRITE !,"you need to run the AGP menu option."
+9 WRITE !!,"The CRSGPRANT export files will not be created; use the AGP menu option "
+10 WRITE !,"to run the report that will create these files."
+11 WRITE !
+12 KILL DIR
SET DIR(0)="E"
SET DIR("A")="PRESS ENTER"
DO ^DIR
KILL DIR
+13 SET BGPSUMON=1
+14 GOTO TP
