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

BDMDD16.m

Go to the documentation of this file. 
  1. BDMDD16 ; IHS/CMI/LAB - 2016 DIABETES AUDIT ; 02 Feb 2014  2:41 PM
  1.  ;;2.0;DIABETES MANAGEMENT SYSTEM;**9**;JUN 14, 2007;Build 78
  1.  ;
  1.  ;
  1. TBCODE(P,EDATE,R) ;EP
  1.  NEW BDMJ,BDMI,X,BDMR
  1.  S BDMJ=""
  1.  S BDMR=$$PPD^BDMDD18(P,EDATE)
  1.  I $E($P(BDMR,"||",2))=1 D  Q BDMJ
  1.  .I $$TBTX^BDMDD12(P)["TX COMPLETE" S BDMJ=1 Q
  1.  .S BDMJ=2
  1.  .Q
  1.  I $E($P(BDMR,"||",2))=2 S BDMJ=4 D  Q BDMJ
  1.  .I $$DODX(P,R,"I")="" S BDMJ=6 Q
  1.  .S D=$$DODX(P,R,"I"),E=$$PPD^BDMDD18(P,EDATE,"I") S BDMJ=$S(D>E:4,1:3)
  1.  .Q
  1.  I $E(BDMR)=4 S BDMJ=5
  1.  I $E(BDMR)=3 S BDMJ=5
  1.  I $E($P(BDMR,"||",2))=3 S BDMJ=5
  1.  I $E($P(BDMR,"||",2))=4 S BDMJ=5
  1.  Q BDMJ
  1.  ;;
  1. 1 ;;PPD +, treatment complete
  1. 2 ;;PPD +, not treated/treatment incomplete or unknown treatment
  1. 3 ;;PPD -, placed on or after date of DM dx
  1. 4 ;;PPD -, placed before date of DM dx
  1. 5 ;;PPD Status unknown
  1. 6 ;;PPD -, date of DX or PPD date unknown
  1. 7 ;;PPD Refused
  1. BI() ;
  1.  Q $S($O(^AUTTIMM(0))>100:1,1:0)
  1. SYSMEAN(P,BDATE,EDATE) ;EP
  1.  NEW X S X=$$BPS^BDMDD13(P,BDATE,EDATE,"I")
  1.  I X="" Q ""
  1.  NEW Y,C,Z S C=0 F Y=1:1:3 I $P(X,";",Y)]"" S C=C+1
  1.  I C<2 Q ""
  1.  S Z=C
  1.  S C=0 F Y=1:1:3 S C=$P($P(X,";",Y),"/")+C
  1.  Q C\Z
  1. DIAMEAN(P,BDATE,EDATE) ;EP
  1.  NEW X S X=$$BPS^BDMDD13(P,BDATE,EDATE,"I")
  1.  I X="" Q ""
  1.  NEW Y,C,Z S C=0 F Y=1:1:3 I $P(X,";",Y)]"" S C=C+1
  1.  I C<2 Q ""
  1.  S Z=C
  1.  S C=0 F Y=1:1:3 S C=$P($P(X,";",Y),"/",2)+C
  1.  Q C\Z
  1. PPDDATE(P,EDATE) ;EP
  1.  NEW X S X=$$LASTNP^BDMDD18(P,EDATE)
  1.  Q X
  1. STATIN(P,BDATE,EDATE) ;EP
  1.  NEW X,BDM,E,BDMALL
  1.  S X=P_"^LAST MEDS [DM AUDIT STATIN DRUGS"_";DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,"BDM(")
  1.  I $D(BDM(1)) S BDMALL($P(BDM(1),U,1))=BDM(1)  ;Q "1  Yes "_$$DATE^BDMS9B1($P(BDM(1),U,1))_" "_$P(BDM(1),U,2)
  1.  NEW BDMSMEDS
  1.  K BDMSMEDS
  1.  D GETMEDS^BDMSMU1(P,BDATE,EDATE,"BGP PQA STATIN MEDS","BGP PQA STATIN NDC",,,.BDMSMEDS)
  1.  S (X,C)=0 F  S X=$O(BDMMEDS(X)) Q:X'=+X  S C=X
  1.  I C S BDMALL($P(BDMMEDS(C),U,1))=BDMMEDS(C) ;Q "1  Yes "_$$DATE^BDMS9B1($P(BDMSMEDS(1),U,1))_" "_$P(BDMSMEDS(1),U,2)
  1.  S (X,C)=0 F  S X=$O(BDMALL(X)) Q:X'=+X  S C=X
  1.  I C Q "1  Yes  "_$$DATE^BDMS9B1($P(BDMALL(C),U,1))_" "_$P(BDMALL(C),U,2)
  1.  ;check allergy/intolerence
  1.  S E=$$STATALG(P,$$DOB^AUPNPAT(P),EDATE,BDATE)
  1.  I E Q "3  "_$P(E,U,2)
  1.  S E=$$STATCON(P,BDATE,EDATE)
  1.  I E Q "3  "_$P(E,U,2)
  1.  Q "2  No"
  1.  ;
  1. STATALG(P,BDATE,EDATE,RPB) ;EP
  1.  NEW BDMG,BDMY,Y,X,N,Z,BDMC
  1.  S BDMC=""
  1.  K BDMG,BDMY S Y="BDMG(",X=P_"^ALL DX [BGP ASA ALLERGY 995.0-995.3;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
  1.  S X=0 F  S X=$O(BDMG(X)) Q:X'=+X  S Y=+$P(BDMG(X),U,4) D
  1.  .S N=$$VAL^XBDIQ1(9000010.07,Y,.04) S N=$$UP^XLFSTR(N)
  1.  .I N["STATIN"!(N["STATINS") S BDMC=1_U_$$DATE^BDMS9B1($P(BDMG(X),U))_" ADR POV "_$P(BDMG(X),U,2)
  1.  .S T="BGP ADV EFF CARDIOVASC NEC"
  1.  .S Z=$P(^AUPNVPOV(Y,0),U,9) I Z]"",$$ICD^BDMUTL(Z,T,9) S BDMC=1_U_$$DATE^BDMS9B1($P(BDMG(X),U))_" ADR POV ["_$P(BDMG(X),U,2)_" + "_$P($$ICDDX^BDMUTL(Z),U,2)_"]  "_N Q
  1.  .S Z=$P(^AUPNVPOV(Y,0),U,18) I Z]"",$$ICD^BDMUTL(Z,T,9) S BDMC=1_U_$$DATE^BDMS9B1($P(BDMG(X),U))_" ADR POV ["_$P(BDMG(X),U,2)_" + "_$P($$ICDDX^BDMUTL(Z),U,2)_"]  "_N Q
  1.  .S Z=$P(^AUPNVPOV(Y,0),U,19) I Z]"",$$ICD^BDMUTL(Z,T,9) S BDMC=1_U_$$DATE^BDMS9B1($P(BDMG(X),U))_" ADR POV ["_$P(BDMG(X),U,2)_" + "_$P($$ICDDX^BDMUTL(Z),U,2)_"]  "_N Q
  1.  .Q
  1.  I BDMC Q BDMC
  1.  K BDMG S BDMC=0 S Y="BDMG(",X=P_"^ALL DX [BGP HX DRUG ALLERGY NEC;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
  1.  S X=0 F  S X=$O(BDMG(X)) Q:X'=+X  S Y=+$P(BDMG(X),U,4) D
  1.  .S N=$$VAL^XBDIQ1(9000010.07,Y,.04),N=$$UP^XLFSTR(N)
  1.  .I N["STATIN"!(N["STATINS") S BDMC=1_U_$$DATE^BDMS9B1($P(BDMG(X),U))_" ADR POV "_$P(BDMG(X),U,2)  ;_"]"
  1.  I BDMC Q BDMC
  1.  ;PL
  1.  S BDMC=0
  1.  S T="",T="BGP ASA ALLERGY 995.0-995.3"
  1.  S X=0 F  S X=$O(^AUPNPROB("AC",P,X)) Q:X'=+X  D
  1.  .S I=$P($G(^AUPNPROB(X,0)),U),Y=$P($$ICDDX^BDMUTL(I),U,2)
  1.  .S N=$$VAL^XBDIQ1(9000011,X,.05),N=$$UP^XLFSTR(N)
  1.  .Q:$P(^AUPNPROB(X,0),U,8)>EDATE
  1.  .Q:$P(^AUPNPROB(X,0),U,12)="D"
  1.  .Q:$P(^AUPNPROB(X,0),U,12)="I"
  1.  .I $$ICD^BDMUTL(I,"BGP HX DRUG ALLERGY NEC",9)!($$ICD^BDMUTL(I,T,9)),N["STATIN"!(N["STATINS") S BDMC=1_U_$$DATE^BDMS9B1($P(^AUPNPROB(X,0),U,8))_" ADR Problem List "_Y  ;_"]"
  1.  .Q
  1.  I BDMC Q BDMC
  1.  ;ART
  1.  S BDMC=0
  1.  S X=0 F  S X=$O(^GMR(120.8,"B",P,X)) Q:X'=+X  D
  1.  .Q:$P($P($G(^GMR(120.8,X,0)),U,4),".")>EDATE
  1.  .S N=$P($G(^GMR(120.8,X,0)),U,2),N=$$UP^XLFSTR(N)
  1.  .I N["STATIN" S BDMC=1_U_$$DATE^BDMS9B1($P(^GMR(120.8,X,0),U,4))_" ADR Allergy Tracking "_N
  1.  I BDMC Q BDMC
  1.  K BDMG S Y="BDMG(",X=P_"^LAST DX [BGP MYOPATHY/MYALGIA;DURING "_$$FMTE^XLFDT(RPB)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
  1.  I $D(BDMG(1)) Q 1_U_$$DATE^BDMS9B1($P(BDMG(1),U))_" ADR POV "_$P(BDMG(1),U,2)  ;_"]"
  1.  S BDMG=""
  1.  S T=$O(^ATXAX("B","BGP CREATINE KINASE LOINC",0))
  1.  S BDMLT=$O(^ATXLAB("B","BGP CREATINE KINASE TAX",0))
  1.  S B=9999999-RPB,E=9999999-EDATE S D=E-1 F  S D=$O(^AUPNVLAB("AE",P,D)) Q:D'=+D!(D>B)!(BDMG)  D
  1.  .S L=0 F  S L=$O(^AUPNVLAB("AE",P,D,L)) Q:L'=+L  D
  1.  ..S X=0 F  S X=$O(^AUPNVLAB("AE",P,D,L,X)) Q:X'=+X  D
  1.  ...Q:'$D(^AUPNVLAB(X,0))
  1.  ...I BDMLT,$P(^AUPNVLAB(X,0),U),$D(^ATXLAB(BDMLT,21,"B",$P(^AUPNVLAB(X,0),U))) I $$RESCK(X) S BDMG=1_U_$$DATE^BDMS9B1((9999999-D))_" ADR creat kinase of "_$P(^AUPNVLAB(X,0),U,4) Q
  1.  ...Q:'T
  1.  ...S J=$P($G(^AUPNVLAB(X,11)),U,13) Q:J=""
  1.  ...Q:'$$LOINC^BDMDD1C(J,T)
  1.  ...I $$RESCK(X) S BDMG=1_U_$$DATE^BDMS9B1((9999999-D))_" ADR creat kinase of "_$P(^AUPNVLAB(X,0),U,4) Q
  1.  ...Q
  1.  I BDMG Q BDMG
  1.  S T=$O(^ATXAX("B","BGP ALT LOINC",0))
  1.  S BDMLT=$O(^ATXLAB("B","DM AUDIT ALT TAX",0))
  1.  S T2=$O(^ATXAX("B","BGP AST LOINC",0))
  1.  S BDMLT2=$O(^ATXLAB("B","DM AUDIT AST TAX",0))
  1.  S B=9999999-$$FMADD^XLFDT(EDATE,-365),E=9999999-EDATE S D=E-1 F  S D=$O(^AUPNVLAB("AE",P,D)) Q:D'=+D!(D>B)!(BDMG)  D
  1.  .S L=0 F  S L=$O(^AUPNVLAB("AE",P,D,L)) Q:L'=+L  D
  1.  ..S X=0 F  S X=$O(^AUPNVLAB("AE",P,D,L,X)) Q:X'=+X  D
  1.  ...Q:'$D(^AUPNVLAB(X,0))
  1.  ...I BDMLT,$P(^AUPNVLAB(X,0),U),$D(^ATXLAB(BDMLT,21,"B",$P(^AUPNVLAB(X,0),U))) S BDMC=BDMC+1,BDMC((9999999-D))=X_U_$P(^AUPNVLAB(X,0),U,4)_U_$P($G(^AUPNVLAB(X,11)),U,5) Q
  1.  ...I BDMLT2,$P(^AUPNVLAB(X,0),U),$D(^ATXLAB(BDMLT2,21,"B",$P(^AUPNVLAB(X,0),U))) S BDMC=BDMC+1,BDMC((9999999-D))=X_U_$P(^AUPNVLAB(X,0),U,4)_U_$P($G(^AUPNVLAB(X,11)),U,5) Q
  1.  ...S J=$P($G(^AUPNVLAB(X,11)),U,13) Q:J=""
  1.  ...I '$$LOINC^BDMDD1C(J,T),'$$LOINC^BDMDD1C(J,T2)
  1.  ...S BDMC=BDMC+1,BDMC((9999999-D))=X_U_$P(^AUPNVLAB(X,0),U,4)_U_$P($G(^AUPNVLAB(X,11)),U,5) Q
  1.  ...Q
  1.  S BDMG=""
  1.  S X=0 F  S X=$O(BDMC(X)) Q:X'=+X!(BDMG)  D
  1.  .Q:'$$RESAL(BDMC(X))
  1.  .S Y=$O(BDMC(X))
  1.  .Q:Y=""
  1.  .I $$RESAL(BDMC(Y)) S BDMG=1_U_" ADR AST/ALT" Q
  1.  .Q
  1.  I BDMG Q BDMG
  1.  Q 0
  1.  ;
  1. RESAL(Y) ;
  1.  NEW V,ULN
  1.  S V=+$P(Y,U,2),ULN=$P(Y,U,3)
  1.  I ULN="" Q ""
  1.  I V>(ULN*3) Q 1
  1.  Q ""
  1. RESCK(Y) ;
  1.  NEW V,ULN
  1.  S V=+$P(^AUPNVLAB(X,0),U,4)
  1.  I V>10000 Q 1
  1.  S ULN=$P($G(^AUPNVLAB(X,11)),U,5)
  1.  I ULN="" Q 0  ;no upper limit
  1.  I V>(ULN*10) Q 1
  1.  Q 0
  1. STATCON(P,BDATE,EDATE) ;EP does patient have an STATIN Contra
  1.  NEW ED,BD,BDMG,BDMC,X,Y,Z,N,E
  1.  ;
  1.  ;pregnant
  1.  S X=$$PREG^BDMDD1B(P,BDATE,EDATE,1,1) I X Q 1_U_"Contraindication pregnant"
  1.  ;nmi
  1.  S BDMG=""
  1.  S T=$O(^ATXAX("B","BGP PQA STATIN MEDS",0))
  1.  S X=0 F  S X=$O(^AUPNPREF("AA",P,50,X)) Q:X'=+X  D
  1.  .Q:'$D(^ATXAX(T,21,"B",X))  ;not an STATI
  1.  .S D=0 F  S D=$O(^AUPNPREF("AA",P,50,X,D)) Q:D'=+D  D
  1.  ..S Y=9999999-D I Y<BDATE Q
  1.  ..I Y>EDATE Q
  1.  ..S N=0 F  S N=$O(^AUPNPREF("AA",P,50,X,D,N)) Q:N'=+N  D
  1.  ...Q:$P($G(^AUPNPREF(N,0)),U,7)'="N"
  1.  ...S BDMG=1_U_$$DATE^BDMS9B1($P(^AUPNPREF(N,0),U,3))_" Contraindication NMI "_$$VAL^XBDIQ1(9000022,N,.04)  ;_"   "_"  "_$$VAL^XBDIQ1(9000022,X,1101)
  1.  ..Q
  1.  .Q
  1.  I BDMG Q BDMG
  1.  ;breastfeeding
  1.  K BDMG S Y="BDMG(",X=P_"^LAST DX [BGP BREASTFEEDING DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
  1.  I $D(BDMG(1)) Q 1_U_$$DATE^BDMS9B1($P(BDMG(1),U))_" Contraindication Breastfeeding "_$P(BDMG(1),U,2)  ;_"]"  ;_$$VAL^XBDIQ1(9000010.07,+$P(BDMG(1),U,4),.04)
  1.  ;now check education
  1.  K BDMG
  1.  S Y="BDMG("
  1.  S X=P_"^ALL EDUC;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
  1.  S (X,D)=0,%="",T="" F  S X=$O(BDMG(X)) Q:X'=+X!(%]"")  D
  1.  .S T=$P(^AUPNVPED(+$P(BDMG(X),U,4),0),U)
  1.  .Q:'T
  1.  .Q:'$D(^AUTTEDT(T,0))
  1.  .S T=$P(^AUTTEDT(T,0),U,2)
  1.  .I T="BF-BC" S %=T_U_$P(BDMG(X),U) Q
  1.  .I T="BF-BP" S %=T_U_$P(BDMG(X),U) Q
  1.  .I T="BF-CS" S %=T_U_$P(BDMG(X),U) Q
  1.  .I T="BF-EQ" S %=T_U_$P(BDMG(X),U) Q
  1.  .I T="BF-FU" S %=T_U_$P(BDMG(X),U) Q
  1.  .I T="BF-HC" S %=T_U_$P(BDMG(X),U) Q
  1.  .I T="BF-ON" S %=T_U_$P(BDMG(X),U) Q
  1.  .I T="BF-M" S %=T_U_$P(BDMG(X),U) Q
  1.  .I T="BF-MK" S %=T_U_$P(BDMG(X),U) Q
  1.  .I T="BF-N" S %=T_U_$P(BDMG(X),U) Q
  1.  .I $P(T,"-",1)]"",$$SNOMED^BDMUTL(2016,"BREASTFEEDING PATIENT ED",$P(T,"-",1)) S %=T_U_$P(BDMG(X),U) Q
  1.  I %]"" Q 1_U_$$DATE^BDMS9B1($P(%,U,2))_" Contraindication Breastfeeding " ;_$P(%,U,1)
  1.  ;NOW CHECK ALCOHOL HEPATITIS
  1.  K BDMG S Y="BDMG(",X=P_"^LAST DX [BGP ALCOHOL HEPATITIS DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
  1.  I $D(BDMG(1)) Q 1_U_$$DATE^BDMS9B1($P(BDMG(1),U))_" Contraindication Alcohol Hepatitis " ;_$P(BDMG(1),U,2) ;_"]"  ;_$$VAL^XBDIQ1(9000010.07,+$P(BDMG(1),U,4),.04)
  1.  Q ""
  1. ACE(P,BDATE,EDATE) ;EP
  1.  NEW X,BDM,E,X,Y,%DT,BD,G
  1.  S X=P_"^LAST MEDS [DM AUDIT ACE INHIBITORS"_";DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,"BDM(")
  1.  I $D(BDM(1)) Q "1  Yes  "_$$DATE^BDMS9B1($P(BDM(1),U))_" "_$P(BDM(1),U,3)
  1.  NEW D,%DT K %DT S X=BDATE,%DT="P" D ^%DT S D=Y
  1.  NEW V,I,%
  1.  K %DT S X=EDATE,%DT="P" D ^%DT S E=Y
  1.  S %=""
  1.  S I=9999999-E,I=I-1 F  S I=$O(^AUPNVMED("AA",P,I)) Q:I'=+I!(%)!(I>(9999999-D))  D
  1.  .S V=0 F  S V=$O(^AUPNVMED("AA",P,I,V)) Q:V'=+V  S G=$P(^AUPNVMED(V,0),U) I $P($G(^PSDRUG(G,0)),U,2)="CV800"!($P($G(^PSDRUG(G,0)),U,2)="CV805") S %=$P($P(^AUPNVSIT($P(^AUPNVMED(V,0),U,3),0),U),".")_U_G
  1.  I %]"" Q "1  Yes  "_$$DATE^BDMS9B1($P(%,U,1))_" "_$P(^PSDRUG($P(%,U,2),0),U)
  1.  ;refusals
  1.  NEW T S T=$O(^ATXAX("B","DM AUDIT ACE INHIBITORS",0))
  1.  I 'T Q "2  No"
  1.  S (G,X)=0 F  S X=$O(^ATXAX(T,21,X)) Q:X'=+X!(G)  S G=$$REFUSAL^BDMDD17(P,50,$P(^ATXAX(T,21,X,0),U),BDATE,EDATE)
  1.  I G,$P(G,U,2)'="N" S G=""
  1.  Q "2  No"_$S(G:" - Not Medically Indicated",1:"")
  1.  ;
  1.  ;
  1. ASPIRIN(P,BDATE,EDATE) ;EP
  1.  NEW X,BDM,E,A,N,G,T,T1,O,B,%
  1.  S (A,B,G,N,D)=""
  1.  S X=P_"^LAST MEDS [DM AUDIT ASPIRIN DRUGS"_";DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,"BDM(")
  1.  I $D(BDM(1)) S A=1 S D=$$DATE^BDMS9B1($P(BDM(1),U))_" "_$P(BDM(1),U,3)
  1.  K BDM S X=P_"^LAST MEDS [DM AUDIT ANTIPLT/ANTICOAG RX"_";DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,"BDM(")
  1.  I $D(BDM(1)) S N=1 S D=$$DATE^BDMS9B1($P(BDM(1),U))_" "_$P(BDM(1),U,3)
  1.  K BDM S X=P_"^LAST MEDS [DM AUDIT ANTI-PLATELET DRUGS"_";DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,"BDM(")
  1.  I $D(BDM(1)) S N=1 S D=$$DATE^BDMS9B1($P(BDM(1),U))_" "_$P(BDM(1),U,3)
  1.  I A Q "1  Yes  "_D
  1.  I N Q "1  Yes  "_D
  1.  S T=$O(^ATXAX("B","DM AUDIT ASPIRIN DRUGS",0))
  1.  S T1=$O(^ATXAX("B","DM AUDIT ANTIPLT/ANTICOAG RX",0))
  1.  S X=0,%="" F  S X=$O(^PS(55,P,"NVA",X)) Q:X'=+X!(%]"")  D
  1.  .I $P($G(^PS(55,P,"NVA",X,999999911)),U,1),$D(^AUPNVMED($P(^PS(55,P,"NVA",X,999999911),U,1),0)) Q  ;got this with V MED
  1.  .S L=$P($P($G(^PS(55,P,"NVA",X,0)),U,10),".")
  1.  .Q:$P(^PS(55,P,"NVA",X,0),U,6)=1  ;discontinued
  1.  .I $P(^PS(55,P,"NVA",X,0),U,7)]"",$P(^PS(55,P,"NVA",X,0),U,7)<EDATE Q  ;discontinued date
  1.  .Q:$P(^PS(55,P,"NVA",X,0),U,9)>EDATE  ;
  1.  .S D=$P(^PS(55,P,"NVA",X,0),U,2)
  1.  .I D S G=0 D
  1.  ..I $D(^ATXAX(T,21,"B",D)) S G=1
  1.  ..I $D(^ATXAX(T1,21,"B",D)) S G=1
  1.  .I D,G S %="1  Yes - NVA MED - "_$P(^PSDRUG(D,0),U,1) Q
  1.  .S O=$P(^PS(55,P,"NVA",X,0),U,1)
  1.  .Q:O=""
  1.  .S O=$P($G(^PS(50.7,O,0)),U,1)
  1.  .Q:O=""
  1.  .I $E(O,1,7)="ASPIRIN",$E(O,8)'="/" S %="1  Yes - NVA MED - "_O Q
  1.  I %]"" Q %
  1.  Q "2  None"
  1.  ;
  1.  ;
  1. THERAPY(P,BD,EDATE) ;EP - therapy code for epi
  1.  I '$G(P) Q ""
  1.  NEW STR,TNAME,X,Y,%DT,HO,TOTAL
  1.  S STR="",TNAME="",HO="",TOTAL=0
  1.  S X=$$INSULIN^BDMDD12(P,BD,EDATE)
  1.  I X]"" S TOTAL=TOTAL+1,STR=STR_2_U,HO=1
  1.  S X=$$SULF^BDMDD12(P,BD,EDATE)
  1.  I X]"" S TOTAL=TOTAL+1,STR=STR_3_U,HO=1
  1.  S X=$$SULFLIKE^BDMDD12(P,BD,EDATE)
  1.  I X]"" S TOTAL=TOTAL+1,STR=STR_4_U,HO=1
  1.  S X=$$MET^BDMDD12(P,BD,EDATE)
  1.  I X]"" S TOTAL=TOTAL+1,STR=STR_5_U,HO=1
  1.  S X=$$ACAR^BDMDD12(P,BD,EDATE)
  1.  I X]"" S TOTAL=TOTAL+1,STR=STR_6_U,HO=1
  1.  S X=$$TROG^BDMDD12(P,BD,EDATE)
  1.  I X]"" S TOTAL=TOTAL+1,STR=STR_7_U,HO=1
  1.  S X=$$GLP1^BDMDD12(P,BD,EDATE)
  1.  I X]"" S TOTAL=TOTAL+1,STR=STR_8_U,HO=1
  1.  S X=$$DPP4^BDMDD12(P,BD,EDATE)
  1.  I X]"" S TOTAL=TOTAL+1,STR=STR_9_U,HO=1
  1.  S X=$$AMYLIN^BDMDD12(P,BD,EDATE)
  1.  I X]"" S TOTAL=TOTAL+1,STR=STR_10_U,HO=1
  1.  S X=$$BROM^BDMDD12(P,BD,EDATE)
  1.  I X]"" S TOTAL=TOTAL+1,STR=STR_11_U,HO=1
  1.  S X=$$COLE^BDMDD12(P,BD,EDATE)
  1.  I X]"" S TOTAL=TOTAL+1,STR=STR_12_U,HO=1
  1.  S X=$$SGLT2^BDMDD12(P,BD,EDATE)
  1.  I X]"" S TOTAL=TOTAL+1,STR=STR_13_U,HO=1
  1.  I HO Q STR_"|||"_TOTAL
  1.  Q 1
  1.  ;
  1. DIETONLY(P,BD,EDATE) ;EP - diet and exercise for audit export
  1.  NEW STR,TNAME,X,Y,%DT
  1.  S STR="",TNAME=""
  1.  S X=$$INSULIN^BDMDD12(P,BD,EDATE)
  1.  I X]"" Q 2
  1.  S X=$$SULF^BDMDD12(P,BD,EDATE)
  1.  I X]"" Q 2
  1.  S X=$$SULFLIKE^BDMDD12(P,BD,EDATE)
  1.  I X]"" Q 2
  1.  S X=$$MET^BDMDD12(P,BD,EDATE)
  1.  I X]"" Q 2
  1.  S X=$$ACAR^BDMDD12(P,BD,EDATE)
  1.  I X]"" Q 2
  1.  S X=$$TROG^BDMDD12(P,BD,EDATE)
  1.  I X]"" Q 2
  1.  ;S X=$$INCR^BDMDD12(P,BD,EDATE)
  1.  ;I X]"" Q 2
  1.  S X=$$DPP4^BDMDD12(P,BD,EDATE)
  1.  I X]"" Q 2
  1.  S X=$$AMYLIN^BDMDD12(P,BD,EDATE)
  1.  I X]"" Q 2
  1.  S X=$$GLP1^BDMDD12(P,BD,EDATE)
  1.  I X]"" Q 2
  1.  S X=$$BROM^BDMDD12(P,BD,EDATE)
  1.  I X]"" Q 2
  1.  S X=$$COLE^BDMDD12(P,BD,EDATE)
  1.  I X]"" Q 2
  1.  S X=$$SGLT2^BDMDD12(P,BD,EDATE)
  1.  I X]"" Q 2
  1.  Q 1
  1.  ;
  1.  ;
  1.  ;
  1. TYPE(P,R,EDATE) ;EP return type 1 or 2 for epi file
  1.  I '$G(P) Q ""
  1.  NEW TYPE S TYPE=""
  1.  I $G(R) S TYPE=$$CMSFDX^BDMDD13(P,R,"DX")
  1.  I TYPE="NIDDM" Q 2
  1.  I TYPE["TYPE II" Q 2
  1.  I TYPE="IDDM" Q 1
  1.  I TYPE="TYPE I" Q 1
  1.  I TYPE["2" Q 2
  1.  I TYPE["1" Q 1
  1.  S TYPE="" NEW X,I,C S X=$$PLDMDXS^BDMDD13(P)
  1.  F I=1:1 S C=$P(X,";",I) Q:C=""!(TYPE]"")  S J=$P($$CODEN^BDMUTL(C,80),"~") I J>0,$$ICD^BDMUTL(J,"DM AUDIT TYPE II DXS",9) S TYPE=2
  1.  I TYPE]"" Q TYPE
  1.  F I=1:1 S C=$P(X,";",I) Q:C=""!(TYPE]"")  S J=$P($$CODEN^BDMUTL(C,80),"~") I J>0,$$ICD^BDMUTL(J,"DM AUDIT TYPE I DXS",9) S TYPE=1
  1.  I TYPE]"" Q TYPE
  1.  S X=$$LASTDMDX^BDMDD13(P,EDATE)
  1.  I X[2 Q 2
  1.  I X[1 Q 1
  1.  Q ""
  1.  ;
  1. DURDM(P,R,EDATE) ;EP
  1.  I '$G(P) Q ""
  1.  NEW Y S Y=$$DODX(P,R,"I")
  1.  I Y="" Q ""
  1.  I 'Y Q ""
  1.  I Y>EDATE Q ""
  1.  Q $P(($$FMDIFF^XLFDT(EDATE,Y,1)\365.25),".")
  1.  ;
  1. DODX(P,R,F) ;EP - date of dx for export file
  1.  I $G(F)="" S F="E"
  1.  NEW DATE,EARLY
  1.  S DATE="",EARLY=9999999
  1.  I $G(R) S DATE=$$CMSFDX^BDMDD13(P,R,"ID")
  1.  I DATE S EARLY=DATE
  1.  S DATE=$$PLDMDOO^BDMDD13(P,"I")
  1.  I DATE,DATE<EARLY S EARLY=DATE
  1.  I EARLY=9999999 S EARLY=""
  1.  Q $S(F="I":$$DI(EARLY),1:$$D(EARLY))
  1.  ;
  1. D(D) ;
  1.  I D="" Q ""
  1.  Q $S($E(D,4,5)="00":"07",1:$E(D,4,5))_"/"_$S($E(D,6,7)="00":"01",1:$E(D,6,7))_"/"_(1700+$E(D,1,3))
  1.  ;
  1. DI(D) ;EP
  1.  I D="" Q ""
  1.  Q $E(D,1,3)_$S($E(D,4,5)="00":"07",1:$E(D,4,5))_$S($E(D,6,7)="00":"01",1:$E(D,6,7))