Routine: BDMPF11

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

 ;;2.0;DIABETES MANAGEMENT SYSTEM;**11**;JUN 14, 2007;Build 30

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^BDMPF12(BDMPF,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

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^BDMDF18(BDMPF,BDMBDAT,BDMADAT,"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^BDMDF18(BDMPF,BDMBDAT,BDMADAT,"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^BDMDF18(BDMPF,BDMBDAT,BDMADAT,"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

 S V=$P(V,".")

 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^BDMDF18(BDMPF,BDMBDAT,BDMADAT,"I")

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

 S V=$P(V,U)

 I $E(V)'=+$E(V) S $P(BDMCUML(200),U,8)=$P(BDMCUML(200),U,8)+1 G FAST ;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

FAST ;

 S:'$D(BDMCUML(600)) BDMCUML(600)="Fasting Glucose obtained ever"

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

 S V=$$FGLUCOSE^BDMDF18(BDMPF,$P(^DPT(BDMPF,0),U,3),BDMADAT,"I")

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

 S V=$P(V,U)

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

 S $P(BDMCUML(600),U,3)=$P(BDMCUML(600),U,3)+1

G75 ;

 S:'$D(BDMCUML(610)) BDMCUML(610)="75gm 2 hour glucose obtained ever"

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

 S V=$$G75^BDMDF18(BDMPF,$P(^DPT(BDMPF,0),U,3),BDMADAT,"I")

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

 S V=$P(V,U)

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

 S $P(BDMCUML(610),U,3)=$P(BDMCUML(610),U,3)+1

END Q

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

 +1       ;;2.0;DIABETES MANAGEMENT SYSTEM;**11**;JUN 14, 2007;Build 30

 +2       ;

 +3       ;

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^BDMPF12(BDMPF,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

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^BDMDF18(BDMPF,BDMBDAT,BDMADAT,"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^BDMDF18(BDMPF,BDMBDAT,BDMADAT,"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^BDMDF18(BDMPF,BDMBDAT,BDMADAT,"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        SET V=$PIECE(V,".")

 +8        IF V<35

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

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

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

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

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

 +11       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^BDMDF18(BDMPF,BDMBDAT,BDMADAT,"I")

 +4        IF V=""

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

               GOTO FAST

 +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 FAST

 +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

FAST      ;

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

               SET BDMCUML(600)="Fasting Glucose obtained ever"

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

 +3        SET V=$$FGLUCOSE^BDMDF18(BDMPF,$PIECE(^DPT(BDMPF,0),U,3),BDMADAT,"I")

 +4        IF V=""

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

               GOTO G75

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

 +6       ;unable to determine result, not a number

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

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

               GOTO G75

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

G75       ;

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

               SET BDMCUML(610)="75gm 2 hour glucose obtained ever"

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

 +3        SET V=$$G75^BDMDF18(BDMPF,$PIECE(^DPT(BDMPF,0),U,3),BDMADAT,"I")

 +4        IF V=""

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

               GOTO END

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

 +6       ;unable to determine result, not a number

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

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

               GOTO END

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

END        QUIT

BDMPF11.m