LEXXFI3 ;ISL/KER - File Info - Record Count ;04/21/2014
;;2.0;LEXICON UTILITY;**32,80**;Sep 23, 1996;Build 1
;
; Global Variables
; ^TMP("LEXCNT") SACC 2.3.2.5.1
;
; External References
; None
;
Q
ONE(X) ; Record Count for a File
N LEXFI K ^TMP("LEXCNT",$J) S LEXFI=+($G(X)) Q:+X'>0 K LEXMD D CNT(LEXFI),DSP^LEXXFI4
Q
ALL ; Record Count for a File(s)
N LEXCTR,LEXEX,LEXFI,LEXLINE,LEXRTN,LEXTAG K ^TMP("LEXCNT",$J)
S LEXFI="",LEXTAG="FILES",LEXRTN="LEXXFI",LEXCTR=0
F D Q:LEXFI=""
. S LEXCTR=LEXCTR+1,LEXEX="S LEXLINE=$T("_LEXTAG_"+"_LEXCTR_"^"_LEXRTN_")" X LEXEX
. S LEXFI=$P(LEXLINE,";;",3) I '$L(LEXFI) K LEXMD D DSP^LEXXFI4 Q
. Q:'$L(LEXFI) D CNT(LEXFI)
Q
CNT(X) ; Count Entries for file X
N DIC,LEX,LEXCFI,LEXCNT,LEXCRT,LEXEXIT,LEXFF,LEXFI,LEXI,LEXIEN
N LEXIENS,LEXIND,LEXLS,LEXNCT,LEXOF,LEXOND,LEXPCD,LEXPCE,LEXPCI
N LEXPCO,LEXPCT,LEXREC,LEXSL
S LEXFF=$G(X) Q:'$L(LEXFF) Q:+LEXFF'>0
D DDI^LEXXFI6(LEXFF,.LEX) Q:'$D(LEX("DD",+LEXFF))
S LEXFI=$$PAR(+LEXFF) Q:+LEXFI'>0 K LEX
I '$D(LEX("DD",LEXFI)) D DDI^LEXXFI6(LEXFI,.LEX)
Q:'$D(LEX("DD",+LEXFI)) Q:'$D(LEX("DIC",+LEXFI,0,"GL"))
Q:$D(^TMP("LEXCNT",$J,"B",+LEXFI)) S ^TMP("LEXCNT",$J,"B",+LEXFI)=""
S ^TMP("LEXCNT",$J,"CNT")=+($G(^TMP("LEXCNT",$J,"CNT")))+1
S (LEXEXIT,LEXNCT,LEXIENS,LEXREC,LEXPCO)=0,DIC=$G(LEX("DIC",+LEXFI,0,"GL"))
Q:'$L(DIC) S LEXOND=DIC_"0)",LEXCRT=DIC,LEXOF=$P(@LEXOND,"^",4)
S:$E(DIC,$L(DIC))="(" LEXCRT=$E(DIC,1,($L(DIC)-1))
S:$E(DIC,$L(DIC))="," LEXCRT=$E(DIC,1,($L(DIC)-1))_")"
F S LEXOND=$Q(@LEXOND) Q:LEXOND=""!(LEXOND'[DIC) D NODE Q:LEXEXIT
D:+($O(LEXCNT(0)))>0 SAV
S:+LEXIENS>0 ^TMP("LEXCNT",$J,"IENS",+LEXFI)=(LEXIENS+1)
I $D(^TMP("LEXCNT","EXIT")) S LEXEXIT=1 K ^TMP("LEXCNT","EXIT")
Q
NODE ; Count a Node as a Record?
; Do not Count Non-Zero Nodes
Q:$E(LEXOND,($L(LEXOND)-2),$L(LEXOND))'[",0)"
; Do not Count Header Nodes
I DIC'[",",LEXOND[",0)",$L(LEXOND,",")#2>0 Q
I DIC[",",LEXOND[",0)",$L(LEXOND,",")#2'>0 Q
S LEXIND=$P(LEXOND,DIC,2),LEXIEN=$P(LEXIND,",0)",1) S:+LEXIEN=LEXIEN LEXIENS=LEXIENS+1
; Do not Count Cross-References (Exit Loop)
I +($P(LEXIND,",",1))'=$P(LEXIND,",",1) S LEXEXIT=1 Q
; Quit if no Sub-Script List
S LEXSL=$P(LEXIND,")",1) I '$L(LEXSL) S LEXEXIT=1 Q
; Percent Complete
S (LEXPCT,LEXPCE)="",LEXPCI=LEXPCO I LEXIENS>0,LEXOF>0 D
. S LEXPCT=(LEXIENS/LEXOF)*100,LEXPCI=+($P(LEXPCT,".",1)),LEXPCD=+($E($P(LEXPCT,".",2),1,2))
. S:$L(LEXPCD)=1 LEXPCD=LEXPCD_"0" S:$L(LEXPCD)=1 LEXPCD=LEXPCD_"0" S LEXPCE=LEXPCI_"%"
S LEXPCO=LEXPCI
; List Subscripts
S LEXNCT=LEXNCT+1 K LEXLS D LS(LEXSL,LEXFI) Q:'$D(LEXLS)
S LEXCFI=$G(LEXLS("FIL")) Q:+LEXCFI'>0 Q:'$D(LEX("DD",+LEXCFI,0))
S LEXCNT(+LEXCFI)=+($G(LEXCNT(+LEXCFI)))+1,LEXREC=LEXREC+1
I LEXREC#10000'>0 S:$D(^TMP("LEXCNT","EXIT")) LEXEXIT=1
Q
LS(X,Y) ; List Subscripts X = Subscripts Y = File
N LEXFI,LEXFLD,LEXI,LEXND,LEXNDI,LEXSB,LEXSF,LEXSFI,LEXSFN,LEXSL
S LEXSL=X Q:'$L(LEXSL) S LEXFI=+($G(Y)) Q:+LEXFI'>0 Q:'$D(LEX("DIC",+LEXFI,0,"GL"))
K LEXLS S LEXLS("CNT")=1 F LEXI=1:1 Q:'$L($P(LEXSL,",",LEXI)) D
. S LEXSB=$P(LEXSL,",",LEXI) I LEXI#2 D
. . S LEXLS("DA",0)=+($G(LEXLS("DA",0)))+1,LEXLS("DA",+($G(LEXLS("DA",0))))=LEXSB
. . S:+LEXSB'=LEXSB LEXLS("CNT")=0 S:LEXSB="0" LEXLS("CNT")=0
. I '(LEXI#2) D
. . S LEXLS("ND",0)=+($G(LEXLS("ND",0)))+1,LEXLS("ND",+($G(LEXLS("ND",0))))=LEXSB
S LEXSF=LEXFI,LEXSFN=0,LEXNDI=0 F S LEXNDI=$O(LEXLS("ND",LEXNDI)) Q:+LEXNDI=0 D
. S LEXND=$G(LEXLS("ND",LEXNDI)) Q:'$L(LEXND)
. S LEXND=$TR(LEXND,"""","") I '$L(LEXND) S LEXSF="ERR" Q
. I '$O(LEX("DD",+LEXSF,"GL",LEXND,0))>0 S LEXSFN=LEXND
. Q:'$D(LEX("DD",+LEXSF,"GL",LEXND,0))
. S LEXFLD=$O(LEX("DD",+LEXSF,"GL",LEXND,0,0)) I +LEXFLD'>0 S LEXSF="ERR" Q
. S LEXSFI=$G(LEX("DD",+LEXSF,+LEXFLD,0))
. S LEXSFI=+($P(LEXSFI,"^",2)) I +LEXSFI'>0 S LEXSF="ERR" Q
. S:$D(LEX("DD",+LEXSFI,0)) LEXSF=+LEXSFI
S LEXLS("FIL")=LEXSF
S LEXLS("ND")=LEXSFN
K:LEXSF="ERR" LEXLS("FIL")
K:+($G(LEXLS("CNT")))'>0 LEXLS
I $O(LEXLS("ND"," "),-1)>0,$G(LEXLS("ND",$O(LEXLS("ND"," "),-1)))'="0" K LEXLS
Q
SAV ; Save Counts in ^TMP("LEXCNT",$J)
N LEXGRND,LEXID,LEXFI,LEXLVL,LEXNAM,LEXPAR,LECTITL,LEXTOT,LEXTYP
S LEXFI=0 F S LEXFI=$O(LEXCNT(LEXFI)) Q:+LEXFI=0 D
. N LEXNAM,LEXTITL,LEXTOT,LEXTYP
. S LEXNAM=$O(LEX("DD",LEXFI,0,"NM","")) Q:'$L(LEXNAM)
. S LEXPAR=$$PAR(+LEXFI) Q:+LEXPAR=0 Q:'$D(LEX("DIC",+LEXPAR,0,"GL"))
. S LEXTOT=+($G(LEXCNT(LEXFI))),LEXGRND=+($G(LEXGRND))+LEXTOT
. S LEXTYP=$S($D(LEX("DD",+LEXFI))&('$D(LEX("DIC",+LEXFI))):"Sub-File",1:"File")
. S LEXTITL=LEXTYP_" #"_LEXFI,^TMP("LEXCNT",$J,LEXPAR,0)=LEXGRND
. S ^TMP("LEXCNT",$J,LEXPAR,LEXFI)=LEXTOT_"^"_LEXNAM_"^"_LEXTITL
. S LEXID=$$ID(LEXFI),LEXLVL=$$LVL(LEXFI)
. S:$L(LEXID) ^TMP("LEXCNT",$J,"ORDER",+LEXPAR,(LEXID_";"))=LEXPAR_"^"_LEXFI_"^"_LEXLVL
. S:'$D(^TMP("LEXCNT",$J,"LVL")) ^TMP("LEXCNT",$J,"LVL")=1
. S:'$D(^TMP("LEXCNT",$J,"HSF")) ^TMP("LEXCNT",$J,"HSF")=0
. S:'$D(^TMP("LEXCNT",$J,"SUB")) ^TMP("LEXCNT",$J,"SUB")=0
. S:+LEXLVL>+($G(^TMP("LEXCNT",$J,"LVL"))) ^TMP("LEXCNT",$J,"LVL")=+LEXLVL
. S:$L((LEXID_";"),";")>2 ^TMP("LEXCNT",$J,"HSF")=1
. S:$L((LEXID_";"),";")>2 ^TMP("LEXCNT",$J,"SUB")=+($G(^TMP("LEXCNT",$J,"SUB")))+1
. S LEXID=$P(LEXID,";",1) S:$L(LEXID) LEXID=LEXID_";~;"
. S:$L(LEXID) ^TMP("LEXCNT",$J,"ORDER",+LEXPAR,(LEXID_";"))=LEXPAR_"^0^0"
Q
PAR(X) ; Parent File X = File/Sub-File Number
N LEXPAR,LEXSUB S LEXSUB=$G(X) Q:+LEXSUB'>0 ""
I '$D(LEX("DD",+LEXSUB)) D DDI^LEXXFI6(+LEXSUB,.LEX)
Q:'$D(LEX("DD",+LEXSUB,0)) "" I '$D(LEX("DD",+LEXSUB,0,"UP")) S X=LEXSUB Q X
S LEXPAR=LEXSUB F Q:('$D(LEX("DD",+LEXSUB,0,"UP"))) D
. S (LEXSUB,LEXPAR)=$G(LEX("DD",+LEXSUB,0,"UP"))
S X=LEXPAR
Q X
LVL(X) ; Level of File X = File/Sub-File Number
N LEXLVL,LEXPAR,LEXSUB S LEXSUB=$G(X) Q:+LEXSUB'>0 0
I '$D(LEX("DD",+LEXSUB)) D DDI^LEXXFI6(+LEXSUB,.LEX)
Q:'$D(LEX("DD",+LEXSUB,0)) 0 Q:'$D(LEX("DD",+LEXSUB,0,"UP")) 1
S LEXLVL=1,LEXPAR=LEXSUB F Q:('$D(LEX("DD",+LEXSUB,0,"UP"))) D
. S (LEXSUB,LEXPAR)=$G(LEX("DD",+LEXSUB,0,"UP")),LEXLVL=LEXLVL+1
S X=LEXLVL Q X
ID(X) ; Unique Identifier X = File/Sub-File Number
N LEXID,LEXPAR,LEXSUB S LEXID="",LEXSUB=$G(X) Q:+LEXSUB'>0 ""
I '$D(LEX("DD",+LEXSUB)) D DDI^LEXXFI6(+LEXSUB,.LEX)
Q:'$D(LEX("DD",+LEXSUB,0)) "" Q:'$D(LEX("DD",+LEXSUB,0,"UP")) +LEXSUB
S LEXID=+LEXSUB,LEXPAR=LEXSUB F Q:('$D(LEX("DD",+LEXSUB,0,"UP"))) D
. S (LEXSUB,LEXPAR)=$G(LEX("DD",+LEXSUB,0,"UP"))
. S:$L(LEXSUB) LEXID=LEXSUB_";"_LEXID
S X=LEXID
Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLEXXFI3 6629 printed Dec 13, 2024@02:10:05 Page 2
LEXXFI3 ;ISL/KER - File Info - Record Count ;04/21/2014
+1 ;;2.0;LEXICON UTILITY;**32,80**;Sep 23, 1996;Build 1
+2 ;
+3 ; Global Variables
+4 ; ^TMP("LEXCNT") SACC 2.3.2.5.1
+5 ;
+6 ; External References
+7 ; None
+8 ;
+9 QUIT
ONE(X) ; Record Count for a File
+1 NEW LEXFI
KILL ^TMP("LEXCNT",$JOB)
SET LEXFI=+($GET(X))
if +X'>0
QUIT
KILL LEXMD
DO CNT(LEXFI)
DO DSP^LEXXFI4
+2 QUIT
ALL ; Record Count for a File(s)
+1 NEW LEXCTR,LEXEX,LEXFI,LEXLINE,LEXRTN,LEXTAG
KILL ^TMP("LEXCNT",$JOB)
+2 SET LEXFI=""
SET LEXTAG="FILES"
SET LEXRTN="LEXXFI"
SET LEXCTR=0
+3 FOR
Begin DoDot:1
+4 SET LEXCTR=LEXCTR+1
SET LEXEX="S LEXLINE=$T("_LEXTAG_"+"_LEXCTR_"^"_LEXRTN_")"
XECUTE LEXEX
+5 SET LEXFI=$PIECE(LEXLINE,";;",3)
IF '$LENGTH(LEXFI)
KILL LEXMD
DO DSP^LEXXFI4
QUIT
+6 if '$LENGTH(LEXFI)
QUIT
DO CNT(LEXFI)
End DoDot:1
if LEXFI=""
QUIT
+7 QUIT
CNT(X) ; Count Entries for file X
+1 NEW DIC,LEX,LEXCFI,LEXCNT,LEXCRT,LEXEXIT,LEXFF,LEXFI,LEXI,LEXIEN
+2 NEW LEXIENS,LEXIND,LEXLS,LEXNCT,LEXOF,LEXOND,LEXPCD,LEXPCE,LEXPCI
+3 NEW LEXPCO,LEXPCT,LEXREC,LEXSL
+4 SET LEXFF=$GET(X)
if '$LENGTH(LEXFF)
QUIT
if +LEXFF'>0
QUIT
+5 DO DDI^LEXXFI6(LEXFF,.LEX)
if '$DATA(LEX("DD",+LEXFF))
QUIT
+6 SET LEXFI=$$PAR(+LEXFF)
if +LEXFI'>0
QUIT
KILL LEX
+7 IF '$DATA(LEX("DD",LEXFI))
DO DDI^LEXXFI6(LEXFI,.LEX)
+8 if '$DATA(LEX("DD",+LEXFI))
QUIT
if '$DATA(LEX("DIC",+LEXFI,0,"GL"))
QUIT
+9 if $DATA(^TMP("LEXCNT",$JOB,"B",+LEXFI))
QUIT
SET ^TMP("LEXCNT",$JOB,"B",+LEXFI)=""
+10 SET ^TMP("LEXCNT",$JOB,"CNT")=+($GET(^TMP("LEXCNT",$JOB,"CNT")))+1
+11 SET (LEXEXIT,LEXNCT,LEXIENS,LEXREC,LEXPCO)=0
SET DIC=$GET(LEX("DIC",+LEXFI,0,"GL"))
+12 if '$LENGTH(DIC)
QUIT
SET LEXOND=DIC_"0)"
SET LEXCRT=DIC
SET LEXOF=$PIECE(@LEXOND,"^",4)
+13 if $EXTRACT(DIC,$LENGTH(DIC))="("
SET LEXCRT=$EXTRACT(DIC,1,($LENGTH(DIC)-1))
+14 if $EXTRACT(DIC,$LENGTH(DIC))=","
SET LEXCRT=$EXTRACT(DIC,1,($LENGTH(DIC)-1))_")"
+15 FOR
SET LEXOND=$QUERY(@LEXOND)
if LEXOND=""!(LEXOND'[DIC)
QUIT
DO NODE
if LEXEXIT
QUIT
+16 if +($ORDER(LEXCNT(0)))>0
DO SAV
+17 if +LEXIENS>0
SET ^TMP("LEXCNT",$JOB,"IENS",+LEXFI)=(LEXIENS+1)
+18 IF $DATA(^TMP("LEXCNT","EXIT"))
SET LEXEXIT=1
KILL ^TMP("LEXCNT","EXIT")
+19 QUIT
NODE ; Count a Node as a Record?
+1 ; Do not Count Non-Zero Nodes
+2 if $EXTRACT(LEXOND,($LENGTH(LEXOND)-2),$LENGTH(LEXOND))'[",0)"
QUIT
+3 ; Do not Count Header Nodes
+4 IF DIC'[","
IF LEXOND[",0)"
IF $LENGTH(LEXOND,",")#2>0
QUIT
+5 IF DIC[","
IF LEXOND[",0)"
IF $LENGTH(LEXOND,",")#2'>0
QUIT
+6 SET LEXIND=$PIECE(LEXOND,DIC,2)
SET LEXIEN=$PIECE(LEXIND,",0)",1)
if +LEXIEN=LEXIEN
SET LEXIENS=LEXIENS+1
+7 ; Do not Count Cross-References (Exit Loop)
+8 IF +($PIECE(LEXIND,",",1))'=$PIECE(LEXIND,",",1)
SET LEXEXIT=1
QUIT
+9 ; Quit if no Sub-Script List
+10 SET LEXSL=$PIECE(LEXIND,")",1)
IF '$LENGTH(LEXSL)
SET LEXEXIT=1
QUIT
+11 ; Percent Complete
+12 SET (LEXPCT,LEXPCE)=""
SET LEXPCI=LEXPCO
IF LEXIENS>0
IF LEXOF>0
Begin DoDot:1
+13 SET LEXPCT=(LEXIENS/LEXOF)*100
SET LEXPCI=+($PIECE(LEXPCT,".",1))
SET LEXPCD=+($EXTRACT($PIECE(LEXPCT,".",2),1,2))
+14 if $LENGTH(LEXPCD)=1
SET LEXPCD=LEXPCD_"0"
if $LENGTH(LEXPCD)=1
SET LEXPCD=LEXPCD_"0"
SET LEXPCE=LEXPCI_"%"
End DoDot:1
+15 SET LEXPCO=LEXPCI
+16 ; List Subscripts
+17 SET LEXNCT=LEXNCT+1
KILL LEXLS
DO LS(LEXSL,LEXFI)
if '$DATA(LEXLS)
QUIT
+18 SET LEXCFI=$GET(LEXLS("FIL"))
if +LEXCFI'>0
QUIT
if '$DATA(LEX("DD",+LEXCFI,0))
QUIT
+19 SET LEXCNT(+LEXCFI)=+($GET(LEXCNT(+LEXCFI)))+1
SET LEXREC=LEXREC+1
+20 IF LEXREC#10000'>0
if $DATA(^TMP("LEXCNT","EXIT"))
SET LEXEXIT=1
+21 QUIT
LS(X,Y) ; List Subscripts X = Subscripts Y = File
+1 NEW LEXFI,LEXFLD,LEXI,LEXND,LEXNDI,LEXSB,LEXSF,LEXSFI,LEXSFN,LEXSL
+2 SET LEXSL=X
if '$LENGTH(LEXSL)
QUIT
SET LEXFI=+($GET(Y))
if +LEXFI'>0
QUIT
if '$DATA(LEX("DIC",+LEXFI,0,"GL"))
QUIT
+3 KILL LEXLS
SET LEXLS("CNT")=1
FOR LEXI=1:1
if '$LENGTH($PIECE(LEXSL,",",LEXI))
QUIT
Begin DoDot:1
+4 SET LEXSB=$PIECE(LEXSL,",",LEXI)
IF LEXI#2
Begin DoDot:2
+5 SET LEXLS("DA",0)=+($GET(LEXLS("DA",0)))+1
SET LEXLS("DA",+($GET(LEXLS("DA",0))))=LEXSB
+6 if +LEXSB'=LEXSB
SET LEXLS("CNT")=0
if LEXSB="0"
SET LEXLS("CNT")=0
End DoDot:2
+7 IF '(LEXI#2)
Begin DoDot:2
+8 SET LEXLS("ND",0)=+($GET(LEXLS("ND",0)))+1
SET LEXLS("ND",+($GET(LEXLS("ND",0))))=LEXSB
End DoDot:2
End DoDot:1
+9 SET LEXSF=LEXFI
SET LEXSFN=0
SET LEXNDI=0
FOR
SET LEXNDI=$ORDER(LEXLS("ND",LEXNDI))
if +LEXNDI=0
QUIT
Begin DoDot:1
+10 SET LEXND=$GET(LEXLS("ND",LEXNDI))
if '$LENGTH(LEXND)
QUIT
+11 SET LEXND=$TRANSLATE(LEXND,"""","")
IF '$LENGTH(LEXND)
SET LEXSF="ERR"
QUIT
+12 IF '$ORDER(LEX("DD",+LEXSF,"GL",LEXND,0))>0
SET LEXSFN=LEXND
+13 if '$DATA(LEX("DD",+LEXSF,"GL",LEXND,0))
QUIT
+14 SET LEXFLD=$ORDER(LEX("DD",+LEXSF,"GL",LEXND,0,0))
IF +LEXFLD'>0
SET LEXSF="ERR"
QUIT
+15 SET LEXSFI=$GET(LEX("DD",+LEXSF,+LEXFLD,0))
+16 SET LEXSFI=+($PIECE(LEXSFI,"^",2))
IF +LEXSFI'>0
SET LEXSF="ERR"
QUIT
+17 if $DATA(LEX("DD",+LEXSFI,0))
SET LEXSF=+LEXSFI
End DoDot:1
+18 SET LEXLS("FIL")=LEXSF
+19 SET LEXLS("ND")=LEXSFN
+20 if LEXSF="ERR"
KILL LEXLS("FIL")
+21 if +($GET(LEXLS("CNT")))'>0
KILL LEXLS
+22 IF $ORDER(LEXLS("ND"," "),-1)>0
IF $GET(LEXLS("ND",$ORDER(LEXLS("ND"," "),-1)))'="0"
KILL LEXLS
+23 QUIT
SAV ; Save Counts in ^TMP("LEXCNT",$J)
+1 NEW LEXGRND,LEXID,LEXFI,LEXLVL,LEXNAM,LEXPAR,LECTITL,LEXTOT,LEXTYP
+2 SET LEXFI=0
FOR
SET LEXFI=$ORDER(LEXCNT(LEXFI))
if +LEXFI=0
QUIT
Begin DoDot:1
+3 NEW LEXNAM,LEXTITL,LEXTOT,LEXTYP
+4 SET LEXNAM=$ORDER(LEX("DD",LEXFI,0,"NM",""))
if '$LENGTH(LEXNAM)
QUIT
+5 SET LEXPAR=$$PAR(+LEXFI)
if +LEXPAR=0
QUIT
if '$DATA(LEX("DIC",+LEXPAR,0,"GL"))
QUIT
+6 SET LEXTOT=+($GET(LEXCNT(LEXFI)))
SET LEXGRND=+($GET(LEXGRND))+LEXTOT
+7 SET LEXTYP=$SELECT($DATA(LEX("DD",+LEXFI))&('$DATA(LEX("DIC",+LEXFI))):"Sub-File",1:"File")
+8 SET LEXTITL=LEXTYP_" #"_LEXFI
SET ^TMP("LEXCNT",$JOB,LEXPAR,0)=LEXGRND
+9 SET ^TMP("LEXCNT",$JOB,LEXPAR,LEXFI)=LEXTOT_"^"_LEXNAM_"^"_LEXTITL
+10 SET LEXID=$$ID(LEXFI)
SET LEXLVL=$$LVL(LEXFI)
+11 if $LENGTH(LEXID)
SET ^TMP("LEXCNT",$JOB,"ORDER",+LEXPAR,(LEXID_";"))=LEXPAR_"^"_LEXFI_"^"_LEXLVL
+12 if '$DATA(^TMP("LEXCNT",$JOB,"LVL"))
SET ^TMP("LEXCNT",$JOB,"LVL")=1
+13 if '$DATA(^TMP("LEXCNT",$JOB,"HSF"))
SET ^TMP("LEXCNT",$JOB,"HSF")=0
+14 if '$DATA(^TMP("LEXCNT",$JOB,"SUB"))
SET ^TMP("LEXCNT",$JOB,"SUB")=0
+15 if +LEXLVL>+($GET(^TMP("LEXCNT",$JOB,"LVL")))
SET ^TMP("LEXCNT",$JOB,"LVL")=+LEXLVL
+16 if $LENGTH((LEXID_";"),";")>2
SET ^TMP("LEXCNT",$JOB,"HSF")=1
+17 if $LENGTH((LEXID_";"),";")>2
SET ^TMP("LEXCNT",$JOB,"SUB")=+($GET(^TMP("LEXCNT",$JOB,"SUB")))+1
+18 SET LEXID=$PIECE(LEXID,";",1)
if $LENGTH(LEXID)
SET LEXID=LEXID_";~;"
+19 if $LENGTH(LEXID)
SET ^TMP("LEXCNT",$JOB,"ORDER",+LEXPAR,(LEXID_";"))=LEXPAR_"^0^0"
End DoDot:1
+20 QUIT
PAR(X) ; Parent File X = File/Sub-File Number
+1 NEW LEXPAR,LEXSUB
SET LEXSUB=$GET(X)
if +LEXSUB'>0
QUIT ""
+2 IF '$DATA(LEX("DD",+LEXSUB))
DO DDI^LEXXFI6(+LEXSUB,.LEX)
+3 if '$DATA(LEX("DD",+LEXSUB,0))
QUIT ""
IF '$DATA(LEX("DD",+LEXSUB,0,"UP"))
SET X=LEXSUB
QUIT X
+4 SET LEXPAR=LEXSUB
FOR
if ('$DATA(LEX("DD",+LEXSUB,0,"UP")))
QUIT
Begin DoDot:1
+5 SET (LEXSUB,LEXPAR)=$GET(LEX("DD",+LEXSUB,0,"UP"))
End DoDot:1
+6 SET X=LEXPAR
+7 QUIT X
LVL(X) ; Level of File X = File/Sub-File Number
+1 NEW LEXLVL,LEXPAR,LEXSUB
SET LEXSUB=$GET(X)
if +LEXSUB'>0
QUIT 0
+2 IF '$DATA(LEX("DD",+LEXSUB))
DO DDI^LEXXFI6(+LEXSUB,.LEX)
+3 if '$DATA(LEX("DD",+LEXSUB,0))
QUIT 0
if '$DATA(LEX("DD",+LEXSUB,0,"UP"))
QUIT 1
+4 SET LEXLVL=1
SET LEXPAR=LEXSUB
FOR
if ('$DATA(LEX("DD",+LEXSUB,0,"UP")))
QUIT
Begin DoDot:1
+5 SET (LEXSUB,LEXPAR)=$GET(LEX("DD",+LEXSUB,0,"UP"))
SET LEXLVL=LEXLVL+1
End DoDot:1
+6 SET X=LEXLVL
QUIT X
ID(X) ; Unique Identifier X = File/Sub-File Number
+1 NEW LEXID,LEXPAR,LEXSUB
SET LEXID=""
SET LEXSUB=$GET(X)
if +LEXSUB'>0
QUIT ""
+2 IF '$DATA(LEX("DD",+LEXSUB))
DO DDI^LEXXFI6(+LEXSUB,.LEX)
+3 if '$DATA(LEX("DD",+LEXSUB,0))
QUIT ""
if '$DATA(LEX("DD",+LEXSUB,0,"UP"))
QUIT +LEXSUB
+4 SET LEXID=+LEXSUB
SET LEXPAR=LEXSUB
FOR
if ('$DATA(LEX("DD",+LEXSUB,0,"UP")))
QUIT
Begin DoDot:1
+5 SET (LEXSUB,LEXPAR)=$GET(LEX("DD",+LEXSUB,0,"UP"))
+6 if $LENGTH(LEXSUB)
SET LEXID=LEXSUB_";"_LEXID
End DoDot:1
+7 SET X=LEXID
+8 QUIT X
