BUD8XTCH ; IHS/CMI/LAB - TAXONOMY CHECK FOR FY04 GPRA REPORT ;
;;10.0;IHS/RPMS UNIFORM DATA SYSTEM;;FEB 04, 2016;Build 50
;
;
D HOME^%ZIS
W:$D(IOF) @IOF
W !!,"Checking for Taxonomies to support the 2008 UDS Report. ",!,"Please enter the device for printing.",!
ZIS ;
S XBRC="",XBRP="TAXCHK^BUD8TXCH",XBNS="",XBRX="XIT^BUD8TXCH"
D ^XBDBQUE
D XIT
Q
TAXCHK ;EP
D HOME^%ZIS
K BUDQUIT
W !,"Checking for Taxonomies to support the 2008 UDS Report...",!
NEW A,BUDX,I,Y,Z,J
K A
S T=$S($G(BUDTAXT)]"":BUDTAXT,1:"TAXS") F J=1:1 S Z=$T(@T+J),BUDX=$P(Z,";;",2),Y=$P(Z,";;",3) Q:BUDX="" D
.I '$D(^ATXAX("B",BUDX)) S A(BUDX)=Y_"^is Missing" Q
.S I=$O(^ATXAX("B",BUDX,0))
.I '$D(^ATXAX(I,21,"B")) S A(BUDX)=Y_"^has no entries "
S T=$S($G(BUDTAXT)]"":"LAB"_BUDTAXT,1:"LAB") F J=1:1 S Z=$T(@T+J),BUDX=$P(Z,";;",2),Y=$P(Z,";;",3) Q:BUDX="" D
.I '$D(^ATXLAB("B",BUDX)) S A(BUDX)=Y_"^is Missing " Q
.S I=$O(^ATXLAB("B",BUDX,0))
.I '$D(^ATXLAB(I,21,"B")) S A(BUDX)=Y_"^has no entries "
I '$D(A) W !,"All taxonomies are present.",! K A,BUDX,Y,I,Z D DONE Q
W !!,"In order for the UDS Report to find all necessary data, several",!,"taxonomies must be established. The following taxonomies are missing or have",!,"no entries:"
S BUDX="" F S BUDX=$O(A(BUDX)) Q:BUDX=""!($D(BUDQUIT)) D
.;I $Y>(IOSL-2) D PAGE Q:$D(BUDQUIT)
.W !,$P(A(BUDX),U)," [",BUDX,"] ",$P(A(BUDX),U,2)
.Q
DONE ;
K BUDQUIT
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 BUD,BUDX,BUDQUIT,BUDLINE,BUDJ,BUDX,BUDTEXT,BUD
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 BUDQUIT="" Q
Q
TAXS ;
;;BUD L26 CPTS
;;BUD IMM CPTS
;;BUD CPT HIV TESTS
;;BGP HIV TEST LOINC CODES
;;BUD CPT PAP 07
;;BGP PAP LOINC CODES
;;BUD CPT PAP 03
;;BUD CPT PAP 04
;;BUD CPT PAP 05
;;BUD CPT PAP 08
;;BUD TABLE 6 LINE 16
;;BUD TABLE 6 LINE 17
;;BUD TABLE 6 LINE 19
;;BUD TABLE 6 LINE 20
;;BGP CPT MAMMOGRAM
;;
LAB ;
;;BGP PAP SMEAR TAX
;;BGP HIV TEST TAX
;;
LAB6B ;;
;;BGP PAP SMEAR TAX
;;
B6 ;;
;;BUD HYSTERECTOMY CPTS
;;BUD HYSTERECTOMY PROCEDURES
;;BGP PAP LOINC CODES
;;BUD CPT PAP 08
;;BUD IPV EVID DISEASE
;;BGP MMR CONTRAINDICATIONS
;;BGP MEASLES EVIDENCE
;;BGP MUMPS EVIDENCE
;;BGP HEP EVIDENCE
;;BGP RUBELLA EVIDENCE
;;BGP HIB EVIDENCE
;;BGP VARICELLA EVIDENCE
;;BGP PERTUSSIS EVIDENCE
;;BGP DIPHTHERIA EVIDENCE
;;BGP GPRA PREGNANCY DIAGNOSES
;;BGP MISCARRIAGE/ABORTION DXS
;;BGP ABORTION PROCEDURES
;;BGP CPT ABORTION
;;BGP CPT MISCARRIAGE
;;
7 ;;
;;BGP HIV/AIDS DXS
;;BUD HYPERTENSION DXS
;;BUD CPT NORMAL SYSTOLIC
;;BUD CPT NORMAL DIASTOLIC
;;BGP GPRA PREGNANCY DIAGNOSES
;;BGP MISCARRIAGE/ABORTION DXS
;;BGP ABORTION PROCEDURES
;;BGP CPT ABORTION
;;BGP CPT MISCARRIAGE
;;SURVEILLANCE DIABETES
;;BUD HYPERTENSION DXS
;;BUD GEST/STEROID DM DX
;;BUD HGBA1C CPTS
;;BGP HGBA1C LOINC CODES
;;
LAB7 ;;
;;DM AUDIT HGB A1C TAX
;;
BUD8XTCH ; IHS/CMI/LAB - TAXONOMY CHECK FOR FY04 GPRA REPORT ;
+1 ;;10.0;IHS/RPMS UNIFORM DATA SYSTEM;;FEB 04, 2016;Build 50
+2 ;
+3 ;
+4 DO HOME^%ZIS
+5 IF $DATA(IOF)
WRITE @IOF
+6 WRITE !!,"Checking for Taxonomies to support the 2008 UDS Report. ",!,"Please enter the device for printing.",!
ZIS ;
+1 SET XBRC=""
SET XBRP="TAXCHK^BUD8TXCH"
SET XBNS=""
SET XBRX="XIT^BUD8TXCH"
+2 DO ^XBDBQUE
+3 DO XIT
+4 QUIT
TAXCHK ;EP
+1 DO HOME^%ZIS
+2 KILL BUDQUIT
+3 WRITE !,"Checking for Taxonomies to support the 2008 UDS Report...",!
+4 NEW A,BUDX,I,Y,Z,J
+5 KILL A
+6 SET T=$SELECT($GET(BUDTAXT)]"":BUDTAXT,1:"TAXS")
FOR J=1:1
SET Z=$TEXT(@T+J)
SET BUDX=$PIECE(Z,";;",2)
SET Y=$PIECE(Z,";;",3)
IF BUDX=""
QUIT
Begin DoDot:1
+7 IF '$DATA(^ATXAX("B",BUDX))
SET A(BUDX)=Y_"^is Missing"
QUIT
+8 SET I=$ORDER(^ATXAX("B",BUDX,0))
+9 IF '$DATA(^ATXAX(I,21,"B"))
SET A(BUDX)=Y_"^has no entries "
End DoDot:1
+10 SET T=$SELECT($GET(BUDTAXT)]"":"LAB"_BUDTAXT,1:"LAB")
FOR J=1:1
SET Z=$TEXT(@T+J)
SET BUDX=$PIECE(Z,";;",2)
SET Y=$PIECE(Z,";;",3)
IF BUDX=""
QUIT
Begin DoDot:1
+11 IF '$DATA(^ATXLAB("B",BUDX))
SET A(BUDX)=Y_"^is Missing "
QUIT
+12 SET I=$ORDER(^ATXLAB("B",BUDX,0))
+13 IF '$DATA(^ATXLAB(I,21,"B"))
SET A(BUDX)=Y_"^has no entries "
End DoDot:1
+14 IF '$DATA(A)
WRITE !,"All taxonomies are present.",!
KILL A,BUDX,Y,I,Z
DO DONE
QUIT
+15 WRITE !!,"In order for the UDS Report to find all necessary data, several",!,"taxonomies must be established. The following taxonomies are missing or have",!,"no entries:"
+16 SET BUDX=""
FOR
SET BUDX=$ORDER(A(BUDX))
IF BUDX=""!($DATA(BUDQUIT))
QUIT
Begin DoDot:1
+17 ;I $Y>(IOSL-2) D PAGE Q:$D(BUDQUIT)
+18 WRITE !,$PIECE(A(BUDX),U)," [",BUDX,"] ",$PIECE(A(BUDX),U,2)
+19 QUIT
End DoDot:1
DONE ;
+1 KILL BUDQUIT
+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 BUD,BUDX,BUDQUIT,BUDLINE,BUDJ,BUDX,BUDTEXT,BUD
+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 BUDQUIT=""
QUIT
+2 QUIT
TAXS ;
+1 ;;BUD L26 CPTS
+2 ;;BUD IMM CPTS
+3 ;;BUD CPT HIV TESTS
+4 ;;BGP HIV TEST LOINC CODES
+5 ;;BUD CPT PAP 07
+6 ;;BGP PAP LOINC CODES
+7 ;;BUD CPT PAP 03
+8 ;;BUD CPT PAP 04
+9 ;;BUD CPT PAP 05
+10 ;;BUD CPT PAP 08
+11 ;;BUD TABLE 6 LINE 16
+12 ;;BUD TABLE 6 LINE 17
+13 ;;BUD TABLE 6 LINE 19
+14 ;;BUD TABLE 6 LINE 20
+15 ;;BGP CPT MAMMOGRAM
+16 ;;
LAB ;
+1 ;;BGP PAP SMEAR TAX
+2 ;;BGP HIV TEST TAX
+3 ;;
LAB6B ;;
+1 ;;BGP PAP SMEAR TAX
+2 ;;
B6 ;;
+1 ;;BUD HYSTERECTOMY CPTS
+2 ;;BUD HYSTERECTOMY PROCEDURES
+3 ;;BGP PAP LOINC CODES
+4 ;;BUD CPT PAP 08
+5 ;;BUD IPV EVID DISEASE
+6 ;;BGP MMR CONTRAINDICATIONS
+7 ;;BGP MEASLES EVIDENCE
+8 ;;BGP MUMPS EVIDENCE
+9 ;;BGP HEP EVIDENCE
+10 ;;BGP RUBELLA EVIDENCE
+11 ;;BGP HIB EVIDENCE
+12 ;;BGP VARICELLA EVIDENCE
+13 ;;BGP PERTUSSIS EVIDENCE
+14 ;;BGP DIPHTHERIA EVIDENCE
+15 ;;BGP GPRA PREGNANCY DIAGNOSES
+16 ;;BGP MISCARRIAGE/ABORTION DXS
+17 ;;BGP ABORTION PROCEDURES
+18 ;;BGP CPT ABORTION
+19 ;;BGP CPT MISCARRIAGE
+20 ;;
7 ;;
+1 ;;BGP HIV/AIDS DXS
+2 ;;BUD HYPERTENSION DXS
+3 ;;BUD CPT NORMAL SYSTOLIC
+4 ;;BUD CPT NORMAL DIASTOLIC
+5 ;;BGP GPRA PREGNANCY DIAGNOSES
+6 ;;BGP MISCARRIAGE/ABORTION DXS
+7 ;;BGP ABORTION PROCEDURES
+8 ;;BGP CPT ABORTION
+9 ;;BGP CPT MISCARRIAGE
+10 ;;SURVEILLANCE DIABETES
+11 ;;BUD HYPERTENSION DXS
+12 ;;BUD GEST/STEROID DM DX
+13 ;;BUD HGBA1C CPTS
+14 ;;BGP HGBA1C LOINC CODES
+15 ;;
LAB7 ;;
+1 ;;DM AUDIT HGB A1C TAX
+2 ;;
