APCLD999 ; IHS/CMI/LAB - 1999 DIABETES AUDIT ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;
;
W:$D(IOF) @IOF
W !!,"Checking for Taxonomies to support the 1999 Audit. ",!,"Please enter the device for printing.",!
ZIS ;
S XBRC="",XBRP="TAXCHK^APCLD999",XBNS="",XBRX="XIT^APCLD999"
D ^XBDBQUE
D XIT
Q
TAXCHK ;EP
W:$D(IOF) @IOF
K APCLQUIT
W !,"Checking for Taxonomies to support the 1999 Audit...",!
NEW A,APCLX,I,Y,Z,J
K A
S T="TAXS" F J=1:1 S Z=$T(@T+J),APCLX=$P(Z,";;",2),Y=$P(Z,";;",3) Q:APCLX="" D
.I '$D(^ATXAX("B",APCLX)) S A(APCLX)=Y_"^is Missing" Q
.S I=$O(^ATXAX("B",APCLX,0))
.I '$D(^ATXAX(I,21,"B")) S A(APCLX)=Y_"^has no entries "
S T="LAB" F J=1:1 S Z=$T(@T+J),APCLX=$P(Z,";;",2),Y=$P(Z,";;",3) Q:APCLX="" D
.I '$D(^ATXLAB("B",APCLX)) S A(APCLX)=Y_"^is Missing " Q
.S I=$O(^ATXLAB("B",APCLX,0))
.I '$D(^ATXLAB(I,21,"B")) S A(APCLX)=Y_"^has no entries "
I $Y>(IOSL-2) D PAGE
I '$D(A) W !,"All taxonomies are present.",! K A,APCLX,Y,I,Z Q
W !!,"In order for the 1999 Diabetes Audit to find all necessary data, several",!,"taxonomies must be established. The following taxonomies are missing or have",!,"no entries:"
S APCLX="" F S APCLX=$O(A(APCLX)) Q:APCLX=""!($D(APCLQUIT)) D
.I $Y>(IOSL-2) D PAGE Q:$D(APCLQUIT)
.W !,$P(A(APCLX),U)," [",APCLX,"] ",$P(A(APCLX),U,2)
.Q
DONE ;
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
Q
XIT ;EP
K APCL,APCLX,APCLQUIT,APCLLINE,APCLJ,APCLX,APCLTEXT,APCL
K X,Y,J
Q
BANNER ;EP - banner for 1999 audit menu
S APCLTEXT="TEXTD",APCL("VERSION")="3.0"
F APCLJ=1:1 S APCLX=$T(@APCLTEXT+APCLJ),APCLX=$P(APCLX,";;",2) Q:APCLX="QUIT"!(APCLX="") S APCLLINE=APCLJ
PRINT D ^XBCLS W:$D(IOF) @IOF
F APCLJ=1:1:APCLLINE S APCLX=$T(@APCLTEXT+APCLJ),APCLX=$P(APCLX,";;",2) W !?80-$L(APCLX)\2,APCLX K APCLX
W !?80-(8+$L(APCL("VERSION")))/2,"Version ",APCL("VERSION")
G XIT:'$D(DUZ(2)) G:'DUZ(2) XIT S APCL("SITE")=$P(^DIC(4,DUZ(2),0),"^") W !!?80-$L(APCL("SITE"))\2,APCL("SITE")
D XIT
Q
TEXTD ;EP
;;****************************************
;;** PCC Management Reports **
;;** 1999 Diabetes Audit Report Menu **
;;****************************************
;;QUIT
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="" Q
Q
TAXS ;
;;SURVEILLANCE DIABETES;;Diabetes Diagnoses Codes
;;SURVEILLANCE HYPERTENSION;;Hypertension Diagnoses Codes
;;SURVEILLANCE TUBERCULOSIS;;Tuberculosis Diagnoses Codes
;;DM AUDIT DIABETES EDUC TOPICS;;Diabetes Education Topics
;;DM AUDIT DIET EDUC TOPICS;;Diabetes Diet Education Topics
;;DM AUDIT EXERCISE EDUC TOPICS;;Diabetes Excercise Education Topics
;;DM AUDIT OTHER EDUC TOPICS;;Other Diabetes Education Topics
;;DM AUDIT SMOKING CESS EDUC;;Smoking Cess Education Topics
;;DM AUDIT TOBACCO HLTH FACTORS;;Tobacco Health Factors
;;DM AUDIT PROBLEM SMOKING DXS;;Smoking related diagnoses for Problem List
;;DM AUDIT PROBLEM HTN DIAGNOSES;;Hypertension Diagnoses
;;DM AUDIT PROBLEM DIABETES DX;;Diabetes Diagnoses
;;DM AUDIT SMOKING RELATED DXS;;Smoking related diagnoses for POVs
;;DM AUDIT CESSATION HLTH FACTOR;;Smoking Cessation Health Factors
;;DM AUDIT SELF MONITOR DRUGS;;Self Monitoring Drugs Taxonomy
;;DM AUDIT TB HEALTH FACTORS;;TB Status Health Factors
;;DM AUDIT INSULIN DRUGS;;Insulin Drug Taxonomy
;;DM AUDIT SULFONYLUREA DRUGS;;Sulfonylurea Drug Taxonomy
;;DM AUDIT METFORMIN DRUGS;;Metformin Drug Taxonomy
;;DM AUDIT ACARBOSE DRUGS;;Acarbose Drug Taxonomy
;;DM AUDIT GLITAZONE DRUGS;;Glitzaone Drug Taxonomy
;;DM AUDIT ACE INHIBITORS;;ACE Inhibitor Drug Taxonomy
;;DM AUDIT ASPIRIN DRUGS;;Aspirin Drug Taxonomy
;;DM AUDIT SDM PROVIDERS;;SDM providers Taxonomy
;;DM AUDIT TYPE II DXS;;Type II Diagnoses
;;DM AUDIT TYPE I DXS;;Type I Diagnoses
;;
LAB ;
;;DM AUDIT URINE PROTEIN TAX;;Urine Protein Lab Taxonomy
;;DM AUDIT MICROALBUMINURIA TAX;;Microalbuminuia Lab Taxonomy
;;DM AUDIT HGB A1C TAX;;HGB A1C Lab Taxonomy
;;DM AUDIT GLUCOSE TESTS TAX;;Glucose Tests Taxonomy
;;DM AUDIT AST TAX;;AST Lab Taxonomy
;;DM AUDIT ALT TAX;;ALT Lab Taxonomy
;;DM AUDIT CREATININE TAX;;Creatinine Lab Taxonomy
;;DM AUDIT CHOLESTEROL TAX;;Cholesterol Lab Taxonomy
;;DM AUDIT LDL CHOLESTEROL TAX;;LDL Cholesterol Lab Taxonomy
;;DM AUDIT TRIGLYCERIDE TAX;;Triglyceride Lab Taxonomy
;;DM AUDIT URINALYSIS TAX;;Urinalysis Lab Taxonomy
;;
APCLD999 ; IHS/CMI/LAB - 1999 DIABETES AUDIT ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;
+3 ;
+4 IF $DATA(IOF)
WRITE @IOF
+5 WRITE !!,"Checking for Taxonomies to support the 1999 Audit. ",!,"Please enter the device for printing.",!
ZIS ;
+1 SET XBRC=""
SET XBRP="TAXCHK^APCLD999"
SET XBNS=""
SET XBRX="XIT^APCLD999"
+2 DO ^XBDBQUE
+3 DO XIT
+4 QUIT
TAXCHK ;EP
+1 IF $DATA(IOF)
WRITE @IOF
+2 KILL APCLQUIT
+3 WRITE !,"Checking for Taxonomies to support the 1999 Audit...",!
+4 NEW A,APCLX,I,Y,Z,J
+5 KILL A
+6 SET T="TAXS"
FOR J=1:1
SET Z=$TEXT(@T+J)
SET APCLX=$PIECE(Z,";;",2)
SET Y=$PIECE(Z,";;",3)
IF APCLX=""
QUIT
Begin DoDot:1
+7 IF '$DATA(^ATXAX("B",APCLX))
SET A(APCLX)=Y_"^is Missing"
QUIT
+8 SET I=$ORDER(^ATXAX("B",APCLX,0))
+9 IF '$DATA(^ATXAX(I,21,"B"))
SET A(APCLX)=Y_"^has no entries "
End DoDot:1
+10 SET T="LAB"
FOR J=1:1
SET Z=$TEXT(@T+J)
SET APCLX=$PIECE(Z,";;",2)
SET Y=$PIECE(Z,";;",3)
IF APCLX=""
QUIT
Begin DoDot:1
+11 IF '$DATA(^ATXLAB("B",APCLX))
SET A(APCLX)=Y_"^is Missing "
QUIT
+12 SET I=$ORDER(^ATXLAB("B",APCLX,0))
+13 IF '$DATA(^ATXLAB(I,21,"B"))
SET A(APCLX)=Y_"^has no entries "
End DoDot:1
+14 IF $Y>(IOSL-2)
DO PAGE
+15 IF '$DATA(A)
WRITE !,"All taxonomies are present.",!
KILL A,APCLX,Y,I,Z
QUIT
+16 WRITE !!,"In order for the 1999 Diabetes Audit to find all necessary data, several",!,"taxonomies must be established. The following taxonomies are missing or have",!,"no entries:"
+17 SET APCLX=""
FOR
SET APCLX=$ORDER(A(APCLX))
IF APCLX=""!($DATA(APCLQUIT))
QUIT
Begin DoDot:1
+18 IF $Y>(IOSL-2)
DO PAGE
IF $DATA(APCLQUIT)
QUIT
+19 WRITE !,$PIECE(A(APCLX),U)," [",APCLX,"] ",$PIECE(A(APCLX),U,2)
+20 QUIT
End DoDot:1
DONE ;
+1 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
SET DIR(0)="EO"
SET DIR("A")="End of taxonomy check. HIT RETURN"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 QUIT
XIT ;EP
+1 KILL APCL,APCLX,APCLQUIT,APCLLINE,APCLJ,APCLX,APCLTEXT,APCL
+2 KILL X,Y,J
+3 QUIT
BANNER ;EP - banner for 1999 audit menu
+1 SET APCLTEXT="TEXTD"
SET APCL("VERSION")="3.0"
+2 FOR APCLJ=1:1
SET APCLX=$TEXT(@APCLTEXT+APCLJ)
SET APCLX=$PIECE(APCLX,";;",2)
IF APCLX="QUIT"!(APCLX="")
QUIT
SET APCLLINE=APCLJ
PRINT DO ^XBCLS
IF $DATA(IOF)
WRITE @IOF
+1 FOR APCLJ=1:1:APCLLINE
SET APCLX=$TEXT(@APCLTEXT+APCLJ)
SET APCLX=$PIECE(APCLX,";;",2)
WRITE !?80-$LENGTH(APCLX)\2,APCLX
KILL APCLX
+2 WRITE !?80-(8+$LENGTH(APCL("VERSION")))/2,"Version ",APCL("VERSION")
+3 IF '$DATA(DUZ(2))
GOTO XIT
IF 'DUZ(2)
GOTO XIT
SET APCL("SITE")=$PIECE(^DIC(4,DUZ(2),0),"^")
WRITE !!?80-$LENGTH(APCL("SITE"))\2,APCL("SITE")
+4 DO XIT
+5 QUIT
TEXTD ;EP
+1 ;;****************************************
+2 ;;** PCC Management Reports **
+3 ;;** 1999 Diabetes Audit Report Menu **
+4 ;;****************************************
+5 ;;QUIT
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=""
QUIT
+2 QUIT
TAXS ;
+1 ;;SURVEILLANCE DIABETES;;Diabetes Diagnoses Codes
+2 ;;SURVEILLANCE HYPERTENSION;;Hypertension Diagnoses Codes
+3 ;;SURVEILLANCE TUBERCULOSIS;;Tuberculosis Diagnoses Codes
+4 ;;DM AUDIT DIABETES EDUC TOPICS;;Diabetes Education Topics
+5 ;;DM AUDIT DIET EDUC TOPICS;;Diabetes Diet Education Topics
+6 ;;DM AUDIT EXERCISE EDUC TOPICS;;Diabetes Excercise Education Topics
+7 ;;DM AUDIT OTHER EDUC TOPICS;;Other Diabetes Education Topics
+8 ;;DM AUDIT SMOKING CESS EDUC;;Smoking Cess Education Topics
+9 ;;DM AUDIT TOBACCO HLTH FACTORS;;Tobacco Health Factors
+10 ;;DM AUDIT PROBLEM SMOKING DXS;;Smoking related diagnoses for Problem List
+11 ;;DM AUDIT PROBLEM HTN DIAGNOSES;;Hypertension Diagnoses
+12 ;;DM AUDIT PROBLEM DIABETES DX;;Diabetes Diagnoses
+13 ;;DM AUDIT SMOKING RELATED DXS;;Smoking related diagnoses for POVs
+14 ;;DM AUDIT CESSATION HLTH FACTOR;;Smoking Cessation Health Factors
+15 ;;DM AUDIT SELF MONITOR DRUGS;;Self Monitoring Drugs Taxonomy
+16 ;;DM AUDIT TB HEALTH FACTORS;;TB Status Health Factors
+17 ;;DM AUDIT INSULIN DRUGS;;Insulin Drug Taxonomy
+18 ;;DM AUDIT SULFONYLUREA DRUGS;;Sulfonylurea Drug Taxonomy
+19 ;;DM AUDIT METFORMIN DRUGS;;Metformin Drug Taxonomy
+20 ;;DM AUDIT ACARBOSE DRUGS;;Acarbose Drug Taxonomy
+21 ;;DM AUDIT GLITAZONE DRUGS;;Glitzaone Drug Taxonomy
+22 ;;DM AUDIT ACE INHIBITORS;;ACE Inhibitor Drug Taxonomy
+23 ;;DM AUDIT ASPIRIN DRUGS;;Aspirin Drug Taxonomy
+24 ;;DM AUDIT SDM PROVIDERS;;SDM providers Taxonomy
+25 ;;DM AUDIT TYPE II DXS;;Type II Diagnoses
+26 ;;DM AUDIT TYPE I DXS;;Type I Diagnoses
+27 ;;
LAB ;
+1 ;;DM AUDIT URINE PROTEIN TAX;;Urine Protein Lab Taxonomy
+2 ;;DM AUDIT MICROALBUMINURIA TAX;;Microalbuminuia Lab Taxonomy
+3 ;;DM AUDIT HGB A1C TAX;;HGB A1C Lab Taxonomy
+4 ;;DM AUDIT GLUCOSE TESTS TAX;;Glucose Tests Taxonomy
+5 ;;DM AUDIT AST TAX;;AST Lab Taxonomy
+6 ;;DM AUDIT ALT TAX;;ALT Lab Taxonomy
+7 ;;DM AUDIT CREATININE TAX;;Creatinine Lab Taxonomy
+8 ;;DM AUDIT CHOLESTEROL TAX;;Cholesterol Lab Taxonomy
+9 ;;DM AUDIT LDL CHOLESTEROL TAX;;LDL Cholesterol Lab Taxonomy
+10 ;;DM AUDIT TRIGLYCERIDE TAX;;Triglyceride Lab Taxonomy
+11 ;;DM AUDIT URINALYSIS TAX;;Urinalysis Lab Taxonomy
+12 ;;
