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
