ATXLABA.m

ATXLABA ; IHS/OHPRD/TMJ -  TAXONOMY FOR ICD9 CODES INTO ICD DIAG FILE ;  

 ;;5.1;TAXONOMY;**11**;FEB 04, 1997;Build 48

 ;

 ;

 ; -- ADD A NEW TAXONOMY OR ADD CODES TO A TAXONOMY

 ;

START ;

 W !,"It is recommended that you have one of the laboratory personnel assist you"

 W !,"when entering this data.",!!

 S DIC="^ATXLAB(",DIC(0)=$S('$D(ATXTXNM):"AEMQL",1:"EMQL"),DIC("DR")="",DLAYGO=9002228 D ^DIC K DIC,DLAYGO

 Q:Y=-1

 S ATXX=+Y

 ;DO DIQ DISPLAY HERE!!

 S %H=$H D YX^%DTC S ATXTIME=X_%

 S DIE="^ATXLAB(",DR="[ATX ADD LAB TAXONOMY]",DA=ATXX D ^DIE K DIE,DR,ATXTIME

 I '$O(^ATXLAB(ATXX,21,0)) S ATXSTP=1 Q

 Q

 ;

EN ;EP - CALLED FROM OPTION

 I '$D(ATXTXNM) W !!,"Error - missing DM AUDIT Lab Taxonomy name!" Q

 W !!,"You are creating/editing the ",ATXTXNM," Lab Taxonomy.",!

 I $D(^ATXLAB("B",ATXTXNM)) W !,"CURRENT DEFINITION: ",! S DA=$O(^ATXLAB("B",ATXTXNM,0)),DIC="^ATXLAB(" D EN^DIQ K DIC,DA,DR

 S X=ATXTXNM

 D START

 D XIT

 Q

XIT ;

 K ATXSTP,ATXTXNM,ATXTXBD

 Q

 ;

 ;

ATXLABA   ; IHS/OHPRD/TMJ -  TAXONOMY FOR ICD9 CODES INTO ICD DIAG FILE ;  

 +1       ;;5.1;TAXONOMY;**11**;FEB 04, 1997;Build 48

 +2       ;

 +3       ;

 +4       ; -- ADD A NEW TAXONOMY OR ADD CODES TO A TAXONOMY

 +5       ;

START     ;

 +1        WRITE !,"It is recommended that you have one of the laboratory personnel assist you"

 +2        WRITE !,"when entering this data.",!!

 +3        SET DIC="^ATXLAB("

           SET DIC(0)=$SELECT('$DATA(ATXTXNM):"AEMQL",1:"EMQL")

           SET DIC("DR")=""

           SET DLAYGO=9002228

           DO ^DIC

           KILL DIC,DLAYGO

 +4        IF Y=-1

               QUIT 

 +5        SET ATXX=+Y

 +6       ;DO DIQ DISPLAY HERE!!

 +7        SET %H=$HOROLOG

           DO YX^%DTC

           SET ATXTIME=X_%

 +8        SET DIE="^ATXLAB("

           SET DR="[ATX ADD LAB TAXONOMY]"

           SET DA=ATXX

           DO ^DIE

           KILL DIE,DR,ATXTIME

 +9        IF '$ORDER(^ATXLAB(ATXX,21,0))

               SET ATXSTP=1

               QUIT 

 +10       QUIT 

 +11      ;

EN        ;EP - CALLED FROM OPTION

 +1        IF '$DATA(ATXTXNM)

               WRITE !!,"Error - missing DM AUDIT Lab Taxonomy name!"

               QUIT 

 +2        WRITE !!,"You are creating/editing the ",ATXTXNM," Lab Taxonomy.",!

 +3        IF $DATA(^ATXLAB("B",ATXTXNM))

               WRITE !,"CURRENT DEFINITION: ",!

               SET DA=$ORDER(^ATXLAB("B",ATXTXNM,0))

               SET DIC="^ATXLAB("

               DO EN^DIQ

               KILL DIC,DA,DR

 +4        SET X=ATXTXNM

 +5        DO START

 +6        DO XIT

 +7        QUIT 

XIT       ;

 +1        KILL ATXSTP,ATXTXNM,ATXTXBD

 +2        QUIT 

 +3       ;

 +4       ;