BDMD01P ; IHS/CMI/LAB - 2010 DIABETES AUDIT PRINT ;
;;2.0;DIABETES MANAGEMENT SYSTEM;**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("BDMDM01",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, 2010 DATE AUDIT RUN: "_$$FMTE^XLFDT(DT)_" Page: "_BDMPG,80)
.W !!,"Audit Period Ending Date: ",$$FMTE^XLFDT(BDMRED),?40,"Facility Name: ",$E($P(^DIC(4,$S($G(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0),U),1,26)
.W !,"REVIEWER initials: ",$$I(14),?40,"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 DM2010
.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: ",$S($$I(22)]"":$$I(22),1:"<not documented>")," Problem List: ",$S($$I(23)]"":$$I(23),1:"<not documented>")," 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: ",$S($$I(24)]"":$$I(24),1:"<not documented>")," Problem List: ",$S($$I(25)]"":$$I(25),1:"<not documented>")," 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,"Cessation Counseling received? " W $$I(28)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !!,"HEIGHT (last ever): ",$$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 in audit period: ",%," ",$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 during audit period:",?45,$P($$I(36),";",1)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !?45,$P($$I(36),";",2)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !?45,$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 or retinal camera): ",!?10,$$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-4) D PAGE Q:BDMQUIT
.W !!,"MENTAL HEALTH"
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !?2,"Depression an active problem? ",$$I(200)
.I $Y>(BDMIOSL-2) D PAGE Q:BDMQUIT
.W !?2,"If 'No', Screened for depression (during audit period)?"
.W !?7,$$I(210)
.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, others)"
.W !?3,$$I(98),?6,"4 Sulfonylurea-like (Prandin, Starlix)"
.W !?3,$$I(54),?6,"5 Metformin (Glucophage, others)"
.W !?3,$$I(55),?6,"6 Acarbose (Precose) or miglitol (Glyset)"
.W !?3,$$I(56),?6,"7 Pioglitazone (Actos) or rosiglitazone (Avandia)"
.W !?3,$$I(58),?6,"8 Incretin Mimetics (Byetta)" ;cmi/maw 12/18/2007 DM2010
.W !?3,$$I(59),?6,"9 DPP4 inhibitors (Januvia, Onglyza)" ;cmi/maw 12/18/2007 DM2010
.W !?3,$P($$I(99),U),?6,"10 Amylin Analogues (Symlin)"
.W !?3,$P($$I(57),U),?6,"11 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-12) D PAGE Q:BDMQUIT
.W !,"Lipid Lowering Agent"
.W !!?3,$$I(300),?6,"1 Statin (simvastatin/Zocor, others)"
.W !?3,$$I(301),?6,"2 Fibrate (gemfibroil/Lopid, others)"
.W !?3,$$I(302),?6,"3 Niacin (Niaspan, OTC niacin)"
.W !?3,$$I(303),?6,"4 Bile Acid Sequestrant (cholestyraminie/Questran, others)"
.W !?3,$$I(304),?6,"5 Ezetimibe (Zetia)"
.W !?3,$$I(305),?6,"6 Fish Oil - Rx or OTC"
.W !?3,$$I(306),?6,"7 Lovaza"
.W !?3,$$I(307),?6,"8 None or refused" ;cmi/maw 12/18/2007 DM2010
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !!,"TB Testing"
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !,"TB test done: ",$P($$I(70),"||",1)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !,"TB test result: ",$P($$I(70),"||",2)
.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))
.W !!,"ECG"
.W !!,"Date of Last ECG: ",?33,$$I(76)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !!,"IMMUNIZATIONS"
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !?2,"Seasonal FLU VACCINE (not H1N1) during audit period: ",?33,$$I(64)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !?2,"PNEUMOVAX Ever: ",?33,$$I(66)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !?2,"Td or Tdap in past 10 yrs: ",?33,$$I(68)
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !!,"LABORATORY DATA during audit period"
.I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
.W !!?2,"HbA1c (most recent): ",?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 (eGFR) documented in the medical record: ",!?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 DM2010
.W !?2,"Total 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 !!,"Urine Protein Testing during 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 Urine Albumin:Creatinine Ratio"
.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 Urine Protein:Creatinine Ratio"
.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 24 hr unrine collection for protein"
.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 Microalbumin:creatinine strips (e.g., Clinitek)"
.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 Microalbumin only (e.g. Micral)"
.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 UA dipstick"
.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-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^BDMD014
DONE ;
K ^TMP($J)
K ^XTMP("BDMDM01",BDMJOB,BDMBTH),BDMJOB,BDMBTH
Q
I(I) ;
Q $G(^XTMP("BDMDM01",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
I BDMPG W:$D(IOF) @IOF
S BDMPG=BDMPG+1
W $$CTR("ASSESSMENT OF DIABETES CARE, 2010 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)
;
BDMD01P ; IHS/CMI/LAB - 2010 DIABETES AUDIT PRINT ;
+1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**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("BDMDM01",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, 2010 DATE AUDIT RUN: "_$$FMTE^XLFDT(DT)_" Page: "_BDMPG,80)
+12 WRITE !!,"Audit Period Ending Date: ",$$FMTE^XLFDT(BDMRED),?40,"Facility Name: ",$EXTRACT($PIECE(^DIC(4,$SELECT($GET(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0),U),1,26)
+13 WRITE !,"REVIEWER initials: ",$$I(14),?40,"Community: ",$$I(122)
+14 ;cmi/maw 12/17/2007 DM2010
WRITE !,"TRIBAL AFFIL: ",$PIECE($$I(120),U,1)," ",$EXTRACT($PIECE($$I(120),U,2),1,25)," STATE of Residence: ",$PIECE($$I(121),U)
+15 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)
+16 WRITE ?J,"CHART #: ",$$I(16)," DOB: ",$$I(18)," SEX: ",$$I(20)
+17 WRITE !,"PRIMARY CARE PROVIDER: ",$$I(15)
+18 WRITE !!,"DATE OF DIABETES DIAGNOSIS:"
+19 WRITE !?2,"DM Reg: ",$SELECT($$I(22)]"":$$I(22),1:"<not documented>")," Problem List: ",$SELECT($$I(23)]"":$$I(23),1:"<not documented>")," 1st PCC DX: ",$$I(21)
+20 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+21 IF $$I(26.5)]""
WRITE !,$$I(26.5),!,$$I(26.6)
+22 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+23 WRITE !,"Diabetes Type: ",$$I(29)
+24 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+25 WRITE !?2,"DM Register: ",$SELECT($$I(24)]"":$$I(24),1:"<not documented>")," Problem List: ",$SELECT($$I(25)]"":$$I(25),1:"<not documented>")," PCC POV's: ",$$I(26)
+26 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+27 WRITE !!,"TOBACCO USE: ",$$I(27)
+28 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+29 WRITE !?2,"Cessation Counseling received? "
WRITE $$I(28)
+30 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+31 WRITE !!,"HEIGHT (last ever): ",$$I(30)
+32 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+33 SET %=$PIECE($$I(32)," ",1)
IF %]""
SET %=$$STRIP^XLFSTR($JUSTIFY(%,6,2)," ")
+34 WRITE !,"Last WEIGHT in audit period: ",%," ",$PIECE($$I(32)," ",2,99)," BMI: ",$$I(112)
+35 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+36 WRITE !!,"HTN (documented DX): ",$$I(34)
+37 IF $Y>(BDMIOSL-3)
DO PAGE
IF BDMQUIT
QUIT
+38 WRITE !,"Last 3 BLOOD PRESSURES during audit period:",?45,$PIECE($$I(36),";",1)
+39 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+40 WRITE !?45,$PIECE($$I(36),";",2)
+41 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+42 WRITE !?45,$PIECE($$I(36),";",3)
+43 IF $Y>(BDMIOSL-5)
DO PAGE
IF BDMQUIT
QUIT
+44 WRITE !!,"EXAMINATIONS (during audit period)"
+45 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+46 WRITE !?2,"FOOT EXAM-complete: ",?34,$$I(38)
+47 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+48 WRITE !?2,"EYE EXAM (dilated or retinal camera): ",!?10,$$I(40)
+49 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+50 WRITE !?2,"DENTAL EXAM: ",?34,$$I(42)
+51 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+52 WRITE !!,"EDUCATION (in past year)"
+53 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+54 WRITE !?2,"Diet Instruction: ",?26,$$I(44)
+55 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+56 WRITE !?2,"Exercise Instruction: ",?26,$$I(46)
+57 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+58 WRITE !?2,"DM Education (Other): ",?26,$$I(48)
+59 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+60 WRITE !!,"MENTAL HEALTH"
+61 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+62 WRITE !?2,"Depression an active problem? ",$$I(200)
+63 IF $Y>(BDMIOSL-2)
DO PAGE
IF BDMQUIT
QUIT
+64 WRITE !?2,"If 'No', Screened for depression (during audit period)?"
+65 WRITE !?7,$$I(210)
+66 IF $Y>(BDMIOSL-14)
DO PAGE
IF BDMQUIT
QUIT
+67 WRITE !!,"DM THERAPY Select all that currently apply:"
+68 WRITE !?3,$$I(51),?6,"1 Diet & Exercise Alone"
+69 WRITE !?3,$$I(52),?6,"2 Insulin"
+70 WRITE !?3,$$I(53),?6,"3 Sulfonylurea (glyburide, glipizide, others)"
+71 WRITE !?3,$$I(98),?6,"4 Sulfonylurea-like (Prandin, Starlix)"
+72 WRITE !?3,$$I(54),?6,"5 Metformin (Glucophage, others)"
+73 WRITE !?3,$$I(55),?6,"6 Acarbose (Precose) or miglitol (Glyset)"
+74 WRITE !?3,$$I(56),?6,"7 Pioglitazone (Actos) or rosiglitazone (Avandia)"
+75 ;cmi/maw 12/18/2007 DM2010
WRITE !?3,$$I(58),?6,"8 Incretin Mimetics (Byetta)"
+76 ;cmi/maw 12/18/2007 DM2010
WRITE !?3,$$I(59),?6,"9 DPP4 inhibitors (Januvia, Onglyza)"
+77 WRITE !?3,$PIECE($$I(99),U),?6,"10 Amylin Analogues (Symlin)"
+78 WRITE !?3,$PIECE($$I(57),U),?6,"11 Refused/Unknown"
IF $$I(57)]""
WRITE " ",$PIECE($$I(57),U,2)
+79 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+80 WRITE !!,"ACE Inhibitor/ARB Use: ",$$I(60)
+81 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+82 WRITE !,"Aspirin/Antiplatelet Therapy: ",$$I(62)
+83 IF $Y>(BDMIOSL-12)
DO PAGE
IF BDMQUIT
QUIT
+84 WRITE !,"Lipid Lowering Agent"
+85 WRITE !!?3,$$I(300),?6,"1 Statin (simvastatin/Zocor, others)"
+86 WRITE !?3,$$I(301),?6,"2 Fibrate (gemfibroil/Lopid, others)"
+87 WRITE !?3,$$I(302),?6,"3 Niacin (Niaspan, OTC niacin)"
+88 WRITE !?3,$$I(303),?6,"4 Bile Acid Sequestrant (cholestyraminie/Questran, others)"
+89 WRITE !?3,$$I(304),?6,"5 Ezetimibe (Zetia)"
+90 WRITE !?3,$$I(305),?6,"6 Fish Oil - Rx or OTC"
+91 WRITE !?3,$$I(306),?6,"7 Lovaza"
+92 ;cmi/maw 12/18/2007 DM2010
WRITE !?3,$$I(307),?6,"8 None or refused"
+93 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+94 WRITE !!,"TB Testing"
+95 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+96 WRITE !,"TB test done: ",$PIECE($$I(70),"||",1)
+97 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+98 WRITE !,"TB test result: ",$PIECE($$I(70),"||",2)
+99 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+100 WRITE !?4,"If PPD Pos, INH Tx Complete: ",?33,$PIECE($$I(72),U)," ",$PIECE($$I(72),U,2)
+101 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+102 WRITE !?4,"If PPD Neg, Last PPD: ",?33,$$FMTE^XLFDT($$I(114))
+103 WRITE !!,"ECG"
+104 WRITE !!,"Date of Last ECG: ",?33,$$I(76)
+105 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+106 WRITE !!,"IMMUNIZATIONS"
+107 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+108 WRITE !?2,"Seasonal FLU VACCINE (not H1N1) during audit period: ",?33,$$I(64)
+109 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+110 WRITE !?2,"PNEUMOVAX Ever: ",?33,$$I(66)
+111 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+112 WRITE !?2,"Td or Tdap in past 10 yrs: ",?33,$$I(68)
+113 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+114 WRITE !!,"LABORATORY DATA during audit period"
+115 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+116 WRITE !!?2,"HbA1c (most recent): ",?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)
+117 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+118 WRITE !?2,"Creatinine: ",?28,$PIECE($$I(84),U,1),?43,$PIECE($$I(84),U,2),?60,$EXTRACT($PIECE($$I(84),U,3),1,19)
+119 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+120 WRITE !?2," Estimated GFR (eGFR) documented in the medical record: ",!?28,$PIECE($$I(79),U,1),?43,$PIECE($$I(79),U,3),?60,$EXTRACT($PIECE($$I(79),U,4),1,19)
+121 ;documented in the" ;cmi/maw 12/18/2007 DM2010
IF $EXTRACT($$I(79))="1"
WRITE !?28,"eGFR value: ",$PIECE($$I(79),U,2)
+122 WRITE !?2,"Total Cholesterol: ",?28,$PIECE($$I(86),U,1),?43,$PIECE($$I(86),U,2),?60,$EXTRACT($PIECE($$I(86),U,3),1,19)
+123 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+124 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)
+125 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+126 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)
+127 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+128 WRITE !?2,"Triglycerides: ",?28,$PIECE($$I(90),U,1),?43,$PIECE($$I(90),U,2),?60,$EXTRACT($PIECE($$I(90),U,3),1,19)
+129 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+130 WRITE !!,"Urine Protein Testing during audit period:"
+131 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+132 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)
+133 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+134 WRITE !!,"SPECIFIC TESTING DONE:"
+135 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+136 SET BDMUTT=$PIECE($$I(92),U,5)
+137 WRITE !?2,$SELECT(BDMUTT=1:"X",1:""),?5,"1 Urine Albumin:Creatinine Ratio"
+138 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+139 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)
+140 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+141 WRITE !?2,$SELECT(BDMUTT=2:"X",1:""),?5,"2 Urine Protein:Creatinine Ratio"
+142 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+143 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)
+144 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+145 WRITE !?2,$SELECT(BDMUTT=3:"X",1:""),?5,"3 24 hr unrine collection for protein"
+146 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+147 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)
+148 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+149 WRITE !?2,$SELECT(BDMUTT=4:"X",1:""),?5,"4 Microalbumin:creatinine strips (e.g., Clinitek)"
+150 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+151 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)
+152 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+153 WRITE !?2,$SELECT(BDMUTT=5:"X",1:""),?5,"5 Microalbumin only (e.g. Micral)"
+154 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+155 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)
+156 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+157 WRITE !?2,$SELECT(BDMUTT=6:"X",1:""),?5,"6 UA dipstick"
+158 IF $Y>(BDMIOSL-4)
DO PAGE
IF BDMQUIT
QUIT
+159 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)
+160 IF $Y>(BDMIOSL-1)
DO PAGE
IF BDMQUIT
QUIT
+161 WRITE !!,"Local Option question:",!
+162 ;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^BDMD014
DONE ;
+1 KILL ^TMP($JOB)
+2 KILL ^XTMP("BDMDM01",BDMJOB,BDMBTH),BDMJOB,BDMBTH
+3 QUIT
I(I) ;
+1 QUIT $GET(^XTMP("BDMDM01",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 BDMPG
IF $DATA(IOF)
WRITE @IOF
+3 SET BDMPG=BDMPG+1
+4 WRITE $$CTR("ASSESSMENT OF DIABETES CARE, 2010 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 ;
