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

BGP7DP1T.m

Go to the documentation of this file. 
  1. BGP7DP1T ; IHS/CMI/LAB - print ind 1 12 Nov 2010 7:38 AM ;
  1.  ;;17.1;IHS CLINICAL REPORTING;;MAY 10, 2017;Build 29
  1.  ;
  1.  ;HIV SCREENING AGE DIST
  1. I1AGE ;EP  special age tallies
  1.  Q:$G(BGPSUMON)
  1.  I BGPINDG="W" G FEM
  1.  S BGPHD1="Active Clinical Pts 3-17",BGPHD2="Active Clinical Pts 3-17 "
  1.  K BGPDAC,BGPDAP,BGPDAB
  1.  S (BGPX,BGPDD)=0,BGPZZ="E" F BGPXX=1:1:4 D I1AGE1
  1.  D I1AGEP
  1.  S BGPHD1="Male Active Clinical Pts 3-17",BGPHD2="Male Active Clinical Pts 3-17 "
  1.  K BGPDAC,BGPDAP,BGPDAB
  1.  S (BGPX,BGPDD)=0,BGPZZ="G" F BGPXX=1:1:4 D I1AGE1
  1.  D I1AGEP
  1. FEM ;
  1.  S BGPHD1="Female Active Clinical Pts 3-17",BGPHD2="Female Active Clinical Pts 3-17 "
  1.  K BGPDAC,BGPDAP,BGPDAB
  1.  S (BGPX,BGPDD)=0,BGPZZ="I" F BGPXX=1:1:4 D I1AGE1
  1.  D I1AGEP
  1.  Q
  1. I1AGE1 ;
  1.  ;
  1.  I BGPXX=1 S BGPP1=2,BGPP2=3
  1.  I BGPXX=2 S BGPP1=4,BGPP2=5
  1.  I BGPXX=3 S BGPP1=6,BGPP2=7
  1.  I BGPXX=4 S BGPP1=8,BGPP2=9
  1.  ;I BGPXX=9 S BGPP1=10,BGPP2=11
  1.  S BGPZ="A",BGPX=1 D AGES
  1.  S BGPZ="B",BGPX=2 D AGES
  1.  ;S BGPZ="C",BGPX=3 D AGES
  1.  Q
  1. AGES ;
  1.  S BGPF="WCC."_BGPZZ_"."_BGPXX_BGPZ S BGPPC=$O(^BGPINDGC("C",BGPF,0))
  1.  D
  1.  .S BGPDF=$P(^BGPINDGC(BGPPC,0),U,8)
  1.  .S BGPNP=$P(^DD(90558.03,BGPDF,0),U,4),N=$P(BGPNP,";"),P=$P(BGPNP,";",2)
  1.  .S $P(BGPDAC(BGPX),U)=$$V^BGP7DP1C(1,BGPRPT,N,P)
  1.  .S $P(BGPDAP(BGPX),U)=$$V^BGP7DP1C(2,BGPRPT,N,P)
  1.  .S $P(BGPDAB(BGPX),U)=$$V^BGP7DP1C(3,BGPRPT,N,P)
  1.  S BGPCYD=$$V^BGP7DP1C(1,BGPRPT,N,P,1) I $G(BGPAREAA) D SETEXA^BGP7DP1C(1,N,P)
  1.  S BGPPRD=$$V^BGP7DP1C(2,BGPRPT,N,P,1) I $G(BGPAREAA) D SETEXA^BGP7DP1C(2,N,P)
  1.  S BGPBLD=$$V^BGP7DP1C(3,BGPRPT,N,P,1) I $G(BGPAREAA) D SETEXA^BGP7DP1C(3,N,P)
  1.  ;set 2nd piece to numerator and 3rd to %
  1.  S J=$P(BGPF,".",3)
  1.  S Q=1
  1.  ;I J["B" S Q=2
  1.  ;I J["C" S Q=2
  1.  ;I J["D" S Q=2
  1.  S BGPNF=$P(^BGPINDGC(BGPPC,0),U,9)
  1.  S BGPNP=$P(^DD(90558.03,BGPNF,0),U,4),N=$P(BGPNP,";"),P=$P(BGPNP,";",2)
  1.  S $P(BGPDAC(BGPX),U,BGPP1)=$$V^BGP7DP1C(1,BGPRPT,N,P),$P(BGPDAC(BGPX),U,BGPP2)=$S($P(BGPDAC(BGPX),U,Q):($P(BGPDAC(BGPX),U,BGPP1)/$P(BGPDAC(BGPX),U,Q)*100),1:"")
  1.  S $P(BGPDAP(BGPX),U,BGPP1)=$$V^BGP7DP1C(2,BGPRPT,N,P),$P(BGPDAP(BGPX),U,BGPP2)=$S($P(BGPDAP(BGPX),U,Q):($P(BGPDAP(BGPX),U,BGPP1)/$P(BGPDAP(BGPX),U,Q)*100),1:"")
  1.  S $P(BGPDAB(BGPX),U,BGPP1)=$$V^BGP7DP1C(3,BGPRPT,N,P),$P(BGPDAB(BGPX),U,BGPP2)=$S($P(BGPDAB(BGPX),U,Q):($P(BGPDAB(BGPX),U,BGPP1)/$P(BGPDAB(BGPX),U,Q)*100),1:"")
  1.  ;S BGPCYN=$$V^BGP7DP1C(1,BGPRPT,N,P,2)
  1.  ;S BGPPRN=$$V^BGP7DP1C(2,BGPRPT,N,P,2)
  1.  ;S BGPBLN=$$V^BGP7DP1C(3,BGPRPT,N,P,2)
  1.  ;S BGPCYP=$S(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
  1.  ;S BGPPRP=$S(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
  1.  ;S BGPBLP=$S(BGPBLD:((BGPBLN/BGPBLD)*100),1:"")
  1.  D SETN1^BGP7DP1C
  1.  Q
  1. I1AGEP ;
  1.  S BGPYSTP=1
  1.  I '$G(BGPSUMON),BGPPTYPE="P" D HEADER^BGP7DPH Q:BGPQUIT  D W^BGP7DP(^BGPINDG(BGPIC,53,1,0),0,1,BGPPTYPE) D:$D(^BGPINDG(BGPIC,53,2,0)) W^BGP7DP(^BGPINDG(BGPIC,53,2,0),0,1,BGPPTYPE) D AH
  1.  I BGPPTYPE'="P" D W^BGP7DP("",0,2,BGPPTYPE) D AH
  1.  D W^BGP7DP("CURRENT REPORT PERIOD",0,1,BGPPTYPE)
  1.  D W^BGP7DP($S(BGPPTYPE="P":BGPHD2,1:BGPHD1),0,1,BGPPTYPE)
  1.  ;I BGPPTYPE="P" D W^BGP7DP(BGPHD3,0,1,BGPPTYPE)
  1.  S BGPARR="BGPDAC" D I1AGEP1
  1.  ;I '$G(BGPSUMON),BGPPTYPE="P" D HEADER^BGP7DPH Q:BGPQUIT  D W^BGP7DP(^BGPINDG(BGPIC,53,1,0),0,1,BGPPTYPE) D:$D(^BGPINDG(BGPIC,53,2,0)) W^BGP7DP(^BGPINDG(BGPIC,53,2,0),0,1,BGPPTYPE) D AH
  1.  I BGPPTYPE'="P" D W^BGP7DP("",0,2,BGPPTYPE) D AH
  1.  D W^BGP7DP("PREVIOUS REPORT PERIOD",0,1,BGPPTYPE)
  1.  D W^BGP7DP($S(BGPPTYPE="P":BGPHD2,1:BGPHD1),0,1,BGPPTYPE)
  1.  ;I BGPPTYPE="P" D W^BGP7DP(BGPHD3,0,1,BGPPTYPE)
  1.  S BGPARR="BGPDAP" D I1AGEP1
  1.  I '$G(BGPSUMON),BGPPTYPE="P" D HEADER^BGP7DPH Q:BGPQUIT  D W^BGP7DP(^BGPINDG(BGPIC,53,1,0),0,1,BGPPTYPE) D:$D(^BGPINDG(BGPIC,53,2,0)) W^BGP7DP(^BGPINDG(BGPIC,53,2,0),0,1,BGPPTYPE) D AH
  1.  I BGPPTYPE'="P" D W^BGP7DP("",0,2,BGPPTYPE) D AH
  1.  D W^BGP7DP("BASELINE REPORT PERIOD",0,1,BGPPTYPE)
  1.  D W^BGP7DP($S(BGPPTYPE="P":BGPHD2,1:BGPHD1),0,1,BGPPTYPE)
  1.  ;I BGPPTYPE="P" D W^BGP7DP(BGPHD3,0,1,BGPPTYPE)
  1.  S BGPARR="BGPDAB" D I1AGEP1
  1.  Q
  1. I1AGEP1 ;
  1.  S T=30 F X=1:1:2 S V=$P(@BGPARR@(X),U) D W^BGP7DP($S(BGPPTYPE="P":$$C(V,0,6),1:$S(V:V,1:0)),0,0,BGPPTYPE,X+1,T) S T=T+11
  1.  D W^BGP7DP("# w/ Comprehensive Assessment",0,2,BGPPTYPE)
  1.  S T=31 F X=1:1:2 S V=$P(@BGPARR@(X),U,2) D W^BGP7DP($S(BGPPTYPE="P":$$C(V,0,6),1:$S(V:V,1:0)),0,0,BGPPTYPE,X+1,T) S T=T+11
  1.  D W^BGP7DP("% w/ Comprehensive Assessment",0,1,BGPPTYPE)
  1.  S T=30 F X=1:1:2 S V=$P(@BGPARR@(X),U,3) D W^BGP7DP($S(BGPPTYPE="P":$J(V,6,1),1:$$SB($J(V,6,1))),0,0,BGPPTYPE,X+1,T) S T=T+11
  1.  D W^BGP7DP("# w/ BMI Documented",0,2,BGPPTYPE)
  1.  S T=31 F X=1:1:2 S V=$P(@BGPARR@(X),U,4) D W^BGP7DP($S(BGPPTYPE="P":$$C(V,0,6),1:$S(V:V,1:0)),0,0,BGPPTYPE,X+1,T) S T=T+11
  1.  D W^BGP7DP("% w/ BMI Documented",0,1,BGPPTYPE)
  1.  S T=30 F X=1:1:2 S V=$P(@BGPARR@(X),U,5) D W^BGP7DP($S(BGPPTYPE="P":$J(V,6,1),1:$$SB($J(V,6,1))),0,0,BGPPTYPE,X+1,T) S T=T+11
  1.  D W^BGP7DP("% w/ Nutrition Counseling",0,2,BGPPTYPE)
  1.  S T=31 F X=1:1:2 S V=$P(@BGPARR@(X),U,6) D W^BGP7DP($S(BGPPTYPE="P":$$C(V,0,6),1:$S(V:V,1:0)),0,0,BGPPTYPE,X+1,T) S T=T+11
  1.  D W^BGP7DP("% w/ Nutrition Counseling",0,1,BGPPTYPE)
  1.  S T=30 F X=1:1:2 S V=$P(@BGPARR@(X),U,7) D W^BGP7DP($S(BGPPTYPE="P":$J(V,6,1),1:$$SB($J(V,6,1))),0,0,BGPPTYPE,X+1,T) S T=T+11
  1.  I BGPPTYPE="D" D W^BGP7DP("# w/ Physical Activity Counseling",0,2,BGPPTYPE)
  1.  I BGPPTYPE="P" D W^BGP7DP("# w/ Physical Activity",0,2,BGPPTYPE),W^BGP7DP(" Counseling",0,1,BGPPTYPE)
  1.  S T=31 F X=1:1:2 S V=$P(@BGPARR@(X),U,8) D W^BGP7DP($S(BGPPTYPE="P":$$C(V,0,6),1:$S(V:V,1:0)),0,0,BGPPTYPE,X+1,T) S T=T+11
  1.  I BGPPTYPE="D" D W^BGP7DP("% w/ Physical Activity Counseling",0,1,BGPPTYPE)
  1.  I BGPPTYPE="P" D W^BGP7DP("% w/ Physical Activity",0,1,BGPPTYPE),W^BGP7DP(" Counseling",0,1,BGPPTYPE)
  1.  S T=30 F X=1:1:2 S V=$P(@BGPARR@(X),U,9) D W^BGP7DP($S(BGPPTYPE="P":$J(V,6,1),1:$$SB($J(V,6,1))),0,0,BGPPTYPE,X+1,T) S T=T+11
  1.  I BGPARR="BGPDAP"!(BGPARR="BGPDAB") D
  1.  .D W^BGP7DP("CHANGE FROM "_$S(BGPARR="BGPDAP":"PREVIOUS YR %",1:"BASELINE YR %"),0,2,BGPPTYPE)
  1.  .S L="# w/ Comprehensive Assessment",P=3 D PBY
  1.  .S L="# w/ BMI Documented",P=5 D PBY
  1.  .S L="# w/ Nutrition Counseling",P=7 D PBY
  1.  .I BGPPTYPE="P" D W^BGP7DP("# w/ Physical Activity",0,1,BGPPTYPE) S L=" Counseling",P=9 D PBY
  1.  .I BGPPTYPE="D" S L="# w/ Physical Activity Counseling",P=9 D PBY
  1.  .Q
  1.  Q
  1. PBY ;
  1.  D W^BGP7DP(L,0,1,BGPPTYPE)
  1.  S T=30 F X=1:1:2 S N=$P(BGPDAC(X),U,P),O=$P(@BGPARR@(X),U,3) S:N="" N=0 S:O="" O=0 S Y=$S(BGPPTYPE="P":$J($FN((N-O),"+,",1),6),1:$$SB($J((N-O),6,1))) D W^BGP7DP(Y,0,0,BGPPTYPE,X+1,T) S T=T+11
  1.  Q
  1. C(X,X2,X3) ;
  1.  D COMMA^%DTC
  1.  Q X
  1. AH ;EP
  1.  Q:$G(BGPSUMON)
  1.  D W^BGP7DP(BGPHD1,1,2,BGPPTYPE)
  1.  ;D W^BGP7DP("Asthma Assessments",0,1,BGPPTYPE)
  1.  D W^BGP7DP(" 3 - 11",0,1,BGPPTYPE,2,34)
  1.  D W^BGP7DP(" 12 - 17",0,0,BGPPTYPE,3,45)
  1.  ;D W^BGP7DP("18+",0,0,BGPPTYPE,4,56)
  1.  ;D W^BGP7DP("65+",0,0,BGPPTYPE,5,67)
  1.  Q
  1. SB(X) ;EP - Strip
  1.  X ^DD("FUNC",$O(^DD("FUNC","B","STRIPBLANKS",0)),1)
  1.  Q X