Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XPDUTL1

XPDUTL1.m

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