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

BGP3D74.m

Go to the documentation of this file. 
  1. BGP3D74 ; IHS/CMI/LAB - measure 1,2,3,4 05 Apr 2010 1:44 PM ;
  1.  ;;13.0;IHS CLINICAL REPORTING;;NOV 20, 2012;Build 81
  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^BGP3UTL($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^BGP3UTL($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^BGP3UTL($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^BGP3UTL($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^BGP3UTL($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^BGP3UTL($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="ANTICHOLINERGIC",BGPGOT=0 D GETMEDS^BGP3UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS ANTICHOLINERGIC MEDS","BGP HEDIS ANTICHOLINERGIC NDC",,,.BGPMEDS1)
  1.  D ADDINMED
  1.  I BGPGOT S BGPRET1(1)=1
  1.  K BGPMEDS1 S BGPXXX="ANTITHROMBOTIC",BGPGOT=0 D GETMEDS^BGP3UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS ANTITHROMBOTIC MEDS","BGP HEDIS ANTITHROMBOTIC NDC",,,.BGPMEDS1)
  1.  D ADDINMED
  1.  I BGPGOT S BGPRET1(2)=1
  1.  K BGPMEDS1 S BGPXXX="ANTI-INFECTIVE",BGPGOT=0 D GETMEDS^BGP3UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS ANTI-INFECTIVE MEDS","BGP HEDIS ANTI-INFECTIVE NDC",,,.BGPMEDS1)
  1.  D ADDINMED
  1.  I BGPGOT S BGPRET1(3)=1
  1.  K BGPMEDS1 S BGPXXX="CARDIOVASCULAR",BGPGOT=0 D GETMEDS^BGP3UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS CARDIOVASCULAR MEDS","BGP HEDIS CARDIOVASCULAR NDC",,,.BGPMEDS1)
  1.  D ADDINMED
  1.  I BGPGOT S BGPRET1(4)=1
  1.  K BGPMEDS1 S BGPXXX="CENTRAL NERVOUS",BGPGOT=0 D GETMEDS^BGP3UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS CENTRAL NERVOUS MEDS","BGP HEDIS CENTRAL NERVOUS NDC",,,.BGPMEDS1)
  1.  D ADDINMED
  1.  I BGPGOT S BGPRET1(5)=1
  1.  K BGPMEDS1 S BGPXXX="ENDOCRINE",BGPGOT=0 D GETMEDS^BGP3UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS ENDOCRINE MEDS","BGP HEDIS ENDOCRINE NDC",,,.BGPMEDS1)
  1.  D ADDINMED
  1.  I BGPGOT S BGPRET1(6)=1
  1.  K BGPMEDS1 S BGPXXX="GASTROINTESTINAL",BGPGOT=0 D GETMEDS^BGP3UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS GASTROINTESTINAL MED","BGP HEDIS GASTROINTESTINAL NDC",,,.BGPMEDS1)
  1.  D ADDINMED
  1.  I BGPGOT S BGPRET1(7)=1
  1.  K BGPMEDS1 S BGPXXX="PAIN",BGPGOT=0 D GETMEDS^BGP3UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS PAIN MEDS","BGP HEDIS PAIN NDC",,,.BGPMEDS1)
  1.  D ADDINMED
  1.  I BGPGOT S BGPRET1(8)=1
  1.  K BGPMEDS1 S BGPXXX="SKL MUSCLE",BGPGOT=0 D GETMEDS^BGP3UTL2(P,BGPBDATE,BGPEDATE,"BGP HEDIS SKL MUSCLE RELAX MED","BGP HEDIS SKL MUSCLE RELAX NDC",,,.BGPMEDS1)
  1.  D ADDINMED
  1.  I BGPGOT S BGPRET1(9)=1
  1.  K BGPMEDS1
  1.  Q
  1. ADDINMED ;
  1.  I BGPXXX="ANTI-INFECTIVE" D ANTIINF Q
  1.  I BGPXXX="CENTRAL NERVOUS" D CENNERV Q
  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. ANTIINF ;
  1.  ;FOR THIS GROUP DAYS SUPPLY MUST BE AT LEAST 90 DAYS TOTAL
  1.  NEW Z,A,T
  1.  S X=0,T=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 Z=$P(BGPMEDS1(X),U,1)
  1.  .S A=$$FMADD^XLFDT(Z,S)
  1.  .I E,E<A S S=$$FMDIFF^XLFDT(E,Z)
  1.  .S T=T+S
  1.  I T<91 Q
  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)=Z  ;LAST FILL
  1.  S $P(BGPRET(D),U,4)=BGPXXX
  1.  S BGPGOT=1
  1.  Q
  1. CENNERV ;
  1.  ;FOR THIS GROUP DAYS SUPPLY MUST BE AT LEAST 90 DAYS TOTAL
  1.  NEW Z,A,T,T1,T2,X,G,F
  1.  S T1=$O(^ATXAX("B","BGP HEDIS NONBENZODIAZ MEDS",0))
  1.  S T2=$O(^ATXAX("B","BGP HEDIS NONBENZODIAZ NDC",0))
  1.  S X=0,G=0 F  S X=$O(BGPMEDS1(X)) Q:X'=+X  D
  1.  .S Y=$P(BGPMEDS1(X),U,4)
  1.  .S D=$P(^AUPNVMED(Y,0),U,1)
  1.  .I $D(^ATXAX(T1,21,"B",D)) S G=1 Q
  1.  .I $$NDC(D,T2) S G=1 Q
  1.  S X=0,T=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 Z=$P(BGPMEDS1(X),U,1)
  1.  .S A=$$FMADD^XLFDT(Z,S)
  1.  .I E,E<A S S=$$FMDIFF^XLFDT(E,Z)
  1.  .S T=T+S
  1.  I G,T<91 Q
  1.  I T=0 Q
  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)=Z  ;LAST FILL
  1.  S $P(BGPRET(D),U,4)=BGPXXX
  1.  S BGPGOT=1
  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^BGP3UTL($P(BGPG(1),U))
  1.  S %=$$CPT^BGP3DU(P,BDATE,EDATE,$O(^ATXAX("B","BGP FALL RISK EXAM CPTS",0)),6)
  1.  I % Q "1^CPT "_$P(%,U,3)_"^"_$$DATE^BGP3UTL($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^BGP3UTL($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^BGP3UTL($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^BGP3UTL($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^BGP3UTL($P(BGPG(X),U,1)) Q
  1.  I G Q G
  1.  Q ""
  1. AGM(P,BDATE,EDATE) ;EP
  1.  S BGPG=$$LASTDX^BGP3UTL1(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^BGP3UTL($P(BGPG,U,3))
  1.  Q ""
  1. REFFRE(P,BDATE,EDATE) ;EP
  1.  ;add Refusal for exam 37
  1.  S G=$$REFUSAL^BGP3UTL1(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^BGP3UTL($P(G,U,2))
  1.  Q ""
  1. NDC(A,B) ;
  1.  ;a is drug ien
  1.  ;b is taxonomy ien
  1.  S BGPNDC=$P($G(^PSDRUG(A,2)),U,4)
  1.  I BGPNDC]"",B,$D(^ATXAX(B,21,"B",BGPNDC)) Q 1
  1.  Q 0