BGP0DS ; IHS/CMI/LAB - IHS gpra print ;
;;10.0;IHS CLINICAL REPORTING;;JUN 18, 2010
;
START ;
Q:$G(BGPAREAA)
Q:'$D(BGPLIST)
I $G(BGPNPL) Q
I $G(BGPCPPL) Q ;not on comprehensive pt
S BGPQUIT="",BGPGPG=0
;D HEADER
S BGPORDSE=0 F S BGPORDSE=$O(^BGPINDT("AOI",BGPORDSE)) Q:BGPORDSE'=+BGPORDSE!(BGPQUIT) S BGPL=$O(^BGPINDT("AOI",BGPORDSE,0)) I $D(BGPLIST(BGPL)) D
.S BGPFIRSP=1 S BGPCOUNT=0,BGPPCNT=0
.D HEADER Q:BGPQUIT
.S BGPCNT=$G(BGPLIST(BGPL))
.I 'BGPCNT S BGPCNT=0 G GO
.I BGPCNT<100 S BGPCNT=1 G GO
.I BGPLIST'="R" S BGPCNT=1 G GO
.;I BGPCNT<100 S BGPCNT=BGPCNT\10 G GO
.;I BGPCNT<100 G GO
.S BGPCNT=10
GO .;
.D WTITLE^BGP0DP(BGPL) ;W !,$P(^BGPINDT(BGPL,0),U,3),!
.D W^BGP0DP("Denominator(s):",0,1,BGPPTYPE)
.S BGPNODE=$S(BGPRTYPE=1:81,BGPRTYPE=4:61,BGPRTYPE=7:83,BGPRTYPE=9:85,1:61)
.S BGPX=0 F S BGPX=$O(^BGPINDT(BGPL,BGPNODE,"B",BGPX)) Q:BGPX'=+BGPX!(BGPQUIT) D
..S BGPY=0 F S BGPY=$O(^BGPINDT(BGPL,BGPNODE,"B",BGPX,BGPY)) Q:BGPY'=+BGPY!(BGPQUIT) D
...;I '$D(^BGPINDT(BGPL,BGPNODE,BGPY,11,"B",BGPRTYPE)) Q ;not this report type
...I BGPRTYPE=4,'$D(^BGPINDT(BGPL,BGPNODE,BGPY,12,"B",BGPINDT)) Q ;not this measure type on selected
...D WP
.I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER^BGP0DPH Q:BGPQUIT
.D W^BGP0DP("Numerator(s):",0,2,BGPPTYPE)
.S BGPNODE=$S(BGPRTYPE=1:82,BGPRTYPE=4:62,BGPRTYPE=7:84,BGPRTYPE=9:86,1:62)
.S BGPX=0 F S BGPX=$O(^BGPINDT(BGPL,BGPNODE,"B",BGPX)) Q:BGPX'=+BGPX!(BGPQUIT) D
..S BGPY=0 F S BGPY=$O(^BGPINDT(BGPL,BGPNODE,"B",BGPX,BGPY)) Q:BGPY'=+BGPY!(BGPQUIT) D
...;I '$D(^BGPINDT(BGPL,62,BGPY,11,"B",BGPRTYPE)) Q ;not this report type
...I BGPRTYPE=4,'$D(^BGPINDT(BGPL,BGPNODE,BGPY,12,"B",BGPINDT)) Q ;not this measure type on selected
...D WP
.S BGPNODE=11
.I BGPRTYPE=1,$O(^BGPINDT(BGPL,54,0)) S BGPNODE=54
.I BGPRTYPE=7,$O(^BGPINDT(BGPL,56,0)) S BGPNODE=56
.I BGPRTYPE=9,$O(^BGPINDT(BGPL,58,0)) S BGPNODE=58
.D W^BGP0DP("Logic:",0,2,BGPPTYPE) S BGPX=0 F S BGPX=$O(^BGPINDT(BGPL,BGPNODE,BGPX)) Q:BGPX'=+BGPX D
..I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER^BGP0DPH Q:BGPQUIT
..D W^BGP0DP(^BGPINDT(BGPL,BGPNODE,BGPX,0),0,1,BGPPTYPE)
.D W^BGP0DP("Performance Measure Description:",0,2,BGPPTYPE) S BGPX=0 F S BGPX=$O(^BGPINDT(BGPL,$S($G(BGPNGR09):57,1:51),BGPX)) Q:BGPX'=+BGPX D
..I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER^BGP0DPH Q:BGPQUIT
..D W^BGP0DP(^BGPINDT(BGPL,$S($G(BGPNGR09):57,1:51),BGPX,0),0,1,BGPPTYPE)
.I $O(^BGPINDT(BGPL,52,0)) D W^BGP0DP("Past Performance and/or Target:",0,2,BGPPTYPE) S BGPX=0 F S BGPX=$O(^BGPINDT(BGPL,52,BGPX)) Q:BGPX'=+BGPX D
..I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER^BGP0DPH Q:BGPQUIT
..D W^BGP0DP(^BGPINDT(BGPL,52,BGPX,0),0,1,BGPPTYPE)
.I $O(^BGPINDT(BGPL,55,0)) D W^BGP0DP("Source:",0,2,BGPPTYPE) S BGPX=0 F S BGPX=$O(^BGPINDT(BGPL,55,BGPX)) Q:BGPX'=+BGPX D
..I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER^BGP0DPH Q:BGPQUIT
..D W^BGP0DP(^BGPINDT(BGPL,55,BGPX,0),0,1,BGPPTYPE)
.I '$O(^BGPINDT(BGPL,55,0)) D W^BGP0DP("",0,1,BGPPTYPE)
.D H1
.Q:BGPQUIT
.S BGPCOM="" F S BGPCOM=$O(^XTMP("BGP0D",BGPJ,BGPH,"LIST",BGPL,BGPCOM)) Q:BGPCOM=""!(BGPQUIT) D
..S BGPSEX="" F S BGPSEX=$O(^XTMP("BGP0D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX)) Q:BGPSEX=""!(BGPQUIT) D
...S BGPAGE="" F S BGPAGE=$O(^XTMP("BGP0D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE)) Q:BGPAGE=""!(BGPQUIT) D
....S DFN=0 F S DFN=$O(^XTMP("BGP0D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN)) Q:DFN'=+DFN!(BGPQUIT) S BGPCOUNT=BGPCOUNT+1 D PRINTL
....Q
...Q
..Q
.I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
.D W^BGP0DP("Total # of Patients on list: "_+$G(BGPPCNT),0,2,BGPPTYPE)
.D W^BGP0DP("",0,1,BGPPTYPE)
D W^BGP0DP("",0,1,BGPPTYPE)
Q
WP ;
K ^UTILITY($J,"W")
S BGPZ=0,BGPLCNT=0
S DIWL=1,DIWR=80,DIWF="",BGPZ=0 F S BGPZ=$O(^BGPINDT(BGPL,BGPNODE,BGPY,1,BGPZ)) Q:BGPZ'=+BGPZ D
.S BGPLCNT=BGPLCNT+1
.S X=^BGPINDT(BGPL,BGPNODE,BGPY,1,BGPZ,0) S:BGPLCNT=1 X=" - "_X D ^DIWP
.Q
WPS ;
S Z=0 F S Z=$O(^UTILITY($J,"W",DIWL,Z)) Q:Z'=+Z D
.I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER^BGP0DPH Q:BGPQUIT
.D W^BGP0DP(^UTILITY($J,"W",DIWL,Z,0),0,1,BGPPTYPE)
K DIWL,DIWR,DIWF,Z
K ^UTILITY($J,"W"),X
Q
;
PRINTL ;print one line
Q:(BGPCOUNT#BGPCNT)
I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER Q:BGPQUIT D
.;S X=0 F S X=$O(^BGPINDT(BGPL,72,X)) Q:X'=+X W !,^BGPINDT(BGPL,72,X,0)
.D H1
Q:BGPQUIT
S BGPPCNT=BGPPCNT+1
I BGPPTYPE="P" W !,$E($P(^DPT(DFN,0),U),1,22),?24,$$HRN^AUPNPAT(DFN,DUZ(2)),?31,$E(BGPCOM,1,14),?46,BGPSEX,?49,BGPAGE D
.W ?53,$P(^XTMP("BGP0D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",1)
.W:BGPL=43 " NUMERATOR: "
.W ?65,$P(^XTMP("BGP0D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",2)
I BGPPTYPE="D" D
.S X=$E($P(^DPT(DFN,0),U),1,22)_U_$$HRN^AUPNPAT(DFN,DUZ(2))_U_$E(BGPCOM,1,14)_U_BGPSEX_U_BGPAGE
.S Y=$P(^XTMP("BGP0D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",1) S $P(X,U,6)=Y
.S Y=$P(^XTMP("BGP0D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",2) S $P(X,U,7)=Y
.D W^BGP0DP(X,0,1,BGPPTYPE)
Q
;
I BGPPTYPE'="P" G HEADER1
G:'BGPGPG HEADER1
K DIR I $E(IOST)="C",IO=IO(0),'$D(ZTQUEUED) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BGPQUIT=1 Q
I BGPPTYPE="P" W:$D(IOF) @IOF S BGPGPG=BGPGPG+1
I $G(BGPGUI),BGPPTYPE="P" D W^BGP0DP("ZZZZZZZ",0,1,BGPPTYPE) ;! ;maw
D W^BGP0DP("***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****",1,1,BGPPTYPE)
I BGPPTYPE="P" S X=$P(^VA(200,DUZ,0),U,2),$E(X,35)=$$FMTE^XLFDT(DT),$E(X,70)="Page "_BGPGPG D W^BGP0EOH(X,1,1,BGPPTYPE)
I BGPPTYPE'="P" S X=$P(^VA(200,DUZ,0),U,2),$P(X,U,2)=$$FMTE^XLFDT(DT) D W^BGP0DP(X,0,1,BGPPTYPE)
D W^BGP0DP("*** IHS 2010 Clinical Performance Measure Patient List ***",1,1,BGPPTYPE)
D W^BGP0DP($P(^DIC(4,DUZ(2),0),U),1,1,BGPPTYPE)
S X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED) D W^BGP0DP(X,1,1,BGPPTYPE)
D W^BGP0DP($S(BGPLIST="A":"Entire Patient List",BGPLIST="R":"Random Patient List",1:"Patient List by Provider: "_BGPLPROV),1,1,BGPPTYPE)
D W^BGP0DP($TR($J("",80)," ","-"),0,1,BGPPTYPE)
Q
H1 ;
S BGPTSUB=$S(BGPFIRSP:71,1:72)
S X=0,C=0 F S X=$O(^BGPINDT(BGPL,BGPTSUB,X)) Q:X'=+X S C=C+1
I BGPPTYPE="P",$Y>(BGPIOSL-(C+6)) D HEADER Q:BGPQUIT
D W^BGP0DP("UP=User Pop; AC=Active Clinical; AD=Active Diabetic; AAD=Active Adult Diabetic",0,1,BGPPTYPE)
D W^BGP0DP("PREG=Pregnant Female; IMM=Active IMM Pkg Pt; IHD=Active Ischemic Heart Disease",0,1,BGPPTYPE)
D W^BGP0DP("CHD=Active Coronary Heart Disease",0,1,BGPRTYPE)
D W^BGP0DP("",0,1,BGPPTYPE)
S X=0 F S X=$O(^BGPINDT(BGPL,BGPTSUB,X)) Q:X'=+X D W^BGP0DP(^BGPINDT(BGPL,BGPTSUB,X,0),0,1,BGPPTYPE)
D W^BGP0DP("",0,1,BGPPTYPE)
D W^BGP0DP("PATIENT NAME",0,1,BGPPTYPE,1)
D W^BGP0DP("HRN",0,0,BGPPTYPE,2,24) ;,?24,"HRN",
D W^BGP0DP("COMMUNITY",0,0,BGPPTYPE,3,31) ;?31,"COMMUNITY",
D W^BGP0DP("SEX",0,0,BGPPTYPE,4,45) ;?45,"SEX",
D W^BGP0DP("AGE",0,0,BGPPTYPE,5,49) ;?49,"AGE",
D W^BGP0DP("DENOMINATOR",0,0,BGPPTYPE,6,53) ;?53,"DENOMINATOR",
D W^BGP0DP("NUMERATOR",0,0,BGPPTYPE,7,65) ;?65,"NUMERATOR"
D W^BGP0DP($TR($J("",80)," ","-"),0,1,BGPPTYPE)
S BGPFIRSP=0
Q
BGP0DS ; IHS/CMI/LAB - IHS gpra print ;
+1 ;;10.0;IHS CLINICAL REPORTING;;JUN 18, 2010
+2 ;
START ;
+1 IF $GET(BGPAREAA)
QUIT
+2 IF '$DATA(BGPLIST)
QUIT
+3 IF $GET(BGPNPL)
QUIT
+4 ;not on comprehensive pt
IF $GET(BGPCPPL)
QUIT
+5 SET BGPQUIT=""
SET BGPGPG=0
+6 ;D HEADER
+7 SET BGPORDSE=0
FOR
SET BGPORDSE=$ORDER(^BGPINDT("AOI",BGPORDSE))
IF BGPORDSE'=+BGPORDSE!(BGPQUIT)
QUIT
SET BGPL=$ORDER(^BGPINDT("AOI",BGPORDSE,0))
IF $DATA(BGPLIST(BGPL))
Begin DoDot:1
+8 SET BGPFIRSP=1
SET BGPCOUNT=0
SET BGPPCNT=0
+9 DO HEADER
IF BGPQUIT
QUIT
+10 SET BGPCNT=$GET(BGPLIST(BGPL))
+11 IF 'BGPCNT
SET BGPCNT=0
GOTO GO
+12 IF BGPCNT<100
SET BGPCNT=1
GOTO GO
+13 IF BGPLIST'="R"
SET BGPCNT=1
GOTO GO
+14 ;I BGPCNT<100 S BGPCNT=BGPCNT\10 G GO
+15 ;I BGPCNT<100 G GO
+16 SET BGPCNT=10
GO ;
+1 ;W !,$P(^BGPINDT(BGPL,0),U,3),!
DO WTITLE^BGP0DP(BGPL)
+2 DO W^BGP0DP("Denominator(s):",0,1,BGPPTYPE)
+3 SET BGPNODE=$SELECT(BGPRTYPE=1:81,BGPRTYPE=4:61,BGPRTYPE=7:83,BGPRTYPE=9:85,1:61)
+4 SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPINDT(BGPL,BGPNODE,"B",BGPX))
IF BGPX'=+BGPX!(BGPQUIT)
QUIT
Begin DoDot:2
+5 SET BGPY=0
FOR
SET BGPY=$ORDER(^BGPINDT(BGPL,BGPNODE,"B",BGPX,BGPY))
IF BGPY'=+BGPY!(BGPQUIT)
QUIT
Begin DoDot:3
+6 ;I '$D(^BGPINDT(BGPL,BGPNODE,BGPY,11,"B",BGPRTYPE)) Q ;not this report type
+7 ;not this measure type on selected
IF BGPRTYPE=4
IF '$DATA(^BGPINDT(BGPL,BGPNODE,BGPY,12,"B",BGPINDT))
QUIT
+8 DO WP
End DoDot:3
End DoDot:2
+9 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-3)
DO HEADER^BGP0DPH
IF BGPQUIT
QUIT
+10 DO W^BGP0DP("Numerator(s):",0,2,BGPPTYPE)
+11 SET BGPNODE=$SELECT(BGPRTYPE=1:82,BGPRTYPE=4:62,BGPRTYPE=7:84,BGPRTYPE=9:86,1:62)
+12 SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPINDT(BGPL,BGPNODE,"B",BGPX))
IF BGPX'=+BGPX!(BGPQUIT)
QUIT
Begin DoDot:2
+13 SET BGPY=0
FOR
SET BGPY=$ORDER(^BGPINDT(BGPL,BGPNODE,"B",BGPX,BGPY))
IF BGPY'=+BGPY!(BGPQUIT)
QUIT
Begin DoDot:3
+14 ;I '$D(^BGPINDT(BGPL,62,BGPY,11,"B",BGPRTYPE)) Q ;not this report type
+15 ;not this measure type on selected
IF BGPRTYPE=4
IF '$DATA(^BGPINDT(BGPL,BGPNODE,BGPY,12,"B",BGPINDT))
QUIT
+16 DO WP
End DoDot:3
End DoDot:2
+17 SET BGPNODE=11
+18 IF BGPRTYPE=1
IF $ORDER(^BGPINDT(BGPL,54,0))
SET BGPNODE=54
+19 IF BGPRTYPE=7
IF $ORDER(^BGPINDT(BGPL,56,0))
SET BGPNODE=56
+20 IF BGPRTYPE=9
IF $ORDER(^BGPINDT(BGPL,58,0))
SET BGPNODE=58
+21 DO W^BGP0DP("Logic:",0,2,BGPPTYPE)
SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPINDT(BGPL,BGPNODE,BGPX))
IF BGPX'=+BGPX
QUIT
Begin DoDot:2
+22 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-3)
DO HEADER^BGP0DPH
IF BGPQUIT
QUIT
+23 DO W^BGP0DP(^BGPINDT(BGPL,BGPNODE,BGPX,0),0,1,BGPPTYPE)
End DoDot:2
+24 DO W^BGP0DP("Performance Measure Description:",0,2,BGPPTYPE)
SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPINDT(BGPL,$SELECT($GET(BGPNGR09):57,1:51),BGPX))
IF BGPX'=+BGPX
QUIT
Begin DoDot:2
+25 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-3)
DO HEADER^BGP0DPH
IF BGPQUIT
QUIT
+26 DO W^BGP0DP(^BGPINDT(BGPL,$SELECT($GET(BGPNGR09):57,1:51),BGPX,0),0,1,BGPPTYPE)
End DoDot:2
+27 IF $ORDER(^BGPINDT(BGPL,52,0))
DO W^BGP0DP("Past Performance and/or Target:",0,2,BGPPTYPE)
SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPINDT(BGPL,52,BGPX))
IF BGPX'=+BGPX
QUIT
Begin DoDot:2
+28 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-3)
DO HEADER^BGP0DPH
IF BGPQUIT
QUIT
+29 DO W^BGP0DP(^BGPINDT(BGPL,52,BGPX,0),0,1,BGPPTYPE)
End DoDot:2
+30 IF $ORDER(^BGPINDT(BGPL,55,0))
DO W^BGP0DP("Source:",0,2,BGPPTYPE)
SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPINDT(BGPL,55,BGPX))
IF BGPX'=+BGPX
QUIT
Begin DoDot:2
+31 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-3)
DO HEADER^BGP0DPH
IF BGPQUIT
QUIT
+32 DO W^BGP0DP(^BGPINDT(BGPL,55,BGPX,0),0,1,BGPPTYPE)
End DoDot:2
+33 IF '$ORDER(^BGPINDT(BGPL,55,0))
DO W^BGP0DP("",0,1,BGPPTYPE)
+34 DO H1
+35 IF BGPQUIT
QUIT
+36 SET BGPCOM=""
FOR
SET BGPCOM=$ORDER(^XTMP("BGP0D",BGPJ,BGPH,"LIST",BGPL,BGPCOM))
IF BGPCOM=""!(BGPQUIT)
QUIT
Begin DoDot:2
+37 SET BGPSEX=""
FOR
SET BGPSEX=$ORDER(^XTMP("BGP0D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX))
IF BGPSEX=""!(BGPQUIT)
QUIT
Begin DoDot:3
+38 SET BGPAGE=""
FOR
SET BGPAGE=$ORDER(^XTMP("BGP0D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE))
IF BGPAGE=""!(BGPQUIT)
QUIT
Begin DoDot:4
+39 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("BGP0D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN))
IF DFN'=+DFN!(BGPQUIT)
QUIT
SET BGPCOUNT=BGPCOUNT+1
DO PRINTL
+40 QUIT
End DoDot:4
+41 QUIT
End DoDot:3
+42 QUIT
End DoDot:2
+43 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-3)
DO HEADER
IF BGPQUIT
QUIT
+44 DO W^BGP0DP("Total # of Patients on list: "_+$GET(BGPPCNT),0,2,BGPPTYPE)
+45 DO W^BGP0DP("",0,1,BGPPTYPE)
End DoDot:1
+46 DO W^BGP0DP("",0,1,BGPPTYPE)
+47 QUIT
WP ;
+1 KILL ^UTILITY($JOB,"W")
+2 SET BGPZ=0
SET BGPLCNT=0
+3 SET DIWL=1
SET DIWR=80
SET DIWF=""
SET BGPZ=0
FOR
SET BGPZ=$ORDER(^BGPINDT(BGPL,BGPNODE,BGPY,1,BGPZ))
IF BGPZ'=+BGPZ
QUIT
Begin DoDot:1
+4 SET BGPLCNT=BGPLCNT+1
+5 SET X=^BGPINDT(BGPL,BGPNODE,BGPY,1,BGPZ,0)
IF BGPLCNT=1
SET X=" - "_X
DO ^DIWP
+6 QUIT
End DoDot:1
WPS ;
+1 SET Z=0
FOR
SET Z=$ORDER(^UTILITY($JOB,"W",DIWL,Z))
IF Z'=+Z
QUIT
Begin DoDot:1
+2 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-3)
DO HEADER^BGP0DPH
IF BGPQUIT
QUIT
+3 DO W^BGP0DP(^UTILITY($JOB,"W",DIWL,Z,0),0,1,BGPPTYPE)
End DoDot:1
+4 KILL DIWL,DIWR,DIWF,Z
+5 KILL ^UTILITY($JOB,"W"),X
+6 QUIT
+7 ;
PRINTL ;print one line
+1 IF (BGPCOUNT#BGPCNT)
QUIT
+2 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-3)
DO HEADER
IF BGPQUIT
QUIT
Begin DoDot:1
+3 ;S X=0 F S X=$O(^BGPINDT(BGPL,72,X)) Q:X'=+X W !,^BGPINDT(BGPL,72,X,0)
+4 DO H1
End DoDot:1
+5 IF BGPQUIT
QUIT
+6 SET BGPPCNT=BGPPCNT+1
+7 IF BGPPTYPE="P"
WRITE !,$EXTRACT($PIECE(^DPT(DFN,0),U),1,22),?24,$$HRN^AUPNPAT(DFN,DUZ(2)),?31,$EXTRACT(BGPCOM,1,14),?46,BGPSEX,?49,BGPAGE
Begin DoDot:1
+8 WRITE ?53,$PIECE(^XTMP("BGP0D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",1)
+9 IF BGPL=43
WRITE " NUMERATOR: "
+10 WRITE ?65,$PIECE(^XTMP("BGP0D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",2)
End DoDot:1
+11 IF BGPPTYPE="D"
Begin DoDot:1
+12 SET X=$EXTRACT($PIECE(^DPT(DFN,0),U),1,22)_U_$$HRN^AUPNPAT(DFN,DUZ(2))_U_$EXTRACT(BGPCOM,1,14)_U_BGPSEX_U_BGPAGE
+13 SET Y=$PIECE(^XTMP("BGP0D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",1)
SET $PIECE(X,U,6)=Y
+14 SET Y=$PIECE(^XTMP("BGP0D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",2)
SET $PIECE(X,U,7)=Y
+15 DO W^BGP0DP(X,0,1,BGPPTYPE)
End DoDot:1
+16 QUIT
+17 ;
+1 IF BGPPTYPE'="P"
GOTO HEADER1
+2 IF 'BGPGPG
GOTO HEADER1
+3 KILL DIR
IF $EXTRACT(IOST)="C"
IF IO=IO(0)
IF '$DATA(ZTQUEUED)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET BGPQUIT=1
QUIT
+1 IF BGPPTYPE="P"
IF $DATA(IOF)
WRITE @IOF
SET BGPGPG=BGPGPG+1
+2 ;! ;maw
IF $GET(BGPGUI)
IF BGPPTYPE="P"
DO W^BGP0DP("ZZZZZZZ",0,1,BGPPTYPE)
+3 DO W^BGP0DP("***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****",1,1,BGPPTYPE)
+4 IF BGPPTYPE="P"
SET X=$PIECE(^VA(200,DUZ,0),U,2)
SET $EXTRACT(X,35)=$$FMTE^XLFDT(DT)
SET $EXTRACT(X,70)="Page "_BGPGPG
DO W^BGP0EOH(X,1,1,BGPPTYPE)
+5 IF BGPPTYPE'="P"
SET X=$PIECE(^VA(200,DUZ,0),U,2)
SET $PIECE(X,U,2)=$$FMTE^XLFDT(DT)
DO W^BGP0DP(X,0,1,BGPPTYPE)
+6 DO W^BGP0DP("*** IHS 2010 Clinical Performance Measure Patient List ***",1,1,BGPPTYPE)
+7 DO W^BGP0DP($PIECE(^DIC(4,DUZ(2),0),U),1,1,BGPPTYPE)
+8 SET X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED)
DO W^BGP0DP(X,1,1,BGPPTYPE)
+9 DO W^BGP0DP($SELECT(BGPLIST="A":"Entire Patient List",BGPLIST="R":"Random Patient List",1:"Patient List by Provider: "_BGPLPROV),1,1,BGPPTYPE)
+10 DO W^BGP0DP($TRANSLATE($JUSTIFY("",80)," ","-"),0,1,BGPPTYPE)
+11 QUIT
H1 ;
+1 SET BGPTSUB=$SELECT(BGPFIRSP:71,1:72)
+2 SET X=0
SET C=0
FOR
SET X=$ORDER(^BGPINDT(BGPL,BGPTSUB,X))
IF X'=+X
QUIT
SET C=C+1
+3 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-(C+6))
DO HEADER
IF BGPQUIT
QUIT
+4 DO W^BGP0DP("UP=User Pop; AC=Active Clinical; AD=Active Diabetic; AAD=Active Adult Diabetic",0,1,BGPPTYPE)
+5 DO W^BGP0DP("PREG=Pregnant Female; IMM=Active IMM Pkg Pt; IHD=Active Ischemic Heart Disease",0,1,BGPPTYPE)
+6 DO W^BGP0DP("CHD=Active Coronary Heart Disease",0,1,BGPRTYPE)
+7 DO W^BGP0DP("",0,1,BGPPTYPE)
+8 SET X=0
FOR
SET X=$ORDER(^BGPINDT(BGPL,BGPTSUB,X))
IF X'=+X
QUIT
DO W^BGP0DP(^BGPINDT(BGPL,BGPTSUB,X,0),0,1,BGPPTYPE)
+9 DO W^BGP0DP("",0,1,BGPPTYPE)
+10 DO W^BGP0DP("PATIENT NAME",0,1,BGPPTYPE,1)
+11 ;,?24,"HRN",
DO W^BGP0DP("HRN",0,0,BGPPTYPE,2,24)
+12 ;?31,"COMMUNITY",
DO W^BGP0DP("COMMUNITY",0,0,BGPPTYPE,3,31)
+13 ;?45,"SEX",
DO W^BGP0DP("SEX",0,0,BGPPTYPE,4,45)
+14 ;?49,"AGE",
DO W^BGP0DP("AGE",0,0,BGPPTYPE,5,49)
+15 ;?53,"DENOMINATOR",
DO W^BGP0DP("DENOMINATOR",0,0,BGPPTYPE,6,53)
+16 ;?65,"NUMERATOR"
DO W^BGP0DP("NUMERATOR",0,0,BGPPTYPE,7,65)
+17 DO W^BGP0DP($TRANSLATE($JUSTIFY("",80)," ","-"),0,1,BGPPTYPE)
+18 SET BGPFIRSP=0
+19 QUIT
