ATXTAXE ; IHS/CMI/LAB - DISPLAY IND LISTS ;
;;5.1;TAXONOMY;**11**;FEB 04, 1997;Build 48
;; ;
EP ;EP - CALLED FROM OPTION
D EN
Q
EOJ ;EP
D ^XBFMK
K ATXITEM,ATXX,ATXTAXI,ATXITMI,ATXHIGH,ATXTXLI
Q
;; ;
EN ;EP -- main entry point for
S DIE="^ATXAX(",DR=".02;5101;1101",DA=ATXTAXI D ^DIE
;
D EN^VALM("ATX TAXONOMY GENERIC EDIT")
D CLEAR^VALM1
D FULL^VALM1
W:$D(IOF) @IOF
D EOJ
Q
;
PAUSE ;EP
Q:$E(IOST)'="C"!(IO'=IO(0))
W ! S DIR(0)="EO",DIR("A")="Press enter to continue...." D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q
HDR ; -- header code
S VALMHDR(1)="Updating the "_ATXTAXN_" taxonomy"
Q
;
INIT ; -- init variables and list array
I ATXFILE=60 D LAB Q
I $P(^ATXAX(ATXTAXI,0),U,13)!($$ACAN($P(^ATXAX(ATXTAXI,0),U,15))) D CANDISP Q
K ATXITEM S ATXHIGH="",C=0
S ATXX=0 F S ATXX=$O(^ATXAX(ATXTAXI,21,ATXX)) Q:ATXX'=+ATXX D
.S C=C+1
.S ATXITMI=$P(^ATXAX(ATXTAXI,21,ATXX,0),U)
.I ATXFILE=9999999.05 S ATXITEM(C,0)=C_") "_ATXITMI I 1
.E S ATXITEM(C,0)=C_") "_$$VAL^XBDIQ1($P(^ATXAX(ATXTAXI,0),U,15),ATXITMI,.01)
.S ATXITEM("IDX",C,C)=ATXITMI
.Q
S (VALMCNT,ATXHIGH)=C
Q
ACAN(F) ;
I $G(F)="" Q 0
I F=80 Q 1
I F=80.1 Q 1
I F=81 Q 1
Q 0
CANDISP ;
K ATXITEM S ATXHIGH="",C=0
S ATXX=0 F S ATXX=$O(^ATXAX(ATXTAXI,21,ATXX)) Q:ATXX'=+ATXX D
.S C=C+1
.S ATXITEM(C,0)=C_") "_$$STRIP^XLFSTR($P(^ATXAX(ATXTAXI,21,ATXX,0),U)," ")_" - "_$$STRIP^XLFSTR($P(^ATXAX(ATXTAXI,21,ATXX,0),U,2)," ")
.S $E(ATXITEM(C,0),30)=$S($P(^ATXAX(ATXTAXI,21,ATXX,0),U,3):" "_$P(^ICDS($P(^ATXAX(ATXTAXI,21,ATXX,0),U,3),0),U,1),1:"")
.S ATXITEM("IDX",C,C)=ATXX
.Q
S (VALMCNT,ATXHIGH)=C
Q
LAB ;
K ATXITEM S ATXHIGH="",C=0
S ATXX=0 F S ATXX=$O(^ATXLAB(ATXTAXI,21,ATXX)) Q:ATXX'=+ATXX D
.S C=C+1
.S ATXITMI=$P(^ATXLAB(ATXTAXI,21,ATXX,0),U)
.S ATXITEM(C,0)=C_") "_$P($G(^LAB(60,ATXITMI,0)),U)
.S ATXITEM("IDX",C,C)=ATXITMI
.Q
S (VALMCNT,ATXHIGH)=C
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
Q
;
EXPND ; -- expand code
Q
;
BACK ;go back to listman
D TERM^VALM0
S VALMBCK="R"
D INIT
D HDR
K DIR
K X,Y,Z,I
Q
;
REM ;
D FULL^VALM1
W !
I ATXFILE=60,$P(^ATXLAB(ATXTAXI,0),U,22) W !!,"The ",$P(^ATXLAB(ATXTAXI,0),U)," Taxonomy is READ ONLY.",!,"You can not update it." D PAUSE G REMX
I ATXFILE'=60,$P(^ATXAX(ATXTAXI,0),U,22) W !!,"The ",$P(^ATXAX(ATXTAXI,0),U)," Taxonomy is READ ONLY.",!,"You can not update it." D PAUSE G REMX
I ATXFILE'=60,$P(^ATXAX(ATXTAXI,0),U,5)'=DUZ W !!,"You are not the creator of the ",$P(^ATXAX(ATXTAXI,0),U)," Taxonomy.",!,"Sorry, but you cannot edit it." D PAUSE G REMX
I ATXFILE=60,$P(^ATXLAB(ATXTAXI,0),U,5)'=DUZ W !!,"You are not the creator of the ",$P(^ATXLAB(ATXTAXI,0),U)," Taxonomy.",!,"Sorry, but you cannot edit it." D PAUSE G REMX
W ! K DIR
NEW ATXREMM
S ATXREMM=1
I ATXFILE=80 D ICD9ADD G REMX
I ATXFILE=80.1 D ICD0ADD G REMX
I ATXFILE=81 D ICPTADD G REMX
;I ATXFILE'=60,$P(^ATXTYPE(ATXTAXT,0),U,4)=1 D ICD9ADD G REMX
S DIR(0)="NO^1:"_ATXHIGH,DIR("A")="Remove Which Item"
D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I Y="" W !,"No item selected." G REMX
I $D(DIRUT) W !,"No item selected." G REMX
S ATXITMI=ATXITEM("IDX",Y,Y)
;sure
I ATXFILE=60 K DIR S DIR(0)="Y",DIR("A")="Are you sure you want to remove the "_$P(^LAB(60,ATXITMI,0),U)_" lab test",DIR("B")="N" KILL DA D ^DIR KILL DIR
I ATXFILE'=60,ATXTAXT K DIR D
.S DIR(0)="Y",DIR("A")="Are you sure you want to remove the "_$S(ATXFILE'=9999999.05:$$VAL^XBDIQ1($P(^ATXAX(ATXTAXI,0),U,15),ATXITMI,.01),1:ATXITMI)_" "_$$VAL^XBDIQ1(9002226,ATXTAXI,.15),DIR("B")="N" KILL DA D ^DIR KILL DIR
I 'Y G REM
I $D(DIRUT) G REMX
D ^XBFMK
I ATXFILE=60 S DA(1)=ATXTAXI,DA=$O(^ATXLAB(ATXTAXI,21,"B",ATXITMI,0)),DIE="^ATXLAB("_ATXTAXI_",21,",DR=".01///@" D ^DIE
I ATXFILE'=60 S DA(1)=ATXTAXI,DA=$O(^ATXAX(ATXTAXI,21,"B",ATXITMI,0)),DIE="^ATXAX("_ATXTAXI_",21,",DR=".01///@" D ^DIE
REMX ;
D ^XBFMK
D BACK
Q
ADD ;EP - add an item to the selected list - called from a protocol
D FULL^VALM1
W !
I ATXFILE=60,$P(^ATXLAB(ATXTAXI,0),U,22) W !!,"The ",$P(^ATXLAB(ATXTAXI,0),U)," is READ ONLY.",!,"You can not update it." D PAUSE G ADDX
I ATXFILE'=60,$P(^ATXAX(ATXTAXI,0),U,22) W !!,"The ",$P(^ATXAX(ATXTAXI,0),U)," is READ ONLY.",!,"You can not update it." D PAUSE G ADDX
I ATXFILE'=60,$P(^ATXAX(ATXTAXI,0),U,5)'=DUZ W !!,"You are not the creator of the ",$P(^ATXAX(ATXTAXI,0),U)," Taxonomy.",!,"Sorry, but you cannot edit it." D PAUSE G ADDX
I ATXFILE=60,$P(^ATXLAB(ATXTAXI,0),U,5)'=DUZ W !!,"You are not the creator of the ",$P(^ATXLAB(ATXTAXI,0),U)," Taxonomy.",!,"Sorry, but you cannot edit it." D PAUSE G ADDX
I ATXFILE=60 D LABADD G ADDX
I ATXFILE=80 D ICD9ADD G ADDX
I ATXFILE=80.1 D ICD0ADD G ADDX
I ATXFILE=81 D ICPTADD G ADDX
K DIC
S DIC(0)="AEMQ",DIC=$P(^ATXAX(ATXTAXI,0),U,15) D ^DIC
I Y=-1 G ADDX
I $D(^ATXAX(ATXTAXI,21,"B",$S(ATXFILE'=9999999.05:+Y,1:$P(^AUTTCOM(+Y,0),U,1)))) W !!,"That item is already in the taxonomy." H 2 G ADD
S DA=ATXTAXI
S (X,ATXTXLI)=+Y
I ATXFILE=9999999.05 S (X,ATXTXLI)=$P(^AUTTCOM(+Y,0),U) ;special processing for community
S ATXFILE=$P(^ATXAX(ATXTAXI,0),U,15)
S DA(1)=ATXTAXI
S DIC="^ATXAX("_DA_",21,"
S DIC(0)="L",DIC("DR")=".02////"_ATXTXLI K DD,DO
S:'$D(^ATXAX(DA,21,0)) ^ATXAX(DA,21,0)="^9002226.02101A"
D FILE^DICN
I '$D(^ATXAX(ATXTAXI,21,"B",ATXTXLI)) W !!,"adding ITEM failed." H 2 G ADD
G ADDX
LABADD ;
K DIC
S DIC(0)="AEMQ",DIC="^LAB(60,",DIC("A")="Which LAB Test: " D ^DIC
I Y=-1 G ADDX
S ATXTXLI=+Y
I '$P(^ATXLAB(ATXTAXI,0),U,11),$O(^LAB(60,ATXTXLI,2,0)) S ATXYN="" D G:'ATXYN ADDX
.W !!,"This lab test, ",$P(^LAB(60,ATXTXLI,0),U),", is a panel test and the"
.W !,"taxonomy ",$P(^ATXLAB(ATXTAXI,0),U)," should not contain panel tests.",!
.S DIR(0)="Y",DIR("A")="Do you still want to add this lab test to this taxonomy",DIR("B")="N" KILL DA D ^DIR KILL DIR
.Q:$D(DIRUT)
.S ATXYN=Y
I $D(^ATXLAB(ATXTAXI,21,"B",ATXTXLI)) W !!,"Lab test ",$P(^LAB(60,ATXTXLI,0),U)," is already in the taxonomy." H 2 G ADD
S DA=ATXTAXI
S X=ATXTXLI
S DA(1)=ATXTAXI
S DIC="^ATXLAB("_DA_",21,"
S DIC(0)="L" K DD,DO
S:'$D(^ATXLAB(DA,21,0)) ^ATXLAB(DA,21,0)="^9002228.02101PA"
D FILE^DICN
I '$D(^ATXLAB(ATXTAXI,21,"B",ATXTXLI)) W !!,"adding lab test failed." H 2 G ADD
ADDX ;
K DIC,DA,DR,ATXTXLI,DD,DO
D BACK
Q
ICD9ADD ;
D ICD9ADD^ATXTAXF
Q
ICD0ADD ;
D ICD9ADD^ATXTAXF
Q
ICPTADD ;
D ICPTADD^ATXTAXL
Q
ATXTAXE ; IHS/CMI/LAB - DISPLAY IND LISTS ;
+1 ;;5.1;TAXONOMY;**11**;FEB 04, 1997;Build 48
+2 ;; ;
EP ;EP - CALLED FROM OPTION
+1 DO EN
+2 QUIT
EOJ ;EP
+1 DO ^XBFMK
+2 KILL ATXITEM,ATXX,ATXTAXI,ATXITMI,ATXHIGH,ATXTXLI
+3 QUIT
+4 ;; ;
EN ;EP -- main entry point for
+1 SET DIE="^ATXAX("
SET DR=".02;5101;1101"
SET DA=ATXTAXI
DO ^DIE
+2 ;
+3 DO EN^VALM("ATX TAXONOMY GENERIC EDIT")
+4 DO CLEAR^VALM1
+5 DO FULL^VALM1
+6 IF $DATA(IOF)
WRITE @IOF
+7 DO EOJ
+8 QUIT
+9 ;
PAUSE ;EP
+1 IF $EXTRACT(IOST)'="C"!(IO'=IO(0))
QUIT
+2 WRITE !
SET DIR(0)="EO"
SET DIR("A")="Press enter to continue...."
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 QUIT
HDR ; -- header code
+1 SET VALMHDR(1)="Updating the "_ATXTAXN_" taxonomy"
+2 QUIT
+3 ;
INIT ; -- init variables and list array
+1 IF ATXFILE=60
DO LAB
QUIT
+2 IF $PIECE(^ATXAX(ATXTAXI,0),U,13)!($$ACAN($PIECE(^ATXAX(ATXTAXI,0),U,15)))
DO CANDISP
QUIT
+3 KILL ATXITEM
SET ATXHIGH=""
SET C=0
+4 SET ATXX=0
FOR
SET ATXX=$ORDER(^ATXAX(ATXTAXI,21,ATXX))
IF ATXX'=+ATXX
QUIT
Begin DoDot:1
+5 SET C=C+1
+6 SET ATXITMI=$PIECE(^ATXAX(ATXTAXI,21,ATXX,0),U)
+7 IF ATXFILE=9999999.05
SET ATXITEM(C,0)=C_") "_ATXITMI
IF 1
+8 IF '$TEST
SET ATXITEM(C,0)=C_") "_$$VAL^XBDIQ1($PIECE(^ATXAX(ATXTAXI,0),U,15),ATXITMI,.01)
+9 SET ATXITEM("IDX",C,C)=ATXITMI
+10 QUIT
End DoDot:1
+11 SET (VALMCNT,ATXHIGH)=C
+12 QUIT
ACAN(F) ;
+1 IF $GET(F)=""
QUIT 0
+2 IF F=80
QUIT 1
+3 IF F=80.1
QUIT 1
+4 IF F=81
QUIT 1
+5 QUIT 0
CANDISP ;
+1 KILL ATXITEM
SET ATXHIGH=""
SET C=0
+2 SET ATXX=0
FOR
SET ATXX=$ORDER(^ATXAX(ATXTAXI,21,ATXX))
IF ATXX'=+ATXX
QUIT
Begin DoDot:1
+3 SET C=C+1
+4 SET ATXITEM(C,0)=C_") "_$$STRIP^XLFSTR($PIECE(^ATXAX(ATXTAXI,21,ATXX,0),U)," ")_" - "_$$STRIP^XLFSTR($PIECE(^ATXAX(ATXTAXI,21,ATXX,0),U,2)," ")
+5 SET $EXTRACT(ATXITEM(C,0),30)=$SELECT($PIECE(^ATXAX(ATXTAXI,21,ATXX,0),U,3):" "_$PIECE(^ICDS($PIECE(^ATXAX(ATXTAXI,21,ATXX,0),U,3),0),U,1),1:"")
+6 SET ATXITEM("IDX",C,C)=ATXX
+7 QUIT
End DoDot:1
+8 SET (VALMCNT,ATXHIGH)=C
+9 QUIT
LAB ;
+1 KILL ATXITEM
SET ATXHIGH=""
SET C=0
+2 SET ATXX=0
FOR
SET ATXX=$ORDER(^ATXLAB(ATXTAXI,21,ATXX))
IF ATXX'=+ATXX
QUIT
Begin DoDot:1
+3 SET C=C+1
+4 SET ATXITMI=$PIECE(^ATXLAB(ATXTAXI,21,ATXX,0),U)
+5 SET ATXITEM(C,0)=C_") "_$PIECE($GET(^LAB(60,ATXITMI,0)),U)
+6 SET ATXITEM("IDX",C,C)=ATXITMI
+7 QUIT
End DoDot:1
+8 SET (VALMCNT,ATXHIGH)=C
+9 QUIT
+10 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 QUIT
+2 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
BACK ;go back to listman
+1 DO TERM^VALM0
+2 SET VALMBCK="R"
+3 DO INIT
+4 DO HDR
+5 KILL DIR
+6 KILL X,Y,Z,I
+7 QUIT
+8 ;
REM ;
+1 DO FULL^VALM1
+2 WRITE !
+3 IF ATXFILE=60
IF $PIECE(^ATXLAB(ATXTAXI,0),U,22)
WRITE !!,"The ",$PIECE(^ATXLAB(ATXTAXI,0),U)," Taxonomy is READ ONLY.",!,"You can not update it."
DO PAUSE
GOTO REMX
+4 IF ATXFILE'=60
IF $PIECE(^ATXAX(ATXTAXI,0),U,22)
WRITE !!,"The ",$PIECE(^ATXAX(ATXTAXI,0),U)," Taxonomy is READ ONLY.",!,"You can not update it."
DO PAUSE
GOTO REMX
+5 IF ATXFILE'=60
IF $PIECE(^ATXAX(ATXTAXI,0),U,5)'=DUZ
WRITE !!,"You are not the creator of the ",$PIECE(^ATXAX(ATXTAXI,0),U)," Taxonomy.",!,"Sorry, but you cannot edit it."
DO PAUSE
GOTO REMX
+6 IF ATXFILE=60
IF $PIECE(^ATXLAB(ATXTAXI,0),U,5)'=DUZ
WRITE !!,"You are not the creator of the ",$PIECE(^ATXLAB(ATXTAXI,0),U)," Taxonomy.",!,"Sorry, but you cannot edit it."
DO PAUSE
GOTO REMX
+7 WRITE !
KILL DIR
+8 NEW ATXREMM
+9 SET ATXREMM=1
+10 IF ATXFILE=80
DO ICD9ADD
GOTO REMX
+11 IF ATXFILE=80.1
DO ICD0ADD
GOTO REMX
+12 IF ATXFILE=81
DO ICPTADD
GOTO REMX
+13 ;I ATXFILE'=60,$P(^ATXTYPE(ATXTAXT,0),U,4)=1 D ICD9ADD G REMX
+14 SET DIR(0)="NO^1:"_ATXHIGH
SET DIR("A")="Remove Which Item"
+15 DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+16 IF Y=""
WRITE !,"No item selected."
GOTO REMX
+17 IF $DATA(DIRUT)
WRITE !,"No item selected."
GOTO REMX
+18 SET ATXITMI=ATXITEM("IDX",Y,Y)
+19 ;sure
+20 IF ATXFILE=60
KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Are you sure you want to remove the "_$PIECE(^LAB(60,ATXITMI,0),U)_" lab test"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+21 IF ATXFILE'=60
IF ATXTAXT
KILL DIR
Begin DoDot:1
+22 SET DIR(0)="Y"
SET DIR("A")="Are you sure you want to remove the "_$SELECT(ATXFILE'=9999999.05:$$VAL^XBDIQ1($PIECE(^ATXAX(ATXTAXI,0),U,15),ATXITMI,.01),1:ATXITMI)_" "_$$VAL^XBDIQ1(9002226,ATXTAXI,.15)
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
End DoDot:1
+23 IF 'Y
GOTO REM
+24 IF $DATA(DIRUT)
GOTO REMX
+25 DO ^XBFMK
+26 IF ATXFILE=60
SET DA(1)=ATXTAXI
SET DA=$ORDER(^ATXLAB(ATXTAXI,21,"B",ATXITMI,0))
SET DIE="^ATXLAB("_ATXTAXI_",21,"
SET DR=".01///@"
DO ^DIE
+27 IF ATXFILE'=60
SET DA(1)=ATXTAXI
SET DA=$ORDER(^ATXAX(ATXTAXI,21,"B",ATXITMI,0))
SET DIE="^ATXAX("_ATXTAXI_",21,"
SET DR=".01///@"
DO ^DIE
REMX ;
+1 DO ^XBFMK
+2 DO BACK
+3 QUIT
ADD ;EP - add an item to the selected list - called from a protocol
+1 DO FULL^VALM1
+2 WRITE !
+3 IF ATXFILE=60
IF $PIECE(^ATXLAB(ATXTAXI,0),U,22)
WRITE !!,"The ",$PIECE(^ATXLAB(ATXTAXI,0),U)," is READ ONLY.",!,"You can not update it."
DO PAUSE
GOTO ADDX
+4 IF ATXFILE'=60
IF $PIECE(^ATXAX(ATXTAXI,0),U,22)
WRITE !!,"The ",$PIECE(^ATXAX(ATXTAXI,0),U)," is READ ONLY.",!,"You can not update it."
DO PAUSE
GOTO ADDX
+5 IF ATXFILE'=60
IF $PIECE(^ATXAX(ATXTAXI,0),U,5)'=DUZ
WRITE !!,"You are not the creator of the ",$PIECE(^ATXAX(ATXTAXI,0),U)," Taxonomy.",!,"Sorry, but you cannot edit it."
DO PAUSE
GOTO ADDX
+6 IF ATXFILE=60
IF $PIECE(^ATXLAB(ATXTAXI,0),U,5)'=DUZ
WRITE !!,"You are not the creator of the ",$PIECE(^ATXLAB(ATXTAXI,0),U)," Taxonomy.",!,"Sorry, but you cannot edit it."
DO PAUSE
GOTO ADDX
+7 IF ATXFILE=60
DO LABADD
GOTO ADDX
+8 IF ATXFILE=80
DO ICD9ADD
GOTO ADDX
+9 IF ATXFILE=80.1
DO ICD0ADD
GOTO ADDX
+10 IF ATXFILE=81
DO ICPTADD
GOTO ADDX
+11 KILL DIC
+12 SET DIC(0)="AEMQ"
SET DIC=$PIECE(^ATXAX(ATXTAXI,0),U,15)
DO ^DIC
+13 IF Y=-1
GOTO ADDX
+14 IF $DATA(^ATXAX(ATXTAXI,21,"B",$SELECT(ATXFILE'=9999999.05:+Y,1:$PIECE(^AUTTCOM(+Y,0),U,1))))
WRITE !!,"That item is already in the taxonomy."
HANG 2
GOTO ADD
+15 SET DA=ATXTAXI
+16 SET (X,ATXTXLI)=+Y
+17 ;special processing for community
IF ATXFILE=9999999.05
SET (X,ATXTXLI)=$PIECE(^AUTTCOM(+Y,0),U)
+18 SET ATXFILE=$PIECE(^ATXAX(ATXTAXI,0),U,15)
+19 SET DA(1)=ATXTAXI
+20 SET DIC="^ATXAX("_DA_",21,"
+21 SET DIC(0)="L"
SET DIC("DR")=".02////"_ATXTXLI
KILL DD,DO
+22 IF '$DATA(^ATXAX(DA,21,0))
SET ^ATXAX(DA,21,0)="^9002226.02101A"
+23 DO FILE^DICN
+24 IF '$DATA(^ATXAX(ATXTAXI,21,"B",ATXTXLI))
WRITE !!,"adding ITEM failed."
HANG 2
GOTO ADD
+25 GOTO ADDX
LABADD ;
+1 KILL DIC
+2 SET DIC(0)="AEMQ"
SET DIC="^LAB(60,"
SET DIC("A")="Which LAB Test: "
DO ^DIC
+3 IF Y=-1
GOTO ADDX
+4 SET ATXTXLI=+Y
+5 IF '$PIECE(^ATXLAB(ATXTAXI,0),U,11)
IF $ORDER(^LAB(60,ATXTXLI,2,0))
SET ATXYN=""
Begin DoDot:1
+6 WRITE !!,"This lab test, ",$PIECE(^LAB(60,ATXTXLI,0),U),", is a panel test and the"
+7 WRITE !,"taxonomy ",$PIECE(^ATXLAB(ATXTAXI,0),U)," should not contain panel tests.",!
+8 SET DIR(0)="Y"
SET DIR("A")="Do you still want to add this lab test to this taxonomy"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+9 IF $DATA(DIRUT)
QUIT
+10 SET ATXYN=Y
End DoDot:1
IF 'ATXYN
GOTO ADDX
+11 IF $DATA(^ATXLAB(ATXTAXI,21,"B",ATXTXLI))
WRITE !!,"Lab test ",$PIECE(^LAB(60,ATXTXLI,0),U)," is already in the taxonomy."
HANG 2
GOTO ADD
+12 SET DA=ATXTAXI
+13 SET X=ATXTXLI
+14 SET DA(1)=ATXTAXI
+15 SET DIC="^ATXLAB("_DA_",21,"
+16 SET DIC(0)="L"
KILL DD,DO
+17 IF '$DATA(^ATXLAB(DA,21,0))
SET ^ATXLAB(DA,21,0)="^9002228.02101PA"
+18 DO FILE^DICN
+19 IF '$DATA(^ATXLAB(ATXTAXI,21,"B",ATXTXLI))
WRITE !!,"adding lab test failed."
HANG 2
GOTO ADD
ADDX ;
+1 KILL DIC,DA,DR,ATXTXLI,DD,DO
+2 DO BACK
+3 QUIT
ICD9ADD ;
+1 DO ICD9ADD^ATXTAXF
+2 QUIT
ICD0ADD ;
+1 DO ICD9ADD^ATXTAXF
+2 QUIT
ICPTADD ;
+1 DO ICPTADD^ATXTAXL
+2 QUIT
