BDMPB1P ; IHS/CMI/LAB - 2003 DIABETES AUDIT PRINT ;
;;2.0;DIABETES MANAGEMENT SYSTEM;**7,8**;JUN 14, 2007;Build 53
;
;
S BDMQUIT=0,BDMIOSL=$S($G(BDMGUI):55,1:IOSL)
I BDMPREP=2 G CUML
;print ind audits first
S BDMPD=0,BDMGUIC=0 F S BDMPD=$O(^XTMP("BDMPB1",BDMJOB,BDMBTH,"AUDIT",BDMPD)) Q:BDMPD'=+BDMPD!(BDMQUIT) D
.I $G(BDMGUI),BDMGUIC W !,"ZZZZZZZ"
.S BDMGUIC=1
.W:$D(IOF) @IOF
.W !,$$CTR("ASSESSMENT PREDIABETES/METABOLIC SYNDROME CARE, FY 2014",80)
.W !!,"AUDIT DATE: ",$$FMTE^XLFDT(BDMRED),?49,"REVIEWER: ",$$I(14)
.W !,"FACILITY NAME: ",$P(^DIC(4,$S($G(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0),U),?49,"AREA: ",$$I(6)," SU: ",$$I(8)," FACILITY: ",$$I(10)
.W !,"# PTS ON PRE-DIABETES REGISTER: ",$$I(12)
.W !!,"TRIBAL AFFIL: ",$P($$I(120),U,1)," ",$E($P($$I(120),U,2),1,20)," ","COMMUNITY: ",$P($$I(121),U)," ",$E($P($$I(121),U,2),1,19)
.W !,"CHART #: ",$$I(16),?21,"DOB: ",$$I(18),?46,"SEX: ",$$I(20)
.;W !,"PRIMARY CARE PROVIDER: ",$$I(15)
.W !,$S($G(BDMPPN):"NAME: "_$P($G(^DPT(BDMPD,0)),U),1:"") S J=$S($G(BDMPPN):$L($P(^DPT(BDMPD,0),U))+10,1:0) W ?J,"PRIMARY CARE PROVIDER: ",$$I(15)
.W !!,"CLASSIFICATION (all that apply):"
.W !?1,"1 IFG - ",$$I(200)
.S X=200 F S X=$O(^XTMP("BDMPB1",BDMJOB,BDMBTH,"AUDIT",BDMPD,X)) Q:X>200.99!(X="") D
..W !?3,^XTMP("BDMPB1",BDMJOB,BDMBTH,"AUDIT",BDMPD,X)
.W !?1,"2 IGT - ",$$I(210)
.S X=210 F S X=$O(^XTMP("BDMPB1",BDMJOB,BDMBTH,"AUDIT",BDMPD,X)) Q:X>210.99!(X="") D
..W !?3,^XTMP("BDMPB1",BDMJOB,BDMBTH,"AUDIT",BDMPD,X)
.W !?1,"3 METABOLIC SYNDROME - ",$$I(220)
.S X=220 F S X=$O(^XTMP("BDMPB1",BDMJOB,BDMBTH,"AUDIT",BDMPD,X)) Q:X>220.99!(X="") D
..W !?3,^XTMP("BDMPB1",BDMJOB,BDMBTH,"AUDIT",BDMPD,X)
.W !?1,"OTHER ABNORMAL GLUCOSE - ",$$I(230)
.S X=230 F S X=$O(^XTMP("BDMPB1",BDMJOB,BDMBTH,"AUDIT",BDMPD,X)) Q:X>230.99!(X="") D
..W !?3,^XTMP("BDMPB1",BDMJOB,BDMBTH,"AUDIT",BDMPD,X)
.W !?1,"CMS Register DX: ",$$I(22)_" "_$$I(24)
.I $D(^XTMP("BDMPB1",BDMJOB,BDMBTH,"AUDIT",BDMPD,25)) W !?1,^(25)
.I $D(^XTMP("BDMPB1",BDMJOB,BDMBTH,"AUDIT",BDMPD,26)) W !?1,^(26)
.I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
.W !!,"Height: ",$$I(30)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !,"Last 3 Weights: " S BDMX=$$I(32)
.F BDMY=2:1:4 I $P(BDMX,"|",BDMY)]"" W !?3,$P(BDMX,"|",BDMY)
.I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
.W !,"Waist Circumference: ",$$I(33),?41,"ACE Inhibitor Use: ",$$I(60)
.I $Y>(BDMIOSL-5) D PAGE Q:BDMQUIT
.W !!,"Last 3 Blood Pressures:",?41,"Aspirin/Anti-Platelet Therapy: ",$$I(62)
.I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
.W !?2,$P($$I(36),";")
.I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
.W !?2,$P($$I(36),";",2),?41,"Lipid Lowering Agent: ",$$I(61)
.I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
.W !?2,$P($$I(36),";",3)
.I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
.W !,"HTN (documented DX): ",$$I(34),?41,"Date of Last EKG: ",$$I(76)
.I $Y>(BDMIOSL-2) D PAGE Q:BDMQUIT
.W !!,"EDUCATION (in past year)"
.I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
.W !,"Diet Instruction: ",$$I(44)
.I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
.W !,"Exercise Instruction: ",$$I(46)
.I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
.W !,"TOBACCO USE: ",$$I(27)
.I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
.W !?1,"Referred for (or provided)"
.I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
.W !?1,"Cessation Counseling: ",$$I(28)
.I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
.W !,"DM THERAPY",!?41,"LABORATORY DATA"
.I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
.W !,"Select all that currently apply",!?41,"Fasting Glucose (most recent):"
.I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
.W !?1,$$I(51),?4,"1 Unknown/Refused/None",?45,$$I(90)
.I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
.W !?1,$$I(54),?4,"2 Metformin ",?41,"75 gm 2 hour glucose (most recent):"
.I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
.W !?1,$$I(55),?4,"3 Acarbose ",?45,$$I(91)
.I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
.W !?1,$$I(56),?4,"4 Glitazones",?41,"MOST RECENT SERUM VALUE IN THE PAST"
.I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
.W !?1,$$I(53),?4,"5 Other: Sulfonylurea, ",?41," 12 MONTHS"
.I $Y>(BDMIOSL-2) D PAGE Q:BDMQUIT
.W !?1,?4," Glyburide, glipizide, etc)",?41,"Total Cholesterol: ",$P($$I(86),U,1)," ",$P($$I(86),U,2)," ",$P($$I(86),U,3)
.I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
.W !?41,"HDL Cholesterol: ",$P($$I(89),U,1)," ",$P($$I(89),U,2)," ",$P($$I(89),U,3)
.I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
.W !?41,"LDL Cholesterol: ",$P($$I(88),U,1)," ",$P($$I(88),U,2)," ",$P($$I(88),U,3)
.I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
.W !?41,"Triglycerides: ",$P($$I(190),U,1)," ",$P($$I(190),U,2)," ",$P($$I(190),U,3)
.W !,"Local Option question:"
CUML ;
I BDMPREP=2!(BDMPREP=3) D CUML^BDMPB14
DONE ;
K ^TMP($J)
K ^XTMP("BDMPB1",BDMJOB,BDMBTH),BDMJOB,BDMBTH
Q
I(I) ;
Q ^XTMP("BDMPB1",BDMJOB,BDMBTH,"AUDIT",BDMPD,I)
;
PAGE ;
I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BDMQUIT=1 Q
W:$D(IOF) @IOF
Q
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
BDMPB1P ; IHS/CMI/LAB - 2003 DIABETES AUDIT PRINT ;
+1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**7,8**;JUN 14, 2007;Build 53
+2 ;
+3 ;
+4 SET BDMQUIT=0
SET BDMIOSL=$SELECT($GET(BDMGUI):55,1:IOSL)
+5 IF BDMPREP=2
GOTO CUML
+6 ;print ind audits first
+7 SET BDMPD=0
SET BDMGUIC=0
FOR
SET BDMPD=$ORDER(^XTMP("BDMPB1",BDMJOB,BDMBTH,"AUDIT",BDMPD))
IF BDMPD'=+BDMPD!(BDMQUIT)
QUIT
Begin DoDot:1
+8 IF $GET(BDMGUI)
IF BDMGUIC
WRITE !,"ZZZZZZZ"
+9 SET BDMGUIC=1
+10 IF $DATA(IOF)
WRITE @IOF
+11 WRITE !,$$CTR("ASSESSMENT PREDIABETES/METABOLIC SYNDROME CARE, FY 2014",80)
+12 WRITE !!,"AUDIT DATE: ",$$FMTE^XLFDT(BDMRED),?49,"REVIEWER: ",$$I(14)
+13 WRITE !,"FACILITY NAME: ",$PIECE(^DIC(4,$SELECT($GET(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0),U),?49,"AREA: ",$$I(6)," SU: ",$$I(8)," FACILITY: ",$$I(10)
+14 WRITE !,"# PTS ON PRE-DIABETES REGISTER: ",$$I(12)
+15 WRITE !!,"TRIBAL AFFIL: ",$PIECE($$I(120),U,1)," ",$EXTRACT($PIECE($$I(120),U,2),1,20)," ","COMMUNITY: ",$PIECE($$I(121),U)," ",$EXTRACT($PIECE($$I(121),U,2),1,19)
+16 WRITE !,"CHART #: ",$$I(16),?21,"DOB: ",$$I(18),?46,"SEX: ",$$I(20)
+17 ;W !,"PRIMARY CARE PROVIDER: ",$$I(15)
+18 WRITE !,$SELECT($GET(BDMPPN):"NAME: "_$PIECE($GET(^DPT(BDMPD,0)),U),1:"")
SET J=$SELECT($GET(BDMPPN):$LENGTH($PIECE(^DPT(BDMPD,0),U))+10,1:0)
WRITE ?J,"PRIMARY CARE PROVIDER: ",$$I(15)
+19 WRITE !!,"CLASSIFICATION (all that apply):"
+20 WRITE !?1,"1 IFG - ",$$I(200)
+21 SET X=200
FOR
SET X=$ORDER(^XTMP("BDMPB1",BDMJOB,BDMBTH,"AUDIT",BDMPD,X))
IF X>200.99!(X="")
QUIT
Begin DoDot:2
+22 WRITE !?3,^XTMP("BDMPB1",BDMJOB,BDMBTH,"AUDIT",BDMPD,X)
End DoDot:2
+23 WRITE !?1,"2 IGT - ",$$I(210)
+24 SET X=210
FOR
SET X=$ORDER(^XTMP("BDMPB1",BDMJOB,BDMBTH,"AUDIT",BDMPD,X))
IF X>210.99!(X="")
QUIT
Begin DoDot:2
+25 WRITE !?3,^XTMP("BDMPB1",BDMJOB,BDMBTH,"AUDIT",BDMPD,X)
End DoDot:2
+26 WRITE !?1,"3 METABOLIC SYNDROME - ",$$I(220)
+27 SET X=220
FOR
SET X=$ORDER(^XTMP("BDMPB1",BDMJOB,BDMBTH,"AUDIT",BDMPD,X))
IF X>220.99!(X="")
QUIT
Begin DoDot:2
+28 WRITE !?3,^XTMP("BDMPB1",BDMJOB,BDMBTH,"AUDIT",BDMPD,X)
End DoDot:2
+29 WRITE !?1,"OTHER ABNORMAL GLUCOSE - ",$$I(230)
+30 SET X=230
FOR
SET X=$ORDER(^XTMP("BDMPB1",BDMJOB,BDMBTH,"AUDIT",BDMPD,X))
IF X>230.99!(X="")
QUIT
Begin DoDot:2
+31 WRITE !?3,^XTMP("BDMPB1",BDMJOB,BDMBTH,"AUDIT",BDMPD,X)
End DoDot:2
+32 WRITE !?1,"CMS Register DX: ",$$I(22)_" "_$$I(24)
+33 IF $DATA(^XTMP("BDMPB1",BDMJOB,BDMBTH,"AUDIT",BDMPD,25))
WRITE !?1,^(25)
+34 IF $DATA(^XTMP("BDMPB1",BDMJOB,BDMBTH,"AUDIT",BDMPD,26))
WRITE !?1,^(26)
+35 IF $Y>(BDMIOSL-1)
DO PAGE
IF BDMQUIT
QUIT
+36 WRITE !!,"Height: ",$$I(30)
+37 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+38 WRITE !,"Last 3 Weights: "
SET BDMX=$$I(32)
+39 FOR BDMY=2:1:4
IF $PIECE(BDMX,"|",BDMY)]""
WRITE !?3,$PIECE(BDMX,"|",BDMY)
+40 IF $Y>(BDMIOSL-1)
DO PAGE
IF BDMQUIT
QUIT
+41 WRITE !,"Waist Circumference: ",$$I(33),?41,"ACE Inhibitor Use: ",$$I(60)
+42 IF $Y>(BDMIOSL-5)
DO PAGE
IF BDMQUIT
QUIT
+43 WRITE !!,"Last 3 Blood Pressures:",?41,"Aspirin/Anti-Platelet Therapy: ",$$I(62)
+44 IF $Y>(BDMIOSL-1)
DO PAGE
IF BDMQUIT
QUIT
+45 WRITE !?2,$PIECE($$I(36),";")
+46 IF $Y>(BDMIOSL-1)
DO PAGE
IF BDMQUIT
QUIT
+47 WRITE !?2,$PIECE($$I(36),";",2),?41,"Lipid Lowering Agent: ",$$I(61)
+48 IF $Y>(BDMIOSL-1)
DO PAGE
IF BDMQUIT
QUIT
+49 WRITE !?2,$PIECE($$I(36),";",3)
+50 IF $Y>(BDMIOSL-1)
DO PAGE
IF BDMQUIT
QUIT
+51 WRITE !,"HTN (documented DX): ",$$I(34),?41,"Date of Last EKG: ",$$I(76)
+52 IF $Y>(BDMIOSL-2)
DO PAGE
IF BDMQUIT
QUIT
+53 WRITE !!,"EDUCATION (in past year)"
+54 IF $Y>(BDMIOSL-1)
DO PAGE
IF BDMQUIT
QUIT
+55 WRITE !,"Diet Instruction: ",$$I(44)
+56 IF $Y>(BDMIOSL-1)
DO PAGE
IF BDMQUIT
QUIT
+57 WRITE !,"Exercise Instruction: ",$$I(46)
+58 IF $Y>(BDMIOSL-1)
DO PAGE
IF BDMQUIT
QUIT
+59 WRITE !,"TOBACCO USE: ",$$I(27)
+60 IF $Y>(BDMIOSL-1)
DO PAGE
IF BDMQUIT
QUIT
+61 WRITE !?1,"Referred for (or provided)"
+62 IF $Y>(BDMIOSL-1)
DO PAGE
IF BDMQUIT
QUIT
+63 WRITE !?1,"Cessation Counseling: ",$$I(28)
+64 IF $Y>(BDMIOSL-1)
DO PAGE
IF BDMQUIT
QUIT
+65 WRITE !,"DM THERAPY",!?41,"LABORATORY DATA"
+66 IF $Y>(BDMIOSL-1)
DO PAGE
IF BDMQUIT
QUIT
+67 WRITE !,"Select all that currently apply",!?41,"Fasting Glucose (most recent):"
+68 IF $Y>(BDMIOSL-1)
DO PAGE
IF BDMQUIT
QUIT
+69 WRITE !?1,$$I(51),?4,"1 Unknown/Refused/None",?45,$$I(90)
+70 IF $Y>(BDMIOSL-1)
DO PAGE
IF BDMQUIT
QUIT
+71 WRITE !?1,$$I(54),?4,"2 Metformin ",?41,"75 gm 2 hour glucose (most recent):"
+72 IF $Y>(BDMIOSL-1)
DO PAGE
IF BDMQUIT
QUIT
+73 WRITE !?1,$$I(55),?4,"3 Acarbose ",?45,$$I(91)
+74 IF $Y>(BDMIOSL-1)
DO PAGE
IF BDMQUIT
QUIT
+75 WRITE !?1,$$I(56),?4,"4 Glitazones",?41,"MOST RECENT SERUM VALUE IN THE PAST"
+76 IF $Y>(BDMIOSL-1)
DO PAGE
IF BDMQUIT
QUIT
+77 WRITE !?1,$$I(53),?4,"5 Other: Sulfonylurea, ",?41," 12 MONTHS"
+78 IF $Y>(BDMIOSL-2)
DO PAGE
IF BDMQUIT
QUIT
+79 WRITE !?1,?4," Glyburide, glipizide, etc)",?41,"Total Cholesterol: ",$PIECE($$I(86),U,1)," ",$PIECE($$I(86),U,2)," ",$PIECE($$I(86),U,3)
+80 IF $Y>(BDMIOSL-1)
DO PAGE
IF BDMQUIT
QUIT
+81 WRITE !?41,"HDL Cholesterol: ",$PIECE($$I(89),U,1)," ",$PIECE($$I(89),U,2)," ",$PIECE($$I(89),U,3)
+82 IF $Y>(BDMIOSL-1)
DO PAGE
IF BDMQUIT
QUIT
+83 WRITE !?41,"LDL Cholesterol: ",$PIECE($$I(88),U,1)," ",$PIECE($$I(88),U,2)," ",$PIECE($$I(88),U,3)
+84 IF $Y>(BDMIOSL-1)
DO PAGE
IF BDMQUIT
QUIT
+85 WRITE !?41,"Triglycerides: ",$PIECE($$I(190),U,1)," ",$PIECE($$I(190),U,2)," ",$PIECE($$I(190),U,3)
+86 WRITE !,"Local Option question:"
End DoDot:1
CUML ;
+1 IF BDMPREP=2!(BDMPREP=3)
DO CUML^BDMPB14
DONE ;
+1 KILL ^TMP($JOB)
+2 KILL ^XTMP("BDMPB1",BDMJOB,BDMBTH),BDMJOB,BDMBTH
+3 QUIT
I(I) ;
+1 QUIT ^XTMP("BDMPB1",BDMJOB,BDMBTH,"AUDIT",BDMPD,I)
+2 ;
PAGE ;
+1 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET BDMQUIT=1
QUIT
+2 IF $DATA(IOF)
WRITE @IOF
+3 QUIT
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 ;----------
