Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BGP0NPLD

BGP0NPLD.m

Go to the documentation of this file.
  1. BGP0NPLD ; IHS/CMI/LAB - IHS gpra print 30 Jun 2009 5:59 PM ;
  1. ;;10.0;IHS CLINICAL REPORTING;;JUN 18, 2010
  1. ;
  1. NPL ;
  1. Q:$G(BGPAREAA)
  1. ;S X=" " D S(X,1,1) D S(X,1,1) D S(X,1,1) S X="PATIENT LISTS" D S(X,1,1) S X=" " D S(X,1,1)
  1. S BGPINDT=0 F S BGPINDT=$O(^XTMP("BGP0DNP",BGPJ,BGPH,"LIST",BGPINDT)) Q:BGPINDT'=+BGPINDT D NPL1
  1. Q
  1. NPL1 ;EP
  1. Q:$G(BGPAREAA)
  1. S BGPO=0 F S BGPO=$O(^XTMP("BGP0DNP",BGPJ,BGPH,"LIST",BGPINDT,BGPO)) Q:BGPO'=+BGPO D NPL11
  1. Q
  1. NPL11 ;
  1. S BGPL=0 F S BGPL=$O(^XTMP("BGP0DNP",BGPJ,BGPH,"LIST",BGPINDT,BGPO,BGPL)) Q:BGPL'=+BGPL D
  1. .S BGPCOUNT=0,BGPPCNT=0
  1. .D HEADER
  1. .S BGPCNT=BGPINDL(BGPINDT,BGPL)
  1. .I BGPCNT<11!(BGPLIST'="R") S BGPCNT=1 G GO
  1. .I BGPCNT<100 S BGPCNT=BGPCNT\10 G GO
  1. .S BGPCNT=10
  1. GO .;
  1. .S X=$P(^BGPINDT(BGPINDT,0),U,3) D S(X,1,1)
  1. .;S X=" " D S(X,1,1)
  1. .G NEXT
  1. .S X="Denominator(s):" D S(X,1,1)
  1. .S BGPNODE=$S(BGPRTYPE=1:81,BGPRTYPE=4:61,BGPRTYPE=7:83,BGPRTYPE=9:85,1:61)
  1. .S BGPX=0 F S BGPX=$O(^BGPINDT(BGPINDT,BGPNODE,"B",BGPX)) Q:BGPX'=+BGPX D
  1. ..S BGPY=0 F S BGPY=$O(^BGPINDT(BGPINDT,BGPNODE,"B",BGPX,BGPY)) Q:BGPY'=+BGPY D
  1. ...;I $P(^BGPINDT(BGPINDT,61,BGPY,0),U,2)'[BGPRTYPE Q ;not a denom def for this report
  1. ...;I '$D(^BGPINDT(BGPINDT,61,BGPY,11,"B",BGPRTYPE)) Q ;not this report type
  1. ...S BGPZ=0 F S BGPZ=$O(^BGPINDT(BGPINDT,BGPNODE,BGPY,1,BGPZ)) Q:BGPZ'=+BGPZ D
  1. ....S Y=^BGPINDT(BGPINDT,BGPNODE,BGPY,1,BGPZ,0) D S(Y,1,1)
  1. ....Q
  1. ...Q
  1. ..Q
  1. .S X=" " D S(X,1,1)
  1. .S X="Numerator(s):" D S(X,1,1)
  1. .S BGPNODE=$S(BGPRTYPE=1:82,BGPRTYPE=4:62,BGPRTYPE=7:84,BGPRTYPE=9:86,1:62)
  1. .S BGPX=0 F S BGPX=$O(^BGPINDT(BGPINDT,BGPNODE,"B",BGPX)) Q:BGPX'=+BGPX D
  1. ..S BGPY=0 F S BGPY=$O(^BGPINDT(BGPINDT,BGPNODE,"B",BGPX,BGPY)) Q:BGPY'=+BGPY D
  1. ...;I $P(^BGPINDT(BGPINDT,62,BGPY,0),U,2)'[BGPRTYPE Q ;not a denom def for this report
  1. ...;I '$D(^BGPINDT(BGPINDT,62,BGPY,11,"B",BGPRTYPE)) Q ;not this report type
  1. ...S BGPZ=0 F S BGPZ=$O(^BGPINDT(BGPINDT,BGPNODE,BGPY,1,BGPZ)) Q:BGPZ'=+BGPZ D
  1. ....S X=^BGPINDT(BGPINDT,BGPNODE,BGPY,1,BGPZ,0) D S(X,1,1)
  1. ....Q
  1. ...Q
  1. ..Q
  1. .S X=" " D S(X,1,1)
  1. .S BGPNODE=11 I BGPRTYPE=1,$O(^BGPINDT(BGPINDT,54,0)) S BGPNODE=54
  1. .S X="Logic" D S(X,1,1)
  1. .S BGPX=0 F S BGPX=$O(^BGPINDT(BGPINDT,BGPNODE,BGPX)) Q:BGPX'=+BGPX D
  1. ..S X=^BGPINDT(BGPINDT,BGPNODE,BGPX,0) D S(X,1,1)
  1. .S X=" " D S(X,1,1) S X="Performance Measure Description" D S(X,1,1) S BGPX=0 F S BGPX=$O(^BGPINDT(BGPINDT,51,BGPX)) Q:BGPX'=+BGPX D
  1. ..S X=^BGPINDT(BGPINDT,51,BGPX,0) D S(X,1,1)
  1. .I $O(^BGPINDT(BGPINDT,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(^BGPINDT(BGPINDT,52,BGPX)) Q:BGPX'=+BGPX D
  1. ..S X=^BGPINDT(BGPINDT,52,BGPX,0) D S(X,1,1)
  1. .I $O(^BGPINDT(BGPINDT,55,0)) S X=" " D S(X,1,1) S X="Source" D S(X,1,1) S BGPX=0 F S BGPX=$O(^BGPINDT(BGPINDT,55,BGPX)) Q:BGPX'=+BGPX D
  1. ..S X=^BGPINDT(BGPINDT,55,BGPX,0) D S(X,1,1)
  1. .S X=" " D S(X,1,1)
  1. NEXT .;
  1. .S BGPX=0 F S BGPX=$O(^BGPNPLT(BGPL,11,BGPX)) Q:BGPX'=+BGPX D
  1. ..S X=^BGPNPLT(BGPL,11,BGPX,0) D S(X,1,1)
  1. .D H1
  1. .S BGPCOM="" F S BGPCOM=$O(^XTMP("BGP0DNP",BGPJ,BGPH,"LIST",BGPINDT,BGPO,BGPL,BGPCOM)) Q:BGPCOM="" D
  1. ..S BGPSEX="" F S BGPSEX=$O(^XTMP("BGP0DNP",BGPJ,BGPH,"LIST",BGPINDT,BGPO,BGPL,BGPCOM,BGPSEX)) Q:BGPSEX="" D
  1. ...S BGPAGE="" F S BGPAGE=$O(^XTMP("BGP0DNP",BGPJ,BGPH,"LIST",BGPINDT,BGPO,BGPL,BGPCOM,BGPSEX,BGPAGE)) Q:BGPAGE="" D
  1. ....S DFN=0 F S DFN=$O(^XTMP("BGP0DNP",BGPJ,BGPH,"LIST",BGPINDT,BGPO,BGPL,BGPCOM,BGPSEX,BGPAGE,DFN)) Q:DFN'=+DFN S BGPCOUNT=BGPCOUNT+1 D PRINTL
  1. ....Q
  1. ...Q
  1. ..Q
  1. .S X=" " D S(X,1,1) S X=" " D S(X,1,1)
  1. .S X=" " D S(X,1,1) S X=" " D S(X,1,1)
  1. .S X="Total # of patients on list: "_+$G(BGPPCNT) D S(X,1,1)
  1. Q
  1. PRINTL ;print one line
  1. Q:(BGPCOUNT#BGPCNT)
  1. S BGPPCNT=BGPPCNT+1
  1. S X=$E($P(^DPT(DFN,0),U),1,22) D S(X,1,1) S X=$$HRN^AUPNPAT(DFN,DUZ(2)) D S(X,,2) S X=$E(BGPCOM,1,14) D S(X,,3) S X=BGPSEX D S(X,,4) S X=BGPAGE D S(X,,5)
  1. S X=$P(^XTMP("BGP0DNP",BGPJ,BGPH,"LIST",BGPINDT,BGPO,BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",1) D S(X,,6)
  1. S X=$P(^XTMP("BGP0DNP",BGPJ,BGPH,"LIST",BGPINDT,BGPO,BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",2) D S(X,,7)
  1. Q
  1. ;
  1. S X="**** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****" D S(X,1,1)
  1. I BGPRTYPE=1 S X="*** IHS 2010 GPRA Performance & PART Patient List ***" D S(X,1,1)
  1. I BGPRTYPE=7 S X="*** IHS 2010 Other National Measures Patient List ***" D S(X,1,1)
  1. S X=$$RPTVER^BGP0BAN D S(X,1,1)
  1. S X=$P(^DIC(4,DUZ(2),0),U) D S(X,1,1)
  1. S X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED) D S(X,1,1)
  1. S X=$S(BGPLIST="A":"All Patients",BGPLIST="R":"Random Patient List",1:"Patient List by Provider: "_BGPLPROV) D S(X,1,1)
  1. S X=$TR($J("",80)," ","-") D S(X,1,1)
  1. Q
  1. H1 ;
  1. S X=" " D S(X,1,1) S X="UP=User Pop; AC=Active Clinical; AD=Active Diabetic;" D S(X,1,1) S X="AAD=Active Adult Diabetic; PREG=Pregnant Female;" D S(X,1,1) D
  1. .S X="IMM=Active IMM Pkg Pt; IHD=Active Ischemic Heart Disease; CHD=Active Coronary Heart Disease" D S(X,1,1)
  1. S X=" " D S(X,1,1)
  1. S X="PATIENT NAME" D S(X,1,1) S X="HRN" D S(X,,2) S X="COMMUNITY" D S(X,,3) S X="SEX" D S(X,,4) S X="AGE" D S(X,,5) S X="DENOMINATOR" D S(X,,6) S X="NUMERATOR" D S(X,,7)
  1. S X=$TR($J("",80)," ","-") D S(X,1,1)
  1. Q
  1. S(Y,F,P) ;EP - set up array
  1. I '$G(F) S F=0
  1. S %=$P(^TMP($J,"BGPDEL",0),U)+F,$P(^TMP($J,"BGPDEL",0),U)=%
  1. I '$D(^TMP($J,"BGPDEL",%)) S ^TMP($J,"BGPDEL",%)=""
  1. S $P(^TMP($J,"BGPDEL",%),U,P)=Y
  1. Q
  1. CTR(X,Y) ;EP - Center X in a field Y wide.
  1. Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
  1. ;----------
  1. USR() ;EP - Return name of current user from ^VA(200.
  1. Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
  1. ;----------
  1. LOC() ;EP - Return location name from file 4 based on DUZ(2).
  1. Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
  1. ;----------