APCLD7TS ; IHS/CMI/LAB - DISPLAY IND LISTS ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;; ;
EP ;EP - CALLED FROM OPTION
D EN
Q
EOJ ;EP
D EN^XBVK("APCL")
Q
;; ;
EN ;EP -- main entry point for
D EN^VALM("APCLD7 TAXONOMY UPDATE")
D CLEAR^VALM1
D FULL^VALM1
W:$D(IOF) @IOF
D EOJ
Q
;
PAUSE ;EP
Q:$E(IOST)'="C"!(IO'=IO(0))
W ! S DIR(0)="EO",DIR("A")="Press enter to continue...." D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q
HDR ; -- header code
S VALMHDR(1)="TAXONOMIES TO SUPPORT 2007 DIABETES AUDIT REPORTING"
S VALMHDR(2)="* Update Taxonomies"
Q
;
INIT ; -- init variables and list array
K APCLTAX S APCLHIGH="",C=0
S T="TAXS" F J=1:1 S Z=$T(@T+J),APCLX=$P(Z,";;",2),Y=$P(Z,";;",3) Q:APCLX="" D
.S APCLTAX(J,0)=J_") "_APCLX,$E(APCLTAX(J,0),38)=$E(Y,1,30)
.S I=$O(^ATXAX("B",APCLX,0))
.S $E(APCLTAX(J,0),70)=$$VAL^XBDIQ1(9002226,I,.15)
.S APCLTAX("IDX",J,J)=I_U_"T"
.S C=C+1
.Q
S J=J-1 S T="LAB" F K=1:1 S Z=$T(@T+K),APCLX=$P(Z,";;",2),Y=$P(Z,";;",3) Q:APCLX="" D
.S J=J+1
.S APCLTAX(J,0)=J_") "_APCLX,$E(APCLTAX(J,0),38)=$E(Y,1,30),$E(APCLTAX(J,0),70)="LAB TEST"
.S I=$O(^ATXLAB("B",APCLX,0))
.S APCLTAX("IDX",J,J)=I_U_"L"
.S C=C+1
.Q
S (VALMCNT,APCLHIGH)=C
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
Q
;
EXPND ; -- expand code
Q
;
BACK ;go back to listman
D TERM^VALM0
S VALMBCK="R"
D INIT
D HDR
K DIR
K X,Y,Z,I
Q
;
ADD ;EP - add an item to the selected list - called from a protocol
D FULL^VALM1
W !
S DIR(0)="NO^1:"_APCLHIGH,DIR("A")="Which Taxonomy"
D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I Y="" W !,"No taxonomy selected." G ADDX
I $D(DIRUT) W !,"No taxonomy selected." G ADDX
S APCLTAXI=$P(APCLTAX("IDX",Y,Y),U,1),APCLTAXT=$P(APCLTAX("IDX",Y,Y),U,2)
I APCLTAXT="L" S APCLTAXN=$P(^ATXLAB(APCLTAXI,0),U)
I APCLTAXT="T" S APCLTAXN=$P(^ATXAX(APCLTAXI,0),U)
I APCLTAXT="L",$P(^ATXLAB(APCLTAXI,0),U,22) W !!,"The ",$P(^ATXLAB(APCLTAXI,0),U)," taxonomy is READ ONLY.",!,"You can not update it." D PAUSE G ADDX
I APCLTAXT="T",$P(^ATXAX(APCLTAXI,0),U,22) W !!,"The ",$P(^ATXAX(APCLTAXI,0),U)," taxonomy is READ ONLY.",!,"You can not update it." D PAUSE G ADDX
D FULL^VALM1 W:$D(IOF) @IOF
D EP^APCLD7TL(APCLTAXI)
ADDX ;
D BACK
Q
DISP ;EP - add an item to the selected list - called from a protocol
W !
S DIR(0)="NO^1:"_APCLHIGH,DIR("A")="Which Taxonomy"
D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I Y="" W !,"No taxonomy selected." G ADDX
I $D(DIRUT) W !,"No taxonomy selected." G ADDX
D FULL^VALM1 W:$D(IOF) @IOF
S APCLTAXI=$P(APCLTAX("IDX",Y,Y),U,1),APCLTAXT=$P(APCLTAX("IDX",Y,Y),U,2)
W !!!,$S(APCLTAXT="L":$P(^ATXLAB(APCLTAXI,0),U),1:$P(^ATXAX(APCLTAXI,0),U))
W !!,"Items currently defined to this taxonomy:"
I APCLTAXT="L" S X=0 F S X=$O(^ATXLAB(APCLTAXI,21,"B",X)) Q:X="" D
.S Y=$P($G(^LAB(60,X,0)),U) W !?5,Y
I APCLTAXT="T",'$P(^ATXAX(APCLTAXI,0),U,13) S X=0 F S X=$O(^ATXAX(APCLTAXI,21,"B",X)) Q:X="" D
.W !?5,$$VAL^XBDIQ1($P(^ATXAX(APCLTAXI,0),U,15),X,.01)
I APCLTAXT="T",$P(^ATXAX(APCLTAXI,0),U,13) S X=0 F S X=$O(^ATXAX(APCLTAXI,21,"B",X)) Q:X="" D
.S H=0 F S H=$O(^ATXAX(APCLTAXI,21,"B",X,H)) Q:H="" D
..W !?5,$P(^ATXAX(APCLTAXI,21,H,0),U)_"-"_$P(^ATXAX(APCLTAXI,21,H,0),U,2)
W !!
K DIR S DIR(0)="E",DIR("A")="Press enter to continue" D ^DIR K DIR
DISPX ;
D BACK
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
;;DM AUDIT LIPID PROFILE TAX;;Lipid Profile taxonomy
;;DM AUDIT GLUCOSE TESTS TAX;;Glucose Tests lab taxonomy
;;
APCLD7TS ; IHS/CMI/LAB - DISPLAY IND LISTS ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;; ;
EP ;EP - CALLED FROM OPTION
+1 DO EN
+2 QUIT
EOJ ;EP
+1 DO EN^XBVK("APCL")
+2 QUIT
+3 ;; ;
EN ;EP -- main entry point for
+1 DO EN^VALM("APCLD7 TAXONOMY UPDATE")
+2 DO CLEAR^VALM1
+3 DO FULL^VALM1
+4 IF $DATA(IOF)
WRITE @IOF
+5 DO EOJ
+6 QUIT
+7 ;
PAUSE ;EP
+1 IF $EXTRACT(IOST)'="C"!(IO'=IO(0))
QUIT
+2 WRITE !
SET DIR(0)="EO"
SET DIR("A")="Press enter to continue...."
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 QUIT
HDR ; -- header code
+1 SET VALMHDR(1)="TAXONOMIES TO SUPPORT 2007 DIABETES AUDIT REPORTING"
+2 SET VALMHDR(2)="* Update Taxonomies"
+3 QUIT
+4 ;
INIT ; -- init variables and list array
+1 KILL APCLTAX
SET APCLHIGH=""
SET C=0
+2 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
+3 SET APCLTAX(J,0)=J_") "_APCLX
SET $EXTRACT(APCLTAX(J,0),38)=$EXTRACT(Y,1,30)
+4 SET I=$ORDER(^ATXAX("B",APCLX,0))
+5 SET $EXTRACT(APCLTAX(J,0),70)=$$VAL^XBDIQ1(9002226,I,.15)
+6 SET APCLTAX("IDX",J,J)=I_U_"T"
+7 SET C=C+1
+8 QUIT
End DoDot:1
+9 SET J=J-1
SET T="LAB"
FOR K=1:1
SET Z=$TEXT(@T+K)
SET APCLX=$PIECE(Z,";;",2)
SET Y=$PIECE(Z,";;",3)
IF APCLX=""
QUIT
Begin DoDot:1
+10 SET J=J+1
+11 SET APCLTAX(J,0)=J_") "_APCLX
SET $EXTRACT(APCLTAX(J,0),38)=$EXTRACT(Y,1,30)
SET $EXTRACT(APCLTAX(J,0),70)="LAB TEST"
+12 SET I=$ORDER(^ATXLAB("B",APCLX,0))
+13 SET APCLTAX("IDX",J,J)=I_U_"L"
+14 SET C=C+1
+15 QUIT
End DoDot:1
+16 SET (VALMCNT,APCLHIGH)=C
+17 QUIT
+18 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 QUIT
+2 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
BACK ;go back to listman
+1 DO TERM^VALM0
+2 SET VALMBCK="R"
+3 DO INIT
+4 DO HDR
+5 KILL DIR
+6 KILL X,Y,Z,I
+7 QUIT
+8 ;
ADD ;EP - add an item to the selected list - called from a protocol
+1 DO FULL^VALM1
+2 WRITE !
+3 SET DIR(0)="NO^1:"_APCLHIGH
SET DIR("A")="Which Taxonomy"
+4 DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+5 IF Y=""
WRITE !,"No taxonomy selected."
GOTO ADDX
+6 IF $DATA(DIRUT)
WRITE !,"No taxonomy selected."
GOTO ADDX
+7 SET APCLTAXI=$PIECE(APCLTAX("IDX",Y,Y),U,1)
SET APCLTAXT=$PIECE(APCLTAX("IDX",Y,Y),U,2)
+8 IF APCLTAXT="L"
SET APCLTAXN=$PIECE(^ATXLAB(APCLTAXI,0),U)
+9 IF APCLTAXT="T"
SET APCLTAXN=$PIECE(^ATXAX(APCLTAXI,0),U)
+10 IF APCLTAXT="L"
IF $PIECE(^ATXLAB(APCLTAXI,0),U,22)
WRITE !!,"The ",$PIECE(^ATXLAB(APCLTAXI,0),U)," taxonomy is READ ONLY.",!,"You can not update it."
DO PAUSE
GOTO ADDX
+11 IF APCLTAXT="T"
IF $PIECE(^ATXAX(APCLTAXI,0),U,22)
WRITE !!,"The ",$PIECE(^ATXAX(APCLTAXI,0),U)," taxonomy is READ ONLY.",!,"You can not update it."
DO PAUSE
GOTO ADDX
+12 DO FULL^VALM1
IF $DATA(IOF)
WRITE @IOF
+13 DO EP^APCLD7TL(APCLTAXI)
ADDX ;
+1 DO BACK
+2 QUIT
DISP ;EP - add an item to the selected list - called from a protocol
+1 WRITE !
+2 SET DIR(0)="NO^1:"_APCLHIGH
SET DIR("A")="Which Taxonomy"
+3 DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+4 IF Y=""
WRITE !,"No taxonomy selected."
GOTO ADDX
+5 IF $DATA(DIRUT)
WRITE !,"No taxonomy selected."
GOTO ADDX
+6 DO FULL^VALM1
IF $DATA(IOF)
WRITE @IOF
+7 SET APCLTAXI=$PIECE(APCLTAX("IDX",Y,Y),U,1)
SET APCLTAXT=$PIECE(APCLTAX("IDX",Y,Y),U,2)
+8 WRITE !!!,$SELECT(APCLTAXT="L":$PIECE(^ATXLAB(APCLTAXI,0),U),1:$PIECE(^ATXAX(APCLTAXI,0),U))
+9 WRITE !!,"Items currently defined to this taxonomy:"
+10 IF APCLTAXT="L"
SET X=0
FOR
SET X=$ORDER(^ATXLAB(APCLTAXI,21,"B",X))
IF X=""
QUIT
Begin DoDot:1
+11 SET Y=$PIECE($GET(^LAB(60,X,0)),U)
WRITE !?5,Y
End DoDot:1
+12 IF APCLTAXT="T"
IF '$PIECE(^ATXAX(APCLTAXI,0),U,13)
SET X=0
FOR
SET X=$ORDER(^ATXAX(APCLTAXI,21,"B",X))
IF X=""
QUIT
Begin DoDot:1
+13 WRITE !?5,$$VAL^XBDIQ1($PIECE(^ATXAX(APCLTAXI,0),U,15),X,.01)
End DoDot:1
+14 IF APCLTAXT="T"
IF $PIECE(^ATXAX(APCLTAXI,0),U,13)
SET X=0
FOR
SET X=$ORDER(^ATXAX(APCLTAXI,21,"B",X))
IF X=""
QUIT
Begin DoDot:1
+15 SET H=0
FOR
SET H=$ORDER(^ATXAX(APCLTAXI,21,"B",X,H))
IF H=""
QUIT
Begin DoDot:2
+16 WRITE !?5,$PIECE(^ATXAX(APCLTAXI,21,H,0),U)_"-"_$PIECE(^ATXAX(APCLTAXI,21,H,0),U,2)
End DoDot:2
End DoDot:1
+17 WRITE !!
+18 KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press enter to continue"
DO ^DIR
KILL DIR
DISPX ;
+1 DO BACK
+2 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 ;;DM AUDIT LIPID PROFILE TAX;;Lipid Profile taxonomy
+12 ;;DM AUDIT GLUCOSE TESTS TAX;;Glucose Tests lab taxonomy
+13 ;;
