BDMDR31.m

BDMDR31 ; IHS/CMI/LAB - patients dm list - chinle ;

 ;;2.0;DIABETES MANAGEMENT SYSTEM;**2,3,4,10**;JUN 14, 2007;Build 12

 ;

 ;

PRINT ;EP - called from xbdbque

 K BDMTHGB,BDMTBP,BDMTLDL,BDMFINL,BDMTHDL,BDMTTRIG,BDMTTC

 S BDMIOSL=$S($G(BDMGUI):55,1:IOSL)

 S BDMTHGB="",BDMTBP="",BDMTLDL="",BDMTHDL="",BDMTTRIG="",BDMTTC=""

 S BDMP=""

 S BDM80D="-------------------------------------------------------------------------------"

 S BDMPG=0

 I '$D(^XTMP("BDMDR3",BDMJOB,BDMBTH)) D HEAD W !!,"NO PATIENTS TO REPORT" G DONE

 S (BDMNAME,BDMP,BDMC)="" K BDMQ

 F  S BDMP=$O(^XTMP("BDMDR3",BDMJOB,BDMBTH,"PATIENTS",BDMP)) Q:BDMP=""!($D(BDMQ))  D

 .;D HEAD Q:$D(BDMQ)

 .S BDMCNT=0

 .K BDMSTOT S BDMC="" F  S BDMC=$O(^XTMP("BDMDR3",BDMJOB,BDMBTH,"PATIENTS",BDMP,BDMC)) Q:BDMC=""!($D(BDMQ))  D

 ..S BDMNAME="" F  S BDMNAME=$O(^XTMP("BDMDR3",BDMJOB,BDMBTH,"PATIENTS",BDMP,BDMC,BDMNAME)) Q:BDMNAME=""!($D(BDMQ))  D

 ...S DFN="" F  S DFN=$O(^XTMP("BDMDR3",BDMJOB,BDMBTH,"PATIENTS",BDMP,BDMC,BDMNAME,DFN)) Q:DFN'=+DFN!($D(BDMQ))  S BDMCNT=BDMCNT+1 D PRINT1

 .Q:$D(BDMQ)

 .D SUBTOT^BDMDR3

 I $D(BDMQ) G DONE

 D FINTOT^BDMDR3

 D DONE

 Q

PRINT1 ;

 S BDMP1=^XTMP("BDMDR3",BDMJOB,BDMBTH,"PATIENTS",BDMP,BDMC,BDMNAME,DFN)

 S BDMWR=1 I BDMPCP,BDMPCP'=BDMP1 S BDMWR=0

 I '$D(BDMTHGB(BDMP,BDMP1)) S BDMTHGB(BDMP,BDMP1)=""

 I '$D(BDMTBP(BDMP,BDMP1)) S BDMTBP(BDMP,BDMP1)=""

 I '$D(BDMTLDL(BDMP,BDMP1)) S BDMTLDL(BDMP,BDMP1)=""

 I '$D(BDMTHDL(BDMP,BDMP1)) S BDMTHDL(BDMP,BDMP1)=""

 I '$D(BDMTTRIG(BDMP,BDMP1)) S BDMTTRIG(BDMP,BDMP1)=""

 I '$D(BDMTTC(BDMP,BDMP1)) S BDMTTC(BDMP,BDMP1)=""

 I BDMWR,BDMCNT=1 D HEAD Q:$D(BDMQ)  I 1

 E  I BDMWR,$Y>(BDMIOSL-10) D HEAD Q:$D(BDMQ)

 S BDMSTOT(0)=$G(BDMSTOT(0))+1

 S BDMDOB=$$FMTE^XLFDT($P(^DPT(DFN,0),U,3))

 W:BDMWR !,$E(BDMNAME,1,25),?27,$$HRN^AUPNPAT(DFN,$S($G(BDMDUZ2):BDMDUZ2,1:DUZ(2))),?34,$$DOB^AUPNPAT(DFN,"E"),?47,BDMC

 W:BDMWR !?2,"Test",?22,"In Past 4 Months",?50,"Next most recent"

 W:BDMWR !?2,"----",?22,"----------------",?50,"----------------"

 S (BDMDMV1,BDMDMV2)="" D LASTDMV

 W:BDMWR !?2,"Last Clinic Visit"

 I BDMDMV1>BDMSD W:BDMWR ?22,$$DATE(BDMDMV1),?50,$$DATE(BDMDMV2) S BDMSTOT(1)=$G(BDMSTOT(1))+1 I 1

 E  W:BDMWR ?50,$$DATE(BDMDMV1)

 W:BDMWR !?2,"Blood Pressure (BP)"

 S (BDMDMV1,BDMDMV2)="" D LASTBP

 I $P(BDMDMV1,U)>BDMSD W:BDMWR ?22,$$DATE($P(BDMDMV1,U))_"  "_$P(BDMDMV1,U,2),?50,$$DATE($P(BDMDMV2,U))_"  "_$P(BDMDMV2,U,2) S BDMSTOT(2)=$G(BDMSTOT(2))+1 I 1

 E  W:BDMWR ?50,$$DATE($P(BDMDMV1,U))_"  "_$P(BDMDMV1,U,2)

 D BPS

HGB ;

 W:BDMWR !?2,"Hgb A1C"

 S (BDMDMV1,BDMDMV2)="" D LASTHBG

 I $P(BDMDMV1,U)>BDMSD W:BDMWR ?22,$$DATE($P(BDMDMV1,U))_"  "_$P(BDMDMV1,U,2),?50,$$DATE($P(BDMDMV2,U))_"  "_$P(BDMDMV2,U,2) S BDMSTOT(3)=$G(BDMSTOT(3))+1 I 1

 E  W:BDMWR ?50,$$DATE($P(BDMDMV1,U))_"  "_$P(BDMDMV1,U,2)

 D HGBS

TC ;

 W:BDMWR !?2,"Total Cholesterol"

 S (BDMDMV1,BDMDMV2)="" D LASTTC

 I $P(BDMDMV1,U)>BDMSD W:BDMWR ?22,$$DATE($P(BDMDMV1,U))_"  "_$P(BDMDMV1,U,2),?50,$$DATE($P(BDMDMV2,U))_"  "_$P(BDMDMV2,U,2) S BDMSTOT(4)=$G(BDMSTOT(4))+1 I 1

 E  W:BDMWR ?50,$$DATE($P(BDMDMV1,U))_"  "_$P(BDMDMV1,U,2)

 D TCS

LDL ;

 W:BDMWR !?2,"LDL Cholesterol"

 S (BDMDMV1,BDMDMV2)="" D LASTLDL

 I $P(BDMDMV1,U)>BDMSD W:BDMWR ?22,$$DATE($P(BDMDMV1,U))_"  "_$P(BDMDMV1,U,2),?50,$$DATE($P(BDMDMV2,U))_"  "_$P(BDMDMV2,U,2) S BDMSTOT(5)=$G(BDMSTOT(5))+1 I 1

 E  W:BDMWR ?50,$$DATE($P(BDMDMV1,U))_"  "_$P(BDMDMV1,U,2)

 D LDLS

HDL ;

 W:BDMWR !?2,"HDL Cholesterol"

 S (BDMDMV1,BDMDMV2)="" D LASTHDL

 I $P(BDMDMV1,U)>BDMSD W:BDMWR ?22,$$DATE($P(BDMDMV1,U))_"  "_$P(BDMDMV1,U,2),?50,$$DATE($P(BDMDMV2,U))_"  "_$P(BDMDMV2,U,2) S BDMSTOT(6)=$G(BDMSTOT(6))+1 I 1

 E  W:BDMWR ?50,$$DATE($P(BDMDMV1,U))_"  "_$P(BDMDMV1,U,2)

 ;W:BDMWR !

 D HDLS

TRIG ;

 W:BDMWR !?2,"Triglycerides"

 S (BDMDMV1,BDMDMV2)="" D LASTTRIG

 I $P(BDMDMV1,U)>BDMSD W:BDMWR ?22,$$DATE($P(BDMDMV1,U))_"  "_$P(BDMDMV1,U,2),?50,$$DATE($P(BDMDMV2,U))_"  "_$P(BDMDMV2,U,2) S BDMSTOT(7)=$G(BDMSTOT(7))+1 I 1

 E  W:BDMWR ?50,$$DATE($P(BDMDMV1,U))_"  "_$P(BDMDMV1,U,2)

 W:BDMWR !

 D TRIGS

 Q

DONE ;

 I $E(IOST)="C",IO=IO(0) S DIR(0)="EO",DIR("A")="End of report.  HIT RETURN" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 W:$D(IOF) @IOF

 K ^XTMP("BDMDR3",BDMJOB,BDMBTH),BDMJOB,BDMBTH

 Q

HEAD ;EP

 I 'BDMPG G HEAD1

 I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BDMQ="" Q

HEAD1 ;

 W:$D(IOF) @IOF S BDMPG=BDMPG+1

 I $G(BDMGUI),BDMPG'=1 W !,"ZZZZZZZ"

 W !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"

 W !,$P(^VA(200,DUZ,0),U,2),?72,"Page ",BDMPG,!

 W ?(80-$L($P(^DIC(4,$S($G(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0),U))/2),$P(^DIC(4,$S($G(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0),U),!

 S X="Patients on the "_$P(^ACM(41.1,BDMREG,0),U)_" Register     Status: "_$S($G(BDMSTAR)]"":BDMSTAR,1:"ALL") W $$CTR(X,80),!

 W $$CTR("As of Date: "_BDMEDD_$S($D(BDMFINL):"",1:"   Designated Provider: "_$G(BDMP)),80),!

 Q:$D(BDMFINL)

PIH I '$D(BDMSUB) W !,"PATIENT NAME",?27,"HRN",?34,"DOB",?47,"COMMUNITY",?62,!,BDM80D

 I $D(BDMSUB) W !,BDM80D

 Q

LASTDMV  ;EP - get last 2 dm clinic visits

 NEW V,D,C

 S C=0,D=0,V=0 F  S D=$O(^AUPNVSIT("AA",DFN,D)) Q:D'=+D!(C=2)  D

 .S V=0 F  S V=$O(^AUPNVSIT("AA",DFN,D,V)) Q:V'=+V!(C=2)  D

 ..Q:$P(^AUPNVSIT(V,0),U,11)

 ..Q:'$P(^AUPNVSIT(V,0),U,9)

 ..Q:'$D(^AUPNVPOV("AD",V))

 ..Q:'$D(^AUPNVPRV("AD",V))

 ..Q:"TCE"[$P(^AUPNVSIT(V,0),U,7)

 ..S C=C+1 S:C=1 BDMDMV1=9999999-$P(D,".") S:C=2 BDMDMV2=9999999-$P(D,".")

 ..Q

 .Q

 Q

LASTBP  ;PEP - return last wt

 NEW %,E,W,A

 K A

 S %=DFN_"^LAST 2 MEAS BP;DURING "_BDMDOB_"-"_BDMEDD NEW X S E=$$START1^APCLDF(%,"A(")

 S BDMDMV1=$P($G(A(1)),U)_"^"_$P($G(A(1)),U,2)

 S BDMDMV2=$P($G(A(2)),U)_"^"_$P($G(A(2)),U,2)

 Q

BPS ;

 S $P(BDMTBP,U)=$P(BDMTBP,U)+1  ;total number of patients

 S $P(BDMTBP(BDMP,BDMP1),U)=$P(BDMTBP(BDMP,BDMP1),U)+1

 I $P(BDMDMV1,U)<BDMBD D  Q

 .S $P(BDMTBP,U,7)=$P(BDMTBP,U,7)+1  ;no value/not tested

 .S $P(BDMTBP(BDMP,BDMP1),U,7)=$P(BDMTBP(BDMP,BDMP1),U,7)+1

 .Q

 S V=$P(BDMDMV1,U,2),S=$P(V,"/"),D=$P(V,"/",2)

 I S=""!(D="") S $P(BDMTBP,U,7)=$P(BDMTBP,U,7)+1,$P(BDMTBP(BDMP,BDMP1),U,7)=$P(BDMTBP(BDMP,BDMP1),U,7)+1 Q

 I S<120&(D<80) S $P(BDMTBP,U,2)=$P(BDMTBP,U,2)+1,$P(BDMTBP(BDMP,BDMP1),U,2)=$P(BDMTBP(BDMP,BDMP1),U,2)+1 Q

 I S<130&(D<85) S $P(BDMTBP,U,3)=$P(BDMTBP,U,3)+1,$P(BDMTBP(BDMP,BDMP1),U,3)=$P(BDMTBP(BDMP,BDMP1),U,3)+1 Q

 I S<140&(D<90) S $P(BDMTBP,U,4)=$P(BDMTBP,U,4)+1,$P(BDMTBP(BDMP,BDMP1),U,4)=$P(BDMTBP(BDMP,BDMP1),U,4)+1 Q

 I S<160&(D<95) S $P(BDMTBP,U,5)=$P(BDMTBP,U,5)+1,$P(BDMTBP(BDMP,BDMP1),U,5)=$P(BDMTBP(BDMP,BDMP1),U,5)+1 Q

 S $P(BDMTBP,U,6)=$P(BDMTBP,U,6)+1,$P(BDMTBP(BDMP,BDMP1),U,6)=$P(BDMTBP(BDMP,BDMP1),U,6)+1

 Q

LDLS ;

 S BDM15M=$$FMADD^XLFDT(BDMED,-(15*30))

 S $P(BDMTLDL,U)=$P(BDMTLDL,U)+1  ;total number of patients

 S $P(BDMTLDL(BDMP,BDMP1),U)=$P(BDMTLDL(BDMP,BDMP1),U)+1

 I $P(BDMDMV1,U)'<BDM15M S V=$P(BDMDMV1,U,2) D LDLS1 Q

 I $P(BDMDMV2,U)'<BDM15M S V=$P(BDMDMV2,U,2) D LDLS1 Q

 S $P(BDMTLDL,U,7)=$P(BDMTLDL,U,7)+1,$P(BDMTLDL(BDMP,BDMP1),U,7)=$P(BDMTLDL(BDMP,BDMP1),U,7)+1

 Q

LDLS1 ;

 I V="" S $P(BDMTLDL,U,6)=$P(BDMTLDL,U,6)+1,$P(BDMTLDL(BDMP,BDMP1),U,6)=$P(BDMTLDL(BDMP,BDMP1),U,6)+1 Q

 I $E(V)'=+$E(V) S $P(BDMTLDL,U,6)=$P(BDMTLDL,U,6)+1,$P(BDMTLDL(BDMP,BDMP1),U,6)=$P(BDMTLDL(BDMP,BDMP1),U,6)+1 Q

 I V<100 S $P(BDMTLDL,U,2)=$P(BDMTLDL,U,2)+1,$P(BDMTLDL(BDMP,BDMP1),U,2)=$P(BDMTLDL(BDMP,BDMP1),U,2)+1 Q

 I V<130&(V>99) S $P(BDMTLDL,U,3)=$P(BDMTLDL,U,3)+1,$P(BDMTLDL(BDMP,BDMP1),U,3)=$P(BDMTLDL(BDMP,BDMP1),U,3)+1 Q

 I V>129&(V<161) S $P(BDMTLDL,U,4)=$P(BDMTLDL,U,4)+1,$P(BDMTLDL(BDMP,BDMP1),U,4)=$P(BDMTLDL(BDMP,BDMP1),U,4)+1 Q

 I V>160 S $P(BDMTLDL,U,5)=$P(BDMTLDL,U,5)+1,$P(BDMTLDL(BDMP,BDMP1),U,5)=$P(BDMTLDL(BDMP,BDMP1),U,5)+1 Q

 Q

TCS ;

 S BDM15M=$$FMADD^XLFDT(BDMED,-(15*30))

 S $P(BDMTTC,U)=$P(BDMTTC,U)+1  ;total number of patients

 S $P(BDMTTC(BDMP,BDMP1),U)=$P(BDMTTC(BDMP,BDMP1),U)+1

 I $P(BDMDMV1,U)'<BDM15M S V=$P(BDMDMV1,U,2) D TCS1 Q

 I $P(BDMDMV2,U)'<BDM15M S V=$P(BDMDMV2,U,2) D TCS1 Q

 S $P(BDMTTC,U,7)=$P(BDMTTC,U,7)+1,$P(BDMTTC(BDMP,BDMP1),U,7)=$P(BDMTTC(BDMP,BDMP1),U,7)+1

 Q

TCS1 ;

 I V="" S $P(BDMTTC,U,6)=$P(BDMTTC,U,6)+1,$P(BDMTTC(BDMP,BDMP1),U,6)=$P(BDMTTC(BDMP,BDMP1),U,6)+1 Q

 I $E(V)'=+$E(V) S $P(BDMTTC,U,6)=$P(BDMTTC,U,6)+1,$P(BDMTTC(BDMP,BDMP1),U,6)=$P(BDMTTC(BDMP,BDMP1),U,6)+1 Q

 I V<200 S $P(BDMTTC,U,2)=$P(BDMTTC,U,2)+1,$P(BDMTTC(BDMP,BDMP1),U,2)=$P(BDMTTC(BDMP,BDMP1),U,2)+1 Q

 I V<240&(V>199) S $P(BDMTTC,U,3)=$P(BDMTTC,U,3)+1,$P(BDMTTC(BDMP,BDMP1),U,3)=$P(BDMTTC(BDMP,BDMP1),U,3)+1 Q

 I V>239 S $P(BDMTTC,U,4)=$P(BDMTTC,U,4)+1,$P(BDMTTC(BDMP,BDMP1),U,4)=$P(BDMTTC(BDMP,BDMP1),U,4)+1 Q

 ;I V>400 S $P(BDMTTC,U,5)=$P(BDMTTC,U,5)+1,$P(BDMTTC(BDMP,BDMP1),U,5)=$P(BDMTTC(BDMP,BDMP1),U,5)+1 Q

 Q

HDLS ;

 S BDM15M=$$FMADD^XLFDT(BDMED,-(15*30))

 S $P(BDMTHDL,U)=$P(BDMTHDL,U)+1  ;total number of patients

 S $P(BDMTHDL(BDMP,BDMP1),U)=$P(BDMTHDL(BDMP,BDMP1),U)+1

 I $P(BDMDMV1,U)'<BDM15M S V=$P(BDMDMV1,U,2) D HDLS1 Q

 I $P(BDMDMV2,U)'<BDM15M S V=$P(BDMDMV2,U,2) D HDLS1 Q

 S $P(BDMTHDL,U,7)=$P(BDMTHDL,U,7)+1,$P(BDMTHDL(BDMP,BDMP1),U,7)=$P(BDMTHDL(BDMP,BDMP1),U,7)+1

 Q

HDLS1 ;

 I V="" S $P(BDMTHDL,U,6)=$P(BDMTHDL,U,6)+1,$P(BDMTHDL(BDMP,BDMP1),U,6)=$P(BDMTHDL(BDMP,BDMP1),U,6)+1 Q

 I $E(V)'=+$E(V) S $P(BDMTHDL,U,6)=$P(BDMTHDL,U,6)+1,$P(BDMTHDL(BDMP,BDMP1),U,6)=$P(BDMTHDL(BDMP,BDMP1),U,6)+1 Q

 I V<35 S $P(BDMTHDL,U,2)=$P(BDMTHDL,U,2)+1,$P(BDMTHDL(BDMP,BDMP1),U,2)=$P(BDMTHDL(BDMP,BDMP1),U,2)+1 Q

 I V<46&(V>34) S $P(BDMTHDL,U,3)=$P(BDMTHDL,U,3)+1,$P(BDMTHDL(BDMP,BDMP1),U,3)=$P(BDMTHDL(BDMP,BDMP1),U,3)+1 Q

 I V>45&(V<56) S $P(BDMTHDL,U,4)=$P(BDMTHDL,U,4)+1,$P(BDMTHDL(BDMP,BDMP1),U,4)=$P(BDMTHDL(BDMP,BDMP1),U,4)+1 Q

 I V>55 S $P(BDMTHDL,U,5)=$P(BDMTHDL,U,5)+1,$P(BDMTHDL(BDMP,BDMP1),U,5)=$P(BDMTHDL(BDMP,BDMP1),U,5)+1 Q

 Q

HGBS ;subtotal hbg values

 S $P(BDMTHGB,U)=$P(BDMTHGB,U)+1  ;total number of patients

 S $P(BDMTHGB(BDMP,BDMP1),U)=$P(BDMTHGB(BDMP,BDMP1),U)+1

 I $P(BDMDMV1,U)<BDMBD D  Q

 .S $P(BDMTHGB,U,9)=$P(BDMTHGB,U,9)+1  ;no value/not tested

 .S $P(BDMTHGB(BDMP,BDMP1),U,9)=$P(BDMTHGB(BDMP,BDMP1),U,9)+1

 .Q

 S V=$P(BDMDMV1,U,2)

 S P=$S(V="":8,V[">":7,$E(V)'=+$E(V):8,V<7.0:2,V>6.9&(V<8.0):3,V>7.9&(V<9.0):4,V>8.9&(V<10.0):5,V<11.0&(V>9.9):6,V>10.9:7,1:8)

 S $P(BDMTHGB,U,P)=$P(BDMTHGB,U,P)+1

 S $P(BDMTHGB(BDMP,BDMP1),U,P)=$P(BDMTHGB(BDMP,BDMP1),U,P)+1

 Q

TRIGS ;

 S BDM15M=$$FMADD^XLFDT(BDMED,-(15*30))

 S $P(BDMTTRIG,U)=$P(BDMTTRIG,U)+1  ;total number of patients

 S $P(BDMTTRIG(BDMP,BDMP1),U)=$P(BDMTTRIG(BDMP,BDMP1),U)+1

 I $P(BDMDMV1,U)'<BDM15M S V=$P(BDMDMV1,U,2) D TRIGS1 Q

 I $P(BDMDMV2,U)'<BDM15M S V=$P(BDMDMV2,U,2) D TRIGS1 Q

 S $P(BDMTTRIG,U,7)=$P(BDMTTRIG,U,7)+1,$P(BDMTTRIG(BDMP,BDMP1),U,7)=$P(BDMTTRIG(BDMP,BDMP1),U,7)+1

 Q

TRIGS1 ;

 I V="" S $P(BDMTTRIG,U,6)=$P(BDMTTRIG,U,6)+1,$P(BDMTTRIG(BDMP,BDMP1),U,6)=$P(BDMTTRIG(BDMP,BDMP1),U,6)+1 Q

 I $E(V)'=+$E(V) S $P(BDMTTRIG,U,6)=$P(BDMTTRIG,U,6)+1,$P(BDMTTRIG(BDMP,BDMP1),U,6)=$P(BDMTTRIG(BDMP,BDMP1),U,6)+1 Q

 I V<150 S $P(BDMTTRIG,U,2)=$P(BDMTTRIG,U,2)+1,$P(BDMTTRIG(BDMP,BDMP1),U,2)=$P(BDMTTRIG(BDMP,BDMP1),U,2)+1 Q

 I V<200&(V>149) S $P(BDMTTRIG,U,3)=$P(BDMTTRIG,U,3)+1,$P(BDMTTRIG(BDMP,BDMP1),U,3)=$P(BDMTTRIG(BDMP,BDMP1),U,3)+1 Q

 I V>199&(V<401) S $P(BDMTTRIG,U,4)=$P(BDMTTRIG,U,4)+1,$P(BDMTTRIG(BDMP,BDMP1),U,4)=$P(BDMTTRIG(BDMP,BDMP1),U,4)+1 Q

 I V>400 S $P(BDMTTRIG,U,5)=$P(BDMTTRIG,U,5)+1,$P(BDMTTRIG(BDMP,BDMP1),U,5)=$P(BDMTTRIG(BDMP,BDMP1),U,5)+1 Q

 Q

LASTHBG ;

 NEW %,E,W,A

 K A

 S %=DFN_"^LAST 2 LAB [DM AUDIT HGB A1C;DURING "_BDMDOB_"-"_BDMEDD NEW X S E=$$START1^APCLDF(%,"A(")

 S BDMDMV1=$P($G(A(1)),U)_"^"_$P($G(A(1)),U,2)_"^"_$P($G(A(1)),U,4)

 S BDMDMV2=$P($G(A(2)),U)_"^"_$P($G(A(2)),U,2)

 Q

LASTTC ;

 NEW %,E,W,A

 K A

 S %=DFN_"^LAST 2 LAB [DM AUDIT CHOLESTEROL TAX;DURING "_BDMDOB_"-"_BDMEDD NEW X S E=$$START1^APCLDF(%,"A(")

 S BDMDMV1=$P($G(A(1)),U)_"^"_$P($G(A(1)),U,2)

 S BDMDMV2=$P($G(A(2)),U)_"^"_$P($G(A(2)),U,2)

 Q

LASTLDL ;

 NEW %,E,W,A

 K A

 S %=DFN_"^LAST 2 LAB [DM AUDIT LDL CHOLESTEROL TAX;DURING "_BDMDOB_"-"_BDMEDD NEW X S E=$$START1^APCLDF(%,"A(")

 S BDMDMV1=$P($G(A(1)),U)_"^"_$P($G(A(1)),U,2)

 S BDMDMV2=$P($G(A(2)),U)_"^"_$P($G(A(2)),U,2)

 Q

LASTHDL ;

 NEW %,E,W,A

 K A

 S %=DFN_"^LAST 2 LAB [DM AUDIT HDL TAX;DURING "_BDMDOB_"-"_BDMEDD NEW X S E=$$START1^APCLDF(%,"A(")

 S BDMDMV1=$P($G(A(1)),U)_"^"_$P($G(A(1)),U,2)

 S BDMDMV2=$P($G(A(2)),U)_"^"_$P($G(A(2)),U,2)

 Q

LASTTRIG ;

 NEW %,E,W,A

 K A

 S %=DFN_"^LAST 2 LAB [DM AUDIT TRIGLYCERIDE TAX;DURING "_BDMDOB_"-"_BDMEDD NEW X S E=$$START1^APCLDF(%,"A(")

 S BDMDMV1=$P($G(A(1)),U)_"^"_$P($G(A(1)),U,2)

 S BDMDMV2=$P($G(A(2)),U)_"^"_$P($G(A(2)),U,2)

 Q

C(X,X2,X3) ;

 D COMMA^%DTC

 Q X

DATE(B) ;

 I $G(B)="" Q ""

 Q $E(B,4,5)_"/"_$E(B,6,7)_"/"_$E(B,2,3)

CTR(X,Y) ;EP - Center X in a field Y wide.

 Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X

 ;----------

EOP ;EP - End of page.

 Q:$E(IOST)'="C"

 Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))

 NEW DIR

 K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT

 S DIR(0)="E" D ^DIR

 Q

 ;----------

USR() ;EP - Return name of current user from ^VA(200.

 Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")

 ;----------

LOC() ;EP - Return location name from file 4 based on DUZ(2).

 Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")

 ;----------

BDMDR31   ; IHS/CMI/LAB - patients dm list - chinle ;

 +1       ;;2.0;DIABETES MANAGEMENT SYSTEM;**2,3,4,10**;JUN 14, 2007;Build 12

 +2       ;

 +3       ;

PRINT     ;EP - called from xbdbque

 +1        KILL BDMTHGB,BDMTBP,BDMTLDL,BDMFINL,BDMTHDL,BDMTTRIG,BDMTTC

 +2        SET BDMIOSL=$SELECT($GET(BDMGUI):55,1:IOSL)

 +3        SET BDMTHGB=""

           SET BDMTBP=""

           SET BDMTLDL=""

           SET BDMTHDL=""

           SET BDMTTRIG=""

           SET BDMTTC=""

 +4        SET BDMP=""

 +5        SET BDM80D="-------------------------------------------------------------------------------"

 +6        SET BDMPG=0

 +7        IF '$DATA(^XTMP("BDMDR3",BDMJOB,BDMBTH))

               DO HEAD

               WRITE !!,"NO PATIENTS TO REPORT"

               GOTO DONE

 +8        SET (BDMNAME,BDMP,BDMC)=""

           KILL BDMQ

 +9        FOR 

               SET BDMP=$ORDER(^XTMP("BDMDR3",BDMJOB,BDMBTH,"PATIENTS",BDMP))

               IF BDMP=""!($DATA(BDMQ))

                   QUIT 

               Begin DoDot:1

 +10      ;D HEAD Q:$D(BDMQ)

 +11               SET BDMCNT=0

 +12               KILL BDMSTOT

                   SET BDMC=""

                   FOR 

                       SET BDMC=$ORDER(^XTMP("BDMDR3",BDMJOB,BDMBTH,"PATIENTS",BDMP,BDMC))

                       IF BDMC=""!($DATA(BDMQ))

                           QUIT 

                       Begin DoDot:2

 +13                       SET BDMNAME=""

                           FOR 

                               SET BDMNAME=$ORDER(^XTMP("BDMDR3",BDMJOB,BDMBTH,"PATIENTS",BDMP,BDMC,BDMNAME))

                               IF BDMNAME=""!($DATA(BDMQ))

                                   QUIT 

                               Begin DoDot:3

 +14                               SET DFN=""

                                   FOR 

                                       SET DFN=$ORDER(^XTMP("BDMDR3",BDMJOB,BDMBTH,"PATIENTS",BDMP,BDMC,BDMNAME,DFN))

                                       IF DFN'=+DFN!($DATA(BDMQ))

                                           QUIT 

                                       SET BDMCNT=BDMCNT+1

                                       DO PRINT1

                               End DoDot:3

                       End DoDot:2

 +15               IF $DATA(BDMQ)

                       QUIT 

 +16               DO SUBTOT^BDMDR3

               End DoDot:1

 +17       IF $DATA(BDMQ)

               GOTO DONE

 +18       DO FINTOT^BDMDR3

 +19       DO DONE

 +20       QUIT 

PRINT1    ;

 +1        SET BDMP1=^XTMP("BDMDR3",BDMJOB,BDMBTH,"PATIENTS",BDMP,BDMC,BDMNAME,DFN)

 +2        SET BDMWR=1

           IF BDMPCP

               IF BDMPCP'=BDMP1

                   SET BDMWR=0

 +3        IF '$DATA(BDMTHGB(BDMP,BDMP1))

               SET BDMTHGB(BDMP,BDMP1)=""

 +4        IF '$DATA(BDMTBP(BDMP,BDMP1))

               SET BDMTBP(BDMP,BDMP1)=""

 +5        IF '$DATA(BDMTLDL(BDMP,BDMP1))

               SET BDMTLDL(BDMP,BDMP1)=""

 +6        IF '$DATA(BDMTHDL(BDMP,BDMP1))

               SET BDMTHDL(BDMP,BDMP1)=""

 +7        IF '$DATA(BDMTTRIG(BDMP,BDMP1))

               SET BDMTTRIG(BDMP,BDMP1)=""

 +8        IF '$DATA(BDMTTC(BDMP,BDMP1))

               SET BDMTTC(BDMP,BDMP1)=""

 +9        IF BDMWR

               IF BDMCNT=1

                   DO HEAD

                   IF $DATA(BDMQ)

                       QUIT 

                   IF 1

 +10      IF '$TEST

               IF BDMWR

                   IF $Y>(BDMIOSL-10)

                       DO HEAD

                       IF $DATA(BDMQ)

                           QUIT 

 +11       SET BDMSTOT(0)=$GET(BDMSTOT(0))+1

 +12       SET BDMDOB=$$FMTE^XLFDT($PIECE(^DPT(DFN,0),U,3))

 +13       IF BDMWR

               WRITE !,$EXTRACT(BDMNAME,1,25),?27,$$HRN^AUPNPAT(DFN,$SELECT($GET(BDMDUZ2):BDMDUZ2,1:DUZ(2))),?34,$$DOB^AUPNPAT(DFN,"E"),?47,BDMC

 +14       IF BDMWR

               WRITE !?2,"Test",?22,"In Past 4 Months",?50,"Next most recent"

 +15       IF BDMWR

               WRITE !?2,"----",?22,"----------------",?50,"----------------"

 +16       SET (BDMDMV1,BDMDMV2)=""

           DO LASTDMV

 +17       IF BDMWR

               WRITE !?2,"Last Clinic Visit"

 +18       IF BDMDMV1>BDMSD

               IF BDMWR

                   WRITE ?22,$$DATE(BDMDMV1),?50,$$DATE(BDMDMV2)

               SET BDMSTOT(1)=$GET(BDMSTOT(1))+1

               IF 1

 +19      IF '$TEST

               IF BDMWR

                   WRITE ?50,$$DATE(BDMDMV1)

 +20       IF BDMWR

               WRITE !?2,"Blood Pressure (BP)"

 +21       SET (BDMDMV1,BDMDMV2)=""

           DO LASTBP

 +22       IF $PIECE(BDMDMV1,U)>BDMSD

               IF BDMWR

                   WRITE ?22,$$DATE($PIECE(BDMDMV1,U))_"  "_$PIECE(BDMDMV1,U,2),?50,$$DATE($PIECE(BDMDMV2,U))_"  "_$PIECE(BDMDMV2,U,2)

               SET BDMSTOT(2)=$GET(BDMSTOT(2))+1

               IF 1

 +23      IF '$TEST

               IF BDMWR

                   WRITE ?50,$$DATE($PIECE(BDMDMV1,U))_"  "_$PIECE(BDMDMV1,U,2)

 +24       DO BPS

HGB       ;

 +1        IF BDMWR

               WRITE !?2,"Hgb A1C"

 +2        SET (BDMDMV1,BDMDMV2)=""

           DO LASTHBG

 +3        IF $PIECE(BDMDMV1,U)>BDMSD

               IF BDMWR

                   WRITE ?22,$$DATE($PIECE(BDMDMV1,U))_"  "_$PIECE(BDMDMV1,U,2),?50,$$DATE($PIECE(BDMDMV2,U))_"  "_$PIECE(BDMDMV2,U,2)