- 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
