APCLTAX2.m

APCLTAX2 ; IHS/CMI/LAB - DMS TAXONOMY MANAGEMENT UTILITY ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 ;UTILITY PROGRAM TO MANAGE TAXONOMY CREATION AND EDITING

OTHER ;EP;TO SELECT AND EDIT NON-DMS TAXONOMIES

 F  D O1 Q:$D(APCLQUIT)!$D(APCLOUT)

 K APCLQUIT

 Q

O1 W @IOF

 S DIR(0)="SO^1:Lab Taxonomies;2:All Other Taxonomies"

 S DIR("A")="Which type of Taxonomy"

 W !

 D DIR^APCLDIC

 I Y<1 S APCLQUIT="" Q

 S:Y=1 APCLWHCH="LAB"

 S:Y=2 APCLWHCH="RX"

 D O2

 Q

STAX S DIC=$S(APCLWHCH="RX":"^ATXAX(",1:"^ATXLAB(")

 S DIC(0)="AEMQZ"

 S DIC("A")="Name of Taxonomy: "

 W !

 D DIC^APCLDIC

 Q:Y<1

 S APCLTDA=+Y

 S APCLTNAM=Y(0,0)

 S APCLCANN=$S(APCLWHCH="RX":$P(Y(0),U,13),1:0)

 S APCLFILE=$S(APCLWHCH="RX":+$P(Y(0),U,15),1:60)

 S APCLTF=^DIC(APCLFILE,0,"GL")

 D APCLTF1^APCLTAX0

 I APCLWHCH="RX" S APCLANAM="OTHER" D TE1^APCLTAX0 Q

 D LABTEST^APCLTAX1

 Q

ATTRIB ;EP;TO SELECT ATTRIBUTE FOR TAXONOMY CREATION

 S DIC="^AMQQ(5,"

 S DIC(0)="AEMQZ"

 S DIC("A")="Which ATTRIBUTE: "

 S DIC("S")="I $P(^(0),U,14)]"""""

 W !!,"Each TAXONOMY must be based on an existing ATTRIBUTE."

 W !!,"Please select an ATTRIBUTE for this TAXONOMY."

 W !

 D DIC^APCLDIC

 Q:Y<1

 S APCLADA=+Y

 S APCLANAM="OTHER"

 S APCLCANN=($P(Y(0),U,14)=2)

 D TERM^APCLTAX0

 Q

O2 ;OTHER TAXONOMY ADD/EDIT

 K APCLADA ;PATCH XXX

 S DIR(0)="SO^1:Edit Existing Taxonomy;2:Add NEW Taxonomy"

 S DIR("A")="Which option"

 W !

 D DIR^APCLDIC

 I Y<1 K APCLQUIT Q

 I Y=1 D STAX Q

 I Y=2 D TAXADD^APCLTAX0:APCLWHCH="RX",LADD^APCLTAX0:APCLWHCH="LAB"

 Q

APCLTAX2  ; IHS/CMI/LAB - DMS TAXONOMY MANAGEMENT UTILITY ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ;UTILITY PROGRAM TO MANAGE TAXONOMY CREATION AND EDITING

OTHER     ;EP;TO SELECT AND EDIT NON-DMS TAXONOMIES

 +1        FOR 

               DO O1

               IF $DATA(APCLQUIT)!$DATA(APCLOUT)

                   QUIT 

 +2        KILL APCLQUIT

 +3        QUIT 

O1         WRITE @IOF

 +1        SET DIR(0)="SO^1:Lab Taxonomies;2:All Other Taxonomies"

 +2        SET DIR("A")="Which type of Taxonomy"

 +3        WRITE !

 +4        DO DIR^APCLDIC

 +5        IF Y<1

               SET APCLQUIT=""

               QUIT 

 +6        IF Y=1

               SET APCLWHCH="LAB"

 +7        IF Y=2

               SET APCLWHCH="RX"

 +8        DO O2

 +9        QUIT 

STAX       SET DIC=$SELECT(APCLWHCH="RX":"^ATXAX(",1:"^ATXLAB(")

 +1        SET DIC(0)="AEMQZ"

 +2        SET DIC("A")="Name of Taxonomy: "

 +3        WRITE !

 +4        DO DIC^APCLDIC

 +5        IF Y<1

               QUIT 

 +6        SET APCLTDA=+Y

 +7        SET APCLTNAM=Y(0,0)

 +8        SET APCLCANN=$SELECT(APCLWHCH="RX":$PIECE(Y(0),U,13),1:0)

 +9        SET APCLFILE=$SELECT(APCLWHCH="RX":+$PIECE(Y(0),U,15),1:60)

 +10       SET APCLTF=^DIC(APCLFILE,0,"GL")

 +11       DO APCLTF1^APCLTAX0

 +12       IF APCLWHCH="RX"

               SET APCLANAM="OTHER"

               DO TE1^APCLTAX0

               QUIT 

 +13       DO LABTEST^APCLTAX1

 +14       QUIT 

ATTRIB    ;EP;TO SELECT ATTRIBUTE FOR TAXONOMY CREATION

 +1        SET DIC="^AMQQ(5,"

 +2        SET DIC(0)="AEMQZ"

 +3        SET DIC("A")="Which ATTRIBUTE: "

 +4        SET DIC("S")="I $P(^(0),U,14)]"""""

 +5        WRITE !!,"Each TAXONOMY must be based on an existing ATTRIBUTE."

 +6        WRITE !!,"Please select an ATTRIBUTE for this TAXONOMY."

 +7        WRITE !

 +8        DO DIC^APCLDIC

 +9        IF Y<1

               QUIT 

 +10       SET APCLADA=+Y

 +11       SET APCLANAM="OTHER"

 +12       SET APCLCANN=($PIECE(Y(0),U,14)=2)

 +13       DO TERM^APCLTAX0

 +14       QUIT 

O2        ;OTHER TAXONOMY ADD/EDIT

 +1       ;PATCH XXX

           KILL APCLADA

 +2        SET DIR(0)="SO^1:Edit Existing Taxonomy;2:Add NEW Taxonomy"

 +3        SET DIR("A")="Which option"

 +4        WRITE !

 +5        DO DIR^APCLDIC

 +6        IF Y<1

               KILL APCLQUIT

               QUIT 

 +7        IF Y=1

               DO STAX

               QUIT 

 +8        IF Y=2

               IF APCLWHCH="RX"

                   DO TAXADD^APCLTAX0

               IF APCLWHCH="LAB"

                   DO LADD^APCLTAX0

 +9        QUIT