BGP7DAR8 ; IHS/CMI/LAB - ihs area GPRA 02 Sep 2004 1:11 PM ; 11 Dec 2007 4:08 PM
;;7.0;IHS CLINICAL REPORTING;**2**;JAN 24, 2007
;
;
W:$D(IOF) @IOF
D TERM^VALM0
W !,$$CTR("IHS 2007 National GPRA Report",80)
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 Report",80)
S X=IORVON_"FOR GPRA YEAR 2008: July 1, 2007 to June 30, 2008"_IORVOFF
W !,$$CTR(X,80)
;
INTRO ;
D EXIT
TP ;
S BGPAREAA=1
S BGPRTYPE=1,BGPBEN=1,BGP7RPTH=""
;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"
;END TEST STUFF
S BGPBD=3070701,BGPED=3080630
S BGPBBD=2990701,BGPBED=3000630
S BGPPBD=3060701,BGPPED=3070630
S BGPPER=3080000,BGPQTR=3
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^BGP7ASL
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(^BGPGPDCA(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=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 BGPEXCEL=1 D
.S BGPNOW=$$NOW^XLFDT() S BGPNOW=$$NOW^XLFDT() S BGPNOW=$P(BGPNOW,".")_"."_$$RZERO^BGP7UTL($P(BGPNOW,".",2),6)
.S BDWC=0,X=0 F S X=$O(BGPSUL(X)) Q:X'=+X S BDWC=BDWC+1
.I BGPUF="" W:'$D(ZTQUEUED) !!,"Cannot continue.....can't find export directory name. EXCEL file",!,"not written." Q
.S BGPFN="CRSNT1"_$P(^AUTTLOC(DUZ(2),0),U,10)_2008063000000000_$$D^BGP7UTL(BGPNOW)_"_"_$$LZERO^BGP7UTL(BDWC,6)_".TXT"
.S BGPFN2="CRSNT2"_$P(^AUTTLOC(DUZ(2),0),U,10)_2008063000000000_$$D^BGP7UTL(BGPNOW)_"_"_$$LZERO^BGP7UTL(BDWC,6)_".TXT"
.S BGPFNEIS="GPRANT1"_$P(^AUTTLOC(DUZ(2),0),U,10)_2008063000000000_$$D^BGP7UTL(BGPNOW)_"_"_$$LZERO^BGP7UTL(BDWC,6)_".TXT"
.Q
S BGPASUF=$P(^AUTTLOC(DUZ(2),0),U,10)
I BGPEXCEL D
.W !!,"A file will be created called ",BGPFN,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
.W !!,"A file will be created called ",BGPFN2,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
.W !!,"A file will be created called ",BGPFNEIS,!,"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(^BGPINDA("GPRA",1,X)) Q:X'=+X S BGPIND(X)=""
S BGPINDT="G"
D PT^BGP7DSL
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^BGP7PARP
I BGPRPTT="A" D EXCELGS^BGP7UTL
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^BGP7DAR",ZTDTH="",ZTDESC="GPRA REPORT" D ^%ZTLOAD D HOME^%ZIS D EXIT Q
Q
;
EXIT ;
D ^%ZISC
D EN^XBVK("BGP")
D KILL^AUPNPAT
D ^XBFMK
Q
;
B ;fiscal year
S (BGPBPER,BGPVDT)=""
W !!,"Enter the BASELINE year for the report. Use a 4 digit ",!,"year, e.g. 2005"
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. 2002, 2005"
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")
;----------
;
NODEV ;
S XBRP="",XBRC="NODEV1^BGP7DAR8",XBRX="EXIT^BGP7DAR",XBNS="BGP"
D ^XBDBQUE
Q
;
NODEV1 ;
D PRINT^BGP7PARP
D ^%ZISC
D EXIT
Q
BGP7DAR8 ; IHS/CMI/LAB - ihs area GPRA 02 Sep 2004 1:11 PM ; 11 Dec 2007 4:08 PM
+1 ;;7.0;IHS CLINICAL REPORTING;**2**;JAN 24, 2007
+2 ;
+3 ;
+4 IF $DATA(IOF)
WRITE @IOF
+5 DO TERM^VALM0
+6 WRITE !,$$CTR("IHS 2007 National GPRA Report",80)
+7 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")
+8 WRITE !!,$$CTR(BGPA_" Area Aggregate National GPRA Report",80)
+9 SET X=IORVON_"FOR GPRA YEAR 2008: July 1, 2007 to June 30, 2008"_IORVOFF
+10 WRITE !,$$CTR(X,80)
+11 ;
INTRO ;
+1 DO EXIT
TP ;
+1 SET BGPAREAA=1
+2 SET BGPRTYPE=1
SET BGPBEN=1
SET BGP7RPTH=""
+3 ;W !!,"for testing purposes only, please enter a report year",!
+4 ;D F
+5 ;I BGPPER="" W !!,"no year entered..bye" D EXIT Q
+6 ;S BGPQTR=3
+7 ;S BGPBD=$E(BGPPER,1,3)_"0101",BGPED=$E(BGPPER,1,3)_"1231"
+8 ;S BGPPBD=($E(BGPPER,1,3)-1)_"0101",BGPPED=($E(BGPPER,1,3)-1)_"1231"
+9 ;W !!,"for testing purposes only, please enter a BASELINE year",!
+10 ;D B
+11 ;I BGPBPER="" W !!,"no year entered..bye" D EXIT Q
+12 ;S BGPBBD=$E(BGPBPER,1,3)_"0101",BGPBED=$E(BGPBPER,1,3)_"1231"
+13 ;END TEST STUFF
+14 SET BGPBD=3070701
SET BGPED=3080630
+15 SET BGPBBD=2990701
SET BGPBED=3000630
+16 SET BGPPBD=3060701
SET BGPPED=3070630
+17 SET BGPPER=3080000
SET BGPQTR=3
+18 WRITE !!,"The date ranges for this report are:"
+19 WRITE !?5,"Report Period: ",?31,$$FMTE^XLFDT(BGPBD)," to ",?31,$$FMTE^XLFDT(BGPED)
+20 WRITE !?5,"Previous Year Period: ",?31,$$FMTE^XLFDT(BGPPBD)," to ",?31,$$FMTE^XLFDT(BGPPED)
+21 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^BGP7ASL
+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(^BGPGPDCA(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=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 BGPEXCEL=1
Begin DoDot:1
+6 SET BGPNOW=$$NOW^XLFDT()
SET BGPNOW=$$NOW^XLFDT()
SET BGPNOW=$PIECE(BGPNOW,".")_"."_$$RZERO^BGP7UTL($PIECE(BGPNOW,".",2),6)
+7 SET BDWC=0
SET X=0
FOR
SET X=$ORDER(BGPSUL(X))
IF X'=+X
QUIT
SET BDWC=BDWC+1
+8 IF BGPUF=""
IF '$DATA(ZTQUEUED)
WRITE !!,"Cannot continue.....can't find export directory name. EXCEL file",!,"not written."
QUIT
+9 SET BGPFN="CRSNT1"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_2008063000000000_$$D^BGP7UTL(BGPNOW)_"_"_$$LZERO^BGP7UTL(BDWC,6)_".TXT"
+10 SET BGPFN2="CRSNT2"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_2008063000000000_$$D^BGP7UTL(BGPNOW)_"_"_$$LZERO^BGP7UTL(BDWC,6)_".TXT"
+11 SET BGPFNEIS="GPRANT1"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_2008063000000000_$$D^BGP7UTL(BGPNOW)_"_"_$$LZERO^BGP7UTL(BDWC,6)_".TXT"
+12 QUIT
End DoDot:1
+13 SET BGPASUF=$PIECE(^AUTTLOC(DUZ(2),0),U,10)
+14 IF BGPEXCEL
Begin DoDot:1
+15 WRITE !!,"A file will be created called ",BGPFN,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
+16 WRITE !!,"A file will be created called ",BGPFN2,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
+17 WRITE !!,"A file will be created called ",BGPFNEIS,!,"and will reside in the ",BGPUF," directory. This file can be used in Excel.",!
End DoDot:1
+18 SET BGPASUF=$PIECE(^AUTTLOC(DUZ(2),0),U,10)
+19 DO ^XBFMK
+20 KILL DIC,DIADD,DLAYGO,DR,DA,DD,X,Y,DINUM
GI ;gather all gpra measures
+1 SET X=0
FOR
SET X=$ORDER(^BGPINDA("GPRA",1,X))
IF X'=+X
QUIT
SET BGPIND(X)=""
+2 SET BGPINDT="G"
+3 DO PT^BGP7DSL
+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^BGP7PARP
+3 IF BGPRPTT="A"
DO EXCELGS^BGP7UTL
+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^BGP7DAR"
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")
+3 DO KILL^AUPNPAT
+4 DO ^XBFMK
+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. 2005"
+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. 2002, 2005"
+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 ;
NODEV ;
+1 SET XBRP=""
SET XBRC="NODEV1^BGP7DAR8"
SET XBRX="EXIT^BGP7DAR"
SET XBNS="BGP"
+2 DO ^XBDBQUE
+3 QUIT
+4 ;
NODEV1 ;
+1 DO PRINT^BGP7PARP
+2 DO ^%ZISC
+3 DO EXIT
+4 QUIT
