Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BDMPD1P

BDMPD1P.m

Go to the documentation of this file.
  1. BDMPD1P ; IHS/CMI/LAB - 2003 DIABETES AUDIT PRINT ;
  1. ;;2.0;DIABETES MANAGEMENT SYSTEM;**9**;JUN 14, 2007;Build 78
  1. ;
  1. ;
  1. S BDMQUIT=0,BDMIOSL=$S($G(BDMGUI):55,1:IOSL)
  1. I BDMPREP=2 G CUML
  1. ;print ind audits first
  1. S BDMPD=0,BDMGUIC=0 F S BDMPD=$O(^XTMP("BDMPD1",BDMJOB,BDMBTH,"AUDIT",BDMPD)) Q:BDMPD'=+BDMPD!(BDMQUIT) D
  1. .I $G(BDMGUI),BDMGUIC W !,"ZZZZZZZ"
  1. .S BDMGUIC=1
  1. .W:$D(IOF) @IOF
  1. .W !,$$CTR("ASSESSMENT PREDIABETES/METABOLIC SYNDROME CARE, FY 2016",80)
  1. .W !!,"AUDIT DATE: ",$$FMTE^XLFDT(BDMRED),?49,"REVIEWER: ",$$I(14)
  1. .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)
  1. .W !,"# PTS ON PRE-DIABETES REGISTER: ",$$I(12)
  1. .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)
  1. .W !,"CHART #: ",$$I(16),?21,"DOB: ",$$I(18),?46,"SEX: ",$$I(20)
  1. .;W !,"PRIMARY CARE PROVIDER: ",$$I(15)
  1. .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)
  1. .W !!,"CLASSIFICATION (all that apply):"
  1. .W !?1,"1 IFG - ",$$I(200)
  1. .S X=200 F S X=$O(^XTMP("BDMPD1",BDMJOB,BDMBTH,"AUDIT",BDMPD,X)) Q:X>200.99!(X="") D
  1. ..W !?3,^XTMP("BDMPD1",BDMJOB,BDMBTH,"AUDIT",BDMPD,X)
  1. .W !?1,"2 IGT - ",$$I(210)
  1. .S X=210 F S X=$O(^XTMP("BDMPD1",BDMJOB,BDMBTH,"AUDIT",BDMPD,X)) Q:X>210.99!(X="") D
  1. ..W !?3,^XTMP("BDMPD1",BDMJOB,BDMBTH,"AUDIT",BDMPD,X)
  1. .W !?1,"3 METABOLIC SYNDROME - ",$$I(220)
  1. .S X=220 F S X=$O(^XTMP("BDMPD1",BDMJOB,BDMBTH,"AUDIT",BDMPD,X)) Q:X>220.99!(X="") D
  1. ..W !?3,^XTMP("BDMPD1",BDMJOB,BDMBTH,"AUDIT",BDMPD,X)
  1. .W !?1,"OTHER ABNORMAL GLUCOSE - ",$$I(230)
  1. .S X=230 F S X=$O(^XTMP("BDMPD1",BDMJOB,BDMBTH,"AUDIT",BDMPD,X)) Q:X>230.99!(X="") D
  1. ..W !?3,^XTMP("BDMPD1",BDMJOB,BDMBTH,"AUDIT",BDMPD,X)
  1. .W !?1,"CMS Register DX: ",$$I(22)_" "_$$I(24)
  1. .I $D(^XTMP("BDMPD1",BDMJOB,BDMBTH,"AUDIT",BDMPD,25)) W !?1,^(25)
  1. .I $D(^XTMP("BDMPD1",BDMJOB,BDMBTH,"AUDIT",BDMPD,26)) W !?1,^(26)
  1. .I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
  1. .W !!,"Height: ",$$I(30)
  1. .I $Y>(BDMIOSL-4) D PAGE Q:BDMQUIT
  1. .W !,"Last 3 Weights (in past year): " S BDMX=$$I(32)
  1. .W !?3 F BDMY=2:1:4 I $P(BDMX,"|",BDMY)]"" W " ",$P(BDMX,"|",BDMY)
  1. .I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
  1. .W !,"Waist Circumference: ",$$I(33),?41,"ACE Inhibitor Use: ",$P($$I(60)," ",2)
  1. .I $Y>(BDMIOSL-5) D PAGE Q:BDMQUIT
  1. .W !!,"Last 3 Blood Pressures:",?41,"Aspirin/Anti-Platelet Therapy: ",$P($$I(62)," ",2)
  1. .I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
  1. .W !?2,$P($$I(36),";")
  1. .I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
  1. .W !?2,$P($$I(36),";",2),?41,"Lipid Lowering Agent: ",$$I(61)
  1. .I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
  1. .W !?2,$P($$I(36),";",3)
  1. .I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
  1. .W !,"HTN (documented DX): ",$$I(34),?41,"Date of Last EKG: ",$$I(76)
  1. .I $Y>(BDMIOSL-2) D PAGE Q:BDMQUIT
  1. .W !!,"EDUCATION (in past year)"
  1. .I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
  1. .W !,"Diet Instruction: ",$$I(44)
  1. .I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
  1. .W !,"Exercise Instruction: ",$P($$I(46)," ",2)
  1. .I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
  1. .W !,"TOBACCO USE: ",$P($$I(27)," ",2)
  1. .I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
  1. .W !?1,"Referred for (or provided)"
  1. .I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
  1. .W !?1,"Cessation Counseling: ",$$I(28)
  1. .I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
  1. .W !!,"DM THERAPY" ;,?41,"LABORATORY DATA"
  1. .I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
  1. .W !,"Select all that currently apply"
  1. .I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
  1. .W !?1,$$I(51),?4,"1 Unknown/Refused/None"
  1. .I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
  1. .W !?1,$$I(54),?4,"2 Metformin "
  1. .I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
  1. .W !?1,$$I(55),?4,"3 Acarbose "
  1. .I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
  1. .W !?1,$$I(56),?4,"4 Glitazones"
  1. .I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
  1. .W !?1,$$I(53),?4,"5 Other: Sulfonylurea, "
  1. .I $Y>(BDMIOSL-2) D PAGE Q:BDMQUIT
  1. .W !?1,?4," Glyburide, glipizide, etc)"
  1. .I $Y>(BDMIOSL-2) D PAGE Q:BDMQUIT
  1. .W !!?1,"LABORATORY DATA"
  1. .W !?1,"Fasting Glucose (most recent):",?40,$$I(90)
  1. .I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
  1. .W !?1,"75 gm 2 hour glucose (most recent):",?40,$$I(91)
  1. .I $Y>(BDMIOSL-2) D PAGE Q:BDMQUIT
  1. .W !!?1,"MOST RECENT SERUM VALUE IN THE PAST 12 MONTHS"
  1. .I $Y>(BDMIOSL-2) D PAGE Q:BDMQUIT
  1. .W !?1,"Total Cholesterol: ",$P($$I(86),U,1)," ",$P($$I(86),U,2)," ",$P($$I(86),U,3)
  1. .I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
  1. .W !?1,"HDL Cholesterol: ",$P($$I(89),U,1)," ",$P($$I(89),U,2)," ",$P($$I(89),U,3)
  1. .I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
  1. .W !?1,"LDL Cholesterol: ",$P($$I(88),U,1)," ",$P($$I(88),U,2)," ",$P($$I(88),U,3)
  1. .I $Y>(BDMIOSL-1) D PAGE Q:BDMQUIT
  1. .W !?1,"Triglycerides: ",$P($$I(190),U,1)," ",$P($$I(190),U,2)," ",$P($$I(190),U,3)
  1. .W !,"Local Option question:"
  1. CUML ;
  1. I BDMPREP=2!(BDMPREP=3) D CUML^BDMPD14
  1. DONE ;
  1. K ^TMP($J)
  1. K ^XTMP("BDMPD1",BDMJOB,BDMBTH),BDMJOB,BDMBTH
  1. Q
  1. I(I) ;
  1. Q ^XTMP("BDMPD1",BDMJOB,BDMBTH,"AUDIT",BDMPD,I)
  1. ;
  1. PAGE ;
  1. 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
  1. W:$D(IOF) @IOF
  1. Q
  1. CTR(X,Y) ;EP - Center X in a field Y wide.
  1. Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
  1. ;----------