[641] | 1 | XBCFIX ; IHS/ADC/GTH - COUNT ENTRIES IN FILEMAN FILES AND FIX ; [ 02/07/97 3:02 PM ]
|
---|
| 2 | ;;4.0;XB;;Jul 20, 2009;Build 2
|
---|
| 3 | ;
|
---|
| 4 | ; This routine counts primary entries in FileMan files and
|
---|
| 5 | ; fixes the 3rd and 4th piece of the 0th node.
|
---|
| 6 | ;
|
---|
| 7 | START ;
|
---|
| 8 | W !,"^XBCFIX - This routine counts primary entries in FileMan files and fixes",!," the 0th node.",!
|
---|
| 9 | S U="^"
|
---|
| 10 | D ^XBDSET
|
---|
| 11 | Q:'$D(^UTILITY("XBDSET",$J))
|
---|
| 12 | W !
|
---|
| 13 | S XBCFIXFL=""
|
---|
| 14 | F XBCFIXL=0:0 S XBCFIXFL=$O(^UTILITY("XBDSET",$J,XBCFIXFL)) Q:XBCFIXFL'=+XBCFIXFL D XBCFIXFL
|
---|
| 15 | D EOJ
|
---|
| 16 | Q
|
---|
| 17 | ;
|
---|
| 18 | XBCFIXFL ;
|
---|
| 19 | W !,XBCFIXFL
|
---|
| 20 | I XBCFIXFL=3.081 W " skipping" Q
|
---|
| 21 | I '$D(^DIC(XBCFIXFL,0,"GL")) W !!,"No data global specified in ^DIC!" Q
|
---|
| 22 | S XBCFIXGB=^DIC(XBCFIXFL,0,"GL")
|
---|
| 23 | I '$D(@($S($E(XBCFIXGB,$L(XBCFIXGB))="(":$E(XBCFIXGB,1,$L(XBCFIXGB)-1),1:$E(XBCFIXGB,1,$L(XBCFIXGB)-1)_")"))) W !!,"Bad global!" Q
|
---|
| 24 | S XBCFIXGB=XBCFIXGB_"XBCFIXNX)",(XBCFIXHI,XBCFIXNX,XBCFIXC)=0
|
---|
| 25 | F XBCFIXL=0:0 S XBCFIXNX=$O(@(XBCFIXGB)) Q:XBCFIXNX'=+XBCFIXNX S XBCFIXHI=XBCFIXNX,XBCFIXC=XBCFIXC+1 W:'(XBCFIXC#50) "."
|
---|
| 26 | W !," Count=",XBCFIXC,?22,"High DFN=",XBCFIXHI
|
---|
| 27 | 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
|
---|
| 28 | I XBCFIXC=XBCFIXY,XBCFIXHI=XBCFIXX W ?50,"[correct]" Q
|
---|
| 29 | W ?50,"[incorrect -- fixed]"
|
---|
| 30 | Q
|
---|
| 31 | ;
|
---|
| 32 | EOJ ;
|
---|
| 33 | KILL XBCFIXHI,XBCFIXX,XBCFIXY,XBCFIXC,DIC,DIC(0),XBCFIXFL,XBCFIXGB,XBCFIXL,XBCFIXNX
|
---|
| 34 | Q
|
---|
| 35 | ;
|
---|