| 1 | XPDGCDEL ;SFISC.SEA/JLI - Delete specified Objects (if not required) ; 3 Feb 95 09:14
|
|---|
| 2 | ;;8.0;KERNEL;;Jul 10, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | EN(XGCROOT) ; Entry is with the root under which IENs for the objects to be
|
|---|
| 5 | ; deleted will be found.
|
|---|
| 6 | N TMPROOT,DAXGC,TMPEVNT,DA,I,J,K,X,XGCOBJ,XGEVNT,XQUIT,DIE,DR
|
|---|
| 7 | S TMPROOT=$NA(^TMP("XPDGCDEL",$J))
|
|---|
| 8 | S TMPEVNT=$NA(^TMP("XPDGCEVN",$J))
|
|---|
| 9 | K @TMPROOT ; array to save those currently in use
|
|---|
| 10 | K @TMPEVNT
|
|---|
| 11 | S XGCOBJ=""
|
|---|
| 12 | D OBJECTS
|
|---|
| 13 | I $D(@TMPROOT) S XGCROOT=TMPROOT D OBJECTS
|
|---|
| 14 | D EVENTS
|
|---|
| 15 | K @TMPROOT
|
|---|
| 16 | K @TMPEVNT
|
|---|
| 17 | Q
|
|---|
| 18 | ;
|
|---|
| 19 | OBJECTS ;
|
|---|
| 20 | F S XGCOBJ=$O(@XGCROOT@(XGCOBJ)) Q:XGCOBJ="" D
|
|---|
| 21 | . S DAXGC=XGCOBJ
|
|---|
| 22 | . S XQUIT=0
|
|---|
| 23 | . F I=0:0 S I=$O(^XTV(8995,I)) Q:I'>0 I $O(^(I,2,0))>0 D Q:XQUIT
|
|---|
| 24 | . . F J=0:0 S J=$O(^XTV(8995,I,2,J)) Q:J'>0 I $P(^(J,0),U,2)=DAXGC D Q:XQUIT
|
|---|
| 25 | . . . I $D(@XGCROOT@($P(^XTV(8995,I,0),U))) S @TMPROOT@(XGCOBJ)=""
|
|---|
| 26 | . . . S XQUIT=1 ; Mark as currently used
|
|---|
| 27 | . . Q:XQUIT
|
|---|
| 28 | . Q:XQUIT
|
|---|
| 29 | . D CHKEVNTS
|
|---|
| 30 | . D CHKPARNT
|
|---|
| 31 | . S DA=DAXGC
|
|---|
| 32 | . S DIK="^XTV(8995,"
|
|---|
| 33 | . D ^DIK
|
|---|
| 34 | . K DIK
|
|---|
| 35 | Q
|
|---|
| 36 | ;
|
|---|
| 37 | CHKEVNTS ;
|
|---|
| 38 | F I=0:0 S I=$O(^XTV(8995,DAXGC,1,I)) Q:I'>0 S X=^(I,0) D
|
|---|
| 39 | . S X=+$P(X,U,2)
|
|---|
| 40 | . S X=$P(^XTV(8995.8,X,0),U)
|
|---|
| 41 | . S @TMPEVNT@(X)=""
|
|---|
| 42 | F I=0:0 S I=$O(^XTV(8995,DAXGC,2,I)) Q:I'>0 D
|
|---|
| 43 | . F J=0:0 S J=$O(^XTV(8995,DAXGC,2,I,1,J)) Q:J'>0 S X=^(J,0) D
|
|---|
| 44 | . . S X=+$P(X,U,2)
|
|---|
| 45 | . . S X=$P(^XTV(8995.8,X,0),U)
|
|---|
| 46 | . . S @TMPEVNT@(X)=""
|
|---|
| 47 | F I=0:0 S I=$O(^XTV(8995,DAXGC,3,I)) Q:I'>0 S X=^(I,0) D
|
|---|
| 48 | . S X=+$P(X,U,4)
|
|---|
| 49 | . S X=$P(^XTV(8995.8,X,0),U)
|
|---|
| 50 | . S @TMPEVNT@(X)=""
|
|---|
| 51 | Q
|
|---|
| 52 | ;
|
|---|
| 53 | CHKPARNT ;
|
|---|
| 54 | F I=0:0 S I=$O(^XTV(8995,I)) Q:I'>0 I I'=DAXGC,$P(^(I,0),U,2)=DAXGC D
|
|---|
| 55 | . S DR=".02///@;",DIE="^XTV(8995,",DA=DAXGC
|
|---|
| 56 | . D ^DIE
|
|---|
| 57 | . K DIE,DR
|
|---|
| 58 | Q
|
|---|
| 59 | ;
|
|---|
| 60 | EVENTS ;
|
|---|
| 61 | S XGEVNT=""
|
|---|
| 62 | F S XGEVNT=$O(@TMPEVNT@(XGEVNT)) Q:XGEVNT="" D
|
|---|
| 63 | . S DAXGC=$O(^XTV(8995.8,"B",XGEVNT)) Q:DAXGC'>0
|
|---|
| 64 | . S XQUIT=0
|
|---|
| 65 | . F I=0:0 Q:XQUIT S I=$O(^XTV(8995,I)) Q:I'>0 D
|
|---|
| 66 | . . F J=0:0 S J=$O(^XTV(8995,I,1,J)) Q:J'>0 I $P(^(J,0),U,2)=DAXGC S XQUIT=1 Q
|
|---|
| 67 | . . F J=0:0 Q:XQUIT S J=$O(^XTV(8995,I,2,J)) Q:J'>0 D
|
|---|
| 68 | . . . F K=0:0 S K=$O(^XTV(8995,I,2,J,1,K)) Q:K'>0 I $P(^(K,0),U,2)=DAXGC S XQUIT=1 Q
|
|---|
| 69 | . . F J=0:0 S J=$O(^XTV(8995,I,3,J)) Q:J'>0 I $P(^(J,0),U,4)=DAXGC S XQUIT=1 Q
|
|---|
| 70 | . S DA=DAXGC
|
|---|
| 71 | . S DIK="^XTV(8995.9,"
|
|---|
| 72 | . D ^DIK
|
|---|
| 73 | . K DIK
|
|---|
| 74 | Q
|
|---|
