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

BGP6DPEE.m

Go to the documentation of this file.
  1. BGP6DPEE ; IHS/CMI/LAB - IHS gpra print ;
  1. ;;16.1;IHS CLINICAL REPORTING;;MAR 22, 2016;Build 170
  1. ;
  1. START ;
  1. Q:$G(BGPAREAA)
  1. Q:'$D(BGPLIST)
  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 BGPL=0 F S BGPL=$O(^XTMP("BGP6PE",BGPJ,BGPH,"LIST",BGPL)) Q:BGPL'=+BGPL D
  1. S BGPL=0 F S BGPL=$O(BGPLIST(BGPL)) Q:BGPL'=+BGPL D
  1. .S BGPCOUNT=0,BGPPCNT=0
  1. .S BGPCNT=$G(BGPLIST(BGPL))
  1. .S:'BGPCNT BGPCNT=0
  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=" " D S(X,1,1) D S(X,1,1)
  1. .S X="**** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****" D S(X,1,1)
  1. .S X=$P(^BGPPEIM(BGPL,0),U,2) D S(X,1,1)
  1. .S X=" " D S(X,1,1)
  1. .I $G(BGPDNT) G CALC
  1. .S X="Denominator(s):" D S(X,1,1)
  1. .S BGPX=0 F S BGPX=$O(^BGPPEIM(BGPL,61,"B",BGPX)) Q:BGPX'=+BGPX D
  1. ..S BGPY=0 F S BGPY=$O(^BGPPEIM(BGPL,61,"B",BGPX,BGPY)) Q:BGPY'=+BGPY D
  1. ...S BGPZ=0 F S BGPZ=$O(^BGPPEIM(BGPL,61,BGPY,11,BGPZ)) Q:BGPZ'=+BGPZ D
  1. ....S Y=^BGPPEIM(BGPL,61,BGPY,11,BGPZ,0) S:BGPZ=1 Y=" - "_Y 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 BGPX=0 F S BGPX=$O(^BGPPEIM(BGPL,62,"B",BGPX)) Q:BGPX'=+BGPX D
  1. ..S BGPY=0 F S BGPY=$O(^BGPPEIM(BGPL,62,"B",BGPX,BGPY)) Q:BGPY'=+BGPY D
  1. ...S BGPZ=0 F S BGPZ=$O(^BGPPEIM(BGPL,62,BGPY,11,BGPZ)) Q:BGPZ'=+BGPZ D
  1. ....S X=^BGPPEIM(BGPL,62,BGPY,11,BGPZ,0) S:BGPZ=1 X=" - "_X D S(X,1,1)
  1. ....Q
  1. ...Q
  1. ..Q
  1. .S X=" " D S(X,1,1)
  1. .S BGPNODE=11
  1. .S BGPX=0 F S BGPX=$O(^BGPPEIM(BGPL,BGPNODE,BGPX)) Q:BGPX'=+BGPX D
  1. ..S X=^BGPPEIM(BGPL,BGPNODE,BGPX,0) D S(X,1,1)
  1. .S X=" " D S(X,1,1) S BGPX=0 F S BGPX=$O(^BGPPEIM(BGPL,51,BGPX)) Q:BGPX'=+BGPX D
  1. ..S X=^BGPPEIM(BGPL,51,BGPX,0) D S(X,1,1)
  1. .S X=" " D S(X,1,1) S BGPX=0 F S BGPX=$O(^BGPPEIM(BGPL,52,BGPX)) Q:BGPX'=+BGPX D
  1. ..S X=^BGPPEIM(BGPL,52,BGPX,0) D S(X,1,1)
  1. CALC .D H1
  1. .S BGPCOM="" F S BGPCOM=$O(^XTMP("BGP6PE",BGPJ,BGPH,"LIST",BGPL,BGPCOM)) Q:BGPCOM="" D
  1. ..S BGPSEX="" F S BGPSEX=$O(^XTMP("BGP6PE",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX)) Q:BGPSEX="" D
  1. ...S BGPAGE="" F S BGPAGE=$O(^XTMP("BGP6PE",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE)) Q:BGPAGE="" D
  1. ....S DFN=0 F S DFN=$O(^XTMP("BGP6PE",BGPJ,BGPH,"LIST",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) S X=$$EDT^BGP6UTL($$DOB^AUPNPAT(DFN)) D S(X,,6)
  1. S X="UP"_$S($P(^XTMP("BGP6PE",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),U,2)=1:", UP PED",1:"") D S(X,,7)
  1. S X=$P(^XTMP("BGP6PE",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),U,1) D S(X,,8)
  1. Q
  1. ;
  1. H1 ;
  1. ;S X=" " D S(X,1,1)
  1. S X=$S(BGPLIST="A":"Entire Patient List",BGPLIST="R":"Random Patient List",BGPLIST="O":"Patient List by Education provider: "_BGPEPROV,BGPLIST="E":"Patient List by Education Provider",1:"Patient List by Provider: "_BGPLPROV) D S(X,1,1)
  1. S X=" " D S(X,1,1) S X="UP=User Pop" D S(X,1,1)
  1. S X=" " D S(X,1,1)
  1. S Y=0 F S Y=$O(^BGPPEIM(BGPL,71,Y)) Q:Y'=+Y S X=^BGPPEIM(BGPL,71,Y,0) 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="DOB" D S(X,,6) S X="DENOMINATOR" D S(X,,7) S X="NUMERATOR" D S(X,,8)
  1. S X=$TR($J("",80)," ","-") D S(X,1,1)
  1. Q
  1. S(Y,F,P) ;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. ;----------