source: IHS-VA_UTILITIES-XB/XBCFIX.m@ 641

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

Initial commit of XB, move away from sf.net.
Includes kids file and documentation.

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.