BGP0DCLP ; IHS/CMI/LAB - IHS gpra print ;
;;10.0;IHS CLINICAL REPORTING;;JUN 18, 2010
;
CPPL1 ;EP
Q:$G(BGPAREAA)
;
S BGPCNT=BGPCPLC,BGPPCNT=0
I BGPCNT<11!(BGPLIST'="R") S BGPCNT=1 G GO
I BGPCNT<100 S BGPCNT=BGPCNT\10 G GO
S BGPCNT=10
GO ;
S BGPQUIT="",BGPGPG=0,BGP0H1P=1
S BGP1L=1 D HEADER
S BGPY=$O(^BGPCTRL("B",2010,0))
S BGPX=0 F S BGPX=$O(^BGPCTRL(BGPY,28,BGPX)) Q:BGPX'=+BGPX!(BGPQUIT) D
.I BGPPTYPE="P",$Y>(IOSL-2) D HEADER Q:BGPQUIT
.D W^BGP0DP(^BGPCTRL(BGPY,28,BGPX,0),0,1,BGPPTYPE)
S BGP1L=0
D HEADER
S BGPCOM="",BGPCOUNT=0 F S BGPCOM=$O(^XTMP("BGP08CPL",BGPJ,BGPH,"LIST",BGPCOM)) Q:BGPCOM=""!(BGPQUIT) D CPL1
D W^BGP0DP("Total # of patients on list: "_+$G(BGPPCNT),0,2,BGPPTYPE)
D W^BGP0DP("",0,1,BGPPTYPE)
Q
CPL1 ;EP
S BGPSEX="" F S BGPSEX=$O(^XTMP("BGP08CPL",BGPJ,BGPH,"LIST",BGPCOM,BGPSEX)) Q:BGPSEX=""!(BGPQUIT) D CPL2
Q
CPL2 ;
S BGPAGE="" F S BGPAGE=$O(^XTMP("BGP08CPL",BGPJ,BGPH,"LIST",BGPCOM,BGPSEX,BGPAGE)) Q:BGPAGE=""!(BGPQUIT) D
.S DFN=0 F S DFN=$O(^XTMP("BGP08CPL",BGPJ,BGPH,"LIST",BGPCOM,BGPSEX,BGPAGE,DFN)) Q:DFN'=+DFN!(BGPQUIT) S BGPCOUNT=BGPCOUNT+1 D PRINTL
.I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
Q
PRINTL ;print one line
Q:(BGPCOUNT#BGPCNT)
I BGPPTYPE="P",$Y>(BGPIOSL-2) D HEADER Q:BGPQUIT
S BGPPCNT=BGPPCNT+1
D W^BGP0DP($E($P(^DPT(DFN,0),U),1,22),0,1,BGPPTYPE,1)
D W^BGP0DP($$HRN^AUPNPAT(DFN,DUZ(2)),0,0,BGPPTYPE,2,24)
D W^BGP0DP($E(BGPCOM,1,14),0,0,BGPPTYPE,3,31)
D W^BGP0DP(BGPSEX,0,0,BGPPTYPE,4,46)
D W^BGP0DP(BGPAGE,0,0,BGPPTYPE,5,49)
S W="",X=$P(^XTMP("BGP08CPL",BGPJ,BGPH,"LIST",BGPCOM,BGPSEX,BGPAGE,DFN),"|||",1) F Y=1:1:12 I $P(X,"$$",Y)]"" S:W]"" W=W_"," S W=W_$P(X,"$$",Y)
S Z="",X=$P(^XTMP("BGP08CPL",BGPJ,BGPH,"LIST",BGPCOM,BGPSEX,BGPAGE,DFN),"|||",2) F Y=1:1 Q:$P(X,"#",Y)="" S:Z]"" Z=Z_", " S Z=Z_$P(X,"#",Y)
D W^BGP0DP(W,0,0,BGPPTYPE,6,53)
D W^BGP0DP(Z_$S(BGPPTYPE="P":"/",1:""),0,0,BGPPTYPE,7,53)
D W^BGP0DP($$LAST(DFN,BGPED),0,0,BGPPTYPE,8,65)
Q
;
LAST(P,EDATE) ;EP
I '$D(^AUPNVSIT("AC",P)) Q ""
K ^TMP($J,"A")
S A="^TMP($J,""A"",",B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT($$FMADD^XLFDT(EDATE,-(365*3)))_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(B,A)
I '$D(^TMP($J,"A",1)) Q ""
K ^TMP($J,"A","VDO")
S (X,G)=0 F S X=$O(^TMP($J,"A",X)) Q:X'=+X S V=$P(^TMP($J,"A",X),U,5) S ^TMP($J,"A","VDO",(9999999-$P($P(^AUPNVSIT(V,0),U),".")),X)=^TMP($J,"A",X)
S (X,G,D)=0 F S D=$O(^TMP($J,"A","VDO",D)) Q:D'=+D!(G) S X=0 F S X=$O(^TMP($J,"A","VDO",D,X)) Q:X'=+X!(G) S V=$P(^TMP($J,"A",X),U,5) D
.Q:'$D(^AUPNVSIT(V,0))
.Q:'$P(^AUPNVSIT(V,0),U,9)
.Q:$P(^AUPNVSIT(V,0),U,11)
.Q:'$D(^AUPNVPRV("AD",V))
.Q:"SAHO"'[$P(^AUPNVSIT(V,0),U,7)
.;Q:"V"[$P(^AUPNVSIT(V,0),U,3)
.Q:$P(^AUPNVSIT(V,0),U,6)=""
.;I $G(BGPMFITI),'$D(^ATXAX(BGPMFITI,21,"B",$P(^AUPNVSIT(V,0),U,6))) Q
.S G=V
.Q
I G Q $$PRIMPROV^APCLV(G,"N")_","_$S($$PRIMPROV^APCLV(G,"F"):$P(^DIC(7,+$$PRIMPROV^APCLV(G,"F"),0),U,2),1:"")_","_$$DATE^BGP0UTL($P($P(^AUPNVSIT(G,0),U),"."))
Q ""
I BGPPTYPE="D" 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 BGPPTYPE="P",$G(BGPGUI) D W^BGP0DP("ZZZZZZZ",0,1,BGPPTYPE) ;! ;maw
D W^BGP0DP("***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****",1,$S(BGPPTYPE="D":3,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)
D W^BGP0DP("*** IHS 2010 Comprehensive National GPRA & PART Patient List ***",1,1,BGPPTYPE)
D W^BGP0DP("*** List of Patients Not Meeting a National GPRA or PART measure ***",1,1,BGPPTYPE)
D W^BGP0DP($$RPTVER^BGP0BAN,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":"All Patients",BGPLIST="R":"Random Patient List",1:"Patient List by Provider: "_BGPLPROV),1,1,BGPPTYPE)
D W^BGP0DP($TR($J("",80)," ","-"),0,1,BGPPTYPE)
Q:BGP1L
H1 ;
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("",0,1,BGPPTYPE)
D W^BGP0DP("PATIENT NAME",0,1,BGPPTYPE)
D W^BGP0DP("HRN",0,0,BGPPTYPE,2,24)
D W^BGP0DP("COMMUNITY",0,0,BGPPTYPE,3,31)
D W^BGP0DP("SEX",0,0,BGPPTYPE,4,45)
D W^BGP0DP("AGE",0,0,BGPPTYPE,5,49)
D W^BGP0DP("DENOMINATOR",0,0,BGPPTYPE,6,53)
D W^BGP0DP("NOT MET/LST PRVDR",0,0,BGPPTYPE,7,65)
D W^BGP0DP($TR($J("",80)," ","-"),0,1,BGPPTYPE)
Q
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
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")
;----------
BGP0DCLP ; IHS/CMI/LAB - IHS gpra print ;
+1 ;;10.0;IHS CLINICAL REPORTING;;JUN 18, 2010
+2 ;
CPPL1 ;EP
+1 IF $GET(BGPAREAA)
QUIT
+2 ;
+3 SET BGPCNT=BGPCPLC
SET BGPPCNT=0
+4 IF BGPCNT<11!(BGPLIST'="R")
SET BGPCNT=1
GOTO GO
+5 IF BGPCNT<100
SET BGPCNT=BGPCNT\10
GOTO GO
+6 SET BGPCNT=10
GO ;
+1 SET BGPQUIT=""
SET BGPGPG=0
SET BGP0H1P=1
+2 SET BGP1L=1
DO HEADER
+3 SET BGPY=$ORDER(^BGPCTRL("B",2010,0))
+4 SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPCTRL(BGPY,28,BGPX))
IF BGPX'=+BGPX!(BGPQUIT)
QUIT
Begin DoDot:1
+5 IF BGPPTYPE="P"
IF $Y>(IOSL-2)
DO HEADER
IF BGPQUIT
QUIT
+6 DO W^BGP0DP(^BGPCTRL(BGPY,28,BGPX,0),0,1,BGPPTYPE)
End DoDot:1
+7 SET BGP1L=0
+8 DO HEADER
+9 SET BGPCOM=""
SET BGPCOUNT=0
FOR
SET BGPCOM=$ORDER(^XTMP("BGP08CPL",BGPJ,BGPH,"LIST",BGPCOM))
IF BGPCOM=""!(BGPQUIT)
QUIT
DO CPL1
+10 DO W^BGP0DP("Total # of patients on list: "_+$GET(BGPPCNT),0,2,BGPPTYPE)
+11 DO W^BGP0DP("",0,1,BGPPTYPE)
+12 QUIT
CPL1 ;EP
+1 SET BGPSEX=""
FOR
SET BGPSEX=$ORDER(^XTMP("BGP08CPL",BGPJ,BGPH,"LIST",BGPCOM,BGPSEX))
IF BGPSEX=""!(BGPQUIT)
QUIT
DO CPL2
+2 QUIT
CPL2 ;
+1 SET BGPAGE=""
FOR
SET BGPAGE=$ORDER(^XTMP("BGP08CPL",BGPJ,BGPH,"LIST",BGPCOM,BGPSEX,BGPAGE))
IF BGPAGE=""!(BGPQUIT)
QUIT
Begin DoDot:1
+2 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("BGP08CPL",BGPJ,BGPH,"LIST",BGPCOM,BGPSEX,BGPAGE,DFN))
IF DFN'=+DFN!(BGPQUIT)
QUIT
SET BGPCOUNT=BGPCOUNT+1
DO PRINTL
+3 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-3)
DO HEADER
IF BGPQUIT
QUIT
End DoDot:1
+4 QUIT
PRINTL ;print one line
+1 IF (BGPCOUNT#BGPCNT)
QUIT
+2 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-2)
DO HEADER
IF BGPQUIT
QUIT
+3 SET BGPPCNT=BGPPCNT+1
+4 DO W^BGP0DP($EXTRACT($PIECE(^DPT(DFN,0),U),1,22),0,1,BGPPTYPE,1)
+5 DO W^BGP0DP($$HRN^AUPNPAT(DFN,DUZ(2)),0,0,BGPPTYPE,2,24)
+6 DO W^BGP0DP($EXTRACT(BGPCOM,1,14),0,0,BGPPTYPE,3,31)
+7 DO W^BGP0DP(BGPSEX,0,0,BGPPTYPE,4,46)
+8 DO W^BGP0DP(BGPAGE,0,0,BGPPTYPE,5,49)
+9 SET W=""
SET X=$PIECE(^XTMP("BGP08CPL",BGPJ,BGPH,"LIST",BGPCOM,BGPSEX,BGPAGE,DFN),"|||",1)
FOR Y=1:1:12
IF $PIECE(X,"$$",Y)]""
IF W]""
SET W=W_","
SET W=W_$PIECE(X,"$$",Y)
+10 SET Z=""
SET X=$PIECE(^XTMP("BGP08CPL",BGPJ,BGPH,"LIST",BGPCOM,BGPSEX,BGPAGE,DFN),"|||",2)
FOR Y=1:1
IF $PIECE(X,"#",Y)=""
QUIT
IF Z]""
SET Z=Z_", "
SET Z=Z_$PIECE(X,"#",Y)
+11 DO W^BGP0DP(W,0,0,BGPPTYPE,6,53)
+12 DO W^BGP0DP(Z_$SELECT(BGPPTYPE="P":"/",1:""),0,0,BGPPTYPE,7,53)
+13 DO W^BGP0DP($$LAST(DFN,BGPED),0,0,BGPPTYPE,8,65)
+14 QUIT
+15 ;
LAST(P,EDATE) ;EP
+1 IF '$DATA(^AUPNVSIT("AC",P))
QUIT ""
+2 KILL ^TMP($JOB,"A")
+3 SET A="^TMP($J,""A"","
SET B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT($$FMADD^XLFDT(EDATE,-(365*3)))_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(B,A)
+4 IF '$DATA(^TMP($JOB,"A",1))
QUIT ""
+5 KILL ^TMP($JOB,"A","VDO")
+6 SET (X,G)=0
FOR
SET X=$ORDER(^TMP($JOB,"A",X))
IF X'=+X
QUIT
SET V=$PIECE(^TMP($JOB,"A",X),U,5)
SET ^TMP($JOB,"A","VDO",(9999999-$PIECE($PIECE(^AUPNVSIT(V,0),U),".")),X)=^TMP($JOB,"A",X)
+7 SET (X,G,D)=0
FOR
SET D=$ORDER(^TMP($JOB,"A","VDO",D))
IF D'=+D!(G)
QUIT
SET X=0
FOR
SET X=$ORDER(^TMP($JOB,"A","VDO",D,X))
IF X'=+X!(G)
QUIT
SET V=$PIECE(^TMP($JOB,"A",X),U,5)
Begin DoDot:1
+8 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+9 IF '$PIECE(^AUPNVSIT(V,0),U,9)
QUIT
+10 IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+11 IF '$DATA(^AUPNVPRV("AD",V))
QUIT
+12 IF "SAHO"'[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+13 ;Q:"V"[$P(^AUPNVSIT(V,0),U,3)
+14 IF $PIECE(^AUPNVSIT(V,0),U,6)=""
QUIT
+15 ;I $G(BGPMFITI),'$D(^ATXAX(BGPMFITI,21,"B",$P(^AUPNVSIT(V,0),U,6))) Q
+16 SET G=V
+17 QUIT
End DoDot:1
+18 IF G
QUIT $$PRIMPROV^APCLV(G,"N")_","_$SELECT($$PRIMPROV^APCLV(G,"F"):$PIECE(^DIC(7,+$$PRIMPROV^APCLV(G,"F"),0),U,2),1:"")_","_$$DATE^BGP0UTL($PIECE($PIECE(^AUPNVSIT(G,0),U),"."))
+19 QUIT ""
+1 IF BGPPTYPE="D"
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 BGPPTYPE="P"
IF $GET(BGPGUI)
DO W^BGP0DP("ZZZZZZZ",0,1,BGPPTYPE)
+3 DO W^BGP0DP("***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****",1,$SELECT(BGPPTYPE="D":3,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 DO W^BGP0DP("*** IHS 2010 Comprehensive National GPRA & PART Patient List ***",1,1,BGPPTYPE)
+6 DO W^BGP0DP("*** List of Patients Not Meeting a National GPRA or PART measure ***",1,1,BGPPTYPE)
+7 DO W^BGP0DP($$RPTVER^BGP0BAN,1,1,BGPPTYPE)
+8 DO W^BGP0DP($PIECE(^DIC(4,DUZ(2),0),U),1,1,BGPPTYPE)
+9 SET X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED)
DO W^BGP0DP(X,1,1,BGPPTYPE)
+10 DO W^BGP0DP($SELECT(BGPLIST="A":"All Patients",BGPLIST="R":"Random Patient List",1:"Patient List by Provider: "_BGPLPROV),1,1,BGPPTYPE)
+11 DO W^BGP0DP($TRANSLATE($JUSTIFY("",80)," ","-"),0,1,BGPPTYPE)
+12 IF BGP1L
QUIT
H1 ;
+1 DO W^BGP0DP("UP=User Pop; AC=Active Clinical; AD=Active Diabetic; AAD=Active Adult Diabetic",0,1,BGPPTYPE)
+2 DO W^BGP0DP("PREG=Pregnant Female; IMM=Active IMM Pkg Pt; IHD=Active Ischemic Heart Disease",0,1,BGPPTYPE)
+3 DO W^BGP0DP("",0,1,BGPPTYPE)
+4 DO W^BGP0DP("PATIENT NAME",0,1,BGPPTYPE)
+5 DO W^BGP0DP("HRN",0,0,BGPPTYPE,2,24)
+6 DO W^BGP0DP("COMMUNITY",0,0,BGPPTYPE,3,31)
+7 DO W^BGP0DP("SEX",0,0,BGPPTYPE,4,45)
+8 DO W^BGP0DP("AGE",0,0,BGPPTYPE,5,49)
+9 DO W^BGP0DP("DENOMINATOR",0,0,BGPPTYPE,6,53)
+10 DO W^BGP0DP("NOT MET/LST PRVDR",0,0,BGPPTYPE,7,65)
+11 DO W^BGP0DP($TRANSLATE($JUSTIFY("",80)," ","-"),0,1,BGPPTYPE)
+12 QUIT
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 ;----------
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 ;----------
