BGP5TXCN.m

BGP5TXCN ; IHS/CMI/LAB - TAXONOMY CHECK FOR FY04 CRS REPORT ;

 ;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007

 ;

 ;

 D HOME^%ZIS

 W:$D(IOF) @IOF

 W !!,"Checking for Taxonomies to support the ",$S('$G(BGP5GPU):"National GPRA Report. ",1:"GPRA Performance Report. "),!,"Please enter the device for printing.",!

ZIS ;

 S XBRC="",XBRP="TAXCHK^BGP5TXCN",XBNS="",XBRX="XIT^BGP5TXCN"

 D ^XBDBQUE

 D XIT

 Q

TAXCHK ;EP

 D HOME^%ZIS

 ;W:$D(IOF) @IOF

 K BGPQUIT

GUICHK ;EP

 W !,"Checking for Taxonomies to support the ",$S('$G(BGP5GPU):"National GPRA Report...",1:"GPRA Performance Report..."),!

 NEW A,BGPX,I,Y,Z,J,BGPY,BGPT

 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

 S BGPT="" F  S BGPT=$O(^BGPTAXV("B",BGPT)) Q:BGPT=""  D

 .S BGPY=$O(^BGPTAXV("B",BGPT,0))

 .Q:'$D(^BGPTAXV(BGPY,12,"B",1))

 .;I $P(^BGPTAXV(BGPY,0),U,2)'="L" S BGPX=$O(^ATXAX("B",BGPT,0))

 .;I $P(^BGPTAXV(BGPY,0),U,2)="L" S BGPX=$O(^ATXLAB("B",BGPT,0))

 .S BGPTYPE=$P(^BGPTAXV(BGPY,0),U,2),Y=$G(^BGPTAXV(BGPY,11,1,0))

 .I BGPTYPE'="L" D

 ..I '$D(^ATXAX("B",BGPT)) S A(BGPT)=Y_"^is Missing" Q

 ..S I=$O(^ATXAX("B",BGPT,0))

 ..I '$D(^ATXAX(I,21,"B")) S A(BGPT)=Y_"^has no entries "

 .I BGPTYPE="L" D

 ..I '$D(^ATXLAB("B",BGPT)) S A(BGPT)=Y_"^is Missing " Q

 ..S I=$O(^ATXLAB("B",BGPT,0))

 ..I '$D(^ATXLAB(I,21,"B")) S A(BGPT)=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 National GPRA 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

 ;;SURVEILLANCE DIABETES;;Diabetes Diagnoses Codes

 ;;BGP CREATININE LOINC CODES

 ;;BGP HGBA1C LOINC CODES

 ;;BGP LIPID PROFILE LOINC CODES

 ;;BGP LDL LOINC CODES

 ;;BGP TRIGLYCERIDE LOINC CODES

 ;;BGP HDL LOINC CODES

 ;;BGP URINE PROTEIN LOINC CODES

 ;;BGP MICROALBUM LOINC CODES

 ;;BGP OPV EVID DISEASE

 ;;BGP OPV CONTRAINDICATIONS

 ;;BGP DIPHTHERIA EVIDENCE

 ;;BGP PERTUSSIS EVIDENCE

 ;;BGP MMR CONTRAINDICATIONS

 ;;BGP MEASLES EVIDENCE

 ;;BGP MUMPS EVIDENCE

 ;;BGP RUBELLA EVIDENCE;;Evidence Dxs for Rubella

 ;;BGP HIB EVIDENCE;;Evidence Dxs for HIB

 ;;BGP HEP EVIDENCE;;Evidence of Hepatitis Dxs

 ;;BGP VARICELLA EVIDENCE;;Evidence of Varicella Dxs

 ;;BGP VARICELLA CONTRA;;Varicella contraindications Dxs

 ;;BGP CPT FLU;;Flu CPTs Taxonomy

 ;;BGP HYSTERECTOMY CPTS

 ;;BGP CPT PAP

 ;;BGP PAP LOINC CODES

 ;;BGP UNI MASTECTOMY PROCEDURES

 ;;BGP CPT MAMMOGRAM

 ;;BGP COLORECTAL CANCER DXS

 ;;BGP FOBT LOINC CODES

 ;;BGP RECTAL PROCEDURE CODES

 ;;BGP SIG CPTS

 ;;BGP BE CPTS

 ;;BGP COLO CPTS

 ;;BGP GPRA PREGNANCY DIAGNOSES

 ;;BGP MISCARRIAGE/ABORTION DXS

 ;;BGP ALCOHOL DXS

 ;;BGP DV DXS

 ;;BGP GPRA SMOKING DXS

 ;;BGP HIV TEST LOINC CODES

 ;;BGP HIV/AIDS DXS

 ;;BGP CPT HIV TESTS

 ;;BGP TOTAL CHOLESTEROL LOINC

 ;;

LAB ;

 ;;DM AUDIT CREATININE TAX;;CREATININE test lab taxonomy

 ;;DM AUDIT HGB A1C TAX;;HGB A1C Lab Taxonomy

 ;;DM AUDIT LIPID PROFILE TAX;;Lipid Profile Lab Taxonomy

 ;;DM AUDIT LDL CHOLESTEROL TAX;;LDL Cholesterol Lab Taxonomy

 ;;DM AUDIT TRIGLYCERIDE TAX;;Triglyceride Lab Taxonomy

 ;;DM AUDIT HDL TAX;;HDL Lab Taxonomy

 ;;DM AUDIT URINE PROTEIN TAX;;Urine Protein Lab Taxonomy

 ;;DM AUDIT MICROALBUMINURIA TAX;;Microalbuminuia Lab Taxonomy

 ;;BGP GPRA ESTIMATED GFR TAX;;Estimated GFR Taxonomy

 ;;BGP PAP SMEAR TAX;;Pap Smear Taxonomy

 ;;BGP GPRA FOB TESTS;;Fecal Occult Blood Tests taxonomy

 ;;BGP HIV TEST TAX;;HIV tests taxonomy

 ;;DM AUDIT CHOLESTEROL TAX;;Cholesterol Taxonomy

 ;;

YYY ;

 ;;BGP CHLAMYDIA LOINC CODES

 ;;BGP CHLAMYDIA CPTS

 ;;BGP ASTHMA DXS

 ;;BGP CD4 LOINC CODES

 ;;BGP VIRAL LOAD LOINC CODES

 ;;SURVEILLANCE HYPERTENSION;;Hypertension dx codes

 ;;BGP DEPRESSIVE DISORDERS;;Depressive Disorders ICD9 Diagnosis Taxonomy

 ;;BGP RECTAL PROCEDURE CODES

XXX ;

 ;;BGP CD4 TAX

 ;;BGP HIV VIRAL LOAD TAX

 ;;BGP CHLAMYDIA TESTS TAX;;Chlamydia lab taxonomy

 ;;

BGP5TXCN  ; IHS/CMI/LAB - TAXONOMY CHECK FOR FY04 CRS 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 ",$SELECT('$GET(BGP5GPU):"National GPRA Report. ",1:"GPRA Performance Report. "),!,"Please enter the device for printing.",!

ZIS       ;

 +1        SET XBRC=""

           SET XBRP="TAXCHK^BGP5TXCN"

           SET XBNS=""

           SET XBRX="XIT^BGP5TXCN"

 +2        DO ^XBDBQUE

 +3        DO XIT

 +4        QUIT 

TAXCHK    ;EP

 +1        DO HOME^%ZIS

 +2       ;W:$D(IOF) @IOF

 +3        KILL BGPQUIT

GUICHK    ;EP

 +1        WRITE !,"Checking for Taxonomies to support the ",$SELECT('$GET(BGP5GPU):"National GPRA Report...",1:"GPRA Performance Report..."),!

 +2        NEW A,BGPX,I,Y,Z,J,BGPY,BGPT

 +3        KILL A

 +4       ;S T="TAXS" F J=1:1 S Z=$T(@T+J),BGPX=$P(Z,";;",2),Y=$P(Z,";;",3) Q:BGPX=""  D

 +5        SET BGPT=""

           FOR 

               SET BGPT=$ORDER(^BGPTAXV("B",BGPT))

               IF BGPT=""

                   QUIT 

               Begin DoDot:1

 +6                SET BGPY=$ORDER(^BGPTAXV("B",BGPT,0))

 +7                IF '$DATA(^BGPTAXV(BGPY,12,"B",1))

                       QUIT 

 +8       ;I $P(^BGPTAXV(BGPY,0),U,2)'="L" S BGPX=$O(^ATXAX("B",BGPT,0))

 +9       ;I $P(^BGPTAXV(BGPY,0),U,2)="L" S BGPX=$O(^ATXLAB("B",BGPT,0))

 +10               SET BGPTYPE=$PIECE(^BGPTAXV(BGPY,0),U,2)

                   SET Y=$GET(^BGPTAXV(BGPY,11,1,0))

 +11               IF BGPTYPE'="L"

                       Begin DoDot:2

 +12                       IF '$DATA(^ATXAX("B",BGPT))

                               SET A(BGPT)=Y_"^is Missing"

                               QUIT 

 +13                       SET I=$ORDER(^ATXAX("B",BGPT,0))

 +14                       IF '$DATA(^ATXAX(I,21,"B"))

                               SET A(BGPT)=Y_"^has no entries "

                       End DoDot:2

 +15               IF BGPTYPE="L"

                       Begin DoDot:2

 +16                       IF '$DATA(^ATXLAB("B",BGPT))

                               SET A(BGPT)=Y_"^is Missing "

                               QUIT 

 +17                       SET I=$ORDER(^ATXLAB("B",BGPT,0))

 +18                       IF '$DATA(^ATXLAB(I,21,"B"))

                               SET A(BGPT)=Y_"^has no entries "

                       End DoDot:2

               End DoDot:1

 +19       IF '$DATA(A)

               WRITE !,"All taxonomies are present.",!

               KILL A,BGPX,Y,I,Z

               DO DONE

               QUIT 

 +20       WRITE !,"In order for the National GPRA Report to find all necessary data, several",!,"taxonomies must be established.  The following taxonomies are missing or have",!,"no entries:"

 +21       SET BGPX=""

           FOR 

               SET BGPX=$ORDER(A(BGPX))

               IF BGPX=""!($DATA(BGPQUIT))

                   QUIT 

               Begin DoDot:1

 +22               IF $Y>(IOSL-2)

                       DO PAGE

                       IF $DATA(BGPQUIT)

                           QUIT 

 +23               WRITE !,$PIECE(A(BGPX),U)," [",BGPX,"] ",$PIECE(A(BGPX),U,2)

 +24               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       ;;SURVEILLANCE DIABETES;;Diabetes Diagnoses Codes

 +3       ;;BGP CREATININE LOINC CODES

 +4       ;;BGP HGBA1C LOINC CODES

 +5       ;;BGP LIPID PROFILE LOINC CODES

 +6       ;;BGP LDL LOINC CODES

 +7       ;;BGP TRIGLYCERIDE LOINC CODES

 +8       ;;BGP HDL LOINC CODES

 +9       ;;BGP URINE PROTEIN LOINC CODES

 +10      ;;BGP MICROALBUM LOINC CODES

 +11      ;;BGP OPV EVID DISEASE

 +12      ;;BGP OPV CONTRAINDICATIONS

 +13      ;;BGP DIPHTHERIA EVIDENCE

 +14      ;;BGP PERTUSSIS EVIDENCE

 +15      ;;BGP MMR CONTRAINDICATIONS

 +16      ;;BGP MEASLES EVIDENCE

 +17      ;;BGP MUMPS EVIDENCE

 +18      ;;BGP RUBELLA EVIDENCE;;Evidence Dxs for Rubella

 +19      ;;BGP HIB EVIDENCE;;Evidence Dxs for HIB

 +20      ;;BGP HEP EVIDENCE;;Evidence of Hepatitis Dxs

 +21      ;;BGP VARICELLA EVIDENCE;;Evidence of Varicella Dxs

 +22      ;;BGP VARICELLA CONTRA;;Varicella contraindications Dxs

 +23      ;;BGP CPT FLU;;Flu CPTs Taxonomy

 +24      ;;BGP HYSTERECTOMY CPTS

 +25      ;;BGP CPT PAP

 +26      ;;BGP PAP LOINC CODES

 +27      ;;BGP UNI MASTECTOMY PROCEDURES

 +28      ;;BGP CPT MAMMOGRAM

 +29      ;;BGP COLORECTAL CANCER DXS

 +30      ;;BGP FOBT LOINC CODES

 +31      ;;BGP RECTAL PROCEDURE CODES

 +32      ;;BGP SIG CPTS

 +33      ;;BGP BE CPTS

 +34      ;;BGP COLO CPTS

 +35      ;;BGP GPRA PREGNANCY DIAGNOSES

 +36      ;;BGP MISCARRIAGE/ABORTION DXS

 +37      ;;BGP ALCOHOL DXS

 +38      ;;BGP DV DXS

 +39      ;;BGP GPRA SMOKING DXS

 +40      ;;BGP HIV TEST LOINC CODES

 +41      ;;BGP HIV/AIDS DXS

 +42      ;;BGP CPT HIV TESTS

 +43      ;;BGP TOTAL CHOLESTEROL LOINC

 +44      ;;

LAB       ;

 +1       ;;DM AUDIT CREATININE TAX;;CREATININE test lab taxonomy

 +2       ;;DM AUDIT HGB A1C TAX;;HGB A1C Lab Taxonomy

 +3       ;;DM AUDIT LIPID PROFILE TAX;;Lipid Profile Lab Taxonomy

 +4       ;;DM AUDIT LDL CHOLESTEROL TAX;;LDL Cholesterol Lab Taxonomy

 +5       ;;DM AUDIT TRIGLYCERIDE TAX;;Triglyceride Lab Taxonomy

 +6       ;;DM AUDIT HDL TAX;;HDL Lab Taxonomy

 +7       ;;DM AUDIT URINE PROTEIN TAX;;Urine Protein Lab Taxonomy

 +8       ;;DM AUDIT MICROALBUMINURIA TAX;;Microalbuminuia Lab Taxonomy

 +9       ;;BGP GPRA ESTIMATED GFR TAX;;Estimated GFR Taxonomy

 +10      ;;BGP PAP SMEAR TAX;;Pap Smear Taxonomy

 +11      ;;BGP GPRA FOB TESTS;;Fecal Occult Blood Tests taxonomy

 +12      ;;BGP HIV TEST TAX;;HIV tests taxonomy

 +13      ;;DM AUDIT CHOLESTEROL TAX;;Cholesterol Taxonomy

 +14      ;;

YYY       ;

 +1       ;;BGP CHLAMYDIA LOINC CODES

 +2       ;;BGP CHLAMYDIA CPTS

 +3       ;;BGP ASTHMA DXS

 +4       ;;BGP CD4 LOINC CODES

 +5       ;;BGP VIRAL LOAD LOINC CODES

 +6       ;;SURVEILLANCE HYPERTENSION;;Hypertension dx codes

 +7       ;;BGP DEPRESSIVE DISORDERS;;Depressive Disorders ICD9 Diagnosis Taxonomy

 +8       ;;BGP RECTAL PROCEDURE CODES

XXX       ;

 +1       ;;BGP CD4 TAX

 +2       ;;BGP HIV VIRAL LOAD TAX

 +3       ;;BGP CHLAMYDIA TESTS TAX;;Chlamydia lab taxonomy

 +4       ;;