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

BGP5NPLP.m

Go to the documentation of this file. 
  1. BGP5NPLP ; IHS/CMI/LAB - IHS gpra print 30 Jun 2010 5:58 PM ;
  1.  ;;15.1;IHS CLINICAL REPORTING;;MAY 06, 2015;Build 143
  1.  ;
  1. NPL ;
  1.  Q:$G(BGPAREAA)
  1.  S BGPQUIT="",BGPGPG=0
  1.  S BGPINDK=0,BGPCOUNT=0
  1.  S BGPINDK=0 F  S BGPINDK=$O(BGPINDL(BGPINDK)) Q:BGPINDK'=+BGPINDK  D
  1.  .S BGPORD=$P($G(^BGPINDK(BGPINDK,12)),U,6)
  1.  .S BGPLIEN=0 F  S BGPLIEN=$O(BGPINDK(BGPINDK,BGPLIEN)) Q:BGPLIEN'=+BGPLIEN  D
  1.  ..S BGPLORD=$S(BGPRTYPE=1:$P(^BGPNPLK(BGPLIEN,0),U,5),1:$P(^BGPNPLK(BGPLIEN,0),U,6))
  1.  ..S BGPINDK("AOI",BGPORD,BGPINDK,BGPLORD,BGPLIEN)=""
  1.  S BGPORD=0 F  S BGPORD=$O(BGPINDL("AOI",BGPORD)) Q:BGPORD=""!(BGPQUIT)  D
  1.  .S BGPINDK=$O(BGPINDL("AOI",BGPORD,0))
  1.  .S BGPLORD=0 F  S BGPLORD=$O(BGPINDL("AOI",BGPORD,BGPINDK,BGPLORD)) Q:BGPLORD=""!(BGPQUIT)  D
  1.  ..S BGPLIEN=$O(BGPINDL("AOI",BGPORD,BGPINDK,BGPLORD,0))
  1.  ..;I '$$ANYPATS(BGPINDK,BGPINDII) D HEADER W !!,"No Patients to Report.",! Q
  1.  ..D NPL11 ;F  S BGPINDK=$O(^XTMP("BGP5DNP",BGPJ,BGPH,"LIST",BGPINDK)) Q:BGPINDK'=+BGPINDK!(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("BGP5DNP",BGPJ,BGPH,"LIST",BGPINDK,O)) Q:O'=+O  D
  1.  .I $D(^XTMP("BGP5DNP",BGPJ,BGPH,"LIST",BGPINDK,O,BGPL)) S G=1
  1.  .Q
  1.  Q
  1. NPL1 ;EP
  1.  Q:$G(BGPAREAA)
  1.  S BGPCR=$S(BGPRTYPE=7:"AON",1:"AN")
  1.  S BGPORD=$P(^BGPINDK(BGPINDK,12),U,6)
  1.  S BGPLORD=0 F  S BGPLORD=$O(^BGPNPLK(BGPCR,BGPINDK,BGPLORD)) Q:BGPLORD'=+BGPLORD  D
  1.  .S BGPLIEN=$O(^BGPNPLK(BGPCR,BGPINDK,BGPLORD,0)) Q:'BGPLIEN
  1.  .I BGPRTYPE=1!(BGPRTYPE=9) Q:BGPRTYPE'=$P(^BGPNPLK(BGPLIEN,0),U,7)
  1.  .Q:'$D(BGPINDL(BGPINDK,BGPLIEN))
  1.  .I '$D(^XTMP("BGP5DNP",BGPJ,BGPH,"LIST",BGPORD,BGPINDK,BGPLORD,BGPLIEN)) D  Q
  1.  ..D HEADER
  1.  ..S X=0 F  S X=$O(^BGPNPLK(BGPLIEN,11,X)) Q:X'=+X  D W^BGP5DP(^BGPNPLK(BGPLIEN,11,X,0),0,1,BGPPTYPE)
  1.  ..D H1
  1.  ..D W^BGP5DP(" ",0,0,BGPRTYPE)
  1.  ..D W^BGP5DP("Total # of patients on list: 0",0,0,BGPPTYPE)
  1.  ..I BGPPTYPE="D" D W^BGP5DP(" ",0,2,BGPPTYPE)
  1.  .D NPL11
  1.  Q
  1. NPL11 ;
  1.  D  ;S BGPLIEN=0 F  S BGPLIEN=$O(^XTMP("BGP5DNP",BGPJ,BGPH,"LIST",BGPORD,BGPINDK,BGPLORD,BGPLIEN)) Q:BGPLIEN'=+BGPLIEN!(BGPQUIT)  D
  1.  .I BGPRTYPE=1!(BGPRTYPE=9) Q:BGPRTYPE'=$P(^BGPNPLK(BGPLIEN,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^BGP5DP("",0,3,BGPPTYPE)
  1.  .S BGPCNT=BGPINDL(BGPINDK,BGPLIEN)
  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^BGP5DP(BGPINDK)  ;W !,$P(^BGPINDK(BGPINDK,0),U,3)
  1. NEXT .;
  1.  .S BGPX=0 F  S BGPX=$O(^BGPNPLK(BGPLIEN,11,BGPX)) Q:BGPX'=+BGPX  D
  1.  ..I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
  1.  ..D W^BGP5DP(^BGPNPLK(BGPLIEN,11,BGPX,0),0,1,BGPPTYPE)
  1.  .D H1
  1.  .;I '$D(^XTMP("BGP5DNP",BGPJ,BGPH,"LIST",BGPORD,BGPINDK,BGPLORD,BGPLIEN)) W !!,"No patients to report.",! Q
  1.  .S BGPCOM="" F  S BGPCOM=$O(^XTMP("BGP5DNP",BGPJ,BGPH,"LIST",BGPORD,BGPINDK,BGPLORD,BGPLIEN,BGPCOM)) Q:BGPCOM=""!(BGPQUIT)  D
  1.  ..S BGPSEX="" F  S BGPSEX=$O(^XTMP("BGP5DNP",BGPJ,BGPH,"LIST",BGPORD,BGPINDK,BGPLORD,BGPLIEN,BGPCOM,BGPSEX)) Q:BGPSEX=""!(BGPQUIT)  D
  1.  ...S BGPAGE="" F  S BGPAGE=$O(^XTMP("BGP5DNP",BGPJ,BGPH,"LIST",BGPORD,BGPINDK,BGPLORD,BGPLIEN,BGPCOM,BGPSEX,BGPAGE)) Q:BGPAGE=""!(BGPQUIT)  D
  1.  ....S DFN=0 F  S DFN=$O(^XTMP("BGP5DNP",BGPJ,BGPH,"LIST",BGPORD,BGPINDK,BGPLORD,BGPLIEN,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^BGP5DP("Total # of patients on list: ",+$G(BGPPCNT),0,2,BGPPTYPE)
  1.  D W^BGP5DP("",0,2,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(^BGPNPLK(BGPLIEN,11,X)) Q:X'=+X  W !,^BGPNPLK(BGPLIEN,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,12),?45,BGPSEX,?49,BGPAGE,?53,$$DATE^BGP5UTL($$DOB^AUPNPAT(DFN)) D
  1.  .S L=$$LASTV(DFN,BGPED)
  1.  .I BGPRTYPE=1!(BGPRTYPE=9) D  I 1
  1.  ..W ?62,$P(L,U),?72,$P(L,U,2)
  1.  ..W !,$P(^XTMP("BGP5DNP",BGPJ,BGPH,"LIST",BGPORD,BGPINDK,BGPLORD,BGPLIEN,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",1),?30,$P(^XTMP("BGP5DNP",BGPJ,BGPH,"LIST",BGPORD,BGPINDK,BGPLORD,BGPLIEN,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",2)
  1.  .E  D
  1.  ..W ?53,$P(^XTMP("BGP5DNP",BGPJ,BGPH,"LIST",BGPORD,BGPINDK,BGPLORD,BGPLIEN,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",1),?65,$P(^XTMP("BGP5DNP",BGPJ,BGPH,"LIST",BGPORD,BGPINDK,BGPLORD,BGPLIEN,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_U_$$EDT^BGP5UTL($$DOB^AUPNPAT(DFN))
  1.  .S L=$$LASTV(DFN,BGPED)
  1.  .I BGPRTYPE=1!(BGPRTYPE=9) D  I 1
  1.  ..S $P(X,U,7)=$P(L,U)
  1.  ..S $P(X,U,8)=$P(L,U,2)
  1.  ..S Y=$P(^XTMP("BGP5DNP",BGPJ,BGPH,"LIST",BGPORD,BGPINDK,BGPLORD,BGPLIEN,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",1) S $P(X,U,9)=Y
  1.  ..S Y=$P(^XTMP("BGP5DNP",BGPJ,BGPH,"LIST",BGPORD,BGPINDK,BGPLORD,BGPLIEN,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",2) S $P(X,U,10)=Y
  1.  .E  D
  1.  ..S Y=$P(^XTMP("BGP5DNP",BGPJ,BGPH,"LIST",BGPORD,BGPINDK,BGPLORD,BGPLIEN,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",1) S $P(X,U,7)=Y
  1.  ..S Y=$P(^XTMP("BGP5DNP",BGPJ,BGPH,"LIST",BGPORD,BGPINDK,BGPLORD,BGPLIEN,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",2) S $P(X,U,8)=Y
  1. PRINTL1 .D W^BGP5DP(X,0,1,BGPPTYPE)
  1.  K ^TMP($J,"A")
  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 2015 GPRA/GPRAMA Patient List  ***",80),!
  1.  I BGPRTYPE=9 W !,$$CTR("***  IHS 2015 GPRA Developmental Measures Patient List  ***",80),!
  1.  I BGPRTYPE=7 W !,$$CTR("***  IHS 2015 Other National Measures Patient List  ***",80),!
  1.  W $$CTR($$RPTVER^BGP5BAN,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.  ;I BGPRTYPE'=1,BGPRTYPE'=9 D H1O Q
  1.  D W^BGP5DP("UP=User Pop; AC=Active Clinical; AD=Active Diabetic; AAD=Active Adult Diabetic",0,2,BGPPTYPE)
  1.  D W^BGP5DP("PREG=Pregnant Female; IMM=Active IMM Pkg Pt; CHD=Active Coronary Heart Disease",0,1,BGPPTYPE)
  1.  D W^BGP5DP("HR-High Risk Patient",0,1,BGPPTYPE)
  1.  D W^BGP5DP("PATIENT NAME",0,1,BGPPTYPE,1)
  1.  D W^BGP5DP("HRN",0,0,BGPPTYPE,2,24)  ;,?24,"HRN",
  1.  D W^BGP5DP("COMMUNITY",0,0,BGPPTYPE,3,31)  ;?31,"COMMUNITY",
  1.  D W^BGP5DP("SEX",0,0,BGPPTYPE,4,45)  ;?45,"SEX",
  1.  D W^BGP5DP("AGE",0,0,BGPPTYPE,5,49)  ;?49,"AGE",
  1.  D W^BGP5DP("DOB",0,0,BGPPTYPE,6,53)
  1.  I BGPPTYPE="D" D W^BGP5DP("LAST MEDICAL VISIT",0,0,BGPPTYPE,7,62)
  1.  I BGPPTYPE="P" D W^BGP5DP("LAST MEDI-",0,0,BGPPTYPE,7,62)
  1.  I BGPPTYPE="D" D W^BGP5DP("LAST VISIT",0,0,BGPPTYPE,8,74)
  1.  I BGPPTYPE="P" D W^BGP4DP("LAST ",0,0,BGPPTYPE,8,74)
  1.  D W^BGP5DP("DENOMINATOR",0,$S(BGPPTYPE="P":1,1:0),BGPPTYPE,9,1)  ;?53,"DENOMINATOR",
  1.  D W^BGP5DP("NUMERATOR",0,0,BGPPTYPE,10,30)  ;?65,"NUMERATOR"
  1.  I BGPPTYPE="P" D W^BGP5DP("CAL VISIT",0,0,BGPPTYPE,7,62)
  1.  I BGPPTYPE="P" D W^BGP4DP("VISIT",0,0,BGPPTYPE,8,74)
  1.  D W^BGP5DP($TR($J("",80)," ","-"),0,1,BGPPTYPE)
  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^BGP5DP(X,0,2,BGPPTYPE)
  1.  I BGPRTYPE=1 S X="***  IHS 2015 GPRA/GPRAMA Patient List  ***" D W^BGP5DP(X,0,1,BGPPTYPE)
  1.  I BGPRTYPE=9 S X="***  IHS 2015 GPRA Developmental Measures Patient List  ***" D W^BGP5DP(X,0,1,BGPPTYPE)
  1.  I BGPRTYPE=7 S X="***  IHS 2015 Other National Measures Patient List  ***" D W^BGP5DP(X,0,1,BGPPTYPE)
  1.  S X=$$RPTVER^BGP5BAN D W^BGP5DP(X,0,1,BGPPTYPE)
  1.  S X=$P(^DIC(4,DUZ(2),0),U) D W^BGP5DP(X,0,1,BGPPTYPE)
  1.  S X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED) D W^BGP5DP(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^BGP5DP(X,0,1,BGPPTYPE)
  1.  S X=$TR($J("",80)," ","-") D W^BGP5DP(X,0,1,BGPPTYPE)
  1.  Q
  1. LASTV(P,EDATE) ;
  1.  ;return last medical visit date^last visit date in mm/dd/yy format
  1.  K ^TMP($J,"A")
  1.  NEW LCC,LV,A,B,E,X
  1.  S LCC="",LV=""
  1.  S A="^TMP($J,""A"",",B=P_"^ALL VISITS;DURING "_$$FMADD^XLFDT(EDATE,-(4*365))_"-"_EDATE,E=$$START1^APCLDF(B,A)
  1.  I '$D(^TMP($J,"A",1)) Q ""
  1.  ;reorder in reverse order
  1.  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
  1.  .Q:'$D(^AUPNVSIT(V,0))
  1.  .Q:'$P(^AUPNVSIT(V,0),U,9)
  1.  .Q:$P(^AUPNVSIT(V,0),U,11)
  1.  .Q:'$D(^AUPNVPRV("AD",V))
  1.  .Q:"SAHOR"'[$P(^AUPNVSIT(V,0),U,7)
  1.  .Q:"V"[$P(^AUPNVSIT(V,0),U,3)
  1.  .Q:$P(^AUPNVSIT(V,0),U,6)=""
  1.  .S D=$$VD^APCLV(V)
  1.  .S B=$$CLINIC^APCLV(V,"C")
  1.  .I B,$D(^BGPCTRL($O(^BGPCTRL("B",2015,0)),11,"B",B)) S LCC(9999999-D)=V
  1.  .I B,$D(^BGPCTRL($O(^BGPCTRL("B",2015,0)),12,"B",B)) S LCC(9999999-D)=V
  1.  .S LV(9999999-D)=V
  1.  .Q
  1.  S LV=$O(LV(0))
  1.  S LCC=$O(LCC(0))
  1.  I LV S LV=$$DATE^BGP5UTL((9999999-LV))
  1.  I LCC S LCC=$$DATE^BGP5UTL((9999999-LCC))
  1.  Q LCC_U_LV