BGP2NPLP ; IHS/CMI/LAB - IHS gpra print 30 Jun 2010 5:58 PM ;
;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
;
NPL ;
Q:$G(BGPAREAA)
S BGPQUIT="",BGPGPG=0
S BGPINDW=0,BGPCOUNT=0
S BGPINDW=0 F S BGPINDW=$O(BGPINDL(BGPINDW)) Q:BGPINDW'=+BGPINDW D
.S BGPORD=$P($G(^BGPINDW(BGPINDW,12)),U,6)
.S BGPLIEN=0 F S BGPLIEN=$O(BGPINDW(BGPINDW,BGPLIEN)) Q:BGPLIEN'=+BGPLIEN D
..S BGPLORD=$S(BGPRTYPE=1:$P(^BGPNPLW(BGPLIEN,0),U,5),1:$P(^BGPNPLW(BGPLIEN,0),U,6))
..S BGPINDW("AOI",BGPORD,BGPINDW,BGPLORD,BGPLIEN)=""
S BGPORD=0 F S BGPORD=$O(BGPINDL("AOI",BGPORD)) Q:BGPORD=""!(BGPQUIT) D
.S BGPINDW=$O(BGPINDL("AOI",BGPORD,0))
.S BGPLORD=0 F S BGPLORD=$O(BGPINDL("AOI",BGPORD,BGPINDW,BGPLORD)) Q:BGPLORD=""!(BGPQUIT) D
..S BGPLIEN=$O(BGPINDL("AOI",BGPORD,BGPINDW,BGPLORD,0))
..;I '$$ANYPATS(BGPINDW,BGPINDII) D HEADER W !!,"No Patients to Report.",! Q
..D NPL11 ;F S BGPINDW=$O(^XTMP("BGP2DNP",BGPJ,BGPH,"LIST",BGPINDW)) Q:BGPINDW'=+BGPINDW!(BGPQUIT) D NPL1
Q
ANYPATS(I,L) ;
NEW O,G
S G=""
S O=0 F S O=$O(^XTMP("BGP2DNP",BGJP,BGPH,"LIST",BGPINDW,O)) Q:O'=+O D
.I $D(^XTMP("BGP2DNP",BGPJ,BGPH,"LIST",BGPINDW,O,BGPL)) S G=1
.Q
Q
NPL1 ;EP
Q:$G(BGPAREAA)
S BGPCR=$S(BGPRTYPE=7:"AON",1:"AN")
S BGPORD=$P(^BGPINDW(BGPINDW,12),U,6)
S BGPLORD=0 F S BGPLORD=$O(^BGPNPLW(BGPCR,BGPINDW,BGPLORD)) Q:BGPLORD'=+BGPLORD D
.S BGPLIEN=$O(^BGPNPLW(BGPCR,BGPINDW,BGPLORD,0)) Q:'BGPLIEN
.I BGPRTYPE=1!(BGPRTYPE=9) Q:BGPRTYPE'=$P(^BGPNPLW(BGPLIEN,0),U,7)
.Q:'$D(BGPINDL(BGPINDW,BGPLIEN))
.I '$D(^XTMP("BGP2DNP",BGPJ,BGPH,"LIST",BGPORD,BGPINDW,BGPLORD,BGPLIEN)) D Q
..D HEADER
..S X=0 F S X=$O(^BGPNPLW(BGPLIEN,11,X)) Q:X'=+X D W^BGP2DP(^BGPNPLW(BGPLIEN,11,X,0),0,1,BGPPTYPE)
..D H1
..D W^BGP2DP(" ",0,0,BGPRTYPE)
..D W^BGP2DP("Total # of patients on list: 0",0,0,BGPPTYPE)
.D NPL11
Q
NPL11 ;
D ;S BGPLIEN=0 F S BGPLIEN=$O(^XTMP("BGP2DNP",BGPJ,BGPH,"LIST",BGPORD,BGPINDW,BGPLORD,BGPLIEN)) Q:BGPLIEN'=+BGPLIEN!(BGPQUIT) D
.I BGPRTYPE=1!(BGPRTYPE=9) Q:BGPRTYPE'=$P(^BGPNPLW(BGPLIEN,0),U,7)
.;I BGPRTYPE="" S BGPRTYPE=1
.S BGPCOUNT=0,BGPPCNT=0
.D HEADER Q:BGPQUIT
.;I BGPPTYPE="D" D W^BGP2DP("",0,3,BGPPTYPE)
.S BGPCNT=BGPINDL(BGPINDW,BGPLIEN)
.I BGPCNT<11!(BGPLIST'="R") S BGPCNT=1 G GO
.I BGPCNT<100 S BGPCNT=BGPCNT\10 G GO
.S BGPCNT=10
GO .;
.D WTITLE^BGP2DP(BGPINDW) ;W !,$P(^BGPINDW(BGPINDW,0),U,3)
NEXT .;
.S BGPX=0 F S BGPX=$O(^BGPNPLW(BGPLIEN,11,BGPX)) Q:BGPX'=+BGPX D
..I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
..D W^BGP2DP(^BGPNPLW(BGPLIEN,11,BGPX,0),0,1,BGPPTYPE)
.D H1
.;I '$D(^XTMP("BGP2DNP",BGPJ,BGPH,"LIST",BGPORD,BGPINDW,BGPLORD,BGPLIEN)) W !!,"No patients to report.",! Q
.S BGPCOM="" F S BGPCOM=$O(^XTMP("BGP2DNP",BGPJ,BGPH,"LIST",BGPORD,BGPINDW,BGPLORD,BGPLIEN,BGPCOM)) Q:BGPCOM=""!(BGPQUIT) D
..S BGPSEX="" F S BGPSEX=$O(^XTMP("BGP2DNP",BGPJ,BGPH,"LIST",BGPORD,BGPINDW,BGPLORD,BGPLIEN,BGPCOM,BGPSEX)) Q:BGPSEX=""!(BGPQUIT) D
...S BGPAGE="" F S BGPAGE=$O(^XTMP("BGP2DNP",BGPJ,BGPH,"LIST",BGPORD,BGPINDW,BGPLORD,BGPLIEN,BGPCOM,BGPSEX,BGPAGE)) Q:BGPAGE=""!(BGPQUIT) D
....S DFN=0 F S DFN=$O(^XTMP("BGP2DNP",BGPJ,BGPH,"LIST",BGPORD,BGPINDW,BGPLORD,BGPLIEN,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^BGP2DP("Total # of patients on list: ",+$G(BGPPCNT),0,2,BGPPTYPE)
D W^BGP2DP("",0,1,BGPPTYPE)
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(^BGPNPLW(BGPLIEN,11,X)) Q:X'=+X W !,^BGPNPLW(BGPLIEN,11,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
.S L=$$LASTV(DFN,BGPED)
.I BGPRTYPE=1!(BGPRTYPE=9) D I 1
..W ?54,$P(L,U),?70,$P(L,U,2)
..W !,$P(^XTMP("BGP2DNP",BGPJ,BGPH,"LIST",BGPORD,BGPINDW,BGPLORD,BGPLIEN,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",1),?30,$P(^XTMP("BGP2DNP",BGPJ,BGPH,"LIST",BGPORD,BGPINDW,BGPLORD,BGPLIEN,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",2)
.E D
..W ?53,$P(^XTMP("BGP2DNP",BGPJ,BGPH,"LIST",BGPORD,BGPINDW,BGPLORD,BGPLIEN,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",1),?65,$P(^XTMP("BGP2DNP",BGPJ,BGPH,"LIST",BGPORD,BGPINDW,BGPLORD,BGPLIEN,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 L=$$LASTV(DFN,BGPED)
.I BGPRTYPE=1!(BGPRTYPE=9) D I 1
..S $P(X,U,6)=$P(L,U)
..S $P(X,U,7)=$P(L,U,2)
..S Y=$P(^XTMP("BGP2DNP",BGPJ,BGPH,"LIST",BGPORD,BGPINDW,BGPLORD,BGPLIEN,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",1) S $P(X,U,8)=Y
..S Y=$P(^XTMP("BGP2DNP",BGPJ,BGPH,"LIST",BGPORD,BGPINDW,BGPLORD,BGPLIEN,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",2) S $P(X,U,9)=Y
.E D
..S Y=$P(^XTMP("BGP2DNP",BGPJ,BGPH,"LIST",BGPORD,BGPINDW,BGPLORD,BGPLIEN,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",1) S $P(X,U,6)=Y
..S Y=$P(^XTMP("BGP2DNP",BGPJ,BGPH,"LIST",BGPORD,BGPINDW,BGPLORD,BGPLIEN,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",2) S $P(X,U,7)=Y
PRINTL1 .D W^BGP2DP(X,0,1,BGPPTYPE)
K ^TMP($J,"A")
Q
;
I BGPPTYPE="D" D HEADERD Q
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
W:$D(IOF) @IOF S BGPGPG=BGPGPG+1
I $G(BGPGUI) W "ZZZZZZZ",! ;maw
W !,"***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****"
W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BGPGPG,!
I BGPRTYPE=1 W !,$$CTR("*** IHS 2012 GPRA Performance & PART Patient List ***",80),!
I BGPRTYPE=9 W !,$$CTR("*** IHS 2012 GPRA Developmental Measures Patient List ***",80),!
I BGPRTYPE=7 W !,$$CTR("*** IHS 2012 Other National Measures Patient List ***",80),!
W $$CTR($$RPTVER^BGP2BAN,80),!
W $$CTR($P(^DIC(4,DUZ(2),0),U),80),!
S X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED) W $$CTR(X,80),!
W $$CTR($S(BGPLIST="A":"All Patients",BGPLIST="R":"Random Patient List",1:"Patient List by Provider: "_BGPLPROV),80),!
W !,$TR($J("",80)," ","-")
Q
H1 ;
I BGPRTYPE'=1,BGPRTYPE'=9 D H1O Q
D W^BGP2DP("UP=User Pop; AC=Active Clinical; AD=Active Diabetic; AAD=Active Adult Diabetic",0,2,BGPPTYPE)
D W^BGP2DP("PREG=Pregnant Female; IMM=Active IMM Pkg Pt; IHD=Active Ischemic Heart Disease",0,1,BGPPTYPE)
D W^BGP2DP("CHD=Active Coronary Heart Disease; HR-High Risk Patient",0,1,BGPPTYPE)
D W^BGP2DP("PATIENT NAME",0,1,BGPPTYPE,1)
D W^BGP2DP("HRN",0,0,BGPPTYPE,2,24) ;,?24,"HRN",
D W^BGP2DP("COMMUNITY",0,0,BGPPTYPE,3,31) ;?31,"COMMUNITY",
D W^BGP2DP("SEX",0,0,BGPPTYPE,4,45) ;?45,"SEX",
D W^BGP2DP("AGE",0,0,BGPPTYPE,5,49) ;?49,"AGE",
I BGPPTYPE="D" D W^BGP2DP("LAST MEDICAL VISIT",0,0,BGPPTYPE,6,54)
I BGPPTYPE="P" D W^BGP2DP("LAST MEDICAL",0,0,BGPPTYPE,6,54)
D W^BGP2DP("LAST VISIT",0,0,BGPPTYPE,7,70)
D W^BGP2DP("DENOMINATOR",0,$S(BGPPTYPE="P":1,1:0),BGPPTYPE,8,1) ;?53,"DENOMINATOR",
D W^BGP2DP("NUMERATOR",0,0,BGPPTYPE,9,30) ;?65,"NUMERATOR"
I BGPPTYPE="P" D W^BGP2DP("VISIT",0,0,BGPPTYPE,6,56)
D W^BGP2DP($TR($J("",80)," ","-"),0,1,BGPPTYPE)
Q
H1O ;
D W^BGP0DP("UP=User Pop; AC=Active Clinical; AD=Active Diabetic; AAD=Active Adult Diabetic",0,2,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("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)
;W !,"PATIENT NAME",?24,"HRN",?31,"COMMUNITY",?45,"SEX",?49,"AGE",?53,"DENOMINATOR",?65,"NUMERATOR"
;W !,$TR($J("",80)," ","-")
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")
;----------
S X="**** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****" D W^BGP2DP(X,0,2,BGPPTYPE)
I BGPRTYPE=1 S X="*** IHS 2012 GPRA Performance & PART Patient List ***" D W^BGP2DP(X,0,1,BGPPTYPE)
I BGPRTYPE=9 S X="*** IHS 2012 GPRA Developmental Measures Patient List ***" D W^BGP2DP(X,0,1,BGPPTYPE)
I BGPRTYPE=7 S X="*** IHS 2012 Other National Measures Patient List ***" D W^BGP2DP(X,0,1,BGPPTYPE)
S X=$$RPTVER^BGP2BAN D W^BGP2DP(X,0,1,BGPPTYPE)
S X=$P(^DIC(4,DUZ(2),0),U) D W^BGP2DP(X,0,1,BGPPTYPE)
S X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED) D W^BGP2DP(X,0,1,BGPPTYPE)
S X=$S(BGPLIST="A":"All Patients",BGPLIST="R":"Random Patient List",1:"Patient List by Provider: "_BGPLPROV) D W^BGP2DP(X,0,1,BGPPTYPE)
S X=$TR($J("",80)," ","-") D W^BGP2DP(X,0,1,BGPPTYPE)
Q
LASTV(P,EDATE) ;
;return last medical visit date^last visit date in mm/dd/yy format
K ^TMP($J,"A")
NEW LCC,LV,A,B,E,X
S LCC="",LV=""
S A="^TMP($J,""A"",",B=P_"^ALL VISITS;DURING "_$$FMADD^XLFDT(EDATE,-(4*365))_"-"_EDATE,E=$$START1^APCLDF(B,A)
I '$D(^TMP($J,"A",1)) Q ""
;reorder in reverse order
S (X,G,F,S)=0 F S X=$O(^TMP($J,"A",X)) Q:X'=+X 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:"SAHOR"'[$P(^AUPNVSIT(V,0),U,7)
.Q:"V"[$P(^AUPNVSIT(V,0),U,3)
.Q:$P(^AUPNVSIT(V,0),U,6)=""
.S D=$$VD^APCLV(V)
.S B=$$CLINIC^APCLV(V,"C")
.I B,$D(^BGPCTRL($O(^BGPCTRL("B",2012,0)),11,"B",B)) S LCC(9999999-D)=V
.I B,$D(^BGPCTRL($O(^BGPCTRL("B",2012,0)),12,"B",B)) S LCC(9999999-D)=V
.S LV(9999999-D)=V
.Q
S LV=$O(LV(0))
S LCC=$O(LCC(0))
I LV S LV=$$DATE^BGP2UTL((9999999-LV))
I LCC S LCC=$$DATE^BGP2UTL((9999999-LCC))
Q LCC_U_LV
BGP2NPLP ; IHS/CMI/LAB - IHS gpra print 30 Jun 2010 5:58 PM ;
+1 ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
+2 ;
NPL ;
+1 IF $GET(BGPAREAA)
QUIT
+2 SET BGPQUIT=""
SET BGPGPG=0
+3 SET BGPINDW=0
SET BGPCOUNT=0
+4 SET BGPINDW=0
FOR
SET BGPINDW=$ORDER(BGPINDL(BGPINDW))
IF BGPINDW'=+BGPINDW
QUIT
Begin DoDot:1
+5 SET BGPORD=$PIECE($GET(^BGPINDW(BGPINDW,12)),U,6)
+6 SET BGPLIEN=0
FOR
SET BGPLIEN=$ORDER(BGPINDW(BGPINDW,BGPLIEN))
IF BGPLIEN'=+BGPLIEN
QUIT
Begin DoDot:2
+7 SET BGPLORD=$SELECT(BGPRTYPE=1:$PIECE(^BGPNPLW(BGPLIEN,0),U,5),1:$PIECE(^BGPNPLW(BGPLIEN,0),U,6))
+8 SET BGPINDW("AOI",BGPORD,BGPINDW,BGPLORD,BGPLIEN)=""
End DoDot:2
End DoDot:1
+9 SET BGPORD=0
FOR
SET BGPORD=$ORDER(BGPINDL("AOI",BGPORD))
IF BGPORD=""!(BGPQUIT)
QUIT
Begin DoDot:1
+10 SET BGPINDW=$ORDER(BGPINDL("AOI",BGPORD,0))
+11 SET BGPLORD=0
FOR
SET BGPLORD=$ORDER(BGPINDL("AOI",BGPORD,BGPINDW,BGPLORD))
IF BGPLORD=""!(BGPQUIT)
QUIT
Begin DoDot:2
+12 SET BGPLIEN=$ORDER(BGPINDL("AOI",BGPORD,BGPINDW,BGPLORD,0))
+13 ;I '$$ANYPATS(BGPINDW,BGPINDII) D HEADER W !!,"No Patients to Report.",! Q
+14 ;F S BGPINDW=$O(^XTMP("BGP2DNP",BGPJ,BGPH,"LIST",BGPINDW)) Q:BGPINDW'=+BGPINDW!(BGPQUIT) D NPL1
DO NPL11
End DoDot:2
End DoDot:1
+15 QUIT
ANYPATS(I,L) ;
+1 NEW O,G
+2 SET G=""
+3 SET O=0
FOR
SET O=$ORDER(^XTMP("BGP2DNP",BGJP,BGPH,"LIST",BGPINDW,O))
IF O'=+O
QUIT
Begin DoDot:1
+4 IF $DATA(^XTMP("BGP2DNP",BGPJ,BGPH,"LIST",BGPINDW,O,BGPL))
SET G=1
+5 QUIT
End DoDot:1
+6 QUIT
NPL1 ;EP
+1 IF $GET(BGPAREAA)
QUIT
+2 SET BGPCR=$SELECT(BGPRTYPE=7:"AON",1:"AN")
+3 SET BGPORD=$PIECE(^BGPINDW(BGPINDW,12),U,6)
+4 SET BGPLORD=0
FOR
SET BGPLORD=$ORDER(^BGPNPLW(BGPCR,BGPINDW,BGPLORD))
IF BGPLORD'=+BGPLORD
QUIT
Begin DoDot:1
+5 SET BGPLIEN=$ORDER(^BGPNPLW(BGPCR,BGPINDW,BGPLORD,0))
IF 'BGPLIEN
QUIT
+6 IF BGPRTYPE=1!(BGPRTYPE=9)
IF BGPRTYPE'=$PIECE(^BGPNPLW(BGPLIEN,0),U,7)
QUIT
+7 IF '$DATA(BGPINDL(BGPINDW,BGPLIEN))
QUIT
+8 IF '$DATA(^XTMP("BGP2DNP",BGPJ,BGPH,"LIST",BGPORD,BGPINDW,BGPLORD,BGPLIEN))
Begin DoDot:2
+9 DO HEADER
+10 SET X=0
FOR
SET X=$ORDER(^BGPNPLW(BGPLIEN,11,X))
IF X'=+X
QUIT
DO W^BGP2DP(^BGPNPLW(BGPLIEN,11,X,0),0,1,BGPPTYPE)
+11 DO H1
+12 DO W^BGP2DP(" ",0,0,BGPRTYPE)
+13 DO W^BGP2DP("Total # of patients on list: 0",0,0,BGPPTYPE)
End DoDot:2
QUIT
+14 DO NPL11
End DoDot:1
+15 QUIT
NPL11 ;
+1 ;S BGPLIEN=0 F S BGPLIEN=$O(^XTMP("BGP2DNP",BGPJ,BGPH,"LIST",BGPORD,BGPINDW,BGPLORD,BGPLIEN)) Q:BGPLIEN'=+BGPLIEN!(BGPQUIT) D
Begin DoDot:1
+2 IF BGPRTYPE=1!(BGPRTYPE=9)
IF BGPRTYPE'=$PIECE(^BGPNPLW(BGPLIEN,0),U,7)
QUIT
+3 ;I BGPRTYPE="" S BGPRTYPE=1
+4 SET BGPCOUNT=0
SET BGPPCNT=0
+5 DO HEADER
IF BGPQUIT
QUIT
+6 ;I BGPPTYPE="D" D W^BGP2DP("",0,3,BGPPTYPE)
+7 SET BGPCNT=BGPINDL(BGPINDW,BGPLIEN)
+8 IF BGPCNT<11!(BGPLIST'="R")
SET BGPCNT=1
GOTO GO
+9 IF BGPCNT<100
SET BGPCNT=BGPCNT\10
GOTO GO
+10 SET BGPCNT=10
GO ;
+1 ;W !,$P(^BGPINDW(BGPINDW,0),U,3)
DO WTITLE^BGP2DP(BGPINDW)
NEXT ;
+1 SET BGPX=0
FOR
SET BGPX=$ORDER(^BGPNPLW(BGPLIEN,11,BGPX))
IF BGPX'=+BGPX
QUIT
Begin DoDot:2
+2 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-3)
DO HEADER
IF BGPQUIT
QUIT
+3 DO W^BGP2DP(^BGPNPLW(BGPLIEN,11,BGPX,0),0,1,BGPPTYPE)
End DoDot:2
+4 DO H1
+5 ;I '$D(^XTMP("BGP2DNP",BGPJ,BGPH,"LIST",BGPORD,BGPINDW,BGPLORD,BGPLIEN)) W !!,"No patients to report.",! Q
+6 SET BGPCOM=""
FOR
SET BGPCOM=$ORDER(^XTMP("BGP2DNP",BGPJ,BGPH,"LIST",BGPORD,BGPINDW,BGPLORD,BGPLIEN,BGPCOM))
IF BGPCOM=""!(BGPQUIT)
QUIT
Begin DoDot:2
+7 SET BGPSEX=""
FOR
SET BGPSEX=$ORDER(^XTMP("BGP2DNP",BGPJ,BGPH,"LIST",BGPORD,BGPINDW,BGPLORD,BGPLIEN,BGPCOM,BGPSEX))
IF BGPSEX=""!(BGPQUIT)
QUIT
Begin DoDot:3
+8 SET BGPAGE=""
FOR
SET BGPAGE=$ORDER(^XTMP("BGP2DNP",BGPJ,BGPH,"LIST",BGPORD,BGPINDW,BGPLORD,BGPLIEN,BGPCOM,BGPSEX,BGPAGE))
IF BGPAGE=""!(BGPQUIT)
QUIT
Begin DoDot:4
+9 SET DFN=0
FOR
SET DFN=$ORDER(^XTMP("BGP2DNP",BGPJ,BGPH,"LIST",BGPORD,BGPINDW,BGPLORD,BGPLIEN,BGPCOM,BGPSEX,BGPAGE,DFN))
IF DFN'=+DFN!(BGPQUIT)
QUIT
SET BGPCOUNT=BGPCOUNT+1
DO PRINTL
End DoDot:4
+10 QUIT
End DoDot:3
+11 QUIT
End DoDot:2
+12 QUIT
End DoDot:1
+13 IF BGPPTYPE="P"
IF $Y>(BGPIOSL-3)
DO HEADER
IF BGPQUIT
QUIT
+14 DO W^BGP2DP("Total # of patients on list: ",+$GET(BGPPCNT),0,2,BGPPTYPE)
+15 DO W^BGP2DP("",0,1,BGPPTYPE)
+16 QUIT
+17 ;
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 SET X=0
FOR
SET X=$ORDER(^BGPNPLW(BGPLIEN,11,X))
IF X'=+X
QUIT
WRITE !,^BGPNPLW(BGPLIEN,11,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 SET L=$$LASTV(DFN,BGPED)
+9 IF BGPRTYPE=1!(BGPRTYPE=9)
Begin DoDot:2
+10 WRITE ?54,$PIECE(L,U),?70,$PIECE(L,U,2)
+11 WRITE !,$PIECE(^XTMP("BGP2DNP",BGPJ,BGPH,"LIST",BGPORD,BGPINDW,BGPLORD,BGPLIEN,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",1),?30,$PIECE(^XTMP("BGP2DNP",BGPJ,BGPH,"LIST",BGPORD,BGPINDW,BGPLORD,BGPLIEN,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",2)
End DoDot:2
IF 1
+12 IF '$TEST
Begin DoDot:2
+13 WRITE ?53,$PIECE(^XTMP("BGP2DNP",BGPJ,BGPH,"LIST",BGPORD,BGPINDW,BGPLORD,BGPLIEN,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",1),?65,$PIECE(^XTMP("BGP2DNP",BGPJ,BGPH,"LIST",BGPORD,BGPINDW,BGPLORD,BGPLIEN,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",2)
End DoDot:2
End DoDot:1
+14 IF BGPPTYPE="D"
Begin DoDot:1
+15 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
+16 SET L=$$LASTV(DFN,BGPED)
+17 IF BGPRTYPE=1!(BGPRTYPE=9)
Begin DoDot:2
+18 SET $PIECE(X,U,6)=$PIECE(L,U)
+19 SET $PIECE(X,U,7)=$PIECE(L,U,2)
+20 SET Y=$PIECE(^XTMP("BGP2DNP",BGPJ,BGPH,"LIST",BGPORD,BGPINDW,BGPLORD,BGPLIEN,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",1)
SET $PIECE(X,U,8)=Y
+21 SET Y=$PIECE(^XTMP("BGP2DNP",BGPJ,BGPH,"LIST",BGPORD,BGPINDW,BGPLORD,BGPLIEN,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",2)
SET $PIECE(X,U,9)=Y
End DoDot:2
IF 1
+22 IF '$TEST
Begin DoDot:2
+23 SET Y=$PIECE(^XTMP("BGP2DNP",BGPJ,BGPH,"LIST",BGPORD,BGPINDW,BGPLORD,BGPLIEN,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",1)
SET $PIECE(X,U,6)=Y
+24 SET Y=$PIECE(^XTMP("BGP2DNP",BGPJ,BGPH,"LIST",BGPORD,BGPINDW,BGPLORD,BGPLIEN,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",2)
SET $PIECE(X,U,7)=Y
End DoDot:2
PRINTL1 DO W^BGP2DP(X,0,1,BGPPTYPE)
End DoDot:1
+1 KILL ^TMP($JOB,"A")
+2 QUIT
+3 ;
+1 IF BGPPTYPE="D"
DO HEADERD
QUIT
+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 $DATA(IOF)
WRITE @IOF
SET BGPGPG=BGPGPG+1
+2 ;maw
IF $GET(BGPGUI)
WRITE "ZZZZZZZ",!
+3 WRITE !,"***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****"
+4 WRITE !?3,$PIECE(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BGPGPG,!
+5 IF BGPRTYPE=1
WRITE !,$$CTR("*** IHS 2012 GPRA Performance & PART Patient List ***",80),!
+6 IF BGPRTYPE=9
WRITE !,$$CTR("*** IHS 2012 GPRA Developmental Measures Patient List ***",80),!
+7 IF BGPRTYPE=7
WRITE !,$$CTR("*** IHS 2012 Other National Measures Patient List ***",80),!
+8 WRITE $$CTR($$RPTVER^BGP2BAN,80),!
+9 WRITE $$CTR($PIECE(^DIC(4,DUZ(2),0),U),80),!
+10 SET X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED)
WRITE $$CTR(X,80),!
+11 WRITE $$CTR($SELECT(BGPLIST="A":"All Patients",BGPLIST="R":"Random Patient List",1:"Patient List by Provider: "_BGPLPROV),80),!
+12 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-")
+13 QUIT
H1 ;
+1 IF BGPRTYPE'=1
IF BGPRTYPE'=9
DO H1O
QUIT
+2 DO W^BGP2DP("UP=User Pop; AC=Active Clinical; AD=Active Diabetic; AAD=Active Adult Diabetic",0,2,BGPPTYPE)
+3 DO W^BGP2DP("PREG=Pregnant Female; IMM=Active IMM Pkg Pt; IHD=Active Ischemic Heart Disease",0,1,BGPPTYPE)
+4 DO W^BGP2DP("CHD=Active Coronary Heart Disease; HR-High Risk Patient",0,1,BGPPTYPE)
+5 DO W^BGP2DP("PATIENT NAME",0,1,BGPPTYPE,1)
+6 ;,?24,"HRN",
DO W^BGP2DP("HRN",0,0,BGPPTYPE,2,24)
+7 ;?31,"COMMUNITY",
DO W^BGP2DP("COMMUNITY",0,0,BGPPTYPE,3,31)
+8 ;?45,"SEX",
DO W^BGP2DP("SEX",0,0,BGPPTYPE,4,45)
+9 ;?49,"AGE",
DO W^BGP2DP("AGE",0,0,BGPPTYPE,5,49)
+10 IF BGPPTYPE="D"
DO W^BGP2DP("LAST MEDICAL VISIT",0,0,BGPPTYPE,6,54)
+11 IF BGPPTYPE="P"
DO W^BGP2DP("LAST MEDICAL",0,0,BGPPTYPE,6,54)
+12 DO W^BGP2DP("LAST VISIT",0,0,BGPPTYPE,7,70)
+13 ;?53,"DENOMINATOR",
DO W^BGP2DP("DENOMINATOR",0,$SELECT(BGPPTYPE="P":1,1:0),BGPPTYPE,8,1)
+14 ;?65,"NUMERATOR"
DO W^BGP2DP("NUMERATOR",0,0,BGPPTYPE,9,30)
+15 IF BGPPTYPE="P"
DO W^BGP2DP("VISIT",0,0,BGPPTYPE,6,56)
+16 DO W^BGP2DP($TRANSLATE($JUSTIFY("",80)," ","-"),0,1,BGPPTYPE)
+17 QUIT
H1O ;
+1 DO W^BGP0DP("UP=User Pop; AC=Active Clinical; AD=Active Diabetic; AAD=Active Adult Diabetic",0,2,BGPPTYPE)
+2 DO W^BGP0DP("PREG=Pregnant Female; IMM=Active IMM Pkg Pt; IHD=Active Ischemic Heart Disease",0,1,BGPPTYPE)
+3 ;D W^BGP0DP("CHD=Active Coronary Heart Disease",0,1,BGPRTYPE)
+4 DO W^BGP0DP("PATIENT NAME",0,1,BGPPTYPE,1)
+5 ;,?24,"HRN",
DO W^BGP0DP("HRN",0,0,BGPPTYPE,2,24)
+6 ;?31,"COMMUNITY",
DO W^BGP0DP("COMMUNITY",0,0,BGPPTYPE,3,31)
+7 ;?45,"SEX",
DO W^BGP0DP("SEX",0,0,BGPPTYPE,4,45)
+8 ;?49,"AGE",
DO W^BGP0DP("AGE",0,0,BGPPTYPE,5,49)
+9 ;?53,"DENOMINATOR",
DO W^BGP0DP("DENOMINATOR",0,0,BGPPTYPE,6,53)
+10 ;?65,"NUMERATOR"
DO W^BGP0DP("NUMERATOR",0,0,BGPPTYPE,7,65)
+11 DO W^BGP0DP($TRANSLATE($JUSTIFY("",80)," ","-"),0,1,BGPPTYPE)
+12 ;W !,"PATIENT NAME",?24,"HRN",?31,"COMMUNITY",?45,"SEX",?49,"AGE",?53,"DENOMINATOR",?65,"NUMERATOR"
+13 ;W !,$TR($J("",80)," ","-")
+14 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 ;----------
+1 SET X="**** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****"
DO W^BGP2DP(X,0,2,BGPPTYPE)
+2 IF BGPRTYPE=1
SET X="*** IHS 2012 GPRA Performance & PART Patient List ***"
DO W^BGP2DP(X,0,1,BGPPTYPE)
+3 IF BGPRTYPE=9
SET X="*** IHS 2012 GPRA Developmental Measures Patient List ***"
DO W^BGP2DP(X,0,1,BGPPTYPE)
+4 IF BGPRTYPE=7
SET X="*** IHS 2012 Other National Measures Patient List ***"
DO W^BGP2DP(X,0,1,BGPPTYPE)
+5 SET X=$$RPTVER^BGP2BAN
DO W^BGP2DP(X,0,1,BGPPTYPE)
+6 SET X=$PIECE(^DIC(4,DUZ(2),0),U)
DO W^BGP2DP(X,0,1,BGPPTYPE)
+7 SET X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED)
DO W^BGP2DP(X,0,1,BGPPTYPE)
+8 SET X=$SELECT(BGPLIST="A":"All Patients",BGPLIST="R":"Random Patient List",1:"Patient List by Provider: "_BGPLPROV)
DO W^BGP2DP(X,0,1,BGPPTYPE)
+9 SET X=$TRANSLATE($JUSTIFY("",80)," ","-")
DO W^BGP2DP(X,0,1,BGPPTYPE)
+10 QUIT
LASTV(P,EDATE) ;
+1 ;return last medical visit date^last visit date in mm/dd/yy format
+2 KILL ^TMP($JOB,"A")
+3 NEW LCC,LV,A,B,E,X
+4 SET LCC=""
SET LV=""
+5 SET A="^TMP($J,""A"","
SET B=P_"^ALL VISITS;DURING "_$$FMADD^XLFDT(EDATE,-(4*365))_"-"_EDATE
SET E=$$START1^APCLDF(B,A)
+6 IF '$DATA(^TMP($JOB,"A",1))
QUIT ""
+7 ;reorder in reverse order
+8 SET (X,G,F,S)=0
FOR
SET X=$ORDER(^TMP($JOB,"A",X))
IF X'=+X
QUIT
SET V=$PIECE(^TMP($JOB,"A",X),U,5)
Begin DoDot:1
+9 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+10 IF '$PIECE(^AUPNVSIT(V,0),U,9)
QUIT
+11 IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+12 IF '$DATA(^AUPNVPRV("AD",V))
QUIT
+13 IF "SAHOR"'[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+14 IF "V"[$PIECE(^AUPNVSIT(V,0),U,3)
QUIT
+15 IF $PIECE(^AUPNVSIT(V,0),U,6)=""
QUIT
+16 SET D=$$VD^APCLV(V)
+17 SET B=$$CLINIC^APCLV(V,"C")
+18 IF B
IF $DATA(^BGPCTRL($ORDER(^BGPCTRL("B",2012,0)),11,"B",B))
SET LCC(9999999-D)=V
+19 IF B
IF $DATA(^BGPCTRL($ORDER(^BGPCTRL("B",2012,0)),12,"B",B))
SET LCC(9999999-D)=V
+20 SET LV(9999999-D)=V
+21 QUIT
End DoDot:1
+22 SET LV=$ORDER(LV(0))
+23 SET LCC=$ORDER(LCC(0))
+24 IF LV
SET LV=$$DATE^BGP2UTL((9999999-LV))
+25 IF LCC
SET LCC=$$DATE^BGP2UTL((9999999-LCC))
+26 QUIT LCC_U_LV
