BDMS9D1 ; IHS/CMI/LAB - DIABETIC CARE SUMMARY SUPPLEMENT ; 01 Feb 2011 8:49 AM
;;2.0;DIABETES MANAGEMENT SYSTEM;**3,4,8,9**;JUN 14, 2007;Build 78
;
;
EP ;EP - called from component
Q:'$G(BDMSPAT)
I $$PLTAX^BDMSMU(BDMSPAT,"SURVEILLANCE DIABETES") Q ;has diabetes
S X=$$LASTITEM^BDMSMU(BDMSPAT,"[SURVEILLANCE DIABETES","DX")
I X>$$FMADD^XLFDT(DT,-366) Q ;if date of last dm dx is w/in past year then quit
I $E(IOST)="C",IO=IO(0) W !! S DIR("A")="PRE-DIABETES CARE SUMMARY WILL NOW BE DISPLAYED (^ TO EXIT, RETURN TO CONTINUE)",DIR(0)="E" D ^DIR I $D(DIRUT) S BDMSQIT=1 Q
D EP2(BDMSPAT)
W ;write out array
W:$D(IOF) @IOF
K BDMQUIT
S BDMX=0 F S BDMX=$O(^TMP("APCHS",$J,"DCS",BDMX)) Q:BDMX'=+BDMX!($D(BDMQUIT)) D
.I $Y>(IOSL-3) D HEADER Q:$D(BDMQUIT)
.W !,^TMP("APCHS",$J,"DCS",BDMX)
.Q
I $D(BDMQUIT) S BDMSQIT=1
D EOJ
Q
;
EOJ ;
K BDMX,BDMQUIT,BDMY,BDMSDFN,BDMSBEG,BDMSTOB,BDMSUPI,BDMSED,BDMTOBN,BDMTOB,BDMSTEX
K N,%,T,F,X,Y,B,C,E,F,H,L,N,P,T,W
Q
K DIR I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BDMQUIT="" Q
HEAD1 ;
W:$D(IOF) @IOF
W !,BDMSHDR,!
W !,"PreDiabetes Patient Care Summary - continued"
W !,"Patient: ",$P(^DPT(BDMSPAT,0),U)," HRN: ",$$HRN^AUPNPAT(BDMSPAT,DUZ(2)),!
Q
EP2(BDMSDFN) ;PEP - PASS DFN get back array of patient care summary
;at this point you are stuck with ^TMP("APCHS",$J,"DCS"
K ^TMP("APCHS",$J,"DCS")
S ^TMP("APCHS",$J,"DCS",0)=0
;I '$D(BDMSCVD) S BDMSCVD="S:Y]"""" Y=+Y,Y=$E(Y,4,5)_""/""_$S($E(Y,6,7):$E(Y,6,7)_""/"",1:"""")_$E(Y,2,3)"
D EN^XBNEW("EP21^BDMS9D1","BDMSDFN")
Q
EP21 ;
S BDMSPAT=BDMSDFN
D SETARRAY
K ^XTMP("BDMTAX",BDMJOB,BDMBTH)
Q
SETARRAY ;set up array containing dm care summary
;CHECK TO SEE IF START1^APCLDF EXISTS
S BDMJOB=$J,BDMBTH=$H
;D UNFOLDTX^BDMUTL(2016)
I '$D(BDMSCVD) S BDMSCVD="S:Y]"""" Y=+Y,Y=$E(Y,4,5)_""/""_$S($E(Y,6,7):$E(Y,6,7)_""/"",1:"""")_$E(Y,2,3)"
S X="APCLDF" X ^%ZOSF("TEST") I '$T Q
S X="PREDIABETES PATIENT CARE SUMMARY Report Date: "_$$FMTE^XLFDT(DT) D S(X)
S X="Patient Name: "_$P(^DPT(BDMSDFN,0),U)_" HRN: "_$$HRN^AUPNPAT(BDMSDFN,DUZ(2)) D S(X)
S X="Age: "_$$AGE^AUPNPAT(BDMSDFN),$E(X,15)="Sex: "_$$SEX^AUPNPAT(BDMSDFN)_" DOB: "_$$FMTE^XLFDT($$DOB^AUPNPAT(BDMSDFN)) D S(X)
S X="Classification:" D S(X,1)
S Y=$$IFG(BDMSDFN) S X="",$E(X,2)=$S($P(Y,U)=1:"Yes",1:"No"),$E(X,8)="Impaired Fasting Glucose" I $P(Y,U)=1 S X=X_": "_$P(Y,U,3)_": "_$$FMTE^XLFDT($P(Y,U,2))
D S(X)
S Y=$$IGT(BDMSDFN) S X="",$E(X,2)=$S($P(Y,U)=1:"Yes",1:"No"),$E(X,8)="Impaired Glucose Tolerance" I $P(Y,U)=1 S X=X_": "_$P(Y,U,3)_": "_$$FMTE^XLFDT($P(Y,U,2))
D S(X)
S Y=$$MS(BDMSDFN) S X="",$E(X,2)=$S($P(Y,U)=1:"Yes",1:"No"),$E(X,8)="Metabolic Syndrome" I $P(Y,U)=1 S X=X_": "_$P(Y,U,3)_": "_$$FMTE^XLFDT($P(Y,U,2))
D S(X)
S X=" " D S(X)
S X="Case Manager: "_$$CMSMAN(BDMSDFN) D S(X) ;HOW TO FIND CASE MANAGER - LORI
S X="Primary Care Provider: "_$$VAL^XBDIQ1(9000001,BDMSDFN,.14) D S(X)
S X=" " D S(X)
D GETHWB(BDMSDFN,DT)
S X=" Last Height: "_BDMX(1,"HT")_$S(BDMX(1,"HT")]"":" inches",1:""),$E(X,33)=BDMX(1,"HTD") D S(X)
S X="Last 3 Weight: "_$S(BDMX(1,"WT")]"":$J(BDMX(1,"WT"),3,0),1:"")_$S(BDMX(1,"WT")]"":" lbs",1:""),$E(X,33)=BDMX(1,"WTD"),$E(X,47)="BMI: "_BDMX(1,"BMI") D S(X)
S X="",$E(X,17)=$S(BDMX(2,"WT")]"":$J(BDMX(2,"WT"),3,0),1:"")_$S(BDMX(2,"WT")]"":" lbs",1:""),$E(X,33)=BDMX(2,"WTD"),$E(X,47)="BMI: "_BDMX(2,"BMI") D S(X)
S X="",$E(X,17)=$S(BDMX(3,"WT")]"":$J(BDMX(3,"WT"),3,0),1:"")_$S(BDMX(3,"WT")]"":" lbs",1:""),$E(X,33)=BDMX(3,"WTD"),$E(X,47)="BMI: "_BDMX(3,"BMI") D S(X)
I BDMX(1,"WC")]"" S X="Last Waist Circumference: "_BDMX(1,"WC"),$E(X,33)=BDMX(1,"WCD") D S(X,1)
S B=$$BP(BDMSDFN)
S X="Last 3 non-ER BP: "_$P($G(BDMX(1)),U,2)_" "_$$FMTE^XLFDT($P($G(BDMX(1)),U))
D S(X,1)
S X="" I $D(BDMX(2)) S X="",$E(X,20)=$P(BDMX(2),U,2)_" "_$$FMTE^XLFDT($P(BDMX(2),U))
D S(X)
S X="" I $D(BDMX(3)) S X="",$E(X,20)=$P(BDMX(3),U,2)_" "_$$FMTE^XLFDT($P(BDMX(3),U))
D S(X)
D TOBACCO^BDMS9B3
S X="Tobacco Use: "_$G(BDMTOB) D S(X,1)
S X="Prediabetes Education Provided (in past yr):" D S(X,1)
S X=" Last Dietitian Visit: "_$$DIETV^BDMS9B3(BDMSDFN) D S(X)
S BDMSBEG=$$FMADD^XLFDT(DT,-366)
K BDMX D EDUC^BDMS9B2 I $D(BDMX) D
.S %=0 F S %=$O(BDMX(%)) Q:%'=+% S X=" "_BDMX(%) D S(X)
K BDMX,BDMY,%
D EDUCREF^BDMS9B2 I $D(BDMX) S X="In the past year, the patient has refused the following Diabetes education:" D S(X,1) D
.S %="" F S %=$O(BDMX(%)) Q:%="" S X=" "_%_" "_BDMX(%) D S(X)
K BDMX,BDMY,%
S X="HTN Diagnosed: "_$$HTN(BDMSDFN) D S(X,1)
S BDMSBEG=$$FMADD^XLFDT(DT,-(6*30.5))
S %=$$ACE^BDMS9B4(BDMSDFN,BDMSBEG) ;get date of last ACE in last year
S X="",X="ON ACE Inhibitor/ARB in past 6 months: "_% D S(X)
K BDMSX S BDMSBEG=$$FMADD^XLFDT(DT,-365) S X="Aspirin Use (in past yr): "_$E($$ASPIRIN(BDMSDFN,BDMSBEG),1,32) D S(X)
S X="",X=$$ASPREF^BDMS9B4(BDMSDFN) I X]"" S X=" "_X D S(X)
M12 ;
D MORE^BDMS9D2
S X=$P(^DPT(BDMSDFN,0),U),$E(X,35)="DOB: "_$$DOB^AUPNPAT(BDMSDFN,"S"),$E(X,55)="Chart #"_$$HRN^AUPNPAT(BDMSDFN,DUZ(2),2) D S(X,1)
Q
S(Y,F,C,T) ;set up array
I '$G(F) S F=0
I '$G(T) S T=0
NEW %,X
F F=1:1:F S X="" D S1
S X=Y
I $G(C) S L=$L(Y),T=(80-L)/2 D D S1 Q
.F %=1:1:(T-1) S X=" "_X
F %=1:1:T S X=" "_Y
D S1
Q
S1 ;
S %=$P(^TMP("APCHS",$J,"DCS",0),U)+1,$P(^TMP("APCHS",$J,"DCS",0),U)=%
S ^TMP("APCHS",$J,"DCS",%)=X
Q
CMSMAN(P,F) ;EP - return date/dx of dm in register
I $G(F)="" S F="E"
I '$G(P) Q ""
NEW R,N,D,D1,Y,X,G S R=0,N="",D="" F S N=$O(^ACM(41.1,"B",N)) Q:N=""!(D]"") S R=0 F S R=$O(^ACM(41.1,"B",N,R)) Q:R'=+R!(D]"") I N["DIAB" D
.S (G,X)=0,(D,Y)="" F S X=$O(^ACM(41,"C",P,X)) Q:X'=+X!(D]"") I $P(^ACM(41,X,0),U,4)=R D
..S D=$P($G(^ACM(41,X,"DT")),U,6) I D]"" S D=$P(^VA(200,D,0),U)
Q $G(D)
;
MS(P) ;
NEW X,Y,I,BDMY,%
S X=$$PLTAX^BDMSMU(P,"DM AUDIT METABOLIC SYNDROME",,2) I X D Q Y
.S D=$P(^AUPNPROB(X,0),U,13) I D]"" S Y=1_U_D_U_"Date of Onset from Problem List" Q
.S D=$P(^AUPNPROB(X,0),U,8) I D]"" S Y=1_U_D_U_"Date Added to Problem List" Q
.S Y=1_U_D_U_"Problem List" Q
K BDMY S %=P_"^FIRST DX [DM AUDIT METABOLIC SYNDROME",E=$$START1^APCLDF(%,"BDMY(")
I $D(BDMY(1)) Q 1_U_$P(BDMY(1),U)_U_"Date of first DX in PCC"
Q ""
IGT(P) ;
NEW X,Y,I,BDMY,%
S X=$$PLTAX^BDMSMU(P,"DM AUDIT IGT DXS",,2) I X D Q Y
.S D=$P(^AUPNPROB(X,0),U,13) I D]"" S Y=1_U_D_U_"Date of Onset from Problem List" Q
.S D=$P(^AUPNPROB(X,0),U,8) I D]"" S Y=1_U_D_U_"Date Added to Problem List" Q
.S Y=1_U_D_U_"Problem List" Q
K BDMY S %=P_"^FIRST DX [DM AUDIT IGT DXS",E=$$START1^APCLDF(%,"BDMY(")
I $D(BDMY(1)) Q 1_U_$P(BDMY(1),U)_U_"Date of first DX in PCC"
Q ""
IFG(P) ;
NEW X,Y,I,BDMY,%
S X=$$PLTAX^BDMSMU(P,"BGP IMPAIRED FASTING GLUCOSE",,2) I X D Q Y
.S D=$P(^AUPNPROB(X,0),U,13) I D]"" S Y=1_U_D_U_"Date of Onset from Problem List" Q
.S D=$P(^AUPNPROB(X,0),U,8) I D]"" S Y=1_U_D_U_"Date Added to Problem List" Q
.S Y=1_U_D_U_"Problem List" Q
K BDMY S %=P_"^FIRST DX [BGP IMPAIRED FASTING GLUCOSE",E=$$START1^APCLDF(%,"BDMY(")
I $D(BDMY(1)) Q 1_U_$P(BDMY(1),U)_U_"Date of first DX in PCC"
Q ""
HTN(P) ;
N T S T=$O(^ATXAX("B","SURVEILLANCE HYPERTENSION",0))
I 'T Q ""
N X,Y,I S (X,Y,I)=0 F S X=$O(^AUPNPROB("AC",P,X)) Q:X'=+X!(I) I $D(^AUPNPROB(X,0)),$P(^AUPNPROB(X,0),U,12)'="D" S Y=$P(^AUPNPROB(X,0),U) I $$ICD^BDMUTL(Y,"SURVEILLANCE HYPERTENSION",9) S I=1
I I Q "Yes"
NEW BDMX
S BDMX=""
S X=P_"^LAST 3 DX [SURVEILLANCE HYPERTENSION" S E=$$START1^APCLDF(X,"BDMX(") G:E HTNX I $D(BDMX(3)) S BDMX="Yes"
I $G(BDMX)="" S BDMX="No"
HTNX ;
Q BDMX
BP(P) ;last 3 BPs - NON ER
NEW BDMD,BDMC
K BDMX
S BDMX="",BDMD="",BDMC=0
S T=$O(^AUTTMSR("B","BP",""))
F S BDMD=$O(^AUPNVMSR("AA",P,T,BDMD)) Q:BDMD=""!(BDMC=3) D
.S M=0 F S M=$O(^AUPNVMSR("AA",P,T,BDMD,M)) Q:M'=+M!(BDMC=3) D
..S V=$P($G(^AUPNVMSR(M,0)),U,3) Q:'V
..Q:'$D(^AUPNVSIT(V,0))
..Q:$$CLINIC^APCLV(V,"C")=30
..S BDMC=BDMC+1,BDMX(BDMC)=(9999999-BDMD)_U_$P(^AUPNVMSR(M,0),U,4)
..Q
.Q
I '$D(BDMX(1)) S BDMX(1)="None recorded"
BPX ;
K BDMD,BDMC
Q BDMX
GETHWB(P,EDATE) ;get last height, height date, weight, weight date and BMI for patient P, return in BDMX("HT"),BDMX("HTD"),BDMX("WT"),BDMX("WTD"),BDMX("BMI")
K BDMX
F X=1:1:3 S BDMX(X,"HT")="",BDMX(X,"HTD")="",BDMX(X,"WT")="",BDMX(X,"WTD")="",BDMX(X,"BMI")="",BDMX(X,"WC")="",BDMX(X,"WCD")="",BDMX(X,"WTI")=""
LASTHT ;
Q:'$D(^AUPNVSIT("AC",P))
Q:'$D(^AUPNVMSR("AC",P))
NEW BDMY
S %=P_"^LAST 3 MEAS HT" NEW X S E=$$START1^APCLDF(%,"BDMY(")
S BDMX(1,"HT")=$P($G(BDMY(1)),U,2),BDMX(1,"HTD")=$$FMTE^XLFDT($P($G(BDMY(1)),U))
S BDMX(1,"HT")=$S(BDMX(1,"HT")]"":$J(BDMX(1,"HT"),2,0),1:"")
S BDMX(2,"HT")=$P($G(BDMY(2)),U,2),BDMX(2,"HTD")=$$FMTE^XLFDT($P($G(BDMY(2)),U))
S BDMX(2,"HT")=$S(BDMX(2,"HT")]"":$J(BDMX(2,"HT"),2,0),1:"")
S BDMX(3,"HT")=$P($G(BDMY(3)),U,2),BDMX(3,"HTD")=$$FMTE^XLFDT($P($G(BDMY(3)),U))
S BDMX(3,"HT")=$S(BDMX(3,"HT")]"":$J(BDMX(3,"HT"),2,0),1:"")
LASTWT ;
K BDMY S %=P_"^LAST 3 MEAS WT" NEW X S E=$$START1^APCLDF(%,"BDMY(")
S BDMX(1,"WT")=$P($G(BDMY(1)),U,2),BDMX(1,"WTD")=$$FMTE^XLFDT($P($G(BDMY(1)),U)),BDMX(1,"WTI")=$P($G(BDMY(1)),U)
S BDMX(2,"WT")=$P($G(BDMY(2)),U,2),BDMX(2,"WTD")=$$FMTE^XLFDT($P($G(BDMY(2)),U)),BDMX(2,"WTI")=$P($G(BDMY(2)),U)
S BDMX(3,"WT")=$P($G(BDMY(3)),U,2),BDMX(3,"WTD")=$$FMTE^XLFDT($P($G(BDMY(3)),U)),BDMX(3,"WTI")=$P($G(BDMY(3)),U)
LASTWC ;
K BDMY S %=P_"^LAST 3 MEAS WC" NEW X S E=$$START1^APCLDF(%,"BDMY(")
S BDMX(1,"WC")=$P($G(BDMY(1)),U,2),BDMX(1,"WCD")=$$FMTE^XLFDT($P($G(BDMY(1)),U))
S BDMX(2,"WC")=$P($G(BDMY(2)),U,2),BDMX(2,"WCD")=$$FMTE^XLFDT($P($G(BDMY(2)),U))
S BDMX(3,"WC")=$P($G(BDMY(3)),U,2),BDMX(3,"WCD")=$$FMTE^XLFDT($P($G(BDMY(3)),U))
BMI ;
F BDMY=1:1:3 D
.I BDMX(BDMY,"WT")="" Q ;no weight
.S BDMHT=""
.I $$AGE^AUPNPAT(P)<19 D Q:BDMHT=""
..;Get weight on that date
..S Y=0 F S Y=$O(BDMX(Y)) Q:Y'=+Y I BDMX(Y,"HTD")=BDMX(BDMY,"WTD") S BDMHT=BDMX(Y,"HT")
.I $$AGE^AUPNPAT(P)>18 D Q:BDMHT=""
..S Y=0 F S Y=$O(BDMX(Y)) Q:Y'=+Y I BDMX(Y,"HTD")=BDMX(BDMY,"WTD") S BDMHT=BDMX(Y,"HT") Q
..S BDMHT=BDMX(1,"HT")
.S %=""
.S W=BDMX(BDMY,"WT")*.45359,H=(BDMHT*0.0254),H=(H*H),%=(W/H),%=$J(%,4,1)
.S BDMX(BDMY,"BMI")=%
Q
ASPIRIN(P,D) ;
I '$G(P) Q ""
I '$G(D) S D=0 ;if don't pass date look at all time
NEW V,I,%
S %=""
NEW T,T1 S T=$O(^ATXAX("B","DM AUDIT ASPIRIN DRUGS",0))
S T1=$O(^ATXAX("B","DM AUDIT ANTI-PLATELET DRUGS",0))
I 'T Q ""
S I=0 F S I=$O(^AUPNVMED("AA",P,I)) Q:I'=+I!(%)!(I>(9999999-D)) D
.S V=0 F S V=$O(^AUPNVMED("AA",P,I,V)) Q:V'=+V!(%) S G=$P(^AUPNVMED(V,0),U) D
..I $D(^ATXAX(T,21,"B",G)) S %=V Q
..I T1,$D(^ATXAX(T1,21,"B",G)) S %=V Q
I %]"" D Q %
.I $P(^AUPNVMED(%,0),U,8)="" S %="Yes - "_$$FMTE^XLFDT($P($P(^AUPNVSIT($P(^AUPNVMED(%,0),U,3),0),U),"."))_" "_$$VAL^XBDIQ1(9000010.14,%,.01) Q
.I $P(^AUPNVMED(%,0),U,8)]"" S %="Discontinued - "_$$FMTE^XLFDT($P($P(^AUPNVSIT($P(^AUPNVMED(%,0),U,3),0),U),"."))_" "_$$VAL^XBDIQ1(9000010.14,%,.01) Q
Q "No"
BDMS9D1 ; IHS/CMI/LAB - DIABETIC CARE SUMMARY SUPPLEMENT ; 01 Feb 2011 8:49 AM
+1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**3,4,8,9**;JUN 14, 2007;Build 78
+2 ;
+3 ;
EP ;EP - called from component
+1 IF '$GET(BDMSPAT)
QUIT
+2 ;has diabetes
IF $$PLTAX^BDMSMU(BDMSPAT,"SURVEILLANCE DIABETES")
QUIT
+3 SET X=$$LASTITEM^BDMSMU(BDMSPAT,"[SURVEILLANCE DIABETES","DX")
+4 ;if date of last dm dx is w/in past year then quit
IF X>$$FMADD^XLFDT(DT,-366)
QUIT
+5 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !!
SET DIR("A")="PRE-DIABETES CARE SUMMARY WILL NOW BE DISPLAYED (^ TO EXIT, RETURN TO CONTINUE)"
SET DIR(0)="E"
DO ^DIR
IF $DATA(DIRUT)
SET BDMSQIT=1
QUIT
+6 DO EP2(BDMSPAT)
W ;write out array
+1 IF $DATA(IOF)
WRITE @IOF
+2 KILL BDMQUIT
+3 SET BDMX=0
FOR
SET BDMX=$ORDER(^TMP("APCHS",$JOB,"DCS",BDMX))
IF BDMX'=+BDMX!($DATA(BDMQUIT))
QUIT
Begin DoDot:1
+4 IF $Y>(IOSL-3)
DO HEADER
IF $DATA(BDMQUIT)
QUIT
+5 WRITE !,^TMP("APCHS",$JOB,"DCS",BDMX)
+6 QUIT
End DoDot:1
+7 IF $DATA(BDMQUIT)
SET BDMSQIT=1
+8 DO EOJ
+9 QUIT
+10 ;
EOJ ;
+1 KILL BDMX,BDMQUIT,BDMY,BDMSDFN,BDMSBEG,BDMSTOB,BDMSUPI,BDMSED,BDMTOBN,BDMTOB,BDMSTEX
+2 KILL N,%,T,F,X,Y,B,C,E,F,H,L,N,P,T,W
+3 QUIT
+1 KILL DIR
IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET BDMQUIT=""
QUIT
HEAD1 ;
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,BDMSHDR,!
+3 WRITE !,"PreDiabetes Patient Care Summary - continued"
+4 WRITE !,"Patient: ",$PIECE(^DPT(BDMSPAT,0),U)," HRN: ",$$HRN^AUPNPAT(BDMSPAT,DUZ(2)),!
+5 QUIT
EP2(BDMSDFN) ;PEP - PASS DFN get back array of patient care summary
+1 ;at this point you are stuck with ^TMP("APCHS",$J,"DCS"
+2 KILL ^TMP("APCHS",$JOB,"DCS")
+3 SET ^TMP("APCHS",$JOB,"DCS",0)=0
+4 ;I '$D(BDMSCVD) S BDMSCVD="S:Y]"""" Y=+Y,Y=$E(Y,4,5)_""/""_$S($E(Y,6,7):$E(Y,6,7)_""/"",1:"""")_$E(Y,2,3)"
+5 DO EN^XBNEW("EP21^BDMS9D1","BDMSDFN")
+6 QUIT
EP21 ;
+1 SET BDMSPAT=BDMSDFN
+2 DO SETARRAY
+3 KILL ^XTMP("BDMTAX",BDMJOB,BDMBTH)
+4 QUIT
SETARRAY ;set up array containing dm care summary
+1 ;CHECK TO SEE IF START1^APCLDF EXISTS
+2 SET BDMJOB=$JOB
SET BDMBTH=$HOROLOG
+3 ;D UNFOLDTX^BDMUTL(2016)
+4 IF '$DATA(BDMSCVD)
SET BDMSCVD="S:Y]"""" Y=+Y,Y=$E(Y,4,5)_""/""_$S($E(Y,6,7):$E(Y,6,7)_""/"",1:"""")_$E(Y,2,3)"
+5 SET X="APCLDF"
XECUTE ^%ZOSF("TEST")
IF '$TEST
QUIT
+6 SET X="PREDIABETES PATIENT CARE SUMMARY Report Date: "_$$FMTE^XLFDT(DT)
DO S(X)
+7 SET X="Patient Name: "_$PIECE(^DPT(BDMSDFN,0),U)_" HRN: "_$$HRN^AUPNPAT(BDMSDFN,DUZ(2))
DO S(X)
+8 SET X="Age: "_$$AGE^AUPNPAT(BDMSDFN)
SET $EXTRACT(X,15)="Sex: "_$$SEX^AUPNPAT(BDMSDFN)_" DOB: "_$$FMTE^XLFDT($$DOB^AUPNPAT(BDMSDFN))
DO S(X)
+9 SET X="Classification:"
DO S(X,1)
+10 SET Y=$$IFG(BDMSDFN)
SET X=""
SET $EXTRACT(X,2)=$SELECT($PIECE(Y,U)=1:"Yes",1:"No")
SET $EXTRACT(X,8)="Impaired Fasting Glucose"
IF $PIECE(Y,U)=1
SET X=X_": "_$PIECE(Y,U,3)_": "_$$FMTE^XLFDT($PIECE(Y,U,2))
+11 DO S(X)
+12 SET Y=$$IGT(BDMSDFN)
SET X=""
SET $EXTRACT(X,2)=$SELECT($PIECE(Y,U)=1:"Yes",1:"No")
SET $EXTRACT(X,8)="Impaired Glucose Tolerance"
IF $PIECE(Y,U)=1
SET X=X_": "_$PIECE(Y,U,3)_": "_$$FMTE^XLFDT($PIECE(Y,U,2))
+13 DO S(X)
+14 SET Y=$$MS(BDMSDFN)
SET X=""
SET $EXTRACT(X,2)=$SELECT($PIECE(Y,U)=1:"Yes",1:"No")
SET $EXTRACT(X,8)="Metabolic Syndrome"
IF $PIECE(Y,U)=1
SET X=X_": "_$PIECE(Y,U,3)_": "_$$FMTE^XLFDT($PIECE(Y,U,2))
+15 DO S(X)
+16 SET X=" "
DO S(X)
+17 ;HOW TO FIND CASE MANAGER - LORI
SET X="Case Manager: "_$$CMSMAN(BDMSDFN)
DO S(X)
+18 SET X="Primary Care Provider: "_$$VAL^XBDIQ1(9000001,BDMSDFN,.14)
DO S(X)
+19 SET X=" "
DO S(X)
+20 DO GETHWB(BDMSDFN,DT)
+21 SET X=" Last Height: "_BDMX(1,"HT")_$SELECT(BDMX(1,"HT")]"":" inches",1:"")
SET $EXTRACT(X,33)=BDMX(1,"HTD")
DO S(X)
+22 SET X="Last 3 Weight: "_$SELECT(BDMX(1,"WT")]"":$JUSTIFY(BDMX(1,"WT"),3,0),1:"")_$SELECT(BDMX(1,"WT")]"":" lbs",1:"")
SET $EXTRACT(X,33)=BDMX(1,"WTD")
SET $EXTRACT(X,47)="BMI: "_BDMX(1,"BMI")
DO S(X)
+23 SET X=""
SET $EXTRACT(X,17)=$SELECT(BDMX(2,"WT")]"":$JUSTIFY(BDMX(2,"WT"),3,0),1:"")_$SELECT(BDMX(2,"WT")]"":" lbs",1:"")
SET $EXTRACT(X,33)=BDMX(2,"WTD")
SET $EXTRACT(X,47)="BMI: "_BDMX(2,"BMI")
DO S(X)
+24 SET X=""
SET $EXTRACT(X,17)=$SELECT(BDMX(3,"WT")]"":$JUSTIFY(BDMX(3,"WT"),3,0),1:"")_$SELECT(BDMX(3,"WT")]"":" lbs",1:"")
SET $EXTRACT(X,33)=BDMX(3,"WTD")
SET $EXTRACT(X,47)="BMI: "_BDMX(3,"BMI")
DO S(X)
+25 IF BDMX(1,"WC")]""
SET X="Last Waist Circumference: "_BDMX(1,"WC")
SET $EXTRACT(X,33)=BDMX(1,"WCD")
DO S(X,1)
+26 SET B=$$BP(BDMSDFN)
+27 SET X="Last 3 non-ER BP: "_$PIECE($GET(BDMX(1)),U,2)_" "_$$FMTE^XLFDT($PIECE($GET(BDMX(1)),U))
+28 DO S(X,1)
+29 SET X=""
IF $DATA(BDMX(2))
SET X=""
SET $EXTRACT(X,20)=$PIECE(BDMX(2),U,2)_" "_$$FMTE^XLFDT($PIECE(BDMX(2),U))
+30 DO S(X)
+31 SET X=""
IF $DATA(BDMX(3))
SET X=""
SET $EXTRACT(X,20)=$PIECE(BDMX(3),U,2)_" "_$$FMTE^XLFDT($PIECE(BDMX(3),U))
+32 DO S(X)
+33 DO TOBACCO^BDMS9B3
+34 SET X="Tobacco Use: "_$GET(BDMTOB)
DO S(X,1)
+35 SET X="Prediabetes Education Provided (in past yr):"
DO S(X,1)
+36 SET X=" Last Dietitian Visit: "_$$DIETV^BDMS9B3(BDMSDFN)
DO S(X)
+37 SET BDMSBEG=$$FMADD^XLFDT(DT,-366)
+38 KILL BDMX
DO EDUC^BDMS9B2
IF $DATA(BDMX)
Begin DoDot:1
+39 SET %=0
FOR
SET %=$ORDER(BDMX(%))
IF %'=+%
QUIT
SET X=" "_BDMX(%)
DO S(X)
End DoDot:1
+40 KILL BDMX,BDMY,%
+41 DO EDUCREF^BDMS9B2
IF $DATA(BDMX)
SET X="In the past year, the patient has refused the following Diabetes education:"
DO S(X,1)
Begin DoDot:1
+42 SET %=""
FOR
SET %=$ORDER(BDMX(%))
IF %=""
QUIT
SET X=" "_%_" "_BDMX(%)
DO S(X)
End DoDot:1
+43 KILL BDMX,BDMY,%
+44 SET X="HTN Diagnosed: "_$$HTN(BDMSDFN)
DO S(X,1)
+45 SET BDMSBEG=$$FMADD^XLFDT(DT,-(6*30.5))
+46 ;get date of last ACE in last year
SET %=$$ACE^BDMS9B4(BDMSDFN,BDMSBEG)
+47 SET X=""
SET X="ON ACE Inhibitor/ARB in past 6 months: "_%
DO S(X)
+48 KILL BDMSX
SET BDMSBEG=$$FMADD^XLFDT(DT,-365)
SET X="Aspirin Use (in past yr): "_$EXTRACT($$ASPIRIN(BDMSDFN,BDMSBEG),1,32)
DO S(X)
+49 SET X=""
SET X=$$ASPREF^BDMS9B4(BDMSDFN)
IF X]""
SET X=" "_X
DO S(X)
M12 ;
+1 DO MORE^BDMS9D2
+2 SET X=$PIECE(^DPT(BDMSDFN,0),U)
SET $EXTRACT(X,35)="DOB: "_$$DOB^AUPNPAT(BDMSDFN,"S")
SET $EXTRACT(X,55)="Chart #"_$$HRN^AUPNPAT(BDMSDFN,DUZ(2),2)
DO S(X,1)
+3 QUIT
S(Y,F,C,T) ;set up array
+1 IF '$GET(F)
SET F=0
+2 IF '$GET(T)
SET T=0
+3 NEW %,X
+4 FOR F=1:1:F
SET X=""
DO S1
+5 SET X=Y
+6 IF $GET(C)
SET L=$LENGTH(Y)
SET T=(80-L)/2
Begin DoDot:1
+7 FOR %=1:1:(T-1)
SET X=" "_X
End DoDot:1
DO S1
QUIT
+8 FOR %=1:1:T
SET X=" "_Y
+9 DO S1
+10 QUIT
S1 ;
+1 SET %=$PIECE(^TMP("APCHS",$JOB,"DCS",0),U)+1
SET $PIECE(^TMP("APCHS",$JOB,"DCS",0),U)=%
+2 SET ^TMP("APCHS",$JOB,"DCS",%)=X
+3 QUIT
CMSMAN(P,F) ;EP - return date/dx of dm in register
+1 IF $GET(F)=""
SET F="E"
+2 IF '$GET(P)
QUIT ""
+3 NEW R,N,D,D1,Y,X,G
SET R=0
SET N=""
SET D=""
FOR
SET N=$ORDER(^ACM(41.1,"B",N))
IF N=""!(D]"")
QUIT
SET R=0
FOR
SET R=$ORDER(^ACM(41.1,"B",N,R))
IF R'=+R!(D]"")
QUIT
IF N["DIAB"
Begin DoDot:1
+4 SET (G,X)=0
SET (D,Y)=""
FOR
SET X=$ORDER(^ACM(41,"C",P,X))
IF X'=+X!(D]"")
QUIT
IF $PIECE(^ACM(41,X,0),U,4)=R
Begin DoDot:2
+5 SET D=$PIECE($GET(^ACM(41,X,"DT")),U,6)
IF D]""
SET D=$PIECE(^VA(200,D,0),U)
End DoDot:2
End DoDot:1
+6 QUIT $GET(D)
+7 ;
MS(P) ;
+1 NEW X,Y,I,BDMY,%
+2 SET X=$$PLTAX^BDMSMU(P,"DM AUDIT METABOLIC SYNDROME",,2)
IF X
Begin DoDot:1
+3 SET D=$PIECE(^AUPNPROB(X,0),U,13)
IF D]""
SET Y=1_U_D_U_"Date of Onset from Problem List"
QUIT
+4 SET D=$PIECE(^AUPNPROB(X,0),U,8)
IF D]""
SET Y=1_U_D_U_"Date Added to Problem List"
QUIT
+5 SET Y=1_U_D_U_"Problem List"
QUIT
End DoDot:1
QUIT Y
+6 KILL BDMY
SET %=P_"^FIRST DX [DM AUDIT METABOLIC SYNDROME"
SET E=$$START1^APCLDF(%,"BDMY(")
+7 IF $DATA(BDMY(1))
QUIT 1_U_$PIECE(BDMY(1),U)_U_"Date of first DX in PCC"
+8 QUIT ""
IGT(P) ;
+1 NEW X,Y,I,BDMY,%
+2 SET X=$$PLTAX^BDMSMU(P,"DM AUDIT IGT DXS",,2)
IF X
Begin DoDot:1
+3 SET D=$PIECE(^AUPNPROB(X,0),U,13)
IF D]""
SET Y=1_U_D_U_"Date of Onset from Problem List"
QUIT
+4 SET D=$PIECE(^AUPNPROB(X,0),U,8)
IF D]""
SET Y=1_U_D_U_"Date Added to Problem List"
QUIT
+5 SET Y=1_U_D_U_"Problem List"
QUIT
End DoDot:1
QUIT Y
+6 KILL BDMY
SET %=P_"^FIRST DX [DM AUDIT IGT DXS"
SET E=$$START1^APCLDF(%,"BDMY(")
+7 IF $DATA(BDMY(1))
QUIT 1_U_$PIECE(BDMY(1),U)_U_"Date of first DX in PCC"
+8 QUIT ""
IFG(P) ;
+1 NEW X,Y,I,BDMY,%
+2 SET X=$$PLTAX^BDMSMU(P,"BGP IMPAIRED FASTING GLUCOSE",,2)
IF X
Begin DoDot:1
+3 SET D=$PIECE(^AUPNPROB(X,0),U,13)
IF D]""
SET Y=1_U_D_U_"Date of Onset from Problem List"
QUIT
+4 SET D=$PIECE(^AUPNPROB(X,0),U,8)
IF D]""
SET Y=1_U_D_U_"Date Added to Problem List"
QUIT
+5 SET Y=1_U_D_U_"Problem List"
QUIT
End DoDot:1
QUIT Y
+6 KILL BDMY
SET %=P_"^FIRST DX [BGP IMPAIRED FASTING GLUCOSE"
SET E=$$START1^APCLDF(%,"BDMY(")
+7 IF $DATA(BDMY(1))
QUIT 1_U_$PIECE(BDMY(1),U)_U_"Date of first DX in PCC"
+8 QUIT ""
HTN(P) ;
+1 NEW T
SET T=$ORDER(^ATXAX("B","SURVEILLANCE HYPERTENSION",0))
+2 IF 'T
QUIT ""
+3 NEW X,Y,I
SET (X,Y,I)=0
FOR
SET X=$ORDER(^AUPNPROB("AC",P,X))
IF X'=+X!(I)
QUIT
IF $DATA(^AUPNPROB(X,0))
IF $PIECE(^AUPNPROB(X,0),U,12)'="D"
SET Y=$PIECE(^AUPNPROB(X,0),U)
IF $$ICD^BDMUTL(Y,"SURVEILLANCE HYPERTENSION",9)
SET I=1
+4 IF I
QUIT "Yes"
+5 NEW BDMX
+6 SET BDMX=""
+7 SET X=P_"^LAST 3 DX [SURVEILLANCE HYPERTENSION"
SET E=$$START1^APCLDF(X,"BDMX(")
IF E
GOTO HTNX
IF $DATA(BDMX(3))
SET BDMX="Yes"
+8 IF $GET(BDMX)=""
SET BDMX="No"
HTNX ;
+1 QUIT BDMX
BP(P) ;last 3 BPs - NON ER
+1 NEW BDMD,BDMC
+2 KILL BDMX
+3 SET BDMX=""
SET BDMD=""
SET BDMC=0
+4 SET T=$ORDER(^AUTTMSR("B","BP",""))
+5 FOR
SET BDMD=$ORDER(^AUPNVMSR("AA",P,T,BDMD))
IF BDMD=""!(BDMC=3)
QUIT
Begin DoDot:1
+6 SET M=0
FOR
SET M=$ORDER(^AUPNVMSR("AA",P,T,BDMD,M))
IF M'=+M!(BDMC=3)
QUIT
Begin DoDot:2
+7 SET V=$PIECE($GET(^AUPNVMSR(M,0)),U,3)
IF 'V
QUIT
+8 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+9 IF $$CLINIC^APCLV(V,"C")=30
QUIT
+10 SET BDMC=BDMC+1
SET BDMX(BDMC)=(9999999-BDMD)_U_$PIECE(^AUPNVMSR(M,0),U,4)
+11 QUIT
End DoDot:2
+12 QUIT
End DoDot:1
+13 IF '$DATA(BDMX(1))
SET BDMX(1)="None recorded"
BPX ;
+1 KILL BDMD,BDMC
+2 QUIT BDMX
GETHWB(P,EDATE) ;get last height, height date, weight, weight date and BMI for patient P, return in BDMX("HT"),BDMX("HTD"),BDMX("WT"),BDMX("WTD"),BDMX("BMI")
+1 KILL BDMX
+2 FOR X=1:1:3
SET BDMX(X,"HT")=""
SET BDMX(X,"HTD")=""
SET BDMX(X,"WT")=""
SET BDMX(X,"WTD")=""
SET BDMX(X,"BMI")=""
SET BDMX(X,"WC")=""
SET BDMX(X,"WCD")=""
SET BDMX(X,"WTI")=""
LASTHT ;
+1 IF '$DATA(^AUPNVSIT("AC",P))
QUIT
+2 IF '$DATA(^AUPNVMSR("AC",P))
QUIT
+3 NEW BDMY
+4 SET %=P_"^LAST 3 MEAS HT"
NEW X
SET E=$$START1^APCLDF(%,"BDMY(")
+5 SET BDMX(1,"HT")=$PIECE($GET(BDMY(1)),U,2)
SET BDMX(1,"HTD")=$$FMTE^XLFDT($PIECE($GET(BDMY(1)),U))
+6 SET BDMX(1,"HT")=$SELECT(BDMX(1,"HT")]"":$JUSTIFY(BDMX(1,"HT"),2,0),1:"")
+7 SET BDMX(2,"HT")=$PIECE($GET(BDMY(2)),U,2)
SET BDMX(2,"HTD")=$$FMTE^XLFDT($PIECE($GET(BDMY(2)),U))
+8 SET BDMX(2,"HT")=$SELECT(BDMX(2,"HT")]"":$JUSTIFY(BDMX(2,"HT"),2,0),1:"")
+9 SET BDMX(3,"HT")=$PIECE($GET(BDMY(3)),U,2)
SET BDMX(3,"HTD")=$$FMTE^XLFDT($PIECE($GET(BDMY(3)),U))
+10 SET BDMX(3,"HT")=$SELECT(BDMX(3,"HT")]"":$JUSTIFY(BDMX(3,"HT"),2,0),1:"")
LASTWT ;
+1 KILL BDMY
SET %=P_"^LAST 3 MEAS WT"
NEW X
SET E=$$START1^APCLDF(%,"BDMY(")
+2 SET BDMX(1,"WT")=$PIECE($GET(BDMY(1)),U,2)
SET BDMX(1,"WTD")=$$FMTE^XLFDT($PIECE($GET(BDMY(1)),U))
SET BDMX(1,"WTI")=$PIECE($GET(BDMY(1)),U)
+3 SET BDMX(2,"WT")=$PIECE($GET(BDMY(2)),U,2)
SET BDMX(2,"WTD")=$$FMTE^XLFDT($PIECE($GET(BDMY(2)),U))
SET BDMX(2,"WTI")=$PIECE($GET(BDMY(2)),U)
+4 SET BDMX(3,"WT")=$PIECE($GET(BDMY(3)),U,2)
SET BDMX(3,"WTD")=$$FMTE^XLFDT($PIECE($GET(BDMY(3)),U))
SET BDMX(3,"WTI")=$PIECE($GET(BDMY(3)),U)
LASTWC ;
+1 KILL BDMY
SET %=P_"^LAST 3 MEAS WC"
NEW X
SET E=$$START1^APCLDF(%,"BDMY(")
+2 SET BDMX(1,"WC")=$PIECE($GET(BDMY(1)),U,2)
SET BDMX(1,"WCD")=$$FMTE^XLFDT($PIECE($GET(BDMY(1)),U))
+3 SET BDMX(2,"WC")=$PIECE($GET(BDMY(2)),U,2)
SET BDMX(2,"WCD")=$$FMTE^XLFDT($PIECE($GET(BDMY(2)),U))
+4 SET BDMX(3,"WC")=$PIECE($GET(BDMY(3)),U,2)
SET BDMX(3,"WCD")=$$FMTE^XLFDT($PIECE($GET(BDMY(3)),U))
BMI ;
+1 FOR BDMY=1:1:3
Begin DoDot:1
+2 ;no weight
IF BDMX(BDMY,"WT")=""
QUIT
+3 SET BDMHT=""
+4 IF $$AGE^AUPNPAT(P)<19
Begin DoDot:2
+5 ;Get weight on that date
+6 SET Y=0
FOR
SET Y=$ORDER(BDMX(Y))
IF Y'=+Y
QUIT
IF BDMX(Y,"HTD")=BDMX(BDMY,"WTD")
SET BDMHT=BDMX(Y,"HT")
End DoDot:2
IF BDMHT=""
QUIT
+7 IF $$AGE^AUPNPAT(P)>18
Begin DoDot:2
+8 SET Y=0
FOR
SET Y=$ORDER(BDMX(Y))
IF Y'=+Y
QUIT
IF BDMX(Y,"HTD")=BDMX(BDMY,"WTD")
SET BDMHT=BDMX(Y,"HT")
QUIT
+9 SET BDMHT=BDMX(1,"HT")
End DoDot:2
IF BDMHT=""
QUIT
+10 SET %=""
+11 SET W=BDMX(BDMY,"WT")*.45359
SET H=(BDMHT*0.0254)
SET H=(H*H)
SET %=(W/H)
SET %=$JUSTIFY(%,4,1)
+12 SET BDMX(BDMY,"BMI")=%
End DoDot:1
+13 QUIT
ASPIRIN(P,D) ;
+1 IF '$GET(P)
QUIT ""
+2 ;if don't pass date look at all time
IF '$GET(D)
SET D=0
+3 NEW V,I,%
+4 SET %=""
+5 NEW T,T1
SET T=$ORDER(^ATXAX("B","DM AUDIT ASPIRIN DRUGS",0))
+6 SET T1=$ORDER(^ATXAX("B","DM AUDIT ANTI-PLATELET DRUGS",0))
+7 IF 'T
QUIT ""
+8 SET I=0
FOR
SET I=$ORDER(^AUPNVMED("AA",P,I))
IF I'=+I!(%)!(I>(9999999-D))
QUIT
Begin DoDot:1
+9 SET V=0
FOR
SET V=$ORDER(^AUPNVMED("AA",P,I,V))
IF V'=+V!(%)
QUIT
SET G=$PIECE(^AUPNVMED(V,0),U)
Begin DoDot:2
+10 IF $DATA(^ATXAX(T,21,"B",G))
SET %=V
QUIT
+11 IF T1
IF $DATA(^ATXAX(T1,21,"B",G))
SET %=V
QUIT
End DoDot:2
End DoDot:1
+12 IF %]""
Begin DoDot:1
+13 IF $PIECE(^AUPNVMED(%,0),U,8)=""
SET %="Yes - "_$$FMTE^XLFDT($PIECE($PIECE(^AUPNVSIT($PIECE(^AUPNVMED(%,0),U,3),0),U),"."))_" "_$$VAL^XBDIQ1(9000010.14,%,.01)
QUIT
+14 IF $PIECE(^AUPNVMED(%,0),U,8)]""
SET %="Discontinued - "_$$FMTE^XLFDT($PIECE($PIECE(^AUPNVSIT($PIECE(^AUPNVMED(%,0),U,3),0),U),"."))_" "_$$VAL^XBDIQ1(9000010.14,%,.01)
QUIT
End DoDot:1
QUIT %
+15 QUIT "No"
