BGP1PDL ; IHS/CMI/LAB - IHS gpra print 01 Jul 2010 8:02 PM ;
;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
;
;
DEL ;
K ^TMP($J)
S ^TMP($J,"BGPDEL",0)=0
K BGPSUMP
D ^BGP1PDLH
D DEL1
I BGPRTYPE=1 D NONSUM^BGP1PDLN
I BGPRTYPE=1 D DEVSUM^BGP1PDLD
;I BGPRTYPE=1 D SUMMARY
I BGPRTYPE=1 D SDP^BGP1PDLN
I BGPRTYPE=1 D SDP^BGP1PDLD
;I BGPRTYPE=1 D SDP
I BGPRTYPE=7 D OTHSUM^BGP1PDLO
D ^BGP1PDLS ;print lists to delimited file
I $G(BGPCPPL) D CPPL1^BGP1DCLD
;if screen selected do screen
;
SAVEDEL ;EP
I $G(BGPSUMON) D SUMONLY Q ;NEW FOR 09, SUMMARY ONLY
I BGPDELT="S" D SCREEN,EXIT Q
;call xbgsave to create output file
S XBGL="BGPDATA"
L +^BGPDATA:300 E W:'$D(ZTQUEUED) "Unable to lock global" Q
K ^TMP($J,"SUMMARYDEL")
K ^BGPDATA ;global for saving
S X=0 F S X=$O(^TMP($J,"BGPDEL",X)) Q:X'=+X I ^TMP($J,"BGPDEL",X)'="ENDCOVERPAGE" S ^BGPDATA(X)=^TMP($J,"BGPDEL",X)
I '$D(BGPGUI) D
.;I $P($G(^BGPSITE(DUZ(2),0)),U,14) S XBUF=$P(^BGPSITE(DUZ(2),0),U,14)
.S XBFLT=1,XBFN=BGPDELF_".txt",XBMED="F",XBTLE="GPRA 11 DELIMITED OUTPUT",XBQ="N",XBF=0
.D ^XBGSAVE
.K XBFLT,XBFN,XBMED,XBTLE,XBE,XBF
I $D(BGPGUI) D
.S (C,X)=0 F S X=$O(^BGPDATA(X)) Q:X'=+X S C=C+1,^BGPGUIB(BGPGIEN,12,C,0)=^BGPDATA(X)
.S ^BGPGUIB(BGPGIEN,12,0)="^90546.0812^"_C_"^"_C_"^"_DT
L -^BGPDATA
K ^BGPDATA ;export global
D EXIT
Q
SUMONLY ;
;if screen selected do screen
I BGPDELT="S" D SCREENSO,EXIT Q
;call xbgsave to create output file
S XBGL="BGPDATA"
L +^BGPDATA:300 E W:'$D(ZTQUEUED) "Unable to lock global" Q
K ^TMP($J,"SUMMARYDEL")
K ^BGPDATA ;global for saving
S X=0 F S X=$O(^TMP($J,"BGPDEL",X)) Q:X'=+X!(^TMP($J,"BGPDEL",X)="ENDCOVERPAGE") S ^BGPDATA(X)=^TMP($J,"BGPDEL",X),BGPLX=X
;GET STARTING POINT
S BGPSTP=0,X=0 F S X=$O(^TMP($J,"BGPDEL",X)) Q:X'=+X I ^TMP($J,"BGPDEL",X)="GPRA DEVELOPMENTAL CLINICAL PERFORMANCE SUMMARY" S BGPSTP=X
S X=BGPSTP-1,BGPLX=BGPLX+1,BGPDEVE=0 F S X=$O(^TMP($J,"BGPDEL",X)) Q:X'=+X!(BGPDEVE) S BGPLX=BGPLX+1 S ^BGPDATA(BGPLX)=^TMP($J,"BGPDEL",X) I ^TMP($J,"BGPDEL",X)="refusals with respect to GPRA Developmental measure." S BGPDEVE=X
I $G(BGPAREAA) D
.S BGPSTP=0,X=BGPDEVE F S X=$O(^TMP($J,"BGPDEL",X)) Q:X'=+X I ^TMP($J,"BGPDEL",X)="refusals with respect to GPRA Developmental measure." S BGPSTP=X
.S X=BGPDEVE,BGPLX=BGPLX+1,BGPDEVE=0 F S X=$O(^TMP($J,"BGPDEL",X)) Q:X'=+X!(BGPDEVE) S BGPLX=BGPLX+1 S ^BGPDATA(BGPLX)=^TMP($J,"BGPDEL",X) I ^TMP($J,"BGPDEL",X)="refusals with respect to GPRA Developmental measure." S BGPDEVE=X
S BGPSTP=0,X=BGPDEVE F S X=$O(^TMP($J,"BGPDEL",X)) Q:X'=+X I ^TMP($J,"BGPDEL",X)="SELECTED NON-GPRA MEASURES CLINICAL PERFORMANCE SUMMARY" S BGPSTP=X
S X=BGPSTP-1,BGPLX=BGPLX+1,BGPDEVE=0 F S X=$O(^TMP($J,"BGPDEL",X)) Q:X'=+X S BGPLX=BGPLX+1 S ^BGPDATA(BGPLX)=^TMP($J,"BGPDEL",X)
I '$D(BGPGUI) D
.;I $P($G(^BGPSITE(DUZ(2),0)),U,14) ;S XBUF=$P(^BGPSITE(DUZ(2),0),U,14)
.S XBFLT=1,XBFN=BGPDELF_".txt",XBMED="F",XBTLE="GPRA 10 DELIMITED OUTPUT",XBQ="N",XBF=0
.D ^XBGSAVE
.K XBFLT,XBFN,XBMED,XBTLE,XBE,XBF
I $D(BGPGUI) D
.S (C,X)=0 F S X=$O(^BGPDATA(X)) Q:X'=+X S C=C+1,^BGPGUIB(BGPGIEN,12,C,0)=^BGPDATA(X)
.S ^BGPGUIB(BGPGIEN,12,0)="^90546.0812^"_C_"^"_C_"^"_DT
L -^BGPDATA
K ^BGPDATA ;export global
D EXIT
Q
SCREENSO ;
S X=0 F S X=$O(^TMP($J,"BGPDEL",X)) Q:X'=+X!(^TMP($J,"BGPDEL",X)="ENDCOVERPAGE") W !,^TMP($J,"BGPDEL",X) S BGPLX=X
S BGPSTP=0,X=0 F S X=$O(^TMP($J,"BGPDEL",X)) Q:X'=+X I ^TMP($J,"BGPDEL",X)["GPRA DEVELOPMENTAL CLINICAL PERFORMANCE SUMMARY" S BGPSTP=X
S X=BGPSTP-1,BGPLX=BGPLX+1,BGPDEVE=0 F S X=$O(^TMP($J,"BGPDEL",X)) Q:X'=+X!(BGPDEVE) S BGPLX=BGPLX+1 W !,^TMP($J,"BGPDEL",X) I ^TMP($J,"BGPDEL",X)="refusals with respect to GPRA Developmental measure." S BGPDEVE=X
I $G(BGPAREAA) D
.S BGPSTP=0,X=BGPDEVE F S X=$O(^TMP($J,"BGPDEL",X)) Q:X'=+X I ^TMP($J,"BGPDEL",X)="refusals with respect to GPRA Developmental measure." S BGPSTP=X
.S X=BGPDEVE,BGPLX=BGPLX+1,BGPDEVE=0 F S X=$O(^TMP($J,"BGPDEL",X)) Q:X'=+X!(BGPDEVE) S BGPLX=BGPLX+1 W !,^TMP($J,"BGPDEL",X) I ^TMP($J,"BGPDEL",X)="refusals with respect to GPRA Developmental measure." S BGPDEVE=X
S BGPSTP=0,X=BGPDEVE F S X=$O(^TMP($J,"BGPDEL",X)) Q:X'=+X I ^TMP($J,"BGPDEL",X)["SELECTED NON-GPRA MEASURES CLINICAL PERFORMANCE SUMMARY" S BGPSTP=X
S X=BGPSTP-1,BGPLX=BGPLX+1,BGPDEVE=0 F S X=$O(^TMP($J,"BGPDEL",X)) Q:X'=+X S BGPLX=BGPLX+1 W !,^TMP($J,"BGPDEL",X)
Q
;
SCREEN ;
S X=0 F S X=$O(^TMP($J,"BGPDEL",X)) Q:X'=+X W:^TMP($J,"BGPDEL",X)'="ENDCOVERPAGE" !,^TMP($J,"BGPDEL",X)
Q
DEL1 ;EP
S BGPIC=0 F S BGPIC=$O(BGPIND(BGPIC)) Q:BGPIC="" D
.D PRINT2
.I $G(BGPNPL),$D(BGPINDL(BGPIC)),'$D(BGP1NPLT) S BGPINDB=BGPIC D NPL1^BGP1NPLP ;printed nat gpra list
.I $G(BGPNPL),$D(BGPINDL(BGPIC)),$D(BGP1NPLT) S BGPINDB=BGPIC D CT^BGP1DSTM ;printed nat gpra SEARCH TEMPLATE
Q:BGPQUIT
I BGPRTYPE'=1 G PRINT3
;now print gpra dev measures
S BGPGDEV=1,BGPRTYPE=9 ;control variable
S BGPIC=0 F S BGPIC=$O(BGPIND(BGPIC)) Q:BGPIC=""!(BGPQUIT) I $P(^BGPINDB(BGPIC,0),U,14) D PRINT2 D
.Q:BGPQUIT
.I $G(BGPNPL),$D(BGPINDL(BGPIC)),'$D(BGP1NPLT) S BGPINDB=BGPIC D NPL1^BGP1NPLP ;printed nat gpra list
.I $G(BGPNPL),$D(BGPINDL(BGPIC)),$D(BGP1NPLT) S BGPINDB=BGPIC D CT^BGP1DSTM ;printed nat gpra SEARCH TEMPLATE
Q:BGPQUIT
;set back to report 1
S BGPRTYPE=1
PRINT3 ;
Q
PRINT2 ;
D
.S X=" " D S(X,1,1),S(X,1,1)
.S X=$P(^BGPINDB(BGPIC,0),U,3) D S(X,1,1)
.S X=" " D S(X,1,1)
.S X="Denominator(s):" D S(X,1,1)
.S BGPNODE=$S(BGPRTYPE=1:81,BGPRTYPE=4:61,BGPRTYPE=7:83,BGPRTYPE=9:85,1:61)
.S BGPX=0 F S BGPX=$O(^BGPINDB(BGPIC,BGPNODE,"B",BGPX)) Q:BGPX'=+BGPX D
..S BGPY=0 F S BGPY=$O(^BGPINDB(BGPIC,BGPNODE,"B",BGPX,BGPY)) Q:BGPY'=+BGPY D
...;I $P(^BGPINDB(BGPIC,61,BGPY,0),U,2)'[BGPRTYPE Q ;not a denom def for this report
...;I '$D(^BGPINDB(BGPIC,61,BGPY,11,"B",BGPRTYPE)) Q
...I BGPRTYPE=4,'$D(^BGPINDB(BGPIC,BGPNODE,BGPY,12,"B",BGPINDB)) Q
...S BGPZ=0 F S BGPZ=$O(^BGPINDB(BGPIC,BGPNODE,BGPY,1,BGPZ)) Q:BGPZ'=+BGPZ D
....S Y=^BGPINDB(BGPIC,BGPNODE,BGPY,1,BGPZ,0) D S(Y,1,1)
....Q
...Q
..Q
.S X=" " D S(X,1,1)
.S X="Numerator(s):" D S(X,1,1)
.S BGPNODE=$S(BGPRTYPE=1:82,BGPRTYPE=4:62,BGPRTYPE=7:84,BGPRTYPE=9:86,1:62)
.S BGPX=0 F S BGPX=$O(^BGPINDB(BGPIC,BGPNODE,"B",BGPX)) Q:BGPX'=+BGPX D
..S BGPY=0 F S BGPY=$O(^BGPINDB(BGPIC,BGPNODE,"B",BGPX,BGPY)) Q:BGPY'=+BGPY D
...;I $P(^BGPINDB(BGPIC,62,BGPY,0),U,2)'[BGPRTYPE Q ;not a denom def for this report
...;I BGPRTYPE=4,BGPINDB'="S",$P(^BGPINDB(BGPIC,62,BGPY,0),U,3)'[BGPINDB Q ;don't display
...;I '$D(^BGPINDB(BGPIC,62,BGPY,11,"B",BGPRTYPE)) Q ;not this report type
...I BGPRTYPE=4,'$D(^BGPINDB(BGPIC,BGPNODE,BGPY,12,"B",BGPINDB)) Q
...S BGPZ=0 F S BGPZ=$O(^BGPINDB(BGPIC,BGPNODE,BGPY,1,BGPZ)) Q:BGPZ'=+BGPZ D
....S X=^BGPINDB(BGPIC,BGPNODE,BGPY,1,BGPZ,0) D S(X,1,1)
....Q
...Q
..Q
.S X=" " D S(X,1,1)
.S BGPNODE=11
.I BGPRTYPE=1,$O(^BGPINDB(BGPIC,54,0)) S BGPNODE=54
.I BGPRTYPE=7,$O(^BGPINDB(BGPIC,56,0)) S BGPNODE=56
.I BGPRTYPE=9,$O(^BGPINDB(BGPIC,58,0)) S BGPNODE=58
.S X="Logic:" D S(X,1,1)
.S BGPX=0 F S BGPX=$O(^BGPINDB(BGPIC,BGPNODE,BGPX)) Q:BGPX'=+BGPX D
..S X=^BGPINDB(BGPIC,BGPNODE,BGPX,0) D S(X,1,1)
.I BGPRTYPE=9 G CALC
.S X=" " D S(X,1,1) S X="Performance Measure Description:" D S(X,1,1) S BGPX=0 F S BGPX=$O(^BGPINDB(BGPIC,$S($G(BGPNGR09):57,1:51),BGPX)) Q:BGPX'=+BGPX D
..S X=^BGPINDB(BGPIC,$S($G(BGPNGR09):57,1:51),BGPX,0) D S(X,1,1)
.I $O(^BGPINDB(BGPIC,52,0)) S X=" " D S(X,1,1) S X="Past Performance and/or Target:" D S(X,1,1) S BGPX=0 F S BGPX=$O(^BGPINDB(BGPIC,52,BGPX)) Q:BGPX'=+BGPX D
..S X=^BGPINDB(BGPIC,52,BGPX,0) D S(X,1,1)
.I $O(^BGPINDB(BGPIC,55,0)) S X=" " D S(X,1,1) S X="Source:" D S(X,1,1) S BGPX=0 F S BGPX=$O(^BGPINDB(BGPIC,55,BGPX)) Q:BGPX'=+BGPX D
..S X=^BGPINDB(BGPIC,55,BGPX,0) D S(X,1,1)
.I '$O(^BGPINDB(BGPIC,55,0)) D S(" ",1,1)
CALC .X ^BGPINDB(BGPIC,4)
Q
S Y=$P(^VA(200,DUZ,0),U,2),$E(Y,35)=$$FMTE^XLFDT(DT) D S(Y,1,1)
I BGPRTYPE=7 S Y="*** IHS 2011 Other National Measures Report ***" D S(Y,1,1)
I BGPRTYPE=4 S Y="*** IHS 2011 Clinical Performance Report ***" D S(Y,1,1)
I BGPRTYPE=1,'$G(BGPNGR09) S Y="*** IHS 2011 National GPRA & PART Report ***" D S(Y,1,1)
I BGPRTYPE=1,$G(BGPNGR09) S Y="*** IHS 2012 National GPRA & PART Report, Run Using 2011 Logic ***" D S(Y,1,1)
I $G(BGPAREAA) S Y="AREA AGGREGATE" D S(Y,1,1)
I '$G(BGPAREAA) S Y=$P(^DIC(4,DUZ(2),0),U) D S(Y,1,1)
;S X=$$RPTVER^BGP1BAN D S(X,1,1)
S X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED) D S(X,1,1)
S X="Previous Year Period: "_$$FMTE^XLFDT(BGPPBD)_" to "_$$FMTE^XLFDT(BGPPED) D S(X,1,1)
S X="Baseline Period: "_$$FMTE^XLFDT(BGPBBD)_" to "_$$FMTE^XLFDT(BGPBED) D S(X,1,1)
S X=" " D S(X,1,1)
Q:$G(BGPSUMP)
I BGPRTYPE=1 S X="Measures: GPRA, GPRA Developmental, and PART Denominators and Numerators and Selected Other Clinical Denominators and Numerators" D S(X,1,1)
S X=" " D S(X,1,1)
I BGPRTYPE=1 S X="Population: AI/AN Only (Classification 01)" D S(X,1,1)
S X=" " D S(X,1,1)
S BGPI=$O(^BGPCTRL("B",2011,0))
S BGPX=0 F S BGPX=$O(^BGPCTRL(BGPI,14,BGPX)) Q:BGPX'=+BGPX D
.S X=^BGPCTRL(BGPI,14,BGPX,0) D S(X,1,1)
I $G(BGPEXPT) S X="A file will be created called BG11"_$P(^AUTTLOC(DUZ(2),0),U,10)_"."_BGPRPT_"." D S(X,1,1)
S X="It will reside in the public/export directory. This file should be sent to your Area Office." D S(X,1,1)
S X=" " D S(X,1,1)
I $G(BGPALLPT) S X="All Communities Included." D S(X,1,1)
I '$G(BGPALLPT),'$G(BGPSEAT) S X="Community Taxonomy Name: "_$P(^ATXAX(BGPTAXI,0),U) D S(X,1,1)
I '$G(BGPALLPT),'$G(BGPSEAT) S X="The following communities are included in this report:" D S(X,1,1) D
.S BGPZZ="",N=0,Y="" F S BGPZZ=$O(BGPTAX(BGPZZ)) Q:BGPZZ="" S N=N+1,Y=Y_$S(N=1:"",1:";")_BGPZZ
.S BGPZZ=0,C=0 F BGPZZ=1:3:N D
..S X=$E($P(Y,";",BGPZZ),1,20),$E(X,3)=$E($P(Y,";",(BGPZZ+1)),1,20),$E(X,60)=$E($P(Y,";",(BGPZZ+2)),1,20)
..Q
I $G(BGPMFITI) S X="MFI Location Taxonomy Name: "_$P(^ATXAX(BGPMFITI,0),U) D S(X,1,1)
I $G(BGPMFITI) S X="The following locations are used for patient visits in this report:" D S(X,1,1) D
.S BGPZZ="",N=0,Y="" F S BGPZZ=$O(^ATXAX(BGPMFITI,21,"B",BGPZZ)) Q:BGPZZ="" S N=N+1,Y=Y_$S(N=1:"",1:";")_$P($G(^DIC(4,BGPZZ,0)),U)
.S BGPZZ=0,C=0 F BGPZZ=1:3:N D
..S X=$E($P(Y,";",BGPZZ),1,20),$E(X,3)=$E($P(Y,";",(BGPZZ+1)),1,20),$E(X,60)=$E($P(Y,";",(BGPZZ+2)),1,20)
..Q
K BGPX,BGPQUIT
S X=$TR($J(""," ","-"),80) D S(X,1,1)
Q
EXIT ;
K ^TMP($J)
Q
CTR(X,Y) ;EP - Center
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
USR() ;EP - Return user
Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
;----------
S(Y,F,P) ;EP set up array
I '$G(F) S F=0
S %=$P(^TMP($J,"BGPDEL",0),U)+F,$P(^TMP($J,"BGPDEL",0),U)=%
I '$D(^TMP($J,"BGPDEL",%)) S ^TMP($J,"BGPDEL",%)=""
S $P(^TMP($J,"BGPDEL",%),U,P)=Y
Q
C(X,X2,X3) ;
D COMMA^%DTC
Q X
BGP1PDL ; IHS/CMI/LAB - IHS gpra print 01 Jul 2010 8:02 PM ;
+1 ;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
+2 ;
+3 ;
DEL ;
+1 KILL ^TMP($JOB)
+2 SET ^TMP($JOB,"BGPDEL",0)=0
+3 KILL BGPSUMP
+4 DO ^BGP1PDLH
+5 DO DEL1
+6 IF BGPRTYPE=1
DO NONSUM^BGP1PDLN
+7 IF BGPRTYPE=1
DO DEVSUM^BGP1PDLD
+8 ;I BGPRTYPE=1 D SUMMARY
+9 IF BGPRTYPE=1
DO SDP^BGP1PDLN
+10 IF BGPRTYPE=1
DO SDP^BGP1PDLD
+11 ;I BGPRTYPE=1 D SDP
+12 IF BGPRTYPE=7
DO OTHSUM^BGP1PDLO
+13 ;print lists to delimited file
DO ^BGP1PDLS
+14 IF $GET(BGPCPPL)
DO CPPL1^BGP1DCLD
+15 ;if screen selected do screen
+16 ;
SAVEDEL ;EP
+1 ;NEW FOR 09, SUMMARY ONLY
IF $GET(BGPSUMON)
DO SUMONLY
QUIT
+2 IF BGPDELT="S"
DO SCREEN
DO EXIT
QUIT
+3 ;call xbgsave to create output file
+4 SET XBGL="BGPDATA"
+5 LOCK +^BGPDATA:300
IF '$TEST
IF '$DATA(ZTQUEUED)
WRITE "Unable to lock global"
QUIT
+6 KILL ^TMP($JOB,"SUMMARYDEL")
+7 ;global for saving
KILL ^BGPDATA
+8 SET X=0
FOR
SET X=$ORDER(^TMP($JOB,"BGPDEL",X))
IF X'=+X
QUIT
IF ^TMP($JOB,"BGPDEL",X)'="ENDCOVERPAGE"
SET ^BGPDATA(X)=^TMP($JOB,"BGPDEL",X)
+9 IF '$DATA(BGPGUI)
Begin DoDot:1
+10 ;I $P($G(^BGPSITE(DUZ(2),0)),U,14) S XBUF=$P(^BGPSITE(DUZ(2),0),U,14)
+11 SET XBFLT=1
SET XBFN=BGPDELF_".txt"
SET XBMED="F"
SET XBTLE="GPRA 11 DELIMITED OUTPUT"
SET XBQ="N"
SET XBF=0
+12 DO ^XBGSAVE
+13 KILL XBFLT,XBFN,XBMED,XBTLE,XBE,XBF
End DoDot:1
+14 IF $DATA(BGPGUI)
Begin DoDot:1
+15 SET (C,X)=0
FOR
SET X=$ORDER(^BGPDATA(X))
IF X'=+X
QUIT
SET C=C+1
SET ^BGPGUIB(BGPGIEN,12,C,0)=^BGPDATA(X)
+16 SET ^BGPGUIB(BGPGIEN,12,0)="^90546.0812^"_C_"^"_C_"^"_DT
End DoDot:1
+17 LOCK -^BGPDATA
+18 ;export global
KILL ^BGPDATA
+19 DO EXIT
+20 QUIT
SUMONLY ;
+1 ;if screen selected do screen
+2 IF BGPDELT="S"
DO SCREENSO
DO EXIT
QUIT
+3 ;call xbgsave to create output file
+4 SET XBGL="BGPDATA"
+5 LOCK +^BGPDATA:300
IF '$TEST
IF '$DATA(ZTQUEUED)
WRITE "Unable to lock global"
QUIT
+6 KILL ^TMP($JOB,"SUMMARYDEL")
+7 ;global for saving
KILL ^BGPDATA
+8 SET X=0
FOR
SET X=$ORDER(^TMP($JOB,"BGPDEL",X))
IF X'=+X!(^TMP($JOB,"BGPDEL",X)="ENDCOVERPAGE")
QUIT
SET ^BGPDATA(X)=^TMP($JOB,"BGPDEL",X)
SET BGPLX=X
+9 ;GET STARTING POINT
+10 SET BGPSTP=0
SET X=0
FOR
SET X=$ORDER(^TMP($JOB,"BGPDEL",X))
IF X'=+X
QUIT
IF ^TMP($JOB,"BGPDEL",X)="GPRA DEVELOPMENTAL CLINICAL PERFORMANCE SUMMARY"
SET BGPSTP=X
+11 SET X=BGPSTP-1
SET BGPLX=BGPLX+1
SET BGPDEVE=0
FOR
SET X=$ORDER(^TMP($JOB,"BGPDEL",X))
IF X'=+X!(BGPDEVE)
QUIT
SET BGPLX=BGPLX+1
SET ^BGPDATA(BGPLX)=^TMP($JOB,"BGPDEL",X)
IF ^TMP($JOB,"BGPDEL",X)="refusals with respect to GPRA Developmental measure."
SET BGPDEVE=X
+12 IF $GET(BGPAREAA)
Begin DoDot:1
+13 SET BGPSTP=0
SET X=BGPDEVE
FOR
SET X=$ORDER(^TMP($JOB,"BGPDEL",X))
IF X'=+X
QUIT
IF ^TMP($JOB,"BGPDEL",X)="refusals with respect to GPRA Developmental measure."
SET BGPSTP=X
+14 SET X=BGPDEVE
SET BGPLX=BGPLX+1
SET BGPDEVE=0
FOR
SET X=$ORDER(^TMP($JOB,"BGPDEL",X))
IF X'=+X!(BGPDEVE)
QUIT
SET BGPLX=BGPLX+1
SET ^BGPDATA(BGPLX)=^TMP($JOB,"BGPDEL",X)
IF ^TMP($JOB,"BGPDEL",X)="refusals with respect to GPRA Developmental measure."
SET BGPDEVE=X
End DoDot:1
+15 SET BGPSTP=0
SET X=BGPDEVE
FOR
SET X=$ORDER(^TMP($JOB,"BGPDEL",X))
IF X'=+X
QUIT
IF ^TMP($JOB,"BGPDEL",X)="SELECTED NON-GPRA MEASURES CLINICAL PERFORMANCE SUMMARY"
SET BGPSTP=X
+16 SET X=BGPSTP-1
SET BGPLX=BGPLX+1
SET BGPDEVE=0
FOR
SET X=$ORDER(^TMP($JOB,"BGPDEL",X))
IF X'=+X
QUIT
SET BGPLX=BGPLX+1
SET ^BGPDATA(BGPLX)=^TMP($JOB,"BGPDEL",X)
+17 IF '$DATA(BGPGUI)
Begin DoDot:1
+18 ;I $P($G(^BGPSITE(DUZ(2),0)),U,14) ;S XBUF=$P(^BGPSITE(DUZ(2),0),U,14)
+19 SET XBFLT=1
SET XBFN=BGPDELF_".txt"
SET XBMED="F"
SET XBTLE="GPRA 10 DELIMITED OUTPUT"
SET XBQ="N"
SET XBF=0
+20 DO ^XBGSAVE
+21 KILL XBFLT,XBFN,XBMED,XBTLE,XBE,XBF
End DoDot:1
+22 IF $DATA(BGPGUI)
Begin DoDot:1
+23 SET (C,X)=0
FOR
SET X=$ORDER(^BGPDATA(X))
IF X'=+X
QUIT
SET C=C+1
SET ^BGPGUIB(BGPGIEN,12,C,0)=^BGPDATA(X)
+24 SET ^BGPGUIB(BGPGIEN,12,0)="^90546.0812^"_C_"^"_C_"^"_DT
End DoDot:1
+25 LOCK -^BGPDATA
+26 ;export global
KILL ^BGPDATA
+27 DO EXIT
+28 QUIT
SCREENSO ;
+1 SET X=0
FOR
SET X=$ORDER(^TMP($JOB,"BGPDEL",X))
IF X'=+X!(^TMP($JOB,"BGPDEL",X)="ENDCOVERPAGE")
QUIT
WRITE !,^TMP($JOB,"BGPDEL",X)
SET BGPLX=X
+2 SET BGPSTP=0
SET X=0
FOR
SET X=$ORDER(^TMP($JOB,"BGPDEL",X))
IF X'=+X
QUIT
IF ^TMP($JOB,"BGPDEL",X)["GPRA DEVELOPMENTAL CLINICAL PERFORMANCE SUMMARY"
SET BGPSTP=X
+3 SET X=BGPSTP-1
SET BGPLX=BGPLX+1
SET BGPDEVE=0
FOR
SET X=$ORDER(^TMP($JOB,"BGPDEL",X))
IF X'=+X!(BGPDEVE)
QUIT
SET BGPLX=BGPLX+1
WRITE !,^TMP($JOB,"BGPDEL",X)
IF ^TMP($JOB,"BGPDEL",X)="refusals with respect to GPRA Developmental measure."
SET BGPDEVE=X
+4 IF $GET(BGPAREAA)
Begin DoDot:1
+5 SET BGPSTP=0
SET X=BGPDEVE
FOR
SET X=$ORDER(^TMP($JOB,"BGPDEL",X))
IF X'=+X
QUIT
IF ^TMP($JOB,"BGPDEL",X)="refusals with respect to GPRA Developmental measure."
SET BGPSTP=X
+6 SET X=BGPDEVE
SET BGPLX=BGPLX+1
SET BGPDEVE=0
FOR
SET X=$ORDER(^TMP($JOB,"BGPDEL",X))
IF X'=+X!(BGPDEVE)
QUIT
SET BGPLX=BGPLX+1
WRITE !,^TMP($JOB,"BGPDEL",X)
IF ^TMP($JOB,"BGPDEL",X)="refusals with respect to GPRA Developmental measure."
SET BGPDEVE=X
End DoDot:1
+7 SET BGPSTP=0
SET X=BGPDEVE
FOR
SET X=$ORDER(^TMP($JOB,"BGPDEL",X))
IF X'=+X
QUIT
IF ^TMP($JOB,"BGPDEL",X)["SELECTED NON-GPRA MEASURES CLINICAL PERFORMANCE SUMMARY"
SET BGPSTP=X
+8 SET X=BGPSTP-1
SET BGPLX=BGPLX+1
SET BGPDEVE=0
FOR
SET X=$ORDER(^TMP($JOB,"BGPDEL",X))
IF X'=+X
QUIT
SET BGPLX=BGPLX+1
WRITE !,^TMP($JOB,"BGPDEL",X)
+9 QUIT
+10 ;
SCREEN ;
+1 SET X=0
FOR
SET X=$ORDER(^TMP($JOB,"BGPDEL",X))
IF X'=+X
QUIT
IF ^TMP($JOB,"BGPDEL",X)'="ENDCOVERPAGE"
WRITE !,^TMP($JOB,"BGPDEL",X)
+2 QUIT
DEL1 ;EP
+1 SET BGPIC=0
FOR
SET BGPIC=$ORDER(BGPIND(BGPIC))
IF BGPIC=""
QUIT
Begin DoDot:1
+2 DO PRINT2
+3 ;printed nat gpra list
IF $GET(BGPNPL)
IF $DATA(BGPINDL(BGPIC))
IF '$DATA(BGP1NPLT)
SET BGPINDB=BGPIC
DO NPL1^BGP1NPLP
+4 ;printed nat gpra SEARCH TEMPLATE
IF $GET(BGPNPL)
IF $DATA(BGPINDL(BGPIC))
IF $DATA(BGP1NPLT)
SET BGPINDB=BGPIC
DO CT^BGP1DSTM
End DoDot:1
+5 IF BGPQUIT
QUIT
+6 IF BGPRTYPE'=1
GOTO PRINT3
+7 ;now print gpra dev measures
+8 ;control variable
SET BGPGDEV=1
SET BGPRTYPE=9
+9 SET BGPIC=0
FOR
SET BGPIC=$ORDER(BGPIND(BGPIC))
IF BGPIC=""!(BGPQUIT)
QUIT
IF $PIECE(^BGPINDB(BGPIC,0),U,14)
DO PRINT2
Begin DoDot:1
+10 IF BGPQUIT
QUIT
+11 ;printed nat gpra list
IF $GET(BGPNPL)
IF $DATA(BGPINDL(BGPIC))
IF '$DATA(BGP1NPLT)
SET BGPINDB=BGPIC
DO NPL1^BGP1NPLP
+12 ;printed nat gpra SEARCH TEMPLATE
IF $GET(BGPNPL)
IF $DATA(BGPINDL(BGPIC))
IF $DATA(BGP1NPLT)
SET BGPINDB=BGPIC
DO CT^BGP1DSTM
End DoDot:1
+13 IF BGPQUIT
QUIT
+14 ;set back to report 1
+15 SET BGPRTYPE=1
PRINT3 ;
+1 QUIT
PRINT2 ;
+1 Begin DoDot:1
+2 SET X=" "
DO S(X,1,1)
DO S(X,1,1)
+3 SET X=$PIECE(^BGPINDB(BGPIC,0),U,3)
DO S(X,1,1)
+4 SET X=" "
DO S(X,1,1)
+5 SET X="Denominator(s):"
DO S(X,1,1)
+6 SET BGPNODE=$SELECT(BGPRTYPE=1:81,BGPRTYPE=4:61,BGPRTYPE=7:83,BGPRTYPE=9:85,1:61)
+7 SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPINDB(BGPIC,BGPNODE,"B",BGPX))
IF BGPX'=+BGPX
QUIT
Begin DoDot:2
+8 SET BGPY=0
FOR
SET BGPY=$ORDER(^BGPINDB(BGPIC,BGPNODE,"B",BGPX,BGPY))
IF BGPY'=+BGPY
QUIT
Begin DoDot:3
+9 ;I $P(^BGPINDB(BGPIC,61,BGPY,0),U,2)'[BGPRTYPE Q ;not a denom def for this report
+10 ;I '$D(^BGPINDB(BGPIC,61,BGPY,11,"B",BGPRTYPE)) Q
+11 IF BGPRTYPE=4
IF '$DATA(^BGPINDB(BGPIC,BGPNODE,BGPY,12,"B",BGPINDB))
QUIT
+12 SET BGPZ=0
FOR
SET BGPZ=$ORDER(^BGPINDB(BGPIC,BGPNODE,BGPY,1,BGPZ))
IF BGPZ'=+BGPZ
QUIT
Begin DoDot:4
+13 SET Y=^BGPINDB(BGPIC,BGPNODE,BGPY,1,BGPZ,0)
DO S(Y,1,1)
+14 QUIT
End DoDot:4
+15 QUIT
End DoDot:3
+16 QUIT
End DoDot:2
+17 SET X=" "
DO S(X,1,1)
+18 SET X="Numerator(s):"
DO S(X,1,1)
+19 SET BGPNODE=$SELECT(BGPRTYPE=1:82,BGPRTYPE=4:62,BGPRTYPE=7:84,BGPRTYPE=9:86,1:62)
+20 SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPINDB(BGPIC,BGPNODE,"B",BGPX))
IF BGPX'=+BGPX
QUIT
Begin DoDot:2
+21 SET BGPY=0
FOR
SET BGPY=$ORDER(^BGPINDB(BGPIC,BGPNODE,"B",BGPX,BGPY))
IF BGPY'=+BGPY
QUIT
Begin DoDot:3
+22 ;I $P(^BGPINDB(BGPIC,62,BGPY,0),U,2)'[BGPRTYPE Q ;not a denom def for this report
+23 ;I BGPRTYPE=4,BGPINDB'="S",$P(^BGPINDB(BGPIC,62,BGPY,0),U,3)'[BGPINDB Q ;don't display
+24 ;I '$D(^BGPINDB(BGPIC,62,BGPY,11,"B",BGPRTYPE)) Q ;not this report type
+25 IF BGPRTYPE=4
IF '$DATA(^BGPINDB(BGPIC,BGPNODE,BGPY,12,"B",BGPINDB))
QUIT
+26 SET BGPZ=0
FOR
SET BGPZ=$ORDER(^BGPINDB(BGPIC,BGPNODE,BGPY,1,BGPZ))
IF BGPZ'=+BGPZ
QUIT
Begin DoDot:4
+27 SET X=^BGPINDB(BGPIC,BGPNODE,BGPY,1,BGPZ,0)
DO S(X,1,1)
+28 QUIT
End DoDot:4
+29 QUIT
End DoDot:3
+30 QUIT
End DoDot:2
+31 SET X=" "
DO S(X,1,1)
+32 SET BGPNODE=11
+33 IF BGPRTYPE=1
IF $ORDER(^BGPINDB(BGPIC,54,0))
SET BGPNODE=54
+34 IF BGPRTYPE=7
IF $ORDER(^BGPINDB(BGPIC,56,0))
SET BGPNODE=56
+35 IF BGPRTYPE=9
IF $ORDER(^BGPINDB(BGPIC,58,0))
SET BGPNODE=58
+36 SET X="Logic:"
DO S(X,1,1)
+37 SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPINDB(BGPIC,BGPNODE,BGPX))
IF BGPX'=+BGPX
QUIT
Begin DoDot:2
+38 SET X=^BGPINDB(BGPIC,BGPNODE,BGPX,0)
DO S(X,1,1)
End DoDot:2
+39 IF BGPRTYPE=9
GOTO CALC
+40 SET X=" "
DO S(X,1,1)
SET X="Performance Measure Description:"
DO S(X,1,1)
SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPINDB(BGPIC,$SELECT($GET(BGPNGR09):57,1:51),BGPX))
IF BGPX'=+BGPX
QUIT
Begin DoDot:2
+41 SET X=^BGPINDB(BGPIC,$SELECT($GET(BGPNGR09):57,1:51),BGPX,0)
DO S(X,1,1)
End DoDot:2
+42 IF $ORDER(^BGPINDB(BGPIC,52,0))
SET X=" "
DO S(X,1,1)
SET X="Past Performance and/or Target:"
DO S(X,1,1)
SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPINDB(BGPIC,52,BGPX))
IF BGPX'=+BGPX
QUIT
Begin DoDot:2
+43 SET X=^BGPINDB(BGPIC,52,BGPX,0)
DO S(X,1,1)
End DoDot:2
+44 IF $ORDER(^BGPINDB(BGPIC,55,0))
SET X=" "
DO S(X,1,1)
SET X="Source:"
DO S(X,1,1)
SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPINDB(BGPIC,55,BGPX))
IF BGPX'=+BGPX
QUIT
Begin DoDot:2
+45 SET X=^BGPINDB(BGPIC,55,BGPX,0)
DO S(X,1,1)
End DoDot:2
+46 IF '$ORDER(^BGPINDB(BGPIC,55,0))
DO S(" ",1,1)
CALC XECUTE ^BGPINDB(BGPIC,4)
End DoDot:1
+1 QUIT
+1 SET Y=$PIECE(^VA(200,DUZ,0),U,2)
SET $EXTRACT(Y,35)=$$FMTE^XLFDT(DT)
DO S(Y,1,1)
+2 IF BGPRTYPE=7
SET Y="*** IHS 2011 Other National Measures Report ***"
DO S(Y,1,1)
+3 IF BGPRTYPE=4
SET Y="*** IHS 2011 Clinical Performance Report ***"
DO S(Y,1,1)
+4 IF BGPRTYPE=1
IF '$GET(BGPNGR09)
SET Y="*** IHS 2011 National GPRA & PART Report ***"
DO S(Y,1,1)
+5 IF BGPRTYPE=1
IF $GET(BGPNGR09)
SET Y="*** IHS 2012 National GPRA & PART Report, Run Using 2011 Logic ***"
DO S(Y,1,1)
+6 IF $GET(BGPAREAA)
SET Y="AREA AGGREGATE"
DO S(Y,1,1)
+7 IF '$GET(BGPAREAA)
SET Y=$PIECE(^DIC(4,DUZ(2),0),U)
DO S(Y,1,1)
+8 ;S X=$$RPTVER^BGP1BAN D S(X,1,1)
+9 SET X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED)
DO S(X,1,1)
+10 SET X="Previous Year Period: "_$$FMTE^XLFDT(BGPPBD)_" to "_$$FMTE^XLFDT(BGPPED)
DO S(X,1,1)
+11 SET X="Baseline Period: "_$$FMTE^XLFDT(BGPBBD)_" to "_$$FMTE^XLFDT(BGPBED)
DO S(X,1,1)
+12 SET X=" "
DO S(X,1,1)
+13 IF $GET(BGPSUMP)
QUIT
+14 IF BGPRTYPE=1
SET X="Measures: GPRA, GPRA Developmental, and PART Denominators and Numerators and Selected Other Clinical Denominators and Numerators"
DO S(X,1,1)
+15 SET X=" "
DO S(X,1,1)
+16 IF BGPRTYPE=1
SET X="Population: AI/AN Only (Classification 01)"
DO S(X,1,1)
+17 SET X=" "
DO S(X,1,1)
+18 SET BGPI=$ORDER(^BGPCTRL("B",2011,0))
+19 SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPCTRL(BGPI,14,BGPX))
IF BGPX'=+BGPX
QUIT
Begin DoDot:1
+20 SET X=^BGPCTRL(BGPI,14,BGPX,0)
DO S(X,1,1)
End DoDot:1
+21 IF $GET(BGPEXPT)
SET X="A file will be created called BG11"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_"."_BGPRPT_"."
DO S(X,1,1)
+22 SET X="It will reside in the public/export directory. This file should be sent to your Area Office."
DO S(X,1,1)
+23 SET X=" "
DO S(X,1,1)
+24 IF $GET(BGPALLPT)
SET X="All Communities Included."
DO S(X,1,1)
+25 IF '$GET(BGPALLPT)
IF '$GET(BGPSEAT)
SET X="Community Taxonomy Name: "_$PIECE(^ATXAX(BGPTAXI,0),U)
DO S(X,1,1)
+26 IF '$GET(BGPALLPT)
IF '$GET(BGPSEAT)
SET X="The following communities are included in this report:"
DO S(X,1,1)
Begin DoDot:1
+27 SET BGPZZ=""
SET N=0
SET Y=""
FOR
SET BGPZZ=$ORDER(BGPTAX(BGPZZ))
IF BGPZZ=""
QUIT
SET N=N+1
SET Y=Y_$SELECT(N=1:"",1:";")_BGPZZ
+28 SET BGPZZ=0
SET C=0
FOR BGPZZ=1:3:N
Begin DoDot:2
+29 SET X=$EXTRACT($PIECE(Y,";",BGPZZ),1,20)
SET $EXTRACT(X,3)=$EXTRACT($PIECE(Y,";",(BGPZZ+1)),1,20)
SET $EXTRACT(X,60)=$EXTRACT($PIECE(Y,";",(BGPZZ+2)),1,20)
+30 QUIT
End DoDot:2
End DoDot:1
+31 IF $GET(BGPMFITI)
SET X="MFI Location Taxonomy Name: "_$PIECE(^ATXAX(BGPMFITI,0),U)
DO S(X,1,1)
+32 IF $GET(BGPMFITI)
SET X="The following locations are used for patient visits in this report:"
DO S(X,1,1)
Begin DoDot:1
+33 SET BGPZZ=""
SET N=0
SET Y=""
FOR
SET BGPZZ=$ORDER(^ATXAX(BGPMFITI,21,"B",BGPZZ))
IF BGPZZ=""
QUIT
SET N=N+1
SET Y=Y_$SELECT(N=1:"",1:";")_$PIECE($GET(^DIC(4,BGPZZ,0)),U)
+34 SET BGPZZ=0
SET C=0
FOR BGPZZ=1:3:N
Begin DoDot:2
+35 SET X=$EXTRACT($PIECE(Y,";",BGPZZ),1,20)
SET $EXTRACT(X,3)=$EXTRACT($PIECE(Y,";",(BGPZZ+1)),1,20)
SET $EXTRACT(X,60)=$EXTRACT($PIECE(Y,";",(BGPZZ+2)),1,20)
+36 QUIT
End DoDot:2
End DoDot:1
+37 KILL BGPX,BGPQUIT
+38 SET X=$TRANSLATE($JUSTIFY(""," ","-"),80)
DO S(X,1,1)
+39 QUIT
EXIT ;
+1 KILL ^TMP($JOB)
+2 QUIT
CTR(X,Y) ;EP - Center
+1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
+2 ;----------
USR() ;EP - Return user
+1 QUIT $SELECT($GET(DUZ):$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
+2 ;----------
S(Y,F,P) ;EP set up array
+1 IF '$GET(F)
SET F=0
+2 SET %=$PIECE(^TMP($JOB,"BGPDEL",0),U)+F
SET $PIECE(^TMP($JOB,"BGPDEL",0),U)=%
+3 IF '$DATA(^TMP($JOB,"BGPDEL",%))
SET ^TMP($JOB,"BGPDEL",%)=""
+4 SET $PIECE(^TMP($JOB,"BGPDEL",%),U,P)=Y
+5 QUIT
C(X,X2,X3) ;
+1 DO COMMA^%DTC
+2 QUIT X
