BDMPF13 ; IHS/CMI/LAB - 2003 DIABETES AUDIT ;
;;2.0;DIABETES MANAGEMENT SYSTEM;**11**;JUN 14, 2007;Build 30
;
;
;cmi/anch/maw 9/12/2007 code set versioning in PLDMDXS,IFG,IGT,MS,ABNG
;
LASTWT(P,EDATE,F) ;PEP - return last wt
I 'P Q ""
I $G(F)="" S F="E"
S BDATE=$$FMADD^XLFDT(EDATE,-365)
NEW %,BDMARRY,E,BDMW,X,BDMN,BDM,BDMD,BDMZ,BDMX,W,H,BDMC
;NEW BDMV221 S BDMV221=$O(^ICD9("BA","V22.1 ",""))
K BDM S BDMW="" S BDMX=P_"^LAST 30 MEAS WT;DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(BDMX,"BDM(")
S BDMC=0,BDMN=0 F S BDMN=$O(BDM(BDMN)) Q:BDMN'=+BDMN!(BDMC>2) D
. S BDMZ=$P(BDM(BDMN),U,5)
. I '$D(^AUPNVPOV("AD",BDMZ)) S BDMC=BDMC+1,BDMW=BDMW_"|"_$P(BDM(BDMN),U,2)_" lbs "_$$FMTE^XLFDT($P(BDM(BDMN),U)) Q
. S BDMD=0 F S BDMD=$O(^AUPNVPOV("AD",BDMZ,BDMD)) Q:'BDMD!(BDMW]"") D
.. ;lets change this code here to look at the taxonomy p8 06/04/2014
.. N TAX,CODE
.. S TAX=$O(^ATXAX("B","BGP PREGNANCY DIAGNOSES 2",0))
.. S CODE=$P($G(^AUPNVPOV(BDMD,0)),U)
.. I '$$ICD^BDMUTL(CODE,"BGP PREGNANCY DIAGNOSES 2",9) S BDMC=BDMC+1,BDMW=BDMW_"|"_$P(BDM(BDMN),U,2)_" lbs "_$$FMTE^XLFDT($P(BDM(BDMN),U))
..Q
Q $S(F="E":BDMW,1:+BDMW)
LASTWC(P,EDATE,F) ;PEP - return last ht and date
I 'P Q ""
I $G(F)="" S F="E"
I '$D(^AUPNVSIT("AC",P)) Q ""
S BDATE=$$FMADD^XLFDT(EDATE,-365)
NEW %,BDMARRY,H,E,W
S %=P_"^LAST MEAS WC;DURING "_BDATE_"-"_EDATE NEW X S E=$$START1^APCLDF(%,"BDMARRY(") S H=$P($G(BDMARRY(1)),U,2)
Q H_" "_$$FMTE^XLFDT($P($G(BDMARRY(1)),U))
;
IFG(P,BDMRET) ;EP
K BDMRET
NEW BDMC,BDM
S BDMC=0
K BDM
;look at problem list then povs
;return where found^dx code^provider narr^date (either visit date or doo from pl)
;look for first and last pov
S X=0 F S X=$O(^AUPNPROB("AC",P,X)) Q:X'=+X D
.S I=$P(^AUPNPROB(X,0),U)
.Q:$P(^AUPNPROB(X,0),U,12)="D"
.;ihs/cmi/maw 06/04/2014 p8
.;S I=$P($$ICDDX^BDMUTL(I),U,2)
.;Q:I'="790.21"
.Q:'$$ICD^BDMUTL(I,"BGP IMPAIRED FASTING GLUCOSE",9)
.S BDMC=BDMC+1,BDMRET(BDMC)="Problem List: "_$P($$ICDDX^BDMUTL(I),U,2)_" Date of Onset: "_$$VAL^XBDIQ1(9000011,X,.13)
.Q
;now look at first and last pov
S Y="BDM("
S X=P_"^LAST DX [BGP IMPAIRED FASTING GLUCOSE;DURING "_$$DOB^AUPNPAT(P,"E")_"-"_DT S E=$$START1^APCLDF(X,Y)
I $D(BDM(1)) S BDMC=BDMC+1,BDMRET(BDMC)="Last POV in PCC: "_$P(BDM(1),U,2)_" Date: "_$$FMTE^XLFDT($P(BDM(1),U))
K BDM S X=P_"^FIRST DX [BGP IMPAIRED FASTING GLUCOSE;DURING "_$$DOB^AUPNPAT(P,"E")_"-"_DT S E=$$START1^APCLDF(X,Y)
I $D(BDM(1)) S BDMC=BDMC+1,BDMRET(BDMC)="First POV in PCC: "_$P(BDM(1),U,2)_" Date: "_$$FMTE^XLFDT($P(BDM(1),U))
Q
IGT(P,BDMRET) ;EP
K BDMRET
NEW BDMC,BDM
S BDMC=0
K BDM
;look at problem list then povs
;return where found^dx code^provider narr^date (either visit date or doo from pl)
;look for first and last pov
S X=0 F S X=$O(^AUPNPROB("AC",P,X)) Q:X'=+X D
.S I=$P(^AUPNPROB(X,0),U)
.Q:$P(^AUPNPROB(X,0),U,12)="D"
.;ihs/cmi/maw 06/04/2014 p8
.;S I=$P($$ICDDX^BDMUTL(I),U,2) ;cmi/anch/maw 9/12/2007 csv
.;Q:I'="790.22"
.Q:'$$ICD^BDMUTL(I,"DM AUDIT IGT DXS",9)
.S BDMC=BDMC+1,BDMRET(BDMC)="Problem List: "_$P($$ICDDX^BDMUTL(I),U,2)_" Date of Onset: "_$$VAL^XBDIQ1(9000011,X,.13)
.Q
;now look at first and last pov
S Y="BDM("
S X=P_"^LAST DX [DM AUDIT IGT DXS;DURING "_$$DOB^AUPNPAT(P,"E")_"-"_DT S E=$$START1^APCLDF(X,Y)
I $D(BDM(1)) S BDMC=BDMC+1,BDMRET(BDMC)="Last POV in PCC: "_$P(BDM(1),U,2)_" Date: "_$$FMTE^XLFDT($P(BDM(1),U))
K BDM S X=P_"^FIRST DX [DM AUDIT IGT DXS;DURING "_$$DOB^AUPNPAT(P,"E")_"-"_DT S E=$$START1^APCLDF(X,Y)
I $D(BDM(1)) S BDMC=BDMC+1,BDMRET(BDMC)="First POV in PCC: "_$P(BDM(1),U,2)_" Date: "_$$FMTE^XLFDT($P(BDM(1),U))
Q
MS(P,BDMRET) ;EP
K BDMRET
NEW BDMC,BDM
S BDMC=0
K BDM
;look at problem list then povs
;return where found^dx code^provider narr^date (either visit date or doo from pl)
;look for first and last pov
S X=0 F S X=$O(^AUPNPROB("AC",P,X)) Q:X'=+X D
.S I=$P(^AUPNPROB(X,0),U)
.Q:$P(^AUPNPROB(X,0),U,12)="D"
.;ihs/cmi/maw 06/04/2014 p8
.;S I=$P($$ICDDX^BDMUTL(I),U,2) ;cmi/anch/maw 9/12/2007 csv
.;Q:I'="277.7"
.Q:'$$ICD^BDMUTL(I,"DM AUDIT METABOLIC SYNDROME",9)
.S BDMC=BDMC+1,BDMRET(BDMC)="Problem List: "_$P($$ICDDX^BDMUTL(I),U,2)_" Date of Onset: "_$$VAL^XBDIQ1(9000011,X,.13)
.Q
;now look at first and last pov
S Y="BDM("
S X=P_"^LAST DX [DM AUDIT METABOLIC SYNDROME;DURING "_$$DOB^AUPNPAT(P,"E")_"-"_DT S E=$$START1^APCLDF(X,Y)
I $D(BDM(1)) S BDMC=BDMC+1,BDMRET(BDMC)="Last POV in PCC: "_$P(BDM(1),U,2)_" Date: "_$$FMTE^XLFDT($P(BDM(1),U))
K BDM S X=P_"^FIRST DX [DM AUDIT METABOLIC SYNDROME;DURING "_$$DOB^AUPNPAT(P,"E")_"-"_DT S E=$$START1^APCLDF(X,Y)
I $D(BDM(1)) S BDMC=BDMC+1,BDMRET(BDMC)="First POV in PCC: "_$P(BDM(1),U,2)_" Date: "_$$FMTE^XLFDT($P(BDM(1),U))
Q
ABNG(P,BDMRET) ;EP
K BDMRET
NEW BDMC
S BDMC=0
;look at problem list then povs
;return where found^dx code^provider narr^date (either visit date or doo from pl)
;look for first and last pov
S X=0 F S X=$O(^AUPNPROB("AC",P,X)) Q:X'=+X D
.S I=$P(^AUPNPROB(X,0),U)
.Q:$P(^AUPNPROB(X,0),U,12)="D"
.;ihs/cmi/maw 06/04/2014 p8
.;S I=$P($$ICDDX^BDMUTL(I),U,2) ;cmi/anch/maw 9/12/2007 csv
.;Q:I'="790.29"
.Q:'$$ICD^BDMUTL(I,"DM AUDIT ABNORMAL GLUCOSE",9)
.S BDMC=BDMC+1,BDMRET(BDMC)="Problem List: "_$P($$ICDDX^BDMUTL(I),U,2)_" Date of Onset: "_$$VAL^XBDIQ1(9000011,X,.13)
.Q
;now look at first and last pov
S Y="BDM("
S X=P_"^LAST DX [DM AUDIT ABNORMAL GLUCOSE;DURING "_$$DOB^AUPNPAT(P,"E")_"-"_DT S E=$$START1^APCLDF(X,Y)
I $D(BDM(1)) S BDMC=BDMC+1,BDMRET(BDMC)="Last POV in PCC: "_$P(BDM(1),U,2)_" Date: "_$$FMTE^XLFDT($P(BDM(1),U))
K BDM S X=P_"^FIRST DX [DM AUDIT ABNORMAL GLUCOSE;DURING "_$$DOB^AUPNPAT(P,"E")_"-"_DT S E=$$START1^APCLDF(X,Y)
I $D(BDM(1)) S BDMC=BDMC+1,BDMRET(BDMC)="First POV in PCC: "_$P(BDM(1),U,2)_" Date: "_$$FMTE^XLFDT($P(BDM(1),U))
Q
BDMPF13 ; IHS/CMI/LAB - 2003 DIABETES AUDIT ;
+1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**11**;JUN 14, 2007;Build 30
+2 ;
+3 ;
+4 ;cmi/anch/maw 9/12/2007 code set versioning in PLDMDXS,IFG,IGT,MS,ABNG
+5 ;
LASTWT(P,EDATE,F) ;PEP - return last wt
+1 IF 'P
QUIT ""
+2 IF $GET(F)=""
SET F="E"
+3 SET BDATE=$$FMADD^XLFDT(EDATE,-365)
+4 NEW %,BDMARRY,E,BDMW,X,BDMN,BDM,BDMD,BDMZ,BDMX,W,H,BDMC
+5 ;NEW BDMV221 S BDMV221=$O(^ICD9("BA","V22.1 ",""))
+6 KILL BDM
SET BDMW=""
SET BDMX=P_"^LAST 30 MEAS WT;DURING "_BDATE_"-"_EDATE
SET E=$$START1^APCLDF(BDMX,"BDM(")
+7 SET BDMC=0
SET BDMN=0
FOR
SET BDMN=$ORDER(BDM(BDMN))
IF BDMN'=+BDMN!(BDMC>2)
QUIT
Begin DoDot:1
+8 SET BDMZ=$PIECE(BDM(BDMN),U,5)
+9 IF '$DATA(^AUPNVPOV("AD",BDMZ))
SET BDMC=BDMC+1
SET BDMW=BDMW_"|"_$PIECE(BDM(BDMN),U,2)_" lbs "_$$FMTE^XLFDT($PIECE(BDM(BDMN),U))
QUIT
+10 SET BDMD=0
FOR
SET BDMD=$ORDER(^AUPNVPOV("AD",BDMZ,BDMD))
IF 'BDMD!(BDMW]"")
QUIT
Begin DoDot:2
+11 ;lets change this code here to look at the taxonomy p8 06/04/2014
+12 NEW TAX,CODE
+13 SET TAX=$ORDER(^ATXAX("B","BGP PREGNANCY DIAGNOSES 2",0))
+14 SET CODE=$PIECE($GET(^AUPNVPOV(BDMD,0)),U)
+15 IF '$$ICD^BDMUTL(CODE,"BGP PREGNANCY DIAGNOSES 2",9)
SET BDMC=BDMC+1
SET BDMW=BDMW_"|"_$PIECE(BDM(BDMN),U,2)_" lbs "_$$FMTE^XLFDT($PIECE(BDM(BDMN),U))
+16 QUIT
End DoDot:2
End DoDot:1
+17 QUIT $SELECT(F="E":BDMW,1:+BDMW)
LASTWC(P,EDATE,F) ;PEP - return last ht and date
+1 IF 'P
QUIT ""
+2 IF $GET(F)=""
SET F="E"
+3 IF '$DATA(^AUPNVSIT("AC",P))
QUIT ""
+4 SET BDATE=$$FMADD^XLFDT(EDATE,-365)
+5 NEW %,BDMARRY,H,E,W
+6 SET %=P_"^LAST MEAS WC;DURING "_BDATE_"-"_EDATE
NEW X
SET E=$$START1^APCLDF(%,"BDMARRY(")
SET H=$PIECE($GET(BDMARRY(1)),U,2)
+7 QUIT H_" "_$$FMTE^XLFDT($PIECE($GET(BDMARRY(1)),U))
+8 ;
IFG(P,BDMRET) ;EP
+1 KILL BDMRET
+2 NEW BDMC,BDM
+3 SET BDMC=0
+4 KILL BDM
+5 ;look at problem list then povs
+6 ;return where found^dx code^provider narr^date (either visit date or doo from pl)
+7 ;look for first and last pov
+8 SET X=0
FOR
SET X=$ORDER(^AUPNPROB("AC",P,X))
IF X'=+X
QUIT
Begin DoDot:1
+9 SET I=$PIECE(^AUPNPROB(X,0),U)
+10 IF $PIECE(^AUPNPROB(X,0),U,12)="D"
QUIT
+11 ;ihs/cmi/maw 06/04/2014 p8
+12 ;S I=$P($$ICDDX^BDMUTL(I),U,2)
+13 ;Q:I'="790.21"
+14 IF '$$ICD^BDMUTL(I,"BGP IMPAIRED FASTING GLUCOSE",9)
QUIT
+15 SET BDMC=BDMC+1
SET BDMRET(BDMC)="Problem List: "_$PIECE($$ICDDX^BDMUTL(I),U,2)_" Date of Onset: "_$$VAL^XBDIQ1(9000011,X,.13)
+16 QUIT
End DoDot:1
+17 ;now look at first and last pov
+18 SET Y="BDM("
+19 SET X=P_"^LAST DX [BGP IMPAIRED FASTING GLUCOSE;DURING "_$$DOB^AUPNPAT(P,"E")_"-"_DT
SET E=$$START1^APCLDF(X,Y)
+20 IF $DATA(BDM(1))
SET BDMC=BDMC+1
SET BDMRET(BDMC)="Last POV in PCC: "_$PIECE(BDM(1),U,2)_" Date: "_$$FMTE^XLFDT($PIECE(BDM(1),U))
+21 KILL BDM
SET X=P_"^FIRST DX [BGP IMPAIRED FASTING GLUCOSE;DURING "_$$DOB^AUPNPAT(P,"E")_"-"_DT
SET E=$$START1^APCLDF(X,Y)
+22 IF $DATA(BDM(1))
SET BDMC=BDMC+1
SET BDMRET(BDMC)="First POV in PCC: "_$PIECE(BDM(1),U,2)_" Date: "_$$FMTE^XLFDT($PIECE(BDM(1),U))
+23 QUIT
IGT(P,BDMRET) ;EP
+1 KILL BDMRET
+2 NEW BDMC,BDM
+3 SET BDMC=0
+4 KILL BDM
+5 ;look at problem list then povs
+6 ;return where found^dx code^provider narr^date (either visit date or doo from pl)
+7 ;look for first and last pov
+8 SET X=0
FOR
SET X=$ORDER(^AUPNPROB("AC",P,X))
IF X'=+X
QUIT
Begin DoDot:1
+9 SET I=$PIECE(^AUPNPROB(X,0),U)
+10 IF $PIECE(^AUPNPROB(X,0),U,12)="D"
QUIT
+11 ;ihs/cmi/maw 06/04/2014 p8
+12 ;S I=$P($$ICDDX^BDMUTL(I),U,2) ;cmi/anch/maw 9/12/2007 csv
+13 ;Q:I'="790.22"
+14 IF '$$ICD^BDMUTL(I,"DM AUDIT IGT DXS",9)
QUIT
+15 SET BDMC=BDMC+1
SET BDMRET(BDMC)="Problem List: "_$PIECE($$ICDDX^BDMUTL(I),U,2)_" Date of Onset: "_$$VAL^XBDIQ1(9000011,X,.13)
+16 QUIT
End DoDot:1
+17 ;now look at first and last pov
+18 SET Y="BDM("
+19 SET X=P_"^LAST DX [DM AUDIT IGT DXS;DURING "_$$DOB^AUPNPAT(P,"E")_"-"_DT
SET E=$$START1^APCLDF(X,Y)
+20 IF $DATA(BDM(1))
SET BDMC=BDMC+1
SET BDMRET(BDMC)="Last POV in PCC: "_$PIECE(BDM(1),U,2)_" Date: "_$$FMTE^XLFDT($PIECE(BDM(1),U))
+21 KILL BDM
SET X=P_"^FIRST DX [DM AUDIT IGT DXS;DURING "_$$DOB^AUPNPAT(P,"E")_"-"_DT
SET E=$$START1^APCLDF(X,Y)
+22 IF $DATA(BDM(1))
SET BDMC=BDMC+1
SET BDMRET(BDMC)="First POV in PCC: "_$PIECE(BDM(1),U,2)_" Date: "_$$FMTE^XLFDT($PIECE(BDM(1),U))
+23 QUIT
MS(P,BDMRET) ;EP
+1 KILL BDMRET
+2 NEW BDMC,BDM
+3 SET BDMC=0
+4 KILL BDM
+5 ;look at problem list then povs
+6 ;return where found^dx code^provider narr^date (either visit date or doo from pl)
+7 ;look for first and last pov
+8 SET X=0
FOR
SET X=$ORDER(^AUPNPROB("AC",P,X))
IF X'=+X
QUIT
Begin DoDot:1
+9 SET I=$PIECE(^AUPNPROB(X,0),U)
+10 IF $PIECE(^AUPNPROB(X,0),U,12)="D"
QUIT
+11 ;ihs/cmi/maw 06/04/2014 p8
+12 ;S I=$P($$ICDDX^BDMUTL(I),U,2) ;cmi/anch/maw 9/12/2007 csv
+13 ;Q:I'="277.7"
+14 IF '$$ICD^BDMUTL(I,"DM AUDIT METABOLIC SYNDROME",9)
QUIT
+15 SET BDMC=BDMC+1
SET BDMRET(BDMC)="Problem List: "_$PIECE($$ICDDX^BDMUTL(I),U,2)_" Date of Onset: "_$$VAL^XBDIQ1(9000011,X,.13)
+16 QUIT
End DoDot:1
+17 ;now look at first and last pov
+18 SET Y="BDM("
+19 SET X=P_"^LAST DX [DM AUDIT METABOLIC SYNDROME;DURING "_$$DOB^AUPNPAT(P,"E")_"-"_DT
SET E=$$START1^APCLDF(X,Y)
+20 IF $DATA(BDM(1))
SET BDMC=BDMC+1
SET BDMRET(BDMC)="Last POV in PCC: "_$PIECE(BDM(1),U,2)_" Date: "_$$FMTE^XLFDT($PIECE(BDM(1),U))
+21 KILL BDM
SET X=P_"^FIRST DX [DM AUDIT METABOLIC SYNDROME;DURING "_$$DOB^AUPNPAT(P,"E")_"-"_DT
SET E=$$START1^APCLDF(X,Y)
+22 IF $DATA(BDM(1))
SET BDMC=BDMC+1
SET BDMRET(BDMC)="First POV in PCC: "_$PIECE(BDM(1),U,2)_" Date: "_$$FMTE^XLFDT($PIECE(BDM(1),U))
+23 QUIT
ABNG(P,BDMRET) ;EP
+1 KILL BDMRET
+2 NEW BDMC
+3 SET BDMC=0
+4 ;look at problem list then povs
+5 ;return where found^dx code^provider narr^date (either visit date or doo from pl)
+6 ;look for first and last pov
+7 SET X=0
FOR
SET X=$ORDER(^AUPNPROB("AC",P,X))
IF X'=+X
QUIT
Begin DoDot:1
+8 SET I=$PIECE(^AUPNPROB(X,0),U)
+9 IF $PIECE(^AUPNPROB(X,0),U,12)="D"
QUIT
+10 ;ihs/cmi/maw 06/04/2014 p8
+11 ;S I=$P($$ICDDX^BDMUTL(I),U,2) ;cmi/anch/maw 9/12/2007 csv
+12 ;Q:I'="790.29"
+13 IF '$$ICD^BDMUTL(I,"DM AUDIT ABNORMAL GLUCOSE",9)
QUIT
+14 SET BDMC=BDMC+1
SET BDMRET(BDMC)="Problem List: "_$PIECE($$ICDDX^BDMUTL(I),U,2)_" Date of Onset: "_$$VAL^XBDIQ1(9000011,X,.13)
+15 QUIT
End DoDot:1
+16 ;now look at first and last pov
+17 SET Y="BDM("
+18 SET X=P_"^LAST DX [DM AUDIT ABNORMAL GLUCOSE;DURING "_$$DOB^AUPNPAT(P,"E")_"-"_DT
SET E=$$START1^APCLDF(X,Y)
+19 IF $DATA(BDM(1))
SET BDMC=BDMC+1
SET BDMRET(BDMC)="Last POV in PCC: "_$PIECE(BDM(1),U,2)_" Date: "_$$FMTE^XLFDT($PIECE(BDM(1),U))
+20 KILL BDM
SET X=P_"^FIRST DX [DM AUDIT ABNORMAL GLUCOSE;DURING "_$$DOB^AUPNPAT(P,"E")_"-"_DT
SET E=$$START1^APCLDF(X,Y)
+21 IF $DATA(BDM(1))
SET BDMC=BDMC+1
SET BDMRET(BDMC)="First POV in PCC: "_$PIECE(BDM(1),U,2)_" Date: "_$$FMTE^XLFDT($PIECE(BDM(1),U))
+22 QUIT
