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

BDMPC19.m

Go to the documentation of this file. 
  1. BDMPC19 ; IHS/CMI/LAB - 2003 DIABETES AUDIT ;
  1.  ;;2.0;DIABETES MANAGEMENT SYSTEM;**8,9,10,11,12**;JUN 14, 2007;Build 51
  1.  ;
  1.  ;
  1.  W:$D(IOF) @IOF
  1.  W !!,"Checking for Taxonomies to support the 2015 Pre-Diabetes Audit. ",!,"Please enter the device for printing.",!
  1. ZIS ;
  1.  S XBRC="",XBRP="TAXCHK^BDMPC19",XBNS="",XBRX="XIT^BDMPC19"
  1.  D ^XBDBQUE
  1.  D XIT
  1.  Q
  1. TAXCHK ;EP
  1.  W:$D(IOF) @IOF
  1.  K BDMQUIT
  1.  W !,"Checking for Taxonomies to support the 2015 Pre-Diabetes Audit...",!
  1.  NEW A,BDMX,I,Y,Z,J,BDMY,B,C
  1.  K A,B
  1.  S C=0
  1.  S T="TAXS" F J=1:1 S Z=$T(@T+J),BDMX=$P(Z,";;",2),Y=$P(Z,";;",3) Q:BDMX=""  D
  1.  .I '$D(^ATXAX("B",BDMX)) S A(BDMX)=Y_"^is Missing" Q
  1.  .S I=$O(^ATXAX("B",BDMX,0))
  1.  .I '$D(^ATXAX(I,21,"B")) S A(BDMX)=Y_"^has no entries "
  1.  S T="LAB" F J=1:1 S Z=$T(@T+J),BDMX=$P(Z,";;",2),Y=$P(Z,";;",3) Q:BDMX=""  D
  1.  .I '$D(^ATXLAB("B",BDMX)) S A(BDMX)=Y_"^is Missing " Q
  1.  .S I=$O(^ATXLAB("B",BDMX,0))
  1.  .I '$D(^ATXLAB(I,21,"B")) S A(BDMX)=Y_"^has no entries " Q
  1.  .I '$P(^ATXLAB(I,0),U,11) D
  1.  ..;check for panels and warn
  1.  ..Q:$P(^ATXLAB(I,0),U)="BGP PAP SMEAR TAX"
  1.  ..S BDMY=0 F  S BDMY=$O(^ATXLAB(I,21,"B",BDMY)) Q:BDMY'=+BDMY  D
  1.  ...I $O(^LAB(60,BDMY,2,0)) S C=C+1,B(BDMX,C)=Y_"^contains a panel test: "_$P(^LAB(60,BDMY,0),U)_" and should not."
  1.  I $Y>(IOSL-2) D PAGE
  1.  I '$D(A),'$D(B) W !,"All taxonomies are present.",! K A,BDMX,Y,I,Z Q
  1.  W !!,"In order for the 2015 Diabetes Audit to find all necessary data, several",!,"taxonomies must be established.  The following taxonomies are missing, have",!,"no entries or contain a panel test and should not:",!
  1.  S BDMX="" F  S BDMX=$O(A(BDMX)) Q:BDMX=""!($D(BDMQUIT))  D
  1.  .I $Y>(IOSL-2) D PAGE Q:$D(BDMQUIT)
  1.  .W !,$P(A(BDMX),U)," [",BDMX,"] ",$P(A(BDMX),U,2)
  1.  .Q
  1.  G:$D(BDMQUIT) DONE
  1.  S BDMX="" F  S BDMX=$O(B(BDMX)) Q:BDMX=""!($D(BDMQUIT))  D
  1.  .S BDMY=0 F  S BDMY=$O(B(BDMX,BDMY)) Q:BDMY'=+BDMY!($D(BDMQUIT))  D
  1.  ..W !,$P(B(BDMX,BDMY),U)," [",BDMX,"] ",$P(B(BDMX,BDMY),U,2)
  1. DONE ;
  1.  I $E(IOST)="C",IO=IO(0) S DIR(0)="EO",DIR("A")="End of taxonomy check.  HIT RETURN" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  Q
  1. XIT ;EP
  1.  K BDM,BDMX,BDMQUIT,BDMLINE,BDMJ,BDMX,BDMTEXT,BDM
  1.  K X,Y,J
  1.  Q
  1. LASTHF(P,C,BDATE,EDATE,F) ;EP - get last factor in category C for patient P
  1.  I '$G(P) Q ""
  1.  I $G(C)="" Q ""
  1.  I $G(F)="" S F=""
  1.  S C=$O(^AUTTHF("B",C,0)) ;ien of category passed
  1.  I '$G(C) Q ""
  1.  NEW H,D,O S H=0 K O
  1.  F  S H=$O(^AUTTHF("AC",C,H))  Q:'+H  D
  1.  .  Q:'$D(^AUPNVHF("AA",P,H))
  1.  .  S D="" F  S D=$O(^AUPNVHF("AA",P,H,D)) Q:D'=+D  D
  1.  .. Q:(9999999-D)>EDATE  ;after time frame
  1.  .. Q:(9999999-D)<BDATE  ;before time frame
  1.  .. S O(D)=$O(^AUPNVHF("AA",P,H,D,""))
  1.  .  Q
  1.  S D=$O(O(0))
  1.  I D="" Q D
  1.  I F="F" Q $P(^AUTTHF($P(^AUPNVHF(O(D),0),U),0),U)
  1.  ;
  1.  Q 1
  1.  ;;
  1.  S BDMTEXT="TEXTD",BDM("VERSION")="2.0 (Patch 12)"
  1.  F BDMJ=1:1 S BDMX=$T(@BDMTEXT+BDMJ),BDMX=$P(BDMX,";;",2) Q:BDMX="QUIT"!(BDMX="")  S BDMLINE=BDMJ
  1. PRINT D ^XBCLS W:$D(IOF) @IOF
  1.  F BDMJ=1:1:BDMLINE S BDMX=$T(@BDMTEXT+BDMJ),BDMX=$P(BDMX,";;",2) W !?80-$L(BDMX)\2,BDMX K BDMX
  1.  W !?80-(8+$L(BDM("VERSION")))/2,"Version ",BDM("VERSION")
  1.   G XIT:'$D(DUZ(2)) G:'DUZ(2) XIT S BDM("SITE")=$P(^DIC(4,$S($G(BDMDUZ2):BDMDUZ2,1:DUZ(2)),0),"^") W !!?80-$L(BDM("SITE"))\2,BDM("SITE")
  1.  D XIT
  1.  Q
  1. TEXTD ;EP
  1.  ;;****************************************
  1.  ;;**      Diabetes Management System    **
  1.  ;;**   2015 Diabetes Audit Report Menu  **
  1.  ;;****************************************
  1.  ;;QUIT
  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="" Q
  1.  Q
  1. BMIEPI(H,W) ;EP ;
  1.  NEW %
  1.  I H="" Q ""
  1.  I W="" Q ""
  1.  S W=W*.45359,H=(H*.0254),H=(H*H),%=(W/H),%=$J(%,4,1)
  1.  Q %
  1. TAXS ;
  1.  ;;SURVEILLANCE DIABETES;;Diabetes Diagnoses Codes
  1.  ;;SURVEILLANCE HYPERTENSION;;Hypertension Diagnoses Codes
  1.  ;;DM AUDIT DIET EDUC TOPICS;;Diabetes Diet Education Topics
  1.  ;;DM AUDIT EXERCISE EDUC TOPICS;;Diabetes Excercise Education Topics
  1.  ;;DM AUDIT SMOKING CESS EDUC;;Smoking Cess Education Topics
  1.  ;;DM AUDIT TOBACCO HLTH FACTORS;;Tobacco Health Factors
  1.  ;;DM AUDIT PROBLEM SMOKING DXS;;Smoking related diagnoses for Problem List
  1.  ;;DM AUDIT PROBLEM HTN DIAGNOSES;;Hypertension Diagnoses
  1.  ;;DM AUDIT PROBLEM DIABETES DX;;Diabetes Diagnoses
  1.  ;;DM AUDIT SMOKING RELATED DXS;;Smoking related diagnoses for POVs
  1.  ;;DM AUDIT CESSATION HLTH FACTOR;;Smoking Cessation Health Factors
  1.  ;;DM AUDIT SULFONYLUREA DRUGS;;Sulfonylurea Drug Taxonomy
  1.  ;;DM AUDIT METFORMIN DRUGS;;Metformin Drug Taxonomy
  1.  ;;DM AUDIT ACARBOSE DRUGS;;Acarbose Drug Taxonomy
  1.  ;;DM AUDIT LIPID LOWERING DRUGS;;Lipid Lowering Drug Taxonomy
  1.  ;;DM AUDIT STATIN DRUGS;;Statin Drug Taxonomy
  1.  ;;DM AUDIT GLITAZONE DRUGS;;Glitzaone Drug Taxonomy
  1.  ;;DM AUDIT ACE INHIBITORS;;ACE Inhibitor Drug Taxonomy
  1.  ;;DM AUDIT ASPIRIN DRUGS;;Aspirin Drug Taxonomy
  1.  ;;DM AUDIT ANTI-PLATELET DRUGS;;Anti-Platelet Drug Taxonomy
  1.  ;;
  1. LAB ;
  1.  ;;DM AUDIT FASTING GLUCOSE TESTS;;Fasting Glucose Tests Taxonomy
  1.  ;;DM AUDIT CHOLESTEROL TAX;;Cholesterol Lab Taxonomy
  1.  ;;DM AUDIT LDL CHOLESTEROL TAX;;LDL Cholesterol Lab Taxonomy
  1.  ;;DM AUDIT HDL TAX;;HDL Lab Taxonomy
  1.  ;;DM AUDIT TRIGLYCERIDE TAX;;Triglyceride Lab Taxonomy
  1.  ;;DM AUDIT 75GM 2HR GLUCOSE;;75 gm 2hr glucose test taxonomy
  1.  ;;DM AUDIT AST TAX
  1.  ;;DM AUDIT ALT TAX
  1.  ;;BGP PAP SMEAR TAX
  1.  ;;