| 1 | XPDIA3 ;SFISC/RWF - Install Pre/Post Actions for Kernel files cont. ;6/22/06 09:13
|
|---|
| 2 | ;;8.0;KERNEL;**201,302,393**;Jul 10, 1995;Build 12
|
|---|
| 3 | Q
|
|---|
| 4 | ;^XTMP("XPDI",,XPDA,"KRN",XPDFILE,OLDA) is the global root
|
|---|
| 5 | ;XPDNM=package name, XPDA=ien in ^XPD(9.6,
|
|---|
| 6 | ;DA=ien in file, OLDA= ien in ^XTMP
|
|---|
| 7 | ;
|
|---|
| 8 | PAR0F2 ;PARAMETER file 8989.5: post. This is a fake entry called from the post of file 8989.51
|
|---|
| 9 | ;Now load any entries from 8989.5
|
|---|
| 10 | N XP1,XP2,DIK,OLDA,DA,ERR,PN,PE,ROOT
|
|---|
| 11 | S XP1=$O(^XTMP("XPDI",XPDA,"PKG",0)) ;Get the package
|
|---|
| 12 | Q:'XP1 S PN=$G(^XTMP("XPDI",XPDA,"PKG",XP1,0))
|
|---|
| 13 | S PE=$$FIND1^DIC(9.4,,"MX",$P(PN,U,2)) ;Get the IEN of the package
|
|---|
| 14 | S OLDA=0,ROOT=$NA(^XTMP("XPDI",XPDA,"KRN",8989.5))
|
|---|
| 15 | F S OLDA=$O(@ROOT@(OLDA)) Q:'OLDA D
|
|---|
| 16 | . S XP1=@ROOT@(OLDA,0)
|
|---|
| 17 | . S $P(XP1,U,1)=PE_";DIC(9.4," ;entity
|
|---|
| 18 | . S $P(XP1,U,2)=$$LK^XPDIA($NA(^XTV(8989.51)),$P(XP1,U,2))
|
|---|
| 19 | . S DA=$$LKPAR($P(XP1,U),$P(XP1,U,2),$P(XP1,U,3))
|
|---|
| 20 | . ;Remove the current entry if we have one
|
|---|
| 21 | . I DA>0 S DIK="^XTV(8989.5," D ^DIK
|
|---|
| 22 | . ;Otherwise Add the zero node, See that we have a IEN
|
|---|
| 23 | . 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))
|
|---|
| 24 | . Q:'DA ;don't have a entry
|
|---|
| 25 | . ;Merge the date ;with IHS fix
|
|---|
| 26 | . M ^XTV(8989.5,DA)=^XTMP("XPDI",XPDA,"KRN",8989.5,OLDA)
|
|---|
| 27 | . S ^XTV(8989.5,DA,0)=XP1 ;zero node with new pointers
|
|---|
| 28 | . ;X-ref it
|
|---|
| 29 | . S DIK="^XTV(8989.5," D IX1^DIK
|
|---|
| 30 | Q
|
|---|
| 31 | ;
|
|---|
| 32 | LKPAR(ENT,PAR,INST) ;Lookup an entry
|
|---|
| 33 | Q $O(^XTV(8989.5,"AC",PAR,ENT,INST,0))
|
|---|
| 34 | ;
|
|---|
| 35 | ADDPAR(ENT,PAR,INST) ;Add a parameter instance
|
|---|
| 36 | N FDA,FDAIEN,DIERR
|
|---|
| 37 | S FDA(8989.5,"+1,",.01)=ENT
|
|---|
| 38 | S FDA(8989.5,"+1,",.02)=PAR
|
|---|
| 39 | S FDA(8989.5,"+1,",.03)=INST
|
|---|
| 40 | D UPDATE^DIE("","FDA","FDAIEN","DIERR")
|
|---|
| 41 | Q
|
|---|
| 42 | ;
|
|---|
| 43 | PAR1F1 ;PARAMETER File 8989.51: file Pre
|
|---|
| 44 | Q
|
|---|
| 45 | PAR1E1 ;PARAMETER file 8989.51: entry pre
|
|---|
| 46 | N XP1,XP2,XP3
|
|---|
| 47 | S ^TMP($J,"XPD",DA)=""
|
|---|
| 48 | ;if there is a new Description, kill the old Description
|
|---|
| 49 | K:$O(^XTMP("XPDI",XPDA,"KRN",8989.51,OLDA,20,0)) ^XTV(8989.51,DA,20)
|
|---|
| 50 | ;Kill any old Allowable entries
|
|---|
| 51 | K:$O(^XTMP("XPDI",XPDA,"KRN",8989.51,OLDA,30,0)) ^XTV(8989.51,DA,30)
|
|---|
| 52 | Q
|
|---|
| 53 | PAR1F2 ;PARAMETER file 8989.51: file post
|
|---|
| 54 | N XPD,DIK,DA
|
|---|
| 55 | S DA=0
|
|---|
| 56 | F S DA=$O(^TMP($J,"XPD",DA)) Q:'DA D
|
|---|
| 57 | . S DIK="^XTV(8989.51," D IX1^DIK
|
|---|
| 58 | D PAR0F2 ;Go load the entries from 8989.5
|
|---|
| 59 | Q
|
|---|
| 60 | PAR1DEL(RT) ;Delete Parameter Def entries
|
|---|
| 61 | D DELPTR^XPDUTL1(8989.51,RT) ;Cleanup pointers
|
|---|
| 62 | D DELIEN^XPDUTL1(8989.51,RT) ;Cleanup entries
|
|---|
| 63 | Q
|
|---|
| 64 | ;
|
|---|
| 65 | PAR2F1 ;PARAMETER File 8989.52: file Pre
|
|---|
| 66 | K ^TMP($J,"XPD")
|
|---|
| 67 | Q
|
|---|
| 68 | PAR2E1 ;PARAMETER file 8989.52: entry Pre
|
|---|
| 69 | N XP1,XP2,ROOT
|
|---|
| 70 | S ROOT=$NA(^XTMP("XPDI",XPDA,"KRN",8989.52))
|
|---|
| 71 | S XP2=$P(@ROOT@(OLDA,0),U,4) ;Use instance of
|
|---|
| 72 | ;Because we change the transport global see that a restart will work
|
|---|
| 73 | I $L(XP2),XP2?1A.E S $P(@ROOT@(OLDA,0),U,4)=$$LK^XPDIA($NA(^XTV(8989.51)),XP2)
|
|---|
| 74 | S XP1=0
|
|---|
| 75 | F S XP1=$O(@ROOT@(OLDA,10,XP1)),XP2="" Q:'XP1 D
|
|---|
| 76 | . S XP2=$P(@ROOT@(OLDA,10,XP1,0),U,2) ;Parameter
|
|---|
| 77 | . I $L(XP2),XP2?1A.E S $P(@ROOT@(OLDA,10,XP1,0),U,2)=$$LK^XPDIA($NA(^XTV(8989.51)),XP2)
|
|---|
| 78 | . Q
|
|---|
| 79 | Q
|
|---|
| 80 | PAR2F2 ;PARAMETER file 8989.52: file Post
|
|---|
| 81 | Q
|
|---|
| 82 | PAR2DEL(RT) ;Delete Parameter Templates
|
|---|
| 83 | D DELIEN^XPDUTL1(8989.52,RT)
|
|---|
| 84 | Q
|
|---|
