source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XPDIA3.m@ 613

Last change on this file since 613 was 613, checked in by George Lilly, 14 years ago

initial load of WorldVistAEHR
File size: 3.3 KB
Line 
1XPDIA3 ;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 ;
9PAR0F2 ;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 ;
38LKPAR(ENT,PAR,INST) ;Lookup an entry
39 Q $O(^XTV(8989.5,"AC",PAR,ENT,INST,0))
40 ;
41ADDPAR(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 ;
49PAR1F1 ;PARAMETER File 8989.51: file Pre
50 Q
51PAR1E1 ;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
59PAR1F2 ;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
66PAR1DEL(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 ;
71PAR2F1 ;PARAMETER File 8989.52: file Pre
72 K ^TMP($J,"XPD")
73 Q
74PAR2E1 ;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
86PAR2F2 ;PARAMETER file 8989.52: file Post
87 Q
88PAR2DEL(RT) ;Delete Parameter Templates
89 D DELIEN^XPDUTL1(8989.52,RT)
90 Q
Note: See TracBrowser for help on using the repository browser.