BATTXCH ; IHS/CMI/LAB - ASTHMA TAXONOMY CHECK ;
;;1.0;IHS ASTHMA REGISTER;;FEB 19, 2003
;
;
TAXCHK ;EP
K BATQUIT
W !,"Checking for Taxonomies to support the ASTHMA REGISTER System...",!
NEW A,BATX,I,Y,Z,J
K A
S T="TAXS" F J=1:1 S Z=$T(@T+J),BATX=$P(Z,";;",2),Y=$P(Z,";;",3) Q:BATX="" D
.I '$D(^ATXAX("B",BATX)) S A(BATX)=Y_"^is Missing" Q
.S I=$O(^ATXAX("B",BATX,0))
.I '$D(^ATXAX(I,21,"B")) S A(BATX)=Y_"^has no entries "
S T="LAB" F J=1:1 S Z=$T(@T+J),BATX=$P(Z,";;",2),Y=$P(Z,";;",3) Q:BATX="" D
.I '$D(^ATXLAB("B",BATX)) S A(BATX)=Y_"^is Missing " Q
.S I=$O(^ATXLAB("B",BATX,0))
.I '$D(^ATXLAB(I,21,"B")) S A(BATX)=Y_"^has no entries "
I '$D(A) W !,"All taxonomies are present.",! K A,BATX,Y,I,Z D DONE Q
W !!,"In order for this application to find all necessary data, several",!,"taxonomies must be established. The following taxonomies are missing or have",!,"no entries:"
S BATX="" F S BATX=$O(A(BATX)) Q:BATX=""!($D(BATQUIT)) D
.I $Y>(IOSL-2) D PAGE Q:$D(BATQUIT)
.W !,$P(A(BATX),U)," [",BATX,"] ",$P(A(BATX),U,2)
.Q
DONE ;
K BATQUIT
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 BAT,BATX,BATQUIT,BATLINE,BATJ,BATX,BATTEXT,BAT
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 BATQUIT="" Q
Q
TAXS ;
;;BAT ASTHMA DIAGNOSES;;Asthma ICD 9 diagnoses codes
;;BAT ASTHMA RELIEVER MEDS;;Taxonomy of Asthma Reliever Meds
;;BAT ASTHMA INHALED STEROIDS;;Taxonomy of Asthma Inhaled Steroids
;;BAT ASTHMA CONTROLLER MEDS;;Taxonomy of Asthma Controller Meds
;;
;;
HS ;EP - called from option
W:$D(IOF) @IOF
S BATOPT=$O(^DIC(19,"B","BAT HS SETUP",0))
I 'BATOPT W !!,"oops something is wrong, option doesn't exist." D EOJ Q
W ;write out array
W:$D(IOF) @IOF
K BATQUIT
S BATX=0 F S BATX=$O(^DIC(19,BATOPT,1,BATX)) Q:BATX'=+BATX!($D(BATQUIT)) D
.I $Y>(IOSL-3) D HEADER Q:$D(BATQUIT)
.W !,^DIC(19,BATOPT,1,BATX,0)
.Q
D EOJ
Q
;
EOJ ;
D HEADER
K BATOPT,BATQUIT,BATX
Q
I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S BATQUIT="" Q
HEAD1 ;
W:$D(IOF) @IOF
Q
BATTXCH ; IHS/CMI/LAB - ASTHMA TAXONOMY CHECK ;
+1 ;;1.0;IHS ASTHMA REGISTER;;FEB 19, 2003
+2 ;
+3 ;
TAXCHK ;EP
+1 KILL BATQUIT
+2 WRITE !,"Checking for Taxonomies to support the ASTHMA REGISTER System...",!
+3 NEW A,BATX,I,Y,Z,J
+4 KILL A
+5 SET T="TAXS"
FOR J=1:1
SET Z=$TEXT(@T+J)
SET BATX=$PIECE(Z,";;",2)
SET Y=$PIECE(Z,";;",3)
IF BATX=""
QUIT
Begin DoDot:1
+6 IF '$DATA(^ATXAX("B",BATX))
SET A(BATX)=Y_"^is Missing"
QUIT
+7 SET I=$ORDER(^ATXAX("B",BATX,0))
+8 IF '$DATA(^ATXAX(I,21,"B"))
SET A(BATX)=Y_"^has no entries "
End DoDot:1
+9 SET T="LAB"
FOR J=1:1
SET Z=$TEXT(@T+J)
SET BATX=$PIECE(Z,";;",2)
SET Y=$PIECE(Z,";;",3)
IF BATX=""
QUIT
Begin DoDot:1
+10 IF '$DATA(^ATXLAB("B",BATX))
SET A(BATX)=Y_"^is Missing "
QUIT
+11 SET I=$ORDER(^ATXLAB("B",BATX,0))
+12 IF '$DATA(^ATXLAB(I,21,"B"))
SET A(BATX)=Y_"^has no entries "
End DoDot:1
+13 IF '$DATA(A)
WRITE !,"All taxonomies are present.",!
KILL A,BATX,Y,I,Z
DO DONE
QUIT
+14 WRITE !!,"In order for this application to find all necessary data, several",!,"taxonomies must be established. The following taxonomies are missing or have",!,"no entries:"
+15 SET BATX=""
FOR
SET BATX=$ORDER(A(BATX))
IF BATX=""!($DATA(BATQUIT))
QUIT
Begin DoDot:1
+16 IF $Y>(IOSL-2)
DO PAGE
IF $DATA(BATQUIT)
QUIT
+17 WRITE !,$PIECE(A(BATX),U)," [",BATX,"] ",$PIECE(A(BATX),U,2)
+18 QUIT
End DoDot:1
DONE ;
+1 KILL BATQUIT
+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 BAT,BATX,BATQUIT,BATLINE,BATJ,BATX,BATTEXT,BAT
+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 BATQUIT=""
QUIT
+2 QUIT
TAXS ;
+1 ;;BAT ASTHMA DIAGNOSES;;Asthma ICD 9 diagnoses codes
+2 ;;BAT ASTHMA RELIEVER MEDS;;Taxonomy of Asthma Reliever Meds
+3 ;;BAT ASTHMA INHALED STEROIDS;;Taxonomy of Asthma Inhaled Steroids
+4 ;;BAT ASTHMA CONTROLLER MEDS;;Taxonomy of Asthma Controller Meds
+5 ;;
+6 ;;
HS ;EP - called from option
+1 IF $DATA(IOF)
WRITE @IOF
+2 SET BATOPT=$ORDER(^DIC(19,"B","BAT HS SETUP",0))
+3 IF 'BATOPT
WRITE !!,"oops something is wrong, option doesn't exist."
DO EOJ
QUIT
W ;write out array
+1 IF $DATA(IOF)
WRITE @IOF
+2 KILL BATQUIT
+3 SET BATX=0
FOR
SET BATX=$ORDER(^DIC(19,BATOPT,1,BATX))
IF BATX'=+BATX!($DATA(BATQUIT))
QUIT
Begin DoDot:1
+4 IF $Y>(IOSL-3)
DO HEADER
IF $DATA(BATQUIT)
QUIT
+5 WRITE !,^DIC(19,BATOPT,1,BATX,0)
+6 QUIT
End DoDot:1
+7 DO EOJ
+8 QUIT
+9 ;
EOJ ;
+1 DO HEADER
+2 KILL BATOPT,BATQUIT,BATX
+3 QUIT
+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 BATQUIT=""
QUIT
HEAD1 ;
+1 IF $DATA(IOF)
WRITE @IOF
+2 QUIT
