XBDINUM.m

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       ;