APCLTAX4 ; IHS/CMI/LAB - TAXONOMY SYSTEM CON'T ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;;
LABLINIT ;EP;TO SET UP LAB LIST ARRAY
D TAXINIT^APCLTAX0
Q
Z(X) ;SET TMP NODE
S VALMCNT=$G(VALMCNT)+1
S ^TMP("APCLVR",$J,VALMCNT,0)=X
Q
TAXTEXT ;EP;TO LIST CURRENT TAXONOMIES
DX ;EP;DIAGNOSIS
;;SURVEILLANCE DIABETES
;;SURVEILLANCE HYPERTENSION
;;SURVEILLANCE TUBERCULOSIS
;;PROBLEM SMOKING DXS
;;SMOKING RELATED DXS
;;PROBLEM HTN DIAGNOSES
;;PROBLEM DIABETES DX
;;TYPE II DXS
;;TYPE I DXS
;;
HF ;;EP;HEALTH FACTORS
;;TOBACCO HLTH FACTORS
;;CESSATION HLTH FACTOR
;;TB HEALTH FACTORS
;;
ET ;;EP;PATIENT ED TOPIC
;;DIET EDUC TOPICS
;;EXERCISE EDUC TOPICS
;;OTHER EDUC TOPICS
;;SMOKING CESS EDUC
;;
RX ;;EP;RX
;;ACE INHIBITORS
;;ACARBOSE DRUGS
;;ASPIRIN DRUGS
;;ANTI-PLATELET DRUGS
;;INSULIN DRUGS
;;METFORMIN DRUGS
;;SULFONYLUREA DRUGS
;;SELF MONITOR DRUGS
;;GLITAZONE DRUGS
;;LIPID LOWERING DRUGS
;;STATIN DRUGS
;;
PV ;;EP;PROVIDER
;;SDM PROVIDERS
;;
ADA ;;EP;;ADA
;;APCH DM ADA EXAMS
;;
LAB ;EP;TO LIST DMS LAB TAXONOMIES
;;ALT TAX
;;AST TAX
;;CHOLESTEROL TAX
;;CREATININE TAX
;;GLUCOSE TESTS TAX
;;HGB A1C TAX
;;LDL CHOLESTEROL TAX
;;HDL TAX
;;MICROALBUMINURIA TAX
;;TRIGLYCERIDE TAX
;;URINALYSIS TAX
;;URINE PROTEIN TAX
;;
Q
PROCESS ;EP;TO PROCESS AND DISPLAY DIFFERENT GROUPS OF DMS TAXONOMIES
K APCLTAX
N X,Y,Z
S X=APCLANAM
S EP=$S(X["DIAG":"DX",X="RX":"RX",X["ED TOP":"ET",X["FACTOR":"HF",X["PROVIDER":"PV",X["ADA":"ADA",1:"LAB")
S X=""
F J=1:1 S X=$T(@EP+J) Q:$P(X,";;",2)="" D
.S Y=$P(X,";;",2)
.I Y'["SURV",$E(Y,1,4)'="APCH" S Y="DM AUDIT "_Y
.Q:Y=""
.I EP'="LAB" S Z=$O(^ATXAX("B",Y,0))
.E S Z=$O(^ATXLAB("B",Y,0))
.Q:'Z
.S APCLTAX(Y)=Z
Q
LABINIT ;EP;INITIALIZE ARRAY FOR TAXONOMY DISPLAY
K ^TMP("APCLVR",$J),APCLJ
S VALMCNT=0
Q:'$G(APCLTDA)
S X=" "_$P(^ATXLAB(APCLTDA,0),U)
D Z(X)
S X=" No. Lab Site/Specimen"
D Z(X)
S X=" --- ------------------------------ --------------"
D Z(X)
N A,B,X,Y,Z
S Z=3
S (APCLX,B)=0
F S APCLX=$O(^ATXLAB(APCLTDA,21,APCLX)) Q:'APCLX D:$D(^ATXLAB(APCLTDA,21,APCLX,0))
.S Y=$P(^ATXLAB(APCLTDA,21,APCLX,0),U)
.Q:'Y
.S Y=$P($G(^LAB(60,Y,0)),U)
.S B=B+1
.S A=" "_B
.S:$L(A)=5 A=" "_A
.S A=A_" "
.S A=A_Y
.S A=A_$E(" ",1,32-$L(Y))
.D Z(A)
.S APCLJ(APCLTDA,B)=APCLX
.S (J,APCLY)=0
.F S APCLY=$O(^ATXLAB(APCLTDA,21,APCLX,11,APCLY)) Q:'APCLY D:$D(^ATXLAB(APCLTDA,21,APCLX,11,APCLY,0))
..S A=$P(^ATXLAB(APCLTDA,21,APCLX,11,APCLY,0),U)
..Q:'A
..S J=J+1
..S A=$P($G(^LAB(61,A,0)),U)
..I J=1 D
...S ^TMP("APCLVR",$J,VALMCNT,0)=^TMP("APCLVR",$J,VALMCNT,0)_A
..I J>1 D
...S X=" "_A
...D Z(X)
I '$D(^TMP("APCLVR",$J)) D
.S ^TMP("APCLVR",$J,1,0)="NO TAXONOMIES ON FILE FOR "_$G(APCLX)
.S Z=1
S APCLJ=B
S VALMCNT=Z
Q
APCLTAX4 ; IHS/CMI/LAB - TAXONOMY SYSTEM CON'T ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;;
LABLINIT ;EP;TO SET UP LAB LIST ARRAY
+1 DO TAXINIT^APCLTAX0
+2 QUIT
Z(X) ;SET TMP NODE
+1 SET VALMCNT=$GET(VALMCNT)+1
+2 SET ^TMP("APCLVR",$JOB,VALMCNT,0)=X
+3 QUIT
TAXTEXT ;EP;TO LIST CURRENT TAXONOMIES
DX ;EP;DIAGNOSIS
+1 ;;SURVEILLANCE DIABETES
+2 ;;SURVEILLANCE HYPERTENSION
+3 ;;SURVEILLANCE TUBERCULOSIS
+4 ;;PROBLEM SMOKING DXS
+5 ;;SMOKING RELATED DXS
+6 ;;PROBLEM HTN DIAGNOSES
+7 ;;PROBLEM DIABETES DX
+8 ;;TYPE II DXS
+9 ;;TYPE I DXS
+10 ;;
HF ;;EP;HEALTH FACTORS
+1 ;;TOBACCO HLTH FACTORS
+2 ;;CESSATION HLTH FACTOR
+3 ;;TB HEALTH FACTORS
+4 ;;
ET ;;EP;PATIENT ED TOPIC
+1 ;;DIET EDUC TOPICS
+2 ;;EXERCISE EDUC TOPICS
+3 ;;OTHER EDUC TOPICS
+4 ;;SMOKING CESS EDUC
+5 ;;
RX ;;EP;RX
+1 ;;ACE INHIBITORS
+2 ;;ACARBOSE DRUGS
+3 ;;ASPIRIN DRUGS
+4 ;;ANTI-PLATELET DRUGS
+5 ;;INSULIN DRUGS
+6 ;;METFORMIN DRUGS
+7 ;;SULFONYLUREA DRUGS
+8 ;;SELF MONITOR DRUGS
+9 ;;GLITAZONE DRUGS
+10 ;;LIPID LOWERING DRUGS
+11 ;;STATIN DRUGS
+12 ;;
PV ;;EP;PROVIDER
+1 ;;SDM PROVIDERS
+2 ;;
ADA ;;EP;;ADA
+1 ;;APCH DM ADA EXAMS
+2 ;;
LAB ;EP;TO LIST DMS LAB TAXONOMIES
+1 ;;ALT TAX
+2 ;;AST TAX
+3 ;;CHOLESTEROL TAX
+4 ;;CREATININE TAX
+5 ;;GLUCOSE TESTS TAX
+6 ;;HGB A1C TAX
+7 ;;LDL CHOLESTEROL TAX
+8 ;;HDL TAX
+9 ;;MICROALBUMINURIA TAX
+10 ;;TRIGLYCERIDE TAX
+11 ;;URINALYSIS TAX
+12 ;;URINE PROTEIN TAX
+13 ;;
+14 QUIT
PROCESS ;EP;TO PROCESS AND DISPLAY DIFFERENT GROUPS OF DMS TAXONOMIES
+1 KILL APCLTAX
+2 NEW X,Y,Z
+3 SET X=APCLANAM
+4 SET EP=$SELECT(X["DIAG":"DX",X="RX":"RX",X["ED TOP":"ET",X["FACTOR":"HF",X["PROVIDER":"PV",X["ADA":"ADA",1:"LAB")
+5 SET X=""
+6 FOR J=1:1
SET X=$TEXT(@EP+J)
IF $PIECE(X,";;",2)=""
QUIT
Begin DoDot:1
+7 SET Y=$PIECE(X,";;",2)
+8 IF Y'["SURV"
IF $EXTRACT(Y,1,4)'="APCH"
SET Y="DM AUDIT "_Y
+9 IF Y=""
QUIT
+10 IF EP'="LAB"
SET Z=$ORDER(^ATXAX("B",Y,0))
+11 IF '$TEST
SET Z=$ORDER(^ATXLAB("B",Y,0))
+12 IF 'Z
QUIT
+13 SET APCLTAX(Y)=Z
End DoDot:1
+14 QUIT
LABINIT ;EP;INITIALIZE ARRAY FOR TAXONOMY DISPLAY
+1 KILL ^TMP("APCLVR",$JOB),APCLJ
+2 SET VALMCNT=0
+3 IF '$GET(APCLTDA)
QUIT
+4 SET X=" "_$PIECE(^ATXLAB(APCLTDA,0),U)
+5 DO Z(X)
+6 SET X=" No. Lab Site/Specimen"
+7 DO Z(X)
+8 SET X=" --- ------------------------------ --------------"
+9 DO Z(X)
+10 NEW A,B,X,Y,Z
+11 SET Z=3
+12 SET (APCLX,B)=0
+13 FOR
SET APCLX=$ORDER(^ATXLAB(APCLTDA,21,APCLX))
IF 'APCLX
QUIT
IF $DATA(^ATXLAB(APCLTDA,21,APCLX,0))
Begin DoDot:1
+14 SET Y=$PIECE(^ATXLAB(APCLTDA,21,APCLX,0),U)
+15 IF 'Y
QUIT
+16 SET Y=$PIECE($GET(^LAB(60,Y,0)),U)
+17 SET B=B+1
+18 SET A=" "_B
+19 IF $LENGTH(A)=5
SET A=" "_A
+20 SET A=A_" "
+21 SET A=A_Y
+22 SET A=A_$EXTRACT(" ",1,32-$LENGTH(Y))
+23 DO Z(A)
+24 SET APCLJ(APCLTDA,B)=APCLX
+25 SET (J,APCLY)=0
+26 FOR
SET APCLY=$ORDER(^ATXLAB(APCLTDA,21,APCLX,11,APCLY))
IF 'APCLY
QUIT
IF $DATA(^ATXLAB(APCLTDA,21,APCLX,11,APCLY,0))
Begin DoDot:2
+27 SET A=$PIECE(^ATXLAB(APCLTDA,21,APCLX,11,APCLY,0),U)
+28 IF 'A
QUIT
+29 SET J=J+1
+30 SET A=$PIECE($GET(^LAB(61,A,0)),U)
+31 IF J=1
Begin DoDot:3
+32 SET ^TMP("APCLVR",$JOB,VALMCNT,0)=^TMP("APCLVR",$JOB,VALMCNT,0)_A
End DoDot:3
+33 IF J>1
Begin DoDot:3
+34 SET X=" "_A
+35 DO Z(X)
End DoDot:3
End DoDot:2
End DoDot:1
+36 IF '$DATA(^TMP("APCLVR",$JOB))
Begin DoDot:1
+37 SET ^TMP("APCLVR",$JOB,1,0)="NO TAXONOMIES ON FILE FOR "_$GET(APCLX)
+38 SET Z=1
End DoDot:1
+39 SET APCLJ=B
+40 SET VALMCNT=Z
+41 QUIT
