XBCOUNT.m

XBCOUNT ; IHS/ADC/GTH - COUNT ENTRIES IN FILEMAN FILE ; [ 02/07/97   3:02 PM ]

 ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997

 ;

 ; This routine counts primary entries in a FileMan file and

 ; corrects the 0th node.

 ;

START ;

 NEW ANS,CTR,FILE,GBL,L,NXT

 W !,"This program counts primary entries for a FileMan file.",!

LOOP ;

 W !

 S DIC=1,DIC(0)="AE"

 D ^DIC

 G:Y<0 EOJ

 S FILE=+Y

ENT ;

 I '$D(^DIC(FILE,0,"GL")) W !!,"DIC file entry invalid or does not exist!",! G LOOP

 S GBL=^DIC(FILE,0,"GL")

 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

 S GBL=GBL_"NXT)"

 S (XBHI,NXT,CTR)=0

 F L=0:0 S NXT=$O(@(GBL)) Q:NXT'=+NXT  S XBHI=NXT,CTR=CTR+1 W:'(CTR#50) "."

 W !!,"FileMan file ",FILE," contains ",CTR," entries.  High DFN=",XBHI,!

 S NXT="",XBX=$O(@(GBL)),XBX=^(0),XBY=$P(XBX,U,4),XBX=$P(XBX,U,3)

 W !,"The 0th node says ",XBY,", ",XBX," respectively."

 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"

 G LOOP

 ;

EOJ ;

 KILL ANS,XBHI,XBX,XBY,CTR,DIC,FILE,GBL,L,NXT

 Q

 ;

XBCOUNT   ; IHS/ADC/GTH - COUNT ENTRIES IN FILEMAN FILE ; [ 02/07/97   3:02 PM ]

 +1       ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997

 +2       ;

 +3       ; This routine counts primary entries in a FileMan file and

 +4       ; corrects the 0th node.

 +5       ;

START     ;

 +1        NEW ANS,CTR,FILE,GBL,L,NXT

 +2        WRITE !,"This program counts primary entries for a FileMan file.",!

LOOP      ;

 +1        WRITE !

 +2        SET DIC=1

           SET DIC(0)="AE"

 +3        DO ^DIC

 +4        IF Y<0

               GOTO EOJ

 +5        SET FILE=+Y

ENT       ;

 +1        IF '$DATA(^DIC(FILE,0,"GL"))

               WRITE !!,"DIC file entry invalid or does not exist!",!

               GOTO LOOP

 +2        SET GBL=^DIC(FILE,0,"GL")

 +3        IF '$DATA(@($SELECT($EXTRACT(GBL,$LENGTH(GBL))="(":$EXTRACT(GBL,1,$LENGTH(GBL)-1),1:$EXTRACT(GBL,1,$LENGTH(GBL)-1)_")")))

               WRITE !!,"Bad global!!",!

               GOTO LOOP

 +4        SET GBL=GBL_"NXT)"

 +5        SET (XBHI,NXT,CTR)=0

 +6        FOR L=0:0

               SET NXT=$ORDER(@(GBL))

               IF NXT'=+NXT

                   QUIT 

               SET XBHI=NXT

               SET CTR=CTR+1

               IF '(CTR#50)

                   WRITE "."

 +7        WRITE !!,"FileMan file ",FILE," contains ",CTR," entries.  High DFN=",XBHI,!

 +8        SET NXT=""

           SET XBX=$ORDER(@(GBL))

           SET XBX=^(0)

           SET XBY=$PIECE(XBX,U,4)

           SET XBX=$PIECE(XBX,U,3)

 +9        WRITE !,"The 0th node says ",XBY,", ",XBX," respectively."

 +10       IF CTR'=XBY!(XBHI'=XBX)

               WRITE !,"  Do you want me to fix it? (Y/N) Y//"

               READ ANS:$GET(DTIME,999)

               IF "Y"[$EXTRACT(ANS)

                   SET NXT=0

                   SET $PIECE(@(GBL),U,3)=XBHI

                   SET $PIECE(^(0),U,4)=CTR

                   WRITE "  Done"

 +11       GOTO LOOP

 +12      ;

EOJ       ;

 +1        KILL ANS,XBHI,XBX,XBY,CTR,DIC,FILE,GBL,L,NXT

 +2        QUIT 

 +3       ;