source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XPDUTL1.m@ 701

Last change on this file since 701 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.3 KB
Line 
1XPDUTL1 ;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
10DELPTR(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 ;
20BUILD(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 ;
36PATH(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 ;
55SCAN ;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
61FILE ;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 ;
67DELIEN(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 ;
Note: See TracBrowser for help on using the repository browser.