- BDMPD1P ; IHS/CMI/LAB - 2003 DIABETES AUDIT PRINT ;
- ;;2.0;DIABETES MANAGEMENT SYSTEM;**9**;JUN 14, 2007;Build 78
- ;
- ;
- 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("BDMPD1",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 2016",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("BDMPD1",BDMJOB,BDMBTH,"AUDIT",BDMPD,X)) Q:X>200.99!(X="") D
- ..W !?3,^XTMP("BDMPD1",BDMJOB,BDMBTH,"AUDIT",BDMPD,X)
- .W !?1,"2 IGT - ",$$I(210)
- .S X=210 F S X=$O(^XTMP("BDMPD1",BDMJOB,BDMBTH,"AUDIT",BDMPD,X)) Q:X>210.99!(X="") D
- ..W !?3,^XTMP("BDMPD1",BDMJOB,BDMBTH,"AUDIT",BDMPD,X)
- .W !?1,"3 METABOLIC SYNDROME - ",$$I(220)
- .S X=220 F S X=$O(^XTMP("BDMPD1",BDMJOB,BDMBTH,"AUDIT",BDMPD,X)) Q:X>220.99!(X="") D
- ..W !?3,^XTMP("BDMPD1",BDMJOB,BDMBTH,"AUDIT",BDMPD,X)
- .W !?1,"OTHER ABNORMAL GLUCOSE - ",$$I(230)
- .S X=230 F S X=$O(^XTMP("BDMPD1",BDMJOB,BDMBTH,"AUDIT",BDMPD,X)) Q:X>230.99!(X="") D
- ..W !?3,^XTMP("BDMPD1",BDMJOB,BDMBTH,"AUDIT",BDMPD,X)
- .W !?1,"CMS Register DX: ",$$I(22)_" "_$$I(24)
- .I $D(^XTMP("BDMPD1",BDMJOB,BDMBTH,"AUDIT",BDMPD,25)) W !?1,^(25)
- .I $D(^XTMP("BDMPD1",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 (in past year): " S BDMX=$$I(32)
- .W !?3 F BDMY=2:1:4 I $P(BDMX,"|",BDMY)]"" W " ",$P(BDMX,"|",BDMY)
- .I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
- .W !,"Waist Circumference: ",$$I(33),?41,"ACE Inhibitor Use: ",$P($$I(60)," ",2)
- .I $Y>(BDMIOSL-5) D PAGE Q:BDMQUIT
- .W !!,"Last 3 Blood Pressures:",?41,"Aspirin/Anti-Platelet Therapy: ",$P($$I(62)," ",2)
- .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: ",$P($$I(46)," ",2)
- .I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
- .W !,"TOBACCO USE: ",$P($$I(27)," ",2)
- .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"
- .I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
- .W !?1,$$I(51),?4,"1 Unknown/Refused/None"
- .I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
- .W !?1,$$I(54),?4,"2 Metformin "
- .I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
- .W !?1,$$I(55),?4,"3 Acarbose "
- .I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
- .W !?1,$$I(56),?4,"4 Glitazones"
- .I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
- .W !?1,$$I(53),?4,"5 Other: Sulfonylurea, "
- .I $Y>(BDMIOSL-2) D PAGE Q:BDMQUIT
- .W !?1,?4," Glyburide, glipizide, etc)"
- .I $Y>(BDMIOSL-2) D PAGE Q:BDMQUIT
- .W !!?1,"LABORATORY DATA"
- .W !?1,"Fasting Glucose (most recent):",?40,$$I(90)
- .I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
- .W !?1,"75 gm 2 hour glucose (most recent):",?40,$$I(91)
- .I $Y>(BDMIOSL-2) D PAGE Q:BDMQUIT
- .W !!?1,"MOST RECENT SERUM VALUE IN THE PAST 12 MONTHS"
- .I $Y>(BDMIOSL-2) D PAGE Q:BDMQUIT
- .W !?1,"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 !?1,"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 !?1,"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 !?1,"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^BDMPD14
- DONE ;
- K ^TMP($J)
- K ^XTMP("BDMPD1",BDMJOB,BDMBTH),BDMJOB,BDMBTH
- Q
- I(I) ;
- Q ^XTMP("BDMPD1",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
- ;----------
- BDMPD1P ; IHS/CMI/LAB - 2003 DIABETES AUDIT PRINT ;
- +1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**9**;JUN 14, 2007;Build 78
- +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("BDMPD1",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 2016",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("BDMPD1",BDMJOB,BDMBTH,"AUDIT",BDMPD,X))
- IF X>200.99!(X="")
- QUIT
- Begin DoDot:2
- +22 WRITE !?3,^XTMP("BDMPD1",BDMJOB,BDMBTH,"AUDIT",BDMPD,X)
- End DoDot:2
- +23 WRITE !?1,"2 IGT - ",$$I(210)
- +24 SET X=210
- FOR
- SET X=$ORDER(^XTMP("BDMPD1",BDMJOB,BDMBTH,"AUDIT",BDMPD,X))
- IF X>210.99!(X="")
- QUIT
- Begin DoDot:2
- +25 WRITE !?3,^XTMP("BDMPD1",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("BDMPD1",BDMJOB,BDMBTH,"AUDIT",BDMPD,X))
- IF X>220.99!(X="")
- QUIT
- Begin DoDot:2
- +28 WRITE !?3,^XTMP("BDMPD1",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("BDMPD1",BDMJOB,BDMBTH,"AUDIT",BDMPD,X))
- IF X>230.99!(X="")
- QUIT
- Begin DoDot:2
- +31 WRITE !?3,^XTMP("BDMPD1",BDMJOB,BDMBTH,"AUDIT",BDMPD,X)
- End DoDot:2
- +32 WRITE !?1,"CMS Register DX: ",$$I(22)_" "_$$I(24)
- +33 IF $DATA(^XTMP("BDMPD1",BDMJOB,BDMBTH,"AUDIT",BDMPD,25))
- WRITE !?1,^(25)
- +34 IF $DATA(^XTMP("BDMPD1",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 (in past year): "
- SET BDMX=$$I(32)
- +39 WRITE !?3
- FOR BDMY=2:1:4
- IF $PIECE(BDMX,"|",BDMY)]""
- WRITE " ",$PIECE(BDMX,"|",BDMY)
- +40 IF $Y>(BDMIOSL-1)
- DO PAGE
- IF BDMQUIT
- QUIT
- +41 WRITE !,"Waist Circumference: ",$$I(33),?41,"ACE Inhibitor Use: ",$PIECE($$I(60)," ",2)
- +42 IF $Y>(BDMIOSL-5)
- DO PAGE
- IF BDMQUIT
- QUIT
- +43 WRITE !!,"Last 3 Blood Pressures:",?41,"Aspirin/Anti-Platelet Therapy: ",$PIECE($$I(62)," ",2)
- +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: ",$PIECE($$I(46)," ",2)
- +58 IF $Y>(BDMIOSL-1)
- DO PAGE
- IF BDMQUIT
- QUIT
- +59 WRITE !,"TOBACCO USE: ",$PIECE($$I(27)," ",2)
- +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 ;,?41,"LABORATORY DATA"
- WRITE !!,"DM THERAPY"
- +66 IF $Y>(BDMIOSL-1)
- DO PAGE
- IF BDMQUIT
- QUIT
- +67 WRITE !,"Select all that currently apply"
- +68 IF $Y>(BDMIOSL-1)
- DO PAGE
- IF BDMQUIT
- QUIT
- +69 WRITE !?1,$$I(51),?4,"1 Unknown/Refused/None"
- +70 IF $Y>(BDMIOSL-1)
- DO PAGE
- IF BDMQUIT
- QUIT
- +71 WRITE !?1,$$I(54),?4,"2 Metformin "
- +72 IF $Y>(BDMIOSL-1)
- DO PAGE
- IF BDMQUIT
- QUIT
- +73 WRITE !?1,$$I(55),?4,"3 Acarbose "
- +74 IF $Y>(BDMIOSL-1)
- DO PAGE
- IF BDMQUIT
- QUIT
- +75 WRITE !?1,$$I(56),?4,"4 Glitazones"
- +76 IF $Y>(BDMIOSL-1)
- DO PAGE
- IF BDMQUIT
- QUIT
- +77 WRITE !?1,$$I(53),?4,"5 Other: Sulfonylurea, "
- +78 IF $Y>(BDMIOSL-2)
- DO PAGE
- IF BDMQUIT
- QUIT
- +79 WRITE !?1,?4," Glyburide, glipizide, etc)"
- +80 IF $Y>(BDMIOSL-2)
- DO PAGE
- IF BDMQUIT
- QUIT
- +81 WRITE !!?1,"LABORATORY DATA"
- +82 WRITE !?1,"Fasting Glucose (most recent):",?40,$$I(90)
- +83 IF $Y>(BDMIOSL-1)
- DO PAGE
- IF BDMQUIT
- QUIT
- +84 WRITE !?1,"75 gm 2 hour glucose (most recent):",?40,$$I(91)
- +85 IF $Y>(BDMIOSL-2)
- DO PAGE
- IF BDMQUIT
- QUIT
- +86 WRITE !!?1,"MOST RECENT SERUM VALUE IN THE PAST 12 MONTHS"
- +87 IF $Y>(BDMIOSL-2)
- DO PAGE
- IF BDMQUIT
- QUIT
- +88 WRITE !?1,"Total Cholesterol: ",$PIECE($$I(86),U,1)," ",$PIECE($$I(86),U,2)," ",$PIECE($$I(86),U,3)
- +89 IF $Y>(BDMIOSL-1)
- DO PAGE
- IF BDMQUIT
- QUIT
- +90 WRITE !?1,"HDL Cholesterol: ",$PIECE($$I(89),U,1)," ",$PIECE($$I(89),U,2)," ",$PIECE($$I(89),U,3)
- +91 IF $Y>(BDMIOSL-1)
- DO PAGE
- IF BDMQUIT
- QUIT
- +92 WRITE !?1,"LDL Cholesterol: ",$PIECE($$I(88),U,1)," ",$PIECE($$I(88),U,2)," ",$PIECE($$I(88),U,3)
- +93 IF $Y>(BDMIOSL-1)
- DO PAGE
- IF BDMQUIT
- QUIT
- +94 WRITE !?1,"Triglycerides: ",$PIECE($$I(190),U,1)," ",$PIECE($$I(190),U,2)," ",$PIECE($$I(190),U,3)
- +95 WRITE !,"Local Option question:"
- End DoDot:1
- CUML ;
- +1 IF BDMPREP=2!(BDMPREP=3)
- DO CUML^BDMPD14
- DONE ;
- +1 KILL ^TMP($JOB)
- +2 KILL ^XTMP("BDMPD1",BDMJOB,BDMBTH),BDMJOB,BDMBTH
- +3 QUIT
- I(I) ;
- +1 QUIT ^XTMP("BDMPD1",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 ;----------