BGP4TXHE ; IHS/CMI/LAB - TAXONOMY CHECK FOR FY04 HEDIS REPORT ;
;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007
;
;
D HOME^%ZIS
W:$D(IOF) @IOF
W !!,"Checking for Taxonomies to support the FY 04 HEDIS Report. ",!,"Please enter the device for printing.",!
ZIS ;
S XBRC="",XBRP="TAXCHK^BGP4TXHE",XBNS="",XBRX="XIT^BGP4TXHE"
D ^XBDBQUE
D XIT
Q
TAXCHK ;EP
D HOME^%ZIS
;W:$D(IOF) @IOF
K BGPQUIT
W !,"Checking for Taxonomies to support the HEDIS Report...",!
NEW A,BGPX,I,Y,Z,J
K A
S T="TAXS" F J=1:1 S Z=$T(@T+J),BGPX=$P(Z,";;",2),Y=$P(Z,";;",3) Q:BGPX="" D
.I '$D(^ATXAX("B",BGPX)) S A(BGPX)=Y_"^is Missing" Q
.S I=$O(^ATXAX("B",BGPX,0))
.I '$D(^ATXAX(I,21,"B")) S A(BGPX)=Y_"^has no entries "
S T="LAB" F J=1:1 S Z=$T(@T+J),BGPX=$P(Z,";;",2),Y=$P(Z,";;",3) Q:BGPX="" D
.I '$D(^ATXLAB("B",BGPX)) S A(BGPX)=Y_"^is Missing " Q
.S I=$O(^ATXLAB("B",BGPX,0))
.I '$D(^ATXLAB(I,21,"B")) S A(BGPX)=Y_"^has no entries "
I '$D(A) W !,"All taxonomies are present.",! K A,BGPX,Y,I,Z D DONE Q
W !!,"In order for the HEDIS Report to find all necessary data, several",!,"taxonomies must be established. The following taxonomies are missing or have",!,"no entries:"
S BGPX="" F S BGPX=$O(A(BGPX)) Q:BGPX=""!($D(BGPQUIT)) D
.I $Y>(IOSL-2) D PAGE Q:$D(BGPQUIT)
.W !,$P(A(BGPX),U)," [",BGPX,"] ",$P(A(BGPX),U,2)
.Q
DONE ;
K BGPQUIT
I $E(IOST)="C",IO=IO(0) S DIR(0)="EO",DIR("A")="End of taxonomy check. PRESS ENTER" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q
XIT ;EP
K BGP,BGPX,BGPQUIT,BGPLINE,BGPJ,BGPX,BGPTEXT,BGP
K X,Y,J
Q
PAGE ;
I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BGPQUIT="" Q
Q
TAXS ;
;;BGP PRIMARY CARE CLINICS
;;BGP CHOLESTEROL LOINC CODES
;;BGP CHLAMYDIA LOINC CODES
;;BGP CHLAMYDIA CPTS
;;BGP HYSTERECTOMY CPTS
;;BGP ISCHEMIC HEART DXS
;;BGP GPRA SMOKING DXS;;Smoking diagnoses Taxonomy
;;SURVEILLANCE DIABETES;;Diabetes Diagnoses Codes
;;SURVEILLANCE HYPERTENSION;;Hypertension dx codes
;;BGP CPT PAP;;Pap CPTs Taxonomy
;;BGP CPT MAMMOGRAM;;Mammogram CPTs Taxonomy
;;BGP CPT FLU;;Flu CPTs Taxonomy
;;BGP URINE PROTEIN LOINC CODES
;;BGP MICROALBUM LOINC CODES
;;BGP LDL LOINC CODES
;;BGP HGBA1C LOINC CODES
;;BGP CREATININE LOINC CODES
;;BGP PAP LOINC CODES
;;BGP FOBT LOINC CODES
;;BGP COLO CPTS
;;BGP RECTAL PROCEDURE CODES
;;BGP SIG CPTS
LAB ;
;;BGP PAP SMEAR TAX
;;BGP GPRA FOB TESTS;;FOBT Lab Tests Taxonomy
;;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 LDL CHOLESTEROL TAX;;LDL Cholesterol Lab Taxonomy
;;DM AUDIT CREATININE TAX;;CREATININE test lab taxonomy
;;BGP CHLAMYDIA TESTS TAX;;Chlamydia lab taxonomy
;;
BGP4TXHE ; IHS/CMI/LAB - TAXONOMY CHECK FOR FY04 HEDIS REPORT ;
+1 ;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007
+2 ;
+3 ;
+4 DO HOME^%ZIS
+5 IF $DATA(IOF)
WRITE @IOF
+6 WRITE !!,"Checking for Taxonomies to support the FY 04 HEDIS Report. ",!,"Please enter the device for printing.",!
ZIS ;
+1 SET XBRC=""
SET XBRP="TAXCHK^BGP4TXHE"
SET XBNS=""
SET XBRX="XIT^BGP4TXHE"
+2 DO ^XBDBQUE
+3 DO XIT
+4 QUIT
TAXCHK ;EP
+1 DO HOME^%ZIS
+2 ;W:$D(IOF) @IOF
+3 KILL BGPQUIT
+4 WRITE !,"Checking for Taxonomies to support the HEDIS Report...",!
+5 NEW A,BGPX,I,Y,Z,J
+6 KILL A
+7 SET T="TAXS"
FOR J=1:1
SET Z=$TEXT(@T+J)
SET BGPX=$PIECE(Z,";;",2)
SET Y=$PIECE(Z,";;",3)
IF BGPX=""
QUIT
Begin DoDot:1
+8 IF '$DATA(^ATXAX("B",BGPX))
SET A(BGPX)=Y_"^is Missing"
QUIT
+9 SET I=$ORDER(^ATXAX("B",BGPX,0))
+10 IF '$DATA(^ATXAX(I,21,"B"))
SET A(BGPX)=Y_"^has no entries "
End DoDot:1
+11 SET T="LAB"
FOR J=1:1
SET Z=$TEXT(@T+J)
SET BGPX=$PIECE(Z,";;",2)
SET Y=$PIECE(Z,";;",3)
IF BGPX=""
QUIT
Begin DoDot:1
+12 IF '$DATA(^ATXLAB("B",BGPX))
SET A(BGPX)=Y_"^is Missing "
QUIT
+13 SET I=$ORDER(^ATXLAB("B",BGPX,0))
+14 IF '$DATA(^ATXLAB(I,21,"B"))
SET A(BGPX)=Y_"^has no entries "
End DoDot:1
+15 IF '$DATA(A)
WRITE !,"All taxonomies are present.",!
KILL A,BGPX,Y,I,Z
DO DONE
QUIT
+16 WRITE !!,"In order for the HEDIS Report to find all necessary data, several",!,"taxonomies must be established. The following taxonomies are missing or have",!,"no entries:"
+17 SET BGPX=""
FOR
SET BGPX=$ORDER(A(BGPX))
IF BGPX=""!($DATA(BGPQUIT))
QUIT
Begin DoDot:1
+18 IF $Y>(IOSL-2)
DO PAGE
IF $DATA(BGPQUIT)
QUIT
+19 WRITE !,$PIECE(A(BGPX),U)," [",BGPX,"] ",$PIECE(A(BGPX),U,2)
+20 QUIT
End DoDot:1
DONE ;
+1 KILL BGPQUIT
+2 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
SET DIR(0)="EO"
SET DIR("A")="End of taxonomy check. PRESS ENTER"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 QUIT
XIT ;EP
+1 KILL BGP,BGPX,BGPQUIT,BGPLINE,BGPJ,BGPX,BGPTEXT,BGP
+2 KILL X,Y,J
+3 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 BGPQUIT=""
QUIT
+2 QUIT
TAXS ;
+1 ;;BGP PRIMARY CARE CLINICS
+2 ;;BGP CHOLESTEROL LOINC CODES
+3 ;;BGP CHLAMYDIA LOINC CODES
+4 ;;BGP CHLAMYDIA CPTS
+5 ;;BGP HYSTERECTOMY CPTS
+6 ;;BGP ISCHEMIC HEART DXS
+7 ;;BGP GPRA SMOKING DXS;;Smoking diagnoses Taxonomy
+8 ;;SURVEILLANCE DIABETES;;Diabetes Diagnoses Codes
+9 ;;SURVEILLANCE HYPERTENSION;;Hypertension dx codes
+10 ;;BGP CPT PAP;;Pap CPTs Taxonomy
+11 ;;BGP CPT MAMMOGRAM;;Mammogram CPTs Taxonomy
+12 ;;BGP CPT FLU;;Flu CPTs Taxonomy
+13 ;;BGP URINE PROTEIN LOINC CODES
+14 ;;BGP MICROALBUM LOINC CODES
+15 ;;BGP LDL LOINC CODES
+16 ;;BGP HGBA1C LOINC CODES
+17 ;;BGP CREATININE LOINC CODES
+18 ;;BGP PAP LOINC CODES
+19 ;;BGP FOBT LOINC CODES
+20 ;;BGP COLO CPTS
+21 ;;BGP RECTAL PROCEDURE CODES
+22 ;;BGP SIG CPTS
LAB ;
+1 ;;BGP PAP SMEAR TAX
+2 ;;BGP GPRA FOB TESTS;;FOBT Lab Tests Taxonomy
+3 ;;DM AUDIT URINE PROTEIN TAX;;Urine Protein Lab Taxonomy
+4 ;;DM AUDIT MICROALBUMINURIA TAX;;Microalbuminuia Lab Taxonomy
+5 ;;DM AUDIT HGB A1C TAX;;HGB A1C Lab Taxonomy
+6 ;;DM AUDIT LDL CHOLESTEROL TAX;;LDL Cholesterol Lab Taxonomy
+7 ;;DM AUDIT CREATININE TAX;;CREATININE test lab taxonomy
+8 ;;BGP CHLAMYDIA TESTS TAX;;Chlamydia lab taxonomy
+9 ;;
