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

BGP7DPEQ.m

Go to the documentation of this file.
BGP7DPEQ ; IHS/CMI/LAB - IHS gpra print ;
 ;;17.1;IHS CLINICAL REPORTING;;MAY 10, 2017;Build 29
 ;
7 ;EP
 I $Y>(BGPIOSL-6) D HEADER^BGP7DPEP Q:BGPQUIT  W !,$P(^BGPPEIG(BGPIC,0),U,2)
 D H1^BGP7DPH
 S BGPCYD=$$V^BGP7DPEP(1,BGPRPT,11,29)
 S BGPPRD=$$V^BGP7DPEP(2,BGPRPT,11,29)
 S BGPBLD=$$V^BGP7DPEP(3,BGPRPT,11,29)
 I $G(BGPSEAT) W !!,$P(^DIBT(BGPSEAT,0),U,1)," Population"
 W:'$G(BGPSEAT) ! W !,"# User Pop"
 W ?20,$$C^BGP7DPEP(BGPCYD,0,8),?35,$$C^BGP7DPEP(BGPPRD,0,8),?58,$$C^BGP7DPEP(BGPBLD,0,8),!
 S N=11,P=24 D SETN^BGP7DPEP
 W !,"# w/ Goal Set"
 D H2^BGP7DPH
 K BGPPROVS
 S N=16 D SETNM
 K BGPX
 S BGPCNT=0
 S X="",C=0 F  S X=$O(BGPPROVS(X)) Q:X=""  S Y="" F  S Y=$O(BGPPROVS(X,Y)) Q:Y=""  S C=C+1 S BGPX((9999999-$P(BGPPROVS(X,Y),U,1)),C)=X_U_Y_U_BGPPROVS(X,Y)
 S BGP1=0 F  S BGP1=$O(BGPX(BGP1)) Q:BGP1'=+BGP1!(BGPQUIT)!(BGPCNT>15)  D
 .S BGPCNT=BGPCNT+1 S BGP2=0 F  S BGP2=$O(BGPX(BGP1,BGP2)) Q:BGP2'=+BGP2!(BGPQUIT)  D
 ..I $Y>(BGPIOSL-3) D HEADER^BGP7DPEP Q:BGPQUIT  W !,$P(^BGPPEIG(BGPIC,0),U,2) D H1^BGP7DPH W !
 ..W !?2,BGPCNT,". ",$E($P(BGPX(BGP1,BGP2),U,2),1,15)
 ..S BGPCYN=$P(BGPX(BGP1,BGP2),U,3)
 ..S BGPPRN=$P(BGPX(BGP1,BGP2),U,4)
 ..S BGPBLN=$P(BGPX(BGP1,BGP2),U,5)
 ..S BGPCYP=$P(BGPX(BGP1,BGP2),U,6)
 ..S BGPPRP=$P(BGPX(BGP1,BGP2),U,7)
 ..S BGPBLP=$P(BGPX(BGP1,BGP2),U,8)
 ..D H2^BGP7DPH
 ;not set
 I $Y>(BGPIOSL-6) D HEADER^BGP7DPEP Q:BGPQUIT  W !,$P(^BGPPEIG(BGPIC,0),U,2) D H1^BGP7DPH
 S BGPCYD=$$V^BGP7DPEP(1,BGPRPT,11,29)
 S BGPPRD=$$V^BGP7DPEP(2,BGPRPT,11,29)
 S BGPBLD=$$V^BGP7DPEP(3,BGPRPT,11,29)
 ;I $G(BGPSEAT) W !!,$P(^DIBT(BGPSEAT,0),U,1)," Population"
 ;W:'$G(BGPSEAT) ! W !,"Total User Population",!," Patients"
 W !!
 S N=11,P=25 D SETN^BGP7DPEP
 W !,"# w/ Goal Not Set"
 D H2^BGP7DPH
 I $Y>(BGPIOSL-6) D HEADER^BGP7DPEP Q:BGPQUIT  W !,$P(^BGPPEIG(BGPIC,0),U,2)
 K BGPPROVS
 S N=17 D SETNM^BGP7DPEQ
 K BGPX
 S BGPCNT=0
 S X="",C=0 F  S X=$O(BGPPROVS(X)) Q:X=""  S Y="" F  S Y=$O(BGPPROVS(X,Y)) Q:Y=""  S C=C+1 S BGPX((9999999-$P(BGPPROVS(X,Y),U,1)),C)=X_U_Y_U_BGPPROVS(X,Y)
 S BGP1=0 F  S BGP1=$O(BGPX(BGP1)) Q:BGP1'=+BGP1!(BGPQUIT)!(BGPCNT>15)  D
 .S BGPCNT=BGPCNT+1 S BGP2=0 F  S BGP2=$O(BGPX(BGP1,BGP2)) Q:BGP2'=+BGP2!(BGPQUIT)  D
 ..I $Y>(BGPIOSL-3) D HEADER^BGP7DPEP Q:BGPQUIT  W !,$P(^BGPPEIG(BGPIC,0),U,2) D H1^BGP7DPH W !
 ..W !?2,BGPCNT,". ",$E($P(BGPX(BGP1,BGP2),U,2),1,15)
 ..S BGPCYN=$P(BGPX(BGP1,BGP2),U,3)
 ..S BGPPRN=$P(BGPX(BGP1,BGP2),U,4)
 ..S BGPBLN=$P(BGPX(BGP1,BGP2),U,5)
 ..S BGPCYP=$P(BGPX(BGP1,BGP2),U,6)
 ..S BGPPRP=$P(BGPX(BGP1,BGP2),U,7)
 ..S BGPBLP=$P(BGPX(BGP1,BGP2),U,8)
 ..D H2^BGP7DPH
 ;
 ;met
 I $Y>(BGPIOSL-6) D HEADER^BGP7DPEP Q:BGPQUIT  W !,$P(^BGPPEIG(BGPIC,0),U,2) D H1^BGP7DPH
 S BGPCYD=$$V^BGP7DPEP(1,BGPRPT,11,29)
 S BGPPRD=$$V^BGP7DPEP(2,BGPRPT,11,29)
 S BGPBLD=$$V^BGP7DPEP(3,BGPRPT,11,29)
 ;I $G(BGPSEAT) W !!,$P(^DIBT(BGPSEAT,0),U,1)," Population"
 ;W:'$G(BGPSEAT) ! W !,"Total User Population",!," Patients"
 W !!
 S N=11,P=26 D SETN^BGP7DPEP
 W !,"# w/ Goal Met"
 D H2^BGP7DPH
 I $Y>(BGPIOSL-6) D HEADER^BGP7DPEP Q:BGPQUIT  W !,$P(^BGPPEIG(BGPIC,0),U,2)
 K BGPPROVS
 S N=18 D SETNM^BGP7DPEQ
 K BGPX
 S BGPCNT=0
 S X="",C=0 F  S X=$O(BGPPROVS(X)) Q:X=""  S Y="" F  S Y=$O(BGPPROVS(X,Y)) Q:Y=""  S C=C+1 S BGPX((9999999-$P(BGPPROVS(X,Y),U,1)),C)=X_U_Y_U_BGPPROVS(X,Y)
 S BGP1=0 F  S BGP1=$O(BGPX(BGP1)) Q:BGP1'=+BGP1!(BGPQUIT)!(BGPCNT>15)  D
 .S BGPCNT=BGPCNT+1 S BGP2=0 F  S BGP2=$O(BGPX(BGP1,BGP2)) Q:BGP2'=+BGP2!(BGPQUIT)  D
 ..I $Y>(BGPIOSL-3) D HEADER^BGP7DPEP Q:BGPQUIT  W !,$P(^BGPPEIG(BGPIC,0),U,2) D H1^BGP7DPH W !
 ..W !?2,BGPCNT,". ",$E($P(BGPX(BGP1,BGP2),U,2),1,15)
 ..S BGPCYN=$P(BGPX(BGP1,BGP2),U,3)
 ..S BGPPRN=$P(BGPX(BGP1,BGP2),U,4)
 ..S BGPBLN=$P(BGPX(BGP1,BGP2),U,5)
 ..S BGPCYP=$P(BGPX(BGP1,BGP2),U,6)
 ..S BGPPRP=$P(BGPX(BGP1,BGP2),U,7)
 ..S BGPBLP=$P(BGPX(BGP1,BGP2),U,8)
 ..D H2^BGP7DPH
 ;maintain
 I $Y>(BGPIOSL-6) D HEADER^BGP7DPEP Q:BGPQUIT  W !,$P(^BGPPEIG(BGPIC,0),U,2) D H1^BGP7DPH
 S BGPCYD=$$V^BGP7DPEP(1,BGPRPT,11,29)
 S BGPPRD=$$V^BGP7DPEP(2,BGPRPT,11,29)
 S BGPBLD=$$V^BGP7DPEP(3,BGPRPT,11,29)
 ;I $G(BGPSEAT) W !!,$P(^DIBT(BGPSEAT,0),U,1)," Population"
 ;W:'$G(BGPSEAT) ! W !,"Total User Population",!," Patients"
 W !!
 S N=11,P=27 D SETN^BGP7DPEP
 W !,"# w/ Goal Maintained"
 D H2^BGP7DPH
 I $Y>(BGPIOSL-6) D HEADER^BGP7DPEP Q:BGPQUIT  W !,$P(^BGPPEIG(BGPIC,0),U,2)
 K BGPPROVS
 S N=19 D SETNM^BGP7DPEQ
 K BGPX
 S BGPCNT=0
 S X="",C=0 F  S X=$O(BGPPROVS(X)) Q:X=""  S Y="" F  S Y=$O(BGPPROVS(X,Y)) Q:Y=""  S C=C+1 S BGPX((9999999-$P(BGPPROVS(X,Y),U,1)),C)=X_U_Y_U_BGPPROVS(X,Y)
 S BGP1=0 F  S BGP1=$O(BGPX(BGP1)) Q:BGP1'=+BGP1!(BGPQUIT)!(BGPCNT>15)  D
 .S BGPCNT=BGPCNT+1 S BGP2=0 F  S BGP2=$O(BGPX(BGP1,BGP2)) Q:BGP2'=+BGP2!(BGPQUIT)  D
 ..I $Y>(BGPIOSL-3) D HEADER^BGP7DPEP Q:BGPQUIT  W !,$P(^BGPPEIG(BGPIC,0),U,2) D H1^BGP7DPH W !
 ..W !?2,BGPCNT,". ",$E($P(BGPX(BGP1,BGP2),U,2),1,15)
 ..S BGPCYN=$P(BGPX(BGP1,BGP2),U,3)
 ..S BGPPRN=$P(BGPX(BGP1,BGP2),U,4)
 ..S BGPBLN=$P(BGPX(BGP1,BGP2),U,5)
 ..S BGPCYP=$P(BGPX(BGP1,BGP2),U,6)
 ..S BGPPRP=$P(BGPX(BGP1,BGP2),U,7)
 ..S BGPBLP=$P(BGPX(BGP1,BGP2),U,8)
 ..D H2^BGP7DPH
 ;not met
 I $Y>(BGPIOSL-6) D HEADER^BGP7DPEP Q:BGPQUIT  W !,$P(^BGPPEIG(BGPIC,0),U,2) D H1^BGP7DPH
 S BGPCYD=$$V^BGP7DPEP(1,BGPRPT,11,29)
 S BGPPRD=$$V^BGP7DPEP(2,BGPRPT,11,29)
 S BGPBLD=$$V^BGP7DPEP(3,BGPRPT,11,29)
 ;I $G(BGPSEAT) W !!,$P(^DIBT(BGPSEAT,0),U,1)," Population"
 ;W:'$G(BGPSEAT) ! W !,"Total User Population",!," Patients"
 W !!
 S N=11,P=28 D SETN^BGP7DPEP
 W !,"# w/ Goal Not Met"
 D H2^BGP7DPH
 I $Y>(BGPIOSL-6) D HEADER^BGP7DPEP Q:BGPQUIT  W !,$P(^BGPPEIG(BGPIC,0),U,2)
 K BGPPROVS
 S N=21 D SETNM^BGP7DPEQ
 K BGPX
 S BGPCNT=0
 S X="",C=0 F  S X=$O(BGPPROVS(X)) Q:X=""  S Y="" F  S Y=$O(BGPPROVS(X,Y)) Q:Y=""  S C=C+1 S BGPX((9999999-$P(BGPPROVS(X,Y),U,1)),C)=X_U_Y_U_BGPPROVS(X,Y)
 S BGP1=0 F  S BGP1=$O(BGPX(BGP1)) Q:BGP1'=+BGP1!(BGPQUIT)!(BGPCNT>15)  D
 .S BGPCNT=BGPCNT+1 S BGP2=0 F  S BGP2=$O(BGPX(BGP1,BGP2)) Q:BGP2'=+BGP2!(BGPQUIT)  D
 ..I $Y>(BGPIOSL-3) D HEADER^BGP7DPEP Q:BGPQUIT  W !,$P(^BGPPEIG(BGPIC,0),U,2) D H1^BGP7DPH W !
 ..W !?2,BGPCNT,". ",$E($P(BGPX(BGP1,BGP2),U,2),1,15)
 ..S BGPCYN=$P(BGPX(BGP1,BGP2),U,3)
 ..S BGPPRN=$P(BGPX(BGP1,BGP2),U,4)
 ..S BGPBLN=$P(BGPX(BGP1,BGP2),U,5)
 ..S BGPCYP=$P(BGPX(BGP1,BGP2),U,6)
 ..S BGPPRP=$P(BGPX(BGP1,BGP2),U,7)
 ..S BGPBLP=$P(BGPX(BGP1,BGP2),U,8)
 ..D H2^BGP7DPH
 ;UP PED
 I $Y>(BGPIOSL-6) D HEADER^BGP7DPEP Q:BGPQUIT  W !,$P(^BGPPEIG(BGPIC,0),U,2)
 D H1^BGP7DPH
 S BGPCYD=$$V^BGP7DPEP(1,BGPRPT,11,19)
 S BGPPRD=$$V^BGP7DPEP(2,BGPRPT,11,19)
 S BGPBLD=$$V^BGP7DPEP(3,BGPRPT,11,19)
 I '$G(BGPSEAT) W !!,"# User Pop w/ Pat Ed"
 I $G(BGPSEAT) W !!,$P(^DIBT(BGPSEAT,0),U,1)," Population",!," w/ Pat Ed"
 W ?20,$$C^BGP7DPEP(BGPCYD,0,8),?35,$$C^BGP7DPEP(BGPPRD,0,8),?58,$$C^BGP7DPEP(BGPBLD,0,8),!
 W ! ;,"Goal Setting"
 S N=11,P=20 D SETN^BGP7DPEP
 W !,"# w/goal set"
 D H2^BGP7DPH
 S N=11,P=21 D SETN^BGP7DPEP
 W !,"# w/goal not set"
 D H2^BGP7DPH
 S N=11,P=22 D SETN^BGP7DPEP
 W !,"# w/goal met"
 D H2^BGP7DPH
 S N=11,P=23 D SETN^BGP7DPEP
 W !,"# w/goal not met"
 D H2^BGP7DPH
 ;
 Q
 ;----------
SETNM ;EP
 K BGPPROVS
 S (BGPCYD,BGPPRD,BGPBLD)=0
 I $G(BGPAREAA) D SETNMA Q
 S X=0 F  S X=$O(^BGPPEDCG(BGPRPT,N,X)) Q:X'=+X  D
 .S C=$P(^BGPPEDCG(BGPRPT,N,X,0),U),L=$P(^BGPPEDCG(BGPRPT,N,X,0),U,2),M=$P(^BGPPEDCG(BGPRPT,N,X,0),U,3)
 .S $P(BGPPROVS(C,L),U,1)=M,BGPCYD=BGPCYD+M
 S X=0 F  S X=$O(^BGPPEDPG(BGPRPT,N,X)) Q:X'=+X  D
 .S C=$P(^BGPPEDPG(BGPRPT,N,X,0),U),L=$P(^BGPPEDPG(BGPRPT,N,X,0),U,2),M=$P(^BGPPEDPG(BGPRPT,N,X,0),U,3)
 .S $P(BGPPROVS(C,L),U,2)=M,BGPPRD=BGPPRD+M
 S X=0 F  S X=$O(^BGPPEDBG(BGPRPT,N,X)) Q:X'=+X  D
 .S C=$P(^BGPPEDBG(BGPRPT,N,X,0),U),L=$P(^BGPPEDBG(BGPRPT,N,X,0),U,2),M=$P(^BGPPEDBG(BGPRPT,N,X,0),U,3)
 .S $P(BGPPROVS(C,L),U,3)=M,BGPBLD=BGPBLD+M
 ;set %ages
 S X="" F  S X=$O(BGPPROVS(X)) Q:X=""  S Y="" F  S Y=$O(BGPPROVS(X,Y)) Q:Y=""  D
 .S A=$P(BGPPROVS(X,Y),U,1),$P(BGPPROVS(X,Y),U,4)=$S(BGPCYD:((A/BGPCYD)*100),1:"")
 .S B=$P(BGPPROVS(X,Y),U,2),$P(BGPPROVS(X,Y),U,5)=$S(BGPPRD:((B/BGPPRD)*100),1:"")
 .S C=$P(BGPPROVS(X,Y),U,3),$P(BGPPROVS(X,Y),U,6)=$S(BGPBLD:((C/BGPBLD)*100),1:"")
 .Q
 Q
SETNMA ;
 NEW X,V,C S Z=0,C="" F  S Z=$O(BGPSUL(Z)) Q:Z'=+Z  D SETNMA1
 S X="" F  S X=$O(BGPPROVS(X)) Q:X=""  S Y="" F  S Y=$O(BGPPROVS(X,Y)) Q:Y=""  D
 .S A=$P(BGPPROVS(X,Y),U,1),$P(BGPPROVS(X,Y),U,4)=$S(BGPCYD:((A/BGPCYD)*100),1:"")
 .S B=$P(BGPPROVS(X,Y),U,2),$P(BGPPROVS(X,Y),U,5)=$S(BGPPRD:((B/BGPPRD)*100),1:"")
 .S C=$P(BGPPROVS(X,Y),U,3),$P(BGPPROVS(X,Y),U,6)=$S(BGPBLD:((C/BGPBLD)*100),1:"")
 .Q
 Q
SETNMA1 ;
 S X=0 F  S X=$O(^BGPPEDCG(Z,N,X)) Q:X'=+X  D
 .S C=$P(^BGPPEDCG(Z,N,X,0),U),L=$P(^BGPPEDCG(Z,N,X,0),U,2),M=$P(^BGPPEDCG(Z,N,X,0),U,3)
 .S $P(BGPPROVS(C,L),U,1)=$P($G(BGPPROVS(C,L)),U,1)+M,BGPCYD=BGPCYD+M
 S X=0 F  S X=$O(^BGPPEDPG(Z,N,X)) Q:X'=+X  D
 .S C=$P(^BGPPEDPG(Z,N,X,0),U),L=$P(^BGPPEDPG(Z,N,X,0),U,2),M=$P(^BGPPEDPG(Z,N,X,0),U,3)
 .S $P(BGPPROVS(C,L),U,2)=$P($G(BGPPROVS(C,L)),U,2)+M,BGPPRD=BGPPRD+M
 S X=0 F  S X=$O(^BGPPEDBG(Z,N,X)) Q:X'=+X  D
 .S C=$P(^BGPPEDBG(Z,N,X,0),U),L=$P(^BGPPEDBG(Z,N,X,0),U,2),M=$P(^BGPPEDBG(Z,N,X,0),U,3)
 .S $P(BGPPROVS(C,L),U,3)=$P($G(BGPPROVS(C,L)),U,3)+M,BGPBLD=BGPBLD+M
 .Q
 Q