BGP4TXCH.m

BGP4TXCH ; IHS/CMI/LAB - TAXONOMY CHECK FOR FY03 GPRA REPORT ;

 ;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114

 ;

 ;

 D HOME^%ZIS

 W:$D(IOF) @IOF

 W !!,"Checking for Taxonomies to support the FY 03 GPRA Report. ",!,"Please enter the device for printing.",!

ZIS ;

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

 D ^XBDBQUE

 D XIT

 Q

TAXCHK ;EP

 D HOME^%ZIS

 ;W:$D(IOF) @IOF

 K BGPQUIT

 W !,"Checking for Taxonomies to support the GPRA 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 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 ASTHMA DXS

 ;;BGP CD4 LOINC CODES

 ;;BGP CPT HIV TESTS

 ;;BGP HIV TEST LOINC CODES

 ;;BGP HIV/AIDS DXS

 ;;BGP ISCHEMIC HEART DXS

 ;;BGP PCR LOINC CODES

 ;;BGP GPRA PREGNANCY DIAGNOSES;;Pregnancy dxs Taxonomy

 ;;BGP GPRA SMOKING DXS;;Smoking diagnoses Taxonomy

 ;;SURVEILLANCE DIABETES;;Diabetes Diagnoses Codes

 ;;BGP CPT PAP;;Pap CPTs Taxonomy

 ;;BGP CPT MAMMOGRAM;;Mammogram CPTs Taxonomy

 ;;BGP CPT FLU;;Flu CPTs Taxonomy

 ;;BGP DEPRESSIVE DISORDERS;;Depressive Disorders ICD DXDiagnosis Taxonomy

 ;;

LAB ;

 ;;BGP HIV TEST TAX

 ;;BGP CD4 TAX

 ;;BGP PCR 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 GLUCOSE TESTS TAX;;Glucose Tests Taxonomy

 ;;DM AUDIT LIPID PROFILE TAX;;Lipid Profile 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 CREATININE TAX;;CREATININE test lab taxonomy

 ;;DM AUDIT TRIGLYCERIDE TAX;;Triglyceride Lab Taxonomy

 ;;

BGP4TXCH  ; IHS/CMI/LAB - TAXONOMY CHECK FOR FY03 GPRA REPORT ;

 +1       ;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114

 +2       ;

 +3       ;

 +4        DO HOME^%ZIS

 +5        IF $DATA(IOF)

               WRITE @IOF

 +6        WRITE !!,"Checking for Taxonomies to support the FY 03 GPRA Report. ",!,"Please enter the device for printing.",!

ZIS       ;

 +1        SET XBRC=""

           SET XBRP="TAXCHK^BGP4TXCH"

           SET XBNS=""

           SET XBRX="XIT^BGP4TXCH"

 +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 GPRA 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 GPRA 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 ASTHMA DXS

 +2       ;;BGP CD4 LOINC CODES

 +3       ;;BGP CPT HIV TESTS

 +4       ;;BGP HIV TEST LOINC CODES

 +5       ;;BGP HIV/AIDS DXS

 +6       ;;BGP ISCHEMIC HEART DXS

 +7       ;;BGP PCR LOINC CODES

 +8       ;;BGP GPRA PREGNANCY DIAGNOSES;;Pregnancy dxs Taxonomy

 +9       ;;BGP GPRA SMOKING DXS;;Smoking diagnoses Taxonomy

 +10      ;;SURVEILLANCE DIABETES;;Diabetes Diagnoses Codes

 +11      ;;BGP CPT PAP;;Pap CPTs Taxonomy

 +12      ;;BGP CPT MAMMOGRAM;;Mammogram CPTs Taxonomy

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

 +14      ;;BGP DEPRESSIVE DISORDERS;;Depressive Disorders ICD DXDiagnosis Taxonomy

 +15      ;;

LAB       ;

 +1       ;;BGP HIV TEST TAX

 +2       ;;BGP CD4 TAX

 +3       ;;BGP PCR TAX

 +4       ;;BGP GPRA FOB TESTS;;FOBT Lab Tests Taxonomy

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

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

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

 +8       ;;DM AUDIT GLUCOSE TESTS TAX;;Glucose Tests Taxonomy

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

 +10      ;;DM AUDIT CHOLESTEROL TAX;;Cholesterol Lab Taxonomy

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

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

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

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

 +15      ;;