ATXTAXG ; IHS/CMI/LAB - DISPLAY TAX ;
;;5.1;TAXONOMY;**11**;FEB 04, 1997;Build 48
;; ;
EP ;EP - CALLED FROM OPTION
D EOJ ;START CLEAN
D EN
Q
EOJ ;EP
D EN^XBVK("ATX")
Q
;; ;
EN ;EP -- main entry point for
D EN^VALM("ATX TAXONOMY GENERIC SETUP")
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)="ADD OR EDIT TAXONOMIES"
S VALMHDR(2)="TAXONOMY TYPE",$E(VALMHDR(2),38)="FILE NAME",$E(VALMHDR(2),70)="FILE"
Q
;
INIT ; -- init variables and list array
K ATXTAX S ATXHIGH="",C=0
S J=0 F S J=$O(^ATXTYPE(J)) Q:J'=+J D
.S C=C+1
.S F=$P(^ATXTYPE(J,0),U,2)
.Q:F=""
.Q:'$D(^DIC(F))
.S ATXTAX(C,0)=C_") "_$P(^ATXTYPE(J,0),U),$E(ATXTAX(C,0),38)=$E($P(^DIC(F,0),U),1,30)
.S $E(ATXTAX(J,0),70)=F
.S ATXTAX("IDX",C,C)=J_U_F
.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
;
SEL ;EP - add an item to the selected list - called from a protocol
D FULL^VALM1
W !
S DIR(0)="NO^1:"_ATXHIGH,DIR("A")="Which Taxonomy Type"
D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I Y="" W !,"No taxonomy type selected." G ADDX
I $D(DIRUT) W !,"No taxonomy type selected." G ADDX
S ATXTAXT=$P(ATXTAX("IDX",Y,Y),U,1),ATXTAXF=$P(ATXTAX("IDX",Y,Y),U,2)
D FULL^VALM1 W:$D(IOF) @IOF
S ATXFILE=ATXTAXF
D EP^ATXTAXT
ADDX ;
D BACK
Q
ATXTAXG ; IHS/CMI/LAB - DISPLAY TAX ;
+1 ;;5.1;TAXONOMY;**11**;FEB 04, 1997;Build 48
+2 ;; ;
EP ;EP - CALLED FROM OPTION
+1 ;START CLEAN
DO EOJ
+2 DO EN
+3 QUIT
EOJ ;EP
+1 DO EN^XBVK("ATX")
+2 QUIT
+3 ;; ;
EN ;EP -- main entry point for
+1 DO EN^VALM("ATX TAXONOMY GENERIC SETUP")
+2 DO CLEAR^VALM1
+3 DO FULL^VALM1
+4 IF $DATA(IOF)
WRITE @IOF
+5 DO EOJ
+6 QUIT
+7 ;
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)="ADD OR EDIT TAXONOMIES"
+2 SET VALMHDR(2)="TAXONOMY TYPE"
SET $EXTRACT(VALMHDR(2),38)="FILE NAME"
SET $EXTRACT(VALMHDR(2),70)="FILE"
+3 QUIT
+4 ;
INIT ; -- init variables and list array
+1 KILL ATXTAX
SET ATXHIGH=""
SET C=0
+2 SET J=0
FOR
SET J=$ORDER(^ATXTYPE(J))
IF J'=+J
QUIT
Begin DoDot:1
+3 SET C=C+1
+4 SET F=$PIECE(^ATXTYPE(J,0),U,2)
+5 IF F=""
QUIT
+6 IF '$DATA(^DIC(F))
QUIT
+7 SET ATXTAX(C,0)=C_") "_$PIECE(^ATXTYPE(J,0),U)
SET $EXTRACT(ATXTAX(C,0),38)=$EXTRACT($PIECE(^DIC(F,0),U),1,30)
+8 SET $EXTRACT(ATXTAX(J,0),70)=F
+9 SET ATXTAX("IDX",C,C)=J_U_F
+10 QUIT
End DoDot:1
+11 SET (VALMCNT,ATXHIGH)=C
+12 QUIT
+13 ;
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 ;
SEL ;EP - add an item to the selected list - called from a protocol
+1 DO FULL^VALM1
+2 WRITE !
+3 SET DIR(0)="NO^1:"_ATXHIGH
SET DIR("A")="Which Taxonomy Type"
+4 DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+5 IF Y=""
WRITE !,"No taxonomy type selected."
GOTO ADDX
+6 IF $DATA(DIRUT)
WRITE !,"No taxonomy type selected."
GOTO ADDX
+7 SET ATXTAXT=$PIECE(ATXTAX("IDX",Y,Y),U,1)
SET ATXTAXF=$PIECE(ATXTAX("IDX",Y,Y),U,2)
+8 DO FULL^VALM1
IF $DATA(IOF)
WRITE @IOF
+9 SET ATXFILE=ATXTAXF
+10 DO EP^ATXTAXT
ADDX ;
+1 DO BACK
+2 QUIT
