BDMDR3 ; IHS/CMI/LAB - patients dm list - chinle ;
;;2.0;DIABETES MANAGEMENT SYSTEM;**2,4,8,10**;JUN 14, 2007;Build 12
;
;
START ;
D INFORM
D EXIT
D GETINFO
I $D(BDMQUIT) D EXIT Q
D ZIS
Q
INFORM ;
W:$D(IOF) @IOF
W !,$$CTR($$LOC)
W !,$$CTR($$USR)
W !!,"This report will list patients who are on the diabetes register",!,"that you select.",!,"The following data items will be printed for each patient: Name, HRN, DOB",!,"Community of Residence.",!
W !,"For each of the following tests the last value in the 4 months prior to the",!,"as of date you enter and the next most recent prior to that one will be",!,"displayed:"
W !?5,"Hgb A1C, BP, Total Cholesterol, HDL, LDL, Triglyceride, Last visit date",!!
Q
;
GETINFO ;
R ;
W !!,"Patients must be a member of the Diabetes Register in order to be included in",!,"this report.",!
S BDMREG=""
S DIC="^ACM(41.1,",DIC(0)="AEMQ",DIC("A")="Enter the Name of the DM Register: " D ^DIC
I Y=-1 W !,"No register selected." S BDMQUIT="" Q
S BDMREG=+Y
;get status
S BDMSTAT=""
S DIR(0)="Y",DIR("A")="Do you want to select register patients with a particular status",DIR("B")="Y" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G R
I Y=0 S BDMSTAT="" G PCP
;which status
S DIR(0)="9002241,1",DIR("A")="Which status",DIR("B")="A" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G R
S BDMSTAT=Y,BDMSTAR=Y(0)
PCP ;
S BDMPCP=""
S DIR(0)="Y",DIR("A")="Limit the report to a particular primary care provider ",DIR("B")="N" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G R
I 'Y G EDATE
K DIC S DIC=$S($P(^DD(9000001,.14,0),U,2)[200:200,1:6),DIC(0)="AEMQ" D ^DIC K DIC
I Y=-1 G PCP
S BDMPCP=+Y
EDATE ;get visit date range for functional assessment
S BDMED=""
K DIR W ! S DIR(0)="D^::EXP",DIR("A")="Enter As of Date for 4 month period"
D ^DIR K DIR G:Y<1 PCP S BDMED=Y,BDMEDD=$$FMTE^XLFDT(BDMED)
S BDMBD=$$FMADD^XLFDT(BDMED,-(4*30.5))
S BDMSD=$$FMADD^XLFDT(BDMBD,-1)
;
Q
ZIS ;
S BDMTEMP=""
S DIR(0)="S^P:PRINT the List;B:BROWSE the List on the Screen",DIR("A")="Output Type",DIR("B")="P" KILL DA D ^DIR KILL DIR
I $D(DIRUT) D EXIT Q
S BDMTEMP=Y
;call to XBDBQUE
DEMO ;
D DEMOCHK^BDMUTL(.BDMDEMO)
I BDMDEMO=-1 D EXIT Q
I BDMTEMP="B" D BROWSE,EXIT Q
S XBRP="PRINT^BDMDR31",XBRC="PROC^BDMDR3",XBRX="EXIT^BDMDR3",XBNS="BDM"
D ^XBDBQUE
D EXIT
Q
BROWSE ;
S XBRP="VIEWR^XBLM(""PRINT^BDMDR31"")"
S XBRC="PROC^BDMDR3",XBRX="EXIT^BDMDR3",XBIOP=0 D ^XBDBQUE
Q
EXIT ;clean up and exit
K A,B,C,P,X,Y
I '$D(BDMGUI) D EN^XBVK("BDM")
D ^XBFMK
D KILL^AUPNPAT
Q
;
PROC ;EP - called from XBDBQUE
S BDMJOB=$J,BDMBTH=$H
K ^XTMP("BDMDR3",BDMJOB,BDMBTH)
D XTMP^BDMOSUT("BDMDR3","DM LIST DM PATIENTS")
D REGPROC
Q
REGPROC ;
S X=0 F S X=$O(^ACM(41,"B",BDMREG,X)) Q:X'=+X D
.I BDMSTAT]"",$P($G(^ACM(41,X,"DT")),U,1)=BDMSTAT S DFN=$P(^ACM(41,X,0),U,2) D CHKSET Q
.I BDMSTAT="" S DFN=$P(^ACM(41,X,0),U,2) D CHKSET Q
.Q
Q
CHKSET ;
Q:$$DOD^AUPNPAT(DFN)]""
Q:$$DEMO^BDMUTL(DFN,$G(BDMDEMO))
;I BDMPCP,$P(^AUPNPAT(DFN,0),U,14)'=BDMPCP Q
S P=$$VAL^XBDIQ1(9000001,DFN,.14),P=$S(P]"":P,1:"???")
S P1=$$VALI^XBDIQ1(9000001,DFN,.14)
S C=$$COMMRES^AUPNPAT(DFN,"E"),C=$S(C]"":C,1:"???")
S ^XTMP("BDMDR3",BDMJOB,BDMBTH,"PATIENTS",P,C,$P(^DPT(DFN,0),U),DFN)=$S(P1:P1,1:"???")
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")
;----------
POST ;EP
S X=$$ADD^XPDMENU("BDM M MAIN DM MENU","BDM DM PTS 4 MONTHS","DMV")
I 'X W "Attempt to add Patients w/selected values in 4 months option failed.." H 3
Q
SUBTOT ;EP
Q:'BDMWR
S BDMSUB=""
I $Y>(BDMIOSL-9) D HEAD^BDMDR31 Q:$D(BDMQ)
W !,"Subtotals for "_$E(BDMP,1,16)_": ",?37,"# Patients",?50," # w/item done",?70,"%"
W !?2,"Last Clinic Visit",?38,$J($$C(BDMSTOT(0),0,8),9),?52,$J($$C($G(BDMSTOT(1)),0,8),9)
S X=($G(BDMSTOT(1))/BDMSTOT(0))*100
W ?67,$J(X,6,2)
W !?2,"Blood Pressure",?38,$J($$C(BDMSTOT(0),0,8),9),?52,$J($$C($G(BDMSTOT(2)),0,8),9)
S X=($G(BDMSTOT(2))/BDMSTOT(0))*100
W ?67,$J(X,6,2)
W !?2,"HGB A1C",?38,$J($$C(BDMSTOT(0),0,8),9),?52,$J($$C($G(BDMSTOT(3)),0,8),9)
S X=($G(BDMSTOT(3))/BDMSTOT(0))*100
W ?67,$J(X,6,2)
W !?2,"Total Cholesterol",?38,$J($$C(BDMSTOT(0),0,8),9),?52,$J($$C($G(BDMSTOT(4)),0,8),9)
S X=($G(BDMSTOT(4))/BDMSTOT(0))*100
W ?67,$J(X,6,2)
W !?2,"LDL Cholesterol",?38,$J($$C(BDMSTOT(0),0,8),9),?52,$J($$C($G(BDMSTOT(5)),0,8),9)
S X=($G(BDMSTOT(5))/BDMSTOT(0))*100
W ?67,$J(X,6,2)
W !?2,"HDL Cholesterol",?38,$J($$C(BDMSTOT(0),0,8),9),?52,$J($$C($G(BDMSTOT(6)),0,8),9)
S X=($G(BDMSTOT(6))/BDMSTOT(0))*100
W ?67,$J(X,6,2)
W !?2,"Triglycerides",?38,$J($$C(BDMSTOT(0),0,8),9),?52,$J($$C($G(BDMSTOT(7)),0,8),9)
S X=($G(BDMSTOT(6))/BDMSTOT(0))*100
W ?67,$J(X,6,2)
K BDMSUB
Q
FINH ;
W !,$$CTR("Value Totals/Comparisons for: "_BDMP,80),!
W !?35,"PROVIDER SPECIFIC",?56,"TOTAL REGISTER",!
W ?35,"# pats",?48,"%",?56,"# pats",?68,"%",!
Q
FINTOT ;EP
S BDMFINL=""
;print page for each provider from BDMHGB, ETC
S BDMP="" F S BDMP=$O(BDMTHGB(BDMP)) Q:BDMP=""!($D(BDMQ)) D
.S BDMP1="" F S BDMP1=$O(BDMTHGB(BDMP,BDMP1)) Q:BDMP1="" D FINTOT1
Q
FINTOT1 ;
I BDMPCP,BDMP1'=BDMPCP Q
;header, then print and calculate
D HEAD^BDMDR31
Q:$D(BDMQ)
D FINH
S BDMTOTP=$P(BDMTHGB,U),BDMTOPP=$P(BDMTHGB(BDMP,BDMP1),U)
W !,"Total Number of Patients",?33,$J($$C(BDMTOPP,0,8),9),?53,$J($$C(BDMTOTP,0,8),9),!
W !,"Blood Glucose Control"
I $Y>(BDMIOSL-4) D HEAD^BDMDR31 Q:$D(BDMQ) D FINH
S BDMPN=$P(BDMTHGB(BDMP,BDMP1),U,2),BDMTN=$P(BDMTHGB,U,2) W !?2,"HbA1c <7.0" D W
I $Y>(BDMIOSL-4) D HEAD^BDMDR31 Q:$D(BDMQ) D FINH
S BDMPN=$P(BDMTHGB(BDMP,BDMP1),U,3),BDMTN=$P(BDMTHGB,U,3) W !?8,"7.0-7.9" D W
I $Y>(BDMIOSL-4) D HEAD^BDMDR31 Q:$D(BDMQ) D FINH
S BDMPN=$P(BDMTHGB(BDMP,BDMP1),U,4),BDMTN=$P(BDMTHGB,U,4) W !?8,"8.0-8.9" D W
I $Y>(BDMIOSL-4) D HEAD^BDMDR31 Q:$D(BDMQ) D FINH
S BDMPN=$P(BDMTHGB(BDMP,BDMP1),U,5),BDMTN=$P(BDMTHGB,U,5) W !?8,"9.0-9.9" D W
I $Y>(BDMIOSL-4) D HEAD^BDMDR31 Q:$D(BDMQ) D FINH
S BDMPN=$P(BDMTHGB(BDMP,BDMP1),U,6),BDMTN=$P(BDMTHGB,U,6) W !?8,"10.0-10.9" D W
I $Y>(BDMIOSL-4) D HEAD^BDMDR31 Q:$D(BDMQ) D FINH
S BDMPN=$P(BDMTHGB(BDMP,BDMP1),U,7),BDMTN=$P(BDMTHGB,U,7) W !?8,"11.0 or higher" D W
I $Y>(BDMIOSL-4) D HEAD^BDMDR31 Q:$D(BDMQ) D FINH
S BDMPN=$P(BDMTHGB(BDMP,BDMP1),U,8),BDMTN=$P(BDMTHGB,U,8) W !?8,"Tested but no value" D W
I $Y>(BDMIOSL-4) D HEAD^BDMDR31 Q:$D(BDMQ) D FINH
S BDMPN=$P(BDMTHGB(BDMP,BDMP1),U,9),BDMTN=$P(BDMTHGB,U,9) W !?8,"Not tested in 4 months" D W
FINBP ;
I $Y>(BDMIOSL-4) D HEAD^BDMDR31 Q:$D(BDMQ) D FINH
W !!,"Blood Pressure Control"
I $Y>(BDMIOSL-4) D HEAD^BDMDR31 Q:$D(BDMQ) D FINH
S BDMPN=$P(BDMTBP(BDMP,BDMP1),U,2),BDMTN=$P(BDMTBP,U,2) W !?8,"<120/80" D W
I $Y>(BDMIOSL-4) D HEAD^BDMDR31 Q:$D(BDMQ) D FINH
S BDMPN=$P(BDMTBP(BDMP,BDMP1),U,3),BDMTN=$P(BDMTBP,U,3) W !?8,"120/80-<130/85" D W
I $Y>(BDMIOSL-4) D HEAD^BDMDR31 Q:$D(BDMQ) D FINH
S BDMPN=$P(BDMTBP(BDMP,BDMP1),U,4),BDMTN=$P(BDMTBP,U,4) W !?8,"130/85-<140/90" D W
I $Y>(BDMIOSL-4) D HEAD^BDMDR31 Q:$D(BDMQ) D FINH
S BDMPN=$P(BDMTBP(BDMP,BDMP1),U,5),BDMTN=$P(BDMTBP,U,5) W !?8,"140/90-<160/95" D W
I $Y>(BDMIOSL-4) D HEAD^BDMDR31 Q:$D(BDMQ) D FINH
S BDMPN=$P(BDMTBP(BDMP,BDMP1),U,6),BDMTN=$P(BDMTBP,U,6) W !?8,"160/95 or higher" D W
I $Y>(BDMIOSL-4) D HEAD^BDMDR31 Q:$D(BDMQ) D FINH
S BDMPN=$P(BDMTBP(BDMP,BDMP1),U,7),BDMTN=$P(BDMTBP,U,7) W !?8,"Not tested in 4 months" D W
FINTC ;
I $Y>(BDMIOSL-4) D HEAD^BDMDR31 Q:$D(BDMQ) D FINH
W !!,"Total Cholesterol"
I $Y>(BDMIOSL-4) D HEAD^BDMDR31 Q:$D(BDMQ) D FINH
S BDMPN=$P(BDMTTC(BDMP,BDMP1),U,2),BDMTN=$P(BDMTTC,U,2) W !?8,"<200 mg/dl" D W
I $Y>(BDMIOSL-4) D HEAD^BDMDR31 Q:$D(BDMQ) D FINH
S BDMPN=$P(BDMTTC(BDMP,BDMP1),U,3),BDMTN=$P(BDMTTC,U,3) W !?8,"200-239 mg/dl" D W
I $Y>(BDMIOSL-4) D HEAD^BDMDR31 Q:$D(BDMQ) D FINH
S BDMPN=$P(BDMTTC(BDMP,BDMP1),U,4),BDMTN=$P(BDMTTC,U,4) W !?8,">240 mg/dl" D W
;I $Y>(BDMIOSL-4) D HEAD^BDMDR31 Q:$D(BDMQ) D FINH
;S BDMPN=$P(BDMTTC(BDMP,BDMP1),U,5),BDMTN=$P(BDMTTC,U,5) W !?8,">160 mg/dl" D W
I $Y>(BDMIOSL-4) D HEAD^BDMDR31 Q:$D(BDMQ) D FINH
S BDMPN=$P(BDMTTC(BDMP,BDMP1),U,6),BDMTN=$P(BDMTTC,U,6) W !?8,"Tested but no value" D W
I $Y>(BDMIOSL-4) D HEAD^BDMDR31 Q:$D(BDMQ) D FINH
S BDMPN=$P(BDMTTC(BDMP,BDMP1),U,7),BDMTN=$P(BDMTTC,U,7) W !?8,"Not tested in 15 months" D W
FINLDL ;
I $Y>(BDMIOSL-4) D HEAD^BDMDR31 Q:$D(BDMQ) D FINH
W !!,"LDL Cholesterol"
I $Y>(BDMIOSL-4) D HEAD^BDMDR31 Q:$D(BDMQ) D FINH
S BDMPN=$P(BDMTLDL(BDMP,BDMP1),U,2),BDMTN=$P(BDMTLDL,U,2) W !?8,"<100 mg/dl" D W
I $Y>(BDMIOSL-4) D HEAD^BDMDR31 Q:$D(BDMQ) D FINH
S BDMPN=$P(BDMTLDL(BDMP,BDMP1),U,3),BDMTN=$P(BDMTLDL,U,3) W !?8,"100-129 mg/dl" D W
I $Y>(BDMIOSL-4) D HEAD^BDMDR31 Q:$D(BDMQ) D FINH
S BDMPN=$P(BDMTLDL(BDMP,BDMP1),U,4),BDMTN=$P(BDMTLDL,U,4) W !?8,"130-160 mg/dl" D W
I $Y>(BDMIOSL-4) D HEAD^BDMDR31 Q:$D(BDMQ) D FINH
S BDMPN=$P(BDMTLDL(BDMP,BDMP1),U,5),BDMTN=$P(BDMTLDL,U,5) W !?8,">160 mg/dl" D W
I $Y>(BDMIOSL-4) D HEAD^BDMDR31 Q:$D(BDMQ) D FINH
S BDMPN=$P(BDMTLDL(BDMP,BDMP1),U,6),BDMTN=$P(BDMTLDL,U,6) W !?8,"Tested but no value" D W
I $Y>(BDMIOSL-4) D HEAD^BDMDR31 Q:$D(BDMQ) D FINH
S BDMPN=$P(BDMTLDL(BDMP,BDMP1),U,7),BDMTN=$P(BDMTLDL,U,7) W !?8,"Not tested in 15 months" D W
FINHDL ;
I $Y>(BDMIOSL-4) D HEAD^BDMDR31 Q:$D(BDMQ) D FINH
W !!,"HDL Cholesterol"
I $Y>(BDMIOSL-4) D HEAD^BDMDR31 Q:$D(BDMQ) D FINH
S BDMPN=$P(BDMTHDL(BDMP,BDMP1),U,2),BDMTN=$P(BDMTHDL,U,2) W !?8,"<35 mg/dl" D W
I $Y>(BDMIOSL-4) D HEAD^BDMDR31 Q:$D(BDMQ) D FINH
S BDMPN=$P(BDMTHDL(BDMP,BDMP1),U,3),BDMTN=$P(BDMTHDL,U,3) W !?8,"35-45 mg/dl" D W
I $Y>(BDMIOSL-4) D HEAD^BDMDR31 Q:$D(BDMQ) D FINH
S BDMPN=$P(BDMTHDL(BDMP,BDMP1),U,4),BDMTN=$P(BDMTHDL,U,4) W !?8,"46-55 mg/dl" D W
I $Y>(BDMIOSL-4) D HEAD^BDMDR31 Q:$D(BDMQ) D FINH
S BDMPN=$P(BDMTHDL(BDMP,BDMP1),U,5),BDMTN=$P(BDMTHDL,U,5) W !?8,">55 mg/dl" D W
I $Y>(BDMIOSL-4) D HEAD^BDMDR31 Q:$D(BDMQ) D FINH
S BDMPN=$P(BDMTHDL(BDMP,BDMP1),U,6),BDMTN=$P(BDMTHDL,U,6) W !?8,"Tested but no value" D W
I $Y>(BDMIOSL-4) D HEAD^BDMDR31 Q:$D(BDMQ) D FINH
S BDMPN=$P(BDMTHDL(BDMP,BDMP1),U,7),BDMTN=$P(BDMTHDL,U,7) W !?8,"Not tested in 15 months" D W
;
FINTRIG ;
I $Y>(BDMIOSL-4) D HEAD^BDMDR31 Q:$D(BDMQ) D FINH
W !!,"Triglycerides"
I $Y>(BDMIOSL-4) D HEAD^BDMDR31 Q:$D(BDMQ) D FINH
S BDMPN=$P(BDMTTRIG(BDMP,BDMP1),U,2),BDMTN=$P(BDMTTRIG,U,2) W !?8,"<100 mg/dl" D W
I $Y>(BDMIOSL-4) D HEAD^BDMDR31 Q:$D(BDMQ) D FINH
S BDMPN=$P(BDMTTRIG(BDMP,BDMP1),U,3),BDMTN=$P(BDMTTRIG,U,3) W !?8,"100-129 mg/dl" D W
I $Y>(BDMIOSL-4) D HEAD^BDMDR31 Q:$D(BDMQ) D FINH
S BDMPN=$P(BDMTTRIG(BDMP,BDMP1),U,4),BDMTN=$P(BDMTTRIG,U,4) W !?8,"130-160 mg/dl" D W
I $Y>(BDMIOSL-4) D HEAD^BDMDR31 Q:$D(BDMQ) D FINH
S BDMPN=$P(BDMTTRIG(BDMP,BDMP1),U,5),BDMTN=$P(BDMTTRIG,U,5) W !?8,">160 mg/dl" D W
I $Y>(BDMIOSL-4) D HEAD^BDMDR31 Q:$D(BDMQ) D FINH
S BDMPN=$P(BDMTTRIG(BDMP,BDMP1),U,6),BDMTN=$P(BDMTTRIG,U,6) W !?8,"Tested but no value" D W
I $Y>(BDMIOSL-4) D HEAD^BDMDR31 Q:$D(BDMQ) D FINH
S BDMPN=$P(BDMTTRIG(BDMP,BDMP1),U,7),BDMTN=$P(BDMTTRIG,U,7) W !?8,"Not tested in 15 months" D W
Q
W ;
W ?33,$J($$C(BDMPN,0,8),9),?45,$$PER(BDMPN,BDMTOPP),?53,$J($$C(BDMTN,0,8),9),?65,$$PER(BDMTN,BDMTOTP)
Q
PER(N,D) ;n=numerator, d=denominator
I $G(D)="" Q ""
I $G(D)=0 Q ""
NEW X,Y,Z
S X=N/D,X=X*100,X=$J(X,5,1)
Q X
;
TEST ;
D BDMG(1,"A",,DT,"ACTIVE")
Q
BDMG(BDMREG,BDMSTAT,BDMPCP,BDMED,BDMSTAR) ;EP - GUI DMS Entry Point
;cmi/anch/maw added 10/19/2004
S BDMEDD=$$FMTE^XLFDT(BDMED)
S BDMGUI=1
S BDMBD=$$FMADD^XLFDT(BDMED,-(4*30.5))
S BDMSD=$$FMADD^XLFDT(BDMBD,-1)
S BDMPCP=$G(BDMPCP)
NEW BDMNOW,BDMOPT,BDMIEN
S BDMOPT="DM Register Patients and Select Values in 4 Months"
D NOW^%DTC
S BDMNOW=$G(%)
K DD,DO,DIC
S X=DUZ_BDMNOW
S DIC("DR")=".02////"_DUZ_";.03////"_BDMNOW_";.06///"_$G(BDMOPT)_";.07////R"
S DIC="^BDMGUI(",DIC(0)="L",DIADD=1,DLAYGO=9003201.4
D FILE^DICN
K DIADD,DLAYGO,DIC,DA
I Y=-1 S BDMIEN=-1 Q
S BDMIEN=+Y
S BDMGIEN=BDMIEN ;cmi/maw added
D ^XBFMK
K ZTSAVE S ZTSAVE("*")=""
;D GUIEP for interactive testing
S ZTIO="",ZTDTH=$$NOW^XLFDT,ZTRTN="GUIEP^BDMDR3",ZTDESC="GUI DM 4 MONTHS" D ^%ZTLOAD
D EXIT
Q
GUIEP ;EP
D PROC
K ^TMP($J,"BDMDR3")
S IOM=80
D GUIR^XBLM("PRINT^BDMDR31","^TMP($J,""BDMDR3"",")
S X=0,C=0 F S X=$O(^TMP($J,"BDMDR3",X)) Q:X'=+X D
.S BDMDATA=^TMP($J,"BDMDR3",X)
.;I BDMDATA="ZZZZZZZ" ;S BDMDATA=$C(12)
.S ^BDMGUI(BDMIEN,11,X,0)=BDMDATA,C=C+1
S ^BDMGUI(BDMIEN,11,0)="^^"_C_"^"_C_"^"_DT_"^"
S DA=BDMIEN,DIK="^BDMGUI(" D IX1^DIK
D ENDLOG
K ^TMP($J,"BDMDR3")
D EXIT
S ZTREQ="@"
Q
;
ENDLOG ;-- write the end of the log
D NOW^%DTC
S BDMNOW=$G(%)
S DIE="^BDMGUI(",DA=BDMIEN,DR=".04////"_BDMNOW_";.07////C"
D ^DIE
K DIE,DR,DA
Q
BDMDR3 ; IHS/CMI/LAB - patients dm list - chinle ;
+1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**2,4,8,10**;JUN 14, 2007;Build 12
+2 ;
+3 ;
START ;
+1 DO INFORM
+2 DO EXIT
+3 DO GETINFO
+4 IF $DATA(BDMQUIT)
DO EXIT
QUIT
+5 DO ZIS
+6 QUIT
INFORM ;
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,$$CTR($$LOC)
+3 WRITE !,$$CTR($$USR)
+4 WRITE !!,"This report will list patients who are on the diabetes register",!,"that you select.",!,"The following data items will be printed for each patient: Name, HRN, DOB",!,"Community of Residence.",!
+5 WRITE !,"For each of the following tests the last value in the 4 months prior to the",!,"as of date you enter and the next most recent prior to that one will be",!,"displayed:"
+6 WRITE !?5,"Hgb A1C, BP, Total Cholesterol, HDL, LDL, Triglyceride, Last visit date",!!
+7 QUIT
+8 ;
GETINFO ;
R ;
+1 WRITE !!,"Patients must be a member of the Diabetes Register in order to be included in",!,"this report.",!
+2 SET BDMREG=""
+3 SET DIC="^ACM(41.1,"
SET DIC(0)="AEMQ"
SET DIC("A")="Enter the Name of the DM Register: "
DO ^DIC
+4 IF Y=-1
WRITE !,"No register selected."
SET BDMQUIT=""
QUIT
+5 SET BDMREG=+Y
+6 ;get status
+7 SET BDMSTAT=""
+8 SET DIR(0)="Y"
SET DIR("A")="Do you want to select register patients with a particular status"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+9 IF $DATA(DIRUT)
GOTO R
+10 IF Y=0
SET BDMSTAT=""
GOTO PCP
+11 ;which status
+12 SET DIR(0)="9002241,1"
SET DIR("A")="Which status"
SET DIR("B")="A"
KILL DA
DO ^DIR
KILL DIR
+13 IF $DATA(DIRUT)
GOTO R
+14 SET BDMSTAT=Y
SET BDMSTAR=Y(0)
PCP ;
+1 SET BDMPCP=""
+2 SET DIR(0)="Y"
SET DIR("A")="Limit the report to a particular primary care provider "
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
GOTO R
+4 IF 'Y
GOTO EDATE
+5 KILL DIC
SET DIC=$SELECT($PIECE(^DD(9000001,.14,0),U,2)[200:200,1:6)
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
+6 IF Y=-1
GOTO PCP
+7 SET BDMPCP=+Y
EDATE ;get visit date range for functional assessment
+1 SET BDMED=""
+2 KILL DIR
WRITE !
SET DIR(0)="D^::EXP"
SET DIR("A")="Enter As of Date for 4 month period"
+3 DO ^DIR
KILL DIR
IF Y<1
GOTO PCP
SET BDMED=Y
SET BDMEDD=$$FMTE^XLFDT(BDMED)
+4 SET BDMBD=$$FMADD^XLFDT(BDMED,-(4*30.5))
+5 SET BDMSD=$$FMADD^XLFDT(BDMBD,-1)
+6 ;
+7 QUIT
ZIS ;
+1 SET BDMTEMP=""
+2 SET DIR(0)="S^P:PRINT the List;B:BROWSE the List on the Screen"
SET DIR("A")="Output Type"
SET DIR("B")="P"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
DO EXIT
QUIT
+4 SET BDMTEMP=Y
+5 ;call to XBDBQUE
DEMO ;
+1 DO DEMOCHK^BDMUTL(.BDMDEMO)
+2 IF BDMDEMO=-1
DO EXIT
QUIT
+3 IF BDMTEMP="B"
DO BROWSE
DO EXIT
QUIT
+4 SET XBRP="PRINT^BDMDR31"
SET XBRC="PROC^BDMDR3"
SET XBRX="EXIT^BDMDR3"
SET XBNS="BDM"
+5 DO ^XBDBQUE
+6 DO EXIT
+7 QUIT
BROWSE ;
+1 SET XBRP="VIEWR^XBLM(""PRINT^BDMDR31"")"
+2 SET XBRC="PROC^BDMDR3"
SET XBRX="EXIT^BDMDR3"
SET XBIOP=0
DO ^XBDBQUE
+3 QUIT
EXIT ;clean up and exit
+1 KILL A,B,C,P,X,Y
+2 IF '$DATA(BDMGUI)
DO EN^XBVK("BDM")
+3 DO ^XBFMK
+4 DO KILL^AUPNPAT
+5 QUIT
+6 ;
PROC ;EP - called from XBDBQUE
+1 SET BDMJOB=$JOB
SET BDMBTH=$HOROLOG
+2 KILL ^XTMP("BDMDR3",BDMJOB,BDMBTH)
+3 DO XTMP^BDMOSUT("BDMDR3","DM LIST DM PATIENTS")
+4 DO REGPROC
+5 QUIT
REGPROC ;
+1 SET X=0
FOR
SET X=$ORDER(^ACM(41,"B",BDMREG,X))
IF X'=+X
QUIT
Begin DoDot:1
+2 IF BDMSTAT]""
IF $PIECE($GET(^ACM(41,X,"DT")),U,1)=BDMSTAT
SET DFN=$PIECE(^ACM(41,X,0),U,2)
DO CHKSET
QUIT
+3 IF BDMSTAT=""
SET DFN=$PIECE(^ACM(41,X,0),U,2)
DO CHKSET
QUIT
+4 QUIT
End DoDot:1
+5 QUIT
CHKSET ;
+1 IF $$DOD^AUPNPAT(DFN)]""
QUIT
+2 IF $$DEMO^BDMUTL(DFN,$GET(BDMDEMO))
QUIT
+3 ;I BDMPCP,$P(^AUPNPAT(DFN,0),U,14)'=BDMPCP Q
+4 SET P=$$VAL^XBDIQ1(9000001,DFN,.14)
SET P=$SELECT(P]"":P,1:"???")
+5 SET P1=$$VALI^XBDIQ1(9000001,DFN,.14)
+6 SET C=$$COMMRES^AUPNPAT(DFN,"E")
SET C=$SELECT(C]"":C,1:"???")
+7 SET ^XTMP("BDMDR3",BDMJOB,BDMBTH,"PATIENTS",P,C,$PIECE(^DPT(DFN,0),U),DFN)=$SELECT(P1:P1,1:"???")
+8 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 ;----------
POST ;EP
+1 SET X=$$ADD^XPDMENU("BDM M MAIN DM MENU","BDM DM PTS 4 MONTHS","DMV")
+2 IF 'X
WRITE "Attempt to add Patients w/selected values in 4 months option failed.."
HANG 3
+3 QUIT
SUBTOT ;EP
+1 IF 'BDMWR
QUIT
+2 SET BDMSUB=""
+3 IF $Y>(BDMIOSL-9)
DO HEAD^BDMDR31
IF $DATA(BDMQ)
QUIT
+4 WRITE !,"Subtotals for "_$EXTRACT(BDMP,1,16)_": ",?37,"# Patients",?50," # w/item done",?70,"%"
+5 WRITE !?2,"Last Clinic Visit",?38,$JUSTIFY($$C(BDMSTOT(0),0,8),9),?52,$JUSTIFY($$C($GET(BDMSTOT(1)),0,8),9)
+6 SET X=($GET(BDMSTOT(1))/BDMSTOT(0))*100
+7 WRITE ?67,$JUSTIFY(X,6,2)
+8 WRITE !?2,"Blood Pressure",?38,$JUSTIFY($$C(BDMSTOT(0),0,8),9),?52,$JUSTIFY($$C($GET(BDMSTOT(2)),0,8),9)
+9 SET X=($GET(BDMSTOT(2))/BDMSTOT(0))*100
+10 WRITE ?67,$JUSTIFY(X,6,2)
+11 WRITE !?2,"HGB A1C",?38,$JUSTIFY($$C(BDMSTOT(0),0,8),9),?52,$JUSTIFY($$C($GET(BDMSTOT(3)),0,8),9)
+12 SET X=($GET(BDMSTOT(3))/BDMSTOT(0))*100
+13 WRITE ?67,$JUSTIFY(X,6,2)
+14 WRITE !?2,"Total Cholesterol",?38,$JUSTIFY($$C(BDMSTOT(0),0,8),9),?52,$JUSTIFY($$C($GET(BDMSTOT(4)),0,8),9)
+15 SET X=($GET(BDMSTOT(4))/BDMSTOT(0))*100
+16 WRITE ?67,$JUSTIFY(X,6,2)
+17 WRITE !?2,"LDL Cholesterol",?38,$JUSTIFY($$C(BDMSTOT(0),0,8),9),?52,$JUSTIFY($$C($GET(BDMSTOT(5)),0,8),9)
+18 SET X=($GET(BDMSTOT(5))/BDMSTOT(0))*100
+19 WRITE ?67,$JUSTIFY(X,6,2)
+20 WRITE !?2,"HDL Cholesterol",?38,$JUSTIFY($$C(BDMSTOT(0),0,8),9),?52,$JUSTIFY($$C($GET(BDMSTOT(6)),0,8),9)
+21 SET X=($GET(BDMSTOT(6))/BDMSTOT(0))*100
+22 WRITE ?67,$JUSTIFY(X,6,2)
+23 WRITE !?2,"Triglycerides",?38,$JUSTIFY($$C(BDMSTOT(0),0,8),9),?52,$JUSTIFY($$C($GET(BDMSTOT(7)),0,8),9)
+24 SET X=($GET(BDMSTOT(6))/BDMSTOT(0))*100
+25 WRITE ?67,$JUSTIFY(X,6,2)
+26 KILL BDMSUB
+27 QUIT
FINH ;
+1 WRITE !,$$CTR("Value Totals/Comparisons for: "_BDMP,80),!
+2 WRITE !?35,"PROVIDER SPECIFIC",?56,"TOTAL REGISTER",!
+3 WRITE ?35,"# pats",?48,"%",?56,"# pats",?68,"%",!
+4 QUIT
FINTOT ;EP
+1 SET BDMFINL=""
+2 ;print page for each provider from BDMHGB, ETC
+3 SET BDMP=""
FOR
SET BDMP=$ORDER(BDMTHGB(BDMP))
IF BDMP=""!($DATA(BDMQ))
QUIT
Begin DoDot:1
+4 SET BDMP1=""
FOR
SET BDMP1=$ORDER(BDMTHGB(BDMP,BDMP1))
IF BDMP1=""
QUIT
DO FINTOT1
End DoDot:1
+5 QUIT
FINTOT1 ;
+1 IF BDMPCP
IF BDMP1'=BDMPCP
QUIT
+2 ;header, then print and calculate
+3 DO HEAD^BDMDR31
+4 IF $DATA(BDMQ)
QUIT
+5 DO FINH
+6 SET BDMTOTP=$PIECE(BDMTHGB,U)
SET BDMTOPP=$PIECE(BDMTHGB(BDMP,BDMP1),U)
+7 WRITE !,"Total Number of Patients",?33,$JUSTIFY($$C(BDMTOPP,0,8),9),?53,$JUSTIFY($$C(BDMTOTP,0,8),9),!
+8 WRITE !,"Blood Glucose Control"
+9 IF $Y>(BDMIOSL-4)
DO HEAD^BDMDR31
IF $DATA(BDMQ)
QUIT
DO FINH
+10 SET BDMPN=$PIECE(BDMTHGB(BDMP,BDMP1),U,2)
SET BDMTN=$PIECE(BDMTHGB,U,2)
WRITE !?2,"HbA1c <7.0"
DO W
+11 IF $Y>(BDMIOSL-4)
DO HEAD^BDMDR31
IF $DATA(BDMQ)
QUIT
DO FINH
+12 SET BDMPN=$PIECE(BDMTHGB(BDMP,BDMP1),U,3)
SET BDMTN=$PIECE(BDMTHGB,U,3)
WRITE !?8,"7.0-7.9"
DO W
+13 IF $Y>(BDMIOSL-4)
DO HEAD^BDMDR31
IF $DATA(BDMQ)
QUIT
DO FINH
+14 SET BDMPN=$PIECE(BDMTHGB(BDMP,BDMP1),U,4)
SET BDMTN=$PIECE(BDMTHGB,U,4)
WRITE !?8,"8.0-8.9"
DO W
+15 IF $Y>(BDMIOSL-4)
DO HEAD^BDMDR31
IF $DATA(BDMQ)
QUIT
DO FINH
+16 SET BDMPN=$PIECE(BDMTHGB(BDMP,BDMP1),U,5)
SET BDMTN=$PIECE(BDMTHGB,U,5)
WRITE !?8,"9.0-9.9"
DO W
+17 IF $Y>(BDMIOSL-4)
DO HEAD^BDMDR31
IF $DATA(BDMQ)
QUIT
DO FINH
+18 SET BDMPN=$PIECE(BDMTHGB(BDMP,BDMP1),U,6)
SET BDMTN=$PIECE(BDMTHGB,U,6)
WRITE !?8,"10.0-10.9"
DO W
+19 IF $Y>(BDMIOSL-4)
DO HEAD^BDMDR31
IF $DATA(BDMQ)
QUIT
DO FINH
+20 SET BDMPN=$PIECE(BDMTHGB(BDMP,BDMP1),U,7)
SET BDMTN=$PIECE(BDMTHGB,U,7)
WRITE !?8,"11.0 or higher"
DO W
+21 IF $Y>(BDMIOSL-4)
DO HEAD^BDMDR31
IF $DATA(BDMQ)
QUIT
DO FINH
+22 SET BDMPN=$PIECE(BDMTHGB(BDMP,BDMP1),U,8)
SET BDMTN=$PIECE(BDMTHGB,U,8)
WRITE !?8,"Tested but no value"
DO W
+23 IF $Y>(BDMIOSL-4)
DO HEAD^BDMDR31
IF $DATA(BDMQ)
QUIT
DO FINH
+24 SET BDMPN=$PIECE(BDMTHGB(BDMP,BDMP1),U,9)
SET BDMTN=$PIECE(BDMTHGB,U,9)
WRITE !?8,"Not tested in 4 months"
DO W
FINBP ;
+1 IF $Y>(BDMIOSL-4)
DO HEAD^BDMDR31
IF $DATA(BDMQ)
QUIT
DO FINH
+2 WRITE !!,"Blood Pressure Control"
+3 IF $Y>(BDMIOSL-4)
DO HEAD^BDMDR31
IF $DATA(BDMQ)
QUIT
DO FINH
+4 SET BDMPN=$PIECE(BDMTBP(BDMP,BDMP1),U,2)
SET BDMTN=$PIECE(BDMTBP,U,2)
WRITE !?8,"<120/80"
DO W
+5 IF $Y>(BDMIOSL-4)
DO HEAD^BDMDR31
IF $DATA(BDMQ)
QUIT
DO FINH
+6 SET BDMPN=$PIECE(BDMTBP(BDMP,BDMP1),U,3)
SET BDMTN=$PIECE(BDMTBP,U,3)
WRITE !?8,"120/80-<130/85"
DO W
+7 IF $Y>(BDMIOSL-4)
DO HEAD^BDMDR31
IF $DATA(BDMQ)
QUIT
DO FINH
+8 SET BDMPN=$PIECE(BDMTBP(BDMP,BDMP1),U,4)
SET BDMTN=$PIECE(BDMTBP,U,4)
WRITE !?8,"130/85-<140/90"
DO W
+9 IF $Y>(BDMIOSL-4)
DO HEAD^BDMDR31
IF $DATA(BDMQ)
QUIT
DO FINH
+10 SET BDMPN=$PIECE(BDMTBP(BDMP,BDMP1),U,5)
SET BDMTN=$PIECE(BDMTBP,U,5)
WRITE !?8,"140/90-<160/95"
DO W
+11 IF $Y>(BDMIOSL-4)
DO HEAD^BDMDR31
IF $DATA(BDMQ)
QUIT
DO FINH
+12 SET BDMPN=$PIECE(BDMTBP(BDMP,BDMP1),U,6)
SET BDMTN=$PIECE(BDMTBP,U,6)
WRITE !?8,"160/95 or higher"
DO W
+13 IF $Y>(BDMIOSL-4)
DO HEAD^BDMDR31
IF $DATA(BDMQ)
QUIT
DO FINH
+14 SET BDMPN=$PIECE(BDMTBP(BDMP,BDMP1),U,7)
SET BDMTN=$PIECE(BDMTBP,U,7)
WRITE !?8,"Not tested in 4 months"
DO W
FINTC ;
+1 IF $Y>(BDMIOSL-4)
DO HEAD^BDMDR31
IF $DATA(BDMQ)
QUIT
DO FINH
+2 WRITE !!,"Total Cholesterol"
+3 IF $Y>(BDMIOSL-4)
DO HEAD^BDMDR31
IF $DATA(BDMQ)
QUIT
DO FINH
+4 SET BDMPN=$PIECE(BDMTTC(BDMP,BDMP1),U,2)
SET BDMTN=$PIECE(BDMTTC,U,2)
WRITE !?8,"<200 mg/dl"
DO W
+5 IF $Y>(BDMIOSL-4)
DO HEAD^BDMDR31
IF $DATA(BDMQ)
QUIT
DO FINH
+6 SET BDMPN=$PIECE(BDMTTC(BDMP,BDMP1),U,3)
SET BDMTN=$PIECE(BDMTTC,U,3)
WRITE !?8,"200-239 mg/dl"
DO W
+7 IF $Y>(BDMIOSL-4)
DO HEAD^BDMDR31
IF $DATA(BDMQ)
QUIT
DO FINH
+8 SET BDMPN=$PIECE(BDMTTC(BDMP,BDMP1),U,4)
SET BDMTN=$PIECE(BDMTTC,U,4)
WRITE !?8,">240 mg/dl"
DO W
+9 ;I $Y>(BDMIOSL-4) D HEAD^BDMDR31 Q:$D(BDMQ) D FINH
+10 ;S BDMPN=$P(BDMTTC(BDMP,BDMP1),U,5),BDMTN=$P(BDMTTC,U,5) W !?8,">160 mg/dl" D W
+11 IF $Y>(BDMIOSL-4)
DO HEAD^BDMDR31
IF $DATA(BDMQ)
QUIT
DO FINH
+12 SET BDMPN=$PIECE(BDMTTC(BDMP,BDMP1),U,6)
SET BDMTN=$PIECE(BDMTTC,U,6)
WRITE !?8,"Tested but no value"
DO W
+13 IF $Y>(BDMIOSL-4)
DO HEAD^BDMDR31
IF $DATA(BDMQ)
QUIT
DO FINH
+14 SET BDMPN=$PIECE(BDMTTC(BDMP,BDMP1),U,7)
SET BDMTN=$PIECE(BDMTTC,U,7)
WRITE !?8,"Not tested in 15 months"
DO W
FINLDL ;
+1 IF $Y>(BDMIOSL-4)
DO HEAD^BDMDR31
IF $DATA(BDMQ)
QUIT
DO FINH
+2 WRITE !!,"LDL Cholesterol"
+3 IF $Y>(BDMIOSL-4)
DO HEAD^BDMDR31
IF $DATA(BDMQ)
QUIT
DO FINH
+4 SET BDMPN=$PIECE(BDMTLDL(BDMP,BDMP1),U,2)
SET BDMTN=$PIECE(BDMTLDL,U,2)
WRITE !?8,"<100 mg/dl"
DO W
+5 IF $Y>(BDMIOSL-4)
DO HEAD^BDMDR31
IF $DATA(BDMQ)
QUIT
DO FINH
+6 SET BDMPN=$PIECE(BDMTLDL(BDMP,BDMP1),U,3)
SET BDMTN=$PIECE(BDMTLDL,U,3)
WRITE !?8,"100-129 mg/dl"
DO W
+7 IF $Y>(BDMIOSL-4)
DO HEAD^BDMDR31
IF $DATA(BDMQ)
QUIT
DO FINH
+8 SET BDMPN=$PIECE(BDMTLDL(BDMP,BDMP1),U,4)
SET BDMTN=$PIECE(BDMTLDL,U,4)
WRITE !?8,"130-160 mg/dl"
DO W
+9 IF $Y>(BDMIOSL-4)
DO HEAD^BDMDR31
IF $DATA(BDMQ)
QUIT
DO FINH
+10 SET BDMPN=$PIECE(BDMTLDL(BDMP,BDMP1),U,5)
SET BDMTN=$PIECE(BDMTLDL,U,5)
WRITE !?8,">160 mg/dl"
DO W
+11 IF $Y>(BDMIOSL-4)
DO HEAD^BDMDR31
IF $DATA(BDMQ)
QUIT
DO FINH
+12 SET BDMPN=$PIECE(BDMTLDL(BDMP,BDMP1),U,6)
SET BDMTN=$PIECE(BDMTLDL,U,6)
WRITE !?8,"Tested but no value"
DO W
+13 IF $Y>(BDMIOSL-4)
DO HEAD^BDMDR31
IF $DATA(BDMQ)
QUIT
DO FINH
+14 SET BDMPN=$PIECE(BDMTLDL(BDMP,BDMP1),U,7)
SET BDMTN=$PIECE(BDMTLDL,U,7)
WRITE !?8,"Not tested in 15 months"
DO W
FINHDL ;
+1 IF $Y>(BDMIOSL-4)
DO HEAD^BDMDR31
IF $DATA(BDMQ)
QUIT
DO FINH
+2 WRITE !!,"HDL Cholesterol"
+3 IF $Y>(BDMIOSL-4)
DO HEAD^BDMDR31
IF $DATA(BDMQ)
QUIT
DO FINH
+4 SET BDMPN=$PIECE(BDMTHDL(BDMP,BDMP1),U,2)
SET BDMTN=$PIECE(BDMTHDL,U,2)
WRITE !?8,"<35 mg/dl"
DO W
+5 IF $Y>(BDMIOSL-4)
DO HEAD^BDMDR31
IF $DATA(BDMQ)
QUIT
DO FINH
+6 SET BDMPN=$PIECE(BDMTHDL(BDMP,BDMP1),U,3)
SET BDMTN=$PIECE(BDMTHDL,U,3)
WRITE !?8,"35-45 mg/dl"
DO W
+7 IF $Y>(BDMIOSL-4)
DO HEAD^BDMDR31
IF $DATA(BDMQ)
QUIT
DO FINH
+8 SET BDMPN=$PIECE(BDMTHDL(BDMP,BDMP1),U,4)
SET BDMTN=$PIECE(BDMTHDL,U,4)
WRITE !?8,"46-55 mg/dl"
DO W
+9 IF $Y>(BDMIOSL-4)
DO HEAD^BDMDR31
IF $DATA(BDMQ)
QUIT
DO FINH
+10 SET BDMPN=$PIECE(BDMTHDL(BDMP,BDMP1),U,5)
SET BDMTN=$PIECE(BDMTHDL,U,5)
WRITE !?8,">55 mg/dl"
DO W
+11 IF $Y>(BDMIOSL-4)
DO HEAD^BDMDR31
IF $DATA(BDMQ)
QUIT
DO FINH
+12 SET BDMPN=$PIECE(BDMTHDL(BDMP,BDMP1),U,6)
SET BDMTN=$PIECE(BDMTHDL,U,6)
WRITE !?8,"Tested but no value"
DO W
+13 IF $Y>(BDMIOSL-4)
DO HEAD^BDMDR31
IF $DATA(BDMQ)
QUIT
DO FINH
+14 SET BDMPN=$PIECE(BDMTHDL(BDMP,BDMP1),U,7)
SET BDMTN=$PIECE(BDMTHDL,U,7)
WRITE !?8,"Not tested in 15 months"
DO W
+15 ;
FINTRIG ;
+1 IF $Y>(BDMIOSL-4)
DO HEAD^BDMDR31
IF $DATA(BDMQ)
QUIT
DO FINH
+2 WRITE !!,"Triglycerides"
+3 IF $Y>(BDMIOSL-4)
DO HEAD^BDMDR31
IF $DATA(BDMQ)
QUIT
DO FINH
+4 SET BDMPN=$PIECE(BDMTTRIG(BDMP,BDMP1),U,2)
SET BDMTN=$PIECE(BDMTTRIG,U,2)
WRITE !?8,"<100 mg/dl"
DO W
+5 IF $Y>(BDMIOSL-4)
DO HEAD^BDMDR31
IF $DATA(BDMQ)
QUIT
DO FINH
+6 SET BDMPN=$PIECE(BDMTTRIG(BDMP,BDMP1),U,3)
SET BDMTN=$PIECE(BDMTTRIG,U,3)
WRITE !?8,"100-129 mg/dl"
DO W
+7 IF $Y>(BDMIOSL-4)
DO HEAD^BDMDR31
IF $DATA(BDMQ)
QUIT
DO FINH
+8 SET BDMPN=$PIECE(BDMTTRIG(BDMP,BDMP1),U,4)
SET BDMTN=$PIECE(BDMTTRIG,U,4)
WRITE !?8,"130-160 mg/dl"
DO W
+9 IF $Y>(BDMIOSL-4)
DO HEAD^BDMDR31
IF $DATA(BDMQ)
QUIT
DO FINH
+10 SET BDMPN=$PIECE(BDMTTRIG(BDMP,BDMP1),U,5)
SET BDMTN=$PIECE(BDMTTRIG,U,5)
WRITE !?8,">160 mg/dl"
DO W
+11 IF $Y>(BDMIOSL-4)
DO HEAD^BDMDR31
IF $DATA(BDMQ)
QUIT
DO FINH
+12 SET BDMPN=$PIECE(BDMTTRIG(BDMP,BDMP1),U,6)
SET BDMTN=$PIECE(BDMTTRIG,U,6)
WRITE !?8,"Tested but no value"
DO W
+13 IF $Y>(BDMIOSL-4)
DO HEAD^BDMDR31
IF $DATA(BDMQ)
QUIT
DO FINH
+14 SET BDMPN=$PIECE(BDMTTRIG(BDMP,BDMP1),U,7)
SET BDMTN=$PIECE(BDMTTRIG,U,7)
WRITE !?8,"Not tested in 15 months"
DO W
+15 QUIT
W ;
+1 WRITE ?33,$JUSTIFY($$C(BDMPN,0,8),9),?45,$$PER(BDMPN,BDMTOPP),?53,$JUSTIFY($$C(BDMTN,0,8),9),?65,$$PER(BDMTN,BDMTOTP)
+2 QUIT
PER(N,D) ;n=numerator, d=denominator
+1 IF $GET(D)=""
QUIT ""
+2 IF $GET(D)=0
QUIT ""
+3 NEW X,Y,Z
+4 SET X=N/D
SET X=X*100
SET X=$JUSTIFY(X,5,1)
+5 QUIT X
+6 ;
TEST ;
+1 DO BDMG(1,"A",,DT,"ACTIVE")
+2 QUIT
BDMG(BDMREG,BDMSTAT,BDMPCP,BDMED,BDMSTAR) ;EP - GUI DMS Entry Point
+1 ;cmi/anch/maw added 10/19/2004
+2 SET BDMEDD=$$FMTE^XLFDT(BDMED)
+3 SET BDMGUI=1
+4 SET BDMBD=$$FMADD^XLFDT(BDMED,-(4*30.5))
+5 SET BDMSD=$$FMADD^XLFDT(BDMBD,-1)
+6 SET BDMPCP=$GET(BDMPCP)
+7 NEW BDMNOW,BDMOPT,BDMIEN
+8 SET BDMOPT="DM Register Patients and Select Values in 4 Months"
+9 DO NOW^%DTC
+10 SET BDMNOW=$GET(%)
+11 KILL DD,DO,DIC
+12 SET X=DUZ_BDMNOW
+13 SET DIC("DR")=".02////"_DUZ_";.03////"_BDMNOW_";.06///"_$GET(BDMOPT)_";.07////R"
+14 SET DIC="^BDMGUI("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9003201.4
+15 DO FILE^DICN
+16 KILL DIADD,DLAYGO,DIC,DA
+17 IF Y=-1
SET BDMIEN=-1
QUIT
+18 SET BDMIEN=+Y
+19 ;cmi/maw added
SET BDMGIEN=BDMIEN
+20 DO ^XBFMK
+21 KILL ZTSAVE
SET ZTSAVE("*")=""
+22 ;D GUIEP for interactive testing
+23 SET ZTIO=""
SET ZTDTH=$$NOW^XLFDT
SET ZTRTN="GUIEP^BDMDR3"
SET ZTDESC="GUI DM 4 MONTHS"
DO ^%ZTLOAD
+24 DO EXIT
+25 QUIT
GUIEP ;EP
+1 DO PROC
+2 KILL ^TMP($JOB,"BDMDR3")
+3 SET IOM=80
+4 DO GUIR^XBLM("PRINT^BDMDR31","^TMP($J,""BDMDR3"",")
+5 SET X=0
SET C=0
FOR
SET X=$ORDER(^TMP($JOB,"BDMDR3",X))
IF X'=+X
QUIT
Begin DoDot:1
+6 SET BDMDATA=^TMP($JOB,"BDMDR3",X)
+7 ;I BDMDATA="ZZZZZZZ" ;S BDMDATA=$C(12)
+8 SET ^BDMGUI(BDMIEN,11,X,0)=BDMDATA
SET C=C+1
End DoDot:1
+9 SET ^BDMGUI(BDMIEN,11,0)="^^"_C_"^"_C_"^"_DT_"^"
+10 SET DA=BDMIEN
SET DIK="^BDMGUI("
DO IX1^DIK
+11 DO ENDLOG
+12 KILL ^TMP($JOB,"BDMDR3")
+13 DO EXIT
+14 SET ZTREQ="@"
+15 QUIT
+16 ;
ENDLOG ;-- write the end of the log
+1 DO NOW^%DTC
+2 SET BDMNOW=$GET(%)
+3 SET DIE="^BDMGUI("
SET DA=BDMIEN
SET DR=".04////"_BDMNOW_";.07////C"
+4 DO ^DIE
+5 KILL DIE,DR,DA
+6 QUIT
