- 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 Mar 13, 2025@21:14:38 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
