| 1 | XPAR1 ;SLC/KCM - Supporting Calls - Validate;11:35 PM 12 May 1998
|
|---|
| 2 | ;;7.3;TOOLKIT;**26**;Apr 25, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | INTERN ;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
|
|---|
| 23 | C1 ; 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
|
|---|
| 30 | ENTEXT(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
|
|---|
| 41 | ENTDFLT(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
|
|---|
| 62 | ENTLST(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
|
|---|
| 92 | MAKEVP(FN) ; function - returns VP suffix given file number
|
|---|
| 93 | Q ";"_$P($$ROOT^DILFD(FN),U,2)
|
|---|
| 94 | ;
|
|---|
