source: IHS-VA_UTILITIES-XB/trunk/XBCOUNT.m@ 1303

Last change on this file since 1303 was 642, checked in by Sam Habiel, 15 years ago

Modified directory structure; moved routines.

File size: 1.1 KB
Line 
1XBCOUNT ; IHS/ADC/GTH - COUNT ENTRIES IN FILEMAN FILE ; [ 02/07/97 3:02 PM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;
4 ; This routine counts primary entries in a FileMan file and
5 ; corrects the 0th node.
6 ;
7START ;
8 NEW ANS,CTR,FILE,GBL,L,NXT
9 W !,"This program counts primary entries for a FileMan file.",!
10LOOP ;
11 W !
12 S DIC=1,DIC(0)="AE"
13 D ^DIC
14 G:Y<0 EOJ
15 S FILE=+Y
16ENT ;
17 I '$D(^DIC(FILE,0,"GL")) W !!,"DIC file entry invalid or does not exist!",! G LOOP
18 S GBL=^DIC(FILE,0,"GL")
19 I '$D(@($S($E(GBL,$L(GBL))="(":$E(GBL,1,$L(GBL)-1),1:$E(GBL,1,$L(GBL)-1)_")"))) W !!,"Bad global!!",! G LOOP
20 S GBL=GBL_"NXT)"
21 S (XBHI,NXT,CTR)=0
22 F L=0:0 S NXT=$O(@(GBL)) Q:NXT'=+NXT S XBHI=NXT,CTR=CTR+1 W:'(CTR#50) "."
23 W !!,"FileMan file ",FILE," contains ",CTR," entries. High DFN=",XBHI,!
24 S NXT="",XBX=$O(@(GBL)),XBX=^(0),XBY=$P(XBX,U,4),XBX=$P(XBX,U,3)
25 W !,"The 0th node says ",XBY,", ",XBX," respectively."
26 I CTR'=XBY!(XBHI'=XBX) W !," Do you want me to fix it? (Y/N) Y//" R ANS:$G(DTIME,999) I "Y"[$E(ANS) S NXT=0,$P(@(GBL),U,3)=XBHI,$P(^(0),U,4)=CTR W " Done"
27 G LOOP
28 ;
29EOJ ;
30 KILL ANS,XBHI,XBX,XBY,CTR,DIC,FILE,GBL,L,NXT
31 Q
32 ;
Note: See TracBrowser for help on using the repository browser.