source: IHS-VA_UTILITIES-XB/trunk/XBCFIX.m@ 1619

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

Modified directory structure; moved routines.

File size: 1.4 KB
RevLine 
[641]1XBCFIX ; 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 ;
7START ;
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 ;
18XBCFIXFL ;
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 ;
32EOJ ;
33 KILL XBCFIXHI,XBCFIXX,XBCFIXY,XBCFIXC,DIC,DIC(0),XBCFIXFL,XBCFIXGB,XBCFIXL,XBCFIXNX
34 Q
35 ;
Note: See TracBrowser for help on using the repository browser.