- APCLD619 ; IHS/CMI/LAB - 2006 DIABETES AUDIT ;
- ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- ;
- ;
- W:$D(IOF) @IOF
- W !!,"Checking for Taxonomies to support the 2006 Audit. ",!,"Please enter the device for printing.",!
- ZIS ;
- S XBRC="",XBRP="TAXCHK^APCLD619",XBNS="",XBRX="XIT^APCLD619"
- D ^XBDBQUE
- D XIT
- Q
- TAXCHK ;EP
- W:$D(IOF) @IOF
- K APCLQUIT
- W !,"Checking for Taxonomies to support the 2006 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 2006 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
- LASTHF(P,C,BDATE,EDATE,F) ;EP - get last factor in category C for patient P
- I '$G(P) Q ""
- I $G(C)="" Q ""
- I $G(F)="" S F=""
- S C=$O(^AUTTHF("B",C,0)) ;ien of category passed
- I '$G(C) Q ""
- NEW H,D,O S H=0 K O
- F S H=$O(^AUTTHF("AC",C,H)) Q:'+H D
- . Q:'$D(^AUPNVHF("AA",P,H))
- . S D="" F S D=$O(^AUPNVHF("AA",P,H,D)) Q:D'=+D D
- .. Q:(9999999-D)>EDATE ;after time frame
- .. Q:(9999999-D)<BDATE ;before time frame
- .. S O(D)=$O(^AUPNVHF("AA",P,H,D,""))
- . Q
- S D=$O(O(0))
- I D="" Q D
- I F="F" Q $P(^AUTTHF($P(^AUPNVHF(O(D),0),U),0),U)
- ;
- Q 1
- ;;
- BANNER ;EP - banner for 2006 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 **
- ;;** 2006 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
- BMIEPI(H,W) ;EP ;
- NEW %
- I H="" Q ""
- I W="" Q ""
- I 'H Q ""
- S W=W*.45359,H=(H*.0254),H=(H*H),%=(W/H),%=$J(%,4,1)
- Q %
- TAXS ;
- ;;SURVEILLANCE DIABETES;;Diabetes Diagnoses Codes
- ;;SURVEILLANCE HYPERTENSION;;Hypertension Diagnoses Codes
- ;;SURVEILLANCE TUBERCULOSIS;;Tuberculosis Diagnoses Codes
- ;;DM AUDIT DEPRESSIVE DISORDERS;;Depressive Disorders Diagnoses Codes
- ;;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 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 LIPID LOWERING DRUGS;;Lipid Lowering Drug Taxonomy
- ;;DM AUDIT STATIN DRUGS;;Statin 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 ANTI-PLATELET DRUGS;;Anti-Platelet 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 CREATININE TAX;;Creatinine Lab Taxonomy
- ;;DM AUDIT CHOLESTEROL TAX;;Cholesterol Lab Taxonomy
- ;;DM AUDIT LDL CHOLESTEROL TAX;;LDL Cholesterol Lab Taxonomy
- ;;DM AUDIT HDL TAX;;HDL Lab Taxonomy
- ;;DM AUDIT TRIGLYCERIDE TAX;;Triglyceride Lab Taxonomy
- ;;DM AUDIT URINALYSIS TAX;;Urinalysis Lab Taxonomy
- ;;DM AUDIT A/C RATIO TAX;;A/C RATIO Lab Taxonomy
- ;;
- APCLD619 ; IHS/CMI/LAB - 2006 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 2006 Audit. ",!,"Please enter the device for printing.",!
- ZIS ;
- +1 SET XBRC=""
- SET XBRP="TAXCHK^APCLD619"
- SET XBNS=""
- SET XBRX="XIT^APCLD619"
- +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 2006 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 2006 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
- LASTHF(P,C,BDATE,EDATE,F) ;EP - get last factor in category C for patient P
- +1 IF '$GET(P)
- QUIT ""
- +2 IF $GET(C)=""
- QUIT ""
- +3 IF $GET(F)=""
- SET F=""
- +4 ;ien of category passed
- SET C=$ORDER(^AUTTHF("B",C,0))
- +5 IF '$GET(C)
- QUIT ""
- +6 NEW H,D,O
- SET H=0
- KILL O
- +7 FOR
- SET H=$ORDER(^AUTTHF("AC",C,H))
- IF '+H
- QUIT
- Begin DoDot:1
- +8 IF '$DATA(^AUPNVHF("AA",P,H))
- QUIT
- +9 SET D=""
- FOR
- SET D=$ORDER(^AUPNVHF("AA",P,H,D))
- IF D'=+D
- QUIT
- Begin DoDot:2
- +10 ;after time frame
- IF (9999999-D)>EDATE
- QUIT
- +11 ;before time frame
- IF (9999999-D)<BDATE
- QUIT
- +12 SET O(D)=$ORDER(^AUPNVHF("AA",P,H,D,""))
- End DoDot:2
- +13 QUIT
- End DoDot:1
- +14 SET D=$ORDER(O(0))
- +15 IF D=""
- QUIT D
- +16 IF F="F"
- QUIT $PIECE(^AUTTHF($PIECE(^AUPNVHF(O(D),0),U),0),U)
- +17 ;
- +18 QUIT 1
- +19 ;;
- BANNER ;EP - banner for 2006 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 ;;** 2006 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
- BMIEPI(H,W) ;EP ;
- +1 NEW %
- +2 IF H=""
- QUIT ""
- +3 IF W=""
- QUIT ""
- +4 IF 'H
- QUIT ""
- +5 SET W=W*.45359
- SET H=(H*.0254)
- SET H=(H*H)
- SET %=(W/H)
- SET %=$JUSTIFY(%,4,1)
- +6 QUIT %
- TAXS ;
- +1 ;;SURVEILLANCE DIABETES;;Diabetes Diagnoses Codes
- +2 ;;SURVEILLANCE HYPERTENSION;;Hypertension Diagnoses Codes
- +3 ;;SURVEILLANCE TUBERCULOSIS;;Tuberculosis Diagnoses Codes
- +4 ;;DM AUDIT DEPRESSIVE DISORDERS;;Depressive Disorders Diagnoses Codes
- +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 TB HEALTH FACTORS;;TB Status Health Factors
- +16 ;;DM AUDIT INSULIN DRUGS;;Insulin Drug Taxonomy
- +17 ;;DM AUDIT SULFONYLUREA DRUGS;;Sulfonylurea Drug Taxonomy
- +18 ;;DM AUDIT METFORMIN DRUGS;;Metformin Drug Taxonomy
- +19 ;;DM AUDIT ACARBOSE DRUGS;;Acarbose Drug Taxonomy
- +20 ;;DM AUDIT LIPID LOWERING DRUGS;;Lipid Lowering Drug Taxonomy
- +21 ;;DM AUDIT STATIN DRUGS;;Statin Drug Taxonomy
- +22 ;;DM AUDIT GLITAZONE DRUGS;;Glitzaone Drug Taxonomy
- +23 ;;DM AUDIT ACE INHIBITORS;;ACE Inhibitor Drug Taxonomy
- +24 ;;DM AUDIT ASPIRIN DRUGS;;Aspirin Drug Taxonomy
- +25 ;;DM AUDIT ANTI-PLATELET DRUGS;;Anti-Platelet Drug Taxonomy
- +26 ;;DM AUDIT SDM PROVIDERS;;SDM providers Taxonomy
- +27 ;;DM AUDIT TYPE II DXS;;Type II Diagnoses
- +28 ;;DM AUDIT TYPE I DXS;;Type I Diagnoses
- +29 ;;
- 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 CREATININE TAX;;Creatinine Lab Taxonomy
- +5 ;;DM AUDIT CHOLESTEROL TAX;;Cholesterol Lab Taxonomy
- +6 ;;DM AUDIT LDL CHOLESTEROL TAX;;LDL Cholesterol Lab Taxonomy
- +7 ;;DM AUDIT HDL TAX;;HDL Lab Taxonomy
- +8 ;;DM AUDIT TRIGLYCERIDE TAX;;Triglyceride Lab Taxonomy
- +9 ;;DM AUDIT URINALYSIS TAX;;Urinalysis Lab Taxonomy
- +10 ;;DM AUDIT A/C RATIO TAX;;A/C RATIO Lab Taxonomy
- +11 ;;