- 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 Apr 23, 2025@18:24:16 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
