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

BGP2D74.m

Go to the documentation of this file.
  1. BGP2D74 ; IHS/CMI/LAB - measure 1,2,3,4 05 Apr 2010 1:44 PM ;
  1. ;;12.1;IHS CLINICAL REPORTING;;MAY 17, 2012;Build 66
  1. ;
  1. IEFR ;EP
  1. S (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9)=0
  1. S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7)=0
  1. I BGPAGEB<65 S BGPSTOP=1 Q
  1. S BGPD2=1 ;user pop
  1. I BGPACTCL S BGPD1=1 ;active clinical
  1. I BGPAGEB>64,BGPAGEB<75,BGPD1 S BGPD3=1
  1. I BGPAGEB>74,BGPAGEB<85,BGPD1 S BGPD4=1
  1. I BGPAGEB>84,BGPD1 S BGPD5=1
  1. S BGPVALUE=""
  1. S BGPFREX=$$FALLEX(DFN,BGPBDATE,BGPEDATE)
  1. I BGPFREX S BGPN2=1,BGPVALUE="Screen: "_$P(BGPFREX,U,3)_" "_$P(BGPFREX,U,2)
  1. S BGPDHF=$$DHF(DFN,BGPBDATE,BGPEDATE)
  1. I BGPDHF S BGPN3=1,BGPVALUE=BGPVALUE_$S(BGPVALUE]"":"; ",1:"")_$P(BGPDHF,U,3)_" "_$P(BGPDHF,U,2)
  1. S BGPFID=$$FID(DFN,BGPBDATE,BGPEDATE)
  1. I BGPFID S BGPN4=1,BGPVALUE=BGPVALUE_$S(BGPVALUE]"":";",1:"")_$P(BGPFID,U,3)_" "_$P(BGPFID,U,2)
  1. S BGPAGM=$$AGM(DFN,BGPBDATE,BGPEDATE)
  1. I BGPAGM S BGPN5=1,BGPVALUE=BGPVALUE_$S(BGPVALUE]"":";",1:"")_$P(BGPAGM,U,3)_" "_$P(BGPAGM,U,2)
  1. S BGPREFEX=$$REFFRE(DFN,BGPBDATE,BGPEDATE)
  1. I BGPREFEX S BGPN6=1,BGPVALUE=BGPVALUE_$S(BGPVALUE]"":";",1:"")_$P(BGPREFEX,U,3)_" "_$P(BGPREFEX,U,2)
  1. S BGPVALUE=$S(BGPRTYPE=5:"",1:"UP")_$S(BGPD1:",AC",1:"")_"|||"_BGPVALUE
  1. I BGPN2!(BGPN3)!(BGPN4)!(BGPN5) S BGPN1=1
  1. K X,Y,Z,%,A,B,C,D,E,H,BDATE,EDATE,P,V,S,F,T,BGPG
  1. Q
  1. IEDA ;EP
  1. S (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9)=0
  1. S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7)=0
  1. K BGPNUMV ;FOR ELDER 20 NUMERATORS
  1. I BGPAGEB<65 S BGPSTOP=1 Q
  1. S BGPD4=1 ;user pop
  1. I BGPACTCL S BGPD1=1 ;active clinical
  1. I BGPRTYPE=5,'BGPD1 S BGPSTOP=1 Q ;elder only wants active clinical
  1. I BGPD1,BGPSEX="M" S BGPD2=1
  1. I BGPD1,BGPSEX="F" S BGPD3=1
  1. I BGPD4,BGPSEX="M" S BGPD5=1
  1. I BGPD4,BGPSEX="F" S BGPD6=1
  1. I BGPAGEB>64,BGPAGEB<75,BGPD1 S BGPD7=1
  1. I BGPAGEB>74,BGPAGEB<85,BGPD1 S BGPD8=1
  1. I BGPAGEB>84,BGPD1 S BGPD9=1
  1. K BGPMEDS,BGPDAE
  1. D GETDAE(DFN,BGPBDATE,BGPEDATE,.BGPDAE,.BGPNUMV)
  1. S X=0,C=0,J="" F S X=$O(BGPDAE(X)) Q:X'=+X S C=C+1,J=J_$S(J]"":"; ",1:"")_$$DATE^BGP2UTL($P(BGPDAE(X),U,3))_" "_$P(BGPDAE(X),U,2)_" ("_$P(BGPDAE(X),U,4)_")"
  1. I C>0 S BGPN1=1
  1. I C>1 S BGPN2=1
  1. F X=1:1:18 I '$D(BGPNUMV(X)) S BGPNUMV(X)=0
  1. S BGPVALUE="UP"
  1. I BGPRTYPE=3!(BGPRTYPE=5) S BGPVALUE=""
  1. S BGPVALUE=BGPVALUE_$S(BGPD1&(BGPVALUE]""):",AC",BGPD1&(BGPVALUE=""):"AC",1:"")_"|||" I C S BGPVALUE=BGPVALUE_C_" drug"_$S(C>1:"s: ",1:":")_J
  1. K BGPMEDS,BGPMEDS1,J,X,C,Y,BGPDAE
  1. K ^TMP($J,"MEDS")
  1. Q
  1. IBFR ;EP
  1. S (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPD9)=0
  1. S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN9)=0
  1. S (BGPV2,BGPV3,BGPV4,BGPV5,BGPV6)=""
  1. S BGPADAY=$$FMDIFF^XLFDT(BGPBDATE,$P(^DPT(DFN,0),U,3))
  1. I BGPADAY<30 S BGPSTOP=1 Q
  1. I BGPADAY>394 S BGPSTOP=1 Q
  1. I 'BGPACTCL S BGPSTOP=1 Q
  1. S BGPD1=1
  1. K BGPBFR
  1. D GETIFC(DFN,BGPBDATE,BGPEDATE,.BGPBFR)
  1. I $D(BGPBFR) S BGPN1=1 ;has a screening
  1. ;n2
  1. D
  1. .S X=44,G="" K Z F S X=$O(BGPBFR(X)) Q:X'=+X!(X>89) S Z($$ABS^XLFMTH(X-60))=X
  1. .Q:'$D(Z)
  1. .S X=$O(Z("")),X=Z(X) ;this is the lowest/closest to 60 days
  1. .S BGPN2=1
  1. .S Y=BGPBFR(X)
  1. .I +Y=1!(+Y=2) S BGPN6=1
  1. .S BGPV2="2 MOS: "_X_" DO, "_$$DATE^BGP2UTL($P(Y,U,2))_" "_$$EXTSET^XBFUNC(9000010.44,.01,+Y)
  1. .S G=1
  1. D
  1. .S X=164,G="" K Z F S X=$O(BGPBFR(X)) Q:X'=+X!(X>209) S Z($$ABS^XLFMTH(X-180))=X
  1. .Q:'$D(Z)
  1. .S X=$O(Z("")),X=Z(X) ;this is the lowest/closest to 180 days
  1. .S BGPN3=1
  1. .S Y=BGPBFR(X)
  1. .I +Y=1!(+Y=2) S BGPN7=1
  1. .S BGPV3="6 MOS: "_X_" DO, "_$$DATE^BGP2UTL($P(Y,U,2))_" "_$$EXTSET^XBFUNC(9000010.44,.01,+Y)
  1. .S G=1
  1. D
  1. .S X=254,G="" K Z F S X=$O(BGPBFR(X)) Q:X'=+X!(X>299) S Z($$ABS^XLFMTH(X-270))=X
  1. .Q:'$D(Z)
  1. .S X=$O(Z("")),X=Z(X) ;this is the lowest/closest to 270 days
  1. .S BGPN4=1
  1. .S Y=BGPBFR(X)
  1. .I +Y=1!(+Y=2) S BGPN8=1
  1. .S BGPV4="9 MOS: "_X_" DO, "_$$DATE^BGP2UTL($P(Y,U,2))_" "_$$EXTSET^XBFUNC(9000010.44,.01,+Y)
  1. .S G=1
  1. D
  1. .S X=349,G="" K Z F S X=$O(BGPBFR(X)) Q:X'=+X!(X>394) S Z($$ABS^XLFMTH(X-365))=X
  1. .Q:'$D(Z)
  1. .S X=$O(Z("")),X=Z(X) ;this is the lowest/closest to 365 days
  1. .S BGPN5=1
  1. .S Y=BGPBFR(X)
  1. .I +Y=1!(+Y=2) S BGPN9=1
  1. .S BGPV5="1 YR: "_X_" DO, "_$$DATE^BGP2UTL($P(Y,U,2))_" "_$$EXTSET^XBFUNC(9000010.44,.01,+Y)
  1. .S G=1
  1. S BGPVALUE=$S(BGPN1=1:"Scrn: ",1:"") ;,BGPVALUE=BGPVALUE_$S(BGPV2]""!(BGPV3]"")!(BGPV4]"")!(BGPV5)]"":": ",1:"")
  1. S C=0
  1. I BGPV2]"" S BGPVALUE=BGPVALUE_$S(C=1:"; ",1:"")_BGPV2,C=1
  1. I BGPV3]"" S BGPVALUE=BGPVALUE_$S(C=1:"; ",1:"")_BGPV3,C=1
  1. I BGPV4]"" S BGPVALUE=BGPVALUE_$S(C=1:"; ",1:"")_BGPV4,C=1
  1. I BGPV5]"" S BGPVALUE=BGPVALUE_$S(C=1:"; ",1:"")_BGPV5,C=1
  1. I BGPN1,BGPV2="",BGPV3="",BGPV4="",BGPV5="" D
  1. .S X=$O(BGPBFR("")) S Y=BGPBFR(X) S BGPVALUE="Scrn: "_X_" DO, "_$$DATE^BGP2UTL($P(Y,U,2))_" "_$$EXTSET^XBFUNC(9000010.44,.01,+Y)
  1. S BGPVALUE="AC|||"_BGPVALUE
  1. K BGPV1,BGPV2,BGPV3,BGPV4,BGPV5,BGPV6,BGPBFR
  1. Q
  1. GETDAE(P,BDATE,EDATE,BGPRET,BGPRET1) ;EP
  1. ;get all meds in all taxonomies
  1. K BGPMEDS,BGPMEDST,BGPRET,BGPRET1
  1. K BGPMEDS1 S BGPXXX="ANTIANXIETY",BGPGOT=0 D GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS ANTIANXIETY MEDS","BGP HEDIS ANTIANXIETY NDC",,,.BGPMEDS1)
  1. D ADDINMED
  1. I BGPGOT S BGPRET1(1)=1
  1. K BGPMEDS1 S BGPXXX="ANTIEMETIC",BGPGOT=0 D GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS ANTIEMETIC MEDS","BGP HEDIS ANTIEMETIC NDC",,,.BGPMEDS1)
  1. D ADDINMED
  1. I BGPGOT S BGPRET1(2)=1
  1. K BGPMEDS1 S BGPXXX="ANALGESIC",BGPGOT=0 D GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS ANALGESIC MEDS","BGP HEDIS ANALGESIC NDC",,,.BGPMEDS1)
  1. D ADDINMED
  1. I BGPGOT S BGPRET1(3)=1
  1. K BGPMEDS1 S BGPXXX="ANTIHISTAMINE",BGPGOT=0 D GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS ANTIHISTAMINE MEDS","BGP HEDIS ANTIHISTAMINE NDC",,,.BGPMEDS1)
  1. D ADDINMED
  1. I BGPGOT S BGPRET1(4)=1
  1. K BGPMEDS1 S BGPXXX="ANTIPSYCHOTIC",BGPGOT=0 D GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS ANTIPSYCHOTIC MEDS","BGP HEDIS ANTIPSYCHOTIC NDC",,,.BGPMEDS1)
  1. D ADDINMED
  1. I BGPGOT S BGPRET1(5)=1
  1. K BGPMEDS1 S BGPXXX="AMPHETAMINE",BGPGOT=0 D GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS AMPHETAMINE MEDS","BGP HEDIS AMPHETAMINE NDC",,,.BGPMEDS1)
  1. D ADDINMED
  1. I BGPGOT S BGPRET1(6)=1
  1. K BGPMEDS1 S BGPXXX="BARBITURATE",BGPGOT=0 D GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS BARBITURATE MEDS","BGP HEDIS BARBITURATE NDC",,,.BGPMEDS1)
  1. D ADDINMED
  1. I BGPGOT S BGPRET1(7)=1
  1. K BGPMEDS1 S BGPXXX="BENZODIAZEPINE",BGPGOT=0 D GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS BENZODIAZEPINE MEDS","BGP HEDIS BENZODIAZEPINE NDC",,,.BGPMEDS1)
  1. D ADDINMED
  1. I BGPGOT S BGPRET1(8)=1
  1. ;K BGPMEDS1 S BGPXXX="OTHER BENZODIAZEPNE",BGPGOT=0 D GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS OTHER BENZODIAZEPINE","BGP HEDIS OTHER BENZO NDC",,,.BGPMEDS1)
  1. ;D ADDINMED
  1. ;I BGPGOT S BGPRET1(9)=1
  1. K BGPMEDS1 S BGPXXX="CALCIUM CHANNEL",BGPGOT=0 D GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS CALCIUM CHANNEL MEDS","BGP HEDIS CALCIUM CHANNEL NDC",,,.BGPMEDS1)
  1. D ADDINMED
  1. I BGPGOT S BGPRET1(10)=1
  1. K BGPMEDS1 S BGPXXX="GASTRO ANTISPASM",BGPGOT=0 D GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS GASTRO ANTISPASM MED","BGP HEDIS GASTRO ANTISPASM NDC",,,.BGPMEDS1)
  1. D ADDINMED
  1. I BGPGOT S BGPRET1(11)=1
  1. K BGPMEDS1 S BGPXXX="BELLADONNA",BGPGOT=0 D GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS BELLADONNA ALKA MEDS","BGP HEDIS BELLADONNA ALKA NDC",,,.BGPMEDS1)
  1. D ADDINMED
  1. I BGPGOT S BGPRET1(12)=1
  1. K BGPMEDS1 S BGPXXX="SKL MUSCLE",BGPGOT=0 D GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS SKL MUSCLE RELAX MED","BGP HEDIS SKL MUSCLE RELAX NDC",,,.BGPMEDS1)
  1. D ADDINMED
  1. I BGPGOT S BGPRET1(13)=1
  1. K BGPMEDS1 S BGPXXX="ORAL ESTROGEN",BGPGOT=0 D GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS ORAL ESTROGEN MEDS","BGP HEDIS ORAL ESTROGEN NDC",,,.BGPMEDS1)
  1. D ADDINMED
  1. I BGPGOT S BGPRET1(14)=1
  1. K BGPMEDS1 S BGPXXX="ORAL HYPOGLYCEMIC",BGPGOT=0 D GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS ORAL HYPOGLYCEMIC RX","BGP HEDIS ORAL HYPOGLYCEMIC ND",,,.BGPMEDS1)
  1. D ADDINMED
  1. I BGPGOT S BGPRET1(15)=1
  1. K BGPMEDS1 S BGPXXX="NARCOTIC",BGPGOT=0 D GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS NARCOTIC MEDS","BGP HEDIS NARCOTIC NDC",,,.BGPMEDS1)
  1. D ADDINMED
  1. I BGPGOT S BGPRET1(16)=1
  1. K BGPMEDS1 S BGPXXX="VASODILATOR",BGPGOT=0 D GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS VASODILATOR MEDS","BGP HEDIS VASODILATOR NDC",,,.BGPMEDS1)
  1. D ADDINMED
  1. I BGPGOT S BGPRET1(17)=1
  1. K BGPMEDS1 S BGPXXX="OTHER MEDS",BGPGOT=0 D GETMEDS^BGP2UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS OTHER MEDS AVOID ELD","BGP HEDIS OTHER NDC AVOID ELD",,,.BGPMEDS1)
  1. D ADDINMED
  1. I BGPGOT S BGPRET1(18)=1
  1. K BGPMEDS1
  1. Q
  1. ADDINMED ;
  1. S X=0 F S X=$O(BGPMEDS1(X)) Q:X'=+X D
  1. .S Y=$P(BGPMEDS1(X),U,4) ;vmed ien
  1. .Q:'$D(^AUPNVMED(Y,0))
  1. .Q:$$UP^XLFSTR($P($G(^AUPNVMED(Y,11)),U))["RETURNED TO STOCK"
  1. .S D=$P(^AUPNVMED(Y,0),U,1) ;drug ien
  1. .;DAYS SUPPLY MUST BE >0
  1. .S E=$P(^AUPNVMED(Y,0),U,8) ;date discontinued
  1. .S S=$P(^AUPNVMED(Y,0),U,7) ;DAYS SUPPLY
  1. .Q:'S
  1. .I E,E'>$P(BGPMEDS1(X),U,1) Q ;at least one day
  1. .S $P(BGPRET(D),U)=$P($G(BGPRET(D)),U)+1
  1. .S $P(BGPRET(D),U,2)=$P(^PSDRUG(D,0),U)
  1. .S $P(BGPRET(D),U,3)=$P(BGPMEDS1(X),U,1) ;LAST FILL
  1. .S $P(BGPRET(D),U,4)=BGPXXX
  1. .S BGPGOT=1
  1. .Q
  1. Q
  1. GETIFC(P,BDATE,EDATE,BGPRET) ;EP
  1. K BGPRET,BGPG,C,X
  1. S X=0 F S X=$O(^AUPNVIF("AC",P,X)) Q:X'=+X D
  1. .Q:'$D(^AUPNVIF(X))
  1. .S V=$P(^AUPNVIF(X,0),U,3),C=$P(^AUPNVIF(X,0),U,1)
  1. .Q:V=""
  1. .Q:'$D(^AUPNVSIT(V,0))
  1. .S V=$P($P(^AUPNVSIT(V,0),U),".")
  1. .;I V<BDATE Q
  1. .;I V>EDATE Q
  1. .S BGPRET($$FMDIFF^XLFDT(V,$P(^DPT(P,0),U,3)))=C_U_V
  1. .Q
  1. Q
  1. FALLEX(P,BDATE,EDATE) ;EP
  1. NEW %,BGPG,E
  1. K BGPG S %=P_"^LAST EXAM 37;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGPG(")
  1. I $D(BGPG(1)) Q 1_"^Ex 37^"_$$DATE^BGP2UTL($P(BGPG(1),U))
  1. S %=$$CPT^BGP2DU(P,BDATE,EDATE,$O(^ATXAX("B","BGP FALL RISK EXAM CPTS",0)),6)
  1. I % Q "1^CPT "_$P(%,U,3)_"^"_$$DATE^BGP2UTL($P(%,U,2))
  1. Q ""
  1. DHF(P,BDATE,EDATE) ;EP
  1. K BGPG
  1. S Y="BGPG("
  1. S X=P_"^LAST DX [BGP HISTORY OF FALL DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
  1. I $D(BGPG(1)) Q 1_U_"POV "_$P(BGPG(1),U,2)_U_"Hx of Fall: "_$$DATE^BGP2UTL($P(BGPG(1),U))
  1. Q ""
  1. FID(P,BDATE,EDATE) ;EP
  1. S Y="BGPG("
  1. K BGPG
  1. S X=P_"^ALL DX;DURING "_BDATE_-EDATE S E=$$START1^APCLDF(X,Y)
  1. S G=""
  1. S T=$O(^ATXAX("B","BGP FALL RELATED E-CODES",0))
  1. S X=0 F S X=$O(BGPG(X)) Q:X'=+X!(G) D
  1. .S Y=+$P(BGPG(X),U,4),D=$P(^AUPNVPOV(Y,0),U)
  1. .I $P(^AUPNVPOV(Y,0),U,9)="",$P(^AUPNVPOV(Y,0),U,18)="",$P(^AUPNVPOV(Y,0),U,19)="" Q
  1. .S E=$P(^AUPNVPOV(Y,0),U,9) I E,$$ICD^ATXCHK(E,T,9) S G=1_U_"E-CODE "_$P($$ICDDX^ICDCODE(E),U,2)_U_"Fall Injury: "_$$DATE^BGP2UTL($P(BGPG(X),U,1)) Q
  1. .S E=$P(^AUPNVPOV(Y,0),U,18) I E,$$ICD^ATXCHK(E,T,9) S G=1_U_"E-CODE "_$P($$ICDDX^ICDCODE(E),U,2)_U_"Fall Injury: "_$$DATE^BGP2UTL($P(BGPG(X),U,1)) Q
  1. .S E=$P(^AUPNVPOV(Y,0),U,19) I E,$$ICD^ATXCHK(E,T,9) S G=1_U_"E-CODE "_$P($$ICDDX^ICDCODE(E),U,2)_U_"Fall Injury: "_$$DATE^BGP2UTL($P(BGPG(X),U,1)) Q
  1. I G Q G
  1. Q ""
  1. AGM(P,BDATE,EDATE) ;EP
  1. S BGPG=$$LASTDX^BGP2UTL1(P,"BGP ABNORMAL GAIT OR MOBILITY",BDATE,EDATE)
  1. I $P(BGPG,U) Q 1_U_"POV "_$P(BGPG,U,2)_U_"Abnormal Gait: "_$$DATE^BGP2UTL($P(BGPG,U,3))
  1. Q ""
  1. REFFRE(P,BDATE,EDATE) ;EP
  1. ;add Refusal for exam 37
  1. S G=$$REFUSAL^BGP2UTL1(P,9999999.15,$O(^AUTTEXAM("C",37,0)),$$FMADD^XLFDT(EDATE,-365),EDATE)
  1. I $P(G,U)=1 Q 1_"^Ex 37^"_"Refused "_$$DATE^BGP2UTL($P(G,U,2))
  1. Q ""