BGP7DPE ; IHS/CMI/LAB - IHS GPRA 16 REPORT DRIVER 01 Feb 2017 12:11 PM ;
;;17.1;IHS CLINICAL REPORTING;;MAY 10, 2017;Build 29
;
;
W:$D(IOF) @IOF
;W !,$$CTR("IHS 2017 Patient Education w/Community Specified Report",80),!!
INTRO ;
D XIT
INTRO1 ;
S BGPCTRL=$O(^BGPCTRL("B",2017,0))
S Y=$S($G(BGPEDPP):74,1:61)
S X=0 F S X=$O(^BGPCTRL(BGPCTRL,Y,X)) Q:X'=+X W !,^BGPCTRL(BGPCTRL,Y,X,0)
K DIR S DIR(0)="E",DIR("A")="PRESS ENTER" D ^DIR K DIR
S BGPRTYPE=6
S X=$$DEMOCHK^BGP7UTL2()
I 'X W !!,"Exiting Report....." D PAUSE^BGP7DU,XIT Q
I '$G(BGPEDPP) G MSR
ST ;get search template
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 D XIT Q
S BGPSEAT=+Y,BGPPEEXP=0
;
MSR ;BEGIN TEST STUFF
K DIR
S DIR(0)="S^S:Selected set of Measures;A:All Measures",DIR("A")="Run the report on",DIR("B")="S" KILL DA D ^DIR KILL DIR
I $D(DIRUT) D XIT Q
S BGPZZ=Y
I BGPZZ="S" D EN^BGP7PESI I '$D(BGPIND) W !!,"No measures selected" G INTRO
I BGPZZ="A" S X=0 F S X=$O(^BGPPEIG(X)) Q:X'=+X S BGPIND(X)=""
TP ;get time period
S BGPRTYPE=6
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 date range",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 GETDATES
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 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)
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
COMM ;
I $G(BGPEDPP) G C
W !!,"Specify the community taxonomy to determine which patients will be",!,"included in the report. You should have created this taxonomy using QMAN.",!
K BGPTAX
S BGPTAXI=""
D ^XBFMK
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
I X="^" G INTRO
I Y=-1 G INTRO
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
S X=0,G=0
F S X=$O(^ATXAX(BGPTAXI,21,X)) Q:'X D
.S C=$P(^ATXAX(BGPTAXI,21,X,0),U)
.I '$D(^AUTTCOM("B",C)) W !!,"*** Warning: Community ",C," is in the taxonomy but was not",!,"found in the standard community table." S G=1
.Q
I G D I BGPQUIT D XIT Q
.W !!,"These communities may have been renamed or there may be patients"
.W !,"who have been reassigned from this community to a new community and this"
.W !,"could reduce your patient population."
.S BGPQUIT=0
.S DIR(0)="Y",DIR("A")="Do you want to cancel the report and review the communities" KILL DA D ^DIR KILL DIR
.I $D(DIRUT) S BGPQUIT=1
.I Y S BGPQUIT=1
.Q
C K BGPQUIT
D LISTS
BEN ;
I $G(BGPEDPP) S BGPBEN=3,BGPPEEXP=0 G SUM
S BGPBEN=""
S DIR(0)="S^1:Indian/Alaskan Native (Classification 01);2:Not Indian Alaskan/Native (Not Classification 01);3:All (both Indian/Alaskan Natives and Non 01)",DIR("A")="Select Beneficiary Population to include in this report"
S DIR("B")="1" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G COMM
S BGPBEN=Y
EXPORT ;export to area or not?
S BGPPEEXP="" I BGPZZ'="A" G SUM
I BGPZZ="A" S DIR(0)="Y",DIR("A")="Do you wish to export this patient education data to Area" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G BEN
S BGPPEEXP=Y
SUM ;display summary of this report
S BGPUF=$$GETDIR^BGP7UTL2()
I BGPPEEXP,BGPUF="" W:'$D(ZTQUEUED) !!,"Cannot continue.....can't find export directory name. EXCEL file",!,"not written." D PAUSE^BGP7DU,XIT Q
W:$D(IOF) @IOF
W !,$$CTR("SUMMARY OF IHS 2017 PATIENT EDUCATION 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)
I '$G(BGPEDPP) W !!,"The COMMUNITY Taxonomy to be used is: ",$P(^ATXAX(BGPTAXI,0),U)
I $G(BGPSEAT) W !!,"The Patient Panel Population: ",$P(^DIBT(BGPSEAT,0),U)
D TEXT^BGP7DSL
I $D(DIRUT) G BEN
D PT^BGP7PESL
I BGPROT="" G:$G(BGPSEAT) TP G:'$G(BGPSEAT) BEN
ZIS ;call to XBDBQUE
D REPORT^BGP7PUTL
I $G(BGPQUIT) D XIT Q
I BGPRPT="" D XIT Q
I BGPPEEXP D
.W !!,"A file will be created called BG171",$P(^AUTTLOC(DUZ(2),0),U,10)_".PED"_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.",!
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="^BGPPEDCG(" D ^DIK K DIK D XIT Q
I POP W !,"Report Aborted" S DA=BGPRPT,DIK="^BGPPEDPG(" D ^DIK K DIK D XIT Q
I POP W !,"Report Aborted" S DA=BGPRPT,DIK="^BGPPEDBG(" D ^DIK K DIK D XIT Q
I $D(IO("Q")) G TSKMN
DRIVER ;
D ^BGP7DPE1
U IO
D ^BGP7DPEP
D ^%ZISC
I BGPPEEXP D GS^BGP7PUTL
D XIT
Q
;
NODEV ;
S XBRP="",XBRC="NODEV1^BGP7DPE",XBRX="XIT^BGP7DPE",XBNS="BGP"
D ^XBDBQUE
Q
;
NODEV1 ;
D ^BGP7DPE1
D ^BGP7DPEP
D ^%ZISC
I BGPPEEXP D GS^BGP7PUTL
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^BGP7DPE",ZTDTH="",ZTDESC="PAT ED 09 REPORT" D ^%ZTLOAD D XIT Q
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")
;----------
;
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^BGP7PESL
I '$D(BGPLIST) W !!,"No lists selected.",!
I $D(BGPLIST) D RT^BGP7PESL I '$D(BGPLIST)!($D(BGPQUIT)) G LISTS
Q
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 Calendar Year for the report END date. Use a 4 digit",!,"year, e.g. 2017"
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
GETDATES ;EP
W !!,"When entering dates, if you do not enter a full 4 digit year (e.g. 2017)"
W !,"will assume a year in the past, if you want to put in a future date,"
W !,"remember to enter the full 4 digit year. For example, if today is"
W !,"January 4, 2010 and you type in 6/30/05 the system will assume the year"
W !,"as 1905 since that is a date in the past. You must type 6/30/2010 if you"
W !,"want a date in the future."
S (BGPPER,BGPVDT)=""
BD ;get beginning date
W ! S DIR(0)="D^:DT:EP",DIR("A")="Enter beginning Visit Date" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) Q
S BGPBD=Y
ED ;get ending date
W ! S DIR(0)="D^"_BGPBD_":DT:EP",DIR("A")="Enter ending Visit Date" S Y=BGPBD D DD^%DT D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) G BD
S BGPED=Y
S (BGPPER,BGPVDT)=Y
Q
PP ;EP - PP REPORT
D XIT
S BGPEDPP=1
G INTRO1
BGP7DPE ; IHS/CMI/LAB - IHS GPRA 16 REPORT DRIVER 01 Feb 2017 12:11 PM ;
+1 ;;17.1;IHS CLINICAL REPORTING;;MAY 10, 2017;Build 29
+2 ;
+3 ;
+4 IF $DATA(IOF)
WRITE @IOF
+5 ;W !,$$CTR("IHS 2017 Patient Education w/Community Specified Report",80),!!
INTRO ;
+1 DO XIT
INTRO1 ;
+1 SET BGPCTRL=$ORDER(^BGPCTRL("B",2017,0))
+2 SET Y=$SELECT($GET(BGPEDPP):74,1:61)
+3 SET X=0
FOR
SET X=$ORDER(^BGPCTRL(BGPCTRL,Y,X))
IF X'=+X
QUIT
WRITE !,^BGPCTRL(BGPCTRL,Y,X,0)
+4 KILL DIR
SET DIR(0)="E"
SET DIR("A")="PRESS ENTER"
DO ^DIR
KILL DIR
+5 SET BGPRTYPE=6
+6 SET X=$$DEMOCHK^BGP7UTL2()
+7 IF 'X
WRITE !!,"Exiting Report....."
DO PAUSE^BGP7DU
DO XIT
QUIT
+8 IF '$GET(BGPEDPP)
GOTO MSR
ST ;get search template
+1 WRITE !!,"Please enter the search template name. The template will contain a",!,"panel of patients defined by the user.",!
+2 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
+3 IF Y=-1
DO XIT
QUIT
+4 SET BGPSEAT=+Y
SET BGPPEEXP=0
+5 ;
MSR ;BEGIN TEST STUFF
+1 KILL DIR
+2 SET DIR(0)="S^S:Selected set of Measures;A:All Measures"
SET DIR("A")="Run the report on"
SET DIR("B")="S"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
DO XIT
QUIT
+4 SET BGPZZ=Y
+5 IF BGPZZ="S"
DO EN^BGP7PESI
IF '$DATA(BGPIND)
WRITE !!,"No measures selected"
GOTO INTRO
+6 IF BGPZZ="A"
SET X=0
FOR
SET X=$ORDER(^BGPPEIG(X))
IF X'=+X
QUIT
SET BGPIND(X)=""
TP ;get time period
+1 SET BGPRTYPE=6
+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 date range"
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 GETDATES
+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 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. 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)
+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
COMM ;
+1 IF $GET(BGPEDPP)
GOTO C
+2 WRITE !!,"Specify the community taxonomy to determine which patients will be",!,"included in the report. You should have created this taxonomy using QMAN.",!
+3 KILL BGPTAX
+4 SET BGPTAXI=""
+5 DO ^XBFMK
+6 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: "
+7 SET B=$PIECE($GET(^BGPSITE(DUZ(2),0)),U,5)
IF B
SET DIC("B")=$PIECE(^ATXAX(B,0),U)
+8 DO ^DIC
+9 IF X="^"
GOTO INTRO
+10 IF Y=-1
GOTO INTRO
+11 SET BGPTAXI=+Y
COM1 ;
+1 SET X=0
+2 FOR
SET X=$ORDER(^ATXAX(BGPTAXI,21,X))
IF 'X
QUIT
Begin DoDot:1
+3 SET BGPTAX($PIECE(^ATXAX(BGPTAXI,21,X,0),U))=""
+4 QUIT
End DoDot:1
+5 IF '$DATA(BGPTAX)
WRITE !!,"There are no communities in that taxonomy."
GOTO COMM
+6 SET X=0
SET G=0
+7 FOR
SET X=$ORDER(^ATXAX(BGPTAXI,21,X))
IF 'X
QUIT
Begin DoDot:1
+8 SET C=$PIECE(^ATXAX(BGPTAXI,21,X,0),U)
+9 IF '$DATA(^AUTTCOM("B",C))
WRITE !!,"*** Warning: Community ",C," is in the taxonomy but was not",!,"found in the standard community table."
SET G=1
+10 QUIT
End DoDot:1
+11 IF G
Begin DoDot:1
+12 WRITE !!,"These communities may have been renamed or there may be patients"
+13 WRITE !,"who have been reassigned from this community to a new community and this"
+14 WRITE !,"could reduce your patient population."
+15 SET BGPQUIT=0
+16 SET DIR(0)="Y"
SET DIR("A")="Do you want to cancel the report and review the communities"
KILL DA
DO ^DIR
KILL DIR
+17 IF $DATA(DIRUT)
SET BGPQUIT=1
+18 IF Y
SET BGPQUIT=1
+19 QUIT
End DoDot:1
IF BGPQUIT
DO XIT
QUIT
C KILL BGPQUIT
+1 DO LISTS
BEN ;
+1 IF $GET(BGPEDPP)
SET BGPBEN=3
SET BGPPEEXP=0
GOTO SUM
+2 SET BGPBEN=""
+3 SET DIR(0)="S^1:Indian/Alaskan Native (Classification 01);2:Not Indian Alaskan/Native (Not Classification 01);3:All (both Indian/Alaskan Natives and Non 01)"
SET DIR("A")="Select Beneficiary Population to include in this report"
+4 SET DIR("B")="1"
KILL DA
DO ^DIR
KILL DIR
+5 IF $DATA(DIRUT)
GOTO COMM
+6 SET BGPBEN=Y
EXPORT ;export to area or not?
+1 SET BGPPEEXP=""
IF BGPZZ'="A"
GOTO SUM
+2 IF BGPZZ="A"
SET DIR(0)="Y"
SET DIR("A")="Do you wish to export this patient education data to Area"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
GOTO BEN
+4 SET BGPPEEXP=Y
SUM ;display summary of this report
+1 SET BGPUF=$$GETDIR^BGP7UTL2()
+2 IF BGPPEEXP
IF BGPUF=""
IF '$DATA(ZTQUEUED)
WRITE !!,"Cannot continue.....can't find export directory name. EXCEL file",!,"not written."
DO PAUSE^BGP7DU
DO XIT
QUIT
+3 IF $DATA(IOF)
WRITE @IOF
+4 WRITE !,$$CTR("SUMMARY OF IHS 2017 PATIENT EDUCATION REPORT TO BE GENERATED")
+5 WRITE !!,"The date ranges for this report are:"
+6 WRITE !?5,"Report Period: ",?31,$$FMTE^XLFDT(BGPBD)," to ",?31,$$FMTE^XLFDT(BGPED)
+7 WRITE !?5,"Previous Year Period: ",?31,$$FMTE^XLFDT(BGPPBD)," to ",?31,$$FMTE^XLFDT(BGPPED)
+8 WRITE !?5,"Baseline Period: ",?31,$$FMTE^XLFDT(BGPBBD)," to ",?31,$$FMTE^XLFDT(BGPBED)
+9 IF '$GET(BGPEDPP)
WRITE !!,"The COMMUNITY Taxonomy to be used is: ",$PIECE(^ATXAX(BGPTAXI,0),U)
+10 IF $GET(BGPSEAT)
WRITE !!,"The Patient Panel Population: ",$PIECE(^DIBT(BGPSEAT,0),U)
+11 DO TEXT^BGP7DSL
+12 IF $DATA(DIRUT)
GOTO BEN
+13 DO PT^BGP7PESL
+14 IF BGPROT=""
IF $GET(BGPSEAT)
GOTO TP
IF '$GET(BGPSEAT)
GOTO BEN
ZIS ;call to XBDBQUE
+1 DO REPORT^BGP7PUTL
+2 IF $GET(BGPQUIT)
DO XIT
QUIT
+3 IF BGPRPT=""
DO XIT
QUIT
+4 IF BGPPEEXP
Begin DoDot:1
+5 WRITE !!,"A file will be created called BG171",$PIECE(^AUTTLOC(DUZ(2),0),U,10)_".PED"_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 KILL IOP,%ZIS
IF BGPROT="D"
IF BGPDELT="F"
DO NODEV
DO XIT
QUIT
+8 KILL IOP,%ZIS
WRITE !!
SET %ZIS=$SELECT(BGPDELT'="S":"PQM",1:"PM")
DO ^%ZIS
+9 IF POP
WRITE !,"Report Aborted"
SET DA=BGPRPT
SET DIK="^BGPPEDCG("
DO ^DIK
KILL DIK
DO XIT
QUIT
+10 IF POP
WRITE !,"Report Aborted"
SET DA=BGPRPT
SET DIK="^BGPPEDPG("
DO ^DIK
KILL DIK
DO XIT
QUIT
+11 IF POP
WRITE !,"Report Aborted"
SET DA=BGPRPT
SET DIK="^BGPPEDBG("
DO ^DIK
KILL DIK
DO XIT
QUIT
+12 IF $DATA(IO("Q"))
GOTO TSKMN
DRIVER ;
+1 DO ^BGP7DPE1
+2 USE IO
+3 DO ^BGP7DPEP
+4 DO ^%ZISC
+5 IF BGPPEEXP
DO GS^BGP7PUTL
+6 DO XIT
+7 QUIT
+8 ;
NODEV ;
+1 SET XBRP=""
SET XBRC="NODEV1^BGP7DPE"
SET XBRX="XIT^BGP7DPE"
SET XBNS="BGP"
+2 DO ^XBDBQUE
+3 QUIT
+4 ;
NODEV1 ;
+1 DO ^BGP7DPE1
+2 DO ^BGP7DPEP
+3 DO ^%ZISC
+4 IF BGPPEEXP
DO GS^BGP7PUTL
+5 DO XIT
+6 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^BGP7DPE"
SET ZTDTH=""
SET ZTDESC="PAT ED 09 REPORT"
DO ^%ZTLOAD
DO XIT
QUIT
+6 QUIT
+7 ;
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 IF $DATA(ZTQUEUED)!'(IOT="TRM")!$DATA(IO("S"))
QUIT
+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 ;
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^BGP7PESL
+10 IF '$DATA(BGPLIST)
WRITE !!,"No lists selected.",!
+11 IF $DATA(BGPLIST)
DO RT^BGP7PESL
IF '$DATA(BGPLIST)!($DATA(BGPQUIT))
GOTO LISTS
+12 QUIT
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 Calendar Year for the report END date. Use a 4 digit",!,"year, e.g. 2017"
+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
GETDATES ;EP
+1 WRITE !!,"When entering dates, if you do not enter a full 4 digit year (e.g. 2017)"
+2 WRITE !,"will assume a year in the past, if you want to put in a future date,"
+3 WRITE !,"remember to enter the full 4 digit year. For example, if today is"
+4 WRITE !,"January 4, 2010 and you type in 6/30/05 the system will assume the year"
+5 WRITE !,"as 1905 since that is a date in the past. You must type 6/30/2010 if you"
+6 WRITE !,"want a date in the future."
+7 SET (BGPPER,BGPVDT)=""
BD ;get beginning date
+1 WRITE !
SET DIR(0)="D^:DT:EP"
SET DIR("A")="Enter beginning Visit Date"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
QUIT
+3 SET BGPBD=Y
ED ;get ending date
+1 WRITE !
SET DIR(0)="D^"_BGPBD_":DT:EP"
SET DIR("A")="Enter ending Visit Date"
SET Y=BGPBD
DO DD^%DT
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO BD
+3 SET BGPED=Y
+4 SET (BGPPER,BGPVDT)=Y
+5 QUIT
PP ;EP - PP REPORT
+1 DO XIT
+2 SET BGPEDPP=1
+3 GOTO INTRO1
