LEXXFI6 ;ISL/KER - File Info - DD Information ;04/21/2014
;;2.0;LEXICON UTILITY;**32,80**;Sep 23, 1996;Build 1
;
; Global Variables
; ^TMP("LEXI") Suggest SACC 2.3.2.5.1
;
; External References
; %XY^%RCR ICR 10022
;
Q
DDI(X,LEX) ; Data Dictionary Information
N %X,%Y,LEXFI,LEXFLD,LEXLOC,LEXND,LEXNDD,LEXNM,LEXSF
K ^TMP("LEXI",$J) S LEXFI=+($G(X)) Q:+LEXFI'>0
S %X="^DD("_LEXFI_",",%Y="^TMP(""LEXI"",$J,"_LEXFI_"," D %XY^%RCR
S LEX("DD",LEXFI,0)=$G(^TMP("LEXI",$J,LEXFI,0))
S LEXNM=$O(^TMP("LEXI",$J,LEXFI,0,"NM",""))
S:$L(LEXNM) LEX("DD",LEXFI,0,"NM",LEXNM)=""
S LEXFLD=0 F S LEXFLD=$O(^TMP("LEXI",$J,LEXFI,LEXFLD)) Q:+LEXFLD=0 D
. S LEXLOC=$G(^TMP("LEXI",$J,LEXFI,LEXFLD,0))
. Q:+($P($P(LEXLOC,"^",4),";",2))>0
. S LEX("DD",LEXFI,LEXFLD,0)=$G(^TMP("LEXI",$J,LEXFI,LEXFLD,0))
S LEXND="" F S LEXND=$O(^TMP("LEXI",$J,LEXFI,"GL",LEXND)) Q:LEXND="" D
. S LEXLOC="" F S LEXLOC=$O(^TMP("LEXI",$J,LEXFI,"GL",LEXND,LEXLOC)) Q:LEXLOC="" D
. . Q:+LEXLOC>0 S LEXFLD=0
. . F S LEXFLD=$O(^TMP("LEXI",$J,LEXFI,"GL",LEXND,LEXLOC,LEXFLD)) Q:+LEXFLD=0 D
. . . S LEXNDD=$G(^TMP("LEXI",$J,LEXFI,LEXFLD,0))
. . . S LEXSF=+($P(LEXNDD,"^",2)) Q:+LEXSF=0
. . . S LEX("DD",LEXFI,"GL",LEXND,LEXLOC,LEXFLD)=""
. . . S:+LEXSF>0 LEX("DD",LEXFI,"GL",LEXND,LEXLOC,LEXFLD)=+LEXSF
S LEXSF=0 F S LEXSF=$O(^TMP("LEXI",$J,LEXFI,"SB",LEXSF)) Q:+LEXSF=0 D
. S LEXFLD=0 F S LEXFLD=$O(^TMP("LEXI",$J,LEXFI,"SB",LEXSF,LEXFLD)) Q:+LEXFLD=0 D
. . S LEX("DD",LEXFI,"SB",LEXSF,LEXFLD)=""
I $L($G(^TMP("LEXI",$J,LEXFI,0,"UP"))) D
. S LEX("DD",LEXFI,0,"UP")=$G(^TMP("LEXI",$J,LEXFI,0,"UP"))
K ^TMP("LEXI",$J,LEXFI)
S %X="^DIC("_LEXFI_",",%Y="^TMP(""LEXI"",$J,"_LEXFI_"," D %XY^%RCR
I $D(^TMP("LEXI",$J,LEXFI,0)) D
. S LEX("DIC",LEXFI,0)=$G(^TMP("LEXI",$J,LEXFI,0))
I $D(^TMP("LEXI",$J,LEXFI,0,"GL")) D
. S LEX("DIC",LEXFI,0,"GL")=$G(^TMP("LEXI",$J,LEXFI,0,"GL"))
K ^TMP("LEXI",$J,LEXFI)
S LEXSF=0 F S LEXSF=$O(LEX("DD",LEXFI,"SB",LEXSF)) Q:+LEXSF'>0 D DDI2
I $D(LEX("DD",LEXFI,0,"UP")) D DDI3
Q
DDI2 ; Sub-Files
Q:+($G(LEXSF))'>0 Q:$D(LEX("DD",LEXSF))
N LEXTSF,LEXTFI S LEXTSF=LEXSF,LEXTFI=LEXFI
N LEXFI S LEXFI=+LEXTSF K ^TMP("LEXI",$J,LEXTFI)
D DDI(LEXFI,.LEX)
Q
DDI3 ; Parent Files
Q:'$D(LEX("DD",LEXFI,0,"UP"))
N LEXUP,LEXTFI
S LEXUP=+($G(LEX("DD",LEXFI,0,"UP"))) Q:$D(LEX("DD",LEXUP))
S LEXTFI=LEXFI N LEXFI S LEXFI=+LEXUP
D DDI(LEXFI,.LEX)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXXFI6 2499 printed Dec 13, 2024@02:10:08 Page 2
LEXXFI6 ;ISL/KER - File Info - DD Information ;04/21/2014
+1 ;;2.0;LEXICON UTILITY;**32,80**;Sep 23, 1996;Build 1
+2 ;
+3 ; Global Variables
+4 ; ^TMP("LEXI") Suggest SACC 2.3.2.5.1
+5 ;
+6 ; External References
+7 ; %XY^%RCR ICR 10022
+8 ;
+9 QUIT
DDI(X,LEX) ; Data Dictionary Information
+1 NEW %X,%Y,LEXFI,LEXFLD,LEXLOC,LEXND,LEXNDD,LEXNM,LEXSF
+2 KILL ^TMP("LEXI",$JOB)
SET LEXFI=+($GET(X))
if +LEXFI'>0
QUIT
+3 SET %X="^DD("_LEXFI_","
SET %Y="^TMP(""LEXI"",$J,"_LEXFI_","
DO %XY^%RCR
+4 SET LEX("DD",LEXFI,0)=$GET(^TMP("LEXI",$JOB,LEXFI,0))
+5 SET LEXNM=$ORDER(^TMP("LEXI",$JOB,LEXFI,0,"NM",""))
+6 if $LENGTH(LEXNM)
SET LEX("DD",LEXFI,0,"NM",LEXNM)=""
+7 SET LEXFLD=0
FOR
SET LEXFLD=$ORDER(^TMP("LEXI",$JOB,LEXFI,LEXFLD))
if +LEXFLD=0
QUIT
Begin DoDot:1
+8 SET LEXLOC=$GET(^TMP("LEXI",$JOB,LEXFI,LEXFLD,0))
+9 if +($PIECE($PIECE(LEXLOC,"^",4),";",2))>0
QUIT
+10 SET LEX("DD",LEXFI,LEXFLD,0)=$GET(^TMP("LEXI",$JOB,LEXFI,LEXFLD,0))
End DoDot:1
+11 SET LEXND=""
FOR
SET LEXND=$ORDER(^TMP("LEXI",$JOB,LEXFI,"GL",LEXND))
if LEXND=""
QUIT
Begin DoDot:1
+12 SET LEXLOC=""
FOR
SET LEXLOC=$ORDER(^TMP("LEXI",$JOB,LEXFI,"GL",LEXND,LEXLOC))
if LEXLOC=""
QUIT
Begin DoDot:2
+13 if +LEXLOC>0
QUIT
SET LEXFLD=0
+14 FOR
SET LEXFLD=$ORDER(^TMP("LEXI",$JOB,LEXFI,"GL",LEXND,LEXLOC,LEXFLD))
if +LEXFLD=0
QUIT
Begin DoDot:3
+15 SET LEXNDD=$GET(^TMP("LEXI",$JOB,LEXFI,LEXFLD,0))
+16 SET LEXSF=+($PIECE(LEXNDD,"^",2))
if +LEXSF=0
QUIT
+17 SET LEX("DD",LEXFI,"GL",LEXND,LEXLOC,LEXFLD)=""
+18 if +LEXSF>0
SET LEX("DD",LEXFI,"GL",LEXND,LEXLOC,LEXFLD)=+LEXSF
End DoDot:3
End DoDot:2
End DoDot:1
+19 SET LEXSF=0
FOR
SET LEXSF=$ORDER(^TMP("LEXI",$JOB,LEXFI,"SB",LEXSF))
if +LEXSF=0
QUIT
Begin DoDot:1
+20 SET LEXFLD=0
FOR
SET LEXFLD=$ORDER(^TMP("LEXI",$JOB,LEXFI,"SB",LEXSF,LEXFLD))
if +LEXFLD=0
QUIT
Begin DoDot:2
+21 SET LEX("DD",LEXFI,"SB",LEXSF,LEXFLD)=""
End DoDot:2
End DoDot:1
+22 IF $LENGTH($GET(^TMP("LEXI",$JOB,LEXFI,0,"UP")))
Begin DoDot:1
+23 SET LEX("DD",LEXFI,0,"UP")=$GET(^TMP("LEXI",$JOB,LEXFI,0,"UP"))
End DoDot:1
+24 KILL ^TMP("LEXI",$JOB,LEXFI)
+25 SET %X="^DIC("_LEXFI_","
SET %Y="^TMP(""LEXI"",$J,"_LEXFI_","
DO %XY^%RCR
+26 IF $DATA(^TMP("LEXI",$JOB,LEXFI,0))
Begin DoDot:1
+27 SET LEX("DIC",LEXFI,0)=$GET(^TMP("LEXI",$JOB,LEXFI,0))
End DoDot:1
+28 IF $DATA(^TMP("LEXI",$JOB,LEXFI,0,"GL"))
Begin DoDot:1
+29 SET LEX("DIC",LEXFI,0,"GL")=$GET(^TMP("LEXI",$JOB,LEXFI,0,"GL"))
End DoDot:1
+30 KILL ^TMP("LEXI",$JOB,LEXFI)
+31 SET LEXSF=0
FOR
SET LEXSF=$ORDER(LEX("DD",LEXFI,"SB",LEXSF))
if +LEXSF'>0
QUIT
DO DDI2
+32 IF $DATA(LEX("DD",LEXFI,0,"UP"))
DO DDI3
+33 QUIT
DDI2 ; Sub-Files
+1 if +($GET(LEXSF))'>0
QUIT
if $DATA(LEX("DD",LEXSF))
QUIT
+2 NEW LEXTSF,LEXTFI
SET LEXTSF=LEXSF
SET LEXTFI=LEXFI
+3 NEW LEXFI
SET LEXFI=+LEXTSF
KILL ^TMP("LEXI",$JOB,LEXTFI)
+4 DO DDI(LEXFI,.LEX)
+5 QUIT
DDI3 ; Parent Files
+1 if '$DATA(LEX("DD",LEXFI,0,"UP"))
QUIT
+2 NEW LEXUP,LEXTFI
+3 SET LEXUP=+($GET(LEX("DD",LEXFI,0,"UP")))
if $DATA(LEX("DD",LEXUP))
QUIT
+4 SET LEXTFI=LEXFI
NEW LEXFI
SET LEXFI=+LEXUP
+5 DO DDI(LEXFI,.LEX)
+6 QUIT
