BDMD91P ; IHS/CMI/LAB - 2009 DIABETES AUDIT PRINT ;
;;2.0;DIABETES MANAGEMENT SYSTEM;**2,3**;JUN 14, 2007
;
;
S BDMQUIT=0,BDMPG=0,BDMIOSL=$S($G(BDMGUI):55,1:IOSL)
I BDMPREP=3 G CUML
;print ind audits first
S BDMPD=0,BDMGUIC=0 F S BDMPD=$O(^XTMP("BDMDM91",BDMJOB,BDMBTH,"AUDIT",BDMPD)) Q:BDMPD'=+BDMPD!(BDMQUIT) D
.I $G(BDMGUI),BDMGUIC W !,"ZZZZZZZ",! ;maw
.S BDMGUIC=1
.W:$D(IOF) @IOF
.S BDMPG=BDMPG+1 W $$CTR("ASSESSMENT OF DIABETES CARE, 2009 DATE AUDIT RUN: "_$$FMTE^XLFDT(DT)_" Page: "_BDMPG,80)
.W !!,"Audit Period Ending Date: ",$$FMTE^XLFDT(BDMRED)
.W !,"Facility Name: ",$P(^DIC(4,$S($G(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0),U),?46,"Area: ",$$I(6),?55,"SU: ",$$I(8),?62,"FACILITY: ",$$I(10)
.W !,"# of ACTIVE Pts in Registry: ",$$I(12)
.I $G(BDMSDPI)]"" W !,"Does your community receive SDPI grant funds? "_$S(BDMSDPI=1:"Yes",BDMSDPI=2:"No",BDMSDPI=3:"Don't know",1:"")
.I $G(BDMSDPI)=1 W " ",BDMSDPG
.W !,"REVIEWER: ",$$I(14),?35,"Community: ",$$I(122)
.W !,"TRIBAL AFFIL: ",$P($$I(120),U,1)," ",$E($P($$I(120),U,2),1,25)," STATE of Residence: ",$P($$I(121),U) ;cmi/maw 12/17/2007 DM2009
.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,"CHART #: ",$$I(16)," DOB: ",$$I(18)," SEX: ",$$I(20)
.W !,"PRIMARY CARE PROVIDER: ",$$I(15)
.W !,"DATE OF DIABETES DIAGNOSIS:"
.W !?2,"DM Reg: ",$$I(22)," Problem List: ",$$I(23)," 1st PCC DX: ",$$I(21)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.I $$I(26.5)]"" W !,$$I(26.5),!,$$I(26.6)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !,"Diabetes Type: ",$$I(29)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !?2,"DM Register: ",$$I(24)," Problem List: ",$$I(25)," PCC POV's: ",$$I(26)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !!,"TOBACCO USE: ",$$I(27)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !?2,"Referred for (or provided) Cessation Counseling: "
.I $$I(28)]"" W !?4,$$I(28)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !!,"HEIGHT: ",$$I(30)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.S %=$P($$I(32)," ",1) I %]"" S %=$$STRIP^XLFSTR($J(%,6,2)," ")
.W !,"Last WEIGHT: ",%," ",$P($$I(32)," ",2,99)," BMI: ",$$I(112)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !!,"HTN (documented DX): ",$$I(34)
.I $Y>(BDMIOSL-3) D PAGE Q:BDMQUIT
.W !,"Last 3 BLOOD PRESSURES: ",?26,$P($$I(36),";",1)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !?26,$P($$I(36),";",2)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !?26,$P($$I(36),";",3)
.I $Y>(BDMIOSL-5) D PAGE Q:BDMQUIT
.W !!,"EXAMINATIONS (during audit period)"
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !?2,"FOOT EXAM-complete: ",?34,$$I(38)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !?2,"EYE EXAM (dilated/fundus): ",?34,$$I(40)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !?2,"DENTAL EXAM: ",?34,$$I(42)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !!,"EDUCATION (in past year)"
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !?2,"Diet Instruction: ",?26,$$I(44)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !?2,"Exercise Instruction: ",?26,$$I(46)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !?2,"DM Education (Other): ",?26,$$I(48)
.I $Y>(BDMIOSL-14) D PAGE Q:BDMQUIT
.W !!,"DM THERAPY Select all that currently apply:"
.W !?3,$$I(51),?6,"1 Diet & Exercise Alone"
.W !?3,$$I(52),?6,"2 Insulin"
.W !?3,$$I(53),?6,"3 Sulfonylurea (glyburide, glipizide, repaglinide, nateglinide, others"
.W !?3,$$I(54),?6,"4 Metformin "
.W !?3,$$I(55),?6,"5 Acarbose "
.W !?3,$$I(56),?6,"6 Glitazones"
.W !?3,$$I(58),?6,"7 Incretin Mimetics" ;cmi/maw 12/18/2007 DM2009
.W !?3,$$I(59),?6,"8 DPP4 inhibitors" ;cmi/maw 12/18/2007 DM2009
.W !?3,$P($$I(99),U),?6,"9 Amylin Analogues"
.W !?3,$P($$I(57),U),?6,"10 Refused/Unknown" I $$I(57)]"" W " ",$P($$I(57),U,2)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !!,"ACE Inhibitor/ARB Use: ",$$I(60)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !,"Aspirin/Antiplatelet Therapy: ",$$I(62)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !,"Lipid Lowering Agent: ",$$I(61)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !!,"IMMUNIZATIONS"
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !?2,"Flu vaccine (past yr): ",?33,$$I(64)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !?2,"Pneumococcal Ever: ",?33,$$I(66)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !?2,"Td in past 10 yrs: ",?33,$$I(68)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !?2,"PPD Status: ",?33,$$I(70)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !?4,"If PPD Pos, INH Tx Complete: ",?33,$P($$I(72),U)," ",$P($$I(72),U,2)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !?4,"If PPD Neg, Last PPD: ",?33,$$FMTE^XLFDT($$I(114))
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !!,"Date of Last ECG: ",?33,$$I(76)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !!,"LABORATORY DATA (most recent values obtained during 12 mo audit period)"
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !!?2,"HbA1c: ",?28,$P($$I(78),U,2),?43,$$FMTE^XLFDT($P($$I(78),U,1)),?60,$E($$VAL^XBDIQ1(9000010.09,+$P($$I(78),U,4),.01),1,19)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !?2,"Creatinine: ",?28,$P($$I(84),U,1),?43,$P($$I(84),U,2),?60,$E($P($$I(84),U,3),1,19)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !?2," Estimated GFR: ",?28,$P($$I(79),U,1),?43,$P($$I(79),U,3),?60,$E($P($$I(79),U,4),1,19)
.I $E($$I(79))="1" W !?28,"eGFR value: ",$P($$I(79),U,2) ;documented in the" ;cmi/maw 12/18/2007 DM2009
.W !?2,"Cholesterol: ",?28,$P($$I(86),U,1),?43,$P($$I(86),U,2),?60,$E($P($$I(86),U,3),1,19)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !?2,"HDL Cholesterol: ",?28,$P($$I(89),U,1),?43,$P($$I(89),U,2),?60,$E($P($$I(89),U,3),1,19)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !?2,"LDL Cholesterol: ",?28,$P($$I(88),U,1),?43,$P($$I(88),U,2),?60,$E($P($$I(88),U,3),1,19)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !?2,"Triglycerides: ",?28,$P($$I(90),U,1),?43,$P($$I(90),U,2),?60,$E($P($$I(90),U,3),1,19)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !!,"Most recent urine protein testing during 12 month audit period:"
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !!,"URINE TESTED FOR PROTEIN: ",?28,$P($$I(92),U,1),?43,$P($$I(92),U,3),?60,$E($P($$I(92),U,4),1,19)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !!,"SPECIFIC TESTING DONE:"
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.S BDMUTT=$P($$I(92),U,5)
.W !?2,$S(BDMUTT=1:"X",1:""),?5,"1 Quantitative Albumin:Creatinine Ratio (UACR)"
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !?7,"UACR value: " I BDMUTT=1 W ?28,$P($$I(92),U,2),?43,$P($$I(92),U,3),?60,$E($P($$I(92),U,4),1,19)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !?2,$S(BDMUTT=2:"X",1:""),?5,"2 Semi-quantitative UACR"
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.I BDMUTT=2 W !?28,$P($$I(92),U,2),?43,$P($$I(92),U,3),?60,$E($P($$I(92),U,4),1,19)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !?2,$S(BDMUTT=3:"X",1:""),?5,"3 Protein:Creatinine Ratio (UPCR)"
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.I BDMUTT=3 W !?28,$P($$I(92),U,2),?43,$P($$I(92),U,3),?60,$E($P($$I(92),U,4),1,19)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !?2,$S(BDMUTT=4:"X",1:""),?5,"4 Other Quantitative test (e.g. 24 hr urine albumin)"
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.I BDMUTT=4 W !?28,$P($$I(92),U,2),?43,$P($$I(92),U,3),?60,$E($P($$I(92),U,4),1,19)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !?2,$S(BDMUTT=5:"X",1:""),?5,"5 Found to have 1+ protein or more on standard UA dipstick"
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.I BDMUTT=5 W !?28,$P($$I(92),U,2),?43,$P($$I(92),U,3),?60,$E($P($$I(92),U,4),1,19)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !?2,$S(BDMUTT=6:"X",1:""),?5,"6 Other non-quantitative test"
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.I BDMUTT=6 W !?28,$P($$I(92),U,2),?43,$P($$I(92),U,3),?60,$E($P($$I(92),U,4),1,19)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !!,"MENTAL HEALTH"
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !?2,"Does pt have depression as an active problem? "
.W !?7,$$I(200)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !?2,"If 'No', has pt been screened for depression in the past year?"
.W !?7,$$I(210)
.I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
.W !,"Local Option question:",!
.I $E(IOST,1,2)'="P-" W !! S DIR(0)="E" D ^DIR K DIR ;CMI/GRL 1/18/07
CUML ;
I BDMPREP=4!(BDMPREP=3) D CUML^BDMD914
DONE ;
K ^TMP($J)
K ^XTMP("BDMDM91",BDMJOB,BDMBTH),BDMJOB,BDMBTH
Q
I(I) ;
Q $G(^XTMP("BDMDM91",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
S BDMPG=BDMPG+1
W $$CTR("ASSESSMENT OF DIABETES CARE, 2009 DATE AUDIT RUN: "_$$FMTE^XLFDT(DT)_" Page: "_BDMPG,80)
W !,"Audit Period Ending Date: ",$$FMTE^XLFDT(BDMRED)
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,"CHART #: ",$$I(16)," DOB: ",$$I(18)," SEX: ",$$I(20)
W !,$$REPEAT^XLFSTR("-",79)
Q
;
ACPCOQ() ;-- return none if no UACR, UPCR, Quant
I $P($$I(91),U)="X" Q ""
I $P($$I(93),U)="X" Q ""
I $P($$I(95),U)="X" Q ""
Q "X"
;
ACPCRES() ;-- return result from UACR UPCR
I $P($$I(91),U)="X" Q $P($$I(91),U,2)
I $P($$I(93),U)="X" Q $P($$I(93),U,2)
Q ""
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
QUANCHK() ;--check quantitative
I $P($$I(91),U)]"" Q ""
I $P($$I(93),U)]"" Q ""
Q $$I(95)
;
BDMD91P ; IHS/CMI/LAB - 2009 DIABETES AUDIT PRINT ;
+1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**2,3**;JUN 14, 2007
+2 ;
+3 ;
+4 SET BDMQUIT=0
SET BDMPG=0
SET BDMIOSL=$SELECT($GET(BDMGUI):55,1:IOSL)
+5 IF BDMPREP=3
GOTO CUML
+6 ;print ind audits first
+7 SET BDMPD=0
SET BDMGUIC=0
FOR
SET BDMPD=$ORDER(^XTMP("BDMDM91",BDMJOB,BDMBTH,"AUDIT",BDMPD))
IF BDMPD'=+BDMPD!(BDMQUIT)
QUIT
Begin DoDot:1
+8 ;maw
IF $GET(BDMGUI)
IF BDMGUIC
WRITE !,"ZZZZZZZ",!
+9 SET BDMGUIC=1
+10 IF $DATA(IOF)
WRITE @IOF
+11 SET BDMPG=BDMPG+1
WRITE $$CTR("ASSESSMENT OF DIABETES CARE, 2009 DATE AUDIT RUN: "_$$FMTE^XLFDT(DT)_" Page: "_BDMPG,80)
+12 WRITE !!,"Audit Period Ending Date: ",$$FMTE^XLFDT(BDMRED)
+13 WRITE !,"Facility Name: ",$PIECE(^DIC(4,$SELECT($GET(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0),U),?46,"Area: ",$$I(6),?55,"SU: ",$$I(8),?62,"FACILITY: ",$$I(10)
+14 WRITE !,"# of ACTIVE Pts in Registry: ",$$I(12)
+15 IF $GET(BDMSDPI)]""
WRITE !,"Does your community receive SDPI grant funds? "_$SELECT(BDMSDPI=1:"Yes",BDMSDPI=2:"No",BDMSDPI=3:"Don't know",1:"")
+16 IF $GET(BDMSDPI)=1
WRITE " ",BDMSDPG
+17 WRITE !,"REVIEWER: ",$$I(14),?35,"Community: ",$$I(122)
+18 ;cmi/maw 12/17/2007 DM2009
WRITE !,"TRIBAL AFFIL: ",$PIECE($$I(120),U,1)," ",$EXTRACT($PIECE($$I(120),U,2),1,25)," STATE of Residence: ",$PIECE($$I(121),U)
+19 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)
+20 WRITE ?J,"CHART #: ",$$I(16)," DOB: ",$$I(18)," SEX: ",$$I(20)
+21 WRITE !,"PRIMARY CARE PROVIDER: ",$$I(15)
+22 WRITE !,"DATE OF DIABETES DIAGNOSIS:"
+23 WRITE !?2,"DM Reg: ",$$I(22)," Problem List: ",$$I(23)," 1st PCC DX: ",$$I(21)
+24 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+25 IF $$I(26.5)]""
WRITE !,$$I(26.5),!,$$I(26.6)
+26 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+27 WRITE !,"Diabetes Type: ",$$I(29)
+28 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+29 WRITE !?2,"DM Register: ",$$I(24)," Problem List: ",$$I(25)," PCC POV's: ",$$I(26)
+30 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+31 WRITE !!,"TOBACCO USE: ",$$I(27)
+32 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+33 WRITE !?2,"Referred for (or provided) Cessation Counseling: "
+34 IF $$I(28)]""
WRITE !?4,$$I(28)
+35 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+36 WRITE !!,"HEIGHT: ",$$I(30)
+37 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+38 SET %=$PIECE($$I(32)," ",1)
IF %]""
SET %=$$STRIP^XLFSTR($JUSTIFY(%,6,2)," ")
+39 WRITE !,"Last WEIGHT: ",%," ",$PIECE($$I(32)," ",2,99)," BMI: ",$$I(112)
+40 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+41 WRITE !!,"HTN (documented DX): ",$$I(34)
+42 IF $Y>(BDMIOSL-3)
DO PAGE
IF BDMQUIT
QUIT
+43 WRITE !,"Last 3 BLOOD PRESSURES: ",?26,$PIECE($$I(36),";",1)
+44 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+45 WRITE !?26,$PIECE($$I(36),";",2)
+46 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+47 WRITE !?26,$PIECE($$I(36),";",3)
+48 IF $Y>(BDMIOSL-5)
DO PAGE
IF BDMQUIT
QUIT
+49 WRITE !!,"EXAMINATIONS (during audit period)"
+50 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+51 WRITE !?2,"FOOT EXAM-complete: ",?34,$$I(38)
+52 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+53 WRITE !?2,"EYE EXAM (dilated/fundus): ",?34,$$I(40)
+54 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+55 WRITE !?2,"DENTAL EXAM: ",?34,$$I(42)
+56 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+57 WRITE !!,"EDUCATION (in past year)"
+58 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+59 WRITE !?2,"Diet Instruction: ",?26,$$I(44)
+60 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+61 WRITE !?2,"Exercise Instruction: ",?26,$$I(46)
+62 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+63 WRITE !?2,"DM Education (Other): ",?26,$$I(48)
+64 IF $Y>(BDMIOSL-14)
DO PAGE
IF BDMQUIT
QUIT
+65 WRITE !!,"DM THERAPY Select all that currently apply:"
+66 WRITE !?3,$$I(51),?6,"1 Diet & Exercise Alone"
+67 WRITE !?3,$$I(52),?6,"2 Insulin"
+68 WRITE !?3,$$I(53),?6,"3 Sulfonylurea (glyburide, glipizide, repaglinide, nateglinide, others"
+69 WRITE !?3,$$I(54),?6,"4 Metformin "
+70 WRITE !?3,$$I(55),?6,"5 Acarbose "
+71 WRITE !?3,$$I(56),?6,"6 Glitazones"
+72 ;cmi/maw 12/18/2007 DM2009
WRITE !?3,$$I(58),?6,"7 Incretin Mimetics"
+73 ;cmi/maw 12/18/2007 DM2009
WRITE !?3,$$I(59),?6,"8 DPP4 inhibitors"
+74 WRITE !?3,$PIECE($$I(99),U),?6,"9 Amylin Analogues"
+75 WRITE !?3,$PIECE($$I(57),U),?6,"10 Refused/Unknown"
IF $$I(57)]""
WRITE " ",$PIECE($$I(57),U,2)
+76 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+77 WRITE !!,"ACE Inhibitor/ARB Use: ",$$I(60)
+78 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+79 WRITE !,"Aspirin/Antiplatelet Therapy: ",$$I(62)
+80 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+81 WRITE !,"Lipid Lowering Agent: ",$$I(61)
+82 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+83 WRITE !!,"IMMUNIZATIONS"
+84 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+85 WRITE !?2,"Flu vaccine (past yr): ",?33,$$I(64)
+86 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+87 WRITE !?2,"Pneumococcal Ever: ",?33,$$I(66)
+88 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+89 WRITE !?2,"Td in past 10 yrs: ",?33,$$I(68)
+90 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+91 WRITE !?2,"PPD Status: ",?33,$$I(70)
+92 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+93 WRITE !?4,"If PPD Pos, INH Tx Complete: ",?33,$PIECE($$I(72),U)," ",$PIECE($$I(72),U,2)
+94 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+95 WRITE !?4,"If PPD Neg, Last PPD: ",?33,$$FMTE^XLFDT($$I(114))
+96 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+97 WRITE !!,"Date of Last ECG: ",?33,$$I(76)
+98 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+99 WRITE !!,"LABORATORY DATA (most recent values obtained during 12 mo audit period)"
+100 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+101 WRITE !!?2,"HbA1c: ",?28,$PIECE($$I(78),U,2),?43,$$FMTE^XLFDT($PIECE($$I(78),U,1)),?60,$EXTRACT($$VAL^XBDIQ1(9000010.09,+$PIECE($$I(78),U,4),.01),1,19)
+102 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+103 WRITE !?2,"Creatinine: ",?28,$PIECE($$I(84),U,1),?43,$PIECE($$I(84),U,2),?60,$EXTRACT($PIECE($$I(84),U,3),1,19)
+104 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+105 WRITE !?2," Estimated GFR: ",?28,$PIECE($$I(79),U,1),?43,$PIECE($$I(79),U,3),?60,$EXTRACT($PIECE($$I(79),U,4),1,19)
+106 ;documented in the" ;cmi/maw 12/18/2007 DM2009
IF $EXTRACT($$I(79))="1"
WRITE !?28,"eGFR value: ",$PIECE($$I(79),U,2)
+107 WRITE !?2,"Cholesterol: ",?28,$PIECE($$I(86),U,1),?43,$PIECE($$I(86),U,2),?60,$EXTRACT($PIECE($$I(86),U,3),1,19)
+108 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+109 WRITE !?2,"HDL Cholesterol: ",?28,$PIECE($$I(89),U,1),?43,$PIECE($$I(89),U,2),?60,$EXTRACT($PIECE($$I(89),U,3),1,19)
+110 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+111 WRITE !?2,"LDL Cholesterol: ",?28,$PIECE($$I(88),U,1),?43,$PIECE($$I(88),U,2),?60,$EXTRACT($PIECE($$I(88),U,3),1,19)
+112 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+113 WRITE !?2,"Triglycerides: ",?28,$PIECE($$I(90),U,1),?43,$PIECE($$I(90),U,2),?60,$EXTRACT($PIECE($$I(90),U,3),1,19)
+114 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+115 WRITE !!,"Most recent urine protein testing during 12 month audit period:"
+116 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+117 WRITE !!,"URINE TESTED FOR PROTEIN: ",?28,$PIECE($$I(92),U,1),?43,$PIECE($$I(92),U,3),?60,$EXTRACT($PIECE($$I(92),U,4),1,19)
+118 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+119 WRITE !!,"SPECIFIC TESTING DONE:"
+120 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+121 SET BDMUTT=$PIECE($$I(92),U,5)
+122 WRITE !?2,$SELECT(BDMUTT=1:"X",1:""),?5,"1 Quantitative Albumin:Creatinine Ratio (UACR)"
+123 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+124 WRITE !?7,"UACR value: "
IF BDMUTT=1
WRITE ?28,$PIECE($$I(92),U,2),?43,$PIECE($$I(92),U,3),?60,$EXTRACT($PIECE($$I(92),U,4),1,19)
+125 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+126 WRITE !?2,$SELECT(BDMUTT=2:"X",1:""),?5,"2 Semi-quantitative UACR"
+127 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+128 IF BDMUTT=2
WRITE !?28,$PIECE($$I(92),U,2),?43,$PIECE($$I(92),U,3),?60,$EXTRACT($PIECE($$I(92),U,4),1,19)
+129 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+130 WRITE !?2,$SELECT(BDMUTT=3:"X",1:""),?5,"3 Protein:Creatinine Ratio (UPCR)"
+131 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+132 IF BDMUTT=3
WRITE !?28,$PIECE($$I(92),U,2),?43,$PIECE($$I(92),U,3),?60,$EXTRACT($PIECE($$I(92),U,4),1,19)
+133 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+134 WRITE !?2,$SELECT(BDMUTT=4:"X",1:""),?5,"4 Other Quantitative test (e.g. 24 hr urine albumin)"
+135 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+136 IF BDMUTT=4
WRITE !?28,$PIECE($$I(92),U,2),?43,$PIECE($$I(92),U,3),?60,$EXTRACT($PIECE($$I(92),U,4),1,19)
+137 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+138 WRITE !?2,$SELECT(BDMUTT=5:"X",1:""),?5,"5 Found to have 1+ protein or more on standard UA dipstick"
+139 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+140 IF BDMUTT=5
WRITE !?28,$PIECE($$I(92),U,2),?43,$PIECE($$I(92),U,3),?60,$EXTRACT($PIECE($$I(92),U,4),1,19)
+141 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+142 WRITE !?2,$SELECT(BDMUTT=6:"X",1:""),?5,"6 Other non-quantitative test"
+143 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+144 IF BDMUTT=6
WRITE !?28,$PIECE($$I(92),U,2),?43,$PIECE($$I(92),U,3),?60,$EXTRACT($PIECE($$I(92),U,4),1,19)
+145 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+146 WRITE !!,"MENTAL HEALTH"
+147 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+148 WRITE !?2,"Does pt have depression as an active problem? "
+149 WRITE !?7,$$I(200)
+150 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+151 WRITE !?2,"If 'No', has pt been screened for depression in the past year?"
+152 WRITE !?7,$$I(210)
+153 IF $Y>(BDMIOSL-1)
DO PAGE
IF BDMQUIT
QUIT
+154 WRITE !,"Local Option question:",!
+155 ;CMI/GRL 1/18/07
IF $EXTRACT(IOST,1,2)'="P-"
WRITE !!
SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:1
CUML ;
+1 IF BDMPREP=4!(BDMPREP=3)
DO CUML^BDMD914
DONE ;
+1 KILL ^TMP($JOB)
+2 KILL ^XTMP("BDMDM91",BDMJOB,BDMBTH),BDMJOB,BDMBTH
+3 QUIT
I(I) ;
+1 QUIT $GET(^XTMP("BDMDM91",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 SET BDMPG=BDMPG+1
+4 WRITE $$CTR("ASSESSMENT OF DIABETES CARE, 2009 DATE AUDIT RUN: "_$$FMTE^XLFDT(DT)_" Page: "_BDMPG,80)
+5 WRITE !,"Audit Period Ending Date: ",$$FMTE^XLFDT(BDMRED)
+6 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)
+7 WRITE ?J,"CHART #: ",$$I(16)," DOB: ",$$I(18)," SEX: ",$$I(20)
+8 WRITE !,$$REPEAT^XLFSTR("-",79)
+9 QUIT
+10 ;
ACPCOQ() ;-- return none if no UACR, UPCR, Quant
+1 IF $PIECE($$I(91),U)="X"
QUIT ""
+2 IF $PIECE($$I(93),U)="X"
QUIT ""
+3 IF $PIECE($$I(95),U)="X"
QUIT ""
+4 QUIT "X"
+5 ;
ACPCRES() ;-- return result from UACR UPCR
+1 IF $PIECE($$I(91),U)="X"
QUIT $PIECE($$I(91),U,2)
+2 IF $PIECE($$I(93),U)="X"
QUIT $PIECE($$I(93),U,2)
+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 ;----------
QUANCHK() ;--check quantitative
+1 IF $PIECE($$I(91),U)]""
QUIT ""
+2 IF $PIECE($$I(93),U)]""
QUIT ""
+3 QUIT $$I(95)
+4 ;
