85 lines
2.9 KiB
Mathematica
85 lines
2.9 KiB
Mathematica
XPDIA3 ;SFISC/RWF - Install Pre/Post Actions for Kernel files cont. ;6/22/06 09:13
|
|
;;8.0;KERNEL;**201,302,393**;Jul 10, 1995;Build 12
|
|
Q
|
|
;^XTMP("XPDI",,XPDA,"KRN",XPDFILE,OLDA) is the global root
|
|
;XPDNM=package name, XPDA=ien in ^XPD(9.6,
|
|
;DA=ien in file, OLDA= ien in ^XTMP
|
|
;
|
|
PAR0F2 ;PARAMETER file 8989.5: post. This is a fake entry called from the post of file 8989.51
|
|
;Now load any entries from 8989.5
|
|
N XP1,XP2,DIK,OLDA,DA,ERR,PN,PE,ROOT
|
|
S XP1=$O(^XTMP("XPDI",XPDA,"PKG",0)) ;Get the package
|
|
Q:'XP1 S PN=$G(^XTMP("XPDI",XPDA,"PKG",XP1,0))
|
|
S PE=$$FIND1^DIC(9.4,,"MX",$P(PN,U,2)) ;Get the IEN of the package
|
|
S OLDA=0,ROOT=$NA(^XTMP("XPDI",XPDA,"KRN",8989.5))
|
|
F S OLDA=$O(@ROOT@(OLDA)) Q:'OLDA D
|
|
. S XP1=@ROOT@(OLDA,0)
|
|
. S $P(XP1,U,1)=PE_";DIC(9.4," ;entity
|
|
. S $P(XP1,U,2)=$$LK^XPDIA($NA(^XTV(8989.51)),$P(XP1,U,2))
|
|
. S DA=$$LKPAR($P(XP1,U),$P(XP1,U,2),$P(XP1,U,3))
|
|
. ;Remove the current entry if we have one
|
|
. I DA>0 S DIK="^XTV(8989.5," D ^DIK
|
|
. ;Otherwise Add the zero node, See that we have a IEN
|
|
. I DA'>0 D ADDPAR($P(XP1,U),$P(XP1,U,2),$P(XP1,U,3)) S DA=$$LKPAR($P(XP1,U),$P(XP1,U,2),$P(XP1,U,3))
|
|
. Q:'DA ;don't have a entry
|
|
. ;Merge the date ;with IHS fix
|
|
. M ^XTV(8989.5,DA)=^XTMP("XPDI",XPDA,"KRN",8989.5,OLDA)
|
|
. S ^XTV(8989.5,DA,0)=XP1 ;zero node with new pointers
|
|
. ;X-ref it
|
|
. S DIK="^XTV(8989.5," D IX1^DIK
|
|
Q
|
|
;
|
|
LKPAR(ENT,PAR,INST) ;Lookup an entry
|
|
Q $O(^XTV(8989.5,"AC",PAR,ENT,INST,0))
|
|
;
|
|
ADDPAR(ENT,PAR,INST) ;Add a parameter instance
|
|
N FDA,FDAIEN,DIERR
|
|
S FDA(8989.5,"+1,",.01)=ENT
|
|
S FDA(8989.5,"+1,",.02)=PAR
|
|
S FDA(8989.5,"+1,",.03)=INST
|
|
D UPDATE^DIE("","FDA","FDAIEN","DIERR")
|
|
Q
|
|
;
|
|
PAR1F1 ;PARAMETER File 8989.51: file Pre
|
|
Q
|
|
PAR1E1 ;PARAMETER file 8989.51: entry pre
|
|
N XP1,XP2,XP3
|
|
S ^TMP($J,"XPD",DA)=""
|
|
;if there is a new Description, kill the old Description
|
|
K:$O(^XTMP("XPDI",XPDA,"KRN",8989.51,OLDA,20,0)) ^XTV(8989.51,DA,20)
|
|
;Kill any old Allowable entries
|
|
K:$O(^XTMP("XPDI",XPDA,"KRN",8989.51,OLDA,30,0)) ^XTV(8989.51,DA,30)
|
|
Q
|
|
PAR1F2 ;PARAMETER file 8989.51: file post
|
|
N XPD,DIK,DA
|
|
S DA=0
|
|
F S DA=$O(^TMP($J,"XPD",DA)) Q:'DA D
|
|
. S DIK="^XTV(8989.51," D IX1^DIK
|
|
D PAR0F2 ;Go load the entries from 8989.5
|
|
Q
|
|
PAR1DEL(RT) ;Delete Parameter Def entries
|
|
D DELPTR^XPDUTL1(8989.51,RT) ;Cleanup pointers
|
|
D DELIEN^XPDUTL1(8989.51,RT) ;Cleanup entries
|
|
Q
|
|
;
|
|
PAR2F1 ;PARAMETER File 8989.52: file Pre
|
|
K ^TMP($J,"XPD")
|
|
Q
|
|
PAR2E1 ;PARAMETER file 8989.52: entry Pre
|
|
N XP1,XP2,ROOT
|
|
S ROOT=$NA(^XTMP("XPDI",XPDA,"KRN",8989.52))
|
|
S XP2=$P(@ROOT@(OLDA,0),U,4) ;Use instance of
|
|
;Because we change the transport global see that a restart will work
|
|
I $L(XP2),XP2?1A.E S $P(@ROOT@(OLDA,0),U,4)=$$LK^XPDIA($NA(^XTV(8989.51)),XP2)
|
|
S XP1=0
|
|
F S XP1=$O(@ROOT@(OLDA,10,XP1)),XP2="" Q:'XP1 D
|
|
. S XP2=$P(@ROOT@(OLDA,10,XP1,0),U,2) ;Parameter
|
|
. I $L(XP2),XP2?1A.E S $P(@ROOT@(OLDA,10,XP1,0),U,2)=$$LK^XPDIA($NA(^XTV(8989.51)),XP2)
|
|
. Q
|
|
Q
|
|
PAR2F2 ;PARAMETER file 8989.52: file Post
|
|
Q
|
|
PAR2DEL(RT) ;Delete Parameter Templates
|
|
D DELIEN^XPDUTL1(8989.52,RT)
|
|
Q
|