Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BGP6XTHE

BGP6XTHE.m

Go to the documentation of this file.
  1. BGP6XTHE ; IHS/CMI/LAB - TAXONOMY CHECK FOR FY07 HEDIS REPORT ;
  1. ;;16.1;IHS CLINICAL REPORTING;;MAR 22, 2016;Build 170
  1. ;
  1. ;
  1. D HOME^%ZIS
  1. W:$D(IOF) @IOF
  1. W !!,"Checking for Taxonomies to support the 2016 HEDIS Report. ",!,"Please enter the device for printing.",!
  1. ZIS ;
  1. S XBRC="",XBRP="TAXCHK^BGP6XTHE",XBNS="",XBRX="XIT^BGP6XTHE"
  1. D ^XBDBQUE
  1. D XIT
  1. Q
  1. TAXCHK ;EP
  1. ;D HOME^%ZIS
  1. K BGPQUIT
  1. GUICHK ;EP - gui tax check
  1. W !,"Checking for Taxonomies to support the HEDIS Report...",!
  1. NEW A,BGPX,I,Y,Z,J,BGPY,BGPT
  1. K A
  1. ;S T="TAXS" F J=1:1 S Z=$T(@T+J),BGPX=$P(Z,";;",2),Y=$P(Z,";;",3) Q:BGPX="" D
  1. S BGPT="" F S BGPT=$O(^BGPTAXM("B",BGPT)) Q:BGPT="" D
  1. .S BGPY=$O(^BGPTAXM("B",BGPT,0))
  1. .Q:'$D(^BGPTAXM(BGPY,12,"B",3))
  1. .;I $P(^BGPTAXM(BGPY,0),U,2)'="L" S BGPX=$O(^ATXAX("B",BGPT,0))
  1. .;I $P(^BGPTAXM(BGPY,0),U,2)="L" S BGPX=$O(^ATXLAB("B",BGPT,0))
  1. .S BGPTYPE=$P(^BGPTAXM(BGPY,0),U,2),Y=$G(^BGPTAXM(BGPY,11,1,0))
  1. .I BGPTYPE'="L" D
  1. ..I '$D(^ATXAX("B",BGPT)) S A(BGPT)=Y_"^is Missing" Q
  1. ..S I=$O(^ATXAX("B",BGPT,0))
  1. ..I '$D(^ATXAX(I,21,"B")) S A(BGPT)=Y_"^has no entries "
  1. .I BGPTYPE="L" D
  1. ..I '$D(^ATXLAB("B",BGPT)) S A(BGPT)=Y_"^is Missing " Q
  1. ..S I=$O(^ATXLAB("B",BGPT,0))
  1. ..I '$D(^ATXLAB(I,21,"B")) S A(BGPT)=Y_"^has no entries "
  1. I '$D(A) W !,"All taxonomies are present.",! K A,BGPX,Y,I,Z D DONE Q
  1. W !!,"In order for the HEDIS Report to find all necessary data, several",!,"taxonomies must be established. The following taxonomies are missing or have",!,"no entries:"
  1. S BGPX="" F S BGPX=$O(A(BGPX)) Q:BGPX=""!($D(BGPQUIT)) D
  1. .I $Y>(IOSL-2) D PAGE Q:$D(BGPQUIT)
  1. .W !,$P(A(BGPX),U)," [",BGPX,"] ",$P(A(BGPX),U,2)
  1. .Q
  1. DONE ;
  1. K BGPQUIT
  1. Q:$D(ZTQUEUED)
  1. 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
  1. Q
  1. XIT ;EP
  1. K BGP,BGPX,BGPQUIT,BGPLINE,BGPJ,BGPX,BGPTEXT,BGP
  1. K X,Y,J
  1. Q
  1. PAGE ;
  1. 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
  1. Q