BGP1DPP ; IHS/CMI/LAB - IHS GPRA 10 SELECTED REPORT DRIVER ALL PATIENTS 29 Apr 2011 8:36 PM ;
;;11.1;IHS CLINICAL REPORTING SYSTEM;**1**;JUN 27, 2011;Build 106
;
;
W:$D(IOF) @IOF
W !!,$$CTR("2011 Clinical Performance Measure Report (Selected Measures)",80)
W !,$$CTR("Report on all Patients in a User Defined Search Template",80),!!
INTRO ;
D XIT
W !,"This will produce a Performance Measure Report for one or more measures for a",!,"year period you specify. You will be asked to provide: 1) the"
W !,"reporting period and 2) the baseline period to compare data."
W !!,"NOTE: With this option all patients in a user defined search template",!,"will be included in the report. The user population and active clinical user",!,"logic will NOT be applied."
W !,"You can create a search template using Q-MAN, PGEN, VGEN or other",!,"RPMS options.",!
D EOP
D TAXCHK^BGP1XTCH
S X=$$DEMOCHK^BGP1UTL2()
I 'X W !!,"Exiting Report....." D PAUSE^BGP1CL,XIT Q
TEMPLAT ;
D XIT
W !!,"Please enter the search template name. The template will contain a",!,"panel of patients defined by the user.",!
S DIC("S")="I $P(^(0),U,4)=2!($P(^(0),U,4)=9000001)" S DIC="^DIBT(",DIC("A")="Enter SEARCH TEMPLATE name: ",DIC(0)="AEMQ" D ^DIC K DIC,DA,DR,DICR
I Y=-1 G XIT
S BGPSEAT=+Y
;
SETIND ;
S BGPINDB=""
S BGPRTYPE=4,BGP1RPTH="P"
S DIR(0)="S^DM:Diabetes-Related Measures;CVD:Cardiovascular Disease Prevention for At-Risk Patients;WH:Women's Health-Related Measures"
S DIR(0)=DIR(0)_";IPC:Improving Patient Care Measures;PQA:Pharmacy Quality Alliance Measures;SEL:Selected Performance Measures (User Defined)"
S DIR("A")="Which set of Measures should be included in this report" KILL DA D ^DIR KILL DIR
I $D(DIRUT) D XIT Q
S BGPINDB=$E(Y)
I BGPINDB="S" D SI I '$D(BGPIND) G SETIND
GI ;gather all measures
I BGPINDB="D" D DI
I BGPINDB="C" D CI
I BGPINDB="W" D WI
I BGPINDB="E" D EI
I BGPINDB="I" D II
I BGPINDB="P" D PI
I '$D(BGPIND) W !!,"no measures selected" G SETIND
TP ;get time period
S BGPRTYPE=4,BGP1RPTH="P"
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 XIT Q
S BGPQTR=Y
I BGPQTR=5 D ENDDATE^BGP1DGPU
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
S BGPBEN=3
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 SUM
W !,"Your HOME location is defined as: ",$P(^DIC(4,BGPHOME,0),U)," asufac: ",$P(^AUTTLOC(BGPHOME,0),U,10)
I BGPINDB'="S" D LISTS
SUM ;display summary of this report
W:$D(IOF) @IOF
W !,$$CTR("SUMMARY OF 2011 CLINICAL MEASURE PERFORMANCE 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 following search template of patients will be included in ",!,"this report: ",$P(^DIBT(BGPSEAT,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 !!,"These measures will be calculated: " S X=0 F S X=$O(BGPIND(X)) Q:X'=+X W $P(^BGPINDB(X,0),U,3)," ; "
W !!,"Lists will be produced for these measures: "
S X=0 F S X=$O(BGPLIST(X)) Q:X'=+X W $P(^BGPINDB(X,0),U,3)," ; "
D PT^BGP1DSL
I BGPROT="" G LISTS
ZIS ;call to XBDBQUE
D REPORT^BGP1UTL
I $G(BGPQUIT) D XIT Q
I BGPRPT="" D XIT Q
K IOP,%ZIS I BGPROT="D",BGPDELT="F" D NODEV,XIT Q
W !! S %ZIS=$S(BGPDELT'="S":"PQM",1:"PM") D ^%ZIS
ZIS1 ;
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 ^BGP1D10
U IO
D ^BGP1DP
D ^%ZISC
D XIT
Q
;
NODEV1 ;
D ^BGP1D10
D ^BGP1DP
D ^%ZISC
D XIT
Q
DI ;
S X=0 F S X=$O(^BGPINDBC("ADM",1,X)) Q:X'=+X S BGPIND($P(^BGPINDBC(X,0),U,1))=""
Q
CI ;
S X=0 F S X=$O(^BGPINDBC("ACARD",1,X)) Q:X'=+X S BGPIND($P(^BGPINDBC(X,0),U,1))=""
Q
WI ;
S X=0 F S X=$O(^BGPINDBC("AWH",1,X)) Q:X'=+X S BGPIND($P(^BGPINDBC(X,0),U,1))=""
Q
EI ;
S X=0 F S X=$O(^BGPINDBC("AEL",1,X)) Q:X'=+X S BGPIND($P(^BGPINDBC(X,0),U,1))=""
Q
II ;
S X=0 F S X=$O(^BGPINDBC("AIPC",1,X)) Q:X'=+X S BGPIND($P(^BGPINDBC(X,0),U,1))=""
Q
PI ;
S X=0 F S X=$O(^BGPINDBC("APQA",1,X)) Q:X'=+X S BGPIND($P(^BGPINDBC(X,0),U,1))=""
Q
SI ;
K BGPIND
D EN^BGP1DSI
I '$D(BGPIND) Q
D LISTS
Q
LISTS ;any lists with measures?
K BGPLIST
W !!,"PATIENT LISTS"
I '$D(^XUSEC("BGPZ PATIENT LISTS",DUZ)) W !!,"You do not have the security access to print patient lists.",!,"Please see your supervisor or program manager if you feel you should have",!,"the BGPZ PATIENT LISTS security key.",! D Q
.K DIR S DIR(0)="E",DIR("A")="Press enter to continue" D ^DIR K DIR
S DIR(0)="Y",DIR("A")="Do you want patient lists for any of the measures",DIR("B")="N" KILL DA D ^DIR KILL DIR
I $D(DIRUT)!(Y="") Q
I Y=0 Q
K BGPLIST
D EN^BGP1DSL
I '$D(BGPLIST) W !!,"No lists selected.",!
I $D(BGPLIST) D RT^BGP1DSL I '$D(BGPLIST)!($D(BGPQUIT)) G LISTS ;get report type for each list
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^BGP1DPP",ZTDTH="",ZTDESC="GPRA 10 REPORT" D ^%ZTLOAD D XIT Q
Q
;
NODEV ;
S XBRP="",XBRC="NODEV1^BGP1DPP",XBRX="XIT^BGP1DPP",XBNS="BGP"
D ^XBDBQUE
;D XIT
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 ;calendar year
S (BGPPER,BGPVDT)=""
W !!,"Enter the Calendar Year for the report END date. 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
BGP1DPP ; IHS/CMI/LAB - IHS GPRA 10 SELECTED REPORT DRIVER ALL PATIENTS 29 Apr 2011 8:36 PM ;
+1 ;;11.1;IHS CLINICAL REPORTING SYSTEM;**1**;JUN 27, 2011;Build 106
+2 ;
+3 ;
+4 IF $DATA(IOF)
WRITE @IOF
+5 WRITE !!,$$CTR("2011 Clinical Performance Measure Report (Selected Measures)",80)
+6 WRITE !,$$CTR("Report on all Patients in a User Defined Search Template",80),!!
INTRO ;
+1 DO XIT
+2 WRITE !,"This will produce a Performance Measure Report for one or more measures for a",!,"year period you specify. You will be asked to provide: 1) the"
+3 WRITE !,"reporting period and 2) the baseline period to compare data."
+4 WRITE !!,"NOTE: With this option all patients in a user defined search template",!,"will be included in the report. The user population and active clinical user",!,"logic will NOT be applied."
+5 WRITE !,"You can create a search template using Q-MAN, PGEN, VGEN or other",!,"RPMS options.",!
+6 DO EOP
+7 DO TAXCHK^BGP1XTCH
+8 SET X=$$DEMOCHK^BGP1UTL2()
+9 IF 'X
WRITE !!,"Exiting Report....."
DO PAUSE^BGP1CL
DO XIT
QUIT
TEMPLAT ;
+1 DO XIT
+2 WRITE !!,"Please enter the search template name. The template will contain a",!,"panel of patients defined by the user.",!
+3 SET DIC("S")="I $P(^(0),U,4)=2!($P(^(0),U,4)=9000001)"
SET DIC="^DIBT("
SET DIC("A")="Enter SEARCH TEMPLATE name: "
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC,DA,DR,DICR
+4 IF Y=-1
GOTO XIT
+5 SET BGPSEAT=+Y
+6 ;
SETIND ;
+1 SET BGPINDB=""
+2 SET BGPRTYPE=4
SET BGP1RPTH="P"
+3 SET DIR(0)="S^DM:Diabetes-Related Measures;CVD:Cardiovascular Disease Prevention for At-Risk Patients;WH:Women's Health-Related Measures"
+4 SET DIR(0)=DIR(0)_";IPC:Improving Patient Care Measures;PQA:Pharmacy Quality Alliance Measures;SEL:Selected Performance Measures (User Defined)"
+5 SET DIR("A")="Which set of Measures should be included in this report"
KILL DA
DO ^DIR
KILL DIR
+6 IF $DATA(DIRUT)
DO XIT
QUIT
+7 SET BGPINDB=$EXTRACT(Y)
+8 IF BGPINDB="S"
DO SI
IF '$DATA(BGPIND)
GOTO SETIND
GI ;gather all measures
+1 IF BGPINDB="D"
DO DI
+2 IF BGPINDB="C"
DO CI
+3 IF BGPINDB="W"
DO WI
+4 IF BGPINDB="E"
DO EI
+5 IF BGPINDB="I"
DO II
+6 IF BGPINDB="P"
DO PI
+7 IF '$DATA(BGPIND)
WRITE !!,"no measures selected"
GOTO SETIND
TP ;get time period
+1 SET BGPRTYPE=4
SET BGP1RPTH="P"
+2 SET (BGPBD,BGPED,BGPTP)=""
+3 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
+4 IF $DATA(DIRUT)
DO XIT
QUIT
+5 SET BGPQTR=Y
+6 IF BGPQTR=5
DO ENDDATE^BGP1DGPU
+7 IF BGPQTR'=5
DO F
+8 IF BGPPER=""
WRITE !,"Year not entered.",!
GOTO TP
+9 IF BGPQTR=1
SET BGPBD=$EXTRACT(BGPPER,1,3)_"0101"
SET BGPED=$EXTRACT(BGPPER,1,3)_"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 BGPQTR=5
SET BGPBD=$$FMADD^XLFDT(BGPPER,-364)
SET BGPED=BGPPER
SET BGPPER=$EXTRACT(BGPED,1,3)_"0000"
+14 IF BGPED>DT
Begin DoDot:1
+15 WRITE !!,"You have selected Current Report period ",$$FMTE^XLFDT(BGPBD)," through ",$$FMTE^XLFDT(BGPED),"."
+16 WRITE !,"The end date of this report is in the future; your data will not be",!,"complete.",!
+17 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
+18 IF $DATA(DIRUT)
SET BGPDO=1
QUIT
+19 IF Y
SET BGPDO=1
QUIT
+20 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
+21 SET BGPBEN=3
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 SUM
+3 WRITE !,"Your HOME location is defined as: ",$PIECE(^DIC(4,BGPHOME,0),U)," asufac: ",$PIECE(^AUTTLOC(BGPHOME,0),U,10)
+4 IF BGPINDB'="S"
DO LISTS
SUM ;display summary of this report
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,$$CTR("SUMMARY OF 2011 CLINICAL MEASURE PERFORMANCE 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 following search template of patients will be included in ",!,"this report: ",$PIECE(^DIBT(BGPSEAT,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 !!,"These measures will be calculated: "
SET X=0
FOR
SET X=$ORDER(BGPIND(X))
IF X'=+X
QUIT
WRITE $PIECE(^BGPINDB(X,0),U,3)," ; "
+11 WRITE !!,"Lists will be produced for these measures: "
+12 SET X=0
FOR
SET X=$ORDER(BGPLIST(X))
IF X'=+X
QUIT
WRITE $PIECE(^BGPINDB(X,0),U,3)," ; "
+13 DO PT^BGP1DSL
+14 IF BGPROT=""
GOTO LISTS
ZIS ;call to XBDBQUE
+1 DO REPORT^BGP1UTL
+2 IF $GET(BGPQUIT)
DO XIT
QUIT
+3 IF BGPRPT=""
DO XIT
QUIT
+4 KILL IOP,%ZIS
IF BGPROT="D"
IF BGPDELT="F"
DO NODEV
DO XIT
QUIT
+5 WRITE !!
SET %ZIS=$SELECT(BGPDELT'="S":"PQM",1:"PM")
DO ^%ZIS
ZIS1 ;
+1 IF POP
WRITE !,"Report Aborted"
SET DA=BGPRPT
SET DIK="^BGPGPDCB("
DO ^DIK
KILL DIK
DO XIT
QUIT
+2 IF POP
WRITE !,"Report Aborted"
SET DA=BGPRPT
SET DIK="^BGPGPDPB("
DO ^DIK
KILL DIK
DO XIT
QUIT
+3 IF POP
WRITE !,"Report Aborted"
SET DA=BGPRPT
SET DIK="^BGPGPDBB("
DO ^DIK
KILL DIK
DO XIT
QUIT
+4 IF $DATA(IO("Q"))
GOTO TSKMN
DRIVER ;
+1 DO ^BGP1D10
+2 USE IO
+3 DO ^BGP1DP
+4 DO ^%ZISC
+5 DO XIT
+6 QUIT
+7 ;
NODEV1 ;
+1 DO ^BGP1D10
+2 DO ^BGP1DP
+3 DO ^%ZISC
+4 DO XIT
+5 QUIT
DI ;
+1 SET X=0
FOR
SET X=$ORDER(^BGPINDBC("ADM",1,X))
IF X'=+X
QUIT
SET BGPIND($PIECE(^BGPINDBC(X,0),U,1))=""
+2 QUIT
CI ;
+1 SET X=0
FOR
SET X=$ORDER(^BGPINDBC("ACARD",1,X))
IF X'=+X
QUIT
SET BGPIND($PIECE(^BGPINDBC(X,0),U,1))=""
+2 QUIT
WI ;
+1 SET X=0
FOR
SET X=$ORDER(^BGPINDBC("AWH",1,X))
IF X'=+X
QUIT
SET BGPIND($PIECE(^BGPINDBC(X,0),U,1))=""
+2 QUIT
EI ;
+1 SET X=0
FOR
SET X=$ORDER(^BGPINDBC("AEL",1,X))
IF X'=+X
QUIT
SET BGPIND($PIECE(^BGPINDBC(X,0),U,1))=""
+2 QUIT
II ;
+1 SET X=0
FOR
SET X=$ORDER(^BGPINDBC("AIPC",1,X))
IF X'=+X
QUIT
SET BGPIND($PIECE(^BGPINDBC(X,0),U,1))=""
+2 QUIT
PI ;
+1 SET X=0
FOR
SET X=$ORDER(^BGPINDBC("APQA",1,X))
IF X'=+X
QUIT
SET BGPIND($PIECE(^BGPINDBC(X,0),U,1))=""
+2 QUIT
SI ;
+1 KILL BGPIND
+2 DO EN^BGP1DSI
+3 IF '$DATA(BGPIND)
QUIT
+4 DO LISTS
+5 QUIT
LISTS ;any lists with measures?
+1 KILL BGPLIST
+2 WRITE !!,"PATIENT LISTS"
+3 IF '$DATA(^XUSEC("BGPZ PATIENT LISTS",DUZ))
WRITE !!,"You do not have the security access to print patient lists.",!,"Please see your supervisor or program manager if you feel you should have",!,"the BGPZ PATIENT LISTS security key.",!
Begin DoDot:1
+4 KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press enter to continue"
DO ^DIR
KILL DIR
End DoDot:1
QUIT
+5 SET DIR(0)="Y"
SET DIR("A")="Do you want patient lists for any of the measures"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+6 IF $DATA(DIRUT)!(Y="")
QUIT
+7 IF Y=0
QUIT
+8 KILL BGPLIST
+9 DO EN^BGP1DSL
+10 IF '$DATA(BGPLIST)
WRITE !!,"No lists selected.",!
+11 ;get report type for each list
IF $DATA(BGPLIST)
DO RT^BGP1DSL
IF '$DATA(BGPLIST)!($DATA(BGPQUIT))
GOTO LISTS
+12 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^BGP1DPP"
SET ZTDTH=""
SET ZTDESC="GPRA 10 REPORT"
DO ^%ZTLOAD
DO XIT
QUIT
+6 QUIT
+7 ;
NODEV ;
+1 SET XBRP=""
SET XBRC="NODEV1^BGP1DPP"
SET XBRX="XIT^BGP1DPP"
SET XBNS="BGP"
+2 DO ^XBDBQUE
+3 ;D XIT
+4 QUIT
+5 ;
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 ;Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))
+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 ;calendar year
+1 SET (BGPPER,BGPVDT)=""
+2 WRITE !!,"Enter the Calendar Year for the report END date. 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
