- BGP0DAR9 ; IHS/CMI/LAB - ihs area GPRA 02 Sep 2004 1:11 PM 09 Apr 2010 10:03 AM ;
- ;;10.0;IHS CLINICAL REPORTING;**1**;JUN 18, 2010
- ;
- ;
- 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 & PART Report",80)
- W !!,"This will produce an Area Aggregate National GPRA & PART Report for the"
- W !,"2011 GPRA year using the same performance measure definitions from CRS"
- W !,"Version 10.0."
- W !!
- INTRO ;
- D EXIT
- TP ;
- S BGPAREAA=1
- S BGPRTYPE=1,BGPBEN=1,BGP0RPTH=""
- S X=$O(^BGPCTRL("B",2010,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
- ;ADDED FOR 10 REPORT
- S BGPBD=3100701,BGPED=3110630
- S BGPPBD=3090701,BGPPED=3100630
- S BGPPER=3110000
- S BGPNGR09=1
- G NT ;comment out when testing in TEHR
- W !!,"for testing purposes only, please enter a report year",!
- D F
- I BGPPER="" W !!,"no year entered..bye" D EXIT 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 EXIT 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)
- 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^BGP0ASL
- 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(^BGPGPDCT(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,1:1)
- S BGPUF=$$GETDIR^BGP0UTL2()
- ;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^BGP0UTL($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)_2011063000000000_$$D^BGP0UTL(BGPNOW)_"_"_$$LZERO^BGP0UTL(BGPC,6)_".TXT"
- .S BGPFGNT2="CRSGPRANT2"_$P(^AUTTLOC(DUZ(2),0),U,10)_2011063000000000_$$D^BGP0UTL(BGPNOW)_"_"_$$LZERO^BGP0UTL(BGPC,6)_".TXT"
- .S BGPFDEV1="CRSGPRADEVNT1"_$P(^AUTTLOC(DUZ(2),0),U,10)_2011063000000000_$$D^BGP0UTL(BGPNOW)_"_"_$$LZERO^BGP0UTL(BGPC,6)_".TXT"
- .S BGPFDEV2="CRSGPRADEVNT2"_$P(^AUTTLOC(DUZ(2),0),U,10)_2011063000000000_$$D^BGP0UTL(BGPNOW)_"_"_$$LZERO^BGP0UTL(BGPC,6)_".TXT"
- .;S BGPFGNT3="CRSGPRANT3"_$P(^AUTTLOC(DUZ(2),0),U,10)_2010063000000000_$$D^BGP0UTL(BGPNOW)_"_"_$$LZERO^BGP0UTL(BGPC,6)_".TXT"
- .;S BGPFGNT4="CRSGPRANT4"_$P(^AUTTLOC(DUZ(2),0),U,10)_2010063000000000_$$D^BGP0UTL(BGPNOW)_"_"_$$LZERO^BGP0UTL(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 ",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.",!
- . 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(^BGPINDT("GPRA",1,X)) Q:X'=+X S BGPIND(X)=""
- S BGPINDT="G"
- D PT^BGP0DSL
- 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^BGP0PARP
- I BGPRPTT="A",BGPIFTR=1,BGPEXCEL D GNT1^BGP0UTL
- 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^BGP0DAR",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^BGP0DAR",XBRX="EXIT^BGP0DAR",XBNS="BGP"
- D ^XBDBQUE
- Q
- ;
- NODEV1 ;
- D PRINT^BGP0PARP
- I BGPRPTT="A",BGPIFTR,BGPEXCEL D GNT1^BGP0UTL
- 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. 2009, 2010"
- 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 2010 Area National GPRA & PART Report Clinical Performance Summaries")
- W !!,"This will produce ONLY the clinical performance summaries for the Area "
- W !,"National GPRA & PART Report for the 2010 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
- BGP0DAR9 ; IHS/CMI/LAB - ihs area GPRA 02 Sep 2004 1:11 PM 09 Apr 2010 10:03 AM ;
- +1 ;;10.0;IHS CLINICAL REPORTING;**1**;JUN 18, 2010
- +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 & PART Report",80)
- +7 WRITE !!,"This will produce an Area Aggregate National GPRA & PART Report for the"
- +8 WRITE !,"2011 GPRA year using the same performance measure definitions from CRS"
- +9 WRITE !,"Version 10.0."
- +10 WRITE !!
- INTRO ;
- +1 DO EXIT
- TP ;
- +1 SET BGPAREAA=1
- +2 SET BGPRTYPE=1
- SET BGPBEN=1
- SET BGP0RPTH=""
- +3 SET X=$ORDER(^BGPCTRL("B",2010,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=3
- +9 ;ADDED FOR 10 REPORT
- +10 SET BGPBD=3100701
- SET BGPED=3110630
- +11 SET BGPPBD=3090701
- SET BGPPED=3100630
- +12 SET BGPPER=3110000
- +13 SET BGPNGR09=1
- +14 ;comment out when testing in TEHR
- GOTO NT
- +15 WRITE !!,"for testing purposes only, please enter a report year",!
- +16 DO F
- +17 IF BGPPER=""
- WRITE !!,"no year entered..bye"
- DO EXIT
- QUIT
- +18 SET BGPQTR=3
- +19 SET BGPBD=$EXTRACT(BGPPER,1,3)_"0101"
- SET BGPED=$EXTRACT(BGPPER,1,3)_"1231"
- +20 SET BGPPBD=($EXTRACT(BGPPER,1,3)-1)_"0101"
- SET BGPPED=($EXTRACT(BGPPER,1,3)-1)_"1231"
- +21 WRITE !!,"for testing purposes only, please enter a BASELINE year",!
- +22 DO B
- +23 IF BGPBPER=""
- WRITE !!,"no year entered..bye"
- DO EXIT
- QUIT
- +24 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)
- 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^BGP0ASL
- +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(^BGPGPDCT(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,1:1)
- +2 SET BGPUF=$$GETDIR^BGP0UTL2()
- +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^BGP0UTL($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)_2011063000000000_$$D^BGP0UTL(BGPNOW)_"_"_$$LZERO^BGP0UTL(BGPC,6)_".TXT"
- +10 SET BGPFGNT2="CRSGPRANT2"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_2011063000000000_$$D^BGP0UTL(BGPNOW)_"_"_$$LZERO^BGP0UTL(BGPC,6)_".TXT"
- +11 SET BGPFDEV1="CRSGPRADEVNT1"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_2011063000000000_$$D^BGP0UTL(BGPNOW)_"_"_$$LZERO^BGP0UTL(BGPC,6)_".TXT"
- +12 SET BGPFDEV2="CRSGPRADEVNT2"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_2011063000000000_$$D^BGP0UTL(BGPNOW)_"_"_$$LZERO^BGP0UTL(BGPC,6)_".TXT"
- +13 ;S BGPFGNT3="CRSGPRANT3"_$P(^AUTTLOC(DUZ(2),0),U,10)_2010063000000000_$$D^BGP0UTL(BGPNOW)_"_"_$$LZERO^BGP0UTL(BGPC,6)_".TXT"
- +14 ;S BGPFGNT4="CRSGPRANT4"_$P(^AUTTLOC(DUZ(2),0),U,10)_2010063000000000_$$D^BGP0UTL(BGPNOW)_"_"_$$LZERO^BGP0UTL(BGPC,6)_".TXT"
- +15 QUIT
- End DoDot:1
- +16 SET BGPASUF=$PIECE(^AUTTLOC(DUZ(2),0),U,10)
- +17 IF BGPEXCEL
- Begin DoDot:1
- +18 WRITE !!,"A file will be created called ",BGPFGNT1,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
- +19 WRITE !!,"A file will be created called ",BGPFGNT2,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
- +20 WRITE !!,"A file will be created called ",BGPFDEV1,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
- +21 WRITE !!,"A file will be created called ",BGPFDEV2,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
- +22 SET BGPASUF=$PIECE(^AUTTLOC(DUZ(2),0),U,10)
- End DoDot:1
- +23 DO ^XBFMK
- +24 KILL DIC,DIADD,DLAYGO,DR,DA,DD,X,Y,DINUM
- GI ;gather all gpra measures
- +1 SET X=0
- FOR
- SET X=$ORDER(^BGPINDT("GPRA",1,X))
- IF X'=+X
- QUIT
- SET BGPIND(X)=""
- +2 SET BGPINDT="G"
- +3 DO PT^BGP0DSL
- +4 IF BGPROT=""
- GOTO ASU
- +5 ;
- +6 KILL IOP,%ZIS
- IF BGPROT="D"
- IF BGPDELT="F"
- DO NODEV
- DO EXIT
- QUIT
- +7 KILL IOP,%ZIS
- WRITE !!
- SET %ZIS=$SELECT(BGPDELT'="S":"PQM",1:"PM")
- DO ^%ZIS
- +8 IF POP
- DO EXIT
- QUIT
- +9 IF $DATA(IO("Q"))
- GOTO TSKMN
- DRIVER ;
- +1 USE IO
- +2 DO PRINT^BGP0PARP
- +3 IF BGPRPTT="A"
- IF BGPIFTR=1
- IF BGPEXCEL
- DO GNT1^BGP0UTL
- +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^BGP0DAR"
- 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^BGP0DAR"
- SET XBRX="EXIT^BGP0DAR"
- SET XBNS="BGP"
- +2 DO ^XBDBQUE
- +3 QUIT
- +4 ;
- NODEV1 ;
- +1 DO PRINT^BGP0PARP
- +2 IF BGPRPTT="A"
- IF BGPIFTR
- IF BGPEXCEL
- DO GNT1^BGP0UTL
- +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. 2009, 2010"
- +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 2010 Area National GPRA & PART Report Clinical Performance Summaries")
- +4 WRITE !!,"This will produce ONLY the clinical performance summaries for the Area "
- +5 WRITE !,"National GPRA & PART Report for the 2010 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