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

BGP0NPLP.m

Go to the documentation of this file. 
  1. BGP0NPLP ; IHS/CMI/LAB - IHS gpra print 30 Jun 2009 5:58 PM ;
  1.  ;;10.0;IHS CLINICAL REPORTING;;JUN 18, 2010
  1.  ;
  1. NPL ;
  1.  Q:$G(BGPAREAA)
  1.  S BGPQUIT="",BGPGPG=0
  1.  S BGPINDT=0,BGPCOUNT=0
  1.  S BGPINDT=0 F  S BGPINDT=$O(BGPINDL(BGPINDT)) Q:BGPINDT'=+BGPINDT!(BGPQUIT)  D
  1.  .S BGPINDII=0 F  S BGPINDII=$O(BGPINDL(BGPINDT,BGPL)) Q:BGPINDII'=+BGPINDII!(BGPQUIT)  D
  1.  ..I '$$ANYPATS(BGPINDT,BGPINDII) D HEADER W !!,"No Patients to Report.",! Q
  1.  ..D NPL1  ;F  S BGPINDT=$O(^XTMP("BGP0DNP",BGPJ,BGPH,"LIST",BGPINDT)) Q:BGPINDT'=+BGPINDT!(BGPQUIT)  D NPL1
  1.  Q
  1. ANYPATS(I,L) ;
  1.  NEW O,G
  1.  S G=""
  1.  S O=0 F  S O=$O(^XTMP("BGP0DNP",BGJP,BGPH,"LIST",BGPINDT,O)) Q:O'=+O  D
  1.  .I $D(^XTMP("BGP0DNP",BGPJ,BGPH,"LIST",BGPINDT,O,BGPL)) S G=1
  1.  .Q
  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!(BGPQUIT)  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!(BGPQUIT)  D
  1.  .S BGPINDT=$P(^BGPNPLT(BGPL,0),U)
  1.  .I BGPRTYPE=1!(BGPRTYPE=9) Q:BGPRTYPE'=$P(^BGPNPLT(BGPL,0),U,7)
  1.  .;I BGPRTYPE="" S BGPRTYPE=1
  1.  .S BGPCOUNT=0,BGPPCNT=0
  1.  .D HEADER Q:BGPQUIT
  1.  .;I BGPPTYPE="D" D W^BGP0DP("",0,3,BGPPTYPE)
  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.  .D WTITLE^BGP0DP(BGPINDT)  ;W !,$P(^BGPINDT(BGPINDT,0),U,3)
  1. NEXT .;
  1.  .S BGPX=0 F  S BGPX=$O(^BGPNPLT(BGPL,11,BGPX)) Q:BGPX'=+BGPX  D
  1.  ..I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
  1.  ..D W^BGP0DP(^BGPNPLT(BGPL,11,BGPX,0),0,1,BGPPTYPE)
  1.  .D H1
  1.  .S BGPCOM="" F  S BGPCOM=$O(^XTMP("BGP0DNP",BGPJ,BGPH,"LIST",BGPINDT,BGPO,BGPL,BGPCOM)) Q:BGPCOM=""!(BGPQUIT)  D
  1.  ..S BGPSEX="" F  S BGPSEX=$O(^XTMP("BGP0DNP",BGPJ,BGPH,"LIST",BGPINDT,BGPO,BGPL,BGPCOM,BGPSEX)) Q:BGPSEX=""!(BGPQUIT)  D
  1.  ...S BGPAGE="" F  S BGPAGE=$O(^XTMP("BGP0DNP",BGPJ,BGPH,"LIST",BGPINDT,BGPO,BGPL,BGPCOM,BGPSEX,BGPAGE)) Q:BGPAGE=""!(BGPQUIT)  D
  1.  ....S DFN=0 F  S DFN=$O(^XTMP("BGP0DNP",BGPJ,BGPH,"LIST",BGPINDT,BGPO,BGPL,BGPCOM,BGPSEX,BGPAGE,DFN)) Q:DFN'=+DFN!(BGPQUIT)  S BGPCOUNT=BGPCOUNT+1 D PRINTL
  1.  ....Q
  1.  ...Q
  1.  ..Q
  1.  .I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
  1.  .D W^BGP0DP("Total # of patients on list: ",+$G(BGPPCNT),0,2,BGPPTYPE)
  1.  .D W^BGP0DP("",0,1,BGPPTYPE)
  1.  Q
  1.  ;
  1. PRINTL ;print one line
  1.  Q:(BGPCOUNT#BGPCNT)
  1.  I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER Q:BGPQUIT  D
  1.  .S X=0 F  S X=$O(^BGPNPLT(BGPL,11,X)) Q:X'=+X  W !,^BGPNPLT(BGPL,11,X,0)
  1.  .D H1
  1.  Q:BGPQUIT
  1.  S BGPPCNT=BGPPCNT+1
  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
  1.  .W ?53,$P(^XTMP("BGP0DNP",BGPJ,BGPH,"LIST",BGPINDT,BGPO,BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",1),?65,$P(^XTMP("BGP0DNP",BGPJ,BGPH,"LIST",BGPINDT,BGPO,BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",2)
  1.  I BGPPTYPE="D" D
  1.  .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
  1.  .S Y=$P(^XTMP("BGP0DNP",BGPJ,BGPH,"LIST",BGPINDT,BGPO,BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",1) S $P(X,U,6)=Y
  1.  .S Y=$P(^XTMP("BGP0DNP",BGPJ,BGPH,"LIST",BGPINDT,BGPO,BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",2) S $P(X,U,7)=Y
  1.  .D W^BGP0DP(X,0,1,BGPPTYPE)
  1.  Q
  1.  ;
  1.  I BGPPTYPE="D" D HEADERD Q
  1.  G:'BGPGPG HEADER1
  1.  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
  1. HEADER1 ;
  1.  W:$D(IOF) @IOF S BGPGPG=BGPGPG+1
  1.  I $G(BGPGUI) W "ZZZZZZZ",!  ;maw
  1.  W !,"***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****"
  1.  W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",BGPGPG,!
  1.  I BGPRTYPE=1 W !,$$CTR("***  IHS 2010 GPRA Performance & PART Patient List  ***",80),!
  1.  I BGPRTYPE=9 W !,$$CTR("***  IHS 2010 GPRA Developmental Measures Patient List  ***",80),!
  1.  I BGPRTYPE=7 W !,$$CTR("***  IHS 2010 Other National Measures Patient List  ***",80),!
  1.  W $$CTR($$RPTVER^BGP0BAN,80),!
  1.  W $$CTR($P(^DIC(4,DUZ(2),0),U),80),!
  1.  S X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED) W $$CTR(X,80),!
  1.  W $$CTR($S(BGPLIST="A":"All Patients",BGPLIST="R":"Random Patient List",1:"Patient List by Provider: "_BGPLPROV),80),!
  1.  W !,$TR($J("",80)," ","-")
  1.  Q
  1. H1 ;
  1.  D W^BGP0DP("UP=User Pop; AC=Active Clinical; AD=Active Diabetic; AAD=Active Adult Diabetic",0,2,BGPPTYPE)
  1.  D W^BGP0DP("PREG=Pregnant Female; IMM=Active IMM Pkg Pt; IHD=Active Ischemic Heart Disease",0,1,BGPPTYPE)
  1.  D W^BGP0DP("CHD=Active Coronary Heart Disease",0,1,BGPRTYPE)
  1.  D W^BGP0DP("PATIENT NAME",0,1,BGPPTYPE,1)
  1.  D W^BGP0DP("HRN",0,0,BGPPTYPE,2,24)  ;,?24,"HRN",
  1.  D W^BGP0DP("COMMUNITY",0,0,BGPPTYPE,3,31)  ;?31,"COMMUNITY",
  1.  D W^BGP0DP("SEX",0,0,BGPPTYPE,4,45)  ;?45,"SEX",
  1.  D W^BGP0DP("AGE",0,0,BGPPTYPE,5,49)  ;?49,"AGE",
  1.  D W^BGP0DP("DENOMINATOR",0,0,BGPPTYPE,6,53)  ;?53,"DENOMINATOR",
  1.  D W^BGP0DP("NUMERATOR",0,0,BGPPTYPE,7,65)  ;?65,"NUMERATOR"
  1.  D W^BGP0DP($TR($J("",80)," ","-"),0,1,BGPPTYPE)
  1.  ;W !,"PATIENT NAME",?24,"HRN",?31,"COMMUNITY",?45,"SEX",?49,"AGE",?53,"DENOMINATOR",?65,"NUMERATOR"
  1.  ;W !,$TR($J("",80)," ","-")
  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.  ;----------
  1. HEADERD ;EP
  1.  S X="**** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****" D W^BGP0DP(X,0,2,BGPPTYPE)
  1.  I BGPRTYPE=1 S X="***  IHS 2010 GPRA Performance & PART Patient List  ***" D W^BGP0DP(X,0,1,BGPPTYPE)
  1.  I BGPRTYPE=9 S X="***  IHS 2010 GPRA Developmental Measures Patient List  ***" D W^BGP0DP(X,0,1,BGPPTYPE)
  1.  I BGPRTYPE=7 S X="***  IHS 2010 Other National Measures Patient List  ***" D W^BGP0DP(X,0,1,BGPPTYPE)
  1.  S X=$$RPTVER^BGP0BAN D W^BGP0DP(X,0,1,BGPPTYPE)
  1.  S X=$P(^DIC(4,DUZ(2),0),U) D W^BGP0DP(X,0,1,BGPPTYPE)
  1.  S X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED) D W^BGP0DP(X,0,1,BGPPTYPE)
  1.  S X=$S(BGPLIST="A":"All Patients",BGPLIST="R":"Random Patient List",1:"Patient List by Provider: "_BGPLPROV) D W^BGP0DP(X,0,1,BGPPTYPE)
  1.  S X=$TR($J("",80)," ","-") D W^BGP0DP(X,0,1,BGPPTYPE)
  1.  Q