- XBDINUM ; IHS/ADC/GTH - CONVERTS NON-DINUM FILE TO DINUM FILE ; [ 02/07/97 3:02 PM ]
- ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
- ;
- START ;
- S U="^"
- W !!,"This program sets the DFNs of a DINUM file appropriately.",!
- S DIC="^DIC(",DIC(0)="QAZEM"
- D ^DIC
- Q:Y<0
- S DIC=+Y
- I '$D(^DIC(DIC,0,"GL")) W !!,"Corrupted ^DIC!",!,"No ""GL"" node in zeroth node of file ",DIC,"." Q
- S XBDIGBL=^DIC(DIC,0,"GL")
- X "S XBDIX=$D("_XBDIGBL_"0))"
- I 'XBDIX W !!,XBDIGBL,"0) does not exist." Q
- I '$P(@(XBDIGBL_"0)"),U,4) W !!,"File ",DIC," has no entries." Q
- I '$D(^DD(DIC,.01,0)) W !!,"Corrupted ^DD!" Q
- I ^DD(DIC,.01,0)'["DINUM=X" W !!,"File ",DIC," is not a DINUM file." Q
- KILL ^UTILITY("XBDINUM",$J),^UTILITY("XBDIDUP",$J)
- S (XBDI3,XBDI4,XBDIDFN)=0
- X "S ^UTILITY(""XBDINUM"",$J,0)="_XBDIGBL_"0)"
- F XBDIL=0:0 X "S XBDIDFN=$O("_XBDIGBL_XBDIDFN_"))" Q:XBDIDFN'=+XBDIDFN D X1
- S XBDIX=^UTILITY("XBDINUM",$J,0),$P(XBDIX,U,3)=XBDI3,$P(XBDIX,U,4)=XBDI4,^(0)=XBDIX
- W !!,"Global ",$E(XBDIGBL,1,$L(XBDIGBL)-1)," now renumbered and stored in ^UTILITY(""XBDINUM"",",$J,!," High DFN=",XBDI3," Number of entries=",XBDI4
- I $D(^UTILITY("XBDIDUP",$J)) W !!,"Duplicate entries found. Stored in ^UTILITY(""XBDIDUP"",",$J,!," Eliminate duplicates and rerun this job!" G EOJ
- S XBDIX=$S($E(XBDIGBL,$L(XBDIGBL))="(":$E(XBDIGBL,1,$L(XBDIGBL)-1),1:$E(XBDIGBL,1,$L(XBDIGBL)-1)_")")
- KILL @(XBDIX)
- W !!,XBDIX," has been killed! Now being recreated."
- S TO=XBDIGBL,FROM="^UTILITY(""XBDINUM"",$J,",TALK=1
- D ^XBGXFR
- W !!,"File now being RE-INDEXED!",!
- S DIK=XBDIGBL,XBDIX=0
- F XBDIL=0:0 X "S XBDIX=$O("_XBDIGBL_XBDIX_"))" Q:XBDIX'=+XBDIX W "." S DA=XBDIX D IX1^DIK
- D EOJ
- Q
- ;
- X1 ;
- S FROM=XBDIGBL_XBDIDFN_","
- X "S TO=+"_XBDIGBL_XBDIDFN_",0)"
- S:TO>XBDI3 XBDI3=TO
- S TO=$S('$D(^UTILITY("XBDINUM",$J,TO)):"^UTILITY(""XBDINUM"",$J,"_TO_",",1:"^UTILITY(""XBDIDUP"",$J,"_TO_",")
- S:TO'["XBDIDUP" XBDI4=XBDI4+1
- S TALK=1
- D ^XBGXFR
- Q
- ;
- EOJ ;
- KILL ^UTILITY("XBDINUM",$J),XBDIGBL,XBDIX,XBDI3,XBDI4,XBDIDFN,XBDIL
- Q
- ;
- XBDINUM ; IHS/ADC/GTH - CONVERTS NON-DINUM FILE TO DINUM FILE ; [ 02/07/97 3:02 PM ]
- +1 ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
- +2 ;
- START ;
- +1 SET U="^"
- +2 WRITE !!,"This program sets the DFNs of a DINUM file appropriately.",!
- +3 SET DIC="^DIC("
- SET DIC(0)="QAZEM"
- +4 DO ^DIC
- +5 IF Y<0
- QUIT
- +6 SET DIC=+Y
- +7 IF '$DATA(^DIC(DIC,0,"GL"))
- WRITE !!,"Corrupted ^DIC!",!,"No ""GL"" node in zeroth node of file ",DIC,"."
- QUIT
- +8 SET XBDIGBL=^DIC(DIC,0,"GL")
- +9 XECUTE "S XBDIX=$D("_XBDIGBL_"0))"
- +10 IF 'XBDIX
- WRITE !!,XBDIGBL,"0) does not exist."
- QUIT
- +11 IF '$PIECE(@(XBDIGBL_"0)"),U,4)
- WRITE !!,"File ",DIC," has no entries."
- QUIT
- +12 IF '$DATA(^DD(DIC,.01,0))
- WRITE !!,"Corrupted ^DD!"
- QUIT
- +13 IF ^DD(DIC,.01,0)'["DINUM=X"
- WRITE !!,"File ",DIC," is not a DINUM file."
- QUIT
- +14 KILL ^UTILITY("XBDINUM",$JOB),^UTILITY("XBDIDUP",$JOB)
- +15 SET (XBDI3,XBDI4,XBDIDFN)=0
- +16 XECUTE "S ^UTILITY(""XBDINUM"",$J,0)="_XBDIGBL_"0)"
- +17 FOR XBDIL=0:0
- XECUTE "S XBDIDFN=$O("_XBDIGBL_XBDIDFN_"))"
- IF XBDIDFN'=+XBDIDFN
- QUIT
- DO X1
- +18 SET XBDIX=^UTILITY("XBDINUM",$JOB,0)
- SET $PIECE(XBDIX,U,3)=XBDI3
- SET $PIECE(XBDIX,U,4)=XBDI4
- SET ^(0)=XBDIX
- +19 WRITE !!,"Global ",$EXTRACT(XBDIGBL,1,$LENGTH(XBDIGBL)-1)," now renumbered and stored in ^UTILITY(""XBDINUM"",",$JOB,!," High DFN=",XBDI3," Number of entries=",XBDI4
- +20 IF $DATA(^UTILITY("XBDIDUP",$JOB))
- WRITE !!,"Duplicate entries found. Stored in ^UTILITY(""XBDIDUP"",",$JOB,!," Eliminate duplicates and rerun this job!"
- GOTO EOJ
- +21 SET XBDIX=$SELECT($EXTRACT(XBDIGBL,$LENGTH(XBDIGBL))="(":$EXTRACT(XBDIGBL,1,$LENGTH(XBDIGBL)-1),1:$EXTRACT(XBDIGBL,1,$LENGTH(XBDIGBL)-1)_")")
- +22 KILL @(XBDIX)
- +23 WRITE !!,XBDIX," has been killed! Now being recreated."
- +24 SET TO=XBDIGBL
- SET FROM="^UTILITY(""XBDINUM"",$J,"
- SET TALK=1
- +25 DO ^XBGXFR
- +26 WRITE !!,"File now being RE-INDEXED!",!
- +27 SET DIK=XBDIGBL
- SET XBDIX=0
- +28 FOR XBDIL=0:0
- XECUTE "S XBDIX=$O("_XBDIGBL_XBDIX_"))"
- IF XBDIX'=+XBDIX
- QUIT
- WRITE "."
- SET DA=XBDIX
- DO IX1^DIK
- +29 DO EOJ
- +30 QUIT
- +31 ;
- X1 ;
- +1 SET FROM=XBDIGBL_XBDIDFN_","
- +2 XECUTE "S TO=+"_XBDIGBL_XBDIDFN_",0)"
- +3 IF TO>XBDI3
- SET XBDI3=TO
- +4 SET TO=$SELECT('$DATA(^UTILITY("XBDINUM",$JOB,TO)):"^UTILITY(""XBDINUM"",$J,"_TO_",",1:"^UTILITY(""XBDIDUP"",$J,"_TO_",")
- +5 IF TO'["XBDIDUP"
- SET XBDI4=XBDI4+1
- +6 SET TALK=1
- +7 DO ^XBGXFR
- +8 QUIT
- +9 ;
- EOJ ;
- +1 KILL ^UTILITY("XBDINUM",$JOB),XBDIGBL,XBDIX,XBDI3,XBDI4,XBDIDFN,XBDIL
- +2 QUIT
- +3 ;
