- XPDTA2 ;SFISC/RWF - Build Actions for Kernel Files Cont. ;08/09/2001 12:36
- ;;8.0;KERNEL;**201,498**;Jul 10, 1995;Build 13
- ;Per VHA Directive 2004-038, this routine should not be modified.
- Q
- ;^XTMP("XPDT",XPDA,"KRN",XPDFILE,DA) is the global root
- ;DA=ien in ^XTMP,XPDNM=package name, XPDA=package ien in ^XPD(9.6,
- ;
- PAR1E1 ;PARAMETER file 8989.51: entry post
- N XP,XP1,XP2,XP3,XP4,VP,PN,PT,ROOT
- S ROOT=$NA(^XTMP("XPDT",XPDA,"KRN"))
- D PAR51(DA) ;Handle the entry from 8989.51
- 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
- S:PT]"" PT=$S(PT:$$GR^XPDTA(PT),1:"") ;PT=file # of pointed to file from parm def.
- ;Now find any entrys in 8989.5 to transport, because we point to them
- S XP=0,XP3=$P(^XPD(9.6,XPDA,0),U,2),VP=XP3_";DIC(9.4,",PN=$$PT^XPDTA("^DIC(9.4)",XP3)
- Q:'XP3 ;No package file link
- F S XP=$O(^XTV(8989.5,"AC",DA,VP,XP)),XP1=0 Q:'XP D ;Instance
- . F S XP1=$O(^XTV(8989.5,"AC",DA,VP,XP,XP1)) Q:'XP1 D ;entry
- . . M ^XTMP("XPDT",XPDA,"KRN",8989.5,XP1)=^XTV(8989.5,XP1)
- . . S XP3=^XTV(8989.5,XP1,0),XP4=$G(^(1)) ;param def.
- . . S $P(@ROOT@(8989.5,XP1,0),U,2)=$$PT^XPDTA("^XTV(8989.51)",$P(XP3,U,2))
- . . I PT]"",XP4>0 S $P(@ROOT@(8989.5,XP1,1),U)=$$PT^XPDTA(PT,XP4) ;Data Type pointer - resolve
- . . Q ;Will redo the ENT at other end.
- Q
- ;
- PAR51(DA) ;Fix one 8989.51 entry in transport global
- ;Called from both PAR1E1 and PAR2E1
- N XP,XP1,XP2,XP3,VP,PN,ROOT
- S ROOT=$NA(^XTMP("XPDT",XPDA,"KRN"))
- ;Don't bring X-ref
- K @ROOT@(8989.51,DA,30,"B"),^("AG")
- S XP=0
- ;Entries in the file will be maintained by Toolkit patches.
- Q
- ;
- PAR2E1 ;PARAMETER file 8989.52 entry post
- N XP1,XP2,XP3,ROOT
- S ROOT=$NA(^XTMP("XPDT",XPDA,"KRN"))
- ;Resolve USE INSTANCE OF
- S XP2=$P(^XTV(8989.52,DA,0),U,4),XP3="" I XP2 S XP3=$$PT^XPDTA($NA(^XTV(8989.51)),XP2)
- I $L(XP3) S $P(@ROOT@(8989.52,DA,0),U,4)=XP3
- ;Resolve PARAMETERS
- S XP1=0 K ^XTMP("XPDT",XPDA,"KRN",8989.52,DA,10,"B") ;Drop X-ref
- F S XP1=$O(^XTV(8989.52,DA,10,XP1)),XP3="" Q:'XP1 D
- . S XP2=$P(^XTV(8989.52,DA,10,XP1,0),U,2)
- . I XP2 S XP3=$$PT^XPDTA($NA(^XTV(8989.51)),XP2)
- . I '$L(XP3) K @ROOT@(8989.52,DA,10,XP1)
- . S $P(^XTMP("XPDT",XPDA,"KRN",8989.52,DA,10,XP1,0),U,2)=XP3
- . ;Now to move the entries this points to.
- . I '$D(@ROOT@(8989.51,XP2)) M @ROOT@(8989.51,XP2)=^XTV(8989.51,XP2) D PAR51(XP2)
- . Q
- Q
- XPDTA2 ;SFISC/RWF - Build Actions for Kernel Files Cont. ;08/09/2001 12:36
- +1 ;;8.0;KERNEL;**201,498**;Jul 10, 1995;Build 13
- +2 ;Per VHA Directive 2004-038, this routine should not be modified.
- +3 QUIT
- +4 ;^XTMP("XPDT",XPDA,"KRN",XPDFILE,DA) is the global root
- +5 ;DA=ien in ^XTMP,XPDNM=package name, XPDA=package ien in ^XPD(9.6,
- +6 ;
- PAR1E1 ;PARAMETER file 8989.51: entry post
- +1 NEW XP,XP1,XP2,XP3,XP4,VP,PN,PT,ROOT
- +2 SET ROOT=$NAME(^XTMP("XPDT",XPDA,"KRN"))
- +3 ;Handle the entry from 8989.51
- DO PAR51(DA)
- +4 ;Data Type & Value - check if pointer in for loop
- SET PT=$SELECT($EXTRACT($GET(^XTV(8989.51,DA,1)))="P":$PIECE(^(1),U,2),1:"")
- +5 ;PT=file # of pointed to file from parm def.
- IF PT]""
- SET PT=$SELECT(PT:$$GR^XPDTA(PT),1:"")
- +6 ;Now find any entrys in 8989.5 to transport, because we point to them
- +7 SET XP=0
- SET XP3=$PIECE(^XPD(9.6,XPDA,0),U,2)
- SET VP=XP3_";DIC(9.4,"
- SET PN=$$PT^XPDTA("^DIC(9.4)",XP3)
- +8 ;No package file link
- IF 'XP3
- QUIT
- +9 ;Instance
- FOR
- SET XP=$ORDER(^XTV(8989.5,"AC",DA,VP,XP))
- SET XP1=0
- IF 'XP
- QUIT
- Begin DoDot:1
- +10 ;entry
- FOR
- SET XP1=$ORDER(^XTV(8989.5,"AC",DA,VP,XP,XP1))
- IF 'XP1
- QUIT
- Begin DoDot:2
- +11 MERGE ^XTMP("XPDT",XPDA,"KRN",8989.5,XP1)=^XTV(8989.5,XP1)
- +12 ;param def.
- SET XP3=^XTV(8989.5,XP1,0)
- SET XP4=$GET(^(1))
- +13 SET $PIECE(@ROOT@(8989.5,XP1,0),U,2)=$$PT^XPDTA("^XTV(8989.51)",$PIECE(XP3,U,2))
- +14 ;Data Type pointer - resolve
- IF PT]""
- IF XP4>0
- SET $PIECE(@ROOT@(8989.5,XP1,1),U)=$$PT^XPDTA(PT,XP4)
- +15 ;Will redo the ENT at other end.
- QUIT
- End DoDot:2
- End DoDot:1
- +16 QUIT
- +17 ;
- PAR51(DA) ;Fix one 8989.51 entry in transport global
- +1 ;Called from both PAR1E1 and PAR2E1
- +2 NEW XP,XP1,XP2,XP3,VP,PN,ROOT
- +3 SET ROOT=$NAME(^XTMP("XPDT",XPDA,"KRN"))
- +4 ;Don't bring X-ref
- +5 KILL @ROOT@(8989.51,DA,30,"B"),^("AG")
- +6 SET XP=0
- +7 ;Entries in the file will be maintained by Toolkit patches.
- +8 QUIT
- +9 ;
- PAR2E1 ;PARAMETER file 8989.52 entry post
- +1 NEW XP1,XP2,XP3,ROOT
- +2 SET ROOT=$NAME(^XTMP("XPDT",XPDA,"KRN"))
- +3 ;Resolve USE INSTANCE OF
- +4 SET XP2=$PIECE(^XTV(8989.52,DA,0),U,4)
- SET XP3=""
- IF XP2
- SET XP3=$$PT^XPDTA($NAME(^XTV(8989.51)),XP2)
- +5 IF $LENGTH(XP3)
- SET $PIECE(@ROOT@(8989.52,DA,0),U,4)=XP3
- +6 ;Resolve PARAMETERS
- +7 ;Drop X-ref
- SET XP1=0
- KILL ^XTMP("XPDT",XPDA,"KRN",8989.52,DA,10,"B")
- +8 FOR
- SET XP1=$ORDER(^XTV(8989.52,DA,10,XP1))
- SET XP3=""
- IF 'XP1
- QUIT
- Begin DoDot:1
- +9 SET XP2=$PIECE(^XTV(8989.52,DA,10,XP1,0),U,2)
- +10 IF XP2
- SET XP3=$$PT^XPDTA($NAME(^XTV(8989.51)),XP2)
- +11 IF '$LENGTH(XP3)
- KILL @ROOT@(8989.52,DA,10,XP1)
- +12 SET $PIECE(^XTMP("XPDT",XPDA,"KRN",8989.52,DA,10,XP1,0),U,2)=XP3
- +13 ;Now to move the entries this points to.
- +14 IF '$DATA(@ROOT@(8989.51,XP2))
- MERGE @ROOT@(8989.51,XP2)=^XTV(8989.51,XP2)
- DO PAR51(XP2)
- +15 QUIT
- End DoDot:1
- +16 QUIT