APCLD81P ; IHS/CMI/LAB - 2008 DIABETES AUDIT PRINT ;
;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
;
;
S APCLQUIT=0,APCLPG=0,APCLIOSL=$S($G(APCLGUI):55,1:IOSL)
I APCLPREP=3 G CUML
;print ind audits first
S APCLPD=0,APCLGUIC=0 F S APCLPD=$O(^XTMP("APCLDM81",APCLJOB,APCLBTH,"AUDIT",APCLPD)) Q:APCLPD'=+APCLPD!(APCLQUIT) D
.I $G(APCLGUI),APCLGUIC W !,"ZZZZZZZ",! ;maw
.S APCLGUIC=1
.W:$D(IOF) @IOF
.W $$CTR("ASSESSMENT OF DIABETES CARE, 2008 DATE AUDIT RUN: "_$$FMTE^XLFDT(DT),80)
.;W !,$$CTR("DATE AUDIT RUN: "_$$FMTE^XLFDT(DT),80)
.W !,"AUDIT DATE: ",$$FMTE^XLFDT(APCLRED),?30,"FACILITY NAME: ",$P(^DIC(4,DUZ(2),0),U)
.W !,"AREA: ",$$I(6),?12,"SU: ",$$I(8),?30,"FACILITY: ",$$I(10),?48,"# PTS ON DM REGISTER: ",$$I(12)
.I $G(APCLSDPI)]"" W !,"Does you community receive SDPI grant funds? "_$S(APCLSDPI=1:"Yes",APCLSDPI=2:"No",APCLSDPI=3:"Don't know",1:"")
.I $G(APCLSDPI)=1 W " ",APCLSDPG
.;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 !,"TRIBAL AFFIL: ",$P($$I(120),U,1)," ",$E($P($$I(120),U,2),1,20)," ","STATE of Residence: ",$P($$I(121),U) ;cmi/maw 12/17/2007 DM2008
.W !,"REVIEWER: ",$$I(14),?17,"CHART #: ",$$I(16),?35,"DOB: ",$$I(18),?55,"SEX: ",$$I(20)
.W !,$S($G(APCLPPN):"NAME: "_$P($G(^DPT(APCLPD,0)),U),1:"") S J=$S($G(APCLPPN):$L($P(^DPT(APCLPD,0),U))+10,1:0) W ?J,"DESIGNATED PCP: ",$$I(15)
.W !,"DATE OF DIABETES DIAGNOSIS:"
.W ?42,"Lipid Lowering Agent: " ;,$$I(61)
.W !?1,"CMS Register: ",$$I(22),?45,$$I(61)
.W !?1,"Problem List: ",$$I(23)
.W ?42,"IMMUNIZATIONS"
.W !?1,"1st DX recorded in PCC: ",$$I(21)
.W ?42,"Flu vaccine (past yr): ",$$I(64)
.W !,"Diabetes Type: ",$$I(29)
.W ?42,"Pneumovax Ever: ",$$I(66)
.W !?1,"CMS Register: ",$$I(24)
.W ?42,"Td in past 10 yrs: ",$$I(68)
.W !?1,"Problem List: ",$$I(25)
.W ?42,"PPD Status: ",$$I(70)
.W !?1,"PCC POV's: ",$$I(26)
.W ?42,"If PPD Pos, INH Tx Complete: "
.I $Y>(APCLIOSL-1) D PAGE Q:APCLQUIT
.W !
.W ?44,$P($$I(72),U)," ",$P($$I(72),U,2)
.I $Y>(APCLIOSL-1) D PAGE Q:APCLQUIT
.W !,"TOBACCO USE: ",$$I(27)
.W ?42,"If PPD Neg, Last PPD: " W $$FMTE^XLFDT($$I(114))
.I $Y>(APCLIOSL-1) D PAGE Q:APCLQUIT
.W !?1,"Referred for (or provided) Cessation"
.I $Y>(APCLIOSL-1) D PAGE Q:APCLQUIT
.W !?1,"Counseling: ",$$I(28)
.W ?42,"Date of Last EKG: ",$$I(76)
.I $Y>(APCLIOSL-1) D PAGE Q:APCLQUIT
.W !
.I $Y>(APCLIOSL-1) D PAGE Q:APCLQUIT
.W !,"VITAL STATISTICS"
.W ?42,"LABORATORY DATA"
.I $Y>(APCLIOSL-1) D PAGE Q:APCLQUIT
.W !,"Height: ",$$I(30)
.W ?42,"HbA1c (most recent): ",$P($$I(78),U,1)
.I $Y>(APCLIOSL-1) D PAGE Q:APCLQUIT
.S %=$P($$I(32)," ",1),%=$$STRIP^XLFSTR($J(%,6,2)," ")
.W !,"Last Weight (in 2 yrs): ",%," ",$P($$I(32)," ",2,99)
.W ?45,"Date Obtained: ",$P($$I(78),U,2)
.I $Y>(APCLIOSL-1) D PAGE Q:APCLQUIT
.W !," BMI: ",$$I(112)
.;W ?42,"HbA1c (next most recent): ",$P($$I(78),U,4) ;cmi/maw 12/18/2007 DM2008
.I $Y>(APCLIOSL-1) D PAGE Q:APCLQUIT
.W !,"HTN (documented DX): ",$$I(34)
.I $Y>(APCLIOSL-1) D PAGE Q:APCLQUIT
.W !,"Last 3 Blood Pressures (in past yr):"
.I $Y>(APCLIOSL-1) D PAGE Q:APCLQUIT
.W !?2,$P($$I(36),";")
.W ?42,"MOST RECENT SERUM VALUE (in the"
.I $Y>(APCLIOSL-1) D PAGE Q:APCLQUIT
.W !?2,$P($$I(36),";",2)
.W ?42,"past 12 months):"
.I $Y>(APCLIOSL-1) D PAGE Q:APCLQUIT
.W !?2,$P($$I(36),";",3)
.W ?43,"Creatinine: ",$$I(84)
.I $Y>(APCLIOSL-1) D PAGE Q:APCLQUIT
.W !,?43," Estimated GFR: "_$$I(79) ;documented in the" ;cmi/maw 12/18/2007 DM2008
.;W !,?43,"medical record during the audit" ;cmi/maw 12/18/2007 DM2008
.;W !,?43,"period: "_$$I(79) ;cmi/maw 12/18/2007 DM2008
.W !,?43,"Tot Cholesterol: ",$$I(86)
.W !,"EXAMINATIONS (in past year)"
.W ?43,"HDL Cholesterol: ",$$I(89)
.I $Y>(APCLIOSL-1) D PAGE Q:APCLQUIT
.W !,"Foot exam-complete: "
.W ?43,"LDL Cholesterol: ",$$I(88)
.I $Y>(APCLIOSL-1) D PAGE Q:APCLQUIT
.W !?2,$$I(38)
.W ?43,"Triglycerides: ",$$I(90)
.I $Y>(APCLIOSL-1) D PAGE Q:APCLQUIT
.W !,"Eye exam (dilated/fundus): "
.I $Y>(APCLIOSL-1) D PAGE Q:APCLQUIT
.W !?2,$$I(40)
.;W ?43,"Urinalysis or A/C Ratio: " ;cmi/maw 12/18/2007 DM2008
.W ?43,"Albumin:Creatinine Ratio (UACR): "_$P($$I(91),U) ;cmi/maw 12/18/2007 DM2008
.I $Y>(APCLIOSL-1) D PAGE Q:APCLQUIT
.W !,"Dental exam: "
.;W ?44,$$I(92) ;cmi/maw 12/18/2007 DM2008
.W ?43,"Protein:Creatinine Ratio (UPCR): "_$S($P($$I(91),U)="":$P($$I(93),U),1:"") ;cmi/maw 12/18/2007 DM2008
.I $Y>(APCLIOSL-1) D PAGE Q:APCLQUIT
.W !?2,$$I(42)
.;W ?43,"Proteinuria: " ;cmi/maw 12/18/2007 DM2008
.W ?43,"Other quantitative urine" ;cmi/maw 12/18/2007 DM2008
.W !,?43,"protein test: "_$$QUANCHK ;cmi/maw 12/18/2007 DM2008
.W !,?43,"None: "_$$ACPCOQ ;cmi/maw 12/18/2007 DM2008
.W !,?50,$$ACPCRES
.;I $Y>(APCLIOSL-1) D PAGE Q:APCLQUIT
.;W !
.;W ?44,$$I(94) ;cmi/maw 12/18/2007 DM2008
.I $Y>(APCLIOSL-1) D PAGE Q:APCLQUIT
.W !,"EDUCATION (in past year)"
.;W ?43,"Microalbuminuria: " ;cmi/maw 12/18/2007 DM2008
.I $Y>(APCLIOSL-1) D PAGE Q:APCLQUIT
.W !,"Diet Instruction: ",$$I(44)
.;W ?44,$$I(96) ;cmi/maw 12/18/2007 DM2008
.I $Y>(APCLIOSL-1) D PAGE Q:APCLQUIT
.W !,"Exercise Instruction: ",$$I(46)
.I $Y>(APCLIOSL-1) D PAGE Q:APCLQUIT
.W !,"DM Education (Other): ",$$I(48)
.;W ?42,"Self monitoring of blood glucose"
.;I $Y>(APCLIOSL-1) D PAGE Q:APCLQUIT
.;W !
.;W ?43,"documented in chart: ",$$I(98)
.I $Y>(APCLIOSL-1) D PAGE Q:APCLQUIT
.W !,"DM THERAPY"
.I $Y>(APCLIOSL-1) D PAGE Q:APCLQUIT
.W !,"Select all that currently apply"
.W ?42,"Supplemental Section"
.I $Y>(APCLIOSL-1) D PAGE Q:APCLQUIT
.W !?1,$$I(51),?4,"1 Diet & Exercise Alone"
.W ?42,"Does pt have depression as an active"
.I $Y>(APCLIOSL-1) D PAGE Q:APCLQUIT
.W !?1,$$I(52),?4,"2 Insulin"
.W ?43,"problem? ",$$I(200)
.I $Y>(APCLIOSL-1) D PAGE Q:APCLQUIT
.W !?1,$$I(53),?4,"3 Sulfonylurea "
.I $Y>(APCLIOSL-1) D PAGE Q:APCLQUIT
.W !?1,$$I(54),?4,"4 Metformin "
.W ?42,"If 'No', has pt been screened for"
.I $Y>(APCLIOSL-1) D PAGE Q:APCLQUIT
.W !?1,$$I(55),?4,"5 Acarbose "
.W ?43,"depression in the past year?"
.I $Y>(APCLIOSL-1) D PAGE Q:APCLQUIT
.W !?1,$$I(56),?4,"6 Glitazones"
.W !?1,$$I(58),?4,"7 Incretin Mimetics" ;cmi/maw 12/18/2007 DM2008
.W !?1,$$I(59),?4,"8 DPP4 inhibitors" ;cmi/maw 12/18/2007 DM2008
.W ?44,$$I(210)
.I $Y>(APCLIOSL-1) D PAGE Q:APCLQUIT
.W !?1,$P($$I(57),U),?4,"9 Unknown/Refused" I $$I(57)]"" W " ",$P($$I(57),U,2)
.I $Y>(APCLIOSL-1) D PAGE Q:APCLQUIT
.W !,"ACE Inhibitor/ARB Use: ",$$I(60)
.W ?43,"Local Option question:"
.I $Y>(APCLIOSL-1) D PAGE Q:APCLQUIT
.W !,"Aspirin/AntiPlatelet Therapy: ",$$I(62)
.I $E(IOST,1,2)'="P-" W !! S DIR(0)="E" D ^DIR K DIR ;CMI/GRL 1/18/07
.;D PAGE Q:APCLQUIT
CUML ;
I APCLPREP=4!(APCLPREP=3) D CUML^APCLD814
DONE ;
K ^TMP($J)
K ^XTMP("APCLDM81",APCLJOB,APCLBTH),APCLJOB,APCLBTH
Q
I(I) ;
Q ^XTMP("APCLDM81",APCLJOB,APCLBTH,"AUDIT",APCLPD,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 APCLQUIT=1 Q
W:$D(IOF) @IOF
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)
;
APCLD81P ; IHS/CMI/LAB - 2008 DIABETES AUDIT PRINT ;
+1 ;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
+2 ;
+3 ;
+4 SET APCLQUIT=0
SET APCLPG=0
SET APCLIOSL=$SELECT($GET(APCLGUI):55,1:IOSL)
+5 IF APCLPREP=3
GOTO CUML
+6 ;print ind audits first
+7 SET APCLPD=0
SET APCLGUIC=0
FOR
SET APCLPD=$ORDER(^XTMP("APCLDM81",APCLJOB,APCLBTH,"AUDIT",APCLPD))
IF APCLPD'=+APCLPD!(APCLQUIT)
QUIT
Begin DoDot:1
+8 ;maw
IF $GET(APCLGUI)
IF APCLGUIC
WRITE !,"ZZZZZZZ",!
+9 SET APCLGUIC=1
+10 IF $DATA(IOF)
WRITE @IOF
+11 WRITE $$CTR("ASSESSMENT OF DIABETES CARE, 2008 DATE AUDIT RUN: "_$$FMTE^XLFDT(DT),80)
+12 ;W !,$$CTR("DATE AUDIT RUN: "_$$FMTE^XLFDT(DT),80)
+13 WRITE !,"AUDIT DATE: ",$$FMTE^XLFDT(APCLRED),?30,"FACILITY NAME: ",$PIECE(^DIC(4,DUZ(2),0),U)
+14 WRITE !,"AREA: ",$$I(6),?12,"SU: ",$$I(8),?30,"FACILITY: ",$$I(10),?48,"# PTS ON DM REGISTER: ",$$I(12)
+15 IF $GET(APCLSDPI)]""
WRITE !,"Does you community receive SDPI grant funds? "_$SELECT(APCLSDPI=1:"Yes",APCLSDPI=2:"No",APCLSDPI=3:"Don't know",1:"")
+16 IF $GET(APCLSDPI)=1
WRITE " ",APCLSDPG
+17 ;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)
+18 ;cmi/maw 12/17/2007 DM2008
WRITE !,"TRIBAL AFFIL: ",$PIECE($$I(120),U,1)," ",$EXTRACT($PIECE($$I(120),U,2),1,20)," ","STATE of Residence: ",$PIECE($$I(121),U)
+19 WRITE !,"REVIEWER: ",$$I(14),?17,"CHART #: ",$$I(16),?35,"DOB: ",$$I(18),?55,"SEX: ",$$I(20)
+20 WRITE !,$SELECT($GET(APCLPPN):"NAME: "_$PIECE($GET(^DPT(APCLPD,0)),U),1:"")
SET J=$SELECT($GET(APCLPPN):$LENGTH($PIECE(^DPT(APCLPD,0),U))+10,1:0)
WRITE ?J,"DESIGNATED PCP: ",$$I(15)
+21 WRITE !,"DATE OF DIABETES DIAGNOSIS:"
+22 ;,$$I(61)
WRITE ?42,"Lipid Lowering Agent: "
+23 WRITE !?1,"CMS Register: ",$$I(22),?45,$$I(61)
+24 WRITE !?1,"Problem List: ",$$I(23)
+25 WRITE ?42,"IMMUNIZATIONS"
+26 WRITE !?1,"1st DX recorded in PCC: ",$$I(21)
+27 WRITE ?42,"Flu vaccine (past yr): ",$$I(64)
+28 WRITE !,"Diabetes Type: ",$$I(29)
+29 WRITE ?42,"Pneumovax Ever: ",$$I(66)
+30 WRITE !?1,"CMS Register: ",$$I(24)
+31 WRITE ?42,"Td in past 10 yrs: ",$$I(68)
+32 WRITE !?1,"Problem List: ",$$I(25)
+33 WRITE ?42,"PPD Status: ",$$I(70)
+34 WRITE !?1,"PCC POV's: ",$$I(26)
+35 WRITE ?42,"If PPD Pos, INH Tx Complete: "
+36 IF $Y>(APCLIOSL-1)
DO PAGE
IF APCLQUIT
QUIT
+37 WRITE !
+38 WRITE ?44,$PIECE($$I(72),U)," ",$PIECE($$I(72),U,2)
+39 IF $Y>(APCLIOSL-1)
DO PAGE
IF APCLQUIT
QUIT
+40 WRITE !,"TOBACCO USE: ",$$I(27)
+41 WRITE ?42,"If PPD Neg, Last PPD: "
WRITE $$FMTE^XLFDT($$I(114))
+42 IF $Y>(APCLIOSL-1)
DO PAGE
IF APCLQUIT
QUIT
+43 WRITE !?1,"Referred for (or provided) Cessation"
+44 IF $Y>(APCLIOSL-1)
DO PAGE
IF APCLQUIT
QUIT
+45 WRITE !?1,"Counseling: ",$$I(28)
+46 WRITE ?42,"Date of Last EKG: ",$$I(76)
+47 IF $Y>(APCLIOSL-1)
DO PAGE
IF APCLQUIT
QUIT
+48 WRITE !
+49 IF $Y>(APCLIOSL-1)
DO PAGE
IF APCLQUIT
QUIT
+50 WRITE !,"VITAL STATISTICS"
+51 WRITE ?42,"LABORATORY DATA"
+52 IF $Y>(APCLIOSL-1)
DO PAGE
IF APCLQUIT
QUIT
+53 WRITE !,"Height: ",$$I(30)
+54 WRITE ?42,"HbA1c (most recent): ",$PIECE($$I(78),U,1)
+55 IF $Y>(APCLIOSL-1)
DO PAGE
IF APCLQUIT
QUIT
+56 SET %=$PIECE($$I(32)," ",1)
SET %=$$STRIP^XLFSTR($JUSTIFY(%,6,2)," ")
+57 WRITE !,"Last Weight (in 2 yrs): ",%," ",$PIECE($$I(32)," ",2,99)
+58 WRITE ?45,"Date Obtained: ",$PIECE($$I(78),U,2)
+59 IF $Y>(APCLIOSL-1)
DO PAGE
IF APCLQUIT
QUIT
+60 WRITE !," BMI: ",$$I(112)
+61 ;W ?42,"HbA1c (next most recent): ",$P($$I(78),U,4) ;cmi/maw 12/18/2007 DM2008
+62 IF $Y>(APCLIOSL-1)
DO PAGE
IF APCLQUIT
QUIT
+63 WRITE !,"HTN (documented DX): ",$$I(34)
+64 IF $Y>(APCLIOSL-1)
DO PAGE
IF APCLQUIT
QUIT
+65 WRITE !,"Last 3 Blood Pressures (in past yr):"
+66 IF $Y>(APCLIOSL-1)
DO PAGE
IF APCLQUIT
QUIT
+67 WRITE !?2,$PIECE($$I(36),";")
+68 WRITE ?42,"MOST RECENT SERUM VALUE (in the"
+69 IF $Y>(APCLIOSL-1)
DO PAGE
IF APCLQUIT
QUIT
+70 WRITE !?2,$PIECE($$I(36),";",2)
+71 WRITE ?42,"past 12 months):"
+72 IF $Y>(APCLIOSL-1)
DO PAGE
IF APCLQUIT
QUIT
+73 WRITE !?2,$PIECE($$I(36),";",3)
+74 WRITE ?43,"Creatinine: ",$$I(84)
+75 IF $Y>(APCLIOSL-1)
DO PAGE
IF APCLQUIT
QUIT
+76 ;documented in the" ;cmi/maw 12/18/2007 DM2008
WRITE !,?43," Estimated GFR: "_$$I(79)
+77 ;W !,?43,"medical record during the audit" ;cmi/maw 12/18/2007 DM2008
+78 ;W !,?43,"period: "_$$I(79) ;cmi/maw 12/18/2007 DM2008
+79 WRITE !,?43,"Tot Cholesterol: ",$$I(86)
+80 WRITE !,"EXAMINATIONS (in past year)"
+81 WRITE ?43,"HDL Cholesterol: ",$$I(89)
+82 IF $Y>(APCLIOSL-1)
DO PAGE
IF APCLQUIT
QUIT
+83 WRITE !,"Foot exam-complete: "
+84 WRITE ?43,"LDL Cholesterol: ",$$I(88)
+85 IF $Y>(APCLIOSL-1)
DO PAGE
IF APCLQUIT
QUIT
+86 WRITE !?2,$$I(38)
+87 WRITE ?43,"Triglycerides: ",$$I(90)
+88 IF $Y>(APCLIOSL-1)
DO PAGE
IF APCLQUIT
QUIT
+89 WRITE !,"Eye exam (dilated/fundus): "
+90 IF $Y>(APCLIOSL-1)
DO PAGE
IF APCLQUIT
QUIT
+91 WRITE !?2,$$I(40)
+92 ;W ?43,"Urinalysis or A/C Ratio: " ;cmi/maw 12/18/2007 DM2008
+93 ;cmi/maw 12/18/2007 DM2008
WRITE ?43,"Albumin:Creatinine Ratio (UACR): "_$PIECE($$I(91),U)
+94 IF $Y>(APCLIOSL-1)
DO PAGE
IF APCLQUIT
QUIT
+95 WRITE !,"Dental exam: "
+96 ;W ?44,$$I(92) ;cmi/maw 12/18/2007 DM2008
+97 ;cmi/maw 12/18/2007 DM2008
WRITE ?43,"Protein:Creatinine Ratio (UPCR): "_$SELECT($PIECE($$I(91),U)="":$PIECE($$I(93),U),1:"")
+98 IF $Y>(APCLIOSL-1)
DO PAGE
IF APCLQUIT
QUIT
+99 WRITE !?2,$$I(42)
+100 ;W ?43,"Proteinuria: " ;cmi/maw 12/18/2007 DM2008
+101 ;cmi/maw 12/18/2007 DM2008
WRITE ?43,"Other quantitative urine"
+102 ;cmi/maw 12/18/2007 DM2008
WRITE !,?43,"protein test: "_$$QUANCHK
+103 ;cmi/maw 12/18/2007 DM2008
WRITE !,?43,"None: "_$$ACPCOQ
+104 WRITE !,?50,$$ACPCRES
+105 ;I $Y>(APCLIOSL-1) D PAGE Q:APCLQUIT
+106 ;W !
+107 ;W ?44,$$I(94) ;cmi/maw 12/18/2007 DM2008
+108 IF $Y>(APCLIOSL-1)
DO PAGE
IF APCLQUIT
QUIT
+109 WRITE !,"EDUCATION (in past year)"
+110 ;W ?43,"Microalbuminuria: " ;cmi/maw 12/18/2007 DM2008
+111 IF $Y>(APCLIOSL-1)
DO PAGE
IF APCLQUIT
QUIT
+112 WRITE !,"Diet Instruction: ",$$I(44)
+113 ;W ?44,$$I(96) ;cmi/maw 12/18/2007 DM2008
+114 IF $Y>(APCLIOSL-1)
DO PAGE
IF APCLQUIT
QUIT
+115 WRITE !,"Exercise Instruction: ",$$I(46)
+116 IF $Y>(APCLIOSL-1)
DO PAGE
IF APCLQUIT
QUIT
+117 WRITE !,"DM Education (Other): ",$$I(48)
+118 ;W ?42,"Self monitoring of blood glucose"
+119 ;I $Y>(APCLIOSL-1) D PAGE Q:APCLQUIT
+120 ;W !
+121 ;W ?43,"documented in chart: ",$$I(98)
+122 IF $Y>(APCLIOSL-1)
DO PAGE
IF APCLQUIT
QUIT
+123 WRITE !,"DM THERAPY"
+124 IF $Y>(APCLIOSL-1)
DO PAGE
IF APCLQUIT
QUIT
+125 WRITE !,"Select all that currently apply"
+126 WRITE ?42,"Supplemental Section"
+127 IF $Y>(APCLIOSL-1)
DO PAGE
IF APCLQUIT
QUIT
+128 WRITE !?1,$$I(51),?4,"1 Diet & Exercise Alone"
+129 WRITE ?42,"Does pt have depression as an active"
+130 IF $Y>(APCLIOSL-1)
DO PAGE
IF APCLQUIT
QUIT
+131 WRITE !?1,$$I(52),?4,"2 Insulin"
+132 WRITE ?43,"problem? ",$$I(200)
+133 IF $Y>(APCLIOSL-1)
DO PAGE
IF APCLQUIT
QUIT
+134 WRITE !?1,$$I(53),?4,"3 Sulfonylurea "
+135 IF $Y>(APCLIOSL-1)
DO PAGE
IF APCLQUIT
QUIT
+136 WRITE !?1,$$I(54),?4,"4 Metformin "
+137 WRITE ?42,"If 'No', has pt been screened for"
+138 IF $Y>(APCLIOSL-1)
DO PAGE
IF APCLQUIT
QUIT
+139 WRITE !?1,$$I(55),?4,"5 Acarbose "
+140 WRITE ?43,"depression in the past year?"
+141 IF $Y>(APCLIOSL-1)
DO PAGE
IF APCLQUIT
QUIT
+142 WRITE !?1,$$I(56),?4,"6 Glitazones"
+143 ;cmi/maw 12/18/2007 DM2008
WRITE !?1,$$I(58),?4,"7 Incretin Mimetics"
+144 ;cmi/maw 12/18/2007 DM2008
WRITE !?1,$$I(59),?4,"8 DPP4 inhibitors"
+145 WRITE ?44,$$I(210)
+146 IF $Y>(APCLIOSL-1)
DO PAGE
IF APCLQUIT
QUIT
+147 WRITE !?1,$PIECE($$I(57),U),?4,"9 Unknown/Refused"
IF $$I(57)]""
WRITE " ",$PIECE($$I(57),U,2)
+148 IF $Y>(APCLIOSL-1)
DO PAGE
IF APCLQUIT
QUIT
+149 WRITE !,"ACE Inhibitor/ARB Use: ",$$I(60)
+150 WRITE ?43,"Local Option question:"
+151 IF $Y>(APCLIOSL-1)
DO PAGE
IF APCLQUIT
QUIT
+152 WRITE !,"Aspirin/AntiPlatelet Therapy: ",$$I(62)
+153 ;CMI/GRL 1/18/07
IF $EXTRACT(IOST,1,2)'="P-"
WRITE !!
SET DIR(0)="E"
DO ^DIR
KILL DIR
+154 ;D PAGE Q:APCLQUIT
End DoDot:1
CUML ;
+1 IF APCLPREP=4!(APCLPREP=3)
DO CUML^APCLD814
DONE ;
+1 KILL ^TMP($JOB)
+2 KILL ^XTMP("APCLDM81",APCLJOB,APCLBTH),APCLJOB,APCLBTH
+3 QUIT
I(I) ;
+1 QUIT ^XTMP("APCLDM81",APCLJOB,APCLBTH,"AUDIT",APCLPD,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 APCLQUIT=1
QUIT
+2 IF $DATA(IOF)
WRITE @IOF
+3 QUIT
+4 ;
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 ;
