Routine: BATTXCH

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

XIT ;EP

 K BAT,BATX,BATQUIT,BATLINE,BATJ,BATX,BATTEXT,BAT

 K X,Y,J

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

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

EOJ ;

 D HEADER

 K BATOPT,BATQUIT,BATX

HEADER ;

 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

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

HEADER    ;

 +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

BATTXCH.m