Routine: BDMD211

BDMD211 ; IHS/CMI/LAB -IHS -CUMULATIVE REPORT ;

 ;;2.0;DIABETES MANAGEMENT SYSTEM;**2**;JUN 14, 2007

IMM ;

 S:'$D(BDMCUML(140)) BDMCUML(140)="IMMUNIZATIONS"

 S $P(BDMCUML(140),U,2)=$P(BDMCUML(140),U,2)+1

 S V=$G(^XTMP("BDMDM21",BDMJOB,BDMBTH,"AUDIT",BDMPD,64))

 I $E(V)="Y" S $P(BDMCUML(140),U,3)=$P(BDMCUML(140),U,3)+1

 I $E(V)="R" S $P(BDMCUML(140),U,6)=$P(BDMCUML(140),U,6)+1

 S V=$G(^XTMP("BDMDM21",BDMJOB,BDMBTH,"AUDIT",BDMPD,66))

 I $E(V)="Y" S $P(BDMCUML(140),U,4)=$P(BDMCUML(140),U,4)+1

 I $E(V)="R" S $P(BDMCUML(140),U,7)=$P(BDMCUML(140),U,7)+1

 S V=$G(^XTMP("BDMDM21",BDMJOB,BDMBTH,"AUDIT",BDMPD,68))

 I $E(V)="Y" S $P(BDMCUML(140),U,5)=$P(BDMCUML(140),U,5)+1

 I $E(V)="R" S $P(BDMCUML(140),U,8)=$P(BDMCUML(140),U,8)+1

URIN ;

 ;title^total^total with urinalysis^protein present^protein absent^protein not done^micro present^micro absent^micro not done

 ;145

 S:'$D(BDMCUML(145)) BDMCUML(145)="URINALYSIS"

 S $P(BDMCUML(145),U,2)=$P(BDMCUML(145),U,2)+1

 S V=$G(^XTMP("BDMDM21",BDMJOB,BDMBTH,"AUDIT",BDMPD,92))

 S A=$G(^XTMP("BDMDM21",BDMJOB,BDMBTH,"AUDIT",BDMPD,94))

 I $E(V)="Y" S $P(BDMCUML(145),U,3)=$P(BDMCUML(145),U,3)+1

 I $E(A)="Y" S $P(BDMCUML(145),U,4)=$P(BDMCUML(145),U,4)+1

 I A["No result" S $P(BDMCUML(145),U,6)=$P(BDMCUML(145),U,6)+1 G EKG

 I $E(A)="N" S $P(BDMCUML(145),U,5)=$P(BDMCUML(145),U,5)+1 D

 .S V=$G(^XTMP("BDMDM21",BDMJOB,BDMBTH,"AUDIT",BDMPD,96))

 .I $E(V,1,3)="Pos" S $P(BDMCUML(145),U,7)=$P(BDMCUML(145),U,7)+1 Q

 .I $E(V,1,3)="Neg" S $P(BDMCUML(145),U,8)=$P(BDMCUML(145),U,8)+1 Q

 .S $P(BDMCUML(145),U,9)=$P(BDMCUML(145),U,9)+1

.Q

EKG ;need date of last ekg

 S:'$D(BDMCUML(150)) BDMCUML(150)="EKG"

 S $P(BDMCUML(150),U,2)=$P(BDMCUML(150),U,2)+1

 S V=$$EKG^BDMD212(BDMPD,BDMRED,"I")

 I V]"" D

 .S E=$$FMDIFF^XLFDT(BDMADAT,V)

 .I E<(365.25*3) S $P(BDMCUML(150),U,3)=$P(BDMCUML(150),U,3)+1

 .I E<(365.25*5) S $P(BDMCUML(150),U,4)=$P(BDMCUML(150),U,4)+1

 .S $P(BDMCUML(150),U,5)=$P(BDMCUML(150),U,5)+1

CREAT ;

 S:'$D(BDMCUML(170)) BDMCUML(170)="Creatinine obtained in the past 12 months"

 S $P(BDMCUML(170),U,2)=$P(BDMCUML(170),U,2)+1

 S V=$$CREAT^BDMD218(BDMPD,BDMRBD,BDMRED,"I")

 I V="" S $P(BDMCUML(170),U,5)=$P(BDMCUML(170),U,5)+1 G TCHOL

 S V=$P(V,U)

 I $E(V)'=+$E(V),$E(V)'="." S $P(BDMCUML(170),U,6)=$P(BDMCUML(170),U,6)+1 G TCHOL ;unable to determine result, not a number

 I V>1.9 S $P(BDMCUML(170),U,3)=$P(BDMCUML(170),U,3)+1

 I V<2.0 S $P(BDMCUML(170),U,4)=$P(BDMCUML(170),U,4)+1

TCHOL ;

 S:'$D(BDMCUML(180)) BDMCUML(180)="Total Cholesterol obtained in past 12 months"

 S $P(BDMCUML(180),U,2)=$P(BDMCUML(180),U,2)+1

 S V=$$CHOL^BDMD218(BDMPD,BDMRBD,BDMRED,"I")

 I V="" S $P(BDMCUML(180),U,6)=$P(BDMCUML(180),U,6)+1 G LDL

 S V=$P(V,U)

 I $E(V)'=+$E(V) S $P(BDMCUML(180),U,7)=$P(BDMCUML(180),U,7)+1 G LDL ;unable to determine result, not a number or is blank

 I V<200 S $P(BDMCUML(180),U,3)=$P(BDMCUML(180),U,3)+1

 I V<240&(V>199) S $P(BDMCUML(180),U,4)=$P(BDMCUML(180),U,4)+1

 I V>239 S $P(BDMCUML(180),U,5)=$P(BDMCUML(180),U,5)+1

LDL ;

 S:'$D(BDMCUML(190)) BDMCUML(190)="LDL Cholesterol obtained in the past 12 months"

 S $P(BDMCUML(190),U,2)=$P(BDMCUML(190),U,2)+1

 S V=$$LDL^BDMD218(BDMPD,BDMRBD,BDMRED,"I")

 I V="" S $P(BDMCUML(190),U,7)=$P(BDMCUML(190),U,7)+1 G HDL

 S V=$P(V,U)

 I $E(V)'=+$E(V) S $P(BDMCUML(190),U,8)=$P(BDMCUML(190),U,8)+1 G HDL ;unable to determine result, not a number or blank

 I V<100 S $P(BDMCUML(190),U,3)=$P(BDMCUML(190),U,3)+1

 I V<130&(V>99) S $P(BDMCUML(190),U,4)=$P(BDMCUML(190),U,4)+1

 I V>129&(V<161) S $P(BDMCUML(190),U,5)=$P(BDMCUML(190),U,5)+1

 I V>160 S $P(BDMCUML(190),U,6)=$P(BDMCUML(190),U,6)+1

HDL ;

 S:'$D(BDMCUML(195)) BDMCUML(195)="HDL Cholesterol obtained in the past 12 months"

 S $P(BDMCUML(195),U,2)=$P(BDMCUML(195),U,2)+1

 S V=$$HDL^BDMD218(BDMPD,BDMRBD,BDMRED,"I")

 I V="" S $P(BDMCUML(195),U,7)=$P(BDMCUML(195),U,7)+1 G TRIG

 S V=$P(V,U)

 I $E(V)'=+$E(V) S $P(BDMCUML(195),U,8)=$P(BDMCUML(195),U,8)+1 G TRIG ;unable to determine result, not a number

 I V<35 S $P(BDMCUML(195),U,3)=$P(BDMCUML(195),U,3)+1

 I V<46&(V>34) S $P(BDMCUML(195),U,4)=$P(BDMCUML(195),U,4)+1

 I V>45&(V<56) S $P(BDMCUML(195),U,5)=$P(BDMCUML(195),U,5)+1

 I V>55 S $P(BDMCUML(195),U,6)=$P(BDMCUML(195),U,6)+1

TRIG ;

 S:'$D(BDMCUML(200)) BDMCUML(200)="Triglycerides obtained in past 12 months"

 S $P(BDMCUML(200),U,2)=$P(BDMCUML(200),U,2)+1

 S V=$$TRIG^BDMD218(BDMPD,BDMRBD,BDMRED,"I")

 I V="" S $P(BDMCUML(200),U,7)=$P(BDMCUML(200),U,7)+1 G SELF

 S V=$P(V,U)

 I $E(V)'=+$E(V) S $P(BDMCUML(200),U,8)=$P(BDMCUML(200),U,8)+1 G SELF ;unable to determine result, not a number

 I V<150 S $P(BDMCUML(200),U,3)=$P(BDMCUML(200),U,3)+1

 I V<200&(V>149) S $P(BDMCUML(200),U,4)=$P(BDMCUML(200),U,4)+1

 I V>199&(V<401) S $P(BDMCUML(200),U,5)=$P(BDMCUML(200),U,5)+1

 I V>400 S $P(BDMCUML(200),U,6)=$P(BDMCUML(200),U,6)+1

SELF ;

 S:'$D(BDMCUML(210)) BDMCUML(210)="Self monitoring of blood glucose documented"

 S $P(BDMCUML(210),U,2)=$P(BDMCUML(210),U,2)+1

 S V=$G(^XTMP("BDMDM21",BDMJOB,BDMBTH,"AUDIT",BDMPD,98))

 S P=$S($E(V)="Y":3,$E(V)="N":4,$E(V)="R":5,1:6)

 S $P(BDMCUML(210),U,P)=$P(BDMCUML(210),U,P)+1

SDM  ;

 S:'$D(BDMCUML(220)) BDMCUML(220)="Participating in SDM"

 S $P(BDMCUML(220),U,2)=$P(BDMCUML(220),U,2)+1

 S V=$G(^XTMP("BDMDM21",BDMJOB,BDMBTH,"AUDIT",BDMPD,100))

 S P=$S($E(V)="Y":3,1:4)

 S $P(BDMCUML(220),U,P)=$P(BDMCUML(220),U,P)+1

CESS(P,B,D) ;EP - find any cessation hf in 12 months before E

 I '$G(P) Q ""

 NEW BDM,E,X,G,T

 K BDM

 S X=P_"^LAST HEALTH [DM AUDIT CESSATION HLTH FACTOR;DURING "_B_"-"_D S E=$$START1^APCLDF(X,"BDM(")

 I $D(BDM(1)) Q "Yes-"_$$FMTE^XLFDT($P(BDM(1),U))

 S X=P_"^EDUC [DM AUDIT SMOKING CESS EDUC;DURING "_B_"-"_D S E=$$START1^APCLDF(X,"BDM(")

 I $D(BDM(1)) Q "Yes-"_$$FMTE^XLFDT($P(BDM(1),U))

 NEW T S T=$O(^ATXAX("B","DM AUDIT SMOKING CESS EDUC",0))

 I 'T Q "No"

 S (X,G)=0 F  S X=$O(^ATXAX(T,21,X)) Q:X'=+X!(G)  I $$REFUSAL^BDMD217(P,9999999.09,$P(^ATXAX(T,21,X,0),U),B,D) S G=1

 I G Q "Refused"

 Q "No"

BDMD211   ; IHS/CMI/LAB -IHS -CUMULATIVE REPORT ;

 +1       ;;2.0;DIABETES MANAGEMENT SYSTEM;**2**;JUN 14, 2007

 +2       ;

 +3       ;

IMM       ;

 +1        IF '$DATA(BDMCUML(140))

               SET BDMCUML(140)="IMMUNIZATIONS"

 +2        SET $PIECE(BDMCUML(140),U,2)=$PIECE(BDMCUML(140),U,2)+1

 +3        SET V=$GET(^XTMP("BDMDM21",BDMJOB,BDMBTH,"AUDIT",BDMPD,64))

 +4        IF $EXTRACT(V)="Y"

               SET $PIECE(BDMCUML(140),U,3)=$PIECE(BDMCUML(140),U,3)+1

 +5        IF $EXTRACT(V)="R"

               SET $PIECE(BDMCUML(140),U,6)=$PIECE(BDMCUML(140),U,6)+1

 +6        SET V=$GET(^XTMP("BDMDM21",BDMJOB,BDMBTH,"AUDIT",BDMPD,66))

 +7        IF $EXTRACT(V)="Y"

               SET $PIECE(BDMCUML(140),U,4)=$PIECE(BDMCUML(140),U,4)+1

 +8        IF $EXTRACT(V)="R"

               SET $PIECE(BDMCUML(140),U,7)=$PIECE(BDMCUML(140),U,7)+1

 +9        SET V=$GET(^XTMP("BDMDM21",BDMJOB,BDMBTH,"AUDIT",BDMPD,68))

 +10       IF $EXTRACT(V)="Y"

               SET $PIECE(BDMCUML(140),U,5)=$PIECE(BDMCUML(140),U,5)+1

 +11       IF $EXTRACT(V)="R"

               SET $PIECE(BDMCUML(140),U,8)=$PIECE(BDMCUML(140),U,8)+1

URIN      ;

 +1       ;title^total^total with urinalysis^protein present^protein absent^protein not done^micro present^micro absent^micro not done

 +2       ;145

 +3        IF '$DATA(BDMCUML(145))

               SET BDMCUML(145)="URINALYSIS"

 +4        SET $PIECE(BDMCUML(145),U,2)=$PIECE(BDMCUML(145),U,2)+1

 +5        SET V=$GET(^XTMP("BDMDM21",BDMJOB,BDMBTH,"AUDIT",BDMPD,92))

 +6        SET A=$GET(^XTMP("BDMDM21",BDMJOB,BDMBTH,"AUDIT",BDMPD,94))

 +7        IF $EXTRACT(V)="Y"

               SET $PIECE(BDMCUML(145),U,3)=$PIECE(BDMCUML(145),U,3)+1

 +8        IF $EXTRACT(A)="Y"

               SET $PIECE(BDMCUML(145),U,4)=$PIECE(BDMCUML(145),U,4)+1

 +9        IF A["No result"

               SET $PIECE(BDMCUML(145),U,6)=$PIECE(BDMCUML(145),U,6)+1

               GOTO EKG

 +10       IF $EXTRACT(A)="N"

               SET $PIECE(BDMCUML(145),U,5)=$PIECE(BDMCUML(145),U,5)+1

               Begin DoDot:1

 +11               SET V=$GET(^XTMP("BDMDM21",BDMJOB,BDMBTH,"AUDIT",BDMPD,96))

 +12               IF $EXTRACT(V,1,3)="Pos"

                       SET $PIECE(BDMCUML(145),U,7)=$PIECE(BDMCUML(145),U,7)+1

                       QUIT

 +13               IF $EXTRACT(V,1,3)="Neg"

                       SET $PIECE(BDMCUML(145),U,8)=$PIECE(BDMCUML(145),U,8)+1

                       QUIT

 +14               SET $PIECE(BDMCUML(145),U,9)=$PIECE(BDMCUML(145),U,9)+1

 +15               QUIT

               End DoDot:1

EKG       ;need date of last ekg

 +1        IF '$DATA(BDMCUML(150))

               SET BDMCUML(150)="EKG"

 +2        SET $PIECE(BDMCUML(150),U,2)=$PIECE(BDMCUML(150),U,2)+1

 +3        SET V=$$EKG^BDMD212(BDMPD,BDMRED,"I")

 +4        IF V]""

               Begin DoDot:1

 +5                SET E=$$FMDIFF^XLFDT(BDMADAT,V)

 +6                IF E<(365.25*3)

                       SET $PIECE(BDMCUML(150),U,3)=$PIECE(BDMCUML(150),U,3)+1

 +7                IF E<(365.25*5)

                       SET $PIECE(BDMCUML(150),U,4)=$PIECE(BDMCUML(150),U,4)+1

 +8                SET $PIECE(BDMCUML(150),U,5)=$PIECE(BDMCUML(150),U,5)+1

               End DoDot:1

CREAT     ;

 +1        IF '$DATA(BDMCUML(170))

               SET BDMCUML(170)="Creatinine obtained in the past 12 months"

 +2        SET $PIECE(BDMCUML(170),U,2)=$PIECE(BDMCUML(170),U,2)+1

 +3        SET V=$$CREAT^BDMD218(BDMPD,BDMRBD,BDMRED,"I")

 +4        IF V=""

               SET $PIECE(BDMCUML(170),U,5)=$PIECE(BDMCUML(170),U,5)+1

               GOTO TCHOL

 +5        SET V=$PIECE(V,U)

 +6       ;unable to determine result, not a number

           IF $EXTRACT(V)'=+$EXTRACT(V)

               IF $EXTRACT(V)'="."

                   SET $PIECE(BDMCUML(170),U,6)=$PIECE(BDMCUML(170),U,6)+1

                   GOTO TCHOL

 +7        IF V>1.9

               SET $PIECE(BDMCUML(170),U,3)=$PIECE(BDMCUML(170),U,3)+1

 +8        IF V<2.0

               SET $PIECE(BDMCUML(170),U,4)=$PIECE(BDMCUML(170),U,4)+1

TCHOL     ;

 +1        IF '$DATA(BDMCUML(180))

               SET BDMCUML(180)="Total Cholesterol obtained in past 12 months"

 +2        SET $PIECE(BDMCUML(180),U,2)=$PIECE(BDMCUML(180),U,2)+1

 +3        SET V=$$CHOL^BDMD218(BDMPD,BDMRBD,BDMRED,"I")

 +4        IF V=""

               SET $PIECE(BDMCUML(180),U,6)=$PIECE(BDMCUML(180),U,6)+1

               GOTO LDL

 +5        SET V=$PIECE(V,U)

 +6       ;unable to determine result, not a number or is blank

           IF $EXTRACT(V)'=+$EXTRACT(V)

               SET $PIECE(BDMCUML(180),U,7)=$PIECE(BDMCUML(180),U,7)+1

               GOTO LDL

 +7        IF V<200

               SET $PIECE(BDMCUML(180),U,3)=$PIECE(BDMCUML(180),U,3)+1

 +8        IF V<240&(V>199)

               SET $PIECE(BDMCUML(180),U,4)=$PIECE(BDMCUML(180),U,4)+1

 +9        IF V>239

               SET $PIECE(BDMCUML(180),U,5)=$PIECE(BDMCUML(180),U,5)+1

LDL       ;

 +1        IF '$DATA(BDMCUML(190))

               SET BDMCUML(190)="LDL Cholesterol obtained in the past 12 months"

 +2        SET $PIECE(BDMCUML(190),U,2)=$PIECE(BDMCUML(190),U,2)+1

 +3        SET V=$$LDL^BDMD218(BDMPD,BDMRBD,BDMRED,"I")

 +4        IF V=""

               SET $PIECE(BDMCUML(190),U,7)=$PIECE(BDMCUML(190),U,7)+1

               GOTO HDL

 +5        SET V=$PIECE(V,U)

 +6       ;unable to determine result, not a number or blank

           IF $EXTRACT(V)'=+$EXTRACT(V)

               SET $PIECE(BDMCUML(190),U,8)=$PIECE(BDMCUML(190),U,8)+1

               GOTO HDL

 +7        IF V<100

               SET $PIECE(BDMCUML(190),U,3)=$PIECE(BDMCUML(190),U,3)+1

 +8        IF V<130&(V>99)

               SET $PIECE(BDMCUML(190),U,4)=$PIECE(BDMCUML(190),U,4)+1

 +9        IF V>129&(V<161)

               SET $PIECE(BDMCUML(190),U,5)=$PIECE(BDMCUML(190),U,5)+1

 +10       IF V>160

               SET $PIECE(BDMCUML(190),U,6)=$PIECE(BDMCUML(190),U,6)+1

HDL       ;

 +1        IF '$DATA(BDMCUML(195))

               SET BDMCUML(195)="HDL Cholesterol obtained in the past 12 months"

 +2        SET $PIECE(BDMCUML(195),U,2)=$PIECE(BDMCUML(195),U,2)+1

 +3        SET V=$$HDL^BDMD218(BDMPD,BDMRBD,BDMRED,"I")

 +4        IF V=""

               SET $PIECE(BDMCUML(195),U,7)=$PIECE(BDMCUML(195),U,7)+1

               GOTO TRIG

 +5        SET V=$PIECE(V,U)

 +6       ;unable to determine result, not a number

           IF $EXTRACT(V)'=+$EXTRACT(V)

               SET $PIECE(BDMCUML(195),U,8)=$PIECE(BDMCUML(195),U,8)+1

               GOTO TRIG

 +7        IF V<35

               SET $PIECE(BDMCUML(195),U,3)=$PIECE(BDMCUML(195),U,3)+1

 +8        IF V<46&(V>34)

               SET $PIECE(BDMCUML(195),U,4)=$PIECE(BDMCUML(195),U,4)+1

 +9        IF V>45&(V<56)

               SET $PIECE(BDMCUML(195),U,5)=$PIECE(BDMCUML(195),U,5)+1

 +10       IF V>55

               SET $PIECE(BDMCUML(195),U,6)=$PIECE(BDMCUML(195),U,6)+1

TRIG      ;

 +1        IF '$DATA(BDMCUML(200))

               SET BDMCUML(200)="Triglycerides obtained in past 12 months"

 +2        SET $PIECE(BDMCUML(200),U,2)=$PIECE(BDMCUML(200),U,2)+1

 +3        SET V=$$TRIG^BDMD218(BDMPD,BDMRBD,BDMRED,"I")

 +4        IF V=""

               SET $PIECE(BDMCUML(200),U,7)=$PIECE(BDMCUML(200),U,7)+1

               GOTO SELF

 +5        SET V=$PIECE(V,U)

 +6       ;unable to determine result, not a number

           IF $EXTRACT(V)'=+$EXTRACT(V)

               SET $PIECE(BDMCUML(200),U,8)=$PIECE(BDMCUML(200),U,8)+1

               GOTO SELF

 +7        IF V<150

               SET $PIECE(BDMCUML(200),U,3)=$PIECE(BDMCUML(200),U,3)+1

 +8        IF V<200&(V>149)

               SET $PIECE(BDMCUML(200),U,4)=$PIECE(BDMCUML(200),U,4)+1

 +9        IF V>199&(V<401)

               SET $PIECE(BDMCUML(200),U,5)=$PIECE(BDMCUML(200),U,5)+1

 +10       IF V>400

               SET $PIECE(BDMCUML(200),U,6)=$PIECE(BDMCUML(200),U,6)+1

SELF      ;

 +1        IF '$DATA(BDMCUML(210))

               SET BDMCUML(210)="Self monitoring of blood glucose documented"

 +2        SET $PIECE(BDMCUML(210),U,2)=$PIECE(BDMCUML(210),U,2)+1

 +3        SET V=$GET(^XTMP("BDMDM21",BDMJOB,BDMBTH,"AUDIT",BDMPD,98))

 +4        SET P=$SELECT($EXTRACT(V)="Y":3,$EXTRACT(V)="N":4,$EXTRACT(V)="R":5,1:6)

 +5        SET $PIECE(BDMCUML(210),U,P)=$PIECE(BDMCUML(210),U,P)+1

SDM       ;

 +1        IF '$DATA(BDMCUML(220))

               SET BDMCUML(220)="Participating in SDM"

 +2        SET $PIECE(BDMCUML(220),U,2)=$PIECE(BDMCUML(220),U,2)+1

 +3        SET V=$GET(^XTMP("BDMDM21",BDMJOB,BDMBTH,"AUDIT",BDMPD,100))

 +4        SET P=$SELECT($EXTRACT(V)="Y":3,1:4)

 +5        SET $PIECE(BDMCUML(220),U,P)=$PIECE(BDMCUML(220),U,P)+1

 +6        QUIT

CESS(P,B,D) ;EP - find any cessation hf in 12 months before E

 +1        IF '$GET(P)

               QUIT ""

 +2        NEW BDM,E,X,G,T

 +3        KILL BDM

 +4        SET X=P_"^LAST HEALTH [DM AUDIT CESSATION HLTH FACTOR;DURING "_B_"-"_D

           SET E=$$START1^APCLDF(X,"BDM(")

 +5        IF $DATA(BDM(1))

               QUIT "Yes-"_$$FMTE^XLFDT($PIECE(BDM(1),U))

 +6        SET X=P_"^EDUC [DM AUDIT SMOKING CESS EDUC;DURING "_B_"-"_D

           SET E=$$START1^APCLDF(X,"BDM(")

 +7        IF $DATA(BDM(1))

               QUIT "Yes-"_$$FMTE^XLFDT($PIECE(BDM(1),U))

 +8        NEW T

           SET T=$ORDER(^ATXAX("B","DM AUDIT SMOKING CESS EDUC",0))

 +9        IF 'T

               QUIT "No"

 +10       SET (X,G)=0

FOR

               SET X=$ORDER(^ATXAX(T,21,X))

               IF X'=+X!(G)

                   QUIT

               IF $$REFUSAL^BDMD217(P,9999999.09,$PIECE(^ATXAX(T,21,X,0),U),B,D)

                   SET G=1

 +11       IF G

               QUIT "Refused"

 +12       QUIT "No"

 +13      ;

BDMD211.m