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)
SET BDMSTOT(3)=$GET(BDMSTOT(3))+1
IF 1
+4 IF '$TEST
IF BDMWR
WRITE ?50,$$DATE($PIECE(BDMDMV1,U))_" "_$PIECE(BDMDMV1,U,2)
+5 DO HGBS
TC ;
+1 IF BDMWR
WRITE !?2,"Total Cholesterol"
+2 SET (BDMDMV1,BDMDMV2)=""
DO LASTTC
+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)
SET BDMSTOT(4)=$GET(BDMSTOT(4))+1
IF 1
+4 IF '$TEST
IF BDMWR
WRITE ?50,$$DATE($PIECE(BDMDMV1,U))_" "_$PIECE(BDMDMV1,U,2)
+5 DO TCS
LDL ;
+1 IF BDMWR
WRITE !?2,"LDL Cholesterol"
+2 SET (BDMDMV1,BDMDMV2)=""
DO LASTLDL
+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)
SET BDMSTOT(5)=$GET(BDMSTOT(5))+1
IF 1
+4 IF '$TEST
IF BDMWR
WRITE ?50,$$DATE($PIECE(BDMDMV1,U))_" "_$PIECE(BDMDMV1,U,2)
+5 DO LDLS
HDL ;
+1 IF BDMWR
WRITE !?2,"HDL Cholesterol"
+2 SET (BDMDMV1,BDMDMV2)=""
DO LASTHDL
+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)
SET BDMSTOT(6)=$GET(BDMSTOT(6))+1
IF 1
+4 IF '$TEST
IF BDMWR
WRITE ?50,$$DATE($PIECE(BDMDMV1,U))_" "_$PIECE(BDMDMV1,U,2)
+5 ;W:BDMWR !
+6 DO HDLS
TRIG ;
+1 IF BDMWR
WRITE !?2,"Triglycerides"
+2 SET (BDMDMV1,BDMDMV2)=""
DO LASTTRIG
+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)
SET BDMSTOT(7)=$GET(BDMSTOT(7))+1
IF 1
+4 IF '$TEST
IF BDMWR
WRITE ?50,$$DATE($PIECE(BDMDMV1,U))_" "_$PIECE(BDMDMV1,U,2)
+5 IF BDMWR
WRITE !
+6 DO TRIGS
+7 QUIT
DONE ;
+1 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
SET DIR(0)="EO"
SET DIR("A")="End of report. HIT RETURN"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(IOF)
WRITE @IOF
+3 KILL ^XTMP("BDMDR3",BDMJOB,BDMBTH),BDMJOB,BDMBTH
+4 QUIT
HEAD ;EP
+1 IF 'BDMPG
GOTO HEAD1
+2 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET BDMQ=""
QUIT
HEAD1 ;
+1 IF $DATA(IOF)
WRITE @IOF
SET BDMPG=BDMPG+1
+2 IF $GET(BDMGUI)
IF BDMPG'=1
WRITE !,"ZZZZZZZ"
+3 WRITE !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"
+4 WRITE !,$PIECE(^VA(200,DUZ,0),U,2),?72,"Page ",BDMPG,!
+5 WRITE ?(80-$LENGTH($PIECE(^DIC(4,$SELECT($GET(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0),U))/2),$PIECE(^DIC(4,$SELECT($GET(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0),U),!
+6 SET X="Patients on the "_$PIECE(^ACM(41.1,BDMREG,0),U)_" Register Status: "_$SELECT($GET(BDMSTAR)]"":BDMSTAR,1:"ALL")
WRITE $$CTR(X,80),!
+7 WRITE $$CTR("As of Date: "_BDMEDD_$SELECT($DATA(BDMFINL):"",1:" Designated Provider: "_$GET(BDMP)),80),!
+8 IF $DATA(BDMFINL)
QUIT
PIH IF '$DATA(BDMSUB)
WRITE !,"PATIENT NAME",?27,"HRN",?34,"DOB",?47,"COMMUNITY",?62,!,BDM80D
+1 IF $DATA(BDMSUB)
WRITE !,BDM80D
+2 QUIT
LASTDMV ;EP - get last 2 dm clinic visits
+1 NEW V,D,C
+2 SET C=0
SET D=0
SET V=0
FOR
SET D=$ORDER(^AUPNVSIT("AA",DFN,D))
IF D'=+D!(C=2)
QUIT
Begin DoDot:1
+3 SET V=0
FOR
SET V=$ORDER(^AUPNVSIT("AA",DFN,D,V))
IF V'=+V!(C=2)
QUIT
Begin DoDot:2
+4 IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+5 IF '$PIECE(^AUPNVSIT(V,0),U,9)
QUIT
+6 IF '$DATA(^AUPNVPOV("AD",V))
QUIT
+7 IF '$DATA(^AUPNVPRV("AD",V))
QUIT
+8 IF "TCE"[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+9 SET C=C+1
IF C=1
SET BDMDMV1=9999999-$PIECE(D,".")
IF C=2
SET BDMDMV2=9999999-$PIECE(D,".")
+10 QUIT
End DoDot:2
+11 QUIT
End DoDot:1
+12 QUIT
LASTBP ;PEP - return last wt
+1 NEW %,E,W,A
+2 KILL A
+3 SET %=DFN_"^LAST 2 MEAS BP;DURING "_BDMDOB_"-"_BDMEDD
NEW X
SET E=$$START1^APCLDF(%,"A(")
+4 SET BDMDMV1=$PIECE($GET(A(1)),U)_"^"_$PIECE($GET(A(1)),U,2)
+5 SET BDMDMV2=$PIECE($GET(A(2)),U)_"^"_$PIECE($GET(A(2)),U,2)
+6 QUIT
BPS ;
+1 ;total number of patients
SET $PIECE(BDMTBP,U)=$PIECE(BDMTBP,U)+1
+2 SET $PIECE(BDMTBP(BDMP,BDMP1),U)=$PIECE(BDMTBP(BDMP,BDMP1),U)+1
+3 IF $PIECE(BDMDMV1,U)<BDMBD
Begin DoDot:1
+4 ;no value/not tested
SET $PIECE(BDMTBP,U,7)=$PIECE(BDMTBP,U,7)+1
+5 SET $PIECE(BDMTBP(BDMP,BDMP1),U,7)=$PIECE(BDMTBP(BDMP,BDMP1),U,7)+1
+6 QUIT
End DoDot:1
QUIT
+7 SET V=$PIECE(BDMDMV1,U,2)
SET S=$PIECE(V,"/")
SET D=$PIECE(V,"/",2)
+8 IF S=""!(D="")
SET $PIECE(BDMTBP,U,7)=$PIECE(BDMTBP,U,7)+1
SET $PIECE(BDMTBP(BDMP,BDMP1),U,7)=$PIECE(BDMTBP(BDMP,BDMP1),U,7)+1
QUIT
+9 IF S<120&(D<80)
SET $PIECE(BDMTBP,U,2)=$PIECE(BDMTBP,U,2)+1
SET $PIECE(BDMTBP(BDMP,BDMP1),U,2)=$PIECE(BDMTBP(BDMP,BDMP1),U,2)+1
QUIT
+10 IF S<130&(D<85)
SET $PIECE(BDMTBP,U,3)=$PIECE(BDMTBP,U,3)+1
SET $PIECE(BDMTBP(BDMP,BDMP1),U,3)=$PIECE(BDMTBP(BDMP,BDMP1),U,3)+1
QUIT
+11 IF S<140&(D<90)
SET $PIECE(BDMTBP,U,4)=$PIECE(BDMTBP,U,4)+1
SET $PIECE(BDMTBP(BDMP,BDMP1),U,4)=$PIECE(BDMTBP(BDMP,BDMP1),U,4)+1
QUIT
+12 IF S<160&(D<95)
SET $PIECE(BDMTBP,U,5)=$PIECE(BDMTBP,U,5)+1
SET $PIECE(BDMTBP(BDMP,BDMP1),U,5)=$PIECE(BDMTBP(BDMP,BDMP1),U,5)+1
QUIT
+13 SET $PIECE(BDMTBP,U,6)=$PIECE(BDMTBP,U,6)+1
SET $PIECE(BDMTBP(BDMP,BDMP1),U,6)=$PIECE(BDMTBP(BDMP,BDMP1),U,6)+1
+14 QUIT
LDLS ;
+1 SET BDM15M=$$FMADD^XLFDT(BDMED,-(15*30))
+2 ;total number of patients
SET $PIECE(BDMTLDL,U)=$PIECE(BDMTLDL,U)+1
+3 SET $PIECE(BDMTLDL(BDMP,BDMP1),U)=$PIECE(BDMTLDL(BDMP,BDMP1),U)+1
+4 IF $PIECE(BDMDMV1,U)'<BDM15M
SET V=$PIECE(BDMDMV1,U,2)
DO LDLS1
QUIT
+5 IF $PIECE(BDMDMV2,U)'<BDM15M
SET V=$PIECE(BDMDMV2,U,2)
DO LDLS1
QUIT
+6 SET $PIECE(BDMTLDL,U,7)=$PIECE(BDMTLDL,U,7)+1
SET $PIECE(BDMTLDL(BDMP,BDMP1),U,7)=$PIECE(BDMTLDL(BDMP,BDMP1),U,7)+1
+7 QUIT
LDLS1 ;
+1 IF V=""
SET $PIECE(BDMTLDL,U,6)=$PIECE(BDMTLDL,U,6)+1
SET $PIECE(BDMTLDL(BDMP,BDMP1),U,6)=$PIECE(BDMTLDL(BDMP,BDMP1),U,6)+1
QUIT
+2 IF $EXTRACT(V)'=+$EXTRACT(V)
SET $PIECE(BDMTLDL,U,6)=$PIECE(BDMTLDL,U,6)+1
SET $PIECE(BDMTLDL(BDMP,BDMP1),U,6)=$PIECE(BDMTLDL(BDMP,BDMP1),U,6)+1
QUIT
+3 IF V<100
SET $PIECE(BDMTLDL,U,2)=$PIECE(BDMTLDL,U,2)+1
SET $PIECE(BDMTLDL(BDMP,BDMP1),U,2)=$PIECE(BDMTLDL(BDMP,BDMP1),U,2)+1
QUIT
+4 IF V<130&(V>99)
SET $PIECE(BDMTLDL,U,3)=$PIECE(BDMTLDL,U,3)+1
SET $PIECE(BDMTLDL(BDMP,BDMP1),U,3)=$PIECE(BDMTLDL(BDMP,BDMP1),U,3)+1
QUIT
+5 IF V>129&(V<161)
SET $PIECE(BDMTLDL,U,4)=$PIECE(BDMTLDL,U,4)+1
SET $PIECE(BDMTLDL(BDMP,BDMP1),U,4)=$PIECE(BDMTLDL(BDMP,BDMP1),U,4)+1
QUIT
+6 IF V>160
SET $PIECE(BDMTLDL,U,5)=$PIECE(BDMTLDL,U,5)+1
SET $PIECE(BDMTLDL(BDMP,BDMP1),U,5)=$PIECE(BDMTLDL(BDMP,BDMP1),U,5)+1
QUIT
+7 QUIT
TCS ;
+1 SET BDM15M=$$FMADD^XLFDT(BDMED,-(15*30))
+2 ;total number of patients
SET $PIECE(BDMTTC,U)=$PIECE(BDMTTC,U)+1
+3 SET $PIECE(BDMTTC(BDMP,BDMP1),U)=$PIECE(BDMTTC(BDMP,BDMP1),U)+1
+4 IF $PIECE(BDMDMV1,U)'<BDM15M
SET V=$PIECE(BDMDMV1,U,2)
DO TCS1
QUIT
+5 IF $PIECE(BDMDMV2,U)'<BDM15M
SET V=$PIECE(BDMDMV2,U,2)
DO TCS1
QUIT
+6 SET $PIECE(BDMTTC,U,7)=$PIECE(BDMTTC,U,7)+1
SET $PIECE(BDMTTC(BDMP,BDMP1),U,7)=$PIECE(BDMTTC(BDMP,BDMP1),U,7)+1
+7 QUIT
TCS1 ;
+1 IF V=""
SET $PIECE(BDMTTC,U,6)=$PIECE(BDMTTC,U,6)+1
SET $PIECE(BDMTTC(BDMP,BDMP1),U,6)=$PIECE(BDMTTC(BDMP,BDMP1),U,6)+1
QUIT
+2 IF $EXTRACT(V)'=+$EXTRACT(V)
SET $PIECE(BDMTTC,U,6)=$PIECE(BDMTTC,U,6)+1
SET $PIECE(BDMTTC(BDMP,BDMP1),U,6)=$PIECE(BDMTTC(BDMP,BDMP1),U,6)+1
QUIT
+3 IF V<200
SET $PIECE(BDMTTC,U,2)=$PIECE(BDMTTC,U,2)+1
SET $PIECE(BDMTTC(BDMP,BDMP1),U,2)=$PIECE(BDMTTC(BDMP,BDMP1),U,2)+1
QUIT
+4 IF V<240&(V>199)
SET $PIECE(BDMTTC,U,3)=$PIECE(BDMTTC,U,3)+1
SET $PIECE(BDMTTC(BDMP,BDMP1),U,3)=$PIECE(BDMTTC(BDMP,BDMP1),U,3)+1
QUIT
+5 IF V>239
SET $PIECE(BDMTTC,U,4)=$PIECE(BDMTTC,U,4)+1
SET $PIECE(BDMTTC(BDMP,BDMP1),U,4)=$PIECE(BDMTTC(BDMP,BDMP1),U,4)+1
QUIT
+6 ;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
+7 QUIT
HDLS ;
+1 SET BDM15M=$$FMADD^XLFDT(BDMED,-(15*30))
+2 ;total number of patients
SET $PIECE(BDMTHDL,U)=$PIECE(BDMTHDL,U)+1
+3 SET $PIECE(BDMTHDL(BDMP,BDMP1),U)=$PIECE(BDMTHDL(BDMP,BDMP1),U)+1
+4 IF $PIECE(BDMDMV1,U)'<BDM15M
SET V=$PIECE(BDMDMV1,U,2)
DO HDLS1
QUIT
+5 IF $PIECE(BDMDMV2,U)'<BDM15M
SET V=$PIECE(BDMDMV2,U,2)
DO HDLS1
QUIT
+6 SET $PIECE(BDMTHDL,U,7)=$PIECE(BDMTHDL,U,7)+1
SET $PIECE(BDMTHDL(BDMP,BDMP1),U,7)=$PIECE(BDMTHDL(BDMP,BDMP1),U,7)+1
+7 QUIT
HDLS1 ;
+1 IF V=""
SET $PIECE(BDMTHDL,U,6)=$PIECE(BDMTHDL,U,6)+1
SET $PIECE(BDMTHDL(BDMP,BDMP1),U,6)=$PIECE(BDMTHDL(BDMP,BDMP1),U,6)+1
QUIT
+2 IF $EXTRACT(V)'=+$EXTRACT(V)
SET $PIECE(BDMTHDL,U,6)=$PIECE(BDMTHDL,U,6)+1
SET $PIECE(BDMTHDL(BDMP,BDMP1),U,6)=$PIECE(BDMTHDL(BDMP,BDMP1),U,6)+1
QUIT
+3 IF V<35
SET $PIECE(BDMTHDL,U,2)=$PIECE(BDMTHDL,U,2)+1
SET $PIECE(BDMTHDL(BDMP,BDMP1),U,2)=$PIECE(BDMTHDL(BDMP,BDMP1),U,2)+1
QUIT
+4 IF V<46&(V>34)
SET $PIECE(BDMTHDL,U,3)=$PIECE(BDMTHDL,U,3)+1
SET $PIECE(BDMTHDL(BDMP,BDMP1),U,3)=$PIECE(BDMTHDL(BDMP,BDMP1),U,3)+1
QUIT
+5 IF V>45&(V<56)
SET $PIECE(BDMTHDL,U,4)=$PIECE(BDMTHDL,U,4)+1
SET $PIECE(BDMTHDL(BDMP,BDMP1),U,4)=$PIECE(BDMTHDL(BDMP,BDMP1),U,4)+1
QUIT
+6 IF V>55
SET $PIECE(BDMTHDL,U,5)=$PIECE(BDMTHDL,U,5)+1
SET $PIECE(BDMTHDL(BDMP,BDMP1),U,5)=$PIECE(BDMTHDL(BDMP,BDMP1),U,5)+1
QUIT
+7 QUIT
HGBS ;subtotal hbg values
+1 ;total number of patients
SET $PIECE(BDMTHGB,U)=$PIECE(BDMTHGB,U)+1
+2 SET $PIECE(BDMTHGB(BDMP,BDMP1),U)=$PIECE(BDMTHGB(BDMP,BDMP1),U)+1
+3 IF $PIECE(BDMDMV1,U)<BDMBD
Begin DoDot:1
+4 ;no value/not tested
SET $PIECE(BDMTHGB,U,9)=$PIECE(BDMTHGB,U,9)+1
+5 SET $PIECE(BDMTHGB(BDMP,BDMP1),U,9)=$PIECE(BDMTHGB(BDMP,BDMP1),U,9)+1
+6 QUIT
End DoDot:1
QUIT
+7 SET V=$PIECE(BDMDMV1,U,2)
+8 SET P=$SELECT(V="":8,V[">":7,$EXTRACT(V)'=+$EXTRACT(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)
+9 SET $PIECE(BDMTHGB,U,P)=$PIECE(BDMTHGB,U,P)+1
+10 SET $PIECE(BDMTHGB(BDMP,BDMP1),U,P)=$PIECE(BDMTHGB(BDMP,BDMP1),U,P)+1
+11 QUIT
TRIGS ;
+1 SET BDM15M=$$FMADD^XLFDT(BDMED,-(15*30))
+2 ;total number of patients
SET $PIECE(BDMTTRIG,U)=$PIECE(BDMTTRIG,U)+1
+3 SET $PIECE(BDMTTRIG(BDMP,BDMP1),U)=$PIECE(BDMTTRIG(BDMP,BDMP1),U)+1
+4 IF $PIECE(BDMDMV1,U)'<BDM15M
SET V=$PIECE(BDMDMV1,U,2)
DO TRIGS1
QUIT
+5 IF $PIECE(BDMDMV2,U)'<BDM15M
SET V=$PIECE(BDMDMV2,U,2)
DO TRIGS1
QUIT
+6 SET $PIECE(BDMTTRIG,U,7)=$PIECE(BDMTTRIG,U,7)+1
SET $PIECE(BDMTTRIG(BDMP,BDMP1),U,7)=$PIECE(BDMTTRIG(BDMP,BDMP1),U,7)+1
+7 QUIT
TRIGS1 ;
+1 IF V=""
SET $PIECE(BDMTTRIG,U,6)=$PIECE(BDMTTRIG,U,6)+1
SET $PIECE(BDMTTRIG(BDMP,BDMP1),U,6)=$PIECE(BDMTTRIG(BDMP,BDMP1),U,6)+1
QUIT
+2 IF $EXTRACT(V)'=+$EXTRACT(V)
SET $PIECE(BDMTTRIG,U,6)=$PIECE(BDMTTRIG,U,6)+1
SET $PIECE(BDMTTRIG(BDMP,BDMP1),U,6)=$PIECE(BDMTTRIG(BDMP,BDMP1),U,6)+1
QUIT
+3 IF V<150
SET $PIECE(BDMTTRIG,U,2)=$PIECE(BDMTTRIG,U,2)+1
SET $PIECE(BDMTTRIG(BDMP,BDMP1),U,2)=$PIECE(BDMTTRIG(BDMP,BDMP1),U,2)+1
QUIT
+4 IF V<200&(V>149)
SET $PIECE(BDMTTRIG,U,3)=$PIECE(BDMTTRIG,U,3)+1
SET $PIECE(BDMTTRIG(BDMP,BDMP1),U,3)=$PIECE(BDMTTRIG(BDMP,BDMP1),U,3)+1
QUIT
+5 IF V>199&(V<401)
SET $PIECE(BDMTTRIG,U,4)=$PIECE(BDMTTRIG,U,4)+1
SET $PIECE(BDMTTRIG(BDMP,BDMP1),U,4)=$PIECE(BDMTTRIG(BDMP,BDMP1),U,4)+1
QUIT
+6 IF V>400
SET $PIECE(BDMTTRIG,U,5)=$PIECE(BDMTTRIG,U,5)+1
SET $PIECE(BDMTTRIG(BDMP,BDMP1),U,5)=$PIECE(BDMTTRIG(BDMP,BDMP1),U,5)+1
QUIT
+7 QUIT
LASTHBG ;
+1 NEW %,E,W,A
+2 KILL A
+3 SET %=DFN_"^LAST 2 LAB [DM AUDIT HGB A1C;DURING "_BDMDOB_"-"_BDMEDD
NEW X
SET E=$$START1^APCLDF(%,"A(")
+4 SET BDMDMV1=$PIECE($GET(A(1)),U)_"^"_$PIECE($GET(A(1)),U,2)_"^"_$PIECE($GET(A(1)),U,4)
+5 SET BDMDMV2=$PIECE($GET(A(2)),U)_"^"_$PIECE($GET(A(2)),U,2)
+6 QUIT
LASTTC ;
+1 NEW %,E,W,A
+2 KILL A
+3 SET %=DFN_"^LAST 2 LAB [DM AUDIT CHOLESTEROL TAX;DURING "_BDMDOB_"-"_BDMEDD
NEW X
SET E=$$START1^APCLDF(%,"A(")
+4 SET BDMDMV1=$PIECE($GET(A(1)),U)_"^"_$PIECE($GET(A(1)),U,2)
+5 SET BDMDMV2=$PIECE($GET(A(2)),U)_"^"_$PIECE($GET(A(2)),U,2)
+6 QUIT
LASTLDL ;
+1 NEW %,E,W,A
+2 KILL A
+3 SET %=DFN_"^LAST 2 LAB [DM AUDIT LDL CHOLESTEROL TAX;DURING "_BDMDOB_"-"_BDMEDD
NEW X
SET E=$$START1^APCLDF(%,"A(")
+4 SET BDMDMV1=$PIECE($GET(A(1)),U)_"^"_$PIECE($GET(A(1)),U,2)
+5 SET BDMDMV2=$PIECE($GET(A(2)),U)_"^"_$PIECE($GET(A(2)),U,2)
+6 QUIT
LASTHDL ;
+1 NEW %,E,W,A
+2 KILL A
+3 SET %=DFN_"^LAST 2 LAB [DM AUDIT HDL TAX;DURING "_BDMDOB_"-"_BDMEDD
NEW X
SET E=$$START1^APCLDF(%,"A(")
+4 SET BDMDMV1=$PIECE($GET(A(1)),U)_"^"_$PIECE($GET(A(1)),U,2)
+5 SET BDMDMV2=$PIECE($GET(A(2)),U)_"^"_$PIECE($GET(A(2)),U,2)
+6 QUIT
LASTTRIG ;
+1 NEW %,E,W,A
+2 KILL A
+3 SET %=DFN_"^LAST 2 LAB [DM AUDIT TRIGLYCERIDE TAX;DURING "_BDMDOB_"-"_BDMEDD
NEW X
SET E=$$START1^APCLDF(%,"A(")
+4 SET BDMDMV1=$PIECE($GET(A(1)),U)_"^"_$PIECE($GET(A(1)),U,2)
+5 SET BDMDMV2=$PIECE($GET(A(2)),U)_"^"_$PIECE($GET(A(2)),U,2)
+6 QUIT
C(X,X2,X3) ;
+1 DO COMMA^%DTC
+2 QUIT X
DATE(B) ;
+1 IF $GET(B)=""
QUIT ""
+2 QUIT $EXTRACT(B,4,5)_"/"_$EXTRACT(B,6,7)_"/"_$EXTRACT(B,2,3)
CTR(X,Y) ;EP - Center X in a field Y wide.
+1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
+2 ;----------
EOP ;EP - End of page.
+1 IF $EXTRACT(IOST)'="C"
QUIT
+2 IF $DATA(ZTQUEUED)!'(IOT="TRM")!$DATA(IO("S"))
QUIT
+3 NEW DIR
+4 KILL DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
+5 SET DIR(0)="E"
DO ^DIR
+6 QUIT
+7 ;----------
USR() ;EP - Return name of current user from ^VA(200.
+1 QUIT $SELECT($GET(DUZ):$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
+2 ;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
+1 QUIT $SELECT($GET(DUZ(2)):$SELECT($DATA(^DIC(4,DUZ(2),0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
+2 ;----------
