DDEX ;SLC/MKB - Entity DD utilities ;AUG 1, 2018 12:37
;;22.2;VA FileMan;**9,21**;Jan 05, 2016;Build 4
;;Per VA Directive 6402, this routine should not be modified.
Q
;
TREE ;Look back up tree to make sure item is not ancestor (input xform)
;From: 1.51,.08 Entry: DA(1),X
N DDEDA,DDED
S DDEDA=DA(1) K:X=DDEDA X
D TREE1
Q
TREE1 F DDED=0:0 Q:'$D(X) S DDED=$O(^DDE("AD",DDEDA,DDED)) Q:DDED'>0 K:DDED=X X Q:'$D(X) D TREE2
Q
TREE2 N DDEDA S DDEDA=DDED N DDED D TREE1
Q
;
FLDLST ; -- ??help for FIELD# [DDEFN set in ScreenMan form]
N FN,DIC,DO,X
S FN=$G(DDEFN) S:'FN FN=$P($G(^DDE(DA(1),1,DA,0)),U,4) Q:'FN
S DIC="^DD("_FN_",",DIC(0)="EQ",X="??" D ^DIC
Q
;
CHKNAME ;Input transform for .01 field in ENTITY file (#1.5) ;p21
I $D(DIC(0))#2,DIC(0)'["E" Q
I $D(^DDE("B",X)) D EN^DDIOL(" Duplicate names are not allowed.") K X Q
N %,%1 S %1=""
D NAME I %1="" D EN^DDIOL("Not a known package or a local namespace.") Q
D EN^DDIOL(" Located in the "_$E(X,1,%)_" ("_%1_") namespace.") Q
Q
;
NAME ;check name X as PREFIX (#1) in PACKAGE file (#9.4)
I $E(X,1)="Z" S %=1,%1="Local" Q
F %=4:-1:2 G:$D(^DIC(9.4,"C",$E(X,1,%))) NAMEOK
I $E(X,1)="A" S %=1,%1="Local" Q
Q
;
NAMEOK S %1=$O(^DIC(9.4,"C",$E(X,1,%),0)) I %1,$G(^DIC(9.4,%1,0))]"" S %1=$P(^(0),U,1) Q
S %1="" Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDDEX 1328 printed Dec 13, 2024@02:42:08 Page 2
DDEX ;SLC/MKB - Entity DD utilities ;AUG 1, 2018 12:37
+1 ;;22.2;VA FileMan;**9,21**;Jan 05, 2016;Build 4
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
TREE ;Look back up tree to make sure item is not ancestor (input xform)
+1 ;From: 1.51,.08 Entry: DA(1),X
+2 NEW DDEDA,DDED
+3 SET DDEDA=DA(1)
if X=DDEDA
KILL X
+4 DO TREE1
+5 QUIT
TREE1 FOR DDED=0:0
if '$DATA(X)
QUIT
SET DDED=$ORDER(^DDE("AD",DDEDA,DDED))
if DDED'>0
QUIT
if DDED=X
KILL X
if '$DATA(X)
QUIT
DO TREE2
+1 QUIT
TREE2 NEW DDEDA
SET DDEDA=DDED
NEW DDED
DO TREE1
+1 QUIT
+2 ;
FLDLST ; -- ??help for FIELD# [DDEFN set in ScreenMan form]
+1 NEW FN,DIC,DO,X
+2 SET FN=$GET(DDEFN)
if 'FN
SET FN=$PIECE($GET(^DDE(DA(1),1,DA,0)),U,4)
if 'FN
QUIT
+3 SET DIC="^DD("_FN_","
SET DIC(0)="EQ"
SET X="??"
DO ^DIC
+4 QUIT
+5 ;
CHKNAME ;Input transform for .01 field in ENTITY file (#1.5) ;p21
+1 IF $DATA(DIC(0))#2
IF DIC(0)'["E"
QUIT
+2 IF $DATA(^DDE("B",X))
DO EN^DDIOL(" Duplicate names are not allowed.")
KILL X
QUIT
+3 NEW %,%1
SET %1=""
+4 DO NAME
IF %1=""
DO EN^DDIOL("Not a known package or a local namespace.")
QUIT
+5 DO EN^DDIOL(" Located in the "_$EXTRACT(X,1,%)_" ("_%1_") namespace.")
QUIT
+6 QUIT
+7 ;
NAME ;check name X as PREFIX (#1) in PACKAGE file (#9.4)
+1 IF $EXTRACT(X,1)="Z"
SET %=1
SET %1="Local"
QUIT
+2 FOR %=4:-1:2
if $DATA(^DIC(9.4,"C",$EXTRACT(X,1,%)))
GOTO NAMEOK
+3 IF $EXTRACT(X,1)="A"
SET %=1
SET %1="Local"
QUIT
+4 QUIT
+5 ;
NAMEOK SET %1=$ORDER(^DIC(9.4,"C",$EXTRACT(X,1,%),0))
IF %1
IF $GET(^DIC(9.4,%1,0))]""
SET %1=$PIECE(^(0),U,1)
QUIT
+1 SET %1=""
QUIT
+2 ;
