- BGP0XTCN ; IHS/CMI/LAB - TAXONOMY CHECK FOR FY04 CRS REPORT ;
- ;;10.0;IHS CLINICAL REPORTING;;JUN 18, 2010
- ;
- ;
- D HOME^%ZIS
- W:$D(IOF) @IOF
- W !!,"Checking for Taxonomies to support the National GPRA & PART/GPRA & PART Performance Reports.",!,"Please enter the device for printing.",!
- ZIS ;
- S BGPTCO=1
- S XBRC="",XBRP="TAXCHK^BGP0XTCN",XBNS="BGPTCO",XBRX="XIT^BGP0XTCN"
- 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 "
- W $S($G(BGPTCO)=1:"National GPRA & PART/GPRA & PART Performance Reports...",'$G(BGP0GPU):"National GPRA & PART Report...",1:"GPRA & PART 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(^BGPTAXT("B",BGPT)) Q:BGPT="" D
- .S BGPY=$O(^BGPTAXT("B",BGPT,0))
- .Q:'$D(^BGPTAXT(BGPY,12,"B",1))
- .;I $P(^BGPTAXT(BGPY,0),U,2)'="L" S BGPX=$O(^ATXAX("B",BGPT,0))
- .;I $P(^BGPTAXT(BGPY,0),U,2)="L" S BGPX=$O(^ATXLAB("B",BGPT,0))
- .S BGPTYPE=$P(^BGPTAXT(BGPY,0),U,2),Y=$G(^BGPTAXT(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 GRPA & PART 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
- Q:$D(ZTQUEUED)
- 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
- BGP0XTCN ; IHS/CMI/LAB - TAXONOMY CHECK FOR FY04 CRS REPORT ;
- +1 ;;10.0;IHS CLINICAL REPORTING;;JUN 18, 2010
- +2 ;
- +3 ;
- +4 DO HOME^%ZIS
- +5 IF $DATA(IOF)
- WRITE @IOF
- +6 WRITE !!,"Checking for Taxonomies to support the National GPRA & PART/GPRA & PART Performance Reports.",!,"Please enter the device for printing.",!
- ZIS ;
- +1 SET BGPTCO=1
- +2 SET XBRC=""
- SET XBRP="TAXCHK^BGP0XTCN"
- SET XBNS="BGPTCO"
- SET XBRX="XIT^BGP0XTCN"
- +3 DO ^XBDBQUE
- +4 DO XIT
- +5 QUIT
- TAXCHK ;EP
- +1 ;D HOME^%ZIS
- +2 ;W:$D(IOF) @IOF
- +3 KILL BGPQUIT
- GUICHK ;EP
- +1 WRITE !,"Checking for Taxonomies to support the "
- +2 WRITE $SELECT($GET(BGPTCO)=1:"National GPRA & PART/GPRA & PART Performance Reports...",'$GET(BGP0GPU):"National GPRA & PART Report...",1:"GPRA & PART Performance Report..."),!
- +3 NEW A,BGPX,I,Y,Z,J,BGPY,BGPT
- +4 KILL A
- +5 ;S T="TAXS" F J=1:1 S Z=$T(@T+J),BGPX=$P(Z,";;",2),Y=$P(Z,";;",3) Q:BGPX="" D
- +6 SET BGPT=""
- FOR
- SET BGPT=$ORDER(^BGPTAXT("B",BGPT))
- IF BGPT=""
- QUIT
- Begin DoDot:1
- +7 SET BGPY=$ORDER(^BGPTAXT("B",BGPT,0))
- +8 IF '$DATA(^BGPTAXT(BGPY,12,"B",1))
- QUIT
- +9 ;I $P(^BGPTAXT(BGPY,0),U,2)'="L" S BGPX=$O(^ATXAX("B",BGPT,0))
- +10 ;I $P(^BGPTAXT(BGPY,0),U,2)="L" S BGPX=$O(^ATXLAB("B",BGPT,0))
- +11 SET BGPTYPE=$PIECE(^BGPTAXT(BGPY,0),U,2)
- SET Y=$GET(^BGPTAXT(BGPY,11,1,0))
- +12 IF BGPTYPE'="L"
- Begin DoDot:2
- +13 IF '$DATA(^ATXAX("B",BGPT))
- SET A(BGPT)=Y_"^is Missing"
- QUIT
- +14 SET I=$ORDER(^ATXAX("B",BGPT,0))
- +15 IF '$DATA(^ATXAX(I,21,"B"))
- SET A(BGPT)=Y_"^has no entries "
- End DoDot:2
- +16 IF BGPTYPE="L"
- Begin DoDot:2
- +17 IF '$DATA(^ATXLAB("B",BGPT))
- SET A(BGPT)=Y_"^is Missing "
- QUIT
- +18 SET I=$ORDER(^ATXLAB("B",BGPT,0))
- +19 IF '$DATA(^ATXLAB(I,21,"B"))
- SET A(BGPT)=Y_"^has no entries "
- End DoDot:2
- End DoDot:1
- +20 IF '$DATA(A)
- WRITE !,"All taxonomies are present.",!
- KILL A,BGPX,Y,I,Z
- DO DONE
- QUIT
- +21 WRITE !,"In order for the National GRPA & PART Report to find all necessary data, several",!,"taxonomies must be established. The following taxonomies are missing or have",!,"no entries:"
- +22 SET BGPX=""
- FOR
- SET BGPX=$ORDER(A(BGPX))
- IF BGPX=""!($DATA(BGPQUIT))
- QUIT
- Begin DoDot:1
- +23 ;I $Y>(IOSL-2) D PAGE Q:$D(BGPQUIT)
- +24 WRITE !,$PIECE(A(BGPX),U)," [",BGPX,"] ",$PIECE(A(BGPX),U,2)
- +25 QUIT
- End DoDot:1
- DONE ;
- +1 KILL BGPQUIT
- +2 IF $DATA(ZTQUEUED)
- QUIT
- +3 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
- +4 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