| 1 | XPDUTL1 ;SFISC/RWF - KIDS utilities (Delete pointers) ;10/28/2002 09:33
|
|---|
| 2 | ;;8.0;KERNEL;**229**;Jul 10,1995
|
|---|
| 3 | Q
|
|---|
| 4 | ;New with patch 229
|
|---|
| 5 | ;DELPTR will go thru all the files that point to a given file and
|
|---|
| 6 | ;delete any pointer to a set of deleted entries.
|
|---|
| 7 | ;FILE is the file number that the entries are being deleted from.
|
|---|
| 8 | ;DELRT is the closed root of an array of IEN values being deleted.
|
|---|
| 9 | ;SKIP is an array of files to skip from deleting
|
|---|
| 10 | DELPTR(FILE,DELRT,SKIP) ;
|
|---|
| 11 | N DA,FDA,IENS,PFL,PFE,EXE
|
|---|
| 12 | S PFL=0
|
|---|
| 13 | F S PFL=$O(^DD(FILE,0,"PT",PFL)),PFE=0 Q:PFL'>0 D
|
|---|
| 14 | . I $D(SKIP(PFL)) Q ;Skip this File
|
|---|
| 15 | . F S PFE=$O(^DD(FILE,0,"PT",PFL,PFE)) Q:PFE'>0 D
|
|---|
| 16 | . . D BUILD(PFL,PFE) Q
|
|---|
| 17 | . Q
|
|---|
| 18 | Q
|
|---|
| 19 | ;
|
|---|
| 20 | BUILD(FL,FE) ;BUILD and Execute SCAN
|
|---|
| 21 | N DIC,CNT,FLD,LV,EX,ND,QUIT
|
|---|
| 22 | S LV=0,EX=0,QUIT=0,FLD=$G(^DD(FL,FE,0)) Q:'$L(FLD)
|
|---|
| 23 | ;Get the pointing field
|
|---|
| 24 | S EX(LV,1)=FLD,FLD(0)=$P(FLD,"^",4),FLD(1)=$P(FLD(0),";"),FLD(2)=$P(FLD(0),";",2)
|
|---|
| 25 | S EX(LV,2)=FLD(1) ;Save the node
|
|---|
| 26 | ;find the path to this field
|
|---|
| 27 | S DIC=$$PATH(LV+1,FL,FE) ;Leave EX as global
|
|---|
| 28 | I QUIT Q ;Couldn't build the path
|
|---|
| 29 | ;Build the code to check this pointer value
|
|---|
| 30 | S ND=FLD(1)
|
|---|
| 31 | 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"
|
|---|
| 32 | ;Run the scan
|
|---|
| 33 | D SCAN
|
|---|
| 34 | Q
|
|---|
| 35 | ;
|
|---|
| 36 | PATH(LV,FL,FE) ;Return path to node
|
|---|
| 37 | N DIC,DA,FLD,FL2,FE2
|
|---|
| 38 | ;At the root of the file
|
|---|
| 39 | S DA=$S(LV>1:"DA("_(LV-1)_")",1:"DA")
|
|---|
| 40 | I $D(^DIC(FL,0,"GL")) D Q DIC_DA_","
|
|---|
| 41 | . S DIC=$G(^DIC(FL,0,"GL"))
|
|---|
| 42 | . S EX(LV,1)=DIC,EX=LV
|
|---|
| 43 | . S EX(LV)="S "_DA_"=0 F S "_DA_"=$O("_DIC_DA_")) Q:"_DA_"'>0 X EX("_(LV-1)_")"
|
|---|
| 44 | . Q
|
|---|
| 45 | ;In a sub-file
|
|---|
| 46 | S FL2=$G(^DD(FL,0,"UP")) I 'FL2 S QUIT=1 Q ""
|
|---|
| 47 | S FE2=$O(^DD(FL2,"SB",FL,0)) I 'FE2 S QUIT=1 Q ""
|
|---|
| 48 | S FLD=$G(^DD(FL2,FE2,0)),FLD(0)=$P(FLD,"^",4),FLD(1)=$P(FLD(0),";"),FLD(2)=$P(FLD(0),";",2)
|
|---|
| 49 | S ND(LV)=FLD(1) ;Use a variable for nodes
|
|---|
| 50 | S DIC=$$PATH(LV+1,FL2,FE2)_"ND("_LV_"),"_DA
|
|---|
| 51 | S EX(LV,1)=DIC
|
|---|
| 52 | S EX(LV)="S "_DA_"=0 F S "_DA_"=$O("_DIC_")) Q:"_DA_"'>0 X EX("_(LV-1)_")"
|
|---|
| 53 | Q DIC_","
|
|---|
| 54 | ;
|
|---|
| 55 | SCAN ;Manage the scan of a file
|
|---|
| 56 | N CNT,DA,FDA
|
|---|
| 57 | S CNT=0
|
|---|
| 58 | X EX(EX)
|
|---|
| 59 | I CNT>0 D FILE
|
|---|
| 60 | Q
|
|---|
| 61 | FILE ;File a FDA
|
|---|
| 62 | N MSG S CNT=0
|
|---|
| 63 | D FILE^DIE("KS","FDA","MSG")
|
|---|
| 64 | ;I $D(MSG) ZW MSG ;***DEBUG***
|
|---|
| 65 | Q
|
|---|
| 66 | ;
|
|---|
| 67 | DELIEN(FL,RT) ;Delete the iens in RT from file FL
|
|---|
| 68 | N DA,DIK,XPDI
|
|---|
| 69 | S DIK=$G(^DIC(FL,0,"GL")),XPDI=0 Q:'$L(DIK)
|
|---|
| 70 | F S XPDI=$O(@RT@(XPDI)) Q:'XPDI S DA=XPDI D ^DIK
|
|---|
| 71 | Q
|
|---|
| 72 | ;
|
|---|
