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@ 1297

Last change on this file since 1297 was 623, checked in by George Lilly, 15 years ago

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