ATXTV1.m

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

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

 ;; ;

EP(ATXTAXI,ATXTYPE) ;EP - CALLED FROM OPTION

 NEW ATXRPTTT,ATXRPTT1,ATXRPTT2

 D EN

 Q

EOJ ;EP

 D EN^XBVK("ATX")

 Q

 ;; ;

EN ;EP -- main entry point for 

 D TERM^VALM0

 D EN^VALM("ATX TAXONOMY VIEW ONE")

 D CLEAR^VALM1

 D FULL^VALM1

 W:$D(IOF) @IOF

 D EOJ

 Q

 ;

HDR ; -- header code

 S VALMHDR(1)="Display of the "_$$NAME(ATXTAXI,ATXTYPE)_" taxonomy"

 S VALMHDR(2)="* View Taxonomies"

 Q

 ;

NAME(I,T) ;

 I T="L" Q $P(^ATXLAB(I,0),U)

 I T'="L" Q $P(^ATXAX(I,0),U)

 Q ""

INIT ; -- init variables and list array

 ;

 S VALMSG="Select the Appropriate Action   Q to Quit"

 I ATXTYPE="L" S ATXFILE=60

 I ATXTYPE'="L" S ATXFILE=$P(^ATXAX(ATXTAXI,0),U,15)

 I ATXTYPE="L" D LAB Q

 I $P(^ATXAX(ATXTAXI,0),U,13) D CANDISP Q

 K ATXITEM S ATXHIGH="",C=0

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

 .S ATXY=$O(^ATXAX(ATXTAXI,21,"B",ATXX,ATXY)) Q:ATXY'=+ATXY  D

 ..S C=C+1

 ..S ATXITMI=$P(^ATXAX(ATXTAXI,21,ATXY,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

CANDISP ;

 K ATXITEM S ATXHIGH="",C=0

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

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

 ..S C=C+1

 ..S ATXITEM(C,0)=C_")  "_$P(^ATXAX(ATXTAXI,21,ATXY,0),U)_" through  "_$P(^ATXAX(ATXTAXI,21,ATXY,0),U,2) I $P(^ATXAX(ATXTAXI,21,ATXY,0),U,3) S $E(ATXITEM(C,0),40)=$P(^ICDS($P(^ATXAX(ATXTAXI,21,ATXY,0),U,3),0),U,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

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

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

 +2       ;; ;

EP(ATXTAXI,ATXTYPE) ;EP - CALLED FROM OPTION

 +1        NEW ATXRPTTT,ATXRPTT1,ATXRPTT2

 +2        DO EN

 +3        QUIT 

EOJ       ;EP

 +1        DO EN^XBVK("ATX")

 +2        QUIT 

 +3       ;; ;

EN        ;EP -- main entry point for 

 +1        DO TERM^VALM0

 +2        DO EN^VALM("ATX TAXONOMY VIEW ONE")

 +3        DO CLEAR^VALM1

 +4        DO FULL^VALM1

 +5        IF $DATA(IOF)

               WRITE @IOF

 +6        DO EOJ

 +7        QUIT 

 +8       ;

HDR       ; -- header code

 +1        SET VALMHDR(1)="Display of the "_$$NAME(ATXTAXI,ATXTYPE)_" taxonomy"

 +2        SET VALMHDR(2)="* View Taxonomies"

 +3        QUIT 

 +4       ;

NAME(I,T) ;

 +1        IF T="L"

               QUIT $PIECE(^ATXLAB(I,0),U)

 +2        IF T'="L"

               QUIT $PIECE(^ATXAX(I,0),U)

 +3        QUIT ""

INIT      ; -- init variables and list array

 +1       ;

 +2        SET VALMSG="Select the Appropriate Action   Q to Quit"

 +3        IF ATXTYPE="L"

               SET ATXFILE=60

 +4        IF ATXTYPE'="L"

               SET ATXFILE=$PIECE(^ATXAX(ATXTAXI,0),U,15)

 +5        IF ATXTYPE="L"

               DO LAB

               QUIT 

 +6        IF $PIECE(^ATXAX(ATXTAXI,0),U,13)

               DO CANDISP

               QUIT 

 +7        KILL ATXITEM

           SET ATXHIGH=""

           SET C=0

 +8        SET ATXX=0

           FOR 

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

               IF ATXX=""

                   QUIT 

               Begin DoDot:1

 +9                SET ATXY=$ORDER(^ATXAX(ATXTAXI,21,"B",ATXX,ATXY))

                   IF ATXY'=+ATXY

                       QUIT 

                   Begin DoDot:2

 +10                   SET C=C+1

 +11                   SET ATXITMI=$PIECE(^ATXAX(ATXTAXI,21,ATXY,0),U)

 +12                   IF ATXFILE=9999999.05

                           SET ATXITEM(C,0)=C_")  "_ATXITMI

                           IF 1

 +13                  IF '$TEST

                           SET ATXITEM(C,0)=C_")  "_$$VAL^XBDIQ1($PIECE(^ATXAX(ATXTAXI,0),U,15),ATXITMI,.01)

 +14                   SET ATXITEM("IDX",C,C)=ATXITMI

                   End DoDot:2

 +15               QUIT 

               End DoDot:1

 +16       SET (VALMCNT,ATXHIGH)=C

 +17       QUIT 

CANDISP   ;

 +1        KILL ATXITEM

           SET ATXHIGH=""

           SET C=0

 +2        SET ATXX=0

           FOR 

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

               IF ATXX=""

                   QUIT 

               Begin DoDot:1

 +3                SET ATXY=0

                   FOR 

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

                       IF ATXY=""

                           QUIT 

                       Begin DoDot:2

 +4                        SET C=C+1

 +5                        SET ATXITEM(C,0)=C_")  "_$PIECE(^ATXAX(ATXTAXI,21,ATXY,0),U)_" through  "_$PIECE(^ATXAX(ATXTAXI,21,ATXY,0),U,2)

                           IF $PIECE(^ATXAX(ATXTAXI,21,ATXY,0),U,3)

                               SET $EXTRACT(ATXITEM(C,0),40)=$PIECE(^ICDS($PIECE(^ATXAX(ATXTAXI,21,ATXY,0),U,3),0),U,1)

 +6                        SET ATXITEM("IDX",C,C)=ATXX

                       End DoDot:2

 +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 

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