| 1 | XPDTA2 ;SFISC/RWF - Build Actions for Kernel Files Cont. ;08/09/2001 12:36
|
|---|
| 2 | ;;8.0;KERNEL;**201,498**;Jul 10, 1995;Build 13
|
|---|
| 3 | ;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;^XTMP("XPDT",XPDA,"KRN",XPDFILE,DA) is the global root
|
|---|
| 6 | ;DA=ien in ^XTMP,XPDNM=package name, XPDA=package ien in ^XPD(9.6,
|
|---|
| 7 | ;
|
|---|
| 8 | PAR1E1 ;PARAMETER file 8989.51: entry post
|
|---|
| 9 | N XP,XP1,XP2,XP3,XP4,VP,PN,PT,ROOT
|
|---|
| 10 | S ROOT=$NA(^XTMP("XPDT",XPDA,"KRN"))
|
|---|
| 11 | D PAR51(DA) ;Handle the entry from 8989.51
|
|---|
| 12 | S PT=$S($E($G(^XTV(8989.51,DA,1)))="P":$P(^(1),U,2),1:"") ;Data Type & Value - check if pointer in for loop
|
|---|
| 13 | S:PT]"" PT=$S(PT:$$GR^XPDTA(PT),1:"") ;PT=file # of pointed to file from parm def.
|
|---|
| 14 | ;Now find any entrys in 8989.5 to transport, because we point to them
|
|---|
| 15 | S XP=0,XP3=$P(^XPD(9.6,XPDA,0),U,2),VP=XP3_";DIC(9.4,",PN=$$PT^XPDTA("^DIC(9.4)",XP3)
|
|---|
| 16 | Q:'XP3 ;No package file link
|
|---|
| 17 | F S XP=$O(^XTV(8989.5,"AC",DA,VP,XP)),XP1=0 Q:'XP D ;Instance
|
|---|
| 18 | . F S XP1=$O(^XTV(8989.5,"AC",DA,VP,XP,XP1)) Q:'XP1 D ;entry
|
|---|
| 19 | . . M ^XTMP("XPDT",XPDA,"KRN",8989.5,XP1)=^XTV(8989.5,XP1)
|
|---|
| 20 | . . S XP3=^XTV(8989.5,XP1,0),XP4=$G(^(1)) ;param def.
|
|---|
| 21 | . . S $P(@ROOT@(8989.5,XP1,0),U,2)=$$PT^XPDTA("^XTV(8989.51)",$P(XP3,U,2))
|
|---|
| 22 | . . I PT]"",XP4>0 S $P(@ROOT@(8989.5,XP1,1),U)=$$PT^XPDTA(PT,XP4) ;Data Type pointer - resolve
|
|---|
| 23 | . . Q ;Will redo the ENT at other end.
|
|---|
| 24 | Q
|
|---|
| 25 | ;
|
|---|
| 26 | PAR51(DA) ;Fix one 8989.51 entry in transport global
|
|---|
| 27 | ;Called from both PAR1E1 and PAR2E1
|
|---|
| 28 | N XP,XP1,XP2,XP3,VP,PN,ROOT
|
|---|
| 29 | S ROOT=$NA(^XTMP("XPDT",XPDA,"KRN"))
|
|---|
| 30 | ;Don't bring X-ref
|
|---|
| 31 | K @ROOT@(8989.51,DA,30,"B"),^("AG")
|
|---|
| 32 | S XP=0
|
|---|
| 33 | ;Entries in the file will be maintained by Toolkit patches.
|
|---|
| 34 | Q
|
|---|
| 35 | ;
|
|---|
| 36 | PAR2E1 ;PARAMETER file 8989.52 entry post
|
|---|
| 37 | N XP1,XP2,XP3,ROOT
|
|---|
| 38 | S ROOT=$NA(^XTMP("XPDT",XPDA,"KRN"))
|
|---|
| 39 | ;Resolve USE INSTANCE OF
|
|---|
| 40 | S XP2=$P(^XTV(8989.52,DA,0),U,4),XP3="" I XP2 S XP3=$$PT^XPDTA($NA(^XTV(8989.51)),XP2)
|
|---|
| 41 | I $L(XP3) S $P(@ROOT@(8989.52,DA,0),U,4)=XP3
|
|---|
| 42 | ;Resolve PARAMETERS
|
|---|
| 43 | S XP1=0 K ^XTMP("XPDT",XPDA,"KRN",8989.52,DA,10,"B") ;Drop X-ref
|
|---|
| 44 | F S XP1=$O(^XTV(8989.52,DA,10,XP1)),XP3="" Q:'XP1 D
|
|---|
| 45 | . S XP2=$P(^XTV(8989.52,DA,10,XP1,0),U,2)
|
|---|
| 46 | . I XP2 S XP3=$$PT^XPDTA($NA(^XTV(8989.51)),XP2)
|
|---|
| 47 | . I '$L(XP3) K @ROOT@(8989.52,DA,10,XP1)
|
|---|
| 48 | . S $P(^XTMP("XPDT",XPDA,"KRN",8989.52,DA,10,XP1,0),U,2)=XP3
|
|---|
| 49 | . ;Now to move the entries this points to.
|
|---|
| 50 | . I '$D(@ROOT@(8989.51,XP2)) M @ROOT@(8989.51,XP2)=^XTV(8989.51,XP2) D PAR51(XP2)
|
|---|
| 51 | . Q
|
|---|
| 52 | Q
|
|---|
