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

BGP1DS.m

Go to the documentation of this file.
BGP1DS ; IHS/CMI/LAB - IHS gpra print ;
 ;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
 ;
START ;
 Q:$G(BGPAREAA)
 Q:'$D(BGPLIST)
 I $G(BGPNPL) Q
 I $G(BGPCPPL) Q  ;not on comprehensive pt
 S BGPQUIT="",BGPGPG=0
 ;D HEADER
 S BGPORDSE=0 F  S BGPORDSE=$O(^BGPINDB("AOI",BGPORDSE)) Q:BGPORDSE'=+BGPORDSE!(BGPQUIT)  S BGPL=$O(^BGPINDB("AOI",BGPORDSE,0)) I $D(BGPLIST(BGPL)) D
 .S BGPFIRSP=1 S BGPCOUNT=0,BGPPCNT=0
 .D HEADER Q:BGPQUIT
 .S BGPCNT=$G(BGPLIST(BGPL))
 .I 'BGPCNT S BGPCNT=0 G GO
 .I BGPCNT<100 S BGPCNT=1 G GO
 .I BGPLIST'="R" S BGPCNT=1 G GO
 .;I BGPCNT<100 S BGPCNT=BGPCNT\10 G GO
 .;I BGPCNT<100 G GO
 .S BGPCNT=10
GO .;
 .D WTITLE^BGP1DP(BGPL)  ;W !,$P(^BGPINDB(BGPL,0),U,3),!
 .D W^BGP1DP("Denominator(s):",0,1,BGPPTYPE)
 .S BGPNODE=$S(BGPRTYPE=1:81,BGPRTYPE=4:61,BGPRTYPE=7:83,BGPRTYPE=9:85,1:61)
 .I BGPRTYPE=4 S BGPNODE=$S(BGPINDB="D":87,BGPINDB="C":89,BGPINDB="W":92,BGPINDB="I":94,BGPINDB="P":96,1:BGPNODE)
 .S BGPX=0 F  S BGPX=$O(^BGPINDB(BGPL,BGPNODE,"B",BGPX)) Q:BGPX'=+BGPX!(BGPQUIT)  D
 ..S BGPY=0 F  S BGPY=$O(^BGPINDB(BGPL,BGPNODE,"B",BGPX,BGPY)) Q:BGPY'=+BGPY!(BGPQUIT)  D
 ...;I '$D(^BGPINDB(BGPL,BGPNODE,BGPY,11,"B",BGPRTYPE)) Q  ;not this report type
 ...;I BGPRTYPE=4,'$D(^BGPINDB(BGPL,BGPNODE,BGPY,12,"B",BGPINDB)) Q  ;not this measure type on selected
 ...D WP
 .I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER^BGP1DPH Q:BGPQUIT
 .D W^BGP1DP("Numerator(s):",0,2,BGPPTYPE)
 .S BGPNODE=$S(BGPRTYPE=1:82,BGPRTYPE=4:62,BGPRTYPE=7:84,BGPRTYPE=9:86,1:62)
 .I BGPRTYPE=4 S BGPNODE=$S(BGPINDB="D":88,BGPINDB="C":91,BGPINDB="W":93,BGPINDB="I":95,BGPINDB="P":97,1:BGPNODE)
 .S BGPX=0 F  S BGPX=$O(^BGPINDB(BGPL,BGPNODE,"B",BGPX)) Q:BGPX'=+BGPX!(BGPQUIT)  D
 ..S BGPY=0 F  S BGPY=$O(^BGPINDB(BGPL,BGPNODE,"B",BGPX,BGPY)) Q:BGPY'=+BGPY!(BGPQUIT)  D
 ...;I '$D(^BGPINDB(BGPL,62,BGPY,11,"B",BGPRTYPE)) Q  ;not this report type
 ...;I BGPRTYPE=4,'$D(^BGPINDB(BGPL,BGPNODE,BGPY,12,"B",BGPINDB)) Q  ;not this measure type on selected
 ...D WP
 .S BGPNODE=11
 .I BGPRTYPE=1,$O(^BGPINDB(BGPL,54,0)) S BGPNODE=54
 .I BGPRTYPE=7,$O(^BGPINDB(BGPL,56,0)) S BGPNODE=56
 .I BGPRTYPE=9,$O(^BGPINDB(BGPL,58,0)) S BGPNODE=58
 .D W^BGP1DP("Logic:",0,2,BGPPTYPE) S BGPX=0 F  S BGPX=$O(^BGPINDB(BGPL,BGPNODE,BGPX)) Q:BGPX'=+BGPX  D
 ..I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER^BGP1DPH Q:BGPQUIT
 ..D W^BGP1DP(^BGPINDB(BGPL,BGPNODE,BGPX,0),0,1,BGPPTYPE)
 .D W^BGP1DP("Performance Measure Description:",0,2,BGPPTYPE) S BGPX=0 F  S BGPX=$O(^BGPINDB(BGPL,$S($G(BGPNGR09):57,1:51),BGPX)) Q:BGPX'=+BGPX  D
 ..I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER^BGP1DPH Q:BGPQUIT
 ..D W^BGP1DP(^BGPINDB(BGPL,$S($G(BGPNGR09):57,1:51),BGPX,0),0,1,BGPPTYPE)
 .I $O(^BGPINDB(BGPL,52,0)) D W^BGP1DP("Past Performance and/or Target:",0,2,BGPPTYPE) S BGPX=0 F  S BGPX=$O(^BGPINDB(BGPL,52,BGPX)) Q:BGPX'=+BGPX  D
 ..I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER^BGP1DPH Q:BGPQUIT
 ..D W^BGP1DP(^BGPINDB(BGPL,52,BGPX,0),0,1,BGPPTYPE)
 .I $O(^BGPINDB(BGPL,55,0)) D W^BGP1DP("Source:",0,2,BGPPTYPE) S BGPX=0 F  S BGPX=$O(^BGPINDB(BGPL,55,BGPX)) Q:BGPX'=+BGPX  D
 ..I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER^BGP1DPH Q:BGPQUIT
 ..D W^BGP1DP(^BGPINDB(BGPL,55,BGPX,0),0,1,BGPPTYPE)
 .I '$O(^BGPINDB(BGPL,55,0)) D W^BGP1DP("",0,1,BGPPTYPE)
 .D H1
 .Q:BGPQUIT
 .S BGPCOM="" F  S BGPCOM=$O(^XTMP("BGP1D",BGPJ,BGPH,"LIST",BGPL,BGPCOM)) Q:BGPCOM=""!(BGPQUIT)  D
 ..S BGPSEX="" F  S BGPSEX=$O(^XTMP("BGP1D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX)) Q:BGPSEX=""!(BGPQUIT)  D
 ...S BGPAGE="" F  S BGPAGE=$O(^XTMP("BGP1D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE)) Q:BGPAGE=""!(BGPQUIT)  D
 ....S DFN=0 F  S DFN=$O(^XTMP("BGP1D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN)) Q:DFN'=+DFN!(BGPQUIT)  S BGPCOUNT=BGPCOUNT+1 D PRINTL
 ....Q
 ...Q
 ..Q
 .I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER Q:BGPQUIT
 .D W^BGP1DP("Total # of Patients on list: "_+$G(BGPPCNT),0,2,BGPPTYPE)
 .D W^BGP1DP("",0,1,BGPPTYPE)
 D W^BGP1DP("",0,1,BGPPTYPE)
 Q
WP ;
 K ^UTILITY($J,"W")
 S BGPZ=0,BGPLCNT=0
 S DIWL=1,DIWR=80,DIWF="",BGPZ=0 F  S BGPZ=$O(^BGPINDB(BGPL,BGPNODE,BGPY,1,BGPZ)) Q:BGPZ'=+BGPZ  D
 .S BGPLCNT=BGPLCNT+1
 .S X=^BGPINDB(BGPL,BGPNODE,BGPY,1,BGPZ,0) S:BGPLCNT=1 X=" - "_X D ^DIWP
 .Q
WPS ;
 S Z=0 F  S Z=$O(^UTILITY($J,"W",DIWL,Z)) Q:Z'=+Z  D
 .I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER^BGP1DPH Q:BGPQUIT
 .D W^BGP1DP(^UTILITY($J,"W",DIWL,Z,0),0,1,BGPPTYPE)
 K DIWL,DIWR,DIWF,Z
 K ^UTILITY($J,"W"),X
 Q
 ;
PRINTL ;print one line
 Q:(BGPCOUNT#BGPCNT)
 I BGPPTYPE="P",$Y>(BGPIOSL-3) D HEADER Q:BGPQUIT  D
 .;S X=0 F  S X=$O(^BGPINDB(BGPL,72,X)) Q:X'=+X  W !,^BGPINDB(BGPL,72,X,0)
 .D H1
 Q:BGPQUIT
 S BGPPCNT=BGPPCNT+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
 .W ?53,$P(^XTMP("BGP1D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",1)
 .W:BGPL=43 " NUMERATOR: "
 .W ?65,$P(^XTMP("BGP1D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",2)
 I BGPPTYPE="D" D
 .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
 .S Y=$P(^XTMP("BGP1D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",1) S $P(X,U,6)=Y
 .S Y=$P(^XTMP("BGP1D",BGPJ,BGPH,"LIST",BGPL,BGPCOM,BGPSEX,BGPAGE,DFN),"|||",2) S $P(X,U,7)=Y
 .D W^BGP1DP(X,0,1,BGPPTYPE)
 Q
 ;
 I BGPPTYPE'="P" G HEADER1
 G:'BGPGPG HEADER1
 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
HEADER1 ;
 I BGPPTYPE="P" W:$D(IOF) @IOF S BGPGPG=BGPGPG+1
 I $G(BGPGUI),BGPPTYPE="P" D W^BGP1DP("ZZZZZZZ",0,1,BGPPTYPE)  ;!  ;maw
 D W^BGP1DP("***** CONFIDENTIAL PATIENT INFORMATION, COVERED BY THE PRIVACY ACT *****",1,1,BGPPTYPE)
 I BGPPTYPE="P" S X=$P(^VA(200,DUZ,0),U,2),$E(X,35)=$$FMTE^XLFDT(DT),$E(X,70)="Page "_BGPGPG D W^BGP1EOH(X,1,1,BGPPTYPE)
 I BGPPTYPE'="P" S X=$P(^VA(200,DUZ,0),U,2),$P(X,U,2)=$$FMTE^XLFDT(DT) D W^BGP1DP(X,0,1,BGPPTYPE)
 D W^BGP1DP("*** IHS 2011 Clinical Performance Measure Patient List  ***",1,1,BGPPTYPE)
 D W^BGP1DP($P(^DIC(4,DUZ(2),0),U),1,1,BGPPTYPE)
 S X="Report Period: "_$$FMTE^XLFDT(BGPBD)_" to "_$$FMTE^XLFDT(BGPED) D W^BGP1DP(X,1,1,BGPPTYPE)
 D W^BGP1DP($S(BGPLIST="A":"Entire Patient List",BGPLIST="R":"Random Patient List",1:"Patient List by Provider: "_BGPLPROV),1,1,BGPPTYPE)
 D W^BGP1DP($TR($J("",80)," ","-"),0,1,BGPPTYPE)
 Q
H1 ;
 S BGPTSUB=$S(BGPFIRSP:71,1:72)
 S X=0,C=0 F  S X=$O(^BGPINDB(BGPL,BGPTSUB,X)) Q:X'=+X  S C=C+1
 I BGPPTYPE="P",$Y>(BGPIOSL-(C+6)) D HEADER Q:BGPQUIT
 D W^BGP1DP("UP=User Pop; AC=Active Clinical; AD=Active Diabetic; AAD=Active Adult Diabetic",0,1,BGPPTYPE)
 D W^BGP1DP("PREG=Pregnant Female; IMM=Active IMM Pkg Pt; IHD=Active Ischemic Heart Disease",0,1,BGPPTYPE)
 ;D W^BGP1DP("CHD=Active Coronary Heart Disease",0,1,BGPRTYPE)
 D W^BGP1DP("",0,1,BGPPTYPE)
 S X=0 F  S X=$O(^BGPINDB(BGPL,BGPTSUB,X)) Q:X'=+X  D W^BGP1DP(^BGPINDB(BGPL,BGPTSUB,X,0),0,1,BGPPTYPE)
 D W^BGP1DP("",0,1,BGPPTYPE)
 D W^BGP1DP("PATIENT NAME",0,1,BGPPTYPE,1)
 D W^BGP1DP("HRN",0,0,BGPPTYPE,2,24)  ;,?24,"HRN",
 D W^BGP1DP("COMMUNITY",0,0,BGPPTYPE,3,31)  ;?31,"COMMUNITY",
 D W^BGP1DP("SEX",0,0,BGPPTYPE,4,45)  ;?45,"SEX",
 D W^BGP1DP("AGE",0,0,BGPPTYPE,5,49)  ;?49,"AGE",
 D W^BGP1DP("DENOMINATOR",0,0,BGPPTYPE,6,53)  ;?53,"DENOMINATOR",
 D W^BGP1DP("NUMERATOR",0,0,BGPPTYPE,7,65)  ;?65,"NUMERATOR"
 D W^BGP1DP($TR($J("",80)," ","-"),0,1,BGPPTYPE)
 S BGPFIRSP=0
 Q