ATXTAXF.m

ATXTAXF ; IHS/CMI/LAB - DISPLAY IND LISTS ;

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

 ;; ;

ICD9ADD ;EP

 S ATXFLG=""

 I ATXFILE=80 S ATXGBL="^ICD9("

 I ATXFILE=80.1 S ATXGBL="^ICD0("

 S ATXX=ATXTAXI

 D BUILD,^ATXCODE

 D EDIT

 K ATXFLG,ATXX,ATXL,ATX,ATXTBLE,ATXSYS

 Q

 ;

BUILD ;BUILD ATXTBLE FOR ROUTINE ATXCODE

 NEW X,Y,A,B

 S X="" F  S X=$O(^ATXAX(ATXX,21,"B",X)) Q:X=""  D

 .S Y=0 F  S Y=$O(^ATXAX(ATXX,21,"B",X,Y)) Q:Y=""  D

 ..S A=$P(^ATXAX(ATXX,21,Y,0),U,1),B=$P(^ATXAX(ATXX,21,Y,0),U,2),C=$P(^ATXAX(ATXX,21,Y,0),U,3)

 ..S ATXTBLE(A)=B_U_C

 Q

ENTER ;

 S ATX=0 F  S ATX=$O(ATXTBLE(ATX)) Q:ATX=""  S ATX("X")=$$STRIP^XLFSTR(ATX," ") D CALLDIE I $D(Y) S ATXSTP=1 Q

 I $P(^ATXAX(ATXX,0),U,8),$P(^(0),U,15)=80 D DFNS^ATXAX  ;IF CREATED BY TAXONOMY SYSTEM - EDIT 41 MULTIPLE IN FILE 80

 W !!,"Done!"

 Q

 ;

CALLDIE ;

 S ATXHI=$$STRIP^XLFSTR($P(ATXTBLE(ATX),U,1)," ")

 S ATXSYS=$P(ATXTBLE(ATX),U,2)

 S DIE="^ATXAX(",DR="2101///"_ATX("X")_" ",DA=ATXX,DR(2,9002226.02101)=".02////"_ATXHI_" "_";.03////"_ATXSYS D ^DIE I $D(Y)

 E  I '$D(ZTQUEUED),$D(ATX("NOT TAX")) W "."

 I $D(Y),'$D(ZTQUEUED),$D(ATX("NOT TAX")) W !!,"ERROR ENCOUNTERED - REENTER RANGES",!

 K DIE,DR,DA

 Q

 ;

EDIT ;DELETE CODES IN TAXONOMY FILE, THEN ENTER NEW RANGES

 ;IF CREATED BY TAXONOMY SYSTEM, DELETE ALL FROM ICD9 41 MULTIPLE

 W !,"hold on..."

 I $P(^ATXAX(ATXX,0),U,8),$P(^(0),U,15)=80 D DFNS^ATXDEL  ;delete out of icd9 41 multiple

 S ATX=0 F  S ATX=$O(^ATXAX(ATXX,21,ATX)) Q:ATX'=+ATX  S DA(1)=ATXX,DA=ATX,DIK="^ATXAX("_DA(1)_",21," D ^DIK K DIK,DA

 D ENTER

 Q

 ;

EOJ1 ;

 K ATXHI

 I $D(ZTQUEUED) S ZTREQ="@"

 Q

 ;

ATXTAXF   ; IHS/CMI/LAB - DISPLAY IND LISTS ;

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

 +2       ;; ;

ICD9ADD   ;EP

 +1        SET ATXFLG=""

 +2        IF ATXFILE=80

               SET ATXGBL="^ICD9("

 +3        IF ATXFILE=80.1

               SET ATXGBL="^ICD0("

 +4        SET ATXX=ATXTAXI

 +5        DO BUILD

           DO ^ATXCODE

 +6        DO EDIT

 +7        KILL ATXFLG,ATXX,ATXL,ATX,ATXTBLE,ATXSYS

 +8        QUIT 

 +9       ;

BUILD     ;BUILD ATXTBLE FOR ROUTINE ATXCODE

 +1        NEW X,Y,A,B

 +2        SET X=""

           FOR 

               SET X=$ORDER(^ATXAX(ATXX,21,"B",X))

               IF X=""

                   QUIT 

               Begin DoDot:1

 +3                SET Y=0

                   FOR 

                       SET Y=$ORDER(^ATXAX(ATXX,21,"B",X,Y))

                       IF Y=""

                           QUIT 

                       Begin DoDot:2

 +4                        SET A=$PIECE(^ATXAX(ATXX,21,Y,0),U,1)

                           SET B=$PIECE(^ATXAX(ATXX,21,Y,0),U,2)

                           SET C=$PIECE(^ATXAX(ATXX,21,Y,0),U,3)

 +5                        SET ATXTBLE(A)=B_U_C

                       End DoDot:2

               End DoDot:1

 +6        QUIT 

ENTER     ;

 +1        SET ATX=0

           FOR 

               SET ATX=$ORDER(ATXTBLE(ATX))

               IF ATX=""

                   QUIT 

               SET ATX("X")=$$STRIP^XLFSTR(ATX," ")

               DO CALLDIE

               IF $DATA(Y)

                   SET ATXSTP=1

                   QUIT 

 +2       ;IF CREATED BY TAXONOMY SYSTEM - EDIT 41 MULTIPLE IN FILE 80

           IF $PIECE(^ATXAX(ATXX,0),U,8)

               IF $PIECE(^(0),U,15)=80

                   DO DFNS^ATXAX

 +3        WRITE !!,"Done!"

 +4        QUIT 

 +5       ;

CALLDIE   ;

 +1        SET ATXHI=$$STRIP^XLFSTR($PIECE(ATXTBLE(ATX),U,1)," ")

 +2        SET ATXSYS=$PIECE(ATXTBLE(ATX),U,2)

 +3        SET DIE="^ATXAX("

           SET DR="2101///"_ATX("X")_" "

           SET DA=ATXX

           SET DR(2,9002226.02101)=".02////"_ATXHI_" "_";.03////"_ATXSYS

           DO ^DIE

           IF $DATA(Y)

 +4       IF '$TEST

               IF '$DATA(ZTQUEUED)

                   IF $DATA(ATX("NOT TAX"))

                       WRITE "."

 +5        IF $DATA(Y)

               IF '$DATA(ZTQUEUED)

                   IF $DATA(ATX("NOT TAX"))

                       WRITE !!,"ERROR ENCOUNTERED - REENTER RANGES",!

 +6        KILL DIE,DR,DA

 +7        QUIT 

 +8       ;

EDIT      ;DELETE CODES IN TAXONOMY FILE, THEN ENTER NEW RANGES

 +1       ;IF CREATED BY TAXONOMY SYSTEM, DELETE ALL FROM ICD9 41 MULTIPLE

 +2        WRITE !,"hold on..."

 +3       ;delete out of icd9 41 multiple

           IF $PIECE(^ATXAX(ATXX,0),U,8)

               IF $PIECE(^(0),U,15)=80

                   DO DFNS^ATXDEL

 +4        SET ATX=0

           FOR 

               SET ATX=$ORDER(^ATXAX(ATXX,21,ATX))

               IF ATX'=+ATX

                   QUIT 

               SET DA(1)=ATXX

               SET DA=ATX

               SET DIK="^ATXAX("_DA(1)_",21,"

               DO ^DIK

               KILL DIK,DA

 +5        DO ENTER

 +6        QUIT 

 +7       ;

EOJ1      ;

 +1        KILL ATXHI

 +2        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +3        QUIT 

 +4       ;