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

BGP0EOS.m

Go to the documentation of this file.
  1. BGP0EOS ; IHS/CMI/LAB - IHS gpra print ;
  1. ;;10.0;IHS CLINICAL REPORTING;;JUN 18, 2010
  1. ;
  1. START ;
  1. Q:$G(BGPAREAA)
  1. ;Q:'$D(BGPLIST) ;cmi/maw 7/9/08 orig line
  1. Q:'$O(BGPLIST("")) ;cmi/maw 7/9/08 modified as BGPLIST always exists but sometimes not with the list array
  1. S BGPQUIT="",BGPGPG=0,BGPCOUNT=0
  1. D:BGPPTYPE="P" W^BGP0EOH("PATIENT LISTS",0,3,BGPPTYPE) D
  1. .D W^BGP0EOH("**** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****",0,2,BGPPTYPE)
  1. S BGPL=0 F S BGPL=$O(BGPLIST(BGPL)) Q:BGPL'=+BGPL!(BGPQUIT) D
  1. .S BGPCOUNT=0,BGPPCNT=0
  1. .I BGPPTYPE="P" D HEADER Q:BGPQUIT
  1. .I BGPPTYPE="D" D W^BGP0EOH("",0,2,BGPPTYPE)
  1. .S BGPCNT=$G(BGPLIST(BGPL))
  1. .I 'BGPCNT S BGPCNT=0 G GO
  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 W^BGP0EOH($P(^BGPEOMT(BGPL,0),U,2),0,1,BGPPTYPE)
  1. .I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
  1. .D W^BGP0EOH("Denominator(s):",0,2,BGPPTYPE)
  1. .S BGPX=0 F S BGPX=$O(^BGPEOMT(BGPL,61,"B",BGPX)) Q:BGPX'=+BGPX!(BGPQUIT) D
  1. ..S BGPY=0 F S BGPY=$O(^BGPEOMT(BGPL,61,"B",BGPX,BGPY)) Q:BGPY'=+BGPY!(BGPQUIT) D
  1. ...D WP
  1. .I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
  1. .D W^BGP0EOH("Numerator(s):",0,2,BGPPTYPE)
  1. .S BGPX=0 F S BGPX=$O(^BGPEOMT(BGPL,62,"B",BGPX)) Q:BGPX'=+BGPX!(BGPQUIT) D
  1. ..S BGPY=0 F S BGPY=$O(^BGPEOMT(BGPL,62,"B",BGPX,BGPY)) Q:BGPY'=+BGPY!(BGPQUIT) D
  1. ...D WP
  1. .I $O(^BGPEOMT(BGPL,11,0)) D W^BGP0EOH("Logic:",0,2,BGPPTYPE) S BGPX=0 F S BGPX=$O(^BGPEOMT(BGPL,11,BGPX)) Q:BGPX'=+BGPX D
  1. ..I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
  1. ..D W^BGP0EOH(^BGPEOMT(BGPL,11,BGPX,0),0,1,BGPPTYPE)
  1. .D W^BGP0EOH("",0,1,BGPPTYPE) S BGPX=0 F S BGPX=$O(^BGPEOMT(BGPL,71,BGPX)) Q:BGPX'=+BGPX D
  1. ..I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
  1. ..;D W^BGP0EOH(^BGPEOMT(BGPL,71,BGPX,0),0,1,BGPPTYPE)
  1. .D H1
  1. .S BGPCOM="" F S BGPCOM=$O(^XTMP("BGP0D",BGPJ,BGPH,"LIST",BGPL,BGPCOM)) Q:BGPCOM=""!(BGPQUIT) D
  1. ..S BGPSEX="" F S BGPSEX=$O(^XTMP("BGP0D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX)) Q:BGPSEX=""!(BGPQUIT) D
  1. ...S BGPAGE="" F S BGPAGE=$O(^XTMP("BGP0D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE)) Q:BGPAGE=""!(BGPQUIT) D
  1. ....S DFN=0 F S DFN=$O(^XTMP("BGP0D",BGPJ,BGPH,"LIST",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^BGP0EOH("Total # of Patients on list: "_+$G(BGPPCNT),0,2,BGPPTYPE),W^BGP0EOH("",0,1,BGPPTYPE)
  1. Q
  1. WP ;
  1. K ^UTILITY($J,"W")
  1. S BGPZ=0,BGPLCNT=0
  1. S DIWL=1,DIWR=80,DIWF="",BGPZ=0 F S BGPZ=$O(^BGPEOMT(BGPL,BGPNODE,BGPY,1,BGPZ)) Q:BGPZ'=+BGPZ D
  1. .S BGPLCNT=BGPLCNT+1
  1. .S X=^BGPEOMT(BGPL,BGPNODE,BGPY,1,BGPZ,0) S:BGPLCNT=1 X=" - "_X D ^DIWP
  1. .Q
  1. WPS ;
  1. S Z=0 F S Z=$O(^UTILITY($J,"W",DIWL,Z)) Q:Z'=+Z D
  1. .I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
  1. .D W^BGP0EOH(^UTILITY($J,"W",DIWL,Z,0),0,1,BGPPTYPE)
  1. K DIWL,DIWR,DIWF,Z
  1. K ^UTILITY($J,"W"),X
  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. .D H1
  1. S BGPPCNT=BGPPCNT+1
  1. D W^BGP0EOH($E($P(^DPT(DFN,0),U),1,22),0,1,BGPPTYPE)
  1. D W^BGP0EOH($$HRN^AUPNPAT(DFN,DUZ(2)),0,0,BGPPTYPE,2,24)
  1. D W^BGP0EOH(BGPCOM,0,0,BGPPTYPE,3,31)
  1. D W^BGP0EOH(BGPSEX,0,0,BGPPTYPE,4,46)
  1. D W^BGP0EOH(BGPAGE,0,0,BGPPTYPE,5,49)
  1. D W^BGP0EOH($P(^XTMP("BGP0D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",1),0,0,BGPPTYPE,6,53)
  1. D W^BGP0EOH($P(^XTMP("BGP0D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",2),0,0,BGPPTYPE,7,59)
  1. ;W !,$E($P(^DPT(DFN,0),U),1,22),?24,$$HRN^AUPNPAT(DFN,DUZ(2)),?31,$E(BGPCOM,1,14),?46,BGPSEX,?49,BGPAGE
  1. ;W ?53,$P(^XTMP("BGP0D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",1),?59,$P(^XTMP("BGP0D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",2)
  1. Q
  1. ;
  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. W !,$$CTR("*** IHS 2010 Executive Order Quality Transparency Measures Patient List ***",80),!
  1. W $$CTR($P(^DIC(4,DUZ(2),0),U),80),!
  1. S X="Reporting Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED) W $$CTR(X,80),!
  1. ;W $$CTR($S(BGPLIST="A":"Entire Patient List",BGPLIST="R":"Random Patient List",1:"Patient List by Provider: "_BGPLPROV),80),!
  1. W !,$TR($J("",80)," ","-")
  1. Q
  1. H1 ;
  1. S X=$S(BGPLIST="A":"Entire Patient List",BGPLIST="R":"Random Patient List",1:"Patient List by Provider: "_BGPLPROV) D W^BGP0EOH(X,0,1,BGPPTYPE)
  1. D W^BGP0EOH("UP=User Pop; AC=Active Clinical; AD=Active Diabetic",0,2,BGPPTYPE),W^BGP0EOH("",0,1,BGPPTYPE)
  1. S N=$S(BGPCOUNT<2:71,1:72) S X=0 F S X=$O(^BGPEOMT(BGPL,N,X)) Q:X'=+X D W^BGP0EOH(^BGPEOMT(BGPL,N,X,0),0,1,BGPPTYPE)
  1. D W^BGP0EOH("PATIENT NAME",0,2,BGPPTYPE)
  1. D W^BGP0EOH("HRN",0,0,BGPPTYPE,2,24)
  1. D W^BGP0EOH("COMMUNITY",0,0,BGPPTYPE,3,31)
  1. D W^BGP0EOH("SEX",0,0,BGPPTYPE,4,45)
  1. D W^BGP0EOH("AGE",0,0,BGPPTYPE,5,49)
  1. D W^BGP0EOH("DENOM",0,0,BGPPTYPE,6,53)
  1. D W^BGP0EOH("NUMERATOR",0,0,BGPPTYPE,7,59)
  1. D W^BGP0EOH($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. ;----------