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