88 lines
3.8 KiB
Mathematica
88 lines
3.8 KiB
Mathematica
XPAREDT1 ;SLC/KCM - Supporting Calls - Entities;12:16 AM 13 May 1998
|
|
;;7.3;TOOLKIT;**26**;Apr 25, 1995
|
|
;
|
|
BLDLST ; ...continued from BLDLST^XPAREDIT(LST,PAR)
|
|
; Build list of entities allowed for this parameter
|
|
; # is precedence, 'fixed' is VP to implied instance (i.e., SYS, PKG)
|
|
; .LST(#)=file number^message^order^prefix^fixed^lookup info
|
|
; ("M", message) = #
|
|
; ("P", prefix) = #
|
|
; PAR=ien^name
|
|
N IEN,SEQ,FN,X K LST ; make sure LST is empty initially
|
|
S SEQ=0,LST=0
|
|
F S SEQ=$O(^XTV(8989.51,+PAR,30,"B",SEQ)) Q:'SEQ S IEN=$O(^(SEQ,0)) D
|
|
. S FN=$P(^XTV(8989.51,+PAR,30,IEN,0),"^",2) I FN=9.4,(DUZ(0)'["@") Q
|
|
. S X=^XTV(8989.518,FN,0),X=FN_U_$P(X,U,3)_U_U_$P(X,U,2)
|
|
. S LST=LST+1,LST(SEQ)=X
|
|
. S LST("M",$$UPPER($P(X,U,2)))=SEQ
|
|
. S LST("P",$P(X,U,4))=SEQ
|
|
. ; find IEN's where only one entity instance is possible
|
|
. I FN=9.4 D ; find package to which this parameter belongs
|
|
. . N PRN,PRE
|
|
. . S PRN=$P($G(^XTV(8989.51,+PAR,0)),"^",1) Q:'$L(PRN)
|
|
. . S PRE=PRN F S PRE=$O(^DIC(9.4,"C",PRE),-1) Q:'$L(PRE) Q:(PRE=$E(PRN,1,$L(PRE))) I '($E(PRE,1)=$E(PRN,1)) S PRE="" Q
|
|
. . Q:'$L(PRE)
|
|
. . S X=$O(^DIC(9.4,"C",PRE,0))
|
|
. . S $P(LST(SEQ),U,5)=X_";DIC(9.4,"
|
|
. . S $P(LST(SEQ),U,6)=$P(^DIC(9.4,X,0),"^",1)
|
|
. I FN=4.2 D ; find domain for this system
|
|
. . S X=$$KSP^XUPARAM("WHERE")
|
|
. . S $P(LST(SEQ),U,5)=$$FIND1^DIC(4.2,"","QX",X)_";DIC(4.2,"
|
|
. . S $P(LST(SEQ),U,6)=X
|
|
. I FN=4 D ; find division if this site not multi-divisional
|
|
. . S X=$$KSP^XUPARAM("INST")
|
|
. . I $$GET1^DIQ(4,X_",",5,"I")'="Y" D
|
|
. . . S $P(LST(SEQ),U,5)=X_";DIC(4,"
|
|
. . . S $P(LST(SEQ),U,6)=$$GET1^DIQ(4,X_",",.01)
|
|
. I '$L($P(LST(SEQ),U,5)) D ; otherwise...
|
|
. . N XPARY,XPARFN S XPARFN=FN N FN
|
|
. . D FILE^DID(XPARFN,"","NAME","XPARY")
|
|
. . S $P(LST(SEQ),U,6)=$G(XPARY("NAME"))
|
|
Q
|
|
GETCLS ; ...continued from GETCLS^XPAREDIT(X,PAR,LST)
|
|
; Choose the class of entity
|
|
; optionally, lookup entity using variable pointer syntax (PRE.NAME)
|
|
; .X=returns seq # or entity in VP format
|
|
; PAR=ien^name for parameter
|
|
; .LST=list from which the entity is selected
|
|
N TMP,DONE
|
|
D SHWCLS
|
|
S DONE=0 F D Q:DONE
|
|
. W !,"Enter selection: " R X:DTIME S:'$T X="^" S X=$$UPPER(X)
|
|
. I '$L(X)!(X="^")!(X="^^") S ENT="",DONE=1 Q
|
|
. I $E(X)="?" D HLPCLS I $E(X,1,2)="??" D SHWCLS ; help requested
|
|
. I X=" " S X=$G(^DISV(DUZ,"XPAR01",+PAR)) Q:'X ; spacebar recall
|
|
. I +X,$D(LST(X)) S DONE=1 Q ; # -> seq #
|
|
. I $D(LST("P",X)) S X=LST("P",X),DONE=1 Q ; PRE -> seq #
|
|
. I $D(LST("M",X)) S X=LST("M",X),DONE=1 Q ; NAME -> seq #
|
|
. S TMP=$O(LST("M",X))
|
|
. I $E(TMP,1,$L(X))=X S X=LST("M",TMP),DONE=1 Q ; PARTIAL -> seq #
|
|
. I $L(X,".")>1,$D(LST("P",$P(X,".",1))) D Q:DONE ; if VP syntax
|
|
. . S TMP=$P(X,".",2)
|
|
. . D LOOKUP^XPAREDIT(.TMP,+LST(LST("P",$P(X,".",1)))) ; silent lookup
|
|
. . I $L(TMP) S X=TMP,DONE=1 ; PRE.NAME -> VP
|
|
. W " ??" D HLPCLS ; invalid entry
|
|
I +X D
|
|
. W " ",$P(LST(X),U,2)," ",$P(LST(X),U,6) ; echo selection
|
|
. I +LST(X)=9.4 D
|
|
. . W !!,"Parameters set for 'Package' may be replaced if "
|
|
. . W $P(LST(X),U,6),!,"is installed in this account."
|
|
. S ^DISV(DUZ,"XPAR01",+PAR)=X
|
|
Q
|
|
SHWCLS ; procedure used only by GETCLS
|
|
; show entity classes appropriate for this parameter
|
|
N I,X
|
|
W !!,$P(PAR,"^",2)," may be set for the following:",!!
|
|
S I=0 F S I=$O(LST(I)) Q:'I S X=LST(I) D
|
|
. W ?5,I,?9,$P(X,"^",2),?23,$P(X,U,4),?30
|
|
. I $L($P(X,U,5)) W "["_$P(X,U,6)_"]",!
|
|
. I '$L($P(X,U,5)) W "[choose from "_$P(X,U,6)_"]",!
|
|
Q
|
|
HLPCLS ; procedure used only by GETCLS
|
|
; display help for entity class selection
|
|
W !,"Enter the number, name, or abbreviation of the selection."
|
|
W !,"You may also use variable pointer syntax (Example: LOC.WEST2)."
|
|
Q
|
|
UPPER(X) ; function - convert lower to upper case
|
|
Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|