XBCFIX.m

XBCFIX ; IHS/ADC/GTH - COUNT ENTRIES IN FILEMAN FILES AND FIX ; [ 02/07/97   3:02 PM ]

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

 ;

 ; This routine counts primary entries in FileMan files and

 ; fixes the 3rd and 4th piece of the 0th node.

 ;

START ;

 W !,"^XBCFIX - This routine counts primary entries in FileMan files and fixes",!,"          the 0th node.",!

 S U="^"

 D ^XBDSET

 Q:'$D(^UTILITY("XBDSET",$J))

 W !

 S XBCFIXFL=""

 F XBCFIXL=0:0 S XBCFIXFL=$O(^UTILITY("XBDSET",$J,XBCFIXFL)) Q:XBCFIXFL'=+XBCFIXFL  D XBCFIXFL

 D EOJ

 Q

 ;

XBCFIXFL ;

 W !,XBCFIXFL

 I XBCFIXFL=3.081 W "  skipping" Q

 I '$D(^DIC(XBCFIXFL,0,"GL")) W !!,"No data global specified in ^DIC!" Q

 S XBCFIXGB=^DIC(XBCFIXFL,0,"GL")

 I '$D(@($S($E(XBCFIXGB,$L(XBCFIXGB))="(":$E(XBCFIXGB,1,$L(XBCFIXGB)-1),1:$E(XBCFIXGB,1,$L(XBCFIXGB)-1)_")"))) W !!,"Bad global!" Q

 S XBCFIXGB=XBCFIXGB_"XBCFIXNX)",(XBCFIXHI,XBCFIXNX,XBCFIXC)=0

 F XBCFIXL=0:0 S XBCFIXNX=$O(@(XBCFIXGB)) Q:XBCFIXNX'=+XBCFIXNX  S XBCFIXHI=XBCFIXNX,XBCFIXC=XBCFIXC+1 W:'(XBCFIXC#50) "."

 W !,"    Count=",XBCFIXC,?22,"High DFN=",XBCFIXHI

 S XBCFIXNX="",XBCFIXX=$O(@(XBCFIXGB)),XBCFIXX=^(0),XBCFIXY=$P(XBCFIXX,U,4),XBCFIXX=$P(XBCFIXX,U,3),$P(^(0),U,3)=XBCFIXHI,$P(^(0),U,4)=XBCFIXC

 I XBCFIXC=XBCFIXY,XBCFIXHI=XBCFIXX W ?50,"[correct]" Q

 W ?50,"[incorrect -- fixed]"

 Q

 ;

EOJ ;

 KILL XBCFIXHI,XBCFIXX,XBCFIXY,XBCFIXC,DIC,DIC(0),XBCFIXFL,XBCFIXGB,XBCFIXL,XBCFIXNX

 Q

 ;

XBCFIX    ; IHS/ADC/GTH - COUNT ENTRIES IN FILEMAN FILES AND FIX ; [ 02/07/97   3:02 PM ]

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

 +2       ;

 +3       ; This routine counts primary entries in FileMan files and

 +4       ; fixes the 3rd and 4th piece of the 0th node.

 +5       ;

START     ;

 +1        WRITE !,"^XBCFIX - This routine counts primary entries in FileMan files and fixes",!,"          the 0th node.",!

 +2        SET U="^"

 +3        DO ^XBDSET

 +4        IF '$DATA(^UTILITY("XBDSET",$JOB))

               QUIT 

 +5        WRITE !

 +6        SET XBCFIXFL=""

 +7        FOR XBCFIXL=0:0

               SET XBCFIXFL=$ORDER(^UTILITY("XBDSET",$JOB,XBCFIXFL))

               IF XBCFIXFL'=+XBCFIXFL

                   QUIT 

               DO XBCFIXFL

 +8        DO EOJ

 +9        QUIT 

 +10      ;

XBCFIXFL  ;

 +1        WRITE !,XBCFIXFL

 +2        IF XBCFIXFL=3.081

               WRITE "  skipping"

               QUIT 

 +3        IF '$DATA(^DIC(XBCFIXFL,0,"GL"))

               WRITE !!,"No data global specified in ^DIC!"

               QUIT 

 +4        SET XBCFIXGB=^DIC(XBCFIXFL,0,"GL")

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

               WRITE !!,"Bad global!"

               QUIT 

 +6        SET XBCFIXGB=XBCFIXGB_"XBCFIXNX)"

           SET (XBCFIXHI,XBCFIXNX,XBCFIXC)=0

 +7        FOR XBCFIXL=0:0

               SET XBCFIXNX=$ORDER(@(XBCFIXGB))

               IF XBCFIXNX'=+XBCFIXNX

                   QUIT 

               SET XBCFIXHI=XBCFIXNX

               SET XBCFIXC=XBCFIXC+1

               IF '(XBCFIXC#50)

                   WRITE "."

 +8        WRITE !,"    Count=",XBCFIXC,?22,"High DFN=",XBCFIXHI

 +9        SET XBCFIXNX=""

           SET XBCFIXX=$ORDER(@(XBCFIXGB))

           SET XBCFIXX=^(0)

           SET XBCFIXY=$PIECE(XBCFIXX,U,4)

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

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

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

 +10       IF XBCFIXC=XBCFIXY

               IF XBCFIXHI=XBCFIXX

                   WRITE ?50,"[correct]"

                   QUIT 

 +11       WRITE ?50,"[incorrect -- fixed]"

 +12       QUIT 

 +13      ;

EOJ       ;

 +1        KILL XBCFIXHI,XBCFIXX,XBCFIXY,XBCFIXC,DIC,DIC(0),XBCFIXFL,XBCFIXGB,XBCFIXL,XBCFIXNX

 +2        QUIT 

 +3       ;