BHSDMPR1 ;IHS/CIA/MGH - Health Summary for Pre-Diabetic Supplement ;19-Jun-2008 12:37;MGH
;;1.0;HEALTH SUMMARY COMPONENTS;**1,2**;Mar 17,2006
;====================================================================
; IHS/TUCSON/LAB - DIABETIC CARE SUMMARY SUPPLEMENT ;07-Jul-2006 16:02;MGH
;;2.0;IHS RPMS/PCC Health Summary;**3,5,6,7,8,9,10,11,12,14**;JUN 24, 1997
;IHS/CMI/LAB patch 3 - patch 3 fixes various problems
;Copied from APCHS9B2
;======================================================================
;
;
MORE ;EP
N X,BHSX,BHSY,BHSIEN,V,Y
S BHSBEG=$$FMADD^XLFDT(DT,-(6*30))
S X="On Metformin: "_$$MET(BHSDFN,BHSBEG,DT) D S(X,1)
S X="On TZD: "_$$TROG(BHSDFN,BHSBEG,DT) D S(X)
S X="On Acarbose: "_$$ACAR(BHSDFN,BHSBEG,DT) D S(X)
S X="On Lipid Lowering Drugs: "_$$LLOW(BHSDFN,BHSBEG,DT) D S(X)
S BHSX=$$STATIN(BHSDFN,BHSBEG,DT) I $E(BHSX,1,3)="Yes" S X=" :"_BHSX D S(X)
S X="Laboratory Results (most recent):" D S(X,1)
S X="Last Fasting Glucose:" S Y=$$FGLUCOSE(BHSDFN),$E(X,28)=$P(Y,"|||"),$E(X,42)=$P(Y,"|||",2),$E(X,56)=$P(Y,"|||",3) D S(X)
S X="Last 75 GM 2 hour Glucose:" S Y=$$GM75(BHSDFN),$E(X,28)=$P(Y,"|||"),$E(X,42)=$P(Y,"|||",2),$E(X,56)=$P(Y,"|||",3) D S(X)
S X="Total Cholesterol:" S Y=$$TCHOL^BHSDM2(BHSDFN),$E(X,28)=$P(Y,"|||"),$E(X,42)=$P(Y,"|||",2),$E(X,56)=$P(Y,"|||",3) D S(X,1)
S X=" LDL Cholesterol:" S Y=$$CHOL^BHSDM2(BHSDFN),$E(X,28)=$P(Y,"|||"),$E(X,42)=$P(Y,"|||",2),$E(X,56)=$P(Y,"|||",3) D S(X)
S V=$P(Y,"|||") I V'=+V D
.;get last 3 and display next most recent 2
.S BHSIEN=$P(Y,"|||",4)
.S T=$O(^ATXLAB("B","DM AUDIT LDL CHOLESTEROL TAX",0)) D LDLLAB^BHSDM2
.I $D(BHSX) S X=" Next most recent LDL values:" D S(X)
.S BHSY=0 F S BHSY=$O(BHSX(BHSY)) Q:BHSY'=+BHSY S X="",$E(X,28)=$P(BHSX(BHSY),U),$E(X,42)=$$FMTE^XLFDT($P(BHSX(BHSY),U,2)) D S(X)
S X=" HDL Cholesterol:" S Y=$$HDL^BHSDM2(BHSDFN),$E(X,28)=$P(Y,"|||"),$E(X,42)=$P(Y,"|||",2),$E(X,56)=$P(Y,"|||",3) D S(X)
S X=" Triglycerides:" S Y=$$TRIG^BHSDM2(BHSDFN),$E(X,28)=$P(Y,"|||"),$E(X,42)=$P(Y,"|||",2),$E(X,56)=$P(Y,"|||",3) D S(X)
Q
S(Y,F,C,T) ;set up array
I '$G(F) S F=0
I '$G(T) S T=0
NEW %,X,L
;blank lines
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("BHS",$J,"DCS",0),U)+1,$P(^TMP("BHS",$J,"DCS",0),U)=%
S ^TMP("BHS",$J,"DCS",%)=X
Q
EDUC ;gather up all education provided in past year in APCHX
K APCHX,APCHY S %=BHSDFN_"^ALL EDUC;DURING "_$$FMTE^XLFDT($$FMADD^XLFDT(DT,-365))_"-"_$$FMTE^XLFDT(DT) S E=$$START1^APCLDF(%,"APCHY(")
I '$D(APCHY) S APCHX(1)=" <No Education Topics recorded in past year>" K APCHY Q
NEW X,APCHP K APCHP S X=0,E="" F S X=$O(APCHY(X)) Q:X'=+X S E=+$P(APCHY(X),U,4),E=$P(^AUPNVPED(E,0),U) I $$EDT(E) S APCHP($P(APCHY(X),U,2))=$$FMTE^XLFDT($P(APCHY(X),U))
S %=0,E="" F S E=$O(APCHP(E)) Q:E="" S %=%+1,APCHX(%)=E,$E(APCHX(%),25)=APCHP(E)
K APCHY,APCHP
Q
EDT(E) ;
;is this ien in any taxonomy
NEW T
S T=$O(^ATXAX("B","DM AUDIT DIABETES EDUC TOPICS",0))
I T,$D(^ATXAX(T,21,"B",E)) Q 1
S T=$O(^ATXAX("B","DM AUDIT DIET EDUC TOPICS",0))
I T,$D(^ATXAX(T,21,"B",E)) Q 1
S T=$O(^ATXAX("B","DM AUDIT EXERCISE EDUC TOPICS",0))
I T,$D(^ATXAX(T,21,"B",E)) Q 1
S T=$O(^ATXAX("B","DM AUDIT OTHER EDUC TOPICS",0))
I T,$D(^ATXAX(T,21,"B",E)) Q 1
S T=$P(^AUTTEDT(E,0),U)
I $P(T,"-")="DM" Q 1
I $P(T,"-")="DMC" Q 1
Q ""
FGLUCOSE(P) ;
N LT
I '$G(P) Q ""
NEW T S T=$O(^ATXLAB("B","DM AUDIT FASTING GLUCOSE TESTS",0)),LT="DM AUDIT FASTING GLUC LOINC" I 'T Q "<Taxonomy Missing>"
Q $$LAB^BHSDM2(P,T,LT)
GM75(P) ;
I '$G(P) Q ""
NEW T S T=$O(^ATXLAB("B","DM AUDIT 75GM 2HR GLUCOSE",0)),LT="DM AUDIT 75GM 2HR GLUC LOINC" I 'T Q "<Taxonomy Missing>"
Q $$LAB^BHSDM2(P,T,LT)
DATE(D) ;EP - convert to slashed date
I $G(D)="" Q ""
Q $E(D,4,5)_"/"_$E(D,6,7)_"/"_$E(D,2,3)
LLOW(P,BDATE,EDATE) ;EP
NEW X,APCH,E
S X=P_"^LAST MEDS [DM AUDIT LIPID LOWERING DRUGS"_";DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,"APCH(")
I $D(APCH(1)) Q "Yes - "_$$VAL^XBDIQ1(9000010.14,+$P(APCH(1),U,4),.01)_" "_$$FMTE^XLFDT($P(APCH(1),U))
Q "No"
;
STATIN(P,BDATE,EDATE) ;EP
NEW X,APCH,E
S X=P_"^LAST MEDS [DM AUDIT STATIN DRUGS"_";DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,"APCH(")
I $D(APCH(1)) Q "Yes - "_$$VAL^XBDIQ1(9000010.14,+$P(APCH(1),U,4),.01)_" "_$$FMTE^XLFDT($P(APCH(1),U))
Q "No"
MET(P,BDATE,EDATE) ;EP
NEW X,APCH,E
S X=P_"^LAST MEDS [DM AUDIT METFORMIN DRUGS"_";DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,"APCH(")
I $D(APCH(1)) Q "Yes - "_$$VAL^XBDIQ1(9000010.14,+$P(APCH(1),U,4),.01)_" "_$$FMTE^XLFDT($P(APCH(1),U))
Q "No"
;
ACAR(P,BDATE,EDATE) ;EP
NEW X,APCH,E
S X=P_"^LAST MEDS [DM AUDIT ACARBOSE DRUGS"_";DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,"APCH(")
I $D(APCH(1)) Q "Yes - "_$$VAL^XBDIQ1(9000010.14,+$P(APCH(1),U,4),.01)_" "_$$FMTE^XLFDT($P(APCH(1),U))
Q "No"
;
TROG(P,BDATE,EDATE) ;EP
NEW X,APCH,E
I '$O(^ATXAX("B","DM AUDIT GLITAZONE DRUGS",0)) Q $$TROG1(P,BDATE,EDATE)
S X=P_"^LAST MEDS [DM AUDIT GLITAZONE DRUGS"_";DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,"APCH(")
I $D(APCH(1)) Q "Yes - "_$$VAL^XBDIQ1(9000010.14,+$P(APCH(1),U,4),.01)_" "_$$FMTE^XLFDT($P(APCH(1),U))
Q "No"
TROG1(P,BDATE,EDATE) ;EP
NEW X,APCH,E
S X=P_"^LAST MEDS [DM AUDIT TROGLITAZONE DRUGS"_";DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,"APCH(")
I $D(APCH(1)) Q "Yes - "_$$VAL^XBDIQ1(9000010.14,+$P(APCH(1),U,4),.01)_" "_$$FMTE^XLFDT($P(APCH(1),U))
Q "No"
BHSDMPR1 ;IHS/CIA/MGH - Health Summary for Pre-Diabetic Supplement ;19-Jun-2008 12:37;MGH
+1 ;;1.0;HEALTH SUMMARY COMPONENTS;**1,2**;Mar 17,2006
+2 ;====================================================================
+3 ; IHS/TUCSON/LAB - DIABETIC CARE SUMMARY SUPPLEMENT ;07-Jul-2006 16:02;MGH
+4 ;;2.0;IHS RPMS/PCC Health Summary;**3,5,6,7,8,9,10,11,12,14**;JUN 24, 1997
+5 ;IHS/CMI/LAB patch 3 - patch 3 fixes various problems
+6 ;Copied from APCHS9B2
+7 ;======================================================================
+8 ;
+9 ;
MORE ;EP
+1 NEW X,BHSX,BHSY,BHSIEN,V,Y
+2 SET BHSBEG=$$FMADD^XLFDT(DT,-(6*30))
+3 SET X="On Metformin: "_$$MET(BHSDFN,BHSBEG,DT)
DO S(X,1)
+4 SET X="On TZD: "_$$TROG(BHSDFN,BHSBEG,DT)
DO S(X)
+5 SET X="On Acarbose: "_$$ACAR(BHSDFN,BHSBEG,DT)
DO S(X)
+6 SET X="On Lipid Lowering Drugs: "_$$LLOW(BHSDFN,BHSBEG,DT)
DO S(X)
+7 SET BHSX=$$STATIN(BHSDFN,BHSBEG,DT)
IF $EXTRACT(BHSX,1,3)="Yes"
SET X=" :"_BHSX
DO S(X)
+8 SET X="Laboratory Results (most recent):"
DO S(X,1)
+9 SET X="Last Fasting Glucose:"
SET Y=$$FGLUCOSE(BHSDFN)
SET $EXTRACT(X,28)=$PIECE(Y,"|||")
SET $EXTRACT(X,42)=$PIECE(Y,"|||",2)
SET $EXTRACT(X,56)=$PIECE(Y,"|||",3)
DO S(X)
+10 SET X="Last 75 GM 2 hour Glucose:"
SET Y=$$GM75(BHSDFN)
SET $EXTRACT(X,28)=$PIECE(Y,"|||")
SET $EXTRACT(X,42)=$PIECE(Y,"|||",2)
SET $EXTRACT(X,56)=$PIECE(Y,"|||",3)
DO S(X)
+11 SET X="Total Cholesterol:"
SET Y=$$TCHOL^BHSDM2(BHSDFN)
SET $EXTRACT(X,28)=$PIECE(Y,"|||")
SET $EXTRACT(X,42)=$PIECE(Y,"|||",2)
SET $EXTRACT(X,56)=$PIECE(Y,"|||",3)
DO S(X,1)
+12 SET X=" LDL Cholesterol:"
SET Y=$$CHOL^BHSDM2(BHSDFN)
SET $EXTRACT(X,28)=$PIECE(Y,"|||")
SET $EXTRACT(X,42)=$PIECE(Y,"|||",2)
SET $EXTRACT(X,56)=$PIECE(Y,"|||",3)
DO S(X)
+13 SET V=$PIECE(Y,"|||")
IF V'=+V
Begin DoDot:1
+14 ;get last 3 and display next most recent 2
+15 SET BHSIEN=$PIECE(Y,"|||",4)
+16 SET T=$ORDER(^ATXLAB("B","DM AUDIT LDL CHOLESTEROL TAX",0))
DO LDLLAB^BHSDM2
+17 IF $DATA(BHSX)
SET X=" Next most recent LDL values:"
DO S(X)
+18 SET BHSY=0
FOR
SET BHSY=$ORDER(BHSX(BHSY))
IF BHSY'=+BHSY
QUIT
SET X=""
SET $EXTRACT(X,28)=$PIECE(BHSX(BHSY),U)
SET $EXTRACT(X,42)=$$FMTE^XLFDT($PIECE(BHSX(BHSY),U,2))
DO S(X)
End DoDot:1
+19 SET X=" HDL Cholesterol:"
SET Y=$$HDL^BHSDM2(BHSDFN)
SET $EXTRACT(X,28)=$PIECE(Y,"|||")
SET $EXTRACT(X,42)=$PIECE(Y,"|||",2)
SET $EXTRACT(X,56)=$PIECE(Y,"|||",3)
DO S(X)
+20 SET X=" Triglycerides:"
SET Y=$$TRIG^BHSDM2(BHSDFN)
SET $EXTRACT(X,28)=$PIECE(Y,"|||")
SET $EXTRACT(X,42)=$PIECE(Y,"|||",2)
SET $EXTRACT(X,56)=$PIECE(Y,"|||",3)
DO S(X)
+21 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,L
+4 ;blank lines
+5 FOR F=1:1:F
SET X=""
DO S1
+6 SET X=Y
+7 IF $GET(C)
SET L=$LENGTH(Y)
SET T=(80-L)/2
Begin DoDot:1
+8 FOR %=1:1:(T-1)
SET X=" "_X
End DoDot:1
DO S1
QUIT
+9 FOR %=1:1:T
SET X=" "_Y
+10 DO S1
+11 QUIT
S1 ;
+1 SET %=$PIECE(^TMP("BHS",$JOB,"DCS",0),U)+1
SET $PIECE(^TMP("BHS",$JOB,"DCS",0),U)=%
+2 SET ^TMP("BHS",$JOB,"DCS",%)=X
+3 QUIT
EDUC ;gather up all education provided in past year in APCHX
+1 KILL APCHX,APCHY
SET %=BHSDFN_"^ALL EDUC;DURING "_$$FMTE^XLFDT($$FMADD^XLFDT(DT,-365))_"-"_$$FMTE^XLFDT(DT)
SET E=$$START1^APCLDF(%,"APCHY(")
+2 IF '$DATA(APCHY)
SET APCHX(1)=" <No Education Topics recorded in past year>"
KILL APCHY
QUIT
+3 NEW X,APCHP
KILL APCHP
SET X=0
SET E=""
FOR
SET X=$ORDER(APCHY(X))
IF X'=+X
QUIT
SET E=+$PIECE(APCHY(X),U,4)
SET E=$PIECE(^AUPNVPED(E,0),U)
IF $$EDT(E)
SET APCHP($PIECE(APCHY(X),U,2))=$$FMTE^XLFDT($PIECE(APCHY(X),U))
+4 SET %=0
SET E=""
FOR
SET E=$ORDER(APCHP(E))
IF E=""
QUIT
SET %=%+1
SET APCHX(%)=E
SET $EXTRACT(APCHX(%),25)=APCHP(E)
+5 KILL APCHY,APCHP
+6 QUIT
EDT(E) ;
+1 ;is this ien in any taxonomy
+2 NEW T
+3 SET T=$ORDER(^ATXAX("B","DM AUDIT DIABETES EDUC TOPICS",0))
+4 IF T
IF $DATA(^ATXAX(T,21,"B",E))
QUIT 1
+5 SET T=$ORDER(^ATXAX("B","DM AUDIT DIET EDUC TOPICS",0))
+6 IF T
IF $DATA(^ATXAX(T,21,"B",E))
QUIT 1
+7 SET T=$ORDER(^ATXAX("B","DM AUDIT EXERCISE EDUC TOPICS",0))
+8 IF T
IF $DATA(^ATXAX(T,21,"B",E))
QUIT 1
+9 SET T=$ORDER(^ATXAX("B","DM AUDIT OTHER EDUC TOPICS",0))
+10 IF T
IF $DATA(^ATXAX(T,21,"B",E))
QUIT 1
+11 SET T=$PIECE(^AUTTEDT(E,0),U)
+12 IF $PIECE(T,"-")="DM"
QUIT 1
+13 IF $PIECE(T,"-")="DMC"
QUIT 1
+14 QUIT ""
FGLUCOSE(P) ;
+1 NEW LT
+2 IF '$GET(P)
QUIT ""
+3 NEW T
SET T=$ORDER(^ATXLAB("B","DM AUDIT FASTING GLUCOSE TESTS",0))
SET LT="DM AUDIT FASTING GLUC LOINC"
IF 'T
QUIT "<Taxonomy Missing>"
+4 QUIT $$LAB^BHSDM2(P,T,LT)
GM75(P) ;
+1 IF '$GET(P)
QUIT ""
+2 NEW T
SET T=$ORDER(^ATXLAB("B","DM AUDIT 75GM 2HR GLUCOSE",0))
SET LT="DM AUDIT 75GM 2HR GLUC LOINC"
IF 'T
QUIT "<Taxonomy Missing>"
+3 QUIT $$LAB^BHSDM2(P,T,LT)
DATE(D) ;EP - convert to slashed date
+1 IF $GET(D)=""
QUIT ""
+2 QUIT $EXTRACT(D,4,5)_"/"_$EXTRACT(D,6,7)_"/"_$EXTRACT(D,2,3)
LLOW(P,BDATE,EDATE) ;EP
+1 NEW X,APCH,E
+2 SET X=P_"^LAST MEDS [DM AUDIT LIPID LOWERING DRUGS"_";DURING "_BDATE_"-"_EDATE
SET E=$$START1^APCLDF(X,"APCH(")
+3 IF $DATA(APCH(1))
QUIT "Yes - "_$$VAL^XBDIQ1(9000010.14,+$PIECE(APCH(1),U,4),.01)_" "_$$FMTE^XLFDT($PIECE(APCH(1),U))
+4 QUIT "No"
+5 ;
STATIN(P,BDATE,EDATE) ;EP
+1 NEW X,APCH,E
+2 SET X=P_"^LAST MEDS [DM AUDIT STATIN DRUGS"_";DURING "_BDATE_"-"_EDATE
SET E=$$START1^APCLDF(X,"APCH(")
+3 IF $DATA(APCH(1))
QUIT "Yes - "_$$VAL^XBDIQ1(9000010.14,+$PIECE(APCH(1),U,4),.01)_" "_$$FMTE^XLFDT($PIECE(APCH(1),U))
+4 QUIT "No"
MET(P,BDATE,EDATE) ;EP
+1 NEW X,APCH,E
+2 SET X=P_"^LAST MEDS [DM AUDIT METFORMIN DRUGS"_";DURING "_BDATE_"-"_EDATE
SET E=$$START1^APCLDF(X,"APCH(")
+3 IF $DATA(APCH(1))
QUIT "Yes - "_$$VAL^XBDIQ1(9000010.14,+$PIECE(APCH(1),U,4),.01)_" "_$$FMTE^XLFDT($PIECE(APCH(1),U))
+4 QUIT "No"
+5 ;
ACAR(P,BDATE,EDATE) ;EP
+1 NEW X,APCH,E
+2 SET X=P_"^LAST MEDS [DM AUDIT ACARBOSE DRUGS"_";DURING "_BDATE_"-"_EDATE
SET E=$$START1^APCLDF(X,"APCH(")
+3 IF $DATA(APCH(1))
QUIT "Yes - "_$$VAL^XBDIQ1(9000010.14,+$PIECE(APCH(1),U,4),.01)_" "_$$FMTE^XLFDT($PIECE(APCH(1),U))
+4 QUIT "No"
+5 ;
TROG(P,BDATE,EDATE) ;EP
+1 NEW X,APCH,E
+2 IF '$ORDER(^ATXAX("B","DM AUDIT GLITAZONE DRUGS",0))
QUIT $$TROG1(P,BDATE,EDATE)
+3 SET X=P_"^LAST MEDS [DM AUDIT GLITAZONE DRUGS"_";DURING "_BDATE_"-"_EDATE
SET E=$$START1^APCLDF(X,"APCH(")
+4 IF $DATA(APCH(1))
QUIT "Yes - "_$$VAL^XBDIQ1(9000010.14,+$PIECE(APCH(1),U,4),.01)_" "_$$FMTE^XLFDT($PIECE(APCH(1),U))
+5 QUIT "No"
TROG1(P,BDATE,EDATE) ;EP
+1 NEW X,APCH,E
+2 SET X=P_"^LAST MEDS [DM AUDIT TROGLITAZONE DRUGS"_";DURING "_BDATE_"-"_EDATE
SET E=$$START1^APCLDF(X,"APCH(")
+3 IF $DATA(APCH(1))
QUIT "Yes - "_$$VAL^XBDIQ1(9000010.14,+$PIECE(APCH(1),U,4),.01)_" "_$$FMTE^XLFDT($PIECE(APCH(1),U))
+4 QUIT "No"
