source: WorldVistAEHR/trunk/r/LEXICON_UTILITY-LEX-GMPT/LEXXFI3.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 6.4 KB
RevLine 
[613]1LEXXFI3 ; ISL/KER - File Info - Record Count ; 07/28/2004
2 ;;2.0;LEXICON UTILITY;**32**;Sep 23, 1996;Build 1
3 Q
4 ;
5 ; Global Variables
6 ; ^TMP("LEXCNT",$J SACC 2.3.2.5.1
7 ;
8 ; External References
9 ; None
10 ;
11ONE(X) ; Record Count for a File
12 N LEXFI K ^TMP("LEXCNT",$J) S LEXFI=+($G(X)) Q:+X'>0 K LEXMD D CNT(LEXFI),DSP^LEXXFI4
13 Q
14ALL ; Record Count for a File(s)
15 N LEXCTR,LEXEX,LEXFI,LEXLINE,LEXRTN,LEXTAG K ^TMP("LEXCNT",$J)
16 S LEXFI="",LEXTAG="FILES",LEXRTN="LEXXFI",LEXCTR=0
17 F D Q:LEXFI=""
18 . S LEXCTR=LEXCTR+1,LEXEX="S LEXLINE=$T("_LEXTAG_"+"_LEXCTR_"^"_LEXRTN_")" X LEXEX
19 . S LEXFI=$P(LEXLINE,";;",3) I '$L(LEXFI) K LEXMD D DSP^LEXXFI4 Q
20 . Q:'$L(LEXFI) D CNT(LEXFI)
21 Q
22CNT(X) ; Count Entries for file X
23 N DIC,LEX,LEXCFI,LEXCNT,LEXCRT,LEXEXIT,LEXFF,LEXFI,LEXI,LEXIEN
24 N LEXIENS,LEXIND,LEXLS,LEXNCT,LEXOF,LEXOND,LEXPCD,LEXPCE,LEXPCI
25 N LEXPCO,LEXPCT,LEXREC,LEXSL
26 S LEXFF=$G(X) Q:'$L(LEXFF) Q:+LEXFF'>0
27 D DDI^LEXXFI6(LEXFF,.LEX) Q:'$D(LEX("DD",+LEXFF))
28 S LEXFI=$$PAR(+LEXFF) Q:+LEXFI'>0 K LEX
29 I '$D(LEX("DD",LEXFI)) D DDI^LEXXFI6(LEXFI,.LEX)
30 Q:'$D(LEX("DD",+LEXFI)) Q:'$D(LEX("DIC",+LEXFI,0,"GL"))
31 Q:$D(^TMP("LEXCNT",$J,"B",+LEXFI)) S ^TMP("LEXCNT",$J,"B",+LEXFI)=""
32 S ^TMP("LEXCNT",$J,"CNT")=+($G(^TMP("LEXCNT",$J,"CNT")))+1
33 S (LEXEXIT,LEXNCT,LEXIENS,LEXREC,LEXPCO)=0,DIC=$G(LEX("DIC",+LEXFI,0,"GL"))
34 Q:'$L(DIC) S LEXOND=DIC_"0)",LEXCRT=DIC,LEXOF=$P(@LEXOND,"^",4)
35 S:$E(DIC,$L(DIC))="(" LEXCRT=$E(DIC,1,($L(DIC)-1))
36 S:$E(DIC,$L(DIC))="," LEXCRT=$E(DIC,1,($L(DIC)-1))_")"
37 F S LEXOND=$Q(@LEXOND) Q:LEXOND=""!(LEXOND'[DIC) D NODE Q:LEXEXIT
38 D:+($O(LEXCNT(0)))>0 SAV
39 S:+LEXIENS>0 ^TMP("LEXCNT",$J,"IENS",+LEXFI)=(LEXIENS+1)
40 I $D(^TMP("LEXCNT","EXIT")) S LEXEXIT=1 K ^TMP("LEXCNT","EXIT")
41 Q
42NODE ; Count a Node as a Record?
43 ; Do not Count Non-Zero Nodes
44 Q:$E(LEXOND,($L(LEXOND)-2),$L(LEXOND))'[",0)"
45 ; Do not Count Header Nodes
46 I DIC'[",",LEXOND[",0)",$L(LEXOND,",")#2>0 Q
47 I DIC[",",LEXOND[",0)",$L(LEXOND,",")#2'>0 Q
48 S LEXIND=$P(LEXOND,DIC,2),LEXIEN=$P(LEXIND,",0)",1) S:+LEXIEN=LEXIEN LEXIENS=LEXIENS+1
49 ; Do not Count Cross-References (Exit Loop)
50 I +($P(LEXIND,",",1))'=$P(LEXIND,",",1) S LEXEXIT=1 Q
51 ; Quit if no Sub-Script List
52 S LEXSL=$P(LEXIND,")",1) I '$L(LEXSL) S LEXEXIT=1 Q
53 ; Percent Complete
54 S (LEXPCT,LEXPCE)="",LEXPCI=LEXPCO I LEXIENS>0,LEXOF>0 D
55 . S LEXPCT=(LEXIENS/LEXOF)*100,LEXPCI=+($P(LEXPCT,".",1)),LEXPCD=+($E($P(LEXPCT,".",2),1,2))
56 . S:$L(LEXPCD)=1 LEXPCD=LEXPCD_"0" S:$L(LEXPCD)=1 LEXPCD=LEXPCD_"0" S LEXPCE=LEXPCI_"%"
57 S LEXPCO=LEXPCI
58 ; List Subscripts
59 S LEXNCT=LEXNCT+1 K LEXLS D LS(LEXSL,LEXFI) Q:'$D(LEXLS)
60 S LEXCFI=$G(LEXLS("FIL")) Q:+LEXCFI'>0 Q:'$D(LEX("DD",+LEXCFI,0))
61 S LEXCNT(+LEXCFI)=+($G(LEXCNT(+LEXCFI)))+1,LEXREC=LEXREC+1
62 I LEXREC#10000'>0 S:$D(^TMP("LEXCNT","EXIT")) LEXEXIT=1
63 Q
64LS(X,Y) ; List Subscripts X = Subscripts Y = File
65 N LEXFI,LEXFLD,LEXI,LEXND,LEXNDI,LEXSB,LEXSF,LEXSFI,LEXSFN,LEXSL
66 S LEXSL=X Q:'$L(LEXSL) S LEXFI=+($G(Y)) Q:+LEXFI'>0 Q:'$D(LEX("DIC",+LEXFI,0,"GL"))
67 K LEXLS S LEXLS("CNT")=1 F LEXI=1:1 Q:'$L($P(LEXSL,",",LEXI)) D
68 . S LEXSB=$P(LEXSL,",",LEXI) I LEXI#2 D
69 . . S LEXLS("DA",0)=+($G(LEXLS("DA",0)))+1,LEXLS("DA",+($G(LEXLS("DA",0))))=LEXSB
70 . . S:+LEXSB'=LEXSB LEXLS("CNT")=0 S:LEXSB="0" LEXLS("CNT")=0
71 . I '(LEXI#2) D
72 . . S LEXLS("ND",0)=+($G(LEXLS("ND",0)))+1,LEXLS("ND",+($G(LEXLS("ND",0))))=LEXSB
73 S LEXSF=LEXFI,LEXSFN=0,LEXNDI=0 F S LEXNDI=$O(LEXLS("ND",LEXNDI)) Q:+LEXNDI=0 D
74 . S LEXND=$G(LEXLS("ND",LEXNDI)) Q:'$L(LEXND)
75 . S LEXND=$TR(LEXND,"""","") I '$L(LEXND) S LEXSF="ERR" Q
76 . I '$O(LEX("DD",+LEXSF,"GL",LEXND,0))>0 S LEXSFN=LEXND
77 . Q:'$D(LEX("DD",+LEXSF,"GL",LEXND,0))
78 . S LEXFLD=$O(LEX("DD",+LEXSF,"GL",LEXND,0,0)) I +LEXFLD'>0 S LEXSF="ERR" Q
79 . S LEXSFI=$G(LEX("DD",+LEXSF,+LEXFLD,0))
80 . S LEXSFI=+($P(LEXSFI,"^",2)) I +LEXSFI'>0 S LEXSF="ERR" Q
81 . S:$D(LEX("DD",+LEXSFI,0)) LEXSF=+LEXSFI
82 S LEXLS("FIL")=LEXSF
83 S LEXLS("ND")=LEXSFN
84 K:LEXSF="ERR" LEXLS("FIL")
85 K:+($G(LEXLS("CNT")))'>0 LEXLS
86 I $O(LEXLS("ND"," "),-1)>0,$G(LEXLS("ND",$O(LEXLS("ND"," "),-1)))'="0" K LEXLS
87 Q
88SAV ; Save Counts in ^TMP("LEXCNT",$J)
89 N LEXGRND,LEXID,LEXFI,LEXLVL,LEXNAM,LEXPAR,LECTITL,LEXTOT,LEXTYP
90 S LEXFI=0 F S LEXFI=$O(LEXCNT(LEXFI)) Q:+LEXFI=0 D
91 . N LEXNAM,LEXTITL,LEXTOT,LEXTYP
92 . S LEXNAM=$O(LEX("DD",LEXFI,0,"NM","")) Q:'$L(LEXNAM)
93 . S LEXPAR=$$PAR(+LEXFI) Q:+LEXPAR=0 Q:'$D(LEX("DIC",+LEXPAR,0,"GL"))
94 . S LEXTOT=+($G(LEXCNT(LEXFI))),LEXGRND=+($G(LEXGRND))+LEXTOT
95 . S LEXTYP=$S($D(LEX("DD",+LEXFI))&('$D(LEX("DIC",+LEXFI))):"Sub-File",1:"File")
96 . S LEXTITL=LEXTYP_" #"_LEXFI,^TMP("LEXCNT",$J,LEXPAR,0)=LEXGRND
97 . S ^TMP("LEXCNT",$J,LEXPAR,LEXFI)=LEXTOT_"^"_LEXNAM_"^"_LEXTITL
98 . S LEXID=$$ID(LEXFI),LEXLVL=$$LVL(LEXFI)
99 . S:$L(LEXID) ^TMP("LEXCNT",$J,"ORDER",+LEXPAR,(LEXID_";"))=LEXPAR_"^"_LEXFI_"^"_LEXLVL
100 . S:'$D(^TMP("LEXCNT",$J,"LVL")) ^TMP("LEXCNT",$J,"LVL")=1
101 . S:'$D(^TMP("LEXCNT",$J,"HSF")) ^TMP("LEXCNT",$J,"HSF")=0
102 . S:'$D(^TMP("LEXCNT",$J,"SUB")) ^TMP("LEXCNT",$J,"SUB")=0
103 . S:+LEXLVL>+($G(^TMP("LEXCNT",$J,"LVL"))) ^TMP("LEXCNT",$J,"LVL")=+LEXLVL
104 . S:$L((LEXID_";"),";")>2 ^TMP("LEXCNT",$J,"HSF")=1
105 . S:$L((LEXID_";"),";")>2 ^TMP("LEXCNT",$J,"SUB")=+($G(^TMP("LEXCNT",$J,"SUB")))+1
106 . S LEXID=$P(LEXID,";",1) S:$L(LEXID) LEXID=LEXID_";~;"
107 . S:$L(LEXID) ^TMP("LEXCNT",$J,"ORDER",+LEXPAR,(LEXID_";"))=LEXPAR_"^0^0"
108 Q
109PAR(X) ; Parent File X = File/Sub-File Number
110 N LEXPAR,LEXSUB S LEXSUB=$G(X) Q:+LEXSUB'>0 ""
111 I '$D(LEX("DD",+LEXSUB)) D DDI^LEXXFI6(+LEXSUB,.LEX)
112 Q:'$D(LEX("DD",+LEXSUB,0)) "" I '$D(LEX("DD",+LEXSUB,0,"UP")) S X=LEXSUB Q X
113 S LEXPAR=LEXSUB F Q:('$D(LEX("DD",+LEXSUB,0,"UP"))) D
114 . S (LEXSUB,LEXPAR)=$G(LEX("DD",+LEXSUB,0,"UP"))
115 S X=LEXPAR
116 Q X
117LVL(X) ; Level of File X = File/Sub-File Number
118 N LEXLVL,LEXPAR,LEXSUB S LEXSUB=$G(X) Q:+LEXSUB'>0 0
119 I '$D(LEX("DD",+LEXSUB)) D DDI^LEXXFI6(+LEXSUB,.LEX)
120 Q:'$D(LEX("DD",+LEXSUB,0)) 0 Q:'$D(LEX("DD",+LEXSUB,0,"UP")) 1
121 S LEXLVL=1,LEXPAR=LEXSUB F Q:('$D(LEX("DD",+LEXSUB,0,"UP"))) D
122 . S (LEXSUB,LEXPAR)=$G(LEX("DD",+LEXSUB,0,"UP")),LEXLVL=LEXLVL+1
123 S X=LEXLVL Q X
124ID(X) ; Unique Identifier X = File/Sub-File Number
125 N LEXID,LEXPAR,LEXSUB S LEXID="",LEXSUB=$G(X) Q:+LEXSUB'>0 ""
126 I '$D(LEX("DD",+LEXSUB)) D DDI^LEXXFI6(+LEXSUB,.LEX)
127 Q:'$D(LEX("DD",+LEXSUB,0)) "" Q:'$D(LEX("DD",+LEXSUB,0,"UP")) +LEXSUB
128 S LEXID=+LEXSUB,LEXPAR=LEXSUB F Q:('$D(LEX("DD",+LEXSUB,0,"UP"))) D
129 . S (LEXSUB,LEXPAR)=$G(LEX("DD",+LEXSUB,0,"UP"))
130 . S:$L(LEXSUB) LEXID=LEXSUB_";"_LEXID
131 S X=LEXID
132 Q X
Note: See TracBrowser for help on using the repository browser.