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