- 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 Feb 19, 2025@00:08:23 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 ;
