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

BGP4DP1L.m

Go to the documentation of this file. 
  1. BGP4DP1L ; IHS/CMI/LAB - print ind 1 12 Nov 2010 7:38 AM ;
  1.  ;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114
  1.  ;
  1.  ;HIV SCREENING AGE DIST
  1. I1AGE ;EP  special age tallies
  1.  Q:$G(BGPSUMON)
  1.  S BGPHD1="Active Clinical Pts =>5 w/Persistent Asthma",BGPHD2="Active Clinical Pts =>5 ",BGPHD3=" w/persistent asthma"
  1.  K BGPDAC,BGPDAP,BGPDAB
  1.  S (BGPX,BGPDD)=0 F BGPXX=12:1:22 D I1AGE1
  1.  D I1AGEP
  1.  Q
  1. I1AGE1 ;
  1.  ;
  1.  I BGPXX=12 S BGPP1=2,BGPP2=3
  1.  I BGPXX=13 S BGPP1=4,BGPP2=5
  1.  I BGPXX=14 S BGPP1=6,BGPP2=7
  1.  I BGPXX=15 S BGPP1=8,BGPP2=9
  1.  I BGPXX=16 S BGPP1=10,BGPP2=11
  1.  I BGPXX=17 S BGPP1=12,BGPP2=13
  1.  I BGPXX=18 S BGPP1=14,BGPP2=15
  1.  I BGPXX=19 S BGPP1=16,BGPP2=17
  1.  I BGPXX=20 S BGPP1=18,BGPP2=19
  1.  I BGPXX=21 S BGPP1=20,BGPP2=21
  1.  I BGPXX=22 S BGPP1=22,BGPP2=23
  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.  S BGPZ="D",BGPX=4 D AGES
  1.  Q
  1. AGES ;
  1.  S BGPF="AA.A."_BGPXX_BGPZ S BGPPC=$O(^BGPINDJC("C",BGPF,0))
  1.  D
  1.  .S BGPDF=$P(^BGPINDJC(BGPPC,0),U,8)
  1.  .S BGPNP=$P(^DD(90552.03,BGPDF,0),U,4),N=$P(BGPNP,";"),P=$P(BGPNP,";",2)
  1.  .S $P(BGPDAC(BGPX),U)=$$V^BGP4DP1C(1,BGPRPT,N,P)
  1.  .S $P(BGPDAP(BGPX),U)=$$V^BGP4DP1C(2,BGPRPT,N,P)
  1.  .S $P(BGPDAB(BGPX),U)=$$V^BGP4DP1C(3,BGPRPT,N,P)
  1.  ;S BGPCYD=$$V^BGP4DP1C(1,BGPRPT,N,P,1) I $G(BGPAREAA) D SETEXA^BGP4DP1C(1,N,P)
  1.  ;S BGPPRD=$$V^BGP4DP1C(2,BGPRPT,N,P,1) I $G(BGPAREAA) D SETEXA^BGP4DP1C(2,N,P)
  1.  ;S BGPBLD=$$V^BGP4DP1C(3,BGPRPT,N,P,1) I $G(BGPAREAA) D SETEXA^BGP4DP1C(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(^BGPINDJC(BGPPC,0),U,9)
  1.  S BGPNP=$P(^DD(90552.03,BGPNF,0),U,4),N=$P(BGPNP,";"),P=$P(BGPNP,";",2)
  1.  S $P(BGPDAC(BGPX),U,BGPP1)=$$V^BGP4DP1C(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^BGP4DP1C(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^BGP4DP1C(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^BGP4DP1C(1,BGPRPT,N,P,2)
  1.  ;S BGPPRN=$$V^BGP4DP1C(2,BGPRPT,N,P,2)
  1.  ;S BGPBLN=$$V^BGP4DP1C(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.  Q
  1. I1AGEP ;
  1.  S BGPYSTP=1
  1.  I '$G(BGPSUMON),BGPPTYPE="P" D HEADER^BGP4DPH Q:BGPQUIT  D W^BGP4DP(^BGPINDJ(BGPIC,53,1,0),0,1,BGPPTYPE) D:$D(^BGPINDJ(BGPIC,53,2,0)) W^BGP4DP(^BGPINDJ(BGPIC,53,2,0),0,1,BGPPTYPE) D AH
  1.  I BGPPTYPE'="P" D W^BGP4DP("",0,2,BGPPTYPE) D AH
  1.  D W^BGP4DP("CURRENT REPORT PERIOD",0,1,BGPPTYPE)
  1.  D W^BGP4DP($S(BGPPTYPE="P":BGPHD2,1:BGPHD1),0,1,BGPPTYPE)
  1.  I BGPPTYPE="P" D W^BGP4DP(BGPHD3,0,1,BGPPTYPE)
  1.  S BGPARR="BGPDAC" D I1AGEP1
  1.  I '$G(BGPSUMON),BGPPTYPE="P" D HEADER^BGP4DPH Q:BGPQUIT  D W^BGP4DP(^BGPINDJ(BGPIC,53,1,0),0,1,BGPPTYPE) D:$D(^BGPINDJ(BGPIC,53,2,0)) W^BGP4DP(^BGPINDJ(BGPIC,53,2,0),0,1,BGPPTYPE) D AH
  1.  I BGPPTYPE'="P" D W^BGP4DP("",0,2,BGPPTYPE) D AH
  1.  D W^BGP4DP("PREVIOUS REPORT PERIOD",0,1,BGPPTYPE)
  1.  D W^BGP4DP($S(BGPPTYPE="P":BGPHD2,1:BGPHD1),0,1,BGPPTYPE)
  1.  I BGPPTYPE="P" D W^BGP4DP(BGPHD3,0,1,BGPPTYPE)
  1.  S BGPARR="BGPDAP" D I1AGEP1
  1.  I '$G(BGPSUMON),BGPPTYPE="P" D HEADER^BGP4DPH Q:BGPQUIT  D W^BGP4DP(^BGPINDJ(BGPIC,53,1,0),0,1,BGPPTYPE) D:$D(^BGPINDJ(BGPIC,53,2,0)) W^BGP4DP(^BGPINDJ(BGPIC,53,2,0),0,1,BGPPTYPE) D AH
  1.  I BGPPTYPE'="P" D W^BGP4DP("",0,2,BGPPTYPE) D AH
  1.  D W^BGP4DP("BASELINE REPORT PERIOD",0,1,BGPPTYPE)
  1.  D W^BGP4DP($S(BGPPTYPE="P":BGPHD2,1:BGPHD1),0,1,BGPPTYPE)
  1.  I BGPPTYPE="P" D W^BGP4DP(BGPHD3,0,1,BGPPTYPE)
  1.  S BGPARR="BGPDAB" D I1AGEP1
  1.  Q
  1. I1AGEP1 ;
  1.  S T=30 F X=1:1:4 S V=$P(@BGPARR@(X),U) D W^BGP4DP($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^BGP4DP("# w/management plan",0,2,BGPPTYPE)
  1.  S T=31 F X=1:1:4 S V=$P(@BGPARR@(X),U,2) D W^BGP4DP($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^BGP4DP("% w/managment plan",0,1,BGPPTYPE)
  1.  S T=30 F X=1:1:4 S V=$P(@BGPARR@(X),U,3) D W^BGP4DP($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^BGP4DP("# w/severity documented",0,2,BGPPTYPE)
  1.  S T=31 F X=1:1:4 S V=$P(@BGPARR@(X),U,4) D W^BGP4DP($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^BGP4DP("% w/severity documented",0,1,BGPPTYPE)
  1.  S T=30 F X=1:1:4 S V=$P(@BGPARR@(X),U,5) D W^BGP4DP($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^BGP4DP("% w/control documented",0,2,BGPPTYPE)
  1.  S T=31 F X=1:1:4 S V=$P(@BGPARR@(X),U,6) D W^BGP4DP($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^BGP4DP("% w/control documented",0,1,BGPPTYPE)
  1.  S T=30 F X=1:1:4 S V=$P(@BGPARR@(X),U,7) D W^BGP4DP($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^BGP4DP("# w/# symptom free days",0,2,BGPPTYPE)
  1.  S T=31 F X=1:1:4 S V=$P(@BGPARR@(X),U,8) D W^BGP4DP($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^BGP4DP("% w/# symptom free days",0,1,BGPPTYPE)
  1.  S T=30 F X=1:1:4 S V=$P(@BGPARR@(X),U,9) D W^BGP4DP($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^BGP4DP("# w/# symptom free days 0-5",0,2,BGPPTYPE)
  1.  S T=31 F X=1:1:4 S V=$P(@BGPARR@(X),U,10) D W^BGP4DP($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^BGP4DP("% w/# symptom free days 0-5",0,1,BGPPTYPE)
  1.  S T=30 F X=1:1:4 S V=$P(@BGPARR@(X),U,11) D W^BGP4DP($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^BGP4DP("# w/# symptom free days 6-12",0,2,BGPPTYPE)
  1.  S T=31 F X=1:1:4 S V=$P(@BGPARR@(X),U,12) D W^BGP4DP($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^BGP4DP("% w/# symptom free days 6-12",0,1,BGPPTYPE)
  1.  S T=30 F X=1:1:4 S V=$P(@BGPARR@(X),U,13) D W^BGP4DP($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^BGP4DP("# w/# symptom free days 13-14",0,2,BGPPTYPE)
  1.  S T=31 F X=1:1:4 S V=$P(@BGPARR@(X),U,14) D W^BGP4DP($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^BGP4DP("% w/# symptom free days 13-14",0,1,BGPPTYPE)
  1.  S T=30 F X=1:1:4 S V=$P(@BGPARR@(X),U,15) D W^BGP4DP($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^BGP4DP("# w/# school/work days missed",0,2,BGPPTYPE)
  1.  I BGPPTYPE="P" D W^BGP4DP("# w/# school/work days",0,2,BGPPTYPE),W^BGP4DP(" missed",0,1,BGPPTYPE)
  1.  S T=31 F X=1:1:4 S V=$P(@BGPARR@(X),U,16) D W^BGP4DP($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^BGP4DP("% w/# school/work days missed",0,1,BGPPTYPE)
  1.  I BGPPTYPE="P" D W^BGP4DP("% w/# school/work days",0,1,BGPPTYPE),W^BGP4DP(" missed",0,1,BGPPTYPE)
  1.  S T=30 F X=1:1:4 S V=$P(@BGPARR@(X),U,17) D W^BGP4DP($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^BGP4DP("# w/# school/work days missed 0-2",0,2,BGPPTYPE)
  1.  I BGPPTYPE="P" D W^BGP4DP("# w/# school/work days",0,2,BGPPTYPE),W^BGP4DP(" missed 0-2",0,1,BGPPTYPE)
  1.  S T=31 F X=1:1:4 S V=$P(@BGPARR@(X),U,18) D W^BGP4DP($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^BGP4DP("% w/# school/work days missed 0-2",0,1,BGPPTYPE)
  1.  I BGPPTYPE="P" D W^BGP4DP("% w/# school/work days",0,1,BGPPTYPE),W^BGP4DP(" missed 0-2",0,1,BGPPTYPE)
  1.  S T=30 F X=1:1:4 S V=$P(@BGPARR@(X),U,19) D W^BGP4DP($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^BGP4DP("# w/# school/work days missed 3-7",0,2,BGPPTYPE)
  1.  I BGPPTYPE="P" D W^BGP4DP("# w/# school/work days",0,2,BGPPTYPE),W^BGP4DP(" missed 3-7",0,1,BGPPTYPE)
  1.  S T=31 F X=1:1:4 S V=$P(@BGPARR@(X),U,20) D W^BGP4DP($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^BGP4DP("% w/# school/work days missed 3-7",0,1,BGPPTYPE)
  1.  I BGPPTYPE="P" D W^BGP4DP("% w/# school/work days",0,1,BGPPTYPE),W^BGP4DP(" missed 3-7",0,1,BGPPTYPE)
  1.  S T=30 F X=1:1:4 S V=$P(@BGPARR@(X),U,21) D W^BGP4DP($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^BGP4DP("# w/# school/work days missed 8-14",0,2,BGPPTYPE)
  1.  I BGPPTYPE="P" D W^BGP4DP("# w/# school/work days",0,2,BGPPTYPE),W^BGP4DP(" missed 8-14",0,1,BGPPTYPE)
  1.  S T=31 F X=1:1:4 S V=$P(@BGPARR@(X),U,22) D W^BGP4DP($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^BGP4DP("% w/# school/work days missed 8-14",0,1,BGPPTYPE)
  1.  I BGPPTYPE="P" D W^BGP4DP("% w/# school/work days",0,1,BGPPTYPE),W^BGP4DP(" missed 8-14",0,1,BGPPTYPE)
  1.  S T=30 F X=1:1:4 S V=$P(@BGPARR@(X),U,23) D W^BGP4DP($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^BGP4DP("CHANGE FROM "_$S(BGPARR="BGPDAP":"PREVIOUS YR %",1:"BASELINE YR %"),0,2,BGPPTYPE)
  1.  .S L="# w/mangagement plan",P=3 D PBY
  1.  .S L="# w/severity documented",P=5 D PBY
  1.  .S L="# w/control documented",P=7 D PBY
  1.  .S L="# w/# symptom free days",P=9 D PBY
  1.  .S L="# w/# symptom free days 0-5",P=11 D PBY
  1.  .S L="# w/# symptom free days 6-12",P=13 D PBY
  1.  .S L="# w/# symptom free days 13-14",P=15 D PBY
  1.  .I BGPPTYPE="P" D W^BGP4DP("# w/school/work days",0,1,BGPPTYPE) S L=" missed",P=17 D PBY
  1.  .I BGPPTYPE="D" S L="# w/school/work days missed",P=17 D PBY
  1.  .I BGPPTYPE="P" D W^BGP4DP("# w/school/work days",0,1,BGPPTYPE) S L=" missed 0-2",P=19 D PBY
  1.  .I BGPPTYPE="D" S L="# w/school/work days missed 0-2",P=19 D PBY
  1.  .I BGPPTYPE="P" D W^BGP4DP("# w/school/work days",0,1,BGPPTYPE) S L=" missed 3-7",P=21 D PBY
  1.  .I BGPPTYPE="D" S L="# w/school/work days missed 3-7",P=21 D PBY
  1.  .I BGPPTYPE="P" D W^BGP4DP("# w/school/work days",0,1,BGPPTYPE) S L=" missed 8-14",P=23 D PBY
  1.  .I BGPPTYPE="D" S L="# w/school/work days missed 8-14",P=23 D PBY
  1.  .Q
  1.  Q
  1. PBY ;
  1.  D W^BGP4DP(L,0,1,BGPPTYPE)
  1.  S T=30 F X=1:1:4 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^BGP4DP(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^BGP4DP(BGPHD1,1,2,BGPPTYPE)
  1.  ;D W^BGP4DP("Asthma Assessments",0,1,BGPPTYPE)
  1.  D W^BGP4DP(" 5-14",0,1,BGPPTYPE,2,34)
  1.  D W^BGP4DP("15-34",0,0,BGPPTYPE,3,45)
  1.  D W^BGP4DP("35-64",0,0,BGPPTYPE,4,56)
  1.  D W^BGP4DP("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