BGP8NPL ; IHS/CMI/LAB - national patient list 20 Dec 2004 9:24 AM 30 Jun 2010 5:21 PM ;
;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
;
;
;
W:$D(IOF) @IOF
W !,$$CTR("IHS GPRA/GPRAMA Performance Report Patient List",80)
W !,$$CTR($$RPTVER^BGP8BAN,80)
INTRO ;
D XIT
W !!,"This will produce a list of patients who either met or did not meet a National"
W !,"GPRA/GPRAMA Report performance measure or a list of both those patients"
W !,"who met and those who did not meet a National GPRA/GPRAMA Report performance"
W !,"measure. You will be asked to select one or more performance measure"
W !,"topics and then choose which performance measure numerators you "
W !,"would like to report on.",!!
W !,"You will also be asked to provide the community taxonomy to determine"
W !,"which patients will be included, the beneficiary population of the"
W !,"patients, and the Report Period and Baseline Year."
K DIR S DIR(0)="E",DIR("A")="Press enter to continue" D ^DIR K DIR
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
D TAXCHK^BGP8XTCN
S X=$$DEMOCHK^BGP8UTL2()
I 'X W !!,"Exiting Report....." D PAUSE^BGP8DU,XIT Q
TP ;get time period
D XIT
S BGPRTYPE=1,BGPYRPTH="",BGPNPL=1,BGPINDG="G",BGPYGPU=1
SI ;
K DIRUT
K BGPIND
D EN^BGP8DSI
I '$D(BGPIND) W !!,"No measures selected." H 3 D XIT Q
SI1 ;NOW SELECT ONE OR MORE W/IN THE TOPIC
K BGPLIST,BGPX,BGPY,BGPINDL S BGPQ=0
D TERM^VALM0
;REORDER IN AOI FORMAT
K BGPINDO
S BGPIND=0 F S BGPIND=$O(BGPIND(BGPIND)) Q:BGPIND'=+BGPIND S BGPINDO($P(^BGPINDR(BGPIND,12),U,6),BGPIND)=""
S BGPORD=0 F S BGPORD=$O(BGPINDO(BGPORD)) Q:BGPORD'=+BGPORD!(BGPQ)!($D(DIRUT)) D
.S BGPIND=$O(BGPINDO(BGPORD,0))
.S BGPCR=$S(BGPRTYPE=7:"AON",1:"AN")
.K BGPX S BGPO=0,X=0,BGPC=0 F S BGPO=$O(^BGPNPLR(BGPCR,BGPIND,BGPO)) Q:BGPO'=+BGPO!($D(DIRUT)) D
..S X=$O(^BGPNPLR(BGPCR,BGPIND,BGPO,0))
..;I BGPRTYPE=1,$P(^BGPNPLR(X,0),U,4)'="N" Q
..;I BGPRTYPE=7,$P(^BGPNPLR(X,0),U,4)'="O" Q
..S BGPX(BGPO,X)="",BGPC=BGPC+1
.;display the choices
.W !!!,"Please select one or more of these report choices within the",!,IORVON,$P(^BGPINDR(BGPIND,0),U,3),IORVOFF," performance measure topic.",!
.K BGPY S X=0,BGPC=0,BGPO=0 F S BGPO=$O(BGPX(BGPO)) Q:BGPO'=+BGPO!($D(DIRUT)) S X=0 F S X=$O(BGPX(BGPO,X)) Q:X'=+X!($D(DIRUT)) S BGPC=BGPC+1 W !?5,BGPC,")",?9,$P(^BGPNPLR(X,0),U,3) S BGPY(BGPC)=X
.S DIR(0)="L^1:"_BGPC,DIR("A")="Which item(s)"
.D ^DIR K DIR S:$D(DUOUT) DIRUT=1
.I Y="" W !,"No REPORTS selected for this topic." Q
.I $D(DIRUT) W !,"No REPORTs selected for this topic." Q
.S BGPANS=Y,BGPC="" F BGPI=1:1 S BGPC=$P(BGPANS,",",BGPI) Q:BGPC="" S BGPINDL(BGPIND,BGPY(BGPC))=""
;get report type
I $D(DIRUT) G SI
K BGPQUIT D RT^BGP8DSL I '$D(BGPLIST)!($D(BGPQUIT)) G SI
TP1 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) G SI
S BGPQTR=Y
I BGPQTR=5 D ENDDATE
I BGPQTR'=5 D F
I BGPPER="" W !,"Year not entered.",! G TP1
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 TP1
.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 TP1
I $D(DUOUT) S DIRUT=1 G TP1
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 ;
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 Y=-1 G BY
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
K BGPQUIT
;
BEN ;
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,BGPBENF=Y(0)
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)
SUM ;display summary of this report
W:$D(IOF) @IOF
I BGPRTYPE=7 W !,$$CTR("SUMMARY OF "_$S(BGPRTYPE=7:"OTHER ",1:"")_"NATIONAL GPRA REPORT TO BE GENERATED")
I BGPRTYPE'=7 W !,$$CTR("SUMMARY OF NATIONAL GPRA/GPRAMA REPORT TO BE GENERATED")
W !,$$CTR($$RPTVER^BGP8BAN,80)
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 COMMUNITY Taxonomy to be used is: ",$P(^ATXAX(BGPTAXI,0),U)
D TEXT^BGP8DSL
I $D(DIRUT) G BEN
D PT^BGP8DSL
I BGPROT="" G COMM
ZIS ;call to XBDBQUE
D REPORT^BGP8UTL
I $G(BGPQUIT) D XIT Q
I BGPRPT="" D XIT Q
S BGPUF=$$GETDIR^BGP8UTL2()
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="^BGPGPDCR(" D ^DIK K DIK D XIT Q
I POP W !,"Report Aborted" S DA=BGPRPT,DIK="^BGPGPDPR(" D ^DIK K DIK D XIT Q
I POP W !,"Report Aborted" S DA=BGPRPT,DIK="^BGPGPDBR(" D ^DIK K DIK D XIT Q
I $D(IO("Q")) G TSKMN
DRIVER ;
D ^BGP8D1
U IO
D ^BGP8DP
D ^%ZISC
D XIT
Q
;
NODEV ;
S XBRP="",XBRC="NODEV1^BGP8NPL",XBRX="XIT^BGP8NPL",XBNS="BGP"
D ^XBDBQUE
Q
;
NODEV1 ;
D ^BGP8D1
D ^BGP8DP
D ^%ZISC
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^BGP8NPL",ZTDTH="",ZTDESC="NATIONAL GPRA REPORT 06" D ^%ZTLOAD D XIT Q
Q
;
XIT ;
D ^%ZISC
D EN^XBVK("BGP")
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. 2018"
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
ENDDATE ;
W !!,"When entering dates, if you do not enter a full 4 digit year (e.g. 2018)"
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/2009 if you"
W !,"want a date in the future."
S (BGPPER,BGPVDT)=""
W ! K DIR,X,Y S DIR(0)="D^::EP",DIR("A")="Enter End Date for the Report: (e.g. 11/30/2005)" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DIRUT) Q
S (BGPPER,BGPVDT)=Y
Q
;
NONNPL ;EP
W:$D(IOF) @IOF
W !,$$CTR("IHS Other National Measures Performance Report Patient List",80)
W !,$$CTR($$RPTVER^BGP8BAN,80)
INTRONON ;
D XIT
W !!,"This will produce a list of patients who either met or did not meet"
W !,"an Other National Measures Report performance measure or a list of"
W !,"both those patients who met and those who did not meet an Other National "
W !,"Measures Report performance measure. You will be asked to select one or "
W !,"more performance measure topics and then choose which performance "
W !,"measure numerators you would like to report on."
W !!,"You will also be asked to provide the community taxonomy to determine"
W !,"which patients will be included, the beneficiary population of the"
W !,"patients, and the Report Period and Baseline Year."
K DIR S DIR(0)="E",DIR("A")="Press enter to continue" D ^DIR K DIR
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
D TAXCHK^BGP8XTCO
S X=$$DEMOCHK^BGP8UTL2()
I 'X W !!,"Exiting Report....." D PAUSE^BGP8DU,XIT Q
TPNON ;get time period
D XIT
S BGPRTYPE=7,BGPYRPTH="",BGPNPL=1,BGPINDG="G",BGPYGPU=1,BGPONMR=1,BGPRTC="U"
G SI
BGP8NPL ; IHS/CMI/LAB - national patient list 20 Dec 2004 9:24 AM 30 Jun 2010 5:21 PM ;
+1 ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
+2 ;
+3 ;
+4 ;
+5 IF $DATA(IOF)
WRITE @IOF
+6 WRITE !,$$CTR("IHS GPRA/GPRAMA Performance Report Patient List",80)
+7 WRITE !,$$CTR($$RPTVER^BGP8BAN,80)
INTRO ;
+1 DO XIT
+2 WRITE !!,"This will produce a list of patients who either met or did not meet a National"
+3 WRITE !,"GPRA/GPRAMA Report performance measure or a list of both those patients"
+4 WRITE !,"who met and those who did not meet a National GPRA/GPRAMA Report performance"
+5 WRITE !,"measure. You will be asked to select one or more performance measure"
+6 WRITE !,"topics and then choose which performance measure numerators you "
+7 WRITE !,"would like to report on.",!!
+8 WRITE !,"You will also be asked to provide the community taxonomy to determine"
+9 WRITE !,"which patients will be included, the beneficiary population of the"
+10 WRITE !,"patients, and the Report Period and Baseline Year."
+11 KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press enter to continue"
DO ^DIR
KILL DIR
+12 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
+13 KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press enter to continue"
DO ^DIR
KILL DIR
End DoDot:1
QUIT
+14 DO TAXCHK^BGP8XTCN
+15 SET X=$$DEMOCHK^BGP8UTL2()
+16 IF 'X
WRITE !!,"Exiting Report....."
DO PAUSE^BGP8DU
DO XIT
QUIT
TP ;get time period
+1 DO XIT
+2 SET BGPRTYPE=1
SET BGPYRPTH=""
SET BGPNPL=1
SET BGPINDG="G"
SET BGPYGPU=1
SI ;
+1 KILL DIRUT
+2 KILL BGPIND
+3 DO EN^BGP8DSI
+4 IF '$DATA(BGPIND)
WRITE !!,"No measures selected."
HANG 3
DO XIT
QUIT
SI1 ;NOW SELECT ONE OR MORE W/IN THE TOPIC
+1 KILL BGPLIST,BGPX,BGPY,BGPINDL
SET BGPQ=0
+2 DO TERM^VALM0
+3 ;REORDER IN AOI FORMAT
+4 KILL BGPINDO
+5 SET BGPIND=0
FOR
SET BGPIND=$ORDER(BGPIND(BGPIND))
IF BGPIND'=+BGPIND
QUIT
SET BGPINDO($PIECE(^BGPINDR(BGPIND,12),U,6),BGPIND)=""
+6 SET BGPORD=0
FOR
SET BGPORD=$ORDER(BGPINDO(BGPORD))
IF BGPORD'=+BGPORD!(BGPQ)!($DATA(DIRUT))
QUIT
Begin DoDot:1
+7 SET BGPIND=$ORDER(BGPINDO(BGPORD,0))
+8 SET BGPCR=$SELECT(BGPRTYPE=7:"AON",1:"AN")
+9 KILL BGPX
SET BGPO=0
SET X=0
SET BGPC=0
FOR
SET BGPO=$ORDER(^BGPNPLR(BGPCR,BGPIND,BGPO))
IF BGPO'=+BGPO!($DATA(DIRUT))
QUIT
Begin DoDot:2
+10 SET X=$ORDER(^BGPNPLR(BGPCR,BGPIND,BGPO,0))
+11 ;I BGPRTYPE=1,$P(^BGPNPLR(X,0),U,4)'="N" Q
+12 ;I BGPRTYPE=7,$P(^BGPNPLR(X,0),U,4)'="O" Q
+13 SET BGPX(BGPO,X)=""
SET BGPC=BGPC+1
End DoDot:2
+14 ;display the choices
+15 WRITE !!!,"Please select one or more of these report choices within the",!,IORVON,$PIECE(^BGPINDR(BGPIND,0),U,3),IORVOFF," performance measure topic.",!
+16 KILL BGPY
SET X=0
SET BGPC=0
SET BGPO=0
FOR
SET BGPO=$ORDER(BGPX(BGPO))
IF BGPO'=+BGPO!($DATA(DIRUT))
QUIT
SET X=0
FOR
SET X=$ORDER(BGPX(BGPO,X))
IF X'=+X!($DATA(DIRUT))
QUIT
SET BGPC=BGPC+1
WRITE !?5,BGPC,")",?9,$PIECE(^BGPNPLR(X,0),U,3)
SET BGPY(BGPC)=X
+17 SET DIR(0)="L^1:"_BGPC
SET DIR("A")="Which item(s)"
+18 DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+19 IF Y=""
WRITE !,"No REPORTS selected for this topic."
QUIT
+20 IF $DATA(DIRUT)
WRITE !,"No REPORTs selected for this topic."
QUIT
+21 SET BGPANS=Y
SET BGPC=""
FOR BGPI=1:1
SET BGPC=$PIECE(BGPANS,",",BGPI)
IF BGPC=""
QUIT
SET BGPINDL(BGPIND,BGPY(BGPC))=""
End DoDot:1
+22 ;get report type
+23 IF $DATA(DIRUT)
GOTO SI
+24 KILL BGPQUIT
DO RT^BGP8DSL
IF '$DATA(BGPLIST)!($DATA(BGPQUIT))
GOTO SI
TP1 SET (BGPBD,BGPED,BGPTP)=""
+1 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
+2 IF $DATA(DIRUT)
GOTO SI
+3 SET BGPQTR=Y
+4 IF BGPQTR=5
DO ENDDATE
+5 IF BGPQTR'=5
DO F
+6 IF BGPPER=""
WRITE !,"Year not entered.",!
GOTO TP1
+7 IF BGPQTR=1
SET BGPBD=$EXTRACT(BGPPER,1,3)_"0101"
SET BGPED=$EXTRACT(BGPPER,1,3)_"1231"
+8 IF BGPQTR=2
SET BGPBD=($EXTRACT(BGPPER,1,3)-1)_"0401"
SET BGPED=$EXTRACT(BGPPER,1,3)_"0331"
+9 IF BGPQTR=3
SET BGPBD=($EXTRACT(BGPPER,1,3)-1)_"0701"
SET BGPED=$EXTRACT(BGPPER,1,3)_"0630"
+10 IF BGPQTR=4
SET BGPBD=($EXTRACT(BGPPER,1,3)-1)_"1001"
SET BGPED=$EXTRACT(BGPPER,1,3)_"0930"
+11 IF BGPQTR=5
Begin DoDot:1
+12 SET D=$$FMADD^XLFDT(BGPPER,1)
+13 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"
+14 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
+15 IF BGPED>DT
Begin DoDot:1
+16 WRITE !!,"You have selected Current Report period ",$$FMTE^XLFDT(BGPBD)," through ",$$FMTE^XLFDT(BGPED),"."
+17 WRITE !,"The end date of this report is in the future; your data will not be",!,"complete.",!
+18 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
+19 IF $DATA(DIRUT)
SET BGPDO=1
QUIT
+20 IF Y
SET BGPDO=1
QUIT
+21 QUIT
End DoDot:1
IF BGPDO=1
GOTO TP1
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 TP1
+7 IF $DATA(DUOUT)
SET DIRUT=1
GOTO TP1
+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 WRITE !!,"Specify the community taxonomy to determine which patients will be",!,"included in the report. You should have created this taxonomy using QMAN.",!
+2 KILL BGPTAX
+3 SET BGPTAXI=""
+4 DO ^XBFMK
+5 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: "
+6 SET B=$PIECE($GET(^BGPSITE(DUZ(2),0)),U,5)
IF B
SET DIC("B")=$PIECE(^ATXAX(B,0),U)
+7 DO ^DIC
+8 IF Y=-1
GOTO BY
+9 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
+20 KILL BGPQUIT
+21 ;
BEN ;
+1 SET BGPBEN=""
+2 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"
+3 SET DIR("B")="1"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
GOTO COMM
+5 SET BGPBEN=Y
SET BGPBENF=Y(0)
HOME ;
+1 SET BGPHOME=$PIECE($GET(^BGPSITE(DUZ(2),0)),U,2)
+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
+3 ;W !,"Your HOME location is defined as: ",$P(^DIC(4,BGPHOME,0),U)," asufac: ",$P(^AUTTLOC(BGPHOME,0),U,10)
SUM ;display summary of this report
+1 IF $DATA(IOF)
WRITE @IOF
+2 IF BGPRTYPE=7
WRITE !,$$CTR("SUMMARY OF "_$SELECT(BGPRTYPE=7:"OTHER ",1:"")_"NATIONAL GPRA REPORT TO BE GENERATED")
+3 IF BGPRTYPE'=7
WRITE !,$$CTR("SUMMARY OF NATIONAL GPRA/GPRAMA REPORT TO BE GENERATED")
+4 WRITE !,$$CTR($$RPTVER^BGP8BAN,80)
+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 WRITE !!,"The COMMUNITY Taxonomy to be used is: ",$PIECE(^ATXAX(BGPTAXI,0),U)
+10 DO TEXT^BGP8DSL
+11 IF $DATA(DIRUT)
GOTO BEN
+12 DO PT^BGP8DSL
+13 IF BGPROT=""
GOTO COMM
ZIS ;call to XBDBQUE
+1 DO REPORT^BGP8UTL
+2 IF $GET(BGPQUIT)
DO XIT
QUIT
+3 IF BGPRPT=""
DO XIT
QUIT
+4 SET BGPUF=$$GETDIR^BGP8UTL2()
+5 KILL IOP,%ZIS
IF BGPROT="D"
IF BGPDELT="F"
DO NODEV
DO XIT
QUIT
+6 KILL IOP,%ZIS
WRITE !!
SET %ZIS=$SELECT(BGPDELT'="S":"PQM",1:"PM")
DO ^%ZIS
+7 IF POP
WRITE !,"Report Aborted"
SET DA=BGPRPT
SET DIK="^BGPGPDCR("
DO ^DIK
KILL DIK
DO XIT
QUIT
+8 IF POP
WRITE !,"Report Aborted"
SET DA=BGPRPT
SET DIK="^BGPGPDPR("
DO ^DIK
KILL DIK
DO XIT
QUIT
+9 IF POP
WRITE !,"Report Aborted"
SET DA=BGPRPT
SET DIK="^BGPGPDBR("
DO ^DIK
KILL DIK
DO XIT
QUIT
+10 IF $DATA(IO("Q"))
GOTO TSKMN
DRIVER ;
+1 DO ^BGP8D1
+2 USE IO
+3 DO ^BGP8DP
+4 DO ^%ZISC
+5 DO XIT
+6 QUIT
+7 ;
NODEV ;
+1 SET XBRP=""
SET XBRC="NODEV1^BGP8NPL"
SET XBRX="XIT^BGP8NPL"
SET XBNS="BGP"
+2 DO ^XBDBQUE
+3 QUIT
+4 ;
NODEV1 ;
+1 DO ^BGP8D1
+2 DO ^BGP8DP
+3 DO ^%ZISC
+4 DO XIT
+5 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^BGP8NPL"
SET ZTDTH=""
SET ZTDESC="NATIONAL GPRA REPORT 06"
DO ^%ZTLOAD
DO XIT
QUIT
+6 QUIT
+7 ;
XIT ;
+1 DO ^%ZISC
+2 DO EN^XBVK("BGP")
+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 ;
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. 2018"
+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
ENDDATE ;
+1 WRITE !!,"When entering dates, if you do not enter a full 4 digit year (e.g. 2018)"
+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/2009 if you"
+6 WRITE !,"want a date in the future."
+7 SET (BGPPER,BGPVDT)=""
+8 WRITE !
KILL DIR,X,Y
SET DIR(0)="D^::EP"
SET DIR("A")="Enter End Date for the Report: (e.g. 11/30/2005)"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+9 IF $DATA(DIRUT)
QUIT
+10 SET (BGPPER,BGPVDT)=Y
+11 QUIT
+12 ;
NONNPL ;EP
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,$$CTR("IHS Other National Measures Performance Report Patient List",80)
+3 WRITE !,$$CTR($$RPTVER^BGP8BAN,80)
INTRONON ;
+1 DO XIT
+2 WRITE !!,"This will produce a list of patients who either met or did not meet"
+3 WRITE !,"an Other National Measures Report performance measure or a list of"
+4 WRITE !,"both those patients who met and those who did not meet an Other National "
+5 WRITE !,"Measures Report performance measure. You will be asked to select one or "
+6 WRITE !,"more performance measure topics and then choose which performance "
+7 WRITE !,"measure numerators you would like to report on."
+8 WRITE !!,"You will also be asked to provide the community taxonomy to determine"
+9 WRITE !,"which patients will be included, the beneficiary population of the"
+10 WRITE !,"patients, and the Report Period and Baseline Year."
+11 KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press enter to continue"
DO ^DIR
KILL DIR
+12 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
+13 KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press enter to continue"
DO ^DIR
KILL DIR
End DoDot:1
QUIT
+14 DO TAXCHK^BGP8XTCO
+15 SET X=$$DEMOCHK^BGP8UTL2()
+16 IF 'X
WRITE !!,"Exiting Report....."
DO PAUSE^BGP8DU
DO XIT
QUIT
TPNON ;get time period
+1 DO XIT
+2 SET BGPRTYPE=7
SET BGPYRPTH=""
SET BGPNPL=1
SET BGPINDG="G"
SET BGPYGPU=1
SET BGPONMR=1
SET BGPRTC="U"
+3 GOTO SI
