BGP8XTCH ; IHS/CMI/LAB - TAXONOMY CHECK FOR CRS REPORT 16 Jan 2009 4:02 PM 09 Feb 2017 1:35 PM ;
;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
;
;
D HOME^%ZIS
W:$D(IOF) @IOF
W !!,"Checking for Taxonomies to support the 2018 CRS Report. ",!,"Please enter the device for printing.",!
ZIS ;
K IOP,%ZIS
W !! S %ZIS="PQM" D ^%ZIS
I POP D XIT Q
ZIS1 ;
I $D(IO("Q")) G TSKMN
DRIVER ;
U IO
D TAXCHK^BGP8XTCH
D ^%ZISC
D XIT
Q
;
TSKMN ;EP ENTRY POINT FROM TASKMAN
S ZTIO=$S($D(ION):ION,1:IO) I $D(IOST)#2,IOST]"" S ZTIO=ZTIO_";"_IOST
I $G(IO("DOC"))]"" S ZTIO=ZTIO_";"_$G(IO("DOC"))
I $D(IOM)#2,IOM S ZTIO=ZTIO_";"_IOM I $D(IOSL)#2,IOSL S ZTIO=ZTIO_";"_IOSL
K ZTSAVE S ZTSAVE("BGP*")=""
S ZTCPU=$G(IOCPU),ZTRTN="TAXCHK^BGP8XTCH",ZTDTH="",ZTDESC="CRS 15 TAX REPORT" D ^%ZTLOAD D XIT Q
Q
TAXCHK ;EP
;D HOME^%ZIS
K BGPQUIT
GUICHK ;EP
W !,"Checking for Taxonomies to support the Selected Measures 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(^BGPTAXR("B",BGPT)) Q:BGPT="" D
.S BGPY=$O(^BGPTAXR("B",BGPT,0))
.Q:'$D(^BGPTAXR(BGPY,12,"B",2))
.;I $P(^BGPTAXR(BGPY,0),U,2)'="L" S BGPX=$O(^ATXAX("B",BGPT,0))
.;I $P(^BGPTAXR(BGPY,0),U,2)="L" S BGPX=$O(^ATXLAB("B",BGPT,0))
.S BGPTYPE=$P(^BGPTAXR(BGPY,0),U,2),Y=$G(^BGPTAXR(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,BGPT,BGPY,Y,I,Z D DONE Q
W !!,"In order for the CRS 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
I $D(ZTQUEUED) S ZTREQ="@"
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
BGP8XTCH ; IHS/CMI/LAB - TAXONOMY CHECK FOR CRS REPORT 16 Jan 2009 4:02 PM 09 Feb 2017 1:35 PM ;
+1 ;;18.1;IHS CLINICAL REPORTING;;MAY 25, 2018;Build 66
+2 ;
+3 ;
+4 DO HOME^%ZIS
+5 IF $DATA(IOF)
WRITE @IOF
+6 WRITE !!,"Checking for Taxonomies to support the 2018 CRS Report. ",!,"Please enter the device for printing.",!
ZIS ;
+1 KILL IOP,%ZIS
+2 WRITE !!
SET %ZIS="PQM"
DO ^%ZIS
+3 IF POP
DO XIT
QUIT
ZIS1 ;
+1 IF $DATA(IO("Q"))
GOTO TSKMN
DRIVER ;
+1 USE IO
+2 DO TAXCHK^BGP8XTCH
+3 DO ^%ZISC
+4 DO XIT
+5 QUIT
+6 ;
TSKMN ;EP ENTRY POINT FROM TASKMAN
+1 SET ZTIO=$SELECT($DATA(ION):ION,1:IO)
IF $DATA(IOST)#2
IF IOST]""
SET ZTIO=ZTIO_";"_IOST
+2 IF $GET(IO("DOC"))]""
SET ZTIO=ZTIO_";"_$GET(IO("DOC"))
+3 IF $DATA(IOM)#2
IF IOM
SET ZTIO=ZTIO_";"_IOM
IF $DATA(IOSL)#2
IF IOSL
SET ZTIO=ZTIO_";"_IOSL
+4 KILL ZTSAVE
SET ZTSAVE("BGP*")=""
+5 SET ZTCPU=$GET(IOCPU)
SET ZTRTN="TAXCHK^BGP8XTCH"
SET ZTDTH=""
SET ZTDESC="CRS 15 TAX REPORT"
DO ^%ZTLOAD
DO XIT
QUIT
+6 QUIT
TAXCHK ;EP
+1 ;D HOME^%ZIS
+2 KILL BGPQUIT
GUICHK ;EP
+1 WRITE !,"Checking for Taxonomies to support the Selected Measures 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(^BGPTAXR("B",BGPT))
IF BGPT=""
QUIT
Begin DoDot:1
+6 SET BGPY=$ORDER(^BGPTAXR("B",BGPT,0))
+7 IF '$DATA(^BGPTAXR(BGPY,12,"B",2))
QUIT
+8 ;I $P(^BGPTAXR(BGPY,0),U,2)'="L" S BGPX=$O(^ATXAX("B",BGPT,0))
+9 ;I $P(^BGPTAXR(BGPY,0),U,2)="L" S BGPX=$O(^ATXLAB("B",BGPT,0))
+10 SET BGPTYPE=$PIECE(^BGPTAXR(BGPY,0),U,2)
SET Y=$GET(^BGPTAXR(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,BGPT,BGPY,Y,I,Z
DO DONE
QUIT
+20 WRITE !!,"In order for the CRS 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 ;I $Y>(IOSL-2) D PAGE Q:$D(BGPQUIT)
+23 WRITE !,$PIECE(A(BGPX),U)," [",BGPX,"] ",$PIECE(A(BGPX),U,2)
+24 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 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+4 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
