source: WorldVistAEHR/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XPAR1.m@ 862

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

initial load of WorldVistAEHR
File size: 4.1 KB
Line 
1XPAR1 ;SLC/KCM - Supporting Calls - Validate;11:35 PM 12 May 1998
2 ;;7.3;TOOLKIT;**26**;Apr 25, 1995
3 ;
4INTERN ;convert ENT, PAR, and INST to internal form - called from XPAR only
5 ; ENT: entity in external or internal form
6 ; PAR: parameter in external or internal form
7 ; INST: instance in external or internal form, or null
8 ; (may be null when retrieving all instances)
9 ; ERR: returns error (0 if none, otherwise #^error text)
10 ; -- parameter
11 I 'PAR S PAR=+$O(^XTV(8989.51,"B",PAR,0))
12 ; -- instance
13 I $D(XPARCHK) D VALID^XPARDD(PAR,.INST,"I",.ERR) Q:ERR
14 ; -- entity formats are: nnn;GLO( vptr int
15 ; PRE.NAME vptr ext
16 ; PRE.`nnn vptr ien
17 ; PRE default
18 ; ALL search chain
19 ; begin case
20 I ($L(ENT,"^")>1)!(ENT="ALL") D ENTLST(.ENT,PAR,INST) G C1
21 I ENT?3U D ENTDFLT(.ENT) G C1 ;resolve default entity
22 I '(+ENT&(ENT[";")) D ENTEXT(.ENT) G C1 ;resolve external vptr fmt
23C1 ; end case
24 ; by this time, ENT should be in internal variable ptr format
25 I '$D(XPARGET) D ;tighter checks when storing data
26 . I '(+ENT&(ENT[";")) S ERR=$$ERR^XPARDD(89895011) Q ;not VP fmt
27 . I $D(@("^"_$P(ENT,";",2)_$P(ENT,";",1)_")"))'>1 D Q ;not found
28 . . S ERR=$$ERR^XPARDD(89895012)
29 Q
30ENTEXT(ENT) ; change entity from external form (PRE.NAME) to VP form
31 ; .ENT: entity in external VP form
32 ; .FN: optionally returns file number for entity
33 I ENT'["." S ENT="" Q
34 N FN,PRE,X
35 S PRE=$P(ENT,".",1),X=$P(ENT,".",2,3),ENT=""
36 S FN=$O(^XTV(8989.518,"C",PRE,0))
37 I $E(X)="`" S ENT=+$E(X,2,99)_$$MAKEVP(FN) Q
38 S ENT=$$FIND1^DIC(FN,"","X",X)_$$MAKEVP(FN)
39 I 'ENT S ENT=""
40 Q
41ENTDFLT(ENT) ; change default form (prefix only) to actual value in VP format
42 ; .ENT: entity prefix only
43 ; XPARSYS should be a system wide variable, identifies current domain
44 I ENT="SYS" D:'$D(XPARSYS) S ENT=XPARSYS Q ; current site
45 . S XPARSYS=$$FIND1^DIC(4.2,"","QX",$$KSP^XUPARAM("WHERE"))_";DIC(4.2,"
46 I ENT="USR" S ENT=DUZ_";VA(200," Q ; user in DUZ
47 I ENT="CLS" S ENT="" Q ; no default
48 I ENT="TEA" S ENT="" Q ; no default
49 I ENT="BED" S ENT="" Q ; no default
50 I ENT="LOC" S ENT="" Q ; no default
51 I ENT="SRV" S ENT="" Q ; no default
52 I ENT="DIV" D Q ; division in DUZ(2)
53 . S ENT="" I +DUZ(2) S ENT=DUZ(2)_";DIC(4,"
54 I ENT="PKG" D Q ; package of param namespace
55 . N PKG,NAM
56 . S NAM=$P(^XTV(8989.51,PAR,0),"^",1),PKG=NAM
57 . F S PKG=$O(^DIC(9.4,"C",PKG),-1) Q:$E(NAM,1,$L(PKG))=PKG
58 . I $L(PKG) S PKG=$O(^DIC(9.4,"C",PKG,0))
59 . I PKG S ENT=PKG_";DIC(9.4,"
60 S ENT="" ; no default found
61 Q
62ENTLST(ENT,PAR,INST) ; resolve entity list to entity with highest precedence
63 ; .ENT: multiple entity pieces or keyword 'ALL'
64 ; PAR: parameter IEN
65 ; INST: instance (may be null)
66 I $E(ENT,1,3)="ALL" D
67 . N FND,IEN,FN,GREF,LIST,I,X
68 . ; set up list of entity values that were passed in
69 . F I=2:1:$L(ENT,"^") S X=$P(ENT,"^",I) I $L(X) D
70 . . I $D(^XTV(8989.518,"C",X)) D ENTDFLT(.X)
71 . . I '(+X&(X[";")) D ENTEXT(.X)
72 . . S GREF=$P(X,";",2)
73 . . I $D(^XTV(8989.51,PAR,30,"AG",GREF)) S IEN=$O(^(GREF,0)) D
74 . . . S LIST($P(^XTV(8989.51,PAR,30,IEN,0),"^",2))=X
75 . ; using precedence defined for parameter, look up entities
76 . S I=0,FND=0
77 . F S I=$O(^XTV(8989.51,PAR,30,"B",I)) Q:'I S IEN=$O(^(I,0)) D Q:FND
78 . . S FN=$P(^XTV(8989.51,PAR,30,IEN,0),"^",2),X=$G(LIST(FN))
79 . . I '$L(X) S X=$P(^XTV(8989.518,FN,0),U,2) D ENTDFLT(.X)
80 . . I $L(X),'$L(INST),$D(^XTV(8989.5,"AC",PAR,X)) S ENT=X,FND=1 Q
81 . . I $L(X),$L(INST),$D(^XTV(8989.5,"AC",PAR,X,INST)) S ENT=X,FND=1 Q
82 E D
83 . ; use only entity values that were passed in
84 . N I,FND
85 . S FND=0
86 . F I=1:1:$L(ENT,"^") S X=$P(ENT,"^",I) I $L(X) D Q:FND
87 . . I $D(^XTV(8989.518,"C",X)) D ENTDFLT(.X)
88 . . I '(+X&(X[";")) D ENTEXT(.X)
89 . . I $L(X),'$L(INST),$D(^XTV(8989.5,"AC",PAR,X)) S ENT=X,FND=1 Q
90 . . I $L(X),$L(INST),$D(^XTV(8989.5,"AC",PAR,X,INST)) S ENT=X,FND=1 Q
91 Q
92MAKEVP(FN) ; function - returns VP suffix given file number
93 Q ";"_$P($$ROOT^DILFD(FN),U,2)
94 ;
Note: See TracBrowser for help on using the repository browser.