73 lines
2.3 KiB
Mathematica
73 lines
2.3 KiB
Mathematica
XPDUTL1 ;SFISC/RWF - KIDS utilities (Delete pointers) ;10/28/2002 09:33
|
|
;;8.0;KERNEL;**229**;Jul 10,1995
|
|
Q
|
|
;New with patch 229
|
|
;DELPTR will go thru all the files that point to a given file and
|
|
;delete any pointer to a set of deleted entries.
|
|
;FILE is the file number that the entries are being deleted from.
|
|
;DELRT is the closed root of an array of IEN values being deleted.
|
|
;SKIP is an array of files to skip from deleting
|
|
DELPTR(FILE,DELRT,SKIP) ;
|
|
N DA,FDA,IENS,PFL,PFE,EXE
|
|
S PFL=0
|
|
F S PFL=$O(^DD(FILE,0,"PT",PFL)),PFE=0 Q:PFL'>0 D
|
|
. I $D(SKIP(PFL)) Q ;Skip this File
|
|
. F S PFE=$O(^DD(FILE,0,"PT",PFL,PFE)) Q:PFE'>0 D
|
|
. . D BUILD(PFL,PFE) Q
|
|
. Q
|
|
Q
|
|
;
|
|
BUILD(FL,FE) ;BUILD and Execute SCAN
|
|
N DIC,CNT,FLD,LV,EX,ND,QUIT
|
|
S LV=0,EX=0,QUIT=0,FLD=$G(^DD(FL,FE,0)) Q:'$L(FLD)
|
|
;Get the pointing field
|
|
S EX(LV,1)=FLD,FLD(0)=$P(FLD,"^",4),FLD(1)=$P(FLD(0),";"),FLD(2)=$P(FLD(0),";",2)
|
|
S EX(LV,2)=FLD(1) ;Save the node
|
|
;find the path to this field
|
|
S DIC=$$PATH(LV+1,FL,FE) ;Leave EX as global
|
|
I QUIT Q ;Couldn't build the path
|
|
;Build the code to check this pointer value
|
|
S ND=FLD(1)
|
|
S EX(LV)="S X=$P($G("_DIC_"ND)),U,"_FLD(2)_") I $L(X),$D(@DELRT@(X)) S IEN=$$IENS^DILF(.DA),CNT=CNT+1,FDA("_PFL_",IEN,"_PFE_")=""@"" D:CNT>10 FILE^XPDUTL1"
|
|
;Run the scan
|
|
D SCAN
|
|
Q
|
|
;
|
|
PATH(LV,FL,FE) ;Return path to node
|
|
N DIC,DA,FLD,FL2,FE2
|
|
;At the root of the file
|
|
S DA=$S(LV>1:"DA("_(LV-1)_")",1:"DA")
|
|
I $D(^DIC(FL,0,"GL")) D Q DIC_DA_","
|
|
. S DIC=$G(^DIC(FL,0,"GL"))
|
|
. S EX(LV,1)=DIC,EX=LV
|
|
. S EX(LV)="S "_DA_"=0 F S "_DA_"=$O("_DIC_DA_")) Q:"_DA_"'>0 X EX("_(LV-1)_")"
|
|
. Q
|
|
;In a sub-file
|
|
S FL2=$G(^DD(FL,0,"UP")) I 'FL2 S QUIT=1 Q ""
|
|
S FE2=$O(^DD(FL2,"SB",FL,0)) I 'FE2 S QUIT=1 Q ""
|
|
S FLD=$G(^DD(FL2,FE2,0)),FLD(0)=$P(FLD,"^",4),FLD(1)=$P(FLD(0),";"),FLD(2)=$P(FLD(0),";",2)
|
|
S ND(LV)=FLD(1) ;Use a variable for nodes
|
|
S DIC=$$PATH(LV+1,FL2,FE2)_"ND("_LV_"),"_DA
|
|
S EX(LV,1)=DIC
|
|
S EX(LV)="S "_DA_"=0 F S "_DA_"=$O("_DIC_")) Q:"_DA_"'>0 X EX("_(LV-1)_")"
|
|
Q DIC_","
|
|
;
|
|
SCAN ;Manage the scan of a file
|
|
N CNT,DA,FDA
|
|
S CNT=0
|
|
X EX(EX)
|
|
I CNT>0 D FILE
|
|
Q
|
|
FILE ;File a FDA
|
|
N MSG S CNT=0
|
|
D FILE^DIE("KS","FDA","MSG")
|
|
;I $D(MSG) ZW MSG ;***DEBUG***
|
|
Q
|
|
;
|
|
DELIEN(FL,RT) ;Delete the iens in RT from file FL
|
|
N DA,DIK,XPDI
|
|
S DIK=$G(^DIC(FL,0,"GL")),XPDI=0 Q:'$L(DIK)
|
|
F S XPDI=$O(@RT@(XPDI)) Q:'XPDI S DA=XPDI D ^DIK
|
|
Q
|
|
;
|