Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XPDTA2

XPDTA2.m

Go to the documentation of this file. 
  1. XPDTA2 ;SFISC/RWF -  Build Actions for Kernel Files Cont. ;08/09/2001  12:36
  1.  ;;8.0;KERNEL;**201,498,672**;Jul 10, 1995;Build 28
  1.  ;Per VHA Directive 2004-038, this routine should not be modified.
  1.  Q
  1.  ;^XTMP("XPDT",XPDA,"KRN",XPDFILE,DA) is the global root
  1.  ;DA=ien in ^XTMP,XPDNM=package name, XPDA=package ien in ^XPD(9.6,
  1.  ;
  1. PAR1E1 ;PARAMETER DEFINITION file 8989.51: entry post
  1.  N XP,XP1,XP2,XP3,XP4,VP,PN,PT,ROOT
  1.  S ROOT=$NA(^XTMP("XPDT",XPDA,"KRN"))
  1.  D PAR51(DA) ;Handle the entry from 8989.51
  1.  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
  1.  S:PT]"" PT=$S(PT:$$GR^XPDTA(PT),1:"") ;PT=file # of pointed to file from parm def.
  1.  ;Now find any entrys in 8989.5 to transport, because we point to them
  1.  S XP=0,XP3=$P(^XPD(9.6,XPDA,0),U,2),VP=XP3_";DIC(9.4,",PN=$$PT^XPDTA("^DIC(9.4)",XP3)
  1.  Q:'XP3  ;No package file link
  1.  F  S XP=$O(^XTV(8989.5,"AC",DA,VP,XP)),XP1=0 Q:'XP  D  ;Instance
  1.  . F  S XP1=$O(^XTV(8989.5,"AC",DA,VP,XP,XP1)) Q:'XP1  D  ;entry
  1.  . . M ^XTMP("XPDT",XPDA,"KRN",8989.5,XP1)=^XTV(8989.5,XP1)
  1.  . . S XP3=^XTV(8989.5,XP1,0),XP4=$G(^(1)) ;param def.
  1.  . . S $P(@ROOT@(8989.5,XP1,0),U,2)=$$PT^XPDTA("^XTV(8989.51)",$P(XP3,U,2))
  1.  . . I PT]"",XP4>0 S $P(@ROOT@(8989.5,XP1,1),U)=$$PT^XPDTA(PT,XP4) ;Data Type pointer - resolve
  1.  . . Q  ;Will redo the ENT at other end.
  1.  Q
  1.  ;
  1. PAR51(DA) ;Fix one 8989.51 entry in transport global
  1.  ;Called from both PAR1E1 and PAR2E1
  1.  N XP,XP1,XP2,XP3,VP,PN,ROOT
  1.  S ROOT=$NA(^XTMP("XPDT",XPDA,"KRN"))
  1.  ;Don't bring X-ref
  1.  K @ROOT@(8989.51,DA,30,"B"),^("AG")
  1.  S XP=0
  1.  ;Entries in the file will be maintained by Toolkit patches.
  1.  Q
  1.  ;
  1. PAR2E1 ;PARAMETER file 8989.52 entry post
  1.  N XP1,XP2,XP3,ROOT
  1.  S ROOT=$NA(^XTMP("XPDT",XPDA,"KRN"))
  1.  ;Resolve USE INSTANCE OF
  1.  S XP2=$P(^XTV(8989.52,DA,0),U,4),XP3="" I XP2 S XP3=$$PT^XPDTA($NA(^XTV(8989.51)),XP2)
  1.  I $L(XP3) S $P(@ROOT@(8989.52,DA,0),U,4)=XP3
  1.  ;Resolve PARAMETERS
  1.  S XP1=0 K ^XTMP("XPDT",XPDA,"KRN",8989.52,DA,10,"B") ;Drop X-ref
  1.  F  S XP1=$O(^XTV(8989.52,DA,10,XP1)),XP3="" Q:'XP1  D
  1.  . S XP2=$P(^XTV(8989.52,DA,10,XP1,0),U,2)
  1.  . I XP2 S XP3=$$PT^XPDTA($NA(^XTV(8989.51)),XP2)
  1.  . I '$L(XP3) K @ROOT@(8989.52,DA,10,XP1)
  1.  . S $P(^XTMP("XPDT",XPDA,"KRN",8989.52,DA,10,XP1,0),U,2)=XP3
  1.  . ;Now to move the entries this points to.
  1.  . I '$D(@ROOT@(8989.51,XP2)) M @ROOT@(8989.51,XP2)=^XTV(8989.51,XP2) D PAR51(XP2)
  1.  . Q
  1.  Q
  1. XULM ;XULM LOCK DICTIONARY file 8993
  1.  N XP1,XP2
  1.  ;resolve PACKAGE
  1.  S XP1=$P($G(^XTMP("XPDT",XPDA,"KRN",8993,DA,1)),U)
  1.  S:XP1 $P(^XTMP("XPDT",XPDA,"KRN",8993,DA,1),U)=$$PT^XPDTA("^DIC(9.4)",XP1)
  1.  ;kill X-ref
  1.  K ^XTMP("XPDT",XPDA,"KRN",8993,2,"B"),^XTMP("XPDT",XPDA,"KRN",8993,3,"B"),^("C")
  1.  Q
  1.  ;
  1. ENT ;ENTITY file 1.5
  1.  N %,%1
  1.  ;Loop thru ITEM multiple and resolve ENTITY (0;8)
  1.  S %1=0 F  S %1=$O(^XTMP("XPDT",XPDA,"KRN",1.5,DA,1,%1)) Q:'%1  S %=$G(^(%1,0)) D:$P(%,U,8)
  1.  . S $P(%,U,8)=$$PT^XPDTA("^DDE",$P(%,U,8)),^XTMP("XPDT",XPDA,"KRN",1.5,DA,1,%1,0)=%
  1.  Q
  1.  ;
  1. POL ;POLICY file 1.6
  1.  N %,%1,%2
  1.  ;if link, kill everything and just process the MEMBERS(10)
  1.  I XPDFL=2 D  G POLM
  1.  .S %1=0 F  S %1=$O(^XTMP("XPDT",XPDA,"KRN",1.6,DA,%1)) Q:'%1  K:%1'=10 ^(%)
  1.  .Q
  1.  ;resolve ATTRIBUTE FUNCTION (0;4) and RESULT FUNCTION (0;7)
  1.  S %=^XTMP("XPDT",XPDA,"KRN",1.6,DA,0) D  S ^XTMP("XPDT",XPDA,"KRN",1.6,DA,0)=%
  1.  .F %1=4,7 S %2=$P(%,U,%1),$P(%,U,%1)=$$PT^XPDTA("^DIAC(1.62)",%2)
  1.  .Q
  1.  ;resolve DENY OBLIGATION (7) and PERMIT OBLIGATION (8)
  1.  F %1=7,8 S %=$G(^XTMP("XPDT",XPDA,"KRN",1.6,DA,%1)) D:$L(%)
  1.  .S %2=$P(%,U),$P(%,U)=$$PT^XPDTA("^DIAC(1.62)",%2)
  1.  .S ^XTMP("XPDT",XPDA,"KRN",1.6,DA,%1)=%
  1.  .Q
  1.  ;kill under TAGETS (2) ^("B"),^("AKEY")
  1.  I $O(^XTMP("XPDT",XPDA,"KRN",1.6,DA,2,0)) K ^("B"),^("AKEY")
  1.  ;check if CONDITIONS (3) are sent, if yes then kill ^("B") and process
  1.  I $O(^XTMP("XPDT",XPDA,"KRN",1.6,DA,3,0)) K ^("B") D
  1.  .;loop thru and resolve FUNCTION (0;2)
  1.  .S %1=0 F  S %1=$O(^XTMP("XPDT",XPDA,"KRN",1.6,DA,3,%1)) Q:'%1  S %=$G(^(%1,0)) D
  1.  ..S %2=$P(%,U,2) Q:'%2
  1.  ..S $P(%,U,2)=$$PT^XPDTA("^DIAC(1.62)",%2)
  1.  ..S ^XTMP("XPDT",XPDA,"KRN",1.6,DA,3,%1,0)=%
  1.  .Q
  1. POLM ;loop thru 10=MEMEBERS and resolve MEMBER (0;1), kill if it doesn't resolve
  1.  Q:'$O(^XTMP("XPDT",XPDA,"KRN",1.6,DA,10,0))
  1.  ;kill under MEMBERS (10), "B"=name, "AC"=SEQUENCE
  1.  K ^XTMP("XPDT",XPDA,"KRN",1.6,DA,10,"B"),^("AC")
  1.  S %1=0 F  S %1=$O(^XTMP("XPDT",XPDA,"KRN",1.6,DA,10,%1)) Q:'%1  S %=$G(^(%1,0)) D
  1.  .S %2=$$PT^XPDTA("^DIAC(1.6)",+%)
  1.  .;MEMBER must also be sent by itself, check "B" x-ref, save text on U node
  1.  .I $L(%2),$D(^XPD(9.6,XPDA,"KRN",1.6,"NM","B",%2)) S ^XTMP("XPDT",XPDA,"KRN",1.6,DA,10,%1,U)=%2 Q
  1.  .K ^XTMP("XPDT",XPDA,"KRN",1.6,DA,10,%1)
  1.  .Q
  1.  Q
  1.  ;
  1. POLE ;EVENT #1.61
  1.  N %,%1,%2
  1.  S %=^XTMP("XPDT",XPDA,"KRN",1.61,DA,0)
  1.  ;resolve POLICY (0;5)
  1.  S %1=$P(%,U,5) Q:'%1
  1.  S %2=$$PT^XPDTA("^DIAC(1.6)",%1),$P(%,U,5)=%2,^XTMP("XPDT",XPDA,"KRN",1.61,DA,0)=%
  1.  Q
  1.  ;
  1. POLF ;FUNCTION #1.62
  1.  Q