AUCOUNT.m

%AUCOUNT ; COUNT ENTIRES IN FILEMAN FILE [ 10/08/86  2:27 PM ]

 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

 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 (AUHI,NXT,CTR)=0

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

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

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

 I CTR'=AUY!(AUHI'=AUX) W !,"The 0th node says ",AUY,", ",AUX," respectively.",!,"  Do you want me to fix it? (Y/N) Y//" R ANS I "Y"[$E(ANS) S $P(^(0),U,3)=AUHI,$P(^(0),U,4)=CTR W "  Done"

 G LOOP

 ;

EOJ ;

 K ANS,AUHI,AUX,AUY,CTR,DIC,DIC(0),FILE,GBL,L,NXT

 Q

%AUCOUNT  ; COUNT ENTIRES IN FILEMAN FILE [ 10/08/86  2:27 PM ]

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

LOOP      ;

 +1        WRITE !

 +2        SET DIC=1

           SET DIC(0)="AE"

           DO ^DIC

 +3        IF Y<0

               GOTO EOJ

 +4        SET FILE=+Y

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

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

               GOTO LOOP

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

 +7        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

 +8        SET GBL=GBL_"NXT)"

 +9        SET (AUHI,NXT,CTR)=0

 +10       FOR L=0:0

               SET NXT=$ORDER(@(GBL))

               IF NXT'=+NXT

                   QUIT 

               SET AUHI=NXT

               SET CTR=CTR+1

               IF '(CTR#50)

                   WRITE "."

 +11       WRITE !!,"FileMan file ",FILE," contains ",CTR," entries.  High DFN=",AUHI,!

 +12       SET NXT=""

           SET AUX=$ORDER(@(GBL))

           SET AUX=^(0)

           SET AUY=$PIECE(AUX,U,4)

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

 +13       IF CTR'=AUY!(AUHI'=AUX)

               WRITE !,"The 0th node says ",AUY,", ",AUX," respectively.",!,"  Do you want me to fix it? (Y/N) Y//"

               READ ANS

               IF "Y"[$EXTRACT(ANS)

                   SET $PIECE(^(0),U,3)=AUHI

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

                   WRITE "  Done"

 +14       GOTO LOOP

 +15      ;

EOJ       ;

 +1        KILL ANS,AUHI,AUX,AUY,CTR,DIC,DIC(0),FILE,GBL,L,NXT

 +2        QUIT