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

APCLD99P.m

Go to the documentation of this file. 
  1. APCLD99P ; IHS/CMI/LAB - 1999 DIABETES AUDIT PRINT ;
  1.  ;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
  1.  ;
  1.  ;
  1.  S APCLQUIT=0
  1.  I APCLPREP=3 G CUML
  1.  ;print ind audits first
  1.  S APCLPD=0 F  S APCLPD=$O(^XTMP("APCLDM99",APCLJOB,APCLBTH,"AUDIT",APCLPD)) Q:APCLPD'=+APCLPD!(APCLQUIT)  D
  1.  .W:$D(IOF) @IOF
  1.  .W !,$$CTR("ASSESSMENT OF DIABETES CARE, 1999",80)
  1.  .W !,$$CTR("DATE AUDIT RUN: "_$$FMTE^XLFDT(DT),80)
  1.  .W !!,"AUDIT DATE: ",$$FMTE^XLFDT(APCLRED),?30,"FACILITY NAME: ",$P(^DIC(4,DUZ(2),0),U)
  1.  .W !,"AREA: ",$$I(6),?12,"SU: ",$$I(8),?30,"FACILITY: ",$$I(10),?48,"# PTS ON DM REGISTER: ",$$I(12)
  1.  .W !,"REVIEWER: ",$$I(14),?17,"CHART #: ",$$I(16),?38,"DOB: ",$$I(18),?66,"SEX: ",$$I(20)
  1.  .W !,"DESIGNATED PRIMARY CARE PROVIDER:  ",$$I(15)
  1.  .W !!,"DATE OF DIABETES DIAGNOSIS:",?40,"IMMUNIZATIONS"
  1.  .W !?1,"CMS Register: ",$$I(22),?40,"Flu vaccine (past yr): ",$$I(64)
  1.  .W !?1,"Problem List: ",$$I(23),?40,"Pneumovax Ever: ",$$I(66)
  1.  .W !?1,"1st DX recorded in PCC: ",$$I(21),?40,"Td in past 10 yrs: ",$$I(68)
  1.  .W !,"Diabetes Type: ",$$I(29),?40,"PPD Status: ",$$I(70)
  1.  .W !?1,"CMS Register: ",$$I(24),?40,"If PPD Pos, INH Tx Complete: "
  1.  .W !?1,"Problem List: ",$$I(25),?42,$P($$I(72),U),"  ",$P($$I(72),U,2)
  1.  .W !?1,"PCC POV's:    ",$$I(26),?40,"If PPD Neg, Last PPD date: " W $$FMTE^XLFDT($$I(114))
  1.  .I $Y>(IOSL-2) D PAGE Q:APCLQUIT
  1.  .W !!,"TOBACCO USE: ",$$I(27),?40,"Date of Last EKG: ",$$I(76)
  1.  .I $Y>(IOSL-2) D PAGE Q:APCLQUIT
  1.  .W !?1,"Referred for (or provided)"
  1.  .I $Y>(IOSL-2) D PAGE Q:APCLQUIT
  1.  .W !?1,"cessation counseling: ",$$I(28),?40,"LABORATORY DATA"
  1.  .I $Y>(IOSL-2) D PAGE Q:APCLQUIT
  1.  .W !?40,"HbA1c (most recent): ",$P($$I(78),U,1)
  1.  .I $Y>(IOSL-2) D PAGE Q:APCLQUIT
  1.  .W !,"VITAL STATISTICS",?41,"Date Obtained: ",$P($$I(78),U,2)
  1.  .I $Y>(IOSL-2) D PAGE Q:APCLQUIT
  1.  .W !,"Height: ",$$I(30),?40,"HbA1c (next most recent): ",$P($$I(78),U,4)
  1.  .I $Y>(IOSL-2) D PAGE Q:APCLQUIT
  1.  .W !,"Last Weight: ",$$I(32),?41,"Date Obtained: ",$P($$I(78),U,5)
  1.  .I $Y>(IOSL-2) D PAGE Q:APCLQUIT
  1.  .W !,"HTN (documented DX): ",$$I(34),?40,"Last 3 Blood Sugars (in past yr)"
  1.  .I $Y>(IOSL-2) D PAGE Q:APCLQUIT
  1.  .W !,"Last 3 Blood Pressures (in past yr):",?42,$P($$I(82),U)
  1.  .I $Y>(IOSL-2) D PAGE Q:APCLQUIT
  1.  .W !?2,$P($$I(36),";"),?42,$P($$I(82),U,2)
  1.  .I $Y>(IOSL-2) D PAGE Q:APCLQUIT
  1.  .W !?2,$P($$I(36),";",2),?42,$P($$I(82),U,3)
  1.  .I $Y>(IOSL-2) D PAGE Q:APCLQUIT
  1.  .W !?2,$P($$I(36),";",3),?40,"MOST RECENT SERUM VALUE (in the"
  1.  .I $Y>(IOSL-2) D PAGE Q:APCLQUIT
  1.  .W !?40,"past 12 months):"
  1.  .I $Y>(IOSL-2) D PAGE Q:APCLQUIT
  1.  .W !,"EXAMINATIONS (in past year)",?41,"Creatinine: ",$$I(84)
  1.  .I $Y>(IOSL-2) D PAGE Q:APCLQUIT
  1.  .W !,"Foot exam-complete: ",?41,"Total Cholesterol: ",$$I(86)
  1.  .I $Y>(IOSL-2) D PAGE Q:APCLQUIT
  1.  .W !?2,$$I(38)
  1.  .W ?41,"LDL Cholesterol: ",$$I(88)
  1.  .I $Y>(IOSL-2) D PAGE Q:APCLQUIT
  1.  .W !,"Eye exam (dilated/fundus): "
  1.  .W ?41,"Triglycerides: ",$$I(90)
  1.  .I $Y>(IOSL-2) D PAGE Q:APCLQUIT
  1.  .W !?2,$$I(40)
  1.  .W ?41,"Urinalysis: ",$$I(92)
  1.  .I $Y>(IOSL-2) D PAGE Q:APCLQUIT
  1.  .W !,"Dental exam: "
  1.  .I $Y>(IOSL-2) D PAGE Q:APCLQUIT
  1.  .W !?2,$$I(42)
  1.  .W ?41,"Proteinuria: ",$$I(94)
  1.  .I $Y>(IOSL-2) D PAGE Q:APCLQUIT
  1.  .W !,"EDUCATION (in past year)"
  1.  .W ?41,"Microalbum: ",$$I(96)
  1.  .I $Y>(IOSL-2) D PAGE Q:APCLQUIT
  1.  .W !,"Diet Instruction: ",$$I(44)
  1.  .I $Y>(IOSL-2) D PAGE Q:APCLQUIT
  1.  .W !,"Exercise Instruction: ",$$I(46)
  1.  .W ?40,"Self monitoring of blood glucose"
  1.  .I $Y>(IOSL-2) D PAGE Q:APCLQUIT
  1.  .W !,"DM Education (Other): ",$$I(48)
  1.  .W ?41,"documented in chart:  ",$$I(98)
  1.  .I $Y>(IOSL-2) D PAGE Q:APCLQUIT
  1.  .W !!,"DM THERAPY"
  1.  .W ?40,"Is patient participating in SDM? ",$$I(100)
  1.  .I $Y>(IOSL-2) D PAGE Q:APCLQUIT
  1.  .W !,"Select all that currently apply"
  1.  .I $Y>(IOSL-2) D PAGE Q:APCLQUIT
  1.  .W !?1,$$I(51),?4,"1 Diet & Exercise Alone"
  1.  .;W ?40,"Peridontal Exam: ",$$I(102)
  1.  .I $Y>(IOSL-2) D PAGE Q:APCLQUIT
  1.  .W !?1,$$I(52),?4,"2 Insulin"
  1.  .I $Y>(IOSL-2) D PAGE Q:APCLQUIT
  1.  .W !?1,$$I(53),?4,"3 Sulfonylurea "
  1.  .W ?40,"Last AST date: ",$$I(104)
  1.  .I $Y>(IOSL-2) D PAGE Q:APCLQUIT
  1.  .I $Y>(IOSL-2) D PAGE Q:APCLQUIT
  1.  .W !?1,$$I(54),?4,"4 Metformin "
  1.  .W ?40,"Last ALT: ",$$I(106)
  1.  .I $Y>(IOSL-2) D PAGE Q:APCLQUIT
  1.  .W !?1,$$I(55),?4,"5 Acarbose "
  1.  .I $Y>(IOSL-2) D PAGE Q:APCLQUIT
  1.  .W !?1,$$I(56),?4,"6 Glitazones"
  1.  .W ?40,"Pap Smear in past yr: ",$$I(108)
  1.  .I $Y>(IOSL-2) D PAGE Q:APCLQUIT
  1.  .W !?1,?4,"9 Unknown/Refused"
  1.  .W ?40,"Mammogram in past yr: ",$$I(110)
  1.  .I $Y>(IOSL-2) D PAGE Q:APCLQUIT
  1.  .W !,"ACE Inhibitor Use: ",$$I(60)
  1.  .I $Y>(IOSL-2) D PAGE Q:APCLQUIT
  1.  .W !,"Daily Aspirin Therapy: ",$$I(62)
  1.  .W ?40,"BMI: ",$$I(112)
  1. CUML ;
  1.  I APCLPREP=4!(APCLPREP=3) D CUML^APCLD994
  1. DONE ;
  1.  K ^TMP($J)
  1.  K ^XTMP("APCLDM99",APCLJOB,APCLBTH),APCLJOB,APCLBTH
  1.  Q
  1. I(I) ;
  1.  Q ^XTMP("APCLDM99",APCLJOB,APCLBTH,"AUDIT",APCLPD,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 APCLQUIT=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.  ;----------